+++ /dev/null
-2003-04-22 Andrew Innes <andrewi@gnu.org>
-
- * nt/makedist.bat: Fix multi-file .zip distribution, by splitting
- emacs.exe before zipping, and including batch file to recreate
- after unpacking.
-
- * nt/stitch.bat: New file.
-
- * nt/README-ftp-server: Update wording and version number etc.
- Add extra instructions for installing multi-file .zip
- distribution.
-
- * nt/README.W32: Remove personal email address and update wording.
-
- * nt/README-UNDUMP.W32: Remove personal email address and update
- wording.
-
-2003-02-10 Francesco Potort
\e,Al
\e(B <pot@gnu.org>
-
- * make-changelog-diff: New script, code stolen from make-announcement.
-
- * make-announcement: Use make-changelog-diff.
-
-2003-01-20 Francesco Potort
\e,Al
\e(B <pot@gnu.org>
-
- * make-tarball.txt: Step-by-step instructions for making a tarball.
-
- * make-announcement: A script for creating pretest annuncements.
-
-2003-01-17 Francesco Potort
\e,Al
\e(B <pot@gnu.org>
-
- * admin.el (add-release-logs): Expand the directory name before
- calling find(1).
- (add-release-logs): Use the same methods as add-log.el for writing
- the date and the user's name and address
-
-2003-01-07 Miles Bader <miles@gnu.org>
-
- * quick-install-emacs: Unset LANG etc. to avoid non-standard
- command output from non-C locales.
-
-2002-10-16 Markus Rost <rost@math.ohio-state.edu>
-
- * cus-test.el: Extended and reorganized. There are now 4 tests
- which can be run in batch mode. See the Commentary section.
-
-2002-10-08 Markus Rost <rost@math.ohio-state.edu>
-
- * cus-test.el: New file.
-
-2002-05-27 Miles Bader <miles@gnu.org>
-
- * quick-install-emacs (VERSION): Calculate using the same method
- that configure.in uses.
-
-2002-04-26 Pavel Jan
\e,Bm
\e(Bk <Pavel@Janik.cz>
-
- * emacs-pretesters: New file with information for Emacs
- pretesters.
-
-2002-03-22 Paul Eggert <eggert@twinsun.com>
-
- * quick-install-emacs (PRUNED): Avoid "head -1" and "tail +2", as
- POSIX 1003.1-2001 disallows both usages.
-
-2002-02-11 Andrew Innes <andrewi@gnu.org>
-
- * nt/makedist.bat: Don't include elisp/term/*.el files twice.
-
-2002-01-24 Andrew Innes <andrewi@gnu.org>
-
- * nt/README.W32: Remove unnecessary version number and date
- references.
-
- * nt/README-UNDUMP.W32: Ditto.
-
-2001-12-06 Gerd Moellmann <gerd@gnu.org>
-
- * make-emacs: Add --trace-move.
-
-2001-10-23 Andrew Innes <andrewi@gnu.org>
-
- * nt/makedist.bat: Remove remaining obsolete reference to
- GETTING.GNU.SOFTWARE.
-
-2001-10-22 Gerd Moellmann <gerd@gnu.org>
-
- * admin.el (set-version): Use `s' interactive spec for
- version number.
-
-2001-10-20 Gerd Moellmann <gerd@gnu.org>
-
- * (Version 21.1 released.)
-
-2001-10-20 Gerd Moellmann <gerd@gnu.org>
-
- * admin.el (add-release-logs): Put the log entry in lispref, too.
-
-2001-10-20 Miles Bader <miles@gnu.org>
-
- * quick-install-emacs: Exit if we can't find some variable.
- (AVOID): Add .orig & .rej files.
- (get_config_var): Be more liberal about format of config.status
- sed commands.
-
-2001-10-19 Gerd Moellmann <gerd@gnu.org>
-
- * admin.el: New file.
-
- * build-configs: Add --help option. Add support for building
- in arbitrary source trees.
-
-2001-10-17 Gerd Moellmann <gerd@gnu.org>
-
- * alloc-colors.c: New file.
-
-2001-10-13 Gerd Moellmann <gerd@gnu.org>
-
- * make-emacs: Add --boot switch for bootstrapping. Logs to
- EMACS_ROOT/boot.log, renames previous log file to boot.log.old.
-
-2001-10-05 Gerd Moellmann <gerd@gnu.org>
-
- * Branch for 21.1.
-
-2001-09-04 Andrew Innes <andrewi@gnu.org>
-
- * admin/nt/makedist.bat: Remove reference to obsolete file
- GETTING.GNU.SOFTWARE. Remove outdated comments. Explain about
- version of tar used.
-
-;; Local Variables:
-;; coding: iso-2022-7bit-unix
-;; End:
-
- Copyright (C) 2001 Free Software Foundation, Inc.
- Copying and distribution of this file, with or without modification,
- are permitted provided the copyright notice and this notice are preserved.
+++ /dev/null
-This directory contains scripts and other things useful for developing
-and maintaining Emacs. These files are not part of Emacs releases
-because they are not deemed generally useful, and you have to know
-what you do when using them.
-
-Brief description of scripts found here:
-
-admin.el utilities for setting version numbers and alike
-alloc-color.c a utility program that allocates a given number of
- colors on X. Can be used to debug Emacs with
- dense colormaps (PseudoColor).
-build-configs build Emacs in various configurations
-check-doc-strings check doc strings against documentation
-cus-test.el tests for custom types and load problems
-diff-tar-files show files added/removed between two tar files
-make-emacs build Emacs in various ways
-make-tarball.txt instructions to create pretest or release tarballs
-quick-install-emacs install emacs quickly (`incrementally')
-revdiff get CVS diffs of files
+++ /dev/null
-;;; admin.el --- utilities for Emacs administration
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; add-release-log add ``Version X released'' change log entries
-;; set-version change Emacs version number in source tree.
-
-;;; Code:
-
-(defun process-lines (program &rest args)
- "Execute PROGRAM with ARGS, returning its output as a list of lines.
-Signal an error if the program returns with a non-zero exit status."
- (with-temp-buffer
- (let ((status (apply 'call-process program nil (current-buffer) nil args)))
- (unless (eq status 0)
- (error "%s exited with status %s" program status))
- (goto-char (point-min))
- (let (lines)
- (while (not (eobp))
- (setq lines (cons (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position))
- lines))
- (forward-line 1))
- (nreverse lines)))))
-
-
-(defun add-release-logs (root version)
- "Add \"Version VERSION released.\" change log entries in ROOT.
-Root must be the root of an Emacs source tree."
- (interactive "DEmacs root directory: \nNVersion number: ")
- (setq root (expand-file-name root))
- (unless (file-exists-p (expand-file-name "src/emacs.c" root))
- (error "%s doesn't seem to be the root of an Emacs source tree" root))
- (let* ((logs (process-lines "find" root "-name" "ChangeLog"))
- (require 'add-log)
- (entry (format "%s %s <%s>\n\n\t* Version %s released.\n\n"
- (funcall add-log-time-format)
- (or add-log-full-name (user-full-name))
- (or add-log-mailing-address user-mail-address)
- version)))
- (dolist (log logs)
- (unless (string-match "/gnus/" log)
- (find-file log)
- (goto-char (point-min))
- (insert entry)))))
-
-
-(defun set-version-in-file (root file version rx)
- (find-file (expand-file-name file root))
- (goto-char (point-min))
- (unless (re-search-forward rx nil t)
- (error "Version not found in %s" file))
- (replace-match (format "%s" version) nil nil nil 1))
-
-
-(defun set-version (root version)
- "Set Emacs version to VERSION in relevant files under ROOT.
-Root must be the root of an Emacs source tree."
- (interactive "DEmacs root directory: \nsVersion number: ")
- (unless (file-exists-p (expand-file-name "src/emacs.c" root))
- (error "%s doesn't seem to be the root of an Emacs source tree" root))
- (set-version-in-file root "lisp/version.el" version
- (rx (and "emacs-version" (0+ space)
- ?\" (submatch (1+ (not (in ?\")))) ?\")))
- (set-version-in-file root "README" version
- (rx (and "version" (1+ space)
- (submatch (1+ (in "0-9."))))))
- (set-version-in-file root "man/emacs.texi" version
- (rx (and "EMACSVER" (1+ space)
- (submatch (1+ (in "0-9.")))))))
-
-;; admin.el ends here.
+++ /dev/null
-/* Allocate X colors. Used for testing with dense colormaps.
- Copyright (C) 2001 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-#include <X11/Xlib.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <stdarg.h>
-#include <unistd.h>
-
-void
-fatal (const char *fmt, ...)
-{
- va_list ap;
-
- va_start (ap, fmt);
- vfprintf (stderr, fmt, ap);
- fputc ('\n', stderr);
- va_end (ap);
- exit (1);
-}
-
-void
-usage (const char *progname)
-{
- fprintf (stderr, "Usage %s options\n", progname);
- fprintf (stderr, "-n NCOLORS allcoate NCOLORS colors\n");
- exit (1);
-}
-
-int
-main (int argc, char **argv)
-{
- Display *dpy;
- int opt, ncolors = 0, i;
- XColor *allocated;
- int nallocated;
- XColor color;
- Colormap cmap;
-
- while ((opt = getopt (argc, argv, "n:")) != EOF)
- switch (opt)
- {
- case 'n':
- ncolors = atoi (optarg);
- break;
-
- case '?':
- usage (argv[0]);
- }
-
- if (ncolors == 0)
- usage (argv[0]);
-
- dpy = XOpenDisplay ("");
- if (dpy == NULL)
- fatal ("Cannot open display");
- cmap = DefaultColormap (dpy, 0);
-
- allocated = malloc (ncolors * sizeof *allocated);
- nallocated = 0;
- memset (&color, 0, sizeof color);
-
- while (nallocated < ncolors
- && color.red < 65536)
- {
- allocated[nallocated] = color;
- if (XAllocColor (dpy, cmap, &allocated[nallocated]))
- {
- for (i = 0; i < nallocated; ++i)
- if (allocated[i].red == allocated[nallocated].red
- && allocated[i].green == allocated[nallocated].green
- && allocated[i].blue == allocated[nallocated].blue)
- break;
-
- if (i == nallocated)
- {
- printf ("allocated %d/%d/%d\n",
- allocated[nallocated].red,
- allocated[nallocated].green,
- allocated[nallocated].blue);
- ++nallocated;
- }
- }
-
- ++color.red;
- ++color.green;
- ++color.blue;
- }
-
- fprintf (stderr, "Waiting. Press ^C to stop.\n");
- while (1)
- sleep (10);
-
- XCloseDisplay (dpy);
- return 0;
-}
+++ /dev/null
-#! /usr/bin/perl
-
-# Copyright (C) 2001 Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to the
-# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# Build Emacs in several different configurations.
-
-require 5;
-use Getopt::Long;
-use File::Basename;
-use Cwd;
-
-@configs =
- (
- ["--without-x", "--optim"],
- ["--without-x-toolkit", "--optim"],
- ["--without-toolkit-scroll-bars", "--optim"],
- ["--with-x-toolkit=lucid", "--optim"],
- ["--with-x-toolkit=motif", "--optim"],
- ["--with-x-toolkit=motif", "--enable-checking"],
- ["--with-x-toolkit=motif", "--gcc3"],
- ["--with-x-toolkit=motif", ""],
- );
-
-$log = "/tmp/$$.out";
-print "Using log file $log\n";
-unlink $log;
-
-$root = $ENV{"EMACS_ROOT"};
-$root = "/gd/gnu/emacs" unless $root;
-
-$rc = GetOptions ("help" => \$help);
-if ($rc == 0 || $help)
- {
- print <<USAGE;
-build-configs
-
-Build Emacs in different configurations.
-
---help show this help
-
-USAGE
- exit 1;
- }
-
-# Chdir to the top-level directory of the tree. If not in a tree
-# containing Emacs, use the default.
-
-while (! -f "src/emacs.c" && cwd () ne "/")
- {
- chdir "..";
- }
-
-chdir $root if cwd () eq "/";
-print "Build in ", cwd (), "\n";
-
-foreach $config (@configs)
- {
- my $configure_options = @$config[0];
- my $make_options = @$config[1];
- my $rc;
-
- print "$configure_options, $make_options\n";
- unlink "config.cache";
-
- $rc = system ("$root/configure $configure_options >>$log 2>&1");
- if ($rc != 0)
- {
- print "configure failed\n";
- exit 1;
- }
-
- $rc = system ("make-emacs --all $make_options >>$log 2>&1");
- if ($rc != 0)
- {
- print "Make failed\n";
- exit 1;
- }
- }
-
-# Local Variables:
-# mode: cperl
-# End:
+++ /dev/null
-: #-*- Perl -*-
-eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge
- if 0; # Author: Martin Buchholz
-
-use strict;
-use POSIX;
-
-(my $myName = $0) =~ s@.*/@@; my $usage="
-Usage: $myName
-
-Finds DOCSTRING arg mismatches between
-formal parameters, docstrings, and lispref texi.
-
-This program is in the public domain.\n";
-
-die $usage if @ARGV;
-die $usage unless -r "src/alloc.c" && -d "CVS" && -d "lisp";
-
-my %texi_funtype;
-my %texi_arglist;
-
-my %code_funtype;
-my %code_arglist;
-
-sub FileContents {
- local $/ = undef;
- open (FILE, "< $_[0]") or die "$_[0]: $!";
- return scalar <FILE>;
-}
-
-sub Show_details {
- my ($show_details, $function, $parms, $docstring) = @_;
- if ($show_details) {
- print "function = $function $parms\n$docstring\n", "-" x 70, "\n";
- }
-}
-
-sub Check_texi_function {
- my ($function, $funtype, $docstring, @parms) = @_;
- my %docstring_parm;
- my %docstring_word;
- my %arglist_parm;
- my $show_details = 0;
-
- if (exists $texi_funtype{$function}) {
- print "duplicate texidoc: $function @parms\n";
- return; # later definition likely bogus package def
- }
-
- $texi_funtype{$function} = $funtype;
- $texi_arglist{$function} = "@parms";
-
- foreach my $parm (@parms) {
- next if $parm eq '&optional' || $parm eq '&rest';
- $arglist_parm{$parm} = 1;
- }
-
- foreach my $parm ($docstring =~ /\@var{([^{}]+)}/g) {
- $docstring_parm{$parm} = 1;
- }
-
- foreach my $hit ($docstring =~ /[^\`]\`[A-Za-z-]+\'/g)
- {
- print "texi \@code missing: $function: $hit\n";
- $show_details = 1;
- }
-
- # (my $raw_docstring = $docstring) =~ s/\@var{[^{}]+}//g;
- # $raw_docstring =~ s/[^a-zA-Z_-]+/ /g;
- # foreach my $word (split (' ', $raw_docstring)) {
- # if ($word =~ /^[A-Z][A-Z-]+$/) {
- # print "Missing \@var: $function: $word\n";
- # }
- # }
-
- foreach my $parm (keys %docstring_parm) {
- if (! exists $arglist_parm{$parm}) {
- print "bogus texi parm: $function: $parm\n";
- $show_details = 1;
- }
- }
-
- foreach my $parm (keys %arglist_parm) {
- if (! exists $docstring_parm{$parm}) {
- print "undocumented texi parm: $function: $parm\n";
- $show_details = 1;
- }
- }
-
- Show_details $show_details, $function, "@parms", $docstring;
-}
-
-sub Check_function {
- my ($function, $funtype, $docstring, @parms) = @_;
- my %docstring_parm;
- my %arglist_parm;
- my $show_details = 0;
-
- if (exists $code_funtype{$function}) {
- print "duplicate codedef: $function @parms\n";
- return; # later definition likely bogus package def
- }
-
- $code_funtype{$function} = $funtype;
- $code_arglist{$function} = "@parms";
- #foreach my $parm ($parms =~ /\b[a-z0-9-]{3,}\b/g) {
- # $arglist_parm{$parm} = 1;
- #}
- foreach my $parm (@parms) {
- next if $parm eq '&optional' || $parm eq '&rest';
- $arglist_parm{$parm} = 1;
- }
- my $doc_tmp = $docstring;
- $doc_tmp =~ s/[^A-Za-z0-9_-]/ /g;
- foreach my $parm (split (' ', $doc_tmp)) {
- if ($parm =~ /^[A-Z][A-Z0-9-]*$/) {
- next if $parm =~ /I18N/;
- next if $parm =~ /M17N/;
- $parm =~ tr[A-Z][a-z];
- $docstring_parm{$parm} = 1;
- }
- }
- # foreach my $parm ($docstring =~ /\b[A-Z0-9-]{1,}\b/g) {
- # next if $parm =~ /-$/;
- # $parm =~ tr[A-Z][a-z];
- # $docstring_parm{$parm} = 1;
- # }
- foreach my $parm (keys %docstring_parm) {
- next if $parm eq 'tty';
- next if $parm eq 'fsf';
- next if $parm eq 'note';
- next if $parm eq 'warning';
- next if $parm eq 'bug';
- next if $parm eq 'ascii';
- next if $parm eq 'iso';
- next if $parm eq 'and';
- next if $parm eq 'absolutely';
- next if $parm eq 'doc';
- next if $parm eq 'user';
- next if $parm eq 'not';
- next if $parm eq 'must';
- next if $parm eq 'nil';
- next if $parm eq 'esc';
- next if $parm eq 'lfd';
- next if $parm eq 'gpm';
- next if $parm eq 'primary';
- next if $parm eq 'secondary';
- next if $parm eq 'clipboard';
- next if length $parm < 3;
- if (! exists $arglist_parm{$parm}) {
- print "bogus parm: $function: $parm\n";
- $show_details = 1;
- }
- }
- foreach my $parm (keys %arglist_parm) {
- if (! exists $docstring_parm{$parm}) {
- print "Undocumented parm: $function: $parm\n";
- $show_details = 1;
- }
- }
-
- if ($docstring !~ /[\]}!\)\.]\s*\Z/m &&
- $docstring =~ /\S/ &&
- $docstring !~ /Keywords supported/)
- {
- print "Missing trailing period: $function\n";
- $show_details = 1;
- }
-
- if (exists $texi_arglist{$function}
- and "@parms" ne $texi_arglist{$function}
- and not ("@parms" eq 'int nargs Lisp-Object *args'
- && $texi_arglist{$function} =~ /&rest/)) {
- my @texi_parms = split (' ', $texi_arglist{$function});
- my @a = ("@parms" =~ /&optional/g);
- my @b = ("@parms" =~ /&rest/g);
- my @c = ("@texi_parms" =~ /&optional/g);
- my @d = ("@texi_parms" =~ /&rest/g);
- if (@parms != @texi_parms
- || (@a != @c) || (@b != @d)) {
- print "serious mismatch: $function: @parms --- @texi_parms\n";
- } else {
- print "texi mismatch: $function: @parms --- $texi_arglist{$function}\n";
- }
- $show_details = 1;
- }
-
- if (exists $texi_funtype{$function}
- && $texi_funtype{$function} ne $funtype) {
- print "interactiveness mismatch: $function: $funtype --- $texi_funtype{$function}\n";
- $show_details = 1;
- }
-
- Show_details $show_details, $function, "@parms", $docstring;
-}
-
-my $lisprefdir;
-if (-d "man/lispref") { $lisprefdir = "man/lispref"; }
-elsif (-d "lispref") { $lisprefdir = "lispref"; }
-else { die "Can't find lispref texi directory.\n"; }
-
-open (FIND, "find $lisprefdir -name '*.texi' -print |") or die;
-while (my $file = <FIND>) {
- my @matches = ((FileContents $file) =~
- /\@(def(?:fn|un))([^\n]+)\n(.*?)\n\@end def(?:un|fn)/sgo);
- # /^\@(def(?:un|fn))\s+(.*)\n([.|\n]*?)^\@end def(?:un|fn)\n/mgo);
- while (@matches) {
- my ($defform, $defn, $docstring) = splice (@matches, 0, 3);
- #print "defform = $defform\n";
- #print "defn = $defn\n";
- #print "docstring = $docstring\n";
- my ($function, @parms, $funtype);
- if ($defform eq 'defun') {
- ($funtype, $function, @parms) = ('Function', split (' ', $defn));
- } else {
- die unless $defform eq 'deffn';
- ($funtype, $function, @parms) = split (' ', $defn);
- }
- next if $funtype eq '{Syntax' or $funtype eq '{Prefix';
-
- Check_texi_function $function, $funtype, $docstring, @parms;
- }
-}
-
-open (FIND, "find src -name '*.c' -print |") or die;
-while (my $file = <FIND>) {
- my @matches =
- ((FileContents $file) =~
- /\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo);
- while (@matches) {
- my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@matches, 0, 6);
- $docstring =~ s/^\n+//s;
- $docstring =~ s/\n+$//s;
- $parms =~ s/,/ /g;
- my @parms = split (' ',$parms);
- for (@parms) { tr/_/-/; s/-$//; }
- if ($parms !~ /Lisp_Object/) {
- if ($minargs < @parms) {
- if ($maxargs =~ /^\d+$/) {
- die unless $maxargs eq @parms;
- splice (@parms, $minargs, 0, '&optional');
- }
- }
- }
- my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function');
- Check_function $function, $funtype, $docstring, @parms;
- }
-}
-
-my @pkgs;
-if (-d "../xemacs-packages") {
- @pkgs = qw (libs/edebug libs/xemacs-base comm/eudc oa/edit-utils);
-} else {
- @pkgs = ();
-}
-for (@pkgs) { s@^@../xemacs-packages/@; }
-open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
-while (my $file = <FIND>) {
- my $contents = FileContents $file;
- $contents =~ s/(?:\s|;);.*//mog;
- my @matches =
- ($contents =~
- /\((def(?:un|subst|macro))\s+(\S+)\s+\(([^()]*)\)\s+\"((?:[^\\\"]|\\.)+)\"(.*?)\)/sgo);
- while (@matches) {
- my ($defform, $function, $parms, $docstring, $code_fragment) = splice (@matches, 0, 5);
-
- my $funtype =
- $defform eq 'defmacro' ? 'Macro' :
- $code_fragment =~ /^\s*\(interactive\b/so ? 'Command' :
- 'Function';
-
- $docstring =~ s/^\n+//s;
- $docstring =~ s/\n+$//s;
-
- my @parms = split (' ', $parms);
-
- Check_function $function, $funtype, $docstring, @parms;
- }
-}
-
-open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
-while (my $file = <FIND>) {
- my $contents = FileContents $file;
- $contents =~ s/(?:\s|;);.*//mog;
-
- my @matches = ($contents =~ /^\((?:defalias|fset|define-function)\s+\'([A-Za-z0-9_-]+)\s+\'([A-Za-z0-9_-]+)/mog);
- while (@matches) {
- my ($alias, $aliasee) = splice (@matches, 0, 2);
- print "alias $alias aliasee $aliasee\n";
- if (exists $code_funtype{$aliasee}) { $code_funtype{$alias} = $code_funtype{$aliasee}; }
- if (exists $code_arglist{$aliasee}) { $code_arglist{$alias} = $code_arglist{$aliasee}; }
- }
-}
-
-foreach my $fun (sort keys %texi_funtype) {
- if (not exists $code_funtype{$fun}) {
- print "nuke-this-doc: $fun $texi_funtype{$fun}\n";
- }
-}
-
+++ /dev/null
-;;; cus-test.el --- tests for custom types and load problems
-
-;; Copyright (C) 1998, 2000, 2002 Free Software Foundation, Inc.
-
-;; Author: Markus Rost <markus.rost@mathematik.uni-regensburg.de>
-;; Maintainer: Markus Rost <rost@math.ohio-state.edu>
-;; Created: 13 Sep 1998
-;; Keywords: maint
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This file provides simple tests to detect custom options with
-;; incorrect customization types and load problems for custom and
-;; autoload dependencies.
-;;
-;; The basic tests can be run in batch mode. Invoke them with
-;;
-;; src/emacs -batch -l admin/cus-test.el -f cus-test-opts
-;;
-;; src/emacs -batch -l admin/cus-test.el -f cus-test-deps
-;;
-;; src/emacs -batch -l admin/cus-test.el -f cus-test-libs
-;;
-;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
-;;
-;; in the emacs source directory.
-;;
-;; For interactive use: Load this file. Then
-;;
-;; M-x cus-test-apropos REGEXP RET
-;;
-;; checks the options matching REGEXP. In particular
-;;
-;; M-x cus-test-apropos RET
-;;
-;; checks all options. The detected options are stored in the
-;; variable `cus-test-errors'.
-;;
-;; Only those options are checked which have been already loaded.
-;; Therefore `cus-test-apropos' is more efficient after loading many
-;; libraries.
-;;
-;; M-x cus-test-load-custom-loads
-;;
-;; loads all (!) custom dependencies and
-;;
-;; M-x cus-test-load-libs
-;;
-;; loads all (!) libraries with autoloads.
-;;
-;; Options with a custom-get property, usually defined by a :get
-;; declaration, are stored in the variable
-;;
-;; `cus-test-vars-with-custom-get'
-;;
-;; Options with a state of 'changed ("changed outside the customize
-;; buffer") are stored in the variable
-;;
-;; `cus-test-vars-with-changed-state'
-;;
-;; These lists are prepared just in case one wants to investigate
-;; those options further.
-;;
-;; The command `cus-test-opts' tests many (all?) custom options.
-;;
-;; The command `cus-test-deps' is like `cus-test-load-custom-loads'
-;; but reports about load errors.
-;;
-;; The command `cus-test-libs' runs for all libraries with autoloads
-;; separate emacs processes of the form "emacs -batch -l LIB".
-;;
-;; The command `cus-test-noloads' returns a list of variables which
-;; are somewhere declared as custom options, but not loaded by
-;; `custom-load-symbol'.
-;;
-;; Some results from October 2002:
-;;
-;; 4523 options tested
-;; The following variables might have problems:
-;; ps-mule-font-info-database-default
-;; grep-tree-command
-;; grep-find-command
-;;
-;; 288 features required
-;; 10 files loaded
-;; The following load problems appeared:
-;; (killing x-win (file-error Cannot open load file x-win))
-;; Symbol faces has loaddefs as custom dependency
-;; (reftex-index-support reftex-vars (void-function reftex-set-dirty))
-;; (eshell-script em-script (void-variable eshell-directory-name))
-;; (pcomplete em-cmpl (void-function eshell-under-windows-p))
-;; (eshell-ext esh-ext (void-function eshell-under-windows-p))
-;; ...
-;;
-;; 422 libraries had no load errors
-;; The following load problems appeared:
-;; (eudc-export error 255)
-;; (ada-xref error 255)
-;; (ada-stmt error 255)
-;;
-;; The following options were not loaded by custom-load-symbol:
-;; edt-bottom-scroll-margin
-;; edt-keep-current-page-delimiter
-;; edt-top-scroll-margin
-;; edt-use-EDT-control-key-bindings
-;; edt-word-entities
-;; grep-find-use-xargs
-;; master-mode-hook
-;; outline-level
-;; outline-minor-mode-hook
-;; refill-mode-hook
-
-\f
-;;; Code:
-
-;;; Workarounds. For a smooth run and to avoid some side effects.
-
-(defvar cus-test-after-load-libs-hook nil
- "Used to switch off undesired side effects of loading libraries.")
-
-(defvar cus-test-skip-list nil
- "List of variables to disregard by `cus-test-apropos'.")
-
-(defvar cus-test-libs-noloads nil
- "List of libraries not to load by `cus-test-load-libs'.")
-
-;; The file eudc-export.el loads libraries "bbdb" and "bbdb-com" which
-;; are not part of GNU Emacs: (locate-library "bbdb") => nil
-;; We avoid the resulting errors from loading eudc-export.el:
-(provide 'bbdb)
-(provide 'bbdb-com)
-
-;; This avoids a hang of `cus-test-apropos' in 21.2.
-;; (add-to-list 'cus-test-skip-list 'sh-alias-alist)
-
-;; Don't create a file `filesets-menu-cache-file'.
-(setq filesets-menu-cache-file "")
-;; Disable filesets hooks.
-(add-hook
- 'cus-test-after-load-libs-hook
- (lambda nil
- (remove-hook 'menu-bar-update-hook 'filesets-build-menu-maybe)
- (remove-hook 'kill-emacs-hook 'filesets-exit)
- (remove-hook 'kill-buffer-hook 'filesets-remove-from-ubl)
- (remove-hook 'first-change-hook 'filesets-reset-filename-on-change)
- ))
-
-;; Loading dunnet in batch mode leads to a Dead end.
-(let (noninteractive) (load "dunnet"))
-(add-to-list 'cus-test-libs-noloads "dunnet")
-
-;; Never Viperize.
-(setq viper-mode nil)
-
-;; Don't create a file `save-place-file'.
-(eval-after-load "saveplace"
- '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
-
-;; Don't create a file `abbrev-file-name'.
-(setq save-abbrevs nil)
-
-;; Avoid compile logs from adviced functions.
-(eval-after-load "bytecomp"
- '(setq ad-default-compilation-action 'never))
-
-\f
-;;; Main code:
-
-;; We want to log all messages.
-(setq message-log-max t)
-
-(require 'cus-edit)
-(require 'cus-load)
-
-(defvar cus-test-errors nil
- "List of problematic variables found by `cus-test-apropos'.")
-
-(defvar cus-test-tested-variables nil
- "List of options tested by last call of `cus-test-apropos'.")
-
-;; I haven't understood this :get stuff. The symbols with a
-;; custom-get property are stored here.
-(defvar cus-test-vars-with-custom-get nil
- "Set by `cus-test-apropos' to a list of options with :get property.")
-
-(defvar cus-test-vars-with-changed-state nil
- "Set by `cus-test-apropos' to a list of options with state 'changed.")
-
-(defvar cus-test-deps-errors nil
- "List of require/load problems found by `cus-test-deps'.")
-
-(defvar cus-test-deps-required nil
- "List of dependencies required by `cus-test-deps'.
-Only unloaded features will be require'd.")
-
-(defvar cus-test-deps-loaded nil
- "List of dependencies loaded by `cus-test-deps'.")
-
-(defvar cus-test-libs-errors nil
- "List of load problems found by `cus-test-load-libs' or `cus-test-libs'.")
-
-(defvar cus-test-libs-loaded nil
- "List of files loaded by `cus-test-load-libs' or `cus-test-libs'.")
-
-(defvar cus-test-vars-not-cus-loaded nil
- "A list of options not loaded by `custom-load-symbol'.
-Set by `cus-test-noloads'.")
-
-;; (defvar cus-test-vars-cus-loaded nil
-;; "A list of options loaded by `custom-load-symbol'.")
-
-(defun cus-test-apropos (regexp)
- "Check the options matching REGEXP.
-The detected problematic options are stored in `cus-test-errors'."
- (interactive "sVariable regexp: ")
- (setq cus-test-errors nil)
- (setq cus-test-tested-variables nil)
- (mapc
- (lambda (symbol)
- (push symbol cus-test-tested-variables)
- ;; Be verbose in case we hang.
- (message "Cus Test running...%s %s"
- (length cus-test-tested-variables) symbol)
- (condition-case alpha
- (let* ((type (custom-variable-type symbol))
- (conv (widget-convert type))
- (get (or (get symbol 'custom-get) 'default-value))
- values
- mismatch)
- (when (default-boundp symbol)
- (push (funcall get symbol) values)
- (push (eval (car (get symbol 'standard-value))) values))
- (if (boundp symbol)
- (push (symbol-value symbol) values))
- ;; That does not work.
- ;; (push (widget-get conv :value) values)
-
- ;; Check the values
- (mapc (lambda (value)
- (unless (widget-apply conv :match value)
- (setq mismatch 'mismatch)))
- values)
-
- ;; Store symbols with a custom-get property.
- (when (get symbol 'custom-get)
- (add-to-list 'cus-test-vars-with-custom-get symbol))
-
- ;; Changed outside the customize buffer?
- ;; This routine is not very much tested.
- (let ((c-value
- (or (get symbol 'customized-value)
- (get symbol 'saved-value)
- (get symbol 'standard-value))))
- (and (consp c-value)
- (boundp symbol)
- (not (equal (eval (car c-value)) (symbol-value symbol)))
- (add-to-list 'cus-test-vars-with-changed-state symbol)))
-
- (if mismatch
- (push symbol cus-test-errors)))
-
- (error
- (push symbol cus-test-errors)
- (message "Error for %s: %s" symbol alpha))))
- (cus-test-get-options regexp))
- (message "%s options tested"
- (length cus-test-tested-variables))
- (cus-test-errors-display))
-
-(defun cus-test-get-options (regexp)
- "Return a list of custom options matching REGEXP."
- (let (found)
- (mapatoms
- (lambda (symbol)
- (and
- (or
- ;; (user-variable-p symbol)
- (get symbol 'standard-value)
- ;; (get symbol 'saved-value)
- (get symbol 'custom-type))
- (string-match regexp (symbol-name symbol))
- (not (member symbol cus-test-skip-list))
- (push symbol found))))
- found))
-
-(defun cus-test-errors-display ()
- "Report about the errors found by cus-test."
- (with-output-to-temp-buffer "*cus-test-errors*"
- (set-buffer standard-output)
- (insert (format "Cus Test tested %s variables.\
- See `cus-test-tested-variables'.\n\n"
- (length cus-test-tested-variables)))
- (if (not cus-test-errors)
- (insert "No errors found by cus-test.")
- (insert "The following variables seem to have problems:\n\n")
- (dolist (e cus-test-errors)
- (insert (symbol-name e) "\n")))))
-
-(defun cus-test-load-custom-loads ()
- "Call `custom-load-symbol' on all atoms."
- (interactive)
- (mapatoms 'custom-load-symbol)
- (run-hooks 'cus-test-after-load-libs-hook))
-
-(defun cus-test-load-libs ()
- "Load the libraries with autoloads.
-Don't load libraries in `cus-test-libs-noloads'."
- (interactive)
- (setq cus-test-libs-errors nil)
- (setq cus-test-libs-loaded nil)
- (mapc
- (lambda (file)
- (condition-case alpha
- (unless (member file cus-test-libs-noloads)
- (load file)
- (push file cus-test-libs-loaded))
- (error
- (push (cons file alpha) cus-test-libs-errors)
- (message "Error for %s: %s" file alpha))))
- (cus-test-get-autoload-deps))
- (message "%s libraries loaded successfully"
- (length cus-test-libs-loaded))
- (if (not cus-test-libs-errors)
- (message "No load problems encountered")
- (message "The following load problems appeared:")
- (cus-test-message cus-test-libs-errors))
- (run-hooks 'cus-test-after-load-libs-hook))
-
-(defun cus-test-get-autoload-deps ()
- "Return the list of libraries with autoloads."
- (with-temp-buffer
- (insert-file-contents (locate-library "loaddefs"))
- ;; This is from `customize-option'.
- (let (deps file)
- (while
- (search-forward "\n;;; Generated autoloads from " nil t)
- (goto-char (match-end 0))
- (setq file (buffer-substring (point)
- (progn (end-of-line) (point))))
- (setq file (file-name-nondirectory file))
- (string-match "\\.el\\'" file)
- (setq file (substring file 0 (match-beginning 0)))
- (setq deps (nconc deps (list file))))
- deps)))
-
-(defun cus-test-message (list)
- "Print the members of LIST line by line."
- (dolist (m list) (message "%s" m)))
-
-\f
-;;; The routines for batch mode:
-
-(defun cus-test-opts ()
- "Test custom options.
-This function is suitable for batch mode. E.g., invoke
-
- src/emacs -batch -l admin/cus-test.el -f cus-test-opts
-
-in the Emacs source directory."
- (interactive)
- (message "Running %s" 'cus-test-load-libs)
- (cus-test-load-libs)
- (message "Running %s" 'cus-test-load-custom-loads)
- (cus-test-load-custom-loads)
- (message "Running %s" 'cus-test-apropos)
- (cus-test-apropos "")
- (if (not cus-test-errors)
- (message "No problems found")
- (message "The following options might have problems:")
- (cus-test-message cus-test-errors)))
-
-(defun cus-test-deps ()
- "Run a verbose version of `custom-load-symbol' on all atoms.
-This function is suitable for batch mode. E.g., invoke
-
- src/emacs -batch -l admin/cus-test.el -f cus-test-deps
-
-in the Emacs source directory."
- (interactive)
- (setq cus-test-deps-errors nil)
- (setq cus-test-deps-required nil)
- (setq cus-test-deps-loaded nil)
- (mapatoms
- ;; This code is mainly from `custom-load-symbol'.
- (lambda (symbol)
- (let ((custom-load-recursion t))
- (dolist (load (get symbol 'custom-loads))
- (cond
- ((symbolp load)
- ;; (condition-case nil (require load) (error nil))
- (condition-case alpha
- (unless (featurep load)
- (require load)
- (push (list symbol load) cus-test-deps-required))
- (error
- (push (list symbol load alpha) cus-test-deps-errors)
- (message "Require problem: %s %s %s" symbol load alpha))))
- ((equal load "loaddefs")
- (push
- (message "Symbol %s has loaddefs as custom dependency" symbol)
- cus-test-deps-errors))
- ;; This is subsumed by the test below, but it's much
- ;; faster.
- ((assoc load load-history))
- ;; This was just
- ;; (assoc (locate-library load) load-history)
- ;; but has been optimized not to load locate-library
- ;; if not necessary.
- ((let ((regexp (concat "\\(\\`\\|/\\)" (regexp-quote load)
- "\\(\\'\\|\\.\\)"))
- (found nil))
- (dolist (loaded load-history)
- (and (stringp (car loaded))
- (string-match regexp (car loaded))
- (setq found t)))
- found))
- ;; Without this, we would load cus-edit recursively.
- ;; We are still loading it when we call this,
- ;; and it is not in load-history yet.
- ((equal load "cus-edit"))
- ;; This would ignore load problems with files in
- ;; lisp/term/
- ;; ((locate-library (concat term-file-prefix load)))
- (t
- ;; (condition-case nil (load load) (error nil))
- (condition-case alpha
- (progn
- (load load)
- (push (list symbol load) cus-test-deps-loaded))
- (error
- (push (list symbol load alpha) cus-test-deps-errors)
- (message "Load Problem: %s %s %s" symbol load alpha))))
- )))))
- (message "%s features required"
- (length cus-test-deps-required))
- (message "%s files loaded"
- (length cus-test-deps-loaded))
- (if (not cus-test-deps-errors)
- (message "No load problems encountered")
- (message "The following load problems appeared:")
- (cus-test-message cus-test-deps-errors))
- (run-hooks 'cus-test-after-load-libs-hook))
-
-(defun cus-test-libs ()
- "Load the libraries with autoloads in separate processes.
-This function is useful to detect load problems of libraries.
-It is suitable for batch mode. E.g., invoke
-
- src/emacs -batch -l admin/cus-test.el -f cus-test-libs
-
-in the Emacs source directory."
- (interactive)
- (with-temp-buffer
- (setq cus-test-libs-errors nil)
- (setq cus-test-libs-loaded nil)
- (cd source-directory)
- (if (not (file-executable-p "src/emacs"))
- (error "No Emacs executable in %ssrc" default-directory))
- (mapc
- (lambda (file)
- (condition-case alpha
- (let (fn cmd status)
- (setq fn (locate-library file))
- (if (not fn)
- (error "Library %s not found" file))
- (setq cmd (concat "src/emacs -batch -l " fn))
- (setq status (call-process shell-file-name nil nil nil
- shell-command-switch cmd))
- (if (equal status 0)
- (message "%s" file)
- (error "%s" status))
- (push file cus-test-libs-loaded))
- (error
- (push (cons file alpha) cus-test-libs-errors)
- (message "Error for %s: %s" file alpha))))
- (cus-test-get-autoload-deps))
- (message "Default Directory: %s" default-directory)
- (message "%s libraries had no load errors"
- (length cus-test-libs-loaded))
- (if (not cus-test-libs-errors)
- (message "No load problems encountered")
- (message "The following load problems appeared:")
- (cus-test-message cus-test-libs-errors))
- (run-hooks 'cus-test-after-load-libs-hook)))
-
-(defun cus-test-noloads ()
- "Find custom options not loaded by `custom-load-symbol'.
-Calling this function after `cus-test-load-libs' is not meaningful.
-It is suitable for batch mode. E.g., invoke
-
- src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
-
-in the Emacs source directory."
- (interactive)
- (let (cus-loaded)
-
- (message "Running %s" 'cus-test-load-custom-loads)
- (cus-test-load-custom-loads)
- (setq cus-loaded
- (cus-test-get-options ""))
-
- (message "Running %s" 'cus-test-load-libs)
- (cus-test-load-libs)
- (setq cus-test-vars-not-cus-loaded
- (cus-test-get-options ""))
-
- (dolist (o cus-loaded)
- (setq cus-test-vars-not-cus-loaded
- (delete o cus-test-vars-not-cus-loaded)))
-
- (if (not cus-test-vars-not-cus-loaded)
- (message "No options not loaded by custom-load-symbol found")
- (message "The following options were not loaded by custom-load-symbol:")
- (cus-test-message
- (sort cus-test-vars-not-cus-loaded 'string<)))))
-
-;; And last but not least a quiz:
-;;
-;; Evaluation of the form (customize-option 'debug-on-error) yields a
-;; *Customize* buffer with a mismatch mess. Why?
-
-(provide 'cus-test)
-
-;;; cus-test.el ends here
+++ /dev/null
-#! /bin/sh
-
-# Copyright (C) 2001 Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to the
-# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-if [ $# != 2 ]; then
- cat <<EOF
-Usage: $0 OLD-TAR NEW-TAR
-
-Print a diff of the files in OLD-TAR and NEW-TAR. Used for checking
-the contents of Emacs tar files.
-EOF
- exit 1;
-fi
-
-old_tar=$1
-new_tar=$2
-
-old_tmp=/tmp/old.$$
-new_tmp=/tmp/new.$$
-trap "rm -f $old_tmp $new_tmp; exit 1" 1 2 15
-
-tar tzf $old_tar | sed -e 's,^[^/]*,,' | sort > $old_tmp
-tar tzf $new_tar | sed -e 's,^[^/]*,,' | sort > $new_tmp
-diff -u $old_tmp $new_tmp
-rm -f $new_tmp $old_tmp
-
-
+++ /dev/null
-Here are the guidelines for being an Emacs pretester.
-If you would like to do this, say so, and I'll add you to
-the pretest list.
-
-
- Information for Emacs Pretesters
-
-The purpose of Emacs pretesting is to verify that the new Emacs
-distribution, about to be released, works properly on your system *with
-no change whatever*, when installed following the precise
-recommendations that come with the Emacs distribution.
-
-Here are some guidelines on how to do pretesting so as to make it
-helpful. All of them follow from common sense together with the
-nature of the purpose and the situation.
-
-Please save this file, and reread it when a new series of pretests
-starts.
-
-* Get the pretest from gnu/emacs/emacs-MM.NN.tar.gz and
-gnu/emacs/leim-MM.NN.tar.gz on alpha.gnu.org.
-
-* After a few days of testing, if there are no problems, please report
-that Emacs works for you and what configuration you are testing it on.
-
-* If you want to communicate with other pretesters, send mail to
-emacs-pretesters@gnu.org. I don't use that mailing list when I send
-to you because I've found that mailing lists tend to amplify random
-noise into long discussions or even arguments, and that can waste a
-lot of time. But when you have a reason to ask other pretesters for
-help, you can do it that way.
-
-* It is absolutely vital that you tell me about even the smallest
-change or departure from the standard sources and procedure.
-
-Otherwise, you are not testing the same program that I asked you to
-test. Testing a different program is usually of no use whatever. It
-can even cause trouble if you fail to tell me that you tested some
-other program instead of what I am about to release. I might think
-that Emacs works, when in fact it has not even been tried, and might
-have a glaring fault.
-
-* Don't use a site-load.el file or a site-init.el file when you pretest.
-Using either of those files means you are not testing Emacs as a typical
-site would use it.
-
-Actually, it does no harm to test Emacs with such customizations *as
-well as* testing it "out of the box". Anything you do that could find
-a bug is useful, as long as you make sure I know exactly what you did.
-The important point is that testing with local changes is no
-substitute for testing Emacs exactly as it is distributed.
-
-* Even changing the compilation options counts as a change in the
-program. The Emacs sources specify which compilation options to use.
-Some of them are specified in makefiles, and some in machine-specific
-configuration files. They also give you ways to override this--but if
-you do, then you are not testing what ordinary users will do.
-Therefore, when pretesting, it is vital to test with the default
-compilation options.
-
-(Testing with a different set of options can be useful *in addition*,
-but not *instead of* the default options.)
-
-* The machine and system configuration files of Emacs are parts of
-Emacs. So when you test Emacs, you need to do it with the
-configuration files that come with Emacs.
-
-If Emacs does not come with configuration files for a certain machine,
-and you test it with configuration files that don't come with Emacs,
-this is effectively changing Emacs. Because the crucial fact about
-the planned release is that, without changes, it doesn't work on that
-machine.
-
-To make Emacs work on that machine, I would need to install new
-configuration files. That is not out of the question, since it is
-safe--it certainly won't break any other machines that already work.
-But you will have to rush me the legal papers to give the FSF
-permission to use such a large piece of text.
-
-* Look in the etc/MACHINES file.
-
-The etc/MACHINES file says which configuration files to use for your
-machine, so use the ones that are recommended. If you guess, you might
-guess wrong and encounter spurious difficulties. What's more, if you
-don't follow etc/MACHINES then you aren't helping to test that its
-recommendations are valid.
-
-The etc/MACHINES file may describe other things that you need to do
-to make Emacs work on your machine. If so, you should follow these
-recommendations also, for the same reason.
-
-* Send your problem reports to emacs-pretest-bug@gnu.org, not
-bug-gnu-emacs.
-
-Sometimes I won't know what to do about a system-dependent issue, and
-I may need people to tell me what happens if you try a certain thing
-on a certain system. When this happens, I'll send out a query.
-
-* Don't delay sending information.
-
-When you test on a system and encounter no problems, please tell me
-about it right away. That way, I will know that someone has tested
-Emacs on that kind of system.
-
-Please don't wait for several days "to see if it really works before
-you say anything." Tell me right away that Emacs seems basically to
-work; then, if you notice a problem a few days later, tell me
-immediately about that when you see it.
-
-It is okay if you double check things before reporting a problem, such
-as to see if you can easily fix it. But don't wait very long. A good
-rule to use in pretesting is always to tell me about every problem on
-the same day you encounter it, even if that means you can't find a
-solution before you report the problem.
-
-I'd much rather hear about a problem today and a solution tomorrow
-than get both of them tomorrow at the same time.
-
-* Make each bug report self-contained.
-
-If you refer back to another message, whether from you or from someone
-else, then it will be necessary for anyone who wants to investigate
-the bug to find the other message. This may be difficult, it is
-probably time-consuming.
-
-To help me save time, simply copy the relevant parts of any previous
-messages into your own bug report.
-
-In particular, if I ask you for more information because a bug report
-was incomplete, it is best to send me the *entire* collection of
-relevant information, all together. If you send just the additional
-information, that makes me do extra work. There is even a risk that
-I won't remember what question you are sending me the answer to.
-
-* When you encounter a bug that manifests itself as a Lisp error,
-try setting debug-on-error to t and making the bug happen again.
-Then you will get a Lisp backtrace. Including that in your bug report
-is very useful.
-
-* Debugging optimized code is possible, if you compile with GCC, but
-in some cases the optimized code can be confusing. If you are not
-accustomed to that, recompile Emacs without -O. One way to do this is
-
- make clean
- make CFLAGS=-g
-
-* If you use X windows, it is a good idea to run Emacs under GDB (or
-some other suitable debugger) *all the time*, at least while
-pretesting.
-
-Then, when Emacs crashes, you will be able to debug the live process,
-not just a core dump. The `pr' command defined in src/.gdbinit is very
-useful in this case for examining Lisp_Object values as they would
-appear in Lisp.
-
-If you can't use `pr' because Emacs has got a fault already, or
-because you have only a core dump, you can use `xtype' to look at the
-type of a value, and then choose one of the other commands `xsymbol',
-`xstring', `xcons', `xvector' and so on to examine the contents.
-
-I myself *always* run Emacs under GDB so that I can debug conveniently
-if the occasion arises.
-
-* To get Lisp-level backtrace information within GDB,
-look for stack frames that call Ffuncall. Select them one by one in GDB
-and type this:
-
- p *args
- pr
-
-This will print the name of the Lisp function called by that level
-of function calling.
-
-By printing the remaining elements of args, you can see the argument
-values. Here's how to print the first argument:
-
- p args[1]
- pr
-
-If you do not have a live process, you can use xtype and the other
-x... commands such as xsymbol to get such information, albeit less
-conveniently.
-
-* Even with a live process, these x... commands are useful for
-examining the fields in a buffer, window, process, frame or marker.
-Here's an example using concepts explained in the node "Value History"
-of the GDB manual to print the variable frame from this line in
-xmenu.c:
-
- buf.frame_or_window = Fcons (frame, prefix);
-
-First, use these commands:
-
- cd src
- gdb emacs
- b xmenu.c:1209
- r -q
-
-Then type C-x 5 2 to create a new frame, and it hits the breakpoint:
-
- (gdb) p frame
- $1 = 1077872640
- (gdb) xtype
- Lisp_Vectorlike
- PVEC_FRAME
- (gdb) xframe
- $2 = (struct frame *) 0x3f0800
- (gdb) p *$
- $3 = {
- size = 536871989,
- next = 0x366240,
- name = 809661752,
- [...]
- }
- (gdb) p $3->name
- $4 = 809661752
-
-Now we can use `pr' to print the name of the frame:
-
- (gdb) pr
- "emacs@steenrod.math.nwu.edu"
-
-* The Emacs C code heavily uses macros defined in lisp.h. So suppose
-we want the address of the l-value expression near the bottom of
-`kbd_buffer_store_event' from keyboard.c:
-
- XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr
- - kbd_buffer]
- = event->frame_or_window);
-
-XVECTOR is a macro, and therefore GDB does not know about it.
-GDB cannot evaluate p XVECTOR (kbd_buffer_frame_or_window).
-
-However, you can use the xvector command in GDB to get the same
-result. Here is how:
-
- (gdb) p kbd_buffer_frame_or_window
- $1 = 1078005760
- (gdb) xvector
- $2 = (struct Lisp_Vector *) 0x411000
- 0
- (gdb) p $->contents[kbd_store_ptr - kbd_buffer]
- $3 = 1077872640
- (gdb) p &$
- $4 = (int *) 0x411008
-
-* Here's a related example of macros and the GDB `define' command.
-There are many Lisp vectors such as `recent_keys', which contains the
-last 100 keystrokes. We can print this Lisp vector
-
-p recent_keys
-pr
-
-But this may be inconvenient, since `recent_keys' is much more verbose
-than `C-h l'. We might want to print only the last 10 elements of
-this vector. `recent_keys' is updated in keyboard.c by the command
-
- XVECTOR (recent_keys)->contents[recent_keys_index] = c;
-
-So we define a GDB command `xvector-elts', so the last 10 keystrokes
-are printed by
-
- xvector-elts recent_keys recent_keys_index 10
-
-where you can define xvector-elts as follows:
-
- define xvector-elts
- set $i = 0
- p $arg0
- xvector
- set $foo = $
- while $i < $arg2
- p $foo->contents[$arg1-($i++)]
- pr
- end
- document xvector-elts
- Prints a range of elements of a Lisp vector.
- xvector-elts v n i
- prints `i' elements of the vector `v' ending at the index `n'.
- end
-
-* To debug what happens while preloading and dumping Emacs,
-do `gdb temacs' and start it with `r -batch -l loadup dump'.
-
-If temacs actually succeeds when running under GDB in this way, do not
-try to run the dumped Emacs, because it was dumped with the GDB
-breakpoints in it.
-
-* If you encounter X protocol errors, try evaluating (x-synchronize t).
-That puts Emacs into synchronous mode, where each Xlib call checks for
-errors before it returns. This mode is much slower, but when you get
-an error, you will see exactly which call really caused the error.
-
-* If the symptom of the bug is that Emacs fails to respond, don't
-assume Emacs is `hung'--it may instead be in an infinite loop. To
-find out which, make the problem happen under GDB and stop Emacs once
-it is not responding. (If Emacs is using X Windows directly, you can
-stop Emacs by typing C-z at the GDB job.) Then try stepping with
-`step'. If Emacs is hung, the `step' command won't return. If it is
-looping, `step' will return.
-
-If this shows Emacs is hung in a system call, stop it again and
-examine the arguments of the call. In your bug report, state exactly
-where in the source the system call is, and what the arguments are.
-
-If Emacs is in an infinite loop, please determine where the loop
-starts and ends. The easiest way to do this is to use the GDB command
-`finish'. Each time you use it, Emacs resumes execution until it
-exits one stack frame. Keep typing `finish' until it doesn't
-return--that means the infinite loop is in the stack frame which you
-just tried to finish.
-
-Stop Emacs again, and use `finish' repeatedly again until you get back
-to that frame. Then use `next' to step through that frame. By
-stepping, you will see where the loop starts and ends. Also please
-examine the data being used in the loop and try to determine why the
-loop does not exit when it should. Include all of this information in
-your bug report.
-
-* If certain operations in Emacs are slower than they used to be, here
-is some advice for how to find out why.
-
-Stop Emacs repeatedly during the slow operation, and make a backtrace
-each time. Compare the backtraces looking for a pattern--a specific
-function that shows up more often than you'd expect.
-
-If you don't see a pattern in the C backtraces, get some Lisp
-backtrace information by looking at Ffuncall frames (see above), and
-again look for a pattern.
-
-When using X, you can stop Emacs at any time by typing C-z at GDB.
-When not using X, you can do this with C-g.
-
-* Configure tries to figure out what kind of system you have by
-compiling and linking programs which calls various functions and looks
-at whether that succeeds. The file config.log contains any messages
-produced by compilers while running configure, to aid debugging if
-configure makes a mistake. But note that config.cache reads:
-
-# Giving --cache-file=/dev/null disables caching, for debugging configure.
-
-or more simply,
-
-rm config.cache
-./configure
-
-* Always be precise when talking about changes you have made. Show
-things rather than describing them. Use exact filenames (relative to
-the main directory of the distribution), not partial ones. For
-example, say "I changed Makefile" rather than "I changed the
-makefile". Instead of saying "I defined the MUMBLE macro", send a
-diff.
-
-* Always use `diff -c' to make diffs. If you don't include context, it
-may be hard for me to figure out where you propose to make the
-changes. So I might have to ignore your patch.
-
-* When you write a fix, keep in mind that I can't install a change
-that *might* break other systems without the risk that it will fail to
-work and therefore require an additional cycle of pretesting.
-
-People often suggest fixing a problem by changing config.h or
-src/ymakefile or even src/Makefile to do something special that a
-particular system needs. Sometimes it is totally obvious that such
-changes would break Emacs for almost all users. I can't possibly make
-a change like that. All I can do is send it back to you and ask you
-to find a fix that is safe to install.
-
-Sometimes people send fixes that *might* be an improvement in
-general--but it is hard to be sure of this. I can install such
-changes some of the time, but not during pretest, when I am trying to
-get a new version to work reliably as quickly as possible.
-
-The safest changes for me to install are changes to the s- and m-
-files. At least I know those can't affect most systems.
-
-Another safe kind of change is one that uses a conditional to make
-sure it will apply only to a particular kind of system. Ordinarily,
-that is a bad way to solve a problem, and I would want to find a
-cleaner alternative. But the virtue of safety can make it superior at
-pretest time.
-
-* Don't try changing Emacs *in any way* unless it fails to work unchanged.
-
-* Don't even suggest changes to add features or make something
-cleaner. Every change I install could introduce a bug, so I won't
-install a change during pretest unless I see it is *necessary*.
-
-* If you would like to suggest changes for purposes other than fixing
-user-visible bugs, don't wait till pretest time. Instead, send them
-after I have made a release that proves to be stable. Then I can give
-your suggestions proper consideration. If you send them at pretest
-time, I will have to defer them till later, and that might mean I
-forget all about them.
-
-* In some cases, if you don't follow these guidelines, your
-information might still be useful, but I might have to do more work to
-make use of it. Unfortunately, I am so far behind in my work that I
-just can't keep up unless you help me to do it efficiently.
-\f
-Some suggestions for debugging on MS Windows:
-
- Marc Fleischeuers, Geoff Voelker and Andrew Innes
-
-To debug emacs with Microsoft Visual C++, you either start emacs from
-the debugger or attach the debugger to a running emacs process. To
-start emacs from the debugger, you can use the file bin/debug.bat. The
-Microsoft Developer studio will start and under Project, Settings,
-Debug, General you can set the command-line arguments and emacs'
-startup directory. Set breakpoints (Edit, Breakpoints) at Fsignal and
-other functions that you want to examine. Run the program (Build,
-Start debug). Emacs will start and the debugger will take control as
-soon as a breakpoint is hit.
-
-You can also attach the debugger to an already running emacs process.
-To do this, start up the Microsoft Developer studio and select Build,
-Start debug, Attach to process. Choose the emacs process from the
-list. Send a break to the running process (Debug, Break) and you will
-find that execution is halted somewhere in user32.dll. Open the stack
-trace window and go up the stack to w32_msg_pump. Now you can set
-breakpoints in emacs (Edit, Breakpoints). Continue the running emacs
-process (Debug, Step out) and control will return to emacs, until a
-breakpoint is hit.
-
-To examine the contents of a lisp variable, you can use the function
-'debug_print'. Right-click on a variable, select QuickWatch, and
-place 'debug_print(' and ')' around the expression. Press
-'Recalculate' and the output is sent to the 'Debug' pane in the Output
-window. If emacs was started from the debugger, a console window was
-opened at emacs' startup; this console window also shows the output of
-'debug_print'. It is also possible to keep appropriately masked and
-typecast lisp symbols in the Watch window, this is more convenient
-when steeping though the code. For instance, on entering
-apply_lambda, you can watch (struct Lisp_Symbol *) (0xfffffff &
-args[0]).
-
-\f
-Local Variables:
-mode: text
-End:
+++ /dev/null
-#! /bin/bash
-
-if [ $# -ne 2 ]; then
- echo "usage: $0 <old version number> <new version number>" >&2
- exit 1
-fi
-
-if [ ! -f INSTALL -o ! -f configure -o ! -d lib-src ]; then
- echo "this script should be run in the emacs root directory" >&2
- exit 2
-fi
-
-OLD=$1
-NEW=$2
-outfile=emacs-$NEW.announce
-oldtag=EMACS_PRETEST_$(echo $OLD|tr . _)
-newtag=EMACS_PRETEST_$(echo $NEW|tr . _)
-
-if [ -f $outfile ]; then
- echo "$outfile exists"
- echo -n "interrupt to abort, ENTER to overwrite "; read answer
-fi
-
-echo -n "tag name for OLD emacs version $OLD [$oldtag]: "; read answer
-if [ "$answer" ]; then oldtag=$answer; fi
-
-echo -n "tag name for NEW emacs version $NEW [$newtag]: "; read answer
-if [ "$answer" ]; then newtag=$answer; fi
-
-exec > $outfile
-
-cat <<EOF
-There is a new pretest available in
-
- <ftp://alpha.gnu.org/gnu/emacs/pretest/emacs-$NEW.tar.gz>
- <ftp://alpha.gnu.org/gnu/emacs/pretest/leim-$NEW.tar.gz>
-
-Please report results from compiling and running the pretest to
-<emacs-pretest-bug@gnu.org>. Your feedback is necessary for us
-to know on which platforms the pretest has been tried.
-Please say whether you built with LEIM or not.
-
-If you have the tars from the previous pretest, and you have the
-\`xdelta' utility, you can instead download the much smaller
-
- <ftp://alpha.gnu.org/gnu/emacs/pretest/emacs-$OLD-$NEW.xdelta>
- <ftp://alpha.gnu.org/gnu/emacs/pretest/leim-$OLD-$NEW.xdelta>
-
-You can use a command like
-
- $ xdelta patch XDELTA PREVIOUS-TAR CURRENT-TAR
-
-to generate the new tar from the old one, where XDELTA is the xdelta
-file you downloaded, PREVIOUS-TAR is the tar file from the previous
-pretest, and CURRENT-TAR is the name of the tar file you downloaded.
-
-Information about xdelta can be found on the GNU ftp site, in
-/non-gnu/xdelta.README.
-
-Changes since $OLD
-
-EOF
-
-make-changelog-diff $oldtag $newtag
-
-echo " announcement created in $outfile" >&2
+++ /dev/null
-#! /bin/bash
-
-if [ $# -ne 2 ]; then
- echo "usage: $0 TAG1 TAG2" >&2
- exit 1
-fi
-
-if [ ! -f INSTALL -o ! -f configure -o ! -d lib-src ]; then
- echo "this script should be run in the emacs root directory" >&2
- exit 2
-fi
-
-cvs -q diff -b -r $1 -r $2 $(find -name ChangeLog|sort) |
- sed -n -e 's/^=\+/======/p' -e 's/^> //p' -e 's/^diff.*//p' \
- -e 's/^RCS file: .cvsroot.emacs.emacs.\(.*\),v/\1/p' |
- sed -n -e "/^======$/ {
- N
- N
- h
- d
- }
- H
- s/.*//
- x
- s/^\n//
- p"
+++ /dev/null
-#! /usr/bin/perl
-
-# Copyright (C) 2001 Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to the
-# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# Build Emacs with various options for profiling, debugging,
-# with and without warnings enabled etc.
-
-require 5;
-use Getopt::Long;
-use File::Basename;
-use Cwd;
-
-# Default CVS sandbox directory. Only used when called from outside
-# of the sandbox.
-
-$root = $ENV{"EMACS_ROOT"};
-$root = "/gd/gnu/emacs" unless $root;
-
-# Default make command.
-
-$make = $ENV{"EMACS_MAKE"};
-$make = "gmake" unless $make;
-
-$rc = GetOptions ("help" => \$help,
- "enable-checking" => \$enable_checking,
- "no-warn" => \$no_warn,
- "check-marked" => \$check_marked,
- "all" => \$all,
- "no-optim" => \$no_optim,
- "union-type" => \$union_type,
- "gprof" => \$profile,
- "malloc-check" => \$malloc_check,
- "no-mcheck" => \$no_mcheck,
- "alias" => \$aliasing,
- "boot" => \$boot,
- "wall" => \$wall,
- "gcc3" => \$gcc3,
- "trace-selection" => \$trace_selection,
- "trace-move" => \$trace_move,
- "stabs" => \$use_stabs,
- "optim" => \$optim);
-
-if ($rc == 0 || $help)
- {
- print <<USAGE;
-make-emacs [options] ...
-
-Build Emacs.
-
- --help show this help
- --all make clean versionclean first
- --boot make boostrap, log to boot.log
- --enable-checking ENABLE_CHECKING=1 (implies Lisp union type)
- --no-warn disable warnings
- --check-marked GC_CHECK_MARKED_OBJECTS=1
- --optim no debug defines
- --gprof make Emacs for profiling
- --union-type define USE_LISP_UNION_TYPE (bad for GDB)
- --malloc-check define GC_MALLOC_CHECK
- --no-mcheck dont define GC_MCHECK
- --wall compile with -Wall
- --gcc3 use GCC 3.0 (30% slower compilation, slower code)
- --trace-selection print traces in xselect.c
- --trace-move print traces for move_it* functions
- --stabs use -gstabs instead -g
-
-Default is to compile with warnings, with -DGC_MCHECK=1, and
-with -DGLYPH_DEBUG=1.
-
-USAGE
- exit 1;
- }
-
-# Chdir to the top-level directory of the tree. If not in a tree
-# containing Emacs, use the default.
-
-while (! -f "src/emacs.c" && cwd () ne "/")
- {
- chdir "..";
- }
-
-chdir $root if cwd () eq "/";
-chdir "./src";
-print "Build in ", cwd (), "\n";
-
-# If first arg is `all' or if `--all' specified, ensure a clean
-# build.
-
-if (@ARGV && $ARGV[0] eq "all")
- {
- $all = 1;
- shift @ARGV;
- }
-
-system ("$make clean versionclean") if $all;
-
-if ($wall)
- {
- $warn = "-Wall";
- }
-elsif (!$no_warn)
- {
- $warn = "-Wpointer-arith -Wchar-subscripts -Wformat -Wimplicit-int";
- $warn = "$warn -Wreturn-type -Wswitch -Wuninitialized";
- }
-
-$defs = "-DGLYPH_DEBUG=1" unless $optim;
-$defs = "$defs -DGC_CHECK_MARKED_OBJECTS=1" if $check_marked;
-$defs = "$defs -DENABLE_CHECKING=1" if $enable_checking;
-
-if ($profile)
- {
- $opts = "-pg";
- $defs = "$defs -DPROFILING=1";
- }
-else
- {
- if ($use_stabs)
- {
- $opts = "-gstabs";
- }
- else
- {
- $opts = "-g";
- }
- }
-
-$defs = "$defs -DUSE_LISP_UNION_TYPE" if $union_type;
-$defs = "$defs -DGC_MALLOC_CHECK=1 -DGC_PROTECT_MALLOC_STATE=1" if $malloc_check;
-$defs = "$defs -DGC_MCHECK=1" unless $no_mcheck;
-
-$defs = "$defs -DTRACE_SELECTION" if $trace_selection;
-$defs = "$defs -DDEBUG_TRACE_MOVE" if $trace_move;
-
-# arch=pentium leads to slightly faster code than without.
-$opts = "$opts -march=pentiumpro";
-
-if ($optim)
- {
- $opts = "$opts -pipe -O3";
- }
-elsif ($no_optim)
- {
- $opts = "$opts -pipe -fno-inline";
- }
-else
- {
- $opts = "$opts -O -pipe -fno-inline";
- }
-
-$opts = "$opts -fstrict-aliasing" if $aliasing;
-
-$opts = "$opts $defs" if $defs;
-$opts = "$opts $warn" if $warn;
-
-$cc = "/usr/bin/gcc";
-$cc = "/gd/local/bin/gcc" if $gcc3;
-
-if ($boot)
- {
- chdir "..";
- system "mv boot.log boot.log.old" if -f "boot.log";
- exit system "script boot.log $make CC=\"$cc\" CFLAGS=\"$opts\" bootstrap";
- }
-
-exit system "$make CC=\"$cc\" CFLAGS=\"$opts\" @ARGV";
-
-# Local Variables:
-# mode: cperl
-# End:
+++ /dev/null
-Instructions to create pretest or release tarballs.
--- originally written by Eli Zaretskii, amended by Francesco Potortì
-
-For each step, check for possible errors.
-
-1. cvs -q update -Pd
-
-2. Bootstrap to make 100% sure all elc files are up-to-date, and to
- make sure that the later tagged version will bootstrap, should it be
- necessary to check it out.
-
-3. Set the version number (M-x load-file RET admin/admin.el RET, then
- M-x set-version RET). For a release, add released change log
- entries (M-x add-release-logs RET).
-
-4. rm configure; make bootstrap
-
-5. Commit configure, README, lisp/loaddefs.el, lisp/cus-load.el,
- lisp/finder-inf.el, lisp/version.el, man/emacs.texi. For a release,
- also commit the ChangeLog files in all directories.
-
-6. make-dist --snapshot. Check the contents of the new tar with
- admin/diff-tar-files against an older tar file. Some old pretest
- tarballs are kept under fencepost.gnu.org:~pot/emacs-pretest/, while
- old emacs tarballs are at <ftp://ftp.gnu.org/pub/gnu/emacs/>.
-
-7. xdelta delta emacs-OLD.tar.gz emacs-NEW.tar.gz emacs-OLD-NEW.xdelta
-
-8. tar -zxf emacs-NEW.tar.gz; cd emacs-NEW
- configure && make && make -n install
- Use `script' or M-x compile to save the compilation log in
- compile-NEW.log and compare it against an old one. The easiest way
- to do that is to visit the old log in Emacs, change the version
- number of the old Emacs to __, do the same with the new log and do
- M-x ediff. Especially check that Info files aren't built.
-
-9. cd EMACS_ROOT_DIR; cvs tag TAG
- TAG is EMACS_PRETEST_XX_YY_ZZZ for a pretest, EMACS_XX_YY for a
- release.
-
-10. admin/make-announcement OLD NEW
- This creates an announcement for pretests. OLD is the version used
- to make deltas with respect to NEW. Anouncements for pretests need
- to be crafted by hand. Use an older announcement to start with.
-
-11. For a pretest, do:
- rsync -aP emacs-NEW.tar.gz emacs-OLD-NEW.xdelta compile-NEW.log \
- emacs-NEW.announce alpha.gnu.org:/home/alpha/gnu/emacs/pretest/.
- For a release, do:
- rsync -aP emacs-NEW.tar.gz emacs-OLD-NEW.xdelta \
- alpha.gnu.org:/home/ftp/gnu/emacs/.
-
-12. Verify that the files are visible at
- ftp://alpha.gnu.org/gnu/emacs/pretest/ for a pretest, at
- ftp://ftp.gnu.org/gnu/emacs/ for a release.
-
-13. For a pretest, let Richard Stallman know about the new pretest and
- tell him to announce it using the announcement you prepared. Remind
- him to set a Reply-to header to <emacs-pretest-bug@gnu.org>.
- For a release, Richard should prepare the announcement himself,
- possibly starting from a previous announcment.
+++ /dev/null
-ttn 2003-04-09
-
-we use a C preprocesor not only in the normal compilation of .c files
-into object files, but also for creating
-
- src/Makefile
- lib-src/Makefile
-
-(delimited by comment "start of cpp stuff"). some cpp implementations
-insert whitespace in between tokens, which explains the "$(dot)$(dot)"
-and "UNEXEC_ALIAS" workarounds for unixoid systems and the bundled
-tradcpp/ for vms. [NOTE: tradcpp/ not yet checked in.]
-
-during makefile creation, the preprocessor symbol NOT_C_CODE is defined.
-this should not be defined for normal .c file compilation.
-
-there has been discussion on eliminating this use of cpp and relying
-solely on autoconf processing. rms says to leave it be.
+++ /dev/null
-Iso-Functional Type Contour
-
-
-This is a term coined to describe "column int->float" change approach, and can
-be used whenever low-level types need to change (hopefully not often!) but the
-meanings of the values (whose type has changed) do not.
-
-The premise is that changing a low-level type potentially means lots of code
-needs to be changed as well, and the question is how to do this incrementally,
-which is the preferred way to change things.
-
-Say LOW and HIGH are C functions:
-
- int LOW (void) { return 1; }
- void HIGH (void) { int value = LOW (); }
-
-We want to convert LOW to return float, so we cast HIGH usage:
-
- float LOW (void) { return 1.0; }
- void HIGH (void) { int value = (int) LOW (); } /* iftc */
-
-The comment /* iftc */ is used to mark this type of casting to differentiate
-it from other casting. We commit the changes and can now go about modifying
-LOW and HIGH separately. When HIGH is ready to handle the type change, the
-cast can be removed.
+++ /dev/null
-ttn 2003-02-14
-
-apparently there was a big discussion on emacs-devel wrt trailing whitespace.
-there was a mass-change to remove such from various branches in cvs. probably
-it's a good idea to avoid adding trailing whitespace in new code/docs and in
-changes.
+++ /dev/null
- Emacs for Windows
-
-This README file describes how to dump a bare precompiled version of GNU
-Emacs for Windows NT/2000/XP and Windows 95/98/Me. This distribution
-supplements the standard dumped precompiled distribution of Emacs, which
-you can download from:
-
- ftp://ftp.gnu.org/gnu/windows/emacs/
-
-If you do not have the "bin" distribution, then you will need to
-download it before you can use this undumped version. Also note that
-you should only need to dump Emacs yourself if you want to dump Emacs
-with more elisp files than are included normally, or to rebuild Emacs
-after patching one of the elisp files that is preloaded.
-
-The dumping process consists of running a bare Emacs, loading up a
-number of general elisp files, and then creating a new Emacs executable
-preinitialized and ready to run. In the precompiled distributions,
-Emacs has already been dumped with the standard configuration.
-
-To dump Emacs, unpack this distribution into the directory created by
-unpacking the corresponding standard precompiled distribution. To
-verify that you unpacked in the proper place, check to make sure that
-you now have a temacs.exe file in the bin directory.
-
-Once you have unpacked this distribution, cd into the bin directory and
-run dump.bat. This will produce a new bin\emacs.exe executable for you
-to use (the original one is renamed to emacs.exe.orig; this is not
-overwritten if you run dump more than once).
-
-For more information about running Emacs, read the README.W32 file that
-came with the standard dumped precompiled distribution. If you have
-problems with Emacs, including problems with dumping, send email to
-"help-emacs-windows@gnu.org".
-
-Enjoy!
+++ /dev/null
- Precompiled Distributions of
- Emacs for Windows
-
- Version 21.3
-
- April 22, 2003
-
- This directory contains source and precompiled distributions for GNU
- Emacs on Windows NT/2000/XP and Windows 95/98/Me. This port is a part
- of the standard GNU Emacs distribution from the Free Software
- Foundation; the precompiled distributions are provided here for
- convenience since, unlike Unix, the majority of Windows users do not
- have access to a compiler (and, besides, do you really want to compile
- Emacs when you don't have to?).
-
- If you have access to the World Wide Web, I would recommend pointing
- your favorite web browser to the following document (if you haven't
- already):
-
- http://www.gnu.org/software/emacs/windows/ntemacs.html
-
- The above web document is a far more complete version of this README
- file. If you don't have access to the Web, however, then read on.
-
-
-* IMPORTANT LEGAL REMINDER
-
- If you want to redistribute any of the precompiled distributions of
- Emacs, be careful to check the implications of the GPL. For instance,
- if you put the emacs-21.3-bin-i386.tar.gz file from this directory on
- an Internet site, you must arrange to distribute the source files of
- the SAME version (i.e. emacs-21.3-src.tar.gz).
-
- Making a link to our copy of the source is NOT sufficient, since we
- might upgrade to a new version while you are still distributing the
- old binaries.
-
-
-* Distributions in .tar.gz format
-
- Emacs is distributed primarily as a set of large gzipped tar files
- (*.tar.gz). Because Emacs is quite large and therefore difficult to
- download over unreliable connections, it is provided in several
- combinations, ranging from the complete source plus executables, to
- just the minimal amount needed to run without any source, plus a
- couple of optional packages. Here are the combinations (i386 in the
- name indicates a tarball contains executables compiled for
- Intel-compatible x86 systems):
-
- + Primary precompiled distribution, including lisp source:
-
- emacs-21.3-fullbin-i386.tar.gz
-
- + Minimal precompiled distribution, which excludes lisp source:
-
- emacs-21.3-bin-i386.tar.gz
-
- You can download emacs-21.3-lisp.tar.gz to get the lisp source, if
- you later decide you want it - it is useful for understanding how
- packages work, and how they can best be setup or customized.
-
-
- NB. If you just want to run Emacs, get one of the distributions above.
-
-
- + Bare executables, only useful if you want to get the complete source
- release below, but can't compile Emacs yourself:
-
- emacs-21.3-barebin-i386.tar.gz (requires emacs-21.3-src.tar.gz)
-
- + Undumped executable, only needed for rebuilding Emacs after changing
- certain core lisp files:
-
- emacs-21.3-undumped-i386.tar.gz
-
- + Optional package providing the Library of Emacs Input Methods for
- typing non-ascii characters, notably Chinese, Japanese and Korean,
- but also including European and other character sets:
-
- emacs-21.3-leim.tar.gz
-
- + The complete official source for Emacs:
-
- emacs-21.3-src.tar.gz
-
- + The complete official source for LEIM:
-
- leim-21.3-src.tar.gz
-
-
-* Distributions in multi-file .zip format
-
- A second distribution in the form of multiple small .zip files is also
- provided, for the benefit of people who have unreliable internet
- connections, or who need to copy the distribution onto floppy disks:
-
- em213b*.zip
-
- This is equivalent to getting emacs-21.3-bin-i386.tar.gz above.
- The lisp source is available as em213l*.zip.
-
-
-* Distributions for non-x86 platforms
-
- I try to make this port available for all platforms supported by
- Windows (it should build on all supported Windows NT/9x platforms).
- However, I do not always have access to non-x86 platforms, and so I
- cannot guarantee to provide precompiled distributions for the other
- platforms myself. If you find there are no binaries for your
- platform, and you have access to a Microsoft compiler, then you can
- download the source and compile Emacs yourself (and, if you do, please
- consider contributing your executables; send me mail and we can make
- arrangements for making them available on this ftp server.)
-
-
-* Unpacking distributions
-
- Programs for handling the distribution file formats can be found in
- the utilities directory:
-
- ftp://ftp.gnu.org/gnu/windows/emacs/utilities
-
- For gzipped tar files, you will need either gunzip.exe and tar.exe
- together, or djtarnt.exe. djtarnt.exe can also unpack .zip files. I
- strongly urge you to use these utilities since they were the ones used
- to create the distributions; the most common problem people have in
- trying to get Emacs to run is due to some other utility program
- corrupting the distribution while unpacking.
-
- Open a command prompt (MSDOS) window. Decide on a directory in which
- to place Emacs. Move the distribution to that directory, and then
- unpack it as follows.
-
- If you have the gzipped tar version, use gunzip to uncompress the tar
- file on the fly, and pipe the output through tar with the "xvf" flags
- to extract the files from the tar file:
-
- % gunzip -c some.tar.gz | tar xvf -
-
- You may see messages from tar about not being able to change the
- modification time on directories, and from gunzip complaining about a
- broken pipe. These messages are harmless and you can ignore them. On
- Windows NT, unpacking tarballs this way leaves them in compressed
- form, taking up less space on disk. Unfortunately, on Windows 95 and
- 98, a large temporary file is created, so it is better to use the
- djtarnt.exe program, which performs the equivalent operation in one
- step:
-
- % djtarnt -x some.tar.gz
-
- You may be prompted to rename or overwrite directories when using
- djtarnt: simply type return to continue (this is harmless).
-
- If you have the multi-file .zip distribution, use djtarnt to unpack
- all of the .zip files:
-
- % djtarnt -x *.zip
-
- Once you have unpacked a precompiled distribution of Emacs, it should
- have the following subdirectories:
-
- bin etc info lisp lock site-lisp
-
- If your utility failed to create the lock directory, then you can
- simply create it by hand (it is initially empty).
-
- One final step is needed only when installing from the multi-file .zip
- distribution, in order to recreate emacs.exe from its fragments (it is
- too big to fit on a floppy even when zipped):
-
- % cd emacs-21.3\bin
- % stitch
-
-
-* Unpacking with other tools
-
- If you do use other utility programs to unpack the distribution, check
- the following to be sure the distribution was not corrupted:
-
- + Be sure to disable the CR/LF translation or the executables will be
- unusable. Older versions of WinZipNT would enable this translation
- by default. If you are using WinZipNT, disable it. (I don't have
- WinZipNT myself, and I do not know the specific commands necessary
- to disable it.)
-
- + Check that filenames were not truncated to 8.3. For example, there
- should be a file lisp/abbrevlist.el; if this has been truncated to
- abbrevli.el, your distribution has been corrupted while unpacking
- and Emacs will not start.
-
- + I've been told that some utilities (WinZip again?) don't create the
- lock subdirectory. The lock subdirectory needs to be created.
-
- + I've also had reports that the "gnu-win32" port of tar corrupts the
- executables. Use the version of tar or djtarnt in the utilities
- directory instead.
-
- If you believe you have unpacked the distributions correctly and are
- still encountering problems, see the section on Further Information
- below.
-
-
-* Compiling from source
-
- If you would like to compile Emacs from source, download the source
- distribution, unpack it in the same manner as a precompiled
- distribution, and look in the file nt/INSTALL for detailed directions.
- You can either use the Microsoft compiler included with Visual C++, or
- GCC 2.95 or later with MinGW support, to compile the source. The port
- of GCC included in Cygwin is supported, but check the nt/INSTALL file
- if you have trouble since some builds of GNU make aren't supported.
-
-
-* Further information
-
- If you have access to the World Wide Web, I would recommend pointing
- your favorite web browser to following the document (if you haven't
- already):
-
- http://www.gnu.org/software/emacs/windows/ntemacs.html
-
- This document serves as an FAQ and a source for further information
- about the Windows port and related software packages.
-
- In addition to the FAQ, there is a mailing list for discussing issues
- related to the Windows port of Emacs. For information about the
- list, see this Web page:
-
- http://mail.gnu.org/mailman/listinfo/help-emacs-windows
-
- To ask questions on the mailing list, send email to
- help-emacs-windows@gnu.org. (You don't need to subscribe for that.)
- To subscribe to the list or unsubscribe from it, fill the form you
- find at http://mail.gnu.org/mailman/listinfo/help-emacs-windows as
- explained there.
-
- Another valuable source of information and help which should not be
- overlooked is the various Usenet news groups dedicated to Emacs.
- These are particuarly good for help with general issues which aren't
- specific to the Windows port of Emacs. The main news groups to use
- for seeking help are:
-
- gnu.emacs.help
- comp.emacs
-
- There are also fairly regular postings and announcements of new or
- updated Emacs packages on this group:
-
- gnu.emacs.sources
-
- Enjoy!
-
- Andrew Innes
- (andrewi@gnu.org)
+++ /dev/null
- Emacs for Windows
-
- This README file describes how to set up and run a precompiled version
- of GNU Emacs for Windows NT/2000/XP and Windows 95/98/Me. This
- distribution can be found on the ftp.gnu.org server and its mirrors:
-
- ftp://ftp.gnu.org/gnu/windows/emacs/
-
- This server contains other distributions, including the full Emacs
- source distribution and the lisp source distribution, as well as older
- releases of Emacs for Windows.
-
- Answers to frequently asked questions, and further information about
- this port of GNU Emacs and related software packages can be found via
- http or ftp:
-
- http://www.gnu.org/software/emacs/windows/ntemacs.html
- ftp://ftp.gnu.org/gnu/windows/emacs/docs/ntemacs.html
-
-* Preliminaries
-
- Along with this file should be six subdirectories (bin, etc, info,
- lisp, lock, site-lisp). Depending on which distribution you have
- installed, the lisp subdirectory might contain both the lisp source
- (*.el) and compiled lisp files (*.elc), or just the compiled lisp
- files. If you don't have the lisp source files, you can obtain them
- by downloading the lisp source distribution or the full source
- distribution from the ftp site mentioned above.
-
-* Setting up Emacs
-
- To install Emacs, simply unpack all the files into a directory of your
- choice, but note that you might encounter minor problems if there is a
- space anywhere in the directory name. To complete the installation
- process, you can optionally run the program addpm.exe in the bin
- subdirectory. This will add some entries to the registry that tell
- Emacs where to find its support files, and put an icon for Emacs in
- the Start Menu under "Start -> Programs -> Gnu Emacs -> Emacs".
-
- Some users have reported that the Start Menu item is not created for
- them. If this happens, just create your own shortcut to runemacs.exe,
- eg. by dragging it on to the desktop or the Start button.
-
- Note that running addpm is now an optional step; Emacs is able to
- locate all of its files without needing the information to be set in
- the environment or the registry, although such settings will still be
- obeyed if present. This is convenient for running Emacs on a machine
- which disallows registry changes, or on which software should not be
- installed. For instance, you can now run Emacs directly from a CD
- without copying or installing anything on the machine itself.
-
-* Starting Emacs
-
- To run Emacs, simply select Emacs from the Start Menu, or invoke
- runemacs.exe directly from Explorer or a command prompt. This will
- start Emacs in its default GUI mode, ready to use. If you have never
- used Emacs before, you should follow the tutorial at this point
- (select Emacs Tutorial from the Help menu), since Emacs is quite
- different from ordinary Windows applications in many respects.
-
- If you want to use Emacs in tty or character mode within a command
- window, you can start it by typing "emacs -nw" at the command prompt.
- (Obviously, you need to ensure that the Emacs bin subdirectory is in
- your PATH first, or specify the path to emacs.exe.) The -nw
- (non-windowed) mode of operation is most useful if you have a telnet
- server on your machine, allowing you to run Emacs remotely.
-
-* Uninstalling Emacs
-
- If you should need to uninstall Emacs, simply delete all the files and
- subdirectories from the directory where it was unpacked (Emacs does
- not install or update any files in system directories or anywhere
- else). If you ran the addpm.exe program to create the registry
- entries and the Start menu icon, then you can remove the registry
- entries using regedit. All of the settings are written under the
- Software\GNU\Emacs key in HKEY_LOCAL_MACHINE, or if you didn't have
- administrator privileges, the same key in HKEY_CURRENT_USER. Just
- delete the Software\GNU\Emacs key.
-
- The Start menu entry can be removed by right-clicking on the Task bar
- and selecting Properties, then using the Remove option on the Start
- Menu Programs page. (If you installed under an account with
- administrator privileges, then you need to click the Advanced button
- and look for the Gnu Emacs menu item under All Users.)
-
-* Troubleshooting
-
- Unpacking the distributions
-
- If you encounter trouble trying to run Emacs, there are a number of
- possible causes. If you didn't use the versions of tar and gunzip (or
- djtarnt) on the above ftp site, it is possible that the distribution
- became corrupted while it was being unpacked. Check the following for
- indications that the distribution was not corrupted:
-
- * Be sure to disable the CR/LF translation or the executables will
- be unusable. Older versions of WinZipNT would enable this
- translation by default. If you are using WinZipNT, disable it.
- (I don't have WinZipNT myself, and I do not know the specific
- commands necessary to disable it.)
-
- * Check that filenames were not truncated to 8.3. For example,
- there should be a file lisp\abbrevlist.elc; if this has been
- truncated to abbrevli.elc, your distribution has been corrupted
- while unpacking and Emacs will not start.
-
- * Users have said that some utilities (WinZip again?) don't create
- the lock subdirectory. You can create the lock directory by hand
- (it is normally empty).
-
- * Users have also reported that the gnu-win32 tar corrupts the
- executables. Use the version of tar or djtarnt on the ftp.gnu.org
- site instead.
-
- If you believe you have unpacked the distributions correctly and are
- still encountering problems, see the section on Further Information
- below.
-
- Virus scanners
-
- Some virus scanners interfere with Emacs' use of subprocesses. If you
- are unable to use subprocesses and you use Dr. Solomon's WinGuard or
- McAfee's Vshield, turn off "Scan all files" (WinGuard) or "boot sector
- scanning" (McAfee exclusion properties).
-
-* Further information
-
- If you have access to the World Wide Web, I would recommend pointing
- your favorite web browser to following the document (if you haven't
- already):
-
- http://www.gnu.org/software/emacs/windows/ntemacs.html
-
- This document serves as an FAQ and a source for further information
- about the Windows port and related software packages.
-
- In addition to the FAQ, there is a mailing list for discussing issues
- related to the Windows port of Emacs. For information about the
- list, see this Web page:
-
- http://mail.gnu.org/mailman/listinfo/help-emacs-windows
-
- To ask questions on the mailing list, send email to
- help-emacs-windows@gnu.org. (You don't need to subscribe for that.)
- To subscribe to the list or unsubscribe from it, fill the form you
- find at http://mail.gnu.org/mailman/listinfo/help-emacs-windows as
- explained there.
-
- Another valuable source of information and help which should not be
- overlooked is the various Usenet news groups dedicated to Emacs.
- These are particuarly good for help with general issues which aren't
- specific to the Windows port of Emacs. The main news groups to use
- for seeking help are:
-
- gnu.emacs.help
- comp.emacs
-
- There are also fairly regular postings and announcements of new or
- updated Emacs packages on this group:
-
- gnu.emacs.sources
-
-* Reporting bugs
-
- If you encounter a bug in this port of Emacs, we would like to hear
- about it. First check the FAQ on the web page above to see if the bug
- is already known and if there are any workarounds. Then check whether
- the bug has something to do with code in your .emacs file, e.g. by
- invoking Emacs with the "-q --no-site-file" options.
-
- If you decide that it is a bug in Emacs that might be specific to the
- Windows port, send a message to the "help-emacs-windows@gnu.org"
- mailing list describing the bug, the version of Emacs that you are
- using, and the operating system that you are running on (Windows NT,
- 2000, 95, 98, etc. including service pack level if known). If the bug
- is related to subprocesses, also specify which shell you are using
- (e.g., include the values of `shell-file-name' and
- `shell-explicit-file-name' in your message).
-
- If you think the bug is not specific to the Windows port of Emacs,
- then it is better to mail the bug report to "bug-gnu-emacs@gnu.org" so
- that it will be seen by the right people. If Emacs has been set up to
- send mail, you can use the command M-x report-emacs-bug to create and
- send the bug report, but in some cases there is a function to report
- bugs in a specific package; e.g. M-x gnus-bug for Gnus, M-x
- c-submit-bug-report for C/C++/Java mode, etc.
-
- Enjoy!
+++ /dev/null
-@echo off\r
-rem Run temacs.exe to recreate the dumped emacs.exe.\r
-rem This is only likely to be useful on systems where the prebuilt\r
-rem emacs.exe crashes on startup.\r
-\r
-rem First save original emacs.exe if present\r
-if exist emacs.exe.orig goto dump\r
-echo Saving original emacs.exe as emacs.exe.orig\r
-ren emacs.exe emacs.exe.orig\r
-\r
-:dump\r
-rem Overwrites emacs.exe if still present\r
-mkdir ..\lib-src\r
-copy fns* ..\lib-src\r
-mkdir obj\r
-mkdir obj\i386\r
-mkdir obj\etc\r
-copy ..\etc\DOC* obj\etc\r
-copy temacs.exe obj\i386\r
-obj\i386\temacs -batch -l loadup dump\r
-copy obj\i386\emacs.exe .\r
+++ /dev/null
-@echo off\r
-\r
-rem This batch file doesn't work with Cygwin tar because #files#\r
-rem has DOS line endings, which Cygwin tar misinterprets.\r
-rem I use the version of tar from\r
-rem ftp://ftp.gnu.org/gnu/windows/emacs/utilities/i386/tar-1.11.2a.exe\r
-rem renamed as wtar.exe.\r
-set TAR=wtar\r
-\r
-rem Make a copy of current Emacs source\r
-if (%3) == () goto usage\r
-if not (%4) == () goto %4\r
-if not (%4) == (src) goto :lisp\r
-\r
-:src\r
-\r
-echo Create full source distribution, excluding leim\r
-%TAR% --exclude leim --exclude _marker --exclude DOC --exclude DOC-X --exclude TAGS --exclude bin --exclude obj --exclude obj-spd --exclude oo --exclude oo-spd --exclude *~ --exclude *.rej -cvf - emacs-%1 | gzip -9 > %2-src.tar.gz\r
-if not (%4) == () goto end\r
-\r
-:lisp\r
-echo Create limited elisp source distribution\r
-%TAR% --exclude *.rej --exclude *.elc --exclude *~ -cvf - emacs-%1/lisp | gzip -9 > %2-lisp.tar.gz\r
-if not (%4) == () goto end\r
-\r
-:bin\r
-\r
-set eld=emacs-%1/lisp\r
-\r
-rem Keep this list in sync with the DONTCOMPILE list in lisp/Makefile.in\r
-\r
-set elfiles=%eld%/cus-load.el %eld%/cus-start.el %eld%/emacs-lisp/cl-specs.el %eld%/eshell/esh-maint.el %eld%/eshell/esh-groups.el %eld%/finder-inf.el %eld%/forms-d2.el %eld%/forms-pass.el %eld%/generic-x.el %eld%/international/latin-1.el %eld%/international/latin-2.el %eld%/international/latin-3.el %eld%/international/latin-4.el %eld%/international/latin-5.el %eld%/international/latin-8.el %eld%/international/latin-9.el %eld%/international/mule-conf.el %eld%/loaddefs.el %eld%/loadup.el %eld%/mail/blessmail.el %eld%/patcomp.el %eld%/paths.el %eld%/play/bruce.el %eld%/subdirs.el %eld%/version.el\r
-\r
-set fns_el=\r
-for %%f in (emacs-%1/bin/fns*) do set fns_el=%fns_el% emacs-%1/bin/%%f\r
-\r
-echo Create bin distribution\r
-copy %3\README.W32 emacs-%1\README.W32\r
-\r
-del #files#\r
-for %%f in (emacs-%1/BUGS emacs-%1/README emacs-%1/README.W32) do echo %%f>>#files#\r
-for %%f in (emacs-%1/bin/fns*) do echo emacs-%1/bin/%%f>>#files#\r
-for %%f in (emacs-%1/bin emacs-%1/etc emacs-%1/info emacs-%1/lisp %elfiles%) do echo %%f>>#files#\r
-for %%f in (%eld%/term/*.el) do echo %eld%/term/%%f>>#files#\r
-for %%f in (emacs-%1/lock emacs-%1/site-lisp emacs-%1/site-lisp/subdirs.el) do echo %%f>>#files#\r
-%TAR% --exclude temacs.exe --exclude emacs.mdp --exclude *.pdb --exclude *.opt --exclude *.el --exclude *~ -T #files# -cvf - | gzip -9 > %2-bin-i386.tar.gz\r
-del emacs-%1\README.W32\r
-del #files#\r
-if not (%4) == () goto end\r
-\r
-:fullbin\r
-\r
-echo Create full bin distribution\r
-copy %3\README.W32 emacs-%1\README.W32\r
-\r
-%TAR% --exclude temacs.exe --exclude emacs.mdp --exclude *.pdb --exclude *.opt --exclude *~ -cvf - emacs-%1/BUGS emacs-%1/README emacs-%1/README.W32 emacs-%1/bin emacs-%1/etc emacs-%1/info emacs-%1/lisp emacs-%1/lock emacs-%1/site-lisp | gzip -9 > %2-fullbin-i386.tar.gz\r
-del emacs-%1\README.W32\r
-if not (%4) == () goto end\r
-\r
-:leim\r
-\r
-echo Create archive with precompiled leim files\r
-%TAR% -cvf - emacs-%1/leim/leim-list.el emacs-%1/leim/quail emacs-%1/leim/ja-dic | gzip -9 > %2-leim.tar.gz\r
-if not (%4) == () goto end\r
-\r
-:undumped\r
-\r
-echo Create archive with extra files needed for redumping emacs\r
-copy %3\README-UNDUMP.W32 emacs-%1\README-UNDUMP.W32\r
-copy %3\dump.bat emacs-%1\bin\r
-if exist emacs-%1\src\obj-spd\i386\temacs.exe copy emacs-%1\src\obj-spd\i386\temacs.exe emacs-%1\bin\r
-if exist emacs-%1\src\oo-spd\i386\temacs.exe copy emacs-%1\src\oo-spd\i386\temacs.exe emacs-%1\bin\r
-%TAR% -cvf - emacs-%1/README-UNDUMP.W32 emacs-%1/bin/dump.bat emacs-%1/bin/temacs.exe | gzip -9 > %2-undumped-i386.tar.gz\r
-del emacs-%1\bin\temacs.exe\r
-del emacs-%1\bin\dump.bat\r
-del emacs-%1\README-UNDUMP.W32\r
-if not (%4) == () goto end\r
-\r
-:barebin\r
-\r
-echo Create archive with just the basic binaries and generated files\r
-echo (the user needs to unpack the full source distribution for\r
-echo everything else)\r
-copy %3\README.W32 emacs-%1\README.W32\r
-%TAR% -cvf - emacs-%1/README.W32 emacs-%1/bin emacs-%1/etc/DOC emacs-%1/etc/DOC-X | gzip -9 > %2-barebin-i386.tar.gz\r
-del emacs-%1\README.W32\r
-if not (%4) == () goto end\r
-\r
-goto end\r
-\r
-rem Only do this if explicitly requested\r
-:zipfiles\r
-\r
-echo Create zip files for bin and lisp archives\r
-mkdir distrib\r
-cd distrib\r
-gunzip -c ..\%2-bin-i386.tar.gz | %TAR% xf -\r
-rem Need to split emacs.exe into fragments because it is too big now\r
-rem to fit on a floppy even by itself.\r
-copy %3\stitch.bat %2\bin\r
-cd %2\bin\r
-split -b 1000000 emacs.exe emacs\r
-del emacs.exe\r
-cd ..\..\r
-zip -rp9 em%5bin %2\r
-rm -rf %2\r
-zipsplit -n 1400000 -b .. em%5bin.zip\r
-del em%5bin.zip\r
-gunzip -c ..\%2-lisp.tar.gz | %TAR% xf -\r
-zip -rp9 em%5lis %2\r
-rm -rf %2\r
-zipsplit -n 1400000 -b .. em%5lis.zip\r
-del em%5lis.zip\r
-cd ..\r
-\r
-goto end\r
-\r
-:usage\r
-echo Generate source and binary distributions of emacs.\r
-echo Usage: %0 emacs-version dist-basename distfiles [lisp,bin,undumped,barebin]\r
-echo (e.g., %0 19.34 emacs-19.34.5 d:\andrewi\distfiles)\r
-echo Or: %0 emacs-version dist-basename distfiles "zipfiles" short-version\r
-echo (e.g., %0 20.6 emacs-20.6 d:\andrewi\distfiles zipfiles 206)\r
-:end\r
+++ /dev/null
-#!/bin/sh
-# quick-install-emacs -- do a halfway-decent job of installing emacs quickly
-# Written by Miles Bader <miles@gnu.org>
-
-# This script is mainly intended for emacs maintainer or pretesters who
-# install emacs very often. See the --help output for more details.
-
-PUBLIC_LIBSRC_BINARIES='b2m emacsclient etags ctags ebrowse'
-PUBLIC_LIBSRC_SCRIPTS='grep-changelog rcs-checkin'
-
-AVOID="CVS -DIC README COPYING ChangeLog ~ \.orig$ \.rej$ Makefile makefile stamp-subdir .cvsignore \.[cho]$ make-docfile testfile test-distrib"
-
-# Prune old binaries lying around in the source tree
-PRUNE=no
-# Re-install files even if they already exist
-FORCE=no
-# Command verbose flag
-VERBOSE=''
-
-me="`basename $0`"
-
-# Install commands (these commands are also expected to understand the
-# GNU -v (--verbose) option)
-LINK='cp -lf'
-COPY='cp -f'
-REMOVE='rm -r'
-
-# Used to execute commands once once we create them
-EXEC='sh'
-MKDIR='mkdir --verbose -p'
-
-NAWK=/usr/bin/nawk
-
-# avoid non-standard command output from non-C locales
-unset LANG LC_ALL LC_MESSAGES
-
-# Some messages
-USAGE="Usage: $me [OPTION...] BUILD_TREE [PREFIX]"
-TRY="Try "\`"$me --help' for more information."
-
-# Parse command-line options
-while :; do
- case "$1" in
- -n|--dry-run)
- EXEC=cat; shift;;
- -p|--prune)
- PRUNE=yes; shift;;
- -P|--no-prune)
- PRUNE=no; shift;;
- --prune-only)
- PRUNE=only; shift;;
- -f|--force)
- FORCE=yes; shift;;
- -v|--verbose)
- VERBOSE="-v"; shift;;
- --help)
- cat <<EOF
-$USAGE
-Install emacs quickly
-
- -n, --dry-run print installation commands instead of
- executing them
-
- -f, --force install even files that haven't changed
- -v, --verbose print messages describing what is done
-
- -p, --prune prune old generated files
- -P, --no-prune don't prune old generated files (default)
- --prune-only prune old generated files, but don't install
-
- --help display this help and exit
- --version output version information and exit
-
-$me install emacs \`incrementally,' that is, it will
-install only those files that have changed since the last time it was
-invoked, and remove any obsolete files from the installation
-directories. It also uses hard-links into the source and build trees to
-do the install, so it uses much less space than the default Makefile
-install target; however, this also means that $me can
-not install onto a disk partition other than the one on which the source
-and build directories reside.
-
-Optionally, $me can also remove old versions of
-automatically generated files that are version-specific (such as the
-versioned emacs executables in the \`src' directory, and the DOC-* files
-in the \`etc' directory). The latter action is called \`pruning,' and
-can be enabled using the \`-p' or \`--prune' options.
-EOF
- exit 0
- ;;
- --version)
- cat <<EOF
-$me 1.6
-
-Written by Miles Bader <miles@gnu.org>
-EOF
- exit 0
- ;;
- -[^-]?*)
- # split concatenated single-letter options apart
- FIRST="$1"; shift
- set -- `echo $FIRST | sed 's/-\(.\)\(.*\)/-\1 -\2/'` "$@"
- ;;
- -*)
- echo 1>&2 "$me: unrecognized option "\`"$1'"
- echo 1>&2 "$TRY"
- exit 1
- ;;
- *)
- break;
- esac
-done
-
-LINK_CMD="$LINK $VERBOSE"
-REMOVE_CMD="$REMOVE $VERBOSE"
-
-case $# in
- 1) BUILD="$1";;
- 2) BUILD="$1"; prefix="$2";;
- *)
- echo 1>&2 "$USAGE"
- echo 1>&2 "$TRY"
- exit 1
- ;;
-esac
-
-if test ! -d "$BUILD"; then
- echo 1>&2 "$me: $BUILD: Build tree not found"
- exit 2
-elif test ! -r "$BUILD/config.status"; then
- echo 1>&2 "$me: $BUILD: Not a proper build tree, config.status not found"
- exit 2
-fi
-
-CONFIG_STATUS="$BUILD/config.status"
-function get_config_var () {
- if ! sed -n "s/^s\(.\)@$1@\1\(.*\)\1.*$/\2/p" $CONFIG_STATUS | sed q | grep ''
- then
- echo 1>&2 "$me: $1: Configuration variable not found in $CONFIG_STATUS"
- exit 4
- fi
-}
-
-test x"$SRC" = x && { SRC="`get_config_var srcdir`" || exit 4 ; }
-test x"$prefix" = x && { prefix="`get_config_var prefix`" || exit 4 ; }
-test x"$ARCH" = x && { ARCH="`get_config_var host`" || exit 4 ; }
-
-VERSION=`grep 'defconst[ ]*emacs-version' $SRC/lisp/version.el \
- | sed -e 's/^[^"]*"\([^"]*\)".*$/\1/'`
-
-DST_SHARE="$prefix/share/emacs/$VERSION"
-DST_BIN="$prefix/bin"
-DST_LIBEXEC="$prefix/libexec/emacs/$VERSION/$ARCH"
-DST_INFO="$prefix/info"
-
-function maybe_mkdir () {
- if ! test -d "$1"; then
- $MKDIR "$1" 2>&1 | sed "s/^mkdir:/$me:/" 1>&2
- fi
-}
-
-maybe_mkdir "$DST_BIN"
-maybe_mkdir "$DST_SHARE"
-maybe_mkdir "$DST_SHARE/site-lisp"
-maybe_mkdir "$DST_LIBEXEC"
-maybe_mkdir "$DST_INFO"
-
-( # start of command-generating sub-shell
-
-PRUNED=""
-if test x"$PRUNE" != xno; then
- for D in `ls -1t $BUILD/etc/DOC-* | sed 1d`; do
- echo $REMOVE_CMD $D
- PRUNED="$PRUNED $D"
- done
- for D in `ls -1t $BUILD/src/emacs-$VERSION.* | sed 1d`; do
- echo $REMOVE_CMD $D
- PRUNED="$PRUNED $D"
- done
- for D in `ls -1t $BUILD/lib-src/fns-* | sed 1d`; do
- echo $REMOVE_CMD $D
- PRUNED="$PRUNED $D"
- done
-fi
-
-test x"$PRUNE" = xonly && exit 0
-
-function maybe_emit_copy () {
- if test "$FORCE" = yes || ! cmp -s $1 $2; then
- echo $LINK_CMD $1 $2
- fi
-}
-
-maybe_emit_copy $BUILD/src/emacs $DST_BIN/emacs
-maybe_emit_copy $BUILD/src/emacs $DST_BIN/emacs-$VERSION
-
-for F in $PUBLIC_LIBSRC_BINARIES; do
- maybe_emit_copy $BUILD/lib-src/$F $DST_BIN/$F
-done
-for F in $PUBLIC_LIBSRC_SCRIPTS; do
- maybe_emit_copy $SRC/lib-src/$F $DST_BIN/$F
-done
-
-if test x"$SRC" = x"$BUILD"; then
- PFXS="$BUILD"
-else
- PFXS="$SRC $BUILD"
-fi
-
-for SUBDIR in lisp leim etc lib-src info; do
- # defaults
- SHARED=no
- FORCED=''
- AVOID_PAT="`echo "($AVOID)" | tr ' ' '|'`"
-
- # Set subdir-specific values
- case $SUBDIR in
- lisp|leim)
- DST="$DST_SHARE/$SUBDIR"
- ;;
- etc)
- DST="$DST_SHARE/$SUBDIR"
- # COPYING is in the avoid list, but there should be a copy of it in
- # the install etc dir, so make that here.
- FORCED="$DST/COPYING"
- ;;
- lib-src)
- DST="$DST_LIBEXEC"
- AVOID_PAT="`echo "($AVOID ($PUBLIC_LIBSRC_BINARIES $PUBLIC_LIBSRC_SCRIPTS)\$)" | tr ' ' '|'`"
- ;;
- info)
- DST="$DST_INFO"
- SHARED=yes
- ;;
- esac
-
- for PFX in $PFXS; do
- if [ -d $PFX/$SUBDIR ]; then
- for DIR in `(cd $PFX/$SUBDIR; find . -type d -print | sed 's@^./@@')`; do
- if [ -d $DST/$DIR ]; then
- echo Directory $DST/$DIR exists
- else
- echo Directory $DST/$DIR non-existant
- if [ "`echo $DIR | egrep -v "$AVOID_PAT"`" ]; then
- maybe_mkdir $DST/$DIR
- fi
- fi
- done
- diff -sqr $PFX/$SUBDIR $DST
- fi
- done | $NAWK '
-BEGIN {
- src_pat = "^'"$SRC"'/'"$SUBDIR"'/"
- build_pat = "^'"$BUILD"'/'"$SUBDIR"'/"
- dst_pat = "^'"$DST"'/"
- dst_pfx = "'"$DST"'/"
- avoid_pat = "'"$AVOID_PAT"'"
- force = ("'"$FORCE"'" == "yes")
- shared = ("'"$SHARED"'" == "yes")
- init_bool_array(pruned, "'"$PRUNED"'")
- init_bool_array(forced, "'"$FORCED"'")
-}
-function init_bool_array(array, string, a,k)
-{
- split (string, a)
- for (k in a)
- array[a[k]] = 1
-}
-function install(src, dst)
-{
- if (! (src in pruned)) {
- cp[src] = dst;
- from[dst] = src;
- delete rm[dst];
- }
-}
-function update(src, dst, copy)
-{
- if (src in pruned) {
- rm[dst] = 1;
- delete from[dst]
- } else {
- if (copy)
- cp[src] = dst;
- from[dst] = src;
- delete rm[dst];
- }
-}
-function uninstall(dst)
-{
- if (!(dst in from))
- rm[dst] = 1;
-}
-/^Directory / {
- if ($2 ~ avoid_pat) {
- if ($NF == "exists")
- uninstall($2)
- } else
- update(0, $2, 0)
- next
-}
-/^Files / {
- if ($4 ~ avoid_pat && !($4 in forced))
- uninstall($4)
- else if ($NF == "identical")
- update($2, $4, force)
- else
- update($2, $4, 1)
- next
-}
-/^Only / {
- pfx = $3
- sub (/:$/, "/", pfx)
-
- if (pfx ~ dst_pat) {
- if (! shared)
- uninstall(pfx $4)
- } else {
- subdir = pfx
- if (subdir ~ src_pat)
- sub (src_pat, "", subdir)
- else
- sub (build_pat, "", subdir)
-
- dst = dst_pfx subdir $4
- if (! (dst ~ avoid_pat))
- install(pfx $4, dst)
- }
- next
-}
-END {
- for (f in rm)
- print "'"$REMOVE_CMD"' " f
- for (f in cp)
- print "'"$LINK_CMD"' " f " " cp[f]
-}
-'
-done
-
-) | eval $EXEC
+++ /dev/null
-#! /usr/bin/perl
-
-# Copyright (C) 2001 Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to the
-# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-use File::Basename;
-
-if (@ARGV < 3)
-{
- print <<USAGE;
-revdiff FILE OLD NEW
-
-Get a diff of FILE between revisions OLD and NEW. Store the
-diff in a file named FILE-OLD-NEW.diff.
-
-If OLD is `-' use FILE's current revision for OLD. If OLD is
-`-<number>', use the Nth revision before the current one for OLD.
-
-If NEW is +<number> or -<number>, build diffs between revisions OLD
-and OLD +/- <number>.
-
-Examples:
-
-revdiff FILE - -1 get the latest change of FILE
-revdiff FILE -1 +1 also gets the latest change of FILE
-revdiff FILE 1.500 +2 get diffs 1.500-1.501 and 1.501-1.502.
-
-USAGE
- exit 1;
-}
-
-$file = shift @ARGV;
-$old = shift @ARGV;
-
-sub diffit
-{
- my ($old, $new) = @_;
- print "cvs diff -r$old -r$new $file >$file-$old-$new.diff\n";
- system "cvs diff -r$old -r$new $file >$file-$old-$new.diff";
-}
-
-sub current_revision ($)
-{
- my ($file) = @_;
- my $dir = dirname ($file);
- my $base = basename ($file);
- my $entries = "$dir/CVS/Entries";
- die "Can't find $entries" unless -f $entries;
- open (IN, "<$entries") or die "Cannot open $entries";
- my $rev;
- while ($line = <IN>)
- {
- if ($line =~ m,/$base/([^/]+),)
- {
- $rev = $1;
- break;
- }
- }
- die "Cannot determine current revision of $file" unless $rev;
- close (IN);
- return $rev;
-}
-
-if ($old eq "-")
- {
- $old = current_revision ($file);
- }
-elsif ($old =~ /^-(\d+)$/)
- {
- my $offset = $1;
- $old = current_revision ($file);
- die "Internal error" unless $old =~ /(.*)\.(\d+)$/;
- my $minor = $2 - $offset;
- $old = sprintf ("%d.%d", $1, $minor);
- }
-
-while (@ARGV)
- {
- my $new = shift @ARGV;
- if ($new =~ /^[+]\d+$/)
- {
- my $n = $new;
- for ($i = 0; $i < $n; ++$i)
- {
- unless ($old =~ /(.*)\.(\d+)$/)
- {
- die "Internal error";
- }
- my $j = $2 + 1;
- $new = "$1.$j";
- diffit ($old, $new);
- $old = $new;
- }
- }
- elsif ($new =~ /^[-]\d+$/)
- {
- my $n = - $new;
- for ($i = 0; $i < $n; ++$i)
- {
- unless ($old =~ /(.*)\.(\d+)$/)
- {
- die "Internal error";
- }
- my $j = $2 - 1;
- $new = "$1.$j";
- diffit ($new, $old);
- $old = $new;
- }
- }
- else
- {
- diffit ($old, $new);
- $old = $new;
- }
- }
-
-# Local Variables:
-# mode: cperl
-# End:
** `describe-char' can show data from the Unicode database file. See
user option `unicode-data'.
-** `undo-only' does an undo which does not redo any previous undo.
+** `undo-only' (bound to C-x U) does an undo which does not redo any
+previous undo.
** `uniquify-strip-common-suffix' tells uniquify to prefer
`file|dir1' and `file|dir2' to `file|dir1/subdir' and `file|dir2/subdir'.
`auto-hscroll-mode'. The old name is still available as an alias.
** TeX:
-*** C-c C-c prompts for a command to run, and tries to offer a good default.
+++
*** The user option `tex-start-options-string' has been replaced
by two new user options: `tex-start-options', which should hold
* New modes and packages in 21.4
-** GDB-Script-mode is used for files like .gdbinit.
** GDB-UI is now part of the Emacs distribution.
This mode acts as an enhanced graphical user interface to GDB. You can
---
** The minor mode Reveal mode makes text visible on the fly as you
-move your cursor into hidden regions of the buffer.
+move your cursor into hidden region of the buffer.
It should work with any package that uses overlays to hide parts
of a buffer, such as outline-minor-mode, hs-minor-mode, hide-ifdef-mode, ...
+++ /dev/null
-eterm,
- lines#24,cols#80,
- colors#8,pairs#64,
- cuu1=\E[A,cud1=\n,cub1=\b,cuf1=\E[C,home=\E[H,cr=\r,
- cuu=\E[%p1%dA,cud=\E[%p1%dB,cub=\E[%p1%dD,cuf=\E[%p1%dC,
- cup=\E[%i%p1%d;%p2%dH,
- ind=\n,csr=\E[%i%p1%d;%p2%dr,
- il1=\E[L,il=\E[%p1%dL,
- clear=\E[H\E[J,ed=\E[J,el=\E[K,el1=\E[1K,
- dl1=\E[M,dl=\E[%p1%dM,dch1=\E[P,dch=\E[%p1%dP,
- smir=\E[4h,rmir=\E[4l,ich=\E[%p1%d@,mir,
- smcup=\E7\E[?47h,rmcup=\E[2J\E[?47l\E8,
- ht=\t,khome=\E[1~,kend=\E[4~,knp=\E[6~,kpp=\E[5~,
- kcub1=\EOD, kcud1=\EOB, kcuf1=\EOC, kcuu1=\EOA,
- smso=\E[7m,rmso=\E[m,
- smul=\E[4m,rmul=\E[m,
- rev=\E[7m,bold=\E[1m,sgr0=\E[m,
- invis=\E[8m,
- setab=\E[%p1%{40}%+%dm, setaf=\E[%p1%{30}%+%dm,
- bel=^G,xenl,am,
-
--- /dev/null
+
+
+/******************************************************************
+
+ AmigaOS-spesific routines for GC.
+ This file is normally included from os_dep.c
+
+******************************************************************/
+
+
+#if !defined(GC_AMIGA_DEF) && !defined(GC_AMIGA_SB) && !defined(GC_AMIGA_DS) && !defined(GC_AMIGA_AM)
+# include "gc_priv.h"
+# include <stdio.h>
+# include <signal.h>
+# define GC_AMIGA_DEF
+# define GC_AMIGA_SB
+# define GC_AMIGA_DS
+# define GC_AMIGA_AM
+#endif
+
+
+#ifdef GC_AMIGA_DEF
+
+# ifndef __GNUC__
+# include <exec/exec.h>
+# endif
+# include <proto/exec.h>
+# include <proto/dos.h>
+# include <dos/dosextens.h>
+# include <workbench/startup.h>
+
+#endif
+
+
+
+
+#ifdef GC_AMIGA_SB
+
+/******************************************************************
+ Find the base of the stack.
+******************************************************************/
+
+ptr_t GC_get_stack_base()
+{
+ struct Process *proc = (struct Process*)SysBase->ThisTask;
+
+ /* Reference: Amiga Guru Book Pages: 42,567,574 */
+ if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS
+ && proc->pr_CLI != NULL) {
+ /* first ULONG is StackSize */
+ /*longPtr = proc->pr_ReturnAddr;
+ size = longPtr[0];*/
+
+ return (char *)proc->pr_ReturnAddr + sizeof(ULONG);
+ } else {
+ return (char *)proc->pr_Task.tc_SPUpper;
+ }
+}
+
+#if 0 /* old version */
+ptr_t GC_get_stack_base()
+{
+ extern struct WBStartup *_WBenchMsg;
+ extern long __base;
+ extern long __stack;
+ struct Task *task;
+ struct Process *proc;
+ struct CommandLineInterface *cli;
+ long size;
+
+ if ((task = FindTask(0)) == 0) {
+ GC_err_puts("Cannot find own task structure\n");
+ ABORT("task missing");
+ }
+ proc = (struct Process *)task;
+ cli = BADDR(proc->pr_CLI);
+
+ if (_WBenchMsg != 0 || cli == 0) {
+ size = (char *)task->tc_SPUpper - (char *)task->tc_SPLower;
+ } else {
+ size = cli->cli_DefaultStack * 4;
+ }
+ return (ptr_t)(__base + GC_max(size, __stack));
+}
+#endif
+
+
+#endif
+
+
+#ifdef GC_AMIGA_DS
+/******************************************************************
+ Register data segments.
+******************************************************************/
+
+ void GC_register_data_segments()
+ {
+ struct Process *proc;
+ struct CommandLineInterface *cli;
+ BPTR myseglist;
+ ULONG *data;
+
+ int num;
+
+
+# ifdef __GNUC__
+ ULONG dataSegSize;
+ GC_bool found_segment = FALSE;
+ extern char __data_size[];
+
+ dataSegSize=__data_size+8;
+ /* Can`t find the Location of __data_size, because
+ it`s possible that is it, inside the segment. */
+
+# endif
+
+ proc= (struct Process*)SysBase->ThisTask;
+
+ /* Reference: Amiga Guru Book Pages: 538ff,565,573
+ and XOper.asm */
+ if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS) {
+ if (proc->pr_CLI == NULL) {
+ myseglist = proc->pr_SegList;
+ } else {
+ /* ProcLoaded 'Loaded as a command: '*/
+ cli = BADDR(proc->pr_CLI);
+ myseglist = cli->cli_Module;
+ }
+ } else {
+ ABORT("Not a Process.");
+ }
+
+ if (myseglist == NULL) {
+ ABORT("Arrrgh.. can't find segments, aborting");
+ }
+
+ /* xoper hunks Shell Process */
+
+ num=0;
+ for (data = (ULONG *)BADDR(myseglist); data != NULL;
+ data = (ULONG *)BADDR(data[0])) {
+ if (((ULONG) GC_register_data_segments < (ULONG) &data[1]) ||
+ ((ULONG) GC_register_data_segments > (ULONG) &data[1] + data[-1])) {
+# ifdef __GNUC__
+ if (dataSegSize == data[-1]) {
+ found_segment = TRUE;
+ }
+# endif
+ GC_add_roots_inner((char *)&data[1],
+ ((char *)&data[1]) + data[-1], FALSE);
+ }
+ ++num;
+ } /* for */
+# ifdef __GNUC__
+ if (!found_segment) {
+ ABORT("Can`t find correct Segments.\nSolution: Use an newer version of ixemul.library");
+ }
+# endif
+ }
+
+#if 0 /* old version */
+ void GC_register_data_segments()
+ {
+ extern struct WBStartup *_WBenchMsg;
+ struct Process *proc;
+ struct CommandLineInterface *cli;
+ BPTR myseglist;
+ ULONG *data;
+
+ if ( _WBenchMsg != 0 ) {
+ if ((myseglist = _WBenchMsg->sm_Segment) == 0) {
+ GC_err_puts("No seglist from workbench\n");
+ return;
+ }
+ } else {
+ if ((proc = (struct Process *)FindTask(0)) == 0) {
+ GC_err_puts("Cannot find process structure\n");
+ return;
+ }
+ if ((cli = BADDR(proc->pr_CLI)) == 0) {
+ GC_err_puts("No CLI\n");
+ return;
+ }
+ if ((myseglist = cli->cli_Module) == 0) {
+ GC_err_puts("No seglist from CLI\n");
+ return;
+ }
+ }
+
+ for (data = (ULONG *)BADDR(myseglist); data != 0;
+ data = (ULONG *)BADDR(data[0])) {
+# ifdef AMIGA_SKIP_SEG
+ if (((ULONG) GC_register_data_segments < (ULONG) &data[1]) ||
+ ((ULONG) GC_register_data_segments > (ULONG) &data[1] + data[-1])) {
+# else
+ {
+# endif /* AMIGA_SKIP_SEG */
+ GC_add_roots_inner((char *)&data[1],
+ ((char *)&data[1]) + data[-1], FALSE);
+ }
+ }
+ }
+#endif /* old version */
+
+
+#endif
+
+
+
+#ifdef GC_AMIGA_AM
+
+#ifndef GC_AMIGA_FASTALLOC
+
+void *GC_amiga_allocwrapper(size_t size,void *(*AllocFunction)(size_t size2)){
+ return (*AllocFunction)(size);
+}
+
+void *(*GC_amiga_allocwrapper_do)(size_t size,void *(*AllocFunction)(size_t size2))
+ =GC_amiga_allocwrapper;
+
+#else
+
+
+
+
+void *GC_amiga_allocwrapper_firsttime(size_t size,void *(*AllocFunction)(size_t size2));
+
+void *(*GC_amiga_allocwrapper_do)(size_t size,void *(*AllocFunction)(size_t size2))
+ =GC_amiga_allocwrapper_firsttime;
+
+
+/******************************************************************
+ Amiga-spesific routines to obtain memory, and force GC to give
+ back fast-mem whenever possible.
+ These hacks makes gc-programs go many times faster when
+ the amiga is low on memory, and are therefore strictly necesarry.
+
+ -Kjetil S. Matheussen, 2000.
+******************************************************************/
+
+
+
+/* List-header for all allocated memory. */
+
+struct GC_Amiga_AllocedMemoryHeader{
+ ULONG size;
+ struct GC_Amiga_AllocedMemoryHeader *next;
+};
+struct GC_Amiga_AllocedMemoryHeader *GC_AMIGAMEM=(struct GC_Amiga_AllocedMemoryHeader *)(int)~(NULL);
+
+
+
+/* Type of memory. Once in the execution of a program, this might change to MEMF_ANY|MEMF_CLEAR */
+
+ULONG GC_AMIGA_MEMF = MEMF_FAST | MEMF_CLEAR;
+
+
+/* Prevents GC_amiga_get_mem from allocating memory if this one is TRUE. */
+#ifndef GC_AMIGA_ONLYFAST
+BOOL GC_amiga_dontalloc=FALSE;
+#endif
+
+#ifdef GC_AMIGA_PRINTSTATS
+int succ=0,succ2=0;
+int nsucc=0,nsucc2=0;
+int nullretries=0;
+int numcollects=0;
+int chipa=0;
+int allochip=0;
+int allocfast=0;
+int cur0=0;
+int cur1=0;
+int cur10=0;
+int cur50=0;
+int cur150=0;
+int cur151=0;
+int ncur0=0;
+int ncur1=0;
+int ncur10=0;
+int ncur50=0;
+int ncur150=0;
+int ncur151=0;
+#endif
+
+/* Free everything at program-end. */
+
+void GC_amiga_free_all_mem(void){
+ struct GC_Amiga_AllocedMemoryHeader *gc_am=(struct GC_Amiga_AllocedMemoryHeader *)(~(int)(GC_AMIGAMEM));
+ struct GC_Amiga_AllocedMemoryHeader *temp;
+
+#ifdef GC_AMIGA_PRINTSTATS
+ printf("\n\n"
+ "%d bytes of chip-mem, and %d bytes of fast-mem where allocated from the OS.\n",
+ allochip,allocfast
+ );
+ printf(
+ "%d bytes of chip-mem were returned from the GC_AMIGA_FASTALLOC supported allocating functions.\n",
+ chipa
+ );
+ printf("\n");
+ printf("GC_gcollect was called %d times to avoid returning NULL or start allocating with the MEMF_ANY flag.\n",numcollects);
+ printf("%d of them was a success. (the others had to use allocation from the OS.)\n",nullretries);
+ printf("\n");
+ printf("Succeded forcing %d gc-allocations (%d bytes) of chip-mem to be fast-mem.\n",succ,succ2);
+ printf("Failed forcing %d gc-allocations (%d bytes) of chip-mem to be fast-mem.\n",nsucc,nsucc2);
+ printf("\n");
+ printf(
+ "Number of retries before succeding a chip->fast force:\n"
+ "0: %d, 1: %d, 2-9: %d, 10-49: %d, 50-149: %d, >150: %d\n",
+ cur0,cur1,cur10,cur50,cur150,cur151
+ );
+ printf(
+ "Number of retries before giving up a chip->fast force:\n"
+ "0: %d, 1: %d, 2-9: %d, 10-49: %d, 50-149: %d, >150: %d\n",
+ ncur0,ncur1,ncur10,ncur50,ncur150,ncur151
+ );
+#endif
+
+ while(gc_am!=NULL){
+ temp=gc_am->next;
+ FreeMem(gc_am,gc_am->size);
+ gc_am=(struct GC_Amiga_AllocedMemoryHeader *)(~(int)(temp));
+ }
+}
+
+#ifndef GC_AMIGA_ONLYFAST
+
+/* All memory with address lower than this one is chip-mem. */
+
+char *chipmax;
+
+
+/*
+ * Allways set to the last size of memory tried to be allocated.
+ * Needed to ensure allocation when the size is bigger than 100000.
+ *
+ */
+size_t latestsize;
+
+#endif
+
+
+/*
+ * The actual function that is called with the GET_MEM macro.
+ *
+ */
+
+void *GC_amiga_get_mem(size_t size){
+ struct GC_Amiga_AllocedMemoryHeader *gc_am;
+
+#ifndef GC_AMIGA_ONLYFAST
+ if(GC_amiga_dontalloc==TRUE){
+// printf("rejected, size: %d, latestsize: %d\n",size,latestsize);
+ return NULL;
+ }
+
+ // We really don't want to use chip-mem, but if we must, then as little as possible.
+ if(GC_AMIGA_MEMF==(MEMF_ANY|MEMF_CLEAR) && size>100000 && latestsize<50000) return NULL;
+#endif
+
+ gc_am=AllocMem((ULONG)(size + sizeof(struct GC_Amiga_AllocedMemoryHeader)),GC_AMIGA_MEMF);
+ if(gc_am==NULL) return NULL;
+
+ gc_am->next=GC_AMIGAMEM;
+ gc_am->size=size + sizeof(struct GC_Amiga_AllocedMemoryHeader);
+ GC_AMIGAMEM=(struct GC_Amiga_AllocedMemoryHeader *)(~(int)(gc_am));
+
+// printf("Allocated %d (%d) bytes at address: %x. Latest: %d\n",size,tot,gc_am,latestsize);
+
+#ifdef GC_AMIGA_PRINTSTATS
+ if((char *)gc_am<chipmax){
+ allochip+=size;
+ }else{
+ allocfast+=size;
+ }
+#endif
+
+ return gc_am+1;
+
+}
+
+
+
+
+#ifndef GC_AMIGA_ONLYFAST
+
+/* Tries very hard to force GC to find fast-mem to return. Done recursively
+ * to hold the rejected memory-pointers reachable from the collector in an
+ * easy way.
+ *
+ */
+#ifdef GC_AMIGA_RETRY
+void *GC_amiga_rec_alloc(size_t size,void *(*AllocFunction)(size_t size2),const int rec){
+ void *ret;
+
+ ret=(*AllocFunction)(size);
+
+#ifdef GC_AMIGA_PRINTSTATS
+ if((char *)ret>chipmax || ret==NULL){
+ if(ret==NULL){
+ nsucc++;
+ nsucc2+=size;
+ if(rec==0) ncur0++;
+ if(rec==1) ncur1++;
+ if(rec>1 && rec<10) ncur10++;
+ if(rec>=10 && rec<50) ncur50++;
+ if(rec>=50 && rec<150) ncur150++;
+ if(rec>=150) ncur151++;
+ }else{
+ succ++;
+ succ2+=size;
+ if(rec==0) cur0++;
+ if(rec==1) cur1++;
+ if(rec>1 && rec<10) cur10++;
+ if(rec>=10 && rec<50) cur50++;
+ if(rec>=50 && rec<150) cur150++;
+ if(rec>=150) cur151++;
+ }
+ }
+#endif
+
+ if (((char *)ret)<=chipmax && ret!=NULL && (rec<(size>500000?9:size/5000))){
+ ret=GC_amiga_rec_alloc(size,AllocFunction,rec+1);
+// GC_free(ret2);
+ }
+
+ return ret;
+}
+#endif
+
+
+/* The allocating-functions defined inside the amiga-blocks in gc.h is called
+ * via these functions.
+ */
+
+
+void *GC_amiga_allocwrapper_any(size_t size,void *(*AllocFunction)(size_t size2)){
+ void *ret,*ret2;
+
+ GC_amiga_dontalloc=TRUE; // Pretty tough thing to do, but its indeed necesarry.
+ latestsize=size;
+
+ ret=(*AllocFunction)(size);
+
+ if(((char *)ret) <= chipmax){
+ if(ret==NULL){
+ //Give GC access to allocate memory.
+#ifdef GC_AMIGA_GC
+ if(!GC_dont_gc){
+ GC_gcollect();
+#ifdef GC_AMIGA_PRINTSTATS
+ numcollects++;
+#endif
+ ret=(*AllocFunction)(size);
+ }
+#endif
+ if(ret==NULL){
+ GC_amiga_dontalloc=FALSE;
+ ret=(*AllocFunction)(size);
+ if(ret==NULL){
+ WARN("Out of Memory! Returning NIL!\n", 0);
+ }
+ }
+#ifdef GC_AMIGA_PRINTSTATS
+ else{
+ nullretries++;
+ }
+ if(ret!=NULL && (char *)ret<=chipmax) chipa+=size;
+#endif
+ }
+#ifdef GC_AMIGA_RETRY
+ else{
+ /* We got chip-mem. Better try again and again and again etc., we might get fast-mem sooner or later... */
+ /* Using gctest to check the effectiviness of doing this, does seldom give a very good result. */
+ /* However, real programs doesn't normally rapidly allocate and deallocate. */
+// printf("trying to force... %d bytes... ",size);
+ if(
+ AllocFunction!=GC_malloc_uncollectable
+#ifdef ATOMIC_UNCOLLECTABLE
+ && AllocFunction!=GC_malloc_atomic_uncollectable
+#endif
+ ){
+ ret2=GC_amiga_rec_alloc(size,AllocFunction,0);
+ }else{
+ ret2=(*AllocFunction)(size);
+#ifdef GC_AMIGA_PRINTSTATS
+ if((char *)ret2<chipmax || ret2==NULL){
+ nsucc++;
+ nsucc2+=size;
+ ncur0++;
+ }else{
+ succ++;
+ succ2+=size;
+ cur0++;
+ }
+#endif
+ }
+ if(((char *)ret2)>chipmax){
+// printf("Succeeded.\n");
+ GC_free(ret);
+ ret=ret2;
+ }else{
+ GC_free(ret2);
+// printf("But did not succeed.\n");
+ }
+ }
+#endif
+ }
+
+ GC_amiga_dontalloc=FALSE;
+
+ return ret;
+}
+
+
+
+void (*GC_amiga_toany)(void)=NULL;
+
+void GC_amiga_set_toany(void (*func)(void)){
+ GC_amiga_toany=func;
+}
+
+#endif // !GC_AMIGA_ONLYFAST
+
+
+void *GC_amiga_allocwrapper_fast(size_t size,void *(*AllocFunction)(size_t size2)){
+ void *ret;
+
+ ret=(*AllocFunction)(size);
+
+ if(ret==NULL){
+ // Enable chip-mem allocation.
+// printf("ret==NULL\n");
+#ifdef GC_AMIGA_GC
+ if(!GC_dont_gc){
+ GC_gcollect();
+#ifdef GC_AMIGA_PRINTSTATS
+ numcollects++;
+#endif
+ ret=(*AllocFunction)(size);
+ }
+#endif
+ if(ret==NULL){
+#ifndef GC_AMIGA_ONLYFAST
+ GC_AMIGA_MEMF=MEMF_ANY | MEMF_CLEAR;
+ if(GC_amiga_toany!=NULL) (*GC_amiga_toany)();
+ GC_amiga_allocwrapper_do=GC_amiga_allocwrapper_any;
+ return GC_amiga_allocwrapper_any(size,AllocFunction);
+#endif
+ }
+#ifdef GC_AMIGA_PRINTSTATS
+ else{
+ nullretries++;
+ }
+#endif
+ }
+
+ return ret;
+}
+
+void *GC_amiga_allocwrapper_firsttime(size_t size,void *(*AllocFunction)(size_t size2)){
+ atexit(&GC_amiga_free_all_mem);
+ chipmax=(char *)SysBase->MaxLocMem; // For people still having SysBase in chip-mem, this might speed up a bit.
+ GC_amiga_allocwrapper_do=GC_amiga_allocwrapper_fast;
+ return GC_amiga_allocwrapper_fast(size,AllocFunction);
+}
+
+
+#endif //GC_AMIGA_FASTALLOC
+
+
+
+/*
+ * The wrapped realloc function.
+ *
+ */
+void *GC_amiga_realloc(void *old_object,size_t new_size_in_bytes){
+#ifndef GC_AMIGA_FASTALLOC
+ return GC_realloc(old_object,new_size_in_bytes);
+#else
+ void *ret;
+ latestsize=new_size_in_bytes;
+ ret=GC_realloc(old_object,new_size_in_bytes);
+ if(ret==NULL && GC_AMIGA_MEMF==(MEMF_FAST | MEMF_CLEAR)){
+ /* Out of fast-mem. */
+#ifdef GC_AMIGA_GC
+ if(!GC_dont_gc){
+ GC_gcollect();
+#ifdef GC_AMIGA_PRINTSTATS
+ numcollects++;
+#endif
+ ret=GC_realloc(old_object,new_size_in_bytes);
+ }
+#endif
+ if(ret==NULL){
+#ifndef GC_AMIGA_ONLYFAST
+ GC_AMIGA_MEMF=MEMF_ANY | MEMF_CLEAR;
+ if(GC_amiga_toany!=NULL) (*GC_amiga_toany)();
+ GC_amiga_allocwrapper_do=GC_amiga_allocwrapper_any;
+ ret=GC_realloc(old_object,new_size_in_bytes);
+#endif
+ }
+#ifdef GC_AMIGA_PRINTSTATS
+ else{
+ nullretries++;
+ }
+#endif
+ }
+ if(ret==NULL){
+ WARN("Out of Memory! Returning NIL!\n", 0);
+ }
+#ifdef GC_AMIGA_PRINTSTATS
+ if(((char *)ret)<chipmax && ret!=NULL){
+ chipa+=new_size_in_bytes;
+ }
+#endif
+ return ret;
+#endif
+}
+
+#endif //GC_AMIGA_AM
+
+
--- /dev/null
+# Makefile for Borland C++ 5.5 on NT\r
+# If you have the Borland assembler, remove "-DUSE_GENERIC"\r
+#\r
+bc= c:\Borland\BCC55\r
+bcbin= $(bc)\bin\r
+bclib= $(bc)\lib\r
+bcinclude= $(bc)\include\r
+\r
+gcinclude1 = $(bc)\gc6.2\include\r
+gcinclude2 = $(bc)\gc6.2\cord\r
+\r
+cc= $(bcbin)\bcc32\r
+rc= $(bcbin)\brc32\r
+lib= $(bcbin)\tlib\r
+link= $(bcbin)\ilink32\r
+cflags= -O2 -R -v- -vi -H -H=gc.csm -I$(bcinclude);$(gcinclude1);$(gcinclude2) -L$(bclib) \\r
+ -w-pro -w-aus -w-par -w-ccc -w-rch -a4 -D__STDC__=0\r
+#defines= -DSILENT\r
+defines= -DSMALL_CONFIG -DSILENT -DALL_INTERIOR_POINTERS -DUSE_GENERIC -DNO_GETENV -DJAVA_FINALIZATION -DGC_OPERATOR_NEW_ARRAY\r
+\r
+.c.obj:\r
+ $(cc) @&&|\r
+ $(cdebug) $(cflags) $(cvars) $(defines) -o$* -c $*.c\r
+|\r
+\r
+.cpp.obj:\r
+ $(cc) @&&|\r
+ $(cdebug) $(cflags) $(cvars) $(defines) -o$* -c $*.cpp\r
+|\r
+\r
+.rc.res:\r
+ $(rc) -i$(bcinclude) -r -fo$* $*.rc\r
+\r
+XXXOBJS= XXXalloc.obj XXXreclaim.obj XXXallchblk.obj XXXmisc.obj \\r
+ XXXmach_dep.obj XXXos_dep.obj XXXmark_rts.obj XXXheaders.obj XXXmark.obj \\r
+ XXXobj_map.obj XXXblacklst.obj XXXfinalize.obj XXXnew_hblk.obj \\r
+ XXXdbg_mlc.obj XXXmalloc.obj XXXstubborn.obj XXXdyn_load.obj \\r
+ XXXtypd_mlc.obj XXXptr_chck.obj XXXgc_cpp.obj XXXmallocx.obj\r
+\r
+OBJS= $(XXXOBJS:XXX=)\r
+\r
+all: gctest.exe cord\de.exe test_cpp.exe\r
+\r
+$(OBJS) test.obj: include\private\gc_priv.h include\private\gc_hdrs.h include\gc.h include\private\gcconfig.h MAKEFILE\r
+\r
+gc.lib: $(OBJS)\r
+ del gc.lib\r
+ $(lib) $* @&&|\r
+ $(XXXOBJS:XXX=+)\r
+|\r
+\r
+gctest.exe: tests\test.obj gc.lib\r
+ $(cc) @&&|\r
+ $(cflags) -W -e$* tests\test.obj gc.lib\r
+|\r
+\r
+cord\de.obj cord\de_win.obj: include\cord.h include\private\cord_pos.h cord\de_win.h \\r
+ cord\de_cmds.h\r
+\r
+cord\de.exe: cord\cordbscs.obj cord\cordxtra.obj cord\de.obj cord\de_win.obj \\r
+ cord\de_win.res gc.lib\r
+ $(cc) @&&|\r
+ $(cflags) -W -e$* cord\cordbscs.obj cord\cordxtra.obj \\r
+ cord\de.obj cord\de_win.obj gc.lib\r
+|\r
+ $(rc) cord\de_win.res cord\de.exe\r
+\r
+gc_cpp.obj: include\gc_cpp.h include\gc.h\r
+\r
+gc_cpp.cpp: gc_cpp.cc\r
+ copy gc_cpp.cc gc_cpp.cpp\r
+\r
+test_cpp.cpp: tests\test_cpp.cc\r
+ copy tests\test_cpp.cc test_cpp.cpp\r
+\r
+test_cpp.exe: test_cpp.obj include\gc_cpp.h include\gc.h gc.lib\r
+ $(cc) @&&|\r
+ $(cflags) -W -e$* test_cpp.obj gc.lib\r
+|\r
+\r
+scratch:\r
+ -del *.obj *.res *.exe *.csm cord\*.obj cord\*.res cord\*.exe cord\*.csm\r
+\r
+clean:\r
+ del gc.lib\r
+ del *.obj\r
+ del tests\test.obj\r
+\r
--- /dev/null
+#
+# OS/2 specific Makefile for the EMX environment
+#
+# You need GNU Make 3.71, gcc 2.5.7, emx 0.8h and GNU fileutils 3.9
+# or similar tools. C++ interface and de.exe weren't tested.
+#
+# Rename this file "Makefile".
+#
+
+# Primary targets:
+# gc.a - builds basic library
+# c++ - adds C++ interface to library and include directory
+# cords - adds cords (heavyweight strings) to library and include directory
+# test - prints porting information, then builds basic version of gc.a, and runs
+# some tests of collector and cords. Does not add cords or c++ interface to gc.a
+# cord/de.exe - builds dumb editor based on cords.
+CC= gcc
+CXX=g++
+# Needed only for "make c++", which adds the c++ interface
+
+CFLAGS= -O -DALL_INTERIOR_POINTERS -DSILENT
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+# -DSILENT disables statistics printing, and improves performance.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+# altered stubborn objects, at substantial performance cost.
+# -DFIND_LEAK causes the collector to assume that all inaccessible
+# objects should have been explicitly deallocated, and reports exceptions
+# -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+# (Clients should also define SOLARIS_THREADS and then include
+# gc.h before performing thr_ or GC_ operations.)
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+# of objects to be recognized. (See gc_private.h for consequences.)
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+# usually causing it to use less space in such situations.
+# Incremental collection no longer works in this case.
+# -DDONT_ADD_BYTE_AT_END is meaningful only with
+# -DALL_INTERIOR_POINTERS. Normally -DALL_INTERIOR_POINTERS
+# causes all objects to be padded so that pointers just past the end of
+# an object can be recognized. This can be expensive. (The padding
+# is normally more than one byte due to alignment constraints.)
+# -DDONT_ADD_BYTE_AT_END disables the padding.
+
+AR= ar
+RANLIB= ar s
+
+# Redefining srcdir allows object code for the nonPCR version of the collector
+# to be generated in different directories
+srcdir = .
+VPATH = $(srcdir)
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dyn_load.o dbg_mlc.o malloc.o stubborn.o checksums.o typd_mlc.o ptr_chck.o mallocx.o
+
+CORD_OBJS= cord/cordbscs.o cord/cordxtra.o cord/cordprnt.o
+
+CORD_INCLUDE_FILES= $(srcdir)/gc.h $(srcdir)/cord/cord.h $(srcdir)/cord/ec.h \
+ $(srcdir)/cord/cord_pos.h
+
+# Libraries needed for curses applications. Only needed for de.
+CURSES= -lcurses -ltermlib
+
+# The following is irrelevant on most systems. But a few
+# versions of make otherwise fork the shell specified in
+# the SHELL environment variable.
+SHELL= bash
+
+SPECIALCFLAGS =
+# Alternative flags to the C compiler for mach_dep.c.
+# Mach_dep.c often doesn't like optimization, and it's
+# not time-critical anyway.
+
+all: gc.a gctest.exe
+
+$(OBJS) test.o: $(srcdir)/gc_priv.h $(srcdir)/gc_hdrs.h $(srcdir)/gc.h \
+ $(srcdir)/gcconfig.h $(srcdir)/gc_typed.h
+# The dependency on Makefile is needed. Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o: $(srcdir)/include/gc_mark.h $(srcdir)/include/private/gc_pmark.h
+
+gc.a: $(OBJS)
+ $(AR) ru gc.a $(OBJS)
+ $(RANLIB) gc.a
+
+cords: $(CORD_OBJS) cord/cordtest.exe
+ $(AR) ru gc.a $(CORD_OBJS)
+ $(RANLIB) gc.a
+ cp $(srcdir)/cord/cord.h include/cord.h
+ cp $(srcdir)/cord/ec.h include/ec.h
+ cp $(srcdir)/cord/cord_pos.h include/cord_pos.h
+
+gc_cpp.o: $(srcdir)/gc_cpp.cc $(srcdir)/gc_cpp.h
+ $(CXX) -c -O $(srcdir)/gc_cpp.cc
+
+c++: gc_cpp.o $(srcdir)/gc_cpp.h
+ $(AR) ru gc.a gc_cpp.o
+ $(RANLIB) gc.a
+ cp $(srcdir)/gc_cpp.h include/gc_cpp.h
+
+mach_dep.o: $(srcdir)/mach_dep.c
+ $(CC) -o mach_dep.o -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+
+mark_rts.o: $(srcdir)/mark_rts.c
+ $(CC) -o mark_rts.o -c $(CFLAGS) $(srcdir)/mark_rts.c
+
+cord/cordbscs.o: $(srcdir)/cord/cordbscs.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c $(srcdir)/cord/cordbscs.c -o cord/cordbscs.o
+
+cord/cordxtra.o: $(srcdir)/cord/cordxtra.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c $(srcdir)/cord/cordxtra.c -o cord/cordxtra.o
+
+cord/cordprnt.o: $(srcdir)/cord/cordprnt.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c $(srcdir)/cord/cordprnt.c -o cord/cordprnt.o
+
+cord/cordtest.exe: $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a
+ $(CC) $(CFLAGS) -o cord/cordtest.exe $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a
+
+cord/de.exe: $(srcdir)/cord/de.c $(srcdir)/cord/cordbscs.o $(srcdir)/cord/cordxtra.o gc.a
+ $(CC) $(CFLAGS) -o cord/de.exe $(srcdir)/cord/de.c $(srcdir)/cord/cordbscs.o $(srcdir)/cord/cordxtra.o gc.a $(CURSES)
+
+clean:
+ rm -f gc.a tests/test.o gctest.exe output-local output-diff $(OBJS) \
+ setjmp_test mon.out gmon.out a.out core \
+ $(CORD_OBJS) cord/cordtest.exe cord/de.exe
+ -rm -f *~
+
+gctest.exe: tests/test.o gc.a
+ $(CC) $(CFLAGS) -o gctest.exe tests/test.o gc.a
+
+# If an optimized setjmp_test generates a segmentation fault,
+# odds are your compiler is broken. Gctest may still work.
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test.exe: $(srcdir)/setjmp_t.c $(srcdir)/gc.h
+ $(CC) $(CFLAGS) -o setjmp_test.exe $(srcdir)/setjmp_t.c
+
+test: setjmp_test.exe gctest.exe
+ ./setjmp_test
+ ./gctest
+ make cord/cordtest.exe
+ cord/cordtest
--- /dev/null
+/*
+ MacOS.c
+
+ Some routines for the Macintosh OS port of the Hans-J. Boehm, Alan J. Demers
+ garbage collector.
+
+ <Revision History>
+
+ 11/22/94 pcb StripAddress the temporary memory handle for 24-bit mode.
+ 11/30/94 pcb Tracking all memory usage so we can deallocate it all at once.
+ 02/10/96 pcb Added routine to perform a final collection when
+unloading shared library.
+
+ by Patrick C. Beard.
+ */
+/* Boehm, February 15, 1996 2:55 pm PST */
+
+#include <Resources.h>
+#include <Memory.h>
+#include <LowMem.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "gc.h"
+#include "gc_priv.h"
+
+// use 'CODE' resource 0 to get exact location of the beginning of global space.
+
+typedef struct {
+ unsigned long aboveA5;
+ unsigned long belowA5;
+ unsigned long JTSize;
+ unsigned long JTOffset;
+} *CodeZeroPtr, **CodeZeroHandle;
+
+void* GC_MacGetDataStart()
+{
+ CodeZeroHandle code0 = (CodeZeroHandle)GetResource('CODE', 0);
+ if (code0) {
+ long belowA5Size = (**code0).belowA5;
+ ReleaseResource((Handle)code0);
+ return (LMGetCurrentA5() - belowA5Size);
+ }
+ fprintf(stderr, "Couldn't load the jump table.");
+ exit(-1);
+ return 0;
+}
+
+/* track the use of temporary memory so it can be freed all at once. */
+
+typedef struct TemporaryMemoryBlock TemporaryMemoryBlock, **TemporaryMemoryHandle;
+
+struct TemporaryMemoryBlock {
+ TemporaryMemoryHandle nextBlock;
+ char data[];
+};
+
+static TemporaryMemoryHandle theTemporaryMemory = NULL;
+static Boolean firstTime = true;
+
+void GC_MacFreeTemporaryMemory(void);
+
+Ptr GC_MacTemporaryNewPtr(size_t size, Boolean clearMemory)
+{
+ static Boolean firstTime = true;
+ OSErr result;
+ TemporaryMemoryHandle tempMemBlock;
+ Ptr tempPtr = nil;
+
+ tempMemBlock = (TemporaryMemoryHandle)TempNewHandle(size + sizeof(TemporaryMemoryBlock), &result);
+ if (tempMemBlock && result == noErr) {
+ HLockHi((Handle)tempMemBlock);
+ tempPtr = (**tempMemBlock).data;
+ if (clearMemory) memset(tempPtr, 0, size);
+ tempPtr = StripAddress(tempPtr);
+
+ // keep track of the allocated blocks.
+ (**tempMemBlock).nextBlock = theTemporaryMemory;
+ theTemporaryMemory = tempMemBlock;
+ }
+
+# if !defined(SHARED_LIBRARY_BUILD)
+ // install an exit routine to clean up the memory used at the end.
+ if (firstTime) {
+ atexit(&GC_MacFreeTemporaryMemory);
+ firstTime = false;
+ }
+# endif
+
+ return tempPtr;
+}
+
+extern word GC_fo_entries;
+
+static void perform_final_collection()
+{
+ unsigned i;
+ word last_fo_entries = 0;
+
+ /* adjust the stack bottom, because CFM calls us from another stack
+ location. */
+ GC_stackbottom = (ptr_t)&i;
+
+ /* try to collect and finalize everything in sight */
+ for (i = 0; i < 2 || GC_fo_entries < last_fo_entries; i++) {
+ last_fo_entries = GC_fo_entries;
+ GC_gcollect();
+ }
+}
+
+
+void GC_MacFreeTemporaryMemory()
+{
+# if defined(SHARED_LIBRARY_BUILD)
+ /* if possible, collect all memory, and invoke all finalizers. */
+ perform_final_collection();
+# endif
+
+ if (theTemporaryMemory != NULL) {
+ long totalMemoryUsed = 0;
+ TemporaryMemoryHandle tempMemBlock = theTemporaryMemory;
+ while (tempMemBlock != NULL) {
+ TemporaryMemoryHandle nextBlock = (**tempMemBlock).nextBlock;
+ totalMemoryUsed += GetHandleSize((Handle)tempMemBlock);
+ DisposeHandle((Handle)tempMemBlock);
+ tempMemBlock = nextBlock;
+ }
+ theTemporaryMemory = NULL;
+
+# if !defined(SILENT) && !defined(SHARED_LIBRARY_BUILD)
+ fprintf(stdout, "[total memory used: %ld bytes.]\n",
+ totalMemoryUsed);
+ fprintf(stdout, "[total collections: %ld.]\n", GC_gc_no);
+# endif
+ }
+}
+
+#if __option(far_data)
+
+ void* GC_MacGetDataEnd()
+ {
+ CodeZeroHandle code0 = (CodeZeroHandle)GetResource('CODE', 0);
+ if (code0) {
+ long aboveA5Size = (**code0).aboveA5;
+ ReleaseResource((Handle)code0);
+ return (LMGetCurrentA5() + aboveA5Size);
+ }
+ fprintf(stderr, "Couldn't load the jump table.");
+ exit(-1);
+ return 0;
+ }
+
+#endif /* __option(far_data) */
--- /dev/null
+(This file must be converted with BinHex 4.0)
+
+:$deKBe"bEfTPBh4c,R0TG!"6594%8dP8)3#3"&)e!!!"4UiT8dP8)3!(!!"50A*
+
+-BA8#ZJ#3!aB"#3d0#'GM,MBi5bkjBf038%-ZZ3#3%)Zi!*!8"@`!N!6rN!4069"
+
+568e$3`%!UbqAD+X`19S!!!Ba!!!,*J!!!F%!!!-PfTmj1`#3"PET)d31)LTH6H4
+
+#*AqG5b5HI*)QjY$IIb00%ReTJSi6rG$jG(bZ,"Rc,9Umf[IRj)6FZ-j`GfGR)#!
+
+m-#qLqB#cj'G%46qffB3q8AppLXKc+P&*il4FMJMq3N32r[U,(PlSNdrQm-J(4!p
+
+jK)NHmKJSHY!,&chS$4)pk%8mL3I)B0'$AU6S3'q)k%%[5[5J&ffa#68)0ZM&#T!
+
+!*fHC-2dFZ3i83[Vr[4Xh'+DNQrm'J)rrpqe%ST`,FeVi6b,*qHH")4eQc28NFMN
+
+ZT*m,L"Y%-`pdAk6RLHDaeVV0a,,@P(4UUK66rUM'8bf91llS("lTh81)MBQ+4*q
+
+rfHENEhD)Ke#3!09'M%bL[P1+G88fa$3e)5Gpf0kARpBf*6eIH*0`ZBHR%ii"PbN
+
++D&*)688M)Sm$Bm[cCdDjh2YIjmAc`(TVpi*Vka((A*&Yl@'LTSH1M*AMP#,2[A$
+
+(FHA@S"dL4dER#3b!EfBYem(C9P5iGH"a-bb-AL(F"bb-AL,F6)%a9pJUL,(hf%B
+
+TeQb["X5ib4DQXV!-fa6&mZf&3,(C&UDd-((SpeMBEIB`8Zc,BcZR3A5'X+jYj$'
+
+6)6HVV+R[!`#3!`X!(E@*MFQ%R4d"))`m[3JM[c)bBS54Tj'M(AP+MK&f%VD5SdG
+
+SANFB@3Rqc$Am83(+)`"G(D%A'9!bBQ6!b)b4Sq3SH8D1NDGNX$)bBi54!51--$*
+
+Kj0L!M"KKK"dC--,)-h+-6#KKC-$)-F)NamL!!Z06#X!!b&%bBUHp8RcN'%%6!b,
+
+i!!kV"`"DLHFaK*!!"Ym4K,,2i2X4c[,`c5!GIPf!ZcNi'8'VfJFpSfdpq+CY$8j
+
+-V'f-DZr2[36#1(ael5hmfT@1cSU66D5pqDSA89pdTP-`Z[jj6T&!PmZBFZjal"&
+
+5iG6#blE$+&kLh#QZ118&(0T1J(hZ,9)5MJ9ic*qPI!ac'RJ96QMZjSbkMq()Ui6
+
+B+f,,#'N1icbM4N"aaBr1`3Z9U'8RY'XAiVXFKp#&k2D5Be%VCdh4%,+2QS'b"Q2
+
+%0PNT4rE#%kTUFqYDM56bVjfe!p8MqmL)1VmjVkJY`U[*$&*L3AMSpB@LCQ*U&l%
+
+T+3890rL,V9klFN*4@f0UTf8Z&&afN!"4GC6G8p3fN9$4+4[-@DAeK%lej"@eAAL
+
+eU@&4[Tm28%mqqUkS(F+VDa#lB&'rlRAllRP&l460Qc,)MHR$jMh@$8Y4Xc'e`cd
+
+ZE2AUUiH+fK96feb$epq&'RAQeLG&lCDjmP+"Kr8k9#qp'eI8RPf[6R$dS+$UcqI
+
+ELYSV[*ETFL&j[@lr803qd9I2A#bi4Vei3*d[+@Urk*!!&abe0HTVm%44"i4A6JN
+
+c(2I!kjRl6a9e813DK"A6p(LjRZZGaGH+1L5SiBT[(6ekd2*ILMSXU(l)#m3QMDB
+
+V+QTG!r*NG#RQai#DNh4,l0&!Ie`dYi98Y1%1A$5hKP4,`d9cHdKP'LkD@q4hYC*
+
+%dfdLeCCNN@i9UIBNLh5l5(8N68qhM&4R`d9cfdKP'bkD@dHU+qe&XRfNZSqc10j
+
+#8Me*&ZNfNZT0hSYd+dP&ri-FGM6G6P,p5D,rPNT0`dQLk5+6'NLb5"HDe'$L)Pe
+
+X8N2bj-Z'$r$6-$NZjLGC)1lB-"jQSff@[ak%LJ[rI#%p2ddAGREN(@"V+,S6CI!
+
+I!!!0$3KRBbj38%-ZZ@0M8&"$,VN!N"#$BJ#3%4B!!!d'!*!%rj!%68e38Ne33d-
+
+"!+X[PfqV-$P*!!!'-3!!&UB!!!(&!!!&C80(jji!N!BMM#0%$L)UANhN3L9rV@9
+
+B`f#c2p$XpAVVCc-[`k20Y5bJ+CTHPScj`Z'!lmr*#EPaRH(ZcR!J!!rqMKG"q)#
+
+cj'G%46qffB3q8Aqp4R6FA83PM6`KUjaYD&IlZ@jDrY"pk[b&AZrdH*kFbb9PM*S
+
+`4Kh$c8Lf0bVe+Y`Q$amM6mc%*C1(jF&1bFSdGIlLpc*04b#X&D8[&6R%+-#6HhJ
+
+kX"#A+Bp6%6RGkB&kM%'jh$ZLmam[1Irq,r82rGM"5H4bh1ZB+b"Z%&-pD)5CL9(
+
+AP(4UUK6$!(lkH+UPFXFARF-MIHHMXf!5Nd%SZYRQj'pfL)G3N!$94X#(q25G8U`
+
+VXL'QU3Njk8[phV2@0Q92J#d6rA2N1["[!%c(M4X-8p,0IcYJf2lRBmD2c)*RQEF
+
+68m'9jqq*MjHTji&GqDp$kh501r9fqVPJe4iQDRS)L!)ELqiX08i#@40jpP1+F@p
+
+iC&))L)Qq4Bk-cK-i*h`cDlN1cMBUbZA3+beKhX*-&UD`X%ME%F91fHB3BaCC''Y
+
+KNba-C@(,"-40Yl"l,#c8`YCDf%#"XGD%F4m3'*i'k"iah[Ddam+k"Xd3eV@02'B
+
+bj'D90I9p!!!-q)[jAU2HhQ[NiCQC&f(Ne`JR!hlN1''4Sjc`)hcL5IK+f(@8(q&
+
+(1&Nj2XreTBI[M!0dGB4'MK01#CFF2c,JK"*1MNZ1(q&(11@5ii5EKimF*ja``Np
+
+#bA(#bBL6BpQ6jq5imT-m2mQ!dq2N'H&2RT2M%Nii'6$J,PF!#N#jGS3IS9Uba%G
+
+'A-)*8[#%!j-9'#r3@EpUPQ9+NL6$ldj*kVS6INIK@`*q'q$hGRJCPb,`pUJm(fQ
+
+3!#mGrdQqe$Nm22hkJ2cerNp"i3$m4Z62S5YA40V([V`MbHF@)QPT2IN@3@$ceHm
+
+I&dT3GqF9K,'&&8[6LKMTbQ6@-*%bJE#4RM,b'FA*'VC5`0BBdTa"@aNXM#)mU'"
+
+N@d@XSIKMMiMh#RbbLSjLT49GG9"F84)Q8QfN&![N1hK"A'V5F,,dJIF@+`iNJEb
+
+H-(5Nar84j!"*Q54MH+j&08dYQc,(ipT9I+aFqIQc-XP313&803UUPPD4*+UAIlj
+
+$U+jMAP1QUSfEYV2Qp4HKfZ#TYQTCT)hEaCbp+ZXH0"m5USfHDV1HbL4cCT@41rr
+
+5+d+eL4&+'hR90)iLRp$LYcm)e5McQN@UMR#&$kKqr%eHU-DBejbUCC-k+P4N5r%
+
+Iha+Uc5aj)kVfm*'ej*8Dali5ULfHDLah-l$Zfer1#G9@6l8TTf*r,RKTZ2#Q8'h
+
+MA2&i%MYq(0aCicHKfPlfDYLeJ3*FFEG3l@"HmfJbqFrdHU&IU+jRHE95BmQFkJF
+
+29)qp)93hX!aCGLfYP0!jSEU4HF9)-e8M9rADGfC4U(BbVVC66+8XR2Hj2RAmGk'
+
+kLDNk8`@p0[6F"hrG,e3h`kmm(BhDMQjBm@`ejDH1pG)YbUXYM'Y'5aD`-H(VPZ)
+
+,*i6A,Nqe)D1Y'5@UV@HM3VAE)a3$3MT+9jAGa)HI#%*E@9ie+jmf-PA9dY#66`Z
+
+[fkMA!l&$eZ3)bP996crcal6`ZRdT$9NG0S#+V([`rRZ&eae,A%dMGB2V4H%9YPL
+
+LfZ3B194,NC[ik!QKZSYlaE"deVc1$3[9(XVeFJIG0T,9**@'AVXJZ2Db$%'!,$a
+
+e+d2+8SES`Z&RD1(C`m,VlM*Aj)cP#M@ZlJI#Djp(U28`fl)VL9dKY+IXeFM!HRJ
+
+MVc0#YCpj6@!,M0VrHYh,CMQN!FBjl1ZVEPhjaCK)``"6,6JiU@@ekMjdmEEPI@M
+
+3DpXKj3pi+f`LFFpIUPrF058)N4X)f4ZQ*P5c1[&!pGhC4i@Ue2BCE"bRL&haLRk
+
+Thb#ZUK&ZK-Kc9k4Z-[QKhdaf&1KhN!#*#IdZ-XfJhdPQ)I6l#![SYjD'HXp$hdA
+
+f$1LhNlN-r4DbV8$I8iS[RSEqj#URqY@$9b3dJG1XG))%khUHJMX,Vh896Z%"I%B
+
+PFK1MejpP2[@,$LpbTe[Q%h#[hhai0BBHF+r-MrTeL9G6k!!IKHa1rmf2qMf,9c6
+
+d)%I[5Hq$1hVVq60(`H@-9fb&cfkb$BBDc1-Ck@@#jrVH%0cXH$@cIK[C#F&2Q9X
+
+[qpl(HTpEQ9F`KqVA3&iYS3Pl6#ARpIXMVpCP6[+ma`PkbJPkbJPkbJPkbJPkbJP
+
+kbJPkbJPkbJPk1MHKTlbJTlbJpqGlF2RNe4CD`1XDTfUZEYjDHE@[F0T$,KbK"Vc
+
+mA!9AAPiGS3Qjm[HQi+l-LraVj'p1i3&mcNKce1@eZ4pFX(PY@1(66rD18)Im"eF
+
+YAJ1K#AYcK92peXpVBfM#AZAIKi*r&r$U$"h)dkhp2[JI!kp0S3GjhdZZV))A!43
+
+jH4kk(TLQKF4pTXhHI!ITRb%hcX3KfeN#**1EI54a"'@Z8(9Dm%D@b"Y#qhm!N!-
+
+0!!PRBfaTBLda,VPM8&"$,VN!N"#ah3#3%!9X!!!I``#3"2q3"&"56dT,38K-!3#
+
+TY1))Uc!eD!!!@F-!N!B563#3"2$I!*!)22J1`2KbNQaPEr+hGEX``Jk!Vpa0&eT
+
+RDl*eSGZ&%EEAc@iGG+hAYBDRapHZd6ETQH'lV2AbpMVJ4lN,ck0G4lMb)fcKAQi
+
+*AeLhm1)VRfPGM,"Zi8pBG1%a3VYZi@m,@rM#2'iAfhjHacE,K"[bJGYB,ZcNP&#
+
+"$cqJ[fRG`SmXR'aMC-H6r-)AXTaNHE+Fj"HkN!"0"R[G!H4jITB&`!(!dKX"PZ#
+
+Z+PX+S(dCS&YGZI3,cN3L+P4H)V5R@D3p,54$JD"3'!j')mhRcl%mUJ)9e2PVUaF
+
+j[6lNX)ll!4,jajb6UrZK!hSTX[caD`$ZIHl,pdeVm&EaLeKG-YjQB6AKT)84pF,
+
+kB$+55%ID`b-4QF0T19ckfSl,d['15$X-4cTr0"2!dIR5%1j[S4JQa0,J4lT!pkc
+
+"EjcQ2ZmmNDF36,1DH)X!8($N3ihbR+mcX1GC!E!0fi)+ra)rCUL`#HU&V9)ke`6
+
+IhTB!b&RK%B!&4fA8Ecr8+8IBcr)4Z8L+$bmVaA0$-Lr)$3+SMf0Xkh!%1L(hiM$
+
+H56i!P'Q(V3ZXrmCRE,f[6f'0N!"Z$E6%fl(AqCL20Ka-#kRdjh`qA&CRACe[!5i
+
++PSiKjh)6PJM4H$#5%&U%HF#GqF0F$MM6fH)T68dFSQ!hQ*["e3hGME'TS#e`Fmq
+
+Sl`'0qRTZMfEcM@b8M`(hV,a,kqB4N8iZ[4Sh5b!9ddQpT9YP#5UK!NX`BDbr,"E
+
+!TME)X#08Bm,*$)fP2Ci@G1bTGUbETe@@q%4QL60h[2d5)BQGX-U5,*6)q)99'NX
+
+bP3a1pJZTH#BC&"!P%4'5XP`!Fm82LidDE@#h&eejC#m'cSQd"k1C&S(CD`*"Va"
+
+S%C+TmmkE6aJ*6S3kTd8)4GS&PNjQ"#DY1419T&!JQT+cV-0*5@'9$$5+K-58Y"%
+
+N8Ea'&)q3!*!!UeBZ'qd'!&14D",LQVJ'$qTI1DUU3$%0cAD!e9HMkl`KaGAASBj
+
+TJ#pMhSb5Rq0c+LJ3l3LJkD2dcrJM2Q%3Kh&mZL-JR(&m+L$L-)j29b,%B4br8)j
+
+X!Y$j4ZUh`)[eI!A!R(d!4AHG`LH[d[f@re6*b2mAI`)H5F0aI+2XYq2iC)+N`6M
+
+qC$b5"Z2ij,N%KHI*24K!$k@Plm*Hm'Rd8-bci0h@*rK6m%JDM[-[aZ1Nhq+IKNH
+
+UJA&mE-V&'KM(2a129!2Mq2,5(2qIrSHmNfTSR2rTH+3D'XHRfL81irM8FE,Ep4r
+
+eTUeM[5Ra8bilkJJ6f!)lF0e(0'p*Cke+2Nq9ccEjh#UIZq6c&[RmM(3ZV*!!cL0
+
+k&5l"Jp4$Ilc)-m$9BDMqeV0m$l6LhM(EAX9A,10lG,aR)2GNb6Sm29&b0@CfmMd
+
+&Mr!pHLh'hX&p"qiPVV#h)jIcaN(YAHVY!-im,lH&lp&Fc$pX!KD$+,qKqbMQh",
+
+@BjDAX[M-KFF0&bH!le%r'GC@E`LVXP9mKXdeG)3QcED[U18Vq4jY2c-fD8XFl$a
+
+Jb0pEdXPRCYXVR!e1c(f%qF`GKAUQcPT3T6E-YjCF2GYHhq#[aqa0'*p@XJl4r*8
+
+qM(Fa(e1(MAb2DUZDVTq-SD2mJ+kFAj*ldAQmX-KFQf"C5i,E1fA&P2jHj`!8*c4
+
+Cbq,eU+LUqmriLrQ-H$8"RJ(GXC,YKXYCKk(M!EcN!3MV-HG3b@DB@MEAd"P5,9[
+
+2CjDYplkH1ckr$1D5aNf'jH[,p0ehXaPCKe@(eI0#11SC',UQT)X9K3qD(G8hK#c
+
+C@GQUfADhU*AQPE#2X"A&i-9KaAUdDe$"bpQU)@mfJNfL,U61YQ4RBFiKFac+[hC
+
+Y@49Fi(Ye4UjKII9Fl[b`UM[(Ca+6ZhF[@mq`0Seer)R3*#Y$$IcK`pPc%EI6FKZ
+
+I`IV"'%bLZK'Mdl!5jqQ+3J!feU'k*f(FZf(EGY@@N!!CGAmMqd9@CrDD68d'jf(
+
+3TlQV6AYhAEJlGh4$epjV3bSqBiDXKA!BPjeTVUYp1pI,DPfESAK1"2eSD[B-elh
+
+H#"KCEIFl0K-Um0E-CFr[,$HC6Hhc`fDr-eb-HmN5*`iSE-8)!#TL+mfKpUV"jrc
+
+$X6fMXIlRYZ5'5$I94YXX-&C(`""L$Dkf)VmVe*%)GZr'mh(#3i3EqlYKNKblRf*
+
+'9fi`h"aV43`ejERI0DPfA"MDB``XX)HHa#bYS3h1c!hCcPlQ0+mDh0Yr`mEU8Hk
+
+YrAmUXCIMj8SFBkA%6iNVCjRI%C(IMj&E3@l3G[C&a#hGId-rBQbXrT)c0e6q'2p
+
+eC)89`[fJmPd62,qrh"5fBCA-$%rb1d1R5hbj`ddQ1G,60%Q1l'T#EqB1)110@)h
+
+%i!95M+ekEiM0HfqSHM1k9UQY&%V$jTQPB&VZFVm*4FmG"[Acbff$#qbZ,a3IKUr
+
+B"VZ2A1J-[B%elK$paa&k8Z63JaakNVNdL$c1fP%+A`QGIJ'bm6iH0ZklkX(0S"E
+
+8jP*3Mb,[3pbE@&fLD'2RS@ZY1`pG"kj1X1j#2R9*X*QX*TAMbYcVef*YX2)T6FA
+
+Q@D$Hf'AE5@VBGSP+2*elSqN#9T4Gc"`I)"SMr!P3K8hPL)Se--@E+!*#j8qBAdA
+
+F)f`H'*JMT!TSH@V*`'V2IZI1K@DpeEljYRXA2YJ9eU,IcfjLaVQJjXS%LTUELM'
+
+UNU1Q*M@HTVX(FV[-AA`QqadqFr3i9[JU81PlSB$r%d$A3iqhZfXV+KG!GjBeeU(
+
+[-cfI+9deX0(XqqDqeeCrEqGcqm6iUPf$i$#AQd`B@p0rSjJ6NR2d'hX'fX5-"MQ
+
+MU,pRS%(-F-NCDZeUk[$*BA*h$2XG9RaZHj-D6bq3!1YJC6AD61@QEFZ@lXi09,[
+
+#3r`40LMRE"V0'C!!FecYKJh1Q(D[`hN%90BLbX@@Y!c8C8j3QmY!ApD)[GhVGTJ
+
+**CcApF6MTA!ZjkemqUrh9AKG,PI[cVeVI+q#h6`$QIm$kKcXmZ"@c&ph+[pbaRf
+
++-2[6I1-)JqV1YQR9UpZ-&Cd9Uc'6i5P6JCdV6"8c-TKV%$1eQ*@af2(L22GJCe"
+
+VaTDFcfaEffcXh1Pef-$Pm$Vic)0VQmqbL$(+mRVQJpGcr8kVcZZakIJ-9F5"VJ2
+
+A)XVacTfpDfd&ZhSY"9l2XleH6rpD3Epa6E1D10FlQJjH!G34SPGS&qM3*fC3Pe2
+
+L`2L%lVY,CV!*T39qcpXH[fHHVQRU'%UAhk2&Qk`VKaD[,i2ZHk`cX2[6K&iQRrQ
+
+lbPXmS@QX)1Y!&RH`da"Y"8BfPYDc4GPC#3lV4AhlG+E(2&HTGaMM!VD)&65CaPL
+
+Dr4lQB&J09`k9kE(,mhf[0f[T[[2#[mfpH2-6*6k4bk,U5Z`kcd%Ia$UcfEZ2Z!G
+
+1&'%PEF2B1aKl$'0hBH`R',X1BjX`pP1-h6AD-aHa8TJD0Z"T@[KdIJ$5L*0!R+1
+
+)NmCi#mDEj(J5i`fS4KaV[49[Y[ASjjGJCfSIkdaR)f+)e-#cLpMMH4iTJQFE+B$
+
+RFiN4RXfXNFpBZGXAc[3QM,G2Yh*CMh@3!(q8lFE6#ID-P'YZ"AefKT9M99N2Re%
+
+Z5UJ[cKd0UjR$Y@%N5eQr[bVdDANH1X3[2[#XjcJ0%Se1!jKa'U#f[M%BE`p&`TC
+
+@-mfEF*1J""c`J'Sc4b0!`0Q1cH9X!e(3aCl!)H`k4qIhpfYS1)*',+EMMLJR'JM
+
+*XAVRp4,L3*6EFHJLENI+bThcfZ@BBX$BV8U1Sr-@+@iljX&F'M+D6*J-'5#(%1k
+
+[1&EhlT'("@L3!%(&RA-a6V0,2#9X9%3D8*&8fT'k`V(k5V),NCZX$kh*MY@GDYV
+
+4Y-8%c[bAlh!l-U6&69c*e@N4Mj-C)C2d+XbiMLZjUSJ3--Aq8HQ-$[R0RcMaPa8
+
+e&lLqlpUj[TGS[iMVqri'VZr9AUl[KhZi[J-YA0r"GUl[d&eFhq'YA0rr0h*pEml
+
+RqYlHa2Ap"212)[Ba!pGh2-6e$Gc+p3dqbr80[FMe`hbZAjA&I4IA2aN0'##DQ-I
+
+F0B%8$M1bX*!!6V&dUi!$KD&N2-DNDAZFBic&F2BrKF2r6-!j%"D+4)8c'q,aD,f
+
+3!-3j51B9SJP@RdlLA(j+(8X++A@L25E3BD9ki@,HV9l@i1F0$6KDbP$RC(bL'2*
+
+%ikP8)(QCZL15MXe30%"dDAVbI)DMURqBCV&i5b4dfDrbrk!LN!!@@#SGL#9B+*j
+
+N3JH#Y3HLV#@5r"fhhq@IS5Jp9LM&BLQF6+PSMTk2cbS%9c)KQ@5a90K#Sf4N5PN
+
+S5M[3da4hiQK)k+XiA(ND$YpSYSe-m)LIZ,6N5rL%!p$M"e)Z2G@JJJ8FXU,((EM
+
+pQ)@$C4*&(*ZN6`SqKSGP)q02Q+F@[iqA@RaFJFBHbCM4qfMF%h!%89`D('LN6e`
+
+k'KDkIh4i5)XM8r4*4)JcM9hKZ+)%Kcj2Rl4%aj+pAcSALTmN,qQmF&6[3Z`$k*0
+
+%H%M18RJEF-b22R&0qM&+6,@P[&-a!BIik*1U!BGKe64B611lY)`iBNHI9"S+Ab9
+
+l)JjKd5HT3V25,H+!P%`9Z`rkT%9kNCS1THY!pHQ6Q&%@$8)T99L%Sfhd5H*hI$J
+
+64C28Y,C`Djl#m$6b!XGfTmrR*X8$d@L`Y6QkdK+%4i(E8[b59GP&,"cqQPC3ih4
+
+MlA''N6k&X1iVfl4IfC%6%hNG3kaD8[4Nmd+LGcpXR+[Xb-XNFZZYEkLS`Q4G+Yd
+
+5L413!'S-T`$1NR'U9P55`+R)+U%aM8!K9-"b-+[Xk$GR5FTkh)hN*rJB5@-L'EP
+
+%j(6IK+GdbSlH-e9"XT!!TkM$335*3-%BFqd`miD+#P4)M`VKJ,5STAS-5DFJ,A9
+
+lRF6mdQ"V)#Q+K-c,[YUNl&M9XNEZ@PkXmY(k8'eCj+P3G[5T%69*)e+cY5@CqV"
+
+#$%SP0969B)9`fR3N*L#-jAfF#50kqURL8%pU-)M3+FmipZBILqkTH!E9YJip)aj
+
+%`mKhi"GMeDhkeqSZq1IU*VIi[,SeRcM3"dM$M['C$j!!BhcZ!m11mCN2&2k,$aK
+
+qi32[Hr5%Rh[d,hX-I&T(k6&F2UIBBc4(!m'9d93k(d+2NBr*-djj`D*SpBJAZ,f
+
+9j!86F'3iZ$+9LDAqShqJf[jh,cLPbr2V[SPKZ8BUA*j'UT'@jR"M,2UIAFerUC*
+
+hbU&Hqqk24KaUB492qKV`$C4!&+Z"V#$rQ"GJ24rmKPrCa6X4KAZ0c$d@5+lmTal
+
+hVejS(qNI[*91V#iSP&p#b,2@2paR1A6E52mJe6FBBMJ1dGJL*2+9p3qIhj!![Bp
+
+M('C8fB"h)XK)5,I&%TpfThIZ`BHa&(9Vm2+9kL#QA,kQIZdYiIaLYrARRVV2f2q
+
+YNG[k'UGr%8DeBN-EK0EmEAlarTd(p5,rIHIa&j&hIpETLXk#R@jbC@-b,9jkj$[
+
+SG20dc3jaep#MG,*Rm*9,kClGd#jFfLM2Qq@TmibVrRcNcU2@95h1CX5Efl"&%5r
+
+8mURGV@U5ZdHGS,k4EYRemG4[EPCrFjZ4PqYQYFV$Li`LB4cI%5Ak4CIabTc4cV5
+
+Z`5pfTSPdXM(B'Xb,d*RQlCVl-6rbfNK(iUpddhemB9))4J14@"k%hM42efh'efl
+
+%*i192U1qBE',qSa81Y2F(%qfjbIV-mbRlM2Dk!QiiGN-X@CeBXhQjHJG2R%#l)P
+
+%*m$r!"'46R)DGS+2k[XNTp(qiGGq@r81$FI)IYZ`[)lZM!cTba)YbQKh2VHq(T'
+
+iYATPahXMf583L9i#-b!5'SA3JP$LMk5FV"eL5P&e,)!2AM(fqq[&rAqqJEX3ZJ0
+
+4GUAcq1#I[$MlrpXrj3jb$ZiY+2BkkdRM@qKR3r"mcb,mia%m2lM89dZ[Vqh!-,f
+
+QqNbpVjjZ29qJCq04M`2d!b+N'UT5MqGLqX832%q[Aej$mA2Gr%)2D,J,T!VQVUK
+
+`%6jhAB9V+HAI4,rjJHFl+Pb,m4eQEZZ5@KrPp5aF@N9GqC2+ql1S&YkPdTmG6Gr
+
+!qEV`09U+&4c&223NLQNk-DpALZNdR1mDqVXNM'QAB`crlBKL%mp(M*G"*FCZ`&J
+
+DZ&cZG*Ki-f,J@mmLMhX`*R29E-FB[Qe,XDNr4DlPFZc[1GrDKlkqQYkKeBBaYUl
+
+YEqK(@E3aM+N[HKM14ThU%2X*Hb(-`McNHXhpB"3j2BDaPJB6I!Ne%&qEaD`r`V`
+
+YU-G"k"3ar)MaKKaEKl'$NQC6hd1-Lq4B$Q0G-XB+e-BRajCJ,+'*V3bd4NrqAp,
+
+B[bJT[kddmXG*R(e#AIa5)9RRT[cr!`!!$3!*Cf0XD@)Y-LkjBe"33bkj!*!3qL)
+
+!N"!0"J!!,h3!N!6rN!438Np+5d&)6!%!UE6L#+X`0A!!!#*k!*!'$d%!N!43[J#
+
+3#1j"$F$iCXbcEQ9ffFS2dS@*jbZl63NYVcACZY$0##1XPDZ$V[@ke[$dmVQ6K5h
+
+FYGEmE+(Rmc@246PGf0D9hF)@VNAi`VhS`KGM(GQA+lmmdfiI)f`c`Tq`63P23V[
+
+Y`VEH`KHqX)9f(@(E*!Zrf-)@IZi)AhKXi3[E,M3j*432"&!HrHaD@&$M#f(,qq3
+
+@XL1hN!$"3Rk6AcKCb%+1%di@J&@""TeG+a&(42abSQ*m9@@VL(4[%29TUPEGj%S
+
+NfN09'd1a&"q0T8,*F(-`0#85E)pZZ-eZrEB+Z[80G6A,A6ir2'5jYd$i*mlPdrI
+
+-@8-1XA6I6r6dUG[h&cAjUSAPI(dbhQEPDb0*+mqX6fN-*U1*9$3@'8GN$c0%(%0
+
+GelfTH&Fd4Q0)jLrR%MNc2aM&pcf8d``Y,Ak!B(cHb*GQH1E2Phb'JLQq0Yi5)P*
+
+IZ&DMccNrDX`mDiN1BLbSE&MC!)B+3p!!(FM4Z3"pmf##5,64Fd39&fA9Eck6N4(
+
+q-Kr+TK`qGQ`-&dGPAb51%'Q'J"dB3bK$iZYMHPIm%$'QJ`j8f2l6cq5j@TmTYD&
+
+8Dh0,2)CCjkGqG*&J+Y5CqU@IDmIQUUrh9q!`X*4GG$59b(1#DBYLrXT3Hc`B6B4
+
+D3NZ)Zr'(SNLFq4ETPX+0#01J@-c9Mci&E"ETe"lZK'B2D682F5pVpcl#6cM0`cF
+
+VIh2RdI%LA6N'$6l@jXi1I@kfp+LX3395@i-*Bq1p(FdBDS-m*N)0#&FB@QXXRJV
+
+TqHr&d$F[UDca!YiDjchaf-C3%T1`bTUFNM26%1V@@T1GbH#dKP"R2*d-KU#5L)D
+
+5FVQ)&NXr0"XEY)Prh,6j`NN!Fk+aB(Zk*F3lDTZ$[P"c5bMC1Arq8UD4i#5T15f
+
+KF$3@iP2*G)M2RB8&#LRFh0iTXfaMT'5S@aDD8))aK6DZ*"9[2BV(P+51c4hG,L+
+
+c53S*k44Xa8Acmd49U9R$Xk-p6,4P'e,Rh4bZH3"e6"(G$Pjab5Ikh&MNk*3JKBH
+
+am`[rd,p4KJ)IdrpGAkQ!SYrdArSB+K6p(4q-kaYR%DeiK@MHTTrT+airpFpf(!c
+
+C6D6hMrH[fSGq[SpSi@NLdj2ApC8!q05rrM0pH5A%p,FGr*AqP!RpYPrTjl,kIr)
+
+Mrc0p)kiXJcl9Cb(1%'6hP`BRQ0MP'EU4U`lF@CCrSLp0(%#3!"HAp98B52*lSGq
+
+&ZrfkrM3CD5@kEp'%2R+m!*ldPFM#f(9p0R-`C#rdT5&)cLr`#Kk#rMULrlIXZ[j
+
+d'6P$Y0N+!(Y!54rDdc&h'$"brDYqB3l4$[hhr$0$4PE$2eXNb2ieb2fErJLM)1T
+
+RZCa*(rQIH68r2Xk[*I+#iKreEj!!r52r-kc1XRmYjSpI3ai@B(RaKIqI,BSqG$#
+
+E'MkH69X[ckB'iJEe$Qi`RhhAFB-&cq&lKKZFKRc"-D9m50)#'Z6Fp%2+jFLffS0
+
+N5Tj%4@C5"GI&cC(ZFcD,h$e838lFZmM*m-eX'F$dP%A,,mqff[SF8$&N-KPiM91
+
+9NF2XSa0J@f1fH(J8"hGPCVYkTSRLJ,V55r6R486P'%J,"U5PdFrVi(p*UM20Z#1
+
+AjGIGE[0r"EdLeqdcjp[mNSplX,Y)hCYJ5aj0I@@G*jb-Gm65lHf-'iiR1d+aG!I
+
+M4Q-YACfKpTEfZ,40CpQLY-XkZ5B+lNFp6BS(cVppFXHLm)JE3biI%jRZ4TD29iR
+
+SY!R1P$QEBbjeBD*lqi'1GccMbIje'bEC1H@a56dI1a@*I@9pEqBF-qYcdaaAM`b
+
+5FjP9B(QLVT*e4Aa$'kXN*T*FX[j[jrbLXcJ8Me@X&Eh%AL-JTT!!Gd4B3#S&rjI
+
+6(0UBDSje*M'BT4+G-9BhC9*@-5jcH$[1@!XpJKl'$ZGDCHXmRb03ICB4reapCC!
+
+!(Mqj("6&rGSNfp+B@FQGKfZV'cfXb6ZLR8&V%2h"l5[mJ8hjJPR%eT0&kPUA"r-
+
+MPcHq*D-)FI[,GTp4[[$$5jiqJ&BGP+G#UkjaI6!H#dFM9NbNa28pDebXI1(,,(N
+
+ED'bUV!CChjPULFDCN!"U8NG00mXke@ZV@1Ge4VY$ke-3#PpeT"PAmJT`"+9)V,N
+
+pTl6IHLkVI,'RZ6PAIkpR2HXM[+GCRdK'0dVZpqGr6kpmXC'CT5KCd3'NL33K%LA
+
+eT(2pQ21Q5[3dR+GDX116UUkC9$)S5UXm2KGcINq`Y6NTP421bhiMS(ba5j&Vj+N
+
+6f#aTQ1JNeElPhNVPLj`GVbDV%DYQDdZbmeS[j5Xpee4GLelLG+PS4`JbeUXka[&
+
+k0V$H4$f6H2FMHFHjNP0bI"Sd(Fh4'2DERk5`R-%10TmaEFjrI`$I68b$mrG)kq6
+
+aHBBP*&LlQC0%8Xl9HQQfr9b!L@&XcMHPT*eJ*QI3,1Ibj`$iNqZ&q@YbPJ1Ha&!
+
+Tc3P+,rc(E-IjIaGE%9QEH@4l"'92bccba&FiN!#)&l6[jHikPAbI*GrYmVe9[[I
+
+)phhbr86Z2U8bGeIk!)'b%TGV)mAiNDCMGeGHc9GI%IUT&GqZ"BjUSA+ed+mA[-2
+
+LXC)(FAZaC"ZB'D&IrCc3Ep!"HarI&r!YF8GmAD,SLj2'YmVA4CaPLEK2k0IH*6a
+
+V*Vk$fS9GI4I"H5aL!-[(@%*ka9$HA3N5qMA()VUDA4&9YPT)mi[cZX*6&cM@eJP
+
+93VpZN!!h"R3P6RiqmI$[+mN)k3@15PH6#pcRH,qPD`T@&9NVUY3'[UeNf`)(%Um
+
+4l0h!LdSHK&T$P4pi$qrR04'Md+mkS'(0E3aI&)EejF*+mAAAd"56T5l"Ckd*lZ6
+
+dYG-("ec$9*M3CUehlN4&9Aer+0`PT+AR#H3GeRp3FMK[%pq9er8Y223JLKM!HEY
+
+N,mdU@jbA#DY@la65UhIkhK'(PTE4BPEM30kDR@@'[UIiiUc6TNIh["CTp`k2hPr
+
+5`jXLjbc1QSI$eZbmE28#KdHUPIB[)RkQV95-AKqV@,pZ+bUiLHmHp@@M''(eB8f
+
+f*6X2R,FYF5Vrc4ePeE6)rfDaf,5cCM&h@d69*`VTa,5qikYhmZK0Ble`+6c9aU-
+
+'$C(cf9ZKQl&q68LMIi$490Bh%PU%6PbL0f'aB1Hl9(X5aT1l$Kj@l3YE82GhXer
+
+JkbdqLcQ3!1Fk6iB8YmemmZL+iq,&A6dRGi493YT#@5[6iERXA%YphBr&!El1[CF
+
++&dD44l1b0lLIpNA*b0Ie[@mhS`,[c9hpkT&bXm8F@aUa0,JLKIL@V(3KLJm!)8*
+
+&l+8LDUmD1G8`KVdmJ3fHfLH1XVUTHZhcb&J6TE``hq4Z-c@i`ef*B0pah)HB(K3
+
+H'HbMU6,f$BBChH*)C%0(+c3dM1IjL9Re`SV`bmEQ#NIi'&Lk[$Dk84behl,DCHN
+
+H16RiF'r0K2I@`Gr,ZCIaFJ8(9XVm+EKbPreGN!$mr6@mUF84qbhVQ,I8i-1$d1L
+
+YqD*,(#erAVJEVY!Kh&Y92c(6UfI+c4%lZQ4ZC'U$+c`cjjFl(c$,5(pJUS`F$5#
+
+EZE0`h)YZC!jHBaAMZcmFjCGm1&U$M9+Ne&j+T4(,h&)bVh&lrSC-Tmk6jY8epT%
+
++KrZQ`[0dKhfNlm)+9rKGp,K6bKpRq*MNS4mHqT0LLL3I0lp35RH%Cbk#'pph)mE
+
+6[h0S,fP#'NXTD5D86d2hbhap`Y5EHAZ(lFME$j!!1d1fSr"6Rb5lf@C@BB2jcJl
+
+d"Pmq29"SQ8HDhKll%9B0qe'T%Lq*l`B@mDEXREcc)d9M9,K%USLj(+VSJHQqK)Q
+
+BUR$*mLCd,r",+)phKPA01S'YCFRQb(lRkmXX"TYMlpHHARDS*k*$hLm)m'`$`C@
+
+&''S*&!*9bDJjS-&YYQGB2'VT%G,Cl`MTLd2Sm'j5'3C),I`f)I@3!2%1,)HU+UJ
+
+[bkq[4qlc"L&GfMhFDr(rrZQrf[,p)kG15hMhd4&b@XV0CQ"E"aq41''CBqMY(fk
+
+6'%db`c6B2p`N-G`b3k2E`LC4PM$L%f0jKiiA$`FdZ,h'8JHGYGjZ,MFIA,hUZ$K
+
+Fiik-#KIi%CQcHi)c,(2FXEaGVJlG5DIV!UPX*XE&5&T'QM)AD5aPC#KEMpRZ(3F
+
+@d#@FcrhLGd[T9XjApG)IRkldZGhZJ5-RYrVI*)HP'-lr3A8KTMck#[J2AZG[`VV
+
+Jha3@r)a[((G3NfNVUYR5CUc-9'i"NmFYABR*P@C*M$5iH4*6"eEDLVfl+"l+"(8
+
+@M14#qZ$f$FE-%Cr66QkRcbQN$fhIF,09`KM,jee+2Zp$4fakRpHZ&p+X)mlfR0d
+
+"PD(-NB(YG[A4!D[DjheP`1FGh"ibp'lGS''H'jf"FrF4Q`L4&ES+2A+LQ%dj*8l
+
+JqAe2P46cqDAU"Zq2[3hH*IV!V%Q9RJD[$Y[IcD0hlLbM[MffBNarf[!E,'IqV1S
+
+aElL)9fHGF2%%2`0UDi(dPMEbbl2c%Kck4I2iE0i!RV[80kDaL&r1U`2Q5CH@"Lr
+
+[j0%0QdI,$*Mbr0mIb&Vl[VlL6mAA(hfaa#pj@9j6KDPc$R)3I@Chp&h`$&mbSC-
+
+1!RXIf22!RJ6fYm!H!,BEf0m"Hh*LCMEaT63VNSGE8@5Q-%`Tk#5JFa%k+H!Y`!-
+
+bRJ6HK'V%dHZYf,SBN!$R'c'C1LBRd`93$,0Ui1jQlR&I`LU#Zje9!2GEQ52F,Ia
+
+k)@hM(PmfejF`2MlEaQ@pYK(Kfraah#la*h*F5bXCXX8fMUr1HS@dXLKKFl&i-D,
+
+KRHjGikbVar'Y9la$l2RB6pmR,LdS'+0CVLaC,H`"dT@r%Z!F2cScr3P3LVMhU0$
+
+RDQ6lXmIBIJ6h2FZaT-(pd#Tr(GX$[`!BEfIS4+1rNEepHBe0*1LCXfaR!QFkYKh
+
+"[C!!E89`RpfiTTEKYhU%C9l5FSYb1eVZ[NShdqFHU(5[B[`[Xmd%lNp8ZZr%``V
+
+Z`-Sk2q2e,eY9c6DeamCH2MPq""hf),AJ0Z`'mAk4BHU,`2"fN@(D$$6B3eKJHLe
+
+ijh+BEJhfCmrNX"X@BR0iMP35pJI3b"!RLM2TKUm#`jj4mR%B@%X1Qrhh`&k8X3q
+
+"I82'4(M5h,f&[F[64H#l[1e2f"XKA3FdhPMh,0f#,XX(PR*-SARJ23cXC6*+rTj
+
+($GBeQHQ,U+Ad,JkXA`G[(hJpP*%d'S#PC1a"B'rNDPDX"RC'a[6!hT)eeX&I3XE
+
+f-%rDMYpUEQfrmLafmJQYmYTfr+%XjmL[Mpm65YCl'2rr!!d!#'GMG'9cG#kjZ@0
+
+38%-ZZ3#3%%0D!*!3(m-!!%+&!*!%rj!%8&*25NY"5%`"!+QdiJLV-$9B!!"5l3#
+
+3"K+K!*!%$I3!N!Me"!i!pCQCc1abX2*Ef-,&mj8EA@KjV4fRQfkf--,fZP@[Eld
+
+Z$dq2VmN'A5Bp-hbAY9lHAJFXfQdl+AG,Z2)ME*&GEJRrA-libQIDl@-,fic`*fc
+
+6K5HKhAEKE`YIq-)mEQiRK(pXXmb@iapGq-+kKCfFELT3q1c,IZ&ZXPf1@pl#b%)
+
+ffjdZC,)F@FK#&m,)B+r,!D4[CPq-FBbaqZ@-eH&@A,@%-I9,M(@V+THFE3i'I@,
+
+PFV%p`R[E)f,)lA5*'SmV)SBMaKm`"H(DkkSAQQdeb1%*lP8%I"Kcj(3rX&H6m0M
+
+IZTkaqjrj`UCT$PZ9X*!!V`m&fSamV5GNj#ReR!CAb"Z-H0XpDBqF`ePa(%eGaiT
+
+)S-2EcP+HcTr1B+bXmm9Kh'q$6Mf`X[$"KF4R$RhYV2*CXk3m49H%V`fdL)`T"cl
+
+J+-2j13Fpcq@-E8&E8'&IE%H%!Ne3,pZF#1HDf2Hf""Q,&l1('*Yr8%EphJ1GXSF
+
+r%JrNr)3rGBV*(aq@mf,a)FC8Kq$ER2+`6KCr)B9h0"r'+0,%0Xm[rQdqSqFB2cQ
+
+eBU69f4*S4krcbhc8LClZG$iIR'*cIAh0I"abUXM3iXkAEq$(ilQ,49r!j3f+,H)
+
+maNhp56c112ejNK@"P6JkPXIB&fjK8aKcR!drZX6iG+jqq&li[TdQiqM4U(!CR@&
+
+rGU+(,&FBA8QAdZJ+kKT@q*eSAPdm1Mm9!Sj'C"RE!a%aQhqm(IAaK-)B'-FE!ha
+
+jS(fj'%,(Uc#'FK,*f-@9@FC3113DEaI$J@M)*3)Pk"9$i'!+Qm`pccf[0,(*#J2
+
+h%ZcNS8*JE#k(6ij38,[0q$[cVaRB"FIjhRDA,pSLmUCDTmXQ1P[%8(M@V%X))mK
+
+*81HhL'j[ZmK(3P'46jb,ab@$h%jI@)iU6J@&a*8bd!J5%NZ'TC%NDKY",5%K9lA
+
+%%1kQ%f8Z9IE(4kQ5X*9Mq!UPK%dirih2+53-k[E(m!QELQ!-Rl#ccq$6B)6Z-I`
+
+FQ(52iC0Hd6f'2a&QlKPm`YDG`5GX%V)aI-*'%r+rq)3prJ`qB9260)C2f"21i"-
+
+feI!B2QRI@@I`#A[5'Ic*-1NH`dIV+GeMrFY8Q(52j8mG(mdXar#TGUKe(X1R`pq
+
+T1G'EYSlfTT4IFZ446jL-RfpLA2G!eYX*@kf3!1dTXPdLfkfbh5AE'fAlbB5G8j'
+
+`4rJkCZFXKT(SUhpj-0jKc0+KVIl1dd)2DmAG-GY8*93X&AUb"HYJr,'#0E!H,EJ
+
+1NCe#Mr)KS8HMKZmGh)rJ,V"iE"haZ#h!9,BPYJl''HE&0`Sp@9F+$qSClfFqB9h
+
+h3F6FlY%JbNC43[653pSVJdcS86hQ89H[mbKL98+8Rk[YF1I00PeH*e3+2HTqAYH
+
+N,LMMCc%HqGX+1SASE&1&f@&'l%0mMD%M4m1VBND`e)EiiS,VCTXD(2B'40m'rl5
+
+#08#c9pE!hmAAm#U26ZK4E&E48%VR2LJ-CTF+Lq-[Q!rPj"[UJRc-'14f6EKm3Rq
+
+[HC!!63aQaBb,eS*44IHY`T9#9"TN-1YJpRX&fl4AmahDMZpMp-1B4i1Br38Ef*5
+
+LZGT1Yf,T@L'kG+hYpILK5iVBA1+i5A[CfL*0plhmp&KCF6DUCir(CadF[VkJLmr
+
+hl$189GrN0XCQaUTQQmSPVV*HpY33GT)apN++X4le+M"i0Epbf"EcSZR0GUYL,E'
+
+CL0P[#,$5,pp39-AQe,`b2HjB@cfAZmLMk)i,dH$ilTe,er+S69fpF0LG9mb$!l[
+
+R31a#i(BDla#LU"ri@"l9MH5GKNUFPjh[CUb%le$F&p6Y@VGPQf+Mf`$HhiaG`0F
+
+EE!CpNpCmJ'NLh(AkA6XZh4NrZ+jVe`eZK4!eX*L4F(JZ0X03ArHcH#pICpR!*Pl
+
+XK4j0L8ffh'rc-KeIere1L4i-[$eMkE2E5r8'IIXP(S2Gl*Q)Zf#a'@X,Qq&K$)b
+
+8&-E"[@,S'A[+pp5)VrqCMI&KiNfa[Q3Qde9lQGE01baYqAD,Zb2SkYi*qa$K!H(
+
+QrQk@*rZq5ckG*6lNDIDh!N0&FHA[kK@2A1Tq5ZHFEh)rKLLeYSe0M3qAR,I8E&J
+
+jY+[rT[A9)lQhp[p4)R[CAjVd`eG)q5Ap59[1Ed$+lfq3!*Xb2P4bhK@8@k6rTRj
+
+JV+rq[$NqA2U`m"9NK3VKAUem9mqHIDj8lbP"PFc`j0R0lNQ*I,N$6AVCdp18*hY
+
+f0%'EZEh)H$fUN6,B3ica+pmIjZHp2ebp!DT9@&,)#Mf''B9-IjQPr#f@rm`"TRV
+
+fXT+Kq5E,f4-2X#q@$(82A'Tf[iND,j2dTmcpQ*4$$h,S#F8M6-VMR%F+f4IGNqB
+
+J'pZ22,VGhpLkJDP%PD'3!+P'N!"h!rF@[MkB[ljcr`h&frIIb#bGV(J(mUN2X4*
+
+pX9j4GNhmp4Y3'hcTK+D*KTP-YEkVC$Za8E*$BZ+*q*Y0FrMmf#+ql$LLcLXFCJU
+
+2[K5SU)%*YQ!q)e6KX1%9i!l`mjL@,h-VR'U"@M4@E)Vpm1i&"NfaDF-GpbrBfZ9
+
+43qpR0r'kZ8c&&BRN0640K&FKHr90+PMRPJr'GaLkK'MXKd,di#&8q%UQd23bTI"
+
+9"Y@$aT[+kbSUjl2Z'0pB$phR08+dF1AJHN20YhDrGZhcfjrC,IPAlKKLCBC5[4k
+
+q9Idh5c&Z18Dc[QH`6BT`b"(jr6f$$LR#)NHSe0H#a(a5Q2KG+Ee$aFHh0DPJl5(
+
+93@8ePZK,p9Z@,YNC(kbfH)D&!Aj)MVPY*'C3MV'dDpHCrHTGCHB"TLM1TeLdU%9
+
+-9@4Q+N-4da3eSVGlhF4QX!,1CRRd4iAX3Xj@qF4Il+k`@5b@hZfl9Y@m`Nb'kFM
+
+m(e%[4TI(rJ6aDdl'AmecRb,-rM4HPmkJZV0Y@[@eEEU+cSTV%FR$LPDJFf96T)J
+
+SBV95T"T4851Qcr(ieNkAfS!@ABKZ@GfXkpaZ+bYKPM*EQ4$GZVVj(+2NSbLEp4*
+
+QXhjcHh'fc9U5,85T)[CflEd"+)FkYrHZ,P(Zk$8UEGDRHfh@rY@LC[fUCKAPh&$
+
+@Y1rVM$T#D)9kIMCdBMTe139Pm1GfheX`RFmY90UY2l2DVI1bQkD-SR6CVHVV',Y
+
+QH0(D)YCpAr&dG(pClTG)CrkkmRDVHaU[M*8KLl[iXi"f16cV#a[iKE'C33leSVV
+
+cA&k$1%ZK,B8aKer)+j[dSeNDl&DqM%FeA$0FT%'A9r0mEmcBIIHPIa9riGZ2&Y4
+
+)Z5bXVN6AH6jd%(9@BZSH+"mmR)p+fJ,I1r!p$0mpm2dGI$I#GaYmI`rI25-pFcj
+
+Ib+CiY,#QH5B*Jb`#R#"`$J)R!Rm,r%fb2`5r!f`%81ZYQ*CVS1I,dCQD4M[6f8"
+
+d%aZ`,C3pl(R%#1`5BJ$fKC34E!2I+%5,Z6XAc,!&GAHH@mc&V-9$`JriRE!1mdm
+
+QBJfY6"1EAXca96'V%%d15UJ[MKrdU2JbblTde+I(r2fRV)GU*0F[GKFZ'6FZ&@C
+
+!@&e$S`1V*BfZ3,[Ekc'f'QM#1TGaI6mfFAd[dRd&lTYa2mhe[DcQqPkGarAYVFD
+
+pRq[EGj!!kh[Gb2@pdFVerHebVZqYjlLqJ6bZladIehI`(Ul[(a4Fhf(J[@rMqRk
+
+qJHZ,jh2ph!,FAqIkPGrNqY@YA,rQDG`$A2piD5R$)dE#I+49a0+%1a6`miQp3Qa
+
+bq2hBFJaMcC%A-H[Lh9kI1084#2JDa"!f3ALEk![b$C%30K$$+Rp)$+Z#lAk4M'@
+
+U"BZ%FY95Keh3%Y-m5!m&aNNZUbm3$MY$+e3GhSKrHRQY-ib9%UaRb2XM&r&Bb[Q
+
+$#1m2Y(MG+riPr[FUR"'4$dHFrL$[$S4iX30Jl8iIhq)0r5khhm926M)p@LJ6T9)
+
+i'P,4l,[)jI1kP[&L+-6l`aiMMHaaP!k@(kR(!$5jIF64)2HV9c"fkm2Bb8M[NA,
+
+5*ahe$KKB9T9'TSPBKI4**`H4UR2Kk*+M&9J[`FHC*Q&NUD#pVUA83F[45Jadk'0
+
+F3Yf1$dpTM65,Hfl&AGM3!#1U'a&eQabGKF82I&eA%c-D$%HjjT%"U4TMFAb*[&A
+
+h)@)HETXFRBf&$h`V0NVHj1U3!,`K#cY(qL511H*j`3MI14L%iN0H')LU%pY@kEb
+
+e@+I!ap@!&jDr$K6[395bNR+a,%&ISM6!LST@Uj*V5MUX3Y#A)"$4+kM@NKY`il$
+
+S30pF$R`T#q@S*(BHeKMSieHp#Flf)`,0AQTaDcb@&2)PHQQ)5fb5Xdb1cXF+!Vj
+
+N8DB2,Ic5f4Kjid'T!M!XRlE0,$48%8&NcjVeLhiPLG[pfVbedR#BF'qX0CFl+(-
+
+SP#2N$)DCki1*FLTMEYAMF%qMfLlECUkT+5IZR$kIUlACYmcS)YhC12(&iZ3YB9'
+
+@5Q5*+ZHdkID)X$BCAmp+hXKTKT6AHm#U3r4C*hSQB(BrU*ZE[*&EJ[hH"NF&f1H
+
+b`j%@Ei"`&+-i5TRYhSDUbbZ*lE"hTGJB!9#%@0JA5pj3Yh-5l&V,'fQFRq0a03C
+
+$hZ956TYb(mp1hP#k+8NN)bQBbZ-#L*FT4c0ATc*h9&5!)3dB`XSCTF08SdMC5D3
+
+Pj6BcCAk9Up8CNNK#jN9IDNVH8!QCSr)k39+0G(N`aFD&eSVN$99-XdNF%CZY,D(
+
+`"a@L69D5SkS@&F+T)ekr#"MM-CcF0*pfUMM`5Hd-*A450pjlk`mPT8VU"Y9h0R3
+
+Mi#,4b)#J'D-9V[Mh#PIqZX**-8jAH0BrUp"aT*4UR0)#8Sh6@T!!8Se6@T!!maX
+
+Yd(kN"FGd1[HIG2TA[3DH,8Mf'TBDXp4V02ZFVQ8q2,U3!#'KemM%T"XRp@#KVcU
+
+Y"q@f5Y+$A#aMZCD&Srj`4S3qiL3hckljPY445pa8@+b09#FYcCj'[bpc@BGcr'Q
+
+!%69iq@)m[C*8URU(RG4!'ib%'PfYVS`*8j,-6"h[aReIXbG[D8k5c,e@cYh[$#h
+
+lT)pilFFr65[(JLU"+N',p`QF2Y40KM[Pq2-plHN1e&CT4R@a((P61@0C"rU4'Q`
+
+blVmMh8FNDTaTr9MRD@`4JjR-qSM6-pGM1,T84T8160L3!*%BDI-(2jh'hIh8YR5
+
+r8BZ42Y@"2cR5GhfQ,m$+0,B(FZ(*qFCchdR[JG5Dl3[K98[0EFBhc6Jf!k'Hj$p
+
+R)(rUIIG)ebZT#lVHd,,'8%3DJQ5UfdlEP"@LKiU5A8P9!ff@U2hH-(@biF`FQ[(
+
+KV+6++NJeiI9JS(a#A@K@FPTGe,p@Pj4QR&)AdSc6kT,5M&2U3T15dqU5QT4mULl
+
+T5FPrl#eaeipXJ`L95k4YN!"fmDV'M(FlXp`hrMJpBDZc9%XlCB(Q0M6#dJJhdpT
+
+%2bZdFd30'KTT[d-6#2rA22prCQFCZHEjar[pNj2C69PYp)K@DM)V+8'fT!3C%RU
+
+0$!Sc%%F&0K8NII&jQb@NScQPp1@%DKc0DD4,rDbV-ccd@PV(lCAPY$H4%a*G2UI
+
+ARl'MdM)(c3+5MpDF8)f1Rr4*kNc)faB*9I4DMcVDlZfJPej1UXfAEck8RMde1"C
+
+Ci0@')p(QjN#S(A*Mr%a[J*8"E)T3G!%pL5YhHBl+"RVj4bhpa)5,Y@G#d)*M[FH
+
+rp@3IGap(N9*kF+TlbrUSQrlA5IIaD[aidXeYj&CVNMH83&CM+!&9RaC+%&Q"[`%
+
+!PM5C'9(,)ph(*fUTr9!YMqT9DV2iP&iGfErj4+r'r8D[mMkHFibb02iMPNjf1PA
+
+[d("$VLh(CI8d(p1LX&VN*cJbP(8k[pfF2kE#ZPqTX(51-%LC%ZXU[a22)[*i8[E
+
+rZJ[cIcUGL4G#pHMBk,e2kCF0VX,2PP#E5Iik[#T1$qmHrqXJc[6'Fa2`XLUETTM
+
+$*YV-$D3cYp12%m#qEb(qhJ$feL8eGE5PqJMF0!YqXU&'QZAY39+9b(8[r8`"-MX
+
+Ah$6![T!!ITF!pTb'bfV*EbNA&PMaKL[H#UA+i@kTX"!qGeH&C3R&EkCI&X"$k6d
+
+9PN9@f#m[VUY"R%+aB%N90%@4PhahPUZj([c3IkY-$A%eUr''+[Q8"m(LQS3[kcE
+
+1G+!PiF[1j8b6mBiYqG4I![EZK'rFji"Ab"55leDmdYV+9*,[$[MHa&2kj,XIH(K
+
+90KkIa-Ep'I$!Tj5(&h&2b4cN`,G2pSf$$kqZ5Vi*m(hh+pHLCV(B#pqMEAp*2`L
+
+K$S-ce482X[1!F4&mDd`jE#EL`-(e-DD6q,X(FCd12IXm1+#IdU#-2SFi1q)HB*d
+
+54KI`ANVie'C`8jVJFZTNa%85A%ip'ebqP1"bkZr$jj-acJ0'8-Di!,i@'@-Q-2E
+
+*q68KTiMXZ`ja[9RqCFj@hp%rG"RpQjINMlqNrpQ&-qA@"ki53rAP&2rr!!!0$3p
+
+YGbpRBh4PFh3Z0MK,,VN!N""453#3%#pd!!"+8`#3"2q3"%e08&*0680$!3#V,jH
+
+ZUc!jB!!!"M%!!"R%!!!"V3!!"E(*MaZS!*!'[VXM4!iL+Pj0j%)PIdhl9fbRBC!
+
+!DR1(JAFp3hUJ2KNcZ@(k&LeHlIYc*cMM1X2GRCf"!*`N(81C&iAQNTm4&Ifii1"
+
+EpGII4h6#PiP+'R-jb[e$&IeM12rA3hh-XBk+D2XK9#@U!P9e!@eRU22XRT!!%ar
+
+%6jaP3[FjFKhiIjQ@hidE$&25cAm$`-IrIXai*1U*jZd88q%pXX1%F$M`RNJbAQS
+
+ih%%N0J*@A""6p[pE#%1,cL9X%K8j[Z%i38$F)*'R%8!QpTQQT&06TCMf4amme9+
+
+jii[1iC(HE43E%aa#QlrCjZ4[GSL(8*!!e8D-E"#r6LR@&GN3aF6F'028K*cdTGk
+
+aT$fkUhhK6F,P(Tj11!CFTLJ+QQSXDINp,M$RL-+Cm9q6j"VK+Hr'rhrjXB16b1@
+
+iec&AC&Z,)bAP)A[QZNkT`brFF9bj0@L(b*(4H3)$i*YCbh9`YK90aj%$0a!Gm&!
+
+,de[B3!XlC'%$"-Eme,D0'(Z229-8DlB`9Q$FC!Y6@9L'KA%@PQm[")V0YM#PKBP
+
+$[mI#m!L#i#MfjAH50i4eE512Q3bj@@90I4m!N!--!'XcXfpJlh2Ij$4lRaZHF-P
+
+a`Tr-D)4&@%FjIAiV9hi5rZ3i@3NqRhV5`hI'm8m[3MNjENHi%AjN`!NMR"`rbB$
+
+bTrc)FA,m$%r*F51Fm*03FTa`FTa`-Q#%%hlN'4R`Pa`RA(+FF+mMamRa)mq2m$2
+
+#bB!#GjN8B'@Y6-+0iUpN*rl)-F)*2m)*8[#%!j-9H"9SN!!()1QkKK#+`Hm@K$S
+
+HJ&m,rN[#E`hmIJLEJ,q0bk)PQTCS@&q4J@q@4d"9U,FU)md-(0Yrf-'kLSC3Ech
+
+QTZ6PDfM!,6kXTJh48"8c3%-B$Af2ZR8CG9Ip2$-35k-p#&9[4Zd)$4`EE%%G46!
+
+,R0"9-23T99CN34j4,-#2%@HJ4P(6T'aDQa#N[iMDX5G2a3J5j8hqU`G8AI)J-HU
+
+[2pc+8DXTel3Q5K1DDDe`rC'MeMLS#5QV5"2QC-jFKV@(Y,XiDUf$'TI6Q941+fY
+
+NIrEXmabeMLSdTZC&6Ae8m48krm8h(,@HFXdUSU`BRMk!q[lRHBlD3,RQ4#QENT@
+
+#"cXRI2X+4ie6jif)dMfM+mkEUadrc9%E(G5'h+TKlGFqRHHS#3He,LFDrPe`h($
+
+QCBlDa(3e*P+'jG["RP9riDM0,PI9V"`8d09SikJYP'YH1C5kHVfHlZ'SDkKIpI4
+
+i+LIkaJ28)bpbe,88e9!N694cCG6ZNqFjkMUUN!"T6DE6ZT(h&AViKGmikRVU"NX
+
+TAdR(H9q1FY4@bY@D,XL9SfF2rY6286HiPp,*+'9G,aJIFG50p#Uce14Gj3Y'd81
+
+Ek"h5cFV&)blrQ+1f8B8b8UTJU&0#eN-9cVh+8GXGe*U-j!-kU)P6p4b9*UB'dj*
+
+PCDb-E#IIrF$K4qBkCkfIRK)eFi@ZrFEXr4ae-h@$T1I(e%`C&K,!AUi3T&L#1U`
+
+I'P&bCG3h(rRp#Fje+d8&50fBrKHeFp&j@4Q5M3GV$pea1eGSfk+(0$9pa80R1GF
+
+ZCkfce*a5FDbGI1mKMRSpifUSq482fFRj!BlD6Id+#UPkaDr(MfcMU0YGVSSeRLY
+
+8Z0V[F05H43q4)19lk0aM"lL(GMKViS"LkT1'T(MH+rPeTkZ3!*U"!([&H8FjkLl
+
++0@RS306mKfX[64ZJ+`31D"5@fGUaCaUiVRd8Y@!C+5NVP42Ef6h&a0E[S,D5e*Z
+
+k$e*4k[,4R"1qUq@S0cKV-k$Hk86c@fiEqT2V*rYSlLHcfePEppip1YM9Hl2Del9
+
+2!&`"@TQ,U#F1&[Z''jdelZ4b1(ZHmdimH"0(45eR)(&!*q9f)f6q6PCX0VTUBad
+
+IAd$pf!@`[ik1Br'KUlR)+fakrN"cHF(H36)2h%jb&H(+NrX0&jMF9VMIj$*$&L)
+
+T"p)0cLf`Yq1%"AXR6JQ`Yq'FKMf0GB,GdbRXPYLiZ+lq4#IBL8k`%jeJ*cV"6R5
+
+#RHJ%1p%*GU)6l%3Rf)P1h%qc#+[@Y15RS-eL8qhT&"fJcd&k4dVkK,dC'pb'AVi
+
+MRZjKXmB'HccD3(IrcJ8G(KYmfk)&p1R"5Hkrqa'fKQc`$Bdfm0&Ek'dF5*Cm&25
+
+6E"T+qQc(16M5i"iI4FpKHCCb3p#-XSR6I3[1YF$(e@dVrAm(hAhGA,f#1a4fVQ`
+
+D)a0bM1IcX19PNiJXd-QrQrjp$rTP0Nh4$ljDEE6C0*GdfSPEQNJ$[AaI"9dkQjE
+
+)"&rjZ5PSlpQXL6c)65I42'&jkHi((6HE659pGY(F%GhJrk#CBp-AQC!!QcfG`RF
+
+BE0C'2GbTm18(Qh@4"hI+cbI"'a-fkb-2I05,Qq*VI86`ZS90Dq6"IEUNPpZrZ6d
+
+IkmP@hp@`f9$5UmK,"LjZ2dGjKIdd'pTRSrf,Re6[[[HdcbYXX0R3aK[KcVI)#mr
+
+A-dm"R8jJFcLjAc2T0r!1Xr%Ph(NRKdhm"Y1PM9qd9#9(PFc#![X)[SNKr!e@jAm
+
+!N!-0$3pYGbpRBh4PFh3Z8&"$,VN!N"!4c!#3%%+&!*!)rj!%68e38Ne33d-"!+X
+
+[PkkV-$P&!!!'-3!!'Z!!!!'T!!!&bE5F%03!N!B"fL0%$L)UANhN3L9r6IYAE+G
+
+KN!"UFiH"Gce$HU!q'61jBIV#iB$[cjhJM1X-GhH'!`%ib6Q'-Lm+c58r)bVkFF(
+
+"YqU[[irS4$#9MENFjIkKL[iaR2rVS6lQ@%G&Y2d3UK*9JDUkJ,Bce(Pf6fJm&6R
+
+b2Z8HRJiXa'A+ir""h#2TreqK*11PKX-G4'@dI[MrP@fl(cXiL9b1Haec4BbeKmP
+
+aeJj"iNA$iL1d#Y1J+HR89#QQrG%86l98l[LLFhLNlhad)NaL2JK&0pZFr-d1m4!
+
++XYS)fcSm[diTeKAC%-A8h"M6e)5Fp+AHXD3p1ZNm1FY%rabj$[`E!$0bi`E$P26
+
+rG@!p"$aQr-JXH*CjLX,-Um9UPGj1-5VH)fY@`*(4VHaDSf,&r6CPrlq&--R1K6X
+
+*#r!9a`Q#"HZ@0$hdcLR&Z$Fm-LN%a%6I)NG'j`NF&EkCY9`(CaX9iFL4(fpK!IC
+
+B8#c-*P,XP1dG-@D4KE%@0XR#9"C'PcdhhF,ZXE"3#eYVB3-&a[CDHNU"FB-@YXI
+
+#PPJD!bcX5f0T(aH0)DaV'hR-C-M0+Q[Uq``!Da0l'f3fmMSr"jhCCQZ%N3NRNdf
+
+14LJRP"rPR[a@3Sqr%8D1NjAJmk5Hp2#G-Ic6Le"1MJm)Pachb(2###I(6c*J%8k
+
+j%8k1RiHRj,J46[K*+$P11$P11"P3`JNrmS`-q)!-Z'6!D6eKj2L4C`f-F$+J`(8
+
+Q"D$m9QE4e,T1r"&qK,q%%k6J#3FQ+c!qS%%HJ+LU#N)S",rE%'S`i2Fjq"D$ha,
+
+iI4qf+2P[K53BJQi)Q['&0I#IjBQL)Y4CP"42pjcUHm,'ZSf'8'HBF--Ck@qdLS0
+
+b3K-d'HXH'L*+S#ZS9C93Dp(hThY##E32SH*'Y!@KRP2p0@MV!TJ"6QM*DZUi,'%
+
+T+JeJ!r"$PM03TD!SBLUKM%E&Qd60d0-c)3Z*mVDqK3&9&I13!!6eTfr[iUM&P'Y
+
+#%F4446G@Z(l(88YXe)LB`Z+S2TE@Pf(0!mTp(,A84Uf3!",*H&STD'4qmZcc(,@
+
+-+M3XC`4&IJbl#Phql%Z1'UCF8eL3!,#@e`G3hrdd`e(,+GHd)+EL%XlQBDHLAlh
+
+-85ZSm`B%mB'K&HG0PBjFj+L90QTjHXf`jUXI6h28L)eDPKBdpblBE[Mm*BjDaA6
+
+94Z1DiGV"R*4rj+M9$PGCAcdSS+ZfQD2@8+iCI$4qqhSpdmj4DkPIeF4)2#fiaJ2
+
+8Bbpbe(889F1L)XMT!QVVKFXFYBiUT"YMLB5UC9b&(RhKCikkRVV"`)8VDEQKZf-
+
+V4kfRA)f*V,4kp-cqUedFGB0c+Hf-8Y$eQ[B"4pe)Vc*,6IQVI%eEm0!QHSG8IIA
+
+L@5lrN!#MEUCQhhrr8(p,Ec3@kie#4,V"pIbK)a`9-T!!GBlk-`E@KJ84,f%LG'i
+
+f[T!!!'KLUKNie$XiPM(N0&lQH[KU'dGYS"j+L['X*Sp(8hPGSl0R1'UMM9U5&&e
+
+!'c8b%qDSN!"L,3rTKL6Ki3+b'A[l2CZI0G[Y06`a,LMk#PhcpFQ(1'S6pDZSCSE
+
+PC!&fUR[r&Uj3-eASS(Td!+F,U1H1r2)8jpT#83&5e5EZS1kBGej+JZb9Kc82h(-
+
+h9kKehN1+R,MPS8ZFDjZpPPPABF@aCZbG`abeRA(9j-b+KmcBG!p(lD"q"B9NGG@
+
+[CimeFp5G$PGXM+5cUec0YcMUVRN2@9(2pG$Xii2F3jhf'KR%ZMUQL6M[[CaIGcX
+
++b8Q)f,HFGj+MGP'Z-8d&S[SrA2I32!5k3L5#cQ1CV4NkAXjer4pehS"JT*BMJmh
+
+eq+jHMVUAFXdD@Pa-LB8NHQRI3K)PI3p-0D6jHqhb!-,0lkJIrAq#kpTYIkZh1S$
+
+iJj!!%H0,"hSUqR8TjiTU6d$LH!3qd"l'QVp5(*Z0MQj%N5IR8$IK#2YVk#b4%AU
+
+KAhRjVG*[D*cA0T*HB1mJp`hf9R+*B@mR9a,f0R*MBGp1mJVX655"`0j)XK,X1mL
+
+pKlf"*+irG2*l,$B1E[#"6T2S$,#X@[56ejba+FlV&"bJcm2dMZ6dm6Xk0U4jAES
+
+MHGhp&Sp0DH#"lZkGmrT#0Q@"!rVX)TRXhr[K0j4X`S%(2RS$[3RXDKCpj(@KE-T
+
+cqZ`NL6E3i"kI4160319LE["D@$B9G'mQ#4Ai1,Ued1qGG(GeFr6blT!!hqqbU3a
+
+-b$&jRrZ0-TY)B)&1lYedll[ACE1T#Rl`e9TlcUBkTp0ZdVF%-H4Z[lGR8a1Bi#X
+
+h0hN["GM8"KlNTJYSfQ*jrHjlI6UE66PpZQMZ#'l`[pH@XGNEQ*!!Qr-kq@mqf+`
+
+,HVK6rLX60R@""hI+c5IHHaBfk`-2I,5(G,jrpK(H5aSfpB%(pqQkANlrj[4mV#G
+
+EHm2$CN01V`9H%R"aqMR+bhpj`iDqe%&p8bAIR!qTj%[4$kpFY(MK'lcmYcPXk&Z
+
+H1lcmlTi0lIT[mPVbJIFUL!elGjRM4BM8c8"+#$@"@kr%qK5GrJGH8d5JeDSp%6Z
+
+S`aY94TZmpLQ+$H(Nh"cl%r`RK-KrL#Vr!3#3!aq$!!!"!*!$!43!N!-8!*!$-Tr
+
+lRLe!rr#`!,K[$#eZd!6rm2rdd"lm`FAKdkSV8FY+$deKBe"bEfTPBh4c,R0TG!)
+
+!N!06594%8dP8)3#3"P0*9%46593K!*!BUc!jI3!!8M8!!!&'"1"2l'mDG@6JrHc
+
+K@5U#NI*HN@GK!Z"2kQ`FG&2UN!"S!!,L@5[48(adA`CdC!EJ6qj[8hJS!!EJEHl
+
+LEe5!)D$!FJC1ANl!*IrX51FI-#D`jL63G!*&0K!+1Li!&Ri!)VX-S"lbUKQJ(Z`
+
+3!+SDI!$!#3ZT8,aIE!!!Q$!'8!6"aG!!N!-3!#X!"3%B!J#3"`-!N!-"!*!$!43
+
+!N!-8!*!$-J$j(l!@#J#3!a`!-J!!8f9dC`#3!`S!!2rr!*!&q@G%'@B:
+
--- /dev/null
+/*
+ MacOS_Test_config.h
+
+ Configuration flags for Macintosh development systems.
+
+ Test version.
+
+ <Revision History>
+
+ 11/16/95 pcb Updated compilation flags to reflect latest 4.6 Makefile.
+
+ by Patrick C. Beard.
+ */
+/* Boehm, November 17, 1995 12:05 pm PST */
+
+#ifdef __MWERKS__
+
+// for CodeWarrior Pro with Metrowerks Standard Library (MSL).
+// #define MSL_USE_PRECOMPILED_HEADERS 0
+#include <ansi_prefix.mac.h>
+#ifndef __STDC__
+#define __STDC__ 0
+#endif
+
+#endif
+
+// these are defined again in gc_priv.h.
+#undef TRUE
+#undef FALSE
+
+#define ALL_INTERIOR_POINTERS // follows interior pointers.
+//#define SILENT // want collection messages.
+//#define DONT_ADD_BYTE_AT_END // no padding.
+//#define SMALL_CONFIG // whether to a smaller heap.
+#define NO_SIGNALS // signals aren't real on the Macintosh.
+#define USE_TEMPORARY_MEMORY // use Macintosh temporary memory.
+
+// CFLAGS= -O -DNO_SIGNALS -DALL_INTERIOR_POINTERS -DSILENT
+//
+//LIBGC_CFLAGS= -O -DNO_SIGNALS -DSILENT \
+// -DREDIRECT_MALLOC=GC_malloc_uncollectable \
+// -DDONT_ADD_BYTE_AT_END -DALL_INTERIOR_POINTERS
+// Flags for building libgc.a -- the last two are required.
+//
+// Setjmp_test may yield overly optimistic results when compiled
+// without optimization.
+// -DSILENT disables statistics printing, and improves performance.
+// -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+// altered stubborn objects, at substantial performance cost.
+// Use only for incremental collector debugging.
+// -DFIND_LEAK causes the collector to assume that all inaccessible
+// objects should have been explicitly deallocated, and reports exceptions.
+// Finalization and the test program are not usable in this mode.
+// -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+// (Clients should also define SOLARIS_THREADS and then include
+// gc.h before performing thr_ or GC_ operations.)
+// This is broken on nonSPARC machines.
+// -DALL_INTERIOR_POINTERS allows all pointers to the interior
+// of objects to be recognized. (See gc_priv.h for consequences.)
+// -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+// usually causing it to use less space in such situations.
+// Incremental collection no longer works in this case.
+// -DLARGE_CONFIG tunes the collector for unusually large heaps.
+// Necessary for heaps larger than about 500 MB on most machines.
+// Recommended for heaps larger than about 64 MB.
+// -DDONT_ADD_BYTE_AT_END is meaningful only with
+// -DALL_INTERIOR_POINTERS. Normally -DALL_INTERIOR_POINTERS
+// causes all objects to be padded so that pointers just past the end of
+// an object can be recognized. This can be expensive. (The padding
+// is normally more than one byte due to alignment constraints.)
+// -DDONT_ADD_BYTE_AT_END disables the padding.
+// -DNO_SIGNALS does not disable signals during critical parts of
+// the GC process. This is no less correct than many malloc
+// implementations, and it sometimes has a significant performance
+// impact. However, it is dangerous for many not-quite-ANSI C
+// programs that call things like printf in asynchronous signal handlers.
+// -DGC_OPERATOR_NEW_ARRAY declares that the C++ compiler supports the
+// new syntax "operator new[]" for allocating and deleting arrays.
+// See gc_cpp.h for details. No effect on the C part of the collector.
+// This is defined implicitly in a few environments.
+// -DREDIRECT_MALLOC=X causes malloc, realloc, and free to be defined
+// as aliases for X, GC_realloc, and GC_free, respectively.
+// Calloc is redefined in terms of the new malloc. X should
+// be either GC_malloc or GC_malloc_uncollectable.
+// The former is occasionally useful for working around leaks in code
+// you don't want to (or can't) look at. It may not work for
+// existing code, but it often does. Neither works on all platforms,
+// since some ports use malloc or calloc to obtain system memory.
+// (Probably works for UNIX, and win32.)
+// -DNO_DEBUG removes GC_dump and the debugging routines it calls.
+// Reduces code size slightly at the expense of debuggability.
--- /dev/null
+/*
+ MacOS_config.h
+
+ Configuration flags for Macintosh development systems.
+
+ <Revision History>
+
+ 11/16/95 pcb Updated compilation flags to reflect latest 4.6 Makefile.
+
+ by Patrick C. Beard.
+ */
+/* Boehm, November 17, 1995 12:10 pm PST */
+
+#ifdef __MWERKS__
+
+// for CodeWarrior Pro with Metrowerks Standard Library (MSL).
+// #define MSL_USE_PRECOMPILED_HEADERS 0
+#include <ansi_prefix.mac.h>
+#ifndef __STDC__
+#define __STDC__ 0
+#endif
+
+#endif /* __MWERKS__ */
+
+// these are defined again in gc_priv.h.
+#undef TRUE
+#undef FALSE
+
+#define ALL_INTERIOR_POINTERS // follows interior pointers.
+#define SILENT // no collection messages.
+//#define DONT_ADD_BYTE_AT_END // no padding.
+//#define SMALL_CONFIG // whether to use a smaller heap.
+#define NO_SIGNALS // signals aren't real on the Macintosh.
+#define USE_TEMPORARY_MEMORY // use Macintosh temporary memory.
+
+// CFLAGS= -O -DNO_SIGNALS -DSILENT -DALL_INTERIOR_POINTERS
+//
+//LIBGC_CFLAGS= -O -DNO_SIGNALS -DSILENT \
+// -DREDIRECT_MALLOC=GC_malloc_uncollectable \
+// -DDONT_ADD_BYTE_AT_END -DALL_INTERIOR_POINTERS
+// Flags for building libgc.a -- the last two are required.
+//
+// Setjmp_test may yield overly optimistic results when compiled
+// without optimization.
+// -DSILENT disables statistics printing, and improves performance.
+// -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+// altered stubborn objects, at substantial performance cost.
+// Use only for incremental collector debugging.
+// -DFIND_LEAK causes the collector to assume that all inaccessible
+// objects should have been explicitly deallocated, and reports exceptions.
+// Finalization and the test program are not usable in this mode.
+// -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+// (Clients should also define SOLARIS_THREADS and then include
+// gc.h before performing thr_ or GC_ operations.)
+// This is broken on nonSPARC machines.
+// -DALL_INTERIOR_POINTERS allows all pointers to the interior
+// of objects to be recognized. (See gc_priv.h for consequences.)
+// -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+// usually causing it to use less space in such situations.
+// Incremental collection no longer works in this case.
+// -DLARGE_CONFIG tunes the collector for unusually large heaps.
+// Necessary for heaps larger than about 500 MB on most machines.
+// Recommended for heaps larger than about 64 MB.
+// -DDONT_ADD_BYTE_AT_END is meaningful only with
+// -DALL_INTERIOR_POINTERS. Normally -DALL_INTERIOR_POINTERS
+// causes all objects to be padded so that pointers just past the end of
+// an object can be recognized. This can be expensive. (The padding
+// is normally more than one byte due to alignment constraints.)
+// -DDONT_ADD_BYTE_AT_END disables the padding.
+// -DNO_SIGNALS does not disable signals during critical parts of
+// the GC process. This is no less correct than many malloc
+// implementations, and it sometimes has a significant performance
+// impact. However, it is dangerous for many not-quite-ANSI C
+// programs that call things like printf in asynchronous signal handlers.
+// -DGC_OPERATOR_NEW_ARRAY declares that the C++ compiler supports the
+// new syntax "operator new[]" for allocating and deleting arrays.
+// See gc_cpp.h for details. No effect on the C part of the collector.
+// This is defined implicitly in a few environments.
+// -DREDIRECT_MALLOC=X causes malloc, realloc, and free to be defined
+// as aliases for X, GC_realloc, and GC_free, respectively.
+// Calloc is redefined in terms of the new malloc. X should
+// be either GC_malloc or GC_malloc_uncollectable.
+// The former is occasionally useful for working around leaks in code
+// you don't want to (or can't) look at. It may not work for
+// existing code, but it often does. Neither works on all platforms,
+// since some ports use malloc or calloc to obtain system memory.
+// (Probably works for UNIX, and win32.)
+// -DNO_DEBUG removes GC_dump and the debugging routines it calls.
+// Reduces code size slightly at the expense of debuggability.
--- /dev/null
+/*
+ dataend.c
+
+ A hack to get the extent of global data for the Macintosh.
+
+ by Patrick C. Beard.
+ */
+
+long __dataend;
--- /dev/null
+/*
+ datastart.c
+
+ A hack to get the extent of global data for the Macintosh.
+
+ by Patrick C. Beard.
+ */
+
+long __datastart;
--- /dev/null
+# This is the original manually generated Makefile. It may still be used
+# to build the collector.
+#
+# Primary targets:
+# gc.a - builds basic library
+# c++ - adds C++ interface to library
+# cords - adds cords (heavyweight strings) to library
+# test - prints porting information, then builds basic version of gc.a,
+# and runs some tests of collector and cords. Does not add cords or
+# c++ interface to gc.a
+# cord/de - builds dumb editor based on cords.
+ABI_FLAG=
+# ABI_FLAG should be the cc flag that specifies the ABI. On most
+# platforms this will be the empty string. Possible values:
+# +DD64 for 64-bit executable on HP/UX.
+# -n32, -n64, -o32 for SGI/MIPS ABIs.
+
+AS_ABI_FLAG=$(ABI_FLAG)
+# ABI flag for assembler. On HP/UX this is +A64 for 64 bit
+# executables.
+
+CC=cc $(ABI_FLAG)
+CXX=g++ $(ABI_FLAG)
+AS=as $(AS_ABI_FLAG)
+# The above doesn't work with gas, which doesn't run cpp.
+# Define AS as `gcc -c -x assembler-with-cpp' instead.
+
+# Redefining srcdir allows object code for the nonPCR version of the collector
+# to be generated in different directories.
+srcdir= .
+VPATH= $(srcdir)
+
+CFLAGS= -O -I$(srcdir)/include -DATOMIC_UNCOLLECTABLE -DNO_SIGNALS -DNO_EXECUTE_PERMISSION -DSILENT -DALL_INTERIOR_POINTERS
+
+# To build the parallel collector on Linux, add to the above:
+# -DGC_LINUX_THREADS -DPARALLEL_MARK -DTHREAD_LOCAL_ALLOC
+# To build the parallel collector in a static library on HP/UX,
+# add to the above:
+# -DGC_HPUX_THREADS -DPARALLEL_MARK -DTHREAD_LOCAL_ALLOC -DUSE_HPUX_TLS -D_POSIX_C_SOURCE=199506L
+# To build the thread-safe collector on Tru64, add to the above:
+# -pthread -DGC_OSF1_THREADS
+
+# HOSTCC and HOSTCFLAGS are used to build executables that will be run as
+# part of the build process, i.e. on the build machine. These will usually
+# be the same as CC and CFLAGS, except in a cross-compilation environment.
+# Note that HOSTCFLAGS should include any -D flags that affect thread support.
+HOSTCC=$(CC)
+HOSTCFLAGS=$(CFLAGS)
+
+# For dynamic library builds, it may be necessary to add flags to generate
+# PIC code, e.g. -fPIC on Linux.
+
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+
+# These define arguments influence the collector configuration:
+# -DSILENT disables statistics printing, and improves performance.
+# -DFIND_LEAK causes GC_find_leak to be initially set.
+# This causes the collector to assume that all inaccessible
+# objects should have been explicitly deallocated, and reports exceptions.
+# Finalization and the test program are not usable in this mode.
+# -DGC_SOLARIS_THREADS enables support for Solaris (thr_) threads.
+# (Clients should also define GC_SOLARIS_THREADS and then include
+# gc.h before performing thr_ or dl* or GC_ operations.)
+# Must also define -D_REENTRANT.
+# -DGC_SOLARIS_PTHREADS enables support for Solaris pthreads.
+# (Internally this define GC_SOLARIS_THREADS as well.)
+# -DGC_IRIX_THREADS enables support for Irix pthreads. See README.irix.
+# -DGC_HPUX_THREADS enables support for HP/UX 11 pthreads.
+# Also requires -D_REENTRANT or -D_POSIX_C_SOURCE=199506L. See README.hp.
+# -DGC_LINUX_THREADS enables support for Xavier Leroy's Linux threads.
+# see README.linux. -D_REENTRANT may also be required.
+# -DGC_OSF1_THREADS enables support for Tru64 pthreads. Untested.
+# -DGC_FREEBSD_THREADS enables support for FreeBSD pthreads. Untested.
+# Appeared to run into some underlying thread problems.
+# -DGC_MACOSX_THREADS enables support for Mac OS X pthreads. Untested.
+# -DGC_DGUX386_THREADS enables support for DB/UX on I386 threads.
+# See README.DGUX386.
+# -DGC_THREADS should set the appropriate one of the above macros.
+# It assumes pthreads for Solaris.
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+# of objects to be recognized. (See gc_priv.h for consequences.)
+# Alternatively, GC_all_interior_pointers can be set at process
+# initialization time.
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+# usually causing it to use less space in such situations.
+# Incremental collection no longer works in this case.
+# -DLARGE_CONFIG tunes the collector for unusually large heaps.
+# Necessary for heaps larger than about 500 MB on most machines.
+# Recommended for heaps larger than about 64 MB.
+# -DDONT_ADD_BYTE_AT_END is meaningful only with -DALL_INTERIOR_POINTERS or
+# GC_all_interior_pointers = 1. Normally -DALL_INTERIOR_POINTERS
+# causes all objects to be padded so that pointers just past the end of
+# an object can be recognized. This can be expensive. (The padding
+# is normally more than one byte due to alignment constraints.)
+# -DDONT_ADD_BYTE_AT_END disables the padding.
+# -DNO_SIGNALS does not disable signals during critical parts of
+# the GC process. This is no less correct than many malloc
+# implementations, and it sometimes has a significant performance
+# impact. However, it is dangerous for many not-quite-ANSI C
+# programs that call things like printf in asynchronous signal handlers.
+# This is on by default. Turning it off has not been extensively tested with
+# compilers that reorder stores. It should have been.
+# -DNO_EXECUTE_PERMISSION may cause some or all of the heap to not
+# have execute permission, i.e. it may be impossible to execute
+# code from the heap. Currently this only affects the incremental
+# collector on UNIX machines. It may greatly improve its performance,
+# since this may avoid some expensive cache synchronization.
+# -DGC_NO_OPERATOR_NEW_ARRAY declares that the C++ compiler does not support
+# the new syntax "operator new[]" for allocating and deleting arrays.
+# See gc_cpp.h for details. No effect on the C part of the collector.
+# This is defined implicitly in a few environments. Must also be defined
+# by clients that use gc_cpp.h.
+# -DREDIRECT_MALLOC=X causes malloc to be defined as alias for X.
+# Unless the following macros are defined, realloc is also redirected
+# to GC_realloc, and free is redirected to GC_free.
+# Calloc and strdup are redefined in terms of the new malloc. X should
+# be either GC_malloc or GC_malloc_uncollectable, or
+# GC_debug_malloc_replacement. (The latter invokes GC_debug_malloc
+# with dummy source location information, but still results in
+# properly remembered call stacks on Linux/X86 and Solaris/SPARC.
+# It requires that the following two macros also be used.)
+# The former is occasionally useful for working around leaks in code
+# you don't want to (or can't) look at. It may not work for
+# existing code, but it often does. Neither works on all platforms,
+# since some ports use malloc or calloc to obtain system memory.
+# (Probably works for UNIX, and win32.) If you build with DBG_HDRS_ALL,
+# you should only use GC_debug_malloc_replacement as a malloc
+# replacement.
+# -DREDIRECT_REALLOC=X causes GC_realloc to be redirected to X.
+# The canonical use is -DREDIRECT_REALLOC=GC_debug_realloc_replacement,
+# together with -DREDIRECT_MALLOC=GC_debug_malloc_replacement to
+# generate leak reports with call stacks for both malloc and realloc.
+# This also requires the following:
+# -DREDIRECT_FREE=X causes free to be redirected to X. The
+# canonical use is -DREDIRECT_FREE=GC_debug_free.
+# -DIGNORE_FREE turns calls to free into a noop. Only useful with
+# -DREDIRECT_MALLOC.
+# -DNO_DEBUGGING removes GC_dump and the debugging routines it calls.
+# Reduces code size slightly at the expense of debuggability.
+# -DJAVA_FINALIZATION makes it somewhat safer to finalize objects out of
+# order by specifying a nonstandard finalization mark procedure (see
+# finalize.c). Objects reachable from finalizable objects will be marked
+# in a sepearte postpass, and hence their memory won't be reclaimed.
+# Not recommended unless you are implementing a language that specifies
+# these semantics. Since 5.0, determines only only the initial value
+# of GC_java_finalization variable.
+# -DFINALIZE_ON_DEMAND causes finalizers to be run only in response
+# to explicit GC_invoke_finalizers() calls.
+# In 5.0 this became runtime adjustable, and this only determines the
+# initial value of GC_finalize_on_demand.
+# -DATOMIC_UNCOLLECTABLE includes code for GC_malloc_atomic_uncollectable.
+# This is useful if either the vendor malloc implementation is poor,
+# or if REDIRECT_MALLOC is used.
+# -DHBLKSIZE=ddd, where ddd is a power of 2 between 512 and 16384, explicitly
+# sets the heap block size. Each heap block is devoted to a single size and
+# kind of object. For the incremental collector it makes sense to match
+# the most likely page size. Otherwise large values result in more
+# fragmentation, but generally better performance for large heaps.
+# -DUSE_MMAP use MMAP instead of sbrk to get new memory.
+# Works for Solaris and Irix.
+# -DUSE_MUNMAP causes memory to be returned to the OS under the right
+# circumstances. This currently disables VM-based incremental collection.
+# This is currently experimental, and works only under some Unix,
+# Linux and Windows versions.
+# -DMMAP_STACKS (for Solaris threads) Use mmap from /dev/zero rather than
+# GC_scratch_alloc() to get stack memory.
+# -DPRINT_BLACK_LIST Whenever a black list entry is added, i.e. whenever
+# the garbage collector detects a value that looks almost, but not quite,
+# like a pointer, print both the address containing the value, and the
+# value of the near-bogus-pointer. Can be used to identifiy regions of
+# memory that are likely to contribute misidentified pointers.
+# -DKEEP_BACK_PTRS Add code to save back pointers in debugging headers
+# for objects allocated with the debugging allocator. If all objects
+# through GC_MALLOC with GC_DEBUG defined, this allows the client
+# to determine how particular or randomly chosen objects are reachable
+# for debugging/profiling purposes. The gc_backptr.h interface is
+# implemented only if this is defined.
+# -DGC_ASSERTIONS Enable some internal GC assertion checking. Currently
+# this facility is only used in a few places. It is intended primarily
+# for debugging of the garbage collector itself, but could also
+# -DDBG_HDRS_ALL Make sure that all objects have debug headers. Increases
+# the reliability (from 99.9999% to 100%) of some of the debugging
+# code (especially KEEP_BACK_PTRS). Makes -DSHORT_DBG_HDRS possible.
+# Assumes that all client allocation is done through debugging
+# allocators.
+# -DSHORT_DBG_HDRS Assume that all objects have debug headers. Shorten
+# the headers to minimize object size, at the expense of checking for
+# writes past the end of an object. This is intended for environments
+# in which most client code is written in a "safe" language, such as
+# Scheme or Java. Assumes that all client allocation is done using
+# the GC_debug_ functions, or through the macros that expand to these,
+# or by redirecting malloc to GC_debug_malloc_replacement.
+# (Also eliminates the field for the requested object size.)
+# occasionally be useful for debugging of client code. Slows down the
+# collector somewhat, but not drastically.
+# -DSAVE_CALL_COUNT=<n> Set the number of call frames saved with objects
+# allocated through the debugging interface. Affects the amount of
+# information generated in leak reports. Only matters on platforms
+# on which we can quickly generate call stacks, currently Linux/(X86 & SPARC)
+# and Solaris/SPARC and platforms that provide execinfo.h.
+# Default is zero. On X86, client
+# code should NOT be compiled with -fomit-frame-pointer.
+# -DSAVE_CALL_NARGS=<n> Set the number of functions arguments to be
+# saved with each call frame. Default is zero. Ignored if we
+# don't know how to retrieve arguments on the platform.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+# altered stubborn objects, at substantial performance cost.
+# Use only for debugging of the incremental collector.
+# -DGC_GCJ_SUPPORT includes support for gcj (and possibly other systems
+# that include a pointer to a type descriptor in each allocated object).
+# Building this way requires an ANSI C compiler.
+# -DUSE_I686_PREFETCH causes the collector to issue Pentium III style
+# prefetch instructions. No effect except on X86 Linux platforms.
+# Assumes a very recent gcc-compatible compiler and assembler.
+# (Gas prefetcht0 support was added around May 1999.)
+# Empirically the code appears to still run correctly on Pentium II
+# processors, though with no performance benefit. May not run on other
+# X86 processors? In some cases this improves performance by
+# 15% or so.
+# -DUSE_3DNOW_PREFETCH causes the collector to issue AMD 3DNow style
+# prefetch instructions. Same restrictions as USE_I686_PREFETCH.
+# Minimally tested. Didn't appear to be an obvious win on a K6-2/500.
+# -DUSE_PPC_PREFETCH causes the collector to issue PowerPC style
+# prefetch instructions. No effect except on PowerPC OS X platforms.
+# Performance impact untested.
+# -DGC_USE_LD_WRAP in combination with the old flags listed in README.linux
+# causes the collector some system and pthread calls in a more transparent
+# fashion than the usual macro-based approach. Requires GNU ld, and
+# currently probably works only with Linux.
+# -DTHREAD_LOCAL_ALLOC defines GC_local_malloc(), GC_local_malloc_atomic()
+# and GC_local_gcj_malloc(). Needed for gc_gcj.h interface. These allocate
+# in a way that usually does not involve acquisition of a global lock.
+# Currently requires -DGC_LINUX_THREADS, but should be easy to port to
+# other pthreads environments. Recommended for multiprocessors.
+# -DPARALLEL_MARK allows the marker to run in multiple threads. Recommended
+# for multiprocessors. Currently requires Linux on X86 or IA64, though
+# support for other Posix platforms should be fairly easy to add,
+# if the thread implementation is otherwise supported.
+# -DNO_GETENV prevents the collector from looking at environment variables.
+# These may otherwise alter its configuration, or turn off GC altogether.
+# I don't know of a reason to disable this, except possibly if the
+# resulting process runs as a privileged user?
+# -DUSE_GLOBAL_ALLOC. Win32 only. Use GlobalAlloc instead of
+# VirtualAlloc to allocate the heap. May be needed to work around
+# a Windows NT/2000 issue. Incompatible with USE_MUNMAP.
+# See README.win32 for details.
+# -DMAKE_BACK_GRAPH. Enable GC_PRINT_BACK_HEIGHT environment variable.
+# See README.environment for details. Experimental. Limited platform
+# support. Implies DBG_HDRS_ALL. All allocation should be done using
+# the debug interface.
+# -DSTUBBORN_ALLOC allows allocation of "hard to change" objects, and thus
+# makes incremental collection easier. Was enabled by default until 6.0.
+# Rarely used, to my knowledge.
+# -DHANDLE_FORK attempts to make GC_malloc() work in a child process fork()ed
+# from a multithreaded parent. Currently only supported by linux_threads.c.
+# (Similar code should work on Solaris or Irix, but it hasn't been tried.)
+# -DTEST_WITH_SYSTEM_MALLOC causes gctest to allocate (and leak) large chunks
+# of memory with the standard system malloc. This will cause the root
+# set and collected heap to grow significantly if malloced memory is
+# somehow getting traced by the collector. This has no impact on the
+# generated library; it only affects the test.
+# -DPOINTER_MASK=0x... causes candidate pointers to be ANDed with the
+# given mask before being considered. If either this or the following
+# macro is defined, it will be assumed that all pointers stored in
+# the heap need to be processed this way. Stack and register pointers
+# will be considered both with and without processing.
+# These macros are normally needed only to support systems that use
+# high-order pointer tags. EXPERIMENTAL.
+# -DPOINTER_SHIFT=n causes the collector to left shift candidate pointers
+# by the indicated amount before trying to interpret them. Applied
+# after POINTER_MASK. EXPERIMENTAL. See also the preceding macro.
+#
+
+CXXFLAGS= $(CFLAGS)
+AR= ar
+RANLIB= ranlib
+
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o irix_threads.o linux_threads.o typd_mlc.o ptr_chck.o mallocx.o solaris_pthreads.o gcj_mlc.o specific.o gc_dlopen.o backgraph.o
+
+CSRCS= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c irix_threads.c linux_threads.c typd_mlc.c ptr_chck.c mallocx.c solaris_pthreads.c gcj_mlc.c specific.c gc_dlopen.c backgraph.c
+
+CORD_SRCS= cord/cordbscs.c cord/cordxtra.c cord/cordprnt.c cord/de.c cord/cordtest.c include/cord.h include/ec.h include/private/cord_pos.h cord/de_win.c cord/de_win.h cord/de_cmds.h cord/de_win.ICO cord/de_win.RC
+
+CORD_OBJS= cord/cordbscs.o cord/cordxtra.o cord/cordprnt.o
+
+SRCS= $(CSRCS) mips_sgi_mach_dep.S rs6000_mach_dep.s alpha_mach_dep.S \
+ sparc_mach_dep.S include/gc.h include/gc_typed.h \
+ include/private/gc_hdrs.h include/private/gc_priv.h \
+ include/private/gcconfig.h include/private/gc_pmark.h \
+ include/gc_inl.h include/gc_inline.h include/gc_mark.h \
+ threadlibs.c if_mach.c if_not_there.c gc_cpp.cc include/gc_cpp.h \
+ gcname.c include/weakpointer.h include/private/gc_locks.h \
+ gcc_support.c mips_ultrix_mach_dep.s include/gc_alloc.h \
+ include/new_gc_alloc.h include/gc_allocator.h \
+ include/javaxfc.h sparc_sunos4_mach_dep.s sparc_netbsd_mach_dep.s \
+ include/private/solaris_threads.h include/gc_backptr.h \
+ hpux_test_and_clear.s include/gc_gcj.h \
+ include/gc_local_alloc.h include/private/dbg_mlc.h \
+ include/private/specific.h powerpc_macosx_mach_dep.s \
+ include/leak_detector.h include/gc_amiga_redirects.h \
+ include/gc_pthread_redirects.h ia64_save_regs_in_stack.s \
+ include/gc_config_macros.h $(CORD_SRCS)
+
+DOC_FILES= README.QUICK doc/README.Mac doc/README.MacOSX doc/README.OS2 \
+ doc/README.amiga doc/README.cords doc/debugging.html \
+ doc/README.dj doc/README.hp doc/README.linux doc/README.rs6000 \
+ doc/README.sgi doc/README.solaris2 doc/README.uts \
+ doc/README.win32 doc/barrett_diagram doc/README \
+ doc/README.contributors doc/README.changes doc/gc.man \
+ doc/README.environment doc/tree.html doc/gcdescr.html \
+ doc/README.autoconf doc/README.macros doc/README.ews4800 \
+ doc/README.DGUX386 doc/README.arm.cross doc/leak.html \
+ doc/scale.html doc/gcinterface.html
+
+TESTS= tests/test.c tests/test_cpp.cc tests/trace_test.c \
+ tests/leak_test.c tests/thread_leak_test.c
+
+GNU_BUILD_FILES= configure.in Makefile.am configure acinclude.m4 \
+ libtool.m4 install-sh configure.host Makefile.in \
+ ltconfig aclocal.m4 config.sub config.guess \
+ include/Makefile.am include/Makefile.in \
+ doc/Makefile.am doc/Makefile.in \
+ ltmain.sh mkinstalldirs depcomp missing
+
+OTHER_MAKEFILES= OS2_MAKEFILE NT_MAKEFILE NT_THREADS_MAKEFILE gc.mak \
+ BCC_MAKEFILE EMX_MAKEFILE WCC_MAKEFILE Makefile.dj \
+ PCR-Makefile SMakefile.amiga Makefile.DLLs \
+ digimars.mak Makefile.direct
+# Makefile and Makefile.direct are copies of each other.
+
+OTHER_FILES= Makefile setjmp_t.c callprocs pc_excludes \
+ MacProjects.sit.hqx MacOS.c \
+ Mac_files/datastart.c Mac_files/dataend.c \
+ Mac_files/MacOS_config.h Mac_files/MacOS_Test_config.h \
+ add_gc_prefix.c gc_cpp.cpp win32_threads.c \
+ version.h AmigaOS.c \
+ $(TESTS) $(GNU_BUILD_FILES) $(OTHER_MAKEFILES)
+
+CORD_INCLUDE_FILES= $(srcdir)/include/gc.h $(srcdir)/include/cord.h \
+ $(srcdir)/include/ec.h $(srcdir)/include/private/cord_pos.h
+
+UTILS= if_mach if_not_there threadlibs
+
+# Libraries needed for curses applications. Only needed for de.
+CURSES= -lcurses -ltermlib
+
+# The following is irrelevant on most systems. But a few
+# versions of make otherwise fork the shell specified in
+# the SHELL environment variable.
+SHELL= /bin/sh
+
+SPECIALCFLAGS = -I$(srcdir)/include
+# Alternative flags to the C compiler for mach_dep.c.
+# Mach_dep.c often doesn't like optimization, and it's
+# not time-critical anyway.
+# Set SPECIALCFLAGS to -q nodirect_code on Encore.
+
+all: gc.a gctest
+
+BSD-pkg-all: bsd-libgc.a
+
+bsd-libgc.a:
+ $(MAKE) CFLAGS="$(CFLAGS)" clean c++-t
+ mv gc.a bsd-libgc.a
+
+BSD-pkg-install: BSD-pkg-all
+ ${CP} bsd-libgc.a libgc.a
+ ${INSTALL_DATA} libgc.a ${PREFIX}/lib
+ ${INSTALL_DATA} gc.h gc_cpp.h ${PREFIX}/include
+
+pcr: PCR-Makefile include/private/gc_private.h include/private/gc_hdrs.h \
+include/private/gc_locks.h include/gc.h include/private/gcconfig.h \
+mach_dep.o $(SRCS)
+ $(MAKE) -f PCR-Makefile depend
+ $(MAKE) -f PCR-Makefile
+
+$(OBJS) tests/test.o dyn_load.o dyn_load_sunos53.o: \
+ $(srcdir)/include/private/gc_priv.h \
+ $(srcdir)/include/private/gc_hdrs.h $(srcdir)/include/private/gc_locks.h \
+ $(srcdir)/include/gc.h $(srcdir)/include/gc_pthread_redirects.h \
+ $(srcdir)/include/private/gcconfig.h $(srcdir)/include/gc_typed.h \
+ $(srcdir)/include/gc_config_macros.h Makefile
+# The dependency on Makefile is needed. Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o ptr_chck.o: $(srcdir)/include/gc_mark.h $(srcdir)/include/private/gc_pmark.h
+
+specific.o linux_threads.o: $(srcdir)/include/private/specific.h
+
+solaris_threads.o solaris_pthreads.o: $(srcdir)/include/private/solaris_threads.h
+
+dbg_mlc.o gcj_mlc.o: $(srcdir)/include/private/dbg_mlc.h
+
+tests/test.o: tests $(srcdir)/tests/test.c
+ $(CC) $(CFLAGS) -c $(srcdir)/tests/test.c
+ mv test.o tests/test.o
+
+tests:
+ mkdir tests
+
+base_lib gc.a: $(OBJS) dyn_load.o $(UTILS)
+ echo > base_lib
+ rm -f dont_ar_1
+ ./if_mach SPARC SUNOS5 touch dont_ar_1
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a $(OBJS) dyn_load.o
+ ./if_mach M68K AMIGA touch dont_ar_1
+ ./if_mach M68K AMIGA $(AR) -vrus gc.a $(OBJS) dyn_load.o
+ ./if_not_there dont_ar_1 $(AR) ru gc.a $(OBJS) dyn_load.o
+ ./if_not_there dont_ar_1 $(RANLIB) gc.a || cat /dev/null
+# ignore ranlib failure; that usually means it doesn't exist, and isn't needed
+
+cords: $(CORD_OBJS) cord/cordtest $(UTILS)
+ rm -f dont_ar_3
+ ./if_mach SPARC SUNOS5 touch dont_ar_3
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a $(CORD_OBJS)
+ ./if_mach M68K AMIGA touch dont_ar_3
+ ./if_mach M68K AMIGA $(AR) -vrus gc.a $(CORD_OBJS)
+ ./if_not_there dont_ar_3 $(AR) ru gc.a $(CORD_OBJS)
+ ./if_not_there dont_ar_3 $(RANLIB) gc.a || cat /dev/null
+
+gc_cpp.o: $(srcdir)/gc_cpp.cc $(srcdir)/include/gc_cpp.h $(srcdir)/include/gc.h Makefile
+ $(CXX) -c $(CXXFLAGS) $(srcdir)/gc_cpp.cc
+
+test_cpp: $(srcdir)/tests/test_cpp.cc $(srcdir)/include/gc_cpp.h gc_cpp.o $(srcdir)/include/gc.h \
+base_lib $(UTILS)
+ rm -f test_cpp
+ ./if_mach HP_PA HPUX $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/tests/test_cpp.cc gc_cpp.o gc.a -ldld `./threadlibs`
+ ./if_not_there test_cpp $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/tests/test_cpp.cc gc_cpp.o gc.a `./threadlibs`
+
+c++-t: c++
+ ./test_cpp 1
+
+c++-nt: c++
+ @echo "Use ./test_cpp 1 to test the leak library"
+
+c++: gc_cpp.o $(srcdir)/include/gc_cpp.h test_cpp
+ rm -f dont_ar_4
+ ./if_mach SPARC SUNOS5 touch dont_ar_4
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a gc_cpp.o
+ ./if_mach M68K AMIGA touch dont_ar_4
+ ./if_mach M68K AMIGA $(AR) -vrus gc.a gc_cpp.o
+ ./if_not_there dont_ar_4 $(AR) ru gc.a gc_cpp.o
+ ./if_not_there dont_ar_4 $(RANLIB) gc.a || cat /dev/null
+ ./test_cpp 1
+ echo > c++
+
+dyn_load_sunos53.o: dyn_load.c
+ $(CC) $(CFLAGS) -DSUNOS53_SHARED_LIB -c $(srcdir)/dyn_load.c -o $@
+
+# SunOS5 shared library version of the collector
+sunos5gc.so: $(OBJS) dyn_load_sunos53.o
+ $(CC) -G -o sunos5gc.so $(OBJS) dyn_load_sunos53.o -ldl
+ ln sunos5gc.so libgc.so
+
+# Alpha/OSF shared library version of the collector
+libalphagc.so: $(OBJS)
+ ld -shared -o libalphagc.so $(OBJS) dyn_load.o -lc
+ ln libalphagc.so libgc.so
+
+# IRIX shared library version of the collector
+libirixgc.so: $(OBJS) dyn_load.o
+ ld -shared $(ABI_FLAG) -o libirixgc.so $(OBJS) dyn_load.o -lc
+ ln libirixgc.so libgc.so
+
+# Linux shared library version of the collector
+liblinuxgc.so: $(OBJS) dyn_load.o
+ gcc -shared -o liblinuxgc.so $(OBJS) dyn_load.o
+ ln liblinuxgc.so libgc.so
+
+# Alternative Linux rule. This is preferable, but is likely to break the
+# Makefile for some non-linux platforms.
+# LIBOBJS= $(patsubst %.o, %.lo, $(OBJS))
+#
+#.SUFFIXES: .lo $(SUFFIXES)
+#
+#.c.lo:
+# $(CC) $(CFLAGS) $(CPPFLAGS) -fPIC -c $< -o $@
+#
+# liblinuxgc.so: $(LIBOBJS) dyn_load.lo
+# gcc -shared -Wl,-soname=libgc.so.0 -o libgc.so.0 $(LIBOBJS) dyn_load.lo
+# touch liblinuxgc.so
+
+mach_dep.o: $(srcdir)/mach_dep.c $(srcdir)/mips_sgi_mach_dep.S \
+ $(srcdir)/mips_ultrix_mach_dep.s \
+ $(srcdir)/rs6000_mach_dep.s $(srcdir)/powerpc_macosx_mach_dep.s \
+ $(srcdir)/sparc_mach_dep.S $(srcdir)/sparc_sunos4_mach_dep.s \
+ $(srcdir)/ia64_save_regs_in_stack.s \
+ $(srcdir)/sparc_netbsd_mach_dep.s $(UTILS)
+ rm -f mach_dep.o
+ ./if_mach MIPS IRIX5 $(CC) -E $(srcdir)/mips_sgi_mach_dep.S \
+ | ./if_mach MIPS IRIX5 grep -v "^\#" > $(srcdir)/mips_sgi_mach_dep.s
+ ./if_mach MIPS RISCOS $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+ ./if_mach MIPS ULTRIX $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+ ./if_mach POWERPC MACOSX $(AS) -o mach_dep.o $(srcdir)/powerpc_macosx_mach_dep.s
+ ./if_mach ALPHA LINUX $(CC) -c -o mach_dep.o $(srcdir)/alpha_mach_dep.S
+ ./if_mach SPARC SUNOS5 $(CC) -c -o mach_dep.o $(srcdir)/sparc_mach_dep.S
+ ./if_mach SPARC SUNOS4 $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+ ./if_mach SPARC OPENBSD $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+ ./if_mach SPARC NETBSD $(AS) -o mach_dep.o $(srcdir)/sparc_netbsd_mach_dep.s
+ ./if_mach IA64 "" as $(AS_ABI_FLAG) -o ia64_save_regs_in_stack.o $(srcdir)/ia64_save_regs_in_stack.s
+ ./if_mach IA64 "" $(CC) -c -o mach_dep1.o $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+ ./if_mach IA64 "" ld -r -o mach_dep.o mach_dep1.o ia64_save_regs_in_stack.o
+ ./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+
+mark_rts.o: $(srcdir)/mark_rts.c $(UTILS)
+ rm -f mark_rts.o
+ -./if_mach ALPHA OSF1 $(CC) -c $(CFLAGS) -Wo,-notail $(srcdir)/mark_rts.c
+ ./if_not_there mark_rts.o $(CC) -c $(CFLAGS) $(srcdir)/mark_rts.c
+# Work-around for DEC optimizer tail recursion elimination bug.
+# The ALPHA-specific line should be removed if gcc is used.
+
+alloc.o: version.h
+
+cord:
+ mkdir cord
+
+cord/cordbscs.o: cord $(srcdir)/cord/cordbscs.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordbscs.c
+ mv cordbscs.o cord/cordbscs.o
+# not all compilers understand -o filename
+
+cord/cordxtra.o: cord $(srcdir)/cord/cordxtra.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordxtra.c
+ mv cordxtra.o cord/cordxtra.o
+
+cord/cordprnt.o: cord $(srcdir)/cord/cordprnt.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordprnt.c
+ mv cordprnt.o cord/cordprnt.o
+
+cord/cordtest: $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a $(UTILS)
+ rm -f cord/cordtest
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -lucb
+ ./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -ldld `./threadlibs`
+ ./if_mach M68K AMIGA $(CC) $(CFLAGS) -UGC_AMIGA_MAKINGLIB -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a `./threadlibs`
+ ./if_not_there cord/cordtest $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a `./threadlibs`
+
+cord/de: $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(UTILS)
+ rm -f cord/de
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -lucb `./threadlibs`
+ ./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -ldld `./threadlibs`
+ ./if_mach RS6000 "" $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+ ./if_mach POWERPC MACOSX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a
+ ./if_mach I386 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+ ./if_mach ALPHA LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+ ./if_mach IA64 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+ ./if_mach M68K AMIGA $(CC) $(CFLAGS) -UGC_AMIGA_MAKINGLIB -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+ ./if_not_there cord/de $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) `./threadlibs`
+
+if_mach: $(srcdir)/if_mach.c $(srcdir)/include/private/gcconfig.h
+ $(HOSTCC) $(HOSTCFLAGS) -o if_mach $(srcdir)/if_mach.c
+
+threadlibs: $(srcdir)/threadlibs.c $(srcdir)/include/private/gcconfig.h Makefile
+ $(HOSTCC) $(HOSTCFLAGS) -o threadlibs $(srcdir)/threadlibs.c
+
+if_not_there: $(srcdir)/if_not_there.c
+ $(HOSTCC) $(HOSTCFLAGS) -o if_not_there $(srcdir)/if_not_there.c
+
+clean:
+ rm -f gc.a *.o *.exe tests/*.o gctest gctest_dyn_link test_cpp \
+ setjmp_test mon.out gmon.out a.out core if_not_there if_mach \
+ threadlibs $(CORD_OBJS) cord/cordtest cord/de mips_sgi_mach_dep.s
+ -rm -f *~
+
+gctest: tests/test.o gc.a $(UTILS)
+ rm -f gctest
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o gctest tests/test.o gc.a -lucb
+ ./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o gctest tests/test.o gc.a -ldld `./threadlibs`
+ ./if_mach M68K AMIGA $(CC) $(CFLAGS) -UGC_AMIGA_MAKINGLIB -o gctest tests/test.o gc.a `./threadlibs`
+ ./if_not_there gctest $(CC) $(CFLAGS) -o gctest tests/test.o gc.a `./threadlibs`
+
+# If an optimized setjmp_test generates a segmentation fault,
+# odds are your compiler is broken. Gctest may still work.
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test: $(srcdir)/setjmp_t.c $(srcdir)/include/gc.h $(UTILS)
+ $(CC) $(CFLAGS) -o setjmp_test $(srcdir)/setjmp_t.c
+
+test: KandRtest cord/cordtest
+ cord/cordtest
+
+# Those tests that work even with a K&R C compiler:
+KandRtest: setjmp_test gctest
+ ./setjmp_test
+ ./gctest
+
+add_gc_prefix: $(srcdir)/add_gc_prefix.c $(srcdir)/version.h
+ $(CC) -o add_gc_prefix $(srcdir)/add_gc_prefix.c
+
+gcname: $(srcdir)/gcname.c $(srcdir)/version.h
+ $(CC) -o gcname $(srcdir)/gcname.c
+
+gc.tar: $(SRCS) $(DOC_FILES) $(OTHER_FILES) add_gc_prefix gcname
+ cp Makefile Makefile.old
+ cp Makefile.direct Makefile
+ rm -f `./gcname`
+ ln -s . `./gcname`
+ ./add_gc_prefix $(SRCS) $(DOC_FILES) $(OTHER_FILES) > /tmp/gc.tar-files
+ tar cvfh gc.tar `cat /tmp/gc.tar-files`
+ cp gc.tar `./gcname`.tar
+ gzip `./gcname`.tar
+ rm `./gcname`
+
+pc_gc.tar: $(SRCS) $(OTHER_FILES)
+ tar cvfX pc_gc.tar pc_excludes $(SRCS) $(OTHER_FILES)
+
+floppy: pc_gc.tar
+ -mmd a:/cord
+ -mmd a:/cord/private
+ -mmd a:/include
+ -mmd a:/include/private
+ mkdir /tmp/pc_gc
+ cat pc_gc.tar | (cd /tmp/pc_gc; tar xvf -)
+ -mcopy -tmn /tmp/pc_gc/* a:
+ -mcopy -tmn /tmp/pc_gc/cord/* a:/cord
+ -mcopy -mn /tmp/pc_gc/cord/de_win.ICO a:/cord
+ -mcopy -tmn /tmp/pc_gc/cord/private/* a:/cord/private
+ -mcopy -tmn /tmp/pc_gc/include/* a:/include
+ -mcopy -tmn /tmp/pc_gc/include/private/* a:/include/private
+ rm -r /tmp/pc_gc
+
+gc.tar.Z: gc.tar
+ compress gc.tar
+
+gc.tar.gz: gc.tar
+ gzip gc.tar
+
+lint: $(CSRCS) tests/test.c
+ lint -DLINT $(CSRCS) tests/test.c | egrep -v "possible pointer alignment problem|abort|exit|sbrk|mprotect|syscall|change in ANSI|improper alignment"
+
+# BTL: added to test shared library version of collector.
+# Currently works only under SunOS5. Requires GC_INIT call from statically
+# loaded client code.
+ABSDIR = `pwd`
+gctest_dyn_link: tests/test.o libgc.so
+ $(CC) -L$(ABSDIR) -R$(ABSDIR) -o gctest_dyn_link tests/test.o -lgc -ldl -lthread
+
+gctest_irix_dyn_link: tests/test.o libirixgc.so
+ $(CC) -L$(ABSDIR) -o gctest_irix_dyn_link tests/test.o -lirixgc
+
+# The following appear to be dead, especially since libgc_globals.h
+# is apparently lost.
+test_dll.o: tests/test.c libgc_globals.h
+ $(CC) $(CFLAGS) -DGC_USE_DLL -c tests/test.c -o test_dll.o
+
+test_dll: test_dll.o libgc_dll.a libgc.dll
+ $(CC) test_dll.o -L$(ABSDIR) -lgc_dll -o test_dll
+
+SYM_PREFIX-libgc=GC
+
+# Uncomment the following line to build a GNU win32 DLL
+# include Makefile.DLLs
+
+reserved_namespace: $(SRCS)
+ for file in $(SRCS) tests/test.c tests/test_cpp.cc; do \
+ sed s/GC_/_GC_/g < $$file > tmp; \
+ cp tmp $$file; \
+ done
+
+user_namespace: $(SRCS)
+ for file in $(SRCS) tests/test.c tests/test_cpp.cc; do \
+ sed s/_GC_/GC_/g < $$file > tmp; \
+ cp tmp $$file; \
+ done
--- /dev/null
+#-----------------------------------------------------------------------------#
+
+# Makefile.DLLs, version 0.4.
+
+# Contributed by Fergus Henderson.
+
+# This Makefile contains rules for creating DLLs on Windows using gnu-win32.
+
+#-----------------------------------------------------------------------------#
+
+# This rule creates a `.def' file, which lists the symbols that are exported
+# from the DLL. We use `nm' to get a list of all the exported text (`T')
+# symbols and data symbols -- including uninitialized data (`B'),
+# initialized data (`D'), read-only data (`R'), and common blocks (`C').
+%.def: %.a
+ echo EXPORTS > $@
+ nm $< | grep '^........ [BCDRT] _' | sed 's/[^_]*_//' >> $@
+
+# We need to use macros to access global data:
+# the user of the DLL must refer to `foo' as `(*__imp_foo)'.
+# This rule creates a `_globals.h' file, which contains macros
+# for doing this.
+
+SYM_PREFIX = $(firstword $(SYM_PREFIX-$*) $*)
+DLL_MACRO = $(SYM_PREFIX)_USE_DLL
+IMP_MACRO = $(SYM_PREFIX)_IMP
+GLOBAL_MACRO = $(SYM_PREFIX)_GLOBAL
+
+%_globals.h: %.a
+ echo "/* automatically generated by Makefile.DLLs */" > $@
+ echo "#if defined(__GNUC__) && defined(_WIN32) \\" >> $@
+ echo " && defined($(DLL_MACRO))" >> $@
+ echo "# define $(IMP_MACRO)(name) __imp_##name" >> $@
+ echo "# define $(GLOBAL_MACRO)(name) (*$(IMP_MACRO)(name))" >> $@
+ echo "#else" >> $@
+ echo "# define $(GLOBAL_MACRO)(name) name" >> $@
+ echo "#endif" >> $@
+ echo "" >> $@
+ for sym in `nm $< | grep '^........ [BCDR] _' | sed 's/[^_]*_//'`; do \
+ echo "#define $$sym $(GLOBAL_MACRO)($$sym)" >> $@; \
+ done
+
+# This rule creates the export object file (`foo.exp') which contains the
+# jump table array; this export object file becomes part of the DLL.
+# This rule also creates the import library (`foo_dll.a') which contains small
+# stubs for all the functions exported by the DLL which jump to them via the
+# jump table. Executables that will use the DLL must be linked against this
+# stub library.
+%.exp %_dll.a : %.def
+ dlltool $(DLLTOOLFLAGS) $(DLLTOOLFLAGS-$*) \
+ --def $< \
+ --dllname $*.dll \
+ --output-exp $*.exp \
+ --output-lib $*_dll.a
+
+# The `sed' commands below are to convert DOS-style `C:\foo\bar'
+# pathnames into Unix-style `//c/foo/bar' pathnames.
+CYGWIN32_LIBS = $(shell echo \
+ -L`dirname \`gcc -print-file-name=libgcc.a | \
+ sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
+ -L`dirname \`gcc -print-file-name=libcygwin.a | \
+ sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
+ -L`dirname \`gcc -print-file-name=libkernel32.a | \
+ sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
+ -lgcc -lcygwin -lkernel32 -lgcc)
+
+RELOCATABLE=yes
+
+ifeq "$(strip $(RELOCATABLE))" "yes"
+
+# to create relocatable DLLs, we need to do two passes
+%.dll: %.exp %.a dll_fixup.o dll_init.o
+ $(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll -o $*.base \
+ -e _dll_entry@12 dll_init.o \
+ dll_fixup.o $*.exp $*.a \
+ $(LDLIBS) $(LDLIBS-$*) \
+ $(CYGWIN32_LIBS)
+ $(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll --base-file $*.base -o $@ \
+ -e _dll_entry@12 dll_init.o \
+ dll_fixup.o $*.exp $*.a \
+ $(LDLIBS) $(LDLIBS-$*) \
+ $(CYGWIN32_LIBS)
+ rm -f $*.base
+else
+
+%.dll: %.exp %.a dll_fixup.o dll_init.o
+ $(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll -o $@ \
+ -e _dll_entry@12 dll_init.o \
+ dll_fixup.o $*.exp $*.a \
+ $(LDLIBS) $(LDLIBS-$*) \
+ $(CYGWIN32_LIBS)
+
+endif
+
+# This black magic piece of assembler needs to be linked in in order to
+# properly terminate the list of imported DLLs.
+dll_fixup.s:
+ echo '.section .idata$$3' > dll_fixup.s
+ echo '.long 0,0,0,0, 0,0,0,0' >> dll_fixup.s
+
+# This bit is necessary to provide an initialization function for the DLL.
+dll_init.c:
+ echo '__attribute__((stdcall))' > dll_init.c
+ echo 'int dll_entry(int handle, int reason, void *ptr)' >> dll_init.c
+ echo '{return 1; }' >> dll_init.c
+
+dont_throw_away: dll_fixup.o dll_init.o
--- /dev/null
+# Copyright (c) 1999-2001 by Red Hat, Inc. All rights reserved.
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Original author: Tom Tromey
+# Severely truncated by Hans-J. Boehm
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+
+## Process this file with automake to produce Makefile.in.
+
+## FIXME: `make distcheck' in this directory will not currently work.
+## This is most likely to the explicit flags passed to submakes.
+
+AUTOMAKE_OPTIONS = foreign
+
+SUBDIRS = doc include
+
+EXTRA_DIST =
+ ## more items will be succesively added below
+
+lib_LTLIBRARIES = libgc.la
+
+include_HEADERS = include/gc.h include/gc_local_alloc.h \
+include/gc_pthread_redirects.h include/gc_config_macros.h \
+include/leak_detector.h include/gc_typed.h @addincludes@
+
+EXTRA_HEADERS = include/gc_cpp.h include/gc_allocator.h
+
+libgc_la_SOURCES = allchblk.c alloc.c blacklst.c checksums.c dbg_mlc.c \
+dyn_load.c finalize.c gc_dlopen.c gcj_mlc.c headers.c irix_threads.c \
+linux_threads.c malloc.c mallocx.c mark.c mark_rts.c misc.c new_hblk.c \
+obj_map.c os_dep.c pcr_interface.c ptr_chck.c real_malloc.c reclaim.c \
+solaris_pthreads.c solaris_threads.c specific.c stubborn.c typd_mlc.c \
+backgraph.c win32_threads.c
+
+# Include THREADLIBS here to ensure that the correct versions of
+# linuxthread semaphore functions get linked:
+libgc_la_LIBADD = @addobjs@ $(THREADLIBS)
+libgc_la_DEPENDENCIES = @addobjs@
+libgc_la_LDFLAGS = -version-info 1:2:0
+
+EXTRA_libgc_la_SOURCES = alpha_mach_dep.S \
+ mips_sgi_mach_dep.S mips_ultrix_mach_dep.s powerpc_macosx_mach_dep.s \
+ rs6000_mach_dep.s sparc_mach_dep.S sparc_netbsd_mach_dep.s \
+ sparc_sunos4_mach_dep.s ia64_save_regs_in_stack.s gc_cpp.cc
+
+EXTRA_DIST += alpha_mach_dep.S mips_sgi_mach_dep.S sparc_mach_dep.S
+
+AM_CXXFLAGS = @GC_CFLAGS@
+AM_CFLAGS = @GC_CFLAGS@
+
+check_PROGRAMS = gctest @addtests@
+EXTRA_PROGRAMS = test_cpp
+
+test.o: $(srcdir)/tests/test.c
+ $(COMPILE) -c $(srcdir)/tests/test.c
+# Using $< in the above seems to fail with the HP/UX on Itanium make.
+test_cpp.o: $(srcdir)/tests/test_cpp.cc
+ $(COMPILE) -c $(srcdir)/tests/test_cpp.cc
+
+## FIXME: this is probably the reason why some files from BUILT_SOURCES
+## are included in the distribution
+# gctest_OBJECTS = test.o
+gctest_SOURCES = tests/test.c
+gctest_LDADD = ./libgc.la $(THREADLIBS) $(EXTRA_TEST_LIBS)
+test_cpp_SOURCES = tests/test_cpp.cc
+test_cpp_LDADD = ./libgc.la $(THREADLIBS) $(EXTRA_TEST_LIBS)
+TESTS_ENVIRONMENT = LD_LIBRARY_PATH=../../gcc
+TESTS = gctest @addtests@
+
+## FIXME: relies on internal code generated by automake.
+all_objs = @addobjs@ $(libgc_la_OBJECTS)
+$(all_objs) : include/private/gcconfig.h include/private/gc_priv.h \
+include/private/gc_hdrs.h include/gc.h include/gc_gcj.h \
+include/gc_pthread_redirects.h include/gc_config_macros.h \
+include/gc_mark.h @addincludes@
+
+## FIXME: we shouldn't have to do this, but automake forces us to.
+.s.lo:
+## We use -Wp,-P to strip #line directives. Irix `as' chokes on
+## these.
+ $(LTCOMPILE) -Wp,-P -x assembler-with-cpp -c $<
+
+## We have our own definition of LTCOMPILE because we want to use our
+## CFLAGS, not those passed in from the top level make.
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) \
+ $(AM_CPPFLAGS) $(CPPFLAGS) \
+ $(AM_CFLAGS) $(MY_CFLAGS) $(GC_CFLAGS)
+LINK = $(LIBTOOL) --mode=link $(CC) $(AM_CFLAGS) $(MY_CFLAGS) $(LDFLAGS) -o $@
+
+## We need to add DEFS to assembler flags
+## :FIXME: what if assembler does not accept -D... ?
+## (use Autoconf to prepare ASDEFS ???)
+
+CCASFLAGS += $(DEFS)
+
+dist_noinst_SCRIPTS = callprocs configure.host
+ ## callprocs --- used by Makefile.{dj,direct}
+ ## configure.host --- used by Makefile.{am,dj,direct}
+
+# headers which are not installed
+# (see include/Makefile.am for more)
+#
+dist_noinst_HEADERS = version.h
+
+# documentation which is not installed
+#
+EXTRA_DIST += README.QUICK
+
+# other makefiles
+# :GOTCHA: deliberately we do not include 'Makefile'
+EXTRA_DIST += BCC_MAKEFILE NT_MAKEFILE NT_THREADS_MAKEFILE \
+ OS2_MAKEFILE PCR-Makefile digimars.mak EMX_MAKEFILE \
+ Makefile.direct Makefile.dj Makefile.DLLs SMakefile.amiga \
+ WCC_MAKEFILE
+
+# files used by makefiles other than Makefile.am
+# (:FIXME: do we really need gcc_support.c ?)
+#
+EXTRA_DIST += add_gc_prefix.c gcname.c if_mach.c if_not_there.c \
+ hpux_test_and_clear.s pc_excludes gc.mak MacOS.c \
+ MacProjects.sit.hqx gcc_support.c mach_dep.c setjmp_t.c \
+ threadlibs.c AmigaOS.c \
+ Mac_files/datastart.c Mac_files/dataend.c \
+ Mac_files/MacOS_config.h Mac_files/MacOS_Test_config.h
+
+# part of C++ interface
+#
+EXTRA_DIST += gc_cpp.cc gc_cpp.cpp
+
+# tests not used by Makefile.am (:FIXME: why?)
+#
+EXTRA_DIST += tests/test_cpp.cc tests/trace_test.c \
+ tests/leak_test.c tests/thread_leak_test.c
+
+# cord package
+#
+EXTRA_DIST += cord/cordbscs.c cord/cordtest.c cord/de.c cord/de_win.c \
+ cord/de_win.ICO cord/cordprnt.c cord/cordxtra.c cord/de_cmds.h \
+ cord/de_win.h cord/de_win.RC
+
+# this is an auxiliary shell file used by Makefile and Makefile.direct
+#
+CONFIG_STATUS_DEPENDENCIES = $(srcdir)/configure.host
+
+# :FIXME: why do we distribute this one???
+#
+EXTRA_DIST += libtool.m4
+
+MAKEOVERRIDES=
+
+#
+# :GOTCHA: GNU make rule for making .s out of .S is flawed,
+# it will not remove dest if building fails
+.S.s:
+ if $(CPP) $< >$@ ; then :; else rm -f $@; fi
--- /dev/null
+# This is the original manually generated Makefile. It may still be used
+# to build the collector.
+#
+# Primary targets:
+# gc.a - builds basic library
+# c++ - adds C++ interface to library
+# cords - adds cords (heavyweight strings) to library
+# test - prints porting information, then builds basic version of gc.a,
+# and runs some tests of collector and cords. Does not add cords or
+# c++ interface to gc.a
+# cord/de - builds dumb editor based on cords.
+ABI_FLAG=
+# ABI_FLAG should be the cc flag that specifies the ABI. On most
+# platforms this will be the empty string. Possible values:
+# +DD64 for 64-bit executable on HP/UX.
+# -n32, -n64, -o32 for SGI/MIPS ABIs.
+
+AS_ABI_FLAG=$(ABI_FLAG)
+# ABI flag for assembler. On HP/UX this is +A64 for 64 bit
+# executables.
+
+CC=cc $(ABI_FLAG)
+CXX=g++ $(ABI_FLAG)
+AS=as $(AS_ABI_FLAG)
+# The above doesn't work with gas, which doesn't run cpp.
+# Define AS as `gcc -c -x assembler-with-cpp' instead.
+
+# Redefining srcdir allows object code for the nonPCR version of the collector
+# to be generated in different directories.
+srcdir= .
+VPATH= $(srcdir)
+
+CFLAGS= -O -I$(srcdir)/include -DATOMIC_UNCOLLECTABLE -DNO_SIGNALS -DNO_EXECUTE_PERMISSION -DSILENT -DALL_INTERIOR_POINTERS
+
+# To build the parallel collector on Linux, add to the above:
+# -DGC_LINUX_THREADS -DPARALLEL_MARK -DTHREAD_LOCAL_ALLOC
+# To build the parallel collector in a static library on HP/UX,
+# add to the above:
+# -DGC_HPUX_THREADS -DPARALLEL_MARK -DTHREAD_LOCAL_ALLOC -DUSE_HPUX_TLS -D_POSIX_C_SOURCE=199506L
+# To build the thread-safe collector on Tru64, add to the above:
+# -pthread -DGC_OSF1_THREADS
+
+# HOSTCC and HOSTCFLAGS are used to build executables that will be run as
+# part of the build process, i.e. on the build machine. These will usually
+# be the same as CC and CFLAGS, except in a cross-compilation environment.
+# Note that HOSTCFLAGS should include any -D flags that affect thread support.
+HOSTCC=$(CC)
+HOSTCFLAGS=$(CFLAGS)
+
+# For dynamic library builds, it may be necessary to add flags to generate
+# PIC code, e.g. -fPIC on Linux.
+
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+
+# These define arguments influence the collector configuration:
+# -DSILENT disables statistics printing, and improves performance.
+# -DFIND_LEAK causes GC_find_leak to be initially set.
+# This causes the collector to assume that all inaccessible
+# objects should have been explicitly deallocated, and reports exceptions.
+# Finalization and the test program are not usable in this mode.
+# -DGC_SOLARIS_THREADS enables support for Solaris (thr_) threads.
+# (Clients should also define GC_SOLARIS_THREADS and then include
+# gc.h before performing thr_ or dl* or GC_ operations.)
+# Must also define -D_REENTRANT.
+# -DGC_SOLARIS_PTHREADS enables support for Solaris pthreads.
+# (Internally this define GC_SOLARIS_THREADS as well.)
+# -DGC_IRIX_THREADS enables support for Irix pthreads. See README.irix.
+# -DGC_HPUX_THREADS enables support for HP/UX 11 pthreads.
+# Also requires -D_REENTRANT or -D_POSIX_C_SOURCE=199506L. See README.hp.
+# -DGC_LINUX_THREADS enables support for Xavier Leroy's Linux threads.
+# see README.linux. -D_REENTRANT may also be required.
+# -DGC_OSF1_THREADS enables support for Tru64 pthreads. Untested.
+# -DGC_FREEBSD_THREADS enables support for FreeBSD pthreads. Untested.
+# Appeared to run into some underlying thread problems.
+# -DGC_MACOSX_THREADS enables support for Mac OS X pthreads. Untested.
+# -DGC_DGUX386_THREADS enables support for DB/UX on I386 threads.
+# See README.DGUX386.
+# -DGC_THREADS should set the appropriate one of the above macros.
+# It assumes pthreads for Solaris.
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+# of objects to be recognized. (See gc_priv.h for consequences.)
+# Alternatively, GC_all_interior_pointers can be set at process
+# initialization time.
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+# usually causing it to use less space in such situations.
+# Incremental collection no longer works in this case.
+# -DLARGE_CONFIG tunes the collector for unusually large heaps.
+# Necessary for heaps larger than about 500 MB on most machines.
+# Recommended for heaps larger than about 64 MB.
+# -DDONT_ADD_BYTE_AT_END is meaningful only with -DALL_INTERIOR_POINTERS or
+# GC_all_interior_pointers = 1. Normally -DALL_INTERIOR_POINTERS
+# causes all objects to be padded so that pointers just past the end of
+# an object can be recognized. This can be expensive. (The padding
+# is normally more than one byte due to alignment constraints.)
+# -DDONT_ADD_BYTE_AT_END disables the padding.
+# -DNO_SIGNALS does not disable signals during critical parts of
+# the GC process. This is no less correct than many malloc
+# implementations, and it sometimes has a significant performance
+# impact. However, it is dangerous for many not-quite-ANSI C
+# programs that call things like printf in asynchronous signal handlers.
+# This is on by default. Turning it off has not been extensively tested with
+# compilers that reorder stores. It should have been.
+# -DNO_EXECUTE_PERMISSION may cause some or all of the heap to not
+# have execute permission, i.e. it may be impossible to execute
+# code from the heap. Currently this only affects the incremental
+# collector on UNIX machines. It may greatly improve its performance,
+# since this may avoid some expensive cache synchronization.
+# -DGC_NO_OPERATOR_NEW_ARRAY declares that the C++ compiler does not support
+# the new syntax "operator new[]" for allocating and deleting arrays.
+# See gc_cpp.h for details. No effect on the C part of the collector.
+# This is defined implicitly in a few environments. Must also be defined
+# by clients that use gc_cpp.h.
+# -DREDIRECT_MALLOC=X causes malloc to be defined as alias for X.
+# Unless the following macros are defined, realloc is also redirected
+# to GC_realloc, and free is redirected to GC_free.
+# Calloc and strdup are redefined in terms of the new malloc. X should
+# be either GC_malloc or GC_malloc_uncollectable, or
+# GC_debug_malloc_replacement. (The latter invokes GC_debug_malloc
+# with dummy source location information, but still results in
+# properly remembered call stacks on Linux/X86 and Solaris/SPARC.
+# It requires that the following two macros also be used.)
+# The former is occasionally useful for working around leaks in code
+# you don't want to (or can't) look at. It may not work for
+# existing code, but it often does. Neither works on all platforms,
+# since some ports use malloc or calloc to obtain system memory.
+# (Probably works for UNIX, and win32.) If you build with DBG_HDRS_ALL,
+# you should only use GC_debug_malloc_replacement as a malloc
+# replacement.
+# -DREDIRECT_REALLOC=X causes GC_realloc to be redirected to X.
+# The canonical use is -DREDIRECT_REALLOC=GC_debug_realloc_replacement,
+# together with -DREDIRECT_MALLOC=GC_debug_malloc_replacement to
+# generate leak reports with call stacks for both malloc and realloc.
+# This also requires the following:
+# -DREDIRECT_FREE=X causes free to be redirected to X. The
+# canonical use is -DREDIRECT_FREE=GC_debug_free.
+# -DIGNORE_FREE turns calls to free into a noop. Only useful with
+# -DREDIRECT_MALLOC.
+# -DNO_DEBUGGING removes GC_dump and the debugging routines it calls.
+# Reduces code size slightly at the expense of debuggability.
+# -DJAVA_FINALIZATION makes it somewhat safer to finalize objects out of
+# order by specifying a nonstandard finalization mark procedure (see
+# finalize.c). Objects reachable from finalizable objects will be marked
+# in a sepearte postpass, and hence their memory won't be reclaimed.
+# Not recommended unless you are implementing a language that specifies
+# these semantics. Since 5.0, determines only only the initial value
+# of GC_java_finalization variable.
+# -DFINALIZE_ON_DEMAND causes finalizers to be run only in response
+# to explicit GC_invoke_finalizers() calls.
+# In 5.0 this became runtime adjustable, and this only determines the
+# initial value of GC_finalize_on_demand.
+# -DATOMIC_UNCOLLECTABLE includes code for GC_malloc_atomic_uncollectable.
+# This is useful if either the vendor malloc implementation is poor,
+# or if REDIRECT_MALLOC is used.
+# -DHBLKSIZE=ddd, where ddd is a power of 2 between 512 and 16384, explicitly
+# sets the heap block size. Each heap block is devoted to a single size and
+# kind of object. For the incremental collector it makes sense to match
+# the most likely page size. Otherwise large values result in more
+# fragmentation, but generally better performance for large heaps.
+# -DUSE_MMAP use MMAP instead of sbrk to get new memory.
+# Works for Solaris and Irix.
+# -DUSE_MUNMAP causes memory to be returned to the OS under the right
+# circumstances. This currently disables VM-based incremental collection.
+# This is currently experimental, and works only under some Unix,
+# Linux and Windows versions.
+# -DMMAP_STACKS (for Solaris threads) Use mmap from /dev/zero rather than
+# GC_scratch_alloc() to get stack memory.
+# -DPRINT_BLACK_LIST Whenever a black list entry is added, i.e. whenever
+# the garbage collector detects a value that looks almost, but not quite,
+# like a pointer, print both the address containing the value, and the
+# value of the near-bogus-pointer. Can be used to identifiy regions of
+# memory that are likely to contribute misidentified pointers.
+# -DKEEP_BACK_PTRS Add code to save back pointers in debugging headers
+# for objects allocated with the debugging allocator. If all objects
+# through GC_MALLOC with GC_DEBUG defined, this allows the client
+# to determine how particular or randomly chosen objects are reachable
+# for debugging/profiling purposes. The gc_backptr.h interface is
+# implemented only if this is defined.
+# -DGC_ASSERTIONS Enable some internal GC assertion checking. Currently
+# this facility is only used in a few places. It is intended primarily
+# for debugging of the garbage collector itself, but could also
+# -DDBG_HDRS_ALL Make sure that all objects have debug headers. Increases
+# the reliability (from 99.9999% to 100%) of some of the debugging
+# code (especially KEEP_BACK_PTRS). Makes -DSHORT_DBG_HDRS possible.
+# Assumes that all client allocation is done through debugging
+# allocators.
+# -DSHORT_DBG_HDRS Assume that all objects have debug headers. Shorten
+# the headers to minimize object size, at the expense of checking for
+# writes past the end of an object. This is intended for environments
+# in which most client code is written in a "safe" language, such as
+# Scheme or Java. Assumes that all client allocation is done using
+# the GC_debug_ functions, or through the macros that expand to these,
+# or by redirecting malloc to GC_debug_malloc_replacement.
+# (Also eliminates the field for the requested object size.)
+# occasionally be useful for debugging of client code. Slows down the
+# collector somewhat, but not drastically.
+# -DSAVE_CALL_COUNT=<n> Set the number of call frames saved with objects
+# allocated through the debugging interface. Affects the amount of
+# information generated in leak reports. Only matters on platforms
+# on which we can quickly generate call stacks, currently Linux/(X86 & SPARC)
+# and Solaris/SPARC and platforms that provide execinfo.h.
+# Default is zero. On X86, client
+# code should NOT be compiled with -fomit-frame-pointer.
+# -DSAVE_CALL_NARGS=<n> Set the number of functions arguments to be
+# saved with each call frame. Default is zero. Ignored if we
+# don't know how to retrieve arguments on the platform.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+# altered stubborn objects, at substantial performance cost.
+# Use only for debugging of the incremental collector.
+# -DGC_GCJ_SUPPORT includes support for gcj (and possibly other systems
+# that include a pointer to a type descriptor in each allocated object).
+# Building this way requires an ANSI C compiler.
+# -DUSE_I686_PREFETCH causes the collector to issue Pentium III style
+# prefetch instructions. No effect except on X86 Linux platforms.
+# Assumes a very recent gcc-compatible compiler and assembler.
+# (Gas prefetcht0 support was added around May 1999.)
+# Empirically the code appears to still run correctly on Pentium II
+# processors, though with no performance benefit. May not run on other
+# X86 processors? In some cases this improves performance by
+# 15% or so.
+# -DUSE_3DNOW_PREFETCH causes the collector to issue AMD 3DNow style
+# prefetch instructions. Same restrictions as USE_I686_PREFETCH.
+# Minimally tested. Didn't appear to be an obvious win on a K6-2/500.
+# -DUSE_PPC_PREFETCH causes the collector to issue PowerPC style
+# prefetch instructions. No effect except on PowerPC OS X platforms.
+# Performance impact untested.
+# -DGC_USE_LD_WRAP in combination with the old flags listed in README.linux
+# causes the collector some system and pthread calls in a more transparent
+# fashion than the usual macro-based approach. Requires GNU ld, and
+# currently probably works only with Linux.
+# -DTHREAD_LOCAL_ALLOC defines GC_local_malloc(), GC_local_malloc_atomic()
+# and GC_local_gcj_malloc(). Needed for gc_gcj.h interface. These allocate
+# in a way that usually does not involve acquisition of a global lock.
+# Currently requires -DGC_LINUX_THREADS, but should be easy to port to
+# other pthreads environments. Recommended for multiprocessors.
+# -DPARALLEL_MARK allows the marker to run in multiple threads. Recommended
+# for multiprocessors. Currently requires Linux on X86 or IA64, though
+# support for other Posix platforms should be fairly easy to add,
+# if the thread implementation is otherwise supported.
+# -DNO_GETENV prevents the collector from looking at environment variables.
+# These may otherwise alter its configuration, or turn off GC altogether.
+# I don't know of a reason to disable this, except possibly if the
+# resulting process runs as a privileged user?
+# -DUSE_GLOBAL_ALLOC. Win32 only. Use GlobalAlloc instead of
+# VirtualAlloc to allocate the heap. May be needed to work around
+# a Windows NT/2000 issue. Incompatible with USE_MUNMAP.
+# See README.win32 for details.
+# -DMAKE_BACK_GRAPH. Enable GC_PRINT_BACK_HEIGHT environment variable.
+# See README.environment for details. Experimental. Limited platform
+# support. Implies DBG_HDRS_ALL. All allocation should be done using
+# the debug interface.
+# -DSTUBBORN_ALLOC allows allocation of "hard to change" objects, and thus
+# makes incremental collection easier. Was enabled by default until 6.0.
+# Rarely used, to my knowledge.
+# -DHANDLE_FORK attempts to make GC_malloc() work in a child process fork()ed
+# from a multithreaded parent. Currently only supported by linux_threads.c.
+# (Similar code should work on Solaris or Irix, but it hasn't been tried.)
+# -DTEST_WITH_SYSTEM_MALLOC causes gctest to allocate (and leak) large chunks
+# of memory with the standard system malloc. This will cause the root
+# set and collected heap to grow significantly if malloced memory is
+# somehow getting traced by the collector. This has no impact on the
+# generated library; it only affects the test.
+# -DPOINTER_MASK=0x... causes candidate pointers to be ANDed with the
+# given mask before being considered. If either this or the following
+# macro is defined, it will be assumed that all pointers stored in
+# the heap need to be processed this way. Stack and register pointers
+# will be considered both with and without processing.
+# These macros are normally needed only to support systems that use
+# high-order pointer tags. EXPERIMENTAL.
+# -DPOINTER_SHIFT=n causes the collector to left shift candidate pointers
+# by the indicated amount before trying to interpret them. Applied
+# after POINTER_MASK. EXPERIMENTAL. See also the preceding macro.
+#
+
+CXXFLAGS= $(CFLAGS)
+AR= ar
+RANLIB= ranlib
+
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o irix_threads.o linux_threads.o typd_mlc.o ptr_chck.o mallocx.o solaris_pthreads.o gcj_mlc.o specific.o gc_dlopen.o backgraph.o
+
+CSRCS= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c irix_threads.c linux_threads.c typd_mlc.c ptr_chck.c mallocx.c solaris_pthreads.c gcj_mlc.c specific.c gc_dlopen.c backgraph.c
+
+CORD_SRCS= cord/cordbscs.c cord/cordxtra.c cord/cordprnt.c cord/de.c cord/cordtest.c include/cord.h include/ec.h include/private/cord_pos.h cord/de_win.c cord/de_win.h cord/de_cmds.h cord/de_win.ICO cord/de_win.RC
+
+CORD_OBJS= cord/cordbscs.o cord/cordxtra.o cord/cordprnt.o
+
+SRCS= $(CSRCS) mips_sgi_mach_dep.S rs6000_mach_dep.s alpha_mach_dep.S \
+ sparc_mach_dep.S include/gc.h include/gc_typed.h \
+ include/private/gc_hdrs.h include/private/gc_priv.h \
+ include/private/gcconfig.h include/private/gc_pmark.h \
+ include/gc_inl.h include/gc_inline.h include/gc_mark.h \
+ threadlibs.c if_mach.c if_not_there.c gc_cpp.cc include/gc_cpp.h \
+ gcname.c include/weakpointer.h include/private/gc_locks.h \
+ gcc_support.c mips_ultrix_mach_dep.s include/gc_alloc.h \
+ include/new_gc_alloc.h include/gc_allocator.h \
+ include/javaxfc.h sparc_sunos4_mach_dep.s sparc_netbsd_mach_dep.s \
+ include/private/solaris_threads.h include/gc_backptr.h \
+ hpux_test_and_clear.s include/gc_gcj.h \
+ include/gc_local_alloc.h include/private/dbg_mlc.h \
+ include/private/specific.h powerpc_macosx_mach_dep.s \
+ include/leak_detector.h include/gc_amiga_redirects.h \
+ include/gc_pthread_redirects.h ia64_save_regs_in_stack.s \
+ include/gc_config_macros.h $(CORD_SRCS)
+
+DOC_FILES= README.QUICK doc/README.Mac doc/README.MacOSX doc/README.OS2 \
+ doc/README.amiga doc/README.cords doc/debugging.html \
+ doc/README.dj doc/README.hp doc/README.linux doc/README.rs6000 \
+ doc/README.sgi doc/README.solaris2 doc/README.uts \
+ doc/README.win32 doc/barrett_diagram doc/README \
+ doc/README.contributors doc/README.changes doc/gc.man \
+ doc/README.environment doc/tree.html doc/gcdescr.html \
+ doc/README.autoconf doc/README.macros doc/README.ews4800 \
+ doc/README.DGUX386 doc/README.arm.cross doc/leak.html \
+ doc/scale.html doc/gcinterface.html
+
+TESTS= tests/test.c tests/test_cpp.cc tests/trace_test.c \
+ tests/leak_test.c tests/thread_leak_test.c
+
+GNU_BUILD_FILES= configure.in Makefile.am configure acinclude.m4 \
+ libtool.m4 install-sh configure.host Makefile.in \
+ ltconfig aclocal.m4 config.sub config.guess \
+ include/Makefile.am include/Makefile.in \
+ doc/Makefile.am doc/Makefile.in \
+ ltmain.sh mkinstalldirs depcomp missing
+
+OTHER_MAKEFILES= OS2_MAKEFILE NT_MAKEFILE NT_THREADS_MAKEFILE gc.mak \
+ BCC_MAKEFILE EMX_MAKEFILE WCC_MAKEFILE Makefile.dj \
+ PCR-Makefile SMakefile.amiga Makefile.DLLs \
+ digimars.mak Makefile.direct
+# Makefile and Makefile.direct are copies of each other.
+
+OTHER_FILES= Makefile setjmp_t.c callprocs pc_excludes \
+ MacProjects.sit.hqx MacOS.c \
+ Mac_files/datastart.c Mac_files/dataend.c \
+ Mac_files/MacOS_config.h Mac_files/MacOS_Test_config.h \
+ add_gc_prefix.c gc_cpp.cpp win32_threads.c \
+ version.h AmigaOS.c \
+ $(TESTS) $(GNU_BUILD_FILES) $(OTHER_MAKEFILES)
+
+CORD_INCLUDE_FILES= $(srcdir)/include/gc.h $(srcdir)/include/cord.h \
+ $(srcdir)/include/ec.h $(srcdir)/include/private/cord_pos.h
+
+UTILS= if_mach if_not_there threadlibs
+
+# Libraries needed for curses applications. Only needed for de.
+CURSES= -lcurses -ltermlib
+
+# The following is irrelevant on most systems. But a few
+# versions of make otherwise fork the shell specified in
+# the SHELL environment variable.
+SHELL= /bin/sh
+
+SPECIALCFLAGS = -I$(srcdir)/include
+# Alternative flags to the C compiler for mach_dep.c.
+# Mach_dep.c often doesn't like optimization, and it's
+# not time-critical anyway.
+# Set SPECIALCFLAGS to -q nodirect_code on Encore.
+
+all: gc.a gctest
+
+BSD-pkg-all: bsd-libgc.a
+
+bsd-libgc.a:
+ $(MAKE) CFLAGS="$(CFLAGS)" clean c++-t
+ mv gc.a bsd-libgc.a
+
+BSD-pkg-install: BSD-pkg-all
+ ${CP} bsd-libgc.a libgc.a
+ ${INSTALL_DATA} libgc.a ${PREFIX}/lib
+ ${INSTALL_DATA} gc.h gc_cpp.h ${PREFIX}/include
+
+pcr: PCR-Makefile include/private/gc_private.h include/private/gc_hdrs.h \
+include/private/gc_locks.h include/gc.h include/private/gcconfig.h \
+mach_dep.o $(SRCS)
+ $(MAKE) -f PCR-Makefile depend
+ $(MAKE) -f PCR-Makefile
+
+$(OBJS) tests/test.o dyn_load.o dyn_load_sunos53.o: \
+ $(srcdir)/include/private/gc_priv.h \
+ $(srcdir)/include/private/gc_hdrs.h $(srcdir)/include/private/gc_locks.h \
+ $(srcdir)/include/gc.h $(srcdir)/include/gc_pthread_redirects.h \
+ $(srcdir)/include/private/gcconfig.h $(srcdir)/include/gc_typed.h \
+ $(srcdir)/include/gc_config_macros.h Makefile
+# The dependency on Makefile is needed. Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o ptr_chck.o: $(srcdir)/include/gc_mark.h $(srcdir)/include/private/gc_pmark.h
+
+specific.o linux_threads.o: $(srcdir)/include/private/specific.h
+
+solaris_threads.o solaris_pthreads.o: $(srcdir)/include/private/solaris_threads.h
+
+dbg_mlc.o gcj_mlc.o: $(srcdir)/include/private/dbg_mlc.h
+
+tests/test.o: tests $(srcdir)/tests/test.c
+ $(CC) $(CFLAGS) -c $(srcdir)/tests/test.c
+ mv test.o tests/test.o
+
+tests:
+ mkdir tests
+
+base_lib gc.a: $(OBJS) dyn_load.o $(UTILS)
+ echo > base_lib
+ rm -f dont_ar_1
+ ./if_mach SPARC SUNOS5 touch dont_ar_1
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a $(OBJS) dyn_load.o
+ ./if_mach M68K AMIGA touch dont_ar_1
+ ./if_mach M68K AMIGA $(AR) -vrus gc.a $(OBJS) dyn_load.o
+ ./if_not_there dont_ar_1 $(AR) ru gc.a $(OBJS) dyn_load.o
+ ./if_not_there dont_ar_1 $(RANLIB) gc.a || cat /dev/null
+# ignore ranlib failure; that usually means it doesn't exist, and isn't needed
+
+cords: $(CORD_OBJS) cord/cordtest $(UTILS)
+ rm -f dont_ar_3
+ ./if_mach SPARC SUNOS5 touch dont_ar_3
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a $(CORD_OBJS)
+ ./if_mach M68K AMIGA touch dont_ar_3
+ ./if_mach M68K AMIGA $(AR) -vrus gc.a $(CORD_OBJS)
+ ./if_not_there dont_ar_3 $(AR) ru gc.a $(CORD_OBJS)
+ ./if_not_there dont_ar_3 $(RANLIB) gc.a || cat /dev/null
+
+gc_cpp.o: $(srcdir)/gc_cpp.cc $(srcdir)/include/gc_cpp.h $(srcdir)/include/gc.h Makefile
+ $(CXX) -c $(CXXFLAGS) $(srcdir)/gc_cpp.cc
+
+test_cpp: $(srcdir)/tests/test_cpp.cc $(srcdir)/include/gc_cpp.h gc_cpp.o $(srcdir)/include/gc.h \
+base_lib $(UTILS)
+ rm -f test_cpp
+ ./if_mach HP_PA HPUX $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/tests/test_cpp.cc gc_cpp.o gc.a -ldld `./threadlibs`
+ ./if_not_there test_cpp $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/tests/test_cpp.cc gc_cpp.o gc.a `./threadlibs`
+
+c++-t: c++
+ ./test_cpp 1
+
+c++-nt: c++
+ @echo "Use ./test_cpp 1 to test the leak library"
+
+c++: gc_cpp.o $(srcdir)/include/gc_cpp.h test_cpp
+ rm -f dont_ar_4
+ ./if_mach SPARC SUNOS5 touch dont_ar_4
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a gc_cpp.o
+ ./if_mach M68K AMIGA touch dont_ar_4
+ ./if_mach M68K AMIGA $(AR) -vrus gc.a gc_cpp.o
+ ./if_not_there dont_ar_4 $(AR) ru gc.a gc_cpp.o
+ ./if_not_there dont_ar_4 $(RANLIB) gc.a || cat /dev/null
+ ./test_cpp 1
+ echo > c++
+
+dyn_load_sunos53.o: dyn_load.c
+ $(CC) $(CFLAGS) -DSUNOS53_SHARED_LIB -c $(srcdir)/dyn_load.c -o $@
+
+# SunOS5 shared library version of the collector
+sunos5gc.so: $(OBJS) dyn_load_sunos53.o
+ $(CC) -G -o sunos5gc.so $(OBJS) dyn_load_sunos53.o -ldl
+ ln sunos5gc.so libgc.so
+
+# Alpha/OSF shared library version of the collector
+libalphagc.so: $(OBJS)
+ ld -shared -o libalphagc.so $(OBJS) dyn_load.o -lc
+ ln libalphagc.so libgc.so
+
+# IRIX shared library version of the collector
+libirixgc.so: $(OBJS) dyn_load.o
+ ld -shared $(ABI_FLAG) -o libirixgc.so $(OBJS) dyn_load.o -lc
+ ln libirixgc.so libgc.so
+
+# Linux shared library version of the collector
+liblinuxgc.so: $(OBJS) dyn_load.o
+ gcc -shared -o liblinuxgc.so $(OBJS) dyn_load.o
+ ln liblinuxgc.so libgc.so
+
+# Alternative Linux rule. This is preferable, but is likely to break the
+# Makefile for some non-linux platforms.
+# LIBOBJS= $(patsubst %.o, %.lo, $(OBJS))
+#
+#.SUFFIXES: .lo $(SUFFIXES)
+#
+#.c.lo:
+# $(CC) $(CFLAGS) $(CPPFLAGS) -fPIC -c $< -o $@
+#
+# liblinuxgc.so: $(LIBOBJS) dyn_load.lo
+# gcc -shared -Wl,-soname=libgc.so.0 -o libgc.so.0 $(LIBOBJS) dyn_load.lo
+# touch liblinuxgc.so
+
+mach_dep.o: $(srcdir)/mach_dep.c $(srcdir)/mips_sgi_mach_dep.S \
+ $(srcdir)/mips_ultrix_mach_dep.s \
+ $(srcdir)/rs6000_mach_dep.s $(srcdir)/powerpc_macosx_mach_dep.s \
+ $(srcdir)/sparc_mach_dep.S $(srcdir)/sparc_sunos4_mach_dep.s \
+ $(srcdir)/ia64_save_regs_in_stack.s \
+ $(srcdir)/sparc_netbsd_mach_dep.s $(UTILS)
+ rm -f mach_dep.o
+ ./if_mach MIPS IRIX5 $(CC) -E $(srcdir)/mips_sgi_mach_dep.S \
+ | ./if_mach MIPS IRIX5 grep -v "^\#" > $(srcdir)/mips_sgi_mach_dep.s
+ ./if_mach MIPS RISCOS $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+ ./if_mach MIPS ULTRIX $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+ ./if_mach POWERPC MACOSX $(AS) -o mach_dep.o $(srcdir)/powerpc_macosx_mach_dep.s
+ ./if_mach ALPHA LINUX $(CC) -c -o mach_dep.o $(srcdir)/alpha_mach_dep.S
+ ./if_mach SPARC SUNOS5 $(CC) -c -o mach_dep.o $(srcdir)/sparc_mach_dep.S
+ ./if_mach SPARC SUNOS4 $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+ ./if_mach SPARC OPENBSD $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+ ./if_mach SPARC NETBSD $(AS) -o mach_dep.o $(srcdir)/sparc_netbsd_mach_dep.s
+ ./if_mach IA64 "" as $(AS_ABI_FLAG) -o ia64_save_regs_in_stack.o $(srcdir)/ia64_save_regs_in_stack.s
+ ./if_mach IA64 "" $(CC) -c -o mach_dep1.o $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+ ./if_mach IA64 "" ld -r -o mach_dep.o mach_dep1.o ia64_save_regs_in_stack.o
+ ./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+
+mark_rts.o: $(srcdir)/mark_rts.c $(UTILS)
+ rm -f mark_rts.o
+ -./if_mach ALPHA OSF1 $(CC) -c $(CFLAGS) -Wo,-notail $(srcdir)/mark_rts.c
+ ./if_not_there mark_rts.o $(CC) -c $(CFLAGS) $(srcdir)/mark_rts.c
+# Work-around for DEC optimizer tail recursion elimination bug.
+# The ALPHA-specific line should be removed if gcc is used.
+
+alloc.o: version.h
+
+cord:
+ mkdir cord
+
+cord/cordbscs.o: cord $(srcdir)/cord/cordbscs.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordbscs.c
+ mv cordbscs.o cord/cordbscs.o
+# not all compilers understand -o filename
+
+cord/cordxtra.o: cord $(srcdir)/cord/cordxtra.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordxtra.c
+ mv cordxtra.o cord/cordxtra.o
+
+cord/cordprnt.o: cord $(srcdir)/cord/cordprnt.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordprnt.c
+ mv cordprnt.o cord/cordprnt.o
+
+cord/cordtest: $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a $(UTILS)
+ rm -f cord/cordtest
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -lucb
+ ./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -ldld `./threadlibs`
+ ./if_mach M68K AMIGA $(CC) $(CFLAGS) -UGC_AMIGA_MAKINGLIB -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a `./threadlibs`
+ ./if_not_there cord/cordtest $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a `./threadlibs`
+
+cord/de: $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(UTILS)
+ rm -f cord/de
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -lucb `./threadlibs`
+ ./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -ldld `./threadlibs`
+ ./if_mach RS6000 "" $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+ ./if_mach POWERPC MACOSX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a
+ ./if_mach I386 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+ ./if_mach ALPHA LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+ ./if_mach IA64 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+ ./if_mach M68K AMIGA $(CC) $(CFLAGS) -UGC_AMIGA_MAKINGLIB -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+ ./if_not_there cord/de $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) `./threadlibs`
+
+if_mach: $(srcdir)/if_mach.c $(srcdir)/include/private/gcconfig.h
+ $(HOSTCC) $(HOSTCFLAGS) -o if_mach $(srcdir)/if_mach.c
+
+threadlibs: $(srcdir)/threadlibs.c $(srcdir)/include/private/gcconfig.h Makefile
+ $(HOSTCC) $(HOSTCFLAGS) -o threadlibs $(srcdir)/threadlibs.c
+
+if_not_there: $(srcdir)/if_not_there.c
+ $(HOSTCC) $(HOSTCFLAGS) -o if_not_there $(srcdir)/if_not_there.c
+
+clean:
+ rm -f gc.a *.o *.exe tests/*.o gctest gctest_dyn_link test_cpp \
+ setjmp_test mon.out gmon.out a.out core if_not_there if_mach \
+ threadlibs $(CORD_OBJS) cord/cordtest cord/de mips_sgi_mach_dep.s
+ -rm -f *~
+
+gctest: tests/test.o gc.a $(UTILS)
+ rm -f gctest
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o gctest tests/test.o gc.a -lucb
+ ./if_mach HP_PA HPUX $(CC) $(CFLAGS) -o gctest tests/test.o gc.a -ldld `./threadlibs`
+ ./if_mach M68K AMIGA $(CC) $(CFLAGS) -UGC_AMIGA_MAKINGLIB -o gctest tests/test.o gc.a `./threadlibs`
+ ./if_not_there gctest $(CC) $(CFLAGS) -o gctest tests/test.o gc.a `./threadlibs`
+
+# If an optimized setjmp_test generates a segmentation fault,
+# odds are your compiler is broken. Gctest may still work.
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test: $(srcdir)/setjmp_t.c $(srcdir)/include/gc.h $(UTILS)
+ $(CC) $(CFLAGS) -o setjmp_test $(srcdir)/setjmp_t.c
+
+test: KandRtest cord/cordtest
+ cord/cordtest
+
+# Those tests that work even with a K&R C compiler:
+KandRtest: setjmp_test gctest
+ ./setjmp_test
+ ./gctest
+
+add_gc_prefix: $(srcdir)/add_gc_prefix.c $(srcdir)/version.h
+ $(CC) -o add_gc_prefix $(srcdir)/add_gc_prefix.c
+
+gcname: $(srcdir)/gcname.c $(srcdir)/version.h
+ $(CC) -o gcname $(srcdir)/gcname.c
+
+gc.tar: $(SRCS) $(DOC_FILES) $(OTHER_FILES) add_gc_prefix gcname
+ cp Makefile Makefile.old
+ cp Makefile.direct Makefile
+ rm -f `./gcname`
+ ln -s . `./gcname`
+ ./add_gc_prefix $(SRCS) $(DOC_FILES) $(OTHER_FILES) > /tmp/gc.tar-files
+ tar cvfh gc.tar `cat /tmp/gc.tar-files`
+ cp gc.tar `./gcname`.tar
+ gzip `./gcname`.tar
+ rm `./gcname`
+
+pc_gc.tar: $(SRCS) $(OTHER_FILES)
+ tar cvfX pc_gc.tar pc_excludes $(SRCS) $(OTHER_FILES)
+
+floppy: pc_gc.tar
+ -mmd a:/cord
+ -mmd a:/cord/private
+ -mmd a:/include
+ -mmd a:/include/private
+ mkdir /tmp/pc_gc
+ cat pc_gc.tar | (cd /tmp/pc_gc; tar xvf -)
+ -mcopy -tmn /tmp/pc_gc/* a:
+ -mcopy -tmn /tmp/pc_gc/cord/* a:/cord
+ -mcopy -mn /tmp/pc_gc/cord/de_win.ICO a:/cord
+ -mcopy -tmn /tmp/pc_gc/cord/private/* a:/cord/private
+ -mcopy -tmn /tmp/pc_gc/include/* a:/include
+ -mcopy -tmn /tmp/pc_gc/include/private/* a:/include/private
+ rm -r /tmp/pc_gc
+
+gc.tar.Z: gc.tar
+ compress gc.tar
+
+gc.tar.gz: gc.tar
+ gzip gc.tar
+
+lint: $(CSRCS) tests/test.c
+ lint -DLINT $(CSRCS) tests/test.c | egrep -v "possible pointer alignment problem|abort|exit|sbrk|mprotect|syscall|change in ANSI|improper alignment"
+
+# BTL: added to test shared library version of collector.
+# Currently works only under SunOS5. Requires GC_INIT call from statically
+# loaded client code.
+ABSDIR = `pwd`
+gctest_dyn_link: tests/test.o libgc.so
+ $(CC) -L$(ABSDIR) -R$(ABSDIR) -o gctest_dyn_link tests/test.o -lgc -ldl -lthread
+
+gctest_irix_dyn_link: tests/test.o libirixgc.so
+ $(CC) -L$(ABSDIR) -o gctest_irix_dyn_link tests/test.o -lirixgc
+
+# The following appear to be dead, especially since libgc_globals.h
+# is apparently lost.
+test_dll.o: tests/test.c libgc_globals.h
+ $(CC) $(CFLAGS) -DGC_USE_DLL -c tests/test.c -o test_dll.o
+
+test_dll: test_dll.o libgc_dll.a libgc.dll
+ $(CC) test_dll.o -L$(ABSDIR) -lgc_dll -o test_dll
+
+SYM_PREFIX-libgc=GC
+
+# Uncomment the following line to build a GNU win32 DLL
+# include Makefile.DLLs
+
+reserved_namespace: $(SRCS)
+ for file in $(SRCS) tests/test.c tests/test_cpp.cc; do \
+ sed s/GC_/_GC_/g < $$file > tmp; \
+ cp tmp $$file; \
+ done
+
+user_namespace: $(SRCS)
+ for file in $(SRCS) tests/test.c tests/test_cpp.cc; do \
+ sed s/_GC_/GC_/g < $$file > tmp; \
+ cp tmp $$file; \
+ done
--- /dev/null
+# This Makefile is intended only for DJGPP use.
+# It is mainly a copy of the main Makefile, but tends to get out of sync
+# with it. A merge would probably be appropriate.
+
+# Primary targets:
+# gc.a - builds basic library
+# libgc.a - builds library for use with g++ "-fgc-keyword" extension
+# -fgc-keyword was never really available. Historical
+# interest only.
+# c++ - adds C++ interface to library
+# cords - adds cords (heavyweight strings) to library
+# test - prints porting information, then builds basic version of gc.a,
+# and runs some tests of collector and cords. Does not add cords or
+# c++ interface to gc.a
+# cord/de$(EXE_SUFFIX) - builds dumb editor based on cords.
+ABI_FLAG=
+CC=gcc $(ABI_FLAG)
+CXX=gxx $(ABI_FLAG)
+AS=gcc -c -x assembler-with-cpp $(ABI_FLAG)
+# The above doesn't work with gas, which doesn't run cpp.
+# Define AS as `gcc -c -x assembler-with-cpp' instead.
+# Under Irix 6, you will have to specify the ABI (-o32, -n32, or -64)
+# if you use something other than the default ABI on your machine.
+
+# special defines for DJGPP
+CXXLD=gxx $(ABI_FLAG)
+EXE_SUFFIX=.exe
+
+srcdir= .
+VPATH= $(srcdir)
+
+CFLAGS= -O -I$(srcdir)/include -DATOMIC_UNCOLLECTABLE -DNO_SIGNALS -DALL_INTERIOR_POINTERS -DNO_EXECUTE_PERMISSION -DSILENT
+
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+# -DSILENT disables statistics printing, and improves performance.
+# -DFIND_LEAK causes GC_find_leak to be initially set.
+# This causes the collector to assume that all inaccessible
+# objects should have been explicitly deallocated, and reports exceptions.
+# Finalization and the test program are not usable in this mode.
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+# of objects to be recognized. (See gc_priv.h for consequences.)
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+# usually causing it to use less space in such situations.
+# Incremental collection no longer works in this case.
+# -DLARGE_CONFIG tunes the collector for unusually large heaps.
+# Necessary for heaps larger than about 500 MB on most machines.
+# Recommended for heaps larger than about 64 MB.
+# -DDONT_ADD_BYTE_AT_END is meaningful only with
+# -DALL_INTERIOR_POINTERS. Normally -DALL_INTERIOR_POINTERS
+# causes all objects to be padded so that pointers just past the end of
+# an object can be recognized. This can be expensive. (The padding
+# is normally more than one byte due to alignment constraints.)
+# -DDONT_ADD_BYTE_AT_END disables the padding.
+# -DNO_SIGNALS does not disable signals during critical parts of
+# the GC process. This is no less correct than many malloc
+# implementations, and it sometimes has a significant performance
+# impact. However, it is dangerous for many not-quite-ANSI C
+# programs that call things like printf in asynchronous signal handlers.
+# This is on by default. Turning it off has not been extensively tested with
+# compilers that reorder stores. It should have been.
+# -DNO_EXECUTE_PERMISSION may cause some or all of the heap to not
+# have execute permission, i.e. it may be impossible to execute
+# code from the heap. Currently this only affects the incremental
+# collector on UNIX machines. It may greatly improve its performance,
+# since this may avoid some expensive cache synchronization.
+# -DGC_NO_OPERATOR_NEW_ARRAY declares that the C++ compiler does not support
+# the new syntax "operator new[]" for allocating and deleting arrays.
+# See gc_cpp.h for details. No effect on the C part of the collector.
+# This is defined implicitly in a few environments. Must also be defined
+# by clients that use gc_cpp.h.
+# -DREDIRECT_MALLOC=X causes malloc, realloc, and free to be defined
+# as aliases for X, GC_realloc, and GC_free, respectively.
+# Calloc is redefined in terms of the new malloc. X should
+# be either GC_malloc or GC_malloc_uncollectable.
+# The former is occasionally useful for working around leaks in code
+# you don't want to (or can't) look at. It may not work for
+# existing code, but it often does. Neither works on all platforms,
+# since some ports use malloc or calloc to obtain system memory.
+# (Probably works for UNIX, and win32.)
+# -DIGNORE_FREE turns calls to free into a noop. Only useful with
+# -DREDIRECT_MALLOC.
+# -DNO_DEBUGGING removes GC_dump and the debugging routines it calls.
+# Reduces code size slightly at the expense of debuggability.
+# -DJAVA_FINALIZATION makes it somewhat safer to finalize objects out of
+# order by specifying a nonstandard finalization mark procedure (see
+# finalize.c). Objects reachable from finalizable objects will be marked
+# in a sepearte postpass, and hence their memory won't be reclaimed.
+# Not recommended unless you are implementing a language that specifies
+# these semantics. Since 5.0, determines only only the initial value
+# of GC_java_finalization variable.
+# -DFINALIZE_ON_DEMAND causes finalizers to be run only in response
+# to explicit GC_invoke_finalizers() calls.
+# In 5.0 this became runtime adjustable, and this only determines the
+# initial value of GC_finalize_on_demand.
+# -DATOMIC_UNCOLLECTABLE includes code for GC_malloc_atomic_uncollectable.
+# This is useful if either the vendor malloc implementation is poor,
+# or if REDIRECT_MALLOC is used.
+# -DHBLKSIZE=ddd, where ddd is a power of 2 between 512 and 16384, explicitly
+# sets the heap block size. Each heap block is devoted to a single size and
+# kind of object. For the incremental collector it makes sense to match
+# the most likely page size. Otherwise large values result in more
+# fragmentation, but generally better performance for large heaps.
+# -DPRINT_BLACK_LIST Whenever a black list entry is added, i.e. whenever
+# the garbage collector detects a value that looks almost, but not quite,
+# like a pointer, print both the address containing the value, and the
+# value of the near-bogus-pointer. Can be used to identifiy regions of
+# memory that are likely to contribute misidentified pointers.
+# -DKEEP_BACK_PTRS Add code to save back pointers in debugging headers
+# for objects allocated with the debugging allocator. If all objects
+# through GC_MALLOC with GC_DEBUG defined, this allows the client
+# to determine how particular or randomly chosen objects are reachable
+# for debugging/profiling purposes. The gc_backptr.h interface is
+# implemented only if this is defined.
+# -DGC_ASSERTIONS Enable some internal GC assertion checking. Currently
+# this facility is only used in a few places. It is intended primarily
+# for debugging of the garbage collector itself, but could also
+# -DDBG_HDRS_ALL Make sure that all objects have debug headers. Increases
+# the reliability (from 99.9999% to 100%) of some of the debugging
+# code (especially KEEP_BACK_PTRS). Makes -DSHORT_DBG_HDRS possible.
+# Assumes that all client allocation is done through debugging
+# allocators.
+# -DSHORT_DBG_HDRS Assume that all objects have debug headers. Shorten
+# the headers to minimize object size, at the expense of checking for
+# writes past the end of an object. This is intended for environments
+# in which most client code is written in a "safe" language, such as
+# Scheme or Java. Assumes that all client allocation is done using
+# the GC_debug_ functions (or through the macros that expand to these.
+# (Also eliminates the field for the requested object size.)
+# occasionally be useful for debugging of client code. Slows down the
+# collector somewhat, but not drastically.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+# altered stubborn objects, at substantial performance cost.
+# Use only for debugging of the incremental collector.
+# -DGC_GCJ_SUPPORT includes support for gcj (and possibly other systems
+# that include a pointer to a type descriptor in each allocated object).
+# Building this way requires an ANSI C compiler.
+# -DUSE_I686_PREFETCH causes the collector to issue Pentium III style
+# prefetch instructions. No effect except on X86 Linux platforms.
+# Assumes a very recent gcc-compatible compiler and assembler.
+# (Gas prefetcht0 support was added around May 1999.)
+# Empirically the code appears to still run correctly on Pentium II
+# processors, though with no performance benefit. May not run on other
+# X86 processors? In some cases this improves performance by
+# 15% or so.
+# -DUSE_3DNOW_PREFETCH causes the collector to issue AMD 3DNow style
+# prefetch instructions. Same restrictions as USE_I686_PREFETCH.
+# UNTESTED!!
+# -DGC_USE_LD_WRAP in combination with the gld flags listed in README.linux
+# causes the collector some system and pthread calls in a more transparent
+# fashion than the usual macro-based approach. Requires GNU ld, and
+# currently probably works only with Linux.
+
+
+CXXFLAGS= $(CFLAGS) -DGC_OPERATOR_NEW_ARRAY
+AR= ar
+RANLIB= ranlib
+
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o hpux_irix_threads.o linux_threads.o typd_mlc.o ptr_chck.o mallocx.o solaris_pthreads.o gcj_mlc.o specific.o
+
+CSRCS= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c hpux_irix_threads.c linux_threads.c typd_mlc.c ptr_chck.c mallocx.c solaris_pthreads.c gcj_mlc.c specific.c
+
+CORD_SRCS= cord/cordbscs.c cord/cordxtra.c cord/cordprnt.c cord/de.c cord/cordtest.c include/cord.h include/ec.h include/private/cord_pos.h cord/de_win.c cord/de_win.h cord/de_cmds.h cord/de_win.ICO cord/de_win.RC cord/SCOPTIONS.amiga cord/SMakefile.amiga
+
+CORD_OBJS= cord/cordbscs.o cord/cordxtra.o cord/cordprnt.o
+
+SRCS= $(CSRCS) mips_sgi_mach_dep.S rs6000_mach_dep.s alpha_mach_dep.S \
+ sparc_mach_dep.S include/gc.h include/gc_typed.h \
+ include/private/gc_hdrs.h include/private/gc_priv.h \
+ include/private/gcconfig.h include/private/gc_mark.h \
+ include/gc_inl.h include/gc_inline.h gc.man \
+ threadlibs.c if_mach.c if_not_there.c gc_cpp.cc include/gc_cpp.h \
+ include/weakpointer.h include/private/gc_locks.h \
+ gcc_support.c mips_ultrix_mach_dep.s include/gc_alloc.h \
+ include/new_gc_alloc.h include/javaxfc.h sparc_sunos4_mach_dep.s \
+ include/private/solaris_threads.h include/gc_backptr.h \
+ hpux_test_and_clear.s include/gc_gcj.h \
+ include/gc_local_alloc.h include/private/dbg_mlc.h \
+ include/private/specific.h powerpc_macosx_mach_dep.s \
+ include/leak_detector.h $(CORD_SRCS)
+
+OTHER_FILES= Makefile PCR-Makefile OS2_MAKEFILE NT_MAKEFILE BCC_MAKEFILE \
+ README test.c test_cpp.cc setjmp_t.c SMakefile.amiga \
+ SCoptions.amiga README.amiga README.win32 cord/README \
+ README.rs6000 README.QUICK callprocs pc_excludes \
+ barrett_diagram README.OS2 README.Mac MacProjects.sit.hqx \
+ MacOS.c EMX_MAKEFILE README.debugging \
+ Mac_files/datastart.c Mac_files/dataend.c \
+ Mac_files/MacOS_config.h Mac_files/MacOS_Test_config.h \
+ add_gc_prefix.c README.solaris2 README.sgi README.hp README.uts \
+ win32_threads.c NT_THREADS_MAKEFILE gc.mak README.dj Makefile.dj \
+ README.alpha README.linux README.MacOSX version.h Makefile.DLLs \
+ WCC_MAKEFILE nursery.c include/gc_nursery.h include/gc_copy_descr.h
+
+CORD_INCLUDE_FILES= $(srcdir)/include/gc.h $(srcdir)/include/cord.h \
+ $(srcdir)/include/ec.h $(srcdir)/include/private/cord_pos.h
+
+UTILS= if_mach$(EXE_SUFFIX) if_not_there$(EXE_SUFFIX)
+
+# Libraries needed for curses applications. Only needed for de.
+CURSES= -lcurses -ltermlib
+
+# The following is irrelevant on most systems. But a few
+# versions of make otherwise fork the shell specified in
+# the SHELL environment variable.
+SHELL= /bin/sh
+
+SPECIALCFLAGS =
+# Alternative flags to the C compiler for mach_dep.c.
+# Mach_dep.c often doesn't like optimization, and it's
+# not time-critical anyway.
+# Set SPECIALCFLAGS to -q nodirect_code on Encore.
+
+all: gc.a gctest$(EXE_SUFFIX)
+
+$(OBJS) test.o dyn_load.o dyn_load_sunos53.o: \
+ $(srcdir)/include/private/gc_priv.h \
+ $(srcdir)/include/private/gc_hdrs.h $(srcdir)/include/private/gc_locks.h \
+ $(srcdir)/include/gc.h \
+ $(srcdir)/include/private/gcconfig.h $(srcdir)/include/gc_typed.h \
+ Makefile
+# The dependency on Makefile is needed. Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o: $(srcdir)/gc_mark.h
+
+base_lib gc.a: $(OBJS) dyn_load.o $(UTILS)
+ echo > base_lib
+ rm -f on_sparc_sunos5_1
+ ./if_mach SPARC SUNOS5 touch on_sparc_sunos5_1
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a $(OBJS) dyn_load.o
+ ./if_not_there on_sparc_sunos5_1 $(AR) ru gc.a $(OBJS) dyn_load.o
+ -./if_not_there on_sparc_sunos5_1 $(RANLIB) gc.a
+# ignore ranlib failure; that usually means it doesn't exist, and isn't needed
+
+cords: $(CORD_OBJS) cord/cordtest$(EXE_SUFFIX) $(UTILS)
+ rm -f on_sparc_sunos5_3
+ ./if_mach SPARC SUNOS5 touch on_sparc_sunos5_3
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a $(CORD_OBJS)
+ ./if_not_there on_sparc_sunos5_3 $(AR) ru gc.a $(CORD_OBJS)
+ -./if_not_there on_sparc_sunos5_3 $(RANLIB) gc.a
+
+gc_cpp.o: $(srcdir)/gc_cpp.cc $(srcdir)/include/gc_cpp.h $(srcdir)/include/gc.h Makefile
+ $(CXX) -c $(CXXFLAGS) $(srcdir)/gc_cpp.cc
+
+test_cpp$(EXE_SUFFIX): $(srcdir)/test_cpp.cc $(srcdir)/include/gc_cpp.h gc_cpp.o $(srcdir)/include/gc.h \
+base_lib $(UTILS)
+ rm -f test_cpp test_cpp$(EXE_SUFFIX)
+ ./if_mach HP_PA "" $(CXX) $(CXXFLAGS) -o test_cpp $(srcdir)/test_cpp.cc gc_cpp.o gc.a -ldld
+ ./if_not_there test_cpp$(EXE_SUFFIX) $(CXXLD) $(CXXFLAGS) -o test_cpp$(EXE_SUFFIX) $(srcdir)/test_cpp.cc gc_cpp.o gc.a
+ rm -f test_cpp
+
+c++: gc_cpp.o $(srcdir)/include/gc_cpp.h test_cpp$(EXE_SUFFIX)
+ rm -f on_sparc_sunos5_4
+ ./if_mach SPARC SUNOS5 touch on_sparc_sunos5_4
+ ./if_mach SPARC SUNOS5 $(AR) rus gc.a gc_cpp.o
+ ./if_not_there on_sparc_sunos5_4 $(AR) ru gc.a gc_cpp.o
+ -./if_not_there on_sparc_sunos5_4 $(RANLIB) gc.a
+ ./test_cpp$(EXE_SUFFIX) 1
+ echo > c++
+
+dyn_load_sunos53.o: dyn_load.c
+ $(CC) $(CFLAGS) -DSUNOS53_SHARED_LIB -c $(srcdir)/dyn_load.c -o $@
+
+# SunOS5 shared library version of the collector
+sunos5gc.so: $(OBJS) dyn_load_sunos53.o
+ $(CC) -G -o sunos5gc.so $(OBJS) dyn_load_sunos53.o -ldl
+ ln sunos5gc.so libgc.so
+
+# Alpha/OSF shared library version of the collector
+libalphagc.so: $(OBJS)
+ ld -shared -o libalphagc.so $(OBJS) dyn_load.o -lc
+ ln libalphagc.so libgc.so
+
+# IRIX shared library version of the collector
+libirixgc.so: $(OBJS) dyn_load.o
+ ld -shared $(ABI_FLAG) -o libirixgc.so $(OBJS) dyn_load.o -lc
+ ln libirixgc.so libgc.so
+
+# Linux shared library version of the collector
+liblinuxgc.so: $(OBJS) dyn_load.o
+ gcc -shared -o liblinuxgc.so $(OBJS) dyn_load.o -lo
+ ln liblinuxgc.so libgc.so
+
+mach_dep.o: $(srcdir)/mach_dep.c $(srcdir)/mips_sgi_mach_dep.S $(srcdir)/mips_ultrix_mach_dep.s \
+ $(srcdir)/rs6000_mach_dep.s $(srcdir)/powerpc_macosx_mach_dep.s $(UTILS)
+ rm -f mach_dep.o
+ ./if_mach MIPS IRIX5 $(AS) -o mach_dep.o $(srcdir)/mips_sgi_mach_dep.S
+ ./if_mach MIPS RISCOS $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+ ./if_mach MIPS ULTRIX $(AS) -o mach_dep.o $(srcdir)/mips_ultrix_mach_dep.s
+ ./if_mach RS6000 "" $(AS) -o mach_dep.o $(srcdir)/rs6000_mach_dep.s
+ ./if_mach POWERPC MACOSX $(AS) -o mach_dep.o $(srcdir)/powerpc_macosx_mach_dep.s
+ ./if_mach ALPHA "" $(AS) -o mach_dep.o $(srcdir)/alpha_mach_dep.S
+ ./if_mach SPARC SUNOS5 $(AS) -o mach_dep.o $(srcdir)/sparc_mach_dep.S
+ ./if_mach SPARC SUNOS4 $(AS) -o mach_dep.o $(srcdir)/sparc_sunos4_mach_dep.s
+ ./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
+
+mark_rts.o: $(srcdir)/mark_rts.c if_mach if_not_there $(UTILS)
+ rm -f mark_rts.o
+ -./if_mach ALPHA OSF1 $(CC) -c $(CFLAGS) -Wo,-notail $(srcdir)/mark_rts.c
+ ./if_not_there mark_rts.o $(CC) -c $(CFLAGS) $(srcdir)/mark_rts.c
+# Work-around for DEC optimizer tail recursion elimination bug.
+# The ALPHA-specific line should be removed if gcc is used.
+
+alloc.o: version.h
+
+cord/cordbscs.o: $(srcdir)/cord/cordbscs.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordbscs.c
+ mv cordbscs.o cord/cordbscs.o
+# not all compilers understand -o filename
+
+cord/cordxtra.o: $(srcdir)/cord/cordxtra.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordxtra.c
+ mv cordxtra.o cord/cordxtra.o
+
+cord/cordprnt.o: $(srcdir)/cord/cordprnt.c $(CORD_INCLUDE_FILES)
+ $(CC) $(CFLAGS) -c -I$(srcdir) $(srcdir)/cord/cordprnt.c
+ mv cordprnt.o cord/cordprnt.o
+
+cord/cordtest$(EXE_SUFFIX): $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a $(UTILS) /tmp
+ rm -f cord/cordtest$(EXE_SUFFIX)
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/cordtest$(EXE_SUFFIX) $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -lucb
+ ./if_mach HP_PA "" $(CC) $(CFLAGS) -o cord/cordtest$(EXE_SUFFIX) $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a -ldld
+ ./if_not_there cord/cordtest$(EXE_SUFFIX) $(CC) $(CFLAGS) -o cord/cordtest $(srcdir)/cord/cordtest.c $(CORD_OBJS) gc.a
+ rm -f cord/cordtest cordtest
+ -mv cordtest$(EXE_SUFFIX) cord/
+
+/tmp: $(UTILS)
+ ./if_not_there /tmp mkdir /tmp
+
+cord/de$(EXE_SUFFIX): $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(UTILS)
+ rm -f cord/de cord/de$(EXE_SUFFIX)
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -lucb `./threadlibs`
+ ./if_mach HP_PA "" $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES) -ldld
+ ./if_mach RS6000 "" $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+ ./if_mach I386 LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses `./threadlibs`
+ ./if_mach ALPHA LINUX $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a -lcurses
+ ./if_not_there cord/de$(EXE_SUFFIX) $(CC) $(CFLAGS) -o cord/de$(EXE_SUFFIX) $(srcdir)/cord/de.c cord/cordbscs.o cord/cordxtra.o gc.a $(CURSES)
+
+if_mach$(EXE_SUFFIX): $(srcdir)/if_mach.c $(srcdir)/include/private/gcconfig.h
+ rm -f if_mach if_mach$(EXE_SUFFIX)
+ $(CC) $(CFLAGS) -o if_mach $(srcdir)/if_mach.c
+
+threadlibs$(EXE_SUFFIX): $(srcdir)/threadlibs.c $(srcdir)include/private/gcconfig.h Makefile
+ rm -f threadlibs threadlibs$(EXE_SUFFIX)
+ $(CC) $(CFLAGS) -o threadlibs $(srcdir)/threadlibs.c
+
+if_not_there$(EXE_SUFFIX): $(srcdir)/if_not_there.c
+ rm -f if_not_there if_not_there$(EXE_SUFFIX)
+ $(CC) $(CFLAGS) -o if_not_there $(srcdir)/if_not_there.c
+
+# Clean removes *.o several times,
+# because as the first one doesn't seem to get them all!
+clean:
+ rm -f gc.a *.o
+ rm -f *.o
+ rm -f *.o
+ rm -f cord/*.o
+ rm -f gctest gctest_dyn_link test_cpp
+ rm -f setjmp_test mon.out gmon.out a.out core if_not_there if_mach
+ rm -f threadlibs $(CORD_OBJS) cordtest cord/cordtest de cord/de
+ rm -f gctest$(EXE_SUFFIX) gctest_dyn_link$(EXE_SUFFIX) test_cpp$(EXE_SUFFIX)
+ rm -f setjmp_test$(EXE_SUFFIX) if_not_there$(EXE_SUFFIX) if_mach$(EXE_SUFFIX)
+ rm -f threadlibs$(EXE_SUFFIX) cord/cordtest$(EXE_SUFFIX)
+ -rm -f *~
+
+gctest$(EXE_SUFFIX): test.o gc.a if_mach$(EXE_SUFFIX) if_not_there$(EXE_SUFFIX)
+ rm -f gctest gctest$(EXE_SUFFIX)
+ ./if_mach SPARC DRSNX $(CC) $(CFLAGS) -o gctest test.o gc.a -lucb
+ ./if_mach HP_PA "" $(CC) $(CFLAGS) -o gctest test.o gc.a -ldld
+ ./if_not_there gctest$(EXE_SUFFIX) $(CC) $(CFLAGS) -o gctest$(EXE_SUFFIX) test.o gc.a
+ rm -f gctest
+
+# If an optimized setjmp_test generates a segmentation fault,
+# odds are your compiler is broken. Gctest may still work.
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test$(EXE_SUFFIX): $(srcdir)/setjmp_t.c $(srcdir)/include/gc.h \
+ if_mach$(EXE_SUFFIX) if_not_there$(EXE_SUFFIX)
+ rm -f setjmp_test$(EXE_SUFFIX)
+ $(CC) $(CFLAGS) -o setjmp_test $(srcdir)/setjmp_t.c
+ rm -f setjmp_test
+
+test: KandRtest cord/cordtest$(EXE_SUFFIX)
+ ./cord/cordtest$(EXE_SUFFIX)
+
+# Those tests that work even with a K&R C compiler:
+KandRtest: setjmp_test$(EXE_SUFFIX) gctest$(EXE_SUFFIX)
+ ./setjmp_test$(EXE_SUFFIX)
+ ./gctest$(EXE_SUFFIX)
+
+add_gc_prefix$(EXE_SUFFIX): add_gc_prefix.c
+ $(CC) -o add_gc_prefix$(EXE_SUFFIX) $(srcdir)/add_gc_prefix.c
+ rm -f add_gc_prefix
+
+gc.tar: $(SRCS) $(OTHER_FILES) add_gc_prefix
+ ./add_gc_prefix$(EXE_SUFFIX) $(SRCS) $(OTHER_FILES) > /tmp/gc.tar-files
+ (cd $(srcdir)/.. ; tar cvfh - `cat /tmp/gc.tar-files`) > gc.tar
+
+pc_gc.tar: $(SRCS) $(OTHER_FILES)
+ tar cvfX pc_gc.tar pc_excludes $(SRCS) $(OTHER_FILES)
+
+gc.tar.Z: gc.tar
+ compress gc.tar
+
+gc.tar.gz: gc.tar
+ gzip gc.tar
+
+lint: $(CSRCS) test.c
+ lint -DLINT $(CSRCS) test.c | egrep -v "possible pointer alignment problem|abort|exit|sbrk|mprotect|syscall"
+
+# BTL: added to test shared library version of collector.
+# Currently works only under SunOS5. Requires GC_INIT call from statically
+# loaded client code.
+ABSDIR = `pwd`
+gctest_dyn_link: test.o libgc.so
+ $(CC) -L$(ABSDIR) -R$(ABSDIR) -o gctest_dyn_link test.o -lgc -ldl -lthread
+
+test_dll.o: test.c libgc_globals.h
+ $(CC) $(CFLAGS) -DGC_USE_DLL -c test.c -o test_dll.o
+
+test_dll: test_dll.o libgc_dll.a libgc.dll
+ $(CC) test_dll.o -L$(ABSDIR) -lgc_dll -o test_dll
+
+SYM_PREFIX-libgc=GC
+
+# Uncomment the following line to build a GNU win32 DLL
+# include Makefile.DLLs
+
--- /dev/null
+# Makefile.in generated by automake 1.6.3 from Makefile.am.
+# @configure_input@
+
+# Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+# Free Software Foundation, Inc.
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+# Copyright (c) 1999-2001 by Red Hat, Inc. All rights reserved.
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Original author: Tom Tromey
+# Severely truncated by Hans-J. Boehm
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+SHELL = @SHELL@
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+bindir = @bindir@
+sbindir = @sbindir@
+libexecdir = @libexecdir@
+datadir = @datadir@
+sysconfdir = @sysconfdir@
+sharedstatedir = @sharedstatedir@
+localstatedir = @localstatedir@
+libdir = @libdir@
+infodir = @infodir@
+mandir = @mandir@
+includedir = @includedir@
+oldincludedir = /usr/include
+pkgdatadir = $(datadir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+top_builddir = .
+
+ACLOCAL = @ACLOCAL@
+AUTOCONF = @AUTOCONF@
+AUTOMAKE = @AUTOMAKE@
+AUTOHEADER = @AUTOHEADER@
+
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = @program_transform_name@
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+host_alias = @host_alias@
+host_triplet = @host@
+
+EXEEXT = @EXEEXT@
+OBJEXT = @OBJEXT@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+
+CCASFLAGS = @CCASFLAGS@ $(DEFS)
+CFLAGS = @CFLAGS@
+CXX = @CXX@
+CXXFLAGS = @CXXFLAGS@
+CXXINCLUDES = @CXXINCLUDES@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+ECHO = @ECHO@
+EXTRA_TEST_LIBS = @EXTRA_TEST_LIBS@
+GC_CFLAGS = @GC_CFLAGS@
+GC_VERSION = @GC_VERSION@
+INCLUDES = @INCLUDES@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+MAINT = @MAINT@
+MY_CFLAGS = @MY_CFLAGS@
+OBJDUMP = @OBJDUMP@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+STRIP = @STRIP@
+THREADLIBS = @THREADLIBS@
+VERSION = @VERSION@
+addincludes = @addincludes@
+addobjs = @addobjs@
+addtests = @addtests@
+am__include = @am__include@
+am__quote = @am__quote@
+install_sh = @install_sh@
+target_all = @target_all@
+
+AUTOMAKE_OPTIONS = foreign
+
+SUBDIRS = doc include
+
+
+# documentation which is not installed
+#
+
+# other makefiles
+# :GOTCHA: deliberately we do not include 'Makefile'
+
+# files used by makefiles other than Makefile.am
+# (:FIXME: do we really need gcc_support.c ?)
+#
+
+# part of C++ interface
+#
+
+# tests not used by Makefile.am (:FIXME: why?)
+#
+
+# cord package
+#
+
+# :FIXME: why do we distribute this one???
+#
+EXTRA_DIST = alpha_mach_dep.S mips_sgi_mach_dep.S sparc_mach_dep.S README.QUICK BCC_MAKEFILE NT_MAKEFILE NT_THREADS_MAKEFILE \
+ OS2_MAKEFILE PCR-Makefile digimars.mak EMX_MAKEFILE \
+ Makefile.direct Makefile.dj Makefile.DLLs SMakefile.amiga \
+ WCC_MAKEFILE\
+add_gc_prefix.c gcname.c if_mach.c if_not_there.c \
+ hpux_test_and_clear.s pc_excludes gc.mak MacOS.c \
+ MacProjects.sit.hqx gcc_support.c mach_dep.c setjmp_t.c \
+ threadlibs.c AmigaOS.c \
+ Mac_files/datastart.c Mac_files/dataend.c \
+ Mac_files/MacOS_config.h Mac_files/MacOS_Test_config.h\
+gc_cpp.cc gc_cpp.cpp tests/test_cpp.cc tests/trace_test.c \
+ tests/leak_test.c tests/thread_leak_test.c\
+cord/cordbscs.c cord/cordtest.c cord/de.c cord/de_win.c \
+ cord/de_win.ICO cord/cordprnt.c cord/cordxtra.c cord/de_cmds.h \
+ cord/de_win.h cord/de_win.RC\
+libtool.m4
+
+lib_LTLIBRARIES = libgc.la
+
+include_HEADERS = include/gc.h include/gc_local_alloc.h \
+include/gc_pthread_redirects.h include/gc_config_macros.h \
+include/leak_detector.h include/gc_typed.h @addincludes@
+
+
+EXTRA_HEADERS = include/gc_cpp.h include/gc_allocator.h
+
+libgc_la_SOURCES = allchblk.c alloc.c blacklst.c checksums.c dbg_mlc.c \
+dyn_load.c finalize.c gc_dlopen.c gcj_mlc.c headers.c irix_threads.c \
+linux_threads.c malloc.c mallocx.c mark.c mark_rts.c misc.c new_hblk.c \
+obj_map.c os_dep.c pcr_interface.c ptr_chck.c real_malloc.c reclaim.c \
+solaris_pthreads.c solaris_threads.c specific.c stubborn.c typd_mlc.c \
+backgraph.c win32_threads.c
+
+
+# Include THREADLIBS here to ensure that the correct versions of
+# linuxthread semaphore functions get linked:
+libgc_la_LIBADD = @addobjs@ $(THREADLIBS)
+libgc_la_DEPENDENCIES = @addobjs@
+libgc_la_LDFLAGS = -version-info 1:2:0
+
+EXTRA_libgc_la_SOURCES = alpha_mach_dep.S \
+ mips_sgi_mach_dep.S mips_ultrix_mach_dep.s powerpc_macosx_mach_dep.s \
+ rs6000_mach_dep.s sparc_mach_dep.S sparc_netbsd_mach_dep.s \
+ sparc_sunos4_mach_dep.s ia64_save_regs_in_stack.s gc_cpp.cc
+
+
+AM_CXXFLAGS = @GC_CFLAGS@
+AM_CFLAGS = @GC_CFLAGS@
+
+check_PROGRAMS = gctest @addtests@
+EXTRA_PROGRAMS = test_cpp
+
+# gctest_OBJECTS = test.o
+gctest_SOURCES = tests/test.c
+gctest_LDADD = ./libgc.la $(THREADLIBS) $(EXTRA_TEST_LIBS)
+test_cpp_SOURCES = tests/test_cpp.cc
+test_cpp_LDADD = ./libgc.la $(THREADLIBS) $(EXTRA_TEST_LIBS)
+TESTS_ENVIRONMENT = LD_LIBRARY_PATH=../../gcc
+TESTS = gctest @addtests@
+
+all_objs = @addobjs@ $(libgc_la_OBJECTS)
+
+LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) \
+ $(AM_CPPFLAGS) $(CPPFLAGS) \
+ $(AM_CFLAGS) $(MY_CFLAGS) $(GC_CFLAGS)
+
+LINK = $(LIBTOOL) --mode=link $(CC) $(AM_CFLAGS) $(MY_CFLAGS) $(LDFLAGS) -o $@
+
+dist_noinst_SCRIPTS = callprocs configure.host
+
+# headers which are not installed
+# (see include/Makefile.am for more)
+#
+dist_noinst_HEADERS = version.h
+
+# this is an auxiliary shell file used by Makefile and Makefile.direct
+#
+CONFIG_STATUS_DEPENDENCIES = $(srcdir)/configure.host
+
+MAKEOVERRIDES =
+subdir = .
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_CLEAN_FILES =
+LTLIBRARIES = $(lib_LTLIBRARIES)
+
+am_libgc_la_OBJECTS = allchblk.lo alloc.lo blacklst.lo checksums.lo \
+ dbg_mlc.lo dyn_load.lo finalize.lo gc_dlopen.lo gcj_mlc.lo \
+ headers.lo irix_threads.lo linux_threads.lo malloc.lo \
+ mallocx.lo mark.lo mark_rts.lo misc.lo new_hblk.lo obj_map.lo \
+ os_dep.lo pcr_interface.lo ptr_chck.lo real_malloc.lo \
+ reclaim.lo solaris_pthreads.lo solaris_threads.lo specific.lo \
+ stubborn.lo typd_mlc.lo backgraph.lo win32_threads.lo
+libgc_la_OBJECTS = $(am_libgc_la_OBJECTS)
+EXTRA_PROGRAMS = test_cpp$(EXEEXT)
+check_PROGRAMS = gctest$(EXEEXT) @addtests@
+am_gctest_OBJECTS = test.$(OBJEXT)
+gctest_OBJECTS = $(am_gctest_OBJECTS)
+gctest_DEPENDENCIES = ./libgc.la
+gctest_LDFLAGS =
+am_test_cpp_OBJECTS = test_cpp.$(OBJEXT)
+test_cpp_OBJECTS = $(am_test_cpp_OBJECTS)
+test_cpp_DEPENDENCIES = ./libgc.la
+test_cpp_LDFLAGS =
+SCRIPTS = $(dist_noinst_SCRIPTS)
+
+
+DEFS = @DEFS@
+DEFAULT_INCLUDES = -I. -I$(srcdir)
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+depcomp = $(SHELL) $(top_srcdir)/depcomp
+am__depfiles_maybe = depfiles
+@AMDEP_TRUE@DEP_FILES = ./$(DEPDIR)/allchblk.Plo ./$(DEPDIR)/alloc.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/backgraph.Plo ./$(DEPDIR)/blacklst.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/checksums.Plo ./$(DEPDIR)/dbg_mlc.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/dyn_load.Plo ./$(DEPDIR)/finalize.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/gc_cpp.Plo ./$(DEPDIR)/gc_dlopen.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/gcj_mlc.Plo ./$(DEPDIR)/headers.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/irix_threads.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/linux_threads.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/malloc.Plo ./$(DEPDIR)/mallocx.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/mark.Plo ./$(DEPDIR)/mark_rts.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/misc.Plo ./$(DEPDIR)/new_hblk.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/obj_map.Plo ./$(DEPDIR)/os_dep.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/pcr_interface.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/ptr_chck.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/real_malloc.Plo ./$(DEPDIR)/reclaim.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/solaris_pthreads.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/solaris_threads.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/specific.Plo ./$(DEPDIR)/stubborn.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/test.Po ./$(DEPDIR)/test_cpp.Po \
+@AMDEP_TRUE@ ./$(DEPDIR)/typd_mlc.Plo \
+@AMDEP_TRUE@ ./$(DEPDIR)/win32_threads.Plo
+CCASCOMPILE = $(CCAS) $(AM_CCASFLAGS) $(CCASFLAGS)
+LTCCASCOMPILE = $(LIBTOOL) --mode=compile $(CCAS) $(AM_CCASFLAGS) \
+ $(CCASFLAGS)
+COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
+ $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CCLD = $(CC)
+CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
+ $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS)
+LTCXXCOMPILE = $(LIBTOOL) --mode=compile $(CXX) $(DEFS) \
+ $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
+ $(AM_CXXFLAGS) $(CXXFLAGS)
+CXXLD = $(CXX)
+CXXLINK = $(LIBTOOL) --mode=link $(CXXLD) $(AM_CXXFLAGS) $(CXXFLAGS) \
+ $(AM_LDFLAGS) $(LDFLAGS) -o $@
+DIST_SOURCES = $(libgc_la_SOURCES) $(EXTRA_libgc_la_SOURCES) \
+ $(gctest_SOURCES) $(test_cpp_SOURCES)
+HEADERS = $(dist_noinst_HEADERS) $(include_HEADERS)
+
+
+RECURSIVE_TARGETS = info-recursive dvi-recursive install-info-recursive \
+ uninstall-info-recursive all-recursive install-data-recursive \
+ install-exec-recursive installdirs-recursive install-recursive \
+ uninstall-recursive check-recursive installcheck-recursive
+DIST_COMMON = $(dist_noinst_HEADERS) $(dist_noinst_SCRIPTS) \
+ $(include_HEADERS) Makefile.am Makefile.in acinclude.m4 \
+ aclocal.m4 config.guess config.sub configure configure.in \
+ depcomp install-sh ltconfig ltmain.sh missing mkinstalldirs
+DIST_SUBDIRS = $(SUBDIRS)
+SOURCES = $(libgc_la_SOURCES) $(EXTRA_libgc_la_SOURCES) $(gctest_SOURCES) $(test_cpp_SOURCES)
+
+all: all-recursive
+
+.SUFFIXES:
+.SUFFIXES: .S .c .cc .lo .o .obj .s
+
+am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
+ configure.lineno
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4)
+ cd $(top_srcdir) && \
+ $(AUTOMAKE) --foreign Makefile
+Makefile: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.in $(top_builddir)/config.status
+ cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)
+
+$(top_builddir)/config.status: $(srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+ $(SHELL) ./config.status --recheck
+$(srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(srcdir)/configure.in $(ACLOCAL_M4) $(CONFIGURE_DEPENDENCIES)
+ cd $(srcdir) && $(AUTOCONF)
+
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ configure.in acinclude.m4
+ cd $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS)
+libLTLIBRARIES_INSTALL = $(INSTALL)
+install-libLTLIBRARIES: $(lib_LTLIBRARIES)
+ @$(NORMAL_INSTALL)
+ $(mkinstalldirs) $(DESTDIR)$(libdir)
+ @list='$(lib_LTLIBRARIES)'; for p in $$list; do \
+ if test -f $$p; then \
+ f="`echo $$p | sed -e 's|^.*/||'`"; \
+ echo " $(LIBTOOL) --mode=install $(libLTLIBRARIES_INSTALL) $(INSTALL_STRIP_FLAG) $$p $(DESTDIR)$(libdir)/$$f"; \
+ $(LIBTOOL) --mode=install $(libLTLIBRARIES_INSTALL) $(INSTALL_STRIP_FLAG) $$p $(DESTDIR)$(libdir)/$$f; \
+ else :; fi; \
+ done
+
+uninstall-libLTLIBRARIES:
+ @$(NORMAL_UNINSTALL)
+ @list='$(lib_LTLIBRARIES)'; for p in $$list; do \
+ p="`echo $$p | sed -e 's|^.*/||'`"; \
+ echo " $(LIBTOOL) --mode=uninstall rm -f $(DESTDIR)$(libdir)/$$p"; \
+ $(LIBTOOL) --mode=uninstall rm -f $(DESTDIR)$(libdir)/$$p; \
+ done
+
+clean-libLTLIBRARIES:
+ -test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES)
+ @list='$(lib_LTLIBRARIES)'; for p in $$list; do \
+ dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \
+ test -z "$dir" && dir=.; \
+ echo "rm -f \"$${dir}/so_locations\""; \
+ rm -f "$${dir}/so_locations"; \
+ done
+libgc.la: $(libgc_la_OBJECTS) $(libgc_la_DEPENDENCIES)
+ $(CXXLINK) -rpath $(libdir) $(libgc_la_LDFLAGS) $(libgc_la_OBJECTS) $(libgc_la_LIBADD) $(LIBS)
+
+clean-checkPROGRAMS:
+ @list='$(check_PROGRAMS)'; for p in $$list; do \
+ f=`echo $$p|sed 's/$(EXEEXT)$$//'`; \
+ echo " rm -f $$p $$f"; \
+ rm -f $$p $$f ; \
+ done
+test.$(OBJEXT): tests/test.c
+gctest$(EXEEXT): $(gctest_OBJECTS) $(gctest_DEPENDENCIES)
+ @rm -f gctest$(EXEEXT)
+ $(LINK) $(gctest_LDFLAGS) $(gctest_OBJECTS) $(gctest_LDADD) $(LIBS)
+test_cpp.$(OBJEXT): tests/test_cpp.cc
+test_cpp$(EXEEXT): $(test_cpp_OBJECTS) $(test_cpp_DEPENDENCIES)
+ @rm -f test_cpp$(EXEEXT)
+ $(CXXLINK) $(test_cpp_LDFLAGS) $(test_cpp_OBJECTS) $(test_cpp_LDADD) $(LIBS)
+
+mostlyclean-compile:
+ -rm -f *.$(OBJEXT) core *.core
+
+distclean-compile:
+ -rm -f *.tab.c
+
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allchblk.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/alloc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backgraph.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/blacklst.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/checksums.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dbg_mlc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dyn_load.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/finalize.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc_cpp.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gc_dlopen.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gcj_mlc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/headers.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/irix_threads.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/linux_threads.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/malloc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mallocx.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mark.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mark_rts.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/misc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/new_hblk.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/obj_map.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/os_dep.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pcr_interface.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ptr_chck.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/real_malloc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reclaim.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/solaris_pthreads.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/solaris_threads.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/specific.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stubborn.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/test.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/test_cpp.Po@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/typd_mlc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/win32_threads.Plo@am__quote@
+
+distclean-depend:
+ -rm -rf ./$(DEPDIR)
+
+.S.o:
+ $(CCASCOMPILE) -c `test -f '$<' || echo '$(srcdir)/'`$<
+
+.S.obj:
+ $(CCASCOMPILE) -c `cygpath -w $<`
+
+.S.lo:
+ $(LTCCASCOMPILE) -c -o $@ `test -f '$<' || echo '$(srcdir)/'`$<
+
+.c.o:
+@AMDEP_TRUE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/$*.Po' tmpdepfile='$(DEPDIR)/$*.TPo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(COMPILE) -c `test -f '$<' || echo '$(srcdir)/'`$<
+
+.c.obj:
+@AMDEP_TRUE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/$*.Po' tmpdepfile='$(DEPDIR)/$*.TPo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(COMPILE) -c `cygpath -w $<`
+
+.c.lo:
+@AMDEP_TRUE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/$*.Plo' tmpdepfile='$(DEPDIR)/$*.TPlo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(LTCOMPILE) -c -o $@ `test -f '$<' || echo '$(srcdir)/'`$<
+
+test.obj: tests/test.c
+@AMDEP_TRUE@ source='tests/test.c' object='test.obj' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/test.Po' tmpdepfile='$(DEPDIR)/test.TPo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o test.obj `cygpath -w tests/test.c`
+
+test.lo: tests/test.c
+@AMDEP_TRUE@ source='tests/test.c' object='test.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/test.Plo' tmpdepfile='$(DEPDIR)/test.TPlo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o test.lo `test -f 'tests/test.c' || echo '$(srcdir)/'`tests/test.c
+CCDEPMODE = @CCDEPMODE@
+
+.cc.o:
+@AMDEP_TRUE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/$*.Po' tmpdepfile='$(DEPDIR)/$*.TPo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(CXXCOMPILE) -c -o $@ `test -f '$<' || echo '$(srcdir)/'`$<
+
+.cc.obj:
+@AMDEP_TRUE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/$*.Po' tmpdepfile='$(DEPDIR)/$*.TPo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(CXXCOMPILE) -c -o $@ `cygpath -w $<`
+
+.cc.lo:
+@AMDEP_TRUE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/$*.Plo' tmpdepfile='$(DEPDIR)/$*.TPlo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(LTCXXCOMPILE) -c -o $@ `test -f '$<' || echo '$(srcdir)/'`$<
+
+test_cpp.obj: tests/test_cpp.cc
+@AMDEP_TRUE@ source='tests/test_cpp.cc' object='test_cpp.obj' libtool=no @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/test_cpp.Po' tmpdepfile='$(DEPDIR)/test_cpp.TPo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -c -o test_cpp.obj `cygpath -w tests/test_cpp.cc`
+
+test_cpp.lo: tests/test_cpp.cc
+@AMDEP_TRUE@ source='tests/test_cpp.cc' object='test_cpp.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@ depfile='$(DEPDIR)/test_cpp.Plo' tmpdepfile='$(DEPDIR)/test_cpp.TPlo' @AMDEPBACKSLASH@
+@AMDEP_TRUE@ $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+ $(LIBTOOL) --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -c -o test_cpp.lo `test -f 'tests/test_cpp.cc' || echo '$(srcdir)/'`tests/test_cpp.cc
+CXXDEPMODE = @CXXDEPMODE@
+
+.s.o:
+ $(CCASCOMPILE) -c `test -f '$<' || echo '$(srcdir)/'`$<
+
+.s.obj:
+ $(CCASCOMPILE) -c `cygpath -w $<`
+
+mostlyclean-libtool:
+ -rm -f *.lo
+
+clean-libtool:
+ -rm -rf .libs _libs
+
+distclean-libtool:
+ -rm -f libtool
+uninstall-info-am:
+includeHEADERS_INSTALL = $(INSTALL_HEADER)
+install-includeHEADERS: $(include_HEADERS)
+ @$(NORMAL_INSTALL)
+ $(mkinstalldirs) $(DESTDIR)$(includedir)
+ @list='$(include_HEADERS)'; for p in $$list; do \
+ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+ f="`echo $$p | sed -e 's|^.*/||'`"; \
+ echo " $(includeHEADERS_INSTALL) $$d$$p $(DESTDIR)$(includedir)/$$f"; \
+ $(includeHEADERS_INSTALL) $$d$$p $(DESTDIR)$(includedir)/$$f; \
+ done
+
+uninstall-includeHEADERS:
+ @$(NORMAL_UNINSTALL)
+ @list='$(include_HEADERS)'; for p in $$list; do \
+ f="`echo $$p | sed -e 's|^.*/||'`"; \
+ echo " rm -f $(DESTDIR)$(includedir)/$$f"; \
+ rm -f $(DESTDIR)$(includedir)/$$f; \
+ done
+
+# This directory's subdirectories are mostly independent; you can cd
+# into them and run `make' without going through this Makefile.
+# To change the values of `make' variables: instead of editing Makefiles,
+# (1) if the variable is set in `config.status', edit `config.status'
+# (which will cause the Makefiles to be regenerated when you run `make');
+# (2) otherwise, pass the desired values on the `make' command line.
+$(RECURSIVE_TARGETS):
+ @set fnord $$MAKEFLAGS; amf=$$2; \
+ dot_seen=no; \
+ target=`echo $@ | sed s/-recursive//`; \
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ echo "Making $$target in $$subdir"; \
+ if test "$$subdir" = "."; then \
+ dot_seen=yes; \
+ local_target="$$target-am"; \
+ else \
+ local_target="$$target"; \
+ fi; \
+ (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+ || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+ done; \
+ if test "$$dot_seen" = "no"; then \
+ $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+ fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+ @set fnord $$MAKEFLAGS; amf=$$2; \
+ dot_seen=no; \
+ case "$@" in \
+ distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
+ *) list='$(SUBDIRS)' ;; \
+ esac; \
+ rev=''; for subdir in $$list; do \
+ if test "$$subdir" = "."; then :; else \
+ rev="$$subdir $$rev"; \
+ fi; \
+ done; \
+ rev="$$rev ."; \
+ target=`echo $@ | sed s/-recursive//`; \
+ for subdir in $$rev; do \
+ echo "Making $$target in $$subdir"; \
+ if test "$$subdir" = "."; then \
+ local_target="$$target-am"; \
+ else \
+ local_target="$$target"; \
+ fi; \
+ (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+ || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+ done && test -z "$$fail"
+tags-recursive:
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+ done
+
+ETAGS = etags
+ETAGSFLAGS =
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
+ unique=`for i in $$list; do \
+ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+ done | \
+ $(AWK) ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ mkid -fID $$unique
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
+ $(TAGS_FILES) $(LISP)
+ tags=; \
+ here=`pwd`; \
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ if test "$$subdir" = .; then :; else \
+ test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+ fi; \
+ done; \
+ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
+ unique=`for i in $$list; do \
+ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+ done | \
+ $(AWK) ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ test -z "$(ETAGS_ARGS)$$tags$$unique" \
+ || $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+ $$tags $$unique
+
+GTAGS:
+ here=`$(am__cd) $(top_builddir) && pwd` \
+ && cd $(top_srcdir) \
+ && gtags -i $(GTAGS_ARGS) $$here
+
+distclean-tags:
+ -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH
+
+check-TESTS: $(TESTS)
+ @failed=0; all=0; xfail=0; xpass=0; \
+ srcdir=$(srcdir); export srcdir; \
+ list='$(TESTS)'; \
+ if test -n "$$list"; then \
+ for tst in $$list; do \
+ if test -f ./$$tst; then dir=./; \
+ elif test -f $$tst; then dir=; \
+ else dir="$(srcdir)/"; fi; \
+ if $(TESTS_ENVIRONMENT) $${dir}$$tst; then \
+ all=`expr $$all + 1`; \
+ case " $(XFAIL_TESTS) " in \
+ *" $$tst "*) \
+ xpass=`expr $$xpass + 1`; \
+ failed=`expr $$failed + 1`; \
+ echo "XPASS: $$tst"; \
+ ;; \
+ *) \
+ echo "PASS: $$tst"; \
+ ;; \
+ esac; \
+ elif test $$? -ne 77; then \
+ all=`expr $$all + 1`; \
+ case " $(XFAIL_TESTS) " in \
+ *" $$tst "*) \
+ xfail=`expr $$xfail + 1`; \
+ echo "XFAIL: $$tst"; \
+ ;; \
+ *) \
+ failed=`expr $$failed + 1`; \
+ echo "FAIL: $$tst"; \
+ ;; \
+ esac; \
+ fi; \
+ done; \
+ if test "$$failed" -eq 0; then \
+ if test "$$xfail" -eq 0; then \
+ banner="All $$all tests passed"; \
+ else \
+ banner="All $$all tests behaved as expected ($$xfail expected failures)"; \
+ fi; \
+ else \
+ if test "$$xpass" -eq 0; then \
+ banner="$$failed of $$all tests failed"; \
+ else \
+ banner="$$failed of $$all tests did not behave as expected ($$xpass unexpected passes)"; \
+ fi; \
+ fi; \
+ dashes=`echo "$$banner" | sed s/./=/g`; \
+ echo "$$dashes"; \
+ echo "$$banner"; \
+ echo "$$dashes"; \
+ test "$$failed" -eq 0; \
+ else :; fi
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+top_distdir = .
+distdir = $(PACKAGE)-$(VERSION)
+
+am__remove_distdir = \
+ { test ! -d $(distdir) \
+ || { find $(distdir) -type d ! -perm -200 -exec chmod u+w {} ';' \
+ && rm -fr $(distdir); }; }
+
+GZIP_ENV = --best
+distcleancheck_listfiles = find . -type f -print
+
+distdir: $(DISTFILES)
+ $(am__remove_distdir)
+ mkdir $(distdir)
+ $(mkinstalldirs) $(distdir)/Mac_files $(distdir)/cord $(distdir)/include $(distdir)/tests
+ @list='$(DISTFILES)'; for file in $$list; do \
+ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
+ dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \
+ if test "$$dir" != "$$file" && test "$$dir" != "."; then \
+ dir="/$$dir"; \
+ $(mkinstalldirs) "$(distdir)$$dir"; \
+ else \
+ dir=''; \
+ fi; \
+ if test -d $$d/$$file; then \
+ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
+ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \
+ fi; \
+ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \
+ else \
+ test -f $(distdir)/$$file \
+ || cp -p $$d/$$file $(distdir)/$$file \
+ || exit 1; \
+ fi; \
+ done
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ if test "$$subdir" = .; then :; else \
+ test -d $(distdir)/$$subdir \
+ || mkdir $(distdir)/$$subdir \
+ || exit 1; \
+ (cd $$subdir && \
+ $(MAKE) $(AM_MAKEFLAGS) \
+ top_distdir="$(top_distdir)" \
+ distdir=../$(distdir)/$$subdir \
+ distdir) \
+ || exit 1; \
+ fi; \
+ done
+ -find $(distdir) -type d ! -perm -777 -exec chmod a+rwx {} \; -o \
+ ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \
+ ! -type d ! -perm -400 -exec chmod a+r {} \; -o \
+ ! -type d ! -perm -444 -exec $(SHELL) $(install_sh) -c -m a+r {} {} \; \
+ || chmod -R a+r $(distdir)
+dist-gzip: distdir
+ $(AMTAR) chof - $(distdir) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz
+ $(am__remove_distdir)
+
+dist dist-all: distdir
+ $(AMTAR) chof - $(distdir) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz
+ $(am__remove_distdir)
+
+# This target untars the dist file and tries a VPATH configuration. Then
+# it guarantees that the distribution is self-contained by making another
+# tarfile.
+distcheck: dist
+ $(am__remove_distdir)
+ GZIP=$(GZIP_ENV) gunzip -c $(distdir).tar.gz | $(AMTAR) xf -
+ chmod -R a-w $(distdir); chmod a+w $(distdir)
+ mkdir $(distdir)/=build
+ mkdir $(distdir)/=inst
+ chmod a-w $(distdir)
+ dc_install_base=`$(am__cd) $(distdir)/=inst && pwd` \
+ && cd $(distdir)/=build \
+ && ../configure --srcdir=.. --prefix=$$dc_install_base \
+ $(DISTCHECK_CONFIGURE_FLAGS) \
+ && $(MAKE) $(AM_MAKEFLAGS) \
+ && $(MAKE) $(AM_MAKEFLAGS) dvi \
+ && $(MAKE) $(AM_MAKEFLAGS) check \
+ && $(MAKE) $(AM_MAKEFLAGS) install \
+ && $(MAKE) $(AM_MAKEFLAGS) installcheck \
+ && $(MAKE) $(AM_MAKEFLAGS) uninstall \
+ && (test `find $$dc_install_base -type f -print | wc -l` -le 1 \
+ || { echo "ERROR: files left after uninstall:" ; \
+ find $$dc_install_base -type f -print ; \
+ exit 1; } >&2 ) \
+ && $(MAKE) $(AM_MAKEFLAGS) dist-gzip \
+ && rm -f $(distdir).tar.gz \
+ && $(MAKE) $(AM_MAKEFLAGS) distcleancheck
+ $(am__remove_distdir)
+ @echo "$(distdir).tar.gz is ready for distribution" | \
+ sed 'h;s/./=/g;p;x;p;x'
+distcleancheck: distclean
+ if test '$(srcdir)' = . ; then \
+ echo "ERROR: distcleancheck can only run from a VPATH build" ; \
+ exit 1 ; \
+ fi
+ test `$(distcleancheck_listfiles) | wc -l` -eq 0 \
+ || { echo "ERROR: files left after distclean:" ; \
+ $(distcleancheck_listfiles) ; \
+ exit 1; } >&2
+check-am: all-am
+ $(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
+ $(MAKE) $(AM_MAKEFLAGS) check-TESTS
+check: check-recursive
+all-am: Makefile $(LTLIBRARIES) $(SCRIPTS) $(HEADERS)
+installdirs: installdirs-recursive
+installdirs-am:
+ $(mkinstalldirs) $(DESTDIR)$(libdir) $(DESTDIR)$(includedir)
+
+install: install-recursive
+install-exec: install-exec-recursive
+install-data: install-data-recursive
+uninstall: uninstall-recursive
+
+install-am: all-am
+ @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-recursive
+install-strip:
+ $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+ INSTALL_STRIP_FLAG=-s \
+ `test -z '$(STRIP)' || \
+ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+ -rm -f Makefile $(CONFIG_CLEAN_FILES)
+
+maintainer-clean-generic:
+ @echo "This command is intended for maintainers to use"
+ @echo "it deletes files that may require special tools to rebuild."
+clean: clean-recursive
+
+clean-am: clean-checkPROGRAMS clean-generic clean-libLTLIBRARIES \
+ clean-libtool mostlyclean-am
+
+distclean: distclean-recursive
+ -rm -f $(am__CONFIG_DISTCLEAN_FILES)
+distclean-am: clean-am distclean-compile distclean-depend \
+ distclean-generic distclean-libtool distclean-tags
+
+dvi: dvi-recursive
+
+dvi-am:
+
+info: info-recursive
+
+info-am:
+
+install-data-am: install-includeHEADERS
+
+install-exec-am: install-libLTLIBRARIES
+
+install-info: install-info-recursive
+
+install-man:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-recursive
+ -rm -f $(am__CONFIG_DISTCLEAN_FILES)
+ -rm -rf autom4te.cache
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-recursive
+
+mostlyclean-am: mostlyclean-compile mostlyclean-generic \
+ mostlyclean-libtool
+
+uninstall-am: uninstall-includeHEADERS uninstall-info-am \
+ uninstall-libLTLIBRARIES
+
+uninstall-info: uninstall-info-recursive
+
+.PHONY: $(RECURSIVE_TARGETS) GTAGS all all-am check check-TESTS check-am \
+ clean clean-checkPROGRAMS clean-generic clean-libLTLIBRARIES \
+ clean-libtool clean-recursive dist dist-all dist-gzip distcheck \
+ distclean distclean-compile distclean-depend distclean-generic \
+ distclean-libtool distclean-recursive distclean-tags \
+ distcleancheck distdir dvi dvi-am dvi-recursive info info-am \
+ info-recursive install install-am install-data install-data-am \
+ install-data-recursive install-exec install-exec-am \
+ install-exec-recursive install-includeHEADERS install-info \
+ install-info-am install-info-recursive install-libLTLIBRARIES \
+ install-man install-recursive install-strip installcheck \
+ installcheck-am installdirs installdirs-am \
+ installdirs-recursive maintainer-clean maintainer-clean-generic \
+ maintainer-clean-recursive mostlyclean mostlyclean-compile \
+ mostlyclean-generic mostlyclean-libtool mostlyclean-recursive \
+ tags tags-recursive uninstall uninstall-am \
+ uninstall-includeHEADERS uninstall-info-am \
+ uninstall-info-recursive uninstall-libLTLIBRARIES \
+ uninstall-recursive
+
+
+test.o: $(srcdir)/tests/test.c
+ $(COMPILE) -c $(srcdir)/tests/test.c
+# Using $< in the above seems to fail with the HP/UX on Itanium make.
+test_cpp.o: $(srcdir)/tests/test_cpp.cc
+ $(COMPILE) -c $(srcdir)/tests/test_cpp.cc
+$(all_objs) : include/private/gcconfig.h include/private/gc_priv.h \
+include/private/gc_hdrs.h include/gc.h include/gc_gcj.h \
+include/gc_pthread_redirects.h include/gc_config_macros.h \
+include/gc_mark.h @addincludes@
+
+.s.lo:
+ $(LTCOMPILE) -Wp,-P -x assembler-with-cpp -c $<
+
+#
+# :GOTCHA: GNU make rule for making .s out of .S is flawed,
+# it will not remove dest if building fails
+.S.s:
+ if $(CPP) $< >$@ ; then :; else rm -f $@; fi
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
--- /dev/null
+# Makefile for Windows NT. Assumes Microsoft compiler, and a single thread.
+# DLLs are included in the root set under NT, but not under win32S.
+# Use "nmake nodebug=1 all" for optimized versions of library, gctest and editor.
+
+CPU= i386
+!include <ntwin32.mak>
+
+OBJS= alloc.obj reclaim.obj allchblk.obj misc.obj mach_dep.obj os_dep.obj mark_rts.obj headers.obj mark.obj obj_map.obj blacklst.obj finalize.obj new_hblk.obj dbg_mlc.obj malloc.obj stubborn.obj dyn_load.obj typd_mlc.obj ptr_chck.obj gc_cpp.obj mallocx.obj
+
+all: gctest.exe cord\de.exe test_cpp.exe
+
+.c.obj:
+ $(cc) $(cdebug) $(cflags) $(cvars) -Iinclude -DSILENT -DALL_INTERIOR_POINTERS -D__STDC__ -DGC_NOT_DLL $*.c /Fo$*.obj
+
+.cpp.obj:
+ $(cc) $(cdebug) $(cflags) $(cvars) -Iinclude -DSILENT -DALL_INTERIOR_POINTERS -DGC_NOT_DLL $*.CPP /Fo$*.obj
+
+$(OBJS) tests\test.obj: include\private\gc_priv.h include\private\gc_hdrs.h include\gc.h include\private\gcconfig.h include\private\gc_locks.h include\private\gc_pmark.h include\gc_mark.h
+
+gc.lib: $(OBJS)
+ lib /MACHINE:i386 /out:gc.lib $(OBJS)
+# The original NT SDK used lib32 instead of lib
+
+gctest.exe: tests\test.obj gc.lib
+# The following works for win32 debugging. For win32s debugging use debugtype:coff
+# and add mapsympe line.
+# This produces a "GUI" applications that opens no windows and writes to the log file
+# "gc.log". This is done to make the result runnable under win32s.
+ $(link) -debug:full -debugtype:cv $(guiflags) -stack:131072 -out:$*.exe tests\test.obj $(guilibs) gc.lib
+# mapsympe -n -o gctest.sym gctest.exe
+
+cord\de_win.rbj: cord\de_win.res
+ cvtres -$(CPU) cord\de_win.res -o cord\de_win.rbj
+
+cord\de.obj cord\de_win.obj: include\cord.h include\private\cord_pos.h cord\de_win.h cord\de_cmds.h
+
+cord\de_win.res: cord\de_win.rc cord\de_win.h cord\de_cmds.h
+ $(rc) $(rcvars) -r -fo cord\de_win.res $(cvars) cord\de_win.rc
+
+# Cord/de is a real win32 gui application.
+cord\de.exe: cord\cordbscs.obj cord\cordxtra.obj cord\de.obj cord\de_win.obj cord\de_win.rbj gc.lib
+ $(link) -debug:full -debugtype:cv $(guiflags) -stack:16384 -out:cord\de.exe cord\cordbscs.obj cord\cordxtra.obj cord\de.obj cord\de_win.obj cord\de_win.rbj gc.lib $(guilibs)
+
+gc_cpp.obj: include\gc_cpp.h include\gc.h
+
+gc_cpp.cpp: gc_cpp.cc
+ copy gc_cpp.cc gc_cpp.cpp
+
+test_cpp.cpp: tests\test_cpp.cc
+ copy tests\test_cpp.cc test_cpp.cpp
+
+# This generates the C++ test executable. The executable expects
+# a single numeric argument, which is the number of iterations.
+# The output appears in the file "gc.log".
+test_cpp.exe: test_cpp.obj include\gc_cpp.h include\gc.h gc.lib
+ $(link) -debug:full -debugtype:cv $(guiflags) -stack:16384 -out:test_cpp.exe test_cpp.obj gc.lib $(guilibs)
+
+
+
--- /dev/null
+# Microsoft Developer Studio Generated NMAKE File, Format Version 4.10
+# This has been hand-edited way too many times.
+# A clean, manually generated makefile would be an improvement.
+
+# TARGTYPE "Win32 (x86) Application" 0x0101
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+
+!IF "$(CFG)" == ""
+CFG=gctest - Win32 Release
+!MESSAGE No configuration specified. Defaulting to cord - Win32 Debug.
+!ENDIF
+
+!IF "$(CFG)" != "gc - Win32 Release" && "$(CFG)" != "gc - Win32 Debug" &&\
+ "$(CFG)" != "gctest - Win32 Release" && "$(CFG)" != "gctest - Win32 Debug" &&\
+ "$(CFG)" != "cord - Win32 Release" && "$(CFG)" != "cord - Win32 Debug"
+!MESSAGE Invalid configuration "$(CFG)" specified.
+!MESSAGE You can specify a configuration when running NMAKE on this makefile
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "gc.mak" CFG="cord - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "gc - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "gc - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "gctest - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "gctest - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE "cord - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "cord - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE
+!ERROR An invalid configuration is specified.
+!ENDIF
+
+!IF "$(OS)" == "Windows_NT"
+NULL=
+!ELSE
+NULL=nul
+!ENDIF
+################################################################################
+# Begin Project
+# PROP Target_Last_Scanned "gctest - Win32 Debug"
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+OUTDIR=.\Release
+INTDIR=.\Release
+
+ALL : ".\Release\gc.dll" ".\Release\gc.bsc"
+
+CLEAN :
+ -@erase ".\Release\allchblk.obj"
+ -@erase ".\Release\allchblk.sbr"
+ -@erase ".\Release\alloc.obj"
+ -@erase ".\Release\alloc.sbr"
+ -@erase ".\Release\blacklst.obj"
+ -@erase ".\Release\blacklst.sbr"
+ -@erase ".\Release\checksums.obj"
+ -@erase ".\Release\checksums.sbr"
+ -@erase ".\Release\dbg_mlc.obj"
+ -@erase ".\Release\dbg_mlc.sbr"
+ -@erase ".\Release\dyn_load.obj"
+ -@erase ".\Release\dyn_load.sbr"
+ -@erase ".\Release\finalize.obj"
+ -@erase ".\Release\finalize.sbr"
+ -@erase ".\Release\gc.bsc"
+ -@erase ".\Release\gc_cpp.obj"
+ -@erase ".\Release\gc_cpp.sbr"
+ -@erase ".\Release\gc.dll"
+ -@erase ".\Release\gc.exp"
+ -@erase ".\Release\gc.lib"
+ -@erase ".\Release\headers.obj"
+ -@erase ".\Release\headers.sbr"
+ -@erase ".\Release\mach_dep.obj"
+ -@erase ".\Release\mach_dep.sbr"
+ -@erase ".\Release\malloc.obj"
+ -@erase ".\Release\malloc.sbr"
+ -@erase ".\Release\mallocx.obj"
+ -@erase ".\Release\mallocx.sbr"
+ -@erase ".\Release\mark.obj"
+ -@erase ".\Release\mark.sbr"
+ -@erase ".\Release\mark_rts.obj"
+ -@erase ".\Release\mark_rts.sbr"
+ -@erase ".\Release\misc.obj"
+ -@erase ".\Release\misc.sbr"
+ -@erase ".\Release\new_hblk.obj"
+ -@erase ".\Release\new_hblk.sbr"
+ -@erase ".\Release\obj_map.obj"
+ -@erase ".\Release\obj_map.sbr"
+ -@erase ".\Release\os_dep.obj"
+ -@erase ".\Release\os_dep.sbr"
+ -@erase ".\Release\ptr_chck.obj"
+ -@erase ".\Release\ptr_chck.sbr"
+ -@erase ".\Release\reclaim.obj"
+ -@erase ".\Release\reclaim.sbr"
+ -@erase ".\Release\stubborn.obj"
+ -@erase ".\Release\stubborn.sbr"
+ -@erase ".\Release\typd_mlc.obj"
+ -@erase ".\Release\typd_mlc.sbr"
+ -@erase ".\Release\win32_threads.obj"
+ -@erase ".\Release\win32_threads.sbr"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /I include /D "NDEBUG" /D "SILENT" /D "GC_BUILD" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /I include /D "NDEBUG" /D "SILENT" /D "GC_BUILD" /D\
+ "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D\
+ "GC_WIN32_THREADS" /FR"$(INTDIR)/" /Fp"$(INTDIR)/gc.pch" /YX /Fo"$(INTDIR)/" /c
+CPP_OBJS=.\Release/
+CPP_SBRS=.\Release/
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gc.bsc"
+BSC32_SBRS= \
+ ".\Release\allchblk.sbr" \
+ ".\Release\alloc.sbr" \
+ ".\Release\blacklst.sbr" \
+ ".\Release\checksums.sbr" \
+ ".\Release\dbg_mlc.sbr" \
+ ".\Release\dyn_load.sbr" \
+ ".\Release\finalize.sbr" \
+ ".\Release\gc_cpp.sbr" \
+ ".\Release\headers.sbr" \
+ ".\Release\mach_dep.sbr" \
+ ".\Release\malloc.sbr" \
+ ".\Release\mallocx.sbr" \
+ ".\Release\mark.sbr" \
+ ".\Release\mark_rts.sbr" \
+ ".\Release\misc.sbr" \
+ ".\Release\new_hblk.sbr" \
+ ".\Release\obj_map.sbr" \
+ ".\Release\os_dep.sbr" \
+ ".\Release\ptr_chck.sbr" \
+ ".\Release\reclaim.sbr" \
+ ".\Release\stubborn.sbr" \
+ ".\Release\typd_mlc.sbr" \
+ ".\Release\win32_threads.sbr"
+
+".\Release\gc.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+ $(BSC32) @<<
+ $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /dll /incremental:no\
+ /pdb:"$(OUTDIR)/gc.pdb" /machine:I386 /out:"$(OUTDIR)/gc.dll"\
+ /implib:"$(OUTDIR)/gc.lib"
+LINK32_OBJS= \
+ ".\Release\allchblk.obj" \
+ ".\Release\alloc.obj" \
+ ".\Release\blacklst.obj" \
+ ".\Release\checksums.obj" \
+ ".\Release\dbg_mlc.obj" \
+ ".\Release\dyn_load.obj" \
+ ".\Release\finalize.obj" \
+ ".\Release\gc_cpp.obj" \
+ ".\Release\headers.obj" \
+ ".\Release\mach_dep.obj" \
+ ".\Release\malloc.obj" \
+ ".\Release\mallocx.obj" \
+ ".\Release\mark.obj" \
+ ".\Release\mark_rts.obj" \
+ ".\Release\misc.obj" \
+ ".\Release\new_hblk.obj" \
+ ".\Release\obj_map.obj" \
+ ".\Release\os_dep.obj" \
+ ".\Release\ptr_chck.obj" \
+ ".\Release\reclaim.obj" \
+ ".\Release\stubborn.obj" \
+ ".\Release\typd_mlc.obj" \
+ ".\Release\win32_threads.obj"
+
+".\Release\gc.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+OUTDIR=.\Debug
+INTDIR=.\Debug
+
+ALL : ".\Debug\gc.dll" ".\Debug\gc.bsc"
+
+CLEAN :
+ -@erase ".\Debug\allchblk.obj"
+ -@erase ".\Debug\allchblk.sbr"
+ -@erase ".\Debug\alloc.obj"
+ -@erase ".\Debug\alloc.sbr"
+ -@erase ".\Debug\blacklst.obj"
+ -@erase ".\Debug\blacklst.sbr"
+ -@erase ".\Debug\checksums.obj"
+ -@erase ".\Debug\checksums.sbr"
+ -@erase ".\Debug\dbg_mlc.obj"
+ -@erase ".\Debug\dbg_mlc.sbr"
+ -@erase ".\Debug\dyn_load.obj"
+ -@erase ".\Debug\dyn_load.sbr"
+ -@erase ".\Debug\finalize.obj"
+ -@erase ".\Debug\finalize.sbr"
+ -@erase ".\Debug\gc_cpp.obj"
+ -@erase ".\Debug\gc_cpp.sbr"
+ -@erase ".\Debug\gc.bsc"
+ -@erase ".\Debug\gc.dll"
+ -@erase ".\Debug\gc.exp"
+ -@erase ".\Debug\gc.lib"
+ -@erase ".\Debug\gc.map"
+ -@erase ".\Debug\gc.pdb"
+ -@erase ".\Debug\headers.obj"
+ -@erase ".\Debug\headers.sbr"
+ -@erase ".\Debug\mach_dep.obj"
+ -@erase ".\Debug\mach_dep.sbr"
+ -@erase ".\Debug\malloc.obj"
+ -@erase ".\Debug\malloc.sbr"
+ -@erase ".\Debug\mallocx.obj"
+ -@erase ".\Debug\mallocx.sbr"
+ -@erase ".\Debug\mark.obj"
+ -@erase ".\Debug\mark.sbr"
+ -@erase ".\Debug\mark_rts.obj"
+ -@erase ".\Debug\mark_rts.sbr"
+ -@erase ".\Debug\misc.obj"
+ -@erase ".\Debug\misc.sbr"
+ -@erase ".\Debug\new_hblk.obj"
+ -@erase ".\Debug\new_hblk.sbr"
+ -@erase ".\Debug\obj_map.obj"
+ -@erase ".\Debug\obj_map.sbr"
+ -@erase ".\Debug\os_dep.obj"
+ -@erase ".\Debug\os_dep.sbr"
+ -@erase ".\Debug\ptr_chck.obj"
+ -@erase ".\Debug\ptr_chck.sbr"
+ -@erase ".\Debug\reclaim.obj"
+ -@erase ".\Debug\reclaim.sbr"
+ -@erase ".\Debug\stubborn.obj"
+ -@erase ".\Debug\stubborn.sbr"
+ -@erase ".\Debug\typd_mlc.obj"
+ -@erase ".\Debug\typd_mlc.sbr"
+ -@erase ".\Debug\vc40.idb"
+ -@erase ".\Debug\vc40.pdb"
+ -@erase ".\Debug\win32_threads.obj"
+ -@erase ".\Debug\win32_threads.sbr"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I include /D "_DEBUG" /D "SILENT" /D "GC_BUILD" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /I include /D "_DEBUG" /D "SILENT" /D "GC_BUILD"\
+ /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D\
+ "GC_WIN32_THREADS" /FR"$(INTDIR)/" /Fp"$(INTDIR)/gc.pch" /YX /Fo"$(INTDIR)/"\
+ /Fd"$(INTDIR)/" /c
+CPP_OBJS=.\Debug/
+CPP_SBRS=.\Debug/
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gc.bsc"
+BSC32_SBRS= \
+ ".\Debug\allchblk.sbr" \
+ ".\Debug\alloc.sbr" \
+ ".\Debug\blacklst.sbr" \
+ ".\Debug\checksums.sbr" \
+ ".\Debug\dbg_mlc.sbr" \
+ ".\Debug\dyn_load.sbr" \
+ ".\Debug\finalize.sbr" \
+ ".\Debug\gc_cpp.sbr" \
+ ".\Debug\headers.sbr" \
+ ".\Debug\mach_dep.sbr" \
+ ".\Debug\malloc.sbr" \
+ ".\Debug\mallocx.sbr" \
+ ".\Debug\mark.sbr" \
+ ".\Debug\mark_rts.sbr" \
+ ".\Debug\misc.sbr" \
+ ".\Debug\new_hblk.sbr" \
+ ".\Debug\obj_map.sbr" \
+ ".\Debug\os_dep.sbr" \
+ ".\Debug\ptr_chck.sbr" \
+ ".\Debug\reclaim.sbr" \
+ ".\Debug\stubborn.sbr" \
+ ".\Debug\typd_mlc.sbr" \
+ ".\Debug\win32_threads.sbr"
+
+".\Debug\gc.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+ $(BSC32) @<<
+ $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /incremental:no /map /debug /machine:I386
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /dll /incremental:no\
+ /pdb:"$(OUTDIR)/gc.pdb" /map:"$(INTDIR)/gc.map" /debug /machine:I386\
+ /out:"$(OUTDIR)/gc.dll" /implib:"$(OUTDIR)/gc.lib"
+LINK32_OBJS= \
+ ".\Debug\allchblk.obj" \
+ ".\Debug\alloc.obj" \
+ ".\Debug\blacklst.obj" \
+ ".\Debug\checksums.obj" \
+ ".\Debug\dbg_mlc.obj" \
+ ".\Debug\dyn_load.obj" \
+ ".\Debug\finalize.obj" \
+ ".\Debug\gc_cpp.obj" \
+ ".\Debug\headers.obj" \
+ ".\Debug\mach_dep.obj" \
+ ".\Debug\malloc.obj" \
+ ".\Debug\mallocx.obj" \
+ ".\Debug\mark.obj" \
+ ".\Debug\mark_rts.obj" \
+ ".\Debug\misc.obj" \
+ ".\Debug\new_hblk.obj" \
+ ".\Debug\obj_map.obj" \
+ ".\Debug\os_dep.obj" \
+ ".\Debug\ptr_chck.obj" \
+ ".\Debug\reclaim.obj" \
+ ".\Debug\stubborn.obj" \
+ ".\Debug\typd_mlc.obj" \
+ ".\Debug\win32_threads.obj"
+
+".\Debug\gc.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "gctest\Release"
+# PROP BASE Intermediate_Dir "gctest\Release"
+# PROP BASE Target_Dir "gctest"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "gctest\Release"
+# PROP Intermediate_Dir "gctest\Release"
+# PROP Target_Dir "gctest"
+OUTDIR=.\gctest\Release
+INTDIR=.\gctest\Release
+
+ALL : "gc - Win32 Release" ".\Release\gctest.exe"
+
+CLEAN :
+ -@erase ".\gctest\Release\test.obj"
+ -@erase ".\Release\gctest.exe"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+test.c : tests\test.c
+ copy tests\test.c test.c
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /I include /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /I include /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D\
+ "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS"\
+ /Fp"$(INTDIR)/gctest.pch" /YX /Fo"$(INTDIR)/" /c
+CPP_OBJS=.\gctest\Release/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gctest.bsc"
+BSC32_SBRS= \
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /out:"Release/gctest.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no\
+ /pdb:"$(OUTDIR)/gctest.pdb" /machine:I386 /out:"Release/gctest.exe"
+LINK32_OBJS= \
+ ".\gctest\Release\test.obj" \
+ ".\Release\gc.lib"
+
+".\Release\gctest.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "gctest\Debug"
+# PROP BASE Intermediate_Dir "gctest\Debug"
+# PROP BASE Target_Dir "gctest"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "gctest\Debug"
+# PROP Intermediate_Dir "gctest\Debug"
+# PROP Target_Dir "gctest"
+OUTDIR=.\gctest\Debug
+INTDIR=.\gctest\Debug
+
+ALL : "gc - Win32 Debug" ".\Debug\gctest.exe" ".\gctest\Debug\gctest.bsc"
+
+CLEAN :
+ -@erase ".\Debug\gctest.exe"
+ -@erase ".\gctest\Debug\gctest.bsc"
+ -@erase ".\gctest\Debug\gctest.map"
+ -@erase ".\gctest\Debug\gctest.pdb"
+ -@erase ".\gctest\Debug\test.obj"
+ -@erase ".\gctest\Debug\test.sbr"
+ -@erase ".\gctest\Debug\vc40.idb"
+ -@erase ".\gctest\Debug\vc40.pdb"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /I include /D "_DEBUG" /D "WIN32" /D "_WINDOWS"\
+ /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /FR"$(INTDIR)/"\
+ /Fp"$(INTDIR)/gctest.pch" /YX /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c
+CPP_OBJS=.\gctest\Debug/
+CPP_SBRS=.\gctest\Debug/
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gctest.bsc"
+BSC32_SBRS= \
+ ".\gctest\Debug\test.sbr"
+
+".\gctest\Debug\gctest.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+ $(BSC32) @<<
+ $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /incremental:no /map /debug /machine:I386 /out:"Debug/gctest.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no\
+ /pdb:"$(OUTDIR)/gctest.pdb" /map:"$(INTDIR)/gctest.map" /debug /machine:I386\
+ /out:"Debug/gctest.exe"
+LINK32_OBJS= \
+ ".\Debug\gc.lib" \
+ ".\gctest\Debug\test.obj"
+
+".\Debug\gctest.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "cord - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "cord\Release"
+# PROP BASE Intermediate_Dir "cord\Release"
+# PROP BASE Target_Dir "cord"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "cord\Release"
+# PROP Intermediate_Dir "cord\Release"
+# PROP Target_Dir "cord"
+OUTDIR=.\cord\Release
+INTDIR=.\cord\Release
+
+ALL : "gc - Win32 Release" ".\Release\de.exe"
+
+CLEAN :
+ -@erase ".\cord\Release\cordbscs.obj"
+ -@erase ".\cord\Release\cordxtra.obj"
+ -@erase ".\cord\Release\de.obj"
+ -@erase ".\cord\Release\de_win.obj"
+ -@erase ".\cord\Release\de_win.res"
+ -@erase ".\Release\de.exe"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /I "." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /I "." /I include /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D\
+ "ALL_INTERIOR_POINTERS" /Fp"$(INTDIR)/cord.pch" /YX /Fo"$(INTDIR)/" /c
+CPP_OBJS=.\cord\Release/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+RSC_PROJ=/l 0x809 /fo"$(INTDIR)/de_win.res" /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/cord.bsc"
+BSC32_SBRS= \
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /out:"Release/de.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no /pdb:"$(OUTDIR)/de.pdb"\
+ /machine:I386 /out:"Release/de.exe"
+LINK32_OBJS= \
+ ".\cord\Release\cordbscs.obj" \
+ ".\cord\Release\cordxtra.obj" \
+ ".\cord\Release\de.obj" \
+ ".\cord\Release\de_win.obj" \
+ ".\cord\Release\de_win.res" \
+ ".\Release\gc.lib"
+
+".\Release\de.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "cord\Debug"
+# PROP BASE Intermediate_Dir "cord\Debug"
+# PROP BASE Target_Dir "cord"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "cord\Debug"
+# PROP Intermediate_Dir "cord\Debug"
+# PROP Target_Dir "cord"
+OUTDIR=.\cord\Debug
+INTDIR=.\cord\Debug
+
+ALL : "gc - Win32 Debug" ".\Debug\de.exe"
+
+CLEAN :
+ -@erase ".\cord\Debug\cordbscs.obj"
+ -@erase ".\cord\Debug\cordxtra.obj"
+ -@erase ".\cord\Debug\de.obj"
+ -@erase ".\cord\Debug\de.pdb"
+ -@erase ".\cord\Debug\de_win.obj"
+ -@erase ".\cord\Debug\de_win.res"
+ -@erase ".\cord\Debug\vc40.idb"
+ -@erase ".\cord\Debug\vc40.pdb"
+ -@erase ".\Debug\de.exe"
+ -@erase ".\Debug\de.ilk"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /I "." /I include /D "_DEBUG" /D "WIN32" /D\
+ "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /Fp"$(INTDIR)/cord.pch" /YX\
+ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c
+CPP_OBJS=.\cord\Debug/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+RSC_PROJ=/l 0x809 /fo"$(INTDIR)/de_win.res" /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/cord.bsc"
+BSC32_SBRS= \
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /out:"Debug/de.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:yes\
+ /pdb:"$(OUTDIR)/de.pdb" /debug /machine:I386 /out:"Debug/de.exe"
+LINK32_OBJS= \
+ ".\cord\Debug\cordbscs.obj" \
+ ".\cord\Debug\cordxtra.obj" \
+ ".\cord\Debug\de.obj" \
+ ".\cord\Debug\de_win.obj" \
+ ".\cord\Debug\de_win.res" \
+ ".\Debug\gc.lib"
+
+".\Debug\de.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ENDIF
+
+################################################################################
+# Begin Target
+
+# Name "gc - Win32 Release"
+# Name "gc - Win32 Debug"
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+!ENDIF
+
+################################################################################
+# Begin Source File
+
+SOURCE=.\gc_cpp.cpp
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_RECLA=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_cpp.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_RECLA=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\gc_cpp.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Release\gc_cpp.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_RECLA=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_cpp.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_RECLA=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\gc_cpp.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Debug\gc_cpp.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\reclaim.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_RECLA=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_RECLA=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\reclaim.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Release\reclaim.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_RECLA=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_RECLA=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\reclaim.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Debug\reclaim.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+
+################################################################################
+# Begin Source File
+
+SOURCE=.\os_dep.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_OS_DE=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\STAT.H"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_OS_DE=\
+ ".\il\PCR_IL.h"\
+ ".\mm\PCR_MM.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+ ".\vd\PCR_VD.h"\
+
+
+".\Release\os_dep.obj" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+".\Release\os_dep.sbr" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_OS_DE=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\STAT.H"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_OS_DE=\
+ ".\il\PCR_IL.h"\
+ ".\mm\PCR_MM.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+ ".\vd\PCR_VD.h"\
+
+
+".\Debug\os_dep.obj" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+".\Debug\os_dep.sbr" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\misc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MISC_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MISC_=\
+ ".\il\PCR_IL.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\misc.obj" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+".\Release\misc.sbr" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MISC_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MISC_=\
+ ".\il\PCR_IL.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\misc.obj" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+".\Debug\misc.sbr" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mark_rts.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MARK_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MARK_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\mark_rts.obj" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+".\Release\mark_rts.sbr" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MARK_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MARK_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\mark_rts.obj" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+".\Debug\mark_rts.sbr" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mach_dep.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MACH_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MACH_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\mach_dep.obj" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+".\Release\mach_dep.sbr" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MACH_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MACH_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\mach_dep.obj" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+".\Debug\mach_dep.sbr" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\headers.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_HEADE=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_HEADE=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\headers.obj" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+".\Release\headers.sbr" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_HEADE=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_HEADE=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\headers.obj" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+".\Debug\headers.sbr" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\alloc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_ALLOC=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_ALLOC=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\alloc.obj" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+".\Release\alloc.sbr" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_ALLOC=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_ALLOC=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\alloc.obj" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+".\Debug\alloc.sbr" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\allchblk.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_ALLCH=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_ALLCH=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\allchblk.obj" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+".\Release\allchblk.sbr" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_ALLCH=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_ALLCH=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\allchblk.obj" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+".\Debug\allchblk.sbr" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\stubborn.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_STUBB=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_STUBB=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\stubborn.obj" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+".\Release\stubborn.sbr" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_STUBB=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_STUBB=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\stubborn.obj" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+".\Debug\stubborn.sbr" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\obj_map.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_OBJ_M=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_OBJ_M=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\obj_map.obj" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+".\Release\obj_map.sbr" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_OBJ_M=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_OBJ_M=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\obj_map.obj" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+".\Debug\obj_map.sbr" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\new_hblk.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_NEW_H=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_NEW_H=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\new_hblk.obj" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+".\Release\new_hblk.sbr" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_NEW_H=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_NEW_H=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\new_hblk.obj" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+".\Debug\new_hblk.sbr" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mark.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MARK_C=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MARK_C=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\mark.obj" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+".\Release\mark.sbr" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MARK_C=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MARK_C=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\mark.obj" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+".\Debug\mark.sbr" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\malloc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MALLO=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MALLO=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\malloc.obj" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+".\Release\malloc.sbr" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MALLO=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MALLO=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\malloc.obj" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+".\Debug\malloc.sbr" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mallocx.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MALLX=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MALLX=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\mallocx.obj" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+".\Release\mallocx.sbr" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MALLX=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MALLX=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\mallocx.obj" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+".\Debug\mallocx.sbr" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\finalize.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_FINAL=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_FINAL=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\finalize.obj" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+".\Release\finalize.sbr" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_FINAL=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_FINAL=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\finalize.obj" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+".\Debug\finalize.sbr" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\dbg_mlc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_DBG_M=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_DBG_M=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\dbg_mlc.obj" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+".\Release\dbg_mlc.sbr" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_DBG_M=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_DBG_M=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\dbg_mlc.obj" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+".\Debug\dbg_mlc.sbr" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\blacklst.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_BLACK=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_BLACK=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\blacklst.obj" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+".\Release\blacklst.sbr" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_BLACK=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_BLACK=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\blacklst.obj" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+".\Debug\blacklst.sbr" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\typd_mlc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_TYPD_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_typed.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_TYPD_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\typd_mlc.obj" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+".\Release\typd_mlc.sbr" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_TYPD_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_typed.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_TYPD_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\typd_mlc.obj" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+".\Debug\typd_mlc.sbr" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\ptr_chck.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_PTR_C=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_PTR_C=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\ptr_chck.obj" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+".\Release\ptr_chck.sbr" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_PTR_C=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_PTR_C=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\ptr_chck.obj" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+".\Debug\ptr_chck.sbr" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\dyn_load.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_DYN_L=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\STAT.H"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_DYN_L=\
+ ".\il\PCR_IL.h"\
+ ".\mm\PCR_MM.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\dyn_load.obj" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+".\Release\dyn_load.sbr" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_DYN_L=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\STAT.H"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_DYN_L=\
+ ".\il\PCR_IL.h"\
+ ".\mm\PCR_MM.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\dyn_load.obj" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+".\Debug\dyn_load.sbr" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\win32_threads.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_WIN32=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_WIN32=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\win32_threads.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+".\Release\win32_threads.sbr" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_WIN32=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_WIN32=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\win32_threads.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+".\Debug\win32_threads.sbr" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\checksums.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_CHECK=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_CHECK=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\checksums.obj" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+".\Release\checksums.sbr" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_CHECK=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_CHECK=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\checksums.obj" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+".\Debug\checksums.sbr" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+# End Target
+################################################################################
+# Begin Target
+
+# Name "gctest - Win32 Release"
+# Name "gctest - Win32 Debug"
+
+!IF "$(CFG)" == "gctest - Win32 Release"
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Debug"
+
+!ENDIF
+
+################################################################################
+# Begin Project Dependency
+
+# Project_Dep_Name "gc"
+
+!IF "$(CFG)" == "gctest - Win32 Release"
+
+"gc - Win32 Release" :
+ $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Release"
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Debug"
+
+"gc - Win32 Debug" :
+ $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Debug"
+
+!ENDIF
+
+# End Project Dependency
+################################################################################
+# Begin Source File
+
+SOURCE=.\tests\test.c
+DEP_CPP_TEST_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_typed.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_TEST_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+!IF "$(CFG)" == "gctest - Win32 Release"
+
+
+".\gctest\Release\test.obj" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Debug"
+
+
+".\gctest\Debug\test.obj" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+".\gctest\Debug\test.sbr" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+# End Target
+################################################################################
+# Begin Target
+
+# Name "cord - Win32 Release"
+# Name "cord - Win32 Debug"
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+!ENDIF
+
+################################################################################
+# Begin Project Dependency
+
+# Project_Dep_Name "gc"
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+"gc - Win32 Release" :
+ $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Release"
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+"gc - Win32 Debug" :
+ $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Debug"
+
+!ENDIF
+
+# End Project Dependency
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de_win.c
+DEP_CPP_DE_WI=\
+ ".\include\cord.h"\
+ ".\cord\de_cmds.h"\
+ ".\cord\de_win.h"\
+ ".\include\private\cord_pos.h"\
+
+NODEP_CPP_DE_WI=\
+ ".\include\gc.h"\
+
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de_win.obj" : $(SOURCE) $(DEP_CPP_DE_WI) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de_win.obj" : $(SOURCE) $(DEP_CPP_DE_WI) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de.c
+DEP_CPP_DE_C2e=\
+ ".\include\cord.h"\
+ ".\cord\de_cmds.h"\
+ ".\cord\de_win.h"\
+ ".\include\private\cord_pos.h"\
+
+NODEP_CPP_DE_C2e=\
+ ".\include\gc.h"\
+
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de.obj" : $(SOURCE) $(DEP_CPP_DE_C2e) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de.obj" : $(SOURCE) $(DEP_CPP_DE_C2e) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\cordxtra.c
+DEP_CPP_CORDX=\
+ ".\include\cord.h"\
+ ".\include\ec.h"\
+ ".\include\private\cord_pos.h"\
+
+NODEP_CPP_CORDX=\
+ ".\include\gc.h"\
+
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\cordxtra.obj" : $(SOURCE) $(DEP_CPP_CORDX) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\cordxtra.obj" : $(SOURCE) $(DEP_CPP_CORDX) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\cordbscs.c
+DEP_CPP_CORDB=\
+ ".\include\cord.h"\
+ ".\include\private\cord_pos.h"\
+
+NODEP_CPP_CORDB=\
+ ".\include\gc.h"\
+
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\cordbscs.obj" : $(SOURCE) $(DEP_CPP_CORDB) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\cordbscs.obj" : $(SOURCE) $(DEP_CPP_CORDB) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de_win.RC
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de_win.res" : $(SOURCE) "$(INTDIR)"
+ $(RSC) /l 0x809 /fo"$(INTDIR)/de_win.res" /i "cord" /d "NDEBUG" $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de_win.res" : $(SOURCE) "$(INTDIR)"
+ $(RSC) /l 0x809 /fo"$(INTDIR)/de_win.res" /i "cord" /d "_DEBUG" $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+# End Target
+# End Project
+################################################################################
--- /dev/null
+# Makefile for OS/2. Assumes IBM's compiler, static linking, and a single thread.
+# Adding dynamic linking support seems easy, but takes a little bit of work.
+# Adding thread support may be nontrivial, since we haven't yet figured out how to
+# look at another thread's registers.
+
+# Significantly revised for GC version 4.4 by Mark Boulter (Jan 1994).
+
+OBJS= alloc.obj reclaim.obj allchblk.obj misc.obj mach_dep.obj os_dep.obj mark_rts.obj headers.obj mark.obj obj_map.obj blacklst.obj finalize.obj new_hblk.obj dbg_mlc.obj malloc.obj stubborn.obj typd_mlc.obj ptr_chck.obj mallocx.obj
+
+CORDOBJS= cord\cordbscs.obj cord\cordxtra.obj cord\cordprnt.obj
+
+CC= icc
+CFLAGS= /O /Q /DSILENT /DSMALL_CONFIG /DALL_INTERIOR_POINTERS
+# Use /Ti instead of /O for debugging
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+
+all: $(OBJS) gctest.exe cord\cordtest.exe
+
+$(OBJS) test.obj: include\private\gc_priv.h include\private\gc_hdrs.h include\gc.h include\private\gcconfig.h
+
+## ERASE THE LIB FIRST - if it is already there then this command will fail
+## (make sure its there or erase will fail!)
+gc.lib: $(OBJS)
+ echo . > gc.lib
+ erase gc.lib
+ LIB gc.lib $(OBJS), gc.lst
+
+mach_dep.obj: mach_dep.c
+ $(CC) $(CFLAGS) /C mach_dep.c
+
+gctest.exe: test.obj gc.lib
+ $(CC) $(CFLAGS) /B"/STACK:524288" /Fegctest test.obj gc.lib
+
+cord\cordbscs.obj: cord\cordbscs.c include\cord.h include\private\cord_pos.h
+ $(CC) $(CFLAGS) /C /Focord\cordbscs cord\cordbscs.c
+
+cord\cordxtra.obj: cord\cordxtra.c include\cord.h include\private\cord_pos.h include\ec.h
+ $(CC) $(CFLAGS) /C /Focord\cordxtra cord\cordxtra.c
+
+cord\cordprnt.obj: cord\cordprnt.c include\cord.h include\private\cord_pos.h include\ec.h
+ $(CC) $(CFLAGS) /C /Focord\cordprnt cord\cordprnt.c
+
+cord\cordtest.exe: cord\cordtest.c include\cord.h include\private\cord_pos.h include\ec.h $(CORDOBJS) gc.lib
+ $(CC) $(CFLAGS) /B"/STACK:65536" /Fecord\cordtest cord\cordtest.c gc.lib $(CORDOBJS)
--- /dev/null
+#
+# Default target
+#
+
+default: gc.o
+
+include ../config/common.mk
+
+#
+# compilation flags, etc.
+#
+
+
+CPPFLAGS = $(INCLUDE) $(CONFIG_CPPFLAGS) \
+ -DPCR_NO_RENAME -DPCR_NO_HOSTDEP_ERR
+#CFLAGS = -DPCR -DSILENT $(CONFIG_CFLAGS)
+CFLAGS = -DPCR $(CONFIG_CFLAGS)
+SPECIALCFLAGS = # For code involving asm's
+
+ASPPFLAGS = $(INCLUDE) $(CONFIG_ASPPFLAGS) \
+ -DPCR_NO_RENAME -DPCR_NO_HOSTDEP_ERR -DASM
+
+ASFLAGS = $(CONFIG_ASFLAGS)
+
+LDRFLAGS = $(CONFIG_LDRFLAGS)
+
+LDFLAGS = $(CONFIG_LDFLAGS)
+
+#
+#
+#
+#
+# BEGIN PACKAGE-SPECIFIC PART
+#
+#
+#
+#
+
+# Fix to point to local pcr installation directory.
+PCRDIR= ..
+
+COBJ= alloc.o reclaim.o allchblk.o misc.o os_dep.o mark_rts.o headers.o mark.o obj_map.o pcr_interface.o blacklst.o finalize.o new_hblk.o real_malloc.o dyn_load.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o typd_mlc.o ptr_chck.o mallocx.o
+
+CSRC= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c typd_mlc.c ptr_chck.c mallocx.c
+
+SHELL= /bin/sh
+
+default: gc.o
+
+gc.o: $(COBJ) mach_dep.o
+ $(LDR) $(CONFIG_LDRFLAGS) -o gc.o $(COBJ) mach_dep.o
+
+
+mach_dep.o: mach_dep.c mips_mach_dep.s rs6000_mach_dep.s if_mach if_not_there
+ rm -f mach_dep.o
+ ./if_mach MIPS "" as -o mach_dep.o mips_mach_dep.s
+ ./if_mach RS6000 "" as -o mach_dep.o rs6000_mach_dep.s
+ ./if_mach ALPHA "" as -o mach_dep.o alpha_mach_dep.s
+ ./if_mach SPARC SUNOS5 as -o mach_dep.o sparc_mach_dep.s
+ ./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) mach_dep.c
+
+if_mach: if_mach.c gcconfig.h
+ $(CC) $(CFLAGS) -o if_mach if_mach.c
+
+if_not_there: if_not_there.c
+ $(CC) $(CFLAGS) -o if_not_there if_not_there.c
+
+
--- /dev/null
+Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved.
+Copyright (c) 1999-2001 by Hewlett-Packard. All rights reserved.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+
+Permission is hereby granted to use or copy this program
+for any purpose, provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is granted,
+provided the above notices are retained, and a notice that the code was
+modified is included with the above copyright notice.
+
+A few files have other copyright holders. A few of the files needed
+to use the GNU-style build procedure come with a modified GPL license
+that appears not to significantly restrict use of the collector, though
+use of those files for a purpose other than building the collector may
+require the resulting code to be covered by the GPL.
+
+For more details and the names of other contributors, see the
+doc/README* files and include/gc.h. This file describes typical use of
+the collector on a machine that is already supported.
+
+For the version number, see doc/README or version.h.
+
+INSTALLATION:
+Under UN*X, Linux:
+Alternative 1 (the old way): type "make test" in this directory.
+ Link against gc.a.
+
+Alternative 2 (the new way): type
+ "./configure --prefix=<dir>; make; make check; make install".
+ Link against <dir>/lib/libgc.a or <dir>/lib/libgc.so.
+ See README.autoconf for details
+
+Under OS/2 or Windows 95, 98, Me, NT, or 2000:
+copy the appropriate makefile to MAKEFILE, read it, and type "nmake test".
+(Under Windows, this assumes you have Microsoft command-line tools
+installed, and have DOS configured with enough environment space to run them.)
+Read the machine specific README in the doc directory if one exists.
+The only way to develop code with the collector for Windows 3.1 is
+to develop under Windows NT or 95+, and then to use win32S.
+
+If you need thread support, you will need to either follow the special
+platform-dependent instructions (win32), or add a suitable define
+option as described in Makefile.
+
+If you wish to use the cord (structured string) library, type
+"make cords". (This requires an ANSI C compiler. You may need
+to redefine CC in the Makefile. The CORD_printf implementation in
+cordprnt.c is known to be less than perfectly portable. The rest
+of the package should still work.)
+
+If you wish to use the collector from C++, type
+"make c++". These add further files to gc.a and to the include
+subdirectory. See cord/cord.h and include/gc_cpp.h.
+
+TYPICAL USE:
+Include "gc.h" from the include subdirectory. Link against the
+appropriate library ("gc.a" under UN*X). Replace calls to malloc
+by calls to GC_MALLOC, and calls to realloc by calls to GC_REALLOC.
+If the object is known to never contain pointers, use GC_MALLOC_ATOMIC
+instead of GC_MALLOC.
+
+Define GC_DEBUG before including gc.h for additional checking.
+
+More documentation on the collector interface can be found at
+http://www.hpl.hp.com/personal/Hans_Boehm/gc/gcinterface.html,
+in doc/README, and in include/gc.h .
+
+WARNINGS:
+
+Do not store the only pointer to an object in memory allocated
+with system malloc, since the collector usually does not scan
+memory allocated in this way.
+
+Use with threads may be supported on your system, but requires the
+collector to be built with thread support. See Makefile. The collector
+does not guarantee to scan thread-local storage (e.g. of the kind
+accessed with pthread_getspecific()). The collector does scan
+thread stacks though, so generally the best solution is to ensure that
+any pointers stored in thread-local storage are also stored on the
+thread's stack for the duration of their lifetime.
+
--- /dev/null
+
+# Rewritten smakefile for amiga / sas/c. -Kjetil M.
+# Dont use the cord-package if you define parm=both or parm=reg.
+
+
+#----------------TOOLS--------------------------------
+CC=sc
+LINKER=slink
+LIBER=oml
+
+#----------------CPU OPTIONS--------------------------
+
+CPU=68060
+
+#----------------FPU OPTIONS--------------------------
+
+MATH=8
+MATHLIB=LIB:scm881.lib
+
+#----------------COMPILER OPTIONS---------------------
+
+IGNORE= IGNORE=85 IGNORE=154 IGNORE=161 IGNORE=100
+
+OPTIMIZE=optimize optimizetime optglobal optimizerdepth=100 optimizerpeephole optloop OPTSCHED optimizerinlocal optimizerrecurdepth=100
+# optimizerinline optimizercomplexity=100
+
+OPT= $(OPTIMIZE) CPU=$(CPU) math=$(MATH) NOSTACKCHECK VERBOSE \
+MAPHUNK NOVERSION NOICONS nodebug \
+DEFINE SILENT \
+parm=reg \
+DEFINE __USE_SYSBASE
+
+
+SOPT= $(OPT) $(IGNORE) \
+DEFINE AMIGA_SKIP_SEG \
+DEFINE ATOMIC_UNCOLLECTABLE \
+DEFINE GC_AMIGA_FASTALLOC \
+DEFINE GC_AMIGA_RETRY \
+DEFINE GC_AMIGA_PRINTSTATS \
+DEFINE GC_AMIGA_GC
+
+
+#DEFINE ALL_INTERIOR_POINTERS \
+
+
+SCOPT= $(SOPT) define GC_AMIGA_MAKINGLIB
+
+CSCOPT= $(OPT) DEFINE AMIGA IGNORE=100 IGNORE=161
+
+#------------------LINKING----------------------------
+
+
+all: gctest setjmp_t cord/cordtest
+
+clean:
+ delete *.lib gctest setjmp_t *.o *.lnk cord/*.o cord/*.lib cord/*.lnk cord/cordtest
+ smake
+
+test: setjmp_t gctest cord/cordtest
+ setjmp_t
+ gctest
+ cord/cordtest
+
+gctest: gc$(CPU).lib GCAmigaOS$(CPU).lib test.o
+ $(LINKER) LIB:c.o test.o TO gctest LIB gc$(CPU).lib LIB:sc.lib $(MATHLIB)
+
+setjmp_t: setjmp_t.o gc.h
+ $(LINKER) LIB:c.o setjmp_t.o to setjmp_t lib LIB:sc.lib
+
+cord/cordtest: cord/cordtest.o cord/cord$(CPU).lib gc$(CPU).lib
+ slink LIB:c.o cord/cordtest.o LIB $(MATHLIB) gc$(CPU).lib cord/cord$(CPU).lib LIB:sc.lib TO cord/cordtest
+
+
+#------------------LIBBING----------------------------
+
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o real_malloc.o dyn_load.o dbg_mlc.o malloc.o stubborn.o checksums.o typd_mlc.o ptr_chck.o mallocx.o
+
+gc$(CPU).lib: $(OBJS)
+ $(LIBER) gc$(CPU).lib r $(OBJS)
+
+
+COBJS = cord/cordbscs.o cord/cordprnt.o cord/cordxtra.o
+
+cord/cord$(CPU).lib: $(COBJS)
+ oml cord/cord$(CPU).lib r $(COBJS)
+
+#------------------COMPILING--------------------------
+
+INC= gc_private.h gc_hdrs.h gc.h gcconfig.h
+
+alloc.o : alloc.c $(INC)
+ $(CC) alloc.c $(SCOPT) ignore=7
+
+reclaim.o : reclaim.c $(INC)
+ $(CC) reclaim.c $(SCOPT)
+
+allchblk.o : allchblk.c $(INC)
+ $(CC) allchblk.c $(SCOPT)
+
+misc.o : misc.c $(INC)
+ $(CC) misc.c $(SCOPT)
+
+os_dep.o : os_dep.c $(INC) AmigaOS.c
+ $(CC) os_dep.c $(SCOPT)
+
+mark_rts.o : mark_rts.c $(INC)
+ $(CC) mark_rts.c $(SCOPT)
+
+headers.o : headers.c $(INC)
+ $(CC) headers.c $(SCOPT)
+
+mark.o : mark.c $(INC)
+ $(CC) mark.c $(SCOPT)
+
+obj_map.o : obj_map.c $(INC)
+ $(CC) obj_map.c $(SCOPT)
+
+blacklst.o : blacklst.c $(INC)
+ $(CC) blacklst.c $(SCOPT)
+
+finalize.o : finalize.c $(INC)
+ $(CC) finalize.c $(SCOPT) noopt #Could sas/c still have problems with this one? Gctest sometimes fails to finalize all.
+
+new_hblk.o : new_hblk.c $(INC)
+ $(CC) new_hblk.c $(SCOPT)
+
+real_malloc.o : real_malloc.c $(INC)
+ $(CC) real_malloc.c $(SCOPT)
+
+dyn_load.o : dyn_load.c $(INC)
+ $(CC) dyn_load.c $(SCOPT)
+
+dbg_mlc.o : dbg_mlc.c $(INC)
+ $(CC) dbg_mlc.c $(SCOPT)
+
+malloc.o : malloc.c $(INC)
+ $(CC) malloc.c $(SCOPT)
+
+mallocx.o : mallocx.c $(INC)
+ $(CC) mallocx.c $(SCOPT)
+
+stubborn.o : stubborn.c $(INC)
+ $(CC) stubborn.c $(SCOPT)
+
+checksums.o : checksums.c $(INC)
+ $(CC) checksums.c $(SCOPT)
+
+typd_mlc.o: typd_mlc.c $(INC)
+ $(CC) typd_mlc.c $(SCOPT)
+
+mach_dep.o : mach_dep.c $(INC)
+ $(CC) mach_dep.c $(SCOPT)
+
+ptr_chck.o: ptr_chck.c $(INC)
+ $(CC) ptr_chck.c $(SCOPT)
+
+test.o : test.c $(INC)
+ $(CC) test.c $(SOPT)
+
+setjmp_t: setjmp_t.c gc.h
+ $(CC) setjmp_t.c $(SOPT)
+
+
+# cords:
+
+cord/cordbscs.o: cord/cordbscs.c
+ sc cord/cordbscs.c $(CSCOPT)
+
+cord/cordprnt.o: cord/cordprnt.c
+ sc cord/cordprnt.c $(CSCOPT)
+
+cord/cordxtra.o: cord/cordxtra.c
+ sc cord/cordxtra.c $(CSCOPT)
+
+cord/cordtest.o: cord/cordtest.c
+ sc cord/cordtest.c $(CSCOPT)
+
+
--- /dev/null
+# Makefile for Watcom C/C++ 10.5, 10.6, 11.0 on NT, OS2 and DOS4GW.
+# May work with Watcom 10.0.
+
+# Uncoment one of the lines below for cross compilation.
+SYSTEM=MSWIN32
+#SYSTEM=DOS4GW
+#SYSTEM=OS2
+
+# The collector can be built either as dynamic or as static library.
+# Select the library type you need.
+#MAKE_AS_DLL=1
+MAKE_AS_LIB=1
+
+# Select calling conventions.
+# Possible choices are r and s.
+CALLING=s
+
+# Select target CPU.
+# Possible choices are 3, 4, 5, and 6.
+# The last choice available only since version 11.0.
+CPU=5
+
+# Set optimization options.
+# Watcom before 11.0 does not support option "-oh".
+OPTIM=-oneatx -s
+#OPTIM=-ohneatx -s
+
+DEFS=-DALL_INTERIOR_POINTERS -DSILENT -DNO_SIGNALS #-DSMALL_CONFIG #-DGC_DEBUG
+
+
+#####
+
+!ifndef SYSTEM
+!ifdef __MSDOS__
+SYSTEM=DOS4GW
+!else ifdef __NT__
+SYSTEM=MSWIN32
+!else ifdef __OS2__
+SYSTEM=OS2
+!else
+SYSTEM=Unknown
+!endif
+!endif
+
+!define $(SYSTEM)
+
+!ifdef DOS4GW
+SYSFLAG=-DDOS4GW -bt=dos
+!else ifdef MSWIN32
+SYSFLAG=-DMSWIN32 -bt=nt
+!else ifdef OS2
+SYSFLAG=-DOS2 -bt=os2
+!else
+!error undefined or unsupported target platform: $(SYSTEM)
+!endif
+!ifdef MAKE_AS_DLL
+DLLFLAG=-bd -DGC_DLL
+TEST_DLLFLAG=-DGC_DLL
+!else ifdef MAKE_AS_LIB
+DLLFLAG=
+TEST_DLLFLAG=
+!else
+!error Either MAKE_AS_LIB or MAKE_AS_DLL should be defined
+!endif
+
+CC=wcc386
+CXX=wpp386
+
+# -DUSE_GENERIC is required !
+CFLAGS=-$(CPU)$(CALLING) $(OPTIM) -zp4 -zc $(SYSFLAG) $(DLLFLAG) -DGC_BUILD -DUSE_GENERIC $(DEFS)
+CXXFLAGS= $(CFLAGS)
+TEST_CFLAGS=-$(CPU)$(CALLING) $(OPTIM) -zp4 -zc $(SYSFLAG) $(TEST_DLLFLAG) $(DEFS)
+TEST_CXXFLAGS= $(TEST_CFLAGS)
+
+OBJS= alloc.obj reclaim.obj allchblk.obj misc.obj &
+ mach_dep.obj os_dep.obj mark_rts.obj headers.obj mark.obj &
+ obj_map.obj blacklst.obj finalize.obj new_hblk.obj &
+ dbg_mlc.obj malloc.obj stubborn.obj dyn_load.obj &
+ typd_mlc.obj ptr_chck.obj mallocx.obj
+
+all: gc.lib gctest.exe test_cpp.exe
+
+!ifdef MAKE_AS_DLL
+
+gc.lib: gc.dll gc_cpp.obj
+ *wlib -b -c -n -p=512 $@ +gc.dll +gc_cpp.obj
+
+gc.dll: $(OBJS) .AUTODEPEND
+ @%create $*.lnk
+!ifdef DOS4GW
+ @%append $*.lnk sys os2v2_dll
+!else ifdef MSWIN32
+ @%append $*.lnk sys nt_dll
+!else ifdef OS2
+ @%append $*.lnk sys os2v2_dll
+!endif
+ @%append $*.lnk name $*
+ @for %i in ($(OBJS)) do @%append $*.lnk file '%i'
+!ifeq CALLING s
+ @%append $*.lnk export GC_is_marked
+ @%append $*.lnk export GC_incr_words_allocd
+ @%append $*.lnk export GC_incr_mem_freed
+ @%append $*.lnk export GC_generic_malloc_words_small
+!else
+ @%append $*.lnk export GC_is_marked_
+ @%append $*.lnk export GC_incr_words_allocd_
+ @%append $*.lnk export GC_incr_mem_freed_
+ @%append $*.lnk export GC_generic_malloc_words_small_
+!endif
+ *wlink @$*.lnk
+!else
+gc.lib: $(OBJS) gc_cpp.obj
+ @%create $*.lb1
+ @for %i in ($(OBJS)) do @%append $*.lb1 +'%i'
+ @%append $*.lb1 +'gc_cpp.obj'
+ *wlib -b -c -n -p=512 $@ @$*.lb1
+
+!endif
+
+
+gctest.exe: test.obj gc.lib
+ %create $*.lnk
+!ifdef DOS4GW
+ @%append $*.lnk sys dos4g
+!else ifdef MSWIN32
+ @%append $*.lnk sys nt
+!else ifdef OS2
+ @%append $*.lnk sys os2v2
+!endif
+ @%append $*.lnk op case
+ @%append $*.lnk op stack=256K
+ @%append $*.lnk name $*
+ @%append $*.lnk file test.obj
+ @%append $*.lnk library gc.lib
+!ifdef MAKE_AS_DLL
+!ifeq CALLING s
+ @%append $*.lnk import GC_is_marked gc
+!else
+ @%append $*.lnk import GC_is_marked_ gc
+!endif
+!endif
+ *wlink @$*.lnk
+test_cpp.exe: test_cpp.obj gc.lib
+ %create $*.lnk
+!ifdef DOS4GW
+ @%append $*.lnk sys dos4g
+!else ifdef MSWIN32
+ @%append $*.lnk sys nt
+!else ifdef OS2
+ @%append $*.lnk sys os2v2
+!endif
+ @%append $*.lnk op case
+ @%append $*.lnk op stack=256K
+ @%append $*.lnk name $*
+ @%append $*.lnk file test_cpp.obj
+ @%append $*.lnk library gc.lib
+!ifdef MAKE_AS_DLL
+!ifeq CALLING s
+ @%append $*.lnk import GC_incr_words_allocd gc
+ @%append $*.lnk import GC_incr_mem_freed gc
+ @%append $*.lnk import GC_generic_malloc_words_small gc
+!else
+ @%append $*.lnk import GC_incr_words_allocd_ gc
+ @%append $*.lnk import GC_incr_mem_freed_ gc
+ @%append $*.lnk import GC_generic_malloc_words_small_ gc
+!endif
+!endif
+ *wlink @$*.lnk
+
+gc_cpp.obj: gc_cpp.cc .AUTODEPEND
+ $(CXX) $(TEST_CXXFLAGS) -iinclude $*.cc
+test.obj: tests\test.c .AUTODEPEND
+ $(CC) $(TEST_CFLAGS) $*.c
+test_cpp.obj: tests\test_cpp.cc .AUTODEPEND
+ $(CXX) $(TEST_CXXFLAGS) -iinclude $*.cc
+
+
+.c.obj: .AUTODEPEND
+ $(CC) $(CFLAGS) $*.c
+
+.cc.obj: .AUTODEPEND
+ $(CXX) $(CXXFLAGS) $*.cc
+
+clean : .SYMBOLIC
+ @if exist *.obj del *.obj
+ @if exist *.map del *.map
+ @if exist *.lnk del *.lnk
+ @if exist *.lb1 del *.lb1
+ @if exist *.sym del *.sym
+ @if exist *.err del *.err
+ @if exist *.tmp del *.tmp
+ @if exist *.lst del *.lst
+ @if exist *.exe del *.exe
+ @if exist *.log del *.log
+ @if exist *.lib del *.lib
+ @if exist *.dll del *.dll
--- /dev/null
+#
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+
+# GC_SET_VERSION
+# sets and AC_DEFINEs GC_VERSION_MAJOR, GC_VERSION_MINOR and GC_ALPHA_VERSION
+# based on the contents of PACKAGE_VERSION; PACKAGE_VERSION must conform to
+# [0-9]+[.][0-9]+(alpha[0.9]+)?
+# in lex syntax; if there is no alpha number, GC_ALPHA_VERSION is empty
+#
+AC_DEFUN(GC_SET_VERSION, [
+ AC_MSG_CHECKING(GC version numbers)
+ GC_VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\([[0-9]][[0-9]]*\)[[.]].*$/\1/g'`
+ GC_VERSION_MINOR=`echo $PACKAGE_VERSION | sed 's/^[[^.]]*[[.]]\([[0-9]][[0-9]]*\).*$/\1/g'`
+ GC_ALPHA_VERSION=`echo $PACKAGE_VERSION | sed 's/^[[^.]]*[[.]][[0-9]]*//'`
+
+ case "$GC_ALPHA_VERSION" in
+ alpha*)
+ GC_ALPHA_VERSION=`echo $GC_ALPHA_VERSION \
+ | sed 's/alpha\([[0-9]][[0-9]]*\)/\1/'` ;;
+ *) GC_VERSION_MAJOR='' ;;
+ esac
+
+ if test :$GC_VERSION_MAJOR: = :: \
+ -o :$GC_VERSION_MINOR: = :: ;
+ then
+ AC_MSG_RESULT(invalid)
+ AC_MSG_ERROR([nonconforming PACKAGE_VERSION='$PACKAGE_VERSION'])
+ fi
+
+ AC_DEFINE_UNQUOTED(GC_VERSION_MAJOR, $GC_VERSION_MAJOR)
+ AC_DEFINE_UNQUOTED(GC_VERSION_MINOR, $GC_VERSION_MINOR)
+ if test :$GC_ALPHA_VERSION: != :: ; then
+ AC_DEFINE_UNQUOTED(GC_ALPHA_VERSION, $GC_ALPHA_VERSION)
+ fi
+ AC_MSG_RESULT(major=$GC_VERSION_MAJOR minor=$GC_VERSION_MINOR \
+${GC_ALPHA_VERSION:+alpha=}$GC_ALPHA_VERSION)
+])
+
+sinclude(libtool.m4)
--- /dev/null
+# aclocal.m4 generated automatically by aclocal 1.6.3 -*- Autoconf -*-
+
+# Copyright 1996, 1997, 1998, 1999, 2000, 2001, 2002
+# Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+#
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+
+# GC_SET_VERSION
+# sets and AC_DEFINEs GC_VERSION_MAJOR, GC_VERSION_MINOR and GC_ALPHA_VERSION
+# based on the contents of PACKAGE_VERSION; PACKAGE_VERSION must conform to
+# [0-9]+[.][0-9]+(alpha[0.9]+)?
+# in lex syntax; if there is no alpha number, GC_ALPHA_VERSION is empty
+#
+AC_DEFUN(GC_SET_VERSION, [
+ AC_MSG_CHECKING(GC version numbers)
+ GC_VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\([[0-9]][[0-9]]*\)[[.]].*$/\1/g'`
+ GC_VERSION_MINOR=`echo $PACKAGE_VERSION | sed 's/^[[^.]]*[[.]]\([[0-9]][[0-9]]*\).*$/\1/g'`
+ GC_ALPHA_VERSION=`echo $PACKAGE_VERSION | sed 's/^[[^.]]*[[.]][[0-9]]*//'`
+
+ case "$GC_ALPHA_VERSION" in
+ alpha*)
+ GC_ALPHA_VERSION=`echo $GC_ALPHA_VERSION \
+ | sed 's/alpha\([[0-9]][[0-9]]*\)/\1/'` ;;
+ *) GC_VERSION_MAJOR='' ;;
+ esac
+
+ if test :$GC_VERSION_MAJOR: = :: \
+ -o :$GC_VERSION_MINOR: = :: ;
+ then
+ AC_MSG_RESULT(invalid)
+ AC_MSG_ERROR([nonconforming PACKAGE_VERSION='$PACKAGE_VERSION'])
+ fi
+
+ AC_DEFINE_UNQUOTED(GC_VERSION_MAJOR, $GC_VERSION_MAJOR)
+ AC_DEFINE_UNQUOTED(GC_VERSION_MINOR, $GC_VERSION_MINOR)
+ if test :$GC_ALPHA_VERSION: != :: ; then
+ AC_DEFINE_UNQUOTED(GC_ALPHA_VERSION, $GC_ALPHA_VERSION)
+ fi
+ AC_MSG_RESULT(major=$GC_VERSION_MAJOR minor=$GC_VERSION_MINOR \
+${GC_ALPHA_VERSION:+alpha=}$GC_ALPHA_VERSION)
+])
+
+sinclude(libtool.m4)
+
+# Do all the work for Automake. -*- Autoconf -*-
+
+# This macro actually does too much some checks are only needed if
+# your package does certain things. But this isn't really a big deal.
+
+# Copyright 1996, 1997, 1998, 1999, 2000, 2001, 2002
+# Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 8
+
+# There are a few dirty hacks below to avoid letting `AC_PROG_CC' be
+# written in clear, in which case automake, when reading aclocal.m4,
+# will think it sees a *use*, and therefore will trigger all it's
+# C support machinery. Also note that it means that autoscan, seeing
+# CC etc. in the Makefile, will ask for an AC_PROG_CC use...
+
+
+AC_PREREQ([2.52])
+
+# Autoconf 2.50 wants to disallow AM_ names. We explicitly allow
+# the ones we care about.
+m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl
+
+# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE])
+# AM_INIT_AUTOMAKE([OPTIONS])
+# -----------------------------------------------
+# The call with PACKAGE and VERSION arguments is the old style
+# call (pre autoconf-2.50), which is being phased out. PACKAGE
+# and VERSION should now be passed to AC_INIT and removed from
+# the call to AM_INIT_AUTOMAKE.
+# We support both call styles for the transition. After
+# the next Automake release, Autoconf can make the AC_INIT
+# arguments mandatory, and then we can depend on a new Autoconf
+# release and drop the old call support.
+AC_DEFUN([AM_INIT_AUTOMAKE],
+[AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl
+ AC_REQUIRE([AC_PROG_INSTALL])dnl
+# test to see if srcdir already configured
+if test "`cd $srcdir && pwd`" != "`pwd`" &&
+ test -f $srcdir/config.status; then
+ AC_MSG_ERROR([source directory already configured; run "make distclean" there first])
+fi
+
+# Define the identity of the package.
+dnl Distinguish between old-style and new-style calls.
+m4_ifval([$2],
+[m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl
+ AC_SUBST([PACKAGE], [$1])dnl
+ AC_SUBST([VERSION], [$2])],
+[_AM_SET_OPTIONS([$1])dnl
+ AC_SUBST([PACKAGE], [AC_PACKAGE_TARNAME])dnl
+ AC_SUBST([VERSION], [AC_PACKAGE_VERSION])])dnl
+
+_AM_IF_OPTION([no-define],,
+[AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package])
+ AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package])])dnl
+
+# Some tools Automake needs.
+AC_REQUIRE([AM_SANITY_CHECK])dnl
+AC_REQUIRE([AC_ARG_PROGRAM])dnl
+AM_MISSING_PROG(ACLOCAL, aclocal-${am__api_version})
+AM_MISSING_PROG(AUTOCONF, autoconf)
+AM_MISSING_PROG(AUTOMAKE, automake-${am__api_version})
+AM_MISSING_PROG(AUTOHEADER, autoheader)
+AM_MISSING_PROG(MAKEINFO, makeinfo)
+AM_MISSING_PROG(AMTAR, tar)
+AM_PROG_INSTALL_SH
+AM_PROG_INSTALL_STRIP
+# We need awk for the "check" target. The system "awk" is bad on
+# some platforms.
+AC_REQUIRE([AC_PROG_AWK])dnl
+AC_REQUIRE([AC_PROG_MAKE_SET])dnl
+
+_AM_IF_OPTION([no-dependencies],,
+[AC_PROVIDE_IFELSE([AC_PROG_][CC],
+ [_AM_DEPENDENCIES(CC)],
+ [define([AC_PROG_][CC],
+ defn([AC_PROG_][CC])[_AM_DEPENDENCIES(CC)])])dnl
+AC_PROVIDE_IFELSE([AC_PROG_][CXX],
+ [_AM_DEPENDENCIES(CXX)],
+ [define([AC_PROG_][CXX],
+ defn([AC_PROG_][CXX])[_AM_DEPENDENCIES(CXX)])])dnl
+])
+])
+
+# Copyright 2002 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+
+# AM_AUTOMAKE_VERSION(VERSION)
+# ----------------------------
+# Automake X.Y traces this macro to ensure aclocal.m4 has been
+# generated from the m4 files accompanying Automake X.Y.
+AC_DEFUN([AM_AUTOMAKE_VERSION],[am__api_version="1.6"])
+
+# AM_SET_CURRENT_AUTOMAKE_VERSION
+# -------------------------------
+# Call AM_AUTOMAKE_VERSION so it can be traced.
+# This function is AC_REQUIREd by AC_INIT_AUTOMAKE.
+AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
+ [AM_AUTOMAKE_VERSION([1.6.3])])
+
+# Helper functions for option handling. -*- Autoconf -*-
+
+# Copyright 2001, 2002 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 2
+
+# _AM_MANGLE_OPTION(NAME)
+# -----------------------
+AC_DEFUN([_AM_MANGLE_OPTION],
+[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])])
+
+# _AM_SET_OPTION(NAME)
+# ------------------------------
+# Set option NAME. Presently that only means defining a flag for this option.
+AC_DEFUN([_AM_SET_OPTION],
+[m4_define(_AM_MANGLE_OPTION([$1]), 1)])
+
+# _AM_SET_OPTIONS(OPTIONS)
+# ----------------------------------
+# OPTIONS is a space-separated list of Automake options.
+AC_DEFUN([_AM_SET_OPTIONS],
+[AC_FOREACH([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])])
+
+# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET])
+# -------------------------------------------
+# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise.
+AC_DEFUN([_AM_IF_OPTION],
+[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])])
+
+#
+# Check to make sure that the build environment is sane.
+#
+
+# Copyright 1996, 1997, 2000, 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 3
+
+# AM_SANITY_CHECK
+# ---------------
+AC_DEFUN([AM_SANITY_CHECK],
+[AC_MSG_CHECKING([whether build environment is sane])
+# Just in case
+sleep 1
+echo timestamp > conftest.file
+# Do `set' in a subshell so we don't clobber the current shell's
+# arguments. Must try -L first in case configure is actually a
+# symlink; some systems play weird games with the mod time of symlinks
+# (eg FreeBSD returns the mod time of the symlink's containing
+# directory).
+if (
+ set X `ls -Lt $srcdir/configure conftest.file 2> /dev/null`
+ if test "$[*]" = "X"; then
+ # -L didn't work.
+ set X `ls -t $srcdir/configure conftest.file`
+ fi
+ rm -f conftest.file
+ if test "$[*]" != "X $srcdir/configure conftest.file" \
+ && test "$[*]" != "X conftest.file $srcdir/configure"; then
+
+ # If neither matched, then we have a broken ls. This can happen
+ # if, for instance, CONFIG_SHELL is bash and it inherits a
+ # broken ls alias from the environment. This has actually
+ # happened. Such a system could not be considered "sane".
+ AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken
+alias in your environment])
+ fi
+
+ test "$[2]" = conftest.file
+ )
+then
+ # Ok.
+ :
+else
+ AC_MSG_ERROR([newly created file is older than distributed files!
+Check your system clock])
+fi
+AC_MSG_RESULT(yes)])
+
+# -*- Autoconf -*-
+
+
+# Copyright 1997, 1999, 2000, 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 3
+
+# AM_MISSING_PROG(NAME, PROGRAM)
+# ------------------------------
+AC_DEFUN([AM_MISSING_PROG],
+[AC_REQUIRE([AM_MISSING_HAS_RUN])
+$1=${$1-"${am_missing_run}$2"}
+AC_SUBST($1)])
+
+
+# AM_MISSING_HAS_RUN
+# ------------------
+# Define MISSING if not defined so far and test if it supports --run.
+# If it does, set am_missing_run to use it, otherwise, to nothing.
+AC_DEFUN([AM_MISSING_HAS_RUN],
+[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
+test x"${MISSING+set}" = xset || MISSING="\${SHELL} $am_aux_dir/missing"
+# Use eval to expand $SHELL
+if eval "$MISSING --run true"; then
+ am_missing_run="$MISSING --run "
+else
+ am_missing_run=
+ AC_MSG_WARN([`missing' script is too old or missing])
+fi
+])
+
+# AM_AUX_DIR_EXPAND
+
+# Copyright 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets
+# $ac_aux_dir to `$srcdir/foo'. In other projects, it is set to
+# `$srcdir', `$srcdir/..', or `$srcdir/../..'.
+#
+# Of course, Automake must honor this variable whenever it calls a
+# tool from the auxiliary directory. The problem is that $srcdir (and
+# therefore $ac_aux_dir as well) can be either absolute or relative,
+# depending on how configure is run. This is pretty annoying, since
+# it makes $ac_aux_dir quite unusable in subdirectories: in the top
+# source directory, any form will work fine, but in subdirectories a
+# relative path needs to be adjusted first.
+#
+# $ac_aux_dir/missing
+# fails when called from a subdirectory if $ac_aux_dir is relative
+# $top_srcdir/$ac_aux_dir/missing
+# fails if $ac_aux_dir is absolute,
+# fails when called from a subdirectory in a VPATH build with
+# a relative $ac_aux_dir
+#
+# The reason of the latter failure is that $top_srcdir and $ac_aux_dir
+# are both prefixed by $srcdir. In an in-source build this is usually
+# harmless because $srcdir is `.', but things will broke when you
+# start a VPATH build or use an absolute $srcdir.
+#
+# So we could use something similar to $top_srcdir/$ac_aux_dir/missing,
+# iff we strip the leading $srcdir from $ac_aux_dir. That would be:
+# am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"`
+# and then we would define $MISSING as
+# MISSING="\${SHELL} $am_aux_dir/missing"
+# This will work as long as MISSING is not called from configure, because
+# unfortunately $(top_srcdir) has no meaning in configure.
+# However there are other variables, like CC, which are often used in
+# configure, and could therefore not use this "fixed" $ac_aux_dir.
+#
+# Another solution, used here, is to always expand $ac_aux_dir to an
+# absolute PATH. The drawback is that using absolute paths prevent a
+# configured tree to be moved without reconfiguration.
+
+# Rely on autoconf to set up CDPATH properly.
+AC_PREREQ([2.50])
+
+AC_DEFUN([AM_AUX_DIR_EXPAND], [
+# expand $ac_aux_dir to an absolute path
+am_aux_dir=`cd $ac_aux_dir && pwd`
+])
+
+# AM_PROG_INSTALL_SH
+# ------------------
+# Define $install_sh.
+
+# Copyright 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+AC_DEFUN([AM_PROG_INSTALL_SH],
+[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
+install_sh=${install_sh-"$am_aux_dir/install-sh"}
+AC_SUBST(install_sh)])
+
+# AM_PROG_INSTALL_STRIP
+
+# Copyright 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# One issue with vendor `install' (even GNU) is that you can't
+# specify the program used to strip binaries. This is especially
+# annoying in cross-compiling environments, where the build's strip
+# is unlikely to handle the host's binaries.
+# Fortunately install-sh will honor a STRIPPROG variable, so we
+# always use install-sh in `make install-strip', and initialize
+# STRIPPROG with the value of the STRIP variable (set by the user).
+AC_DEFUN([AM_PROG_INSTALL_STRIP],
+[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl
+# Installed binaries are usually stripped using `strip' when the user
+# run `make install-strip'. However `strip' might not be the right
+# tool to use in cross-compilation environments, therefore Automake
+# will honor the `STRIP' environment variable to overrule this program.
+dnl Don't test for $cross_compiling = yes, because it might be `maybe'.
+if test "$cross_compiling" != no; then
+ AC_CHECK_TOOL([STRIP], [strip], :)
+fi
+INSTALL_STRIP_PROGRAM="\${SHELL} \$(install_sh) -c -s"
+AC_SUBST([INSTALL_STRIP_PROGRAM])])
+
+# serial 4 -*- Autoconf -*-
+
+# Copyright 1999, 2000, 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+
+# There are a few dirty hacks below to avoid letting `AC_PROG_CC' be
+# written in clear, in which case automake, when reading aclocal.m4,
+# will think it sees a *use*, and therefore will trigger all it's
+# C support machinery. Also note that it means that autoscan, seeing
+# CC etc. in the Makefile, will ask for an AC_PROG_CC use...
+
+
+
+# _AM_DEPENDENCIES(NAME)
+# ----------------------
+# See how the compiler implements dependency checking.
+# NAME is "CC", "CXX", "GCJ", or "OBJC".
+# We try a few techniques and use that to set a single cache variable.
+#
+# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was
+# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular
+# dependency, and given that the user is not expected to run this macro,
+# just rely on AC_PROG_CC.
+AC_DEFUN([_AM_DEPENDENCIES],
+[AC_REQUIRE([AM_SET_DEPDIR])dnl
+AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl
+AC_REQUIRE([AM_MAKE_INCLUDE])dnl
+AC_REQUIRE([AM_DEP_TRACK])dnl
+
+ifelse([$1], CC, [depcc="$CC" am_compiler_list=],
+ [$1], CXX, [depcc="$CXX" am_compiler_list=],
+ [$1], OBJC, [depcc="$OBJC" am_compiler_list='gcc3 gcc'],
+ [$1], GCJ, [depcc="$GCJ" am_compiler_list='gcc3 gcc'],
+ [depcc="$$1" am_compiler_list=])
+
+AC_CACHE_CHECK([dependency style of $depcc],
+ [am_cv_$1_dependencies_compiler_type],
+[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
+ # We make a subdir and do the tests there. Otherwise we can end up
+ # making bogus files that we don't know about and never remove. For
+ # instance it was reported that on HP-UX the gcc test will end up
+ # making a dummy file named `D' -- because `-MD' means `put the output
+ # in D'.
+ mkdir conftest.dir
+ # Copy depcomp to subdir because otherwise we won't find it if we're
+ # using a relative directory.
+ cp "$am_depcomp" conftest.dir
+ cd conftest.dir
+
+ am_cv_$1_dependencies_compiler_type=none
+ if test "$am_compiler_list" = ""; then
+ am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp`
+ fi
+ for depmode in $am_compiler_list; do
+ # We need to recreate these files for each test, as the compiler may
+ # overwrite some of them when testing with obscure command lines.
+ # This happens at least with the AIX C compiler.
+ echo '#include "conftest.h"' > conftest.c
+ echo 'int i;' > conftest.h
+ echo "${am__include} ${am__quote}conftest.Po${am__quote}" > confmf
+
+ case $depmode in
+ nosideeffect)
+ # after this tag, mechanisms are not by side-effect, so they'll
+ # only be used when explicitly requested
+ if test "x$enable_dependency_tracking" = xyes; then
+ continue
+ else
+ break
+ fi
+ ;;
+ none) break ;;
+ esac
+ # We check with `-c' and `-o' for the sake of the "dashmstdout"
+ # mode. It turns out that the SunPro C++ compiler does not properly
+ # handle `-M -o', and we need to detect this.
+ if depmode=$depmode \
+ source=conftest.c object=conftest.o \
+ depfile=conftest.Po tmpdepfile=conftest.TPo \
+ $SHELL ./depcomp $depcc -c conftest.c -o conftest.o >/dev/null 2>&1 &&
+ grep conftest.h conftest.Po > /dev/null 2>&1 &&
+ ${MAKE-make} -s -f confmf > /dev/null 2>&1; then
+ am_cv_$1_dependencies_compiler_type=$depmode
+ break
+ fi
+ done
+
+ cd ..
+ rm -rf conftest.dir
+else
+ am_cv_$1_dependencies_compiler_type=none
+fi
+])
+AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type])
+])
+
+
+# AM_SET_DEPDIR
+# -------------
+# Choose a directory name for dependency files.
+# This macro is AC_REQUIREd in _AM_DEPENDENCIES
+AC_DEFUN([AM_SET_DEPDIR],
+[rm -f .deps 2>/dev/null
+mkdir .deps 2>/dev/null
+if test -d .deps; then
+ DEPDIR=.deps
+else
+ # MS-DOS does not allow filenames that begin with a dot.
+ DEPDIR=_deps
+fi
+rmdir .deps 2>/dev/null
+AC_SUBST([DEPDIR])
+])
+
+
+# AM_DEP_TRACK
+# ------------
+AC_DEFUN([AM_DEP_TRACK],
+[AC_ARG_ENABLE(dependency-tracking,
+[ --disable-dependency-tracking Speeds up one-time builds
+ --enable-dependency-tracking Do not reject slow dependency extractors])
+if test "x$enable_dependency_tracking" != xno; then
+ am_depcomp="$ac_aux_dir/depcomp"
+ AMDEPBACKSLASH='\'
+fi
+AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno])
+AC_SUBST([AMDEPBACKSLASH])
+])
+
+# Generate code to set up dependency tracking. -*- Autoconf -*-
+
+# Copyright 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+#serial 2
+
+# _AM_OUTPUT_DEPENDENCY_COMMANDS
+# ------------------------------
+AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS],
+[for mf in $CONFIG_FILES; do
+ # Strip MF so we end up with the name of the file.
+ mf=`echo "$mf" | sed -e 's/:.*$//'`
+ # Check whether this is an Automake generated Makefile or not.
+ # We used to match only the files named `Makefile.in', but
+ # some people rename them; so instead we look at the file content.
+ # Grep'ing the first line is not enough: some people post-process
+ # each Makefile.in and add a new line on top of each file to say so.
+ # So let's grep whole file.
+ if grep '^#.*generated by automake' $mf > /dev/null 2>&1; then
+ dirpart=`AS_DIRNAME("$mf")`
+ else
+ continue
+ fi
+ grep '^DEP_FILES *= *[[^ @%:@]]' < "$mf" > /dev/null || continue
+ # Extract the definition of DEP_FILES from the Makefile without
+ # running `make'.
+ DEPDIR=`sed -n -e '/^DEPDIR = / s///p' < "$mf"`
+ test -z "$DEPDIR" && continue
+ # When using ansi2knr, U may be empty or an underscore; expand it
+ U=`sed -n -e '/^U = / s///p' < "$mf"`
+ test -d "$dirpart/$DEPDIR" || mkdir "$dirpart/$DEPDIR"
+ # We invoke sed twice because it is the simplest approach to
+ # changing $(DEPDIR) to its actual value in the expansion.
+ for file in `sed -n -e '
+ /^DEP_FILES = .*\\\\$/ {
+ s/^DEP_FILES = //
+ :loop
+ s/\\\\$//
+ p
+ n
+ /\\\\$/ b loop
+ p
+ }
+ /^DEP_FILES = / s/^DEP_FILES = //p' < "$mf" | \
+ sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g' -e 's/\$U/'"$U"'/g'`; do
+ # Make sure the directory exists.
+ test -f "$dirpart/$file" && continue
+ fdir=`AS_DIRNAME(["$file"])`
+ AS_MKDIR_P([$dirpart/$fdir])
+ # echo "creating $dirpart/$file"
+ echo '# dummy' > "$dirpart/$file"
+ done
+done
+])# _AM_OUTPUT_DEPENDENCY_COMMANDS
+
+
+# AM_OUTPUT_DEPENDENCY_COMMANDS
+# -----------------------------
+# This macro should only be invoked once -- use via AC_REQUIRE.
+#
+# This code is only required when automatic dependency tracking
+# is enabled. FIXME. This creates each `.P' file that we will
+# need in order to bootstrap the dependency handling code.
+AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS],
+[AC_CONFIG_COMMANDS([depfiles],
+ [test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS],
+ [AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"])
+])
+
+# Copyright 2001 Free Software Foundation, Inc. -*- Autoconf -*-
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 2
+
+# AM_MAKE_INCLUDE()
+# -----------------
+# Check to see how make treats includes.
+AC_DEFUN([AM_MAKE_INCLUDE],
+[am_make=${MAKE-make}
+cat > confinc << 'END'
+doit:
+ @echo done
+END
+# If we don't find an include directive, just comment out the code.
+AC_MSG_CHECKING([for style of include used by $am_make])
+am__include="#"
+am__quote=
+_am_result=none
+# First try GNU make style include.
+echo "include confinc" > confmf
+# We grep out `Entering directory' and `Leaving directory'
+# messages which can occur if `w' ends up in MAKEFLAGS.
+# In particular we don't look at `^make:' because GNU make might
+# be invoked under some other name (usually "gmake"), in which
+# case it prints its new name instead of `make'.
+if test "`$am_make -s -f confmf 2> /dev/null | fgrep -v 'ing directory'`" = "done"; then
+ am__include=include
+ am__quote=
+ _am_result=GNU
+fi
+# Now try BSD make style include.
+if test "$am__include" = "#"; then
+ echo '.include "confinc"' > confmf
+ if test "`$am_make -s -f confmf 2> /dev/null`" = "done"; then
+ am__include=.include
+ am__quote="\""
+ _am_result=BSD
+ fi
+fi
+AC_SUBST(am__include)
+AC_SUBST(am__quote)
+AC_MSG_RESULT($_am_result)
+rm -f confinc confmf
+])
+
+# AM_CONDITIONAL -*- Autoconf -*-
+
+# Copyright 1997, 2000, 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 5
+
+AC_PREREQ(2.52)
+
+# AM_CONDITIONAL(NAME, SHELL-CONDITION)
+# -------------------------------------
+# Define a conditional.
+AC_DEFUN([AM_CONDITIONAL],
+[ifelse([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])],
+ [$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl
+AC_SUBST([$1_TRUE])
+AC_SUBST([$1_FALSE])
+if $2; then
+ $1_TRUE=
+ $1_FALSE='#'
+else
+ $1_TRUE='#'
+ $1_FALSE=
+fi
+AC_CONFIG_COMMANDS_PRE(
+[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then
+ AC_MSG_ERROR([conditional \"$1\" was never defined.
+Usually this means the macro was only invoked conditionally.])
+fi])])
+
+# Figure out how to run the assembler. -*- Autoconf -*-
+
+# serial 2
+
+# Copyright 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# AM_PROG_AS
+# ----------
+AC_DEFUN([AM_PROG_AS],
+[# By default we simply use the C compiler to build assembly code.
+AC_REQUIRE([AC_PROG_CC])
+: ${CCAS='$(CC)'}
+# Set ASFLAGS if not already set.
+: ${CCASFLAGS='$(CFLAGS)'}
+AC_SUBST(CCAS)
+AC_SUBST(CCASFLAGS)])
+
+# Add --enable-maintainer-mode option to configure.
+# From Jim Meyering
+
+# Copyright 1996, 1998, 2000, 2001 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# serial 1
+
+AC_DEFUN([AM_MAINTAINER_MODE],
+[AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
+ dnl maintainer-mode is disabled by default
+ AC_ARG_ENABLE(maintainer-mode,
+[ --enable-maintainer-mode enable make rules and dependencies not useful
+ (and sometimes confusing) to the casual installer],
+ USE_MAINTAINER_MODE=$enableval,
+ USE_MAINTAINER_MODE=no)
+ AC_MSG_RESULT([$USE_MAINTAINER_MODE])
+ AM_CONDITIONAL(MAINTAINER_MODE, [test $USE_MAINTAINER_MODE = yes])
+ MAINT=$MAINTAINER_MODE_TRUE
+ AC_SUBST(MAINT)dnl
+]
+)
+
+# libtool.m4 - Configure libtool for the host system. -*-Shell-script-*-
+
+# serial 46 AC_PROG_LIBTOOL
+
+AC_DEFUN([AC_PROG_LIBTOOL],
+[AC_REQUIRE([AC_LIBTOOL_SETUP])dnl
+
+# This can be used to rebuild libtool when needed
+LIBTOOL_DEPS="$ac_aux_dir/ltmain.sh"
+
+# Always use our own libtool.
+LIBTOOL='$(SHELL) $(top_builddir)/libtool'
+AC_SUBST(LIBTOOL)dnl
+
+# Prevent multiple expansion
+define([AC_PROG_LIBTOOL], [])
+])
+
+AC_DEFUN([AC_LIBTOOL_SETUP],
+[AC_PREREQ(2.13)dnl
+AC_REQUIRE([AC_ENABLE_SHARED])dnl
+AC_REQUIRE([AC_ENABLE_STATIC])dnl
+AC_REQUIRE([AC_ENABLE_FAST_INSTALL])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_PROG_LD])dnl
+AC_REQUIRE([AC_PROG_LD_RELOAD_FLAG])dnl
+AC_REQUIRE([AC_PROG_NM])dnl
+AC_REQUIRE([AC_PROG_LN_S])dnl
+AC_REQUIRE([AC_DEPLIBS_CHECK_METHOD])dnl
+AC_REQUIRE([AC_OBJEXT])dnl
+AC_REQUIRE([AC_EXEEXT])dnl
+dnl
+
+_LT_AC_PROG_ECHO_BACKSLASH
+# Only perform the check for file, if the check method requires it
+case $deplibs_check_method in
+file_magic*)
+ if test "$file_magic_cmd" = '$MAGIC_CMD'; then
+ AC_PATH_MAGIC
+ fi
+ ;;
+esac
+
+AC_CHECK_TOOL(RANLIB, ranlib, :)
+AC_CHECK_TOOL(STRIP, strip, :)
+
+ifdef([AC_PROVIDE_AC_LIBTOOL_DLOPEN], enable_dlopen=yes, enable_dlopen=no)
+ifdef([AC_PROVIDE_AC_LIBTOOL_WIN32_DLL],
+enable_win32_dll=yes, enable_win32_dll=no)
+
+AC_ARG_ENABLE(libtool-lock,
+ [ --disable-libtool-lock avoid locking (might break parallel builds)])
+test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes
+
+# Some flags need to be propagated to the compiler or linker for good
+# libtool support.
+case $host in
+*-*-irix6*)
+ # Find out which ABI we are using.
+ echo '[#]line __oline__ "configure"' > conftest.$ac_ext
+ if AC_TRY_EVAL(ac_compile); then
+ case `/usr/bin/file conftest.$ac_objext` in
+ *32-bit*)
+ LD="${LD-ld} -32"
+ ;;
+ *N32*)
+ LD="${LD-ld} -n32"
+ ;;
+ *64-bit*)
+ LD="${LD-ld} -64"
+ ;;
+ esac
+ fi
+ rm -rf conftest*
+ ;;
+
+*-*-sco3.2v5*)
+ # On SCO OpenServer 5, we need -belf to get full-featured binaries.
+ SAVE_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -belf"
+ AC_CACHE_CHECK([whether the C compiler needs -belf], lt_cv_cc_needs_belf,
+ [AC_LANG_SAVE
+ AC_LANG_C
+ AC_TRY_LINK([],[],[lt_cv_cc_needs_belf=yes],[lt_cv_cc_needs_belf=no])
+ AC_LANG_RESTORE])
+ if test x"$lt_cv_cc_needs_belf" != x"yes"; then
+ # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
+ CFLAGS="$SAVE_CFLAGS"
+ fi
+ ;;
+
+ifdef([AC_PROVIDE_AC_LIBTOOL_WIN32_DLL],
+[*-*-cygwin* | *-*-mingw* | *-*-pw32*)
+ AC_CHECK_TOOL(DLLTOOL, dlltool, false)
+ AC_CHECK_TOOL(AS, as, false)
+ AC_CHECK_TOOL(OBJDUMP, objdump, false)
+
+ # recent cygwin and mingw systems supply a stub DllMain which the user
+ # can override, but on older systems we have to supply one
+ AC_CACHE_CHECK([if libtool should supply DllMain function], lt_cv_need_dllmain,
+ [AC_TRY_LINK([],
+ [extern int __attribute__((__stdcall__)) DllMain(void*, int, void*);
+ DllMain (0, 0, 0);],
+ [lt_cv_need_dllmain=no],[lt_cv_need_dllmain=yes])])
+
+ case $host/$CC in
+ *-*-cygwin*/gcc*-mno-cygwin*|*-*-mingw*)
+ # old mingw systems require "-dll" to link a DLL, while more recent ones
+ # require "-mdll"
+ SAVE_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -mdll"
+ AC_CACHE_CHECK([how to link DLLs], lt_cv_cc_dll_switch,
+ [AC_TRY_LINK([], [], [lt_cv_cc_dll_switch=-mdll],[lt_cv_cc_dll_switch=-dll])])
+ CFLAGS="$SAVE_CFLAGS" ;;
+ *-*-cygwin* | *-*-pw32*)
+ # cygwin systems need to pass --dll to the linker, and not link
+ # crt.o which will require a WinMain@16 definition.
+ lt_cv_cc_dll_switch="-Wl,--dll -nostartfiles" ;;
+ esac
+ ;;
+ ])
+esac
+
+_LT_AC_LTCONFIG_HACK
+
+])
+
+# AC_LIBTOOL_HEADER_ASSERT
+# ------------------------
+AC_DEFUN([AC_LIBTOOL_HEADER_ASSERT],
+[AC_CACHE_CHECK([whether $CC supports assert without backlinking],
+ [lt_cv_func_assert_works],
+ [case $host in
+ *-*-solaris*)
+ if test "$GCC" = yes && test "$with_gnu_ld" != yes; then
+ case `$CC --version 2>/dev/null` in
+ [[12]].*) lt_cv_func_assert_works=no ;;
+ *) lt_cv_func_assert_works=yes ;;
+ esac
+ fi
+ ;;
+ esac])
+
+if test "x$lt_cv_func_assert_works" = xyes; then
+ AC_CHECK_HEADERS(assert.h)
+fi
+])# AC_LIBTOOL_HEADER_ASSERT
+
+# _LT_AC_CHECK_DLFCN
+# --------------------
+AC_DEFUN([_LT_AC_CHECK_DLFCN],
+[AC_CHECK_HEADERS(dlfcn.h)
+])# _LT_AC_CHECK_DLFCN
+
+# AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE
+# ---------------------------------
+AC_DEFUN([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE],
+[AC_REQUIRE([AC_CANONICAL_HOST])
+AC_REQUIRE([AC_PROG_NM])
+AC_REQUIRE([AC_OBJEXT])
+# Check for command to grab the raw symbol name followed by C symbol from nm.
+AC_MSG_CHECKING([command to parse $NM output])
+AC_CACHE_VAL([lt_cv_sys_global_symbol_pipe], [dnl
+
+# These are sane defaults that work on at least a few old systems.
+# [They come from Ultrix. What could be older than Ultrix?!! ;)]
+
+# Character class describing NM global symbol codes.
+symcode='[[BCDEGRST]]'
+
+# Regexp to match symbols that can be accessed directly from C.
+sympat='\([[_A-Za-z]][[_A-Za-z0-9]]*\)'
+
+# Transform the above into a raw symbol and a C symbol.
+symxfrm='\1 \2\3 \3'
+
+# Transform an extracted symbol line into a proper C declaration
+lt_cv_global_symbol_to_cdecl="sed -n -e 's/^. .* \(.*\)$/extern char \1;/p'"
+
+# Transform an extracted symbol line into symbol name and symbol address
+lt_cv_global_symbol_to_c_name_address="sed -n -e 's/^: \([[^ ]]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode \([[^ ]]*\) \([[^ ]]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'"
+
+# Define system-specific variables.
+case $host_os in
+aix*)
+ symcode='[[BCDT]]'
+ ;;
+cygwin* | mingw* | pw32*)
+ symcode='[[ABCDGISTW]]'
+ ;;
+hpux*) # Its linker distinguishes data from code symbols
+ lt_cv_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern char \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'"
+ lt_cv_global_symbol_to_c_name_address="sed -n -e 's/^: \([[^ ]]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode* \([[^ ]]*\) \([[^ ]]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'"
+ ;;
+irix*)
+ symcode='[[BCDEGRST]]'
+ ;;
+solaris* | sysv5*)
+ symcode='[[BDT]]'
+ ;;
+sysv4)
+ symcode='[[DFNSTU]]'
+ ;;
+esac
+
+# Handle CRLF in mingw tool chain
+opt_cr=
+case $host_os in
+mingw*)
+ opt_cr=`echo 'x\{0,1\}' | tr x '\015'` # option cr in regexp
+ ;;
+esac
+
+# If we're using GNU nm, then use its standard symbol codes.
+if $NM -V 2>&1 | egrep '(GNU|with BFD)' > /dev/null; then
+ symcode='[[ABCDGISTW]]'
+fi
+
+# Try without a prefix undercore, then with it.
+for ac_symprfx in "" "_"; do
+
+ # Write the raw and C identifiers.
+lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[[ ]]\($symcode$symcode*\)[[ ]][[ ]]*\($ac_symprfx\)$sympat$opt_cr$/$symxfrm/p'"
+
+ # Check to see that the pipe works correctly.
+ pipe_works=no
+ rm -f conftest*
+ cat > conftest.$ac_ext <<EOF
+#ifdef __cplusplus
+extern "C" {
+#endif
+char nm_test_var;
+void nm_test_func(){}
+#ifdef __cplusplus
+}
+#endif
+int main(){nm_test_var='a';nm_test_func();return(0);}
+EOF
+
+ if AC_TRY_EVAL(ac_compile); then
+ # Now try to grab the symbols.
+ nlist=conftest.nm
+ if AC_TRY_EVAL(NM conftest.$ac_objext \| $lt_cv_sys_global_symbol_pipe \> $nlist) && test -s "$nlist"; then
+ # Try sorting and uniquifying the output.
+ if sort "$nlist" | uniq > "$nlist"T; then
+ mv -f "$nlist"T "$nlist"
+ else
+ rm -f "$nlist"T
+ fi
+
+ # Make sure that we snagged all the symbols we need.
+ if egrep ' nm_test_var$' "$nlist" >/dev/null; then
+ if egrep ' nm_test_func$' "$nlist" >/dev/null; then
+ cat <<EOF > conftest.$ac_ext
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+EOF
+ # Now generate the symbol file.
+ eval "$lt_cv_global_symbol_to_cdecl"' < "$nlist" >> conftest.$ac_ext'
+
+ cat <<EOF >> conftest.$ac_ext
+#if defined (__STDC__) && __STDC__
+# define lt_ptr void *
+#else
+# define lt_ptr char *
+# define const
+#endif
+
+/* The mapping between symbol names and symbols. */
+const struct {
+ const char *name;
+ lt_ptr address;
+}
+lt_preloaded_symbols[[]] =
+{
+EOF
+ sed "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (lt_ptr) \&\2},/" < "$nlist" >> conftest.$ac_ext
+ cat <<\EOF >> conftest.$ac_ext
+ {0, (lt_ptr) 0}
+};
+
+#ifdef __cplusplus
+}
+#endif
+EOF
+ # Now try linking the two files.
+ mv conftest.$ac_objext conftstm.$ac_objext
+ save_LIBS="$LIBS"
+ save_CFLAGS="$CFLAGS"
+ LIBS="conftstm.$ac_objext"
+ CFLAGS="$CFLAGS$no_builtin_flag"
+ if AC_TRY_EVAL(ac_link) && test -s conftest; then
+ pipe_works=yes
+ fi
+ LIBS="$save_LIBS"
+ CFLAGS="$save_CFLAGS"
+ else
+ echo "cannot find nm_test_func in $nlist" >&AC_FD_CC
+ fi
+ else
+ echo "cannot find nm_test_var in $nlist" >&AC_FD_CC
+ fi
+ else
+ echo "cannot run $lt_cv_sys_global_symbol_pipe" >&AC_FD_CC
+ fi
+ else
+ echo "$progname: failed program was:" >&AC_FD_CC
+ cat conftest.$ac_ext >&5
+ fi
+ rm -f conftest* conftst*
+
+ # Do not use the global_symbol_pipe unless it works.
+ if test "$pipe_works" = yes; then
+ break
+ else
+ lt_cv_sys_global_symbol_pipe=
+ fi
+done
+])
+global_symbol_pipe="$lt_cv_sys_global_symbol_pipe"
+if test -z "$lt_cv_sys_global_symbol_pipe"; then
+ global_symbol_to_cdecl=
+ global_symbol_to_c_name_address=
+else
+ global_symbol_to_cdecl="$lt_cv_global_symbol_to_cdecl"
+ global_symbol_to_c_name_address="$lt_cv_global_symbol_to_c_name_address"
+fi
+if test -z "$global_symbol_pipe$global_symbol_to_cdec$global_symbol_to_c_name_address";
+then
+ AC_MSG_RESULT(failed)
+else
+ AC_MSG_RESULT(ok)
+fi
+]) # AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE
+
+# _LT_AC_LIBTOOL_SYS_PATH_SEPARATOR
+# ---------------------------------
+AC_DEFUN([_LT_AC_LIBTOOL_SYS_PATH_SEPARATOR],
+[# Find the correct PATH separator. Usually this is `:', but
+# DJGPP uses `;' like DOS.
+if test "X${PATH_SEPARATOR+set}" != Xset; then
+ UNAME=${UNAME-`uname 2>/dev/null`}
+ case X$UNAME in
+ *-DOS) lt_cv_sys_path_separator=';' ;;
+ *) lt_cv_sys_path_separator=':' ;;
+ esac
+ PATH_SEPARATOR=$lt_cv_sys_path_separator
+fi
+])# _LT_AC_LIBTOOL_SYS_PATH_SEPARATOR
+
+# _LT_AC_PROG_ECHO_BACKSLASH
+# --------------------------
+# Add some code to the start of the generated configure script which
+# will find an echo command which doesn't interpret backslashes.
+AC_DEFUN([_LT_AC_PROG_ECHO_BACKSLASH],
+[ifdef([AC_DIVERSION_NOTICE], [AC_DIVERT_PUSH(AC_DIVERSION_NOTICE)],
+ [AC_DIVERT_PUSH(NOTICE)])
+_LT_AC_LIBTOOL_SYS_PATH_SEPARATOR
+
+# Check that we are running under the correct shell.
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+case X$ECHO in
+X*--fallback-echo)
+ # Remove one level of quotation (which was required for Make).
+ ECHO=`echo "$ECHO" | sed 's,\\\\\[$]\\[$]0,'[$]0','`
+ ;;
+esac
+
+echo=${ECHO-echo}
+if test "X[$]1" = X--no-reexec; then
+ # Discard the --no-reexec flag, and continue.
+ shift
+elif test "X[$]1" = X--fallback-echo; then
+ # Avoid inline document here, it may be left over
+ :
+elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then
+ # Yippee, $echo works!
+ :
+else
+ # Restart under the correct shell.
+ exec $SHELL "[$]0" --no-reexec ${1+"[$]@"}
+fi
+
+if test "X[$]1" = X--fallback-echo; then
+ # used as fallback echo
+ shift
+ cat <<EOF
+$*
+EOF
+ exit 0
+fi
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+if test "X${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
+
+if test -z "$ECHO"; then
+if test "X${echo_test_string+set}" != Xset; then
+# find a string as large as possible, as long as the shell can cope with it
+ for cmd in 'sed 50q "[$]0"' 'sed 20q "[$]0"' 'sed 10q "[$]0"' 'sed 2q "[$]0"' 'echo test'; do
+ # expected sizes: less than 2Kb, 1Kb, 512 bytes, 16 bytes, ...
+ if (echo_test_string="`eval $cmd`") 2>/dev/null &&
+ echo_test_string="`eval $cmd`" &&
+ (test "X$echo_test_string" = "X$echo_test_string") 2>/dev/null
+ then
+ break
+ fi
+ done
+fi
+
+if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ :
+else
+ # The Solaris, AIX, and Digital Unix default echo programs unquote
+ # backslashes. This makes it impossible to quote backslashes using
+ # echo "$something" | sed 's/\\/\\\\/g'
+ #
+ # So, first we look for a working echo in the user's PATH.
+
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for dir in $PATH /usr/ucb; do
+ if (test -f $dir/echo || test -f $dir/echo$ac_exeext) &&
+ test "X`($dir/echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($dir/echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ echo="$dir/echo"
+ break
+ fi
+ done
+ IFS="$save_ifs"
+
+ if test "X$echo" = Xecho; then
+ # We didn't find a better echo, so look for alternatives.
+ if test "X`(print -r '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`(print -r "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ # This shell has a builtin print -r that does the trick.
+ echo='print -r'
+ elif (test -f /bin/ksh || test -f /bin/ksh$ac_exeext) &&
+ test "X$CONFIG_SHELL" != X/bin/ksh; then
+ # If we have ksh, try running configure again with it.
+ ORIGINAL_CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
+ export ORIGINAL_CONFIG_SHELL
+ CONFIG_SHELL=/bin/ksh
+ export CONFIG_SHELL
+ exec $CONFIG_SHELL "[$]0" --no-reexec ${1+"[$]@"}
+ else
+ # Try using printf.
+ echo='printf %s\n'
+ if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ # Cool, printf works
+ :
+ elif echo_testing_string=`($ORIGINAL_CONFIG_SHELL "[$]0" --fallback-echo '\t') 2>/dev/null` &&
+ test "X$echo_testing_string" = 'X\t' &&
+ echo_testing_string=`($ORIGINAL_CONFIG_SHELL "[$]0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ CONFIG_SHELL=$ORIGINAL_CONFIG_SHELL
+ export CONFIG_SHELL
+ SHELL="$CONFIG_SHELL"
+ export SHELL
+ echo="$CONFIG_SHELL [$]0 --fallback-echo"
+ elif echo_testing_string=`($CONFIG_SHELL "[$]0" --fallback-echo '\t') 2>/dev/null` &&
+ test "X$echo_testing_string" = 'X\t' &&
+ echo_testing_string=`($CONFIG_SHELL "[$]0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ echo="$CONFIG_SHELL [$]0 --fallback-echo"
+ else
+ # maybe with a smaller string...
+ prev=:
+
+ for cmd in 'echo test' 'sed 2q "[$]0"' 'sed 10q "[$]0"' 'sed 20q "[$]0"' 'sed 50q "[$]0"'; do
+ if (test "X$echo_test_string" = "X`eval $cmd`") 2>/dev/null
+ then
+ break
+ fi
+ prev="$cmd"
+ done
+
+ if test "$prev" != 'sed 50q "[$]0"'; then
+ echo_test_string=`eval $prev`
+ export echo_test_string
+ exec ${ORIGINAL_CONFIG_SHELL-${CONFIG_SHELL-/bin/sh}} "[$]0" ${1+"[$]@"}
+ else
+ # Oops. We lost completely, so just stick with echo.
+ echo=echo
+ fi
+ fi
+ fi
+ fi
+fi
+fi
+
+# Copy echo and quote the copy suitably for passing to libtool from
+# the Makefile, instead of quoting the original, which is used later.
+ECHO=$echo
+if test "X$ECHO" = "X$CONFIG_SHELL [$]0 --fallback-echo"; then
+ ECHO="$CONFIG_SHELL \\\$\[$]0 --fallback-echo"
+fi
+
+AC_SUBST(ECHO)
+AC_DIVERT_POP
+])# _LT_AC_PROG_ECHO_BACKSLASH
+
+# _LT_AC_TRY_DLOPEN_SELF (ACTION-IF-TRUE, ACTION-IF-TRUE-W-USCORE,
+# ACTION-IF-FALSE, ACTION-IF-CROSS-COMPILING)
+# ------------------------------------------------------------------
+AC_DEFUN([_LT_AC_TRY_DLOPEN_SELF],
+[if test "$cross_compiling" = yes; then :
+ [$4]
+else
+ AC_REQUIRE([_LT_AC_CHECK_DLFCN])dnl
+ lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+ lt_status=$lt_dlunknown
+ cat > conftest.$ac_ext <<EOF
+[#line __oline__ "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include <dlfcn.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef RTLD_GLOBAL
+# define LT_DLGLOBAL RTLD_GLOBAL
+#else
+# ifdef DL_GLOBAL
+# define LT_DLGLOBAL DL_GLOBAL
+# else
+# define LT_DLGLOBAL 0
+# endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+ find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+# ifdef RTLD_LAZY
+# define LT_DLLAZY_OR_NOW RTLD_LAZY
+# else
+# ifdef DL_LAZY
+# define LT_DLLAZY_OR_NOW DL_LAZY
+# else
+# ifdef RTLD_NOW
+# define LT_DLLAZY_OR_NOW RTLD_NOW
+# else
+# ifdef DL_NOW
+# define LT_DLLAZY_OR_NOW DL_NOW
+# else
+# define LT_DLLAZY_OR_NOW 0
+# endif
+# endif
+# endif
+# endif
+#endif
+
+#ifdef __cplusplus
+extern "C" void exit (int);
+#endif
+
+void fnord() { int i=42;}
+int main ()
+{
+ void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+ int status = $lt_dlunknown;
+
+ if (self)
+ {
+ if (dlsym (self,"fnord")) status = $lt_dlno_uscore;
+ else if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore;
+ /* dlclose (self); */
+ }
+
+ exit (status);
+}]
+EOF
+ if AC_TRY_EVAL(ac_link) && test -s conftest${ac_exeext} 2>/dev/null; then
+ (./conftest; exit; ) 2>/dev/null
+ lt_status=$?
+ case x$lt_status in
+ x$lt_dlno_uscore) $1 ;;
+ x$lt_dlneed_uscore) $2 ;;
+ x$lt_unknown|x*) $3 ;;
+ esac
+ else :
+ # compilation failed
+ $3
+ fi
+fi
+rm -fr conftest*
+])# _LT_AC_TRY_DLOPEN_SELF
+
+# AC_LIBTOOL_DLOPEN_SELF
+# -------------------
+AC_DEFUN([AC_LIBTOOL_DLOPEN_SELF],
+[if test "x$enable_dlopen" != xyes; then
+ enable_dlopen=unknown
+ enable_dlopen_self=unknown
+ enable_dlopen_self_static=unknown
+else
+ lt_cv_dlopen=no
+ lt_cv_dlopen_libs=
+
+ case $host_os in
+ beos*)
+ lt_cv_dlopen="load_add_on"
+ lt_cv_dlopen_libs=
+ lt_cv_dlopen_self=yes
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ lt_cv_dlopen="LoadLibrary"
+ lt_cv_dlopen_libs=
+ ;;
+
+ *)
+ AC_CHECK_FUNC([shl_load],
+ [lt_cv_dlopen="shl_load"],
+ [AC_CHECK_LIB([dld], [shl_load],
+ [lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-dld"],
+ [AC_CHECK_FUNC([dlopen],
+ [lt_cv_dlopen="dlopen"],
+ [AC_CHECK_LIB([dl], [dlopen],
+ [lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"],
+ [AC_CHECK_LIB([svld], [dlopen],
+ [lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld"],
+ [AC_CHECK_LIB([dld], [dld_link],
+ [lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-dld"])
+ ])
+ ])
+ ])
+ ])
+ ])
+ ;;
+ esac
+
+ if test "x$lt_cv_dlopen" != xno; then
+ enable_dlopen=yes
+ else
+ enable_dlopen=no
+ fi
+
+ case $lt_cv_dlopen in
+ dlopen)
+ save_CPPFLAGS="$CPPFLAGS"
+ AC_REQUIRE([_LT_AC_CHECK_DLFCN])dnl
+ test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
+
+ save_LDFLAGS="$LDFLAGS"
+ eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
+
+ save_LIBS="$LIBS"
+ LIBS="$lt_cv_dlopen_libs $LIBS"
+
+ AC_CACHE_CHECK([whether a program can dlopen itself],
+ lt_cv_dlopen_self, [dnl
+ _LT_AC_TRY_DLOPEN_SELF(
+ lt_cv_dlopen_self=yes, lt_cv_dlopen_self=yes,
+ lt_cv_dlopen_self=no, lt_cv_dlopen_self=cross)
+ ])
+
+ if test "x$lt_cv_dlopen_self" = xyes; then
+ LDFLAGS="$LDFLAGS $link_static_flag"
+ AC_CACHE_CHECK([whether a statically linked program can dlopen itself],
+ lt_cv_dlopen_self_static, [dnl
+ _LT_AC_TRY_DLOPEN_SELF(
+ lt_cv_dlopen_self_static=yes, lt_cv_dlopen_self_static=yes,
+ lt_cv_dlopen_self_static=no, lt_cv_dlopen_self_static=cross)
+ ])
+ fi
+
+ CPPFLAGS="$save_CPPFLAGS"
+ LDFLAGS="$save_LDFLAGS"
+ LIBS="$save_LIBS"
+ ;;
+ esac
+
+ case $lt_cv_dlopen_self in
+ yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
+ *) enable_dlopen_self=unknown ;;
+ esac
+
+ case $lt_cv_dlopen_self_static in
+ yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
+ *) enable_dlopen_self_static=unknown ;;
+ esac
+fi
+])# AC_LIBTOOL_DLOPEN_SELF
+
+AC_DEFUN([_LT_AC_LTCONFIG_HACK],
+[AC_REQUIRE([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE])dnl
+# Sed substitution that helps us do robust quoting. It backslashifies
+# metacharacters that are still active within double-quoted strings.
+Xsed='sed -e s/^X//'
+sed_quote_subst='s/\([[\\"\\`$\\\\]]\)/\\\1/g'
+
+# Same as above, but do not quote variable references.
+double_quote_subst='s/\([[\\"\\`\\\\]]\)/\\\1/g'
+
+# Sed substitution to delay expansion of an escaped shell variable in a
+# double_quote_subst'ed string.
+delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
+
+# Constants:
+rm="rm -f"
+
+# Global variables:
+default_ofile=libtool
+can_build_shared=yes
+
+# All known linkers require a `.a' archive for static linking (except M$VC,
+# which needs '.lib').
+libext=a
+ltmain="$ac_aux_dir/ltmain.sh"
+ofile="$default_ofile"
+with_gnu_ld="$lt_cv_prog_gnu_ld"
+need_locks="$enable_libtool_lock"
+
+old_CC="$CC"
+old_CFLAGS="$CFLAGS"
+
+# Set sane defaults for various variables
+test -z "$AR" && AR=ar
+test -z "$AR_FLAGS" && AR_FLAGS=cru
+test -z "$AS" && AS=as
+test -z "$CC" && CC=cc
+test -z "$DLLTOOL" && DLLTOOL=dlltool
+test -z "$LD" && LD=ld
+test -z "$LN_S" && LN_S="ln -s"
+test -z "$MAGIC_CMD" && MAGIC_CMD=file
+test -z "$NM" && NM=nm
+test -z "$OBJDUMP" && OBJDUMP=objdump
+test -z "$RANLIB" && RANLIB=:
+test -z "$STRIP" && STRIP=:
+test -z "$ac_objext" && ac_objext=o
+
+if test x"$host" != x"$build"; then
+ ac_tool_prefix=${host_alias}-
+else
+ ac_tool_prefix=
+fi
+
+# Transform linux* to *-*-linux-gnu*, to support old configure scripts.
+case $host_os in
+linux-gnu*) ;;
+linux*) host=`echo $host | sed 's/^\(.*-.*-linux\)\(.*\)$/\1-gnu\2/'`
+esac
+
+case $host_os in
+aix3*)
+ # AIX sometimes has problems with the GCC collect2 program. For some
+ # reason, if we set the COLLECT_NAMES environment variable, the problems
+ # vanish in a puff of smoke.
+ if test "X${COLLECT_NAMES+set}" != Xset; then
+ COLLECT_NAMES=
+ export COLLECT_NAMES
+ fi
+ ;;
+esac
+
+# Determine commands to create old-style static archives.
+old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs$old_deplibs'
+old_postinstall_cmds='chmod 644 $oldlib'
+old_postuninstall_cmds=
+
+if test -n "$RANLIB"; then
+ case $host_os in
+ openbsd*)
+ old_postinstall_cmds="\$RANLIB -t \$oldlib~$old_postinstall_cmds"
+ ;;
+ *)
+ old_postinstall_cmds="\$RANLIB \$oldlib~$old_postinstall_cmds"
+ ;;
+ esac
+ old_archive_cmds="$old_archive_cmds~\$RANLIB \$oldlib"
+fi
+
+# Allow CC to be a program name with arguments.
+set dummy $CC
+compiler="[$]2"
+
+AC_MSG_CHECKING([for objdir])
+rm -f .libs 2>/dev/null
+mkdir .libs 2>/dev/null
+if test -d .libs; then
+ objdir=.libs
+else
+ # MS-DOS does not allow filenames that begin with a dot.
+ objdir=_libs
+fi
+rmdir .libs 2>/dev/null
+AC_MSG_RESULT($objdir)
+
+
+AC_ARG_WITH(pic,
+[ --with-pic try to use only PIC/non-PIC objects [default=use both]],
+pic_mode="$withval", pic_mode=default)
+test -z "$pic_mode" && pic_mode=default
+
+# We assume here that the value for lt_cv_prog_cc_pic will not be cached
+# in isolation, and that seeing it set (from the cache) indicates that
+# the associated values are set (in the cache) correctly too.
+AC_MSG_CHECKING([for $compiler option to produce PIC])
+AC_CACHE_VAL(lt_cv_prog_cc_pic,
+[ lt_cv_prog_cc_pic=
+ lt_cv_prog_cc_shlib=
+ lt_cv_prog_cc_wl=
+ lt_cv_prog_cc_static=
+ lt_cv_prog_cc_no_builtin=
+ lt_cv_prog_cc_can_build_shared=$can_build_shared
+
+ if test "$GCC" = yes; then
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-static'
+
+ case $host_os in
+ aix*)
+ # Below there is a dirty hack to force normal static linking with -ldl
+ # The problem is because libdl dynamically linked with both libc and
+ # libC (AIX C++ library), which obviously doesn't included in libraries
+ # list by gcc. This cause undefined symbols with -static flags.
+ # This hack allows C programs to be linked with "-static -ldl", but
+ # not sure about C++ programs.
+ lt_cv_prog_cc_static="$lt_cv_prog_cc_static ${lt_cv_prog_cc_wl}-lC"
+ ;;
+ amigaos*)
+ # FIXME: we need at least 68020 code to build shared libraries, but
+ # adding the `-m68020' flag to GCC prevents building anything better,
+ # like `-m68040'.
+ lt_cv_prog_cc_pic='-m68020 -resident32 -malways-restore-a4'
+ ;;
+ beos* | irix5* | irix6* | osf3* | osf4* | osf5*)
+ # PIC is the default for these OSes.
+ ;;
+ darwin* | rhapsody*)
+ # PIC is the default on this platform
+ # Common symbols not allowed in MH_DYLIB files
+ lt_cv_prog_cc_pic='-fno-common'
+ ;;
+ cygwin* | mingw* | pw32* | os2*)
+ # This hack is so that the source file can tell whether it is being
+ # built for inclusion in a dll (and should export symbols for example).
+ lt_cv_prog_cc_pic='-DDLL_EXPORT'
+ ;;
+ sysv4*MP*)
+ if test -d /usr/nec; then
+ lt_cv_prog_cc_pic=-Kconform_pic
+ fi
+ ;;
+ *)
+ lt_cv_prog_cc_pic='-fPIC'
+ ;;
+ esac
+ else
+ # PORTME Check for PIC flags for the system compiler.
+ case $host_os in
+ aix3* | aix4* | aix5*)
+ lt_cv_prog_cc_wl='-Wl,'
+ # All AIX code is PIC.
+ if test "$host_cpu" = ia64; then
+ # AIX 5 now supports IA64 processor
+ lt_cv_prog_cc_static='-Bstatic'
+ else
+ lt_cv_prog_cc_static='-bnso -bI:/lib/syscalls.exp'
+ fi
+ ;;
+
+ hpux9* | hpux10* | hpux11*)
+ # Is there a better lt_cv_prog_cc_static that works with the bundled CC?
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static="${lt_cv_prog_cc_wl}-a ${lt_cv_prog_cc_wl}archive"
+ lt_cv_prog_cc_pic='+Z'
+ ;;
+
+ irix5* | irix6*)
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-non_shared'
+ # PIC (with -KPIC) is the default.
+ ;;
+
+ cygwin* | mingw* | pw32* | os2*)
+ # This hack is so that the source file can tell whether it is being
+ # built for inclusion in a dll (and should export symbols for example).
+ lt_cv_prog_cc_pic='-DDLL_EXPORT'
+ ;;
+
+ newsos6)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ ;;
+
+ osf3* | osf4* | osf5*)
+ # All OSF/1 code is PIC.
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-non_shared'
+ ;;
+
+ sco3.2v5*)
+ lt_cv_prog_cc_pic='-Kpic'
+ lt_cv_prog_cc_static='-dn'
+ lt_cv_prog_cc_shlib='-belf'
+ ;;
+
+ solaris*)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ lt_cv_prog_cc_wl='-Wl,'
+ ;;
+
+ sunos4*)
+ lt_cv_prog_cc_pic='-PIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ lt_cv_prog_cc_wl='-Qoption ld '
+ ;;
+
+ sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ if test "x$host_vendor" = xsni; then
+ lt_cv_prog_cc_wl='-LD'
+ else
+ lt_cv_prog_cc_wl='-Wl,'
+ fi
+ ;;
+
+ uts4*)
+ lt_cv_prog_cc_pic='-pic'
+ lt_cv_prog_cc_static='-Bstatic'
+ ;;
+
+ sysv4*MP*)
+ if test -d /usr/nec ;then
+ lt_cv_prog_cc_pic='-Kconform_pic'
+ lt_cv_prog_cc_static='-Bstatic'
+ fi
+ ;;
+
+ *)
+ lt_cv_prog_cc_can_build_shared=no
+ ;;
+ esac
+ fi
+])
+if test -z "$lt_cv_prog_cc_pic"; then
+ AC_MSG_RESULT([none])
+else
+ AC_MSG_RESULT([$lt_cv_prog_cc_pic])
+
+ # Check to make sure the pic_flag actually works.
+ AC_MSG_CHECKING([if $compiler PIC flag $lt_cv_prog_cc_pic works])
+ AC_CACHE_VAL(lt_cv_prog_cc_pic_works, [dnl
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS $lt_cv_prog_cc_pic -DPIC"
+ AC_TRY_COMPILE([], [], [dnl
+ case $host_os in
+ hpux9* | hpux10* | hpux11*)
+ # On HP-UX, both CC and GCC only warn that PIC is supported... then
+ # they create non-PIC objects. So, if there were any warnings, we
+ # assume that PIC is not supported.
+ if test -s conftest.err; then
+ lt_cv_prog_cc_pic_works=no
+ else
+ lt_cv_prog_cc_pic_works=yes
+ fi
+ ;;
+ *)
+ lt_cv_prog_cc_pic_works=yes
+ ;;
+ esac
+ ], [dnl
+ lt_cv_prog_cc_pic_works=no
+ ])
+ CFLAGS="$save_CFLAGS"
+ ])
+
+ if test "X$lt_cv_prog_cc_pic_works" = Xno; then
+ lt_cv_prog_cc_pic=
+ lt_cv_prog_cc_can_build_shared=no
+ else
+ lt_cv_prog_cc_pic=" $lt_cv_prog_cc_pic"
+ fi
+
+ AC_MSG_RESULT([$lt_cv_prog_cc_pic_works])
+fi
+
+# Check for any special shared library compilation flags.
+if test -n "$lt_cv_prog_cc_shlib"; then
+ AC_MSG_WARN([\`$CC' requires \`$lt_cv_prog_cc_shlib' to build shared libraries])
+ if echo "$old_CC $old_CFLAGS " | egrep -e "[[ ]]$lt_cv_prog_cc_shlib[[ ]]" >/dev/null; then :
+ else
+ AC_MSG_WARN([add \`$lt_cv_prog_cc_shlib' to the CC or CFLAGS env variable and reconfigure])
+ lt_cv_prog_cc_can_build_shared=no
+ fi
+fi
+
+AC_MSG_CHECKING([if $compiler static flag $lt_cv_prog_cc_static works])
+AC_CACHE_VAL([lt_cv_prog_cc_static_works], [dnl
+ lt_cv_prog_cc_static_works=no
+ save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS $lt_cv_prog_cc_static"
+ AC_TRY_LINK([], [], [lt_cv_prog_cc_static_works=yes])
+ LDFLAGS="$save_LDFLAGS"
+])
+
+# Belt *and* braces to stop my trousers falling down:
+test "X$lt_cv_prog_cc_static_works" = Xno && lt_cv_prog_cc_static=
+AC_MSG_RESULT([$lt_cv_prog_cc_static_works])
+
+pic_flag="$lt_cv_prog_cc_pic"
+special_shlib_compile_flags="$lt_cv_prog_cc_shlib"
+wl="$lt_cv_prog_cc_wl"
+link_static_flag="$lt_cv_prog_cc_static"
+no_builtin_flag="$lt_cv_prog_cc_no_builtin"
+can_build_shared="$lt_cv_prog_cc_can_build_shared"
+
+
+# Check to see if options -o and -c are simultaneously supported by compiler
+AC_MSG_CHECKING([if $compiler supports -c -o file.$ac_objext])
+AC_CACHE_VAL([lt_cv_compiler_c_o], [
+$rm -r conftest 2>/dev/null
+mkdir conftest
+cd conftest
+echo "int some_variable = 0;" > conftest.$ac_ext
+mkdir out
+# According to Tom Tromey, Ian Lance Taylor reported there are C compilers
+# that will create temporary files in the current directory regardless of
+# the output directory. Thus, making CWD read-only will cause this test
+# to fail, enabling locking or at least warning the user not to do parallel
+# builds.
+chmod -w .
+save_CFLAGS="$CFLAGS"
+CFLAGS="$CFLAGS -o out/conftest2.$ac_objext"
+compiler_c_o=no
+if { (eval echo configure:__oline__: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>out/conftest.err; } && test -s out/conftest2.$ac_objext; then
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s out/conftest.err; then
+ lt_cv_compiler_c_o=no
+ else
+ lt_cv_compiler_c_o=yes
+ fi
+else
+ # Append any errors to the config.log.
+ cat out/conftest.err 1>&AC_FD_CC
+ lt_cv_compiler_c_o=no
+fi
+CFLAGS="$save_CFLAGS"
+chmod u+w .
+$rm conftest* out/*
+rmdir out
+cd ..
+rmdir conftest
+$rm -r conftest 2>/dev/null
+])
+compiler_c_o=$lt_cv_compiler_c_o
+AC_MSG_RESULT([$compiler_c_o])
+
+if test x"$compiler_c_o" = x"yes"; then
+ # Check to see if we can write to a .lo
+ AC_MSG_CHECKING([if $compiler supports -c -o file.lo])
+ AC_CACHE_VAL([lt_cv_compiler_o_lo], [
+ lt_cv_compiler_o_lo=no
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -c -o conftest.lo"
+ save_objext="$ac_objext"
+ ac_objext=lo
+ AC_TRY_COMPILE([], [int some_variable = 0;], [dnl
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s conftest.err; then
+ lt_cv_compiler_o_lo=no
+ else
+ lt_cv_compiler_o_lo=yes
+ fi
+ ])
+ ac_objext="$save_objext"
+ CFLAGS="$save_CFLAGS"
+ ])
+ compiler_o_lo=$lt_cv_compiler_o_lo
+ AC_MSG_RESULT([$compiler_o_lo])
+else
+ compiler_o_lo=no
+fi
+
+# Check to see if we can do hard links to lock some files if needed
+hard_links="nottested"
+if test "$compiler_c_o" = no && test "$need_locks" != no; then
+ # do not overwrite the value of need_locks provided by the user
+ AC_MSG_CHECKING([if we can lock with hard links])
+ hard_links=yes
+ $rm conftest*
+ ln conftest.a conftest.b 2>/dev/null && hard_links=no
+ touch conftest.a
+ ln conftest.a conftest.b 2>&5 || hard_links=no
+ ln conftest.a conftest.b 2>/dev/null && hard_links=no
+ AC_MSG_RESULT([$hard_links])
+ if test "$hard_links" = no; then
+ AC_MSG_WARN([\`$CC' does not support \`-c -o', so \`make -j' may be unsafe])
+ need_locks=warn
+ fi
+else
+ need_locks=no
+fi
+
+if test "$GCC" = yes; then
+ # Check to see if options -fno-rtti -fno-exceptions are supported by compiler
+ AC_MSG_CHECKING([if $compiler supports -fno-rtti -fno-exceptions])
+ echo "int some_variable = 0;" > conftest.$ac_ext
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -fno-rtti -fno-exceptions -c conftest.$ac_ext"
+ compiler_rtti_exceptions=no
+ AC_TRY_COMPILE([], [int some_variable = 0;], [dnl
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s conftest.err; then
+ compiler_rtti_exceptions=no
+ else
+ compiler_rtti_exceptions=yes
+ fi
+ ])
+ CFLAGS="$save_CFLAGS"
+ AC_MSG_RESULT([$compiler_rtti_exceptions])
+
+ if test "$compiler_rtti_exceptions" = "yes"; then
+ no_builtin_flag=' -fno-builtin -fno-rtti -fno-exceptions'
+ else
+ no_builtin_flag=' -fno-builtin'
+ fi
+fi
+
+# See if the linker supports building shared libraries.
+AC_MSG_CHECKING([whether the linker ($LD) supports shared libraries])
+
+allow_undefined_flag=
+no_undefined_flag=
+need_lib_prefix=unknown
+need_version=unknown
+# when you set need_version to no, make sure it does not cause -set_version
+# flags to be left without arguments
+archive_cmds=
+archive_expsym_cmds=
+old_archive_from_new_cmds=
+old_archive_from_expsyms_cmds=
+export_dynamic_flag_spec=
+whole_archive_flag_spec=
+thread_safe_flag_spec=
+hardcode_into_libs=no
+hardcode_libdir_flag_spec=
+hardcode_libdir_separator=
+hardcode_direct=no
+hardcode_minus_L=no
+hardcode_shlibpath_var=unsupported
+runpath_var=
+link_all_deplibs=unknown
+always_export_symbols=no
+export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | sed '\''s/.* //'\'' | sort | uniq > $export_symbols'
+# include_expsyms should be a list of space-separated symbols to be *always*
+# included in the symbol list
+include_expsyms=
+# exclude_expsyms can be an egrep regular expression of symbols to exclude
+# it will be wrapped by ` (' and `)$', so one must not match beginning or
+# end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
+# as well as any symbol that contains `d'.
+exclude_expsyms="_GLOBAL_OFFSET_TABLE_"
+# Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
+# platforms (ab)use it in PIC code, but their linkers get confused if
+# the symbol is explicitly referenced. Since portable code cannot
+# rely on this symbol name, it's probably fine to never include it in
+# preloaded symbol tables.
+extract_expsyms_cmds=
+
+case $host_os in
+cygwin* | mingw* | pw32*)
+ # FIXME: the MSVC++ port hasn't been tested in a loooong time
+ # When not using gcc, we currently assume that we are using
+ # Microsoft Visual C++.
+ if test "$GCC" != yes; then
+ with_gnu_ld=no
+ fi
+ ;;
+openbsd*)
+ with_gnu_ld=no
+ ;;
+esac
+
+ld_shlibs=yes
+if test "$with_gnu_ld" = yes; then
+ # If archive_cmds runs LD, not CC, wlarc should be empty
+ wlarc='${wl}'
+
+ # See if GNU ld supports shared libraries.
+ case $host_os in
+ aix3* | aix4* | aix5*)
+ # On AIX, the GNU linker is very broken
+ # Note:Check GNU linker on AIX 5-IA64 when/if it becomes available.
+ ld_shlibs=no
+ cat <<EOF 1>&2
+
+*** Warning: the GNU linker, at least up to release 2.9.1, is reported
+*** to be unable to reliably create shared libraries on AIX.
+*** Therefore, libtool is disabling shared libraries support. If you
+*** really care for shared libraries, you may want to modify your PATH
+*** so that a non-GNU linker is found, and then restart.
+
+EOF
+ ;;
+
+ amigaos*)
+ archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+
+ # Samuel A. Falvo II <kc5tja@dolphin.openprojects.net> reports
+ # that the semantics of dynamic libraries on AmigaOS, at least up
+ # to version 4, is to share data among multiple programs linked
+ # with the same dynamic library. Since this doesn't match the
+ # behavior of shared libraries on other platforms, we can use
+ # them.
+ ld_shlibs=no
+ ;;
+
+ beos*)
+ if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ allow_undefined_flag=unsupported
+ # Joseph Beckenbach <jrb3@best.com> says some releases of gcc
+ # support --undefined. This deserves some investigation. FIXME
+ archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ # hardcode_libdir_flag_spec is actually meaningless, as there is
+ # no search path for DLLs.
+ hardcode_libdir_flag_spec='-L$libdir'
+ allow_undefined_flag=unsupported
+ always_export_symbols=yes
+
+ extract_expsyms_cmds='test -f $output_objdir/impgen.c || \
+ sed -e "/^# \/\* impgen\.c starts here \*\//,/^# \/\* impgen.c ends here \*\// { s/^# //;s/^# *$//; p; }" -e d < $''0 > $output_objdir/impgen.c~
+ test -f $output_objdir/impgen.exe || (cd $output_objdir && \
+ if test "x$HOST_CC" != "x" ; then $HOST_CC -o impgen impgen.c ; \
+ else $CC -o impgen impgen.c ; fi)~
+ $output_objdir/impgen $dir/$soroot > $output_objdir/$soname-def'
+
+ old_archive_from_expsyms_cmds='$DLLTOOL --as=$AS --dllname $soname --def $output_objdir/$soname-def --output-lib $output_objdir/$newlib'
+
+ # cygwin and mingw dlls have different entry points and sets of symbols
+ # to exclude.
+ # FIXME: what about values for MSVC?
+ dll_entry=__cygwin_dll_entry@12
+ dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12~
+ case $host_os in
+ mingw*)
+ # mingw values
+ dll_entry=_DllMainCRTStartup@12
+ dll_exclude_symbols=DllMain@12,DllMainCRTStartup@12,DllEntryPoint@12~
+ ;;
+ esac
+
+ # mingw and cygwin differ, and it's simplest to just exclude the union
+ # of the two symbol sets.
+ dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12,DllMainCRTStartup@12,DllEntryPoint@12
+
+ # recent cygwin and mingw systems supply a stub DllMain which the user
+ # can override, but on older systems we have to supply one (in ltdll.c)
+ if test "x$lt_cv_need_dllmain" = "xyes"; then
+ ltdll_obj='$output_objdir/$soname-ltdll.'"$ac_objext "
+ ltdll_cmds='test -f $output_objdir/$soname-ltdll.c || sed -e "/^# \/\* ltdll\.c starts here \*\//,/^# \/\* ltdll.c ends here \*\// { s/^# //; p; }" -e d < $''0 > $output_objdir/$soname-ltdll.c~
+ test -f $output_objdir/$soname-ltdll.$ac_objext || (cd $output_objdir && $CC -c $soname-ltdll.c)~'
+ else
+ ltdll_obj=
+ ltdll_cmds=
+ fi
+
+ # Extract the symbol export list from an `--export-all' def file,
+ # then regenerate the def file from the symbol export list, so that
+ # the compiled dll only exports the symbol export list.
+ # Be careful not to strip the DATA tag left be newer dlltools.
+ export_symbols_cmds="$ltdll_cmds"'
+ $DLLTOOL --export-all --exclude-symbols '$dll_exclude_symbols' --output-def $output_objdir/$soname-def '$ltdll_obj'$libobjs $convenience~
+ sed -e "1,/EXPORTS/d" -e "s/ @ [[0-9]]*//" -e "s/ *;.*$//" < $output_objdir/$soname-def > $export_symbols'
+
+ # If the export-symbols file already is a .def file (1st line
+ # is EXPORTS), use it as is.
+ # If DATA tags from a recent dlltool are present, honour them!
+ archive_expsym_cmds='if test "x`head -1 $export_symbols`" = xEXPORTS; then
+ cp $export_symbols $output_objdir/$soname-def;
+ else
+ echo EXPORTS > $output_objdir/$soname-def;
+ _lt_hint=1;
+ cat $export_symbols | while read symbol; do
+ set dummy \$symbol;
+ case \[$]# in
+ 2) echo " \[$]2 @ \$_lt_hint ; " >> $output_objdir/$soname-def;;
+ *) echo " \[$]2 @ \$_lt_hint \[$]3 ; " >> $output_objdir/$soname-def;;
+ esac;
+ _lt_hint=`expr 1 + \$_lt_hint`;
+ done;
+ fi~
+ '"$ltdll_cmds"'
+ $CC -Wl,--base-file,$output_objdir/$soname-base '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags~
+ $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp~
+ $CC -Wl,--base-file,$output_objdir/$soname-base $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags~
+ $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp --output-lib $output_objdir/$libname.dll.a~
+ $CC $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags'
+ ;;
+
+ netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
+ wlarc=
+ else
+ archive_cmds='$CC -shared -nodefaultlibs $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared -nodefaultlibs $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ fi
+ ;;
+
+ solaris* | sysv5*)
+ if $LD -v 2>&1 | egrep 'BFD 2\.8' > /dev/null; then
+ ld_shlibs=no
+ cat <<EOF 1>&2
+
+*** Warning: The releases 2.8.* of the GNU linker cannot reliably
+*** create shared libraries on Solaris systems. Therefore, libtool
+*** is disabling shared libraries support. We urge you to upgrade GNU
+*** binutils to release 2.9.1 or newer. Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+EOF
+ elif $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+
+ sunos4*)
+ archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ wlarc=
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ *)
+ if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+ esac
+
+ if test "$ld_shlibs" = yes; then
+ runpath_var=LD_RUN_PATH
+ hardcode_libdir_flag_spec='${wl}--rpath ${wl}$libdir'
+ export_dynamic_flag_spec='${wl}--export-dynamic'
+ case $host_os in
+ cygwin* | mingw* | pw32*)
+ # dlltool doesn't understand --whole-archive et. al.
+ whole_archive_flag_spec=
+ ;;
+ *)
+ # ancient GNU ld didn't support --whole-archive et. al.
+ if $LD --help 2>&1 | egrep 'no-whole-archive' > /dev/null; then
+ whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
+ else
+ whole_archive_flag_spec=
+ fi
+ ;;
+ esac
+ fi
+else
+ # PORTME fill in a description of your system's linker (not GNU ld)
+ case $host_os in
+ aix3*)
+ allow_undefined_flag=unsupported
+ always_export_symbols=yes
+ archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
+ # Note: this linker hardcodes the directories in LIBPATH if there
+ # are no directories specified by -L.
+ hardcode_minus_L=yes
+ if test "$GCC" = yes && test -z "$link_static_flag"; then
+ # Neither direct hardcoding nor static linking is supported with a
+ # broken collect2.
+ hardcode_direct=unsupported
+ fi
+ ;;
+
+ aix4* | aix5*)
+ if test "$host_cpu" = ia64; then
+ # On IA64, the linker does run time linking by default, so we don't
+ # have to do anything special.
+ aix_use_runtimelinking=no
+ exp_sym_flag='-Bexport'
+ no_entry_flag=""
+ else
+ aix_use_runtimelinking=no
+
+ # Test if we are trying to use run time linking or normal
+ # AIX style linking. If -brtl is somewhere in LDFLAGS, we
+ # need to do runtime linking.
+ case $host_os in aix4.[[23]]|aix4.[[23]].*|aix5*)
+ for ld_flag in $LDFLAGS; do
+ if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
+ aix_use_runtimelinking=yes
+ break
+ fi
+ done
+ esac
+
+ exp_sym_flag='-bexport'
+ no_entry_flag='-bnoentry'
+ fi
+
+ # When large executables or shared objects are built, AIX ld can
+ # have problems creating the table of contents. If linking a library
+ # or program results in "error TOC overflow" add -mminimal-toc to
+ # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
+ # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
+
+ hardcode_direct=yes
+ archive_cmds=''
+ hardcode_libdir_separator=':'
+ if test "$GCC" = yes; then
+ case $host_os in aix4.[[012]]|aix4.[[012]].*)
+ collect2name=`${CC} -print-prog-name=collect2`
+ if test -f "$collect2name" && \
+ strings "$collect2name" | grep resolve_lib_name >/dev/null
+ then
+ # We have reworked collect2
+ hardcode_direct=yes
+ else
+ # We have old collect2
+ hardcode_direct=unsupported
+ # It fails to find uninstalled libraries when the uninstalled
+ # path is not listed in the libpath. Setting hardcode_minus_L
+ # to unsupported forces relinking
+ hardcode_minus_L=yes
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_libdir_separator=
+ fi
+ esac
+
+ shared_flag='-shared'
+ else
+ # not using gcc
+ if test "$host_cpu" = ia64; then
+ shared_flag='${wl}-G'
+ else
+ if test "$aix_use_runtimelinking" = yes; then
+ shared_flag='${wl}-G'
+ else
+ shared_flag='${wl}-bM:SRE'
+ fi
+ fi
+ fi
+
+ # It seems that -bexpall can do strange things, so it is better to
+ # generate a list of symbols to export.
+ always_export_symbols=yes
+ if test "$aix_use_runtimelinking" = yes; then
+ # Warning - without using the other runtime loading flags (-brtl),
+ # -berok will link without error, but may produce a broken library.
+ allow_undefined_flag='-berok'
+ hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:/usr/lib:/lib'
+ archive_expsym_cmds="\$CC"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then echo "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols $shared_flag"
+ else
+ if test "$host_cpu" = ia64; then
+ hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib'
+ allow_undefined_flag="-z nodefs"
+ archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname ${wl}-h$soname $libobjs $deplibs $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols"
+ else
+ hardcode_libdir_flag_spec='${wl}-bnolibpath ${wl}-blibpath:$libdir:/usr/lib:/lib'
+ # Warning - without using the other run time loading flags,
+ # -berok will link without error, but may produce a broken library.
+ allow_undefined_flag='${wl}-berok'
+ # This is a bit strange, but is similar to how AIX traditionally builds
+ # it's shared libraries.
+ archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags ${allow_undefined_flag} '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols"' ~$AR -crlo $objdir/$libname$release.a $objdir/$soname'
+ fi
+ fi
+ ;;
+
+ amigaos*)
+ archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+ # see comment about different semantics on the GNU ld section
+ ld_shlibs=no
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ # When not using gcc, we currently assume that we are using
+ # Microsoft Visual C++.
+ # hardcode_libdir_flag_spec is actually meaningless, as there is
+ # no search path for DLLs.
+ hardcode_libdir_flag_spec=' '
+ allow_undefined_flag=unsupported
+ # Tell ltmain to make .lib files, not .a files.
+ libext=lib
+ # FIXME: Setting linknames here is a bad hack.
+ archive_cmds='$CC -o $lib $libobjs $compiler_flags `echo "$deplibs" | sed -e '\''s/ -lc$//'\''` -link -dll~linknames='
+ # The linker will automatically build a .lib file if we build a DLL.
+ old_archive_from_new_cmds='true'
+ # FIXME: Should let the user specify the lib program.
+ old_archive_cmds='lib /OUT:$oldlib$oldobjs$old_deplibs'
+ fix_srcfile_path='`cygpath -w "$srcfile"`'
+ ;;
+
+ darwin* | rhapsody*)
+ case "$host_os" in
+ rhapsody* | darwin1.[[012]])
+ allow_undefined_flag='-undefined suppress'
+ ;;
+ *) # Darwin 1.3 on
+ allow_undefined_flag='-flat_namespace -undefined suppress'
+ ;;
+ esac
+ # FIXME: Relying on posixy $() will cause problems for
+ # cross-compilation, but unfortunately the echo tests do not
+ # yet detect zsh echo's removal of \ escapes.
+ archive_cmds='$nonopt $(test "x$module" = xyes && echo -bundle || echo -dynamiclib) $allow_undefined_flag -o $lib $libobjs $deplibs$linker_flags -install_name $rpath/$soname $verstring'
+ # We need to add '_' to the symbols in $export_symbols first
+ #archive_expsym_cmds="$archive_cmds"' && strip -s $export_symbols'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ whole_archive_flag_spec='-all_load $convenience'
+ ;;
+
+ freebsd1*)
+ ld_shlibs=no
+ ;;
+
+ # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
+ # support. Future versions do this automatically, but an explicit c++rt0.o
+ # does not break anything, and helps significantly (at the cost of a little
+ # extra space).
+ freebsd2.2*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ # Unfortunately, older versions of FreeBSD 2 do not have this feature.
+ freebsd2*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
+ freebsd*)
+ archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ hpux9* | hpux10* | hpux11*)
+ case $host_os in
+ hpux9*) archive_cmds='$rm $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' ;;
+ *) archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' ;;
+ esac
+ hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+ hardcode_libdir_separator=:
+ hardcode_direct=yes
+ hardcode_minus_L=yes # Not in the search PATH, but as the default
+ # location of the library.
+ export_dynamic_flag_spec='${wl}-E'
+ ;;
+
+ irix5* | irix6*)
+ if test "$GCC" = yes; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ else
+ archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ fi
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ link_all_deplibs=yes
+ ;;
+
+ netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out
+ else
+ archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF
+ fi
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ newsos6)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ hardcode_shlibpath_var=no
+ ;;
+
+ openbsd*)
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+ export_dynamic_flag_spec='${wl}-E'
+ else
+ case "$host_os" in
+ openbsd[[01]].* | openbsd2.[[0-7]] | openbsd2.[[0-7]].*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-R$libdir'
+ ;;
+ *)
+ archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+ ;;
+ esac
+ fi
+ ;;
+
+ os2*)
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+ allow_undefined_flag=unsupported
+ archive_cmds='$echo "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$echo "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$echo DATA >> $output_objdir/$libname.def~$echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~$echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
+ old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
+ ;;
+
+ osf3*)
+ if test "$GCC" = yes; then
+ allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+ archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ else
+ allow_undefined_flag=' -expect_unresolved \*'
+ archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ fi
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ ;;
+
+ osf4* | osf5*) # as osf3* with the addition of -msym flag
+ if test "$GCC" = yes; then
+ allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+ archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ else
+ allow_undefined_flag=' -expect_unresolved \*'
+ archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ archive_expsym_cmds='for i in `cat $export_symbols`; do printf "-exported_symbol " >> $lib.exp; echo "\$i" >> $lib.exp; done; echo "-hidden">> $lib.exp~
+ $LD -shared${allow_undefined_flag} -input $lib.exp $linker_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${objdir}/so_locations -o $lib~$rm $lib.exp'
+
+ #Both c and cxx compiler support -rpath directly
+ hardcode_libdir_flag_spec='-rpath $libdir'
+ fi
+ hardcode_libdir_separator=:
+ ;;
+
+ sco3.2v5*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ runpath_var=LD_RUN_PATH
+ hardcode_runpath_var=yes
+ export_dynamic_flag_spec='${wl}-Bexport'
+ ;;
+
+ solaris*)
+ # gcc --version < 3.0 without binutils cannot create self contained
+ # shared libraries reliably, requiring libgcc.a to resolve some of
+ # the object symbols generated in some cases. Libraries that use
+ # assert need libgcc.a to resolve __eprintf, for example. Linking
+ # a copy of libgcc.a into every shared library to guarantee resolving
+ # such symbols causes other problems: According to Tim Van Holder
+ # <tim.van.holder@pandora.be>, C++ libraries end up with a separate
+ # (to the application) exception stack for one thing.
+ no_undefined_flag=' -z defs'
+ if test "$GCC" = yes; then
+ case `$CC --version 2>/dev/null` in
+ [[12]].*)
+ cat <<EOF 1>&2
+
+*** Warning: Releases of GCC earlier than version 3.0 cannot reliably
+*** create self contained shared libraries on Solaris systems, without
+*** introducing a dependency on libgcc.a. Therefore, libtool is disabling
+*** -no-undefined support, which will at least allow you to build shared
+*** libraries. However, you may find that when you link such libraries
+*** into an application without using GCC, you have to manually add
+*** \`gcc --print-libgcc-file-name\` to the link command. We urge you to
+*** upgrade to a newer version of GCC. Another option is to rebuild your
+*** current GCC to use the GNU linker from GNU binutils 2.9.1 or newer.
+
+EOF
+ no_undefined_flag=
+ ;;
+ esac
+ fi
+ # $CC -shared without GNU ld will not create a library from C++
+ # object files and a static libstdc++, better avoid it by now
+ archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
+ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_shlibpath_var=no
+ case $host_os in
+ solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
+ *) # Supported since Solaris 2.6 (maybe 2.5.1?)
+ whole_archive_flag_spec='-z allextract$convenience -z defaultextract' ;;
+ esac
+ link_all_deplibs=yes
+ ;;
+
+ sunos4*)
+ if test "x$host_vendor" = xsequent; then
+ # Use $CC to link under sequent, because it throws in some extra .o
+ # files that make .init and .fini sections work.
+ archive_cmds='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags'
+ else
+ archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
+ fi
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4)
+ if test "x$host_vendor" = xsno; then
+ archive_cmds='$LD -G -Bsymbolic -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes # is this really true???
+ else
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=no #Motorola manual says yes, but my tests say they lie
+ fi
+ runpath_var='LD_RUN_PATH'
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4.3*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ export_dynamic_flag_spec='-Bexport'
+ ;;
+
+ sysv5*)
+ no_undefined_flag=' -z text'
+ # $CC -shared without GNU ld will not create a library from C++
+ # object files and a static libstdc++, better avoid it by now
+ archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
+ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
+ hardcode_libdir_flag_spec=
+ hardcode_shlibpath_var=no
+ runpath_var='LD_RUN_PATH'
+ ;;
+
+ uts4*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_shlibpath_var=no
+ ;;
+
+ dgux*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4*MP*)
+ if test -d /usr/nec; then
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ runpath_var=LD_RUN_PATH
+ hardcode_runpath_var=yes
+ ld_shlibs=yes
+ fi
+ ;;
+
+ sysv4.2uw2*)
+ archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_minus_L=no
+ hardcode_shlibpath_var=no
+ hardcode_runpath_var=yes
+ runpath_var=LD_RUN_PATH
+ ;;
+
+ sysv5uw7* | unixware7*)
+ no_undefined_flag='${wl}-z ${wl}text'
+ if test "$GCC" = yes; then
+ archive_cmds='$CC -shared ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
+ else
+ archive_cmds='$CC -G ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
+ fi
+ runpath_var='LD_RUN_PATH'
+ hardcode_shlibpath_var=no
+ ;;
+
+ *)
+ ld_shlibs=no
+ ;;
+ esac
+fi
+AC_MSG_RESULT([$ld_shlibs])
+test "$ld_shlibs" = no && can_build_shared=no
+
+# Check hardcoding attributes.
+AC_MSG_CHECKING([how to hardcode library paths into programs])
+hardcode_action=
+if test -n "$hardcode_libdir_flag_spec" || \
+ test -n "$runpath_var"; then
+
+ # We can hardcode non-existant directories.
+ if test "$hardcode_direct" != no &&
+ # If the only mechanism to avoid hardcoding is shlibpath_var, we
+ # have to relink, otherwise we might link with an installed library
+ # when we should be linking with a yet-to-be-installed one
+ ## test "$hardcode_shlibpath_var" != no &&
+ test "$hardcode_minus_L" != no; then
+ # Linking always hardcodes the temporary library directory.
+ hardcode_action=relink
+ else
+ # We can link without hardcoding, and we can hardcode nonexisting dirs.
+ hardcode_action=immediate
+ fi
+else
+ # We cannot hardcode anything, or else we can only hardcode existing
+ # directories.
+ hardcode_action=unsupported
+fi
+AC_MSG_RESULT([$hardcode_action])
+
+striplib=
+old_striplib=
+AC_MSG_CHECKING([whether stripping libraries is possible])
+if test -n "$STRIP" && $STRIP -V 2>&1 | grep "GNU strip" >/dev/null; then
+ test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
+ test -z "$striplib" && striplib="$STRIP --strip-unneeded"
+ AC_MSG_RESULT([yes])
+else
+ AC_MSG_RESULT([no])
+fi
+
+reload_cmds='$LD$reload_flag -o $output$reload_objs'
+test -z "$deplibs_check_method" && deplibs_check_method=unknown
+
+# PORTME Fill in your ld.so characteristics
+AC_MSG_CHECKING([dynamic linker characteristics])
+library_names_spec=
+libname_spec='lib$name'
+soname_spec=
+postinstall_cmds=
+postuninstall_cmds=
+finish_cmds=
+finish_eval=
+shlibpath_var=
+shlibpath_overrides_runpath=unknown
+version_type=none
+dynamic_linker="$host_os ld.so"
+sys_lib_dlsearch_path_spec="/lib /usr/lib"
+sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+
+case $host_os in
+aix3*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix $libname.a'
+ shlibpath_var=LIBPATH
+
+ # AIX has no versioning support, so we append a major version to the name.
+ soname_spec='${libname}${release}.so$major'
+ ;;
+
+aix4* | aix5*)
+ version_type=linux
+ if test "$host_cpu" = ia64; then
+ # AIX 5 supports IA64
+ library_names_spec='${libname}${release}.so$major ${libname}${release}.so$versuffix $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ else
+ # With GCC up to 2.95.x, collect2 would create an import file
+ # for dependence libraries. The import file would start with
+ # the line `#! .'. This would cause the generated library to
+ # depend on `.', always an invalid library. This was fixed in
+ # development snapshots of GCC prior to 3.0.
+ case $host_os in
+ aix4 | aix4.[[01]] | aix4.[[01]].*)
+ if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
+ echo ' yes '
+ echo '#endif'; } | ${CC} -E - | grep yes > /dev/null; then
+ :
+ else
+ can_build_shared=no
+ fi
+ ;;
+ esac
+ # AIX (on Power*) has no versioning support, so currently we can
+ # not hardcode correct soname into executable. Probably we can
+ # add versioning support to collect2, so additional links can
+ # be useful in future.
+ if test "$aix_use_runtimelinking" = yes; then
+ # If using run time linking (on AIX 4.2 or later) use lib<name>.so
+ # instead of lib<name>.a to let people know that these are not
+ # typical AIX shared libraries.
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ else
+ # We preserve .a as extension for shared libraries through AIX4.2
+ # and later when we are not doing run time linking.
+ library_names_spec='${libname}${release}.a $libname.a'
+ soname_spec='${libname}${release}.so$major'
+ fi
+ shlibpath_var=LIBPATH
+ fi
+ ;;
+
+amigaos*)
+ library_names_spec='$libname.ixlibrary $libname.a'
+ # Create ${libname}_ixlibrary.a entries in /sys/libs.
+ finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([[^/]]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "(cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a)"; (cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a) || exit 1; done'
+ ;;
+
+beos*)
+ library_names_spec='${libname}.so'
+ dynamic_linker="$host_os ld.so"
+ shlibpath_var=LIBRARY_PATH
+ ;;
+
+bsdi4*)
+ version_type=linux
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
+ sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
+ export_dynamic_flag_spec=-rdynamic
+ # the default ld.so.conf also contains /usr/contrib/lib and
+ # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
+ # libtool to hard-code these into programs
+ ;;
+
+cygwin* | mingw* | pw32*)
+ version_type=windows
+ need_version=no
+ need_lib_prefix=no
+ case $GCC,$host_os in
+ yes,cygwin*)
+ library_names_spec='$libname.dll.a'
+ soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | sed -e 's/[[.]]/-/g'`${versuffix}.dll'
+ postinstall_cmds='dlpath=`bash 2>&1 -c '\''. $dir/${file}i;echo \$dlname'\''`~
+ dldir=$destdir/`dirname \$dlpath`~
+ test -d \$dldir || mkdir -p \$dldir~
+ $install_prog .libs/$dlname \$dldir/$dlname'
+ postuninstall_cmds='dldll=`bash 2>&1 -c '\''. $file; echo \$dlname'\''`~
+ dlpath=$dir/\$dldll~
+ $rm \$dlpath'
+ ;;
+ yes,mingw*)
+ library_names_spec='${libname}`echo ${release} | sed -e 's/[[.]]/-/g'`${versuffix}.dll'
+ sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | sed -e "s/^libraries://" -e "s/;/ /g"`
+ ;;
+ yes,pw32*)
+ library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll'
+ ;;
+ *)
+ library_names_spec='${libname}`echo ${release} | sed -e 's/[[.]]/-/g'`${versuffix}.dll $libname.lib'
+ ;;
+ esac
+ dynamic_linker='Win32 ld.exe'
+ # FIXME: first we should search . and the directory the executable is in
+ shlibpath_var=PATH
+ ;;
+
+darwin* | rhapsody*)
+ dynamic_linker="$host_os dyld"
+ version_type=darwin
+ need_lib_prefix=no
+ need_version=no
+ # FIXME: Relying on posixy $() will cause problems for
+ # cross-compilation, but unfortunately the echo tests do not
+ # yet detect zsh echo's removal of \ escapes.
+ library_names_spec='${libname}${release}${versuffix}.$(test .$module = .yes && echo so || echo dylib) ${libname}${release}${major}.$(test .$module = .yes && echo so || echo dylib) ${libname}.$(test .$module = .yes && echo so || echo dylib)'
+ soname_spec='${libname}${release}${major}.$(test .$module = .yes && echo so || echo dylib)'
+ shlibpath_overrides_runpath=yes
+ shlibpath_var=DYLD_LIBRARY_PATH
+ ;;
+
+freebsd1*)
+ dynamic_linker=no
+ ;;
+
+freebsd*)
+ objformat=`test -x /usr/bin/objformat && /usr/bin/objformat || echo aout`
+ version_type=freebsd-$objformat
+ case $version_type in
+ freebsd-elf*)
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
+ need_version=no
+ need_lib_prefix=no
+ ;;
+ freebsd-*)
+ library_names_spec='${libname}${release}.so$versuffix $libname.so$versuffix'
+ need_version=yes
+ ;;
+ esac
+ shlibpath_var=LD_LIBRARY_PATH
+ case $host_os in
+ freebsd2*)
+ shlibpath_overrides_runpath=yes
+ ;;
+ *)
+ shlibpath_overrides_runpath=no
+ hardcode_into_libs=yes
+ ;;
+ esac
+ ;;
+
+gnu*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so${major} ${libname}.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ hardcode_into_libs=yes
+ ;;
+
+hpux9* | hpux10* | hpux11*)
+ # Give a soname corresponding to the major version so that dld.sl refuses to
+ # link against other versions.
+ dynamic_linker="$host_os dld.sl"
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ shlibpath_var=SHLIB_PATH
+ shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
+ library_names_spec='${libname}${release}.sl$versuffix ${libname}${release}.sl$major $libname.sl'
+ soname_spec='${libname}${release}.sl$major'
+ # HP-UX runs *really* slowly unless shared libraries are mode 555.
+ postinstall_cmds='chmod 555 $lib'
+ ;;
+
+irix5* | irix6*)
+ version_type=irix
+ need_lib_prefix=no
+ need_version=no
+ soname_spec='${libname}${release}.so$major'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major ${libname}${release}.so $libname.so'
+ case $host_os in
+ irix5*)
+ libsuff= shlibsuff=
+ ;;
+ *)
+ case $LD in # libtool.m4 will add one of these switches to LD
+ *-32|*"-32 ") libsuff= shlibsuff= libmagic=32-bit;;
+ *-n32|*"-n32 ") libsuff=32 shlibsuff=N32 libmagic=N32;;
+ *-64|*"-64 ") libsuff=64 shlibsuff=64 libmagic=64-bit;;
+ *) libsuff= shlibsuff= libmagic=never-match;;
+ esac
+ ;;
+ esac
+ shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
+ shlibpath_overrides_runpath=no
+ sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
+ sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
+ ;;
+
+# No shared lib support for Linux oldld, aout, or coff.
+linux-gnuoldld* | linux-gnuaout* | linux-gnucoff*)
+ dynamic_linker=no
+ ;;
+
+# This must be Linux ELF.
+linux-gnu*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=no
+ # This implies no fast_install, which is unacceptable.
+ # Some rework will be needed to allow for fast_install
+ # before this can be enabled.
+ hardcode_into_libs=yes
+
+ # We used to test for /lib/ld.so.1 and disable shared libraries on
+ # powerpc, because MkLinux only supported shared libraries with the
+ # GNU dynamic linker. Since this was broken with cross compilers,
+ # most powerpc-linux boxes support dynamic linking these days and
+ # people can always --disable-shared, the test was removed, and we
+ # assume the GNU/Linux dynamic linker is in use.
+ dynamic_linker='GNU/Linux ld.so'
+ ;;
+
+netbsd*)
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+ dynamic_linker='NetBSD (a.out) ld.so'
+ else
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major ${libname}${release}.so ${libname}.so'
+ soname_spec='${libname}${release}.so$major'
+ dynamic_linker='NetBSD ld.elf_so'
+ fi
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ hardcode_into_libs=yes
+ ;;
+
+newsos6)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ ;;
+
+openbsd*)
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ case "$host_os" in
+ openbsd2.[[89]] | openbsd2.[[89]].*)
+ shlibpath_overrides_runpath=no
+ ;;
+ *)
+ shlibpath_overrides_runpath=yes
+ ;;
+ esac
+ else
+ shlibpath_overrides_runpath=yes
+ fi
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+os2*)
+ libname_spec='$name'
+ need_lib_prefix=no
+ library_names_spec='$libname.dll $libname.a'
+ dynamic_linker='OS/2 ld.exe'
+ shlibpath_var=LIBPATH
+ ;;
+
+osf3* | osf4* | osf5*)
+ version_type=osf
+ need_version=no
+ soname_spec='${libname}${release}.so'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
+ sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
+ ;;
+
+sco3.2v5*)
+ version_type=osf
+ soname_spec='${libname}${release}.so$major'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+solaris*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ hardcode_into_libs=yes
+ # ldd complains unless libraries are executable
+ postinstall_cmds='chmod +x $lib'
+ ;;
+
+sunos4*)
+ version_type=sunos
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ if test "$with_gnu_ld" = yes; then
+ need_lib_prefix=no
+ fi
+ need_version=yes
+ ;;
+
+sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ case $host_vendor in
+ sni)
+ shlibpath_overrides_runpath=no
+ ;;
+ motorola)
+ need_lib_prefix=no
+ need_version=no
+ shlibpath_overrides_runpath=no
+ sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
+ ;;
+ esac
+ ;;
+
+uts4*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+dgux*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+sysv4*MP*)
+ if test -d /usr/nec ;then
+ version_type=linux
+ library_names_spec='$libname.so.$versuffix $libname.so.$major $libname.so'
+ soname_spec='$libname.so.$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ fi
+ ;;
+
+*)
+ dynamic_linker=no
+ ;;
+esac
+AC_MSG_RESULT([$dynamic_linker])
+test "$dynamic_linker" = no && can_build_shared=no
+
+# Report the final consequences.
+AC_MSG_CHECKING([if libtool supports shared libraries])
+AC_MSG_RESULT([$can_build_shared])
+
+AC_MSG_CHECKING([whether to build shared libraries])
+test "$can_build_shared" = "no" && enable_shared=no
+
+# On AIX, shared libraries and static libraries use the same namespace, and
+# are all built from PIC.
+case "$host_os" in
+aix3*)
+ test "$enable_shared" = yes && enable_static=no
+ if test -n "$RANLIB"; then
+ archive_cmds="$archive_cmds~\$RANLIB \$lib"
+ postinstall_cmds='$RANLIB $lib'
+ fi
+ ;;
+
+aix4*)
+ if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
+ test "$enable_shared" = yes && enable_static=no
+ fi
+ ;;
+esac
+AC_MSG_RESULT([$enable_shared])
+
+AC_MSG_CHECKING([whether to build static libraries])
+# Make sure either enable_shared or enable_static is yes.
+test "$enable_shared" = yes || enable_static=yes
+AC_MSG_RESULT([$enable_static])
+
+if test "$hardcode_action" = relink; then
+ # Fast installation is not supported
+ enable_fast_install=no
+elif test "$shlibpath_overrides_runpath" = yes ||
+ test "$enable_shared" = no; then
+ # Fast installation is not necessary
+ enable_fast_install=needless
+fi
+
+variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
+if test "$GCC" = yes; then
+ variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
+fi
+
+AC_LIBTOOL_DLOPEN_SELF
+
+if test "$enable_shared" = yes && test "$GCC" = yes; then
+ case $archive_cmds in
+ *'~'*)
+ # FIXME: we may have to deal with multi-command sequences.
+ ;;
+ '$CC '*)
+ # Test whether the compiler implicitly links with -lc since on some
+ # systems, -lgcc has to come before -lc. If gcc already passes -lc
+ # to ld, don't add -lc before -lgcc.
+ AC_MSG_CHECKING([whether -lc should be explicitly linked in])
+ AC_CACHE_VAL([lt_cv_archive_cmds_need_lc],
+ [$rm conftest*
+ echo 'static int dummy;' > conftest.$ac_ext
+
+ if AC_TRY_EVAL(ac_compile); then
+ soname=conftest
+ lib=conftest
+ libobjs=conftest.$ac_objext
+ deplibs=
+ wl=$lt_cv_prog_cc_wl
+ compiler_flags=-v
+ linker_flags=-v
+ verstring=
+ output_objdir=.
+ libname=conftest
+ save_allow_undefined_flag=$allow_undefined_flag
+ allow_undefined_flag=
+ if AC_TRY_EVAL(archive_cmds 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1)
+ then
+ lt_cv_archive_cmds_need_lc=no
+ else
+ lt_cv_archive_cmds_need_lc=yes
+ fi
+ allow_undefined_flag=$save_allow_undefined_flag
+ else
+ cat conftest.err 1>&5
+ fi])
+ AC_MSG_RESULT([$lt_cv_archive_cmds_need_lc])
+ ;;
+ esac
+fi
+need_lc=${lt_cv_archive_cmds_need_lc-yes}
+
+# The second clause should only fire when bootstrapping the
+# libtool distribution, otherwise you forgot to ship ltmain.sh
+# with your package, and you will get complaints that there are
+# no rules to generate ltmain.sh.
+if test -f "$ltmain"; then
+ :
+else
+ # If there is no Makefile yet, we rely on a make rule to execute
+ # `config.status --recheck' to rerun these tests and create the
+ # libtool script then.
+ test -f Makefile && make "$ltmain"
+fi
+
+if test -f "$ltmain"; then
+ trap "$rm \"${ofile}T\"; exit 1" 1 2 15
+ $rm -f "${ofile}T"
+
+ echo creating $ofile
+
+ # Now quote all the things that may contain metacharacters while being
+ # careful not to overquote the AC_SUBSTed values. We take copies of the
+ # variables and quote the copies for generation of the libtool script.
+ for var in echo old_CC old_CFLAGS \
+ AR AR_FLAGS CC LD LN_S NM SHELL \
+ reload_flag reload_cmds wl \
+ pic_flag link_static_flag no_builtin_flag export_dynamic_flag_spec \
+ thread_safe_flag_spec whole_archive_flag_spec libname_spec \
+ library_names_spec soname_spec \
+ RANLIB old_archive_cmds old_archive_from_new_cmds old_postinstall_cmds \
+ old_postuninstall_cmds archive_cmds archive_expsym_cmds postinstall_cmds \
+ postuninstall_cmds extract_expsyms_cmds old_archive_from_expsyms_cmds \
+ old_striplib striplib file_magic_cmd export_symbols_cmds \
+ deplibs_check_method allow_undefined_flag no_undefined_flag \
+ finish_cmds finish_eval global_symbol_pipe global_symbol_to_cdecl \
+ global_symbol_to_c_name_address \
+ hardcode_libdir_flag_spec hardcode_libdir_separator \
+ sys_lib_search_path_spec sys_lib_dlsearch_path_spec \
+ compiler_c_o compiler_o_lo need_locks exclude_expsyms include_expsyms; do
+
+ case $var in
+ reload_cmds | old_archive_cmds | old_archive_from_new_cmds | \
+ old_postinstall_cmds | old_postuninstall_cmds | \
+ export_symbols_cmds | archive_cmds | archive_expsym_cmds | \
+ extract_expsyms_cmds | old_archive_from_expsyms_cmds | \
+ postinstall_cmds | postuninstall_cmds | \
+ finish_cmds | sys_lib_search_path_spec | sys_lib_dlsearch_path_spec)
+ # Double-quote double-evaled strings.
+ eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\""
+ ;;
+ *)
+ eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\""
+ ;;
+ esac
+ done
+
+ cat <<__EOF__ > "${ofile}T"
+#! $SHELL
+
+# `$echo "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
+# Generated automatically by $PROGRAM (GNU $PACKAGE $VERSION$TIMESTAMP)
+# NOTE: Changes made to this file will be lost: look at ltmain.sh.
+#
+# Copyright (C) 1996-2000 Free Software Foundation, Inc.
+# Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Sed that helps us avoid accidentally triggering echo(1) options like -n.
+Xsed="sed -e s/^X//"
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+if test "X\${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
+
+# ### BEGIN LIBTOOL CONFIG
+
+# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+
+# Shell to use when invoking shell scripts.
+SHELL=$lt_SHELL
+
+# Whether or not to build shared libraries.
+build_libtool_libs=$enable_shared
+
+# Whether or not to build static libraries.
+build_old_libs=$enable_static
+
+# Whether or not to add -lc for building shared libraries.
+build_libtool_need_lc=$need_lc
+
+# Whether or not to optimize for fast installation.
+fast_install=$enable_fast_install
+
+# The host system.
+host_alias=$host_alias
+host=$host
+
+# An echo program that does not interpret backslashes.
+echo=$lt_echo
+
+# The archiver.
+AR=$lt_AR
+AR_FLAGS=$lt_AR_FLAGS
+
+# The default C compiler.
+CC=$lt_CC
+
+# Is the compiler the GNU C compiler?
+with_gcc=$GCC
+
+# The linker used to build libraries.
+LD=$lt_LD
+
+# Whether we need hard or soft links.
+LN_S=$lt_LN_S
+
+# A BSD-compatible nm program.
+NM=$lt_NM
+
+# A symbol stripping program
+STRIP=$STRIP
+
+# Used to examine libraries when file_magic_cmd begins "file"
+MAGIC_CMD=$MAGIC_CMD
+
+# Used on cygwin: DLL creation program.
+DLLTOOL="$DLLTOOL"
+
+# Used on cygwin: object dumper.
+OBJDUMP="$OBJDUMP"
+
+# Used on cygwin: assembler.
+AS="$AS"
+
+# The name of the directory that contains temporary libtool files.
+objdir=$objdir
+
+# How to create reloadable object files.
+reload_flag=$lt_reload_flag
+reload_cmds=$lt_reload_cmds
+
+# How to pass a linker flag through the compiler.
+wl=$lt_wl
+
+# Object file suffix (normally "o").
+objext="$ac_objext"
+
+# Old archive suffix (normally "a").
+libext="$libext"
+
+# Executable file suffix (normally "").
+exeext="$exeext"
+
+# Additional compiler flags for building library objects.
+pic_flag=$lt_pic_flag
+pic_mode=$pic_mode
+
+# Does compiler simultaneously support -c and -o options?
+compiler_c_o=$lt_compiler_c_o
+
+# Can we write directly to a .lo ?
+compiler_o_lo=$lt_compiler_o_lo
+
+# Must we lock files when doing compilation ?
+need_locks=$lt_need_locks
+
+# Do we need the lib prefix for modules?
+need_lib_prefix=$need_lib_prefix
+
+# Do we need a version for libraries?
+need_version=$need_version
+
+# Whether dlopen is supported.
+dlopen_support=$enable_dlopen
+
+# Whether dlopen of programs is supported.
+dlopen_self=$enable_dlopen_self
+
+# Whether dlopen of statically linked programs is supported.
+dlopen_self_static=$enable_dlopen_self_static
+
+# Compiler flag to prevent dynamic linking.
+link_static_flag=$lt_link_static_flag
+
+# Compiler flag to turn off builtin functions.
+no_builtin_flag=$lt_no_builtin_flag
+
+# Compiler flag to allow reflexive dlopens.
+export_dynamic_flag_spec=$lt_export_dynamic_flag_spec
+
+# Compiler flag to generate shared objects directly from archives.
+whole_archive_flag_spec=$lt_whole_archive_flag_spec
+
+# Compiler flag to generate thread-safe objects.
+thread_safe_flag_spec=$lt_thread_safe_flag_spec
+
+# Library versioning type.
+version_type=$version_type
+
+# Format of library name prefix.
+libname_spec=$lt_libname_spec
+
+# List of archive names. First name is the real one, the rest are links.
+# The last name is the one that the linker finds with -lNAME.
+library_names_spec=$lt_library_names_spec
+
+# The coded name of the library, if different from the real name.
+soname_spec=$lt_soname_spec
+
+# Commands used to build and install an old-style archive.
+RANLIB=$lt_RANLIB
+old_archive_cmds=$lt_old_archive_cmds
+old_postinstall_cmds=$lt_old_postinstall_cmds
+old_postuninstall_cmds=$lt_old_postuninstall_cmds
+
+# Create an old-style archive from a shared archive.
+old_archive_from_new_cmds=$lt_old_archive_from_new_cmds
+
+# Create a temporary old-style archive to link instead of a shared archive.
+old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds
+
+# Commands used to build and install a shared archive.
+archive_cmds=$lt_archive_cmds
+archive_expsym_cmds=$lt_archive_expsym_cmds
+postinstall_cmds=$lt_postinstall_cmds
+postuninstall_cmds=$lt_postuninstall_cmds
+
+# Commands to strip libraries.
+old_striplib=$lt_old_striplib
+striplib=$lt_striplib
+
+# Method to check whether dependent libraries are shared objects.
+deplibs_check_method=$lt_deplibs_check_method
+
+# Command to use when deplibs_check_method == file_magic.
+file_magic_cmd=$lt_file_magic_cmd
+
+# Flag that allows shared libraries with undefined symbols to be built.
+allow_undefined_flag=$lt_allow_undefined_flag
+
+# Flag that forces no undefined symbols.
+no_undefined_flag=$lt_no_undefined_flag
+
+# Commands used to finish a libtool library installation in a directory.
+finish_cmds=$lt_finish_cmds
+
+# Same as above, but a single script fragment to be evaled but not shown.
+finish_eval=$lt_finish_eval
+
+# Take the output of nm and produce a listing of raw symbols and C names.
+global_symbol_pipe=$lt_global_symbol_pipe
+
+# Transform the output of nm in a proper C declaration
+global_symbol_to_cdecl=$lt_global_symbol_to_cdecl
+
+# Transform the output of nm in a C name address pair
+global_symbol_to_c_name_address=$lt_global_symbol_to_c_name_address
+
+# This is the shared library runtime path variable.
+runpath_var=$runpath_var
+
+# This is the shared library path variable.
+shlibpath_var=$shlibpath_var
+
+# Is shlibpath searched before the hard-coded library search path?
+shlibpath_overrides_runpath=$shlibpath_overrides_runpath
+
+# How to hardcode a shared library path into an executable.
+hardcode_action=$hardcode_action
+
+# Whether we should hardcode library paths into libraries.
+hardcode_into_libs=$hardcode_into_libs
+
+# Flag to hardcode \$libdir into a binary during linking.
+# This must work even if \$libdir does not exist.
+hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec
+
+# Whether we need a single -rpath flag with a separated argument.
+hardcode_libdir_separator=$lt_hardcode_libdir_separator
+
+# Set to yes if using DIR/libNAME.so during linking hardcodes DIR into the
+# resulting binary.
+hardcode_direct=$hardcode_direct
+
+# Set to yes if using the -LDIR flag during linking hardcodes DIR into the
+# resulting binary.
+hardcode_minus_L=$hardcode_minus_L
+
+# Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into
+# the resulting binary.
+hardcode_shlibpath_var=$hardcode_shlibpath_var
+
+# Variables whose values should be saved in libtool wrapper scripts and
+# restored at relink time.
+variables_saved_for_relink="$variables_saved_for_relink"
+
+# Whether libtool must link a program against all its dependency libraries.
+link_all_deplibs=$link_all_deplibs
+
+# Compile-time system search path for libraries
+sys_lib_search_path_spec=$lt_sys_lib_search_path_spec
+
+# Run-time system search path for libraries
+sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec
+
+# Fix the shell variable \$srcfile for the compiler.
+fix_srcfile_path="$fix_srcfile_path"
+
+# Set to yes if exported symbols are required.
+always_export_symbols=$always_export_symbols
+
+# The commands to list exported symbols.
+export_symbols_cmds=$lt_export_symbols_cmds
+
+# The commands to extract the exported symbol list from a shared archive.
+extract_expsyms_cmds=$lt_extract_expsyms_cmds
+
+# Symbols that should not be listed in the preloaded symbols.
+exclude_expsyms=$lt_exclude_expsyms
+
+# Symbols that must always be exported.
+include_expsyms=$lt_include_expsyms
+
+# ### END LIBTOOL CONFIG
+
+__EOF__
+
+ case $host_os in
+ aix3*)
+ cat <<\EOF >> "${ofile}T"
+
+# AIX sometimes has problems with the GCC collect2 program. For some
+# reason, if we set the COLLECT_NAMES environment variable, the problems
+# vanish in a puff of smoke.
+if test "X${COLLECT_NAMES+set}" != Xset; then
+ COLLECT_NAMES=
+ export COLLECT_NAMES
+fi
+EOF
+ ;;
+ esac
+
+ case $host_os in
+ cygwin* | mingw* | pw32* | os2*)
+ cat <<'EOF' >> "${ofile}T"
+ # This is a source program that is used to create dlls on Windows
+ # Don't remove nor modify the starting and closing comments
+# /* ltdll.c starts here */
+# #define WIN32_LEAN_AND_MEAN
+# #include <windows.h>
+# #undef WIN32_LEAN_AND_MEAN
+# #include <stdio.h>
+#
+# #ifndef __CYGWIN__
+# # ifdef __CYGWIN32__
+# # define __CYGWIN__ __CYGWIN32__
+# # endif
+# #endif
+#
+# #ifdef __cplusplus
+# extern "C" {
+# #endif
+# BOOL APIENTRY DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved);
+# #ifdef __cplusplus
+# }
+# #endif
+#
+# #ifdef __CYGWIN__
+# #include <cygwin/cygwin_dll.h>
+# DECLARE_CYGWIN_DLL( DllMain );
+# #endif
+# HINSTANCE __hDllInstance_base;
+#
+# BOOL APIENTRY
+# DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved)
+# {
+# __hDllInstance_base = hInst;
+# return TRUE;
+# }
+# /* ltdll.c ends here */
+ # This is a source program that is used to create import libraries
+ # on Windows for dlls which lack them. Don't remove nor modify the
+ # starting and closing comments
+# /* impgen.c starts here */
+# /* Copyright (C) 1999-2000 Free Software Foundation, Inc.
+#
+# This file is part of GNU libtool.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# */
+#
+# #include <stdio.h> /* for printf() */
+# #include <unistd.h> /* for open(), lseek(), read() */
+# #include <fcntl.h> /* for O_RDONLY, O_BINARY */
+# #include <string.h> /* for strdup() */
+#
+# /* O_BINARY isn't required (or even defined sometimes) under Unix */
+# #ifndef O_BINARY
+# #define O_BINARY 0
+# #endif
+#
+# static unsigned int
+# pe_get16 (fd, offset)
+# int fd;
+# int offset;
+# {
+# unsigned char b[2];
+# lseek (fd, offset, SEEK_SET);
+# read (fd, b, 2);
+# return b[0] + (b[1]<<8);
+# }
+#
+# static unsigned int
+# pe_get32 (fd, offset)
+# int fd;
+# int offset;
+# {
+# unsigned char b[4];
+# lseek (fd, offset, SEEK_SET);
+# read (fd, b, 4);
+# return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
+# }
+#
+# static unsigned int
+# pe_as32 (ptr)
+# void *ptr;
+# {
+# unsigned char *b = ptr;
+# return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
+# }
+#
+# int
+# main (argc, argv)
+# int argc;
+# char *argv[];
+# {
+# int dll;
+# unsigned long pe_header_offset, opthdr_ofs, num_entries, i;
+# unsigned long export_rva, export_size, nsections, secptr, expptr;
+# unsigned long name_rvas, nexp;
+# unsigned char *expdata, *erva;
+# char *filename, *dll_name;
+#
+# filename = argv[1];
+#
+# dll = open(filename, O_RDONLY|O_BINARY);
+# if (dll < 1)
+# return 1;
+#
+# dll_name = filename;
+#
+# for (i=0; filename[i]; i++)
+# if (filename[i] == '/' || filename[i] == '\\' || filename[i] == ':')
+# dll_name = filename + i +1;
+#
+# pe_header_offset = pe_get32 (dll, 0x3c);
+# opthdr_ofs = pe_header_offset + 4 + 20;
+# num_entries = pe_get32 (dll, opthdr_ofs + 92);
+#
+# if (num_entries < 1) /* no exports */
+# return 1;
+#
+# export_rva = pe_get32 (dll, opthdr_ofs + 96);
+# export_size = pe_get32 (dll, opthdr_ofs + 100);
+# nsections = pe_get16 (dll, pe_header_offset + 4 +2);
+# secptr = (pe_header_offset + 4 + 20 +
+# pe_get16 (dll, pe_header_offset + 4 + 16));
+#
+# expptr = 0;
+# for (i = 0; i < nsections; i++)
+# {
+# char sname[8];
+# unsigned long secptr1 = secptr + 40 * i;
+# unsigned long vaddr = pe_get32 (dll, secptr1 + 12);
+# unsigned long vsize = pe_get32 (dll, secptr1 + 16);
+# unsigned long fptr = pe_get32 (dll, secptr1 + 20);
+# lseek(dll, secptr1, SEEK_SET);
+# read(dll, sname, 8);
+# if (vaddr <= export_rva && vaddr+vsize > export_rva)
+# {
+# expptr = fptr + (export_rva - vaddr);
+# if (export_rva + export_size > vaddr + vsize)
+# export_size = vsize - (export_rva - vaddr);
+# break;
+# }
+# }
+#
+# expdata = (unsigned char*)malloc(export_size);
+# lseek (dll, expptr, SEEK_SET);
+# read (dll, expdata, export_size);
+# erva = expdata - export_rva;
+#
+# nexp = pe_as32 (expdata+24);
+# name_rvas = pe_as32 (expdata+32);
+#
+# printf ("EXPORTS\n");
+# for (i = 0; i<nexp; i++)
+# {
+# unsigned long name_rva = pe_as32 (erva+name_rvas+i*4);
+# printf ("\t%s @ %ld ;\n", erva+name_rva, 1+ i);
+# }
+#
+# return 0;
+# }
+# /* impgen.c ends here */
+
+EOF
+ ;;
+ esac
+
+ # We use sed instead of cat because bash on DJGPP gets confused if
+ # if finds mixed CR/LF and LF-only lines. Since sed operates in
+ # text mode, it properly converts lines to CR/LF. This bash problem
+ # is reportedly fixed, but why not run on old versions too?
+ sed '$q' "$ltmain" >> "${ofile}T" || (rm -f "${ofile}T"; exit 1)
+
+ mv -f "${ofile}T" "$ofile" || \
+ (rm -f "$ofile" && cp "${ofile}T" "$ofile" && rm -f "${ofile}T")
+ chmod +x "$ofile"
+fi
+
+])# _LT_AC_LTCONFIG_HACK
+
+# AC_LIBTOOL_DLOPEN - enable checks for dlopen support
+AC_DEFUN([AC_LIBTOOL_DLOPEN], [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])])
+
+# AC_LIBTOOL_WIN32_DLL - declare package support for building win32 dll's
+AC_DEFUN([AC_LIBTOOL_WIN32_DLL], [AC_BEFORE([$0], [AC_LIBTOOL_SETUP])])
+
+# AC_ENABLE_SHARED - implement the --enable-shared flag
+# Usage: AC_ENABLE_SHARED[(DEFAULT)]
+# Where DEFAULT is either `yes' or `no'. If omitted, it defaults to
+# `yes'.
+AC_DEFUN([AC_ENABLE_SHARED],
+[define([AC_ENABLE_SHARED_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(shared,
+changequote(<<, >>)dnl
+<< --enable-shared[=PKGS] build shared libraries [default=>>AC_ENABLE_SHARED_DEFAULT],
+changequote([, ])dnl
+[p=${PACKAGE-default}
+case $enableval in
+yes) enable_shared=yes ;;
+no) enable_shared=no ;;
+*)
+ enable_shared=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_shared=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac],
+enable_shared=AC_ENABLE_SHARED_DEFAULT)dnl
+])
+
+# AC_DISABLE_SHARED - set the default shared flag to --disable-shared
+AC_DEFUN([AC_DISABLE_SHARED],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_SHARED(no)])
+
+# AC_ENABLE_STATIC - implement the --enable-static flag
+# Usage: AC_ENABLE_STATIC[(DEFAULT)]
+# Where DEFAULT is either `yes' or `no'. If omitted, it defaults to
+# `yes'.
+AC_DEFUN([AC_ENABLE_STATIC],
+[define([AC_ENABLE_STATIC_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(static,
+changequote(<<, >>)dnl
+<< --enable-static[=PKGS] build static libraries [default=>>AC_ENABLE_STATIC_DEFAULT],
+changequote([, ])dnl
+[p=${PACKAGE-default}
+case $enableval in
+yes) enable_static=yes ;;
+no) enable_static=no ;;
+*)
+ enable_static=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_static=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac],
+enable_static=AC_ENABLE_STATIC_DEFAULT)dnl
+])
+
+# AC_DISABLE_STATIC - set the default static flag to --disable-static
+AC_DEFUN([AC_DISABLE_STATIC],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_STATIC(no)])
+
+
+# AC_ENABLE_FAST_INSTALL - implement the --enable-fast-install flag
+# Usage: AC_ENABLE_FAST_INSTALL[(DEFAULT)]
+# Where DEFAULT is either `yes' or `no'. If omitted, it defaults to
+# `yes'.
+AC_DEFUN([AC_ENABLE_FAST_INSTALL],
+[define([AC_ENABLE_FAST_INSTALL_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(fast-install,
+changequote(<<, >>)dnl
+<< --enable-fast-install[=PKGS] optimize for fast installation [default=>>AC_ENABLE_FAST_INSTALL_DEFAULT],
+changequote([, ])dnl
+[p=${PACKAGE-default}
+case $enableval in
+yes) enable_fast_install=yes ;;
+no) enable_fast_install=no ;;
+*)
+ enable_fast_install=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_fast_install=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac],
+enable_fast_install=AC_ENABLE_FAST_INSTALL_DEFAULT)dnl
+])
+
+# AC_DISABLE_FAST_INSTALL - set the default to --disable-fast-install
+AC_DEFUN([AC_DISABLE_FAST_INSTALL],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_FAST_INSTALL(no)])
+
+# AC_LIBTOOL_PICMODE - implement the --with-pic flag
+# Usage: AC_LIBTOOL_PICMODE[(MODE)]
+# Where MODE is either `yes' or `no'. If omitted, it defaults to
+# `both'.
+AC_DEFUN([AC_LIBTOOL_PICMODE],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+pic_mode=ifelse($#,1,$1,default)])
+
+
+# AC_PATH_TOOL_PREFIX - find a file program which can recognise shared library
+AC_DEFUN([AC_PATH_TOOL_PREFIX],
+[AC_MSG_CHECKING([for $1])
+AC_CACHE_VAL(lt_cv_path_MAGIC_CMD,
+[case $MAGIC_CMD in
+ /*)
+ lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a dos path.
+ ;;
+ *)
+ ac_save_MAGIC_CMD="$MAGIC_CMD"
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+dnl $ac_dummy forces splitting on constant user-supplied paths.
+dnl POSIX.2 word splitting is done only on the output of word expansions,
+dnl not every word. This closes a longstanding sh security hole.
+ ac_dummy="ifelse([$2], , $PATH, [$2])"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$1; then
+ lt_cv_path_MAGIC_CMD="$ac_dir/$1"
+ if test -n "$file_magic_test_file"; then
+ case $deplibs_check_method in
+ "file_magic "*)
+ file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
+ MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+ if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+ egrep "$file_magic_regex" > /dev/null; then
+ :
+ else
+ cat <<EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such. This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem. Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+EOF
+ fi ;;
+ esac
+ fi
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ MAGIC_CMD="$ac_save_MAGIC_CMD"
+ ;;
+esac])
+MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+if test -n "$MAGIC_CMD"; then
+ AC_MSG_RESULT($MAGIC_CMD)
+else
+ AC_MSG_RESULT(no)
+fi
+])
+
+
+# AC_PATH_MAGIC - find a file program which can recognise a shared library
+AC_DEFUN([AC_PATH_MAGIC],
+[AC_REQUIRE([AC_CHECK_TOOL_PREFIX])dnl
+AC_PATH_TOOL_PREFIX(${ac_tool_prefix}file, /usr/bin:$PATH)
+if test -z "$lt_cv_path_MAGIC_CMD"; then
+ if test -n "$ac_tool_prefix"; then
+ AC_PATH_TOOL_PREFIX(file, /usr/bin:$PATH)
+ else
+ MAGIC_CMD=:
+ fi
+fi
+])
+
+
+# AC_PROG_LD - find the path to the GNU or non-GNU linker
+AC_DEFUN([AC_PROG_LD],
+[AC_ARG_WITH(gnu-ld,
+[ --with-gnu-ld assume the C compiler uses GNU ld [default=no]],
+test "$withval" = no || with_gnu_ld=yes, with_gnu_ld=no)
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+AC_REQUIRE([_LT_AC_LIBTOOL_SYS_PATH_SEPARATOR])dnl
+ac_prog=ld
+if test "$GCC" = yes; then
+ # Check if gcc -print-prog-name=ld gives a path.
+ AC_MSG_CHECKING([for ld used by GCC])
+ case $host in
+ *-*-mingw*)
+ # gcc leaves a trailing carriage return which upsets mingw
+ ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+ *)
+ ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+ esac
+ case $ac_prog in
+ # Accept absolute paths.
+ [[\\/]]* | [[A-Za-z]]:[[\\/]]*)
+ re_direlt='/[[^/]][[^/]]*/\.\./'
+ # Canonicalize the path of ld
+ ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
+ while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
+ ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
+ done
+ test -z "$LD" && LD="$ac_prog"
+ ;;
+ "")
+ # If it fails, then pretend we aren't using GCC.
+ ac_prog=ld
+ ;;
+ *)
+ # If it is relative, then search for the first ld in PATH.
+ with_gnu_ld=unknown
+ ;;
+ esac
+elif test "$with_gnu_ld" = yes; then
+ AC_MSG_CHECKING([for GNU ld])
+else
+ AC_MSG_CHECKING([for non-GNU ld])
+fi
+AC_CACHE_VAL(lt_cv_path_LD,
+[if test -z "$LD"; then
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+ lt_cv_path_LD="$ac_dir/$ac_prog"
+ # Check to see if the program is GNU ld. I'd rather use --version,
+ # but apparently some GNU ld's only accept -v.
+ # Break only if it was the GNU/non-GNU ld that we prefer.
+ if "$lt_cv_path_LD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then
+ test "$with_gnu_ld" != no && break
+ else
+ test "$with_gnu_ld" != yes && break
+ fi
+ fi
+ done
+ IFS="$ac_save_ifs"
+else
+ lt_cv_path_LD="$LD" # Let the user override the test with a path.
+fi])
+LD="$lt_cv_path_LD"
+if test -n "$LD"; then
+ AC_MSG_RESULT($LD)
+else
+ AC_MSG_RESULT(no)
+fi
+test -z "$LD" && AC_MSG_ERROR([no acceptable ld found in \$PATH])
+AC_PROG_LD_GNU
+])
+
+# AC_PROG_LD_GNU -
+AC_DEFUN([AC_PROG_LD_GNU],
+[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], lt_cv_prog_gnu_ld,
+[# I'd rather use --version here, but apparently some GNU ld's only accept -v.
+if $LD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then
+ lt_cv_prog_gnu_ld=yes
+else
+ lt_cv_prog_gnu_ld=no
+fi])
+with_gnu_ld=$lt_cv_prog_gnu_ld
+])
+
+# AC_PROG_LD_RELOAD_FLAG - find reload flag for linker
+# -- PORTME Some linkers may need a different reload flag.
+AC_DEFUN([AC_PROG_LD_RELOAD_FLAG],
+[AC_CACHE_CHECK([for $LD option to reload object files], lt_cv_ld_reload_flag,
+[lt_cv_ld_reload_flag='-r'])
+reload_flag=$lt_cv_ld_reload_flag
+test -n "$reload_flag" && reload_flag=" $reload_flag"
+])
+
+# AC_DEPLIBS_CHECK_METHOD - how to check for library dependencies
+# -- PORTME fill in with the dynamic library characteristics
+AC_DEFUN([AC_DEPLIBS_CHECK_METHOD],
+[AC_CACHE_CHECK([how to recognise dependant libraries],
+lt_cv_deplibs_check_method,
+[lt_cv_file_magic_cmd='$MAGIC_CMD'
+lt_cv_file_magic_test_file=
+lt_cv_deplibs_check_method='unknown'
+# Need to set the preceding variable on all platforms that support
+# interlibrary dependencies.
+# 'none' -- dependencies not supported.
+# `unknown' -- same as none, but documents that we really don't know.
+# 'pass_all' -- all dependencies passed with no checks.
+# 'test_compile' -- check by making test program.
+# 'file_magic [[regex]]' -- check by looking for files in library path
+# which responds to the $file_magic_cmd with a given egrep regex.
+# If you have `file' or equivalent on your system and you're not sure
+# whether `pass_all' will *always* work, you probably want this one.
+
+case $host_os in
+aix4* | aix5*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+beos*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+bsdi4*)
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib)'
+ lt_cv_file_magic_cmd='/usr/bin/file -L'
+ lt_cv_file_magic_test_file=/shlib/libc.so
+ ;;
+
+cygwin* | mingw* | pw32*)
+ lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?'
+ lt_cv_file_magic_cmd='$OBJDUMP -f'
+ ;;
+
+darwin* | rhapsody*)
+ lt_cv_deplibs_check_method='file_magic Mach-O dynamically linked shared library'
+ lt_cv_file_magic_cmd='/usr/bin/file -L'
+ case "$host_os" in
+ rhapsody* | darwin1.[[012]])
+ lt_cv_file_magic_test_file=`echo /System/Library/Frameworks/System.framework/Versions/*/System | head -1`
+ ;;
+ *) # Darwin 1.3 on
+ lt_cv_file_magic_test_file='/usr/lib/libSystem.dylib'
+ ;;
+ esac
+ ;;
+
+freebsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ > /dev/null; then
+ case $host_cpu in
+ i*86 )
+ # Not sure whether the presence of OpenBSD here was a mistake.
+ # Let's accept both of them until this is cleared up.
+ lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD)/i[[3-9]]86 (compact )?demand paged shared library'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+ ;;
+ esac
+ else
+ lt_cv_deplibs_check_method=pass_all
+ fi
+ ;;
+
+gnu*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+hpux10.20*|hpux11*)
+ lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|PA-RISC[[0-9]].[[0-9]]) shared library'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=/usr/lib/libc.sl
+ ;;
+
+irix5* | irix6*)
+ case $host_os in
+ irix5*)
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method="file_magic ELF 32-bit MSB dynamic lib MIPS - version 1"
+ ;;
+ *)
+ case $LD in
+ *-32|*"-32 ") libmagic=32-bit;;
+ *-n32|*"-n32 ") libmagic=N32;;
+ *-64|*"-64 ") libmagic=64-bit;;
+ *) libmagic=never-match;;
+ esac
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method="file_magic ELF ${libmagic} MSB mips-[[1234]] dynamic lib MIPS - version 1"
+ ;;
+ esac
+ lt_cv_file_magic_test_file=`echo /lib${libsuff}/libc.so*`
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+# This must be Linux ELF.
+linux-gnu*)
+ case $host_cpu in
+ alpha* | hppa* | i*86 | powerpc* | sparc* | ia64* | s390* )
+ lt_cv_deplibs_check_method=pass_all ;;
+ *)
+ # glibc up to 2.1.1 does not perform some relocations on ARM
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB (shared object|dynamic lib )' ;;
+ esac
+ lt_cv_file_magic_test_file=`echo /lib/libc.so* /lib/libc-*.so`
+ ;;
+
+netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ > /dev/null; then
+ lt_cv_deplibs_check_method='match_pattern /lib[[^/\.]]+\.so\.[[0-9]]+\.[[0-9]]+$'
+ else
+ lt_cv_deplibs_check_method='match_pattern /lib[[^/\.]]+\.so$'
+ fi
+ ;;
+
+newos6*)
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (executable|dynamic lib)'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=/usr/lib/libnls.so
+ ;;
+
+openbsd*)
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB shared object'
+ else
+ lt_cv_deplibs_check_method='file_magic OpenBSD.* shared library'
+ fi
+ ;;
+
+osf3* | osf4* | osf5*)
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method='file_magic COFF format alpha shared library'
+ lt_cv_file_magic_test_file=/shlib/libc.so
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+sco3.2v5*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+solaris*)
+ lt_cv_deplibs_check_method=pass_all
+ lt_cv_file_magic_test_file=/lib/libc.so
+ ;;
+
+sysv5uw[[78]]* | sysv4*uw2*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ case $host_vendor in
+ motorola)
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib) M[[0-9]][[0-9]]* Version [[0-9]]'
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
+ ;;
+ ncr)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+ sequent)
+ lt_cv_file_magic_cmd='/bin/file'
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB (shared object|dynamic lib )'
+ ;;
+ sni)
+ lt_cv_file_magic_cmd='/bin/file'
+ lt_cv_deplibs_check_method="file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB dynamic lib"
+ lt_cv_file_magic_test_file=/lib/libc.so
+ ;;
+ esac
+ ;;
+esac
+])
+file_magic_cmd=$lt_cv_file_magic_cmd
+deplibs_check_method=$lt_cv_deplibs_check_method
+])
+
+
+# AC_PROG_NM - find the path to a BSD-compatible name lister
+AC_DEFUN([AC_PROG_NM],
+[AC_REQUIRE([_LT_AC_LIBTOOL_SYS_PATH_SEPARATOR])dnl
+AC_MSG_CHECKING([for BSD-compatible nm])
+AC_CACHE_VAL(lt_cv_path_NM,
+[if test -n "$NM"; then
+ # Let the user override the test.
+ lt_cv_path_NM="$NM"
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for ac_dir in $PATH /usr/ccs/bin /usr/ucb /bin; do
+ test -z "$ac_dir" && ac_dir=.
+ tmp_nm=$ac_dir/${ac_tool_prefix}nm
+ if test -f $tmp_nm || test -f $tmp_nm$ac_exeext ; then
+ # Check to see if the nm accepts a BSD-compat flag.
+ # Adding the `sed 1q' prevents false positives on HP-UX, which says:
+ # nm: unknown option "B" ignored
+ # Tru64's nm complains that /dev/null is an invalid object file
+ if ($tmp_nm -B /dev/null 2>&1 | sed '1q'; exit 0) | egrep '(/dev/null|Invalid file or object type)' >/dev/null; then
+ lt_cv_path_NM="$tmp_nm -B"
+ break
+ elif ($tmp_nm -p /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then
+ lt_cv_path_NM="$tmp_nm -p"
+ break
+ else
+ lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
+ continue # so that we can try to find one that supports BSD flags
+ fi
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$lt_cv_path_NM" && lt_cv_path_NM=nm
+fi])
+NM="$lt_cv_path_NM"
+AC_MSG_RESULT([$NM])
+])
+
+# AC_CHECK_LIBM - check for math library
+AC_DEFUN([AC_CHECK_LIBM],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+LIBM=
+case $host in
+*-*-beos* | *-*-cygwin* | *-*-pw32*)
+ # These system don't have libm
+ ;;
+*-ncr-sysv4.3*)
+ AC_CHECK_LIB(mw, _mwvalidcheckl, LIBM="-lmw")
+ AC_CHECK_LIB(m, main, LIBM="$LIBM -lm")
+ ;;
+*)
+ AC_CHECK_LIB(m, main, LIBM="-lm")
+ ;;
+esac
+])
+
+# AC_LIBLTDL_CONVENIENCE[(dir)] - sets LIBLTDL to the link flags for
+# the libltdl convenience library and INCLTDL to the include flags for
+# the libltdl header and adds --enable-ltdl-convenience to the
+# configure arguments. Note that LIBLTDL and INCLTDL are not
+# AC_SUBSTed, nor is AC_CONFIG_SUBDIRS called. If DIR is not
+# provided, it is assumed to be `libltdl'. LIBLTDL will be prefixed
+# with '${top_builddir}/' and INCLTDL will be prefixed with
+# '${top_srcdir}/' (note the single quotes!). If your package is not
+# flat and you're not using automake, define top_builddir and
+# top_srcdir appropriately in the Makefiles.
+AC_DEFUN([AC_LIBLTDL_CONVENIENCE],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+ case $enable_ltdl_convenience in
+ no) AC_MSG_ERROR([this package needs a convenience libltdl]) ;;
+ "") enable_ltdl_convenience=yes
+ ac_configure_args="$ac_configure_args --enable-ltdl-convenience" ;;
+ esac
+ LIBLTDL='${top_builddir}/'ifelse($#,1,[$1],['libltdl'])/libltdlc.la
+ INCLTDL='-I${top_srcdir}/'ifelse($#,1,[$1],['libltdl'])
+])
+
+# AC_LIBLTDL_INSTALLABLE[(dir)] - sets LIBLTDL to the link flags for
+# the libltdl installable library and INCLTDL to the include flags for
+# the libltdl header and adds --enable-ltdl-install to the configure
+# arguments. Note that LIBLTDL and INCLTDL are not AC_SUBSTed, nor is
+# AC_CONFIG_SUBDIRS called. If DIR is not provided and an installed
+# libltdl is not found, it is assumed to be `libltdl'. LIBLTDL will
+# be prefixed with '${top_builddir}/' and INCLTDL will be prefixed
+# with '${top_srcdir}/' (note the single quotes!). If your package is
+# not flat and you're not using automake, define top_builddir and
+# top_srcdir appropriately in the Makefiles.
+# In the future, this macro may have to be called after AC_PROG_LIBTOOL.
+AC_DEFUN([AC_LIBLTDL_INSTALLABLE],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+ AC_CHECK_LIB(ltdl, main,
+ [test x"$enable_ltdl_install" != xyes && enable_ltdl_install=no],
+ [if test x"$enable_ltdl_install" = xno; then
+ AC_MSG_WARN([libltdl not installed, but installation disabled])
+ else
+ enable_ltdl_install=yes
+ fi
+ ])
+ if test x"$enable_ltdl_install" = x"yes"; then
+ ac_configure_args="$ac_configure_args --enable-ltdl-install"
+ LIBLTDL='${top_builddir}/'ifelse($#,1,[$1],['libltdl'])/libltdl.la
+ INCLTDL='-I${top_srcdir}/'ifelse($#,1,[$1],['libltdl'])
+ else
+ ac_configure_args="$ac_configure_args --enable-ltdl-install=no"
+ LIBLTDL="-lltdl"
+ INCLTDL=
+ fi
+])
+
+# old names
+AC_DEFUN([AM_PROG_LIBTOOL], [AC_PROG_LIBTOOL])
+AC_DEFUN([AM_ENABLE_SHARED], [AC_ENABLE_SHARED($@)])
+AC_DEFUN([AM_ENABLE_STATIC], [AC_ENABLE_STATIC($@)])
+AC_DEFUN([AM_DISABLE_SHARED], [AC_DISABLE_SHARED($@)])
+AC_DEFUN([AM_DISABLE_STATIC], [AC_DISABLE_STATIC($@)])
+AC_DEFUN([AM_PROG_LD], [AC_PROG_LD])
+AC_DEFUN([AM_PROG_NM], [AC_PROG_NM])
+
+# This is just to silence aclocal about the macro not being used
+ifelse([AC_DISABLE_FAST_INSTALL])
+
--- /dev/null
+# include <stdio.h>
+# include "version.h"
+
+int main(argc, argv, envp)
+int argc;
+char ** argv;
+char ** envp;
+{
+ int i;
+
+ for (i = 1; i < argc; i++) {
+ if (GC_ALPHA_VERSION == GC_NOT_ALPHA) {
+ printf("gc%d.%d/%s ", GC_VERSION_MAJOR, GC_VERSION_MINOR, argv[i]);
+ } else {
+ printf("gc%d.%dalpha%d/%s ", GC_VERSION_MAJOR,
+ GC_VERSION_MINOR, GC_ALPHA_VERSION, argv[i]);
+ }
+ }
+ return(0);
+}
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1998-1999 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/* #define DEBUG */
+#include <stdio.h>
+#include "private/gc_priv.h"
+
+GC_bool GC_use_entire_heap = 0;
+
+/*
+ * Free heap blocks are kept on one of several free lists,
+ * depending on the size of the block. Each free list is doubly linked.
+ * Adjacent free blocks are coalesced.
+ */
+
+
+# define MAX_BLACK_LIST_ALLOC (2*HBLKSIZE)
+ /* largest block we will allocate starting on a black */
+ /* listed block. Must be >= HBLKSIZE. */
+
+
+# define UNIQUE_THRESHOLD 32
+ /* Sizes up to this many HBLKs each have their own free list */
+# define HUGE_THRESHOLD 256
+ /* Sizes of at least this many heap blocks are mapped to a */
+ /* single free list. */
+# define FL_COMPRESSION 8
+ /* In between sizes map this many distinct sizes to a single */
+ /* bin. */
+
+# define N_HBLK_FLS (HUGE_THRESHOLD - UNIQUE_THRESHOLD)/FL_COMPRESSION \
+ + UNIQUE_THRESHOLD
+
+struct hblk * GC_hblkfreelist[N_HBLK_FLS+1] = { 0 };
+
+#ifndef USE_MUNMAP
+
+ word GC_free_bytes[N_HBLK_FLS+1] = { 0 };
+ /* Number of free bytes on each list. */
+
+ /* Is bytes + the number of free bytes on lists n .. N_HBLK_FLS */
+ /* > GC_max_large_allocd_bytes? */
+# ifdef __GNUC__
+ __inline__
+# endif
+ static GC_bool GC_enough_large_bytes_left(bytes,n)
+ word bytes;
+ int n;
+ {
+ int i;
+ for (i = N_HBLK_FLS; i >= n; --i) {
+ bytes += GC_free_bytes[i];
+ if (bytes > GC_max_large_allocd_bytes) return TRUE;
+ }
+ return FALSE;
+ }
+
+# define INCR_FREE_BYTES(n, b) GC_free_bytes[n] += (b);
+
+# define FREE_ASSERT(e) GC_ASSERT(e)
+
+#else /* USE_MUNMAP */
+
+# define INCR_FREE_BYTES(n, b)
+# define FREE_ASSERT(e)
+
+#endif /* USE_MUNMAP */
+
+/* Map a number of blocks to the appropriate large block free list index. */
+int GC_hblk_fl_from_blocks(blocks_needed)
+word blocks_needed;
+{
+ if (blocks_needed <= UNIQUE_THRESHOLD) return blocks_needed;
+ if (blocks_needed >= HUGE_THRESHOLD) return N_HBLK_FLS;
+ return (blocks_needed - UNIQUE_THRESHOLD)/FL_COMPRESSION
+ + UNIQUE_THRESHOLD;
+
+}
+
+# define PHDR(hhdr) HDR(hhdr -> hb_prev)
+# define NHDR(hhdr) HDR(hhdr -> hb_next)
+
+# ifdef USE_MUNMAP
+# define IS_MAPPED(hhdr) (((hhdr) -> hb_flags & WAS_UNMAPPED) == 0)
+# else /* !USE_MMAP */
+# define IS_MAPPED(hhdr) 1
+# endif /* USE_MUNMAP */
+
+# if !defined(NO_DEBUGGING)
+void GC_print_hblkfreelist()
+{
+ struct hblk * h;
+ word total_free = 0;
+ hdr * hhdr;
+ word sz;
+ int i;
+
+ for (i = 0; i <= N_HBLK_FLS; ++i) {
+ h = GC_hblkfreelist[i];
+# ifdef USE_MUNMAP
+ if (0 != h) GC_printf1("Free list %ld (Total size %ld):\n",
+ (unsigned long)i);
+# else
+ if (0 != h) GC_printf2("Free list %ld (Total size %ld):\n",
+ (unsigned long)i,
+ (unsigned long)GC_free_bytes[i]);
+# endif
+ while (h != 0) {
+ hhdr = HDR(h);
+ sz = hhdr -> hb_sz;
+ GC_printf2("\t0x%lx size %lu ", (unsigned long)h, (unsigned long)sz);
+ total_free += sz;
+ if (GC_is_black_listed(h, HBLKSIZE) != 0) {
+ GC_printf0("start black listed\n");
+ } else if (GC_is_black_listed(h, hhdr -> hb_sz) != 0) {
+ GC_printf0("partially black listed\n");
+ } else {
+ GC_printf0("not black listed\n");
+ }
+ h = hhdr -> hb_next;
+ }
+ }
+ if (total_free != GC_large_free_bytes) {
+ GC_printf1("GC_large_free_bytes = %lu (INCONSISTENT!!)\n",
+ (unsigned long) GC_large_free_bytes);
+ }
+ GC_printf1("Total of %lu bytes on free list\n", (unsigned long)total_free);
+}
+
+/* Return the free list index on which the block described by the header */
+/* appears, or -1 if it appears nowhere. */
+int free_list_index_of(wanted)
+hdr * wanted;
+{
+ struct hblk * h;
+ hdr * hhdr;
+ int i;
+
+ for (i = 0; i <= N_HBLK_FLS; ++i) {
+ h = GC_hblkfreelist[i];
+ while (h != 0) {
+ hhdr = HDR(h);
+ if (hhdr == wanted) return i;
+ h = hhdr -> hb_next;
+ }
+ }
+ return -1;
+}
+
+void GC_dump_regions()
+{
+ unsigned i;
+ ptr_t start, end;
+ ptr_t p;
+ size_t bytes;
+ hdr *hhdr;
+ for (i = 0; i < GC_n_heap_sects; ++i) {
+ start = GC_heap_sects[i].hs_start;
+ bytes = GC_heap_sects[i].hs_bytes;
+ end = start + bytes;
+ /* Merge in contiguous sections. */
+ while (i+1 < GC_n_heap_sects && GC_heap_sects[i+1].hs_start == end) {
+ ++i;
+ end = GC_heap_sects[i].hs_start + GC_heap_sects[i].hs_bytes;
+ }
+ GC_printf2("***Section from 0x%lx to 0x%lx\n", start, end);
+ for (p = start; p < end;) {
+ hhdr = HDR(p);
+ GC_printf1("\t0x%lx ", (unsigned long)p);
+ if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ GC_printf1("Missing header!!\n", hhdr);
+ p += HBLKSIZE;
+ continue;
+ }
+ if (HBLK_IS_FREE(hhdr)) {
+ int correct_index = GC_hblk_fl_from_blocks(
+ divHBLKSZ(hhdr -> hb_sz));
+ int actual_index;
+
+ GC_printf1("\tfree block of size 0x%lx bytes",
+ (unsigned long)(hhdr -> hb_sz));
+ if (IS_MAPPED(hhdr)) {
+ GC_printf0("\n");
+ } else {
+ GC_printf0("(unmapped)\n");
+ }
+ actual_index = free_list_index_of(hhdr);
+ if (-1 == actual_index) {
+ GC_printf1("\t\tBlock not on free list %ld!!\n",
+ correct_index);
+ } else if (correct_index != actual_index) {
+ GC_printf2("\t\tBlock on list %ld, should be on %ld!!\n",
+ actual_index, correct_index);
+ }
+ p += hhdr -> hb_sz;
+ } else {
+ GC_printf1("\tused for blocks of size 0x%lx bytes\n",
+ (unsigned long)WORDS_TO_BYTES(hhdr -> hb_sz));
+ p += HBLKSIZE * OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz);
+ }
+ }
+ }
+}
+
+# endif /* NO_DEBUGGING */
+
+/* Initialize hdr for a block containing the indicated size and */
+/* kind of objects. */
+/* Return FALSE on failure. */
+static GC_bool setup_header(hhdr, sz, kind, flags)
+register hdr * hhdr;
+word sz; /* object size in words */
+int kind;
+unsigned char flags;
+{
+ register word descr;
+
+ /* Add description of valid object pointers */
+ if (!GC_add_map_entry(sz)) return(FALSE);
+ hhdr -> hb_map = GC_obj_map[sz > MAXOBJSZ? 0 : sz];
+
+ /* Set size, kind and mark proc fields */
+ hhdr -> hb_sz = sz;
+ hhdr -> hb_obj_kind = kind;
+ hhdr -> hb_flags = flags;
+ descr = GC_obj_kinds[kind].ok_descriptor;
+ if (GC_obj_kinds[kind].ok_relocate_descr) descr += WORDS_TO_BYTES(sz);
+ hhdr -> hb_descr = descr;
+
+ /* Clear mark bits */
+ GC_clear_hdr_marks(hhdr);
+
+ hhdr -> hb_last_reclaimed = (unsigned short)GC_gc_no;
+ return(TRUE);
+}
+
+#define FL_UNKNOWN -1
+/*
+ * Remove hhdr from the appropriate free list.
+ * We assume it is on the nth free list, or on the size
+ * appropriate free list if n is FL_UNKNOWN.
+ */
+void GC_remove_from_fl(hhdr, n)
+hdr * hhdr;
+int n;
+{
+ int index;
+
+ GC_ASSERT(((hhdr -> hb_sz) & (HBLKSIZE-1)) == 0);
+# ifndef USE_MUNMAP
+ /* We always need index to mainatin free counts. */
+ if (FL_UNKNOWN == n) {
+ index = GC_hblk_fl_from_blocks(divHBLKSZ(hhdr -> hb_sz));
+ } else {
+ index = n;
+ }
+# endif
+ if (hhdr -> hb_prev == 0) {
+# ifdef USE_MUNMAP
+ if (FL_UNKNOWN == n) {
+ index = GC_hblk_fl_from_blocks(divHBLKSZ(hhdr -> hb_sz));
+ } else {
+ index = n;
+ }
+# endif
+ GC_ASSERT(HDR(GC_hblkfreelist[index]) == hhdr);
+ GC_hblkfreelist[index] = hhdr -> hb_next;
+ } else {
+ hdr *phdr;
+ GET_HDR(hhdr -> hb_prev, phdr);
+ phdr -> hb_next = hhdr -> hb_next;
+ }
+ INCR_FREE_BYTES(index, - (signed_word)(hhdr -> hb_sz));
+ FREE_ASSERT(GC_free_bytes[index] >= 0);
+ if (0 != hhdr -> hb_next) {
+ hdr * nhdr;
+ GC_ASSERT(!IS_FORWARDING_ADDR_OR_NIL(NHDR(hhdr)));
+ GET_HDR(hhdr -> hb_next, nhdr);
+ nhdr -> hb_prev = hhdr -> hb_prev;
+ }
+}
+
+/*
+ * Return a pointer to the free block ending just before h, if any.
+ */
+struct hblk * GC_free_block_ending_at(h)
+struct hblk *h;
+{
+ struct hblk * p = h - 1;
+ hdr * phdr;
+
+ GET_HDR(p, phdr);
+ while (0 != phdr && IS_FORWARDING_ADDR_OR_NIL(phdr)) {
+ p = FORWARDED_ADDR(p,phdr);
+ phdr = HDR(p);
+ }
+ if (0 != phdr) {
+ if(HBLK_IS_FREE(phdr)) {
+ return p;
+ } else {
+ return 0;
+ }
+ }
+ p = GC_prev_block(h - 1);
+ if (0 != p) {
+ phdr = HDR(p);
+ if (HBLK_IS_FREE(phdr) && (ptr_t)p + phdr -> hb_sz == (ptr_t)h) {
+ return p;
+ }
+ }
+ return 0;
+}
+
+/*
+ * Add hhdr to the appropriate free list.
+ * We maintain individual free lists sorted by address.
+ */
+void GC_add_to_fl(h, hhdr)
+struct hblk *h;
+hdr * hhdr;
+{
+ int index = GC_hblk_fl_from_blocks(divHBLKSZ(hhdr -> hb_sz));
+ struct hblk *second = GC_hblkfreelist[index];
+ hdr * second_hdr;
+# ifdef GC_ASSERTIONS
+ struct hblk *next = (struct hblk *)((word)h + hhdr -> hb_sz);
+ hdr * nexthdr = HDR(next);
+ struct hblk *prev = GC_free_block_ending_at(h);
+ hdr * prevhdr = HDR(prev);
+ GC_ASSERT(nexthdr == 0 || !HBLK_IS_FREE(nexthdr) || !IS_MAPPED(nexthdr));
+ GC_ASSERT(prev == 0 || !HBLK_IS_FREE(prevhdr) || !IS_MAPPED(prevhdr));
+# endif
+ GC_ASSERT(((hhdr -> hb_sz) & (HBLKSIZE-1)) == 0);
+ GC_hblkfreelist[index] = h;
+ INCR_FREE_BYTES(index, hhdr -> hb_sz);
+ FREE_ASSERT(GC_free_bytes[index] <= GC_large_free_bytes)
+ hhdr -> hb_next = second;
+ hhdr -> hb_prev = 0;
+ if (0 != second) {
+ GET_HDR(second, second_hdr);
+ second_hdr -> hb_prev = h;
+ }
+ GC_invalidate_map(hhdr);
+}
+
+#ifdef USE_MUNMAP
+
+/* Unmap blocks that haven't been recently touched. This is the only way */
+/* way blocks are ever unmapped. */
+void GC_unmap_old(void)
+{
+ struct hblk * h;
+ hdr * hhdr;
+ word sz;
+ unsigned short last_rec, threshold;
+ int i;
+# define UNMAP_THRESHOLD 6
+
+ for (i = 0; i <= N_HBLK_FLS; ++i) {
+ for (h = GC_hblkfreelist[i]; 0 != h; h = hhdr -> hb_next) {
+ hhdr = HDR(h);
+ if (!IS_MAPPED(hhdr)) continue;
+ threshold = (unsigned short)(GC_gc_no - UNMAP_THRESHOLD);
+ last_rec = hhdr -> hb_last_reclaimed;
+ if (last_rec > GC_gc_no
+ || last_rec < threshold && threshold < GC_gc_no
+ /* not recently wrapped */) {
+ sz = hhdr -> hb_sz;
+ GC_unmap((ptr_t)h, sz);
+ hhdr -> hb_flags |= WAS_UNMAPPED;
+ }
+ }
+ }
+}
+
+/* Merge all unmapped blocks that are adjacent to other free */
+/* blocks. This may involve remapping, since all blocks are either */
+/* fully mapped or fully unmapped. */
+void GC_merge_unmapped(void)
+{
+ struct hblk * h, *next;
+ hdr * hhdr, *nexthdr;
+ word size, nextsize;
+ int i;
+
+ for (i = 0; i <= N_HBLK_FLS; ++i) {
+ h = GC_hblkfreelist[i];
+ while (h != 0) {
+ GET_HDR(h, hhdr);
+ size = hhdr->hb_sz;
+ next = (struct hblk *)((word)h + size);
+ GET_HDR(next, nexthdr);
+ /* Coalesce with successor, if possible */
+ if (0 != nexthdr && HBLK_IS_FREE(nexthdr)) {
+ nextsize = nexthdr -> hb_sz;
+ if (IS_MAPPED(hhdr)) {
+ GC_ASSERT(!IS_MAPPED(nexthdr));
+ /* make both consistent, so that we can merge */
+ if (size > nextsize) {
+ GC_remap((ptr_t)next, nextsize);
+ } else {
+ GC_unmap((ptr_t)h, size);
+ hhdr -> hb_flags |= WAS_UNMAPPED;
+ }
+ } else if (IS_MAPPED(nexthdr)) {
+ GC_ASSERT(!IS_MAPPED(hhdr));
+ if (size > nextsize) {
+ GC_unmap((ptr_t)next, nextsize);
+ } else {
+ GC_remap((ptr_t)h, size);
+ hhdr -> hb_flags &= ~WAS_UNMAPPED;
+ }
+ } else {
+ /* Unmap any gap in the middle */
+ GC_unmap_gap((ptr_t)h, size, (ptr_t)next, nexthdr -> hb_sz);
+ }
+ /* If they are both unmapped, we merge, but leave unmapped. */
+ GC_remove_from_fl(hhdr, i);
+ GC_remove_from_fl(nexthdr, FL_UNKNOWN);
+ hhdr -> hb_sz += nexthdr -> hb_sz;
+ GC_remove_header(next);
+ GC_add_to_fl(h, hhdr);
+ /* Start over at beginning of list */
+ h = GC_hblkfreelist[i];
+ } else /* not mergable with successor */ {
+ h = hhdr -> hb_next;
+ }
+ } /* while (h != 0) ... */
+ } /* for ... */
+}
+
+#endif /* USE_MUNMAP */
+
+/*
+ * Return a pointer to a block starting at h of length bytes.
+ * Memory for the block is mapped.
+ * Remove the block from its free list, and return the remainder (if any)
+ * to its appropriate free list.
+ * May fail by returning 0.
+ * The header for the returned block must be set up by the caller.
+ * If the return value is not 0, then hhdr is the header for it.
+ */
+struct hblk * GC_get_first_part(h, hhdr, bytes, index)
+struct hblk *h;
+hdr * hhdr;
+word bytes;
+int index;
+{
+ word total_size = hhdr -> hb_sz;
+ struct hblk * rest;
+ hdr * rest_hdr;
+
+ GC_ASSERT((total_size & (HBLKSIZE-1)) == 0);
+ GC_remove_from_fl(hhdr, index);
+ if (total_size == bytes) return h;
+ rest = (struct hblk *)((word)h + bytes);
+ rest_hdr = GC_install_header(rest);
+ if (0 == rest_hdr) return(0);
+ rest_hdr -> hb_sz = total_size - bytes;
+ rest_hdr -> hb_flags = 0;
+# ifdef GC_ASSERTIONS
+ /* Mark h not free, to avoid assertion about adjacent free blocks. */
+ hhdr -> hb_map = 0;
+# endif
+ GC_add_to_fl(rest, rest_hdr);
+ return h;
+}
+
+/*
+ * H is a free block. N points at an address inside it.
+ * A new header for n has already been set up. Fix up h's header
+ * to reflect the fact that it is being split, move it to the
+ * appropriate free list.
+ * N replaces h in the original free list.
+ *
+ * Nhdr is not completely filled in, since it is about to allocated.
+ * It may in fact end up on the wrong free list for its size.
+ * (Hence adding it to a free list is silly. But this path is hopefully
+ * rare enough that it doesn't matter. The code is cleaner this way.)
+ */
+void GC_split_block(h, hhdr, n, nhdr, index)
+struct hblk *h;
+hdr * hhdr;
+struct hblk *n;
+hdr * nhdr;
+int index; /* Index of free list */
+{
+ word total_size = hhdr -> hb_sz;
+ word h_size = (word)n - (word)h;
+ struct hblk *prev = hhdr -> hb_prev;
+ struct hblk *next = hhdr -> hb_next;
+
+ /* Replace h with n on its freelist */
+ nhdr -> hb_prev = prev;
+ nhdr -> hb_next = next;
+ nhdr -> hb_sz = total_size - h_size;
+ nhdr -> hb_flags = 0;
+ if (0 != prev) {
+ HDR(prev) -> hb_next = n;
+ } else {
+ GC_hblkfreelist[index] = n;
+ }
+ if (0 != next) {
+ HDR(next) -> hb_prev = n;
+ }
+ INCR_FREE_BYTES(index, -(signed_word)h_size);
+ FREE_ASSERT(GC_free_bytes[index] > 0);
+# ifdef GC_ASSERTIONS
+ nhdr -> hb_map = 0; /* Don't fail test for consecutive */
+ /* free blocks in GC_add_to_fl. */
+# endif
+# ifdef USE_MUNMAP
+ hhdr -> hb_last_reclaimed = GC_gc_no;
+# endif
+ hhdr -> hb_sz = h_size;
+ GC_add_to_fl(h, hhdr);
+ GC_invalidate_map(nhdr);
+}
+
+struct hblk * GC_allochblk_nth();
+
+/*
+ * Allocate (and return pointer to) a heap block
+ * for objects of size sz words, searching the nth free list.
+ *
+ * NOTE: We set obj_map field in header correctly.
+ * Caller is responsible for building an object freelist in block.
+ *
+ * Unlike older versions of the collectors, the client is responsible
+ * for clearing the block, if necessary.
+ */
+struct hblk *
+GC_allochblk(sz, kind, flags)
+word sz;
+int kind;
+unsigned flags; /* IGNORE_OFF_PAGE or 0 */
+{
+ word blocks = OBJ_SZ_TO_BLOCKS(sz);
+ int start_list = GC_hblk_fl_from_blocks(blocks);
+ int i;
+ for (i = start_list; i <= N_HBLK_FLS; ++i) {
+ struct hblk * result = GC_allochblk_nth(sz, kind, flags, i);
+ if (0 != result) {
+ return result;
+ }
+ }
+ return 0;
+}
+/*
+ * The same, but with search restricted to nth free list.
+ */
+struct hblk *
+GC_allochblk_nth(sz, kind, flags, n)
+word sz;
+int kind;
+unsigned char flags; /* IGNORE_OFF_PAGE or 0 */
+int n;
+{
+ register struct hblk *hbp;
+ register hdr * hhdr; /* Header corr. to hbp */
+ register struct hblk *thishbp;
+ register hdr * thishdr; /* Header corr. to hbp */
+ signed_word size_needed; /* number of bytes in requested objects */
+ signed_word size_avail; /* bytes available in this block */
+
+ size_needed = HBLKSIZE * OBJ_SZ_TO_BLOCKS(sz);
+
+ /* search for a big enough block in free list */
+ hbp = GC_hblkfreelist[n];
+ for(; 0 != hbp; hbp = hhdr -> hb_next) {
+ GET_HDR(hbp, hhdr);
+ size_avail = hhdr->hb_sz;
+ if (size_avail < size_needed) continue;
+ if (!GC_use_entire_heap
+ && size_avail != size_needed
+ && USED_HEAP_SIZE >= GC_requested_heapsize
+ && !TRUE_INCREMENTAL && GC_should_collect()) {
+# ifdef USE_MUNMAP
+ continue;
+# else
+ /* If we have enough large blocks left to cover any */
+ /* previous request for large blocks, we go ahead */
+ /* and split. Assuming a steady state, that should */
+ /* be safe. It means that we can use the full */
+ /* heap if we allocate only small objects. */
+ if (!GC_enough_large_bytes_left(GC_large_allocd_bytes, n)) {
+ continue;
+ }
+ /* If we are deallocating lots of memory from */
+ /* finalizers, fail and collect sooner rather */
+ /* than later. */
+ if (GC_finalizer_mem_freed > (GC_heapsize >> 4)) {
+ continue;
+ }
+# endif /* !USE_MUNMAP */
+ }
+ /* If the next heap block is obviously better, go on. */
+ /* This prevents us from disassembling a single large block */
+ /* to get tiny blocks. */
+ {
+ signed_word next_size;
+
+ thishbp = hhdr -> hb_next;
+ if (thishbp != 0) {
+ GET_HDR(thishbp, thishdr);
+ next_size = (signed_word)(thishdr -> hb_sz);
+ if (next_size < size_avail
+ && next_size >= size_needed
+ && !GC_is_black_listed(thishbp, (word)size_needed)) {
+ continue;
+ }
+ }
+ }
+ if ( !IS_UNCOLLECTABLE(kind) &&
+ (kind != PTRFREE || size_needed > MAX_BLACK_LIST_ALLOC)) {
+ struct hblk * lasthbp = hbp;
+ ptr_t search_end = (ptr_t)hbp + size_avail - size_needed;
+ signed_word orig_avail = size_avail;
+ signed_word eff_size_needed = ((flags & IGNORE_OFF_PAGE)?
+ HBLKSIZE
+ : size_needed);
+
+
+ while ((ptr_t)lasthbp <= search_end
+ && (thishbp = GC_is_black_listed(lasthbp,
+ (word)eff_size_needed))
+ != 0) {
+ lasthbp = thishbp;
+ }
+ size_avail -= (ptr_t)lasthbp - (ptr_t)hbp;
+ thishbp = lasthbp;
+ if (size_avail >= size_needed) {
+ if (thishbp != hbp &&
+ 0 != (thishdr = GC_install_header(thishbp))) {
+ /* Make sure it's mapped before we mangle it. */
+# ifdef USE_MUNMAP
+ if (!IS_MAPPED(hhdr)) {
+ GC_remap((ptr_t)hbp, hhdr -> hb_sz);
+ hhdr -> hb_flags &= ~WAS_UNMAPPED;
+ }
+# endif
+ /* Split the block at thishbp */
+ GC_split_block(hbp, hhdr, thishbp, thishdr, n);
+ /* Advance to thishbp */
+ hbp = thishbp;
+ hhdr = thishdr;
+ /* We must now allocate thishbp, since it may */
+ /* be on the wrong free list. */
+ }
+ } else if (size_needed > (signed_word)BL_LIMIT
+ && orig_avail - size_needed
+ > (signed_word)BL_LIMIT) {
+ /* Punt, since anything else risks unreasonable heap growth. */
+ if (++GC_large_alloc_warn_suppressed
+ >= GC_large_alloc_warn_interval) {
+ WARN("Repeated allocation of very large block "
+ "(appr. size %ld):\n"
+ "\tMay lead to memory leak and poor performance.\n",
+ size_needed);
+ GC_large_alloc_warn_suppressed = 0;
+ }
+ size_avail = orig_avail;
+ } else if (size_avail == 0 && size_needed == HBLKSIZE
+ && IS_MAPPED(hhdr)) {
+ if (!GC_find_leak) {
+ static unsigned count = 0;
+
+ /* The block is completely blacklisted. We need */
+ /* to drop some such blocks, since otherwise we spend */
+ /* all our time traversing them if pointerfree */
+ /* blocks are unpopular. */
+ /* A dropped block will be reconsidered at next GC. */
+ if ((++count & 3) == 0) {
+ /* Allocate and drop the block in small chunks, to */
+ /* maximize the chance that we will recover some */
+ /* later. */
+ word total_size = hhdr -> hb_sz;
+ struct hblk * limit = hbp + divHBLKSZ(total_size);
+ struct hblk * h;
+ struct hblk * prev = hhdr -> hb_prev;
+
+ GC_words_wasted += total_size;
+ GC_large_free_bytes -= total_size;
+ GC_remove_from_fl(hhdr, n);
+ for (h = hbp; h < limit; h++) {
+ if (h == hbp || 0 != (hhdr = GC_install_header(h))) {
+ (void) setup_header(
+ hhdr,
+ BYTES_TO_WORDS(HBLKSIZE),
+ PTRFREE, 0); /* Cant fail */
+ if (GC_debugging_started) {
+ BZERO(h, HBLKSIZE);
+ }
+ }
+ }
+ /* Restore hbp to point at free block */
+ hbp = prev;
+ if (0 == hbp) {
+ return GC_allochblk_nth(sz, kind, flags, n);
+ }
+ hhdr = HDR(hbp);
+ }
+ }
+ }
+ }
+ if( size_avail >= size_needed ) {
+# ifdef USE_MUNMAP
+ if (!IS_MAPPED(hhdr)) {
+ GC_remap((ptr_t)hbp, hhdr -> hb_sz);
+ hhdr -> hb_flags &= ~WAS_UNMAPPED;
+ }
+# endif
+ /* hbp may be on the wrong freelist; the parameter n */
+ /* is important. */
+ hbp = GC_get_first_part(hbp, hhdr, size_needed, n);
+ break;
+ }
+ }
+
+ if (0 == hbp) return 0;
+
+ /* Add it to map of valid blocks */
+ if (!GC_install_counts(hbp, (word)size_needed)) return(0);
+ /* This leaks memory under very rare conditions. */
+
+ /* Set up header */
+ if (!setup_header(hhdr, sz, kind, flags)) {
+ GC_remove_counts(hbp, (word)size_needed);
+ return(0); /* ditto */
+ }
+
+ /* Notify virtual dirty bit implementation that we are about to write. */
+ /* Ensure that pointerfree objects are not protected if it's avoidable. */
+ GC_remove_protection(hbp, divHBLKSZ(size_needed),
+ (hhdr -> hb_descr == 0) /* pointer-free */);
+
+ /* We just successfully allocated a block. Restart count of */
+ /* consecutive failures. */
+ {
+ extern unsigned GC_fail_count;
+
+ GC_fail_count = 0;
+ }
+
+ GC_large_free_bytes -= size_needed;
+
+ GC_ASSERT(IS_MAPPED(hhdr));
+ return( hbp );
+}
+
+struct hblk * GC_freehblk_ptr = 0; /* Search position hint for GC_freehblk */
+
+/*
+ * Free a heap block.
+ *
+ * Coalesce the block with its neighbors if possible.
+ *
+ * All mark words are assumed to be cleared.
+ */
+void
+GC_freehblk(hbp)
+struct hblk *hbp;
+{
+struct hblk *next, *prev;
+hdr *hhdr, *prevhdr, *nexthdr;
+signed_word size;
+
+
+ GET_HDR(hbp, hhdr);
+ size = hhdr->hb_sz;
+ size = HBLKSIZE * OBJ_SZ_TO_BLOCKS(size);
+ GC_remove_counts(hbp, (word)size);
+ hhdr->hb_sz = size;
+
+ /* Check for duplicate deallocation in the easy case */
+ if (HBLK_IS_FREE(hhdr)) {
+ GC_printf1("Duplicate large block deallocation of 0x%lx\n",
+ (unsigned long) hbp);
+ ABORT("Duplicate large block deallocation");
+ }
+
+ GC_ASSERT(IS_MAPPED(hhdr));
+ GC_invalidate_map(hhdr);
+ next = (struct hblk *)((word)hbp + size);
+ GET_HDR(next, nexthdr);
+ prev = GC_free_block_ending_at(hbp);
+ /* Coalesce with successor, if possible */
+ if(0 != nexthdr && HBLK_IS_FREE(nexthdr) && IS_MAPPED(nexthdr)) {
+ GC_remove_from_fl(nexthdr, FL_UNKNOWN);
+ hhdr -> hb_sz += nexthdr -> hb_sz;
+ GC_remove_header(next);
+ }
+ /* Coalesce with predecessor, if possible. */
+ if (0 != prev) {
+ prevhdr = HDR(prev);
+ if (IS_MAPPED(prevhdr)) {
+ GC_remove_from_fl(prevhdr, FL_UNKNOWN);
+ prevhdr -> hb_sz += hhdr -> hb_sz;
+ GC_remove_header(hbp);
+ hbp = prev;
+ hhdr = prevhdr;
+ }
+ }
+
+ GC_large_free_bytes += size;
+ GC_add_to_fl(hbp, hhdr);
+}
+
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1996 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1998 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+
+
+# include "private/gc_priv.h"
+
+# include <stdio.h>
+# if !defined(MACOS) && !defined(MSWINCE)
+# include <signal.h>
+# include <sys/types.h>
+# endif
+
+/*
+ * Separate free lists are maintained for different sized objects
+ * up to MAXOBJSZ.
+ * The call GC_allocobj(i,k) ensures that the freelist for
+ * kind k objects of size i points to a non-empty
+ * free list. It returns a pointer to the first entry on the free list.
+ * In a single-threaded world, GC_allocobj may be called to allocate
+ * an object of (small) size i as follows:
+ *
+ * opp = &(GC_objfreelist[i]);
+ * if (*opp == 0) GC_allocobj(i, NORMAL);
+ * ptr = *opp;
+ * *opp = obj_link(ptr);
+ *
+ * Note that this is very fast if the free list is non-empty; it should
+ * only involve the execution of 4 or 5 simple instructions.
+ * All composite objects on freelists are cleared, except for
+ * their first word.
+ */
+
+/*
+ * The allocator uses GC_allochblk to allocate large chunks of objects.
+ * These chunks all start on addresses which are multiples of
+ * HBLKSZ. Each allocated chunk has an associated header,
+ * which can be located quickly based on the address of the chunk.
+ * (See headers.c for details.)
+ * This makes it possible to check quickly whether an
+ * arbitrary address corresponds to an object administered by the
+ * allocator.
+ */
+
+word GC_non_gc_bytes = 0; /* Number of bytes not intended to be collected */
+
+word GC_gc_no = 0;
+
+#ifndef SMALL_CONFIG
+ int GC_incremental = 0; /* By default, stop the world. */
+#endif
+
+int GC_parallel = FALSE; /* By default, parallel GC is off. */
+
+int GC_full_freq = 19; /* Every 20th collection is a full */
+ /* collection, whether we need it */
+ /* or not. */
+
+GC_bool GC_need_full_gc = FALSE;
+ /* Need full GC do to heap growth. */
+
+word GC_used_heap_size_after_full = 0;
+
+char * GC_copyright[] =
+{"Copyright 1988,1989 Hans-J. Boehm and Alan J. Demers ",
+"Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved. ",
+"Copyright (c) 1996-1998 by Silicon Graphics. All rights reserved. ",
+"Copyright (c) 1999-2001 by Hewlett-Packard Company. All rights reserved. ",
+"THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY",
+" EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK.",
+"See source code for details." };
+
+# include "version.h"
+
+/* some more variables */
+
+extern signed_word GC_mem_found; /* Number of reclaimed longwords */
+ /* after garbage collection */
+
+GC_bool GC_dont_expand = 0;
+
+word GC_free_space_divisor = 3;
+
+extern GC_bool GC_collection_in_progress();
+ /* Collection is in progress, or was abandoned. */
+
+extern GC_bool GC_print_back_height;
+
+int GC_never_stop_func GC_PROTO((void)) { return(0); }
+
+unsigned long GC_time_limit = TIME_LIMIT;
+
+CLOCK_TYPE GC_start_time; /* Time at which we stopped world. */
+ /* used only in GC_timeout_stop_func. */
+
+int GC_n_attempts = 0; /* Number of attempts at finishing */
+ /* collection within GC_time_limit. */
+
+#if defined(SMALL_CONFIG) || defined(NO_CLOCK)
+# define GC_timeout_stop_func GC_never_stop_func
+#else
+ int GC_timeout_stop_func GC_PROTO((void))
+ {
+ CLOCK_TYPE current_time;
+ static unsigned count = 0;
+ unsigned long time_diff;
+
+ if ((count++ & 3) != 0) return(0);
+ GET_TIME(current_time);
+ time_diff = MS_TIME_DIFF(current_time,GC_start_time);
+ if (time_diff >= GC_time_limit) {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf0("Abandoning stopped marking after ");
+ GC_printf1("%lu msecs", (unsigned long)time_diff);
+ GC_printf1("(attempt %d)\n", (unsigned long) GC_n_attempts);
+ }
+# endif
+ return(1);
+ }
+ return(0);
+ }
+#endif /* !SMALL_CONFIG */
+
+/* Return the minimum number of words that must be allocated between */
+/* collections to amortize the collection cost. */
+static word min_words_allocd()
+{
+# ifdef THREADS
+ /* We punt, for now. */
+ register signed_word stack_size = 10000;
+# else
+ int dummy;
+ register signed_word stack_size = (ptr_t)(&dummy) - GC_stackbottom;
+# endif
+ word total_root_size; /* includes double stack size, */
+ /* since the stack is expensive */
+ /* to scan. */
+ word scan_size; /* Estimate of memory to be scanned */
+ /* during normal GC. */
+
+ if (stack_size < 0) stack_size = -stack_size;
+ total_root_size = 2 * stack_size + GC_root_size;
+ scan_size = BYTES_TO_WORDS(GC_heapsize - GC_large_free_bytes
+ + (GC_large_free_bytes >> 2)
+ /* use a bit more of large empty heap */
+ + total_root_size);
+ if (TRUE_INCREMENTAL) {
+ return scan_size / (2 * GC_free_space_divisor);
+ } else {
+ return scan_size / GC_free_space_divisor;
+ }
+}
+
+/* Return the number of words allocated, adjusted for explicit storage */
+/* management, etc.. This number is used in deciding when to trigger */
+/* collections. */
+word GC_adj_words_allocd()
+{
+ register signed_word result;
+ register signed_word expl_managed =
+ BYTES_TO_WORDS((long)GC_non_gc_bytes
+ - (long)GC_non_gc_bytes_at_gc);
+
+ /* Don't count what was explicitly freed, or newly allocated for */
+ /* explicit management. Note that deallocating an explicitly */
+ /* managed object should not alter result, assuming the client */
+ /* is playing by the rules. */
+ result = (signed_word)GC_words_allocd
+ - (signed_word)GC_mem_freed
+ + (signed_word)GC_finalizer_mem_freed - expl_managed;
+ if (result > (signed_word)GC_words_allocd) {
+ result = GC_words_allocd;
+ /* probably client bug or unfortunate scheduling */
+ }
+ result += GC_words_finalized;
+ /* We count objects enqueued for finalization as though they */
+ /* had been reallocated this round. Finalization is user */
+ /* visible progress. And if we don't count this, we have */
+ /* stability problems for programs that finalize all objects. */
+ result += GC_words_wasted;
+ /* This doesn't reflect useful work. But if there is lots of */
+ /* new fragmentation, the same is probably true of the heap, */
+ /* and the collection will be correspondingly cheaper. */
+ if (result < (signed_word)(GC_words_allocd >> 3)) {
+ /* Always count at least 1/8 of the allocations. We don't want */
+ /* to collect too infrequently, since that would inhibit */
+ /* coalescing of free storage blocks. */
+ /* This also makes us partially robust against client bugs. */
+ return(GC_words_allocd >> 3);
+ } else {
+ return(result);
+ }
+}
+
+
+/* Clear up a few frames worth of garbage left at the top of the stack. */
+/* This is used to prevent us from accidentally treating garbade left */
+/* on the stack by other parts of the collector as roots. This */
+/* differs from the code in misc.c, which actually tries to keep the */
+/* stack clear of long-lived, client-generated garbage. */
+void GC_clear_a_few_frames()
+{
+# define NWORDS 64
+ word frames[NWORDS];
+ register int i;
+
+ for (i = 0; i < NWORDS; i++) frames[i] = 0;
+}
+
+/* Have we allocated enough to amortize a collection? */
+GC_bool GC_should_collect()
+{
+ return(GC_adj_words_allocd() >= min_words_allocd());
+}
+
+
+void GC_notify_full_gc()
+{
+ if (GC_start_call_back != (void (*) GC_PROTO((void)))0) {
+ (*GC_start_call_back)();
+ }
+}
+
+GC_bool GC_is_full_gc = FALSE;
+
+/*
+ * Initiate a garbage collection if appropriate.
+ * Choose judiciously
+ * between partial, full, and stop-world collections.
+ * Assumes lock held, signals disabled.
+ */
+void GC_maybe_gc()
+{
+ static int n_partial_gcs = 0;
+
+ if (GC_should_collect()) {
+ if (!GC_incremental) {
+ GC_gcollect_inner();
+ n_partial_gcs = 0;
+ return;
+ } else {
+# ifdef PARALLEL_MARK
+ GC_wait_for_reclaim();
+# endif
+ if (GC_need_full_gc || n_partial_gcs >= GC_full_freq) {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf2(
+ "***>Full mark for collection %lu after %ld allocd bytes\n",
+ (unsigned long) GC_gc_no+1,
+ (long)WORDS_TO_BYTES(GC_words_allocd));
+ }
+# endif
+ GC_promote_black_lists();
+ (void)GC_reclaim_all((GC_stop_func)0, TRUE);
+ GC_clear_marks();
+ n_partial_gcs = 0;
+ GC_notify_full_gc();
+ GC_is_full_gc = TRUE;
+ } else {
+ n_partial_gcs++;
+ }
+ }
+ /* We try to mark with the world stopped. */
+ /* If we run out of time, this turns into */
+ /* incremental marking. */
+# ifndef NO_CLOCK
+ if (GC_time_limit != GC_TIME_UNLIMITED) { GET_TIME(GC_start_time); }
+# endif
+ if (GC_stopped_mark(GC_time_limit == GC_TIME_UNLIMITED?
+ GC_never_stop_func : GC_timeout_stop_func)) {
+# ifdef SAVE_CALL_CHAIN
+ GC_save_callers(GC_last_stack);
+# endif
+ GC_finish_collection();
+ } else {
+ if (!GC_is_full_gc) {
+ /* Count this as the first attempt */
+ GC_n_attempts++;
+ }
+ }
+ }
+}
+
+
+/*
+ * Stop the world garbage collection. Assumes lock held, signals disabled.
+ * If stop_func is not GC_never_stop_func, then abort if stop_func returns TRUE.
+ * Return TRUE if we successfully completed the collection.
+ */
+GC_bool GC_try_to_collect_inner(stop_func)
+GC_stop_func stop_func;
+{
+# ifdef CONDPRINT
+ CLOCK_TYPE start_time, current_time;
+# endif
+ if (GC_dont_gc) return FALSE;
+ if (GC_incremental && GC_collection_in_progress()) {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf0(
+ "GC_try_to_collect_inner: finishing collection in progress\n");
+ }
+# endif /* CONDPRINT */
+ /* Just finish collection already in progress. */
+ while(GC_collection_in_progress()) {
+ if (stop_func()) return(FALSE);
+ GC_collect_a_little_inner(1);
+ }
+ }
+ if (stop_func == GC_never_stop_func) GC_notify_full_gc();
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ if (GC_print_stats) GET_TIME(start_time);
+ GC_printf2(
+ "Initiating full world-stop collection %lu after %ld allocd bytes\n",
+ (unsigned long) GC_gc_no+1,
+ (long)WORDS_TO_BYTES(GC_words_allocd));
+ }
+# endif
+ GC_promote_black_lists();
+ /* Make sure all blocks have been reclaimed, so sweep routines */
+ /* don't see cleared mark bits. */
+ /* If we're guaranteed to finish, then this is unnecessary. */
+ /* In the find_leak case, we have to finish to guarantee that */
+ /* previously unmarked objects are not reported as leaks. */
+# ifdef PARALLEL_MARK
+ GC_wait_for_reclaim();
+# endif
+ if ((GC_find_leak || stop_func != GC_never_stop_func)
+ && !GC_reclaim_all(stop_func, FALSE)) {
+ /* Aborted. So far everything is still consistent. */
+ return(FALSE);
+ }
+ GC_invalidate_mark_state(); /* Flush mark stack. */
+ GC_clear_marks();
+# ifdef SAVE_CALL_CHAIN
+ GC_save_callers(GC_last_stack);
+# endif
+ GC_is_full_gc = TRUE;
+ if (!GC_stopped_mark(stop_func)) {
+ if (!GC_incremental) {
+ /* We're partially done and have no way to complete or use */
+ /* current work. Reestablish invariants as cheaply as */
+ /* possible. */
+ GC_invalidate_mark_state();
+ GC_unpromote_black_lists();
+ } /* else we claim the world is already still consistent. We'll */
+ /* finish incrementally. */
+ return(FALSE);
+ }
+ GC_finish_collection();
+# if defined(CONDPRINT)
+ if (GC_print_stats) {
+ GET_TIME(current_time);
+ GC_printf1("Complete collection took %lu msecs\n",
+ MS_TIME_DIFF(current_time,start_time));
+ }
+# endif
+ return(TRUE);
+}
+
+
+
+/*
+ * Perform n units of garbage collection work. A unit is intended to touch
+ * roughly GC_RATE pages. Every once in a while, we do more than that.
+ * This needa to be a fairly large number with our current incremental
+ * GC strategy, since otherwise we allocate too much during GC, and the
+ * cleanup gets expensive.
+ */
+# define GC_RATE 10
+# define MAX_PRIOR_ATTEMPTS 1
+ /* Maximum number of prior attempts at world stop marking */
+ /* A value of 1 means that we finish the second time, no matter */
+ /* how long it takes. Doesn't count the initial root scan */
+ /* for a full GC. */
+
+int GC_deficit = 0; /* The number of extra calls to GC_mark_some */
+ /* that we have made. */
+
+void GC_collect_a_little_inner(n)
+int n;
+{
+ register int i;
+
+ if (GC_dont_gc) return;
+ if (GC_incremental && GC_collection_in_progress()) {
+ for (i = GC_deficit; i < GC_RATE*n; i++) {
+ if (GC_mark_some((ptr_t)0)) {
+ /* Need to finish a collection */
+# ifdef SAVE_CALL_CHAIN
+ GC_save_callers(GC_last_stack);
+# endif
+# ifdef PARALLEL_MARK
+ GC_wait_for_reclaim();
+# endif
+ if (GC_n_attempts < MAX_PRIOR_ATTEMPTS
+ && GC_time_limit != GC_TIME_UNLIMITED) {
+ GET_TIME(GC_start_time);
+ if (!GC_stopped_mark(GC_timeout_stop_func)) {
+ GC_n_attempts++;
+ break;
+ }
+ } else {
+ (void)GC_stopped_mark(GC_never_stop_func);
+ }
+ GC_finish_collection();
+ break;
+ }
+ }
+ if (GC_deficit > 0) GC_deficit -= GC_RATE*n;
+ if (GC_deficit < 0) GC_deficit = 0;
+ } else {
+ GC_maybe_gc();
+ }
+}
+
+int GC_collect_a_little GC_PROTO(())
+{
+ int result;
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ GC_collect_a_little_inner(1);
+ result = (int)GC_collection_in_progress();
+ UNLOCK();
+ ENABLE_SIGNALS();
+ if (!result && GC_debugging_started) GC_print_all_smashed();
+ return(result);
+}
+
+/*
+ * Assumes lock is held, signals are disabled.
+ * We stop the world.
+ * If stop_func() ever returns TRUE, we may fail and return FALSE.
+ * Increment GC_gc_no if we succeed.
+ */
+GC_bool GC_stopped_mark(stop_func)
+GC_stop_func stop_func;
+{
+ register int i;
+ int dummy;
+# if defined(PRINTTIMES) || defined(CONDPRINT)
+ CLOCK_TYPE start_time, current_time;
+# endif
+
+# ifdef PRINTTIMES
+ GET_TIME(start_time);
+# endif
+# if defined(CONDPRINT) && !defined(PRINTTIMES)
+ if (GC_print_stats) GET_TIME(start_time);
+# endif
+# if defined(REGISTER_LIBRARIES_EARLY)
+ GC_cond_register_dynamic_libraries();
+# endif
+ STOP_WORLD();
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("--> Marking for collection %lu ",
+ (unsigned long) GC_gc_no + 1);
+ GC_printf2("after %lu allocd bytes + %lu wasted bytes\n",
+ (unsigned long) WORDS_TO_BYTES(GC_words_allocd),
+ (unsigned long) WORDS_TO_BYTES(GC_words_wasted));
+ }
+# endif
+# ifdef MAKE_BACK_GRAPH
+ if (GC_print_back_height) {
+ GC_build_back_graph();
+ }
+# endif
+
+ /* Mark from all roots. */
+ /* Minimize junk left in my registers and on the stack */
+ GC_clear_a_few_frames();
+ GC_noop(0,0,0,0,0,0);
+ GC_initiate_gc();
+ for(i = 0;;i++) {
+ if ((*stop_func)()) {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf0("Abandoned stopped marking after ");
+ GC_printf1("%lu iterations\n",
+ (unsigned long)i);
+ }
+# endif
+ GC_deficit = i; /* Give the mutator a chance. */
+ START_WORLD();
+ return(FALSE);
+ }
+ if (GC_mark_some((ptr_t)(&dummy))) break;
+ }
+
+ GC_gc_no++;
+# ifdef PRINTSTATS
+ GC_printf2("Collection %lu reclaimed %ld bytes",
+ (unsigned long) GC_gc_no - 1,
+ (long)WORDS_TO_BYTES(GC_mem_found));
+# else
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Collection %lu finished", (unsigned long) GC_gc_no - 1);
+ }
+# endif
+# endif /* !PRINTSTATS */
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1(" ---> heapsize = %lu bytes\n",
+ (unsigned long) GC_heapsize);
+ /* Printf arguments may be pushed in funny places. Clear the */
+ /* space. */
+ GC_printf0("");
+ }
+# endif /* CONDPRINT */
+
+ /* Check all debugged objects for consistency */
+ if (GC_debugging_started) {
+ (*GC_check_heap)();
+ }
+
+ START_WORLD();
+# ifdef PRINTTIMES
+ GET_TIME(current_time);
+ GC_printf1("World-stopped marking took %lu msecs\n",
+ MS_TIME_DIFF(current_time,start_time));
+# else
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GET_TIME(current_time);
+ GC_printf1("World-stopped marking took %lu msecs\n",
+ MS_TIME_DIFF(current_time,start_time));
+ }
+# endif
+# endif
+ return(TRUE);
+}
+
+/* Set all mark bits for the free list whose first entry is q */
+#ifdef __STDC__
+ void GC_set_fl_marks(ptr_t q)
+#else
+ void GC_set_fl_marks(q)
+ ptr_t q;
+#endif
+{
+ ptr_t p;
+ struct hblk * h, * last_h = 0;
+ hdr *hhdr;
+ int word_no;
+
+ for (p = q; p != 0; p = obj_link(p)){
+ h = HBLKPTR(p);
+ if (h != last_h) {
+ last_h = h;
+ hhdr = HDR(h);
+ }
+ word_no = (((word *)p) - ((word *)h));
+ set_mark_bit_from_hdr(hhdr, word_no);
+ }
+}
+
+/* Clear all mark bits for the free list whose first entry is q */
+/* Decrement GC_mem_found by number of words on free list. */
+#ifdef __STDC__
+ void GC_clear_fl_marks(ptr_t q)
+#else
+ void GC_clear_fl_marks(q)
+ ptr_t q;
+#endif
+{
+ ptr_t p;
+ struct hblk * h, * last_h = 0;
+ hdr *hhdr;
+ int word_no;
+
+ for (p = q; p != 0; p = obj_link(p)){
+ h = HBLKPTR(p);
+ if (h != last_h) {
+ last_h = h;
+ hhdr = HDR(h);
+ }
+ word_no = (((word *)p) - ((word *)h));
+ clear_mark_bit_from_hdr(hhdr, word_no);
+# ifdef GATHERSTATS
+ GC_mem_found -= hhdr -> hb_sz;
+# endif
+ }
+}
+
+/* Finish up a collection. Assumes lock is held, signals are disabled, */
+/* but the world is otherwise running. */
+void GC_finish_collection()
+{
+# ifdef PRINTTIMES
+ CLOCK_TYPE start_time;
+ CLOCK_TYPE finalize_time;
+ CLOCK_TYPE done_time;
+
+ GET_TIME(start_time);
+ finalize_time = start_time;
+# endif
+
+# ifdef GATHERSTATS
+ GC_mem_found = 0;
+# endif
+# if defined(LINUX) && defined(__ELF__) && !defined(SMALL_CONFIG)
+ if (getenv("GC_PRINT_ADDRESS_MAP") != 0) {
+ GC_print_address_map();
+ }
+# endif
+ COND_DUMP;
+ if (GC_find_leak) {
+ /* Mark all objects on the free list. All objects should be */
+ /* marked when we're done. */
+ {
+ register word size; /* current object size */
+ int kind;
+ ptr_t q;
+
+ for (kind = 0; kind < GC_n_kinds; kind++) {
+ for (size = 1; size <= MAXOBJSZ; size++) {
+ q = GC_obj_kinds[kind].ok_freelist[size];
+ if (q != 0) GC_set_fl_marks(q);
+ }
+ }
+ }
+ GC_start_reclaim(TRUE);
+ /* The above just checks; it doesn't really reclaim anything. */
+ }
+
+ GC_finalize();
+# ifdef STUBBORN_ALLOC
+ GC_clean_changing_list();
+# endif
+
+# ifdef PRINTTIMES
+ GET_TIME(finalize_time);
+# endif
+
+ if (GC_print_back_height) {
+# ifdef MAKE_BACK_GRAPH
+ GC_traverse_back_graph();
+# else
+# ifndef SMALL_CONFIG
+ GC_err_printf0("Back height not available: "
+ "Rebuild collector with -DMAKE_BACK_GRAPH\n");
+# endif
+# endif
+ }
+
+ /* Clear free list mark bits, in case they got accidentally marked */
+ /* (or GC_find_leak is set and they were intentionally marked). */
+ /* Also subtract memory remaining from GC_mem_found count. */
+ /* Note that composite objects on free list are cleared. */
+ /* Thus accidentally marking a free list is not a problem; only */
+ /* objects on the list itself will be marked, and that's fixed here. */
+ {
+ register word size; /* current object size */
+ register ptr_t q; /* pointer to current object */
+ int kind;
+
+ for (kind = 0; kind < GC_n_kinds; kind++) {
+ for (size = 1; size <= MAXOBJSZ; size++) {
+ q = GC_obj_kinds[kind].ok_freelist[size];
+ if (q != 0) GC_clear_fl_marks(q);
+ }
+ }
+ }
+
+
+# ifdef PRINTSTATS
+ GC_printf1("Bytes recovered before sweep - f.l. count = %ld\n",
+ (long)WORDS_TO_BYTES(GC_mem_found));
+# endif
+ /* Reconstruct free lists to contain everything not marked */
+ GC_start_reclaim(FALSE);
+ if (GC_is_full_gc) {
+ GC_used_heap_size_after_full = USED_HEAP_SIZE;
+ GC_need_full_gc = FALSE;
+ } else {
+ GC_need_full_gc =
+ BYTES_TO_WORDS(USED_HEAP_SIZE - GC_used_heap_size_after_full)
+ > min_words_allocd();
+ }
+
+# ifdef PRINTSTATS
+ GC_printf2(
+ "Immediately reclaimed %ld bytes in heap of size %lu bytes",
+ (long)WORDS_TO_BYTES(GC_mem_found),
+ (unsigned long)GC_heapsize);
+# ifdef USE_MUNMAP
+ GC_printf1("(%lu unmapped)", GC_unmapped_bytes);
+# endif
+ GC_printf2(
+ "\n%lu (atomic) + %lu (composite) collectable bytes in use\n",
+ (unsigned long)WORDS_TO_BYTES(GC_atomic_in_use),
+ (unsigned long)WORDS_TO_BYTES(GC_composite_in_use));
+# endif
+
+ GC_n_attempts = 0;
+ GC_is_full_gc = FALSE;
+ /* Reset or increment counters for next cycle */
+ GC_words_allocd_before_gc += GC_words_allocd;
+ GC_non_gc_bytes_at_gc = GC_non_gc_bytes;
+ GC_words_allocd = 0;
+ GC_words_wasted = 0;
+ GC_mem_freed = 0;
+ GC_finalizer_mem_freed = 0;
+
+# ifdef USE_MUNMAP
+ GC_unmap_old();
+# endif
+# ifdef PRINTTIMES
+ GET_TIME(done_time);
+ GC_printf2("Finalize + initiate sweep took %lu + %lu msecs\n",
+ MS_TIME_DIFF(finalize_time,start_time),
+ MS_TIME_DIFF(done_time,finalize_time));
+# endif
+}
+
+/* Externally callable routine to invoke full, stop-world collection */
+# if defined(__STDC__) || defined(__cplusplus)
+ int GC_try_to_collect(GC_stop_func stop_func)
+# else
+ int GC_try_to_collect(stop_func)
+ GC_stop_func stop_func;
+# endif
+{
+ int result;
+ DCL_LOCK_STATE;
+
+ if (GC_debugging_started) GC_print_all_smashed();
+ GC_INVOKE_FINALIZERS();
+ DISABLE_SIGNALS();
+ LOCK();
+ ENTER_GC();
+ if (!GC_is_initialized) GC_init_inner();
+ /* Minimize junk left in my registers */
+ GC_noop(0,0,0,0,0,0);
+ result = (int)GC_try_to_collect_inner(stop_func);
+ EXIT_GC();
+ UNLOCK();
+ ENABLE_SIGNALS();
+ if(result) {
+ if (GC_debugging_started) GC_print_all_smashed();
+ GC_INVOKE_FINALIZERS();
+ }
+ return(result);
+}
+
+void GC_gcollect GC_PROTO(())
+{
+ (void)GC_try_to_collect(GC_never_stop_func);
+ if (GC_have_errors) GC_print_all_errors();
+}
+
+word GC_n_heap_sects = 0; /* Number of sections currently in heap. */
+
+/*
+ * Use the chunk of memory starting at p of size bytes as part of the heap.
+ * Assumes p is HBLKSIZE aligned, and bytes is a multiple of HBLKSIZE.
+ */
+void GC_add_to_heap(p, bytes)
+struct hblk *p;
+word bytes;
+{
+ word words;
+ hdr * phdr;
+
+ if (GC_n_heap_sects >= MAX_HEAP_SECTS) {
+ ABORT("Too many heap sections: Increase MAXHINCR or MAX_HEAP_SECTS");
+ }
+ phdr = GC_install_header(p);
+ if (0 == phdr) {
+ /* This is extremely unlikely. Can't add it. This will */
+ /* almost certainly result in a 0 return from the allocator, */
+ /* which is entirely appropriate. */
+ return;
+ }
+ GC_heap_sects[GC_n_heap_sects].hs_start = (ptr_t)p;
+ GC_heap_sects[GC_n_heap_sects].hs_bytes = bytes;
+ GC_n_heap_sects++;
+ words = BYTES_TO_WORDS(bytes);
+ phdr -> hb_sz = words;
+ phdr -> hb_map = (unsigned char *)1; /* A value != GC_invalid_map */
+ phdr -> hb_flags = 0;
+ GC_freehblk(p);
+ GC_heapsize += bytes;
+ if ((ptr_t)p <= (ptr_t)GC_least_plausible_heap_addr
+ || GC_least_plausible_heap_addr == 0) {
+ GC_least_plausible_heap_addr = (GC_PTR)((ptr_t)p - sizeof(word));
+ /* Making it a little smaller than necessary prevents */
+ /* us from getting a false hit from the variable */
+ /* itself. There's some unintentional reflection */
+ /* here. */
+ }
+ if ((ptr_t)p + bytes >= (ptr_t)GC_greatest_plausible_heap_addr) {
+ GC_greatest_plausible_heap_addr = (GC_PTR)((ptr_t)p + bytes);
+ }
+}
+
+# if !defined(NO_DEBUGGING)
+void GC_print_heap_sects()
+{
+ register unsigned i;
+
+ GC_printf1("Total heap size: %lu\n", (unsigned long) GC_heapsize);
+ for (i = 0; i < GC_n_heap_sects; i++) {
+ unsigned long start = (unsigned long) GC_heap_sects[i].hs_start;
+ unsigned long len = (unsigned long) GC_heap_sects[i].hs_bytes;
+ struct hblk *h;
+ unsigned nbl = 0;
+
+ GC_printf3("Section %ld from 0x%lx to 0x%lx ", (unsigned long)i,
+ start, (unsigned long)(start + len));
+ for (h = (struct hblk *)start; h < (struct hblk *)(start + len); h++) {
+ if (GC_is_black_listed(h, HBLKSIZE)) nbl++;
+ }
+ GC_printf2("%lu/%lu blacklisted\n", (unsigned long)nbl,
+ (unsigned long)(len/HBLKSIZE));
+ }
+}
+# endif
+
+GC_PTR GC_least_plausible_heap_addr = (GC_PTR)ONES;
+GC_PTR GC_greatest_plausible_heap_addr = 0;
+
+ptr_t GC_max(x,y)
+ptr_t x, y;
+{
+ return(x > y? x : y);
+}
+
+ptr_t GC_min(x,y)
+ptr_t x, y;
+{
+ return(x < y? x : y);
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_set_max_heap_size(GC_word n)
+# else
+ void GC_set_max_heap_size(n)
+ GC_word n;
+# endif
+{
+ GC_max_heapsize = n;
+}
+
+GC_word GC_max_retries = 0;
+
+/*
+ * this explicitly increases the size of the heap. It is used
+ * internally, but may also be invoked from GC_expand_hp by the user.
+ * The argument is in units of HBLKSIZE.
+ * Tiny values of n are rounded up.
+ * Returns FALSE on failure.
+ */
+GC_bool GC_expand_hp_inner(n)
+word n;
+{
+ word bytes;
+ struct hblk * space;
+ word expansion_slop; /* Number of bytes by which we expect the */
+ /* heap to expand soon. */
+
+ if (n < MINHINCR) n = MINHINCR;
+ bytes = n * HBLKSIZE;
+ /* Make sure bytes is a multiple of GC_page_size */
+ {
+ word mask = GC_page_size - 1;
+ bytes += mask;
+ bytes &= ~mask;
+ }
+
+ if (GC_max_heapsize != 0 && GC_heapsize + bytes > GC_max_heapsize) {
+ /* Exceeded self-imposed limit */
+ return(FALSE);
+ }
+ space = GET_MEM(bytes);
+ if( space == 0 ) {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Failed to expand heap by %ld bytes\n",
+ (unsigned long)bytes);
+ }
+# endif
+ return(FALSE);
+ }
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf2("Increasing heap size by %lu after %lu allocated bytes\n",
+ (unsigned long)bytes,
+ (unsigned long)WORDS_TO_BYTES(GC_words_allocd));
+# ifdef UNDEFINED
+ GC_printf1("Root size = %lu\n", GC_root_size);
+ GC_print_block_list(); GC_print_hblkfreelist();
+ GC_printf0("\n");
+# endif
+ }
+# endif
+ expansion_slop = 8 * WORDS_TO_BYTES(min_words_allocd());
+ if (5 * HBLKSIZE * MAXHINCR > expansion_slop) {
+ expansion_slop = 5 * HBLKSIZE * MAXHINCR;
+ }
+ if (GC_last_heap_addr == 0 && !((word)space & SIGNB)
+ || GC_last_heap_addr != 0 && GC_last_heap_addr < (ptr_t)space) {
+ /* Assume the heap is growing up */
+ GC_greatest_plausible_heap_addr =
+ GC_max(GC_greatest_plausible_heap_addr,
+ (ptr_t)space + bytes + expansion_slop);
+ } else {
+ /* Heap is growing down */
+ GC_least_plausible_heap_addr =
+ GC_min(GC_least_plausible_heap_addr,
+ (ptr_t)space - expansion_slop);
+ }
+ GC_prev_heap_addr = GC_last_heap_addr;
+ GC_last_heap_addr = (ptr_t)space;
+ GC_add_to_heap(space, bytes);
+ return(TRUE);
+}
+
+/* Really returns a bool, but it's externally visible, so that's clumsy. */
+/* Arguments is in bytes. */
+# if defined(__STDC__) || defined(__cplusplus)
+ int GC_expand_hp(size_t bytes)
+# else
+ int GC_expand_hp(bytes)
+ size_t bytes;
+# endif
+{
+ int result;
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ if (!GC_is_initialized) GC_init_inner();
+ result = (int)GC_expand_hp_inner(divHBLKSZ((word)bytes));
+ if (result) GC_requested_heapsize += bytes;
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return(result);
+}
+
+unsigned GC_fail_count = 0;
+ /* How many consecutive GC/expansion failures? */
+ /* Reset by GC_allochblk. */
+
+GC_bool GC_collect_or_expand(needed_blocks, ignore_off_page)
+word needed_blocks;
+GC_bool ignore_off_page;
+{
+ if (!GC_incremental && !GC_dont_gc &&
+ (GC_dont_expand && GC_words_allocd > 0 || GC_should_collect())) {
+ GC_gcollect_inner();
+ } else {
+ word blocks_to_get = GC_heapsize/(HBLKSIZE*GC_free_space_divisor)
+ + needed_blocks;
+
+ if (blocks_to_get > MAXHINCR) {
+ word slop;
+
+ if (ignore_off_page) {
+ slop = 4;
+ } else {
+ slop = 2*divHBLKSZ(BL_LIMIT);
+ if (slop > needed_blocks) slop = needed_blocks;
+ }
+ if (needed_blocks + slop > MAXHINCR) {
+ blocks_to_get = needed_blocks + slop;
+ } else {
+ blocks_to_get = MAXHINCR;
+ }
+ }
+ if (!GC_expand_hp_inner(blocks_to_get)
+ && !GC_expand_hp_inner(needed_blocks)) {
+ if (GC_fail_count++ < GC_max_retries) {
+ WARN("Out of Memory! Trying to continue ...\n", 0);
+ GC_gcollect_inner();
+ } else {
+# if !defined(AMIGA) || !defined(GC_AMIGA_FASTALLOC)
+ WARN("Out of Memory! Returning NIL!\n", 0);
+# endif
+ return(FALSE);
+ }
+ } else {
+# ifdef CONDPRINT
+ if (GC_fail_count && GC_print_stats) {
+ GC_printf0("Memory available again ...\n");
+ }
+# endif
+ }
+ }
+ return(TRUE);
+}
+
+/*
+ * Make sure the object free list for sz is not empty.
+ * Return a pointer to the first object on the free list.
+ * The object MUST BE REMOVED FROM THE FREE LIST BY THE CALLER.
+ * Assumes we hold the allocator lock and signals are disabled.
+ *
+ */
+ptr_t GC_allocobj(sz, kind)
+word sz;
+int kind;
+{
+ ptr_t * flh = &(GC_obj_kinds[kind].ok_freelist[sz]);
+ GC_bool tried_minor = FALSE;
+
+ if (sz == 0) return(0);
+
+ while (*flh == 0) {
+ ENTER_GC();
+ /* Do our share of marking work */
+ if(TRUE_INCREMENTAL) GC_collect_a_little_inner(1);
+ /* Sweep blocks for objects of this size */
+ GC_continue_reclaim(sz, kind);
+ EXIT_GC();
+ if (*flh == 0) {
+ GC_new_hblk(sz, kind);
+ }
+ if (*flh == 0) {
+ ENTER_GC();
+ if (GC_incremental && GC_time_limit == GC_TIME_UNLIMITED
+ && ! tried_minor ) {
+ GC_collect_a_little_inner(1);
+ tried_minor = TRUE;
+ } else {
+ if (!GC_collect_or_expand((word)1,FALSE)) {
+ EXIT_GC();
+ return(0);
+ }
+ }
+ EXIT_GC();
+ }
+ }
+ /* Successful allocation; reset failure count. */
+ GC_fail_count = 0;
+
+ return(*flh);
+}
--- /dev/null
+ # $Id: alpha_mach_dep.s,v 1.2 1993/01/18 22:54:51 dosser Exp $
+ .arch ev6
+
+ .text
+ .align 4
+ .globl GC_push_regs
+ .ent GC_push_regs 2
+GC_push_regs:
+ ldgp $gp, 0($27)
+ lda $sp, -16($sp)
+ stq $26, 0($sp)
+ .mask 0x04000000, 0
+ .frame $sp, 16, $26, 0
+
+ # $0 integer result
+ # $1-$8 temp regs - not preserved cross calls
+ # $9-$15 call saved regs
+ # $16-$21 argument regs - not preserved cross calls
+ # $22-$28 temp regs - not preserved cross calls
+ # $29 global pointer - not preserved cross calls
+ # $30 stack pointer
+
+# define call_push(x) \
+ mov x, $16; \
+ jsr $26, GC_push_one; \
+ ldgp $gp, 0($26)
+
+ call_push($9)
+ call_push($10)
+ call_push($11)
+ call_push($12)
+ call_push($13)
+ call_push($14)
+ call_push($15)
+
+ # $f0-$f1 floating point results
+ # $f2-$f9 call saved regs
+ # $f10-$f30 temp regs - not preserved cross calls
+
+ # Use the most efficient transfer method for this hardware.
+ # Bit 1 detects the FIX extension, which includes ftoit.
+ amask 2, $0
+ bne $0, $use_stack
+
+#undef call_push
+#define call_push(x) \
+ ftoit x, $16; \
+ jsr $26, GC_push_one; \
+ ldgp $gp, 0($26)
+
+ call_push($f2)
+ call_push($f3)
+ call_push($f4)
+ call_push($f5)
+ call_push($f6)
+ call_push($f7)
+ call_push($f8)
+ call_push($f9)
+
+ ldq $26, 0($sp)
+ lda $sp, 16($sp)
+ ret $31, ($26), 1
+
+ .align 4
+$use_stack:
+
+#undef call_push
+#define call_push(x) \
+ stt x, 8($sp); \
+ ldq $16, 8($sp); \
+ jsr $26, GC_push_one; \
+ ldgp $gp, 0($26)
+
+ call_push($f2)
+ call_push($f3)
+ call_push($f4)
+ call_push($f5)
+ call_push($f6)
+ call_push($f7)
+ call_push($f8)
+ call_push($f9)
+
+ ldq $26, 0($sp)
+ lda $sp, 16($sp)
+ ret $31, ($26), 1
+
+ .end GC_push_regs
--- /dev/null
+/*
+ * Copyright (c) 2001 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+
+/*
+ * This implements a full, though not well-tuned, representation of the
+ * backwards points-to graph. This is used to test for non-GC-robust
+ * data structures; the code is not used during normal garbage collection.
+ *
+ * One restriction is that we drop all back-edges from nodes with very
+ * high in-degree, and simply add them add them to a list of such
+ * nodes. They are then treated as permanent roots. Id this by itself
+ * doesn't introduce a space leak, then such nodes can't contribute to
+ * a growing space leak.
+ */
+
+#ifdef MAKE_BACK_GRAPH
+
+#define MAX_IN 10 /* Maximum in-degree we handle directly */
+
+#include "private/dbg_mlc.h"
+#include <unistd.h>
+
+#if !defined(DBG_HDRS_ALL) || (ALIGNMENT != CPP_WORDSZ/8) || !defined(UNIX_LIKE)
+# error Configuration doesnt support MAKE_BACK_GRAPH
+#endif
+
+/* We store single back pointers directly in the object's oh_bg_ptr field. */
+/* If there is more than one ptr to an object, we store q | FLAG_MANY, */
+/* where q is a pointer to a back_edges object. */
+/* Every once in a while we use a back_edges object even for a single */
+/* pointer, since we need the other fields in the back_edges structure to */
+/* be present in some fraction of the objects. Otherwise we get serious */
+/* performance issues. */
+#define FLAG_MANY 2
+
+typedef struct back_edges_struct {
+ word n_edges; /* Number of edges, including those in continuation */
+ /* structures. */
+ unsigned short flags;
+# define RETAIN 1 /* Directly points to a reachable object; */
+ /* retain for next GC. */
+ unsigned short height_gc_no;
+ /* If height > 0, then the GC_gc_no value when it */
+ /* was computed. If it was computed this cycle, then */
+ /* it is current. If it was computed during the */
+ /* last cycle, then it represents the old height, */
+ /* which is only saved for live objects referenced by */
+ /* dead ones. This may grow due to refs from newly */
+ /* dead objects. */
+ signed_word height;
+ /* Longest path through unreachable nodes to this node */
+ /* that we found using depth first search. */
+
+# define HEIGHT_UNKNOWN ((signed_word)(-2))
+# define HEIGHT_IN_PROGRESS ((signed_word)(-1))
+ ptr_t edges[MAX_IN];
+ struct back_edges_struct *cont;
+ /* Pointer to continuation structure; we use only the */
+ /* edges field in the continuation. */
+ /* also used as free list link. */
+} back_edges;
+
+/* Allocate a new back edge structure. Should be more sophisticated */
+/* if this were production code. */
+#define MAX_BACK_EDGE_STRUCTS 100000
+static back_edges *back_edge_space = 0;
+int GC_n_back_edge_structs = 0; /* Serves as pointer to never used */
+ /* back_edges space. */
+static back_edges *avail_back_edges = 0;
+ /* Pointer to free list of deallocated */
+ /* back_edges structures. */
+
+static back_edges * new_back_edges(void)
+{
+ if (0 == back_edge_space) {
+ back_edge_space = (back_edges *)
+ sbrk(MAX_BACK_EDGE_STRUCTS*sizeof(back_edges));
+ }
+ if (0 != avail_back_edges) {
+ back_edges * result = avail_back_edges;
+ avail_back_edges = result -> cont;
+ result -> cont = 0;
+ return result;
+ }
+ if (GC_n_back_edge_structs >= MAX_BACK_EDGE_STRUCTS - 1) {
+ ABORT("needed too much space for back edges: adjust "
+ "MAX_BACK_EDGE_STRUCTS");
+ }
+ return back_edge_space + (GC_n_back_edge_structs++);
+}
+
+/* Deallocate p and its associated continuation structures. */
+static void deallocate_back_edges(back_edges *p)
+{
+ back_edges *last = p;
+
+ while (0 != last -> cont) last = last -> cont;
+ last -> cont = avail_back_edges;
+ avail_back_edges = p;
+}
+
+/* Table of objects that are currently on the depth-first search */
+/* stack. Only objects with in-degree one are in this table. */
+/* Other objects are identified using HEIGHT_IN_PROGRESS. */
+/* This data structure NEEDS IMPROVEMENT. */
+#define MAX_IN_PROGRESS 10000
+static ptr_t * in_progress_space = 0;
+static int n_in_progress = 0;
+
+static void push_in_progress(ptr_t p)
+{
+ if (in_progress_space == 0)
+ in_progress_space = sbrk(MAX_IN_PROGRESS * sizeof(ptr_t));
+ if (n_in_progress == MAX_IN_PROGRESS)
+ ABORT("Exceeded MAX_IN_PROGRESS");
+ in_progress_space[n_in_progress++] = p;
+}
+
+static GC_bool is_in_progress(ptr_t p)
+{
+ int i;
+ for (i = 0; i < n_in_progress; ++i) {
+ if (in_progress_space[i] == p) return TRUE;
+ }
+ return FALSE;
+}
+
+static void pop_in_progress(ptr_t p)
+{
+ --n_in_progress;
+ GC_ASSERT(in_progress_space[n_in_progress] == p);
+}
+
+#define GET_OH_BG_PTR(p) \
+ (ptr_t)REVEAL_POINTER(((oh *)(p)) -> oh_bg_ptr)
+#define SET_OH_BG_PTR(p,q) (((oh *)(p)) -> oh_bg_ptr) = HIDE_POINTER(q)
+
+/* Execute s once for each predecessor q of p in the points-to graph. */
+/* s should be a bracketed statement. We declare q. */
+#define FOR_EACH_PRED(q, p, s) \
+ { \
+ ptr_t q = GET_OH_BG_PTR(p); \
+ if (!((word)q & FLAG_MANY)) { \
+ if (q && !((word)q & 1)) s \
+ /* !((word)q & 1) checks for a misnterpreted freelist link */ \
+ } else { \
+ back_edges *orig_be_ = (back_edges *)((word)q & ~FLAG_MANY); \
+ back_edges *be_ = orig_be_; \
+ int total_, local_; \
+ int n_edges_ = be_ -> n_edges; \
+ for (total_ = 0, local_ = 0; total_ < n_edges_; ++local_, ++total_) { \
+ if (local_ == MAX_IN) { \
+ be_ = be_ -> cont; \
+ local_ = 0; \
+ } \
+ q = be_ -> edges[local_]; s \
+ } \
+ } \
+ }
+
+/* Ensure that p has a back_edges structure associated with it. */
+static void ensure_struct(ptr_t p)
+{
+ ptr_t old_back_ptr = GET_OH_BG_PTR(p);
+
+ if (!((word)old_back_ptr & FLAG_MANY)) {
+ back_edges *be = new_back_edges();
+ be -> flags = 0;
+ if (0 == old_back_ptr) {
+ be -> n_edges = 0;
+ } else {
+ be -> n_edges = 1;
+ be -> edges[0] = old_back_ptr;
+ }
+ be -> height = HEIGHT_UNKNOWN;
+ be -> height_gc_no = GC_gc_no - 1;
+ GC_ASSERT(be >= back_edge_space);
+ SET_OH_BG_PTR(p, (word)be | FLAG_MANY);
+ }
+}
+
+/* Add the (forward) edge from p to q to the backward graph. Both p */
+/* q are pointers to the object base, i.e. pointers to an oh. */
+static void add_edge(ptr_t p, ptr_t q)
+{
+ ptr_t old_back_ptr = GET_OH_BG_PTR(q);
+ back_edges * be, *be_cont;
+ word i;
+ static unsigned random_number = 13;
+# define GOT_LUCKY_NUMBER (((++random_number) & 0x7f) == 0)
+ /* A not very random number we use to occasionally allocate a */
+ /* back_edges structure even for a single backward edge. This */
+ /* prevents us from repeatedly tracing back through very long */
+ /* chains, since we will have some place to store height and */
+ /* in_progress flags along the way. */
+
+ GC_ASSERT(p == GC_base(p) && q == GC_base(q));
+ if (!GC_HAS_DEBUG_INFO(q) || !GC_HAS_DEBUG_INFO(p)) {
+ /* This is really a misinterpreted free list link, since we saw */
+ /* a pointer to a free list. Dont overwrite it! */
+ return;
+ }
+ if (0 == old_back_ptr) {
+ SET_OH_BG_PTR(q, p);
+ if (GOT_LUCKY_NUMBER) ensure_struct(q);
+ return;
+ }
+ /* Check whether it was already in the list of predecessors. */
+ FOR_EACH_PRED(pred, q, { if (p == pred) return; });
+ ensure_struct(q);
+ old_back_ptr = GET_OH_BG_PTR(q);
+ be = (back_edges *)((word)old_back_ptr & ~FLAG_MANY);
+ for (i = be -> n_edges, be_cont = be; i > MAX_IN;
+ be_cont = be_cont -> cont, i -= MAX_IN) {}
+ if (i == MAX_IN) {
+ be_cont -> cont = new_back_edges();
+ be_cont = be_cont -> cont;
+ i = 0;
+ }
+ be_cont -> edges[i] = p;
+ be -> n_edges++;
+ if (be -> n_edges == 100) {
+# if 0
+ if (GC_print_stats) {
+ GC_err_printf0("The following object has in-degree >= 100:\n");
+ GC_print_heap_obj(q);
+ }
+# endif
+ }
+}
+
+typedef void (*per_object_func)(ptr_t p, word n_words, word gc_descr);
+
+static void per_object_helper(struct hblk *h, word fn)
+{
+ hdr * hhdr = HDR(h);
+ word sz = hhdr -> hb_sz;
+ word descr = hhdr -> hb_descr;
+ per_object_func f = (per_object_func)fn;
+ int i = 0;
+
+ do {
+ f((ptr_t)(h -> hb_body + i), sz, descr);
+ i += sz;
+ } while (i + sz <= BYTES_TO_WORDS(HBLKSIZE));
+}
+
+void GC_apply_to_each_object(per_object_func f)
+{
+ GC_apply_to_all_blocks(per_object_helper, (word)f);
+}
+
+static void reset_back_edge(ptr_t p, word n_words, word gc_descr)
+{
+ /* Skip any free list links, or dropped blocks */
+ if (GC_HAS_DEBUG_INFO(p)) {
+ ptr_t old_back_ptr = GET_OH_BG_PTR(p);
+ if ((word)old_back_ptr & FLAG_MANY) {
+ back_edges *be = (back_edges *)((word)old_back_ptr & ~FLAG_MANY);
+ if (!(be -> flags & RETAIN)) {
+ deallocate_back_edges(be);
+ SET_OH_BG_PTR(p, 0);
+ } else {
+ word *currentp;
+
+ GC_ASSERT(GC_is_marked(p));
+
+ /* Back edges may point to objects that will not be retained. */
+ /* Delete them for now, but remember the height. */
+ /* Some will be added back at next GC. */
+ be -> n_edges = 0;
+ if (0 != be -> cont) {
+ deallocate_back_edges(be -> cont);
+ be -> cont = 0;
+ }
+
+ GC_ASSERT(GC_is_marked(p));
+
+ /* We only retain things for one GC cycle at a time. */
+ be -> flags &= ~RETAIN;
+ }
+ } else /* Simple back pointer */ {
+ /* Clear to avoid dangling pointer. */
+ SET_OH_BG_PTR(p, 0);
+ }
+ }
+}
+
+static void add_back_edges(ptr_t p, word n_words, word gc_descr)
+{
+ word *currentp = (word *)(p + sizeof(oh));
+
+ /* For now, fix up non-length descriptors conservatively. */
+ if((gc_descr & GC_DS_TAGS) != GC_DS_LENGTH) {
+ gc_descr = WORDS_TO_BYTES(n_words);
+ }
+ while (currentp < (word *)(p + gc_descr)) {
+ word current = *currentp++;
+ FIXUP_POINTER(current);
+ if (current >= (word)GC_least_plausible_heap_addr &&
+ current <= (word)GC_greatest_plausible_heap_addr) {
+ ptr_t target = GC_base((GC_PTR)current);
+ if (0 != target) {
+ add_edge(p, target);
+ }
+ }
+ }
+}
+
+/* Rebuild the reprentation of the backward reachability graph. */
+/* Does not examine mark bits. Can be called before GC. */
+void GC_build_back_graph(void)
+{
+ GC_apply_to_each_object(add_back_edges);
+}
+
+/* Return an approximation to the length of the longest simple path */
+/* through unreachable objects to p. We refer to this as the height */
+/* of p. */
+static word backwards_height(ptr_t p)
+{
+ word result;
+ ptr_t back_ptr = GET_OH_BG_PTR(p);
+ back_edges *be;
+
+ if (0 == back_ptr) return 1;
+ if (!((word)back_ptr & FLAG_MANY)) {
+ if (is_in_progress(p)) return 0; /* DFS back edge, i.e. we followed */
+ /* an edge to an object already */
+ /* on our stack: ignore */
+ push_in_progress(p);
+ result = backwards_height(back_ptr)+1;
+ pop_in_progress(p);
+ return result;
+ }
+ be = (back_edges *)((word)back_ptr & ~FLAG_MANY);
+ if (be -> height >= 0 && be -> height_gc_no == GC_gc_no)
+ return be -> height;
+ /* Ignore back edges in DFS */
+ if (be -> height == HEIGHT_IN_PROGRESS) return 0;
+ result = (be -> height > 0? be -> height : 1);
+ be -> height = HEIGHT_IN_PROGRESS;
+ FOR_EACH_PRED(q, p, {
+ word this_height;
+ if (GC_is_marked(q) && !(FLAG_MANY & (word)GET_OH_BG_PTR(p))) {
+ if (GC_print_stats)
+ GC_printf2("Found bogus pointer from 0x%lx to 0x%lx\n", q, p);
+ /* Reachable object "points to" unreachable one. */
+ /* Could be caused by our lax treatment of GC descriptors. */
+ this_height = 1;
+ } else {
+ this_height = backwards_height(q);
+ }
+ if (this_height >= result) result = this_height + 1;
+ });
+ be -> height = result;
+ be -> height_gc_no = GC_gc_no;
+ return result;
+}
+
+word GC_max_height;
+ptr_t GC_deepest_obj;
+
+/* Compute the maximum height of every unreachable predecessor p of a */
+/* reachable object. Arrange to save the heights of all such objects p */
+/* so that they can be used in calculating the height of objects in the */
+/* next GC. */
+/* Set GC_max_height to be the maximum height we encounter, and */
+/* GC_deepest_obj to be the corresponding object. */
+static void update_max_height(ptr_t p, word n_words, word gc_descr)
+{
+ if (GC_is_marked(p) && GC_HAS_DEBUG_INFO(p)) {
+ int i;
+ word p_height = 0;
+ ptr_t p_deepest_obj = 0;
+ ptr_t back_ptr;
+ back_edges *be = 0;
+
+ /* If we remembered a height last time, use it as a minimum. */
+ /* It may have increased due to newly unreachable chains pointing */
+ /* to p, but it can't have decreased. */
+ back_ptr = GET_OH_BG_PTR(p);
+ if (0 != back_ptr && ((word)back_ptr & FLAG_MANY)) {
+ be = (back_edges *)((word)back_ptr & ~FLAG_MANY);
+ if (be -> height != HEIGHT_UNKNOWN) p_height = be -> height;
+ }
+ FOR_EACH_PRED(q, p, {
+ if (!GC_is_marked(q) && GC_HAS_DEBUG_INFO(q)) {
+ word q_height;
+
+ q_height = backwards_height(q);
+ if (q_height > p_height) {
+ p_height = q_height;
+ p_deepest_obj = q;
+ }
+ }
+ });
+ if (p_height > 0) {
+ /* Remember the height for next time. */
+ if (be == 0) {
+ ensure_struct(p);
+ back_ptr = GET_OH_BG_PTR(p);
+ be = (back_edges *)((word)back_ptr & ~FLAG_MANY);
+ }
+ be -> flags |= RETAIN;
+ be -> height = p_height;
+ be -> height_gc_no = GC_gc_no;
+ }
+ if (p_height > GC_max_height) {
+ GC_max_height = p_height;
+ GC_deepest_obj = p_deepest_obj;
+ }
+ }
+}
+
+void GC_traverse_back_graph(void)
+{
+ static word max_max_height = 0;
+ GC_max_height = 0;
+ GC_apply_to_each_object(update_max_height);
+ GC_printf2("Maximum backwards height of reachable objects at GC %lu is %ld\n",
+ (unsigned long) GC_gc_no, GC_max_height);
+ if (GC_max_height > max_max_height) {
+ max_max_height = GC_max_height;
+ GC_printf0("The following unreachable object is last in a longest chain "
+ "of unreachable objects:\n");
+ GC_print_heap_obj(GC_deepest_obj);
+ }
+ if (GC_print_stats) {
+ GC_printf1("Needed max total of %ld back-edge structs\n",
+ GC_n_back_edge_structs);
+ }
+ GC_apply_to_each_object(reset_back_edge);
+ GC_deepest_obj = 0;
+}
+
+#endif /* MAKE_BACK_GRAPH */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, August 9, 1995 6:09 pm PDT */
+# include "private/gc_priv.h"
+
+/*
+ * We maintain several hash tables of hblks that have had false hits.
+ * Each contains one bit per hash bucket; If any page in the bucket
+ * has had a false hit, we assume that all of them have.
+ * See the definition of page_hash_table in gc_private.h.
+ * False hits from the stack(s) are much more dangerous than false hits
+ * from elsewhere, since the former can pin a large object that spans the
+ * block, eventhough it does not start on the dangerous block.
+ */
+
+/*
+ * Externally callable routines are:
+
+ * GC_add_to_black_list_normal
+ * GC_add_to_black_list_stack
+ * GC_promote_black_lists
+ * GC_is_black_listed
+ *
+ * All require that the allocator lock is held.
+ */
+
+/* Pointers to individual tables. We replace one table by another by */
+/* switching these pointers. */
+word * GC_old_normal_bl;
+ /* Nonstack false references seen at last full */
+ /* collection. */
+word * GC_incomplete_normal_bl;
+ /* Nonstack false references seen since last */
+ /* full collection. */
+word * GC_old_stack_bl;
+word * GC_incomplete_stack_bl;
+
+word GC_total_stack_black_listed;
+
+word GC_black_list_spacing = MINHINCR*HBLKSIZE; /* Initial rough guess */
+
+void GC_clear_bl();
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_default_print_heap_obj_proc(ptr_t p)
+# else
+ void GC_default_print_heap_obj_proc(p)
+ ptr_t p;
+# endif
+{
+ ptr_t base = GC_base(p);
+
+ GC_err_printf2("start: 0x%lx, appr. length: %ld", base, GC_size(base));
+}
+
+void (*GC_print_heap_obj) GC_PROTO((ptr_t p)) =
+ GC_default_print_heap_obj_proc;
+
+void GC_print_source_ptr(p)
+ptr_t p;
+{
+ ptr_t base = GC_base(p);
+ if (0 == base) {
+ if (0 == p) {
+ GC_err_printf0("in register");
+ } else {
+ GC_err_printf0("in root set");
+ }
+ } else {
+ GC_err_printf0("in object at ");
+ (*GC_print_heap_obj)(base);
+ }
+}
+
+void GC_bl_init()
+{
+ if (!GC_all_interior_pointers) {
+ GC_old_normal_bl = (word *)
+ GC_scratch_alloc((word)(sizeof (page_hash_table)));
+ GC_incomplete_normal_bl = (word *)GC_scratch_alloc
+ ((word)(sizeof(page_hash_table)));
+ if (GC_old_normal_bl == 0 || GC_incomplete_normal_bl == 0) {
+ GC_err_printf0("Insufficient memory for black list\n");
+ EXIT();
+ }
+ GC_clear_bl(GC_old_normal_bl);
+ GC_clear_bl(GC_incomplete_normal_bl);
+ }
+ GC_old_stack_bl = (word *)GC_scratch_alloc((word)(sizeof(page_hash_table)));
+ GC_incomplete_stack_bl = (word *)GC_scratch_alloc
+ ((word)(sizeof(page_hash_table)));
+ if (GC_old_stack_bl == 0 || GC_incomplete_stack_bl == 0) {
+ GC_err_printf0("Insufficient memory for black list\n");
+ EXIT();
+ }
+ GC_clear_bl(GC_old_stack_bl);
+ GC_clear_bl(GC_incomplete_stack_bl);
+}
+
+void GC_clear_bl(doomed)
+word *doomed;
+{
+ BZERO(doomed, sizeof(page_hash_table));
+}
+
+void GC_copy_bl(old, new)
+word *new, *old;
+{
+ BCOPY(old, new, sizeof(page_hash_table));
+}
+
+static word total_stack_black_listed();
+
+/* Signal the completion of a collection. Turn the incomplete black */
+/* lists into new black lists, etc. */
+void GC_promote_black_lists()
+{
+ word * very_old_normal_bl = GC_old_normal_bl;
+ word * very_old_stack_bl = GC_old_stack_bl;
+
+ GC_old_normal_bl = GC_incomplete_normal_bl;
+ GC_old_stack_bl = GC_incomplete_stack_bl;
+ if (!GC_all_interior_pointers) {
+ GC_clear_bl(very_old_normal_bl);
+ }
+ GC_clear_bl(very_old_stack_bl);
+ GC_incomplete_normal_bl = very_old_normal_bl;
+ GC_incomplete_stack_bl = very_old_stack_bl;
+ GC_total_stack_black_listed = total_stack_black_listed();
+# ifdef PRINTSTATS
+ GC_printf1("%ld bytes in heap blacklisted for interior pointers\n",
+ (unsigned long)GC_total_stack_black_listed);
+# endif
+ if (GC_total_stack_black_listed != 0) {
+ GC_black_list_spacing =
+ HBLKSIZE*(GC_heapsize/GC_total_stack_black_listed);
+ }
+ if (GC_black_list_spacing < 3 * HBLKSIZE) {
+ GC_black_list_spacing = 3 * HBLKSIZE;
+ }
+ if (GC_black_list_spacing > MAXHINCR * HBLKSIZE) {
+ GC_black_list_spacing = MAXHINCR * HBLKSIZE;
+ /* Makes it easier to allocate really huge blocks, which otherwise */
+ /* may have problems with nonuniform blacklist distributions. */
+ /* This way we should always succeed immediately after growing the */
+ /* heap. */
+ }
+}
+
+void GC_unpromote_black_lists()
+{
+ if (!GC_all_interior_pointers) {
+ GC_copy_bl(GC_old_normal_bl, GC_incomplete_normal_bl);
+ }
+ GC_copy_bl(GC_old_stack_bl, GC_incomplete_stack_bl);
+}
+
+/* P is not a valid pointer reference, but it falls inside */
+/* the plausible heap bounds. */
+/* Add it to the normal incomplete black list if appropriate. */
+#ifdef PRINT_BLACK_LIST
+ void GC_add_to_black_list_normal(p, source)
+ ptr_t source;
+#else
+ void GC_add_to_black_list_normal(p)
+#endif
+word p;
+{
+ if (!(GC_modws_valid_offsets[p & (sizeof(word)-1)])) return;
+ {
+ register int index = PHT_HASH(p);
+
+ if (HDR(p) == 0 || get_pht_entry_from_index(GC_old_normal_bl, index)) {
+# ifdef PRINT_BLACK_LIST
+ if (!get_pht_entry_from_index(GC_incomplete_normal_bl, index)) {
+ GC_err_printf2(
+ "Black listing (normal) 0x%lx referenced from 0x%lx ",
+ (unsigned long) p, (unsigned long) source);
+ GC_print_source_ptr(source);
+ GC_err_puts("\n");
+ }
+# endif
+ set_pht_entry_from_index(GC_incomplete_normal_bl, index);
+ } /* else this is probably just an interior pointer to an allocated */
+ /* object, and isn't worth black listing. */
+ }
+}
+
+/* And the same for false pointers from the stack. */
+#ifdef PRINT_BLACK_LIST
+ void GC_add_to_black_list_stack(p, source)
+ ptr_t source;
+#else
+ void GC_add_to_black_list_stack(p)
+#endif
+word p;
+{
+ register int index = PHT_HASH(p);
+
+ if (HDR(p) == 0 || get_pht_entry_from_index(GC_old_stack_bl, index)) {
+# ifdef PRINT_BLACK_LIST
+ if (!get_pht_entry_from_index(GC_incomplete_stack_bl, index)) {
+ GC_err_printf2(
+ "Black listing (stack) 0x%lx referenced from 0x%lx ",
+ (unsigned long)p, (unsigned long)source);
+ GC_print_source_ptr(source);
+ GC_err_puts("\n");
+ }
+# endif
+ set_pht_entry_from_index(GC_incomplete_stack_bl, index);
+ }
+}
+
+/*
+ * Is the block starting at h of size len bytes black listed? If so,
+ * return the address of the next plausible r such that (r, len) might not
+ * be black listed. (R may not actually be in the heap. We guarantee only
+ * that every smaller value of r after h is also black listed.)
+ * If (h,len) is not black listed, return 0.
+ * Knows about the structure of the black list hash tables.
+ */
+struct hblk * GC_is_black_listed(h, len)
+struct hblk * h;
+word len;
+{
+ register int index = PHT_HASH((word)h);
+ register word i;
+ word nblocks = divHBLKSZ(len);
+
+ if (!GC_all_interior_pointers) {
+ if (get_pht_entry_from_index(GC_old_normal_bl, index)
+ || get_pht_entry_from_index(GC_incomplete_normal_bl, index)) {
+ return(h+1);
+ }
+ }
+
+ for (i = 0; ; ) {
+ if (GC_old_stack_bl[divWORDSZ(index)] == 0
+ && GC_incomplete_stack_bl[divWORDSZ(index)] == 0) {
+ /* An easy case */
+ i += WORDSZ - modWORDSZ(index);
+ } else {
+ if (get_pht_entry_from_index(GC_old_stack_bl, index)
+ || get_pht_entry_from_index(GC_incomplete_stack_bl, index)) {
+ return(h+i+1);
+ }
+ i++;
+ }
+ if (i >= nblocks) break;
+ index = PHT_HASH((word)(h+i));
+ }
+ return(0);
+}
+
+
+/* Return the number of blacklisted blocks in a given range. */
+/* Used only for statistical purposes. */
+/* Looks only at the GC_incomplete_stack_bl. */
+word GC_number_stack_black_listed(start, endp1)
+struct hblk *start, *endp1;
+{
+ register struct hblk * h;
+ word result = 0;
+
+ for (h = start; h < endp1; h++) {
+ register int index = PHT_HASH((word)h);
+
+ if (get_pht_entry_from_index(GC_old_stack_bl, index)) result++;
+ }
+ return(result);
+}
+
+
+/* Return the total number of (stack) black-listed bytes. */
+static word total_stack_black_listed()
+{
+ register unsigned i;
+ word total = 0;
+
+ for (i = 0; i < GC_n_heap_sects; i++) {
+ struct hblk * start = (struct hblk *) GC_heap_sects[i].hs_start;
+ word len = (word) GC_heap_sects[i].hs_bytes;
+ struct hblk * endp1 = start + len/HBLKSIZE;
+
+ total += GC_number_stack_black_listed(start, endp1);
+ }
+ return(total * HBLKSIZE);
+}
+
--- /dev/null
+#!/bin/sh
+GC_DEBUG=1
+export GC_DEBUG
+$* 2>&1 | awk '{print "0x3e=c\""$0"\""};/^\t##PC##=/ {if ($2 != 0) {print $2"?i"}}' | adb $1 | sed "s/^ >/>/"
--- /dev/null
+/*
+ * Copyright (c) 1992-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, March 29, 1995 12:51 pm PST */
+# ifdef CHECKSUMS
+
+# include "gc_priv.h"
+
+/* This is debugging code intended to verify the results of dirty bit */
+/* computations. Works only in a single threaded environment. */
+/* We assume that stubborn objects are changed only when they are */
+/* enabled for writing. (Certain kinds of writing are actually */
+/* safe under other conditions.) */
+# define NSUMS 2000
+
+# define OFFSET 0x10000
+
+typedef struct {
+ GC_bool new_valid;
+ word old_sum;
+ word new_sum;
+ struct hblk * block; /* Block to which this refers + OFFSET */
+ /* to hide it from colector. */
+} page_entry;
+
+page_entry GC_sums [NSUMS];
+
+word GC_checksum(h)
+struct hblk *h;
+{
+ register word *p = (word *)h;
+ register word *lim = (word *)(h+1);
+ register word result = 0;
+
+ while (p < lim) {
+ result += *p++;
+ }
+ return(result | 0x80000000 /* doesn't look like pointer */);
+}
+
+# ifdef STUBBORN_ALLOC
+/* Check whether a stubborn object from the given block appears on */
+/* the appropriate free list. */
+GC_bool GC_on_free_list(h)
+struct hblk *h;
+{
+ register hdr * hhdr = HDR(h);
+ register int sz = hhdr -> hb_sz;
+ ptr_t p;
+
+ if (sz > MAXOBJSZ) return(FALSE);
+ for (p = GC_sobjfreelist[sz]; p != 0; p = obj_link(p)) {
+ if (HBLKPTR(p) == h) return(TRUE);
+ }
+ return(FALSE);
+}
+# endif
+
+int GC_n_dirty_errors;
+int GC_n_changed_errors;
+int GC_n_clean;
+int GC_n_dirty;
+
+void GC_update_check_page(h, index)
+struct hblk *h;
+int index;
+{
+ page_entry *pe = GC_sums + index;
+ register hdr * hhdr = HDR(h);
+
+ if (pe -> block != 0 && pe -> block != h + OFFSET) ABORT("goofed");
+ pe -> old_sum = pe -> new_sum;
+ pe -> new_sum = GC_checksum(h);
+# if !defined(MSWIN32) && !defined(MSWINCE)
+ if (pe -> new_sum != 0 && !GC_page_was_ever_dirty(h)) {
+ GC_printf1("GC_page_was_ever_dirty(0x%lx) is wrong\n",
+ (unsigned long)h);
+ }
+# endif
+ if (GC_page_was_dirty(h)) {
+ GC_n_dirty++;
+ } else {
+ GC_n_clean++;
+ }
+ if (pe -> new_valid && pe -> old_sum != pe -> new_sum) {
+ if (!GC_page_was_dirty(h) || !GC_page_was_ever_dirty(h)) {
+ /* Set breakpoint here */GC_n_dirty_errors++;
+ }
+# ifdef STUBBORN_ALLOC
+ if (!IS_FORWARDING_ADDR_OR_NIL(hhdr)
+ && hhdr -> hb_map != GC_invalid_map
+ && hhdr -> hb_obj_kind == STUBBORN
+ && !GC_page_was_changed(h)
+ && !GC_on_free_list(h)) {
+ /* if GC_on_free_list(h) then reclaim may have touched it */
+ /* without any allocations taking place. */
+ /* Set breakpoint here */GC_n_changed_errors++;
+ }
+# endif
+ }
+ pe -> new_valid = TRUE;
+ pe -> block = h + OFFSET;
+}
+
+word GC_bytes_in_used_blocks;
+
+void GC_add_block(h, dummy)
+struct hblk *h;
+word dummy;
+{
+ register hdr * hhdr = HDR(h);
+ register bytes = WORDS_TO_BYTES(hhdr -> hb_sz);
+
+ bytes += HDR_BYTES + HBLKSIZE-1;
+ bytes &= ~(HBLKSIZE-1);
+ GC_bytes_in_used_blocks += bytes;
+}
+
+void GC_check_blocks()
+{
+ word bytes_in_free_blocks = 0;
+ struct hblk * h = GC_hblkfreelist;
+ hdr * hhdr = HDR(h);
+ word sz;
+
+ GC_bytes_in_used_blocks = 0;
+ GC_apply_to_all_blocks(GC_add_block, (word)0);
+ while (h != 0) {
+ sz = hhdr -> hb_sz;
+ bytes_in_free_blocks += sz;
+ h = hhdr -> hb_next;
+ hhdr = HDR(h);
+ }
+ GC_printf2("GC_bytes_in_used_blocks = %ld, bytes_in_free_blocks = %ld ",
+ GC_bytes_in_used_blocks, bytes_in_free_blocks);
+ GC_printf1("GC_heapsize = %ld\n", GC_heapsize);
+ if (GC_bytes_in_used_blocks + bytes_in_free_blocks != GC_heapsize) {
+ GC_printf0("LOST SOME BLOCKS!!\n");
+ }
+}
+
+/* Should be called immediately after GC_read_dirty and GC_read_changed. */
+void GC_check_dirty()
+{
+ register int index;
+ register unsigned i;
+ register struct hblk *h;
+ register ptr_t start;
+
+ GC_check_blocks();
+
+ GC_n_dirty_errors = 0;
+ GC_n_changed_errors = 0;
+ GC_n_clean = 0;
+ GC_n_dirty = 0;
+
+ index = 0;
+ for (i = 0; i < GC_n_heap_sects; i++) {
+ start = GC_heap_sects[i].hs_start;
+ for (h = (struct hblk *)start;
+ h < (struct hblk *)(start + GC_heap_sects[i].hs_bytes);
+ h++) {
+ GC_update_check_page(h, index);
+ index++;
+ if (index >= NSUMS) goto out;
+ }
+ }
+out:
+ GC_printf2("Checked %lu clean and %lu dirty pages\n",
+ (unsigned long) GC_n_clean, (unsigned long) GC_n_dirty);
+ if (GC_n_dirty_errors > 0) {
+ GC_printf1("Found %lu dirty bit errors\n",
+ (unsigned long)GC_n_dirty_errors);
+ }
+ if (GC_n_changed_errors > 0) {
+ GC_printf1("Found %lu changed bit errors\n",
+ (unsigned long)GC_n_changed_errors);
+ GC_printf0("These may be benign (provoked by nonpointer changes)\n");
+# ifdef THREADS
+ GC_printf0(
+ "Also expect 1 per thread currently allocating a stubborn obj.\n");
+# endif
+ }
+}
+
+# else
+
+extern int GC_quiet;
+ /* ANSI C doesn't allow translation units to be empty. */
+ /* So we guarantee this one is nonempty. */
+
+# endif /* CHECKSUMS */
--- /dev/null
+#! /bin/sh
+# Attempt to guess a canonical system name.
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+# 2000, 2001, 2002 Free Software Foundation, Inc.
+
+timestamp='2002-03-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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Originally written by Per Bothner <per@bothner.com>.
+# Please send patches to <config-patches@gnu.org>. Submit a context
+# diff and a properly formatted ChangeLog entry.
+#
+# This script attempts to guess a canonical system name similar to
+# config.sub. If it succeeds, it prints the system name on stdout, and
+# exits with 0. Otherwise, it exits with 1.
+#
+# The plan is that this can be called by configure scripts if you
+# don't specify an explicit build system type.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION]
+
+Output the configuration name of the system \`$me' is run on.
+
+Operation modes:
+ -h, --help print this help, then exit
+ -t, --time-stamp print date of last modification, then exit
+ -v, --version print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.guess ($timestamp)
+
+Originally written by Per Bothner.
+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
+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."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+ case $1 in
+ --time-stamp | --time* | -t )
+ echo "$timestamp" ; exit 0 ;;
+ --version | -v )
+ echo "$version" ; exit 0 ;;
+ --help | --h* | -h )
+ echo "$usage"; exit 0 ;;
+ -- ) # Stop option processing
+ shift; break ;;
+ - ) # Use stdin as input.
+ break ;;
+ -* )
+ echo "$me: invalid option $1$help" >&2
+ exit 1 ;;
+ * )
+ break ;;
+ esac
+done
+
+if test $# != 0; then
+ echo "$me: too many arguments$help" >&2
+ exit 1
+fi
+
+
+dummy=dummy-$$
+trap 'rm -f $dummy.c $dummy.o $dummy.rel $dummy; exit 1' 1 2 15
+
+# CC_FOR_BUILD -- compiler used by this script.
+# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
+# use `HOST_CC' if defined, but it is deprecated.
+
+set_cc_for_build='case $CC_FOR_BUILD,$HOST_CC,$CC in
+ ,,) echo "int dummy(){}" > $dummy.c ;
+ for c in cc gcc c89 c99 ; do
+ ($c $dummy.c -c -o $dummy.o) >/dev/null 2>&1 ;
+ if test $? = 0 ; then
+ CC_FOR_BUILD="$c"; break ;
+ fi ;
+ done ;
+ rm -f $dummy.c $dummy.o $dummy.rel ;
+ if test x"$CC_FOR_BUILD" = x ; then
+ CC_FOR_BUILD=no_compiler_found ;
+ fi
+ ;;
+ ,,*) CC_FOR_BUILD=$CC ;;
+ ,*,*) CC_FOR_BUILD=$HOST_CC ;;
+esac'
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 1994-08-24)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+ PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ *:NetBSD:*:*)
+ # NetBSD (nbsd) targets should (where applicable) match one or
+ # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,
+ # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
+ # switched to ELF, *-*-netbsd* would select the old
+ # object file format. This provides both forward
+ # compatibility and a consistent mechanism for selecting the
+ # object file format.
+ #
+ # 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)`
+ case "${UNAME_MACHINE_ARCH}" in
+ arm*) machine=arm-unknown ;;
+ sh3el) machine=shl-unknown ;;
+ sh3eb) machine=sh-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)
+ eval $set_cc_for_build
+ if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep __ELF__ >/dev/null
+ then
+ # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
+ # Return netbsd for either. FIX?
+ os=netbsd
+ else
+ os=netbsdelf
+ fi
+ ;;
+ *)
+ os=netbsd
+ ;;
+ esac
+ # The OS release
+ release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
+ # contains redundant information, the shorter form:
+ # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+ echo "${machine}-${os}${release}"
+ exit 0 ;;
+ amiga:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ arc:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ hp300:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mac68k:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ macppc:OpenBSD:*:*)
+ echo powerpc-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mvme68k:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mvme88k:OpenBSD:*:*)
+ echo m88k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mvmeppc:OpenBSD:*:*)
+ echo powerpc-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ pmax:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ sgi:OpenBSD:*:*)
+ echo mipseb-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ sun3:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ wgrisc:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ *:OpenBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ alpha:OSF1:*:*)
+ if test $UNAME_RELEASE = "V4.0"; then
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+ fi
+ # A Vn.n version is a released version.
+ # A Tn.n version is a released field test version.
+ # A Xn.n version is an unreleased experimental baselevel.
+ # 1.2 uses "1.2" for uname -r.
+ cat <<EOF >$dummy.s
+ .data
+\$Lformat:
+ .byte 37,100,45,37,120,10,0 # "%d-%x\n"
+
+ .text
+ .globl main
+ .align 4
+ .ent main
+main:
+ .frame \$30,16,\$26,0
+ ldgp \$29,0(\$27)
+ .prologue 1
+ .long 0x47e03d80 # implver \$0
+ lda \$2,-1
+ .long 0x47e20c21 # amask \$2,\$1
+ lda \$16,\$Lformat
+ mov \$0,\$17
+ not \$1,\$18
+ jsr \$26,printf
+ ldgp \$29,0(\$26)
+ mov 0,\$16
+ jsr \$26,exit
+ .end main
+EOF
+ eval $set_cc_for_build
+ $CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
+ if test "$?" = 0 ; then
+ case `./$dummy` in
+ 0-0)
+ UNAME_MACHINE="alpha"
+ ;;
+ 1-0)
+ UNAME_MACHINE="alphaev5"
+ ;;
+ 1-1)
+ UNAME_MACHINE="alphaev56"
+ ;;
+ 1-101)
+ UNAME_MACHINE="alphapca56"
+ ;;
+ 2-303)
+ UNAME_MACHINE="alphaev6"
+ ;;
+ 2-307)
+ UNAME_MACHINE="alphaev67"
+ ;;
+ 2-1307)
+ UNAME_MACHINE="alphaev68"
+ ;;
+ esac
+ fi
+ rm -f $dummy.s $dummy
+ echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+ exit 0 ;;
+ Alpha\ *:Windows_NT*:*)
+ # How do we know it's Interix rather than the generic POSIX subsystem?
+ # Should we change UNAME_MACHINE based on the output of uname instead
+ # of the specific Alpha model?
+ echo alpha-pc-interix
+ exit 0 ;;
+ 21064:Windows_NT:50:3)
+ echo alpha-dec-winnt3.5
+ exit 0 ;;
+ Amiga*:UNIX_System_V:4.0:*)
+ echo m68k-unknown-sysv4
+ exit 0;;
+ *:[Aa]miga[Oo][Ss]:*:*)
+ echo ${UNAME_MACHINE}-unknown-amigaos
+ exit 0 ;;
+ *:[Mm]orph[Oo][Ss]:*:*)
+ echo ${UNAME_MACHINE}-unknown-morphos
+ exit 0 ;;
+ *:OS/390:*:*)
+ echo i370-ibm-openedition
+ exit 0 ;;
+ arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+ echo arm-acorn-riscix${UNAME_RELEASE}
+ exit 0;;
+ SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+ echo hppa1.1-hitachi-hiuxmpp
+ exit 0;;
+ Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+ # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+ if test "`(/bin/universe) 2>/dev/null`" = att ; then
+ echo pyramid-pyramid-sysv3
+ else
+ echo pyramid-pyramid-bsd
+ fi
+ exit 0 ;;
+ NILE*:*:*:dcosx)
+ echo pyramid-pyramid-svr4
+ exit 0 ;;
+ sun4H:SunOS:5.*:*)
+ echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+ echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ i86pc:SunOS:5.*:*)
+ echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:6*:*)
+ # According to config.sub, this is the proper way to canonicalize
+ # SunOS6. Hard to guess exactly what SunOS6 will be like, but
+ # it's likely to be more like Solaris than SunOS4.
+ echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:*:*)
+ case "`/usr/bin/arch -k`" in
+ Series*|S4*)
+ UNAME_RELEASE=`uname -v`
+ ;;
+ esac
+ # Japanese Language versions have a version number like `4.1.3-JL'.
+ echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+ exit 0 ;;
+ sun3*:SunOS:*:*)
+ echo m68k-sun-sunos${UNAME_RELEASE}
+ exit 0 ;;
+ sun*:*:4.2BSD:*)
+ UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+ test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
+ case "`/bin/arch`" in
+ sun3)
+ echo m68k-sun-sunos${UNAME_RELEASE}
+ ;;
+ sun4)
+ echo sparc-sun-sunos${UNAME_RELEASE}
+ ;;
+ esac
+ exit 0 ;;
+ aushp:SunOS:*:*)
+ echo sparc-auspex-sunos${UNAME_RELEASE}
+ exit 0 ;;
+ # The situation for MiNT is a little confusing. The machine name
+ # can be virtually everything (everything which is not
+ # "atarist" or "atariste" at least should have a processor
+ # > m68000). The system name ranges from "MiNT" over "FreeMiNT"
+ # to the lowercase version "mint" (or "freemint"). Finally
+ # the system name "TOS" denotes a system which is actually not
+ # MiNT. But MiNT is downward compatible to TOS, so this should
+ # be no problem.
+ atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit 0 ;;
+ atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit 0 ;;
+ *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit 0 ;;
+ milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+ echo m68k-milan-mint${UNAME_RELEASE}
+ exit 0 ;;
+ hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+ echo m68k-hades-mint${UNAME_RELEASE}
+ exit 0 ;;
+ *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+ echo m68k-unknown-mint${UNAME_RELEASE}
+ exit 0 ;;
+ powerpc:machten:*:*)
+ echo powerpc-apple-machten${UNAME_RELEASE}
+ exit 0 ;;
+ RISC*:Mach:*:*)
+ echo mips-dec-mach_bsd4.3
+ exit 0 ;;
+ RISC*:ULTRIX:*:*)
+ echo mips-dec-ultrix${UNAME_RELEASE}
+ exit 0 ;;
+ VAX*:ULTRIX*:*:*)
+ echo vax-dec-ultrix${UNAME_RELEASE}
+ exit 0 ;;
+ 2020:CLIX:*:* | 2430:CLIX:*:*)
+ echo clipper-intergraph-clix${UNAME_RELEASE}
+ exit 0 ;;
+ mips:*:*:UMIPS | mips:*:*:RISCos)
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+#ifdef __cplusplus
+#include <stdio.h> /* for printf() prototype */
+ int main (int argc, char *argv[]) {
+#else
+ int main (argc, argv) int argc; char *argv[]; {
+#endif
+ #if defined (host_mips) && defined (MIPSEB)
+ #if defined (SYSTYPE_SYSV)
+ printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_SVR4)
+ printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+ printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+ #endif
+ #endif
+ exit (-1);
+ }
+EOF
+ $CC_FOR_BUILD $dummy.c -o $dummy \
+ && ./$dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \
+ && rm -f $dummy.c $dummy && exit 0
+ rm -f $dummy.c $dummy
+ echo mips-mips-riscos${UNAME_RELEASE}
+ exit 0 ;;
+ Motorola:PowerMAX_OS:*:*)
+ echo powerpc-motorola-powermax
+ exit 0 ;;
+ Night_Hawk:Power_UNIX:*:*)
+ echo powerpc-harris-powerunix
+ exit 0 ;;
+ m88k:CX/UX:7*:*)
+ echo m88k-harris-cxux7
+ exit 0 ;;
+ m88k:*:4*:R4*)
+ echo m88k-motorola-sysv4
+ exit 0 ;;
+ m88k:*:3*:R3*)
+ echo m88k-motorola-sysv3
+ exit 0 ;;
+ AViiON:dgux:*:*)
+ # DG/UX returns AViiON for all architectures
+ UNAME_PROCESSOR=`/usr/bin/uname -p`
+ if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
+ then
+ if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
+ [ ${TARGET_BINARY_INTERFACE}x = x ]
+ then
+ echo m88k-dg-dgux${UNAME_RELEASE}
+ else
+ echo m88k-dg-dguxbcs${UNAME_RELEASE}
+ fi
+ else
+ echo i586-dg-dgux${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ M88*:DolphinOS:*:*) # DolphinOS (SVR3)
+ echo m88k-dolphin-sysv3
+ exit 0 ;;
+ M88*:*:R3*:*)
+ # Delta 88k system running SVR3
+ echo m88k-motorola-sysv3
+ exit 0 ;;
+ XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+ echo m88k-tektronix-sysv3
+ exit 0 ;;
+ Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+ echo m68k-tektronix-bsd
+ exit 0 ;;
+ *:IRIX*:*:*)
+ echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+ exit 0 ;;
+ ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+ echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
+ exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+ i*86:AIX:*:*)
+ echo i386-ibm-aix
+ exit 0 ;;
+ ia64:AIX:*:*)
+ if [ -x /usr/bin/oslevel ] ; then
+ IBM_REV=`/usr/bin/oslevel`
+ else
+ IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+ fi
+ echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}
+ exit 0 ;;
+ *:AIX:2:3)
+ if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #include <sys/systemcfg.h>
+
+ main()
+ {
+ if (!__power_pc())
+ exit(1);
+ puts("powerpc-ibm-aix3.2.5");
+ exit(0);
+ }
+EOF
+ $CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm -f $dummy.c $dummy && exit 0
+ rm -f $dummy.c $dummy
+ echo rs6000-ibm-aix3.2.5
+ elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+ echo rs6000-ibm-aix3.2.4
+ else
+ echo rs6000-ibm-aix3.2
+ fi
+ exit 0 ;;
+ *:AIX:*:[45])
+ IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+ if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then
+ IBM_ARCH=rs6000
+ else
+ IBM_ARCH=powerpc
+ fi
+ if [ -x /usr/bin/oslevel ] ; then
+ IBM_REV=`/usr/bin/oslevel`
+ else
+ IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+ fi
+ echo ${IBM_ARCH}-ibm-aix${IBM_REV}
+ exit 0 ;;
+ *:AIX:*:*)
+ echo rs6000-ibm-aix
+ exit 0 ;;
+ ibmrt:4.4BSD:*|romp-ibm:BSD:*)
+ echo romp-ibm-bsd4.4
+ exit 0 ;;
+ ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
+ echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
+ exit 0 ;; # report: romp-ibm BSD 4.3
+ *:BOSX:*:*)
+ echo rs6000-bull-bosx
+ exit 0 ;;
+ DPX/2?00:B.O.S.:*:*)
+ echo m68k-bull-sysv3
+ exit 0 ;;
+ 9000/[34]??:4.3bsd:1.*:*)
+ echo m68k-hp-bsd
+ exit 0 ;;
+ hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+ echo m68k-hp-bsd4.4
+ exit 0 ;;
+ 9000/[34678]??:HP-UX:*:*)
+ HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+ case "${UNAME_MACHINE}" in
+ 9000/31? ) HP_ARCH=m68000 ;;
+ 9000/[34]?? ) HP_ARCH=m68k ;;
+ 9000/[678][0-9][0-9])
+ if [ -x /usr/bin/getconf ]; then
+ sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
+ sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+ case "${sc_cpu_version}" in
+ 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
+ 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
+ 532) # CPU_PA_RISC2_0
+ case "${sc_kernel_bits}" in
+ 32) HP_ARCH="hppa2.0n" ;;
+ 64) HP_ARCH="hppa2.0w" ;;
+ '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20
+ esac ;;
+ esac
+ fi
+ if [ "${HP_ARCH}" = "" ]; then
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+
+ #define _HPUX_SOURCE
+ #include <stdlib.h>
+ #include <unistd.h>
+
+ int main ()
+ {
+ #if defined(_SC_KERNEL_BITS)
+ long bits = sysconf(_SC_KERNEL_BITS);
+ #endif
+ long cpu = sysconf (_SC_CPU_VERSION);
+
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+ case CPU_PA_RISC2_0:
+ #if defined(_SC_KERNEL_BITS)
+ switch (bits)
+ {
+ case 64: puts ("hppa2.0w"); break;
+ case 32: puts ("hppa2.0n"); break;
+ default: puts ("hppa2.0"); break;
+ } break;
+ #else /* !defined(_SC_KERNEL_BITS) */
+ puts ("hppa2.0"); break;
+ #endif
+ default: puts ("hppa1.0"); break;
+ }
+ exit (0);
+ }
+EOF
+ (CCOPTS= $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null) && HP_ARCH=`./$dummy`
+ if test -z "$HP_ARCH"; then HP_ARCH=hppa; fi
+ rm -f $dummy.c $dummy
+ fi ;;
+ esac
+ echo ${HP_ARCH}-hp-hpux${HPUX_REV}
+ exit 0 ;;
+ ia64:HP-UX:*:*)
+ HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+ echo ia64-hp-hpux${HPUX_REV}
+ exit 0 ;;
+ 3050*:HI-UX:*:*)
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #include <unistd.h>
+ int
+ main ()
+ {
+ long cpu = sysconf (_SC_CPU_VERSION);
+ /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+ true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
+ results, however. */
+ if (CPU_IS_PA_RISC (cpu))
+ {
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+ default: puts ("hppa-hitachi-hiuxwe2"); break;
+ }
+ }
+ else if (CPU_IS_HP_MC68K (cpu))
+ puts ("m68k-hitachi-hiuxwe2");
+ else puts ("unknown-hitachi-hiuxwe2");
+ exit (0);
+ }
+EOF
+ $CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm -f $dummy.c $dummy && exit 0
+ rm -f $dummy.c $dummy
+ echo unknown-hitachi-hiuxwe2
+ exit 0 ;;
+ 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
+ echo hppa1.1-hp-bsd
+ exit 0 ;;
+ 9000/8??:4.3bsd:*:*)
+ echo hppa1.0-hp-bsd
+ exit 0 ;;
+ *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
+ echo hppa1.0-hp-mpeix
+ exit 0 ;;
+ hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
+ echo hppa1.1-hp-osf
+ exit 0 ;;
+ hp8??:OSF1:*:*)
+ echo hppa1.0-hp-osf
+ exit 0 ;;
+ i*86:OSF1:*:*)
+ if [ -x /usr/sbin/sysversion ] ; then
+ echo ${UNAME_MACHINE}-unknown-osf1mk
+ else
+ echo ${UNAME_MACHINE}-unknown-osf1
+ fi
+ exit 0 ;;
+ parisc*:Lites*:*:*)
+ echo hppa1.1-hp-lites
+ exit 0 ;;
+ C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+ echo c1-convex-bsd
+ exit 0 ;;
+ C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit 0 ;;
+ C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+ echo c34-convex-bsd
+ exit 0 ;;
+ C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+ echo c38-convex-bsd
+ exit 0 ;;
+ C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+ echo c4-convex-bsd
+ exit 0 ;;
+ CRAY*Y-MP:*:*:*)
+ echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit 0 ;;
+ CRAY*[A-Z]90:*:*:*)
+ echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
+ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
+ -e 's/\.[^.]*$/.X/'
+ exit 0 ;;
+ CRAY*TS:*:*:*)
+ echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit 0 ;;
+ CRAY*T3D:*:*:*)
+ echo alpha-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit 0 ;;
+ CRAY*T3E:*:*:*)
+ echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit 0 ;;
+ CRAY*SV1:*:*:*)
+ echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit 0 ;;
+ F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
+ FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+ FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+ FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
+ echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+ exit 0 ;;
+ i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+ echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ sparc*:BSD/OS:*:*)
+ echo sparc-unknown-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ *:BSD/OS:*:*)
+ echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ *:FreeBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+ exit 0 ;;
+ i*:CYGWIN*:*)
+ echo ${UNAME_MACHINE}-pc-cygwin
+ exit 0 ;;
+ i*:MINGW*:*)
+ echo ${UNAME_MACHINE}-pc-mingw32
+ exit 0 ;;
+ i*:PW*:*)
+ echo ${UNAME_MACHINE}-pc-pw32
+ exit 0 ;;
+ x86:Interix*:3*)
+ echo i386-pc-interix3
+ exit 0 ;;
+ i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
+ # How do we know it's Interix rather than the generic POSIX subsystem?
+ # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
+ # UNAME_MACHINE based on the output of uname instead of i386?
+ echo i386-pc-interix
+ exit 0 ;;
+ i*:UWIN*:*)
+ echo ${UNAME_MACHINE}-pc-uwin
+ exit 0 ;;
+ p*:CYGWIN*:*)
+ echo powerpcle-unknown-cygwin
+ exit 0 ;;
+ prep*:SunOS:5.*:*)
+ echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ *:GNU:*:*)
+ echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+ exit 0 ;;
+ i*86:Minix:*:*)
+ echo ${UNAME_MACHINE}-pc-minix
+ exit 0 ;;
+ arm*:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit 0 ;;
+ ia64:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit 0 ;;
+ m68*:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit 0 ;;
+ mips:Linux:*:*)
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #undef CPU
+ #undef mips
+ #undef mipsel
+ #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+ CPU=mipsel
+ #else
+ #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+ CPU=mips
+ #else
+ CPU=
+ #endif
+ #endif
+EOF
+ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=`
+ rm -f $dummy.c
+ test x"${CPU}" != x && echo "${CPU}-pc-linux-gnu" && exit 0
+ ;;
+ ppc:Linux:*:*)
+ echo powerpc-unknown-linux-gnu
+ exit 0 ;;
+ ppc64:Linux:*:*)
+ echo powerpc64-unknown-linux-gnu
+ exit 0 ;;
+ alpha:Linux:*:*)
+ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+ EV5) UNAME_MACHINE=alphaev5 ;;
+ EV56) UNAME_MACHINE=alphaev56 ;;
+ PCA56) UNAME_MACHINE=alphapca56 ;;
+ PCA57) UNAME_MACHINE=alphapca56 ;;
+ EV6) UNAME_MACHINE=alphaev6 ;;
+ EV67) UNAME_MACHINE=alphaev67 ;;
+ EV68*) UNAME_MACHINE=alphaev68 ;;
+ esac
+ objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null
+ if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
+ echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
+ exit 0 ;;
+ parisc:Linux:*:* | hppa:Linux:*:*)
+ # Look for CPU level
+ case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+ PA7*) echo hppa1.1-unknown-linux-gnu ;;
+ PA8*) echo hppa2.0-unknown-linux-gnu ;;
+ *) echo hppa-unknown-linux-gnu ;;
+ esac
+ exit 0 ;;
+ parisc64:Linux:*:* | hppa64:Linux:*:*)
+ echo hppa64-unknown-linux-gnu
+ exit 0 ;;
+ s390:Linux:*:* | s390x:Linux:*:*)
+ echo ${UNAME_MACHINE}-ibm-linux
+ exit 0 ;;
+ sh*:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit 0 ;;
+ sparc:Linux:*:* | sparc64:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit 0 ;;
+ x86_64:Linux:*:*)
+ echo x86_64-unknown-linux-gnu
+ exit 0 ;;
+ i*86:Linux:*:*)
+ # The BFD linker knows what the default object file format is, so
+ # first see if it will tell us. cd to the root directory to prevent
+ # problems with other programs or directories called `ld' in the path.
+ # Set LC_ALL=C to ensure ld outputs messages in English.
+ ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \
+ | sed -ne '/supported targets:/!d
+ s/[ ][ ]*/ /g
+ s/.*supported targets: *//
+ s/ .*//
+ p'`
+ case "$ld_supported_targets" in
+ elf32-i386)
+ TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"
+ ;;
+ a.out-i386-linux)
+ echo "${UNAME_MACHINE}-pc-linux-gnuaout"
+ exit 0 ;;
+ coff-i386)
+ echo "${UNAME_MACHINE}-pc-linux-gnucoff"
+ exit 0 ;;
+ "")
+ # Either a pre-BFD a.out linker (linux-gnuoldld) or
+ # one that does not give us useful --help.
+ echo "${UNAME_MACHINE}-pc-linux-gnuoldld"
+ exit 0 ;;
+ esac
+ # Determine whether the default compiler is a.out or elf
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #include <features.h>
+ #ifdef __ELF__
+ # ifdef __GLIBC__
+ # if __GLIBC__ >= 2
+ LIBC=gnu
+ # else
+ LIBC=gnulibc1
+ # endif
+ # else
+ LIBC=gnulibc1
+ # endif
+ #else
+ #ifdef __INTEL_COMPILER
+ LIBC=gnu
+ #else
+ LIBC=gnuaout
+ #endif
+ #endif
+EOF
+ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=`
+ rm -f $dummy.c
+ test x"${LIBC}" != x && echo "${UNAME_MACHINE}-pc-linux-${LIBC}" && exit 0
+ test x"${TENTATIVE}" != x && echo "${TENTATIVE}" && exit 0
+ ;;
+ i*86:DYNIX/ptx:4*:*)
+ # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+ # earlier versions are messed up and put the nodename in both
+ # sysname and nodename.
+ echo i386-sequent-sysv4
+ exit 0 ;;
+ i*86:UNIX_SV:4.2MP:2.*)
+ # Unixware is an offshoot of SVR4, but it has its own version
+ # number series starting with 2...
+ # I am not positive that other SVR4 systems won't match this,
+ # I just have to hope. -- rms.
+ # Use sysv4.2uw... so that sysv4* matches it.
+ echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
+ exit 0 ;;
+ i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
+ UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}
+ else
+ echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}
+ fi
+ exit 0 ;;
+ i*86:*:5:[78]*)
+ case `/bin/uname -X | grep "^Machine"` in
+ *486*) UNAME_MACHINE=i486 ;;
+ *Pentium) UNAME_MACHINE=i586 ;;
+ *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
+ esac
+ echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
+ exit 0 ;;
+ i*86:*:3.2:*)
+ if test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+ echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
+ elif /bin/uname -X 2>/dev/null >/dev/null ; then
+ UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
+ (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \
+ && UNAME_MACHINE=i586
+ (/bin/uname -X|egrep '^Machine.*Pent ?II' >/dev/null) \
+ && UNAME_MACHINE=i686
+ (/bin/uname -X|egrep '^Machine.*Pentium Pro' >/dev/null) \
+ && UNAME_MACHINE=i686
+ echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
+ else
+ echo ${UNAME_MACHINE}-pc-sysv32
+ fi
+ exit 0 ;;
+ i*86:*DOS:*:*)
+ echo ${UNAME_MACHINE}-pc-msdosdjgpp
+ exit 0 ;;
+ pc:*:*:*)
+ # Left here for compatibility:
+ # uname -m prints for DJGPP always 'pc', but it prints nothing about
+ # the processor, so we play safe by assuming i386.
+ echo i386-pc-msdosdjgpp
+ exit 0 ;;
+ Intel:Mach:3*:*)
+ echo i386-pc-mach3
+ exit 0 ;;
+ paragon:*:*:*)
+ echo i860-intel-osf1
+ exit 0 ;;
+ i860:*:4.*:*) # i860-SVR4
+ if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+ echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
+ else # Add other i860-SVR4 vendors below as they are discovered.
+ echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4
+ fi
+ exit 0 ;;
+ mini*:CTIX:SYS*5:*)
+ # "miniframe"
+ echo m68010-convergent-sysv
+ exit 0 ;;
+ M68*:*:R3V[567]*:*)
+ test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
+ 3[34]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0)
+ OS_REL=''
+ test -r /etc/.relid \
+ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4.3${OS_REL} && exit 0
+ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+ && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;;
+ 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4 && exit 0 ;;
+ m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
+ echo m68k-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ mc68030:UNIX_System_V:4.*:*)
+ echo m68k-atari-sysv4
+ exit 0 ;;
+ i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)
+ echo i386-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ TSUNAMI:LynxOS:2.*:*)
+ echo sparc-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ rs6000:LynxOS:2.*:*)
+ echo rs6000-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)
+ echo powerpc-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ SM[BE]S:UNIX_SV:*:*)
+ echo mips-dde-sysv${UNAME_RELEASE}
+ exit 0 ;;
+ RM*:ReliantUNIX-*:*:*)
+ echo mips-sni-sysv4
+ exit 0 ;;
+ RM*:SINIX-*:*:*)
+ echo mips-sni-sysv4
+ exit 0 ;;
+ *:SINIX-*:*:*)
+ if uname -p 2>/dev/null >/dev/null ; then
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ echo ${UNAME_MACHINE}-sni-sysv4
+ else
+ echo ns32k-sni-sysv
+ fi
+ exit 0 ;;
+ PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+ # says <Richard.M.Bartel@ccMail.Census.GOV>
+ echo i586-unisys-sysv4
+ exit 0 ;;
+ *:UNIX_System_V:4*:FTX*)
+ # From Gerald Hewes <hewes@openmarket.com>.
+ # How about differentiating between stratus architectures? -djm
+ echo hppa1.1-stratus-sysv4
+ exit 0 ;;
+ *:*:*:FTX*)
+ # From seanf@swdc.stratus.com.
+ echo i860-stratus-sysv4
+ exit 0 ;;
+ *:VOS:*:*)
+ # From Paul.Green@stratus.com.
+ echo hppa1.1-stratus-vos
+ exit 0 ;;
+ mc68*:A/UX:*:*)
+ echo m68k-apple-aux${UNAME_RELEASE}
+ exit 0 ;;
+ news*:NEWS-OS:6*:*)
+ echo mips-sony-newsos6
+ exit 0 ;;
+ R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+ if [ -d /usr/nec ]; then
+ echo mips-nec-sysv${UNAME_RELEASE}
+ else
+ echo mips-unknown-sysv${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
+ echo powerpc-be-beos
+ exit 0 ;;
+ BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
+ echo powerpc-apple-beos
+ exit 0 ;;
+ BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
+ echo i586-pc-beos
+ exit 0 ;;
+ SX-4:SUPER-UX:*:*)
+ echo sx4-nec-superux${UNAME_RELEASE}
+ exit 0 ;;
+ SX-5:SUPER-UX:*:*)
+ echo sx5-nec-superux${UNAME_RELEASE}
+ exit 0 ;;
+ Power*:Rhapsody:*:*)
+ echo powerpc-apple-rhapsody${UNAME_RELEASE}
+ exit 0 ;;
+ *:Rhapsody:*:*)
+ echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
+ exit 0 ;;
+ *:Darwin:*:*)
+ echo `uname -p`-apple-darwin${UNAME_RELEASE}
+ exit 0 ;;
+ *:procnto*:*:* | *:QNX:[0123456789]*:*)
+ UNAME_PROCESSOR=`uname -p`
+ if test "$UNAME_PROCESSOR" = "x86"; then
+ UNAME_PROCESSOR=i386
+ UNAME_MACHINE=pc
+ fi
+ echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
+ exit 0 ;;
+ *:QNX:*:4*)
+ echo i386-pc-qnx
+ exit 0 ;;
+ NSR-[GKLNPTVW]:NONSTOP_KERNEL:*:*)
+ echo nsr-tandem-nsk${UNAME_RELEASE}
+ exit 0 ;;
+ *:NonStop-UX:*:*)
+ echo mips-compaq-nonstopux
+ exit 0 ;;
+ BS2000:POSIX*:*:*)
+ echo bs2000-siemens-sysv
+ exit 0 ;;
+ DS/*:UNIX_System_V:*:*)
+ echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
+ exit 0 ;;
+ *:Plan9:*:*)
+ # "uname -m" is not consistent, so use $cputype instead. 386
+ # is converted to i386 for consistency with other x86
+ # operating systems.
+ if test "$cputype" = "386"; then
+ UNAME_MACHINE=i386
+ else
+ UNAME_MACHINE="$cputype"
+ fi
+ echo ${UNAME_MACHINE}-unknown-plan9
+ exit 0 ;;
+ i*86:OS/2:*:*)
+ # If we were able to find `uname', then EMX Unix compatibility
+ # is probably installed.
+ echo ${UNAME_MACHINE}-pc-os2-emx
+ exit 0 ;;
+ *:TOPS-10:*:*)
+ echo pdp10-unknown-tops10
+ exit 0 ;;
+ *:TENEX:*:*)
+ echo pdp10-unknown-tenex
+ exit 0 ;;
+ KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
+ echo pdp10-dec-tops20
+ exit 0 ;;
+ XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
+ echo pdp10-xkl-tops20
+ exit 0 ;;
+ *:TOPS-20:*:*)
+ echo pdp10-unknown-tops20
+ exit 0 ;;
+ *:ITS:*:*)
+ echo pdp10-unknown-its
+ exit 0 ;;
+ i*86:XTS-300:*:STOP)
+ echo ${UNAME_MACHINE}-unknown-stop
+ exit 0 ;;
+ i*86:atheos:*:*)
+ echo ${UNAME_MACHINE}-unknown-atheos
+ exit 0 ;;
+esac
+
+#echo '(No uname command or uname output not recognized.)' 1>&2
+#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
+
+eval $set_cc_for_build
+cat >$dummy.c <<EOF
+#ifdef _SEQUENT_
+# include <sys/types.h>
+# include <sys/utsname.h>
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+ /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
+ I don't know.... */
+ printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include <sys/param.h>
+ printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+ "4"
+#else
+ ""
+#endif
+ ); exit (0);
+#endif
+#endif
+
+#if defined (__arm) && defined (__acorn) && defined (__unix)
+ printf ("arm-acorn-riscix"); exit (0);
+#endif
+
+#if defined (hp300) && !defined (hpux)
+ printf ("m68k-hp-bsd\n"); exit (0);
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ if (version < 4)
+ printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+ else
+ printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+ exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+ printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+ printf ("ns32k-encore-mach\n"); exit (0);
+#else
+ printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+ printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+ printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+ printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+ struct utsname un;
+
+ uname(&un);
+
+ if (strncmp(un.version, "V2", 2) == 0) {
+ printf ("i386-sequent-ptx2\n"); exit (0);
+ }
+ if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+ printf ("i386-sequent-ptx1\n"); exit (0);
+ }
+ printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+# if !defined (ultrix)
+# include <sys/param.h>
+# if defined (BSD)
+# if BSD == 43
+ printf ("vax-dec-bsd4.3\n"); exit (0);
+# else
+# if BSD == 199006
+ printf ("vax-dec-bsd4.3reno\n"); exit (0);
+# else
+ printf ("vax-dec-bsd\n"); exit (0);
+# endif
+# endif
+# else
+ printf ("vax-dec-bsd\n"); exit (0);
+# endif
+# else
+ printf ("vax-dec-ultrix\n"); exit (0);
+# endif
+#endif
+
+#if defined (alliant) && defined (i860)
+ printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+ exit (1);
+}
+EOF
+
+$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy && rm -f $dummy.c $dummy && exit 0
+rm -f $dummy.c $dummy
+
+# Apollos put the system type in the environment.
+
+test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; }
+
+# Convex versions that predate uname can use getsysinfo(1)
+
+if [ -x /usr/convex/getsysinfo ]
+then
+ case `getsysinfo -f cpu_type` in
+ c1*)
+ echo c1-convex-bsd
+ exit 0 ;;
+ c2*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit 0 ;;
+ c34*)
+ echo c34-convex-bsd
+ exit 0 ;;
+ c38*)
+ echo c38-convex-bsd
+ exit 0 ;;
+ c4*)
+ echo c4-convex-bsd
+ exit 0 ;;
+ esac
+fi
+
+cat >&2 <<EOF
+$0: unable to guess system type
+
+This script, last modified $timestamp, has failed to recognize
+the operating system you are using. It is advised that you
+download the most up to date version of the config scripts from
+
+ ftp://ftp.gnu.org/pub/gnu/config/
+
+If the version you run ($0) is already up to date, please
+send the following data and any information you think might be
+pertinent to <config-patches@gnu.org> in order to provide the needed
+information to handle your system.
+
+config.guess timestamp = $timestamp
+
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null`
+
+hostinfo = `(hostinfo) 2>/dev/null`
+/bin/universe = `(/bin/universe) 2>/dev/null`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null`
+/bin/arch = `(/bin/arch) 2>/dev/null`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+
+UNAME_MACHINE = ${UNAME_MACHINE}
+UNAME_RELEASE = ${UNAME_RELEASE}
+UNAME_SYSTEM = ${UNAME_SYSTEM}
+UNAME_VERSION = ${UNAME_VERSION}
+EOF
+
+exit 1
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
--- /dev/null
+#! /bin/sh
+# Configuration validation subroutine script.
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+# 2000, 2001, 2002 Free Software Foundation, Inc.
+
+timestamp='2002-03-07'
+
+# This file is (in principle) common to ALL GNU software.
+# The presence of a machine in this file suggests that SOME GNU software
+# can handle that machine. It does not imply ALL GNU software can.
+#
+# 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Please send patches to <config-patches@gnu.org>. Submit a context
+# diff and a properly formatted ChangeLog entry.
+#
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support. The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION] CPU-MFR-OPSYS
+ $0 [OPTION] ALIAS
+
+Canonicalize a configuration name.
+
+Operation modes:
+ -h, --help print this help, then exit
+ -t, --time-stamp print date of last modification, then exit
+ -v, --version print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.sub ($timestamp)
+
+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
+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."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+ case $1 in
+ --time-stamp | --time* | -t )
+ echo "$timestamp" ; exit 0 ;;
+ --version | -v )
+ echo "$version" ; exit 0 ;;
+ --help | --h* | -h )
+ echo "$usage"; exit 0 ;;
+ -- ) # Stop option processing
+ shift; break ;;
+ - ) # Use stdin as input.
+ break ;;
+ -* )
+ echo "$me: invalid option $1$help"
+ exit 1 ;;
+
+ *local*)
+ # First pass through any local machine types.
+ echo $1
+ exit 0;;
+
+ * )
+ break ;;
+ esac
+done
+
+case $# in
+ 0) echo "$me: missing argument$help" >&2
+ exit 1;;
+ 1) ;;
+ *) echo "$me: too many arguments$help" >&2
+ exit 1;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
+# Here we must recognize all the valid KERNEL-OS combinations.
+maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+case $maybe_os in
+ nto-qnx* | linux-gnu* | storm-chaos* | os2-emx* | windows32-* | rtmk-nova*)
+ os=-$maybe_os
+ basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+ ;;
+ *)
+ basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+ if [ $basic_machine != $1 ]
+ then os=`echo $1 | sed 's/.*-/-/'`
+ else os=; fi
+ ;;
+esac
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work. We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+ -sun*os*)
+ # Prevent following clause from handling this invalid input.
+ ;;
+ -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+ -apple | -axis)
+ os=
+ basic_machine=$1
+ ;;
+ -sim | -cisco | -oki | -wec | -winbond)
+ os=
+ basic_machine=$1
+ ;;
+ -scout)
+ ;;
+ -wrs)
+ os=-vxworks
+ basic_machine=$1
+ ;;
+ -chorusos*)
+ os=-chorusos
+ basic_machine=$1
+ ;;
+ -chorusrdb)
+ os=-chorusrdb
+ basic_machine=$1
+ ;;
+ -hiux*)
+ os=-hiuxwe2
+ ;;
+ -sco5)
+ os=-sco3.2v5
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco4)
+ os=-sco3.2v4
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco3.2.[4-9]*)
+ os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco3.2v[4-9]*)
+ # Don't forget version if it is 3.2v4 or newer.
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco*)
+ os=-sco3.2v2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -udk*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -isc)
+ os=-isc2.2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -clix*)
+ basic_machine=clipper-intergraph
+ ;;
+ -isc*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -lynx*)
+ os=-lynxos
+ ;;
+ -ptx*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+ ;;
+ -windowsnt*)
+ os=`echo $os | sed -e 's/windowsnt/winnt/'`
+ ;;
+ -psos*)
+ os=-psos
+ ;;
+ -mint | -mint[0-9]*)
+ basic_machine=m68k-atari
+ os=-mint
+ ;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+ # Recognize the basic CPU types without company name.
+ # Some are omitted here because they have special meanings below.
+ 1750a | 580 \
+ | a29k \
+ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
+ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
+ | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \
+ | c4x | clipper \
+ | d10v | d30v | dsp16xx \
+ | fr30 \
+ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+ | i370 | i860 | i960 | ia64 \
+ | m32r | m68000 | m68k | m88k | mcore \
+ | mips | mips16 | mips64 | mips64el | mips64orion | mips64orionel \
+ | mips64vr4100 | mips64vr4100el | mips64vr4300 \
+ | mips64vr4300el | mips64vr5000 | mips64vr5000el \
+ | mipsbe | mipseb | mipsel | mipsle | mipstx39 | mipstx39el \
+ | mipsisa32 | mipsisa64 \
+ | mn10200 | mn10300 \
+ | ns16k | ns32k \
+ | openrisc | or32 \
+ | pdp10 | pdp11 | pj | pjl \
+ | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
+ | pyramid \
+ | sh | sh[34] | sh[34]eb | shbe | shle | sh64 \
+ | sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \
+ | strongarm \
+ | tahoe | thumb | tic80 | tron \
+ | v850 | v850e \
+ | we32k \
+ | x86 | xscale | xstormy16 | xtensa \
+ | z8k)
+ basic_machine=$basic_machine-unknown
+ ;;
+ m6811 | m68hc11 | m6812 | m68hc12)
+ # Motorola 68HC11/12.
+ basic_machine=$basic_machine-unknown
+ os=-none
+ ;;
+ m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
+ ;;
+
+ # We use `pc' rather than `unknown'
+ # because (1) that's what they normally are, and
+ # (2) the word "unknown" tends to confuse beginning users.
+ i*86 | x86_64)
+ basic_machine=$basic_machine-pc
+ ;;
+ # Object if more than one company name word.
+ *-*-*)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+ # Recognize the basic CPU types with company name.
+ 580-* \
+ | a29k-* \
+ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
+ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
+ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
+ | arm-* | armbe-* | armle-* | armv*-* \
+ | avr-* \
+ | bs2000-* \
+ | c[123]* | c30-* | [cjt]90-* | c54x-* \
+ | clipper-* | cydra-* \
+ | d10v-* | d30v-* \
+ | elxsi-* \
+ | f30[01]-* | f700-* | fr30-* | fx80-* \
+ | h8300-* | h8500-* \
+ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+ | i*86-* | i860-* | i960-* | ia64-* \
+ | m32r-* \
+ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
+ | m88110-* | m88k-* | mcore-* \
+ | mips-* | mips16-* | mips64-* | mips64el-* | mips64orion-* \
+ | mips64orionel-* | mips64vr4100-* | mips64vr4100el-* \
+ | mips64vr4300-* | mips64vr4300el-* | mipsbe-* | mipseb-* \
+ | mipsle-* | mipsel-* | mipstx39-* | mipstx39el-* \
+ | none-* | np1-* | ns16k-* | ns32k-* \
+ | orion-* \
+ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
+ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
+ | pyramid-* \
+ | romp-* | rs6000-* \
+ | sh-* | sh[34]-* | sh[34]eb-* | shbe-* | shle-* | sh64-* \
+ | sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \
+ | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \
+ | tahoe-* | thumb-* | tic30-* | tic54x-* | tic80-* | tron-* \
+ | v850-* | v850e-* | vax-* \
+ | we32k-* \
+ | x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \
+ | xtensa-* \
+ | ymp-* \
+ | z8k-*)
+ ;;
+ # Recognize the various machine names and aliases which stand
+ # for a CPU type and a company and sometimes even an OS.
+ 386bsd)
+ basic_machine=i386-unknown
+ os=-bsd
+ ;;
+ 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+ basic_machine=m68000-att
+ ;;
+ 3b*)
+ basic_machine=we32k-att
+ ;;
+ a29khif)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ adobe68k)
+ basic_machine=m68010-adobe
+ os=-scout
+ ;;
+ alliant | fx80)
+ basic_machine=fx80-alliant
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ ;;
+ am29k)
+ basic_machine=a29k-none
+ os=-bsd
+ ;;
+ amdahl)
+ basic_machine=580-amdahl
+ os=-sysv
+ ;;
+ amiga | amiga-*)
+ basic_machine=m68k-unknown
+ ;;
+ amigaos | amigados)
+ basic_machine=m68k-unknown
+ os=-amigaos
+ ;;
+ amigaunix | amix)
+ basic_machine=m68k-unknown
+ os=-sysv4
+ ;;
+ apollo68)
+ basic_machine=m68k-apollo
+ os=-sysv
+ ;;
+ apollo68bsd)
+ basic_machine=m68k-apollo
+ os=-bsd
+ ;;
+ aux)
+ basic_machine=m68k-apple
+ os=-aux
+ ;;
+ balance)
+ basic_machine=ns32k-sequent
+ os=-dynix
+ ;;
+ c90)
+ basic_machine=c90-cray
+ os=-unicos
+ ;;
+ convex-c1)
+ basic_machine=c1-convex
+ os=-bsd
+ ;;
+ convex-c2)
+ basic_machine=c2-convex
+ os=-bsd
+ ;;
+ convex-c32)
+ basic_machine=c32-convex
+ os=-bsd
+ ;;
+ convex-c34)
+ basic_machine=c34-convex
+ os=-bsd
+ ;;
+ convex-c38)
+ basic_machine=c38-convex
+ os=-bsd
+ ;;
+ cray | j90)
+ basic_machine=j90-cray
+ os=-unicos
+ ;;
+ crds | unos)
+ basic_machine=m68k-crds
+ ;;
+ cris | cris-* | etrax*)
+ basic_machine=cris-axis
+ ;;
+ da30 | da30-*)
+ basic_machine=m68k-da30
+ ;;
+ decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ ;;
+ decsystem10* | dec10*)
+ basic_machine=pdp10-dec
+ os=-tops10
+ ;;
+ decsystem20* | dec20*)
+ basic_machine=pdp10-dec
+ os=-tops20
+ ;;
+ delta | 3300 | motorola-3300 | motorola-delta \
+ | 3300-motorola | delta-motorola)
+ basic_machine=m68k-motorola
+ ;;
+ delta88)
+ basic_machine=m88k-motorola
+ os=-sysv3
+ ;;
+ dpx20 | dpx20-*)
+ basic_machine=rs6000-bull
+ os=-bosx
+ ;;
+ dpx2* | dpx2*-bull)
+ basic_machine=m68k-bull
+ os=-sysv3
+ ;;
+ ebmon29k)
+ basic_machine=a29k-amd
+ os=-ebmon
+ ;;
+ elxsi)
+ basic_machine=elxsi-elxsi
+ os=-bsd
+ ;;
+ encore | umax | mmax)
+ basic_machine=ns32k-encore
+ ;;
+ es1800 | OSE68k | ose68k | ose | OSE)
+ basic_machine=m68k-ericsson
+ os=-ose
+ ;;
+ fx2800)
+ basic_machine=i860-alliant
+ ;;
+ genix)
+ basic_machine=ns32k-ns
+ ;;
+ gmicro)
+ basic_machine=tron-gmicro
+ os=-sysv
+ ;;
+ go32)
+ basic_machine=i386-pc
+ os=-go32
+ ;;
+ h3050r* | hiux*)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ h8300hms)
+ basic_machine=h8300-hitachi
+ os=-hms
+ ;;
+ h8300xray)
+ basic_machine=h8300-hitachi
+ os=-xray
+ ;;
+ h8500hms)
+ basic_machine=h8500-hitachi
+ os=-hms
+ ;;
+ harris)
+ basic_machine=m88k-harris
+ os=-sysv3
+ ;;
+ hp300-*)
+ basic_machine=m68k-hp
+ ;;
+ hp300bsd)
+ basic_machine=m68k-hp
+ os=-bsd
+ ;;
+ hp300hpux)
+ basic_machine=m68k-hp
+ os=-hpux
+ ;;
+ hp3k9[0-9][0-9] | hp9[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hp9k2[0-9][0-9] | hp9k31[0-9])
+ basic_machine=m68000-hp
+ ;;
+ hp9k3[2-9][0-9])
+ basic_machine=m68k-hp
+ ;;
+ hp9k6[0-9][0-9] | hp6[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hp9k7[0-79][0-9] | hp7[0-79][0-9])
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k78[0-9] | hp78[0-9])
+ # FIXME: really hppa2.0-hp
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+ # FIXME: really hppa2.0-hp
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[0-9][13679] | hp8[0-9][13679])
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[0-9][0-9] | hp8[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hppa-next)
+ os=-nextstep3
+ ;;
+ hppaosf)
+ basic_machine=hppa1.1-hp
+ os=-osf
+ ;;
+ hppro)
+ basic_machine=hppa1.1-hp
+ os=-proelf
+ ;;
+ i370-ibm* | ibm*)
+ basic_machine=i370-ibm
+ ;;
+# I'm not sure what "Sysv32" means. Should this be sysv3.2?
+ i*86v32)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv32
+ ;;
+ i*86v4*)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv4
+ ;;
+ i*86v)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv
+ ;;
+ i*86sol2)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-solaris2
+ ;;
+ i386mach)
+ basic_machine=i386-mach
+ os=-mach
+ ;;
+ i386-vsta | vsta)
+ basic_machine=i386-unknown
+ os=-vsta
+ ;;
+ iris | iris4d)
+ basic_machine=mips-sgi
+ case $os in
+ -irix*)
+ ;;
+ *)
+ os=-irix4
+ ;;
+ esac
+ ;;
+ isi68 | isi)
+ basic_machine=m68k-isi
+ os=-sysv
+ ;;
+ m88k-omron*)
+ basic_machine=m88k-omron
+ ;;
+ magnum | m3230)
+ basic_machine=mips-mips
+ os=-sysv
+ ;;
+ merlin)
+ basic_machine=ns32k-utek
+ os=-sysv
+ ;;
+ mingw32)
+ basic_machine=i386-pc
+ os=-mingw32
+ ;;
+ miniframe)
+ basic_machine=m68000-convergent
+ ;;
+ *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
+ basic_machine=m68k-atari
+ os=-mint
+ ;;
+ mips3*-*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
+ ;;
+ mips3*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
+ ;;
+ mmix*)
+ basic_machine=mmix-knuth
+ os=-mmixware
+ ;;
+ monitor)
+ basic_machine=m68k-rom68k
+ os=-coff
+ ;;
+ morphos)
+ basic_machine=powerpc-unknown
+ os=-morphos
+ ;;
+ msdos)
+ basic_machine=i386-pc
+ os=-msdos
+ ;;
+ mvs)
+ basic_machine=i370-ibm
+ os=-mvs
+ ;;
+ ncr3000)
+ basic_machine=i486-ncr
+ os=-sysv4
+ ;;
+ netbsd386)
+ basic_machine=i386-unknown
+ os=-netbsd
+ ;;
+ netwinder)
+ basic_machine=armv4l-rebel
+ os=-linux
+ ;;
+ news | news700 | news800 | news900)
+ basic_machine=m68k-sony
+ os=-newsos
+ ;;
+ news1000)
+ basic_machine=m68030-sony
+ os=-newsos
+ ;;
+ news-3600 | risc-news)
+ basic_machine=mips-sony
+ os=-newsos
+ ;;
+ necv70)
+ basic_machine=v70-nec
+ os=-sysv
+ ;;
+ next | m*-next )
+ basic_machine=m68k-next
+ case $os in
+ -nextstep* )
+ ;;
+ -ns2*)
+ os=-nextstep2
+ ;;
+ *)
+ os=-nextstep3
+ ;;
+ esac
+ ;;
+ nh3000)
+ basic_machine=m68k-harris
+ os=-cxux
+ ;;
+ nh[45]000)
+ basic_machine=m88k-harris
+ os=-cxux
+ ;;
+ nindy960)
+ basic_machine=i960-intel
+ os=-nindy
+ ;;
+ mon960)
+ basic_machine=i960-intel
+ os=-mon960
+ ;;
+ nonstopux)
+ basic_machine=mips-compaq
+ os=-nonstopux
+ ;;
+ np1)
+ basic_machine=np1-gould
+ ;;
+ nsr-tandem)
+ basic_machine=nsr-tandem
+ ;;
+ op50n-* | op60c-*)
+ basic_machine=hppa1.1-oki
+ os=-proelf
+ ;;
+ or32 | or32-*)
+ basic_machine=or32-unknown
+ os=-coff
+ ;;
+ OSE68000 | ose68000)
+ basic_machine=m68000-ericsson
+ os=-ose
+ ;;
+ os68k)
+ basic_machine=m68k-none
+ os=-os68k
+ ;;
+ pa-hitachi)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ paragon)
+ basic_machine=i860-intel
+ os=-osf
+ ;;
+ pbd)
+ basic_machine=sparc-tti
+ ;;
+ pbb)
+ basic_machine=m68k-tti
+ ;;
+ pc532 | pc532-*)
+ basic_machine=ns32k-pc532
+ ;;
+ pentium | p5 | k5 | k6 | nexgen | viac3)
+ basic_machine=i586-pc
+ ;;
+ pentiumpro | p6 | 6x86 | athlon)
+ basic_machine=i686-pc
+ ;;
+ pentiumii | pentium2)
+ basic_machine=i686-pc
+ ;;
+ pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
+ basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pentiumpro-* | p6-* | 6x86-* | athlon-*)
+ basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pentiumii-* | pentium2-*)
+ basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pn)
+ basic_machine=pn-gould
+ ;;
+ power) basic_machine=power-ibm
+ ;;
+ ppc) basic_machine=powerpc-unknown
+ ;;
+ ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ppcle | powerpclittle | ppc-le | powerpc-little)
+ basic_machine=powerpcle-unknown
+ ;;
+ ppcle-* | powerpclittle-*)
+ basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ppc64) basic_machine=powerpc64-unknown
+ ;;
+ ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ppc64le | powerpc64little | ppc64-le | powerpc64-little)
+ basic_machine=powerpc64le-unknown
+ ;;
+ ppc64le-* | powerpc64little-*)
+ basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ps2)
+ basic_machine=i386-ibm
+ ;;
+ pw32)
+ basic_machine=i586-unknown
+ os=-pw32
+ ;;
+ rom68k)
+ basic_machine=m68k-rom68k
+ os=-coff
+ ;;
+ rm[46]00)
+ basic_machine=mips-siemens
+ ;;
+ rtpc | rtpc-*)
+ basic_machine=romp-ibm
+ ;;
+ s390 | s390-*)
+ basic_machine=s390-ibm
+ ;;
+ s390x | s390x-*)
+ basic_machine=s390x-ibm
+ ;;
+ sa29200)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ sequent)
+ basic_machine=i386-sequent
+ ;;
+ sh)
+ basic_machine=sh-hitachi
+ os=-hms
+ ;;
+ sparclite-wrs | simso-wrs)
+ basic_machine=sparclite-wrs
+ os=-vxworks
+ ;;
+ sps7)
+ basic_machine=m68k-bull
+ os=-sysv2
+ ;;
+ spur)
+ basic_machine=spur-unknown
+ ;;
+ st2000)
+ basic_machine=m68k-tandem
+ ;;
+ stratus)
+ basic_machine=i860-stratus
+ os=-sysv4
+ ;;
+ sun2)
+ basic_machine=m68000-sun
+ ;;
+ sun2os3)
+ basic_machine=m68000-sun
+ os=-sunos3
+ ;;
+ sun2os4)
+ basic_machine=m68000-sun
+ os=-sunos4
+ ;;
+ sun3os3)
+ basic_machine=m68k-sun
+ os=-sunos3
+ ;;
+ sun3os4)
+ basic_machine=m68k-sun
+ os=-sunos4
+ ;;
+ sun4os3)
+ basic_machine=sparc-sun
+ os=-sunos3
+ ;;
+ sun4os4)
+ basic_machine=sparc-sun
+ os=-sunos4
+ ;;
+ sun4sol2)
+ basic_machine=sparc-sun
+ os=-solaris2
+ ;;
+ sun3 | sun3-*)
+ basic_machine=m68k-sun
+ ;;
+ sun4)
+ basic_machine=sparc-sun
+ ;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ ;;
+ sv1)
+ basic_machine=sv1-cray
+ os=-unicos
+ ;;
+ symmetry)
+ basic_machine=i386-sequent
+ os=-dynix
+ ;;
+ t3d)
+ basic_machine=alpha-cray
+ os=-unicos
+ ;;
+ t3e)
+ basic_machine=alphaev5-cray
+ os=-unicos
+ ;;
+ t90)
+ basic_machine=t90-cray
+ os=-unicos
+ ;;
+ tic54x | c54x*)
+ basic_machine=tic54x-unknown
+ os=-coff
+ ;;
+ tx39)
+ basic_machine=mipstx39-unknown
+ ;;
+ tx39el)
+ basic_machine=mipstx39el-unknown
+ ;;
+ toad1)
+ basic_machine=pdp10-xkl
+ os=-tops20
+ ;;
+ tower | tower-32)
+ basic_machine=m68k-ncr
+ ;;
+ udi29k)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ ultra3)
+ basic_machine=a29k-nyu
+ os=-sym1
+ ;;
+ v810 | necv810)
+ basic_machine=v810-nec
+ os=-none
+ ;;
+ vaxv)
+ basic_machine=vax-dec
+ os=-sysv
+ ;;
+ vms)
+ basic_machine=vax-dec
+ os=-vms
+ ;;
+ vpp*|vx|vx-*)
+ basic_machine=f301-fujitsu
+ ;;
+ vxworks960)
+ basic_machine=i960-wrs
+ os=-vxworks
+ ;;
+ vxworks68)
+ basic_machine=m68k-wrs
+ os=-vxworks
+ ;;
+ vxworks29k)
+ basic_machine=a29k-wrs
+ os=-vxworks
+ ;;
+ w65*)
+ basic_machine=w65-wdc
+ os=-none
+ ;;
+ w89k-*)
+ basic_machine=hppa1.1-winbond
+ os=-proelf
+ ;;
+ windows32)
+ basic_machine=i386-pc
+ os=-windows32-msvcrt
+ ;;
+ xps | xps100)
+ basic_machine=xps100-honeywell
+ ;;
+ ymp)
+ basic_machine=ymp-cray
+ os=-unicos
+ ;;
+ z8k-*-coff)
+ basic_machine=z8k-unknown
+ os=-sim
+ ;;
+ none)
+ basic_machine=none-none
+ os=-none
+ ;;
+
+# Here we handle the default manufacturer of certain CPU types. It is in
+# some cases the only manufacturer, in others, it is the most popular.
+ w89k)
+ basic_machine=hppa1.1-winbond
+ ;;
+ op50n)
+ basic_machine=hppa1.1-oki
+ ;;
+ op60c)
+ basic_machine=hppa1.1-oki
+ ;;
+ romp)
+ basic_machine=romp-ibm
+ ;;
+ rs6000)
+ basic_machine=rs6000-ibm
+ ;;
+ vax)
+ basic_machine=vax-dec
+ ;;
+ pdp10)
+ # there are many clones, so DEC is not a safe bet
+ basic_machine=pdp10-unknown
+ ;;
+ pdp11)
+ basic_machine=pdp11-dec
+ ;;
+ we32k)
+ basic_machine=we32k-att
+ ;;
+ sh3 | sh4 | sh3eb | sh4eb)
+ basic_machine=sh-unknown
+ ;;
+ sh64)
+ basic_machine=sh64-unknown
+ ;;
+ sparc | sparcv9 | sparcv9b)
+ basic_machine=sparc-sun
+ ;;
+ cydra)
+ basic_machine=cydra-cydrome
+ ;;
+ orion)
+ basic_machine=orion-highlevel
+ ;;
+ orion105)
+ basic_machine=clipper-highlevel
+ ;;
+ mac | mpw | mac-mpw)
+ basic_machine=m68k-apple
+ ;;
+ pmac | pmac-mpw)
+ basic_machine=powerpc-apple
+ ;;
+ c4x*)
+ basic_machine=c4x-none
+ os=-coff
+ ;;
+ *-unknown)
+ # Make sure to match an already-canonicalized machine name.
+ ;;
+ *)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+ *-digital*)
+ basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
+ ;;
+ *-commodore*)
+ basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
+ ;;
+ *)
+ ;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+ # First match some system type aliases
+ # that might get confused with valid system types.
+ # -solaris* is a basic system type, with this one exception.
+ -solaris1 | -solaris1.*)
+ os=`echo $os | sed -e 's|solaris1|sunos4|'`
+ ;;
+ -solaris)
+ os=-solaris2
+ ;;
+ -svr4*)
+ os=-sysv4
+ ;;
+ -unixware*)
+ os=-sysv4.2uw
+ ;;
+ -gnu/linux*)
+ os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+ ;;
+ # First accept the basic system types.
+ # The portable systems comes first.
+ # Each alternative MUST END IN A *, to match a version number.
+ # -sysv* is not here because it comes later, after sysvr4.
+ -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
+ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
+ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+ | -aos* \
+ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+ | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \
+ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
+ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+ | -chorusos* | -chorusrdb* \
+ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+ | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \
+ | -interix* | -uwin* | -rhapsody* | -darwin* | -opened* \
+ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
+ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
+ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
+ | -morphos* | -superux* | -rtmk* | -rtmk-nova*)
+ # Remember, each alternative MUST END IN *, to match a version number.
+ ;;
+ -qnx*)
+ case $basic_machine in
+ x86-* | i*86-*)
+ ;;
+ *)
+ os=-nto$os
+ ;;
+ esac
+ ;;
+ -nto*)
+ os=-nto-qnx
+ ;;
+ -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+ | -windows* | -osx | -abug | -netware* | -os9* | -beos* \
+ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+ ;;
+ -mac*)
+ os=`echo $os | sed -e 's|mac|macos|'`
+ ;;
+ -linux*)
+ os=`echo $os | sed -e 's|linux|linux-gnu|'`
+ ;;
+ -sunos5*)
+ os=`echo $os | sed -e 's|sunos5|solaris2|'`
+ ;;
+ -sunos6*)
+ os=`echo $os | sed -e 's|sunos6|solaris3|'`
+ ;;
+ -opened*)
+ os=-openedition
+ ;;
+ -wince*)
+ os=-wince
+ ;;
+ -osfrose*)
+ os=-osfrose
+ ;;
+ -osf*)
+ os=-osf
+ ;;
+ -utek*)
+ os=-bsd
+ ;;
+ -dynix*)
+ os=-bsd
+ ;;
+ -acis*)
+ os=-aos
+ ;;
+ -atheos*)
+ os=-atheos
+ ;;
+ -386bsd)
+ os=-bsd
+ ;;
+ -ctix* | -uts*)
+ os=-sysv
+ ;;
+ -nova*)
+ os=-rtmk-nova
+ ;;
+ -ns2 )
+ os=-nextstep2
+ ;;
+ -nsk*)
+ os=-nsk
+ ;;
+ # Preserve the version number of sinix5.
+ -sinix5.*)
+ os=`echo $os | sed -e 's|sinix|sysv|'`
+ ;;
+ -sinix*)
+ os=-sysv4
+ ;;
+ -triton*)
+ os=-sysv3
+ ;;
+ -oss*)
+ os=-sysv3
+ ;;
+ -svr4)
+ os=-sysv4
+ ;;
+ -svr3)
+ os=-sysv3
+ ;;
+ -sysvr4)
+ os=-sysv4
+ ;;
+ # This must come after -sysvr4.
+ -sysv*)
+ ;;
+ -ose*)
+ os=-ose
+ ;;
+ -es1800*)
+ os=-ose
+ ;;
+ -xenix)
+ os=-xenix
+ ;;
+ -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+ os=-mint
+ ;;
+ -none)
+ ;;
+ *)
+ # Get rid of the `-' at the beginning of $os.
+ os=`echo $os | sed 's/[^-]*-//'`
+ echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system. Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+ *-acorn)
+ os=-riscix1.2
+ ;;
+ arm*-rebel)
+ os=-linux
+ ;;
+ arm*-semi)
+ os=-aout
+ ;;
+ # This must come before the *-dec entry.
+ pdp10-*)
+ os=-tops20
+ ;;
+ pdp11-*)
+ os=-none
+ ;;
+ *-dec | vax-*)
+ os=-ultrix4.2
+ ;;
+ m68*-apollo)
+ os=-domain
+ ;;
+ i386-sun)
+ os=-sunos4.0.2
+ ;;
+ m68000-sun)
+ os=-sunos3
+ # This also exists in the configure program, but was not the
+ # default.
+ # os=-sunos4
+ ;;
+ m68*-cisco)
+ os=-aout
+ ;;
+ mips*-cisco)
+ os=-elf
+ ;;
+ mips*-*)
+ os=-elf
+ ;;
+ or32-*)
+ os=-coff
+ ;;
+ *-tti) # must be before sparc entry or we get the wrong os.
+ os=-sysv3
+ ;;
+ sparc-* | *-sun)
+ os=-sunos4.1.1
+ ;;
+ *-be)
+ os=-beos
+ ;;
+ *-ibm)
+ os=-aix
+ ;;
+ *-wec)
+ os=-proelf
+ ;;
+ *-winbond)
+ os=-proelf
+ ;;
+ *-oki)
+ os=-proelf
+ ;;
+ *-hp)
+ os=-hpux
+ ;;
+ *-hitachi)
+ os=-hiux
+ ;;
+ i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+ os=-sysv
+ ;;
+ *-cbm)
+ os=-amigaos
+ ;;
+ *-dg)
+ os=-dgux
+ ;;
+ *-dolphin)
+ os=-sysv3
+ ;;
+ m68k-ccur)
+ os=-rtu
+ ;;
+ m88k-omron*)
+ os=-luna
+ ;;
+ *-next )
+ os=-nextstep
+ ;;
+ *-sequent)
+ os=-ptx
+ ;;
+ *-crds)
+ os=-unos
+ ;;
+ *-ns)
+ os=-genix
+ ;;
+ i370-*)
+ os=-mvs
+ ;;
+ *-next)
+ os=-nextstep3
+ ;;
+ *-gould)
+ os=-sysv
+ ;;
+ *-highlevel)
+ os=-bsd
+ ;;
+ *-encore)
+ os=-bsd
+ ;;
+ *-sgi)
+ os=-irix
+ ;;
+ *-siemens)
+ os=-sysv4
+ ;;
+ *-masscomp)
+ os=-rtu
+ ;;
+ f30[01]-fujitsu | f700-fujitsu)
+ os=-uxpv
+ ;;
+ *-rom68k)
+ os=-coff
+ ;;
+ *-*bug)
+ os=-coff
+ ;;
+ *-apple)
+ os=-macos
+ ;;
+ *-atari*)
+ os=-mint
+ ;;
+ *)
+ os=-none
+ ;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer. We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+ *-unknown)
+ case $os in
+ -riscix*)
+ vendor=acorn
+ ;;
+ -sunos*)
+ vendor=sun
+ ;;
+ -aix*)
+ vendor=ibm
+ ;;
+ -beos*)
+ vendor=be
+ ;;
+ -hpux*)
+ vendor=hp
+ ;;
+ -mpeix*)
+ vendor=hp
+ ;;
+ -hiux*)
+ vendor=hitachi
+ ;;
+ -unos*)
+ vendor=crds
+ ;;
+ -dgux*)
+ vendor=dg
+ ;;
+ -luna*)
+ vendor=omron
+ ;;
+ -genix*)
+ vendor=ns
+ ;;
+ -mvs* | -opened*)
+ vendor=ibm
+ ;;
+ -ptx*)
+ vendor=sequent
+ ;;
+ -vxsim* | -vxworks*)
+ vendor=wrs
+ ;;
+ -aux*)
+ vendor=apple
+ ;;
+ -hms*)
+ vendor=hitachi
+ ;;
+ -mpw* | -macos*)
+ vendor=apple
+ ;;
+ -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+ vendor=atari
+ ;;
+ -vos*)
+ vendor=stratus
+ ;;
+ esac
+ basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+ ;;
+esac
+
+echo $basic_machine$os
+exit 0
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
--- /dev/null
+#! /bin/sh
+# From configure.in Revision: 1.2 .
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.53 for gc 6.2alpha4.
+#
+# Report bugs to <Hans.Boehm@hp.com>.
+#
+# Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002
+# Free Software Foundation, Inc.
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Find the correct PATH separator. Usually this is `:', but
+# DJGPP uses `;' like DOS.
+if test "X${PATH_SEPARATOR+set}" != Xset; then
+ UNAME=${UNAME-`uname 2>/dev/null`}
+ case X$UNAME in
+ *-DOS) lt_cv_sys_path_separator=';' ;;
+ *) lt_cv_sys_path_separator=':' ;;
+ esac
+ PATH_SEPARATOR=$lt_cv_sys_path_separator
+fi
+
+
+# Check that we are running under the correct shell.
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+case X$ECHO in
+X*--fallback-echo)
+ # Remove one level of quotation (which was required for Make).
+ ECHO=`echo "$ECHO" | sed 's,\\\\\$\\$0,'$0','`
+ ;;
+esac
+
+echo=${ECHO-echo}
+if test "X$1" = X--no-reexec; then
+ # Discard the --no-reexec flag, and continue.
+ shift
+elif test "X$1" = X--fallback-echo; then
+ # Avoid inline document here, it may be left over
+ :
+elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then
+ # Yippee, $echo works!
+ :
+else
+ # Restart under the correct shell.
+ exec $SHELL "$0" --no-reexec ${1+"$@"}
+fi
+
+if test "X$1" = X--fallback-echo; then
+ # used as fallback echo
+ shift
+ cat <<EOF
+
+EOF
+ exit 0
+fi
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+if test "X${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
+
+if test -z "$ECHO"; then
+if test "X${echo_test_string+set}" != Xset; then
+# find a string as large as possible, as long as the shell can cope with it
+ for cmd in 'sed 50q "$0"' 'sed 20q "$0"' 'sed 10q "$0"' 'sed 2q "$0"' 'echo test'; do
+ # expected sizes: less than 2Kb, 1Kb, 512 bytes, 16 bytes, ...
+ if (echo_test_string="`eval $cmd`") 2>/dev/null &&
+ echo_test_string="`eval $cmd`" &&
+ (test "X$echo_test_string" = "X$echo_test_string") 2>/dev/null
+ then
+ break
+ fi
+ done
+fi
+
+if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ :
+else
+ # The Solaris, AIX, and Digital Unix default echo programs unquote
+ # backslashes. This makes it impossible to quote backslashes using
+ # echo "$something" | sed 's/\\/\\\\/g'
+ #
+ # So, first we look for a working echo in the user's PATH.
+
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for dir in $PATH /usr/ucb; do
+ if (test -f $dir/echo || test -f $dir/echo$ac_exeext) &&
+ test "X`($dir/echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($dir/echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ echo="$dir/echo"
+ break
+ fi
+ done
+ IFS="$save_ifs"
+
+ if test "X$echo" = Xecho; then
+ # We didn't find a better echo, so look for alternatives.
+ if test "X`(print -r '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`(print -r "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ # This shell has a builtin print -r that does the trick.
+ echo='print -r'
+ elif (test -f /bin/ksh || test -f /bin/ksh$ac_exeext) &&
+ test "X$CONFIG_SHELL" != X/bin/ksh; then
+ # If we have ksh, try running configure again with it.
+ ORIGINAL_CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
+ export ORIGINAL_CONFIG_SHELL
+ CONFIG_SHELL=/bin/ksh
+ export CONFIG_SHELL
+ exec $CONFIG_SHELL "$0" --no-reexec ${1+"$@"}
+ else
+ # Try using printf.
+ echo='printf %s\n'
+ if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ # Cool, printf works
+ :
+ elif echo_testing_string=`($ORIGINAL_CONFIG_SHELL "$0" --fallback-echo '\t') 2>/dev/null` &&
+ test "X$echo_testing_string" = 'X\t' &&
+ echo_testing_string=`($ORIGINAL_CONFIG_SHELL "$0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ CONFIG_SHELL=$ORIGINAL_CONFIG_SHELL
+ export CONFIG_SHELL
+ SHELL="$CONFIG_SHELL"
+ export SHELL
+ echo="$CONFIG_SHELL $0 --fallback-echo"
+ elif echo_testing_string=`($CONFIG_SHELL "$0" --fallback-echo '\t') 2>/dev/null` &&
+ test "X$echo_testing_string" = 'X\t' &&
+ echo_testing_string=`($CONFIG_SHELL "$0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ echo="$CONFIG_SHELL $0 --fallback-echo"
+ else
+ # maybe with a smaller string...
+ prev=:
+
+ for cmd in 'echo test' 'sed 2q "$0"' 'sed 10q "$0"' 'sed 20q "$0"' 'sed 50q "$0"'; do
+ if (test "X$echo_test_string" = "X`eval $cmd`") 2>/dev/null
+ then
+ break
+ fi
+ prev="$cmd"
+ done
+
+ if test "$prev" != 'sed 50q "$0"'; then
+ echo_test_string=`eval $prev`
+ export echo_test_string
+ exec ${ORIGINAL_CONFIG_SHELL-${CONFIG_SHELL-/bin/sh}} "$0" ${1+"$@"}
+ else
+ # Oops. We lost completely, so just stick with echo.
+ echo=echo
+ fi
+ fi
+ fi
+ fi
+fi
+fi
+
+# Copy echo and quote the copy suitably for passing to libtool from
+# the Makefile, instead of quoting the original, which is used later.
+ECHO=$echo
+if test "X$ECHO" = "X$CONFIG_SHELL $0 --fallback-echo"; then
+ ECHO="$CONFIG_SHELL \\\$\$0 --fallback-echo"
+fi
+
+
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+
+# NLS nuisances.
+# Support unset when possible.
+if (FOO=FOO; unset FOO) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+(set +x; test -n "`(LANG=C; export LANG) 2>&1`") &&
+ { $as_unset LANG || test "${LANG+set}" != set; } ||
+ { LANG=C; export LANG; }
+(set +x; test -n "`(LC_ALL=C; export LC_ALL) 2>&1`") &&
+ { $as_unset LC_ALL || test "${LC_ALL+set}" != set; } ||
+ { LC_ALL=C; export LC_ALL; }
+(set +x; test -n "`(LC_TIME=C; export LC_TIME) 2>&1`") &&
+ { $as_unset LC_TIME || test "${LC_TIME+set}" != set; } ||
+ { LC_TIME=C; export LC_TIME; }
+(set +x; test -n "`(LC_CTYPE=C; export LC_CTYPE) 2>&1`") &&
+ { $as_unset LC_CTYPE || test "${LC_CTYPE+set}" != set; } ||
+ { LC_CTYPE=C; export LC_CTYPE; }
+(set +x; test -n "`(LANGUAGE=C; export LANGUAGE) 2>&1`") &&
+ { $as_unset LANGUAGE || test "${LANGUAGE+set}" != set; } ||
+ { LANGUAGE=C; export LANGUAGE; }
+(set +x; test -n "`(LC_COLLATE=C; export LC_COLLATE) 2>&1`") &&
+ { $as_unset LC_COLLATE || test "${LC_COLLATE+set}" != set; } ||
+ { LC_COLLATE=C; export LC_COLLATE; }
+(set +x; test -n "`(LC_NUMERIC=C; export LC_NUMERIC) 2>&1`") &&
+ { $as_unset LC_NUMERIC || test "${LC_NUMERIC+set}" != set; } ||
+ { LC_NUMERIC=C; export LC_NUMERIC; }
+(set +x; test -n "`(LC_MESSAGES=C; export LC_MESSAGES) 2>&1`") &&
+ { $as_unset LC_MESSAGES || test "${LC_MESSAGES+set}" != set; } ||
+ { LC_MESSAGES=C; export LC_MESSAGES; }
+
+
+# Name of the executable.
+as_me=`(basename "$0") 2>/dev/null ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conftest.sh
+ echo "exit 0" >>conftest.sh
+ chmod +x conftest.sh
+ if (PATH=".;."; conftest.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conftest.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH || test "${CDPATH+set}" != set || { CDPATH=$PATH_SEPARATOR; export CDPATH; }
+
+
+# Name of the host.
+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+exec 6>&1
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+# Maximum number of lines to put in a shell here document.
+# This variable seems obsolete. It should probably be removed, and
+# only ac_max_sed_lines should be used.
+: ${ac_max_here_lines=38}
+
+# Identity of this package.
+PACKAGE_NAME='gc'
+PACKAGE_TARNAME='gc'
+PACKAGE_VERSION='6.2alpha4'
+PACKAGE_STRING='gc 6.2alpha4'
+PACKAGE_BUGREPORT='Hans.Boehm@hp.com'
+
+ac_unique_file="gcj_mlc.c"
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#if HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#if HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#if STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# if HAVE_STDLIB_H
+# include <stdlib.h>
+# endif
+#endif
+#if HAVE_STRING_H
+# if !STDC_HEADERS && HAVE_MEMORY_H
+# include <memory.h>
+# endif
+# include <string.h>
+#endif
+#if HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+# include <stdint.h>
+# endif
+#endif
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+ac_prev=
+for ac_option
+do
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case $ac_option in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir=$ac_optarg ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build_alias ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build_alias=$ac_optarg ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file=$ac_optarg ;;
+
+ --config-cache | -C)
+ cache_file=config.cache ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir=$ac_optarg ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ eval "enable_$ac_feature=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_$ac_feature='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix=$ac_optarg ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he | -h)
+ ac_init_help=long ;;
+ -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+ ac_init_help=recursive ;;
+ -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+ ac_init_help=short ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host_alias ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host_alias=$ac_optarg ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir=$ac_optarg ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir=$ac_optarg ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir=$ac_optarg ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir=$ac_optarg ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir=$ac_optarg ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir=$ac_optarg ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c | -n)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir=$ac_optarg ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix=$ac_optarg ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix=$ac_optarg ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix=$ac_optarg ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name=$ac_optarg ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir=$ac_optarg ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir=$ac_optarg ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site=$ac_optarg ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir=$ac_optarg ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir=$ac_optarg ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target_alias ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target_alias=$ac_optarg ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers | -V)
+ ac_init_version=: ;;
+
+ -with-* | --with-*)
+ ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_$ac_package='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package | sed 's/-/_/g'`
+ eval "with_$ac_package=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes=$ac_optarg ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries=$ac_optarg ;;
+
+ -*) { echo "$as_me: error: unrecognized option: $ac_option
+Try \`$0 --help' for more information." >&2
+ { (exit 1); exit 1; }; }
+ ;;
+
+ *=*)
+ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
+ { (exit 1); exit 1; }; }
+ ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+ eval "$ac_envvar='$ac_optarg'"
+ export $ac_envvar ;;
+
+ *)
+ # FIXME: should be removed in autoconf 3.0.
+ echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+ echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+ { echo "$as_me: error: missing argument to $ac_option" >&2
+ { (exit 1); exit 1; }; }
+fi
+
+# Be sure to have absolute paths.
+for ac_var in exec_prefix prefix
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# Be sure to have absolute paths.
+for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
+ localstatedir libdir includedir oldincludedir infodir mandir
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+ if test "x$build_alias" = x; then
+ cross_compiling=maybe
+ echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+ If a cross compiler is detected then cross compile mode will be used." >&2
+ elif test "x$build_alias" != "x$host_alias"; then
+ cross_compiling=yes
+ fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_confdir=`(dirname "$0") 2>/dev/null ||
+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$0" : 'X\(//\)[^/]' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$0" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
+ { (exit 1); exit 1; }; }
+ else
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+ { (exit 1); exit 1; }; }
+ fi
+fi
+srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
+ac_env_build_alias_set=${build_alias+set}
+ac_env_build_alias_value=$build_alias
+ac_cv_env_build_alias_set=${build_alias+set}
+ac_cv_env_build_alias_value=$build_alias
+ac_env_host_alias_set=${host_alias+set}
+ac_env_host_alias_value=$host_alias
+ac_cv_env_host_alias_set=${host_alias+set}
+ac_cv_env_host_alias_value=$host_alias
+ac_env_target_alias_set=${target_alias+set}
+ac_env_target_alias_value=$target_alias
+ac_cv_env_target_alias_set=${target_alias+set}
+ac_cv_env_target_alias_value=$target_alias
+ac_env_CC_set=${CC+set}
+ac_env_CC_value=$CC
+ac_cv_env_CC_set=${CC+set}
+ac_cv_env_CC_value=$CC
+ac_env_CFLAGS_set=${CFLAGS+set}
+ac_env_CFLAGS_value=$CFLAGS
+ac_cv_env_CFLAGS_set=${CFLAGS+set}
+ac_cv_env_CFLAGS_value=$CFLAGS
+ac_env_LDFLAGS_set=${LDFLAGS+set}
+ac_env_LDFLAGS_value=$LDFLAGS
+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
+ac_cv_env_LDFLAGS_value=$LDFLAGS
+ac_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_env_CPPFLAGS_value=$CPPFLAGS
+ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_cv_env_CPPFLAGS_value=$CPPFLAGS
+ac_env_CXX_set=${CXX+set}
+ac_env_CXX_value=$CXX
+ac_cv_env_CXX_set=${CXX+set}
+ac_cv_env_CXX_value=$CXX
+ac_env_CXXFLAGS_set=${CXXFLAGS+set}
+ac_env_CXXFLAGS_value=$CXXFLAGS
+ac_cv_env_CXXFLAGS_set=${CXXFLAGS+set}
+ac_cv_env_CXXFLAGS_value=$CXXFLAGS
+ac_env_CPP_set=${CPP+set}
+ac_env_CPP_value=$CPP
+ac_cv_env_CPP_set=${CPP+set}
+ac_cv_env_CPP_value=$CPP
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat <<_ACEOF
+\`configure' configures gc 6.2alpha4 to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE. See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+ -h, --help display this help and exit
+ --help=short display options specific to this package
+ --help=recursive display the short help of all the included packages
+ -V, --version display version information and exit
+ -q, --quiet, --silent do not print \`checking...' messages
+ --cache-file=FILE cache test results in FILE [disabled]
+ -C, --config-cache alias for \`--cache-file=config.cache'
+ -n, --no-create do not create output files
+ --srcdir=DIR find the sources in DIR [configure dir or \`..']
+
+_ACEOF
+
+ cat <<_ACEOF
+Installation directories:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data [PREFIX/share]
+ --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]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --infodir=DIR info documentation [PREFIX/info]
+ --mandir=DIR man documentation [PREFIX/man]
+_ACEOF
+
+ cat <<\_ACEOF
+
+Program names:
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM run sed PROGRAM on installed program names
+
+System types:
+ --build=BUILD configure for building on BUILD [guessed]
+ --host=HOST cross-compile to build programs to run on HOST [BUILD]
+ --target=TARGET configure for building compilers for TARGET [HOST]
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+ case $ac_init_help in
+ short | recursive ) echo "Configuration of gc 6.2alpha4:";;
+ esac
+ cat <<\_ACEOF
+
+Optional Features:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --disable-dependency-tracking Speeds up one-time builds
+ --enable-dependency-tracking Do not reject slow dependency extractors
+ --enable-maintainer-mode enable make rules and dependencies not useful
+ (and sometimes confusing) to the casual installer
+ --enable-threads=TYPE choose threading package
+ --enable-parallel-mark parallelize marking and free list construction
+ --enable-cplusplus include C++ support in GC library and include directory
+ --enable-shared=PKGS build shared libraries default=yes
+ --enable-static=PKGS build static libraries default=yes
+ --enable-fast-install=PKGS optimize for fast installation default=yes
+ --disable-libtool-lock avoid locking (might break parallel builds)
+ --enable-full-debug include full support for pointer backtracing etc.
+ --enable-redirect-malloc redirect malloc and friends to GC routines
+ --enable-gc-assertions collector-internal assertion checking
+
+Optional Packages:
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --with-ecos enable runtime eCos target support
+ --with-gnu-ld assume the C compiler uses GNU ld default=no
+ --with-pic try to use only PIC/non-PIC objects default=use both
+ --with-target-subdir=SUBDIR
+ configuring with a cross compiler
+ --with-cross-host=HOST configuring with a cross compiler
+
+Some influential environment variables:
+ CC C compiler command
+ CFLAGS C compiler flags
+ LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
+ nonstandard directory <lib dir>
+ CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
+ headers in a nonstandard directory <include dir>
+ CXX C++ compiler command
+ CXXFLAGS C++ compiler flags
+ CPP C preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to <Hans.Boehm@hp.com>.
+_ACEOF
+fi
+
+if test "$ac_init_help" = "recursive"; then
+ # If there are subdirs, report their specific --help.
+ ac_popdir=`pwd`
+ for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+ test -d $ac_dir || continue
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+# Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be
+# absolute.
+ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd`
+ac_abs_top_builddir=`cd "$ac_dir" && cd $ac_top_builddir && pwd`
+ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd`
+ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd`
+
+ cd $ac_dir
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_srcdir/configure.gnu; then
+ echo
+ $SHELL $ac_srcdir/configure.gnu --help=recursive
+ elif test -f $ac_srcdir/configure; then
+ echo
+ $SHELL $ac_srcdir/configure --help=recursive
+ elif test -f $ac_srcdir/configure.ac ||
+ test -f $ac_srcdir/configure.in; then
+ echo
+ $ac_configure --help
+ else
+ echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi
+ cd $ac_popdir
+ done
+fi
+
+test -n "$ac_init_help" && exit 0
+if $ac_init_version; then
+ cat <<\_ACEOF
+gc configure 6.2alpha4
+generated by GNU Autoconf 2.53
+
+Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002
+Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+ exit 0
+fi
+exec 5>config.log
+cat >&5 <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by gc $as_me 6.2alpha4, which was
+generated by GNU Autoconf 2.53. Invocation command line was
+
+ $ $0 $@
+
+_ACEOF
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`
+
+/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
+/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ echo "PATH: $as_dir"
+done
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell meta-characters.
+ac_configure_args=
+ac_sep=
+for ac_arg
+do
+ case $ac_arg in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c | -n ) continue ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ continue ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ esac
+ case " $ac_configure_args " in
+ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
+ *) ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
+ ac_sep=" " ;;
+ esac
+ # Get rid of the leading space.
+done
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log. We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Be sure not to use single quotes in there, as some shells,
+# such as our DU 5.0 friend, will then `close' the trap.
+trap 'exit_status=$?
+ # Save into config.log some information that might help in debugging.
+ {
+ echo
+ cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+ echo
+ # The following way of writing the cache mishandles newlines in values,
+{
+ (set) 2>&1 |
+ case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ sed -n \
+ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
+ ;;
+ *)
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+}
+ echo
+ if test -s confdefs.h; then
+ cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+ echo
+ sed "/^$/d" confdefs.h
+ echo
+ fi
+ test "$ac_signal" != 0 &&
+ echo "$as_me: caught signal $ac_signal"
+ echo "$as_me: exit $exit_status"
+ } >&5
+ rm -f core core.* *.core &&
+ rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ exit $exit_status
+ ' 0
+for ac_signal in 1 2 13 15; do
+ trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo >confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
+echo "$as_me: loading site script $ac_site_file" >&6;}
+ sed 's/^/| /' "$ac_site_file" >&5
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ # Some versions of bash will fail to source /dev/null (special
+ # files actually), so we avoid doing that.
+ if test -f "$cache_file"; then
+ { echo "$as_me:$LINENO: loading cache $cache_file" >&5
+echo "$as_me: loading cache $cache_file" >&6;}
+ case $cache_file in
+ [\\/]* | ?:[\\/]* ) . $cache_file;;
+ *) . ./$cache_file;;
+ esac
+ fi
+else
+ { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+echo "$as_me: creating cache $cache_file" >&6;}
+ >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in `(set) 2>&1 |
+ sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+ eval ac_old_set=\$ac_cv_env_${ac_var}_set
+ eval ac_new_set=\$ac_env_${ac_var}_set
+ eval ac_old_val="\$ac_cv_env_${ac_var}_value"
+ eval ac_new_val="\$ac_env_${ac_var}_value"
+ case $ac_old_set,$ac_new_set in
+ set,)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,set)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,);;
+ *)
+ if test "x$ac_old_val" != "x$ac_new_val"; then
+ { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
+echo "$as_me: former value: $ac_old_val" >&2;}
+ { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
+echo "$as_me: current value: $ac_new_val" >&2;}
+ ac_cache_corrupted=:
+ fi;;
+ esac
+ # Pass precious variables to config.status.
+ if test "$ac_new_set" = set; then
+ case $ac_new_val in
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *) ac_arg=$ac_var=$ac_new_val ;;
+ esac
+ case " $ac_configure_args " in
+ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
+ *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ esac
+ fi
+done
+if $ac_cache_corrupted; then
+ { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ## version must conform to [0-9]+[.][0-9]+(alpha[0-9]+)?
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ elif test -f $ac_dir/shtool; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/shtool install -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5
+echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+ac_config_guess="$SHELL $ac_aux_dir/config.guess"
+ac_config_sub="$SHELL $ac_aux_dir/config.sub"
+ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.
+
+# Make sure we can run config.sub.
+$ac_config_sub sun4 >/dev/null 2>&1 ||
+ { { echo "$as_me:$LINENO: error: cannot run $ac_config_sub" >&5
+echo "$as_me: error: cannot run $ac_config_sub" >&2;}
+ { (exit 1); exit 1; }; }
+
+echo "$as_me:$LINENO: checking build system type" >&5
+echo $ECHO_N "checking build system type... $ECHO_C" >&6
+if test "${ac_cv_build+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_build_alias=$build_alias
+test -z "$ac_cv_build_alias" &&
+ ac_cv_build_alias=`$ac_config_guess`
+test -z "$ac_cv_build_alias" &&
+ { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5
+echo "$as_me: error: cannot guess build type; you must specify one" >&2;}
+ { (exit 1); exit 1; }; }
+ac_cv_build=`$ac_config_sub $ac_cv_build_alias` ||
+ { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_build_alias failed" >&5
+echo "$as_me: error: $ac_config_sub $ac_cv_build_alias failed" >&2;}
+ { (exit 1); exit 1; }; }
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_build" >&5
+echo "${ECHO_T}$ac_cv_build" >&6
+build=$ac_cv_build
+build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+
+
+echo "$as_me:$LINENO: checking host system type" >&5
+echo $ECHO_N "checking host system type... $ECHO_C" >&6
+if test "${ac_cv_host+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_host_alias=$host_alias
+test -z "$ac_cv_host_alias" &&
+ ac_cv_host_alias=$ac_cv_build_alias
+ac_cv_host=`$ac_config_sub $ac_cv_host_alias` ||
+ { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_host_alias failed" >&5
+echo "$as_me: error: $ac_config_sub $ac_cv_host_alias failed" >&2;}
+ { (exit 1); exit 1; }; }
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_host" >&5
+echo "${ECHO_T}$ac_cv_host" >&6
+host=$ac_cv_host
+host_cpu=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+
+
+echo "$as_me:$LINENO: checking target system type" >&5
+echo $ECHO_N "checking target system type... $ECHO_C" >&6
+if test "${ac_cv_target+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_target_alias=$target_alias
+test "x$ac_cv_target_alias" = "x" &&
+ ac_cv_target_alias=$ac_cv_host_alias
+ac_cv_target=`$ac_config_sub $ac_cv_target_alias` ||
+ { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_target_alias failed" >&5
+echo "$as_me: error: $ac_config_sub $ac_cv_target_alias failed" >&2;}
+ { (exit 1); exit 1; }; }
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_target" >&5
+echo "${ECHO_T}$ac_cv_target" >&6
+target=$ac_cv_target
+target_cpu=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+target_vendor=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+target_os=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+
+
+# The aliases save the names the user supplied, while $host etc.
+# will get canonicalized.
+test -n "$target_alias" &&
+ test "$program_prefix$program_suffix$program_transform_name" = \
+ NONENONEs,x,x, &&
+ program_prefix=${target_alias}-
+
+
+
+ echo "$as_me:$LINENO: checking GC version numbers" >&5
+echo $ECHO_N "checking GC version numbers... $ECHO_C" >&6
+ GC_VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\([0-9][0-9]*\)[.].*$/\1/g'`
+ GC_VERSION_MINOR=`echo $PACKAGE_VERSION | sed 's/^[^.]*[.]\([0-9][0-9]*\).*$/\1/g'`
+ GC_ALPHA_VERSION=`echo $PACKAGE_VERSION | sed 's/^[^.]*[.][0-9]*//'`
+
+ case "$GC_ALPHA_VERSION" in
+ alpha*)
+ GC_ALPHA_VERSION=`echo $GC_ALPHA_VERSION \
+ | sed 's/alpha\([0-9][0-9]*\)/\1/'` ;;
+ *) GC_VERSION_MAJOR='' ;;
+ esac
+
+ if test :$GC_VERSION_MAJOR: = :: \
+ -o :$GC_VERSION_MINOR: = :: ;
+ then
+ echo "$as_me:$LINENO: result: invalid" >&5
+echo "${ECHO_T}invalid" >&6
+ { { echo "$as_me:$LINENO: error: nonconforming PACKAGE_VERSION='$PACKAGE_VERSION'" >&5
+echo "$as_me: error: nonconforming PACKAGE_VERSION='$PACKAGE_VERSION'" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+
+ cat >>confdefs.h <<_ACEOF
+#define GC_VERSION_MAJOR $GC_VERSION_MAJOR
+_ACEOF
+
+ cat >>confdefs.h <<_ACEOF
+#define GC_VERSION_MINOR $GC_VERSION_MINOR
+_ACEOF
+
+ if test :$GC_ALPHA_VERSION: != :: ; then
+ cat >>confdefs.h <<_ACEOF
+#define GC_ALPHA_VERSION $GC_ALPHA_VERSION
+_ACEOF
+
+ fi
+ echo "$as_me:$LINENO: result: major=$GC_VERSION_MAJOR minor=$GC_VERSION_MINOR \
+${GC_ALPHA_VERSION:+alpha=}$GC_ALPHA_VERSION" >&5
+echo "${ECHO_T}major=$GC_VERSION_MAJOR minor=$GC_VERSION_MINOR \
+${GC_ALPHA_VERSION:+alpha=}$GC_ALPHA_VERSION" >&6
+
+am__api_version="1.6"
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AmigaOS /C/install, which installs bootblocks on floppy discs
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5
+echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6
+if test -z "$INSTALL"; then
+if test "${ac_cv_path_install+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ # Account for people who put trailing slashes in PATH elements.
+case $as_dir/ in
+ ./ | .// | /cC/* | \
+ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+ /usr/ucb/* ) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
+ if test $ac_prog = install &&
+ grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ elif test $ac_prog = install &&
+ grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # program-specific install script used by HP pwplus--don't use.
+ :
+ else
+ ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+ break 3
+ fi
+ fi
+ done
+ done
+ ;;
+esac
+done
+
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL=$ac_cv_path_install
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL=$ac_install_sh
+ fi
+fi
+echo "$as_me:$LINENO: result: $INSTALL" >&5
+echo "${ECHO_T}$INSTALL" >&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+echo "$as_me:$LINENO: checking whether build environment is sane" >&5
+echo $ECHO_N "checking whether build environment is sane... $ECHO_C" >&6
+# Just in case
+sleep 1
+echo timestamp > conftest.file
+# Do `set' in a subshell so we don't clobber the current shell's
+# arguments. Must try -L first in case configure is actually a
+# symlink; some systems play weird games with the mod time of symlinks
+# (eg FreeBSD returns the mod time of the symlink's containing
+# directory).
+if (
+ set X `ls -Lt $srcdir/configure conftest.file 2> /dev/null`
+ if test "$*" = "X"; then
+ # -L didn't work.
+ set X `ls -t $srcdir/configure conftest.file`
+ fi
+ rm -f conftest.file
+ if test "$*" != "X $srcdir/configure conftest.file" \
+ && test "$*" != "X conftest.file $srcdir/configure"; then
+
+ # If neither matched, then we have a broken ls. This can happen
+ # if, for instance, CONFIG_SHELL is bash and it inherits a
+ # broken ls alias from the environment. This has actually
+ # happened. Such a system could not be considered "sane".
+ { { echo "$as_me:$LINENO: error: ls -t appears to fail. Make sure there is not a broken
+alias in your environment" >&5
+echo "$as_me: error: ls -t appears to fail. Make sure there is not a broken
+alias in your environment" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+
+ test "$2" = conftest.file
+ )
+then
+ # Ok.
+ :
+else
+ { { echo "$as_me:$LINENO: error: newly created file is older than distributed files!
+Check your system clock" >&5
+echo "$as_me: error: newly created file is older than distributed files!
+Check your system clock" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+test "$program_prefix" != NONE &&
+ program_transform_name="s,^,$program_prefix,;$program_transform_name"
+# Use a double $ so make ignores it.
+test "$program_suffix" != NONE &&
+ program_transform_name="s,\$,$program_suffix,;$program_transform_name"
+# Double any \ or $. echo might interpret backslashes.
+# By default was `s,x,x', remove it if useless.
+cat <<\_ACEOF >conftest.sed
+s/[\\$]/&&/g;s/;s,x,x,$//
+_ACEOF
+program_transform_name=`echo $program_transform_name | sed -f conftest.sed`
+rm conftest.sed
+
+
+# expand $ac_aux_dir to an absolute path
+am_aux_dir=`cd $ac_aux_dir && pwd`
+
+test x"${MISSING+set}" = xset || MISSING="\${SHELL} $am_aux_dir/missing"
+# Use eval to expand $SHELL
+if eval "$MISSING --run true"; then
+ am_missing_run="$MISSING --run "
+else
+ am_missing_run=
+ { echo "$as_me:$LINENO: WARNING: \`missing' script is too old or missing" >&5
+echo "$as_me: WARNING: \`missing' script is too old or missing" >&2;}
+fi
+
+for ac_prog in gawk mawk nawk awk
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_AWK+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$AWK"; then
+ ac_cv_prog_AWK="$AWK" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_AWK="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+AWK=$ac_cv_prog_AWK
+if test -n "$AWK"; then
+ echo "$as_me:$LINENO: result: $AWK" >&5
+echo "${ECHO_T}$AWK" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$AWK" && break
+done
+
+echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \${MAKE}" >&5
+echo $ECHO_N "checking whether ${MAKE-make} sets \${MAKE}... $ECHO_C" >&6
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,./+-,__p_,'`
+if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.make <<\_ACEOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+_ACEOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftest.make
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+ SET_MAKE=
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+ # test to see if srcdir already configured
+if test "`cd $srcdir && pwd`" != "`pwd`" &&
+ test -f $srcdir/config.status; then
+ { { echo "$as_me:$LINENO: error: source directory already configured; run \"make distclean\" there first" >&5
+echo "$as_me: error: source directory already configured; run \"make distclean\" there first" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+# Define the identity of the package.
+ PACKAGE=gc
+ VERSION=6.2alpha4
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE "$PACKAGE"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define VERSION "$VERSION"
+_ACEOF
+
+# Some tools Automake needs.
+
+ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"}
+
+
+AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"}
+
+
+AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"}
+
+
+AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"}
+
+
+MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"}
+
+
+AMTAR=${AMTAR-"${am_missing_run}tar"}
+
+install_sh=${install_sh-"$am_aux_dir/install-sh"}
+
+# Installed binaries are usually stripped using `strip' when the user
+# run `make install-strip'. However `strip' might not be the right
+# tool to use in cross-compilation environments, therefore Automake
+# will honor the `STRIP' environment variable to overrule this program.
+if test "$cross_compiling" != no; then
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
+set dummy ${ac_tool_prefix}strip; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_STRIP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$STRIP"; then
+ ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_STRIP="${ac_tool_prefix}strip"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+STRIP=$ac_cv_prog_STRIP
+if test -n "$STRIP"; then
+ echo "$as_me:$LINENO: result: $STRIP" >&5
+echo "${ECHO_T}$STRIP" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_STRIP"; then
+ ac_ct_STRIP=$STRIP
+ # Extract the first word of "strip", so it can be a program name with args.
+set dummy strip; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_STRIP"; then
+ ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_STRIP="strip"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ test -z "$ac_cv_prog_ac_ct_STRIP" && ac_cv_prog_ac_ct_STRIP=":"
+fi
+fi
+ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP
+if test -n "$ac_ct_STRIP"; then
+ echo "$as_me:$LINENO: result: $ac_ct_STRIP" >&5
+echo "${ECHO_T}$ac_ct_STRIP" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ STRIP=$ac_ct_STRIP
+else
+ STRIP="$ac_cv_prog_STRIP"
+fi
+
+fi
+INSTALL_STRIP_PROGRAM="\${SHELL} \$(install_sh) -c -s"
+
+# We need awk for the "check" target. The system "awk" is bad on
+# some platforms.
+
+
+
+
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+fi
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# != 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$as_dir/$ac_word" ${1+"$@"}
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ for ac_prog in cl
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$CC" && break
+ done
+fi
+if test -z "$CC"; then
+ ac_ct_CC=$CC
+ for ac_prog in cl
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_CC" && break
+done
+
+ CC=$ac_ct_CC
+fi
+
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH" >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH" >&2;}
+ { (exit 1); exit 1; }; }
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO:" \
+ "checking for C compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.exe"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+echo "$as_me:$LINENO: checking for C compiler default output" >&5
+echo $ECHO_N "checking for C compiler default output... $ECHO_C" >&6
+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
+ (eval $ac_link_default) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # Find the output, starting from the most likely. This scheme is
+# not robust to junk in `.', hence go to wildcards (a.*) only as a last
+# resort.
+
+# Be careful to initialize this variable, since it used to be cached.
+# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
+ac_cv_exeext=
+for ac_file in `ls a_out.exe a.exe conftest.exe 2>/dev/null;
+ ls a.out conftest 2>/dev/null;
+ ls a.* conftest.* 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.o | *.obj | *.xcoff | *.tds | *.d | *.pdb | *.xSYM ) ;;
+ a.out ) # We found the default executable, but exeext='' is most
+ # certainly right.
+ break;;
+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ # FIXME: I believe we export ac_cv_exeext for Libtool --akim.
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+{ { echo "$as_me:$LINENO: error: C compiler cannot create executables" >&5
+echo "$as_me: error: C compiler cannot create executables" >&2;}
+ { (exit 77); exit 77; }; }
+fi
+
+ac_exeext=$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6
+
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether the C compiler works" >&5
+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+ if { ac_try='./$ac_file'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { echo "$as_me:$LINENO: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'." >&5
+echo "$as_me: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ fi
+fi
+echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+
+rm -f a.out a.exe conftest$ac_cv_exeext
+ac_clean_files=$ac_clean_files_save
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
+echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6
+
+echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in `(ls conftest.exe; ls conftest; ls conftest.*) 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.o | *.obj | *.xcoff | *.tds | *.d | *.pdb ) ;;
+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
+else
+ { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link" >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
+if test "${ac_cv_objext+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb ) ;;
+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile" >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_compiler_gnu=no
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
+GCC=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+CFLAGS="-g"
+echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_prog_cc_g=no
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+# Some people use a C++ compiler to compile C. Since we use `exit',
+# in C++ we need to declare it. In case someone uses the same compiler
+# for both compiling C and C++ we need to have the C++ compiler decide
+# the declaration of exit, since it's the most demanding environment.
+cat >conftest.$ac_ext <<_ACEOF
+#ifndef __cplusplus
+ choke me
+#endif
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ for ac_declaration in \
+ ''\
+ '#include <stdlib.h>' \
+ 'extern "C" void std::exit (int) throw (); using std::exit;' \
+ 'extern "C" void std::exit (int); using std::exit;' \
+ 'extern "C" void exit (int) throw ();' \
+ 'extern "C" void exit (int);' \
+ 'void exit (int);'
+do
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+$ac_declaration
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+continue
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+$ac_declaration
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ break
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest*
+if test -n "$ac_declaration"; then
+ echo '#ifdef __cplusplus' >>confdefs.h
+ echo $ac_declaration >>confdefs.h
+ echo '#endif' >>confdefs.h
+fi
+
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+rm -f .deps 2>/dev/null
+mkdir .deps 2>/dev/null
+if test -d .deps; then
+ DEPDIR=.deps
+else
+ # MS-DOS does not allow filenames that begin with a dot.
+ DEPDIR=_deps
+fi
+rmdir .deps 2>/dev/null
+
+
+ac_config_commands="$ac_config_commands depfiles"
+
+
+am_make=${MAKE-make}
+cat > confinc << 'END'
+doit:
+ @echo done
+END
+# If we don't find an include directive, just comment out the code.
+echo "$as_me:$LINENO: checking for style of include used by $am_make" >&5
+echo $ECHO_N "checking for style of include used by $am_make... $ECHO_C" >&6
+am__include="#"
+am__quote=
+_am_result=none
+# First try GNU make style include.
+echo "include confinc" > confmf
+# We grep out `Entering directory' and `Leaving directory'
+# messages which can occur if `w' ends up in MAKEFLAGS.
+# In particular we don't look at `^make:' because GNU make might
+# be invoked under some other name (usually "gmake"), in which
+# case it prints its new name instead of `make'.
+if test "`$am_make -s -f confmf 2> /dev/null | fgrep -v 'ing directory'`" = "done"; then
+ am__include=include
+ am__quote=
+ _am_result=GNU
+fi
+# Now try BSD make style include.
+if test "$am__include" = "#"; then
+ echo '.include "confinc"' > confmf
+ if test "`$am_make -s -f confmf 2> /dev/null`" = "done"; then
+ am__include=.include
+ am__quote="\""
+ _am_result=BSD
+ fi
+fi
+
+
+echo "$as_me:$LINENO: result: $_am_result" >&5
+echo "${ECHO_T}$_am_result" >&6
+rm -f confinc confmf
+
+# Check whether --enable-dependency-tracking or --disable-dependency-tracking was given.
+if test "${enable_dependency_tracking+set}" = set; then
+ enableval="$enable_dependency_tracking"
+
+fi;
+if test "x$enable_dependency_tracking" != xno; then
+ am_depcomp="$ac_aux_dir/depcomp"
+ AMDEPBACKSLASH='\'
+fi
+
+
+if test "x$enable_dependency_tracking" != xno; then
+ AMDEP_TRUE=
+ AMDEP_FALSE='#'
+else
+ AMDEP_TRUE='#'
+ AMDEP_FALSE=
+fi
+
+
+
+
+depcc="$CC" am_compiler_list=
+
+echo "$as_me:$LINENO: checking dependency style of $depcc" >&5
+echo $ECHO_N "checking dependency style of $depcc... $ECHO_C" >&6
+if test "${am_cv_CC_dependencies_compiler_type+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
+ # We make a subdir and do the tests there. Otherwise we can end up
+ # making bogus files that we don't know about and never remove. For
+ # instance it was reported that on HP-UX the gcc test will end up
+ # making a dummy file named `D' -- because `-MD' means `put the output
+ # in D'.
+ mkdir conftest.dir
+ # Copy depcomp to subdir because otherwise we won't find it if we're
+ # using a relative directory.
+ cp "$am_depcomp" conftest.dir
+ cd conftest.dir
+
+ am_cv_CC_dependencies_compiler_type=none
+ if test "$am_compiler_list" = ""; then
+ am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp`
+ fi
+ for depmode in $am_compiler_list; do
+ # We need to recreate these files for each test, as the compiler may
+ # overwrite some of them when testing with obscure command lines.
+ # This happens at least with the AIX C compiler.
+ echo '#include "conftest.h"' > conftest.c
+ echo 'int i;' > conftest.h
+ echo "${am__include} ${am__quote}conftest.Po${am__quote}" > confmf
+
+ case $depmode in
+ nosideeffect)
+ # after this tag, mechanisms are not by side-effect, so they'll
+ # only be used when explicitly requested
+ if test "x$enable_dependency_tracking" = xyes; then
+ continue
+ else
+ break
+ fi
+ ;;
+ none) break ;;
+ esac
+ # We check with `-c' and `-o' for the sake of the "dashmstdout"
+ # mode. It turns out that the SunPro C++ compiler does not properly
+ # handle `-M -o', and we need to detect this.
+ if depmode=$depmode \
+ source=conftest.c object=conftest.o \
+ depfile=conftest.Po tmpdepfile=conftest.TPo \
+ $SHELL ./depcomp $depcc -c conftest.c -o conftest.o >/dev/null 2>&1 &&
+ grep conftest.h conftest.Po > /dev/null 2>&1 &&
+ ${MAKE-make} -s -f confmf > /dev/null 2>&1; then
+ am_cv_CC_dependencies_compiler_type=$depmode
+ break
+ fi
+ done
+
+ cd ..
+ rm -rf conftest.dir
+else
+ am_cv_CC_dependencies_compiler_type=none
+fi
+
+fi
+echo "$as_me:$LINENO: result: $am_cv_CC_dependencies_compiler_type" >&5
+echo "${ECHO_T}$am_cv_CC_dependencies_compiler_type" >&6
+CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type
+
+
+ac_ext=cc
+ac_cpp='$CXXCPP $CPPFLAGS'
+ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_cxx_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ for ac_prog in $CCC g++ c++ gpp aCC CC cxx cc++ cl FCC KCC RCC xlC_r xlC
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CXX+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CXX"; then
+ ac_cv_prog_CXX="$CXX" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CXX="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CXX=$ac_cv_prog_CXX
+if test -n "$CXX"; then
+ echo "$as_me:$LINENO: result: $CXX" >&5
+echo "${ECHO_T}$CXX" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$CXX" && break
+ done
+fi
+if test -z "$CXX"; then
+ ac_ct_CXX=$CXX
+ for ac_prog in $CCC g++ c++ gpp aCC CC cxx cc++ cl FCC KCC RCC xlC_r xlC
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CXX+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CXX"; then
+ ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CXX="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CXX=$ac_cv_prog_ac_ct_CXX
+if test -n "$ac_ct_CXX"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CXX" >&5
+echo "${ECHO_T}$ac_ct_CXX" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_CXX" && break
+done
+test -n "$ac_ct_CXX" || ac_ct_CXX="g++"
+
+ CXX=$ac_ct_CXX
+fi
+
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO:" \
+ "checking for C++ compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+echo "$as_me:$LINENO: checking whether we are using the GNU C++ compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C++ compiler... $ECHO_C" >&6
+if test "${ac_cv_cxx_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_compiler_gnu=no
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+ac_cv_cxx_compiler_gnu=$ac_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_cxx_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_cxx_compiler_gnu" >&6
+GXX=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CXXFLAGS=${CXXFLAGS+set}
+ac_save_CXXFLAGS=$CXXFLAGS
+CXXFLAGS="-g"
+echo "$as_me:$LINENO: checking whether $CXX accepts -g" >&5
+echo $ECHO_N "checking whether $CXX accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_cxx_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cxx_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_prog_cxx_g=no
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_cxx_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cxx_g" >&6
+if test "$ac_test_CXXFLAGS" = set; then
+ CXXFLAGS=$ac_save_CXXFLAGS
+elif test $ac_cv_prog_cxx_g = yes; then
+ if test "$GXX" = yes; then
+ CXXFLAGS="-g -O2"
+ else
+ CXXFLAGS="-g"
+ fi
+else
+ if test "$GXX" = yes; then
+ CXXFLAGS="-O2"
+ else
+ CXXFLAGS=
+ fi
+fi
+for ac_declaration in \
+ ''\
+ '#include <stdlib.h>' \
+ 'extern "C" void std::exit (int) throw (); using std::exit;' \
+ 'extern "C" void std::exit (int); using std::exit;' \
+ 'extern "C" void exit (int) throw ();' \
+ 'extern "C" void exit (int);' \
+ 'void exit (int);'
+do
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+$ac_declaration
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+continue
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+$ac_declaration
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ break
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest*
+if test -n "$ac_declaration"; then
+ echo '#ifdef __cplusplus' >>confdefs.h
+ echo $ac_declaration >>confdefs.h
+ echo '#endif' >>confdefs.h
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+depcc="$CXX" am_compiler_list=
+
+echo "$as_me:$LINENO: checking dependency style of $depcc" >&5
+echo $ECHO_N "checking dependency style of $depcc... $ECHO_C" >&6
+if test "${am_cv_CXX_dependencies_compiler_type+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
+ # We make a subdir and do the tests there. Otherwise we can end up
+ # making bogus files that we don't know about and never remove. For
+ # instance it was reported that on HP-UX the gcc test will end up
+ # making a dummy file named `D' -- because `-MD' means `put the output
+ # in D'.
+ mkdir conftest.dir
+ # Copy depcomp to subdir because otherwise we won't find it if we're
+ # using a relative directory.
+ cp "$am_depcomp" conftest.dir
+ cd conftest.dir
+
+ am_cv_CXX_dependencies_compiler_type=none
+ if test "$am_compiler_list" = ""; then
+ am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp`
+ fi
+ for depmode in $am_compiler_list; do
+ # We need to recreate these files for each test, as the compiler may
+ # overwrite some of them when testing with obscure command lines.
+ # This happens at least with the AIX C compiler.
+ echo '#include "conftest.h"' > conftest.c
+ echo 'int i;' > conftest.h
+ echo "${am__include} ${am__quote}conftest.Po${am__quote}" > confmf
+
+ case $depmode in
+ nosideeffect)
+ # after this tag, mechanisms are not by side-effect, so they'll
+ # only be used when explicitly requested
+ if test "x$enable_dependency_tracking" = xyes; then
+ continue
+ else
+ break
+ fi
+ ;;
+ none) break ;;
+ esac
+ # We check with `-c' and `-o' for the sake of the "dashmstdout"
+ # mode. It turns out that the SunPro C++ compiler does not properly
+ # handle `-M -o', and we need to detect this.
+ if depmode=$depmode \
+ source=conftest.c object=conftest.o \
+ depfile=conftest.Po tmpdepfile=conftest.TPo \
+ $SHELL ./depcomp $depcc -c conftest.c -o conftest.o >/dev/null 2>&1 &&
+ grep conftest.h conftest.Po > /dev/null 2>&1 &&
+ ${MAKE-make} -s -f confmf > /dev/null 2>&1; then
+ am_cv_CXX_dependencies_compiler_type=$depmode
+ break
+ fi
+ done
+
+ cd ..
+ rm -rf conftest.dir
+else
+ am_cv_CXX_dependencies_compiler_type=none
+fi
+
+fi
+echo "$as_me:$LINENO: result: $am_cv_CXX_dependencies_compiler_type" >&5
+echo "${ECHO_T}$am_cv_CXX_dependencies_compiler_type" >&6
+CXXDEPMODE=depmode=$am_cv_CXX_dependencies_compiler_type
+
+
+
+# By default we simply use the C compiler to build assembly code.
+
+: ${CCAS='$(CC)'}
+# Set ASFLAGS if not already set.
+: ${CCASFLAGS='$(CFLAGS)'}
+
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_AR+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$AR"; then
+ ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_AR="${ac_tool_prefix}ar"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+AR=$ac_cv_prog_AR
+if test -n "$AR"; then
+ echo "$as_me:$LINENO: result: $AR" >&5
+echo "${ECHO_T}$AR" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_AR"; then
+ ac_ct_AR=$AR
+ # Extract the first word of "ar", so it can be a program name with args.
+set dummy ar; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_AR+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_AR"; then
+ ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_AR="ar"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_AR=$ac_cv_prog_ac_ct_AR
+if test -n "$ac_ct_AR"; then
+ echo "$as_me:$LINENO: result: $ac_ct_AR" >&5
+echo "${ECHO_T}$ac_ct_AR" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ AR=$ac_ct_AR
+else
+ AR="$ac_cv_prog_AR"
+fi
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+ echo "$as_me:$LINENO: result: $RANLIB" >&5
+echo "${ECHO_T}$RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+ ac_ct_RANLIB=$RANLIB
+ # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_RANLIB"; then
+ ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RANLIB="ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":"
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+ echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
+echo "${ECHO_T}$ac_ct_RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ RANLIB=$ac_ct_RANLIB
+else
+ RANLIB="$ac_cv_prog_RANLIB"
+fi
+ # :)
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AmigaOS /C/install, which installs bootblocks on floppy discs
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5
+echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6
+if test -z "$INSTALL"; then
+if test "${ac_cv_path_install+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ # Account for people who put trailing slashes in PATH elements.
+case $as_dir/ in
+ ./ | .// | /cC/* | \
+ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+ /usr/ucb/* ) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
+ if test $ac_prog = install &&
+ grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ elif test $ac_prog = install &&
+ grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # program-specific install script used by HP pwplus--don't use.
+ :
+ else
+ ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+ break 3
+ fi
+ fi
+ done
+ done
+ ;;
+esac
+done
+
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL=$ac_cv_path_install
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL=$ac_install_sh
+ fi
+fi
+echo "$as_me:$LINENO: result: $INSTALL" >&5
+echo "${ECHO_T}$INSTALL" >&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+echo "$as_me:$LINENO: checking whether to enable maintainer-specific portions of Makefiles" >&5
+echo $ECHO_N "checking whether to enable maintainer-specific portions of Makefiles... $ECHO_C" >&6
+ # Check whether --enable-maintainer-mode or --disable-maintainer-mode was given.
+if test "${enable_maintainer_mode+set}" = set; then
+ enableval="$enable_maintainer_mode"
+ USE_MAINTAINER_MODE=$enableval
+else
+ USE_MAINTAINER_MODE=no
+fi;
+ echo "$as_me:$LINENO: result: $USE_MAINTAINER_MODE" >&5
+echo "${ECHO_T}$USE_MAINTAINER_MODE" >&6
+
+
+if test $USE_MAINTAINER_MODE = yes; then
+ MAINTAINER_MODE_TRUE=
+ MAINTAINER_MODE_FALSE='#'
+else
+ MAINTAINER_MODE_TRUE='#'
+ MAINTAINER_MODE_FALSE=
+fi
+
+ MAINT=$MAINTAINER_MODE_TRUE
+
+
+
+. ${srcdir}/configure.host
+
+GC_CFLAGS=${gc_cflags}
+
+
+# Check whether --enable-threads or --disable-threads was given.
+if test "${enable_threads+set}" = set; then
+ enableval="$enable_threads"
+ THREADS=$enableval
+else
+ echo "$as_me:$LINENO: checking for thread model used by GCC" >&5
+echo $ECHO_N "checking for thread model used by GCC... $ECHO_C" >&6
+ THREADS=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'`
+ if test -z "$THREADS"; then
+ THREADS=no
+ fi
+ echo "$as_me:$LINENO: result: $THREADS" >&5
+echo "${ECHO_T}$THREADS" >&6
+fi;
+
+# Check whether --enable-parallel-mark or --disable-parallel-mark was given.
+if test "${enable_parallel_mark+set}" = set; then
+ enableval="$enable_parallel_mark"
+ case "$THREADS" in
+ no | none | single)
+ { { echo "$as_me:$LINENO: error: Parallel mark requires --enable-threads=x spec" >&5
+echo "$as_me: error: Parallel mark requires --enable-threads=x spec" >&2;}
+ { (exit 1); exit 1; }; }
+ ;;
+ esac
+
+fi;
+
+# Check whether --enable-cplusplus or --disable-cplusplus was given.
+if test "${enable_cplusplus+set}" = set; then
+ enableval="$enable_cplusplus"
+
+fi;
+
+INCLUDES=-I${srcdir}/include
+THREADLIBS=
+case "$THREADS" in
+ no | none | single)
+ THREADS=none
+ ;;
+ posix | pthreads)
+ THREADS=posix
+ THREADLIBS=-lpthread
+ case "$host" in
+ x86-*-linux* | ia64-*-linux* | i586-*-linux* | i686-*-linux* | x86_64-*-linux* | alpha-*-linux*)
+ cat >>confdefs.h <<\_ACEOF
+#define GC_LINUX_THREADS 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define _REENTRANT 1
+_ACEOF
+
+ if test "${enable_parallel_mark}" = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define PARALLEL_MARK 1
+_ACEOF
+
+ fi
+ cat >>confdefs.h <<\_ACEOF
+#define THREAD_LOCAL_ALLOC 1
+_ACEOF
+
+ ;;
+ *-*-linux*)
+ cat >>confdefs.h <<\_ACEOF
+#define GC_LINUX_THREADS 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define _REENTRANT 1
+_ACEOF
+
+ ;;
+ *-*-hpux*)
+ { echo "$as_me:$LINENO: WARNING: \"Only HP/UX 11 threads are supported.\"" >&5
+echo "$as_me: WARNING: \"Only HP/UX 11 threads are supported.\"" >&2;}
+ cat >>confdefs.h <<\_ACEOF
+#define GC_HPUX_THREADS 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define _POSIX_C_SOURCE 199506L
+_ACEOF
+
+ if test "${enable_parallel_mark}" = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define PARALLEL_MARK 1
+_ACEOF
+
+ fi
+ cat >>confdefs.h <<\_ACEOF
+#define THREAD_LOCAL_ALLOC 1
+_ACEOF
+
+ THREADLIBS="-lpthread -lrt"
+ ;;
+ *-*-freebsd*)
+ { echo "$as_me:$LINENO: WARNING: \"FreeBSD does not yet fully support threads with Boehm GC.\"" >&5
+echo "$as_me: WARNING: \"FreeBSD does not yet fully support threads with Boehm GC.\"" >&2;}
+ cat >>confdefs.h <<\_ACEOF
+#define GC_FREEBSD_THREADS 1
+_ACEOF
+
+ INCLUDES="$INCLUDES -pthread"
+ THREADLIBS=-pthread
+ ;;
+ *-*-solaris*)
+ cat >>confdefs.h <<\_ACEOF
+#define GC_SOLARIS_THREADS 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define GC_SOLARIS_PTHREADS 1
+_ACEOF
+
+ ;;
+ *-*-irix*)
+ cat >>confdefs.h <<\_ACEOF
+#define GC_IRIX_THREADS 1
+_ACEOF
+
+ ;;
+ *-*-cygwin*)
+ cat >>confdefs.h <<\_ACEOF
+#define GC_WIN32_THREADS 1
+_ACEOF
+
+ ;;
+ *-*-darwin*)
+ cat >>confdefs.h <<\_ACEOF
+#define GC_MACOSX_THREADS 1
+_ACEOF
+
+ ;;
+ *-*-osf*)
+ cat >>confdefs.h <<\_ACEOF
+#define GC_OSF1_THREADS 1
+_ACEOF
+
+ if test "${enable_parallel_mark}" = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define PARALLEL_MARK 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define THREAD_LOCAL_ALLOC 1
+_ACEOF
+
+ # May want to enable it in other cases, too.
+ # Measurements havent yet been done.
+ fi
+ INCLUDES="$INCLUDES -pthread"
+ THREADLIBS="-lpthread -lrt"
+ ;;
+ esac
+ ;;
+ win32)
+ cat >>confdefs.h <<\_ACEOF
+#define GC_WIN32_THREADS 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define NO_GETENV 1
+_ACEOF
+
+ ;;
+ dgux386)
+ THREADS=dgux386
+echo "$as_me:$LINENO: result: $THREADLIBS" >&5
+echo "${ECHO_T}$THREADLIBS" >&6
+ # Use pthread GCC switch
+ THREADLIBS=-pthread
+ if test "${enable_parallel_mark}" = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define PARALLEL_MARK 1
+_ACEOF
+
+ fi
+ cat >>confdefs.h <<\_ACEOF
+#define THREAD_LOCAL_ALLOC 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define GC_DGUX386_THREADS 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define DGUX_THREADS 1
+_ACEOF
+
+ # Enable _POSIX4A_DRAFT10_SOURCE with flag -pthread
+ INCLUDES="-pthread $INCLUDES"
+ ;;
+ decosf1 | irix | mach | os2 | solaris | dce | vxworks)
+ { { echo "$as_me:$LINENO: error: thread package $THREADS not yet supported" >&5
+echo "$as_me: error: thread package $THREADS not yet supported" >&2;}
+ { (exit 1); exit 1; }; }
+ ;;
+ *)
+ { { echo "$as_me:$LINENO: error: $THREADS is an unknown thread package" >&5
+echo "$as_me: error: $THREADS is an unknown thread package" >&2;}
+ { (exit 1); exit 1; }; }
+ ;;
+esac
+
+
+
+echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5
+echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6
+if test "${ac_cv_lib_dl_dlopen+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldl $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dlopen ();
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+dlopen ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_dl_dlopen=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_lib_dl_dlopen=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5
+echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6
+if test $ac_cv_lib_dl_dlopen = yes; then
+ EXTRA_TEST_LIBS="$EXTRA_TEST_LIBS -ldl"
+fi
+
+
+
+target_all=libgc.la
+
+
+TARGET_ECOS="no"
+
+# Check whether --with-ecos or --without-ecos was given.
+if test "${with_ecos+set}" = set; then
+ withval="$with_ecos"
+ TARGET_ECOS="$with_ecos"
+
+fi;
+
+addobjs=
+addincludes=
+addtests=
+CXXINCLUDES=
+case "$TARGET_ECOS" in
+ no)
+ ;;
+ *)
+ cat >>confdefs.h <<\_ACEOF
+#define ECOS 1
+_ACEOF
+
+ CXXINCLUDES="-I${TARGET_ECOS}/include"
+ addobjs="$addobjs ecos.lo"
+ ;;
+esac
+
+if test "${enable_cplusplus}" = yes; then
+ addobjs="$addobjs gc_cpp.lo"
+ addincludes="$addincludes include/gc_cpp.h include/gc_allocator.h"
+ addtests="$addtests test_cpp"
+fi
+
+
+
+
+
+
+# Configuration of shared libraries
+#
+echo "$as_me:$LINENO: checking whether to build shared libraries" >&5
+echo $ECHO_N "checking whether to build shared libraries... $ECHO_C" >&6
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ p=${PACKAGE-default}
+case $enableval in
+yes) enable_shared=yes ;;
+no) enable_shared=no ;;
+*)
+ enable_shared=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_shared=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+else
+ enable_shared=yes
+fi;
+
+case "$host" in
+ alpha-*-openbsd*)
+ enable_shared=no
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+ ;;
+ *)
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+ ;;
+esac
+
+# Configuration of machine-dependent code
+#
+echo "$as_me:$LINENO: checking which machine-dependent code should be used" >&5
+echo $ECHO_N "checking which machine-dependent code should be used... $ECHO_C" >&6
+machdep=
+case "$host" in
+ alpha-*-openbsd*)
+ machdep="alpha_mach_dep.lo"
+ if test x"${ac_cv_lib_dl_dlopen}" != xyes ; then
+ { echo "$as_me:$LINENO: WARNING: OpenBSD/Alpha without dlopen(). Shared library support is disabled" >&5
+echo "$as_me: WARNING: OpenBSD/Alpha without dlopen(). Shared library support is disabled" >&2;}
+ fi
+ ;;
+ alpha*-*-linux*)
+ machdep="alpha_mach_dep.lo"
+ ;;
+ i?86-*-solaris2.[89]*)
+ cat >>confdefs.h <<\_ACEOF
+#define SOLARIS25_PROC_VDB_BUG_FIXED 1
+_ACEOF
+
+ ;;
+ mipstx39-*-elf*)
+ machdep="mips_ultrix_mach_dep.lo"
+ cat >>confdefs.h <<\_ACEOF
+#define STACKBASE __stackbase
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define DATASTART_IS_ETEXT 1
+_ACEOF
+
+ ;;
+ mips-dec-ultrix*)
+ machdep="mips_ultrix_mach-dep.lo"
+ ;;
+ mips-nec-sysv*|mips-unknown-sysv*)
+ ;;
+ mips*-*-linux*)
+ ;;
+ mips-*-*)
+ machdep="mips_sgi_mach_dep.lo"
+ cat >>confdefs.h <<\_ACEOF
+#define NO_EXECUTE_PERMISSION 1
+_ACEOF
+
+ ;;
+ sparc-*-netbsd*)
+ machdep="sparc_netbsd_mach_dep.lo"
+ ;;
+ sparc-sun-solaris2.3*)
+ machdep="sparc_mach_dep.lo"
+ cat >>confdefs.h <<\_ACEOF
+#define SUNOS53_SHARED_LIB 1
+_ACEOF
+
+ ;;
+ sparc-sun-solaris2.*)
+ machdep="sparc_mach_dep.lo"
+ ;;
+ ia64-*-*)
+ machdep="mach_dep.lo ia64_save_regs_in_stack.lo"
+ ;;
+esac
+if test x"$machdep" = x; then
+echo "$as_me:$LINENO: result: $machdep" >&5
+echo "${ECHO_T}$machdep" >&6
+ machdep="mach_dep.lo"
+fi
+addobjs="$addobjs $machdep"
+
+
+
+
+# Check whether --enable-static or --disable-static was given.
+if test "${enable_static+set}" = set; then
+ enableval="$enable_static"
+ p=${PACKAGE-default}
+case $enableval in
+yes) enable_static=yes ;;
+no) enable_static=no ;;
+*)
+ enable_static=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_static=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+else
+ enable_static=yes
+fi;
+# Check whether --enable-fast-install or --disable-fast-install was given.
+if test "${enable_fast_install+set}" = set; then
+ enableval="$enable_fast_install"
+ p=${PACKAGE-default}
+case $enableval in
+yes) enable_fast_install=yes ;;
+no) enable_fast_install=no ;;
+*)
+ enable_fast_install=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_fast_install=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+else
+ enable_fast_install=yes
+fi;
+# Find the correct PATH separator. Usually this is `:', but
+# DJGPP uses `;' like DOS.
+if test "X${PATH_SEPARATOR+set}" != Xset; then
+ UNAME=${UNAME-`uname 2>/dev/null`}
+ case X$UNAME in
+ *-DOS) lt_cv_sys_path_separator=';' ;;
+ *) lt_cv_sys_path_separator=':' ;;
+ esac
+ PATH_SEPARATOR=$lt_cv_sys_path_separator
+fi
+
+
+# Check whether --with-gnu-ld or --without-gnu-ld was given.
+if test "${with_gnu_ld+set}" = set; then
+ withval="$with_gnu_ld"
+ test "$withval" = no || with_gnu_ld=yes
+else
+ with_gnu_ld=no
+fi;
+ac_prog=ld
+if test "$GCC" = yes; then
+ # Check if gcc -print-prog-name=ld gives a path.
+ echo "$as_me:$LINENO: checking for ld used by GCC" >&5
+echo $ECHO_N "checking for ld used by GCC... $ECHO_C" >&6
+ case $host in
+ *-*-mingw*)
+ # gcc leaves a trailing carriage return which upsets mingw
+ ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+ *)
+ ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+ esac
+ case $ac_prog in
+ # Accept absolute paths.
+ [\\/]* | [A-Za-z]:[\\/]*)
+ re_direlt='/[^/][^/]*/\.\./'
+ # Canonicalize the path of ld
+ ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
+ while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
+ ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
+ done
+ test -z "$LD" && LD="$ac_prog"
+ ;;
+ "")
+ # If it fails, then pretend we aren't using GCC.
+ ac_prog=ld
+ ;;
+ *)
+ # If it is relative, then search for the first ld in PATH.
+ with_gnu_ld=unknown
+ ;;
+ esac
+elif test "$with_gnu_ld" = yes; then
+ echo "$as_me:$LINENO: checking for GNU ld" >&5
+echo $ECHO_N "checking for GNU ld... $ECHO_C" >&6
+else
+ echo "$as_me:$LINENO: checking for non-GNU ld" >&5
+echo $ECHO_N "checking for non-GNU ld... $ECHO_C" >&6
+fi
+if test "${lt_cv_path_LD+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -z "$LD"; then
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+ lt_cv_path_LD="$ac_dir/$ac_prog"
+ # Check to see if the program is GNU ld. I'd rather use --version,
+ # but apparently some GNU ld's only accept -v.
+ # Break only if it was the GNU/non-GNU ld that we prefer.
+ if "$lt_cv_path_LD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then
+ test "$with_gnu_ld" != no && break
+ else
+ test "$with_gnu_ld" != yes && break
+ fi
+ fi
+ done
+ IFS="$ac_save_ifs"
+else
+ lt_cv_path_LD="$LD" # Let the user override the test with a path.
+fi
+fi
+
+LD="$lt_cv_path_LD"
+if test -n "$LD"; then
+ echo "$as_me:$LINENO: result: $LD" >&5
+echo "${ECHO_T}$LD" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+test -z "$LD" && { { echo "$as_me:$LINENO: error: no acceptable ld found in \$PATH" >&5
+echo "$as_me: error: no acceptable ld found in \$PATH" >&2;}
+ { (exit 1); exit 1; }; }
+echo "$as_me:$LINENO: checking if the linker ($LD) is GNU ld" >&5
+echo $ECHO_N "checking if the linker ($LD) is GNU ld... $ECHO_C" >&6
+if test "${lt_cv_prog_gnu_ld+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ # I'd rather use --version here, but apparently some GNU ld's only accept -v.
+if $LD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then
+ lt_cv_prog_gnu_ld=yes
+else
+ lt_cv_prog_gnu_ld=no
+fi
+fi
+echo "$as_me:$LINENO: result: $lt_cv_prog_gnu_ld" >&5
+echo "${ECHO_T}$lt_cv_prog_gnu_ld" >&6
+with_gnu_ld=$lt_cv_prog_gnu_ld
+
+
+echo "$as_me:$LINENO: checking for $LD option to reload object files" >&5
+echo $ECHO_N "checking for $LD option to reload object files... $ECHO_C" >&6
+if test "${lt_cv_ld_reload_flag+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ lt_cv_ld_reload_flag='-r'
+fi
+echo "$as_me:$LINENO: result: $lt_cv_ld_reload_flag" >&5
+echo "${ECHO_T}$lt_cv_ld_reload_flag" >&6
+reload_flag=$lt_cv_ld_reload_flag
+test -n "$reload_flag" && reload_flag=" $reload_flag"
+
+echo "$as_me:$LINENO: checking for BSD-compatible nm" >&5
+echo $ECHO_N "checking for BSD-compatible nm... $ECHO_C" >&6
+if test "${lt_cv_path_NM+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$NM"; then
+ # Let the user override the test.
+ lt_cv_path_NM="$NM"
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for ac_dir in $PATH /usr/ccs/bin /usr/ucb /bin; do
+ test -z "$ac_dir" && ac_dir=.
+ tmp_nm=$ac_dir/${ac_tool_prefix}nm
+ if test -f $tmp_nm || test -f $tmp_nm$ac_exeext ; then
+ # Check to see if the nm accepts a BSD-compat flag.
+ # Adding the `sed 1q' prevents false positives on HP-UX, which says:
+ # nm: unknown option "B" ignored
+ # Tru64's nm complains that /dev/null is an invalid object file
+ if ($tmp_nm -B /dev/null 2>&1 | sed '1q'; exit 0) | egrep '(/dev/null|Invalid file or object type)' >/dev/null; then
+ lt_cv_path_NM="$tmp_nm -B"
+ break
+ elif ($tmp_nm -p /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then
+ lt_cv_path_NM="$tmp_nm -p"
+ break
+ else
+ lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
+ continue # so that we can try to find one that supports BSD flags
+ fi
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$lt_cv_path_NM" && lt_cv_path_NM=nm
+fi
+fi
+
+NM="$lt_cv_path_NM"
+echo "$as_me:$LINENO: result: $NM" >&5
+echo "${ECHO_T}$NM" >&6
+
+echo "$as_me:$LINENO: checking whether ln -s works" >&5
+echo $ECHO_N "checking whether ln -s works... $ECHO_C" >&6
+LN_S=$as_ln_s
+if test "$LN_S" = "ln -s"; then
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+else
+ echo "$as_me:$LINENO: result: no, using $LN_S" >&5
+echo "${ECHO_T}no, using $LN_S" >&6
+fi
+
+echo "$as_me:$LINENO: checking how to recognise dependant libraries" >&5
+echo $ECHO_N "checking how to recognise dependant libraries... $ECHO_C" >&6
+if test "${lt_cv_deplibs_check_method+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ lt_cv_file_magic_cmd='$MAGIC_CMD'
+lt_cv_file_magic_test_file=
+lt_cv_deplibs_check_method='unknown'
+# Need to set the preceding variable on all platforms that support
+# interlibrary dependencies.
+# 'none' -- dependencies not supported.
+# `unknown' -- same as none, but documents that we really don't know.
+# 'pass_all' -- all dependencies passed with no checks.
+# 'test_compile' -- check by making test program.
+# 'file_magic [[regex]]' -- check by looking for files in library path
+# which responds to the $file_magic_cmd with a given egrep regex.
+# If you have `file' or equivalent on your system and you're not sure
+# whether `pass_all' will *always* work, you probably want this one.
+
+case $host_os in
+aix4* | aix5*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+beos*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+bsdi4*)
+ lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)'
+ lt_cv_file_magic_cmd='/usr/bin/file -L'
+ lt_cv_file_magic_test_file=/shlib/libc.so
+ ;;
+
+cygwin* | mingw* | pw32*)
+ lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?'
+ lt_cv_file_magic_cmd='$OBJDUMP -f'
+ ;;
+
+darwin* | rhapsody*)
+ lt_cv_deplibs_check_method='file_magic Mach-O dynamically linked shared library'
+ lt_cv_file_magic_cmd='/usr/bin/file -L'
+ case "$host_os" in
+ rhapsody* | darwin1.[012])
+ lt_cv_file_magic_test_file=`echo /System/Library/Frameworks/System.framework/Versions/*/System | head -1`
+ ;;
+ *) # Darwin 1.3 on
+ lt_cv_file_magic_test_file='/usr/lib/libSystem.dylib'
+ ;;
+ esac
+ ;;
+
+freebsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ > /dev/null; then
+ case $host_cpu in
+ i*86 )
+ # Not sure whether the presence of OpenBSD here was a mistake.
+ # Let's accept both of them until this is cleared up.
+ lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD)/i[3-9]86 (compact )?demand paged shared library'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+ ;;
+ esac
+ else
+ lt_cv_deplibs_check_method=pass_all
+ fi
+ ;;
+
+gnu*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+hpux10.20*|hpux11*)
+ lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9].[0-9]) shared library'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=/usr/lib/libc.sl
+ ;;
+
+irix5* | irix6*)
+ case $host_os in
+ irix5*)
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method="file_magic ELF 32-bit MSB dynamic lib MIPS - version 1"
+ ;;
+ *)
+ case $LD in
+ *-32|*"-32 ") libmagic=32-bit;;
+ *-n32|*"-n32 ") libmagic=N32;;
+ *-64|*"-64 ") libmagic=64-bit;;
+ *) libmagic=never-match;;
+ esac
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method="file_magic ELF ${libmagic} MSB mips-[1234] dynamic lib MIPS - version 1"
+ ;;
+ esac
+ lt_cv_file_magic_test_file=`echo /lib${libsuff}/libc.so*`
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+# This must be Linux ELF.
+linux-gnu*)
+ case $host_cpu in
+ alpha* | hppa* | i*86 | powerpc* | sparc* | ia64* | s390* )
+ lt_cv_deplibs_check_method=pass_all ;;
+ *)
+ # glibc up to 2.1.1 does not perform some relocations on ARM
+ lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' ;;
+ esac
+ lt_cv_file_magic_test_file=`echo /lib/libc.so* /lib/libc-*.so`
+ ;;
+
+netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ > /dev/null; then
+ lt_cv_deplibs_check_method='match_pattern /lib[^/\.]+\.so\.[0-9]+\.[0-9]+$'
+ else
+ lt_cv_deplibs_check_method='match_pattern /lib[^/\.]+\.so$'
+ fi
+ ;;
+
+newos6*)
+ lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=/usr/lib/libnls.so
+ ;;
+
+openbsd*)
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB shared object'
+ else
+ lt_cv_deplibs_check_method='file_magic OpenBSD.* shared library'
+ fi
+ ;;
+
+osf3* | osf4* | osf5*)
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method='file_magic COFF format alpha shared library'
+ lt_cv_file_magic_test_file=/shlib/libc.so
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+sco3.2v5*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+solaris*)
+ lt_cv_deplibs_check_method=pass_all
+ lt_cv_file_magic_test_file=/lib/libc.so
+ ;;
+
+sysv5uw[78]* | sysv4*uw2*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ case $host_vendor in
+ motorola)
+ lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]'
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
+ ;;
+ ncr)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+ sequent)
+ lt_cv_file_magic_cmd='/bin/file'
+ lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )'
+ ;;
+ sni)
+ lt_cv_file_magic_cmd='/bin/file'
+ lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib"
+ lt_cv_file_magic_test_file=/lib/libc.so
+ ;;
+ esac
+ ;;
+esac
+
+fi
+echo "$as_me:$LINENO: result: $lt_cv_deplibs_check_method" >&5
+echo "${ECHO_T}$lt_cv_deplibs_check_method" >&6
+file_magic_cmd=$lt_cv_file_magic_cmd
+deplibs_check_method=$lt_cv_deplibs_check_method
+
+
+
+
+
+
+
+# Check for command to grab the raw symbol name followed by C symbol from nm.
+echo "$as_me:$LINENO: checking command to parse $NM output" >&5
+echo $ECHO_N "checking command to parse $NM output... $ECHO_C" >&6
+if test "${lt_cv_sys_global_symbol_pipe+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+
+# These are sane defaults that work on at least a few old systems.
+# [They come from Ultrix. What could be older than Ultrix?!! ;)]
+
+# Character class describing NM global symbol codes.
+symcode='[BCDEGRST]'
+
+# Regexp to match symbols that can be accessed directly from C.
+sympat='\([_A-Za-z][_A-Za-z0-9]*\)'
+
+# Transform the above into a raw symbol and a C symbol.
+symxfrm='\1 \2\3 \3'
+
+# Transform an extracted symbol line into a proper C declaration
+lt_cv_global_symbol_to_cdecl="sed -n -e 's/^. .* \(.*\)$/extern char \1;/p'"
+
+# Transform an extracted symbol line into symbol name and symbol address
+lt_cv_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode \([^ ]*\) \([^ ]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'"
+
+# Define system-specific variables.
+case $host_os in
+aix*)
+ symcode='[BCDT]'
+ ;;
+cygwin* | mingw* | pw32*)
+ symcode='[ABCDGISTW]'
+ ;;
+hpux*) # Its linker distinguishes data from code symbols
+ lt_cv_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern char \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'"
+ lt_cv_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'"
+ ;;
+irix*)
+ symcode='[BCDEGRST]'
+ ;;
+solaris* | sysv5*)
+ symcode='[BDT]'
+ ;;
+sysv4)
+ symcode='[DFNSTU]'
+ ;;
+esac
+
+# Handle CRLF in mingw tool chain
+opt_cr=
+case $host_os in
+mingw*)
+ opt_cr=`echo 'x\{0,1\}' | tr x '\015'` # option cr in regexp
+ ;;
+esac
+
+# If we're using GNU nm, then use its standard symbol codes.
+if $NM -V 2>&1 | egrep '(GNU|with BFD)' > /dev/null; then
+ symcode='[ABCDGISTW]'
+fi
+
+# Try without a prefix undercore, then with it.
+for ac_symprfx in "" "_"; do
+
+ # Write the raw and C identifiers.
+lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[ ]\($symcode$symcode*\)[ ][ ]*\($ac_symprfx\)$sympat$opt_cr$/$symxfrm/p'"
+
+ # Check to see that the pipe works correctly.
+ pipe_works=no
+ rm -f conftest*
+ cat > conftest.$ac_ext <<EOF
+#ifdef __cplusplus
+extern "C" {
+#endif
+char nm_test_var;
+void nm_test_func(){}
+#ifdef __cplusplus
+}
+#endif
+int main(){nm_test_var='a';nm_test_func();return(0);}
+EOF
+
+ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # Now try to grab the symbols.
+ nlist=conftest.nm
+ if { (eval echo "$as_me:$LINENO: \"$NM conftest.$ac_objext \| $lt_cv_sys_global_symbol_pipe \> $nlist\"") >&5
+ (eval $NM conftest.$ac_objext \| $lt_cv_sys_global_symbol_pipe \> $nlist) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && test -s "$nlist"; then
+ # Try sorting and uniquifying the output.
+ if sort "$nlist" | uniq > "$nlist"T; then
+ mv -f "$nlist"T "$nlist"
+ else
+ rm -f "$nlist"T
+ fi
+
+ # Make sure that we snagged all the symbols we need.
+ if egrep ' nm_test_var$' "$nlist" >/dev/null; then
+ if egrep ' nm_test_func$' "$nlist" >/dev/null; then
+ cat <<EOF > conftest.$ac_ext
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+EOF
+ # Now generate the symbol file.
+ eval "$lt_cv_global_symbol_to_cdecl"' < "$nlist" >> conftest.$ac_ext'
+
+ cat <<EOF >> conftest.$ac_ext
+#if defined (__STDC__) && __STDC__
+# define lt_ptr void *
+#else
+# define lt_ptr char *
+# define const
+#endif
+
+/* The mapping between symbol names and symbols. */
+const struct {
+ const char *name;
+ lt_ptr address;
+}
+lt_preloaded_symbols[] =
+{
+EOF
+ sed "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (lt_ptr) \&\2},/" < "$nlist" >> conftest.$ac_ext
+ cat <<\EOF >> conftest.$ac_ext
+ {0, (lt_ptr) 0}
+};
+
+#ifdef __cplusplus
+}
+#endif
+EOF
+ # Now try linking the two files.
+ mv conftest.$ac_objext conftstm.$ac_objext
+ save_LIBS="$LIBS"
+ save_CFLAGS="$CFLAGS"
+ LIBS="conftstm.$ac_objext"
+ CFLAGS="$CFLAGS$no_builtin_flag"
+ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && test -s conftest; then
+ pipe_works=yes
+ fi
+ LIBS="$save_LIBS"
+ CFLAGS="$save_CFLAGS"
+ else
+ echo "cannot find nm_test_func in $nlist" >&5
+ fi
+ else
+ echo "cannot find nm_test_var in $nlist" >&5
+ fi
+ else
+ echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5
+ fi
+ else
+ echo "$progname: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ fi
+ rm -f conftest* conftst*
+
+ # Do not use the global_symbol_pipe unless it works.
+ if test "$pipe_works" = yes; then
+ break
+ else
+ lt_cv_sys_global_symbol_pipe=
+ fi
+done
+
+fi
+
+global_symbol_pipe="$lt_cv_sys_global_symbol_pipe"
+if test -z "$lt_cv_sys_global_symbol_pipe"; then
+ global_symbol_to_cdecl=
+ global_symbol_to_c_name_address=
+else
+ global_symbol_to_cdecl="$lt_cv_global_symbol_to_cdecl"
+ global_symbol_to_c_name_address="$lt_cv_global_symbol_to_c_name_address"
+fi
+if test -z "$global_symbol_pipe$global_symbol_to_cdec$global_symbol_to_c_name_address";
+then
+ echo "$as_me:$LINENO: result: failed" >&5
+echo "${ECHO_T}failed" >&6
+else
+ echo "$as_me:$LINENO: result: ok" >&5
+echo "${ECHO_T}ok" >&6
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
+echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+ if test "${ac_cv_prog_CPP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ # Double quotes because CPP needs to be expanded
+ for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+ do
+ ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <assert.h>
+ Syntax error
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ egrep -v '^ *\+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ # OK, works on sane cases. Now check whether non-existent headers
+ # can be detected and how.
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <ac_nonexistent.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ egrep -v '^ *\+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ # Broken: success on invalid input.
+continue
+else
+ echo "$as_me: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+ break
+fi
+
+ done
+ ac_cv_prog_CPP=$CPP
+
+fi
+ CPP=$ac_cv_prog_CPP
+else
+ ac_cv_prog_CPP=$CPP
+fi
+echo "$as_me:$LINENO: result: $CPP" >&5
+echo "${ECHO_T}$CPP" >&6
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <assert.h>
+ Syntax error
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ egrep -v '^ *\+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ # OK, works on sane cases. Now check whether non-existent headers
+ # can be detected and how.
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <ac_nonexistent.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ egrep -v '^ *\+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ # Broken: success on invalid input.
+continue
+else
+ echo "$as_me: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+ :
+else
+ { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check" >&5
+echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+echo "$as_me:$LINENO: checking for ANSI C header files" >&5
+echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
+if test "${ac_cv_header_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ egrep -v '^ *\+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ ac_cv_header_stdc=yes
+else
+ echo "$as_me: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_header_stdc=no
+fi
+rm -f conftest.err conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "memchr" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "free" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+ if test "$cross_compiling" = yes; then
+ :
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) (('a' <= (c) && (c) <= 'i') \
+ || ('j' <= (c) && (c) <= 'r') \
+ || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+ int i;
+ for (i = 0; i < 256; i++)
+ if (XOR (islower (i), ISLOWER (i))
+ || toupper (i) != TOUPPER (i))
+ exit(2);
+ exit (0);
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+( exit $ac_status )
+ac_cv_header_stdc=no
+fi
+rm -f core core.* *.core conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+fi
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
+echo "${ECHO_T}$ac_cv_header_stdc" >&6
+if test $ac_cv_header_stdc = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define STDC_HEADERS 1
+_ACEOF
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+
+
+
+
+
+
+
+
+
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+ inttypes.h stdint.h unistd.h
+do
+as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
+if eval "test \"\${$as_ac_Header+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+$ac_includes_default
+
+#include <$ac_header>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ eval "$as_ac_Header=yes"
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+eval "$as_ac_Header=no"
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+
+for ac_header in dlfcn.h
+do
+as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
+if eval "test \"\${$as_ac_Header+set}\" = set"; then
+ echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
+if eval "test \"\${$as_ac_Header+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+else
+ # Is the header compilable?
+echo "$as_me:$LINENO: checking $ac_header usability" >&5
+echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+$ac_includes_default
+#include <$ac_header>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_header_compiler=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_header_compiler=no
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6
+
+# Is the header present?
+echo "$as_me:$LINENO: checking $ac_header presence" >&5
+echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <$ac_header>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ egrep -v '^ *\+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ ac_header_preproc=yes
+else
+ echo "$as_me: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_header_preproc=no
+fi
+rm -f conftest.err conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6
+
+# So? What about this header?
+case $ac_header_compiler:$ac_header_preproc in
+ yes:no )
+ { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;};;
+ no:yes )
+ { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
+echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;};;
+esac
+echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
+if eval "test \"\${$as_ac_Header+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ eval "$as_ac_Header=$ac_header_preproc"
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+
+fi
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+
+
+
+# Only perform the check for file, if the check method requires it
+case $deplibs_check_method in
+file_magic*)
+ if test "$file_magic_cmd" = '$MAGIC_CMD'; then
+ echo "$as_me:$LINENO: checking for ${ac_tool_prefix}file" >&5
+echo $ECHO_N "checking for ${ac_tool_prefix}file... $ECHO_C" >&6
+if test "${lt_cv_path_MAGIC_CMD+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $MAGIC_CMD in
+ /*)
+ lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a dos path.
+ ;;
+ *)
+ ac_save_MAGIC_CMD="$MAGIC_CMD"
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="/usr/bin:$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/${ac_tool_prefix}file; then
+ lt_cv_path_MAGIC_CMD="$ac_dir/${ac_tool_prefix}file"
+ if test -n "$file_magic_test_file"; then
+ case $deplibs_check_method in
+ "file_magic "*)
+ file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
+ MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+ if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+ egrep "$file_magic_regex" > /dev/null; then
+ :
+ else
+ cat <<EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such. This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem. Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+EOF
+ fi ;;
+ esac
+ fi
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ MAGIC_CMD="$ac_save_MAGIC_CMD"
+ ;;
+esac
+fi
+
+MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+if test -n "$MAGIC_CMD"; then
+ echo "$as_me:$LINENO: result: $MAGIC_CMD" >&5
+echo "${ECHO_T}$MAGIC_CMD" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+if test -z "$lt_cv_path_MAGIC_CMD"; then
+ if test -n "$ac_tool_prefix"; then
+ echo "$as_me:$LINENO: checking for file" >&5
+echo $ECHO_N "checking for file... $ECHO_C" >&6
+if test "${lt_cv_path_MAGIC_CMD+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $MAGIC_CMD in
+ /*)
+ lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a dos path.
+ ;;
+ *)
+ ac_save_MAGIC_CMD="$MAGIC_CMD"
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="/usr/bin:$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/file; then
+ lt_cv_path_MAGIC_CMD="$ac_dir/file"
+ if test -n "$file_magic_test_file"; then
+ case $deplibs_check_method in
+ "file_magic "*)
+ file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
+ MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+ if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+ egrep "$file_magic_regex" > /dev/null; then
+ :
+ else
+ cat <<EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such. This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem. Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+EOF
+ fi ;;
+ esac
+ fi
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ MAGIC_CMD="$ac_save_MAGIC_CMD"
+ ;;
+esac
+fi
+
+MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+if test -n "$MAGIC_CMD"; then
+ echo "$as_me:$LINENO: result: $MAGIC_CMD" >&5
+echo "${ECHO_T}$MAGIC_CMD" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ else
+ MAGIC_CMD=:
+ fi
+fi
+
+ fi
+ ;;
+esac
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+RANLIB=$ac_cv_prog_RANLIB
+if test -n "$RANLIB"; then
+ echo "$as_me:$LINENO: result: $RANLIB" >&5
+echo "${ECHO_T}$RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_RANLIB"; then
+ ac_ct_RANLIB=$RANLIB
+ # Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_RANLIB"; then
+ ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_RANLIB="ranlib"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":"
+fi
+fi
+ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
+if test -n "$ac_ct_RANLIB"; then
+ echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
+echo "${ECHO_T}$ac_ct_RANLIB" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ RANLIB=$ac_ct_RANLIB
+else
+ RANLIB="$ac_cv_prog_RANLIB"
+fi
+
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
+set dummy ${ac_tool_prefix}strip; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_STRIP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$STRIP"; then
+ ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_STRIP="${ac_tool_prefix}strip"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+STRIP=$ac_cv_prog_STRIP
+if test -n "$STRIP"; then
+ echo "$as_me:$LINENO: result: $STRIP" >&5
+echo "${ECHO_T}$STRIP" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_STRIP"; then
+ ac_ct_STRIP=$STRIP
+ # Extract the first word of "strip", so it can be a program name with args.
+set dummy strip; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_STRIP"; then
+ ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_STRIP="strip"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ test -z "$ac_cv_prog_ac_ct_STRIP" && ac_cv_prog_ac_ct_STRIP=":"
+fi
+fi
+ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP
+if test -n "$ac_ct_STRIP"; then
+ echo "$as_me:$LINENO: result: $ac_ct_STRIP" >&5
+echo "${ECHO_T}$ac_ct_STRIP" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ STRIP=$ac_ct_STRIP
+else
+ STRIP="$ac_cv_prog_STRIP"
+fi
+
+
+enable_dlopen=no
+enable_win32_dll=no
+
+# Check whether --enable-libtool-lock or --disable-libtool-lock was given.
+if test "${enable_libtool_lock+set}" = set; then
+ enableval="$enable_libtool_lock"
+
+fi;
+test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes
+
+# Some flags need to be propagated to the compiler or linker for good
+# libtool support.
+case $host in
+*-*-irix6*)
+ # Find out which ABI we are using.
+ echo '#line 5338 "configure"' > conftest.$ac_ext
+ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ case `/usr/bin/file conftest.$ac_objext` in
+ *32-bit*)
+ LD="${LD-ld} -32"
+ ;;
+ *N32*)
+ LD="${LD-ld} -n32"
+ ;;
+ *64-bit*)
+ LD="${LD-ld} -64"
+ ;;
+ esac
+ fi
+ rm -rf conftest*
+ ;;
+
+*-*-sco3.2v5*)
+ # On SCO OpenServer 5, we need -belf to get full-featured binaries.
+ SAVE_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -belf"
+ echo "$as_me:$LINENO: checking whether the C compiler needs -belf" >&5
+echo $ECHO_N "checking whether the C compiler needs -belf... $ECHO_C" >&6
+if test "${lt_cv_cc_needs_belf+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+
+
+ ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ lt_cv_cc_needs_belf=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+lt_cv_cc_needs_belf=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+ ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $lt_cv_cc_needs_belf" >&5
+echo "${ECHO_T}$lt_cv_cc_needs_belf" >&6
+ if test x"$lt_cv_cc_needs_belf" != x"yes"; then
+ # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
+ CFLAGS="$SAVE_CFLAGS"
+ fi
+ ;;
+
+
+esac
+
+# Sed substitution that helps us do robust quoting. It backslashifies
+# metacharacters that are still active within double-quoted strings.
+Xsed='sed -e s/^X//'
+sed_quote_subst='s/\([\\"\\`$\\\\]\)/\\\1/g'
+
+# Same as above, but do not quote variable references.
+double_quote_subst='s/\([\\"\\`\\\\]\)/\\\1/g'
+
+# Sed substitution to delay expansion of an escaped shell variable in a
+# double_quote_subst'ed string.
+delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
+
+# Constants:
+rm="rm -f"
+
+# Global variables:
+default_ofile=libtool
+can_build_shared=yes
+
+# All known linkers require a `.a' archive for static linking (except M$VC,
+# which needs '.lib').
+libext=a
+ltmain="$ac_aux_dir/ltmain.sh"
+ofile="$default_ofile"
+with_gnu_ld="$lt_cv_prog_gnu_ld"
+need_locks="$enable_libtool_lock"
+
+old_CC="$CC"
+old_CFLAGS="$CFLAGS"
+
+# Set sane defaults for various variables
+test -z "$AR" && AR=ar
+test -z "$AR_FLAGS" && AR_FLAGS=cru
+test -z "$AS" && AS=as
+test -z "$CC" && CC=cc
+test -z "$DLLTOOL" && DLLTOOL=dlltool
+test -z "$LD" && LD=ld
+test -z "$LN_S" && LN_S="ln -s"
+test -z "$MAGIC_CMD" && MAGIC_CMD=file
+test -z "$NM" && NM=nm
+test -z "$OBJDUMP" && OBJDUMP=objdump
+test -z "$RANLIB" && RANLIB=:
+test -z "$STRIP" && STRIP=:
+test -z "$ac_objext" && ac_objext=o
+
+if test x"$host" != x"$build"; then
+ ac_tool_prefix=${host_alias}-
+else
+ ac_tool_prefix=
+fi
+
+# Transform linux* to *-*-linux-gnu*, to support old configure scripts.
+case $host_os in
+linux-gnu*) ;;
+linux*) host=`echo $host | sed 's/^\(.*-.*-linux\)\(.*\)$/\1-gnu\2/'`
+esac
+
+case $host_os in
+aix3*)
+ # AIX sometimes has problems with the GCC collect2 program. For some
+ # reason, if we set the COLLECT_NAMES environment variable, the problems
+ # vanish in a puff of smoke.
+ if test "X${COLLECT_NAMES+set}" != Xset; then
+ COLLECT_NAMES=
+ export COLLECT_NAMES
+ fi
+ ;;
+esac
+
+# Determine commands to create old-style static archives.
+old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs$old_deplibs'
+old_postinstall_cmds='chmod 644 $oldlib'
+old_postuninstall_cmds=
+
+if test -n "$RANLIB"; then
+ case $host_os in
+ openbsd*)
+ old_postinstall_cmds="\$RANLIB -t \$oldlib~$old_postinstall_cmds"
+ ;;
+ *)
+ old_postinstall_cmds="\$RANLIB \$oldlib~$old_postinstall_cmds"
+ ;;
+ esac
+ old_archive_cmds="$old_archive_cmds~\$RANLIB \$oldlib"
+fi
+
+# Allow CC to be a program name with arguments.
+set dummy $CC
+compiler="$2"
+
+echo "$as_me:$LINENO: checking for objdir" >&5
+echo $ECHO_N "checking for objdir... $ECHO_C" >&6
+rm -f .libs 2>/dev/null
+mkdir .libs 2>/dev/null
+if test -d .libs; then
+ objdir=.libs
+else
+ # MS-DOS does not allow filenames that begin with a dot.
+ objdir=_libs
+fi
+rmdir .libs 2>/dev/null
+echo "$as_me:$LINENO: result: $objdir" >&5
+echo "${ECHO_T}$objdir" >&6
+
+
+
+# Check whether --with-pic or --without-pic was given.
+if test "${with_pic+set}" = set; then
+ withval="$with_pic"
+ pic_mode="$withval"
+else
+ pic_mode=default
+fi;
+test -z "$pic_mode" && pic_mode=default
+
+# We assume here that the value for lt_cv_prog_cc_pic will not be cached
+# in isolation, and that seeing it set (from the cache) indicates that
+# the associated values are set (in the cache) correctly too.
+echo "$as_me:$LINENO: checking for $compiler option to produce PIC" >&5
+echo $ECHO_N "checking for $compiler option to produce PIC... $ECHO_C" >&6
+if test "${lt_cv_prog_cc_pic+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ lt_cv_prog_cc_pic=
+ lt_cv_prog_cc_shlib=
+ lt_cv_prog_cc_wl=
+ lt_cv_prog_cc_static=
+ lt_cv_prog_cc_no_builtin=
+ lt_cv_prog_cc_can_build_shared=$can_build_shared
+
+ if test "$GCC" = yes; then
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-static'
+
+ case $host_os in
+ aix*)
+ # Below there is a dirty hack to force normal static linking with -ldl
+ # The problem is because libdl dynamically linked with both libc and
+ # libC (AIX C++ library), which obviously doesn't included in libraries
+ # list by gcc. This cause undefined symbols with -static flags.
+ # This hack allows C programs to be linked with "-static -ldl", but
+ # not sure about C++ programs.
+ lt_cv_prog_cc_static="$lt_cv_prog_cc_static ${lt_cv_prog_cc_wl}-lC"
+ ;;
+ amigaos*)
+ # FIXME: we need at least 68020 code to build shared libraries, but
+ # adding the `-m68020' flag to GCC prevents building anything better,
+ # like `-m68040'.
+ lt_cv_prog_cc_pic='-m68020 -resident32 -malways-restore-a4'
+ ;;
+ beos* | irix5* | irix6* | osf3* | osf4* | osf5*)
+ # PIC is the default for these OSes.
+ ;;
+ darwin* | rhapsody*)
+ # PIC is the default on this platform
+ # Common symbols not allowed in MH_DYLIB files
+ lt_cv_prog_cc_pic='-fno-common'
+ ;;
+ cygwin* | mingw* | pw32* | os2*)
+ # This hack is so that the source file can tell whether it is being
+ # built for inclusion in a dll (and should export symbols for example).
+ lt_cv_prog_cc_pic='-DDLL_EXPORT'
+ ;;
+ sysv4*MP*)
+ if test -d /usr/nec; then
+ lt_cv_prog_cc_pic=-Kconform_pic
+ fi
+ ;;
+ *)
+ lt_cv_prog_cc_pic='-fPIC'
+ ;;
+ esac
+ else
+ # PORTME Check for PIC flags for the system compiler.
+ case $host_os in
+ aix3* | aix4* | aix5*)
+ lt_cv_prog_cc_wl='-Wl,'
+ # All AIX code is PIC.
+ if test "$host_cpu" = ia64; then
+ # AIX 5 now supports IA64 processor
+ lt_cv_prog_cc_static='-Bstatic'
+ else
+ lt_cv_prog_cc_static='-bnso -bI:/lib/syscalls.exp'
+ fi
+ ;;
+
+ hpux9* | hpux10* | hpux11*)
+ # Is there a better lt_cv_prog_cc_static that works with the bundled CC?
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static="${lt_cv_prog_cc_wl}-a ${lt_cv_prog_cc_wl}archive"
+ lt_cv_prog_cc_pic='+Z'
+ ;;
+
+ irix5* | irix6*)
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-non_shared'
+ # PIC (with -KPIC) is the default.
+ ;;
+
+ cygwin* | mingw* | pw32* | os2*)
+ # This hack is so that the source file can tell whether it is being
+ # built for inclusion in a dll (and should export symbols for example).
+ lt_cv_prog_cc_pic='-DDLL_EXPORT'
+ ;;
+
+ newsos6)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ ;;
+
+ osf3* | osf4* | osf5*)
+ # All OSF/1 code is PIC.
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-non_shared'
+ ;;
+
+ sco3.2v5*)
+ lt_cv_prog_cc_pic='-Kpic'
+ lt_cv_prog_cc_static='-dn'
+ lt_cv_prog_cc_shlib='-belf'
+ ;;
+
+ solaris*)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ lt_cv_prog_cc_wl='-Wl,'
+ ;;
+
+ sunos4*)
+ lt_cv_prog_cc_pic='-PIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ lt_cv_prog_cc_wl='-Qoption ld '
+ ;;
+
+ sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ if test "x$host_vendor" = xsni; then
+ lt_cv_prog_cc_wl='-LD'
+ else
+ lt_cv_prog_cc_wl='-Wl,'
+ fi
+ ;;
+
+ uts4*)
+ lt_cv_prog_cc_pic='-pic'
+ lt_cv_prog_cc_static='-Bstatic'
+ ;;
+
+ sysv4*MP*)
+ if test -d /usr/nec ;then
+ lt_cv_prog_cc_pic='-Kconform_pic'
+ lt_cv_prog_cc_static='-Bstatic'
+ fi
+ ;;
+
+ *)
+ lt_cv_prog_cc_can_build_shared=no
+ ;;
+ esac
+ fi
+
+fi
+
+if test -z "$lt_cv_prog_cc_pic"; then
+ echo "$as_me:$LINENO: result: none" >&5
+echo "${ECHO_T}none" >&6
+else
+ echo "$as_me:$LINENO: result: $lt_cv_prog_cc_pic" >&5
+echo "${ECHO_T}$lt_cv_prog_cc_pic" >&6
+
+ # Check to make sure the pic_flag actually works.
+ echo "$as_me:$LINENO: checking if $compiler PIC flag $lt_cv_prog_cc_pic works" >&5
+echo $ECHO_N "checking if $compiler PIC flag $lt_cv_prog_cc_pic works... $ECHO_C" >&6
+ if test "${lt_cv_prog_cc_pic_works+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS $lt_cv_prog_cc_pic -DPIC"
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ case $host_os in
+ hpux9* | hpux10* | hpux11*)
+ # On HP-UX, both CC and GCC only warn that PIC is supported... then
+ # they create non-PIC objects. So, if there were any warnings, we
+ # assume that PIC is not supported.
+ if test -s conftest.err; then
+ lt_cv_prog_cc_pic_works=no
+ else
+ lt_cv_prog_cc_pic_works=yes
+ fi
+ ;;
+ *)
+ lt_cv_prog_cc_pic_works=yes
+ ;;
+ esac
+
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ lt_cv_prog_cc_pic_works=no
+
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$save_CFLAGS"
+
+fi
+
+
+ if test "X$lt_cv_prog_cc_pic_works" = Xno; then
+ lt_cv_prog_cc_pic=
+ lt_cv_prog_cc_can_build_shared=no
+ else
+ lt_cv_prog_cc_pic=" $lt_cv_prog_cc_pic"
+ fi
+
+ echo "$as_me:$LINENO: result: $lt_cv_prog_cc_pic_works" >&5
+echo "${ECHO_T}$lt_cv_prog_cc_pic_works" >&6
+fi
+
+# Check for any special shared library compilation flags.
+if test -n "$lt_cv_prog_cc_shlib"; then
+ { echo "$as_me:$LINENO: WARNING: \`$CC' requires \`$lt_cv_prog_cc_shlib' to build shared libraries" >&5
+echo "$as_me: WARNING: \`$CC' requires \`$lt_cv_prog_cc_shlib' to build shared libraries" >&2;}
+ if echo "$old_CC $old_CFLAGS " | egrep -e "[ ]$lt_cv_prog_cc_shlib[ ]" >/dev/null; then :
+ else
+ { echo "$as_me:$LINENO: WARNING: add \`$lt_cv_prog_cc_shlib' to the CC or CFLAGS env variable and reconfigure" >&5
+echo "$as_me: WARNING: add \`$lt_cv_prog_cc_shlib' to the CC or CFLAGS env variable and reconfigure" >&2;}
+ lt_cv_prog_cc_can_build_shared=no
+ fi
+fi
+
+echo "$as_me:$LINENO: checking if $compiler static flag $lt_cv_prog_cc_static works" >&5
+echo $ECHO_N "checking if $compiler static flag $lt_cv_prog_cc_static works... $ECHO_C" >&6
+if test "${lt_cv_prog_cc_static_works+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ lt_cv_prog_cc_static_works=no
+ save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS $lt_cv_prog_cc_static"
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ lt_cv_prog_cc_static_works=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+ LDFLAGS="$save_LDFLAGS"
+
+fi
+
+
+# Belt *and* braces to stop my trousers falling down:
+test "X$lt_cv_prog_cc_static_works" = Xno && lt_cv_prog_cc_static=
+echo "$as_me:$LINENO: result: $lt_cv_prog_cc_static_works" >&5
+echo "${ECHO_T}$lt_cv_prog_cc_static_works" >&6
+
+pic_flag="$lt_cv_prog_cc_pic"
+special_shlib_compile_flags="$lt_cv_prog_cc_shlib"
+wl="$lt_cv_prog_cc_wl"
+link_static_flag="$lt_cv_prog_cc_static"
+no_builtin_flag="$lt_cv_prog_cc_no_builtin"
+can_build_shared="$lt_cv_prog_cc_can_build_shared"
+
+
+# Check to see if options -o and -c are simultaneously supported by compiler
+echo "$as_me:$LINENO: checking if $compiler supports -c -o file.$ac_objext" >&5
+echo $ECHO_N "checking if $compiler supports -c -o file.$ac_objext... $ECHO_C" >&6
+if test "${lt_cv_compiler_c_o+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+
+$rm -r conftest 2>/dev/null
+mkdir conftest
+cd conftest
+echo "int some_variable = 0;" > conftest.$ac_ext
+mkdir out
+# According to Tom Tromey, Ian Lance Taylor reported there are C compilers
+# that will create temporary files in the current directory regardless of
+# the output directory. Thus, making CWD read-only will cause this test
+# to fail, enabling locking or at least warning the user not to do parallel
+# builds.
+chmod -w .
+save_CFLAGS="$CFLAGS"
+CFLAGS="$CFLAGS -o out/conftest2.$ac_objext"
+compiler_c_o=no
+if { (eval echo configure:5874: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>out/conftest.err; } && test -s out/conftest2.$ac_objext; then
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s out/conftest.err; then
+ lt_cv_compiler_c_o=no
+ else
+ lt_cv_compiler_c_o=yes
+ fi
+else
+ # Append any errors to the config.log.
+ cat out/conftest.err 1>&5
+ lt_cv_compiler_c_o=no
+fi
+CFLAGS="$save_CFLAGS"
+chmod u+w .
+$rm conftest* out/*
+rmdir out
+cd ..
+rmdir conftest
+$rm -r conftest 2>/dev/null
+
+fi
+
+compiler_c_o=$lt_cv_compiler_c_o
+echo "$as_me:$LINENO: result: $compiler_c_o" >&5
+echo "${ECHO_T}$compiler_c_o" >&6
+
+if test x"$compiler_c_o" = x"yes"; then
+ # Check to see if we can write to a .lo
+ echo "$as_me:$LINENO: checking if $compiler supports -c -o file.lo" >&5
+echo $ECHO_N "checking if $compiler supports -c -o file.lo... $ECHO_C" >&6
+ if test "${lt_cv_compiler_o_lo+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+
+ lt_cv_compiler_o_lo=no
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -c -o conftest.lo"
+ save_objext="$ac_objext"
+ ac_objext=lo
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+int some_variable = 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s conftest.err; then
+ lt_cv_compiler_o_lo=no
+ else
+ lt_cv_compiler_o_lo=yes
+ fi
+
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+ ac_objext="$save_objext"
+ CFLAGS="$save_CFLAGS"
+
+fi
+
+ compiler_o_lo=$lt_cv_compiler_o_lo
+ echo "$as_me:$LINENO: result: $compiler_o_lo" >&5
+echo "${ECHO_T}$compiler_o_lo" >&6
+else
+ compiler_o_lo=no
+fi
+
+# Check to see if we can do hard links to lock some files if needed
+hard_links="nottested"
+if test "$compiler_c_o" = no && test "$need_locks" != no; then
+ # do not overwrite the value of need_locks provided by the user
+ echo "$as_me:$LINENO: checking if we can lock with hard links" >&5
+echo $ECHO_N "checking if we can lock with hard links... $ECHO_C" >&6
+ hard_links=yes
+ $rm conftest*
+ ln conftest.a conftest.b 2>/dev/null && hard_links=no
+ touch conftest.a
+ ln conftest.a conftest.b 2>&5 || hard_links=no
+ ln conftest.a conftest.b 2>/dev/null && hard_links=no
+ echo "$as_me:$LINENO: result: $hard_links" >&5
+echo "${ECHO_T}$hard_links" >&6
+ if test "$hard_links" = no; then
+ { echo "$as_me:$LINENO: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5
+echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;}
+ need_locks=warn
+ fi
+else
+ need_locks=no
+fi
+
+if test "$GCC" = yes; then
+ # Check to see if options -fno-rtti -fno-exceptions are supported by compiler
+ echo "$as_me:$LINENO: checking if $compiler supports -fno-rtti -fno-exceptions" >&5
+echo $ECHO_N "checking if $compiler supports -fno-rtti -fno-exceptions... $ECHO_C" >&6
+ echo "int some_variable = 0;" > conftest.$ac_ext
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -fno-rtti -fno-exceptions -c conftest.$ac_ext"
+ compiler_rtti_exceptions=no
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+int some_variable = 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s conftest.err; then
+ compiler_rtti_exceptions=no
+ else
+ compiler_rtti_exceptions=yes
+ fi
+
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+ CFLAGS="$save_CFLAGS"
+ echo "$as_me:$LINENO: result: $compiler_rtti_exceptions" >&5
+echo "${ECHO_T}$compiler_rtti_exceptions" >&6
+
+ if test "$compiler_rtti_exceptions" = "yes"; then
+ no_builtin_flag=' -fno-builtin -fno-rtti -fno-exceptions'
+ else
+ no_builtin_flag=' -fno-builtin'
+ fi
+fi
+
+# See if the linker supports building shared libraries.
+echo "$as_me:$LINENO: checking whether the linker ($LD) supports shared libraries" >&5
+echo $ECHO_N "checking whether the linker ($LD) supports shared libraries... $ECHO_C" >&6
+
+allow_undefined_flag=
+no_undefined_flag=
+need_lib_prefix=unknown
+need_version=unknown
+# when you set need_version to no, make sure it does not cause -set_version
+# flags to be left without arguments
+archive_cmds=
+archive_expsym_cmds=
+old_archive_from_new_cmds=
+old_archive_from_expsyms_cmds=
+export_dynamic_flag_spec=
+whole_archive_flag_spec=
+thread_safe_flag_spec=
+hardcode_into_libs=no
+hardcode_libdir_flag_spec=
+hardcode_libdir_separator=
+hardcode_direct=no
+hardcode_minus_L=no
+hardcode_shlibpath_var=unsupported
+runpath_var=
+link_all_deplibs=unknown
+always_export_symbols=no
+export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | sed '\''s/.* //'\'' | sort | uniq > $export_symbols'
+# include_expsyms should be a list of space-separated symbols to be *always*
+# included in the symbol list
+include_expsyms=
+# exclude_expsyms can be an egrep regular expression of symbols to exclude
+# it will be wrapped by ` (' and `)$', so one must not match beginning or
+# end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
+# as well as any symbol that contains `d'.
+exclude_expsyms="_GLOBAL_OFFSET_TABLE_"
+# Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
+# platforms (ab)use it in PIC code, but their linkers get confused if
+# the symbol is explicitly referenced. Since portable code cannot
+# rely on this symbol name, it's probably fine to never include it in
+# preloaded symbol tables.
+extract_expsyms_cmds=
+
+case $host_os in
+cygwin* | mingw* | pw32*)
+ # FIXME: the MSVC++ port hasn't been tested in a loooong time
+ # When not using gcc, we currently assume that we are using
+ # Microsoft Visual C++.
+ if test "$GCC" != yes; then
+ with_gnu_ld=no
+ fi
+ ;;
+openbsd*)
+ with_gnu_ld=no
+ ;;
+esac
+
+ld_shlibs=yes
+if test "$with_gnu_ld" = yes; then
+ # If archive_cmds runs LD, not CC, wlarc should be empty
+ wlarc='${wl}'
+
+ # See if GNU ld supports shared libraries.
+ case $host_os in
+ aix3* | aix4* | aix5*)
+ # On AIX, the GNU linker is very broken
+ # Note:Check GNU linker on AIX 5-IA64 when/if it becomes available.
+ ld_shlibs=no
+ cat <<EOF 1>&2
+
+*** Warning: the GNU linker, at least up to release 2.9.1, is reported
+*** to be unable to reliably create shared libraries on AIX.
+*** Therefore, libtool is disabling shared libraries support. If you
+*** really care for shared libraries, you may want to modify your PATH
+*** so that a non-GNU linker is found, and then restart.
+
+EOF
+ ;;
+
+ amigaos*)
+ archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+
+ # Samuel A. Falvo II <kc5tja@dolphin.openprojects.net> reports
+ # that the semantics of dynamic libraries on AmigaOS, at least up
+ # to version 4, is to share data among multiple programs linked
+ # with the same dynamic library. Since this doesn't match the
+ # behavior of shared libraries on other platforms, we can use
+ # them.
+ ld_shlibs=no
+ ;;
+
+ beos*)
+ if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ allow_undefined_flag=unsupported
+ # Joseph Beckenbach <jrb3@best.com> says some releases of gcc
+ # support --undefined. This deserves some investigation. FIXME
+ archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ # hardcode_libdir_flag_spec is actually meaningless, as there is
+ # no search path for DLLs.
+ hardcode_libdir_flag_spec='-L$libdir'
+ allow_undefined_flag=unsupported
+ always_export_symbols=yes
+
+ extract_expsyms_cmds='test -f $output_objdir/impgen.c || \
+ sed -e "/^# \/\* impgen\.c starts here \*\//,/^# \/\* impgen.c ends here \*\// { s/^# //;s/^# *$//; p; }" -e d < $''0 > $output_objdir/impgen.c~
+ test -f $output_objdir/impgen.exe || (cd $output_objdir && \
+ if test "x$HOST_CC" != "x" ; then $HOST_CC -o impgen impgen.c ; \
+ else $CC -o impgen impgen.c ; fi)~
+ $output_objdir/impgen $dir/$soroot > $output_objdir/$soname-def'
+
+ old_archive_from_expsyms_cmds='$DLLTOOL --as=$AS --dllname $soname --def $output_objdir/$soname-def --output-lib $output_objdir/$newlib'
+
+ # cygwin and mingw dlls have different entry points and sets of symbols
+ # to exclude.
+ # FIXME: what about values for MSVC?
+ dll_entry=__cygwin_dll_entry@12
+ dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12~
+ case $host_os in
+ mingw*)
+ # mingw values
+ dll_entry=_DllMainCRTStartup@12
+ dll_exclude_symbols=DllMain@12,DllMainCRTStartup@12,DllEntryPoint@12~
+ ;;
+ esac
+
+ # mingw and cygwin differ, and it's simplest to just exclude the union
+ # of the two symbol sets.
+ dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12,DllMainCRTStartup@12,DllEntryPoint@12
+
+ # recent cygwin and mingw systems supply a stub DllMain which the user
+ # can override, but on older systems we have to supply one (in ltdll.c)
+ if test "x$lt_cv_need_dllmain" = "xyes"; then
+ ltdll_obj='$output_objdir/$soname-ltdll.'"$ac_objext "
+ ltdll_cmds='test -f $output_objdir/$soname-ltdll.c || sed -e "/^# \/\* ltdll\.c starts here \*\//,/^# \/\* ltdll.c ends here \*\// { s/^# //; p; }" -e d < $''0 > $output_objdir/$soname-ltdll.c~
+ test -f $output_objdir/$soname-ltdll.$ac_objext || (cd $output_objdir && $CC -c $soname-ltdll.c)~'
+ else
+ ltdll_obj=
+ ltdll_cmds=
+ fi
+
+ # Extract the symbol export list from an `--export-all' def file,
+ # then regenerate the def file from the symbol export list, so that
+ # the compiled dll only exports the symbol export list.
+ # Be careful not to strip the DATA tag left be newer dlltools.
+ export_symbols_cmds="$ltdll_cmds"'
+ $DLLTOOL --export-all --exclude-symbols '$dll_exclude_symbols' --output-def $output_objdir/$soname-def '$ltdll_obj'$libobjs $convenience~
+ sed -e "1,/EXPORTS/d" -e "s/ @ [0-9]*//" -e "s/ *;.*$//" < $output_objdir/$soname-def > $export_symbols'
+
+ # If the export-symbols file already is a .def file (1st line
+ # is EXPORTS), use it as is.
+ # If DATA tags from a recent dlltool are present, honour them!
+ archive_expsym_cmds='if test "x`head -1 $export_symbols`" = xEXPORTS; then
+ cp $export_symbols $output_objdir/$soname-def;
+ else
+ echo EXPORTS > $output_objdir/$soname-def;
+ _lt_hint=1;
+ cat $export_symbols | while read symbol; do
+ set dummy \$symbol;
+ case \$# in
+ 2) echo " \$2 @ \$_lt_hint ; " >> $output_objdir/$soname-def;;
+ *) echo " \$2 @ \$_lt_hint \$3 ; " >> $output_objdir/$soname-def;;
+ esac;
+ _lt_hint=`expr 1 + \$_lt_hint`;
+ done;
+ fi~
+ '"$ltdll_cmds"'
+ $CC -Wl,--base-file,$output_objdir/$soname-base '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags~
+ $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp~
+ $CC -Wl,--base-file,$output_objdir/$soname-base $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags~
+ $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp --output-lib $output_objdir/$libname.dll.a~
+ $CC $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags'
+ ;;
+
+ netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
+ wlarc=
+ else
+ archive_cmds='$CC -shared -nodefaultlibs $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared -nodefaultlibs $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ fi
+ ;;
+
+ solaris* | sysv5*)
+ if $LD -v 2>&1 | egrep 'BFD 2\.8' > /dev/null; then
+ ld_shlibs=no
+ cat <<EOF 1>&2
+
+*** Warning: The releases 2.8.* of the GNU linker cannot reliably
+*** create shared libraries on Solaris systems. Therefore, libtool
+*** is disabling shared libraries support. We urge you to upgrade GNU
+*** binutils to release 2.9.1 or newer. Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+EOF
+ elif $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+
+ sunos4*)
+ archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ wlarc=
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ *)
+ if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+ esac
+
+ if test "$ld_shlibs" = yes; then
+ runpath_var=LD_RUN_PATH
+ hardcode_libdir_flag_spec='${wl}--rpath ${wl}$libdir'
+ export_dynamic_flag_spec='${wl}--export-dynamic'
+ case $host_os in
+ cygwin* | mingw* | pw32*)
+ # dlltool doesn't understand --whole-archive et. al.
+ whole_archive_flag_spec=
+ ;;
+ *)
+ # ancient GNU ld didn't support --whole-archive et. al.
+ if $LD --help 2>&1 | egrep 'no-whole-archive' > /dev/null; then
+ whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
+ else
+ whole_archive_flag_spec=
+ fi
+ ;;
+ esac
+ fi
+else
+ # PORTME fill in a description of your system's linker (not GNU ld)
+ case $host_os in
+ aix3*)
+ allow_undefined_flag=unsupported
+ always_export_symbols=yes
+ archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
+ # Note: this linker hardcodes the directories in LIBPATH if there
+ # are no directories specified by -L.
+ hardcode_minus_L=yes
+ if test "$GCC" = yes && test -z "$link_static_flag"; then
+ # Neither direct hardcoding nor static linking is supported with a
+ # broken collect2.
+ hardcode_direct=unsupported
+ fi
+ ;;
+
+ aix4* | aix5*)
+ if test "$host_cpu" = ia64; then
+ # On IA64, the linker does run time linking by default, so we don't
+ # have to do anything special.
+ aix_use_runtimelinking=no
+ exp_sym_flag='-Bexport'
+ no_entry_flag=""
+ else
+ aix_use_runtimelinking=no
+
+ # Test if we are trying to use run time linking or normal
+ # AIX style linking. If -brtl is somewhere in LDFLAGS, we
+ # need to do runtime linking.
+ case $host_os in aix4.[23]|aix4.[23].*|aix5*)
+ for ld_flag in $LDFLAGS; do
+ if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
+ aix_use_runtimelinking=yes
+ break
+ fi
+ done
+ esac
+
+ exp_sym_flag='-bexport'
+ no_entry_flag='-bnoentry'
+ fi
+
+ # When large executables or shared objects are built, AIX ld can
+ # have problems creating the table of contents. If linking a library
+ # or program results in "error TOC overflow" add -mminimal-toc to
+ # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
+ # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
+
+ hardcode_direct=yes
+ archive_cmds=''
+ hardcode_libdir_separator=':'
+ if test "$GCC" = yes; then
+ case $host_os in aix4.[012]|aix4.[012].*)
+ collect2name=`${CC} -print-prog-name=collect2`
+ if test -f "$collect2name" && \
+ strings "$collect2name" | grep resolve_lib_name >/dev/null
+ then
+ # We have reworked collect2
+ hardcode_direct=yes
+ else
+ # We have old collect2
+ hardcode_direct=unsupported
+ # It fails to find uninstalled libraries when the uninstalled
+ # path is not listed in the libpath. Setting hardcode_minus_L
+ # to unsupported forces relinking
+ hardcode_minus_L=yes
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_libdir_separator=
+ fi
+ esac
+
+ shared_flag='-shared'
+ else
+ # not using gcc
+ if test "$host_cpu" = ia64; then
+ shared_flag='${wl}-G'
+ else
+ if test "$aix_use_runtimelinking" = yes; then
+ shared_flag='${wl}-G'
+ else
+ shared_flag='${wl}-bM:SRE'
+ fi
+ fi
+ fi
+
+ # It seems that -bexpall can do strange things, so it is better to
+ # generate a list of symbols to export.
+ always_export_symbols=yes
+ if test "$aix_use_runtimelinking" = yes; then
+ # Warning - without using the other runtime loading flags (-brtl),
+ # -berok will link without error, but may produce a broken library.
+ allow_undefined_flag='-berok'
+ hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:/usr/lib:/lib'
+ archive_expsym_cmds="\$CC"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then echo "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols $shared_flag"
+ else
+ if test "$host_cpu" = ia64; then
+ hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib'
+ allow_undefined_flag="-z nodefs"
+ archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname ${wl}-h$soname $libobjs $deplibs $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols"
+ else
+ hardcode_libdir_flag_spec='${wl}-bnolibpath ${wl}-blibpath:$libdir:/usr/lib:/lib'
+ # Warning - without using the other run time loading flags,
+ # -berok will link without error, but may produce a broken library.
+ allow_undefined_flag='${wl}-berok'
+ # This is a bit strange, but is similar to how AIX traditionally builds
+ # it's shared libraries.
+ archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags ${allow_undefined_flag} '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols"' ~$AR -crlo $objdir/$libname$release.a $objdir/$soname'
+ fi
+ fi
+ ;;
+
+ amigaos*)
+ archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+ # see comment about different semantics on the GNU ld section
+ ld_shlibs=no
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ # When not using gcc, we currently assume that we are using
+ # Microsoft Visual C++.
+ # hardcode_libdir_flag_spec is actually meaningless, as there is
+ # no search path for DLLs.
+ hardcode_libdir_flag_spec=' '
+ allow_undefined_flag=unsupported
+ # Tell ltmain to make .lib files, not .a files.
+ libext=lib
+ # FIXME: Setting linknames here is a bad hack.
+ archive_cmds='$CC -o $lib $libobjs $compiler_flags `echo "$deplibs" | sed -e '\''s/ -lc$//'\''` -link -dll~linknames='
+ # The linker will automatically build a .lib file if we build a DLL.
+ old_archive_from_new_cmds='true'
+ # FIXME: Should let the user specify the lib program.
+ old_archive_cmds='lib /OUT:$oldlib$oldobjs$old_deplibs'
+ fix_srcfile_path='`cygpath -w "$srcfile"`'
+ ;;
+
+ darwin* | rhapsody*)
+ case "$host_os" in
+ rhapsody* | darwin1.[012])
+ allow_undefined_flag='-undefined suppress'
+ ;;
+ *) # Darwin 1.3 on
+ allow_undefined_flag='-flat_namespace -undefined suppress'
+ ;;
+ esac
+ # FIXME: Relying on posixy $() will cause problems for
+ # cross-compilation, but unfortunately the echo tests do not
+ # yet detect zsh echo's removal of \ escapes.
+ archive_cmds='$nonopt $(test "x$module" = xyes && echo -bundle || echo -dynamiclib) $allow_undefined_flag -o $lib $libobjs $deplibs$linker_flags -install_name $rpath/$soname $verstring'
+ # We need to add '_' to the symbols in $export_symbols first
+ #archive_expsym_cmds="$archive_cmds"' && strip -s $export_symbols'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ whole_archive_flag_spec='-all_load $convenience'
+ ;;
+
+ freebsd1*)
+ ld_shlibs=no
+ ;;
+
+ # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
+ # support. Future versions do this automatically, but an explicit c++rt0.o
+ # does not break anything, and helps significantly (at the cost of a little
+ # extra space).
+ freebsd2.2*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ # Unfortunately, older versions of FreeBSD 2 do not have this feature.
+ freebsd2*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
+ freebsd*)
+ archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ hpux9* | hpux10* | hpux11*)
+ case $host_os in
+ hpux9*) archive_cmds='$rm $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' ;;
+ *) archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' ;;
+ esac
+ hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+ hardcode_libdir_separator=:
+ hardcode_direct=yes
+ hardcode_minus_L=yes # Not in the search PATH, but as the default
+ # location of the library.
+ export_dynamic_flag_spec='${wl}-E'
+ ;;
+
+ irix5* | irix6*)
+ if test "$GCC" = yes; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ else
+ archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ fi
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ link_all_deplibs=yes
+ ;;
+
+ netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out
+ else
+ archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF
+ fi
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ newsos6)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ hardcode_shlibpath_var=no
+ ;;
+
+ openbsd*)
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+ export_dynamic_flag_spec='${wl}-E'
+ else
+ case "$host_os" in
+ openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-R$libdir'
+ ;;
+ *)
+ archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+ ;;
+ esac
+ fi
+ ;;
+
+ os2*)
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+ allow_undefined_flag=unsupported
+ archive_cmds='$echo "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$echo "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$echo DATA >> $output_objdir/$libname.def~$echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~$echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
+ old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
+ ;;
+
+ osf3*)
+ if test "$GCC" = yes; then
+ allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+ archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ else
+ allow_undefined_flag=' -expect_unresolved \*'
+ archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ fi
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ ;;
+
+ osf4* | osf5*) # as osf3* with the addition of -msym flag
+ if test "$GCC" = yes; then
+ allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+ archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ else
+ allow_undefined_flag=' -expect_unresolved \*'
+ archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ archive_expsym_cmds='for i in `cat $export_symbols`; do printf "-exported_symbol " >> $lib.exp; echo "\$i" >> $lib.exp; done; echo "-hidden">> $lib.exp~
+ $LD -shared${allow_undefined_flag} -input $lib.exp $linker_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${objdir}/so_locations -o $lib~$rm $lib.exp'
+
+ #Both c and cxx compiler support -rpath directly
+ hardcode_libdir_flag_spec='-rpath $libdir'
+ fi
+ hardcode_libdir_separator=:
+ ;;
+
+ sco3.2v5*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ runpath_var=LD_RUN_PATH
+ hardcode_runpath_var=yes
+ export_dynamic_flag_spec='${wl}-Bexport'
+ ;;
+
+ solaris*)
+ # gcc --version < 3.0 without binutils cannot create self contained
+ # shared libraries reliably, requiring libgcc.a to resolve some of
+ # the object symbols generated in some cases. Libraries that use
+ # assert need libgcc.a to resolve __eprintf, for example. Linking
+ # a copy of libgcc.a into every shared library to guarantee resolving
+ # such symbols causes other problems: According to Tim Van Holder
+ # <tim.van.holder@pandora.be>, C++ libraries end up with a separate
+ # (to the application) exception stack for one thing.
+ no_undefined_flag=' -z defs'
+ if test "$GCC" = yes; then
+ case `$CC --version 2>/dev/null` in
+ [12].*)
+ cat <<EOF 1>&2
+
+*** Warning: Releases of GCC earlier than version 3.0 cannot reliably
+*** create self contained shared libraries on Solaris systems, without
+*** introducing a dependency on libgcc.a. Therefore, libtool is disabling
+*** -no-undefined support, which will at least allow you to build shared
+*** libraries. However, you may find that when you link such libraries
+*** into an application without using GCC, you have to manually add
+*** \`gcc --print-libgcc-file-name\` to the link command. We urge you to
+*** upgrade to a newer version of GCC. Another option is to rebuild your
+*** current GCC to use the GNU linker from GNU binutils 2.9.1 or newer.
+
+EOF
+ no_undefined_flag=
+ ;;
+ esac
+ fi
+ # $CC -shared without GNU ld will not create a library from C++
+ # object files and a static libstdc++, better avoid it by now
+ archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
+ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_shlibpath_var=no
+ case $host_os in
+ solaris2.[0-5] | solaris2.[0-5].*) ;;
+ *) # Supported since Solaris 2.6 (maybe 2.5.1?)
+ whole_archive_flag_spec='-z allextract$convenience -z defaultextract' ;;
+ esac
+ link_all_deplibs=yes
+ ;;
+
+ sunos4*)
+ if test "x$host_vendor" = xsequent; then
+ # Use $CC to link under sequent, because it throws in some extra .o
+ # files that make .init and .fini sections work.
+ archive_cmds='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags'
+ else
+ archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
+ fi
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4)
+ if test "x$host_vendor" = xsno; then
+ archive_cmds='$LD -G -Bsymbolic -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes # is this really true???
+ else
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=no #Motorola manual says yes, but my tests say they lie
+ fi
+ runpath_var='LD_RUN_PATH'
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4.3*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ export_dynamic_flag_spec='-Bexport'
+ ;;
+
+ sysv5*)
+ no_undefined_flag=' -z text'
+ # $CC -shared without GNU ld will not create a library from C++
+ # object files and a static libstdc++, better avoid it by now
+ archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
+ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
+ hardcode_libdir_flag_spec=
+ hardcode_shlibpath_var=no
+ runpath_var='LD_RUN_PATH'
+ ;;
+
+ uts4*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_shlibpath_var=no
+ ;;
+
+ dgux*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4*MP*)
+ if test -d /usr/nec; then
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ runpath_var=LD_RUN_PATH
+ hardcode_runpath_var=yes
+ ld_shlibs=yes
+ fi
+ ;;
+
+ sysv4.2uw2*)
+ archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_minus_L=no
+ hardcode_shlibpath_var=no
+ hardcode_runpath_var=yes
+ runpath_var=LD_RUN_PATH
+ ;;
+
+ sysv5uw7* | unixware7*)
+ no_undefined_flag='${wl}-z ${wl}text'
+ if test "$GCC" = yes; then
+ archive_cmds='$CC -shared ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
+ else
+ archive_cmds='$CC -G ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
+ fi
+ runpath_var='LD_RUN_PATH'
+ hardcode_shlibpath_var=no
+ ;;
+
+ *)
+ ld_shlibs=no
+ ;;
+ esac
+fi
+echo "$as_me:$LINENO: result: $ld_shlibs" >&5
+echo "${ECHO_T}$ld_shlibs" >&6
+test "$ld_shlibs" = no && can_build_shared=no
+
+# Check hardcoding attributes.
+echo "$as_me:$LINENO: checking how to hardcode library paths into programs" >&5
+echo $ECHO_N "checking how to hardcode library paths into programs... $ECHO_C" >&6
+hardcode_action=
+if test -n "$hardcode_libdir_flag_spec" || \
+ test -n "$runpath_var"; then
+
+ # We can hardcode non-existant directories.
+ if test "$hardcode_direct" != no &&
+ # If the only mechanism to avoid hardcoding is shlibpath_var, we
+ # have to relink, otherwise we might link with an installed library
+ # when we should be linking with a yet-to-be-installed one
+ ## test "$hardcode_shlibpath_var" != no &&
+ test "$hardcode_minus_L" != no; then
+ # Linking always hardcodes the temporary library directory.
+ hardcode_action=relink
+ else
+ # We can link without hardcoding, and we can hardcode nonexisting dirs.
+ hardcode_action=immediate
+ fi
+else
+ # We cannot hardcode anything, or else we can only hardcode existing
+ # directories.
+ hardcode_action=unsupported
+fi
+echo "$as_me:$LINENO: result: $hardcode_action" >&5
+echo "${ECHO_T}$hardcode_action" >&6
+
+striplib=
+old_striplib=
+echo "$as_me:$LINENO: checking whether stripping libraries is possible" >&5
+echo $ECHO_N "checking whether stripping libraries is possible... $ECHO_C" >&6
+if test -n "$STRIP" && $STRIP -V 2>&1 | grep "GNU strip" >/dev/null; then
+ test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
+ test -z "$striplib" && striplib="$STRIP --strip-unneeded"
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+reload_cmds='$LD$reload_flag -o $output$reload_objs'
+test -z "$deplibs_check_method" && deplibs_check_method=unknown
+
+# PORTME Fill in your ld.so characteristics
+echo "$as_me:$LINENO: checking dynamic linker characteristics" >&5
+echo $ECHO_N "checking dynamic linker characteristics... $ECHO_C" >&6
+library_names_spec=
+libname_spec='lib$name'
+soname_spec=
+postinstall_cmds=
+postuninstall_cmds=
+finish_cmds=
+finish_eval=
+shlibpath_var=
+shlibpath_overrides_runpath=unknown
+version_type=none
+dynamic_linker="$host_os ld.so"
+sys_lib_dlsearch_path_spec="/lib /usr/lib"
+sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+
+case $host_os in
+aix3*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix $libname.a'
+ shlibpath_var=LIBPATH
+
+ # AIX has no versioning support, so we append a major version to the name.
+ soname_spec='${libname}${release}.so$major'
+ ;;
+
+aix4* | aix5*)
+ version_type=linux
+ if test "$host_cpu" = ia64; then
+ # AIX 5 supports IA64
+ library_names_spec='${libname}${release}.so$major ${libname}${release}.so$versuffix $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ else
+ # With GCC up to 2.95.x, collect2 would create an import file
+ # for dependence libraries. The import file would start with
+ # the line `#! .'. This would cause the generated library to
+ # depend on `.', always an invalid library. This was fixed in
+ # development snapshots of GCC prior to 3.0.
+ case $host_os in
+ aix4 | aix4.[01] | aix4.[01].*)
+ if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
+ echo ' yes '
+ echo '#endif'; } | ${CC} -E - | grep yes > /dev/null; then
+ :
+ else
+ can_build_shared=no
+ fi
+ ;;
+ esac
+ # AIX (on Power*) has no versioning support, so currently we can
+ # not hardcode correct soname into executable. Probably we can
+ # add versioning support to collect2, so additional links can
+ # be useful in future.
+ if test "$aix_use_runtimelinking" = yes; then
+ # If using run time linking (on AIX 4.2 or later) use lib<name>.so
+ # instead of lib<name>.a to let people know that these are not
+ # typical AIX shared libraries.
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ else
+ # We preserve .a as extension for shared libraries through AIX4.2
+ # and later when we are not doing run time linking.
+ library_names_spec='${libname}${release}.a $libname.a'
+ soname_spec='${libname}${release}.so$major'
+ fi
+ shlibpath_var=LIBPATH
+ fi
+ ;;
+
+amigaos*)
+ library_names_spec='$libname.ixlibrary $libname.a'
+ # Create ${libname}_ixlibrary.a entries in /sys/libs.
+ finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "(cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a)"; (cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a) || exit 1; done'
+ ;;
+
+beos*)
+ library_names_spec='${libname}.so'
+ dynamic_linker="$host_os ld.so"
+ shlibpath_var=LIBRARY_PATH
+ ;;
+
+bsdi4*)
+ version_type=linux
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
+ sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
+ export_dynamic_flag_spec=-rdynamic
+ # the default ld.so.conf also contains /usr/contrib/lib and
+ # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
+ # libtool to hard-code these into programs
+ ;;
+
+cygwin* | mingw* | pw32*)
+ version_type=windows
+ need_version=no
+ need_lib_prefix=no
+ case $GCC,$host_os in
+ yes,cygwin*)
+ library_names_spec='$libname.dll.a'
+ soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll'
+ postinstall_cmds='dlpath=`bash 2>&1 -c '\''. $dir/${file}i;echo \$dlname'\''`~
+ dldir=$destdir/`dirname \$dlpath`~
+ test -d \$dldir || mkdir -p \$dldir~
+ $install_prog .libs/$dlname \$dldir/$dlname'
+ postuninstall_cmds='dldll=`bash 2>&1 -c '\''. $file; echo \$dlname'\''`~
+ dlpath=$dir/\$dldll~
+ $rm \$dlpath'
+ ;;
+ yes,mingw*)
+ library_names_spec='${libname}`echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll'
+ sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | sed -e "s/^libraries://" -e "s/;/ /g"`
+ ;;
+ yes,pw32*)
+ library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | sed -e 's/./-/g'`${versuffix}.dll'
+ ;;
+ *)
+ library_names_spec='${libname}`echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll $libname.lib'
+ ;;
+ esac
+ dynamic_linker='Win32 ld.exe'
+ # FIXME: first we should search . and the directory the executable is in
+ shlibpath_var=PATH
+ ;;
+
+darwin* | rhapsody*)
+ dynamic_linker="$host_os dyld"
+ version_type=darwin
+ need_lib_prefix=no
+ need_version=no
+ # FIXME: Relying on posixy $() will cause problems for
+ # cross-compilation, but unfortunately the echo tests do not
+ # yet detect zsh echo's removal of \ escapes.
+ library_names_spec='${libname}${release}${versuffix}.$(test .$module = .yes && echo so || echo dylib) ${libname}${release}${major}.$(test .$module = .yes && echo so || echo dylib) ${libname}.$(test .$module = .yes && echo so || echo dylib)'
+ soname_spec='${libname}${release}${major}.$(test .$module = .yes && echo so || echo dylib)'
+ shlibpath_overrides_runpath=yes
+ shlibpath_var=DYLD_LIBRARY_PATH
+ ;;
+
+freebsd1*)
+ dynamic_linker=no
+ ;;
+
+freebsd*)
+ objformat=`test -x /usr/bin/objformat && /usr/bin/objformat || echo aout`
+ version_type=freebsd-$objformat
+ case $version_type in
+ freebsd-elf*)
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
+ need_version=no
+ need_lib_prefix=no
+ ;;
+ freebsd-*)
+ library_names_spec='${libname}${release}.so$versuffix $libname.so$versuffix'
+ need_version=yes
+ ;;
+ esac
+ shlibpath_var=LD_LIBRARY_PATH
+ case $host_os in
+ freebsd2*)
+ shlibpath_overrides_runpath=yes
+ ;;
+ *)
+ shlibpath_overrides_runpath=no
+ hardcode_into_libs=yes
+ ;;
+ esac
+ ;;
+
+gnu*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so${major} ${libname}.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ hardcode_into_libs=yes
+ ;;
+
+hpux9* | hpux10* | hpux11*)
+ # Give a soname corresponding to the major version so that dld.sl refuses to
+ # link against other versions.
+ dynamic_linker="$host_os dld.sl"
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ shlibpath_var=SHLIB_PATH
+ shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
+ library_names_spec='${libname}${release}.sl$versuffix ${libname}${release}.sl$major $libname.sl'
+ soname_spec='${libname}${release}.sl$major'
+ # HP-UX runs *really* slowly unless shared libraries are mode 555.
+ postinstall_cmds='chmod 555 $lib'
+ ;;
+
+irix5* | irix6*)
+ version_type=irix
+ need_lib_prefix=no
+ need_version=no
+ soname_spec='${libname}${release}.so$major'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major ${libname}${release}.so $libname.so'
+ case $host_os in
+ irix5*)
+ libsuff= shlibsuff=
+ ;;
+ *)
+ case $LD in # libtool.m4 will add one of these switches to LD
+ *-32|*"-32 ") libsuff= shlibsuff= libmagic=32-bit;;
+ *-n32|*"-n32 ") libsuff=32 shlibsuff=N32 libmagic=N32;;
+ *-64|*"-64 ") libsuff=64 shlibsuff=64 libmagic=64-bit;;
+ *) libsuff= shlibsuff= libmagic=never-match;;
+ esac
+ ;;
+ esac
+ shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
+ shlibpath_overrides_runpath=no
+ sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
+ sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
+ ;;
+
+# No shared lib support for Linux oldld, aout, or coff.
+linux-gnuoldld* | linux-gnuaout* | linux-gnucoff*)
+ dynamic_linker=no
+ ;;
+
+# This must be Linux ELF.
+linux-gnu*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=no
+ # This implies no fast_install, which is unacceptable.
+ # Some rework will be needed to allow for fast_install
+ # before this can be enabled.
+ hardcode_into_libs=yes
+
+ # We used to test for /lib/ld.so.1 and disable shared libraries on
+ # powerpc, because MkLinux only supported shared libraries with the
+ # GNU dynamic linker. Since this was broken with cross compilers,
+ # most powerpc-linux boxes support dynamic linking these days and
+ # people can always --disable-shared, the test was removed, and we
+ # assume the GNU/Linux dynamic linker is in use.
+ dynamic_linker='GNU/Linux ld.so'
+ ;;
+
+netbsd*)
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+ dynamic_linker='NetBSD (a.out) ld.so'
+ else
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major ${libname}${release}.so ${libname}.so'
+ soname_spec='${libname}${release}.so$major'
+ dynamic_linker='NetBSD ld.elf_so'
+ fi
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ hardcode_into_libs=yes
+ ;;
+
+newsos6)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ ;;
+
+openbsd*)
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ case "$host_os" in
+ openbsd2.[89] | openbsd2.[89].*)
+ shlibpath_overrides_runpath=no
+ ;;
+ *)
+ shlibpath_overrides_runpath=yes
+ ;;
+ esac
+ else
+ shlibpath_overrides_runpath=yes
+ fi
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+os2*)
+ libname_spec='$name'
+ need_lib_prefix=no
+ library_names_spec='$libname.dll $libname.a'
+ dynamic_linker='OS/2 ld.exe'
+ shlibpath_var=LIBPATH
+ ;;
+
+osf3* | osf4* | osf5*)
+ version_type=osf
+ need_version=no
+ soname_spec='${libname}${release}.so'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
+ sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
+ ;;
+
+sco3.2v5*)
+ version_type=osf
+ soname_spec='${libname}${release}.so$major'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+solaris*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ hardcode_into_libs=yes
+ # ldd complains unless libraries are executable
+ postinstall_cmds='chmod +x $lib'
+ ;;
+
+sunos4*)
+ version_type=sunos
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ if test "$with_gnu_ld" = yes; then
+ need_lib_prefix=no
+ fi
+ need_version=yes
+ ;;
+
+sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ case $host_vendor in
+ sni)
+ shlibpath_overrides_runpath=no
+ ;;
+ motorola)
+ need_lib_prefix=no
+ need_version=no
+ shlibpath_overrides_runpath=no
+ sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
+ ;;
+ esac
+ ;;
+
+uts4*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+dgux*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+sysv4*MP*)
+ if test -d /usr/nec ;then
+ version_type=linux
+ library_names_spec='$libname.so.$versuffix $libname.so.$major $libname.so'
+ soname_spec='$libname.so.$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ fi
+ ;;
+
+*)
+ dynamic_linker=no
+ ;;
+esac
+echo "$as_me:$LINENO: result: $dynamic_linker" >&5
+echo "${ECHO_T}$dynamic_linker" >&6
+test "$dynamic_linker" = no && can_build_shared=no
+
+# Report the final consequences.
+echo "$as_me:$LINENO: checking if libtool supports shared libraries" >&5
+echo $ECHO_N "checking if libtool supports shared libraries... $ECHO_C" >&6
+echo "$as_me:$LINENO: result: $can_build_shared" >&5
+echo "${ECHO_T}$can_build_shared" >&6
+
+echo "$as_me:$LINENO: checking whether to build shared libraries" >&5
+echo $ECHO_N "checking whether to build shared libraries... $ECHO_C" >&6
+test "$can_build_shared" = "no" && enable_shared=no
+
+# On AIX, shared libraries and static libraries use the same namespace, and
+# are all built from PIC.
+case "$host_os" in
+aix3*)
+ test "$enable_shared" = yes && enable_static=no
+ if test -n "$RANLIB"; then
+ archive_cmds="$archive_cmds~\$RANLIB \$lib"
+ postinstall_cmds='$RANLIB $lib'
+ fi
+ ;;
+
+aix4*)
+ if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
+ test "$enable_shared" = yes && enable_static=no
+ fi
+ ;;
+esac
+echo "$as_me:$LINENO: result: $enable_shared" >&5
+echo "${ECHO_T}$enable_shared" >&6
+
+echo "$as_me:$LINENO: checking whether to build static libraries" >&5
+echo $ECHO_N "checking whether to build static libraries... $ECHO_C" >&6
+# Make sure either enable_shared or enable_static is yes.
+test "$enable_shared" = yes || enable_static=yes
+echo "$as_me:$LINENO: result: $enable_static" >&5
+echo "${ECHO_T}$enable_static" >&6
+
+if test "$hardcode_action" = relink; then
+ # Fast installation is not supported
+ enable_fast_install=no
+elif test "$shlibpath_overrides_runpath" = yes ||
+ test "$enable_shared" = no; then
+ # Fast installation is not necessary
+ enable_fast_install=needless
+fi
+
+variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
+if test "$GCC" = yes; then
+ variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
+fi
+
+if test "x$enable_dlopen" != xyes; then
+ enable_dlopen=unknown
+ enable_dlopen_self=unknown
+ enable_dlopen_self_static=unknown
+else
+ lt_cv_dlopen=no
+ lt_cv_dlopen_libs=
+
+ case $host_os in
+ beos*)
+ lt_cv_dlopen="load_add_on"
+ lt_cv_dlopen_libs=
+ lt_cv_dlopen_self=yes
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ lt_cv_dlopen="LoadLibrary"
+ lt_cv_dlopen_libs=
+ ;;
+
+ *)
+ echo "$as_me:$LINENO: checking for shl_load" >&5
+echo $ECHO_N "checking for shl_load... $ECHO_C" >&6
+if test "${ac_cv_func_shl_load+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char shl_load (); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char shl_load ();
+char (*f) ();
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_shl_load) || defined (__stub___shl_load)
+choke me
+#else
+f = shl_load;
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_func_shl_load=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_func_shl_load=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_func_shl_load" >&5
+echo "${ECHO_T}$ac_cv_func_shl_load" >&6
+if test $ac_cv_func_shl_load = yes; then
+ lt_cv_dlopen="shl_load"
+else
+ echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5
+echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6
+if test "${ac_cv_lib_dld_shl_load+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldld $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char shl_load ();
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+shl_load ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_dld_shl_load=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_lib_dld_shl_load=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5
+echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6
+if test $ac_cv_lib_dld_shl_load = yes; then
+ lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-dld"
+else
+ echo "$as_me:$LINENO: checking for dlopen" >&5
+echo $ECHO_N "checking for dlopen... $ECHO_C" >&6
+if test "${ac_cv_func_dlopen+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char dlopen (); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dlopen ();
+char (*f) ();
+
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_dlopen) || defined (__stub___dlopen)
+choke me
+#else
+f = dlopen;
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_func_dlopen=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_func_dlopen=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_func_dlopen" >&5
+echo "${ECHO_T}$ac_cv_func_dlopen" >&6
+if test $ac_cv_func_dlopen = yes; then
+ lt_cv_dlopen="dlopen"
+else
+ echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5
+echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6
+if test "${ac_cv_lib_dl_dlopen+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldl $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dlopen ();
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+dlopen ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_dl_dlopen=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_lib_dl_dlopen=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5
+echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6
+if test $ac_cv_lib_dl_dlopen = yes; then
+ lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"
+else
+ echo "$as_me:$LINENO: checking for dlopen in -lsvld" >&5
+echo $ECHO_N "checking for dlopen in -lsvld... $ECHO_C" >&6
+if test "${ac_cv_lib_svld_dlopen+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lsvld $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dlopen ();
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+dlopen ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_svld_dlopen=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_lib_svld_dlopen=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_svld_dlopen" >&5
+echo "${ECHO_T}$ac_cv_lib_svld_dlopen" >&6
+if test $ac_cv_lib_svld_dlopen = yes; then
+ lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld"
+else
+ echo "$as_me:$LINENO: checking for dld_link in -ldld" >&5
+echo $ECHO_N "checking for dld_link in -ldld... $ECHO_C" >&6
+if test "${ac_cv_lib_dld_dld_link+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-ldld $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char dld_link ();
+#ifdef F77_DUMMY_MAIN
+# ifdef __cplusplus
+ extern "C"
+# endif
+ int F77_DUMMY_MAIN() { return 1; }
+#endif
+int
+main ()
+{
+dld_link ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_dld_dld_link=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_cv_lib_dld_dld_link=no
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_dld_dld_link" >&5
+echo "${ECHO_T}$ac_cv_lib_dld_dld_link" >&6
+if test $ac_cv_lib_dld_dld_link = yes; then
+ lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-dld"
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+
+fi
+
+ ;;
+ esac
+
+ if test "x$lt_cv_dlopen" != xno; then
+ enable_dlopen=yes
+ else
+ enable_dlopen=no
+ fi
+
+ case $lt_cv_dlopen in
+ dlopen)
+ save_CPPFLAGS="$CPPFLAGS"
+ test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
+
+ save_LDFLAGS="$LDFLAGS"
+ eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
+
+ save_LIBS="$LIBS"
+ LIBS="$lt_cv_dlopen_libs $LIBS"
+
+ echo "$as_me:$LINENO: checking whether a program can dlopen itself" >&5
+echo $ECHO_N "checking whether a program can dlopen itself... $ECHO_C" >&6
+if test "${lt_cv_dlopen_self+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test "$cross_compiling" = yes; then :
+ lt_cv_dlopen_self=cross
+else
+ lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+ lt_status=$lt_dlunknown
+ cat > conftest.$ac_ext <<EOF
+#line 7667 "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include <dlfcn.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef RTLD_GLOBAL
+# define LT_DLGLOBAL RTLD_GLOBAL
+#else
+# ifdef DL_GLOBAL
+# define LT_DLGLOBAL DL_GLOBAL
+# else
+# define LT_DLGLOBAL 0
+# endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+ find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+# ifdef RTLD_LAZY
+# define LT_DLLAZY_OR_NOW RTLD_LAZY
+# else
+# ifdef DL_LAZY
+# define LT_DLLAZY_OR_NOW DL_LAZY
+# else
+# ifdef RTLD_NOW
+# define LT_DLLAZY_OR_NOW RTLD_NOW
+# else
+# ifdef DL_NOW
+# define LT_DLLAZY_OR_NOW DL_NOW
+# else
+# define LT_DLLAZY_OR_NOW 0
+# endif
+# endif
+# endif
+# endif
+#endif
+
+#ifdef __cplusplus
+extern "C" void exit (int);
+#endif
+
+void fnord() { int i=42;}
+int main ()
+{
+ void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+ int status = $lt_dlunknown;
+
+ if (self)
+ {
+ if (dlsym (self,"fnord")) status = $lt_dlno_uscore;
+ else if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore;
+ /* dlclose (self); */
+ }
+
+ exit (status);
+}
+EOF
+ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && test -s conftest${ac_exeext} 2>/dev/null; then
+ (./conftest; exit; ) 2>/dev/null
+ lt_status=$?
+ case x$lt_status in
+ x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;;
+ x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;;
+ x$lt_unknown|x*) lt_cv_dlopen_self=no ;;
+ esac
+ else :
+ # compilation failed
+ lt_cv_dlopen_self=no
+ fi
+fi
+rm -fr conftest*
+
+
+fi
+echo "$as_me:$LINENO: result: $lt_cv_dlopen_self" >&5
+echo "${ECHO_T}$lt_cv_dlopen_self" >&6
+
+ if test "x$lt_cv_dlopen_self" = xyes; then
+ LDFLAGS="$LDFLAGS $link_static_flag"
+ echo "$as_me:$LINENO: checking whether a statically linked program can dlopen itself" >&5
+echo $ECHO_N "checking whether a statically linked program can dlopen itself... $ECHO_C" >&6
+if test "${lt_cv_dlopen_self_static+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test "$cross_compiling" = yes; then :
+ lt_cv_dlopen_self_static=cross
+else
+ lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+ lt_status=$lt_dlunknown
+ cat > conftest.$ac_ext <<EOF
+#line 7765 "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include <dlfcn.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef RTLD_GLOBAL
+# define LT_DLGLOBAL RTLD_GLOBAL
+#else
+# ifdef DL_GLOBAL
+# define LT_DLGLOBAL DL_GLOBAL
+# else
+# define LT_DLGLOBAL 0
+# endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+ find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+# ifdef RTLD_LAZY
+# define LT_DLLAZY_OR_NOW RTLD_LAZY
+# else
+# ifdef DL_LAZY
+# define LT_DLLAZY_OR_NOW DL_LAZY
+# else
+# ifdef RTLD_NOW
+# define LT_DLLAZY_OR_NOW RTLD_NOW
+# else
+# ifdef DL_NOW
+# define LT_DLLAZY_OR_NOW DL_NOW
+# else
+# define LT_DLLAZY_OR_NOW 0
+# endif
+# endif
+# endif
+# endif
+#endif
+
+#ifdef __cplusplus
+extern "C" void exit (int);
+#endif
+
+void fnord() { int i=42;}
+int main ()
+{
+ void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+ int status = $lt_dlunknown;
+
+ if (self)
+ {
+ if (dlsym (self,"fnord")) status = $lt_dlno_uscore;
+ else if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore;
+ /* dlclose (self); */
+ }
+
+ exit (status);
+}
+EOF
+ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && test -s conftest${ac_exeext} 2>/dev/null; then
+ (./conftest; exit; ) 2>/dev/null
+ lt_status=$?
+ case x$lt_status in
+ x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;;
+ x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;;
+ x$lt_unknown|x*) lt_cv_dlopen_self_static=no ;;
+ esac
+ else :
+ # compilation failed
+ lt_cv_dlopen_self_static=no
+ fi
+fi
+rm -fr conftest*
+
+
+fi
+echo "$as_me:$LINENO: result: $lt_cv_dlopen_self_static" >&5
+echo "${ECHO_T}$lt_cv_dlopen_self_static" >&6
+ fi
+
+ CPPFLAGS="$save_CPPFLAGS"
+ LDFLAGS="$save_LDFLAGS"
+ LIBS="$save_LIBS"
+ ;;
+ esac
+
+ case $lt_cv_dlopen_self in
+ yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
+ *) enable_dlopen_self=unknown ;;
+ esac
+
+ case $lt_cv_dlopen_self_static in
+ yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
+ *) enable_dlopen_self_static=unknown ;;
+ esac
+fi
+
+
+if test "$enable_shared" = yes && test "$GCC" = yes; then
+ case $archive_cmds in
+ *'~'*)
+ # FIXME: we may have to deal with multi-command sequences.
+ ;;
+ '$CC '*)
+ # Test whether the compiler implicitly links with -lc since on some
+ # systems, -lgcc has to come before -lc. If gcc already passes -lc
+ # to ld, don't add -lc before -lgcc.
+ echo "$as_me:$LINENO: checking whether -lc should be explicitly linked in" >&5
+echo $ECHO_N "checking whether -lc should be explicitly linked in... $ECHO_C" >&6
+ if test "${lt_cv_archive_cmds_need_lc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ $rm conftest*
+ echo 'static int dummy;' > conftest.$ac_ext
+
+ if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ soname=conftest
+ lib=conftest
+ libobjs=conftest.$ac_objext
+ deplibs=
+ wl=$lt_cv_prog_cc_wl
+ compiler_flags=-v
+ linker_flags=-v
+ verstring=
+ output_objdir=.
+ libname=conftest
+ save_allow_undefined_flag=$allow_undefined_flag
+ allow_undefined_flag=
+ if { (eval echo "$as_me:$LINENO: \"$archive_cmds 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1\"") >&5
+ (eval $archive_cmds 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+ then
+ lt_cv_archive_cmds_need_lc=no
+ else
+ lt_cv_archive_cmds_need_lc=yes
+ fi
+ allow_undefined_flag=$save_allow_undefined_flag
+ else
+ cat conftest.err 1>&5
+ fi
+fi
+
+ echo "$as_me:$LINENO: result: $lt_cv_archive_cmds_need_lc" >&5
+echo "${ECHO_T}$lt_cv_archive_cmds_need_lc" >&6
+ ;;
+ esac
+fi
+need_lc=${lt_cv_archive_cmds_need_lc-yes}
+
+# The second clause should only fire when bootstrapping the
+# libtool distribution, otherwise you forgot to ship ltmain.sh
+# with your package, and you will get complaints that there are
+# no rules to generate ltmain.sh.
+if test -f "$ltmain"; then
+ :
+else
+ # If there is no Makefile yet, we rely on a make rule to execute
+ # `config.status --recheck' to rerun these tests and create the
+ # libtool script then.
+ test -f Makefile && make "$ltmain"
+fi
+
+if test -f "$ltmain"; then
+ trap "$rm \"${ofile}T\"; exit 1" 1 2 15
+ $rm -f "${ofile}T"
+
+ echo creating $ofile
+
+ # Now quote all the things that may contain metacharacters while being
+ # careful not to overquote the AC_SUBSTed values. We take copies of the
+ # variables and quote the copies for generation of the libtool script.
+ for var in echo old_CC old_CFLAGS \
+ AR AR_FLAGS CC LD LN_S NM SHELL \
+ reload_flag reload_cmds wl \
+ pic_flag link_static_flag no_builtin_flag export_dynamic_flag_spec \
+ thread_safe_flag_spec whole_archive_flag_spec libname_spec \
+ library_names_spec soname_spec \
+ RANLIB old_archive_cmds old_archive_from_new_cmds old_postinstall_cmds \
+ old_postuninstall_cmds archive_cmds archive_expsym_cmds postinstall_cmds \
+ postuninstall_cmds extract_expsyms_cmds old_archive_from_expsyms_cmds \
+ old_striplib striplib file_magic_cmd export_symbols_cmds \
+ deplibs_check_method allow_undefined_flag no_undefined_flag \
+ finish_cmds finish_eval global_symbol_pipe global_symbol_to_cdecl \
+ global_symbol_to_c_name_address \
+ hardcode_libdir_flag_spec hardcode_libdir_separator \
+ sys_lib_search_path_spec sys_lib_dlsearch_path_spec \
+ compiler_c_o compiler_o_lo need_locks exclude_expsyms include_expsyms; do
+
+ case $var in
+ reload_cmds | old_archive_cmds | old_archive_from_new_cmds | \
+ old_postinstall_cmds | old_postuninstall_cmds | \
+ export_symbols_cmds | archive_cmds | archive_expsym_cmds | \
+ extract_expsyms_cmds | old_archive_from_expsyms_cmds | \
+ postinstall_cmds | postuninstall_cmds | \
+ finish_cmds | sys_lib_search_path_spec | sys_lib_dlsearch_path_spec)
+ # Double-quote double-evaled strings.
+ eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\""
+ ;;
+ *)
+ eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\""
+ ;;
+ esac
+ done
+
+ cat <<__EOF__ > "${ofile}T"
+#! $SHELL
+
+# `$echo "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
+# Generated automatically by $PROGRAM (GNU $PACKAGE $VERSION$TIMESTAMP)
+# NOTE: Changes made to this file will be lost: look at ltmain.sh.
+#
+# Copyright (C) 1996-2000 Free Software Foundation, Inc.
+# Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Sed that helps us avoid accidentally triggering echo(1) options like -n.
+Xsed="sed -e s/^X//"
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+if test "X\${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
+
+# ### BEGIN LIBTOOL CONFIG
+
+# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+
+# Shell to use when invoking shell scripts.
+SHELL=$lt_SHELL
+
+# Whether or not to build shared libraries.
+build_libtool_libs=$enable_shared
+
+# Whether or not to build static libraries.
+build_old_libs=$enable_static
+
+# Whether or not to add -lc for building shared libraries.
+build_libtool_need_lc=$need_lc
+
+# Whether or not to optimize for fast installation.
+fast_install=$enable_fast_install
+
+# The host system.
+host_alias=$host_alias
+host=$host
+
+# An echo program that does not interpret backslashes.
+echo=$lt_echo
+
+# The archiver.
+AR=$lt_AR
+AR_FLAGS=$lt_AR_FLAGS
+
+# The default C compiler.
+CC=$lt_CC
+
+# Is the compiler the GNU C compiler?
+with_gcc=$GCC
+
+# The linker used to build libraries.
+LD=$lt_LD
+
+# Whether we need hard or soft links.
+LN_S=$lt_LN_S
+
+# A BSD-compatible nm program.
+NM=$lt_NM
+
+# A symbol stripping program
+STRIP=$STRIP
+
+# Used to examine libraries when file_magic_cmd begins "file"
+MAGIC_CMD=$MAGIC_CMD
+
+# Used on cygwin: DLL creation program.
+DLLTOOL="$DLLTOOL"
+
+# Used on cygwin: object dumper.
+OBJDUMP="$OBJDUMP"
+
+# Used on cygwin: assembler.
+AS="$AS"
+
+# The name of the directory that contains temporary libtool files.
+objdir=$objdir
+
+# How to create reloadable object files.
+reload_flag=$lt_reload_flag
+reload_cmds=$lt_reload_cmds
+
+# How to pass a linker flag through the compiler.
+wl=$lt_wl
+
+# Object file suffix (normally "o").
+objext="$ac_objext"
+
+# Old archive suffix (normally "a").
+libext="$libext"
+
+# Executable file suffix (normally "").
+exeext="$exeext"
+
+# Additional compiler flags for building library objects.
+pic_flag=$lt_pic_flag
+pic_mode=$pic_mode
+
+# Does compiler simultaneously support -c and -o options?
+compiler_c_o=$lt_compiler_c_o
+
+# Can we write directly to a .lo ?
+compiler_o_lo=$lt_compiler_o_lo
+
+# Must we lock files when doing compilation ?
+need_locks=$lt_need_locks
+
+# Do we need the lib prefix for modules?
+need_lib_prefix=$need_lib_prefix
+
+# Do we need a version for libraries?
+need_version=$need_version
+
+# Whether dlopen is supported.
+dlopen_support=$enable_dlopen
+
+# Whether dlopen of programs is supported.
+dlopen_self=$enable_dlopen_self
+
+# Whether dlopen of statically linked programs is supported.
+dlopen_self_static=$enable_dlopen_self_static
+
+# Compiler flag to prevent dynamic linking.
+link_static_flag=$lt_link_static_flag
+
+# Compiler flag to turn off builtin functions.
+no_builtin_flag=$lt_no_builtin_flag
+
+# Compiler flag to allow reflexive dlopens.
+export_dynamic_flag_spec=$lt_export_dynamic_flag_spec
+
+# Compiler flag to generate shared objects directly from archives.
+whole_archive_flag_spec=$lt_whole_archive_flag_spec
+
+# Compiler flag to generate thread-safe objects.
+thread_safe_flag_spec=$lt_thread_safe_flag_spec
+
+# Library versioning type.
+version_type=$version_type
+
+# Format of library name prefix.
+libname_spec=$lt_libname_spec
+
+# List of archive names. First name is the real one, the rest are links.
+# The last name is the one that the linker finds with -lNAME.
+library_names_spec=$lt_library_names_spec
+
+# The coded name of the library, if different from the real name.
+soname_spec=$lt_soname_spec
+
+# Commands used to build and install an old-style archive.
+RANLIB=$lt_RANLIB
+old_archive_cmds=$lt_old_archive_cmds
+old_postinstall_cmds=$lt_old_postinstall_cmds
+old_postuninstall_cmds=$lt_old_postuninstall_cmds
+
+# Create an old-style archive from a shared archive.
+old_archive_from_new_cmds=$lt_old_archive_from_new_cmds
+
+# Create a temporary old-style archive to link instead of a shared archive.
+old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds
+
+# Commands used to build and install a shared archive.
+archive_cmds=$lt_archive_cmds
+archive_expsym_cmds=$lt_archive_expsym_cmds
+postinstall_cmds=$lt_postinstall_cmds
+postuninstall_cmds=$lt_postuninstall_cmds
+
+# Commands to strip libraries.
+old_striplib=$lt_old_striplib
+striplib=$lt_striplib
+
+# Method to check whether dependent libraries are shared objects.
+deplibs_check_method=$lt_deplibs_check_method
+
+# Command to use when deplibs_check_method == file_magic.
+file_magic_cmd=$lt_file_magic_cmd
+
+# Flag that allows shared libraries with undefined symbols to be built.
+allow_undefined_flag=$lt_allow_undefined_flag
+
+# Flag that forces no undefined symbols.
+no_undefined_flag=$lt_no_undefined_flag
+
+# Commands used to finish a libtool library installation in a directory.
+finish_cmds=$lt_finish_cmds
+
+# Same as above, but a single script fragment to be evaled but not shown.
+finish_eval=$lt_finish_eval
+
+# Take the output of nm and produce a listing of raw symbols and C names.
+global_symbol_pipe=$lt_global_symbol_pipe
+
+# Transform the output of nm in a proper C declaration
+global_symbol_to_cdecl=$lt_global_symbol_to_cdecl
+
+# Transform the output of nm in a C name address pair
+global_symbol_to_c_name_address=$lt_global_symbol_to_c_name_address
+
+# This is the shared library runtime path variable.
+runpath_var=$runpath_var
+
+# This is the shared library path variable.
+shlibpath_var=$shlibpath_var
+
+# Is shlibpath searched before the hard-coded library search path?
+shlibpath_overrides_runpath=$shlibpath_overrides_runpath
+
+# How to hardcode a shared library path into an executable.
+hardcode_action=$hardcode_action
+
+# Whether we should hardcode library paths into libraries.
+hardcode_into_libs=$hardcode_into_libs
+
+# Flag to hardcode \$libdir into a binary during linking.
+# This must work even if \$libdir does not exist.
+hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec
+
+# Whether we need a single -rpath flag with a separated argument.
+hardcode_libdir_separator=$lt_hardcode_libdir_separator
+
+# Set to yes if using DIR/libNAME.so during linking hardcodes DIR into the
+# resulting binary.
+hardcode_direct=$hardcode_direct
+
+# Set to yes if using the -LDIR flag during linking hardcodes DIR into the
+# resulting binary.
+hardcode_minus_L=$hardcode_minus_L
+
+# Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into
+# the resulting binary.
+hardcode_shlibpath_var=$hardcode_shlibpath_var
+
+# Variables whose values should be saved in libtool wrapper scripts and
+# restored at relink time.
+variables_saved_for_relink="$variables_saved_for_relink"
+
+# Whether libtool must link a program against all its dependency libraries.
+link_all_deplibs=$link_all_deplibs
+
+# Compile-time system search path for libraries
+sys_lib_search_path_spec=$lt_sys_lib_search_path_spec
+
+# Run-time system search path for libraries
+sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec
+
+# Fix the shell variable \$srcfile for the compiler.
+fix_srcfile_path="$fix_srcfile_path"
+
+# Set to yes if exported symbols are required.
+always_export_symbols=$always_export_symbols
+
+# The commands to list exported symbols.
+export_symbols_cmds=$lt_export_symbols_cmds
+
+# The commands to extract the exported symbol list from a shared archive.
+extract_expsyms_cmds=$lt_extract_expsyms_cmds
+
+# Symbols that should not be listed in the preloaded symbols.
+exclude_expsyms=$lt_exclude_expsyms
+
+# Symbols that must always be exported.
+include_expsyms=$lt_include_expsyms
+
+# ### END LIBTOOL CONFIG
+
+__EOF__
+
+ case $host_os in
+ aix3*)
+ cat <<\EOF >> "${ofile}T"
+
+# AIX sometimes has problems with the GCC collect2 program. For some
+# reason, if we set the COLLECT_NAMES environment variable, the problems
+# vanish in a puff of smoke.
+if test "X${COLLECT_NAMES+set}" != Xset; then
+ COLLECT_NAMES=
+ export COLLECT_NAMES
+fi
+EOF
+ ;;
+ esac
+
+ case $host_os in
+ cygwin* | mingw* | pw32* | os2*)
+ cat <<'EOF' >> "${ofile}T"
+ # This is a source program that is used to create dlls on Windows
+ # Don't remove nor modify the starting and closing comments
+# /* ltdll.c starts here */
+# #define WIN32_LEAN_AND_MEAN
+# #include <windows.h>
+# #undef WIN32_LEAN_AND_MEAN
+# #include <stdio.h>
+#
+# #ifndef __CYGWIN__
+# # ifdef __CYGWIN32__
+# # define __CYGWIN__ __CYGWIN32__
+# # endif
+# #endif
+#
+# #ifdef __cplusplus
+# extern "C" {
+# #endif
+# BOOL APIENTRY DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved);
+# #ifdef __cplusplus
+# }
+# #endif
+#
+# #ifdef __CYGWIN__
+# #include <cygwin/cygwin_dll.h>
+# DECLARE_CYGWIN_DLL( DllMain );
+# #endif
+# HINSTANCE __hDllInstance_base;
+#
+# BOOL APIENTRY
+# DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved)
+# {
+# __hDllInstance_base = hInst;
+# return TRUE;
+# }
+# /* ltdll.c ends here */
+ # This is a source program that is used to create import libraries
+ # on Windows for dlls which lack them. Don't remove nor modify the
+ # starting and closing comments
+# /* impgen.c starts here */
+# /* Copyright (C) 1999-2000 Free Software Foundation, Inc.
+#
+# This file is part of GNU libtool.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# */
+#
+# #include <stdio.h> /* for printf() */
+# #include <unistd.h> /* for open(), lseek(), read() */
+# #include <fcntl.h> /* for O_RDONLY, O_BINARY */
+# #include <string.h> /* for strdup() */
+#
+# /* O_BINARY isn't required (or even defined sometimes) under Unix */
+# #ifndef O_BINARY
+# #define O_BINARY 0
+# #endif
+#
+# static unsigned int
+# pe_get16 (fd, offset)
+# int fd;
+# int offset;
+# {
+# unsigned char b[2];
+# lseek (fd, offset, SEEK_SET);
+# read (fd, b, 2);
+# return b[0] + (b[1]<<8);
+# }
+#
+# static unsigned int
+# pe_get32 (fd, offset)
+# int fd;
+# int offset;
+# {
+# unsigned char b[4];
+# lseek (fd, offset, SEEK_SET);
+# read (fd, b, 4);
+# return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
+# }
+#
+# static unsigned int
+# pe_as32 (ptr)
+# void *ptr;
+# {
+# unsigned char *b = ptr;
+# return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
+# }
+#
+# int
+# main (argc, argv)
+# int argc;
+# char *argv[];
+# {
+# int dll;
+# unsigned long pe_header_offset, opthdr_ofs, num_entries, i;
+# unsigned long export_rva, export_size, nsections, secptr, expptr;
+# unsigned long name_rvas, nexp;
+# unsigned char *expdata, *erva;
+# char *filename, *dll_name;
+#
+# filename = argv[1];
+#
+# dll = open(filename, O_RDONLY|O_BINARY);
+# if (dll < 1)
+# return 1;
+#
+# dll_name = filename;
+#
+# for (i=0; filename[i]; i++)
+# if (filename[i] == '/' || filename[i] == '\\' || filename[i] == ':')
+# dll_name = filename + i +1;
+#
+# pe_header_offset = pe_get32 (dll, 0x3c);
+# opthdr_ofs = pe_header_offset + 4 + 20;
+# num_entries = pe_get32 (dll, opthdr_ofs + 92);
+#
+# if (num_entries < 1) /* no exports */
+# return 1;
+#
+# export_rva = pe_get32 (dll, opthdr_ofs + 96);
+# export_size = pe_get32 (dll, opthdr_ofs + 100);
+# nsections = pe_get16 (dll, pe_header_offset + 4 +2);
+# secptr = (pe_header_offset + 4 + 20 +
+# pe_get16 (dll, pe_header_offset + 4 + 16));
+#
+# expptr = 0;
+# for (i = 0; i < nsections; i++)
+# {
+# char sname[8];
+# unsigned long secptr1 = secptr + 40 * i;
+# unsigned long vaddr = pe_get32 (dll, secptr1 + 12);
+# unsigned long vsize = pe_get32 (dll, secptr1 + 16);
+# unsigned long fptr = pe_get32 (dll, secptr1 + 20);
+# lseek(dll, secptr1, SEEK_SET);
+# read(dll, sname, 8);
+# if (vaddr <= export_rva && vaddr+vsize > export_rva)
+# {
+# expptr = fptr + (export_rva - vaddr);
+# if (export_rva + export_size > vaddr + vsize)
+# export_size = vsize - (export_rva - vaddr);
+# break;
+# }
+# }
+#
+# expdata = (unsigned char*)malloc(export_size);
+# lseek (dll, expptr, SEEK_SET);
+# read (dll, expdata, export_size);
+# erva = expdata - export_rva;
+#
+# nexp = pe_as32 (expdata+24);
+# name_rvas = pe_as32 (expdata+32);
+#
+# printf ("EXPORTS\n");
+# for (i = 0; i<nexp; i++)
+# {
+# unsigned long name_rva = pe_as32 (erva+name_rvas+i*4);
+# printf ("\t%s @ %ld ;\n", erva+name_rva, 1+ i);
+# }
+#
+# return 0;
+# }
+# /* impgen.c ends here */
+
+EOF
+ ;;
+ esac
+
+ # We use sed instead of cat because bash on DJGPP gets confused if
+ # if finds mixed CR/LF and LF-only lines. Since sed operates in
+ # text mode, it properly converts lines to CR/LF. This bash problem
+ # is reportedly fixed, but why not run on old versions too?
+ sed '$q' "$ltmain" >> "${ofile}T" || (rm -f "${ofile}T"; exit 1)
+
+ mv -f "${ofile}T" "$ofile" || \
+ (rm -f "$ofile" && cp "${ofile}T" "$ofile" && rm -f "${ofile}T")
+ chmod +x "$ofile"
+fi
+
+
+
+
+
+# This can be used to rebuild libtool when needed
+LIBTOOL_DEPS="$ac_aux_dir/ltmain.sh"
+
+# Always use our own libtool.
+LIBTOOL='$(SHELL) $(top_builddir)/libtool'
+
+# Prevent multiple expansion
+
+
+
+#
+# Check for AViiON Machines running DGUX
+#
+echo "$as_me:$LINENO: checking if host is AViiON running DGUX" >&5
+echo $ECHO_N "checking if host is AViiON running DGUX... $ECHO_C" >&6
+ac_is_dgux=no
+if test "${ac_cv_header_sys_dg_sys_info_h+set}" = set; then
+ echo "$as_me:$LINENO: checking for sys/dg_sys_info.h" >&5
+echo $ECHO_N "checking for sys/dg_sys_info.h... $ECHO_C" >&6
+if test "${ac_cv_header_sys_dg_sys_info_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_sys_dg_sys_info_h" >&5
+echo "${ECHO_T}$ac_cv_header_sys_dg_sys_info_h" >&6
+else
+ # Is the header compilable?
+echo "$as_me:$LINENO: checking sys/dg_sys_info.h usability" >&5
+echo $ECHO_N "checking sys/dg_sys_info.h usability... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+$ac_includes_default
+#include <sys/dg_sys_info.h>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_header_compiler=yes
+else
+ echo "$as_me: failed program was:" >&5
+cat conftest.$ac_ext >&5
+ac_header_compiler=no
+fi
+rm -f conftest.$ac_objext conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6
+
+# Is the header present?
+echo "$as_me:$LINENO: checking sys/dg_sys_info.h presence" >&5
+echo $ECHO_N "checking sys/dg_sys_info.h presence... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+#include "confdefs.h"
+#include <sys/dg_sys_info.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ egrep -v '^ *\+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ ac_header_preproc=yes
+else
+ echo "$as_me: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_header_preproc=no
+fi
+rm -f conftest.err conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6
+
+# So? What about this header?
+case $ac_header_compiler:$ac_header_preproc in
+ yes:no )
+ { echo "$as_me:$LINENO: WARNING: sys/dg_sys_info.h: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: sys/dg_sys_info.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/dg_sys_info.h: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: sys/dg_sys_info.h: proceeding with the preprocessor's result" >&2;};;
+ no:yes )
+ { echo "$as_me:$LINENO: WARNING: sys/dg_sys_info.h: present but cannot be compiled" >&5
+echo "$as_me: WARNING: sys/dg_sys_info.h: present but cannot be compiled" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/dg_sys_info.h: check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: sys/dg_sys_info.h: check for missing prerequisite headers?" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/dg_sys_info.h: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: sys/dg_sys_info.h: proceeding with the preprocessor's result" >&2;};;
+esac
+echo "$as_me:$LINENO: checking for sys/dg_sys_info.h" >&5
+echo $ECHO_N "checking for sys/dg_sys_info.h... $ECHO_C" >&6
+if test "${ac_cv_header_sys_dg_sys_info_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_header_sys_dg_sys_info_h=$ac_header_preproc
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_sys_dg_sys_info_h" >&5
+echo "${ECHO_T}$ac_cv_header_sys_dg_sys_info_h" >&6
+
+fi
+if test $ac_cv_header_sys_dg_sys_info_h = yes; then
+ ac_is_dgux=yes;
+fi
+
+
+
+echo "$as_me:$LINENO: result: $ac_is_dgux" >&5
+echo "${ECHO_T}$ac_is_dgux" >&6
+ ## :GOTCHA: we do not check anything but sys/dg_sys_info.h
+if test $ac_is_dgux = yes; then
+ if test "$enable_full_debug" = "yes"; then
+ CFLAGS="-g -mstandard -DDGUX -D_DGUX_SOURCE -Di386 -mno-legend -O2"
+ CXXFLAGS="-g -mstandard -DDGUX -D_DGUX_SOURCE -Di386 -mno-legend -O2"
+ else
+ CFLAGS="-DDGUX -D_DGUX_SOURCE -Di386 -mno-legend -O2"
+ CXXFLAGS="-DDGUX -D_DGUX_SOURCE -Di386 -mno-legend -O2"
+ fi
+
+
+fi
+
+
+# Check whether --with-target-subdir or --without-target-subdir was given.
+if test "${with_target_subdir+set}" = set; then
+ withval="$with_target_subdir"
+
+fi;
+
+# Check whether --with-cross-host or --without-cross-host was given.
+if test "${with_cross_host+set}" = set; then
+ withval="$with_cross_host"
+
+fi;
+
+# automake wants to see AC_EXEEXT. But we don't need it. And having
+# it is actually a problem, because the compiler we're passed can't
+# necessarily do a full link. So we fool automake here.
+if false; then
+ # autoconf 2.50 runs AC_EXEEXT by default, and the macro expands
+ # to nothing, so nothing would remain between `then' and `fi' if it
+ # were not for the `:' below.
+ :
+
+fi
+
+echo "$as_me:$LINENO: checking whether Solaris gcc optimization fix is necessary" >&5
+echo $ECHO_N "checking whether Solaris gcc optimization fix is necessary... $ECHO_C" >&6
+case "$host" in
+ sparc-sun-solaris2*)
+ if test "$GCC" = yes; then
+ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+ new_CFLAGS=
+ for i in $CFLAGS; do
+ case "$i" in
+ -O*)
+ ;;
+ *)
+ new_CFLAGS="$new_CFLAGS $i"
+ ;;
+ esac
+ done
+ CFLAGS="$new_CFLAGS"
+ else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+ fi
+ ;;
+ *) echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6 ;;
+esac
+
+MY_CFLAGS="$CFLAGS"
+
+
+cat >>confdefs.h <<\_ACEOF
+#define SILENT 1
+_ACEOF
+
+cat >>confdefs.h <<\_ACEOF
+#define NO_SIGNALS 1
+_ACEOF
+
+cat >>confdefs.h <<\_ACEOF
+#define NO_EXECUTE_PERMISSION 1
+_ACEOF
+
+cat >>confdefs.h <<\_ACEOF
+#define ALL_INTERIOR_POINTERS 1
+_ACEOF
+
+
+cat >>confdefs.h <<\_ACEOF
+#define JAVA_FINALIZATION 1
+_ACEOF
+
+cat >>confdefs.h <<\_ACEOF
+#define GC_GCJ_SUPPORT 1
+_ACEOF
+
+cat >>confdefs.h <<\_ACEOF
+#define ATOMIC_UNCOLLECTABLE 1
+_ACEOF
+
+
+if test -n "${with_cross_host}"; then
+ cat >>confdefs.h <<\_ACEOF
+#define NO_SIGSET 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define NO_CLOCK 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define SMALL_CONFIG 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define NO_DEBUGGING 1
+_ACEOF
+
+fi
+
+# Check whether --enable-full-debug or --disable-full-debug was given.
+if test "${enable_full_debug+set}" = set; then
+ enableval="$enable_full_debug"
+ if test "$enable_full_debug" = "yes"; then
+ { echo "$as_me:$LINENO: WARNING: \"Must define GC_DEBUG and use debug alloc. in clients.\"" >&5
+echo "$as_me: WARNING: \"Must define GC_DEBUG and use debug alloc. in clients.\"" >&2;}
+ cat >>confdefs.h <<\_ACEOF
+#define KEEP_BACK_PTRS 1
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define DBG_HDRS_ALL 1
+_ACEOF
+
+ case $host in
+ ia64-*-linux* )
+ cat >>confdefs.h <<\_ACEOF
+#define MAKE_BACK_GRAPH 1
+_ACEOF
+
+ ;;
+ x86-*-linux* | i586-*-linux* | i686-*-linux* | x86_64-*-linux* )
+ cat >>confdefs.h <<\_ACEOF
+#define MAKE_BACK_GRAPH 1
+_ACEOF
+
+ { echo "$as_me:$LINENO: WARNING: \"Client must not use -fomit-frame-pointer.\"" >&5
+echo "$as_me: WARNING: \"Client must not use -fomit-frame-pointer.\"" >&2;}
+ cat >>confdefs.h <<\_ACEOF
+#define SAVE_CALL_COUNT 8
+_ACEOF
+
+ ;;
+ i345686-*-dgux*)
+ cat >>confdefs.h <<\_ACEOF
+#define MAKE_BACK_GRAPH 1
+_ACEOF
+
+ ;;
+ esac
+ fi
+fi;
+
+# Check whether --enable-redirect-malloc or --disable-redirect-malloc was given.
+if test "${enable_redirect_malloc+set}" = set; then
+ enableval="$enable_redirect_malloc"
+
+fi;
+
+if test "${enable_redirect_malloc}" = yes; then
+ if test "${enable_full_debug}" = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define REDIRECT_MALLOC GC_debug_malloc_replacement
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define REDIRECT_REALLOC GC_debug_realloc_replacement
+_ACEOF
+
+ cat >>confdefs.h <<\_ACEOF
+#define REDIRECT_FREE GC_debug_free
+_ACEOF
+
+ else
+ cat >>confdefs.h <<\_ACEOF
+#define REDIRECT_MALLOC GC_malloc
+_ACEOF
+
+ fi
+fi
+
+# Check whether --enable-gc-assertions or --disable-gc-assertions was given.
+if test "${enable_gc_assertions+set}" = set; then
+ enableval="$enable_gc_assertions"
+
+fi;
+if test "${enable_gc_assertions}" = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define GC_ASSERTIONS 1
+_ACEOF
+
+fi
+
+
+
+if test -z "$with_cross_host"; then
+ USE_LIBDIR_TRUE=
+ USE_LIBDIR_FALSE='#'
+else
+ USE_LIBDIR_TRUE='#'
+ USE_LIBDIR_FALSE=
+fi
+
+
+ac_config_files="$ac_config_files Makefile doc/Makefile include/Makefile"
+ac_config_commands="$ac_config_commands default"
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems. If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overriden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+{
+ (set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ "s/'/'\\\\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+} |
+ sed '
+ t clear
+ : clear
+ s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+ t end
+ /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ : end' >>confcache
+if cmp -s $cache_file confcache; then :; else
+ if test -w $cache_file; then
+ test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
+ cat confcache >$cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=/{
+s/:*\$(srcdir):*/:/;
+s/:*\${srcdir}:*/:/;
+s/:*@srcdir@:*/:/;
+s/^\([^=]*=[ ]*\):*/\1/;
+s/:*$//;
+s/^[^=]*=[ ]*$//;
+}'
+fi
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+#
+# If the first sed substitution is executed (which looks for macros that
+# take arguments), then we branch to the quote section. Otherwise,
+# look for a macro that doesn't take arguments.
+cat >confdef2opt.sed <<\_ACEOF
+t clear
+: clear
+s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
+t quote
+s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g
+t quote
+d
+: quote
+s,[ `~#$^&*(){}\\|;'"<>?],\\&,g
+s,\[,\\&,g
+s,\],\\&,g
+s,\$,$$,g
+p
+_ACEOF
+# We use echo to avoid assuming a particular line-breaking character.
+# The extra dot is to prevent the shell from consuming trailing
+# line-breaks from the sub-command output. A line-break within
+# single-quotes doesn't work because, if this script is created in a
+# platform that uses two characters for line-breaks (e.g., DOS), tr
+# would break.
+ac_LF_and_DOT=`echo; echo .`
+DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
+rm -f confdef2opt.sed
+
+
+if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then
+ { { echo "$as_me:$LINENO: error: conditional \"AMDEP\" was never defined.
+Usually this means the macro was only invoked conditionally." >&5
+echo "$as_me: error: conditional \"AMDEP\" was never defined.
+Usually this means the macro was only invoked conditionally." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+if test -z "${MAINTAINER_MODE_TRUE}" && test -z "${MAINTAINER_MODE_FALSE}"; then
+ { { echo "$as_me:$LINENO: error: conditional \"MAINTAINER_MODE\" was never defined.
+Usually this means the macro was only invoked conditionally." >&5
+echo "$as_me: error: conditional \"MAINTAINER_MODE\" was never defined.
+Usually this means the macro was only invoked conditionally." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+if test -z "${USE_LIBDIR_TRUE}" && test -z "${USE_LIBDIR_FALSE}"; then
+ { { echo "$as_me:$LINENO: error: conditional \"USE_LIBDIR\" was never defined.
+Usually this means the macro was only invoked conditionally." >&5
+echo "$as_me: error: conditional \"USE_LIBDIR\" was never defined.
+Usually this means the macro was only invoked conditionally." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+: ${CONFIG_STATUS=./config.status}
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+echo "$as_me: creating $CONFIG_STATUS" >&6;}
+cat >$CONFIG_STATUS <<_ACEOF
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+SHELL=\${CONFIG_SHELL-$SHELL}
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+
+# NLS nuisances.
+# Support unset when possible.
+if (FOO=FOO; unset FOO) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+(set +x; test -n "`(LANG=C; export LANG) 2>&1`") &&
+ { $as_unset LANG || test "${LANG+set}" != set; } ||
+ { LANG=C; export LANG; }
+(set +x; test -n "`(LC_ALL=C; export LC_ALL) 2>&1`") &&
+ { $as_unset LC_ALL || test "${LC_ALL+set}" != set; } ||
+ { LC_ALL=C; export LC_ALL; }
+(set +x; test -n "`(LC_TIME=C; export LC_TIME) 2>&1`") &&
+ { $as_unset LC_TIME || test "${LC_TIME+set}" != set; } ||
+ { LC_TIME=C; export LC_TIME; }
+(set +x; test -n "`(LC_CTYPE=C; export LC_CTYPE) 2>&1`") &&
+ { $as_unset LC_CTYPE || test "${LC_CTYPE+set}" != set; } ||
+ { LC_CTYPE=C; export LC_CTYPE; }
+(set +x; test -n "`(LANGUAGE=C; export LANGUAGE) 2>&1`") &&
+ { $as_unset LANGUAGE || test "${LANGUAGE+set}" != set; } ||
+ { LANGUAGE=C; export LANGUAGE; }
+(set +x; test -n "`(LC_COLLATE=C; export LC_COLLATE) 2>&1`") &&
+ { $as_unset LC_COLLATE || test "${LC_COLLATE+set}" != set; } ||
+ { LC_COLLATE=C; export LC_COLLATE; }
+(set +x; test -n "`(LC_NUMERIC=C; export LC_NUMERIC) 2>&1`") &&
+ { $as_unset LC_NUMERIC || test "${LC_NUMERIC+set}" != set; } ||
+ { LC_NUMERIC=C; export LC_NUMERIC; }
+(set +x; test -n "`(LC_MESSAGES=C; export LC_MESSAGES) 2>&1`") &&
+ { $as_unset LC_MESSAGES || test "${LC_MESSAGES+set}" != set; } ||
+ { LC_MESSAGES=C; export LC_MESSAGES; }
+
+
+# Name of the executable.
+as_me=`(basename "$0") 2>/dev/null ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conftest.sh
+ echo "exit 0" >>conftest.sh
+ chmod +x conftest.sh
+ if (PATH=".;."; conftest.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conftest.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
+echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
+echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="sed y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="sed y%*+%pp%;s%[^_$as_cr_alnum]%_%g"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH || test "${CDPATH+set}" != set || { CDPATH=$PATH_SEPARATOR; export CDPATH; }
+
+exec 6>&1
+
+# Open the log real soon, to keep \$[0] and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling. Logging --version etc. is OK.
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+} >&5
+cat >&5 <<_CSEOF
+
+This file was extended by gc $as_me 6.2alpha4, which was
+generated by GNU Autoconf 2.53. Invocation command line was
+
+ CONFIG_FILES = $CONFIG_FILES
+ CONFIG_HEADERS = $CONFIG_HEADERS
+ CONFIG_LINKS = $CONFIG_LINKS
+ CONFIG_COMMANDS = $CONFIG_COMMANDS
+ $ $0 $@
+
+_CSEOF
+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+echo >&5
+_ACEOF
+
+# Files that config.status was made for.
+if test -n "$ac_config_files"; then
+ echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_headers"; then
+ echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_links"; then
+ echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_commands"; then
+ echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+ac_cs_usage="\
+\`$as_me' instantiates files from templates according to the
+current configuration.
+
+Usage: $0 [OPTIONS] [FILE]...
+
+ -h, --help print this help, then exit
+ -V, --version print version number, then exit
+ -d, --debug don't remove temporary files
+ --recheck update $as_me by reconfiguring in the same conditions
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
+
+Configuration files:
+$config_files
+
+Configuration commands:
+$config_commands
+
+Report bugs to <bug-autoconf@gnu.org>."
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+ac_cs_version="\\
+gc config.status 6.2alpha4
+configured by $0, generated by GNU Autoconf 2.53,
+ with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+
+Copyright 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001
+Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+srcdir=$srcdir
+INSTALL="$INSTALL"
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If no file are specified by the user, then we need to provide default
+# value. By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test $# != 0
+do
+ case $1 in
+ --*=*)
+ ac_option=`expr "x$1" : 'x\([^=]*\)='`
+ ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ shift
+ set dummy "$ac_option" "$ac_optarg" ${1+"$@"}
+ shift
+ ;;
+ -*);;
+ *) # This is not an option, so the user has probably given explicit
+ # arguments.
+ ac_need_defaults=false;;
+ esac
+
+ case $1 in
+ # Handling of the options.
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running $SHELL $0 " $ac_configure_args " --no-create --no-recursion"
+ exec $SHELL $0 $ac_configure_args --no-create --no-recursion ;;
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+ --version | --vers* | -V )
+ echo "$ac_cs_version"; exit 0 ;;
+ --he | --h)
+ # Conflict between --help and --header
+ { { echo "$as_me:$LINENO: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; };;
+ --help | --hel | -h )
+ echo "$ac_cs_usage"; exit 0 ;;
+ --debug | --d* | -d )
+ debug=: ;;
+ --file | --fil | --fi | --f )
+ shift
+ CONFIG_FILES="$CONFIG_FILES $1"
+ ac_need_defaults=false;;
+ --header | --heade | --head | --hea )
+ shift
+ CONFIG_HEADERS="$CONFIG_HEADERS $1"
+ ac_need_defaults=false;;
+
+ # This is an error.
+ -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; } ;;
+
+ *) ac_config_targets="$ac_config_targets $1" ;;
+
+ esac
+ shift
+done
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+#
+# INIT-COMMANDS section.
+#
+
+AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"
+srcdir=${srcdir}
+host=${host}
+CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
+CC="${CC}"
+DEFS="$DEFS"
+
+
+_ACEOF
+
+
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_config_target in $ac_config_targets
+do
+ case "$ac_config_target" in
+ # Handling of arguments.
+ "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+ "doc/Makefile" ) CONFIG_FILES="$CONFIG_FILES doc/Makefile" ;;
+ "include/Makefile" ) CONFIG_FILES="$CONFIG_FILES include/Makefile" ;;
+ "depfiles" ) CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;;
+ "default" ) CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;;
+ *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
+echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used. Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+ test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands
+fi
+
+# Create a temporary directory, and hook for its removal unless debugging.
+$debug ||
+{
+ trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
+ trap '{ (exit 1); exit 1; }' 1 2 13 15
+}
+
+# Create a (secure) tmp directory for tmp files.
+: ${TMPDIR=/tmp}
+{
+ tmp=`(umask 077 && mktemp -d -q "$TMPDIR/csXXXXXX") 2>/dev/null` &&
+ test -n "$tmp" && test -d "$tmp"
+} ||
+{
+ tmp=$TMPDIR/cs$$-$RANDOM
+ (umask 077 && mkdir $tmp)
+} ||
+{
+ echo "$me: cannot create a temporary directory in $TMPDIR" >&2
+ { (exit 1); exit 1; }
+}
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+
+#
+# CONFIG_FILES section.
+#
+
+# No need to generate the scripts if there are no CONFIG_FILES.
+# This happens for instance when ./config.status config.h
+if test -n "\$CONFIG_FILES"; then
+ # Protect against being on the right side of a sed subst in config.status.
+ sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
+ s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
+s,@SHELL@,$SHELL,;t t
+s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
+s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
+s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
+s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
+s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
+s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
+s,@exec_prefix@,$exec_prefix,;t t
+s,@prefix@,$prefix,;t t
+s,@program_transform_name@,$program_transform_name,;t t
+s,@bindir@,$bindir,;t t
+s,@sbindir@,$sbindir,;t t
+s,@libexecdir@,$libexecdir,;t t
+s,@datadir@,$datadir,;t t
+s,@sysconfdir@,$sysconfdir,;t t
+s,@sharedstatedir@,$sharedstatedir,;t t
+s,@localstatedir@,$localstatedir,;t t
+s,@libdir@,$libdir,;t t
+s,@includedir@,$includedir,;t t
+s,@oldincludedir@,$oldincludedir,;t t
+s,@infodir@,$infodir,;t t
+s,@mandir@,$mandir,;t t
+s,@build_alias@,$build_alias,;t t
+s,@host_alias@,$host_alias,;t t
+s,@target_alias@,$target_alias,;t t
+s,@DEFS@,$DEFS,;t t
+s,@ECHO_C@,$ECHO_C,;t t
+s,@ECHO_N@,$ECHO_N,;t t
+s,@ECHO_T@,$ECHO_T,;t t
+s,@LIBS@,$LIBS,;t t
+s,@build@,$build,;t t
+s,@build_cpu@,$build_cpu,;t t
+s,@build_vendor@,$build_vendor,;t t
+s,@build_os@,$build_os,;t t
+s,@host@,$host,;t t
+s,@host_cpu@,$host_cpu,;t t
+s,@host_vendor@,$host_vendor,;t t
+s,@host_os@,$host_os,;t t
+s,@target@,$target,;t t
+s,@target_cpu@,$target_cpu,;t t
+s,@target_vendor@,$target_vendor,;t t
+s,@target_os@,$target_os,;t t
+s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t
+s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t
+s,@INSTALL_DATA@,$INSTALL_DATA,;t t
+s,@PACKAGE@,$PACKAGE,;t t
+s,@VERSION@,$VERSION,;t t
+s,@ACLOCAL@,$ACLOCAL,;t t
+s,@AUTOCONF@,$AUTOCONF,;t t
+s,@AUTOMAKE@,$AUTOMAKE,;t t
+s,@AUTOHEADER@,$AUTOHEADER,;t t
+s,@MAKEINFO@,$MAKEINFO,;t t
+s,@AMTAR@,$AMTAR,;t t
+s,@install_sh@,$install_sh,;t t
+s,@STRIP@,$STRIP,;t t
+s,@ac_ct_STRIP@,$ac_ct_STRIP,;t t
+s,@INSTALL_STRIP_PROGRAM@,$INSTALL_STRIP_PROGRAM,;t t
+s,@AWK@,$AWK,;t t
+s,@SET_MAKE@,$SET_MAKE,;t t
+s,@GC_VERSION@,$GC_VERSION,;t t
+s,@CC@,$CC,;t t
+s,@CFLAGS@,$CFLAGS,;t t
+s,@LDFLAGS@,$LDFLAGS,;t t
+s,@CPPFLAGS@,$CPPFLAGS,;t t
+s,@ac_ct_CC@,$ac_ct_CC,;t t
+s,@EXEEXT@,$EXEEXT,;t t
+s,@OBJEXT@,$OBJEXT,;t t
+s,@DEPDIR@,$DEPDIR,;t t
+s,@am__include@,$am__include,;t t
+s,@am__quote@,$am__quote,;t t
+s,@AMDEP_TRUE@,$AMDEP_TRUE,;t t
+s,@AMDEP_FALSE@,$AMDEP_FALSE,;t t
+s,@AMDEPBACKSLASH@,$AMDEPBACKSLASH,;t t
+s,@CCDEPMODE@,$CCDEPMODE,;t t
+s,@CXX@,$CXX,;t t
+s,@CXXFLAGS@,$CXXFLAGS,;t t
+s,@ac_ct_CXX@,$ac_ct_CXX,;t t
+s,@CXXDEPMODE@,$CXXDEPMODE,;t t
+s,@CCAS@,$CCAS,;t t
+s,@CCASFLAGS@,$CCASFLAGS,;t t
+s,@AR@,$AR,;t t
+s,@ac_ct_AR@,$ac_ct_AR,;t t
+s,@RANLIB@,$RANLIB,;t t
+s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
+s,@MAINTAINER_MODE_TRUE@,$MAINTAINER_MODE_TRUE,;t t
+s,@MAINTAINER_MODE_FALSE@,$MAINTAINER_MODE_FALSE,;t t
+s,@MAINT@,$MAINT,;t t
+s,@GC_CFLAGS@,$GC_CFLAGS,;t t
+s,@THREADLIBS@,$THREADLIBS,;t t
+s,@EXTRA_TEST_LIBS@,$EXTRA_TEST_LIBS,;t t
+s,@target_all@,$target_all,;t t
+s,@INCLUDES@,$INCLUDES,;t t
+s,@CXXINCLUDES@,$CXXINCLUDES,;t t
+s,@addobjs@,$addobjs,;t t
+s,@addincludes@,$addincludes,;t t
+s,@addtests@,$addtests,;t t
+s,@LN_S@,$LN_S,;t t
+s,@ECHO@,$ECHO,;t t
+s,@CPP@,$CPP,;t t
+s,@LIBTOOL@,$LIBTOOL,;t t
+s,@MY_CFLAGS@,$MY_CFLAGS,;t t
+s,@USE_LIBDIR_TRUE@,$USE_LIBDIR_TRUE,;t t
+s,@USE_LIBDIR_FALSE@,$USE_LIBDIR_FALSE,;t t
+CEOF
+
+_ACEOF
+
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ # Split the substitutions into bite-sized pieces for seds with
+ # small command number limits, like on Digital OSF/1 and HP-UX.
+ ac_max_sed_lines=48
+ ac_sed_frag=1 # Number of current file.
+ ac_beg=1 # First line for current file.
+ ac_end=$ac_max_sed_lines # Line after last line for current file.
+ ac_more_lines=:
+ ac_sed_cmds=
+ while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ else
+ sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ fi
+ if test ! -s $tmp/subs.frag; then
+ ac_more_lines=false
+ else
+ # The purpose of the label and of the branching condition is to
+ # speed up the sed processing (if there are no `@' at all, there
+ # is no need to browse any of the substitutions).
+ # These are the two extra sed commands mentioned above.
+ (echo ':t
+ /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
+ fi
+ ac_sed_frag=`expr $ac_sed_frag + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_lines`
+ fi
+ done
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+ fi
+fi # test -n "$CONFIG_FILES"
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case $ac_file in
+ - | *:- | *:-:* ) # input from stdin
+ cat >$tmp/stdin
+ ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ * ) ac_file_in=$ac_file.in ;;
+ esac
+
+ # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ X"$ac_file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { case "$ac_dir" in
+ [\\/]* | ?:[\\/]* ) as_incr_dir=;;
+ *) as_incr_dir=.;;
+esac
+as_dummy="$ac_dir"
+for as_mkdir_dir in `IFS='/\\'; set X $as_dummy; shift; echo "$@"`; do
+ case $as_mkdir_dir in
+ # Skip DOS drivespec
+ ?:) as_incr_dir=$as_mkdir_dir ;;
+ *)
+ as_incr_dir=$as_incr_dir/$as_mkdir_dir
+ test -d "$as_incr_dir" ||
+ mkdir "$as_incr_dir" ||
+ { { echo "$as_me:$LINENO: error: cannot create \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }
+ ;;
+ esac
+done; }
+
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+# Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be
+# absolute.
+ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd`
+ac_abs_top_builddir=`cd "$ac_dir" && cd $ac_top_builddir && pwd`
+ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd`
+ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd`
+
+
+ case $INSTALL in
+ [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
+ *) ac_INSTALL=$ac_top_builddir$INSTALL ;;
+ esac
+
+ if test x"$ac_file" != x-; then
+ { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+ rm -f "$ac_file"
+ fi
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ if test x"$ac_file" = x-; then
+ configure_input=
+ else
+ configure_input="$ac_file. "
+ fi
+ configure_input=$configure_input"Generated from `echo $ac_file_in |
+ sed 's,.*/,,'` by configure."
+
+ # First look for the input files in the build tree, otherwise in the
+ # src tree.
+ ac_file_inputs=`IFS=:
+ for f in $ac_file_in; do
+ case $f in
+ -) echo $tmp/stdin ;;
+ [\\/$]*)
+ # Absolute (can't be DOS-style, as IFS=:)
+ test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ echo $f;;
+ *) # Relative
+ if test -f "$f"; then
+ # Build tree
+ echo $f
+ elif test -f "$srcdir/$f"; then
+ # Source tree
+ echo $srcdir/$f
+ else
+ # /dev/null tree
+ { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ fi;;
+ esac
+ done` || { (exit 1); exit 1; }
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+ sed "$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s,@configure_input@,$configure_input,;t t
+s,@srcdir@,$ac_srcdir,;t t
+s,@abs_srcdir@,$ac_abs_srcdir,;t t
+s,@top_srcdir@,$ac_top_srcdir,;t t
+s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
+s,@builddir@,$ac_builddir,;t t
+s,@abs_builddir@,$ac_abs_builddir,;t t
+s,@top_builddir@,$ac_top_builddir,;t t
+s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
+s,@INSTALL@,$ac_INSTALL,;t t
+" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
+ rm -f $tmp/stdin
+ if test x"$ac_file" != x-; then
+ mv $tmp/out $ac_file
+ else
+ cat $tmp/out
+ rm -f $tmp/out
+ fi
+
+done
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+#
+# CONFIG_COMMANDS section.
+#
+for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue
+ ac_dest=`echo "$ac_file" | sed 's,:.*,,'`
+ ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_dir=`(dirname "$ac_dest") 2>/dev/null ||
+$as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_dest" : 'X\(//\)[^/]' \| \
+ X"$ac_dest" : 'X\(//\)$' \| \
+ X"$ac_dest" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_dest" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+# Don't blindly perform a `cd "$ac_dir"/$ac_foo && pwd` since $ac_foo can be
+# absolute.
+ac_abs_builddir=`cd "$ac_dir" && cd $ac_builddir && pwd`
+ac_abs_top_builddir=`cd "$ac_dir" && cd $ac_top_builddir && pwd`
+ac_abs_srcdir=`cd "$ac_dir" && cd $ac_srcdir && pwd`
+ac_abs_top_srcdir=`cd "$ac_dir" && cd $ac_top_srcdir && pwd`
+
+
+ { echo "$as_me:$LINENO: executing $ac_dest commands" >&5
+echo "$as_me: executing $ac_dest commands" >&6;}
+ case $ac_dest in
+ depfiles ) test x"$AMDEP_TRUE" != x"" || for mf in $CONFIG_FILES; do
+ # Strip MF so we end up with the name of the file.
+ mf=`echo "$mf" | sed -e 's/:.*$//'`
+ # Check whether this is an Automake generated Makefile or not.
+ # We used to match only the files named `Makefile.in', but
+ # some people rename them; so instead we look at the file content.
+ # Grep'ing the first line is not enough: some people post-process
+ # each Makefile.in and add a new line on top of each file to say so.
+ # So let's grep whole file.
+ if grep '^#.*generated by automake' $mf > /dev/null 2>&1; then
+ dirpart=`(dirname "$mf") 2>/dev/null ||
+$as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$mf" : 'X\(//\)[^/]' \| \
+ X"$mf" : 'X\(//\)$' \| \
+ X"$mf" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$mf" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ else
+ continue
+ fi
+ grep '^DEP_FILES *= *[^ #]' < "$mf" > /dev/null || continue
+ # Extract the definition of DEP_FILES from the Makefile without
+ # running `make'.
+ DEPDIR=`sed -n -e '/^DEPDIR = / s///p' < "$mf"`
+ test -z "$DEPDIR" && continue
+ # When using ansi2knr, U may be empty or an underscore; expand it
+ U=`sed -n -e '/^U = / s///p' < "$mf"`
+ test -d "$dirpart/$DEPDIR" || mkdir "$dirpart/$DEPDIR"
+ # We invoke sed twice because it is the simplest approach to
+ # changing $(DEPDIR) to its actual value in the expansion.
+ for file in `sed -n -e '
+ /^DEP_FILES = .*\\\\$/ {
+ s/^DEP_FILES = //
+ :loop
+ s/\\\\$//
+ p
+ n
+ /\\\\$/ b loop
+ p
+ }
+ /^DEP_FILES = / s/^DEP_FILES = //p' < "$mf" | \
+ sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g' -e 's/\$U/'"$U"'/g'`; do
+ # Make sure the directory exists.
+ test -f "$dirpart/$file" && continue
+ fdir=`(dirname "$file") 2>/dev/null ||
+$as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$file" : 'X\(//\)[^/]' \| \
+ X"$file" : 'X\(//\)$' \| \
+ X"$file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { case $dirpart/$fdir in
+ [\\/]* | ?:[\\/]* ) as_incr_dir=;;
+ *) as_incr_dir=.;;
+esac
+as_dummy=$dirpart/$fdir
+for as_mkdir_dir in `IFS='/\\'; set X $as_dummy; shift; echo "$@"`; do
+ case $as_mkdir_dir in
+ # Skip DOS drivespec
+ ?:) as_incr_dir=$as_mkdir_dir ;;
+ *)
+ as_incr_dir=$as_incr_dir/$as_mkdir_dir
+ test -d "$as_incr_dir" ||
+ mkdir "$as_incr_dir" ||
+ { { echo "$as_me:$LINENO: error: cannot create $dirpart/$fdir" >&5
+echo "$as_me: error: cannot create $dirpart/$fdir" >&2;}
+ { (exit 1); exit 1; }; }
+ ;;
+ esac
+done; }
+
+ # echo "creating $dirpart/$file"
+ echo '# dummy' > "$dirpart/$file"
+ done
+done
+ ;;
+ esac
+done
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+{ (exit 0); exit 0; }
+_ACEOF
+chmod +x $CONFIG_STATUS
+ac_clean_files=$ac_clean_files_save
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded. So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status. When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+ ac_cs_success=:
+ exec 5>/dev/null
+ $SHELL $CONFIG_STATUS || ac_cs_success=false
+ exec 5>>config.log
+ # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+ # would make configure fail if this is the last instruction.
+ $ac_cs_success || { (exit 1); exit 1; }
+fi
+
--- /dev/null
+# configure.host
+
+# This shell script handles all host based configuration for the garbage
+# collector.
+# It sets various shell variables based on the the host and the
+# configuration options. You can modify this shell script without
+# needing to rerun autoconf.
+
+# This shell script should be invoked as
+# . configure.host
+# If it encounters an error, it will exit with a message.
+
+# It uses the following shell variables:
+# host The configuration host
+# host_cpu The configuration host CPU
+# target_optspace --enable-target-optspace ("yes", "no", "")
+# GCC should be "yes" if using gcc
+
+# It sets the following shell variables:
+# gc_cflags Special CFLAGS to use when building
+
+gc_cflags=""
+
+# We should set -fexceptions if we are using gcc and might be used
+# inside something like gcj. This is the zeroth approximation:
+if test :"$GCC": = :yes: ; then
+ gc_cflags="${gc_cflags} -fexceptions"
+else
+ case "$host" in
+ *-*-hpux* )
+ gc_cflags="${gc_flags} +ESdbgasm"
+ # :TODO: actaully we should check using Autoconf if
+ # the compiler supports this option.
+ ;;
+ esac
+fi
+
+case "${target_optspace}:${host}" in
+ yes:*)
+ gc_cflags="${gc_cflags} -Os"
+ ;;
+ :m32r-* | :d10v-* | :d30v-*)
+ gc_cflags="${gc_cflags} -Os"
+ ;;
+ no:* | :*)
+ # Nothing.
+ ;;
+esac
+
+# Set any host dependent compiler flags.
+# THIS TABLE IS SORTED. KEEP IT THAT WAY.
+
+case "${host}" in
+ mips-tx39-*|mipstx39-unknown-*)
+ boehm_gc_cflags="${boehm_gc_cflags} -G 0"
+ ;;
+ *)
+ ;;
+esac
--- /dev/null
+# Copyright (c) 1999-2001 by Red Hat, Inc. All rights reserved.
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Original author: Tom Tromey
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+
+dnl Process this file with autoconf to produce configure.
+
+# Initialization
+# ==============
+
+AC_INIT(gc,6.2alpha4,Hans.Boehm@hp.com)
+ ## version must conform to [0-9]+[.][0-9]+(alpha[0-9]+)?
+AC_CONFIG_SRCDIR(gcj_mlc.c)
+AC_CANONICAL_TARGET
+AC_PREREQ(2.53)
+AC_REVISION($Revision: 1.2 $)
+GC_SET_VERSION
+AM_INIT_AUTOMAKE
+
+AC_SUBST(PACKAGE)
+AC_SUBST(GC_VERSION)
+
+AC_PROG_CC
+AC_PROG_CXX
+
+AM_PROG_AS
+AC_CHECK_TOOL(AR, ar)
+AC_CHECK_TOOL(RANLIB, ranlib, :) # :)
+
+AC_PROG_INSTALL
+
+AM_MAINTAINER_MODE
+
+. [$]{srcdir}/configure.host
+
+GC_CFLAGS=${gc_cflags}
+AC_SUBST(GC_CFLAGS)
+
+AC_ARG_ENABLE(threads, [ --enable-threads=TYPE choose threading package],
+ THREADS=$enableval,
+ [ AC_MSG_CHECKING([for thread model used by GCC])
+ THREADS=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'`
+ if test -z "$THREADS"; then
+ THREADS=no
+ fi
+ AC_MSG_RESULT([$THREADS])])
+
+AC_ARG_ENABLE(parallel-mark,
+[ --enable-parallel-mark parallelize marking and free list construction],
+ [case "$THREADS" in
+ no | none | single)
+ AC_MSG_ERROR([Parallel mark requires --enable-threads=x spec])
+ ;;
+ esac]
+)
+
+AC_ARG_ENABLE(cplusplus,
+[ --enable-cplusplus include C++ support in GC library and include directory],
+)
+
+INCLUDES=-I${srcdir}/include
+THREADLIBS=
+case "$THREADS" in
+ no | none | single)
+ THREADS=none
+ ;;
+ posix | pthreads)
+ THREADS=posix
+ THREADLIBS=-lpthread
+ case "$host" in
+ x86-*-linux* | ia64-*-linux* | i586-*-linux* | i686-*-linux* | x86_64-*-linux* | alpha-*-linux*)
+ AC_DEFINE(GC_LINUX_THREADS)
+ AC_DEFINE(_REENTRANT)
+ if test "${enable_parallel_mark}" = yes; then
+ AC_DEFINE(PARALLEL_MARK)
+ fi
+ AC_DEFINE(THREAD_LOCAL_ALLOC)
+ ;;
+ *-*-linux*)
+ AC_DEFINE(GC_LINUX_THREADS)
+ AC_DEFINE(_REENTRANT)
+ ;;
+ *-*-hpux*)
+ AC_MSG_WARN("Only HP/UX 11 threads are supported.")
+ AC_DEFINE(GC_HPUX_THREADS)
+ AC_DEFINE(_POSIX_C_SOURCE,199506L)
+ if test "${enable_parallel_mark}" = yes; then
+ AC_DEFINE(PARALLEL_MARK)
+ fi
+ AC_DEFINE(THREAD_LOCAL_ALLOC)
+ THREADLIBS="-lpthread -lrt"
+ ;;
+ *-*-freebsd*)
+ AC_MSG_WARN("FreeBSD does not yet fully support threads with Boehm GC.")
+ AC_DEFINE(GC_FREEBSD_THREADS)
+ INCLUDES="$INCLUDES -pthread"
+ THREADLIBS=-pthread
+ ;;
+ *-*-solaris*)
+ AC_DEFINE(GC_SOLARIS_THREADS)
+ AC_DEFINE(GC_SOLARIS_PTHREADS)
+ ;;
+ *-*-irix*)
+ AC_DEFINE(GC_IRIX_THREADS)
+ ;;
+ *-*-cygwin*)
+ AC_DEFINE(GC_WIN32_THREADS)
+ ;;
+ *-*-darwin*)
+ AC_DEFINE(GC_MACOSX_THREADS)
+ ;;
+ *-*-osf*)
+ AC_DEFINE(GC_OSF1_THREADS)
+ if test "${enable_parallel_mark}" = yes; then
+ AC_DEFINE(PARALLEL_MARK)
+ AC_DEFINE(THREAD_LOCAL_ALLOC)
+ # May want to enable it in other cases, too.
+ # Measurements havent yet been done.
+ fi
+ INCLUDES="$INCLUDES -pthread"
+ THREADLIBS="-lpthread -lrt"
+ ;;
+ esac
+ ;;
+ win32)
+ AC_DEFINE(GC_WIN32_THREADS)
+ dnl Wine getenv may not return NULL for missing entry
+ AC_DEFINE(NO_GETENV)
+ ;;
+ dgux386)
+ THREADS=dgux386
+AC_MSG_RESULT($THREADLIBS)
+ # Use pthread GCC switch
+ THREADLIBS=-pthread
+ if test "${enable_parallel_mark}" = yes; then
+ AC_DEFINE(PARALLEL_MARK)
+ fi
+ AC_DEFINE(THREAD_LOCAL_ALLOC)
+ AC_DEFINE(GC_DGUX386_THREADS)
+ AC_DEFINE(DGUX_THREADS)
+ # Enable _POSIX4A_DRAFT10_SOURCE with flag -pthread
+ INCLUDES="-pthread $INCLUDES"
+ ;;
+ decosf1 | irix | mach | os2 | solaris | dce | vxworks)
+ AC_MSG_ERROR(thread package $THREADS not yet supported)
+ ;;
+ *)
+ AC_MSG_ERROR($THREADS is an unknown thread package)
+ ;;
+esac
+AC_SUBST(THREADLIBS)
+
+# I'm not too familiar with autoconf, is this the best way to do this? -Brian
+case "$host" in
+ *-*-darwin*) ;;
+ *)
+ AC_CHECK_LIB(dl, dlopen, EXTRA_TEST_LIBS="$EXTRA_TEST_LIBS -ldl")
+ ;;
+esac
+
+AC_SUBST(EXTRA_TEST_LIBS)
+
+target_all=libgc.la
+AC_SUBST(target_all)
+
+dnl If the target is an eCos system, use the appropriate eCos
+dnl I/O routines.
+dnl FIXME: this should not be a local option but a global target
+dnl system; at present there is no eCos target.
+TARGET_ECOS="no"
+AC_ARG_WITH(ecos,
+[ --with-ecos enable runtime eCos target support],
+TARGET_ECOS="$with_ecos"
+)
+
+addobjs=
+addincludes=
+addtests=
+CXXINCLUDES=
+case "$TARGET_ECOS" in
+ no)
+ ;;
+ *)
+ AC_DEFINE(ECOS)
+ CXXINCLUDES="-I${TARGET_ECOS}/include"
+ addobjs="$addobjs ecos.lo"
+ ;;
+esac
+
+if test "${enable_cplusplus}" = yes; then
+ addobjs="$addobjs gc_cpp.lo"
+ addincludes="$addincludes include/gc_cpp.h include/gc_allocator.h"
+ addtests="$addtests test_cpp"
+fi
+
+AC_SUBST(CXX)
+
+AC_SUBST(INCLUDES)
+AC_SUBST(CXXINCLUDES)
+
+# Configuration of shared libraries
+#
+AC_MSG_CHECKING(whether to build shared libraries)
+AC_ENABLE_SHARED
+
+case "$host" in
+ alpha-*-openbsd*)
+ enable_shared=no
+ AC_MSG_RESULT(no)
+ ;;
+ *)
+ AC_MSG_RESULT(yes)
+ ;;
+esac
+
+# Configuration of machine-dependent code
+#
+AC_MSG_CHECKING(which machine-dependent code should be used)
+machdep=
+case "$host" in
+ alpha-*-openbsd*)
+ machdep="alpha_mach_dep.lo"
+ if test x"${ac_cv_lib_dl_dlopen}" != xyes ; then
+ AC_MSG_WARN(OpenBSD/Alpha without dlopen(). Shared library support is disabled)
+ fi
+ ;;
+ alpha*-*-linux*)
+ machdep="alpha_mach_dep.lo"
+ ;;
+ i?86-*-solaris2.[[89]]*)
+ AC_DEFINE(SOLARIS25_PROC_VDB_BUG_FIXED)
+ ;;
+ mipstx39-*-elf*)
+ machdep="mips_ultrix_mach_dep.lo"
+ AC_DEFINE(STACKBASE, __stackbase)
+ AC_DEFINE(DATASTART_IS_ETEXT)
+ ;;
+ mips-dec-ultrix*)
+ machdep="mips_ultrix_mach-dep.lo"
+ ;;
+ mips-nec-sysv*|mips-unknown-sysv*)
+ ;;
+ mips*-*-linux*)
+ ;;
+ mips-*-*)
+ machdep="mips_sgi_mach_dep.lo"
+ AC_DEFINE(NO_EXECUTE_PERMISSION)
+ ;;
+ sparc-*-netbsd*)
+ machdep="sparc_netbsd_mach_dep.lo"
+ ;;
+ sparc-sun-solaris2.3*)
+ machdep="sparc_mach_dep.lo"
+ AC_DEFINE(SUNOS53_SHARED_LIB)
+ ;;
+ sparc-sun-solaris2.*)
+ machdep="sparc_mach_dep.lo"
+ ;;
+ ia64-*-*)
+ machdep="mach_dep.lo ia64_save_regs_in_stack.lo"
+ ;;
+esac
+if test x"$machdep" = x; then
+AC_MSG_RESULT($machdep)
+ machdep="mach_dep.lo"
+fi
+addobjs="$addobjs $machdep"
+AC_SUBST(addobjs)
+AC_SUBST(addincludes)
+AC_SUBST(addtests)
+
+AC_PROG_LIBTOOL
+
+#
+# Check for AViiON Machines running DGUX
+#
+AC_MSG_CHECKING(if host is AViiON running DGUX)
+ac_is_dgux=no
+AC_CHECK_HEADER(sys/dg_sys_info.h,
+[ac_is_dgux=yes;])
+
+AC_MSG_RESULT($ac_is_dgux)
+ ## :GOTCHA: we do not check anything but sys/dg_sys_info.h
+if test $ac_is_dgux = yes; then
+ if test "$enable_full_debug" = "yes"; then
+ CFLAGS="-g -mstandard -DDGUX -D_DGUX_SOURCE -Di386 -mno-legend -O2"
+ CXXFLAGS="-g -mstandard -DDGUX -D_DGUX_SOURCE -Di386 -mno-legend -O2"
+ else
+ CFLAGS="-DDGUX -D_DGUX_SOURCE -Di386 -mno-legend -O2"
+ CXXFLAGS="-DDGUX -D_DGUX_SOURCE -Di386 -mno-legend -O2"
+ fi
+ AC_SUBST(CFLAGS)
+ AC_SUBST(CXXFLAGS)
+fi
+
+dnl We use these options to decide which functions to include.
+AC_ARG_WITH(target-subdir,
+[ --with-target-subdir=SUBDIR
+ configuring with a cross compiler])
+AC_ARG_WITH(cross-host,
+[ --with-cross-host=HOST configuring with a cross compiler])
+
+# automake wants to see AC_EXEEXT. But we don't need it. And having
+# it is actually a problem, because the compiler we're passed can't
+# necessarily do a full link. So we fool automake here.
+if false; then
+ # autoconf 2.50 runs AC_EXEEXT by default, and the macro expands
+ # to nothing, so nothing would remain between `then' and `fi' if it
+ # were not for the `:' below.
+ :
+ AC_EXEEXT
+fi
+
+dnl As of 4.13a2, the collector will not properly work on Solaris when
+dnl built with gcc and -O. So we remove -O in the appropriate case.
+dnl
+AC_MSG_CHECKING(whether Solaris gcc optimization fix is necessary)
+case "$host" in
+ sparc-sun-solaris2*)
+ if test "$GCC" = yes; then
+ AC_MSG_RESULT(yes)
+ new_CFLAGS=
+ for i in $CFLAGS; do
+ case "$i" in
+ -O*)
+ ;;
+ *)
+ new_CFLAGS="$new_CFLAGS $i"
+ ;;
+ esac
+ done
+ CFLAGS="$new_CFLAGS"
+ else
+ AC_MSG_RESULT(no)
+ fi
+ ;;
+ *) AC_MSG_RESULT(no) ;;
+esac
+
+dnl We need to override the top-level CFLAGS. This is how we do it.
+MY_CFLAGS="$CFLAGS"
+AC_SUBST(MY_CFLAGS)
+
+dnl Include defines that have become de facto standard.
+dnl ALL_INTERIOR_POINTERS can be overridden in startup code.
+AC_DEFINE(SILENT)
+AC_DEFINE(NO_SIGNALS)
+AC_DEFINE(NO_EXECUTE_PERMISSION)
+AC_DEFINE(ALL_INTERIOR_POINTERS)
+
+dnl By default, make the library as general as possible.
+AC_DEFINE(JAVA_FINALIZATION)
+AC_DEFINE(GC_GCJ_SUPPORT)
+AC_DEFINE(ATOMIC_UNCOLLECTABLE)
+
+dnl This is something of a hack. When cross-compiling we turn off
+dnl some functionality. We also enable the "small" configuration.
+dnl These is only correct when targetting an embedded system. FIXME.
+if test -n "${with_cross_host}"; then
+ AC_DEFINE(NO_SIGSET)
+ AC_DEFINE(NO_CLOCK)
+ AC_DEFINE(SMALL_CONFIG)
+ AC_DEFINE(NO_DEBUGGING)
+fi
+
+AC_ARG_ENABLE(full-debug,
+[ --enable-full-debug include full support for pointer backtracing etc.],
+[ if test "$enable_full_debug" = "yes"; then
+ AC_MSG_WARN("Must define GC_DEBUG and use debug alloc. in clients.")
+ AC_DEFINE(KEEP_BACK_PTRS)
+ AC_DEFINE(DBG_HDRS_ALL)
+ case $host in
+ ia64-*-linux* )
+ AC_DEFINE(MAKE_BACK_GRAPH)
+ ;;
+ x86-*-linux* | i586-*-linux* | i686-*-linux* | x86_64-*-linux* )
+ AC_DEFINE(MAKE_BACK_GRAPH)
+ AC_MSG_WARN("Client must not use -fomit-frame-pointer.")
+ AC_DEFINE(SAVE_CALL_COUNT, 8)
+ ;;
+ i[3456]86-*-dgux*)
+ AC_DEFINE(MAKE_BACK_GRAPH)
+ ;;
+ esac ]
+ fi)
+
+AC_ARG_ENABLE(redirect-malloc,
+[ --enable-redirect-malloc redirect malloc and friends to GC routines])
+
+if test "${enable_redirect_malloc}" = yes; then
+ if test "${enable_full_debug}" = yes; then
+ AC_DEFINE(REDIRECT_MALLOC, GC_debug_malloc_replacement)
+ AC_DEFINE(REDIRECT_REALLOC, GC_debug_realloc_replacement)
+ AC_DEFINE(REDIRECT_FREE, GC_debug_free)
+ else
+ AC_DEFINE(REDIRECT_MALLOC, GC_malloc)
+ fi
+fi
+
+AC_ARG_ENABLE(gc-assertions,
+[ --enable-gc-assertions collector-internal assertion checking])
+if test "${enable_gc_assertions}" = yes; then
+ AC_DEFINE(GC_ASSERTIONS)
+fi
+
+AM_CONDITIONAL(USE_LIBDIR, test -z "$with_cross_host")
+
+AC_OUTPUT([Makefile doc/Makefile include/Makefile],,
+srcdir=${srcdir}
+host=${host}
+CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
+CC="${CC}"
+DEFS="$DEFS"
+)
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1997 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999-2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+#include "private/dbg_mlc.h"
+
+void GC_default_print_heap_obj_proc();
+GC_API void GC_register_finalizer_no_order
+ GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR *ocd));
+
+
+#ifndef SHORT_DBG_HDRS
+/* Check whether object with base pointer p has debugging info */
+/* p is assumed to point to a legitimate object in our part */
+/* of the heap. */
+/* This excludes the check as to whether the back pointer is */
+/* odd, which is added by the GC_HAS_DEBUG_INFO macro. */
+/* Note that if DBG_HDRS_ALL is set, uncollectable objects */
+/* on free lists may not have debug information set. Thus it's */
+/* not always safe to return TRUE, even if the client does */
+/* its part. */
+GC_bool GC_has_other_debug_info(p)
+ptr_t p;
+{
+ register oh * ohdr = (oh *)p;
+ register ptr_t body = (ptr_t)(ohdr + 1);
+ register word sz = GC_size((ptr_t) ohdr);
+
+ if (HBLKPTR((ptr_t)ohdr) != HBLKPTR((ptr_t)body)
+ || sz < DEBUG_BYTES + EXTRA_BYTES) {
+ return(FALSE);
+ }
+ if (ohdr -> oh_sz == sz) {
+ /* Object may have had debug info, but has been deallocated */
+ return(FALSE);
+ }
+ if (ohdr -> oh_sf == (START_FLAG ^ (word)body)) return(TRUE);
+ if (((word *)ohdr)[BYTES_TO_WORDS(sz)-1] == (END_FLAG ^ (word)body)) {
+ return(TRUE);
+ }
+ return(FALSE);
+}
+#endif
+
+#ifdef KEEP_BACK_PTRS
+
+# include <stdlib.h>
+
+# if defined(LINUX) || defined(SUNOS4) || defined(SUNOS5) \
+ || defined(HPUX) || defined(IRIX5) || defined(OSF1)
+# define RANDOM() random()
+# else
+# define RANDOM() (long)rand()
+# endif
+
+ /* Store back pointer to source in dest, if that appears to be possible. */
+ /* This is not completely safe, since we may mistakenly conclude that */
+ /* dest has a debugging wrapper. But the error probability is very */
+ /* small, and this shouldn't be used in production code. */
+ /* We assume that dest is the real base pointer. Source will usually */
+ /* be a pointer to the interior of an object. */
+ void GC_store_back_pointer(ptr_t source, ptr_t dest)
+ {
+ if (GC_HAS_DEBUG_INFO(dest)) {
+ ((oh *)dest) -> oh_back_ptr = HIDE_BACK_PTR(source);
+ }
+ }
+
+ void GC_marked_for_finalization(ptr_t dest) {
+ GC_store_back_pointer(MARKED_FOR_FINALIZATION, dest);
+ }
+
+ /* Store information about the object referencing dest in *base_p */
+ /* and *offset_p. */
+ /* source is root ==> *base_p = address, *offset_p = 0 */
+ /* source is heap object ==> *base_p != 0, *offset_p = offset */
+ /* Returns 1 on success, 0 if source couldn't be determined. */
+ /* Dest can be any address within a heap object. */
+ GC_ref_kind GC_get_back_ptr_info(void *dest, void **base_p, size_t *offset_p)
+ {
+ oh * hdr = (oh *)GC_base(dest);
+ ptr_t bp;
+ ptr_t bp_base;
+ if (!GC_HAS_DEBUG_INFO((ptr_t) hdr)) return GC_NO_SPACE;
+ bp = REVEAL_POINTER(hdr -> oh_back_ptr);
+ if (MARKED_FOR_FINALIZATION == bp) return GC_FINALIZER_REFD;
+ if (MARKED_FROM_REGISTER == bp) return GC_REFD_FROM_REG;
+ if (NOT_MARKED == bp) return GC_UNREFERENCED;
+# if ALIGNMENT == 1
+ /* Heuristically try to fix off by 1 errors we introduced by */
+ /* insisting on even addresses. */
+ {
+ ptr_t alternate_ptr = bp + 1;
+ ptr_t target = *(ptr_t *)bp;
+ ptr_t alternate_target = *(ptr_t *)alternate_ptr;
+
+ if (alternate_target >= GC_least_plausible_heap_addr
+ && alternate_target <= GC_greatest_plausible_heap_addr
+ && (target < GC_least_plausible_heap_addr
+ || target > GC_greatest_plausible_heap_addr)) {
+ bp = alternate_ptr;
+ }
+ }
+# endif
+ bp_base = GC_base(bp);
+ if (0 == bp_base) {
+ *base_p = bp;
+ *offset_p = 0;
+ return GC_REFD_FROM_ROOT;
+ } else {
+ if (GC_HAS_DEBUG_INFO(bp_base)) bp_base += sizeof(oh);
+ *base_p = bp_base;
+ *offset_p = bp - bp_base;
+ return GC_REFD_FROM_HEAP;
+ }
+ }
+
+ /* Generate a random heap address. */
+ /* The resulting address is in the heap, but */
+ /* not necessarily inside a valid object. */
+ void *GC_generate_random_heap_address(void)
+ {
+ int i;
+ long heap_offset = RANDOM();
+ if (GC_heapsize > RAND_MAX) {
+ heap_offset *= RAND_MAX;
+ heap_offset += RANDOM();
+ }
+ heap_offset %= GC_heapsize;
+ /* This doesn't yield a uniform distribution, especially if */
+ /* e.g. RAND_MAX = 1.5* GC_heapsize. But for typical cases, */
+ /* it's not too bad. */
+ for (i = 0; i < GC_n_heap_sects; ++ i) {
+ int size = GC_heap_sects[i].hs_bytes;
+ if (heap_offset < size) {
+ return GC_heap_sects[i].hs_start + heap_offset;
+ } else {
+ heap_offset -= size;
+ }
+ }
+ ABORT("GC_generate_random_heap_address: size inconsistency");
+ /*NOTREACHED*/
+ return 0;
+ }
+
+ /* Generate a random address inside a valid marked heap object. */
+ void *GC_generate_random_valid_address(void)
+ {
+ ptr_t result;
+ ptr_t base;
+ for (;;) {
+ result = GC_generate_random_heap_address();
+ base = GC_base(result);
+ if (0 == base) continue;
+ if (!GC_is_marked(base)) continue;
+ return result;
+ }
+ }
+
+ /* Print back trace for p */
+ void GC_print_backtrace(void *p)
+ {
+ void *current = p;
+ int i;
+ GC_ref_kind source;
+ size_t offset;
+ void *base;
+
+ GC_print_heap_obj(GC_base(current));
+ GC_err_printf0("\n");
+ for (i = 0; ; ++i) {
+ source = GC_get_back_ptr_info(current, &base, &offset);
+ if (GC_UNREFERENCED == source) {
+ GC_err_printf0("Reference could not be found\n");
+ goto out;
+ }
+ if (GC_NO_SPACE == source) {
+ GC_err_printf0("No debug info in object: Can't find reference\n");
+ goto out;
+ }
+ GC_err_printf1("Reachable via %d levels of pointers from ",
+ (unsigned long)i);
+ switch(source) {
+ case GC_REFD_FROM_ROOT:
+ GC_err_printf1("root at 0x%lx\n", (unsigned long)base);
+ goto out;
+ case GC_REFD_FROM_REG:
+ GC_err_printf0("root in register\n");
+ goto out;
+ case GC_FINALIZER_REFD:
+ GC_err_printf0("list of finalizable objects\n");
+ goto out;
+ case GC_REFD_FROM_HEAP:
+ GC_err_printf1("offset %ld in object:\n", (unsigned long)offset);
+ /* Take GC_base(base) to get real base, i.e. header. */
+ GC_print_heap_obj(GC_base(base));
+ GC_err_printf0("\n");
+ break;
+ }
+ current = base;
+ }
+ out:;
+ }
+
+ /* Force a garbage collection and generate a backtrace from a */
+ /* random heap address. */
+ void GC_generate_random_backtrace(void)
+ {
+ void * current;
+ GC_gcollect();
+ current = GC_generate_random_valid_address();
+ GC_printf1("Chose address 0x%lx in object\n", (unsigned long)current);
+ GC_print_backtrace(current);
+ }
+
+#endif /* KEEP_BACK_PTRS */
+
+# define CROSSES_HBLK(p, sz) \
+ (((word)(p + sizeof(oh) + sz - 1) ^ (word)p) >= HBLKSIZE)
+/* Store debugging info into p. Return displaced pointer. */
+/* Assumes we don't hold allocation lock. */
+ptr_t GC_store_debug_info(p, sz, string, integer)
+register ptr_t p; /* base pointer */
+word sz; /* bytes */
+GC_CONST char * string;
+word integer;
+{
+ register word * result = (word *)((oh *)p + 1);
+ DCL_LOCK_STATE;
+
+ /* There is some argument that we should dissble signals here. */
+ /* But that's expensive. And this way things should only appear */
+ /* inconsistent while we're in the handler. */
+ LOCK();
+ GC_ASSERT(GC_size(p) >= sizeof(oh) + sz);
+ GC_ASSERT(!(SMALL_OBJ(sz) && CROSSES_HBLK(p, sz)));
+# ifdef KEEP_BACK_PTRS
+ ((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED);
+# endif
+# ifdef MAKE_BACK_GRAPH
+ ((oh *)p) -> oh_bg_ptr = HIDE_BACK_PTR((ptr_t)0);
+# endif
+ ((oh *)p) -> oh_string = string;
+ ((oh *)p) -> oh_int = integer;
+# ifndef SHORT_DBG_HDRS
+ ((oh *)p) -> oh_sz = sz;
+ ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
+ ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
+ result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
+# endif
+ UNLOCK();
+ return((ptr_t)result);
+}
+
+#ifdef DBG_HDRS_ALL
+/* Store debugging info into p. Return displaced pointer. */
+/* This version assumes we do hold the allocation lock. */
+ptr_t GC_store_debug_info_inner(p, sz, string, integer)
+register ptr_t p; /* base pointer */
+word sz; /* bytes */
+char * string;
+word integer;
+{
+ register word * result = (word *)((oh *)p + 1);
+
+ /* There is some argument that we should disable signals here. */
+ /* But that's expensive. And this way things should only appear */
+ /* inconsistent while we're in the handler. */
+ GC_ASSERT(GC_size(p) >= sizeof(oh) + sz);
+ GC_ASSERT(!(SMALL_OBJ(sz) && CROSSES_HBLK(p, sz)));
+# ifdef KEEP_BACK_PTRS
+ ((oh *)p) -> oh_back_ptr = HIDE_BACK_PTR(NOT_MARKED);
+# endif
+# ifdef MAKE_BACK_GRAPH
+ ((oh *)p) -> oh_bg_ptr = HIDE_BACK_PTR((ptr_t)0);
+# endif
+ ((oh *)p) -> oh_string = string;
+ ((oh *)p) -> oh_int = integer;
+# ifndef SHORT_DBG_HDRS
+ ((oh *)p) -> oh_sz = sz;
+ ((oh *)p) -> oh_sf = START_FLAG ^ (word)result;
+ ((word *)p)[BYTES_TO_WORDS(GC_size(p))-1] =
+ result[SIMPLE_ROUNDED_UP_WORDS(sz)] = END_FLAG ^ (word)result;
+# endif
+ return((ptr_t)result);
+}
+#endif
+
+#ifndef SHORT_DBG_HDRS
+/* Check the object with debugging info at ohdr */
+/* return NIL if it's OK. Else return clobbered */
+/* address. */
+ptr_t GC_check_annotated_obj(ohdr)
+register oh * ohdr;
+{
+ register ptr_t body = (ptr_t)(ohdr + 1);
+ register word gc_sz = GC_size((ptr_t)ohdr);
+ if (ohdr -> oh_sz + DEBUG_BYTES > gc_sz) {
+ return((ptr_t)(&(ohdr -> oh_sz)));
+ }
+ if (ohdr -> oh_sf != (START_FLAG ^ (word)body)) {
+ return((ptr_t)(&(ohdr -> oh_sf)));
+ }
+ if (((word *)ohdr)[BYTES_TO_WORDS(gc_sz)-1] != (END_FLAG ^ (word)body)) {
+ return((ptr_t)((word *)ohdr + BYTES_TO_WORDS(gc_sz)-1));
+ }
+ if (((word *)body)[SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)]
+ != (END_FLAG ^ (word)body)) {
+ return((ptr_t)((word *)body + SIMPLE_ROUNDED_UP_WORDS(ohdr -> oh_sz)));
+ }
+ return(0);
+}
+#endif /* !SHORT_DBG_HDRS */
+
+void GC_print_obj(p)
+ptr_t p;
+{
+ register oh * ohdr = (oh *)GC_base(p);
+
+ GC_ASSERT(!I_HOLD_LOCK());
+ GC_err_printf1("0x%lx (", ((unsigned long)ohdr + sizeof(oh)));
+ GC_err_puts(ohdr -> oh_string);
+# ifdef SHORT_DBG_HDRS
+ GC_err_printf1(":%ld)\n", (unsigned long)(ohdr -> oh_int));
+# else
+ GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
+ (unsigned long)(ohdr -> oh_sz));
+# endif
+ PRINT_CALL_CHAIN(ohdr);
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_debug_print_heap_obj_proc(ptr_t p)
+# else
+ void GC_debug_print_heap_obj_proc(p)
+ ptr_t p;
+# endif
+{
+ GC_ASSERT(!I_HOLD_LOCK());
+ if (GC_HAS_DEBUG_INFO(p)) {
+ GC_print_obj(p);
+ } else {
+ GC_default_print_heap_obj_proc(p);
+ }
+}
+
+#ifndef SHORT_DBG_HDRS
+void GC_print_smashed_obj(p, clobbered_addr)
+ptr_t p, clobbered_addr;
+{
+ register oh * ohdr = (oh *)GC_base(p);
+
+ GC_ASSERT(!I_HOLD_LOCK());
+ GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
+ (unsigned long)p);
+ if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
+ || ohdr -> oh_string == 0) {
+ GC_err_printf1("<smashed>, appr. sz = %ld)\n",
+ (GC_size((ptr_t)ohdr) - DEBUG_BYTES));
+ } else {
+ if (ohdr -> oh_string[0] == '\0') {
+ GC_err_puts("EMPTY(smashed?)");
+ } else {
+ GC_err_puts(ohdr -> oh_string);
+ }
+ GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
+ (unsigned long)(ohdr -> oh_sz));
+ PRINT_CALL_CHAIN(ohdr);
+ }
+}
+#endif
+
+void GC_check_heap_proc GC_PROTO((void));
+
+void GC_print_all_smashed_proc GC_PROTO((void));
+
+void GC_do_nothing() {}
+
+void GC_start_debugging()
+{
+# ifndef SHORT_DBG_HDRS
+ GC_check_heap = GC_check_heap_proc;
+ GC_print_all_smashed = GC_print_all_smashed_proc;
+# else
+ GC_check_heap = GC_do_nothing;
+ GC_print_all_smashed = GC_do_nothing;
+# endif
+ GC_print_heap_obj = GC_debug_print_heap_obj_proc;
+ GC_debugging_started = TRUE;
+ GC_register_displacement((word)sizeof(oh));
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_debug_register_displacement(GC_word offset)
+# else
+ void GC_debug_register_displacement(offset)
+ GC_word offset;
+# endif
+{
+ GC_register_displacement(offset);
+ GC_register_displacement((word)sizeof(oh) + offset);
+}
+
+# ifdef __STDC__
+ GC_PTR GC_debug_malloc(size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_malloc(lb, s, i)
+ size_t lb;
+ char * s;
+ int i;
+# ifdef GC_ADD_CALLER
+ --> GC_ADD_CALLER not implemented for K&R C
+# endif
+# endif
+{
+ GC_PTR result = GC_malloc(lb + DEBUG_BYTES);
+
+ if (result == 0) {
+ GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
+ (unsigned long) lb);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return(0);
+ }
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+# ifdef __STDC__
+ GC_PTR GC_debug_malloc_ignore_off_page(size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_malloc_ignore_off_page(lb, s, i)
+ size_t lb;
+ char * s;
+ int i;
+# ifdef GC_ADD_CALLER
+ --> GC_ADD_CALLER not implemented for K&R C
+# endif
+# endif
+{
+ GC_PTR result = GC_malloc_ignore_off_page(lb + DEBUG_BYTES);
+
+ if (result == 0) {
+ GC_err_printf1("GC_debug_malloc_ignore_off_page(%ld) returning NIL (",
+ (unsigned long) lb);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return(0);
+ }
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+# ifdef __STDC__
+ GC_PTR GC_debug_malloc_atomic_ignore_off_page(size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_malloc_atomic_ignore_off_page(lb, s, i)
+ size_t lb;
+ char * s;
+ int i;
+# ifdef GC_ADD_CALLER
+ --> GC_ADD_CALLER not implemented for K&R C
+# endif
+# endif
+{
+ GC_PTR result = GC_malloc_atomic_ignore_off_page(lb + DEBUG_BYTES);
+
+ if (result == 0) {
+ GC_err_printf1("GC_debug_malloc_atomic_ignore_off_page(%ld)"
+ " returning NIL (", (unsigned long) lb);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return(0);
+ }
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+# ifdef DBG_HDRS_ALL
+/*
+ * An allocation function for internal use.
+ * Normally internally allocated objects do not have debug information.
+ * But in this case, we need to make sure that all objects have debug
+ * headers.
+ * We assume debugging was started in collector initialization,
+ * and we already hold the GC lock.
+ */
+ GC_PTR GC_debug_generic_malloc_inner(size_t lb, int k)
+ {
+ GC_PTR result = GC_generic_malloc_inner(lb + DEBUG_BYTES, k);
+
+ if (result == 0) {
+ GC_err_printf1("GC internal allocation (%ld bytes) returning NIL\n",
+ (unsigned long) lb);
+ return(0);
+ }
+ ADD_CALL_CHAIN(result, GC_RETURN_ADDR);
+ return (GC_store_debug_info_inner(result, (word)lb, "INTERNAL", (word)0));
+ }
+
+ GC_PTR GC_debug_generic_malloc_inner_ignore_off_page(size_t lb, int k)
+ {
+ GC_PTR result = GC_generic_malloc_inner_ignore_off_page(
+ lb + DEBUG_BYTES, k);
+
+ if (result == 0) {
+ GC_err_printf1("GC internal allocation (%ld bytes) returning NIL\n",
+ (unsigned long) lb);
+ return(0);
+ }
+ ADD_CALL_CHAIN(result, GC_RETURN_ADDR);
+ return (GC_store_debug_info_inner(result, (word)lb, "INTERNAL", (word)0));
+ }
+# endif
+
+#ifdef STUBBORN_ALLOC
+# ifdef __STDC__
+ GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_malloc_stubborn(lb, s, i)
+ size_t lb;
+ char * s;
+ int i;
+# endif
+{
+ GC_PTR result = GC_malloc_stubborn(lb + DEBUG_BYTES);
+
+ if (result == 0) {
+ GC_err_printf1("GC_debug_malloc(%ld) returning NIL (",
+ (unsigned long) lb);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return(0);
+ }
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+void GC_debug_change_stubborn(p)
+GC_PTR p;
+{
+ register GC_PTR q = GC_base(p);
+ register hdr * hhdr;
+
+ if (q == 0) {
+ GC_err_printf1("Bad argument: 0x%lx to GC_debug_change_stubborn\n",
+ (unsigned long) p);
+ ABORT("GC_debug_change_stubborn: bad arg");
+ }
+ hhdr = HDR(q);
+ if (hhdr -> hb_obj_kind != STUBBORN) {
+ GC_err_printf1("GC_debug_change_stubborn arg not stubborn: 0x%lx\n",
+ (unsigned long) p);
+ ABORT("GC_debug_change_stubborn: arg not stubborn");
+ }
+ GC_change_stubborn(q);
+}
+
+void GC_debug_end_stubborn_change(p)
+GC_PTR p;
+{
+ register GC_PTR q = GC_base(p);
+ register hdr * hhdr;
+
+ if (q == 0) {
+ GC_err_printf1("Bad argument: 0x%lx to GC_debug_end_stubborn_change\n",
+ (unsigned long) p);
+ ABORT("GC_debug_end_stubborn_change: bad arg");
+ }
+ hhdr = HDR(q);
+ if (hhdr -> hb_obj_kind != STUBBORN) {
+ GC_err_printf1("debug_end_stubborn_change arg not stubborn: 0x%lx\n",
+ (unsigned long) p);
+ ABORT("GC_debug_end_stubborn_change: arg not stubborn");
+ }
+ GC_end_stubborn_change(q);
+}
+
+#else /* !STUBBORN_ALLOC */
+
+# ifdef __STDC__
+ GC_PTR GC_debug_malloc_stubborn(size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_malloc_stubborn(lb, s, i)
+ size_t lb;
+ char * s;
+ int i;
+# endif
+{
+ return GC_debug_malloc(lb, OPT_RA s, i);
+}
+
+void GC_debug_change_stubborn(p)
+GC_PTR p;
+{
+}
+
+void GC_debug_end_stubborn_change(p)
+GC_PTR p;
+{
+}
+
+#endif /* !STUBBORN_ALLOC */
+
+# ifdef __STDC__
+ GC_PTR GC_debug_malloc_atomic(size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_malloc_atomic(lb, s, i)
+ size_t lb;
+ char * s;
+ int i;
+# endif
+{
+ GC_PTR result = GC_malloc_atomic(lb + DEBUG_BYTES);
+
+ if (result == 0) {
+ GC_err_printf1("GC_debug_malloc_atomic(%ld) returning NIL (",
+ (unsigned long) lb);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return(0);
+ }
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+# ifdef __STDC__
+ GC_PTR GC_debug_malloc_uncollectable(size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_malloc_uncollectable(lb, s, i)
+ size_t lb;
+ char * s;
+ int i;
+# endif
+{
+ GC_PTR result = GC_malloc_uncollectable(lb + UNCOLLECTABLE_DEBUG_BYTES);
+
+ if (result == 0) {
+ GC_err_printf1("GC_debug_malloc_uncollectable(%ld) returning NIL (",
+ (unsigned long) lb);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return(0);
+ }
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+#ifdef ATOMIC_UNCOLLECTABLE
+# ifdef __STDC__
+ GC_PTR GC_debug_malloc_atomic_uncollectable(size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_malloc_atomic_uncollectable(lb, s, i)
+ size_t lb;
+ char * s;
+ int i;
+# endif
+{
+ GC_PTR result =
+ GC_malloc_atomic_uncollectable(lb + UNCOLLECTABLE_DEBUG_BYTES);
+
+ if (result == 0) {
+ GC_err_printf1(
+ "GC_debug_malloc_atomic_uncollectable(%ld) returning NIL (",
+ (unsigned long) lb);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return(0);
+ }
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+#endif /* ATOMIC_UNCOLLECTABLE */
+
+# ifdef __STDC__
+ void GC_debug_free(GC_PTR p)
+# else
+ void GC_debug_free(p)
+ GC_PTR p;
+# endif
+{
+ register GC_PTR base;
+ register ptr_t clobbered;
+
+ if (0 == p) return;
+ base = GC_base(p);
+ if (base == 0) {
+ GC_err_printf1("Attempt to free invalid pointer %lx\n",
+ (unsigned long)p);
+ ABORT("free(invalid pointer)");
+ }
+ if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
+ GC_err_printf1(
+ "GC_debug_free called on pointer %lx wo debugging info\n",
+ (unsigned long)p);
+ } else {
+# ifndef SHORT_DBG_HDRS
+ clobbered = GC_check_annotated_obj((oh *)base);
+ if (clobbered != 0) {
+ if (((oh *)base) -> oh_sz == GC_size(base)) {
+ GC_err_printf0(
+ "GC_debug_free: found previously deallocated (?) object at ");
+ } else {
+ GC_err_printf0("GC_debug_free: found smashed location at ");
+ }
+ GC_print_smashed_obj(p, clobbered);
+ }
+ /* Invalidate size */
+ ((oh *)base) -> oh_sz = GC_size(base);
+# endif /* SHORT_DBG_HDRS */
+ }
+ if (GC_find_leak) {
+ GC_free(base);
+ } else {
+ register hdr * hhdr = HDR(p);
+ GC_bool uncollectable = FALSE;
+
+ if (hhdr -> hb_obj_kind == UNCOLLECTABLE) {
+ uncollectable = TRUE;
+ }
+# ifdef ATOMIC_UNCOLLECTABLE
+ if (hhdr -> hb_obj_kind == AUNCOLLECTABLE) {
+ uncollectable = TRUE;
+ }
+# endif
+ if (uncollectable) GC_free(base);
+ } /* !GC_find_leak */
+}
+
+#ifdef THREADS
+
+extern void GC_free_inner(GC_PTR p);
+
+/* Used internally; we assume it's called correctly. */
+void GC_debug_free_inner(GC_PTR p)
+{
+ GC_free_inner(GC_base(p));
+}
+#endif
+
+# ifdef __STDC__
+ GC_PTR GC_debug_realloc(GC_PTR p, size_t lb, GC_EXTRA_PARAMS)
+# else
+ GC_PTR GC_debug_realloc(p, lb, s, i)
+ GC_PTR p;
+ size_t lb;
+ char *s;
+ int i;
+# endif
+{
+ register GC_PTR base = GC_base(p);
+ register ptr_t clobbered;
+ register GC_PTR result;
+ register size_t copy_sz = lb;
+ register size_t old_sz;
+ register hdr * hhdr;
+
+ if (p == 0) return(GC_debug_malloc(lb, OPT_RA s, i));
+ if (base == 0) {
+ GC_err_printf1(
+ "Attempt to reallocate invalid pointer %lx\n", (unsigned long)p);
+ ABORT("realloc(invalid pointer)");
+ }
+ if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
+ GC_err_printf1(
+ "GC_debug_realloc called on pointer %lx wo debugging info\n",
+ (unsigned long)p);
+ return(GC_realloc(p, lb));
+ }
+ hhdr = HDR(base);
+ switch (hhdr -> hb_obj_kind) {
+# ifdef STUBBORN_ALLOC
+ case STUBBORN:
+ result = GC_debug_malloc_stubborn(lb, OPT_RA s, i);
+ break;
+# endif
+ case NORMAL:
+ result = GC_debug_malloc(lb, OPT_RA s, i);
+ break;
+ case PTRFREE:
+ result = GC_debug_malloc_atomic(lb, OPT_RA s, i);
+ break;
+ case UNCOLLECTABLE:
+ result = GC_debug_malloc_uncollectable(lb, OPT_RA s, i);
+ break;
+# ifdef ATOMIC_UNCOLLECTABLE
+ case AUNCOLLECTABLE:
+ result = GC_debug_malloc_atomic_uncollectable(lb, OPT_RA s, i);
+ break;
+# endif
+ default:
+ GC_err_printf0("GC_debug_realloc: encountered bad kind\n");
+ ABORT("bad kind");
+ }
+# ifdef SHORT_DBG_HDRS
+ old_sz = GC_size(base) - sizeof(oh);
+# else
+ clobbered = GC_check_annotated_obj((oh *)base);
+ if (clobbered != 0) {
+ GC_err_printf0("GC_debug_realloc: found smashed location at ");
+ GC_print_smashed_obj(p, clobbered);
+ }
+ old_sz = ((oh *)base) -> oh_sz;
+# endif
+ if (old_sz < copy_sz) copy_sz = old_sz;
+ if (result == 0) return(0);
+ BCOPY(p, result, copy_sz);
+ GC_debug_free(p);
+ return(result);
+}
+
+#ifndef SHORT_DBG_HDRS
+
+/* List of smashed objects. We defer printing these, since we can't */
+/* always print them nicely with the allocation lock held. */
+/* We put them here instead of in GC_arrays, since it may be useful to */
+/* be able to look at them with the debugger. */
+#define MAX_SMASHED 20
+ptr_t GC_smashed[MAX_SMASHED];
+unsigned GC_n_smashed = 0;
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_add_smashed(ptr_t smashed)
+# else
+ void GC_add_smashed(smashed)
+ ptr_t smashed;
+#endif
+{
+ GC_ASSERT(GC_is_marked(GC_base(smashed)));
+ GC_smashed[GC_n_smashed] = smashed;
+ if (GC_n_smashed < MAX_SMASHED - 1) ++GC_n_smashed;
+ /* In case of overflow, we keep the first MAX_SMASHED-1 */
+ /* entries plus the last one. */
+ GC_have_errors = TRUE;
+}
+
+/* Print all objects on the list. Clear the list. */
+void GC_print_all_smashed_proc ()
+{
+ unsigned i;
+
+ GC_ASSERT(!I_HOLD_LOCK());
+ if (GC_n_smashed == 0) return;
+ GC_err_printf0("GC_check_heap_block: found smashed heap objects:\n");
+ for (i = 0; i < GC_n_smashed; ++i) {
+ GC_print_smashed_obj(GC_base(GC_smashed[i]), GC_smashed[i]);
+ GC_smashed[i] = 0;
+ }
+ GC_n_smashed = 0;
+}
+
+/* Check all marked objects in the given block for validity */
+/*ARGSUSED*/
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_check_heap_block(register struct hblk *hbp, word dummy)
+# else
+ void GC_check_heap_block(hbp, dummy)
+ register struct hblk *hbp; /* ptr to current heap block */
+ word dummy;
+# endif
+{
+ register struct hblkhdr * hhdr = HDR(hbp);
+ register word sz = hhdr -> hb_sz;
+ register int word_no;
+ register word *p, *plim;
+
+ p = (word *)(hbp->hb_body);
+ word_no = 0;
+ if (sz > MAXOBJSZ) {
+ plim = p;
+ } else {
+ plim = (word *)((((word)hbp) + HBLKSIZE) - WORDS_TO_BYTES(sz));
+ }
+ /* go through all words in block */
+ while( p <= plim ) {
+ if( mark_bit_from_hdr(hhdr, word_no)
+ && GC_HAS_DEBUG_INFO((ptr_t)p)) {
+ ptr_t clobbered = GC_check_annotated_obj((oh *)p);
+
+ if (clobbered != 0) GC_add_smashed(clobbered);
+ }
+ word_no += sz;
+ p += sz;
+ }
+}
+
+
+/* This assumes that all accessible objects are marked, and that */
+/* I hold the allocation lock. Normally called by collector. */
+void GC_check_heap_proc()
+{
+# ifndef SMALL_CONFIG
+ if (sizeof(oh) & (2 * sizeof(word) - 1) != 0) {
+ ABORT("Alignment problem: object header has inappropriate size\n");
+ }
+# endif
+ GC_apply_to_all_blocks(GC_check_heap_block, (word)0);
+}
+
+#endif /* !SHORT_DBG_HDRS */
+
+struct closure {
+ GC_finalization_proc cl_fn;
+ GC_PTR cl_data;
+};
+
+# ifdef __STDC__
+ void * GC_make_closure(GC_finalization_proc fn, void * data)
+# else
+ GC_PTR GC_make_closure(fn, data)
+ GC_finalization_proc fn;
+ GC_PTR data;
+# endif
+{
+ struct closure * result =
+# ifdef DBG_HDRS_ALL
+ (struct closure *) GC_debug_malloc(sizeof (struct closure),
+ GC_EXTRAS);
+# else
+ (struct closure *) GC_malloc(sizeof (struct closure));
+# endif
+
+ result -> cl_fn = fn;
+ result -> cl_data = data;
+ return((GC_PTR)result);
+}
+
+# ifdef __STDC__
+ void GC_debug_invoke_finalizer(void * obj, void * data)
+# else
+ void GC_debug_invoke_finalizer(obj, data)
+ char * obj;
+ char * data;
+# endif
+{
+ register struct closure * cl = (struct closure *) data;
+
+ (*(cl -> cl_fn))((GC_PTR)((char *)obj + sizeof(oh)), cl -> cl_data);
+}
+
+/* Set ofn and ocd to reflect the values we got back. */
+static void store_old (obj, my_old_fn, my_old_cd, ofn, ocd)
+GC_PTR obj;
+GC_finalization_proc my_old_fn;
+struct closure * my_old_cd;
+GC_finalization_proc *ofn;
+GC_PTR *ocd;
+{
+ if (0 != my_old_fn) {
+ if (my_old_fn != GC_debug_invoke_finalizer) {
+ GC_err_printf1("Debuggable object at 0x%lx had non-debug finalizer.\n",
+ obj);
+ /* This should probably be fatal. */
+ } else {
+ if (ofn) *ofn = my_old_cd -> cl_fn;
+ if (ocd) *ocd = my_old_cd -> cl_data;
+ }
+ } else {
+ if (ofn) *ofn = 0;
+ if (ocd) *ocd = 0;
+ }
+}
+
+# ifdef __STDC__
+ void GC_debug_register_finalizer(GC_PTR obj, GC_finalization_proc fn,
+ GC_PTR cd, GC_finalization_proc *ofn,
+ GC_PTR *ocd)
+# else
+ void GC_debug_register_finalizer(obj, fn, cd, ofn, ocd)
+ GC_PTR obj;
+ GC_finalization_proc fn;
+ GC_PTR cd;
+ GC_finalization_proc *ofn;
+ GC_PTR *ocd;
+# endif
+{
+ GC_finalization_proc my_old_fn;
+ GC_PTR my_old_cd;
+ ptr_t base = GC_base(obj);
+ if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
+ GC_err_printf1(
+ "GC_debug_register_finalizer called with non-base-pointer 0x%lx\n",
+ obj);
+ }
+ if (0 == fn) {
+ GC_register_finalizer(base, 0, 0, &my_old_fn, &my_old_cd);
+ } else {
+ GC_register_finalizer(base, GC_debug_invoke_finalizer,
+ GC_make_closure(fn,cd), &my_old_fn, &my_old_cd);
+ }
+ store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd);
+}
+
+# ifdef __STDC__
+ void GC_debug_register_finalizer_no_order
+ (GC_PTR obj, GC_finalization_proc fn,
+ GC_PTR cd, GC_finalization_proc *ofn,
+ GC_PTR *ocd)
+# else
+ void GC_debug_register_finalizer_no_order
+ (obj, fn, cd, ofn, ocd)
+ GC_PTR obj;
+ GC_finalization_proc fn;
+ GC_PTR cd;
+ GC_finalization_proc *ofn;
+ GC_PTR *ocd;
+# endif
+{
+ GC_finalization_proc my_old_fn;
+ GC_PTR my_old_cd;
+ ptr_t base = GC_base(obj);
+ if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
+ GC_err_printf1(
+ "GC_debug_register_finalizer_no_order called with non-base-pointer 0x%lx\n",
+ obj);
+ }
+ if (0 == fn) {
+ GC_register_finalizer_no_order(base, 0, 0, &my_old_fn, &my_old_cd);
+ } else {
+ GC_register_finalizer_no_order(base, GC_debug_invoke_finalizer,
+ GC_make_closure(fn,cd), &my_old_fn,
+ &my_old_cd);
+ }
+ store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd);
+ }
+
+# ifdef __STDC__
+ void GC_debug_register_finalizer_ignore_self
+ (GC_PTR obj, GC_finalization_proc fn,
+ GC_PTR cd, GC_finalization_proc *ofn,
+ GC_PTR *ocd)
+# else
+ void GC_debug_register_finalizer_ignore_self
+ (obj, fn, cd, ofn, ocd)
+ GC_PTR obj;
+ GC_finalization_proc fn;
+ GC_PTR cd;
+ GC_finalization_proc *ofn;
+ GC_PTR *ocd;
+# endif
+{
+ GC_finalization_proc my_old_fn;
+ GC_PTR my_old_cd;
+ ptr_t base = GC_base(obj);
+ if (0 == base || (ptr_t)obj - base != sizeof(oh)) {
+ GC_err_printf1(
+ "GC_debug_register_finalizer_ignore_self called with non-base-pointer 0x%lx\n",
+ obj);
+ }
+ if (0 == fn) {
+ GC_register_finalizer_ignore_self(base, 0, 0, &my_old_fn, &my_old_cd);
+ } else {
+ GC_register_finalizer_ignore_self(base, GC_debug_invoke_finalizer,
+ GC_make_closure(fn,cd), &my_old_fn,
+ &my_old_cd);
+ }
+ store_old(obj, my_old_fn, (struct closure *)my_old_cd, ofn, ocd);
+}
+
+#ifdef GC_ADD_CALLER
+# define RA GC_RETURN_ADDR,
+#else
+# define RA
+#endif
+
+GC_PTR GC_debug_malloc_replacement(lb)
+size_t lb;
+{
+ return GC_debug_malloc(lb, RA "unknown", 0);
+}
+
+GC_PTR GC_debug_realloc_replacement(p, lb)
+GC_PTR p;
+size_t lb;
+{
+ return GC_debug_realloc(p, lb, RA "unknown", 0);
+}
--- /dev/null
+#! /bin/sh
+
+# depcomp - compile a program generating dependencies as side-effects
+# Copyright 1999, 2000 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Originally written by Alexandre Oliva <oliva@dcc.unicamp.br>.
+
+if test -z "$depmode" || test -z "$source" || test -z "$object"; then
+ echo "depcomp: Variables source, object and depmode must be set" 1>&2
+ exit 1
+fi
+# `libtool' can also be set to `yes' or `no'.
+
+if test -z "$depfile"; then
+ base=`echo "$object" | sed -e 's,^.*/,,' -e 's,\.\([^.]*\)$,.P\1,'`
+ dir=`echo "$object" | sed 's,/.*$,/,'`
+ if test "$dir" = "$object"; then
+ dir=
+ fi
+ # FIXME: should be _deps on DOS.
+ depfile="$dir.deps/$base"
+fi
+
+tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`}
+
+rm -f "$tmpdepfile"
+
+# Some modes work just like other modes, but use different flags. We
+# parameterize here, but still list the modes in the big case below,
+# to make depend.m4 easier to write. Note that we *cannot* use a case
+# here, because this file can only contain one case statement.
+if test "$depmode" = hp; then
+ # HP compiler uses -M and no extra arg.
+ gccflag=-M
+ depmode=gcc
+fi
+
+if test "$depmode" = dashXmstdout; then
+ # This is just like dashmstdout with a different argument.
+ dashmflag=-xM
+ depmode=dashmstdout
+fi
+
+case "$depmode" in
+gcc3)
+## gcc 3 implements dependency tracking that does exactly what
+## we want. Yay! Note: for some reason libtool 1.4 doesn't like
+## it if -MD -MP comes after the -MF stuff. Hmm.
+ "$@" -MT "$object" -MD -MP -MF "$tmpdepfile"
+ stat=$?
+ if test $stat -eq 0; then :
+ else
+ rm -f "$tmpdepfile"
+ exit $stat
+ fi
+ mv "$tmpdepfile" "$depfile"
+ ;;
+
+gcc)
+## There are various ways to get dependency output from gcc. Here's
+## why we pick this rather obscure method:
+## - Don't want to use -MD because we'd like the dependencies to end
+## up in a subdir. Having to rename by hand is ugly.
+## (We might end up doing this anyway to support other compilers.)
+## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like
+## -MM, not -M (despite what the docs say).
+## - Using -M directly means running the compiler twice (even worse
+## than renaming).
+ if test -z "$gccflag"; then
+ gccflag=-MD,
+ fi
+ "$@" -Wp,"$gccflag$tmpdepfile"
+ stat=$?
+ if test $stat -eq 0; then :
+ else
+ rm -f "$tmpdepfile"
+ exit $stat
+ fi
+ rm -f "$depfile"
+ echo "$object : \\" > "$depfile"
+ alpha=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz
+## The second -e expression handles DOS-style file names with drive letters.
+ sed -e 's/^[^:]*: / /' \
+ -e 's/^['$alpha']:\/[^:]*: / /' < "$tmpdepfile" >> "$depfile"
+## This next piece of magic avoids the `deleted header file' problem.
+## The problem is that when a header file which appears in a .P file
+## is deleted, the dependency causes make to die (because there is
+## typically no way to rebuild the header). We avoid this by adding
+## dummy dependencies for each header file. Too bad gcc doesn't do
+## this for us directly.
+ tr ' ' '
+' < "$tmpdepfile" |
+## Some versions of gcc put a space before the `:'. On the theory
+## that the space means something, we add a space to the output as
+## well.
+## Some versions of the HPUX 10.20 sed can't process this invocation
+## correctly. Breaking it into two sed invocations is a workaround.
+ sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
+ rm -f "$tmpdepfile"
+ ;;
+
+hp)
+ # This case exists only to let depend.m4 do its work. It works by
+ # looking at the text of this script. This case will never be run,
+ # since it is checked for above.
+ exit 1
+ ;;
+
+sgi)
+ if test "$libtool" = yes; then
+ "$@" "-Wp,-MDupdate,$tmpdepfile"
+ else
+ "$@" -MDupdate "$tmpdepfile"
+ fi
+ stat=$?
+ if test $stat -eq 0; then :
+ else
+ rm -f "$tmpdepfile"
+ exit $stat
+ fi
+ rm -f "$depfile"
+
+ if test -f "$tmpdepfile"; then # yes, the sourcefile depend on other files
+ echo "$object : \\" > "$depfile"
+
+ # Clip off the initial element (the dependent). Don't try to be
+ # clever and replace this with sed code, as IRIX sed won't handle
+ # lines with more than a fixed number of characters (4096 in
+ # IRIX 6.2 sed, 8192 in IRIX 6.5). We also remove comment lines;
+ # the IRIX cc adds comments like `#:fec' to the end of the
+ # dependency line.
+ tr ' ' '
+' < "$tmpdepfile" \
+ | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' | \
+ tr '
+' ' ' >> $depfile
+ echo >> $depfile
+
+ # The second pass generates a dummy entry for each header file.
+ tr ' ' '
+' < "$tmpdepfile" \
+ | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' -e 's/$/:/' \
+ >> $depfile
+ else
+ # The sourcefile does not contain any dependencies, so just
+ # store a dummy comment line, to avoid errors with the Makefile
+ # "include basename.Plo" scheme.
+ echo "#dummy" > "$depfile"
+ fi
+ rm -f "$tmpdepfile"
+ ;;
+
+aix)
+ # The C for AIX Compiler uses -M and outputs the dependencies
+ # in a .u file. This file always lives in the current directory.
+ # Also, the AIX compiler puts `$object:' at the start of each line;
+ # $object doesn't have directory information.
+ stripped=`echo "$object" | sed -e 's,^.*/,,' -e 's/\(.*\)\..*$/\1/'`
+ tmpdepfile="$stripped.u"
+ outname="$stripped.o"
+ if test "$libtool" = yes; then
+ "$@" -Wc,-M
+ else
+ "$@" -M
+ fi
+
+ stat=$?
+ if test $stat -eq 0; then :
+ else
+ rm -f "$tmpdepfile"
+ exit $stat
+ fi
+
+ if test -f "$tmpdepfile"; then
+ # Each line is of the form `foo.o: dependent.h'.
+ # Do two passes, one to just change these to
+ # `$object: dependent.h' and one to simply `dependent.h:'.
+ sed -e "s,^$outname:,$object :," < "$tmpdepfile" > "$depfile"
+ sed -e "s,^$outname: \(.*\)$,\1:," < "$tmpdepfile" >> "$depfile"
+ else
+ # The sourcefile does not contain any dependencies, so just
+ # store a dummy comment line, to avoid errors with the Makefile
+ # "include basename.Plo" scheme.
+ echo "#dummy" > "$depfile"
+ fi
+ rm -f "$tmpdepfile"
+ ;;
+
+tru64)
+ # The Tru64 compiler uses -MD to generate dependencies as a side
+ # effect. `cc -MD -o foo.o ...' puts the dependencies into `foo.o.d'.
+ # At least on Alpha/Redhat 6.1, Compaq CCC V6.2-504 seems to put
+ # dependencies in `foo.d' instead, so we check for that too.
+ # Subdirectories are respected.
+
+ base=`echo "$object" | sed -e 's/\.o$//' -e 's/\.lo$//'`
+ tmpdepfile1="$base.o.d"
+ tmpdepfile2="$base.d"
+ if test "$libtool" = yes; then
+ "$@" -Wc,-MD
+ else
+ "$@" -MD
+ fi
+
+ stat=$?
+ if test $stat -eq 0; then :
+ else
+ rm -f "$tmpdepfile1" "$tmpdepfile2"
+ exit $stat
+ fi
+
+ if test -f "$tmpdepfile1"; then
+ tmpdepfile="$tmpdepfile1"
+ else
+ tmpdepfile="$tmpdepfile2"
+ fi
+ if test -f "$tmpdepfile"; then
+ sed -e "s,^.*\.[a-z]*:,$object:," < "$tmpdepfile" > "$depfile"
+ # That's a space and a tab in the [].
+ sed -e 's,^.*\.[a-z]*:[ ]*,,' -e 's,$,:,' < "$tmpdepfile" >> "$depfile"
+ else
+ echo "#dummy" > "$depfile"
+ fi
+ rm -f "$tmpdepfile"
+ ;;
+
+#nosideeffect)
+ # This comment above is used by automake to tell side-effect
+ # dependency tracking mechanisms from slower ones.
+
+dashmstdout)
+ # Important note: in order to support this mode, a compiler *must*
+ # always write the proprocessed file to stdout, regardless of -o,
+ # because we must use -o when running libtool.
+ test -z "$dashmflag" && dashmflag=-M
+ ( IFS=" "
+ case " $* " in
+ *" --mode=compile "*) # this is libtool, let us make it quiet
+ for arg
+ do # cycle over the arguments
+ case "$arg" in
+ "--mode=compile")
+ # insert --quiet before "--mode=compile"
+ set fnord "$@" --quiet
+ shift # fnord
+ ;;
+ esac
+ set fnord "$@" "$arg"
+ shift # fnord
+ shift # "$arg"
+ done
+ ;;
+ esac
+ "$@" $dashmflag | sed 's:^[^:]*\:[ ]*:'"$object"'\: :' > "$tmpdepfile"
+ ) &
+ proc=$!
+ "$@"
+ stat=$?
+ wait "$proc"
+ if test "$stat" != 0; then exit $stat; fi
+ rm -f "$depfile"
+ cat < "$tmpdepfile" > "$depfile"
+ tr ' ' '
+' < "$tmpdepfile" | \
+## Some versions of the HPUX 10.20 sed can't process this invocation
+## correctly. Breaking it into two sed invocations is a workaround.
+ sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
+ rm -f "$tmpdepfile"
+ ;;
+
+dashXmstdout)
+ # This case only exists to satisfy depend.m4. It is never actually
+ # run, as this mode is specially recognized in the preamble.
+ exit 1
+ ;;
+
+makedepend)
+ # X makedepend
+ (
+ shift
+ cleared=no
+ for arg in "$@"; do
+ case $cleared in no)
+ set ""; shift
+ cleared=yes
+ esac
+ case "$arg" in
+ -D*|-I*)
+ set fnord "$@" "$arg"; shift;;
+ -*)
+ ;;
+ *)
+ set fnord "$@" "$arg"; shift;;
+ esac
+ done
+ obj_suffix="`echo $object | sed 's/^.*\././'`"
+ touch "$tmpdepfile"
+ ${MAKEDEPEND-makedepend} 2>/dev/null -o"$obj_suffix" -f"$tmpdepfile" "$@"
+ ) &
+ proc=$!
+ "$@"
+ stat=$?
+ wait "$proc"
+ if test "$stat" != 0; then exit $stat; fi
+ rm -f "$depfile"
+ cat < "$tmpdepfile" > "$depfile"
+ sed '1,2d' "$tmpdepfile" | tr ' ' '
+' | \
+## Some versions of the HPUX 10.20 sed can't process this invocation
+## correctly. Breaking it into two sed invocations is a workaround.
+ sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
+ rm -f "$tmpdepfile" "$tmpdepfile".bak
+ ;;
+
+cpp)
+ # Important note: in order to support this mode, a compiler *must*
+ # always write the proprocessed file to stdout, regardless of -o,
+ # because we must use -o when running libtool.
+ ( IFS=" "
+ case " $* " in
+ *" --mode=compile "*)
+ for arg
+ do # cycle over the arguments
+ case $arg in
+ "--mode=compile")
+ # insert --quiet before "--mode=compile"
+ set fnord "$@" --quiet
+ shift # fnord
+ ;;
+ esac
+ set fnord "$@" "$arg"
+ shift # fnord
+ shift # "$arg"
+ done
+ ;;
+ esac
+ "$@" -E |
+ sed -n '/^# [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' |
+ sed '$ s: \\$::' > "$tmpdepfile"
+ ) &
+ proc=$!
+ "$@"
+ stat=$?
+ wait "$proc"
+ if test "$stat" != 0; then exit $stat; fi
+ rm -f "$depfile"
+ echo "$object : \\" > "$depfile"
+ cat < "$tmpdepfile" >> "$depfile"
+ sed < "$tmpdepfile" '/^$/d;s/^ //;s/ \\$//;s/$/ :/' >> "$depfile"
+ rm -f "$tmpdepfile"
+ ;;
+
+msvisualcpp)
+ # Important note: in order to support this mode, a compiler *must*
+ # always write the proprocessed file to stdout, regardless of -o,
+ # because we must use -o when running libtool.
+ ( IFS=" "
+ case " $* " in
+ *" --mode=compile "*)
+ for arg
+ do # cycle over the arguments
+ case $arg in
+ "--mode=compile")
+ # insert --quiet before "--mode=compile"
+ set fnord "$@" --quiet
+ shift # fnord
+ ;;
+ esac
+ set fnord "$@" "$arg"
+ shift # fnord
+ shift # "$arg"
+ done
+ ;;
+ esac
+ for arg
+ do
+ case "$arg" in
+ "-Gm"|"/Gm"|"-Gi"|"/Gi"|"-ZI"|"/ZI")
+ set fnord "$@"
+ shift
+ shift
+ ;;
+ *)
+ set fnord "$@" "$arg"
+ shift
+ shift
+ ;;
+ esac
+ done
+ "$@" -E |
+ sed -n '/^#line [0-9][0-9]* "\([^"]*\)"/ s::echo "`cygpath -u \\"\1\\"`":p' | sort | uniq > "$tmpdepfile"
+ ) &
+ proc=$!
+ "$@"
+ stat=$?
+ wait "$proc"
+ if test "$stat" != 0; then exit $stat; fi
+ rm -f "$depfile"
+ echo "$object : \\" > "$depfile"
+ . "$tmpdepfile" | sed 's% %\\ %g' | sed -n '/^\(.*\)$/ s:: \1 \\:p' >> "$depfile"
+ echo " " >> "$depfile"
+ . "$tmpdepfile" | sed 's% %\\ %g' | sed -n '/^\(.*\)$/ s::\1\::p' >> "$depfile"
+ rm -f "$tmpdepfile"
+ ;;
+
+none)
+ exec "$@"
+ ;;
+
+*)
+ echo "Unknown depmode $depmode" 1>&2
+ exit 1
+ ;;
+esac
+
+exit 0
--- /dev/null
+# Makefile to build Hans Boehm garbage collector using the Digital Mars\r
+# compiler from www.digitalmars.com\r
+# Written by Walter Bright\r
+\r
+\r
+DEFINES=-DNDEBUG -DSILENT -DGC_BUILD -D_WINDOWS -DGC_DLL -DALL_INTERIOR_POINTERS -D__STDC__ -DWIN32_THREADS\r
+CFLAGS=-Iinclude $(DEFINES) -wx -g\r
+LFLAGS=/ma/implib/co\r
+CC=sc\r
+\r
+.c.obj:\r
+ $(CC) -c $(CFLAGS) $*\r
+\r
+.cpp.obj:\r
+ $(CC) -c $(CFLAGS) -Aa $*\r
+\r
+OBJS= \\r
+ allchblk.obj\\r
+ alloc.obj\\r
+ blacklst.obj\\r
+ checksums.obj\\r
+ dbg_mlc.obj\\r
+ dyn_load.obj\\r
+ finalize.obj\\r
+ gc_cpp.obj\\r
+ headers.obj\\r
+ mach_dep.obj\\r
+ malloc.obj\\r
+ mallocx.obj\\r
+ mark.obj\\r
+ mark_rts.obj\\r
+ misc.obj\\r
+ new_hblk.obj\\r
+ obj_map.obj\\r
+ os_dep.obj\\r
+ ptr_chck.obj\\r
+ reclaim.obj\\r
+ stubborn.obj\\r
+ typd_mlc.obj\\r
+ win32_threads.obj\r
+\r
+targets: gc.dll gc.lib gctest.exe\r
+\r
+gc.dll: $(OBJS) gc.def digimars.mak\r
+ sc -ogc.dll $(OBJS) -L$(LFLAGS) gc.def kernel32.lib user32.lib\r
+\r
+gc.def: digimars.mak\r
+ echo LIBRARY GC >gc.def\r
+ echo DESCRIPTION "Hans Boehm Garbage Collector" >>gc.def\r
+ echo EXETYPE NT >>gc.def\r
+ echo EXPORTS >>gc.def\r
+ echo GC_is_visible_print_proc >>gc.def\r
+ echo GC_is_valid_displacement_print_proc >>gc.def\r
+\r
+clean:\r
+ del gc.def\r
+ del $(OBJS)\r
+\r
+\r
+gctest.exe : gc.lib tests\test.obj\r
+ sc -ogctest.exe tests\test.obj gc.lib\r
+\r
+tests\test.obj : tests\test.c\r
+ $(CC) -c -g -DNDEBUG -DSILENT -DGC_BUILD -D_WINDOWS -DGC_DLL \\r
+ -DALL_INTERIOR_POINTERS -DWIN32_THREADS \\r
+ -Iinclude tests\test.c -otests\test.obj\r
+\r
+allchblk.obj: allchblk.c\r
+alloc.obj: alloc.c\r
+blacklst.obj: blacklst.c\r
+checksums.obj: checksums.c\r
+dbg_mlc.obj: dbg_mlc.c\r
+dyn_load.obj: dyn_load.c\r
+finalize.obj: finalize.c\r
+gc_cpp.obj: gc_cpp.cpp\r
+headers.obj: headers.c\r
+mach_dep.obj: mach_dep.c\r
+malloc.obj: malloc.c\r
+mallocx.obj: mallocx.c\r
+mark.obj: mark.c\r
+mark_rts.obj: mark_rts.c\r
+misc.obj: misc.c\r
+new_hblk.obj: new_hblk.c\r
+obj_map.obj: obj_map.c\r
+os_dep.obj: os_dep.c\r
+ptr_chck.obj: ptr_chck.c\r
+reclaim.obj: reclaim.c\r
+stubborn.obj: stubborn.c\r
+typd_mlc.obj: typd_mlc.c\r
+win32_threads.obj: win32_threads.c\r
--- /dev/null
+#
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+
+## Process this file with automake to produce Makefile.in.
+
+# installed documentation
+#
+dist_pkgdata_DATA = barrett_diagram debugging.html gc.man \
+ gcdescr.html README README.amiga README.arm.cross \
+ README.autoconf README.changes README.contributors \
+ README.cords README.DGUX386 README.dj README.environment \
+ README.ews4800 README.hp README.linux README.Mac \
+ README.MacOSX README.macros README.OS2 README.rs6000 \
+ README.sgi README.solaris2 README.uts README.win32 \
+ tree.html leak.html gcinterface.html scale.html
+
--- /dev/null
+# Makefile.in generated by automake 1.6.3 from Makefile.am.
+# @configure_input@
+
+# Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+# Free Software Foundation, Inc.
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+#
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+SHELL = @SHELL@
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+bindir = @bindir@
+sbindir = @sbindir@
+libexecdir = @libexecdir@
+datadir = @datadir@
+sysconfdir = @sysconfdir@
+sharedstatedir = @sharedstatedir@
+localstatedir = @localstatedir@
+libdir = @libdir@
+infodir = @infodir@
+mandir = @mandir@
+includedir = @includedir@
+oldincludedir = /usr/include
+pkgdatadir = $(datadir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+top_builddir = ..
+
+ACLOCAL = @ACLOCAL@
+AUTOCONF = @AUTOCONF@
+AUTOMAKE = @AUTOMAKE@
+AUTOHEADER = @AUTOHEADER@
+
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = @program_transform_name@
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+host_alias = @host_alias@
+host_triplet = @host@
+
+EXEEXT = @EXEEXT@
+OBJEXT = @OBJEXT@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+CCASFLAGS = @CCASFLAGS@
+CFLAGS = @CFLAGS@
+CXX = @CXX@
+CXXFLAGS = @CXXFLAGS@
+CXXINCLUDES = @CXXINCLUDES@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+ECHO = @ECHO@
+EXTRA_TEST_LIBS = @EXTRA_TEST_LIBS@
+GC_CFLAGS = @GC_CFLAGS@
+GC_VERSION = @GC_VERSION@
+INCLUDES = @INCLUDES@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+MAINT = @MAINT@
+MY_CFLAGS = @MY_CFLAGS@
+OBJDUMP = @OBJDUMP@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+STRIP = @STRIP@
+THREADLIBS = @THREADLIBS@
+VERSION = @VERSION@
+addincludes = @addincludes@
+addobjs = @addobjs@
+addtests = @addtests@
+am__include = @am__include@
+am__quote = @am__quote@
+install_sh = @install_sh@
+target_all = @target_all@
+
+# installed documentation
+#
+dist_pkgdata_DATA = barrett_diagram debugging.html gc.man \
+ gcdescr.html README README.amiga README.arm.cross \
+ README.autoconf README.changes README.contributors \
+ README.cords README.DGUX386 README.dj README.environment \
+ README.ews4800 README.hp README.linux README.Mac \
+ README.MacOSX README.macros README.OS2 README.rs6000 \
+ README.sgi README.solaris2 README.uts README.win32 \
+ tree.html leak.html gcinterface.html scale.html
+
+subdir = doc
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_CLEAN_FILES =
+DIST_SOURCES =
+DATA = $(dist_pkgdata_DATA)
+
+DIST_COMMON = README $(dist_pkgdata_DATA) Makefile.am Makefile.in
+all: all-am
+
+.SUFFIXES:
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4)
+ cd $(top_srcdir) && \
+ $(AUTOMAKE) --gnu doc/Makefile
+Makefile: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.in $(top_builddir)/config.status
+ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)
+
+mostlyclean-libtool:
+ -rm -f *.lo
+
+clean-libtool:
+ -rm -rf .libs _libs
+
+distclean-libtool:
+ -rm -f libtool
+uninstall-info-am:
+dist_pkgdataDATA_INSTALL = $(INSTALL_DATA)
+install-dist_pkgdataDATA: $(dist_pkgdata_DATA)
+ @$(NORMAL_INSTALL)
+ $(mkinstalldirs) $(DESTDIR)$(pkgdatadir)
+ @list='$(dist_pkgdata_DATA)'; for p in $$list; do \
+ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+ f="`echo $$p | sed -e 's|^.*/||'`"; \
+ echo " $(dist_pkgdataDATA_INSTALL) $$d$$p $(DESTDIR)$(pkgdatadir)/$$f"; \
+ $(dist_pkgdataDATA_INSTALL) $$d$$p $(DESTDIR)$(pkgdatadir)/$$f; \
+ done
+
+uninstall-dist_pkgdataDATA:
+ @$(NORMAL_UNINSTALL)
+ @list='$(dist_pkgdata_DATA)'; for p in $$list; do \
+ f="`echo $$p | sed -e 's|^.*/||'`"; \
+ echo " rm -f $(DESTDIR)$(pkgdatadir)/$$f"; \
+ rm -f $(DESTDIR)$(pkgdatadir)/$$f; \
+ done
+tags: TAGS
+TAGS:
+
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+top_distdir = ..
+distdir = $(top_distdir)/$(PACKAGE)-$(VERSION)
+
+distdir: $(DISTFILES)
+ @list='$(DISTFILES)'; for file in $$list; do \
+ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
+ dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \
+ if test "$$dir" != "$$file" && test "$$dir" != "."; then \
+ dir="/$$dir"; \
+ $(mkinstalldirs) "$(distdir)$$dir"; \
+ else \
+ dir=''; \
+ fi; \
+ if test -d $$d/$$file; then \
+ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
+ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \
+ fi; \
+ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \
+ else \
+ test -f $(distdir)/$$file \
+ || cp -p $$d/$$file $(distdir)/$$file \
+ || exit 1; \
+ fi; \
+ done
+check-am: all-am
+check: check-am
+all-am: Makefile $(DATA)
+
+installdirs:
+ $(mkinstalldirs) $(DESTDIR)$(pkgdatadir)
+
+install: install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+ @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+ $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+ INSTALL_STRIP_FLAG=-s \
+ `test -z '$(STRIP)' || \
+ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+ -rm -f Makefile $(CONFIG_CLEAN_FILES)
+
+maintainer-clean-generic:
+ @echo "This command is intended for maintainers to use"
+ @echo "it deletes files that may require special tools to rebuild."
+clean: clean-am
+
+clean-am: clean-generic clean-libtool mostlyclean-am
+
+distclean: distclean-am
+
+distclean-am: clean-am distclean-generic distclean-libtool
+
+dvi: dvi-am
+
+dvi-am:
+
+info: info-am
+
+info-am:
+
+install-data-am: install-dist_pkgdataDATA
+
+install-exec-am:
+
+install-info: install-info-am
+
+install-man:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-generic mostlyclean-libtool
+
+uninstall-am: uninstall-dist_pkgdataDATA uninstall-info-am
+
+.PHONY: all all-am check check-am clean clean-generic clean-libtool \
+ distclean distclean-generic distclean-libtool distdir dvi \
+ dvi-am info info-am install install-am install-data \
+ install-data-am install-dist_pkgdataDATA install-exec \
+ install-exec-am install-info install-info-am install-man \
+ install-strip installcheck installcheck-am installdirs \
+ maintainer-clean maintainer-clean-generic mostlyclean \
+ mostlyclean-generic mostlyclean-libtool uninstall uninstall-am \
+ uninstall-dist_pkgdataDATA uninstall-info-am
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
--- /dev/null
+Copyright (c) 1988, 1989 Hans-J. Boehm, Alan J. Demers
+Copyright (c) 1991-1996 by Xerox Corporation. All rights reserved.
+Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved.
+Copyright (c) 1999-2001 by Hewlett-Packard Company. All rights reserved.
+
+The file linux_threads.c is also
+Copyright (c) 1998 by Fergus Henderson. All rights reserved.
+
+The files Makefile.am, and configure.in are
+Copyright (c) 2001 by Red Hat Inc. All rights reserved.
+
+Several files supporting GNU-style builds are copyrighted by the Free
+Software Foundation, and carry a different license from that given
+below.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+
+Permission is hereby granted to use or copy this program
+for any purpose, provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is granted,
+provided the above notices are retained, and a notice that the code was
+modified is included with the above copyright notice.
+
+A few of the files needed to use the GNU-style build procedure come with
+slightly different licenses, though they are all similar in spirit. A few
+are GPL'ed, but with an exception that should cover all uses in the
+collector. (If you are concerned about such things, I recommend you look
+at the notice in config.guess or ltmain.sh.)
+
+This is version 6.2alpha3 of a conservative garbage collector for C and C++.
+
+You might find a more recent version of this at
+
+http://www.hpl.hp.com/personal/Hans_Boehm/gc
+
+OVERVIEW
+
+ This is intended to be a general purpose, garbage collecting storage
+allocator. The algorithms used are described in:
+
+Boehm, H., and M. Weiser, "Garbage Collection in an Uncooperative Environment",
+Software Practice & Experience, September 1988, pp. 807-820.
+
+Boehm, H., A. Demers, and S. Shenker, "Mostly Parallel Garbage Collection",
+Proceedings of the ACM SIGPLAN '91 Conference on Programming Language Design
+and Implementation, SIGPLAN Notices 26, 6 (June 1991), pp. 157-164.
+
+Boehm, H., "Space Efficient Conservative Garbage Collection", Proceedings
+of the ACM SIGPLAN '91 Conference on Programming Language Design and
+Implementation, SIGPLAN Notices 28, 6 (June 1993), pp. 197-206.
+
+Boehm H., "Reducing Garbage Collector Cache Misses", Proceedings of the
+2000 International Symposium on Memory Management.
+
+ Possible interactions between the collector and optimizing compilers are
+discussed in
+
+Boehm, H., and D. Chase, "A Proposal for GC-safe C Compilation",
+The Journal of C Language Translation 4, 2 (December 1992).
+
+and
+
+Boehm H., "Simple GC-safe Compilation", Proceedings
+of the ACM SIGPLAN '96 Conference on Programming Language Design and
+Implementation.
+
+(Some of these are also available from
+http://www.hpl.hp.com/personal/Hans_Boehm/papers/, among other places.)
+
+ Unlike the collector described in the second reference, this collector
+operates either with the mutator stopped during the entire collection
+(default) or incrementally during allocations. (The latter is supported
+on only a few machines.) On the most common platforms, it can be built
+with or without thread support. On a few platforms, it can take advantage
+of a multiprocessor to speed up garbage collection.
+
+ Many of the ideas underlying the collector have previously been explored
+by others. Notably, some of the run-time systems developed at Xerox PARC
+in the early 1980s conservatively scanned thread stacks to locate possible
+pointers (cf. Paul Rovner, "On Adding Garbage Collection and Runtime Types
+to a Strongly-Typed Statically Checked, Concurrent Language" Xerox PARC
+CSL 84-7). Doug McIlroy wrote a simpler fully conservative collector that
+was part of version 8 UNIX (tm), but appears to not have received
+widespread use.
+
+ Rudimentary tools for use of the collector as a leak detector are included
+(see http://www.hpl.hp.com/personal/Hans_Boehm/gc/leak.html),
+as is a fairly sophisticated string package "cord" that makes use of the
+collector. (See doc/README.cords and H.-J. Boehm, R. Atkinson, and M. Plass,
+"Ropes: An Alternative to Strings", Software Practice and Experience 25, 12
+(December 1995), pp. 1315-1330. This is very similar to the "rope" package
+in Xerox Cedar, or the "rope" package in the SGI STL or the g++ distribution.)
+
+Further collector documantation can be found at
+
+http://www.hpl.hp.com/personal/Hans_Boehm/gc
+
+
+GENERAL DESCRIPTION
+
+ This is a garbage collecting storage allocator that is intended to be
+used as a plug-in replacement for C's malloc.
+
+ Since the collector does not require pointers to be tagged, it does not
+attempt to ensure that all inaccessible storage is reclaimed. However,
+in our experience, it is typically more successful at reclaiming unused
+memory than most C programs using explicit deallocation. Unlike manually
+introduced leaks, the amount of unreclaimed memory typically stays
+bounded.
+
+ In the following, an "object" is defined to be a region of memory allocated
+by the routines described below.
+
+ Any objects not intended to be collected must be pointed to either
+from other such accessible objects, or from the registers,
+stack, data, or statically allocated bss segments. Pointers from
+the stack or registers may point to anywhere inside an object.
+The same is true for heap pointers if the collector is compiled with
+ ALL_INTERIOR_POINTERS defined, as is now the default.
+
+Compiling without ALL_INTERIOR_POINTERS may reduce accidental retention
+of garbage objects, by requiring pointers from the heap to to the beginning
+of an object. But this no longer appears to be a significant
+issue for most programs.
+
+There are a number of routines which modify the pointer recognition
+algorithm. GC_register_displacement allows certain interior pointers
+to be recognized even if ALL_INTERIOR_POINTERS is nor defined.
+GC_malloc_ignore_off_page allows some pointers into the middle of large objects
+to be disregarded, greatly reducing the probablility of accidental
+retention of large objects. For most purposes it seems best to compile
+with ALL_INTERIOR_POINTERS and to use GC_malloc_ignore_off_page if
+you get collector warnings from allocations of very large objects.
+See README.debugging for details.
+
+ WARNING: pointers inside memory allocated by the standard "malloc" are not
+seen by the garbage collector. Thus objects pointed to only from such a
+region may be prematurely deallocated. It is thus suggested that the
+standard "malloc" be used only for memory regions, such as I/O buffers, that
+are guaranteed not to contain pointers to garbage collectable memory.
+Pointers in C language automatic, static, or register variables,
+are correctly recognized. (Note that GC_malloc_uncollectable has semantics
+similar to standard malloc, but allocates objects that are traced by the
+collector.)
+
+ WARNING: the collector does not always know how to find pointers in data
+areas that are associated with dynamic libraries. This is easy to
+remedy IF you know how to find those data areas on your operating
+system (see GC_add_roots). Code for doing this under SunOS, IRIX 5.X and 6.X,
+HP/UX, Alpha OSF/1, Linux, and win32 is included and used by default. (See
+README.win32 for win32 details.) On other systems pointers from dynamic
+library data areas may not be considered by the collector.
+If you're writing a program that depends on the collector scanning
+dynamic library data areas, it may be a good idea to include at least
+one call to GC_is_visible() to ensure that those areas are visible
+to the collector.
+
+ Note that the garbage collector does not need to be informed of shared
+read-only data. However if the shared library mechanism can introduce
+discontiguous data areas that may contain pointers, then the collector does
+need to be informed.
+
+ Signal processing for most signals may be deferred during collection,
+and during uninterruptible parts of the allocation process.
+Like standard ANSI C mallocs, by default it is unsafe to invoke
+malloc (and other GC routines) from a signal handler while another
+malloc call may be in progress. Removing -DNO_SIGNALS from Makefile
+attempts to remedy that. But that may not be reliable with a compiler that
+substantially reorders memory operations inside GC_malloc.
+
+ The allocator/collector can also be configured for thread-safe operation.
+(Full signal safety can also be achieved, but only at the cost of two system
+calls per malloc, which is usually unacceptable.)
+WARNING: the collector does not guarantee to scan thread-local storage
+(e.g. of the kind accessed with pthread_getspecific()). The collector
+does scan thread stacks, though, so generally the best solution is to
+ensure that any pointers stored in thread-local storage are also
+stored on the thread's stack for the duration of their lifetime.
+(This is arguably a longstanding bug, but it hasn't been fixed yet.)
+
+INSTALLATION AND PORTABILITY
+
+ As distributed, the macro SILENT is defined in Makefile.
+In the event of problems, this can be removed to obtain a moderate
+amount of descriptive output for each collection.
+(The given statistics exhibit a few peculiarities.
+Things don't appear to add up for a variety of reasons, most notably
+fragmentation losses. These are probably much more significant for the
+contrived program "test.c" than for your application.)
+
+ Note that typing "make test" will automatically build the collector
+and then run setjmp_test and gctest. Setjmp_test will give you information
+about configuring the collector, which is useful primarily if you have
+a machine that's not already supported. Gctest is a somewhat superficial
+test of collector functionality. Failure is indicated by a core dump or
+a message to the effect that the collector is broken. Gctest takes about
+35 seconds to run on a SPARCstation 2. It may use up to 8 MB of memory. (The
+multi-threaded version will use more. 64-bit versions may use more.)
+"Make test" will also, as its last step, attempt to build and test the
+"cord" string library. This will fail without an ANSI C compiler, but
+the garbage collector itself should still be usable.
+
+ The Makefile will generate a library gc.a which you should link against.
+Typing "make cords" will add the cord library to gc.a.
+Note that this requires an ANSI C compiler.
+
+ It is suggested that if you need to replace a piece of the collector
+(e.g. GC_mark_rts.c) you simply list your version ahead of gc.a on the
+ld command line, rather than replacing the one in gc.a. (This will
+generate numerous warnings under some versions of AIX, but it still
+works.)
+
+ All include files that need to be used by clients will be put in the
+include subdirectory. (Normally this is just gc.h. "Make cords" adds
+"cord.h" and "ec.h".)
+
+ The collector currently is designed to run essentially unmodified on
+machines that use a flat 32-bit or 64-bit address space.
+That includes the vast majority of Workstations and X86 (X >= 3) PCs.
+(The list here was deleted because it was getting too long and constantly
+out of date.)
+ It does NOT run under plain 16-bit DOS or Windows 3.X. There are however
+various packages (e.g. win32s, djgpp) that allow flat 32-bit address
+applications to run under those systemsif the have at least an 80386 processor,
+and several of those are compatible with the collector.
+
+ In a few cases (Amiga, OS/2, Win32, MacOS) a separate makefile
+or equivalent is supplied. Many of these have separate README.system
+files.
+
+ Dynamic libraries are completely supported only under SunOS/Solaris,
+(and even that support is not functional on the last Sun 3 release),
+Linux, FreeBSD, NetBSD, IRIX 5&6, HP/UX, Win32 (not Win32S) and OSF/1
+on DEC AXP machines plus perhaps a few others listed near the top
+of dyn_load.c. On other machines we recommend that you do one of
+the following:
+
+ 1) Add dynamic library support (and send us the code).
+ 2) Use static versions of the libraries.
+ 3) Arrange for dynamic libraries to use the standard malloc.
+ This is still dangerous if the library stores a pointer to a
+ garbage collected object. But nearly all standard interfaces
+ prohibit this, because they deal correctly with pointers
+ to stack allocated objects. (Strtok is an exception. Don't
+ use it.)
+
+ In all cases we assume that pointer alignment is consistent with that
+enforced by the standard C compilers. If you use a nonstandard compiler
+you may have to adjust the alignment parameters defined in gc_priv.h.
+Note that this may also be an issue with packed records/structs, if those
+enforce less alignment for pointers.
+
+ A port to a machine that is not byte addressed, or does not use 32 bit
+or 64 bit addresses will require a major effort. A port to plain MSDOS
+or win16 is hard.
+
+ For machines not already mentioned, or for nonstandard compilers, the
+following are likely to require change:
+
+1. The parameters in gcconfig.h.
+ The parameters that will usually require adjustment are
+ STACKBOTTOM, ALIGNMENT and DATASTART. Setjmp_test
+ prints its guesses of the first two.
+ DATASTART should be an expression for computing the
+ address of the beginning of the data segment. This can often be
+ &etext. But some memory management units require that there be
+ some unmapped space between the text and the data segment. Thus
+ it may be more complicated. On UNIX systems, this is rarely
+ documented. But the adb "$m" command may be helpful. (Note
+ that DATASTART will usually be a function of &etext. Thus a
+ single experiment is usually insufficient.)
+ STACKBOTTOM is used to initialize GC_stackbottom, which
+ should be a sufficient approximation to the coldest stack address.
+ On some machines, it is difficult to obtain such a value that is
+ valid across a variety of MMUs, OS releases, etc. A number of
+ alternatives exist for using the collector in spite of this. See the
+ discussion in gcconfig.h immediately preceding the various
+ definitions of STACKBOTTOM.
+
+2. mach_dep.c.
+ The most important routine here is one to mark from registers.
+ The distributed file includes a generic hack (based on setjmp) that
+ happens to work on many machines, and may work on yours. Try
+ compiling and running setjmp_t.c to see whether it has a chance of
+ working. (This is not correct C, so don't blame your compiler if it
+ doesn't work. Based on limited experience, register window machines
+ are likely to cause trouble. If your version of setjmp claims that
+ all accessible variables, including registers, have the value they
+ had at the time of the longjmp, it also will not work. Vanilla 4.2 BSD
+ on Vaxen makes such a claim. SunOS does not.)
+ If your compiler does not allow in-line assembly code, or if you prefer
+ not to use such a facility, mach_dep.c may be replaced by a .s file
+ (as we did for the MIPS machine and the PC/RT).
+ At this point enough architectures are supported by mach_dep.c
+ that you will rarely need to do more than adjust for assembler
+ syntax.
+
+3. os_dep.c (and gc_priv.h).
+ Several kinds of operating system dependent routines reside here.
+ Many are optional. Several are invoked only through corresponding
+ macros in gc_priv.h, which may also be redefined as appropriate.
+ The routine GC_register_data_segments is crucial. It registers static
+ data areas that must be traversed by the collector. (User calls to
+ GC_add_roots may sometimes be used for similar effect.)
+ Routines to obtain memory from the OS also reside here.
+ Alternatively this can be done entirely by the macro GET_MEM
+ defined in gc_priv.h. Routines to disable and reenable signals
+ also reside here if they are need by the macros DISABLE_SIGNALS
+ and ENABLE_SIGNALS defined in gc_priv.h.
+ In a multithreaded environment, the macros LOCK and UNLOCK
+ in gc_priv.h will need to be suitably redefined.
+ The incremental collector requires page dirty information, which
+ is acquired through routines defined in os_dep.c. Unless directed
+ otherwise by gcconfig.h, these are implemented as stubs that simply
+ treat all pages as dirty. (This of course makes the incremental
+ collector much less useful.)
+
+4. dyn_load.c
+ This provides a routine that allows the collector to scan data
+ segments associated with dynamic libraries. Often it is not
+ necessary to provide this routine unless user-written dynamic
+ libraries are used.
+
+ For a different version of UN*X or different machines using the
+Motorola 68000, Vax, SPARC, 80386, NS 32000, PC/RT, or MIPS architecture,
+it should frequently suffice to change definitions in gcconfig.h.
+
+
+THE C INTERFACE TO THE ALLOCATOR
+
+ The following routines are intended to be directly called by the user.
+Note that usually only GC_malloc is necessary. GC_clear_roots and GC_add_roots
+calls may be required if the collector has to trace from nonstandard places
+(e.g. from dynamic library data areas on a machine on which the
+collector doesn't already understand them.) On some machines, it may
+be desirable to set GC_stacktop to a good approximation of the stack base.
+(This enhances code portability on HP PA machines, since there is no
+good way for the collector to compute this value.) Client code may include
+"gc.h", which defines all of the following, plus many others.
+
+1) GC_malloc(nbytes)
+ - allocate an object of size nbytes. Unlike malloc, the object is
+ cleared before being returned to the user. Gc_malloc will
+ invoke the garbage collector when it determines this to be appropriate.
+ GC_malloc may return 0 if it is unable to acquire sufficient
+ space from the operating system. This is the most probable
+ consequence of running out of space. Other possible consequences
+ are that a function call will fail due to lack of stack space,
+ or that the collector will fail in other ways because it cannot
+ maintain its internal data structures, or that a crucial system
+ process will fail and take down the machine. Most of these
+ possibilities are independent of the malloc implementation.
+
+2) GC_malloc_atomic(nbytes)
+ - allocate an object of size nbytes that is guaranteed not to contain any
+ pointers. The returned object is not guaranteed to be cleared.
+ (Can always be replaced by GC_malloc, but results in faster collection
+ times. The collector will probably run faster if large character
+ arrays, etc. are allocated with GC_malloc_atomic than if they are
+ statically allocated.)
+
+3) GC_realloc(object, new_size)
+ - change the size of object to be new_size. Returns a pointer to the
+ new object, which may, or may not, be the same as the pointer to
+ the old object. The new object is taken to be atomic iff the old one
+ was. If the new object is composite and larger than the original object,
+ then the newly added bytes are cleared (we hope). This is very likely
+ to allocate a new object, unless MERGE_SIZES is defined in gc_priv.h.
+ Even then, it is likely to recycle the old object only if the object
+ is grown in small additive increments (which, we claim, is generally bad
+ coding practice.)
+
+4) GC_free(object)
+ - explicitly deallocate an object returned by GC_malloc or
+ GC_malloc_atomic. Not necessary, but can be used to minimize
+ collections if performance is critical. Probably a performance
+ loss for very small objects (<= 8 bytes).
+
+5) GC_expand_hp(bytes)
+ - Explicitly increase the heap size. (This is normally done automatically
+ if a garbage collection failed to GC_reclaim enough memory. Explicit
+ calls to GC_expand_hp may prevent unnecessarily frequent collections at
+ program startup.)
+
+6) GC_malloc_ignore_off_page(bytes)
+ - identical to GC_malloc, but the client promises to keep a pointer to
+ the somewhere within the first 256 bytes of the object while it is
+ live. (This pointer should nortmally be declared volatile to prevent
+ interference from compiler optimizations.) This is the recommended
+ way to allocate anything that is likely to be larger than 100Kbytes
+ or so. (GC_malloc may result in failure to reclaim such objects.)
+
+7) GC_set_warn_proc(proc)
+ - Can be used to redirect warnings from the collector. Such warnings
+ should be rare, and should not be ignored during code development.
+
+8) GC_enable_incremental()
+ - Enables generational and incremental collection. Useful for large
+ heaps on machines that provide access to page dirty information.
+ Some dirty bit implementations may interfere with debugging
+ (by catching address faults) and place restrictions on heap arguments
+ to system calls (since write faults inside a system call may not be
+ handled well).
+
+9) Several routines to allow for registration of finalization code.
+ User supplied finalization code may be invoked when an object becomes
+ unreachable. To call (*f)(obj, x) when obj becomes inaccessible, use
+ GC_register_finalizer(obj, f, x, 0, 0);
+ For more sophisticated uses, and for finalization ordering issues,
+ see gc.h.
+
+ The global variable GC_free_space_divisor may be adjusted up from its
+default value of 4 to use less space and more collection time, or down for
+the opposite effect. Setting it to 1 or 0 will effectively disable collections
+and cause all allocations to simply grow the heap.
+
+ The variable GC_non_gc_bytes, which is normally 0, may be changed to reflect
+the amount of memory allocated by the above routines that should not be
+considered as a candidate for collection. Careless use may, of course, result
+in excessive memory consumption.
+
+ Some additional tuning is possible through the parameters defined
+near the top of gc_priv.h.
+
+ If only GC_malloc is intended to be used, it might be appropriate to define:
+
+#define malloc(n) GC_malloc(n)
+#define calloc(m,n) GC_malloc((m)*(n))
+
+ For small pieces of VERY allocation intensive code, gc_inl.h
+includes some allocation macros that may be used in place of GC_malloc
+and friends.
+
+ All externally visible names in the garbage collector start with "GC_".
+To avoid name conflicts, client code should avoid this prefix, except when
+accessing garbage collector routines or variables.
+
+ There are provisions for allocation with explicit type information.
+This is rarely necessary. Details can be found in gc_typed.h.
+
+THE C++ INTERFACE TO THE ALLOCATOR:
+
+ The Ellis-Hull C++ interface to the collector is included in
+the collector distribution. If you intend to use this, type
+"make c++" after the initial build of the collector is complete.
+See gc_cpp.h for the definition of the interface. This interface
+tries to approximate the Ellis-Detlefs C++ garbage collection
+proposal without compiler changes.
+
+Cautions:
+1. Arrays allocated without new placement syntax are
+allocated as uncollectable objects. They are traced by the
+collector, but will not be reclaimed.
+
+2. Failure to use "make c++" in combination with (1) will
+result in arrays allocated using the default new operator.
+This is likely to result in disaster without linker warnings.
+
+3. If your compiler supports an overloaded new[] operator,
+then gc_cpp.cc and gc_cpp.h should be suitably modified.
+
+4. Many current C++ compilers have deficiencies that
+break some of the functionality. See the comments in gc_cpp.h
+for suggested workarounds.
+
+USE AS LEAK DETECTOR:
+
+ The collector may be used to track down leaks in C programs that are
+intended to run with malloc/free (e.g. code with extreme real-time or
+portability constraints). To do so define FIND_LEAK in Makefile
+This will cause the collector to invoke the report_leak
+routine defined near the top of reclaim.c whenever an inaccessible
+object is found that has not been explicitly freed. Such objects will
+also be automatically reclaimed.
+ Productive use of this facility normally involves redefining report_leak
+to do something more intelligent. This typically requires annotating
+objects with additional information (e.g. creation time stack trace) that
+identifies their origin. Such code is typically not very portable, and is
+not included here, except on SPARC machines.
+ If all objects are allocated with GC_DEBUG_MALLOC (see next section),
+then the default version of report_leak will report the source file
+and line number at which the leaked object was allocated. This may
+sometimes be sufficient. (On SPARC/SUNOS4 machines, it will also report
+a cryptic stack trace. This can often be turned into a sympolic stack
+trace by invoking program "foo" with "callprocs foo". Callprocs is
+a short shell script that invokes adb to expand program counter values
+to symbolic addresses. It was largely supplied by Scott Schwartz.)
+ Note that the debugging facilities described in the next section can
+sometimes be slightly LESS effective in leak finding mode, since in
+leak finding mode, GC_debug_free actually results in reuse of the object.
+(Otherwise the object is simply marked invalid.) Also note that the test
+program is not designed to run meaningfully in FIND_LEAK mode.
+Use "make gc.a" to build the collector.
+
+DEBUGGING FACILITIES:
+
+ The routines GC_debug_malloc, GC_debug_malloc_atomic, GC_debug_realloc,
+and GC_debug_free provide an alternate interface to the collector, which
+provides some help with memory overwrite errors, and the like.
+Objects allocated in this way are annotated with additional
+information. Some of this information is checked during garbage
+collections, and detected inconsistencies are reported to stderr.
+
+ Simple cases of writing past the end of an allocated object should
+be caught if the object is explicitly deallocated, or if the
+collector is invoked while the object is live. The first deallocation
+of an object will clear the debugging info associated with an
+object, so accidentally repeated calls to GC_debug_free will report the
+deallocation of an object without debugging information. Out of
+memory errors will be reported to stderr, in addition to returning
+NIL.
+
+ GC_debug_malloc checking during garbage collection is enabled
+with the first call to GC_debug_malloc. This will result in some
+slowdown during collections. If frequent heap checks are desired,
+this can be achieved by explicitly invoking GC_gcollect, e.g. from
+the debugger.
+
+ GC_debug_malloc allocated objects should not be passed to GC_realloc
+or GC_free, and conversely. It is however acceptable to allocate only
+some objects with GC_debug_malloc, and to use GC_malloc for other objects,
+provided the two pools are kept distinct. In this case, there is a very
+low probablility that GC_malloc allocated objects may be misidentified as
+having been overwritten. This should happen with probability at most
+one in 2**32. This probability is zero if GC_debug_malloc is never called.
+
+ GC_debug_malloc, GC_malloc_atomic, and GC_debug_realloc take two
+additional trailing arguments, a string and an integer. These are not
+interpreted by the allocator. They are stored in the object (the string is
+not copied). If an error involving the object is detected, they are printed.
+
+ The macros GC_MALLOC, GC_MALLOC_ATOMIC, GC_REALLOC, GC_FREE, and
+GC_REGISTER_FINALIZER are also provided. These require the same arguments
+as the corresponding (nondebugging) routines. If gc.h is included
+with GC_DEBUG defined, they call the debugging versions of these
+functions, passing the current file name and line number as the two
+extra arguments, where appropriate. If gc.h is included without GC_DEBUG
+defined, then all these macros will instead be defined to their nondebugging
+equivalents. (GC_REGISTER_FINALIZER is necessary, since pointers to
+objects with debugging information are really pointers to a displacement
+of 16 bytes form the object beginning, and some translation is necessary
+when finalization routines are invoked. For details, about what's stored
+in the header, see the definition of the type oh in debug_malloc.c)
+
+INCREMENTAL/GENERATIONAL COLLECTION:
+
+The collector normally interrupts client code for the duration of
+a garbage collection mark phase. This may be unacceptable if interactive
+response is needed for programs with large heaps. The collector
+can also run in a "generational" mode, in which it usually attempts to
+collect only objects allocated since the last garbage collection.
+Furthermore, in this mode, garbage collections run mostly incrementally,
+with a small amount of work performed in response to each of a large number of
+GC_malloc requests.
+
+This mode is enabled by a call to GC_enable_incremental().
+
+Incremental and generational collection is effective in reducing
+pause times only if the collector has some way to tell which objects
+or pages have been recently modified. The collector uses two sources
+of information:
+
+1. Information provided by the VM system. This may be provided in
+one of several forms. Under Solaris 2.X (and potentially under other
+similar systems) information on dirty pages can be read from the
+/proc file system. Under other systems (currently SunOS4.X) it is
+possible to write-protect the heap, and catch the resulting faults.
+On these systems we require that system calls writing to the heap
+(other than read) be handled specially by client code.
+See os_dep.c for details.
+
+2. Information supplied by the programmer. We define "stubborn"
+objects to be objects that are rarely changed. Such an object
+can be allocated (and enabled for writing) with GC_malloc_stubborn.
+Once it has been initialized, the collector should be informed with
+a call to GC_end_stubborn_change. Subsequent writes that store
+pointers into the object must be preceded by a call to
+GC_change_stubborn.
+
+This mechanism performs best for objects that are written only for
+initialization, and such that only one stubborn object is writable
+at once. It is typically not worth using for short-lived
+objects. Stubborn objects are treated less efficiently than pointerfree
+(atomic) objects.
+
+A rough rule of thumb is that, in the absence of VM information, garbage
+collection pauses are proportional to the amount of pointerful storage
+plus the amount of modified "stubborn" storage that is reachable during
+the collection.
+
+Initial allocation of stubborn objects takes longer than allocation
+of other objects, since other data structures need to be maintained.
+
+We recommend against random use of stubborn objects in client
+code, since bugs caused by inappropriate writes to stubborn objects
+are likely to be very infrequently observed and hard to trace.
+However, their use may be appropriate in a few carefully written
+library routines that do not make the objects themselves available
+for writing by client code.
+
+
+BUGS:
+
+ Any memory that does not have a recognizable pointer to it will be
+reclaimed. Exclusive-or'ing forward and backward links in a list
+doesn't cut it.
+ Some C optimizers may lose the last undisguised pointer to a memory
+object as a consequence of clever optimizations. This has almost
+never been observed in practice. Send mail to boehm@acm.org
+for suggestions on how to fix your compiler.
+ This is not a real-time collector. In the standard configuration,
+percentage of time required for collection should be constant across
+heap sizes. But collection pauses will increase for larger heaps.
+(On SPARCstation 2s collection times will be on the order of 300 msecs
+per MB of accessible memory that needs to be scanned. Your mileage
+may vary.) The incremental/generational collection facility helps,
+but is portable only if "stubborn" allocation is used.
+ Please address bug reports to boehm@acm.org. If you are
+contemplating a major addition, you might also send mail to ask whether
+it's already been done (or whether we tried and discarded it).
+
--- /dev/null
+ Garbage Collector (parallel iversion) for ix86 DG/UX Release R4.20MU07
+
+
+ *READ* the file README.QUICK.
+
+ You need the GCC-3.0.3 rev (DG/UX) compiler to build this tree.
+ This compiler has the new "dgux386" threads package implemented.
+ It also supports the switch "-pthread" needed to link correctly
+ the DG/UX's -lrte -lthread with -lgcc and the system's -lc.
+ Finally we support parralleli-mark for the SMP DG/UX machines.
+ To build the garbage collector do:
+
+ ./configure --enable-parallel-mark
+ make
+ make gctest
+
+ Before you run "gctest" you need to set your LD_LIBRARY_PATH
+ correctly so that "gctest" can find the shared library libgc.
+ Alternatively you can do a configuration
+
+ ./configure --enable-parallel-mark --disable-shared
+
+ to build only the static version of libgc.
+
+ To enable debugging messages please do:
+ 1) Add the "--enable-full-debug" flag during configuration.
+ 2) Edit the file linux-threads.c and uncommnect the line:
+
+ /* #define DEBUG_THREADS 1 */ to --->
+
+ #define DEBUG_THREADS 1
+
+ Then give "make" as usual.
+
+ In a machine with 4 CPUs (my own machine) the option parallel
+ mark (aka --enable-parallel-mark) makes a BIG difference.
+
+ Takis Psarogiannakopoulos
+ University of Cambridge
+ Centre for Mathematical Sciences
+ Department of Pure Mathematics
+ Wilberforce Road
+ Cambridge CB3 0WB ,UK , <takis@XFree86.Org>
+ January 2002
+
+
+Note (HB):
+ The integration of this patch is currently not complete.
+ The following patches against 6.1alpha3 where hard to move
+ to alpha4, and are not integrated. There may also be minor
+ problems with stylistic corrections made by me.
+
+
+--- ltconfig.ORIG Mon Jan 28 20:22:18 2002
++++ ltconfig Mon Jan 28 20:44:00 2002
+@@ -689,6 +689,11 @@
+ pic_flag=-Kconform_pic
+ fi
+ ;;
++ dgux*)
++ pic_flag='-fPIC'
++ link_static='-Bstatic'
++ wl='-Wl,'
++ ;;
+ *)
+ pic_flag='-fPIC'
+ ;;
+@@ -718,6 +723,12 @@
+ # We can build DLLs from non-PIC.
+ ;;
+
++ dgux*)
++ pic_flag='-KPIC'
++ link_static='-Bstatic'
++ wl='-Wl,'
++ ;;
++
+ osf3* | osf4* | osf5*)
+ # All OSF/1 code is PIC.
+ wl='-Wl,'
+@@ -1154,6 +1165,22 @@
+ fi
+ ;;
+
++ dgux*)
++ ld_shlibs=yes
++ # For both C/C++ ommit the deplibs. This is because we relying on the fact
++ # that compilation of execitables will put them in correct order
++ # in any case and sometimes are wrong when listed as deplibs (or missing some deplibs)
++ # However when GNU ld and --whole-archive needs to be used we have the problem
++ # that if the -fPIC *_s.a archive is linked through deplibs list we ommiting crucial
++ # .lo/.o files from the created shared lib. This I think is not the case here.
++ archive_cmds='$CC -shared -h $soname -o $lib $libobjs $linkopts'
++ thread_safe_flag_spec='-pthread'
++ wlarc=
++ hardcode_libdir_flag_spec='-L$libdir'
++ hardcode_shlibpath_var=no
++ ac_cv_archive_cmds_needs_lc=no
++ ;;
++
+ cygwin* | mingw*)
+ # hardcode_libdir_flag_spec is actually meaningless, as there is
+ # no search path for DLLs.
+@@ -1497,7 +1524,7 @@
+ ;;
+
+ dgux*)
+- archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linkopts'
++ archive_cmds='$CC -shared -h $soname -o $lib $libobjs $linkopts'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_shlibpath_var=no
+ ;;
+@@ -2092,12 +2119,17 @@
+ ;;
+
+ dgux*)
+- version_type=linux
++ version_type=dgux
+ need_lib_prefix=no
+ need_version=no
+- library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+- soname_spec='${libname}${release}.so$major'
++ library_names_spec='$libname.so$versuffix'
++ soname_spec='$libname.so$versuffix'
+ shlibpath_var=LD_LIBRARY_PATH
++ thread_safe_flag_spec='-pthread'
++ wlarc=
++ hardcode_libdir_flag_spec='-L$libdir'
++ hardcode_shlibpath_var=no
++ ac_cv_archive_cmds_needs_lc=no
+ ;;
+
+ sysv4*MP*)
+
+
+--- ltmain.sh.ORIG Mon Jan 28 20:31:18 2002
++++ ltmain.sh Tue Jan 29 00:11:29 2002
+@@ -1072,11 +1072,38 @@
+ esac
+ ;;
+
++ -thread*)
++ # DG/UX GCC 2.95.x, 3.x.x rev (DG/UX) links -lthread
++ # with the switch -threads
++ if test "$arg" = "-threads"; then
++ case "$host" in
++ i[3456]86-*-dgux*)
++ deplibs="$deplibs $arg"
++ continue
++ ;;
++ esac
++ fi
++ ;;
++
++ -pthread*)
++ # DG/UX GCC 2.95.x, 3.x.x rev (DG/UX) links -lthread
++ # with the switch -pthread
++ if test "$arg" = "-pthread"; then
++ case "$host" in
++ i[3456]86-*-dgux*)
++ deplibs="$deplibs $arg"
++ continue
++ ;;
++ esac
++ fi
++ ;;
++
+ -l*)
+ if test "$arg" = "-lc"; then
+ case "$host" in
+- *-*-cygwin* | *-*-mingw* | *-*-os2* | *-*-beos*)
++ *-*-cygwin* | *-*-mingw* | *-*-os2* | *-*-beos* | i[3456]86-*-dgux*)
+ # These systems don't actually have c library (as such)
++ # It is wrong in DG/UX to add -lc when creating shared/dynamic objs/libs
+ continue
+ ;;
+ esac
+@@ -1248,6 +1275,12 @@
+ temp_deplibs=
+ for deplib in $dependency_libs; do
+ case "$deplib" in
++ -thread*)
++ temp_deplibs="$temp_deplibs $deplib"
++ ;;
++ -pthread)
++ temp_deplibs="$temp_deplibs $deplib"
++ ;;
+ -R*) temp_xrpath=`$echo "X$deplib" | $Xsed -e 's/^-R//'`
+ case " $rpath $xrpath " in
+ *" $temp_xrpath "*) ;;
+@@ -1709,6 +1742,13 @@
+ done
+ ;;
+
++ dgux)
++ # Leave mostly blank for DG/UX
++ major=
++ versuffix=".$current.$revision";
++ verstring=
++ ;;
++
+ linux)
+ major=.`expr $current - $age`
+ versuffix="$major.$age.$revision"
+@@ -1792,8 +1832,9 @@
+
+ dependency_libs="$deplibs"
+ case "$host" in
+- *-*-cygwin* | *-*-mingw* | *-*-os2* | *-*-beos*)
++ *-*-cygwin* | *-*-mingw* | *-*-os2* | *-*-beos* | i[3456]86-*-dgux*)
+ # these systems don't actually have a c library (as such)!
++ # It is wrong in DG/UX to add -lc when creating shared/dynamic objs/libs
+ ;;
+ *)
+ # Add libc to deplibs on all other systems.
--- /dev/null
+Patrick Beard's Notes for building GC v4.12 with CodeWarrior Pro 2:
+----------------------------------------------------------------------------
+The current build environment for the collector is CodeWarrior Pro 2.
+Projects for CodeWarrior Pro 2 (and for quite a few older versions)
+are distributed in the file Mac_projects.sit.hqx. The project file
+:Mac_projects:gc.prj builds static library versions of the collector.
+:Mac_projects:gctest.prj builds the GC test suite.
+
+Configuring the collector is still done by editing the files
+:Mac_files:MacOS_config.h and :Mac_files:MacOS_Test_config.h.
+
+Lars Farm's suggestions on building the collector:
+----------------------------------------------------------------------------
+Garbage Collection on MacOS - a manual 'MakeFile'
+-------------------------------------------------
+
+Project files and IDE's are great on the Macintosh, but they do have
+problems when used as distribution media. This note tries to provide
+porting instructions in pure TEXT form to avoid those problems. A manual
+'makefile' if you like.
+
+ GC version: 4.12a2
+ Codewarrior: CWPro1
+ date: 18 July 1997
+
+The notes may or may not apply to earlier or later versions of the
+GC/CWPro. Actually, they do apply to earlier versions of both except that
+until recently a project could only build one target so each target was a
+separate project. The notes will most likely apply to future versions too.
+Possibly with minor tweaks.
+
+This is just to record my experiences. These notes do not mean I now
+provide a supported port of the GC to MacOS. It works for me. If it works
+for you, great. If it doesn't, sorry, try again...;-) Still, if you find
+errors, please let me know.
+
+ mailto: lars.farm@ite.mh.se
+
+ address: Lars Farm
+ Krönvägen 33b
+ 856 44 Sundsvall
+ Sweden
+
+Porting to MacOS is a bit more complex than it first seems. Which MacOS?
+68K/PowerPC? Which compiler? Each supports both 68K and PowerPC and offer a
+large number of (unique to each environment) compiler settings. Each
+combination of compiler/68K/PPC/settings require a unique combination of
+standard libraries. And the IDE's does not select them for you. They don't
+even check that the library is built with compatible setting and this is
+the major source of problems when porting the GC (and otherwise too).
+
+You will have to make choices when you configure the GC. I've made some
+choices here, but there are other combinations of settings and #defines
+that work too.
+
+As for target settings the major obstacles may be:
+- 68K Processor: check "4-byte Ints".
+- PPC Processor: uncheck "Store Static Data in TOC".
+
+What you need to do:
+===================
+
+1) Build the GC as a library
+2) Test that the library works with 'test.c'.
+3) Test that the C++ interface 'gc_cpp.cc/h' works with 'test_cpp.cc'.
+
+1) The Libraries:
+=================
+I made one project with four targets (68K/PPC tempmem or appheap). One target
+will suffice if you're able to decide which one you want. I wasn't...
+
+Codewarrior allows a large number of compiler/linker settings. I used these:
+
+Settings shared by all targets:
+------------------------------
+o Access Paths:
+ - User Paths: the GC folder
+ - System Paths: {Compiler}:Metrowerks Standard Library:
+ {Compiler}:MacOS Support:Headers:
+ {Compiler}:MacOS Support:MacHeaders:
+o C/C++ language:
+ - inlining: normal
+ - direct to SOM: off
+ - enable/check: exceptions, RTTI, bool (and if you like pool strings)
+
+PowerPC target settings
+-----------------------
+o Target Settings:
+ - name of target
+ - MacOS PPC Linker
+o PPC Target
+ - name of library
+o C/C++ language
+ - prefix file as described below
+o PPC Processor
+ - Struct Alignment: PowerPC
+ - uncheck "Store Static Data in TOC" -- important!
+ I don't think the others matter, I use full optimization and its ok
+o PPC Linker
+ - Factory Settings (SYM file with full paths, faster linking, dead-strip
+ static init, Main: __start)
+
+
+68K target settings
+-------------------
+o Target Settings:
+ - name of target
+ - MacOS 68K Linker
+o 68K Target
+ - name of library
+ - A5 relative data
+o C/C++ language
+ - prefix file as described below
+o 68K Processor
+ - Code model: smart
+ - Struct alignment: 68K
+ - FP: SANE
+ - enable 4-Byte Ints -- important!
+ I don't think the others matter. I selected...
+ - enable: 68020
+ - enable: global register allocation
+o IR Optimizer
+ - enable: Optimize Space, Optimize Speed
+ I suppose the others would work too, but haven't tried...
+o 68K Linker
+ - Factory Settings (New Style MacsBug,SYM file with full paths,
+ A6 Frames, fast link, Merge compiler glue into segment 1,
+ dead-strip static init)
+
+Prefix Files to configure the GC sources
+----------------------------------------
+The Codewarrior equivalent of commandline compilers -DNAME=X is to use
+prefix-files. A TEXT file that is automatically #included before the first byte
+of every source file. I used these:
+
+---- ( cut here ) ---- gc_prefix_tempmem.h -- 68K and PPC -----
+ #include "gc_prefix_common.h"
+ #undef USE_TEMPORARY_MEMORY
+ #define USE_TEMPORARY_MEMORY
+---- ( cut here ) ---- gc_prefix_appmem.h -- 68K and PPC -----
+ #include "gc_prefix_common.h"
+ #undef USE_TEMPORARY_MEMORY
+// #define USE_TEMPORARY_MEMORY
+
+---- ( cut here ) ---- gc_prefix_common.h --------------------
+// gc_prefix_common.h
+// ------------------
+// Codewarrior prefix file to configure the GC libraries
+//
+// prefix files are the Codewarrior equivalent of the
+// command line option -Dname=x frequently seen in makefiles
+
+#if !__MWERKS__
+ #error only tried this with Codewarrior
+#endif
+
+#if macintosh
+ #define MSL_USE_PRECOMPILED_HEADERS 0
+ #include <ansi_prefix.mac.h>
+ #ifndef __STDC__
+ #define __STDC__ 0
+ #endif
+
+ // See list of #defines to configure the library in: 'MakeFile'
+ // see also README
+
+ #define SILENT // no collection messages. In case
+ // of trouble you might want this off
+ #define ALL_INTERIOR_POINTERS // follows interior pointers.
+//#define DONT_ADD_BYTE_AT_END // disables the padding if defined.
+//#define SMALL_CONFIG // whether to use a smaller heap.
+ #define NO_SIGNALS // signals aren't real on the Macintosh.
+ #define ATOMIC_UNCOLLECTABLE // GC_malloc_atomic_uncollectable()
+
+ // define either or none as per personal preference
+ // used in malloc.c
+ #define REDIRECT_MALLOC GC_malloc
+//#define REDIRECT_MALLOC GC_malloc_uncollectable
+ // if REDIRECT_MALLOC is #defined make sure that the GC library
+ // is listed before the ANSI/ISO libs in the Codewarrior
+ // 'Link order' panel
+//#define IGNORE_FREE
+
+ // mac specific configs
+//#define USE_TEMPORARY_MEMORY // use Macintosh temporary memory.
+//#define SHARED_LIBRARY_BUILD // build for use in a shared library.
+
+#else
+ // could build Win32 here too, or in the future
+ // Rhapsody PPC-mach, Rhapsody PPC-MacOS,
+ // Rhapsody Intel-mach, Rhapsody Intel-Win32,...
+ // ... ugh this will get messy ...
+#endif
+
+// make sure ints are at least 32-bit
+// ( could be set to 16-bit by compiler settings (68K) )
+
+struct gc_private_assert_intsize_{ char x[ sizeof(int)>=4 ? 1 : 0 ]; };
+
+#if __powerc
+ #if __option(toc_data)
+ #error turn off "store static data in TOC" when using GC
+ // ... or find a way to add TOC to the root set...(?)
+ #endif
+#endif
+---- ( cut here ) ---- end of gc_prefix_common.h -----------------
+
+Files to build the GC libraries:
+--------------------------------
+ allchblk.c
+ alloc.c
+ blacklst.c
+ checksums.c
+ dbg_mlc.c
+ finalize.c
+ headers.c
+ mach_dep.c
+ MacOS.c -- contains MacOS code
+ malloc.c
+ mallocx.c
+ mark.c
+ mark_rts.c
+ misc.c
+ new_hblk.c
+ obj_map.c
+ os_dep.c -- contains MacOS code
+ ptr_chck.c
+ reclaim.c
+ stubborn.c
+ typd_mlc.c
+ gc++.cc -- this is 'gc_cpp.cc' with less 'inline' and
+ -- throw std::bad_alloc when out of memory
+ -- gc_cpp.cc works just fine too
+
+2) Test that the library works with 'test.c'.
+=============================================
+
+The test app is just an ordinary ANSI-C console app. Make sure settings
+match the library you're testing.
+
+Files
+-----
+ test.c
+ the GC library to test -- link order before ANSI libs
+ suitable Mac+ANSI libraries
+
+prefix:
+------
+---- ( cut here ) ---- gc_prefix_testlib.h -- all libs -----
+#define MSL_USE_PRECOMPILED_HEADERS 0
+#include <ansi_prefix.mac.h>
+#undef NDEBUG
+
+#define ALL_INTERIOR_POINTERS /* for GC_priv.h */
+---- ( cut here ) ----
+
+3) Test that the C++ interface 'gc_cpp.cc/h' works with 'test_cpp.cc'.
+
+The test app is just an ordinary ANSI-C console app. Make sure settings match
+the library you're testing.
+
+Files
+-----
+ test_cpp.cc
+ the GC library to test -- link order before ANSI libs
+ suitable Mac+ANSI libraries
+
+prefix:
+------
+same as for test.c
+
+For convenience I used one test-project with several targets so that all
+test apps are build at once. Two for each library to test: test.c and
+gc_app.cc. When I was satisfied that the libraries were ok. I put the
+libraries + gc.h + the c++ interface-file in a folder that I then put into
+the MSL hierarchy so that I don't have to alter access-paths in projects
+that use the GC.
+
+After that, just add the proper GC library to your project and the GC is in
+action! malloc will call GC_malloc and free GC_free, new/delete too. You
+don't have to call free or delete. You may have to be a bit cautious about
+delete if you're freeing other resources than RAM. See gc_cpp.h. You can
+also keep coding as always with delete/free. That works too. If you want,
+"include <gc.h> and tweak it's use a bit.
+
+Symantec SPM
+============
+It has been a while since I tried the GC in SPM, but I think that the above
+instructions should be sufficient to guide you through in SPM too. SPM
+needs to know where the global data is. Use the files 'datastart.c' and
+'dataend.c'. Put 'datastart.c' at the top of your project and 'dataend.c'
+at the bottom of your project so that all data is surrounded. This is not
+needed in Codewarrior because it provides intrinsic variables
+__datastart__, __data_end__ that wraps all globals.
+
+Source Changes (GC 4.12a2)
+==========================
+Very few. Just one tiny in the GC, not strictly needed.
+- MacOS.c line 131 in routine GC_MacFreeTemporaryMemory()
+ change # if !defined(SHARED_LIBRARY_BUILD)
+ to # if !defined(SILENT) && !defined(SHARED_LIBRARY_BUILD)
+ To turn off a message when the application quits (actually, I faked
+ this change by #defining SHARED_LIBRARY_BUILD in a statically linked
+ library for more than a year without ill effects but perhaps this is
+ better).
+
+- test_cpp.cc
+ made the first lines of main() look like this:
+ ------------
+ int main( int argc, char* argv[] ) {
+ #endif
+ #if macintosh // MacOS
+ char* argv_[] = {"test_cpp","10"}; // doesn't
+ argv=argv_; // have a
+ argc = sizeof(argv_)/sizeof(argv_[0]); // commandline
+ #endif //
+
+ int i, iters, n;
+ # ifndef __GNUC__
+ alloc dummy_to_fool_the_compiler_into_doing_things_it_currently_cant_handle;
+ ------------
+
+- config.h [now gcconfig.h]
+ __MWERKS__ does not have to mean MACOS. You can use Codewarrior to
+ build a Win32 or BeOS library and soon a Rhapsody library. You may
+ have to change that #if...
+
+
+
+ It worked for me, hope it works for you.
+
+ Lars Farm
+ 18 July 1997
+----------------------------------------------------------------------------
+
+
+Patrick Beard's instructions (may be dated):
+
+v4.3 of the collector now runs under Symantec C++/THINK C v7.0.4, and
+Metrowerks C/C++ v4.5 both 68K and PowerPC. Project files are provided
+to build and test the collector under both development systems.
+
+Configuration
+-------------
+
+To configure the collector, under both development systems, a prefix file
+is used to set preprocessor directives. This file is called "MacOS_config.h".
+Also to test the collector, "MacOS_Test_config.h" is provided.
+
+Testing
+-------
+
+To test the collector (always a good idea), build one of the gctest projects,
+gctest.¹ (Symantec C++/THINK C), mw/gctest.68K.¹, or mw/gctest.PPC.¹. The
+test will ask you how many times to run; 1 should be sufficient.
+
+Building
+--------
+
+For your convenience project files for the major Macintosh development
+systems are provided.
+
+For Symantec C++/THINK C, you must build the two projects gclib-1.¹ and
+gclib-2.¹. It has to be split up because the collector has more than 32k
+of static data and no library can have more than this in the Symantec
+environment. (Future versions will probably fix this.)
+
+For Metrowerks C/C++ 4.5 you build gc.68K.¹/gc.PPC.¹ and the result will
+be a library called gc.68K.lib/gc.PPC.lib.
+
+Using
+-----
+
+Under Symantec C++/THINK C, you can just add the gclib-1.¹ and gclib-2.¹
+projects to your own project. Under Metrowerks, you add gc.68K.lib or
+gc.PPC.lib and two additional files. You add the files called datastart.c
+and dataend.c to your project, bracketing all files that use the collector.
+See mw/gctest.¹ for an example.
+
+Include the projects/libraries you built above into your own project,
+#include "gc.h", and call GC_malloc. You don't have to call GC_free.
+
+
+Patrick C. Beard
+January 4, 1995
--- /dev/null
+While the GC should work on MacOS X Server, MacOS X and Darwin, I only tested
+it on MacOS X Server.
+I've added a PPC assembly version of GC_push_regs(), thus the setjmp() hack is
+no longer necessary. Incremental collection is supported via mprotect/signal.
+The current solution isn't really optimal because the signal handler must decode
+the faulting PPC machine instruction in order to find the correct heap address.
+Further, it must poke around in the register state which the kernel saved away
+in some obscure register state structure before it calls the signal handler -
+needless to say the layout of this structure is no where documented.
+Threads and dynamic libraries are not yet supported (adding dynamic library
+support via the low-level dyld API shouldn't be that hard).
+
+The original MacOS X port was brought to you by Andrew Stone.
+
+
+June, 1 2000
+
+Dietmar Planitzer
+dave.pl@ping.at
+
+Note from Andrew Begel:
+
+One more fix to enable gc.a to link successfully into a shared library for
+MacOS X. You have to add -fno-common to the CFLAGS in the Makefile. MacOSX
+disallows common symbols in anything that eventually finds its way into a
+shared library. (I don't completely understand why, but -fno-common seems to
+work and doesn't mess up the garbage collector's functionality).
+
+Feb 26, 2003
+
+Jeff Sturm and Jesse Rosenstock provided a patch that adds thread support.
+GC_MACOSX_THREADS should be defined in the build and in clients. Real
+dynamic library support is still missing, i.e. dynamic library data segments
+are still not scanned. Code that stores pointers to the garbage collected
+heap in statically allocated variables should not reside in a dynamic
+library. This still doesn't appear to be 100% reliable.
+
+Mar 10, 2003
+Brian Alliet contributed dynamic library support for MacOSX. It could also
+use more testing.
--- /dev/null
+The code assumes static linking, and a single thread. The editor de has
+not been ported. The cord test program has. The supplied OS2_MAKEFILE
+assumes the IBM C Set/2 environment, but the code shouldn't.
+
+Since we haven't figured out hoe to do perform partial links or to build static
+libraries, clients currently need to link against a long list of executables.
--- /dev/null
+===========================================================================
+ Kjetil S. Matheussen's notes (28-11-2000)
+===========================================================================
+Compiles under SAS/C again. Should allso still compile under other
+amiga compilers without big changes. I haven't checked if it still
+works under gcc, because I don't have gcc for amiga. But I have
+updated 'Makefile', and hope it compiles fine.
+
+
+WHATS NEW:
+
+1.
+ Made a pretty big effort in preventing GCs allocating-functions from returning
+ chip-mem.
+
+ The lower part of the new file AmigaOS.c does this in various ways, mainly by
+ wrapping GC_malloc, GC_malloc_atomic, GC_malloc_uncollectable,
+ GC_malloc_atomic_uncollectable, GC_malloc_stubborn, GC_malloc_ignore_off_page
+ and GC_malloc_atomic_ignore_off_page. GC_realloc is allso wrapped, but
+ doesn't do the same effort in preventing to return chip-mem.
+ Other allocating-functions (f.ex. GC_*_typed_) can probably be
+ used without any problems, but beware that the warn hook will not be called.
+ In case of problems, don't define GC_AMIGA_FASTALLOC.
+
+ Programs using more time actually using the memory allocated
+ (instead of just allocate and free rapidly) have
+ the most to earn on this, but even gctest now normally runs twice
+ as fast and uses less memory, on my poor 8MB machine.
+
+ The changes have only effect when there is no more
+ fast-mem left. But with the way GC works, it
+ could happen quite often. Beware that an atexit handler had to be added,
+ so using the abort() function will make a big memory-loss.
+ If you absolutely must call abort() instead of exit(), try calling
+ the GC_amiga_free_all_mem function before abort().
+
+ New amiga-spesific compilation flags:
+
+ GC_AMIGA_FASTALLOC - By NOT defining this option, GC will work like before,
+ it will not try to force fast-mem out of the OS, and
+ it will use normal calloc for allocation, and the rest
+ of the following flags will have no effect.
+
+ GC_AMIGA_ONLYFAST - Makes GC never to return chip-mem. GC_AMIGA_RETRY have
+ no effect if this flag is set.
+
+ GC_AMIGA_GC - If gc returns NULL, do a GC_gcollect, and try again. This
+ usually is a success with the standard GC configuration.
+ It is allso the most important flag to set to prevent
+ GC from returning chip-mem. Beware that it slows down a lot
+ when a program is rapidly allocating/deallocating when
+ theres either very little fast-memory left or verly little
+ chip-memory left. Its not a very common situation, but gctest
+ sometimes (very rare) use many minutes because of this.
+
+ GC_AMIGA_RETRY - If gc succeed allocating memory, but it is chip-mem,
+ try again and see if it is fast-mem. Most of the time,
+ it will actually return fast-mem for the second try.
+ I have set max number of retries to 9 or size/5000. You
+ can change this if you like. (see GC_amiga_rec_alloc())
+
+ GC_AMIGA_PRINTSTATS - Gather some statistics during the execution of a
+ program, and prints out the info when the atexit-handler
+ is called.
+
+ My reccomendation is to set all this flags, except GC_AMIGA_PRINTSTATS and
+ GC_AMIGA_ONLYFAST.
+
+ If your program demands high response-time, you should
+ not define GC_AMIGA_GC, and possible allso define GC_AMIGA_ONLYFAST.
+ GC_AMIGA_RETRY does not seem to slow down much.
+
+ Allso, when compiling up programs, and GC_AMIGA_FASTALLOC was not defined when
+ compilling gc, you can define GC_AMIGA_MAKINGLIB to avoid having these allocation-
+ functions wrapped. (see gc.h)
+
+ Note that GC_realloc must not be called before any of
+ the other above mentioned allocating-functions have been called. (shouldn't be
+ any programs doing so either, I hope).
+
+ Another note. The allocation-function is wrapped when defining
+ GC_AMIGA_FASTALLOC by letting the function go thru the new
+ GC_amiga_allocwrapper_do function-pointer (see gc.h). Means that
+ sending function-pointers, such as GC_malloc, GC_malloc_atomic, etc.,
+ for later to be called like f.ex this, (*GC_malloc_functionpointer)(size),
+ will not wrap the function. This is normally not a big problem, unless
+ all allocation function is called like this, which will cause the
+ atexit un-allocating function never to be called. Then you either
+ have to manually add the atexit handler, or call the allocation-
+ functions function-pointer functions like this;
+ (*GC_amiga_allocwrapper_do)(size,GC_malloc_functionpointer).
+ There are probably better ways this problem could be handled, unfortunately,
+ I didn't find any without rewriting or replacing a lot of the GC-code, which
+ I really didn't want to. (Making new GC_malloc_* functions, and just
+ define f.ex GC_malloc as GC_amiga_malloc should allso work).
+
+
+ New amiga-spesific function:
+
+ void GC_amiga_set_toany(void (*func)(void));
+
+ 'func' is a function that will be called right before gc has to change
+ allocation-method from MEMF_FAST to MEMF_ANY. Ie. when it is likely
+ it will return chip-mem.
+
+
+2. A few small compiler-spesific additions to make it compile with SAS/C again.
+
+3. Updated and rewritten the smakefile, so that it works again and that
+ the "unnecesarry" 'SCOPTIONS' files could be removed. Allso included
+ the cord-smakefile stuff in the main smakefile, so that the cord smakefile
+ could be removed too. By writing smake -f Smakefile.smk, both gc.lib and
+ cord.lib will be made.
+
+
+
+STILL MISSING:
+
+Programs can not be started from workbench, at least not for SAS/C. (Martin
+Tauchmanns note about that it now works with workbench is definitely wrong
+when concerning SAS/C). I guess it works if you use the old "#if 0'ed"-code,
+but I haven't tested it. I think the reason for MT to replace the
+"#if 0'ed"-code was only because it was a bit to SAS/C-spesific. But I
+don't know. An iconx-script solves this problem anyway.
+
+
+BEWARE!
+
+-To run gctest, set the stack to around 200000 bytes first.
+-SAS/C-spesific: cord will crash if you compile gc.lib with
+ either parm=reg or parm=both. (missing legal prototypes for
+ function-pointers someplace is the reason I guess.).
+
+
+tested with software: Radium, http://www.stud.ifi.uio.no/~ksvalast/radium/
+
+tested with hardware: MC68060
+
+
+-ksvalast@ifi.uio.no
+
+
+===========================================================================
+ Martin Tauchmann's notes (1-Apr-99)
+===========================================================================
+
+Works now, also with the GNU-C compiler V2.7.2.1. <ftp://ftp.unina.it/pub/amiga/geekgadgets/amiga/m68k/snapshots/971125/amiga-bin/>
+Modify the `Makefile`
+CC=cc $(ABI_FLAG)
+to
+CC=gcc $(ABI_FLAG)
+
+TECHNICAL NOTES
+
+- `GC_get_stack_base()`, `GC_register_data_segments()` works now with every
+ C compiler; also Workbench.
+
+- Removed AMIGA_SKIP_SEG, but the Code-Segment must not be scanned by GC.
+
+
+PROBLEMS
+- When the Linker, does`t merge all Code-Segments to an single one. LD of GCC
+ do it always.
+
+- With ixemul.library V47.3, when an GC program launched from another program
+ (example: `Make` or `if_mach M68K AMIGA gctest`), `GC_register_data_segments()`
+ found the Segment-List of the caller program.
+ Can be fixed, if the run-time initialization code (for C programs, usually *crt0*)
+ support `__data` and `__bss`.
+
+- PowerPC Amiga currently not supported.
+
+- Dynamic libraries (dyn_load.c) not supported.
+
+
+TESTED WITH SOFTWARE
+
+`Optimized Oberon 2 C` (oo2c) <http://cognac.informatik.uni-kl.de/download/index.html>
+
+
+TESTED WITH HARDWARE
+
+MC68030
+
+
+CONTACT
+
+Please, contact me at <martintauchmann@bigfoot.com>, when you change the
+Amiga port. <http://martintauchmann.home.pages.de>
+
+===========================================================================
+ Michel Schinz's notes
+===========================================================================
+WHO DID WHAT
+
+The original Amiga port was made by Jesper Peterson. I (Michel Schinz)
+modified it slightly to reflect the changes made in the new official
+distributions, and to take advantage of the new SAS/C 6.x features. I also
+created a makefile to compile the "cord" package (see the cord
+subdirectory).
+
+TECHNICAL NOTES
+
+In addition to Jesper's notes, I have the following to say:
+
+- Starting with version 4.3, gctest checks to see if the code segment is
+ added to the root set or not, and complains if it is. Previous versions
+ of this Amiga port added the code segment to the root set, so I tried to
+ fix that. The only problem is that, as far as I know, it is impossible to
+ know which segments are code segments and which are data segments (there
+ are indeed solutions to this problem, like scanning the program on disk
+ or patch the LoadSeg functions, but they are rather complicated). The
+ solution I have chosen (see os_dep.c) is to test whether the program
+ counter is in the segment we are about to add to the root set, and if it
+ is, to skip the segment. The problems are that this solution is rather
+ awkward and that it works only for one code segment. This means that if
+ your program has more than one code segment, all of them but one will be
+ added to the root set. This isn't a big problem in fact, since the
+ collector will continue to work correctly, but it may be slower.
+
+ Anyway, the code which decides whether to skip a segment or not can be
+ removed simply by not defining AMIGA_SKIP_SEG. But notice that if you do
+ so, gctest will complain (it will say that "GC_is_visible produced wrong
+ failure indication"). However, it may be useful if you happen to have
+ pointers stored in a code segment (you really shouldn't).
+
+ If anyone has a good solution to the problem of finding, when a program
+ is loaded in memory, whether a segment is a code or a data segment,
+ please let me know.
+
+PROBLEMS
+
+If you have any problem with this version, please contact me at
+schinz@alphanet.ch (but do *not* send long files, since we pay for
+every mail!).
+
+===========================================================================
+ Jesper Peterson's notes
+===========================================================================
+
+ADDITIONAL NOTES FOR AMIGA PORT
+
+These notes assume some familiarity with Amiga internals.
+
+WHY I PORTED TO THE AMIGA
+
+The sole reason why I made this port was as a first step in getting
+the Sather(*) language on the Amiga. A port of this language will
+be done as soon as the Sather 1.0 sources are made available to me.
+Given this motivation, the garbage collection (GC) port is rather
+minimal.
+
+(*) For information on Sather read the comp.lang.sather newsgroup.
+
+LIMITATIONS
+
+This port assumes that the startup code linked with target programs
+is that supplied with SAS/C versions 6.0 or later. This allows
+assumptions to be made about where to find the stack base pointer
+and data segments when programs are run from WorkBench, as opposed
+to running from the CLI. The compiler dependent code is all in the
+GC_get_stack_base() and GC_register_data_segments() functions, but
+may spread as I add Amiga specific features.
+
+Given that SAS/C was assumed, the port is set up to be built with
+"smake" using the "SMakefile". Compiler options in "SCoptions" can
+be set with "scopts" program. Both "smake" and "scopts" are part of
+the SAS/C commercial development system.
+
+In keeping with the porting philosophy outlined above, this port
+will not behave well with Amiga specific code. Especially not inter-
+process comms via messages, and setting up public structures like
+Intuition objects or anything else in the system lists. For the
+time being the use of this library is limited to single threaded
+ANSI/POSIX compliant or near-complient code. (ie. Stick to stdio
+for now). Given this limitation there is currently no mechanism for
+allocating "CHIP" or "PUBLIC" memory under the garbage collector.
+I'll add this after giving it considerable thought. The major
+problem is the entire physical address space may have to me scanned,
+since there is no telling who we may have passed memory to.
+
+If you allocate your own stack in client code, you will have to
+assign the pointer plus stack size to GC_stackbottom.
+
+The initial stack size of the target program can be compiled in by
+setting the __stack symbol (see SAS documentaion). It can be over-
+ridden from the CLI by running the AmigaDOS "stack" program, or from
+the WorkBench by setting the stack size in the tool types window.
+
+SAS/C COMPILER OPTIONS (SCoptions)
+
+You may wish to check the "CPU" code option is appropriate for your
+intended target system.
+
+Under no circumstances set the "StackExtend" code option in either
+compiling the library or *ANY* client code.
+
+All benign compiler warnings have been suppressed. These mainly
+involve lack of prototypes in the code, and dead assignments
+detected by the optimizer.
+
+THE GOOD NEWS
+
+The library as it stands is compatible with the GigaMem commercial
+virtual memory software, and probably similar PD software.
+
+The performance of "gctest" on an Amiga 2630 (68030 @ 25Mhz)
+compares favourably with an HP9000 with similar architecture (a 325
+with a 68030 I think).
+
+-----------------------------------------------------------------------
+
+The Amiga port has been brought to you by:
+
+Jesper Peterson.
+
+jep@mtiame.mtia.oz.au (preferred, but 1 week turnaround)
+jep@orca1.vic.design.telecom.au (that's orca<one>, 1 day turnaround)
+
+At least one of these addresses should be around for a while, even
+though I don't work for either of the companies involved.
+
--- /dev/null
+From: Margaret Fleck
+
+Here's the key details of what worked for me, in case anyone else needs them.
+There may well be better ways to do some of this, but ....
+ -- Margaret
+
+
+The badge4 has a StrongArm-1110 processor and a StrongArm-1111 coprocessor.
+
+Assume that the garbage collector distribution is unpacked into /home/arm/gc6.0,
+which is visible to both the ARM machine and a linux desktop (e.g. via NFS mounting).
+
+Assume that you have a file /home/arm/config.site with contents something like the
+example attached below. Notice that our local ARM toolchain lives in
+/skiff/local.
+
+Go to /home/arm/gc6.0 directory. Do
+ CONFIG_SITE=/home/arm/config.site ./configure --target=arm-linux
+--prefix=/home/arm/gc6.0
+
+On your desktop, do:
+ make
+ make install
+The main garbage collector library should now be in ../gc6.0/lib/libgc.so.
+
+To test the garbage collector, first do the following on your desktop
+ make gctest
+ ./gctest
+Then do the following on the ARM machine
+ cd .libs
+ ./lt-gctest
+
+Do not try to do "make test" (the usual way of running the test
+program). This does not work and seems to erase some of the important
+files.
+
+The gctest program claims to have succeeded. Haven't run any further tests
+with it, though I'll be doing so in the near future.
+
+-------------------------------
+# config.site for configure
+
+# Modified from the one provided by Bradley D. LaRonde
+# Edited by Andrej Cedilnik <acedil1@csee.umbc.edu>
+# Used some of solutions by Tilman Vogel <Tilman.Vogel@web.de>
+# Ported for iPAQ Familiar by Oliver Kurth <oliver.kurth@innominate.com>
+# Further modified by Margaret Fleck for the badge4
+
+HOSTCC=gcc
+
+# Names of the cross-compilers
+CC=/skiff/local/bin/arm-linux-gcc
+CXX=/skiff/local/bin/arm-linux-gcc
+
+# The cross compiler specific options
+CFLAGS="-O2 -fno-exceptions"
+CXXFLAGS="-O2 -fno-exceptions"
+CPPFLAGS="-O2 -fno-exceptions"
+LDFLAGS=""
+
+# Some other programs
+AR=/skiff/local/bin/arm-linux-ar
+RANLIB=/skiff/local/bin/arm-linux-ranlib
+NM=/skiff/local/bin/arm-linux-nm
+ac_cv_path_NM=/skiff/local/bin/arm-linux-nm
+ac_cv_func_setpgrp_void=yes
+x_includes=/skiff/local/arm-linux/include/X11
+x_libraries=/skiff/local/arm-linux/lib/X11
--- /dev/null
+As of GC6.0alpha8, we attempt to support GNU-style builds based on automake,
+autoconf and libtool. This is based almost entirely on Tom Tromey's work
+with gcj.
+
+To build and install libraries use
+
+configure; make; make install
+
+The advantages of this process are:
+
+1) It should eventually do a better job of automatically determining the
+right compiler to use, etc. It probably already does in some cases.
+
+2) It tries to automatically set a good set of default GC parameters for
+the platform (e.g. thread support). It provides an easier way to configure
+some of the others.
+
+3) It integrates better with other projects using a GNU-style build process.
+
+4) It builds both dynamic and static libraries.
+
+The known disadvantages are:
+
+1) The build scripts are much more complex and harder to debug (though largely
+standard). I don't understand them all, and there's probably lots of redundant
+stuff.
+
+2) It probably doesn't work on all Un*x-like platforms yet. It probably will
+never work on the rest.
+
+3) The scripts are not yet complete. Some of the standard GNU targets don't
+yet work. (Corrections/additions are very welcome.)
+
+The distribution should contain all files needed to run "configure" and "make",
+as well as the sources needed to regenerate the derived files. (If I missed
+some, please let me know.)
+
+Note that the distribution comes with a "Makefile" which will be overwritten
+by "configure" with one that is not at all equiavelent to the original. The
+distribution contains a copy of the original "Makefile" in "Makefile.direct".
+
+Important options to configure:
+
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [/usr/local]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --enable-threads=TYPE choose threading package
+ --enable-parallel-mark parallelize marking and free list construction
+ --enable-full-debug include full support for pointer backtracing etc.
+
+Unless --prefix is set (or --exec-prefix or one of the more obscure options),
+make install will install libgc.a and libgc.so in /usr/local/bin, which
+would typically require the "make install" to be run as root.
+
+Most commonly --enable-threads=posix or will be needed. --enable-parallel-mark
+is recommended for multiprocessors if it is supported on the platform.
+
+
--- /dev/null
+This is a rough history of garbage collector bugs and versions.
+
+This has been maintained with varying diligence over the years.
+
+I made an attempt to include recent contributors here. I apologize for any
+omissions.
+
+-------------------------
+
+ Version 1.3 and immediately preceding versions contained spurious
+assembly language assignments to TMP_SP. Only the assignment in the PC/RT
+code is necessary. On other machines, with certain compiler options,
+the assignments can lead to an unsaved register being overwritten.
+Known to cause problems under SunOS 3.5 WITHOUT the -O option. (With
+-O the compiler recognizes it as dead code. It probably shouldn't,
+but that's another story.)
+
+ Version 1.4 and earlier versions used compile time determined values
+for the stack base. This no longer works on Sun 3s, since Sun 3/80s use
+a different stack base. We now use a straightforward heuristic on all
+machines on which it is known to work (incl. Sun 3s) and compile-time
+determined values for the rest. There should really be library calls
+to determine such values.
+
+ Version 1.5 and earlier did not ensure 8 byte alignment for objects
+allocated on a sparc based machine.
+
+ Version 1.8 added ULTRIX support in gc_private.h.
+
+ Version 1.9 fixed a major bug in gc_realloc.
+
+ Version 2.0 introduced a consistent naming convention for collector
+routines and added support for registering dynamic library data segments
+in the standard mark_roots.c. Most of the data structures were revamped.
+The treatment of interior pointers was completely changed. Finalization
+was added. Support for locking was added. Object kinds were added.
+We added a black listing facility to avoid allocating at addresses known
+to occur as integers somewhere in the address space. Much of this
+was accomplished by adapting ideas and code from the PCR collector.
+The test program was changed and expanded.
+
+ Version 2.1 was the first stable version since 1.9, and added support
+for PPCR.
+
+ Version 2.2 added debugging allocation, and fixed various bugs. Among them:
+- GC_realloc could fail to extend the size of the object for certain large object sizes.
+- A blatant subscript range error in GC_printf, which unfortunately
+ wasn't exercised on machines with sufficient stack alignment constraints.
+- GC_register_displacement did the wrong thing if it was called after
+ any allocation had taken place.
+- The leak finding code would eventually break after 2048 byte
+ byte objects leaked.
+- interface.c didn't compile.
+- The heap size remained much too small for large stacks.
+- The stack clearing code behaved badly for large stacks, and perhaps
+ on HP/PA machines.
+
+ Version 2.3 added ALL_INTERIOR_POINTERS and fixed the following bugs:
+- Missing declaration of etext in the A/UX version.
+- Some PCR root-finding problems.
+- Blacklisting was not 100% effective, because the plausible future
+ heap bounds were being miscalculated.
+- GC_realloc didn't handle out-of-memory correctly.
+- GC_base could return a nonzero value for addresses inside free blocks.
+- test.c wasn't really thread safe, and could erroneously report failure
+ in a multithreaded environment. (The locking primitives need to be
+ replaced for other threads packages.)
+- GC_CONS was thoroughly broken.
+- On a SPARC with dynamic linking, signals stayed diabled while the
+ client code was running.
+ (Thanks to Manuel Serrano at INRIA for reporting the last two.)
+
+ Version 2.4 added GC_free_space_divisor as a tuning knob, added
+ support for OS/2 and linux, and fixed the following bugs:
+- On machines with unaligned pointers (e.g. Sun 3), every 128th word could
+ fail to be considered for marking.
+- Dynamic_load.c erroneously added 4 bytes to the length of the data and
+ bss sections of the dynamic library. This could result in a bad memory
+ reference if the actual length was a multiple of a page. (Observed on
+ Sun 3. Can probably also happen on a Sun 4.)
+ (Thanks to Robert Brazile for pointing out that the Sun 3 version
+ was broken. Dynamic library handling is still broken on Sun 3s
+ under 4.1.1U1, but apparently not 4.1.1. If you have such a machine,
+ use -Bstatic.)
+
+ Version 2.5 fixed the following bugs:
+- Removed an explicit call to exit(1)
+- Fixed calls to GC_printf and GC_err_printf, so the correct number of
+ arguments are always supplied. The OS/2 C compiler gets confused if
+ the number of actuals and the number of formals differ. (ANSI C
+ doesn't require this to work. The ANSI sanctioned way of doing things
+ causes too many compatibility problems.)
+
+ Version 3.0 added generational/incremental collection and stubborn
+ objects.
+
+ Version 3.1 added the following features:
+- A workaround for a SunOS 4.X SPARC C compiler
+ misfeature that caused problems when the collector was turned into
+ a dynamic library.
+- A fix for a bug in GC_base that could result in a memory fault.
+- A fix for a performance bug (and several other misfeatures) pointed
+ out by Dave Detlefs and Al Dosser.
+- Use of dirty bit information for static data under Solaris 2.X.
+- DEC Alpha/OSF1 support (thanks to Al Dosser).
+- Incremental collection on more platforms.
+- A more refined heap expansion policy. Less space usage by default.
+- Various minor enhancements to reduce space usage, and to reduce
+ the amount of memory scanned by the collector.
+- Uncollectable allocation without per object overhead.
+- More conscientious handling of out-of-memory conditions.
+- Fixed a bug in debugging stubborn allocation.
+- Fixed a bug that resulted in occasional erroneous reporting of smashed
+ objects with debugging allocation.
+- Fixed bogus leak reports of size 4096 blocks with FIND_LEAK.
+
+ Version 3.2 fixed a serious and not entirely repeatable bug in
+ the incremental collector. It appeared only when dirty bit info
+ on the roots was available, which is normally only under Solaris.
+ It also added GC_general_register_disappearing_link, and some
+ testing code. Interface.c disappeared.
+
+ Version 3.3 fixes several bugs and adds new ports:
+- PCR-specific bugs.
+- Missing locking in GC_free, redundant FASTUNLOCK
+ in GC_malloc_stubborn, and 2 bugs in
+ GC_unregister_disappearing_link.
+ All of the above were pointed out by Neil Sharman
+ (neil@cs.mu.oz.au).
+- Common symbols allocated by the SunOS4.X dynamic loader
+ were not included in the root set.
+- Bug in GC_finalize (reported by Brian Beuning and Al Dosser)
+- Merged Amiga port from Jesper Peterson (untested)
+- Merged NeXT port from Thomas Funke (significantly
+ modified and untested)
+
+ Version 3.4:
+- Fixed a performance bug in GC_realloc.
+- Updated the amiga port.
+- Added NetBSD and 386BSD ports.
+- Added cord library.
+- Added trivial performance enhancement for
+ ALL_INTERIOR_POINTERS. (Don't scan last word.)
+
+ Version 3.5
+- Minor collections now mark from roots only once, if that
+ doesn't cause an excessive pause.
+- The stack clearing heuristic was refined to prevent anomalies
+ with very heavily recursive programs and sparse stacks.
+- Fixed a bug that prevented mark stack growth in some cases.
+ GC_objects_are_marked should be set to TRUE after a call
+ to GC_push_roots and as part of GC_push_marked, since
+ both can now set mark bits. I think this is only a performance
+ bug, but I wouldn't bet on it. It's certainly very hard to argue
+ that the old version was correct.
+- Fixed an incremental collection bug that prevented it from
+ working at all when HBLKSIZE != getpagesize()
+- Changed dynamic_loading.c to include gc_priv.h before testing
+ DYNAMIC_LOADING. SunOS dynamic library scanning
+ must have been broken in 3.4.
+- Object size rounding now adapts to program behavior.
+- Added a workaround (provided by Manuel Serrano and
+ colleagues) to a long-standing SunOS 4.X (and 3.X?) ld bug
+ that I had incorrectly assumed to have been squished.
+ The collector was broken if the text segment size was within
+ 32 bytes of a multiple of 8K bytes, and if the beginning of
+ the data segment contained interesting roots. The workaround
+ assumes a demand-loadable executable. The original may have
+ have "worked" in some other cases.
+- Added dynamic library support under IRIX5.
+- Added support for EMX under OS/2 (thanks to Ari Huttunen).
+
+Version 3.6:
+- fixed a bug in the mark stack growth code that was introduced
+ in 3.4.
+- fixed Makefile to work around DEC AXP compiler tail recursion
+ bug.
+
+Version 3.7:
+- Added a workaround for an HP/UX compiler bug.
+- Fixed another stack clearing performance bug. Reworked
+ that code once more.
+
+Version 4.0:
+- Added support for Solaris threads (which was possible
+ only by reimplementing some fraction of Solaris threads,
+ since Sun doesn't currently make the thread debugging
+ interface available).
+- Added non-threads win32 and win32S support.
+- (Grudgingly, with suitable muttering of obscenities) renamed
+ files so that the collector distribution could live on a FAT
+ file system. Files that are guaranteed to be useless on
+ a PC still have long names. Gc_inline.h and gc_private.h
+ still exist, but now just include gc_inl.h and gc_priv.h.
+- Fixed a really obscure bug in finalization that could cause
+ undetected mark stack overflows. (I would be surprised if
+ any real code ever tickled this one.)
+- Changed finalization code to dynamically resize the hash
+ tables it maintains. (This probably does not matter for well-
+ -written code. It no doubt does for C++ code that overuses
+ destructors.)
+- Added typed allocation primitives. Rewrote the marker to
+ accommodate them with more reasonable efficiency. This
+ change should also speed up marking for GC_malloc allocated
+ objects a little. See gc_typed.h for new primitives.
+- Improved debugging facilities slightly. Allocation time
+ stack traces are now kept by default on SPARC/SUNOS4.
+ (Thanks to Scott Schwartz.)
+- Added better support for small heap applications.
+- Significantly extended cord package. Fixed a bug in the
+ implementation of lazily read files. Printf and friends now
+ have cord variants. Cord traversals are a bit faster.
+- Made ALL_INTERIOR_POINTERS recognition the default.
+- Fixed de so that it can run in constant space, independent
+ of file size. Added simple string searching to cords and de.
+- Added the Hull-Ellis C++ interface.
+- Added dynamic library support for OSF/1.
+ (Thanks to Al Dosser and Tim Bingham at DEC.)
+- Changed argument to GC_expand_hp to be expressed
+ in units of bytes instead of heap blocks. (Necessary
+ since the heap block size now varies depending on
+ configuration. The old version was never very clean.)
+- Added GC_get_heap_size(). The previous "equivalent"
+ was broken.
+- Restructured the Makefile a bit.
+
+Since version 4.0:
+- Changed finalization implementation to guarantee that
+ finalization procedures are called outside of the allocation
+ lock, making direct use of the interface a little less dangerous.
+ MAY BREAK EXISTING CLIENTS that assume finalizers
+ are protected by a lock. Since there seem to be few multithreaded
+ clients that use finalization, this is hopefully not much of
+ a problem.
+- Fixed a gross bug in CORD_prev.
+- Fixed a bug in blacklst.c that could result in unbounded
+ heap growth during startup on machines that do not clear
+ memory obtained from the OS (e.g. win32S).
+- Ported de editor to win32/win32S. (This is now the only
+ version with a mouse-sensitive UI.)
+- Added GC_malloc_ignore_off_page to allocate large arrays
+ in the presence of ALL_INTERIOR_POINTERS.
+- Changed GC_call_with_alloc_lock to not disable signals in
+ the single-threaded case.
+- Reduced retry count in GC_collect_or_expand for garbage
+ collecting when out of memory.
+- Made uncollectable allocations bypass black-listing, as they
+ should.
+- Fixed a bug in typed_test in test.c that could cause (legitimate)
+ GC crashes.
+- Fixed some potential synchronization problems in finalize.c
+- Fixed a real locking problem in typd_mlc.c.
+- Worked around an AIX 3.2 compiler feature that results in
+ out of bounds memory references.
+- Partially worked around an IRIX5.2 beta problem (which may
+ or may not persist to the final release).
+- Fixed a bug in the heap integrity checking code that could
+ result in explicitly deallocated objects being identified as
+ smashed. Fixed a bug in the dbg_mlc stack saving code
+ that caused old argument pointers to be considered live.
+- Fixed a bug in CORD_ncmp (and hence CORD_str).
+- Repaired the OS2 port, which had suffered from bit rot
+ in 4.0. Worked around what appears to be CSet/2 V1.0
+ optimizer bug.
+- Fixed a Makefile bug for target "c++".
+
+Since version 4.1:
+- Multiple bug fixes/workarounds in the Solaris threads version.
+ (It occasionally failed to locate some register contents for
+ marking. It also turns out that thr_suspend and friends are
+ unreliable in Solaris 2.3. Dirty bit reads appear
+ to be unreliable under some weird
+ circumstances. My stack marking code
+ contained a serious performance bug. The new code is
+ extremely defensive, and has not failed in several cpu
+ hours of testing. But no guarantees ...)
+- Added MacOS support (thanks to Patrick Beard.)
+- Fixed several syntactic bugs in gc_c++.h and friends. (These
+ didn't bother g++, but did bother most other compilers.)
+ Fixed gc_c++.h finalization interface. (It didn't.)
+- 64 bit alignment for allocated objects was not guaranteed in a
+ few cases in which it should have been.
+- Added GC_malloc_atomic_ignore_off_page.
+- Added GC_collect_a_little.
+- Added some prototypes to gc.h.
+- Some other minor bug fixes (notably in Makefile).
+- Fixed OS/2 / EMX port (thanks to Ari Huttunen).
+- Fixed AmigaDOS port. (thanks to Michel Schinz).
+- Fixed the DATASTART definition under Solaris. There
+ was a 1 in 16K chance of the collector missing the first
+ 64K of static data (and thus crashing).
+- Fixed some blatant anachronisms in the README file.
+- Fixed PCR-Makefile for upcoming PPCR release.
+
+Since version 4.2:
+- Fixed SPARC alignment problem with GC_DEBUG.
+- Fixed Solaris threads /proc workaround. The real
+ problem was an interaction with mprotect.
+- Incorporated fix from Patrick Beard for gc_c++.h (now gc_cpp.h).
+- Slightly improved allocator space utilization by
+ fixing the GC_size_map mechanism.
+- Integrated some Sony News and MIPS RISCos 4.51
+ patches. (Thanks to Nobuyuki Hikichi of
+ Software Research Associates, Inc. Japan)
+- Fixed HP_PA alignment problem. (Thanks to
+ xjam@cork.cs.berkeley.edu.)
+- Added GC_same_obj and friends. Changed GC_base
+ to return 0 for pointers past the end of large objects.
+ Improved GC_base performance with ALL_INTERIOR_POINTERS
+ on machines with a slow integer mod operation.
+ Added GC_PTR_ADD, GC_PTR_STORE, etc. to prepare
+ for preprocessor.
+- changed the default on most UNIX machines to be that
+ signals are not disabled during critical GC operations.
+ This is still ANSI-conforming, though somewhat dangerous
+ in the presence of signal handlers. But the performance
+ cost of the alternative is sometimes problematic.
+ Can be changed back with a minor Makefile edit.
+- renamed IS_STRING in gc.h, to CORD_IS_STRING, thus
+ following my own naming convention. Added the function
+ CORD_to_const_char_star.
+- Fixed a gross bug in GC_finalize. Symptom: occasional
+ address faults in that function. (Thanks to Anselm
+ Baird-Smith (Anselm.BairdSmith@inria.fr)
+- Added port to ICL DRS6000 running DRS/NX. Restructured
+ things a bit to factor out common code, and remove obsolete
+ code. Collector should now run under SUNOS5 with either
+ mprotect or /proc dirty bits. (Thanks to Douglas Steel
+ (doug@wg.icl.co.uk)).
+- More bug fixes and workarounds for Solaris 2.X. (These were
+ mostly related to putting the collector in a dynamic library,
+ which didn't really work before. Also SOLARIS_THREADS
+ didn't interact well with dl_open.) Thanks to btlewis@eng.sun.com.
+- Fixed a serious performance bug on the DEC Alpha. The text
+ segment was getting registered as part of the root set.
+ (Amazingly, the result was still fast enough that the bug
+ was not conspicuous.) The fix works on OSF/1, version 1.3.
+ Hopefully it also works on other versions of OSF/1 ...
+- Fixed a bug in GC_clear_roots.
+- Fixed a bug in GC_generic_malloc_words_small that broke
+ gc_inl.h. (Reported by Antoine de Maricourt. I broke it
+ in trying to tweak the Mac port.)
+- Fixed some problems with cord/de under Linux.
+- Fixed some cord problems, notably with CORD_riter4.
+- Added DG/UX port.
+ Thanks to Ben A. Mesander (ben@piglet.cr.usgs.gov)
+- Added finalization registration routines with weaker ordering
+ constraints. (This is necessary for C++ finalization with
+ multiple inheritance, since the compiler often adds self-cycles.)
+- Filled the holes in the SCO port. (Thanks to Michael Arnoldus
+ <chime@proinf.dk>.)
+- John Ellis' additions to the C++ support: From John:
+
+* I completely rewrote the documentation in the interface gc_c++.h
+(later renamed gc_cpp.h). I've tried to make it both clearer and more
+precise.
+
+* The definition of accessibility now ignores pointers from an
+finalizable object (an object with a clean-up function) to itself.
+This allows objects with virtual base classes to be finalizable by the
+collector. Compilers typically implement virtual base classes using
+pointers from an object to itself, which under the old definition of
+accessibility prevented objects with virtual base classes from ever
+being collected or finalized.
+
+* gc_cleanup now includes gc as a virtual base. This was enabled by
+the change in the definition of accessibility.
+
+* I added support for operator new[]. Since most (all?) compilers
+don't yet support operator new[], it is conditionalized on
+-DOPERATOR_NEW_ARRAY. The code is untested, but its trivial and looks
+correct.
+
+* The test program test_gc_c++ (later renamed test_cpp.cc)
+tries to test for the C++-specific functionality not tested by the
+other programs.
+- Added <unistd.h> include to misc.c. (Needed for ppcr.)
+- Added PowerMac port. (Thanks to Patrick Beard again.)
+- Fixed "srcdir"-related Makefile problems. Changed things so
+ that all externally visible include files always appear in the
+ include subdirectory of the source. Made gc.h directly
+ includable from C++ code. (These were at Per
+ Bothner's suggestion.)
+- Changed Intel code to also mark from ebp (Kevin Warne's
+ suggestion).
+- Renamed C++ related files so they could live in a FAT
+ file system. (Charles Fiterman's suggestion.)
+- Changed Windows NT Makefile to include C++ support in
+ gc.lib. Added C++ test as Makefile target.
+
+Since version 4.3:
+ - ASM_CLEAR_CODE was erroneously defined for HP
+ PA machines, resulting in a compile error.
+ - Fixed OS/2 Makefile to create a library. (Thanks to
+ Mark Boulter (mboulter@vnet.ibm.com)).
+ - Gc_cleanup objects didn't work if they were created on
+ the stack. Fixed.
+ - One copy of Gc_cpp.h in the distribution was out of
+ synch, and failed to document some known compiler
+ problems with explicit destructor invocation. Partially
+ fixed. There are probably other compilers on which
+ gc_cleanup is miscompiled.
+ - Fixed Makefile to pass C compiler flags to C++ compiler.
+ - Added Mac fixes.
+ - Fixed os_dep.c to work around what appears to be
+ a new and different VirtualQuery bug under newer
+ versions of win32S.
+ - GC_non_gc_bytes was not correctly maintained by
+ GC_free. Fixed. Thanks to James Clark (jjc@jclark.com).
+ - Added GC_set_max_heap_size.
+ - Changed allocation code to ignore blacklisting if it is preventing
+ use of a very large block of memory. This has the advantage
+ that naive code allocating very large objects is much more
+ likely to work. The downside is you might no
+ longer find out that such code should really use
+ GC_malloc_ignore_off_page.
+ - Changed GC_printf under win32 to close and reopen the file
+ between calls. FAT file systems otherwise make the log file
+ useless for debugging.
+ - Added GC_try_to_collect and GC_get_bytes_since_gc. These
+ allow starting an abortable collection during idle times.
+ This facility does not require special OS support. (Thanks to
+ Michael Spertus of Geodesic Systems for suggesting this. It was
+ actually an easy addition. Kumar Srikantan previously added a similar
+ facility to a now ancient version of the collector. At the time
+ this was much harder, and the result was less convincing.)
+ - Added some support for the Borland development environment. (Thanks
+ to John Ellis and Michael Spertus.)
+ - Removed a misfeature from checksums.c that caused unexpected
+ heap growth. (Thanks to Scott Schwartz.)
+ - Changed finalize.c to call WARN if it encounters a finalization cycle.
+ WARN is defined in gc_priv.h to write a message, usually to stdout.
+ In many environments, this may be inappropriate.
+ - Renamed NO_PARAMS in gc.h to GC_NO_PARAMS, thus adhering to my own
+ naming convention.
+ - Added GC_set_warn_proc to intercept warnings.
+ - Fixed Amiga port. (Thanks to Michel Schinz (schinz@alphanet.ch).)
+ - Fixed a bug in mark.c that could result in an access to unmapped
+ memory from GC_mark_from_mark_stack on machines with unaligned
+ pointers.
+ - Fixed a win32 specific performance bug that could result in scanning of
+ objects allocated with the system malloc.
+ - Added REDIRECT_MALLOC.
+
+Since version 4.4:
+ - Fixed many minor and one major README bugs. (Thanks to Franklin Chen
+ (chen@adi.com) for pointing out many of them.)
+ - Fixed ALPHA/OSF/1 dynamic library support. (Thanks to Jonathan Bachrach
+ (jonathan@harlequin.com)).
+ - Added incremental GC support (MPROTECT_VDB) for Linux (with some
+ help from Bruno Haible).
+ - Altered SPARC recognition tests in gc.h and config.h (mostly as
+ suggested by Fergus Henderson).
+ - Added basic incremental GC support for win32, as implemented by
+ Windows NT and Windows 95. GC_enable_incremental is a noop
+ under win32s, which doesn't implement enough of the VM interface.
+ - Added -DLARGE_CONFIG.
+ - Fixed GC_..._ignore_off_page to also function without
+ -DALL_INTERIOR_POINTERS.
+ - (Hopefully) fixed RS/6000 port. (Only the test was broken.)
+ - Fixed a performance bug in the nonincremental collector running
+ on machines supporting incremental collection with MPROTECT_VDB
+ (e.g. SunOS 4, DEC AXP). This turned into a correctness bug under
+ win32s with win32 incremental collection. (Not all memory protection
+ was disabled.)
+ - Fixed some ppcr related bit rot.
+ - Caused dynamic libraries to be unregistered before reregistering.
+ The old way turned out to be a performance bug on some machines.
+ - GC_root_size was not properly maintained under MSWIN32.
+ - Added -DNO_DEBUGGING and GC_dump.
+ - Fixed a couple of bugs arising with SOLARIS_THREADS +
+ REDIRECT_MALLOC.
+ - Added NetBSD/M68K port. (Thanks to Peter Seebach
+ <seebs@taniemarie.solon.com>.)
+ - Fixed a serious realloc bug. For certain object sizes, the collector
+ wouldn't scan the expanded part of the object. (Thanks to Clay Spence
+ (cds@peanut.sarnoff.com) for noticing the problem, and helping me to
+ track it down.)
+
+Since version 4.5:
+ - Added Linux ELF support. (Thanks to Arrigo Triulzi <arrigo@ic.ac.uk>.)
+ - GC_base crashed if it was called before any other GC_ routines.
+ This could happen if a gc_cleanup object was allocated outside the heap
+ before any heap allocation.
+ - The heap expansion heuristic was not stable if all objects had finalization
+ enabled. Fixed finalize.c to count memory in finalization queue and
+ avoid explicit deallocation. Changed alloc.c to also consider this count.
+ (This is still not recommended. It's expensive if nothing else.) Thanks
+ to John Ellis for pointing this out.
+ - GC_malloc_uncollectable(0) was broken. Thanks to Phong Vo for pointing
+ this out.
+ - The collector didn't compile under Linux 1.3.X. (Thanks to Fred Gilham for
+ pointing this out.) The current workaround is ugly, but expected to be
+ temporary.
+ - Fixed a formatting problem for SPARC stack traces.
+ - Fixed some '=='s in os_dep.c that should have been assignments.
+ Fortunately these were in code that should never be executed anyway.
+ (Thanks to Fergus Henderson.)
+ - Fixed the heap block allocator to only drop blacklisted blocks in small
+ chunks. Made BL_LIMIT self adjusting. (Both of these were in response
+ to heap growth observed by Paul Graham.)
+ - Fixed the Metrowerks/68K Mac code to also mark from a6. (Thanks
+ to Patrick Beard.)
+ - Significantly updated README.debugging.
+ - Fixed some problems with longjmps out of signal handlers, especially under
+ Solaris. Added a workaround for the fact that siglongjmp doesn't appear to
+ do the right thing with -lthread under Solaris.
+ - Added MSDOS/djgpp port. (Thanks to Mitch Harris (maharri@uiuc.edu).)
+ - Added "make reserved_namespace" and "make user_namespace". The
+ first renames ALL "GC_xxx" identifiers as "_GC_xxx". The second is the
+ inverse transformation. Note that doing this is guaranteed to break all
+ clients written for the other names.
+ - descriptor field for kind NORMAL in GC_obj_kinds with ADD_BYTE_AT_END
+ defined should be -ALIGNMENT not WORDS_TO_BYTES(-1). This is
+ a serious bug on machines with pointer alignment of less than a word.
+ - GC_ignore_self_finalize_mark_proc didn't handle pointers to very near the
+ end of the object correctly. Caused failures of the C++ test on a DEC Alpha
+ with g++.
+ - gc_inl.h still had problems. Partially fixed. Added warnings at the
+ beginning to hopefully specify the remaining dangers.
+ - Added DATAEND definition to config.h.
+ - Fixed some of the .h file organization. Fixed "make floppy".
+
+Since version 4.6:
+ - Fixed some compilation problems with -DCHECKSUMS (thanks to Ian Searle)
+ - Updated some Mac specific files to synchronize with Patrick Beard.
+ - Fixed a serious bug for machines with non-word-aligned pointers.
+ (Thanks to Patrick Beard for pointing out the problem. The collector
+ should fail almost any conceivable test immediately on such machines.)
+
+Since version 4.7:
+ - Changed a "comment" in a MacOS specific part of mach-dep.c that caused
+ gcc to fail on other platforms.
+
+Since version 4.8
+ - More README.debugging fixes.
+ - Objects ready for finalization, but not finalized in the same GC
+ cycle, could be prematurely collected. This occasionally happened
+ in test_cpp.
+ - Too little memory was obtained from the system for very large
+ objects. That could cause a heap explosion if these objects were
+ not contiguous (e.g. under PCR), and too much of them was blacklisted.
+ - Due to an improper initialization, the collector was too hesitant to
+ allocate blacklisted objects immediately after system startup.
+ - Moved GC_arrays from the data into the bss segment by not explicitly
+ initializing it to zero. This significantly
+ reduces the size of executables, and probably avoids some disk accesses
+ on program startup. It's conceivable that it might break a port that I
+ didn't test.
+ - Fixed EMX_MAKEFILE to reflect the gc_c++.h to gc_cpp.h renaming which
+ occurred a while ago.
+
+Since 4.9:
+ - Fixed a typo around a call to GC_collect_or_expand in alloc.c. It broke
+ handling of out of memory. (Thanks to Patrick Beard for noticing.)
+
+Since 4.10:
+ - Rationalized (hopefully) GC_try_to_collect in an incremental collection
+ environment. It appeared to not handle a call while a collection was in
+ progress, and was otherwise too conservative.
+ - Merged GC_reclaim_or_delete_all into GC_reclaim_all to get rid of some
+ code.
+ - Added Patrick Beard's Mac fixes, with substantial completely untested
+ modifications.
+ - Fixed the MPROTECT_VDB code to deal with large pages and imprecise
+ fault addresses (as on an UltraSPARC running Solaris 2.5). Note that this
+ was not a problem in the default configuration, which uses PROC_VDB.
+ - The DEC Alpha assembly code needed to restore $gp between calls.
+ Thanks to Fergus Henderson for tracking this down and supplying a
+ patch.
+ - The write command for "de" was completely broken for large files.
+ I used the easiest portable fix, which involved changing the semantics
+ so that f.new is written instead of overwriting f. That's safer anyway.
+ - Added README.solaris2 with a discussion of the possible problems of
+ mixing the collector's sbrk allocation with malloc/realloc.
+ - Changed the data segment starting address for SGI machines. The
+ old code failed under IRIX6.
+ - Required double word alignment for MIPS.
+ - Various minor fixes to remove warnings.
+ - Attempted to fix some Solaris threads problems reported by Zhiying Chen.
+ In particular, the collector could try to fork a thread with the
+ world stopped as part of GC_thr_init. It also failed to deal with
+ the case in which the original thread terminated before the whole
+ process did.
+ - Added -DNO_EXECUTE_PERMISSION. This has a major performance impact
+ on the incremental collector under Irix, and perhaps under other
+ operating systems.
+ - Added some code to support allocating the heap with mmap. This may
+ be preferable under some circumstances.
+ - Integrated dynamic library support for HP.
+ (Thanks to Knut Tvedten <knuttv@ifi.uio.no>.)
+ - Integrated James Clark's win32 threads support, and made a number
+ of changes to it, many of which were suggested by Pontus Rydin.
+ This is still not 100% solid.
+ - Integrated Alistair Crooks' support for UTS4 running on an Amdahl
+ 370-class machine.
+ - Fixed a serious bug in explicitly typed allocation. Objects requiring
+ large descriptors where handled in a way that usually resulted in
+ a segmentation fault in the marker. (Thanks to Jeremy Fitzhardinge
+ for helping to track this down.)
+ - Added partial support for GNU win32 development. (Thanks to Fergus
+ Henderson.)
+ - Added optional support for Java-style finalization semantics. (Thanks
+ to Patrick Bridges.) This is recommended only for Java implementations.
+ - GC_malloc_uncollectable faulted instead of returning 0 when out of
+ memory. (Thanks to dan@math.uiuc.edu for noticing.)
+ - Calls to GC_base before the collector was initialized failed on a
+ DEC Alpha. (Thanks to Matthew Flatt.)
+ - Added base pointer checking to GC_REGISTER_FINALIZER in debugging
+ mode, at the suggestion of Jeremy Fitzhardinge.
+ - GC_debug_realloc failed for uncollectable objects. (Thanks to
+ Jeremy Fitzhardinge.)
+ - Explicitly typed allocation could crash if it ran out of memory.
+ (Thanks to Jeremy Fitzhardinge.)
+ - Added minimal support for a DEC Alpha running Linux.
+ - Fixed a problem with allocation of objects whose size overflowed
+ ptrdiff_t. (This now fails unconditionally, as it should.)
+ - Added the beginning of Irix pthread support.
+ - Integrated Xiaokun Zhu's fixes for djgpp 2.01.
+ - Added SGI-style STL allocator support (gc_alloc.h).
+ - Fixed a serious bug in README.solaris2. Multithreaded programs must include
+ gc.h with SOLARIS_THREADS defined.
+ - Changed GC_free so it actually deallocates uncollectable objects.
+ (Thanks to Peter Chubb for pointing out the problem.)
+ - Added Linux ELF support for dynamic libararies. (Thanks again to
+ Patrick Bridges.)
+ - Changed the Borland cc configuration so that the assembler is not
+ required.
+ - Fixed a bug in the C++ test that caused it to fail in 64-bit
+ environments.
+
+Since 4.11:
+ - Fixed ElfW definition in dyn_load.c. (Thanks to Fergus Henderson.)
+ This prevented the dynamic library support from compiling on some
+ older ELF Linux systems.
+ - Fixed UTS4 port (which I apparently mangled during the integration)
+ (Thanks to again to Alistair Crooks.)
+ - "Make C++" failed on Suns with SC4.0, due to a problem with "bool".
+ Fixed in gc_priv.h.
+ - Added more pieces for GNU win32. (Thanks to Timothy N. Newsham.)
+ The current state of things should suffice for at least some
+ applications.
+ - Changed the out of memory retry count handling as suggested by
+ Kenjiro Taura. (This matters only if GC_max_retries > 0, which
+ is no longer the default.)
+ - If a /proc read failed repeatedly, GC_written_pages was not updated
+ correctly. (Thanks to Peter Chubb for diagnosing this.)
+ - Under unlikely circumstances, the allocator could infinite loop in
+ an out of memory situation. (Thanks again to Kenjiro Taura for
+ identifying the problem and supplying a fix.)
+ - Fixed a syntactic error in the DJGPP code. (Thanks to Fergus
+ Henderson for finding this by inspection.) Also fixed a test program
+ problem with DJGPP (Thanks to Peter Monks.)
+ - Atomic uncollectable objects were not treated correctly by the
+ incremental collector. This resulted in weird log statistics and
+ occasional performance problems. (Thanks to Peter Chubb for pointing
+ this out.)
+ - Fixed some problems resulting from compilers that dont define
+ __STDC__. In this case void * and char * were used inconsistently
+ in some cases. (Void * should not have been used at all. If
+ you have an ANSI superset compiler that does not define __STDC__,
+ please compile with -D__STDC__=0. Thanks to Manuel Serrano and others
+ for pointing out the problem.)
+ - Fixed a compilation problem on Irix with -n32 and -DIRIX_THREADS.
+ Also fixed some other IRIX_THREADS problems which may or may not have
+ had observable symptoms.
+ - Fixed an HP PA compilation problem in dyn_load.c. (Thanks to
+ Philippe Queinnec.)
+ - SEGV fault handlers sometimes did not get reset correctly. (Thanks
+ to David Pickens.)
+ - Added a fix for SOLARIS_THREADS on Intel. (Thanks again to David
+ Pickens.) This probably needs more work to become functional.
+ - Fixed struct sigcontext_struct in os_dep.c for compilation under
+ Linux 2.1.X. (Thanks to Fergus Henderson.)
+ - Changed the DJGPP STACKBOTTOM and DATASTART values to those suggested
+ by Kristian Kristensen. These may still not be right, but it is
+ it is likely to work more often than what was there before. They may
+ even be exactly right.
+ - Added a #include <string.h> to test_cpp.cc. This appears to help
+ with HP/UX and gcc. (Thanks to assar@sics.se.)
+ - Version 4.11 failed to run in incremental mode on recent 64-bit Irix
+ kernels. This was a problem related to page unaligned heap segments.
+ Changed the code to page align heap sections on all platforms.
+ (I had mistakenly identified this as a kernel problem earlier.
+ It was not.)
+ - Version 4.11 did not make allocated storage executable, except on
+ one or two platforms, due to a bug in a #if test. (Thanks to Dave
+ Grove for pointing this out.)
+ - Added sparc_sunos4_mach_dep.s to support Sun's compilers under SunOS4.
+ - Added GC_exclude_static_roots.
+ - Fixed the object size mapping algorithm. This shouldn't matter,
+ but the old code was ugly.
+ - Heap checking code could die if one of the allocated objects was
+ larger than its base address. (Unsigned underflow problem. Thanks
+ to Clay Spence for isolating the problem.)
+ - Added RS6000 (AIX) dynamic library support and fixed STACK_BOTTOM.
+ (Thanks to Fred Stearns.)
+ - Added Fergus Henderson's patches for improved robustness with large
+ heaps and lots of blacklisting.
+ - Added Peter Chubb's changes to support Solaris Pthreads, to support
+ MMAP allocation in Solaris, to allow Solaris to find dynamic libraries
+ through /proc, to add malloc_typed_ignore_off_page, and a few other
+ minor features and bug fixes.
+ - The Solaris 2 port should not use sbrk. I received confirmation from
+ Sun that the use of sbrk and malloc in the same program is not
+ supported. The collector now defines USE_MMAP by default on Solaris.
+ - Replaced the djgpp makefile with Gary Leavens' version.
+ - Fixed MSWIN32 detection test.
+ - Added Fergus Henderson's patches to allow putting the collector into
+ a DLL under GNU win32.
+ - Added Ivan V. Demakov's port to Watcom C on X86.
+ - Added Ian Piumarta's Linux/PowerPC port.
+ - On Brian Burton's suggestion added PointerFreeGC to the placement
+ options in gc_cpp.h. This is of course unsafe, and may be controversial.
+ On the other hand, it seems to be needed often enough that it's worth
+ adding as a standard facility.
+
+Since 4.12:
+ - Fixed a crucial bug in the Watcom port. There was a redundant decl
+ of GC_push_one in gc_priv.h.
+ - Added FINALIZE_ON_DEMAND.
+ - Fixed some pre-ANSI cc problems in test.c.
+ - Removed getpagesize() use for Solaris. It seems to be missing in one
+ or two versions.
+ - Fixed bool handling for SPARCCompiler version 4.2.
+ - Fixed some files in include that had gotten unlinked from the main
+ copy.
+ - Some RS/6000 fixes (missing casts). Thanks to Toralf Foerster.
+ - Fixed several problems in GC_debug_realloc, affecting mostly the
+ FIND_LEAK case.
+ - GC_exclude_static_roots contained a buggy unsigned comparison to
+ terminate a loop. (Thanks to Wilson Ho.)
+ - CORD_str failed if the substring occurred at the last possible position.
+ (Only affects cord users.)
+ - Fixed Linux code to deal with RedHat 5.0 and integrated Peter Bigot's
+ os_dep.c code for dealing with various Linux versions.
+ - Added workaround for Irix pthreads sigaction bug and possible signal
+ misdirection problems.
+Since alpha1:
+ - Changed RS6000 STACKBOTTOM.
+ - Integrated Patrick Beard's Mac changes.
+ - Alpha1 didn't compile on Irix m.n, m < 6.
+ - Replaced Makefile.dj with a new one from Gary Leavens.
+ - Added Andrew Stitcher's changes to support SCO OpenServer.
+ - Added PRINT_BLACK_LIST, to allow debugging of high densities of false
+ pointers.
+ - Added code to debug allocator to keep track of return address
+ in GC_malloc caller, thus giving a bit more context.
+ - Changed default behavior of large block allocator to more
+ aggressively avoid fragmentation. This is likely to slow down the
+ collector when it succeeds at reducing space cost.
+ - Integrated Fergus Henderson's CYGWIN32 changes. They are untested,
+ but needed for newer versions.
+ - USE_MMAP had some serious bugs. This caused the collector to fail
+ consistently on Solaris with -DSMALL_CONFIG.
+ - Added Linux threads support, thanks largely to Fergus Henderson.
+Since alpha2:
+ - Fixed more Linux threads problems.
+ - Changed default GC_free_space_divisor to 3 with new large block allocation.
+ (Thanks to Matthew Flatt for some measurements that suggest the old
+ value sometimes favors space too much over time.)
+ - More CYGWIN32 fixes.
+ - Integrated Tyson-Dowd's Linux-M68K port.
+ - Minor HP PA and DEC UNIX fixes from Fergus Henderson.
+ - Integrated Christoffe Raffali's Linux-SPARC changes.
+ - Allowed for one more GC fixup iteration after a full GC in incremental
+ mode. Some quick measurements suggested that this significantly
+ reduces pause times even with smaller GC_RATE values.
+ - Moved some more GC data structures into GC_arrays. This decreases
+ pause times and GC overhead, but makes debugging slightly less convenient.
+ - Fixed namespace pollution problem ("excl_table").
+ - Made GC_incremental a constant for -DSMALL_CONFIG, hopefully shrinking
+ that slightly.
+ - Added some win32 threads fixes.
+ - Integrated Ivan Demakov and David Stes' Watcom fixes.
+ - Various other minor fixes contributed by many people.
+ - Renamed config.h to gcconfig.h, since config.h tends to be used for
+ many other things.
+ - Integrated Matthew Flatt's support for 68K MacOS "far globals".
+ - Fixed up some of the dynamic library Makefile targets for consistency
+ across platforms.
+ - Fixed a USE_MMAP typo that caused out-of-memory handling to fail
+ on Solaris.
+ - Added code to test.c to test thread creation a bit more.
+ - Integrated GC_win32_free_heap, as suggested by Ivan Demakov.
+ - Fixed Solaris 2.7 stack base finding problem. (This may actually
+ have been done in an earlier alpha release.)
+Since alpha3:
+ - Fixed MSWIN32 recognition test, which interfered with cygwin.
+ - Removed unnecessary gc_watcom.asm from distribution. Removed
+ some obsolete README.win32 text.
+ - Added Alpha Linux incremental GC support. (Thanks to Philipp Tomsich
+ for code for retrieving the fault address in a signal handler.)
+ Changed Linux signal handler context argument to be a pointer.
+ - Took care of some new warnings generated by the 7.3 SGI compiler.
+ - Integrated Phillip Musumeci's FreeBSD/ELF fixes.
+ - -DIRIX_THREADS was broken with the -o32 ABI (typo in gc_priv.h>
+
+Since 4.13:
+ - Fixed GC_print_source_ptr to not use a prototype.
+ - generalized CYGWIN test.
+ - gc::new did the wrong thing with PointerFreeGC placement.
+ (Thanks to Rauli Ruohonen.)
+ - In the ALL_INTERIOR_POINTERS (default) case, some callee-save register
+ values could fail to be scanned if the register was saved and
+ reused in a GC frame. This showed up in verbose mode with gctest
+ compiled with an unreleased SGI compiler. I vaguely recall an old
+ bug report that may have been related. The bug was probably quite old.
+ (The problem was that the stack scanning could be deferred until
+ after the relevant frame was overwritten, and the new save location
+ might be outside the scanned area. Fixed by more eager stack scanning.)
+ - PRINT_BLACK_LIST had some problems. A few source addresses were garbage.
+ - Replaced Makefile.dj and added -I flags to cord make targets.
+ (Thanks to Gary Leavens.)
+ - GC_try_to_collect was broken with the nonincremental collector.
+ - gc_cleanup destructors could pass the wrong address to
+ GC_register_finalizer_ignore_self in the presence of multiple
+ inheritance. (Thanks to Darrell Schiebel.)
+ - Changed PowerPC Linux stack finding code.
+
+Since 4.14alpha1
+ - -DSMALL_CONFIG did not work reliably with large (> 4K) pages.
+ Recycling the mark stack during expansion could result in a size
+ zero heap segment, which confused things. (This was probably also an
+ issue with the normal config and huge pages.)
+ - Did more work to make sure that callee-save registers were scanned
+ completely, even with the setjmp-based code. Added USE_GENERIC_PUSH_REGS
+ macro to facilitate testing on machines I have access to.
+ - Added code to explicitly push register contents for win32 threads.
+ This seems to be necessary. (Thanks to Pierre de Rop.)
+
+Since 4.14alpha2
+ - changed STACKBOTTOM for DJGPP (Thanks to Salvador Eduardo Tropea).
+
+Since 4.14
+ - Reworked large block allocator. Now uses multiple doubly linked free
+ lists to approximate best fit.
+ - Changed heap expansion heuristic. Entirely free blocks are no longer
+ counted towards the heap size. This seems to have a major impact on
+ heap size stability; the old version could expand the heap way too
+ much in the presence of large block fragmentation.
+ - added -DGC_ASSERTIONS and some simple assertions inside the collector.
+ This is mainlyt for collector debugging.
+ - added -DUSE_MUNMAP to allow the heap to shrink. Suupported on only
+ a few UNIX-like platforms for now.
+ - added GC_dump_regions() for debugging of fragmentation issues.
+ - Changed PowerPC pointer alignment under Linux to 4. (This needs
+ checking by someone who has one. The suggestions came to me via a
+ rather circuitous path.)
+ - Changed the Linux/Alpha port to walk the data segment backwards until
+ it encounters a SIGSEGV. The old way to find the start of the data
+ segment broke with a recent release.
+ - cordxtra.c needed to call GC_REGISTER_FINALIZER instead of
+ GC_register_finalizer, so that it would continue to work with GC_DEBUG.
+ - allochblk sometimes cleared the wrong block for debugging purposes
+ when it dropped blacklisted blocks. This could result in spurious
+ error reports with GC_DEBUG.
+ - added MACOS X Server support. (Thanks to Andrew Stone.)
+ - Changed the Solaris threads code to ignore stack limits > 8 MB with
+ a warning. Empirically, it is not safe to access arbitrary pages
+ in such large stacks. And the dirty bit implementation does not
+ guarantee that none of them will be accessed.
+ - Integrated Martin Tauchmann's Amiga changes.
+ - Integrated James Dominy's OpenBSD/SPARC port.
+
+Since 5.0alpha1
+ - Fixed bugs introduced in alpha1 (OpenBSD & large block initialization).
+ - Added -DKEEP_BACK_PTRS and backptr.h interface. (The implementation
+ idea came from Al Demers.)
+
+Since 5.0alpha2
+ - Added some highly incomplete code to support a copied young generation.
+ Comments on nursery.h are appreciated.
+ - Changed -DFIND_LEAK, -DJAVA_FINALIZATION, and -DFINALIZE_ON_DEMAND,
+ so the same effect could be obtained with a runtime switch. This is
+ a step towards standardizing on a single dynamic GC library.
+ - Significantly changed the way leak detection is handled, as a consequence
+ of the above.
+
+Since 5.0 alpha3
+ - Added protection fault handling patch for Linux/M68K from Fergus
+ Henderson and Roman Hodek.
+ - Removed the tests for SGI_SOURCE in new_gc_alloc.h. This was causing that
+ interface to fail on nonSGI platforms.
+ - Changed the Linux stack finding code to use /proc, after changing it
+ to use HEURISTIC1. (Thanks to David Mossberger for pointing out the
+ /proc hook.)
+ - Added HP/UX incremental GC support and HP/UX 11 thread support.
+ Thread support is currently still flakey.
+ - Added basic Linux/IA64 support.
+ - Integrated Anthony Green's PicoJava support.
+ - Integrated Scott Ananian's StrongARM/NetBSD support.
+ - Fixed some fairly serious performance bugs in the incremental
+ collector. These have probably been there essentially forever.
+ (Mark bits were sometimes set before scanning dirty pages.
+ The reclaim phase unnecessarily dirtied full small object pages.)
+ - Changed the reclaim phase to ignore nearly full pages to avoid
+ touching them.
+ - Limited GC_black_list_spacing to roughly the heap growth increment.
+ - Changed full collection triggering heuristic to decrease full GC
+ frequency by default, but to explicitly trigger full GCs during
+ heap growth. This doesn't always improve things, but on average it's
+ probably a win.
+ - GC_debug_free(0, ...) failed. Thanks to Fergus Henderson for the
+ bug report and fix.
+
+Since 5.0 alpha4
+ - GC_malloc_explicitly_typed and friends sometimes failed to
+ initialize first word.
+ - Added allocation routines and support in the marker for mark descriptors
+ in a type structure referenced by the first word of an object. This was
+ introduced to support gcj, but hopefully in a way that makes it
+ generically useful.
+ - Added GC_requested_heapsize, and inhibited collections in nonincremental
+ mode if the actual used heap size is less than what was explicitly
+ requested.
+ - The Solaris pthreads version of GC_pthread_create didn't handle a NULL
+ attribute pointer. Solaris thread support used the wrong default thread
+ stack size. (Thanks to Melissa O'Neill for the patch.)
+ - Changed PUSH_CONTENTS macro to no longer modify first parameter.
+ This usually doesn't matter, but it was certainly an accident waiting
+ to happen ...
+ - Added GC_register_finalizer_no_order and friends to gc.h. They're
+ needed by Java implementations.
+ - Integrated a fix for a win32 deadlock resulting from clock() calling
+ malloc. (Thanks to Chris Dodd.)
+ - Integrated Hiroshi Kawashima's port to Linux/MIPS. This was designed
+ for a handheld platform, and may or may not be sufficient for other
+ machines.
+ - Fixed a va_arg problem with the %c specifier in cordprnt.c. It appears
+ that this was always broken, but recent versions of gcc are the first to
+ report the (statically detectable) bug.
+ - Added an attempt at a more general solution to dlopen races/deadlocks.
+ GC_dlopen now temporarily disables collection. Still not ideal, but ...
+ - Added -DUSE_I686_PREFETCH, -DUSE_3DNOW_PREFETCH, and support for IA64
+ prefetch instructions. May improve performance measurably, but I'm not
+ sure the code will run correctly on processors that don't support the
+ instruction. Won't build except with very recent gcc.
+ - Added caching for header lookups in the marker. This seems to result
+ in a barely measurable performance gain. Added support for interleaved
+ lookups of two pointers, but unconfigured that since the performance
+ gain is currently near zero, and it adds to code size.
+ - Changed Linux DATA_START definition to check both data_start and
+ __data_start, since nothing else seems to be portable.
+ - Added -DUSE_LD_WRAP to optionally take advantage of the GNU ld function
+ wrapping mechanism. Probably currently useful only on Linux.
+ - Moved some variables for the scratch allocator into GC_arrays, on
+ Martin Hirzel's suggestion.
+ - Fixed a win32 threads bug that caused the collector to not look for
+ interior pointers from one of the thread stacks without
+ ALL_INTERIOR_POINTERS. (Thanks to Jeff Sturm.)
+ - Added Mingw32 support. (Thanks again to Jeff Sturm for the patch.)
+ - Changed the alpha port to use the generic register scanning code instead
+ of alpha_mach_dep.s. Alpha_mach_dep.s doesn't look for pointers in fp
+ registers, but gcc sometimes spills pointers there. (Thanks to Manuel
+ Serrano for helping me debug this by email.) Changed the IA64 code to
+ do something similar for similar reasons.
+
+[5.0alpha5 doesn't really exist, but it may have escaped.]
+
+Since 5.0alpha6:
+ - -DREDIRECT_MALLOC was broken in alpha6. Fixed.
+ - Cleaned up gc_ccp.h slightly, thus also causing the HP C++ compiler to
+ accept it.
+ - Removed accidental reference to dbg_mlc.c, which caused dbg_mlc.o to be
+ linked into every executable.
+ - Added PREFETCH to bitmap marker. Changed it to use the header cache.
+ - GC_push_marked sometimes pushed one object too many, resulting in a
+ segmentation fault in GC_mark_from_mark_stack. This was probably an old
+ bug. It finally showed up in gctest on win32.
+ - Gc_priv.h erroneously #defined GC_incremental to be TRUE instead of FALSE
+ when SMALL_CONFIG was defined. This was no doubt a major performance bug for
+ the default win32 configuration.
+ - Removed -DSMALL_CONFIG from NT_MAKEFILE. It seemed like an anchronism now
+ that the average PC has 64MB or so.
+ - Integrated Bryce McKinley's patches for linux threads and dynamic loading
+ from the libgcj tree. Turned on dynamic loading support for Linux/PPC.
+ - Changed the stack finding code to use environ on HP/UX. (Thanks
+ to Gustavo Rodriguez-Rivera for the suggestion.) This should probably
+ be done on other platforms, too. Since I can't test those, that'll
+ wait until after 5.0.
+
+Since 5.0alpha7:
+ - Fixed threadlibs.c for linux threads. -DUSE_LD_WRAP was broken and
+ -ldl was omitted. Fixed Linux stack finding code to handle
+ -DUSE_LD_WRAP correctly.
+ - Added MSWIN32 exception handler around marker, so that the collector
+ can recover from root segments that are unmapped during the collection.
+ This caused occasional failures under Windows 98, and may also be
+ an issue under Windows NT/2000.
+
+Since 5.0
+ - Fixed a gc.h header bug which showed up under Irix. (Thanks to
+ Dan Sullivan.)
+ - Fixed a typo in GC_double_descr in typd_mlc.c.
+ This probably could result in objects described by array descriptors not
+ getting traced correctly. (Thanks to Ben Hutchings for pointing this out.)
+ - The block nearly full tests in reclaim.c were not correct for 64 bit
+ environments. This could result in unnecessary heap growth under unlikely
+ conditions.
+
+Since 5.1
+ - dyn_load.c declared GC_scratch_last_end_ptr as an extern even if it
+ was defined as a macro. This prevented the collector from building on
+ Irix.
+ - We quietly assumed that indirect mark descriptors were never 0.
+ Our own typed allocation interface violated that. This could result
+ in segmentation faults in the marker with typed allocation.
+ - Fixed a _DUSE_MUNMAP bug in the heap block allocation code.
+ (Thanks to Ben Hutchings for the patch.)
+ - Taught the collector about VC++ handling array operator new.
+ (Thanks again to Ben Hutchings for the patch.)
+ - The two copies of gc_hdrs.h had diverged. Made one a link to the other
+ again.
+
+Since 5.2 (A few 5.2 patches are not in 6.0alpha1)
+ - Fixed _end declaration for OSF1.
+ - There were lots of spurious leak reports in leak detection mode, caused
+ by the fact that some pages were not being swept, and hence unmarked
+ objects weren't making it onto free lists. (This bug dated back to 5.0.)
+ - Fixed a typo in the liblinuxgc.so Makefile rule.
+ - Added the GetExitCodeThread to Win32 GC_stop_world to (mostly) work
+ around a Windows 95 GetOpenFileName problem. (Thanks to Jacob Navia.)
+
+Since 5.3
+ - Fixed a typo that prevented compilation with -DUSE_3DNOW_PREFETCH.
+ (Thanks to Shawn Wagner for actually testing this.)
+ - Fixed GC_is_thread_stack in solaris_threads.c. It forgot to return a value
+ in the common case. I wonder why nobody noticed?
+ - Fixed another silly syntax problem in GC_double_descr. (Thanks to
+ Fergus Henderson for finding it.)
+ - Fixed a GC_gcj_malloc bug: It tended to release the allocator lock twice.
+
+Since 5.4 (A few 5.3 patches are not in 6.0alpha2)
+ - Added HP/PA prefetch support.
+ - Added -DDBG_HDRS_ALL and -DSHORT_DBG_HDRS to reduce the cost and improve
+ the reliability of generating pointer backtrace information, e.g. in
+ the Bigloo environment.
+ - Added parallel marking support (-DPARALLEL_MARK). This currently
+ works only under IA32 and IA64 Linux, but it shouldn't be hard to adapt
+ to other platforms. This is intended to be a lighter-weight (less
+ new code, probably not as scalable) solution than the work by Toshio Endo
+ et al, at the University of Tokyo. A number of their ideas were
+ reused, though the code wasn't, and the underlying data structure
+ is significantly different. In particular, we keep the global mark
+ stack as a single shared data structure, but most of the work is done
+ on smaller thread-local mark stacks.
+ - Changed GC_malloc_many to be cheaper, and to require less mutual exclusion
+ with -DPARALLEL_MARK.
+ - Added full support for thread local allocation under Linux
+ (-DTHREAD_LOCAL_ALLOC). This is a thin veneer on GC_malloc_many, and
+ should be easily portable to other platforms, especially those that
+ support pthreads.
+ - CLEAR_DOUBLE was not always getting invoked when it should have been.
+ - GC_gcj_malloc and friends used different out of memory handling than
+ everything else, probably because I forgot about one when I implemented
+ the other. They now both call GC_oom_fn(), not GC_oom_action().
+ - Integrated Jakub Jelinek's fixes for Linux/SPARC.
+ - Moved GC_objfreelist, GC_aobjfreelist, and GC_words_allocd out of
+ GC_arrays, and separately registered the first two as excluded roots.
+ This makes code compiled with gc_inl.h less dependent on the
+ collector version. (It would be nice to remove the inclusion of
+ gc_priv.h by gc_inl.h completely, but we're not there yet. The
+ locking definitions in gc_priv.h are still referenced.)
+ This change was later coniditoned on SEPARATE_GLOBALS, which
+ is not defined by default, since it involves a performance hit.
+ - Register GC_obj_kinds separately as an excluded root region. The
+ attempt to register it with GC_arrays was usually failing. (This wasn't
+ serious, but seemed to generate some confusion.)
+ - Moved backptr.h to gc_backptr.h.
+
+Since 6.0alpha1
+ - Added USE_MARK_BYTES to reduce the need for compare-and-swap on platforms
+ for which that's expensive.
+ - Fixed a locking bug ib GC_gcj_malloc and some locking assertion problems.
+ - Added a missing volatile to OR_WORD and renamed the parameter to
+ GC_compare_and_swap so it's not a C++ reserved word. (Thanks to
+ Toshio Endo for pointing out both of those.)
+ - Changed Linux dynamic library registration code to look at /proc/self/maps
+ instead of the rld data structures when REDIRECT_MALLOC is defined.
+ Otherwise some of the rld data data structures may be prematurely garbage
+ collected. (Thanks to Eric Benson for helping to track this down.)
+ - Fixed USE_LD_WRAP a bit more, so it should now work without threads.
+ - Renamed XXX_THREADS macros to GC_XXX_THREADS for namespace correctness.
+ Tomporarily added some backward compatibility definitions. Renamed
+ USE_LD_WRAP to GC_USE_LD_WRAP.
+ - Many MACOSX POWERPC changes, some additions to the gctest output, and
+ a few minor generic bug fixes. (Thanks to Dietmar Planitzer.)
+
+Since 6.0 alpha2
+ - Fixed the /proc/self/maps code to not seek, since that apparently is not
+ reliable across all interesting kernels.
+ - Fixed some compilation problems in the absence of PARALLEL_MARK
+ (introduced in alpha2).
+ - Fixed an algorithmic problem with PARALLEL_MARK. If work needs to
+ be given back to the main mark "stack", the BOTTOM entries of the local
+ stack should be given away, not the top ones. This has substantial
+ performance impact, especially for > 2 processors, from what I can tell.
+ - Extracted gc_lock.h from gc_priv.h. This should eventually make it a
+ bit easier to avoid including gc_priv.h in clients.
+ - Moved all include files to include/ and removed duplicate links to the
+ same file. The old scheme was a bad idea because it was too easy to get the
+ copies out of sync, and many systems don't support hard links.
+ Unfortunately, it's likely that I broke some of the non-Unix Makefiles in
+ the process, although I tried to update them appropriately.
+ - Removed the partial support for a copied nursery. It's not clear that
+ this would be a tremendous win, since we don't consistently lose to
+ generational copying collectors. And it would significantly complicate
+ many things. May be reintroduced if/when it really turns out to win.
+ - Removed references to IRIX_JDK_THREADS, since I believe there never
+ were and never will be any clients.
+ - Added some code to linux_threads.c to possibly support HPUX threads
+ using the Linux code. Unfortunately, it doesn't work yet, and is
+ currently disabled.
+ - Added support under Linux/X86 for saving the call chain, both in (debug)
+ objects for client debugging, and in GC_arrays._last_stack for GC
+ debugging. This was previously supported only under Solaris. It is
+ not enabled by default under X86, since it requires that code be compiled
+ to explicitly dave frame pointers on the call stack. (With gcc this
+ currently happens by default, but is often turned off explicitly.)
+ To turn it on, define SAVE_CALL_CHAIN.
+
+Since 6.0 alpha3
+ - Moved up the detection of mostly full blocks to the initiatiation of the
+ sweep phase. This eliminates some lock conention in the PARALLEL_MARK case,
+ as multiple threads try to look at mostly full blocks concurrently.
+ - Restored the code in GC_malloc_many that grabs a prefix of the global
+ free list. This avoids the case in which every GC_malloc_many call
+ tries and fails to allocate a new heap block, and the returns a single
+ object from the global free list.
+ - Some minor fixes in new_hblk.c. (Attempted to build free lists in order
+ of increasing addresses instead of decreasing addresses for cache performance
+ reasons. But this seems to be only a very minor gain with -DEAGER_SWEEP,
+ and a loss in other cases. So the change was backed out.)
+ - Fixed some of the documentation. (Thanks in large part to Fergus
+ Henderson.)
+ - Fixed the Linux USE_PROC_FOR_LIBRARIES code to deal with apps that perform
+ large numbers of mmaps. (Thanks to Eric Benson.) Also fixed that code to
+ deal with short reads.
+ - Added GC_get_total_bytes().
+ - Fixed leak detection mode to avoid spurious messages under linuxthreads.
+ (This should also now be easy for the other supported threads packages.
+ But the code is tricky enough that I'm hesitant to do it without being able
+ to test. Everything allocated in the GC thread support itself should be
+ explicitly deallocated.)
+ - Made it possible (with luck) to redirect malloc to GC_local_malloc.
+
+Since 6.0 alpha4
+ - Changed the definition of GC_pause in linux_threads.c to use a volatile
+ asm. Some versions of gcc apparently optimize away writes to local volatile
+ variables. This caused poor locking behaviour starting at about
+ 4 processors.
+ - Added GC_start_blocking(), GC_end_blocking() calls and wrapper for sleep
+ to linux_threads.c.
+ The first two calls could be used to generally avoid sending GC signals to
+ blocked threads, avoiding both premature wakeups and unnecessary overhead.
+ - Fixed a serious bug in thread-local allocation. At thread termination,
+ GC_free could get called on small integers. Changed the code for thread
+ termination to more efficiently return left-over free-lists.
+ - Integrated Kjetil Matheussen's BeOS support.
+ - Rearranged the directory structure to create the doc and tests
+ subdirectories.
+ - Sort of integrated Eric Benson's patch for OSF1. This provided basic
+ OSF1 thread support by suitably extending hpux_irix_threads.c. Based
+ on earlier email conversations with David Butenhof, I suspect that it
+ will be more reliable in the long run to base this on linux_threads.c
+ instead. Thus I attempted to patch up linux_threads.c based on Eric's code.
+ The result is almost certainly broken, but hopefully close enough that
+ someone with access to a machine can pick it up.
+ - Integrated lots of minor changes from the NetBSD distribution. (These
+ were supplied by David Brownlee. I'm not sure about the original
+ authors.)
+ - Hacked a bit more on the HP/UX thread-support in linux_threads.c. It
+ now appears to work in the absence of incremental collection. Renamed
+ hpux_irix_threads.c back to irix_threads.c, and removed the attempt to
+ support HPUX there.
+ - Changed gc.h to define _REENTRANT in cases in which it should already
+ have been defined. It is still safer to also define it on the command
+ line.
+
+Since 6.0alpha5:
+ - Changed the definition of DATASTART on ALPHA and IA64, where data_start
+ and __data_start are not defined by earlier versions of glibc. This might
+ need to be fixed on other platforms as well.
+ - Changed the way the stack base and backing store base are found on IA64.
+ This should now remain reliable on future kernels. But since it relies
+ on /proc, it will no longer work in the simulated NUE environment.
+ - Made the call to random() in dbg_mlc.c with -DKEEP_BACK_PTRS dependent
+ on the OS. On non-Unix systems, rand() should be used instead. Handled
+ small RAND_MAX. (Thanks to Peter Ross for pointing this out.)
+ - Fixed the cord make rules to create the cord subdirectory, if necessary.
+ (Thanks to Doug Moen.)
+ - Changed fo_object_size calculation in finalize.c. Turned finalization
+ of nonheap object into a no-op. Removed anachronism from GC_size()
+ implementation.
+ - Changed GC_push_dirty call in solaris_threads.c to GC_push_selected.
+ It was missed in a previous renaming. (Thanks to Vladimir Tsichevski
+ for pointing this out.)
+ - Arranged to not not mask SIGABRT in linux_threads.c. (Thanks to Bryce
+ McKinlay.)
+ - Added GC_no_dls hook for applications that want to register their own
+ roots.
+ - Integrated Kjetil Matheussen's Amiga changes.
+ - Added FREEBSD_STACKBOTTOM. Changed the X86/FreeBSD port to use it.
+ (Thanks to Matthew Flatt.)
+ - Added pthread_detach interception for platforms supported by linux_threads.c
+ and irix_threads.c. Should also be added for Solaris?
+ - Changed the USE_MMAP code to check for the case in which we got the
+ high end of the address space, i.e. mem_ptr + mem_sz == 0. It appears
+ that this can happen under Solaris 7. It seems to be allowed by what
+ I would claim is an oversight in the mmap specification. (Thanks to Toshio
+ Endo for pointing out the problem.)
+ - Cleanup of linux_threads.c. Some code was originally cloned from
+ irix_threads.c and now unnecessary. Some comments were obviously wrong.
+ - (Mostly) fixed a longstanding problem with setting of dirty bits from
+ a signal handler. In the presence of threads, dirty bits could get lost,
+ since the etting of a bit in the bit vector was not atomic with respect
+ to other updates. The fix is 100% correct only for platforms for which
+ GC_test_and_set is defined. The goal is to make that all platforms with
+ thread support. Matters only if incremental GC and threads are both
+ enabled.
+ - made GC_all_interior_pointers (a.k.a. ALL_INTERIOR_POINTERS) an
+ initialization time, instead of build-time option. This is a
+ nontrivial, high risk change. It should slow down the code measurably
+ only if MERGE_SIZES is not defined, which is a very nonstandard
+ configuration.
+ - Added doc/README.environment, and implemented what it describes. This
+ allows a number of additional configuration options to be set through
+ the environment. It documents a few previously undocumented options.
+ - Integrated Eric Benson's leak testing improvements.
+ - Removed the option to throw away the beginning of each page (DISCARD_WORDS).
+ This became less and less useful as processors enforce stricter alignment.
+ And it hadn't been tested in ages, and was thus probably broken anyway.
+
+Since 6.0alpha6:
+ - Added GC_finalizer_notifier. Fixed GC_finalize_on_demand. (The variable
+ actually wasn't being tested at the right points. The build-time flag
+ was.)
+ - Added Tom Tromey's S390 Linux patch.
+ - Added code to push GC_finalize_now in GC_push_finalizer_structures.
+ (Thanks to Matthew Flatt.)
+ - Added GC_push_gc_structures() to push all GC internal roots.
+ - Integrated some FreeBSD changes from Matthew Flatt.
+ - It looks like USRSTACK is not always correctly defined under Solaris.
+ Hacked gcconfig.h to attempt to work around the problem. The result
+ is not well tested. (Thanks again to Matthew Flatt for pointing this
+ out. The gross hack is mine. - HB)
+ - Added Ji-Yong Chung's win32 threads and C++ fixes.
+ - Arranged for hpux_test_and_clear.s to no longer be needed or built.
+ It was causing build problems with gas, and it's not clear this is
+ better than the pthreads alternative on this platform.
+ - Some MINGW32 fixes from Hubert Garavel.
+ - Added Initial Hitachi SH4 port from Kaz Kojima.
+ - Ported thread-local allocation and parallel mark code to HP/UX on PA_RISC.
+ - Made include/gc_mark.h more public and separated out the really private
+ pieces. This is probably still not quite sufficient for clients that
+ want to supply their own kind of type information. But it's a start.
+ This involved lots of identifier renaming to make it namespace clean.
+ - Added GC_dont_precollect for clients that need complete control over
+ the root set.
+ - GC_is_visible didn't do the right thing with gcj objects. (Not that
+ many people are likely to care, but ...)
+ - Don't redefine read with GC_USE_LD_WRAP.
+ - Initial port to LINUX/HP_PA. Incremental collection and threads are not
+ yet supported. (Incremental collection should work if you have the
+ right kernel. Threads may work with a sufficiently patched pthread
+ library.)
+ - Changed gcconfig.h to recognize __i386__ as an alternative to i386 in
+ many places. (Thanks to Benjamin Lerman.)
+ - Made win32_threads.c more tolerant of detaching a thread that it didn't
+ know about. (Thanks to Paul Nash.)
+ - Added Makefile.am and configure.in from gcc to the distribution, with
+ minimal changes. For the moment, those are just placeholders. In the
+ future, we're planning to switch to a GNU-style build environment for
+ Un*x-like systems, though the old Makefile will remain as a backup.
+ - Turned off STUBBORN_ALLOC by default, and added it back as a Makefile
+ option.
+ - Redistributed some functions between malloc.c and mallocx.c, so that
+ simple statically linked apps no longer pull in mallocx.o.
+ - Changed large object allocation to clear the first and last few words
+ of each block before releassing the lock. Otherwise the marker could see
+ objects with nonsensical type descriptors.
+ - Fixed a couple of subtle problems that could result in not recognizing
+ interior pointers from the stack. (I believe these were introduced
+ in 6.0alpha6.)
+ - GC_debug_free_inner called GC_free, which tried to reacquire the
+ allocator lock, and hence deadlocked. (DBG_HDRS_ALL probably never worked
+ with threads?)
+ - Fixed several problems with back traces. Accidental references to a free
+ list could cause the free list pointer to be overwritten by a back pointer.
+ There seemed to be some problems with the encoding of root and finalizer
+ references.
+
+Since 6.0alpha7:
+ - Changed GC_debug_malloc_replacement and GC_debug_realloc_replacement
+ so that they compile under Irix. (Thanks to Dave Love.)
+ - Updated powerpc_macosx_mach_dep.s so that it works if the collector
+ is in a dynamic library. (Thanks to Andrew Begel.)
+ - Transformed README.debugging into debugging.html, updating and
+ expanding it in the process. Added gcdescr.html and tree.html
+ from the web site to the GC distribution.
+ - Fixed several problems related to PRINT_BLACK_LIST. This involved
+ restructuring some of the marker macros.
+ - Fixed some problems with the sizing of objects with debug information.
+ Finalization was broken KEEP_BACK_PTRS or PRINT_BLACK_LIST. Reduced the
+ object size with SHORT_DEBUG_HDRS by another word.
+ - The "Needed to allocate blacklisted ..." warning had inadvertently
+ been turned off by default, due to a buggy test in allchblk.c. Turned
+ it back on.
+ - Removed the marker macros to deal with 2 pointers in interleaved fashion.
+ They were messy and the performance improvement seemed minimal. We'll
+ leave such scheduling issues to the compiler.
+ - Changed Linux/PowerPC test to also check for __powerpc__ in response
+ to a discussion on the gcc mailing list.
+ - On Matthew Flatt's suggestion removed the "static" from the jmp_buf
+ declaration in GC_generic_push_regs. This was causing problems in
+ systems that register all of their own roots. It looks far more correct
+ to me without the "static" anyway.
+ - Fixed several problems with thread local allocation of pointerfree or
+ typed objects. The collector was reclaiming thread-local free lists, since
+ it wasn't following the link fields.
+ - There was apparently a long-standing race condition related to multithreaded
+ incremental collection. A collection could be started and a thread stopped
+ between the memory unprotect system call and the setting of the
+ corresponding dirt bit. I believe this did not affect Solaris or PCR, which
+ use a different dirty-bit implementation. Fixed this by installing
+ signal handlers with sigaction instead of signal, and disabling the thread
+ suspend signal while in the write-protect handler. (It is unclear
+ whether this scenario ever actually occurred. I found it while tracking
+ down the following:)
+ - Incremental collection did not cooperate correctly with the PARALLEL_MARK
+ implementation of GC_malloc_many or the local_malloc primitves. It still
+ doesn't work well, but it shouldn't lose memory anymore.
+ - Integrated some changes from the gcc source tree that I had previously
+ missed. (Thanks to Bryce McKinley for the reminder/diff.)
+ - Added Makefile.direct as a copy of the default Makefile, which would
+ normally be overwritten if configure is run.
+ - Changed the gc.tar target in Makefile.direct to embed the version number
+ in the gc directory name. This will affect future tar file distributions.
+ - Changed the Irix dynamic library finding code to no longer try to
+ eliminate writable text segments under Irix6.x, since that is probably no
+ longer necessary, and can apparently be unsafe on occasion. (Thanks to
+ Shiro Kawai for pointing this out.)
+ - GC_cleanup with GC_DEBUG enabled passed a real object base address to
+ GC_debug_register_finalizer_ignore_self, which expected a pointer past the
+ debug header. Call GC_register_finalizer_ignore_self instead, even with
+ debugging enabled. (Thanks to Jean-Daniel Fekete for catching this.)
+ - The collector didn't build with call chain saving enabled but NARGS=0.
+ (Thanks to Maarten Thibaut.)
+ - Fixed up the GNU-style build files enough so that they work in some
+ obvious cases.
+ - Added initial port to Digital Mars compiler for win32. (Thanks to Walter
+ Bright.)
+
+Since 6.0alpha8:
+ - added README.macros.
+ - Made gc.mak a symbolic link to work around winzip's tendency to ignore
+ hard links.
+ - Simplified the setting of NEED_FIND_LIMIT in os_dep.c, possibly breaking
+ it on untested platforms.
+ - Integrated initial GNU HURD port. (Thanks to Chris Lingard and Igor
+ Khavkine.)
+ - A few more fixes for Digital Mars compiler (Walter Bright).
+ - Fixed gcc version recognition. Renamed OPERATOR_NEW_ARRAY to
+ GC_OPERATOR_NEW_ARRAY. Changed GC_OPERATOR_NEW_ARRAY to be the default.
+ It can be overridden with -DGC_NO_OPERATOR_NEW_ARRAY. (Thanks to
+ Cesar Eduardo Barros.)
+ - Changed the byte size to free-list mapping in thread local allocation
+ so that size 0 allocations are handled correctly.
+ - Fixed Linux/MIPS stackbottom for new toolchain. (Thanks to Ryan Murray.)
+ - Changed finalization registration to invoke GC_oom_fn when it runs out
+ of memory.
+ - Removed lvalue cast in finalize.c. This caused some debug configurations
+ not to build with some non-gcc compilers.
+
+Since 6.0alpha9:
+ - Two more bug fixes for KEEP_BACK_PTRS and DBG_HDRS_ALL.
+ - Fixed a stack clearing problem that resulted in SIGILL with a
+ misaligned stack pointer for multithreaded SPARC builds.
+ - Integrated another HURD patch (thanks to Igor Khavkine).
+
+Since 6.0:
+ - Non-debug, atomic allocations could result in bogus smashed object
+ reports with debugging on. (Thanks to Patrick Doyle for the small
+ test case.)
+ - Fixed GC_get_register_stack_base (Itanium only) to work around a glibc
+ 2.2.4 bug.
+ - Initial port to HP/UX on Itanium. Thread support and both 32 and 64
+ bit ABIs appear to work. Parallel mark support doesn't yet, due to
+ some inline assembly code issues. Thread local allocation does appear
+ to work.
+ - ifdef'ed out glibc2.1/Itanium workaround. I suspect nobody is using
+ that combination anymore.
+ - Added a patch to make new_gc_alloc.h usable with gcc3.0. (Thanks to
+ Dimitris Vyzovitis for the patch.)
+ - Debugged 64-bit support on HP/UX PA-RISC.
+ - Turned on dynamic loading support for FreeBSD/ELF. (Thanks to Peter
+ Housel.)
+ - Unregistering of finalizers with debugging allocation was broken.
+ (Thanks to Jani Kajala for the test case.)
+ - Old finalizers were not returned correctly from GC_debug_register_finalizer.
+ - Disabled MPROTECT_VDB for Linux/M68K based on a report that it doesn't work.
+ - Cleaned up some statistics gathering code in reclaim.c (Thanks to Walter
+ Bright.)
+ - Added some support for OpenBSD/ELF/Linux. (Thanks to Suzuki Toshiya.)
+ - Added Jakub Jelinek's patch to use dl_iterate_phdr for dynamic library
+ traversal to dyn_load.c. Changed it to weakly reference dl_iterate_phdr,
+ so that the old code is stilll used with old versions of glibc.
+ - Cleaned up feature test macros for various threads packages and
+ integrated (partially functional) FreeBSD threads code from Loren Rittle.
+ It's likely that the cleanup broke something, since it touched lots of
+ code. It's also likelly that it fixed some unreported bugs in the
+ less common thread implementations, since some of the original code
+ didn't stand up to close scrutiny. Support for the next pthreads
+ implementation should be easier to add.
+
+Since 6.1alpha1:
+ - No longer wrap read by default in multithreaded applications. It was
+ pointed out on the libgcj list that this holds the allocation lock for
+ way too long if the read blocks. For now, reads into the heap are
+ broken with incremental collection. It's possible to turn this back on
+ if you make sure that read calls don't block (e.g. by calling select
+ first).
+ - Fix ifdef in Solaris_threads.h to refer to GC_SOLARIS_THREADS.
+ - Added check for environment variable GC_IGNORE_GCJ_INFO.
+ - Added printing of stop-the-world GC times if GC_PRINT_STATS environment
+ variable is set.
+ - The calloc definition in leak_detector.h was missing parentheses, and
+ realloc was missing a second argument to GC_REALLOC.
+ (Thanks to Elrond (elrond<at>samba-tng.org).)
+ - Added GC_PRINT_BACK_HEIGHT environment variable and associated
+ code, mostly in the new file backgraph.c. See doc/README.environment.
+ - Added -DUSE_GLOBAL_ALLOC to work around a Windows NT issue. (Thanks to
+ Jonathan Clark.)
+ - Integrated port to NEC EWS4800 (MIPS-based workstation, with somewhat
+ different address-space layout). This may help for other machines with
+ holes in the data segment. (Thanks to Hironori Sakamoto.)
+ - Changed the order in which GC_push_roots and friends push things onto
+ the mark stack. GC_push_all calls need to come first, since we can't
+ necessarily recovere if those overflow the mark stack. (Thanks to
+ Matthew Flatt for tracking down the problem.)
+ - Some minor cleanups to mostly support the Intel compiler on Linux/IA64.
+
+Since 6.1 alpha2:
+ - Minor cleanup on the gcconfig.h section for SPARC.
+ - Minor fix to support Intel compiler for I386/Linux. (Thanks to Sven
+ Hartrumpf.)
+ - Added SPARC V9 (64-bit) support. (Thanks to Jeff Sturm.)
+ - Restructured the way in which we determine whether or not to keep
+ call stacks for debug allocation. By default SAVE_CALL_COUNT is
+ now zero on all platforms. Added SAVE_CALL_NARGS parameters.
+ If possible, use execinfo.h to capture call stack. (This should
+ add support for a number of new platforms, though often at
+ considerable runtime expense.)
+ - Try to print symbolic information for call stacks. On Linux, we
+ do this with a combination of execinfo.h and running addr2line in
+ a separate process. This is both much more expensive and much more
+ useful. Amazingly, it seems to be fast enough for most purposes.
+ - Redefined strdup if -DREDIRECT_MALLOC is given.
+ - Changed incremental collector and MPROTECT_VDB implementation so that,
+ under favorable conditions, pointerfree objects are not protected.
+ Added GC_incremental_protection_needs() to determine ahead of time whether
+ pointerfree objects may be protected. Replaced GC_write_hint() with
+ GC_remove_protection().
+ - Added test for GC_ENABLE_INCREMENTAL environment variable.
+ - Made GC_time_limit runtime configurable. Added GC_PAUSE_TIME_TARGET
+ environment variable.
+ - Eliminated GC_page_sz, a duplicate of GC_page_size.
+ - Caused the Solaris and Irix thread creation primitives to call
+ GC_init_inner().
+
+Since 6.1alpha3:
+ - Fixed typo in sparc_mach_dep.S, preventing the 64-bit version from
+ building. Increased 64-bit heap size limit in test.c slightly, since
+ a functional SPARC collector seems to slightly exceed the old limits.
+ (Thanks again to Jeff Sturm.)
+ - Use NPRGREG in solaris_threads.c, thus printing all registers if things
+ go wrong.
+ - Added GC_MARKERS environment variable to allow use of a single marker
+ thread on an MP without confusing the lock implementation.
+ - Collect much less aggressively in incremental mode with GC_TIME_UNLIMITED.
+ This is really a purely generational mode, and we can afford to
+ postpone the collection until the heap is (nearly) full.
+ - Remove read() wrapper for MPROTECT_VDB. It was causing more harm than
+ good. It is often no longer needed if system calls avoid writing to
+ pointerfull heap objects.
+ - Fix MACOSX test in gcconfig.h. (Thanks to John Clements.)
+ - Change GC_test_and_set so that it consistently has one argument.
+ Add spaces to ::: in powerpc assembly code in gc_locks.h.
+ (Thanks to Ryan Murray.)
+ - Fixed a formatting error in dbg_mlc.c. Added prototype to GC_abort()
+ declaration. (Thanks to Michael Smith.)
+ - Removed "source" argument to GC_find_start(). Eliminate GC_FIND_START().
+ - Added win32 recognition code in configure.in. Changed some of the
+ dllimport/export defines in gc.h. (Thanks to Adam Megacz.)
+ - GC_malloc_many didn't set hb_last_reclaimed when it called
+ GC_reclaim_generic. (I'm not sure this matters much, but ...)
+ - Allocating uncollectable objects with debug information sometimes
+ allocated objects that were one byte too small, since uncollectable
+ objects don't have the extra byte added at the end. (Thanks to
+ Wink Saville for pointing this out.)
+ - Added a bit more assertion checking to make sure that gcj objects
+ on free lists never have a nonzero second word.
+ - Replaced BCC_MAKEFILE with an up-to-date one. (Thanks to
+ Andre Leiradella.)
+ - Upgraded libtool, cinfigure.in and some related files to hopefully
+ support NetBSD/SPARC. (Thanks to Adrian Bunk.) Unfortunately,
+ libtool 1.4.2 seemed to be buggy due to missing quotes in several
+ "test" invocations. Fixed those in the ltmain.sh script.
+ - Some win32-specific patches, including the introduction of
+ GC_CreateThread. (Thanks to Adam Megacz.)
+ - Merged in gcj changes from Anthony Green to support embedded systems.
+ - Tried to consistently rename preprocessed assembly files with a capital
+ .S extension.
+ - Use alpha_mach_dep.S on ALPHA again. It doesn't really matter, but this
+ makes our distribution consistent with the gcc one, avoiding future merge
+ problems.
+ - Move GET_MEM definition into gcconfig.h. Include gcconfig.h slightly
+ later in gc_priv.h to avoid forward references to ptr_t.
+ - Add some testing of local allocation to test.c.
+ - Change definition of INVALID_QTID in specific.h. The -1 value was used
+ inconsistently, and too likely to collide with a valid stack address.
+ Some general clean-up of specific.[ch]. Added assertions. (Thanks
+ to Michael Smith for tracking down an intermittent bug to this
+ general area. I'm not sure it has been squashed yet, however.)
+ - On Pthread systems it was not safe to call GC_malloc() between fork()
+ and exec(). According to the applicable standards, it doesn't appear
+ to be safe to call malloc() or many other libc functions either, thus
+ it's not clear this is fixable. Added experimental support for
+ -DHANDLE_FORK in linux_threads.c which tries to support it. It may
+ succeed if libc does the right thing. I'm not sure whether it does.
+ (Thanks to Kenneth Schalk for pointing out this issue.)
+ - Documented thread local allocation primitives to require an
+ explicit GC_init call. GC_init_parallel is no longer declared to
+ be a constructor function, since that isn't portable and often
+ seems to lead to initialization order problems.
+ - Changed gc_cpp.cc and gc_cpp.h in one more attempt to make them
+ compatible with Visual C++ 6. (Thanks to Wink Saville for the
+ patch.)
+ - Some more patches for Linux on HP PA-RISC.
+ - Added include/gc_allocator.h. It implements (hopefully) standard
+ conforming (as opposed to SGI-style) allocators that allocate
+ collectable (gc_allocator) or GC-traceable, but not collectable
+ (traceable_allocator) objects. This borrows heavily from libstc++,
+ which borrows heavily from the SGI implementation, this part of
+ which was written by Matt Austern. Changed test_cpp.cc to very
+ minimally test this.
+ - On Linux/X86, retry mmap with a different start argument. That should
+ allow the collector to use more (closer to 3GB) of the address space.
+ (Thanks to Jeffrey Mark Siskind for tracking this down.)
+ - Force 64 bit alignment with GCJ support. (Reflects Bryce McKinley's
+ patch to the gcc tree.)
+ - Refined the choice of sa_handler vs. sa_sigaction in GC_dirty_init
+ to accomodate some glibc5 systems. (Thanks to Dan Fandrich for the
+ patch.)
+ - Compensated for the fact that current versions of glibc set
+ __libc_stack_end incorrectly on Linux/IA64 while initialization code
+ is running. This could cause the collector to miss 16 bytes of
+ the memory stack if GC_malloc or friends where called before main().
+ - Mostly integrated Takis Psarogiannakopoulos' port to DG/UX Inix 86.
+ This will probably take another iteration to work, since his
+ patch conflicted with the libtool upgrade.
+ - Added README.arm.cross containing some information about cross-
+ compiling to an ARM processor from Margaret Fleck.
+
+Since 6.1alpha4:
+ - Added GC_finalizer_mem_freed, and changed some of the code that
+ decided on heap expansion to look at it. Memory explicitly
+ deallocated by finalizers essentially needs to be counted as reclaimed
+ by the GC. Otherwise there are cases in which the heap can grow
+ unboundedly. (Thanks to Mark Reichert for the test case.)
+ - Integrated Adam Megacz patches to not scan dynamic libraries if
+ we are compiling with gcc on win32. Otherwise we need structured
+ exception handling to deal with asynchronously unmapped root
+ segments, and gcc doesn't directly support that.
+ - Integrated Anthony Green's patch to support Wine.
+ - GC_OPERATOR_NEW_ARRAY was misspelled OPERATOR_NEW_ARRAY in several
+ places, including gc_cpp.cc. (Thanks to Wink Saville for pointing
+ this out.)
+ - Integrated Loren James Rittle's Alpha FreeBSD patches. In
+ response to Richard Henderson's suggestion, these also
+ changed the declarations of symbols like _end on many platforms to
+ that they wouldn't mistakenly be declared as short data symbols.
+ - Integrated changes from the Debian distribution. (Thanks to Ryan Murray
+ for pointing these out.) Fix C++ comments in POWERPC port. Add ARM32
+ incremental GC support. Get rid of USE_GENERIC_PUSH_REGS for alpha/Linux,
+ this time for real. Use va_copy to get rid of cord printf problems
+ (finally).
+ - Close file descriptor used to count cpus. Thanks to Jeff Sturm for
+ pointing out the omission.
+ - Don't just drop gcj free lists in GC_start_reclaim, since that can
+ eventually cause the marker to see a bogus mark descriptor in the
+ dropped objects. The usual symptom was a very intermittent segmentation
+ fault in the marker. This mattered only if one of the GC_gcj_malloc
+ variants was used. (Thanks to Michael Smith, Jeff Sturm, Bryce
+ McKinley and Tom Tromey for helping to track this down.)
+ - Fixed Linux and Solaris/64 SPARC configuration. (Thanks to David Miller,
+ Jeff Sturm, Tom Tromey, and Christian Joensson.)
+ - Fixed a typo in strdup definition. (Thanks to Gerard A Allan.)
+ - Changed Makefile.direct to invoke $(CC) to assemble alpha_mach_dep.S.
+ This is needed on Linux. I'm not sure whether it's better or worse
+ on Tru64.
+ - Changed gc_cpp.h once more to declare operator new and friends only in
+ a Microsoft environment. This may need further fine tuning. (Thanks to
+ Johannes Schmidt for pointing out that the older code breaks on gcc3.0.4.)
+ - Don't ever override strdup if it's already macro defined. (Thanks to
+ Adnan Ali for pointing out the problem.)
+ - Changed gc_cpp.h yet again to also overload placement new. Due to the
+ C++ overloading rules, the other overloaded new operations otherwise hide
+ placement new, which causes many STL uses to break. (Thanks to Reza
+ Shahidi for reporting this, and to Matt Austern for proposing a fix.)
+ - Integrated cygwin pthreads support from Dan Bonachea.
+ - Turn on DYNAMIC_LOADING for NetBSD. (Thanks to Krister Walfridsson.)
+ - Changed printing code to print more complete GC times.
+ - Applied Mark Mitchell's Irix patch to correct some bitrot.
+ - Clarified which object-printing routines in dbg_mlc.c should hold
+ the allocation lock. Restructured the code to allow reasonable object
+ printing with -DREDIRECT_MALLOC.
+ - Fix the Linux mmap code to always start with 0x1000 as the initial hint.
+ Minor patches for 64-bit AIX, particularly to STACKBOTTOM.
+ (Thanks again to Jeffrey Mark Siskind.)
+ - Renamed "SUSPENDED" flag for Solaris threads support to avoid a conflict
+ with a system header. (Thanks to Philp Brown.)
+ - Cause win32_threads.c to handle an out of range stack pointer correctly,
+ though currently with a warning. (Thanks to Jonathan Clark for
+ observing that win32 applications may temporarily use the stack
+ pointer for other purposes, and suggesting a fix. Unfortunately, it's
+ not clear that there is a complete solution to this problem.)
+
+Since 6.1alpha5:
+ - Added GC_MAXIMUM_HEAP_SIZE environment variable.
+ - Fix configure.in for MIPS/LINUX. (Thanks to H.J. Lu.)
+ - Double page hash table size for -DLARGE_CONFIG.
+ - Integrated Bo Thorsen's X86-64 support.
+ - STACKBOTTOM definition for LINUX/MIPS was partially changed back.
+ (Thanks to H.J. Lu and Hiroshi Kawashima for resolving this.)
+ - Replaced all occurrences of LINUX_DATA_START in gcconfig.h with
+ SEARCH_FOR_DATA_START. It doesn't hurt to falll back to a search.
+ And __data_start doesn't seem to get defined correctly of the GC
+ library is loaded with LD_PRELOAD, e.g. for leak detection.
+ - If the GC_find_leak environment variable is set, do a
+ atexit(GC_gcollect) to give us at least one chance to detect leaks.
+ This may report some very benign leaks, but ...
+ - Addeded REDIRECT_FREE. It's necessary if we want leak detection with
+ LD_PRELOAD.
+ - Defer printing of leaked objects, as for smashed objects.
+ - Fixed process and descriptor leak in GC_print_callers. Try for
+ line number even if we got function name.)
+ - Ported parallel GC support and thread local allocation to Alpha.
+ Not yet well-tested.
+ - Added GC_DUMP_REGULARLY and added finalization statistics to GC_dump().
+ - Fixed Makefile.am to mention alpha_mach_dep.S instead of the defunct
+ alpha_mach_dep.s. (Thanks to Fergus Henderson.)
+ - Incorporated a change to new_gc_alloc.h, suggested by Johannes Schmidt,
+ which should make it work with gcc3.1. (I would still like to encourage
+ use of gc_allocator.h instead.)
+ - Use alpha_mach_dep.S only on Linux. (It's not clear that this is
+ optimal, but it otherwise didn't build on Tru64. Thanks to Fergus
+ Henderson.)
+ - Added ifdef to guard free() in os_dep.c. Otherwise we get a
+ compilation error on Irix. (Thanks to Dai Sato.)
+ - Added an experimental version of GC_memalign to mallocx.c. This can't
+ always work, since we don't handle alignment requests in the hblk-level
+ allocator, and we can't handle arbitrary pointer displacements unless
+ GC_all_interior_pointers is enabled. But it should work for alignment
+ requests up to HBLKSIZE. This is not yet documented in the standard
+ places.
+ - Finally debugged the OSF1/Tru64 thread support. This needs more testing,
+ since I needed to add a somewhat unconvincing workaround for signal
+ delivery issues that I don't yet completely understand. But it does
+ pass my tests, even in parallel GC mode. Incremental GC support is
+ disabled if thread support is enabled, due to the signal issues.
+ - Eliminated name-space-incorrect definition of _cdecl from gc_cpp.h.
+ - Added GC_debug_malloc_replacement and GC_debug_realloc_replacement
+ declarations to gc.h. On IA64, this is required for REDIRECT_MALLOC
+ to work correctly with these.
+ - Fixed Linux USE_PROC_FOR_LIBRARIES to work with a 64-bit /proc format.
+
+Since 6.1:
+ - Guard the test for GC_DUMP_REGULARLY in misc.c with
+ "#ifndef NO_DEBUGGING". Otherwise it fails to build with NO_DEBUGGING
+ defined. (Thanks to Manuel Serrano.)
+ - Message about retrying suspend signals was incorrectly generated even when
+ flag was not set.
+ - Cleaned up MACOSX/NEXT root registration code. There was apparently a
+ separate ifdef case in GC_register_data_segments() for no reason.
+ - Removed MPROTECT_VDB for MACOSX port, based on one negative report.
+ - Arrange for gc.h and friends to be correctly installed with GNU-style
+ "make install".
+ - Enable the GNU-style build facility include C++ support in the library
+ with --enable-cplusplus. (Thanks to Thomas Maier for some of the patch.)
+ - Mark from GC_thread_key in linux_threads.c, in case that's allocated
+ from the garbage collected heap, as it is with our own thread-specific
+ storage implementation. (Thanks to Jeff Sturm.)
+ - Mark all free list header blocks if they are heap allocated. This avoids
+ some unnecessary tracing. And it remains correct if we clear the
+ root set. (Thanks to Jeff Sturm for identifying the bug.)
+ - Improved S390/Linux support. Add S390/Linux 64-bit support. (Thanks
+ to Ulrich Weigand.)
+ - Corrected the spelling of GC_{M,C}ALLOC_EXPLICTLY_TYPED to
+ GC_{M,C}ALLOC_EXPLICITLY_TYPED in gc_typed.h. This is technically
+ an interface change. Based on the fact that nobody reported this,
+ I suspect/hope there were no clients.
+ - Cleaned up gc_typed.h so that (1) it adds an extern "C" declaration
+ when appropriate, (2) doesn't generate references to undefined internal
+ macros, and (3) allows easier manual construction of descriptors.
+ - Close the file descriptor used by GC_print_address_map().
+ - Set the "close-on-exec" bit for various file descriptors maintained
+ for the collector's internal use.
+ - Added a hack to find memory segments owned by the system allocator
+ under win32. Based on my tests, this tends to eventually find all
+ segments, though it may take a while. There appear to be cleaner,
+ but slower solutions under NT/XP. But they rely on an API that's
+ unsupported under 9X.
+ - Changed Linux PowerPC stack finding to LINUX_STACKBOTTOM. (Thanks
+ to Akira Tagoh for pointing out that HEURISTIC1 doesn't work on
+ 64-bit kernels.)
+ - Added GC_set_free_space_divisor to avoid some Windows dll issues.
+ - Added FIXUP_POINTER, POINTER_SHIFT, POINTER_MASK to allow preprocessing
+ of candidate pointers for tagging, etc.
+ - Always lock around GC_notify_full_gc(). Simplified code for
+ invoking GC_notify_full_gc().
+ - Changed the way DATASTART is defined on FreeBSD to be robust against
+ an unmapped page after etext. (Thanks to Hironori Sakamoto for
+ tracking down the intermittent failure.)
+ - Made GC_enable() and GC_disable() official. Deprecated direct update
+ of GC_dont_gc. Changed GC_gcollect to be a noop when garbage collection
+ is disabled.
+ - Call GC_register_dynamic_libraries before stopping the world on Linux,
+ in order to avoid a potential deadlock due to the dl_iterate_phdr lock.
+ - Introduced a more general mechanism for platform-dependent code to
+ decide whether the main data segment should be handled separately
+ from dynamic libraries, or registered by GC_register_dynamic_libraries.
+ The latter is more reliable and easier on Linux with dl_iterate_phdr.
+
+Since 6.2alpha1:
+ - Fixed the completely broken FreeBSD code in 6.2alpha1. (Thanks to
+ Hironori Sakamoto for the patch.)
+ - Changed IRIX reference in dbg_mlc.c to IRIX5. (Thanks to Marcus Herbert.)
+ - Attempted to work around the problems with .S filenames and the SGI
+ compiler. (Reported by several people. Untested.)
+ - Worked around an HP/UX make issue with the GNU-style build process.
+ - Fixed the --enable-cplusplus build machinery to allow builds without
+ a C++ compiler. (That was always the intent ...)
+ - Changed the debugging allocation macros to explicitly pass the return
+ address for Linux and XXXBSD on hardware for which we can't get stack
+ traces. Use __builtin_return_address(0) to generate it when possible.
+ Some of the configuration work was cleaned up (good) and moved to gc.h
+ (bad, but necessary). This should make leak detection more useful
+ on a number of platforms. (Thanks to Fabian Thylman for the suggestion.)
+ - Fixed compilation problems in dbg_mlc.c with GC_ADD_CALLER.
+ - Bumped revision number for dynamic library.
+
+Since 6.2alpha2:
+ - Don't include execinfo.h in os_dep.c when it's not needed, and may not exist.
+
+Since 6.2alpha3:
+ - Use LINUX_STACKBOTTOM for >= glibc2.2 on Linux/MIPS. (See Debian bug
+ # 177204)
+ - Integrated Jeff Sturm and Jesse Rosenstock's MACOSX threads patches.
+ - Integrated Grzegorz Jakacki's substantial GNU build patch. "Make dist"
+ should now work for the GNU build process. Documentation files
+ are installed under share/gc.
+ - Tweaked gc_cpp.h to again support the Borland compiler. (Thanks to
+ Rene Girard for pointing out the problems.)
+ - Updated BCC_MAKEFILE (thanks to Rene Girard).
+ - Added GC_ASSERT check for minimum thread stack size.
+ - Added --enable-gc-assertions.
+ - Added some web documentation to the distribution. Updated it in the
+ process.
+ - Separate gc_conf_macros.h from gc.h.
+ - Added generic GC_THREADS client-defined macro to set the appropriate
+ GC_XXX_THREADS internal macro. (gc_config_macros.h.)
+ - Add debugging versions of _ignore_off_page allocation primitves.
+ - Moved declarations of GC_make_closure and GC_debug_invoke_finalizer
+ from gc.h to gc_priv.h.
+ - Reset GC_fail_count even if only a small allocation succeeds.
+ - Integrated Brian Alliet's patch for dynamic library support on Darwin.
+ - gc_cpp.h's gc_cleanup destructor called GC_REGISTER_FINALIZER_IGNORE_SELF
+ when it should have called the lower case version, since it was
+ explicitly computing a base pointer.
+
+To do:
+ - MacOSX thread support still appears to be a bit unreliable.
+ - A dynamic libgc.so references dlopen unconditionally, but doesn't link
+ against libdl.
+ - GC_proc_fd for Solaris is not correctly updated in response to a
+ fork() call. Thus incremental collection in the child won't work
+ correctly. (Thanks to Ben Cottrell for pointing this out.)
+ - --enable-redirect-malloc is mostly untested and known not to work
+ on some platforms.
+ - There seem to be outstanding issues on Solaris/X86, possibly with
+ finding the data segment starting address. Information/patches would
+ be appreciated.
+ - Very large root set sizes (> 16 MB or so) could cause the collector
+ to abort with an unexpected mark stack overflow. (Thanks again to
+ Peter Chubb.) NOT YET FIXED. Workaround is to increase the initial
+ size.
+ - The SGI version of the collector marks from mmapped pages, even
+ if they are not part of dynamic library static data areas. This
+ causes performance problems with some SGI libraries that use mmap
+ as a bitmap allocator. NOT YET FIXED. It may be possible to turn
+ off DYNAMIC_LOADING in the collector as a workaround. It may also
+ be possible to conditionally intercept mmap and use GC_exclude_static_roots.
+ The real fix is to walk rld data structures, which looks possible.
+ - Incremental collector should handle large objects better. Currently,
+ it looks like the whole object is treated as dirty if any part of it
+ is.
+
--- /dev/null
+This is an attempt to acknowledge early contributions to the garbage
+collector. Later contributions should instead be mentioned in
+README.changes.
+
+HISTORY -
+
+ Early versions of this collector were developed as a part of research
+projects supported in part by the National Science Foundation
+and the Defense Advance Research Projects Agency.
+
+The garbage collector originated as part of the run-time system for
+the Russell programming language implementation. The first version of the
+garbage collector was written primarily by Al Demers. It was then refined
+and mostly rewritten, primarily by Hans-J. Boehm, at Cornell U.,
+the University of Washington, Rice University (where it was first used for
+C and assembly code), Xerox PARC, SGI, and HP Labs. However, significant
+contributions have also been made by many others.
+
+Some other contributors:
+
+More recent contributors are mentioned in the modification history in
+README.changes. My apologies for any omissions.
+
+The SPARC specific code was originally contributed by Mark Weiser.
+The Encore Multimax modifications were supplied by
+Kevin Kenny (kenny@m.cs.uiuc.edu). The adaptation to the IBM PC/RT is largely
+due to Vernon Lee, on machines made available to Rice by IBM.
+Much of the HP specific code and a number of good suggestions for improving the
+generic code are due to Walter Underwood.
+Robert Brazile (brazile@diamond.bbn.com) originally supplied the ULTRIX code.
+Al Dosser (dosser@src.dec.com) and Regis Cridlig (Regis.Cridlig@cl.cam.ac.uk)
+subsequently provided updates and information on variation between ULTRIX
+systems. Parag Patel (parag@netcom.com) supplied the A/UX code.
+Jesper Peterson(jep@mtiame.mtia.oz.au), Michel Schinz, and
+Martin Tauchmann (martintauchmann@bigfoot.com) supplied the Amiga port.
+Thomas Funke (thf@zelator.in-berlin.de(?)) and
+Brian D.Carlstrom (bdc@clark.lcs.mit.edu) supplied the NeXT ports.
+Douglas Steel (doug@wg.icl.co.uk) provided ICL DRS6000 code.
+Bill Janssen (janssen@parc.xerox.com) supplied the SunOS dynamic loader
+specific code. Manuel Serrano (serrano@cornas.inria.fr) supplied linux and
+Sony News specific code. Al Dosser provided Alpha/OSF/1 code. He and
+Dave Detlefs(detlefs@src.dec.com) also provided several generic bug fixes.
+Alistair G. Crooks(agc@uts.amdahl.com) supplied the NetBSD and 386BSD ports.
+Jeffrey Hsu (hsu@soda.berkeley.edu) provided the FreeBSD port.
+Brent Benson (brent@jade.ssd.csd.harris.com) ported the collector to
+a Motorola 88K processor running CX/UX (Harris NightHawk).
+Ari Huttunen (Ari.Huttunen@hut.fi) generalized the OS/2 port to
+nonIBM development environments (a nontrivial task).
+Patrick Beard (beard@cs.ucdavis.edu) provided the initial MacOS port.
+David Chase, then at Olivetti Research, suggested several improvements.
+Scott Schwartz (schwartz@groucho.cse.psu.edu) supplied some of the
+code to save and print call stacks for leak detection on a SPARC.
+Jesse Hull and John Ellis supplied the C++ interface code.
+Zhong Shao performed much of the experimentation that led to the
+current typed allocation facility. (His dynamic type inference code hasn't
+made it into the released version of the collector, yet.)
+
--- /dev/null
+Copyright (c) 1993-1994 by Xerox Corporation. All rights reserved.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+
+Permission is hereby granted to use or copy this program
+for any purpose, provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is granted,
+provided the above notices are retained, and a notice that the code was
+modified is included with the above copyright notice.
+
+Please send bug reports to Hans-J. Boehm (Hans_Boehm@hp.com or
+boehm@acm.org).
+
+This is a string packages that uses a tree-based representation.
+See cord.h for a description of the functions provided. Ec.h describes
+"extensible cords", which are essentially output streams that write
+to a cord. These allow for efficient construction of cords without
+requiring a bound on the size of a cord.
+
+More details on the data structure can be found in
+
+Boehm, Atkinson, and Plass, "Ropes: An Alternative to Strings",
+Software Practice and Experience 25, 12, December 1995, pp. 1315-1330.
+
+A fundamentally similar "rope" data structure is also part of SGI's standard
+template library implementation, and its descendents, which include the
+GNU C++ library. That uses reference counting by default.
+There is a short description of that data structure at
+http://reality.sgi.com/boehm/ropeimpl.html . (The more official location
+http://www.sgi.com/tech/stl/ropeimpl.html is missing a figure.)
+
+All of these are descendents of the "ropes" in Xerox Cedar.
+
+de.c is a very dumb text editor that illustrates the use of cords.
+It maintains a list of file versions. Each version is simply a
+cord representing the file contents. Nonetheless, standard
+editing operations are efficient, even on very large files.
+(Its 3 line "user manual" can be obtained by invoking it without
+arguments. Note that ^R^N and ^R^P move the cursor by
+almost a screen. It does not understand tabs, which will show
+up as highlighred "I"s. Use the UNIX "expand" program first.)
+To build the editor, type "make cord/de" in the gc directory.
+
+This package assumes an ANSI C compiler such as gcc. It will
+not compile with an old-style K&R compiler.
+
+Note that CORD_printf iand friends use C functions with variable numbers
+of arguments in non-standard-conforming ways. This code is known to
+break on some platforms, notably PowerPC. It should be possible to
+build the remainder of the library (everything but cordprnt.c) on
+any platform that supports the collector.
+
--- /dev/null
+[Original version supplied by Xiaokun Zhu <xiaokun@aero.gla.ac.uk>]
+[This version came mostly from Gary Leavens. ]
+
+Look first at Makefile.dj, and possibly change the definitions of
+RM and MV if you don't have rm and mv installed.
+Then use Makefile.dj to compile the garbage collector.
+For example, you can do:
+
+ make -f Makefile.dj test
+
+All the tests should work fine.
+
--- /dev/null
+The garbage collector looks at a number of environment variables which are
+then used to affect its operation. These are examined only on Un*x-like
+platforms.
+
+GC_INITIAL_HEAP_SIZE=<bytes> - Initial heap size in bytes. May speed up
+ process start-up.
+
+GC_MAXIMUM_HEAP_SIZE=<bytes> - Maximum collected heap size.
+
+GC_LOOP_ON_ABORT - Causes the collector abort routine to enter a tight loop.
+ This may make it easier to debug, such a process, especially
+ for multithreaded platforms that don't produce usable core
+ files, or if a core file would be too large. On some
+ platforms, this also causes SIGSEGV to be caught and
+ result in an infinite loop in a handler, allowing
+ similar debugging techniques.
+
+GC_PRINT_STATS - Turn on as much logging as is easily feasible without
+ adding signifcant runtime overhead. Doesn't work if
+ the collector is built with SMALL_CONFIG. Overridden
+ by setting GC_quiet. On by default if the collector
+ was built without -DSILENT.
+
+GC_DUMP_REGULARLY - Generate a GC debugging dump GC_dump() on startup
+ and during every collection. Very verbose. Useful
+ if you have a bug to report, but please include only the
+ last complete dump.
+
+GC_PRINT_ADDRESS_MAP - Linux only. Dump /proc/self/maps, i.e. various address
+ maps for the process, to stderr on every GC. Useful for
+ mapping root addresses to source for deciphering leak
+ reports.
+
+GC_NPROCS=<n> - Linux w/threads only. Explicitly sets the number of processors
+ that the GC should expect to use. Note that setting this to 1
+ when multiple processors are available will preserve
+ correctness, but may lead to really horrible performance,
+ since the lock implementation will immediately yield without
+ first spinning.
+
+GC_MARKERS=<n> - Linux w/threads and parallel marker only. Set the number
+ of marker threads. This is normaly set to the number of
+ processors. It is safer to adjust GC_MARKERS than GC_NPROCS,
+ since GC_MARKERS has no impact on the lock implementation.
+
+GC_NO_BLACKLIST_WARNING - Prevents the collector from issuing
+ warnings about allocations of very large blocks.
+ Deprecated. Use GC_LARGE_ALLOC_WARN_INTERVAL instead.
+
+GC_LARGE_ALLOC_WARN_INTERVAL=<n> - Print every nth warning about very large
+ block allocations, starting with the nth one. Small values
+ of n are generally benign, in that a bounded number of
+ such warnings generally indicate at most a bounded leak.
+ For best results it should be set at 1 during testing.
+ Default is 5. Very large numbers effectively disable the
+ warning.
+
+GC_IGNORE_GCJ_INFO - Ignore the type descriptors implicitly supplied by
+ GC_gcj_malloc and friends. This is useful for debugging
+ descriptor generation problems, and possibly for
+ temporarily working around such problems. It forces a
+ fully conservative scan of all heap objects except
+ those known to be pointerfree, and may thus have other
+ adverse effects.
+
+GC_PRINT_BACK_HEIGHT - Print max length of chain through unreachable objects
+ ending in a reachable one. If this number remains
+ bounded, then the program is "GC robust". This ensures
+ that a fixed number of misidentified pointers can only
+ result in a bounded space leak. This currently only
+ works if debugging allocation is used throughout.
+ It increases GC space and time requirements appreciably.
+ This feature is still somewhat experimental, and requires
+ that the collector have been built with MAKE_BACK_GRAPH
+ defined. For details, see Boehm, "Bounding Space Usage
+ of Conservative Garbage Collectors", POPL 2001, or
+ http://lib.hpl.hp.com/techpubs/2001/HPL-2001-251.html .
+
+GC_RETRY_SIGNALS, GC_NO_RETRY_SIGNALS - Try to compensate for lost
+ thread suspend signals in linux_threads.c. On by
+ default for GC_OSF1_THREADS, off otherwise. Note
+ that this does not work around a possible loss of
+ thread restart signals. This seems to be necessary for
+ some versions of Tru64. Since we've previously seen
+ similar issues on some other operating systems, it
+ was turned into a runtime flag to enable last-minute
+ work-arounds.
+
+The following turn on runtime flags that are also program settable. Checked
+only during initialization. We expect that they will usually be set through
+other means, but this may help with debugging and testing:
+
+GC_ENABLE_INCREMENTAL - Turn on incremental collection at startup. Note that,
+ depending on platform and collector configuration, this
+ may involve write protecting pieces of the heap to
+ track modifications. These pieces may include pointerfree
+ objects or not. Although this is intended to be
+ transparent, it may cause unintended system call failures.
+ Use with caution.
+
+GC_PAUSE_TIME_TARGET - Set the desired garbage collector pause time in msecs.
+ This only has an effect if incremental collection is
+ enabled. If a collection requires appreciably more time
+ than this, the client will be restarted, and the collector
+ will need to do additional work to compensate. The
+ special value "999999" indicates that pause time is
+ unlimited, and the incremental collector will behave
+ completely like a simple generational collector. If
+ the collector is configured for parallel marking, and
+ run on a multiprocessor, incremental collection should
+ only be used with unlimited pause time.
+
+GC_FIND_LEAK - Turns on GC_find_leak and thus leak detection. Forces a
+ collection at program termination to detect leaks that would
+ otherwise occur after the last GC.
+
+GC_ALL_INTERIOR_POINTERS - Turns on GC_all_interior_pointers and thus interior
+ pointer recognition.
+
+GC_DONT_GC - Turns off garbage collection. Use cautiously.
--- /dev/null
+GC on EWS4800
+-------------
+
+1. About EWS4800
+ EWS4800 is 32bit/64bit workstation.
+
+ Vender: NEC Corporation
+ OS: UX/4800 R9.* - R13.* (SystemV R4.2)
+ CPU: R4000, R4400, R10000 (MIPS)
+
+2. Compiler
+
+ 32bit:
+ Use ANSI C compiler.
+ CC = /usr/abiccs/bin/cc
+
+ 64bit:
+ Use 64bit ANSI C compiler.
+ CC = /usr/ccs64/bin/cc
+ AR = /usr/ccs64/bin/ar
+
+3. ELF file format
+ *** Caution: The following infomation is empirical. ***
+
+ 32bit:
+ ELF file has an unique format. (See a.out(4) and end(3C).)
+
+ &_start
+ : text segment
+ &etext
+ DATASTART
+ : data segment (initialized)
+ &edata
+ DATASTART2
+ : data segment (uninitialized)
+ &end
+
+ Here, DATASTART and DATASTART2 are macros of GC, and are defined as
+ the following equations. (See include/private/gcconfig.h.)
+ The algorithm for DATASTART is similar with the function
+ GC_SysVGetDataStart() in os_dep.c.
+
+ DATASTART = ((&etext + 0x3ffff) & ~0x3ffff) + (&etext & 0xffff)
+
+ Dynamically linked:
+ DATASTART2 = (&_gp + 0x8000 + 0x3ffff) & ~0x3ffff
+
+ Statically linked:
+ DATASTART2 = &edata
+
+ GC has to check addresses both between DATASTART and &edata, and
+ between DATASTART2 and &end. If a program accesses between &etext
+ and DATASTART, or between &edata and DATASTART2, the segmentation
+ error occurs and the program stops.
+
+ If a program is statically linked, there is not a gap between
+ &edata and DATASTART2. The global symbol &_DYNAMIC_LINKING is used
+ for the detection.
+
+ 64bit:
+ ELF file has a simple format. (See end(3C).)
+
+ _ftext
+ : text segment
+ _etext
+ _fdata = DATASTART
+ : data segment (initialized)
+ _edata
+ _fbss
+ : data segment (uninitialized)
+ _end = DATAEND
+
+--
+Hironori SAKAMOTO <hsaka@mth.biglobe.ne.jp>
+
+
+When using the new "configure; make" build process, please
+run configure with the --disable-shared option. "Make check" does not
+yet pass with dynamic libraries. Ther reasons for that are not yet
+understood. (HB, paraphrasing message from Hironori SAKAMOTO.)
+
--- /dev/null
+Dynamic loading support requires that executables be linked with -ldld.
+The alternative is to build the collector without defining DYNAMIC_LOADING
+in gcconfig.h and ensuring that all garbage collectable objects are
+accessible without considering statically allocated variables in dynamic
+libraries.
+
+The collector should compile with either plain cc or cc -Ae. Cc -Aa
+fails to define _HPUX_SOURCE and thus will not configure the collector
+correctly.
+
+Incremental collection support was reccently added, and should now work.
+
+In spite of past claims, pthread support under HP/UX 11 should now work.
+Define GC_HPUX_THREADS for the build. Incremental collection still does not
+work in combination with it.
+
+The stack finding code can be confused by putenv calls before collector
+initialization. Call GC_malloc or GC_init before any putenv calls.
--- /dev/null
+See README.alpha for Linux on DEC AXP info.
+
+This file applies mostly to Linux/Intel IA32. Ports to Linux on an M68K, IA64,
+SPARC, MIPS, Alpha and PowerPC are also integrated. They should behave
+similarly, except that the PowerPC port lacks incremental GC support, and
+it is unknown to what extent the Linux threads code is functional.
+See below for M68K specific notes.
+
+Incremental GC is generally supported.
+
+Dynamic libraries are supported on an ELF system. A static executable
+should be linked with the gcc option "-Wl,-defsym,_DYNAMIC=0".
+
+The collector appears to work reliably with Linux threads, but beware
+of older versions of glibc and gdb.
+
+The garbage collector uses SIGPWR and SIGXCPU if it is used with
+Linux threads. These should not be touched by the client program.
+
+To use threads, you need to abide by the following requirements:
+
+1) You need to use LinuxThreads (which are included in libc6).
+
+ The collector relies on some implementation details of the LinuxThreads
+ package. It is unlikely that this code will work on other
+ pthread implementations (in particular it will *not* work with
+ MIT pthreads).
+
+2) You must compile the collector with -DGC_LINUX_THREADS and -D_REENTRANT
+ specified in the Makefile.
+
+3a) Every file that makes thread calls should define GC_LINUX_THREADS and
+ _REENTRANT and then include gc.h. Gc.h redefines some of the
+ pthread primitives as macros which also provide the collector with
+ information it requires.
+
+3b) A new alternative to (3a) is to build the collector and compile GC clients
+ with -DGC_USE_LD_WRAP, and to link the final program with
+
+ (for ld) --wrap read --wrap dlopen --wrap pthread_create \
+ --wrap pthread_join --wrap pthread_detach \
+ --wrap pthread_sigmask --wrap sleep
+
+ (for gcc) -Wl,--wrap -Wl,read -Wl,--wrap -Wl,dlopen -Wl,--wrap \
+ -Wl,pthread_create -Wl,--wrap -Wl,pthread_join -Wl,--wrap \
+ -Wl,pthread_detach -Wl,--wrap -Wl,pthread_sigmask \
+ -Wl,--wrap -Wl,sleep
+
+ In any case, _REENTRANT should be defined during compilation.
+
+4) Dlopen() disables collection during its execution. (It can't run
+ concurrently with the collector, since the collector looks at its
+ data structures. It can't acquire the allocator lock, since arbitrary
+ user startup code may run as part of dlopen().) Under unusual
+ conditions, this may cause unexpected heap growth.
+
+5) The combination of GC_LINUX_THREADS, REDIRECT_MALLOC, and incremental
+ collection fails in seemingly random places. This hasn't been tracked
+ down yet, but is perhaps not completely astonishing. The thread package
+ uses malloc, and thus can presumably get SIGSEGVs while inside the
+ package. There is no real guarantee that signals are handled properly
+ at that point.
+
+6) Thread local storage may not be viewed as part of the root set by the
+ collector. This probably depends on the linuxthreads version. For the
+ time being, any collectable memory referenced by thread local storage should
+ also be referenced from elsewhere, or be allocated as uncollectable.
+ (This is really a bug that should be fixed somehow.)
+
+
+M68K LINUX:
+(From Richard Zidlicky)
+The bad news is that it can crash every linux-m68k kernel on a 68040,
+so an additional test is needed somewhere on startup. I have meanwhile
+patches to correct the problem in 68040 buserror handler but it is not
+yet in any standard kernel.
+
+Here is a simple test program to detect whether the kernel has the
+problem. It could be run as a separate check in configure or tested
+upon startup. If it fails (return !0) than mprotect can't be used
+on that system.
+
+/*
+ * test for bug that may crash 68040 based Linux
+ */
+
+#include <sys/mman.h>
+#include <signal.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+
+char *membase;
+int pagesize=4096;
+int pageshift=12;
+int x_taken=0;
+
+int sighandler(int sig)
+{
+ mprotect(membase,pagesize,PROT_READ|PROT_WRITE);
+ x_taken=1;
+}
+
+main()
+{
+ long l;
+
+ signal(SIGSEGV,sighandler);
+ l=(long)mmap(NULL,pagesize,PROT_READ,MAP_PRIVATE | MAP_ANON,-1,0);
+ if (l==-1)
+ {
+ perror("mmap/malloc");
+ abort();
+ }
+ membase=(char*)l;
+ *(long*)(membase+sizeof(long))=123456789;
+ if (*(long*)(membase+sizeof(long)) != 123456789 )
+ {
+ fprintf(stderr,"writeback failed !\n");
+ exit(1);
+ }
+ if (!x_taken)
+ {
+ fprintf(stderr,"exception not taken !\n");
+ exit(1);
+ }
+ fprintf(stderr,"vmtest Ok\n");
+ exit(0);
+}
+
+
--- /dev/null
+The collector uses a large amount of conditional compilation in order to
+deal with platform dependencies. This violates a number of known coding
+standards. On the other hand, it seems to be the only practical way to
+support this many platforms without excessive code duplication.
+
+A few guidelines have mostly been followed in order to keep this manageable:
+
+1) #if and #ifdef directives are properly indented whenever easily possible.
+All known C compilers allow whitespace between the "#" and the "if" to make
+this possible. ANSI C also allows white space before the "#", though we
+avoid that. It has the known disadvantages that it differs from the normal
+GNU conventions, and that it makes patches larger than otherwise necessary.
+In my opinion, it's still well worth it, for the same reason that we indent
+ordinary "if" statements.
+
+2) Whenever possible, tests are performed on the macros defined in gcconfig.h
+instead of directly testing patform-specific predefined macros. This makes it
+relatively easy to adapt to new compilers with a different set of predefined
+macros. Currently these macros generally identify platforms instead of
+features. In many cases, this is a mistake.
+
+3) The code currently avoids #elif, eventhough that would make it more
+readable. This was done since #elif would need to be understood by ALL
+compilers used to build the collector, and that hasn't always been the case.
+It makes sense to reconsider this decision at some point, since #elif has been
+standardized at least since 1989.
+
+Many of the tested configuration macros are at least somewhat defined in
+either include/private/gcconfig.h or in Makefile.direct. Here is an attempt
+at defining some of the remainder: (Thanks to Walter Bright for suggesting
+this. This is a work in progress)
+
+MACRO EXPLANATION
+----- -----------
+
+__DMC__ Always #define'd by the Digital Mars compiler. Expands
+ to the compiler version number in hex, i.e. 0x810 is
+ version 8.1b0
+
+_ENABLE_ARRAYNEW
+ #define'd by the Digital Mars C++ compiler when
+ operator new[] and delete[] are separately
+ overloadable. Used in gc_cpp.h.
+
+_MSC_VER Expands to the Visual C++ compiler version. Assumed to
+ not be defined for other compilers (at least if they behave
+ appreciably differently).
+
+_DLL Defined by Visual C++ if dynamic libraries are being built
+ or used. Used to test whether __declspec(dllimport) or
+ __declspec(dllexport) needs to be added to declarations
+ to support the case in which the collector is in a dll.
+
+GC_DLL User-settable macro that forces the effect of _DLL.
+
+GC_NOT_DLL User-settable macro that overrides _DLL, e.g. if dynamic
+ libraries are used, but the collector is in a static library.
+
+__STDC__ Assumed to be defined only by compilers that understand
+ prototypes and other C89 features. Its value is generally
+ not used, since we are fine with most nonconforming extensions.
+
+SUNOS5SIGS Solaris-like signal handling. This is probably misnamed,
+ since it really doesn't guarantee much more than Posix.
+ Currently set only for Solaris2.X, HPUX, and DRSNX. Should
+ probably be set for some other platforms.
+
+PCR Set if the collector is being built as part of the Xerox
+ Portable Common Runtime.
+
+SRC_M3 Set if the collector is being built as a replacement of the
+ one in the DEC/Compaq SRC Modula-3 runtime. I suspect this
+ was last used around 1994, and no doubt broke a long time ago.
+ It's there primarily incase someone wants to port to a similar
+ system.
+
+
+
--- /dev/null
+We have so far failed to find a good way to determine the stack base.
+It is highly recommended that GC_stackbottom be set explicitly on program
+startup. The supplied value sometimes causes failure under AIX 4.1, though
+it appears to work under 3.X. HEURISTIC2 seems to work under 4.1, but
+involves a substantial performance penalty, and will fail if there is
+no limit on stack size.
+
+There is no thread support. (I assume recent versions of AIX provide
+pthreads? I no longer have access to a machine ...)
--- /dev/null
+Performance of the incremental collector can be greatly enhanced with
+-DNO_EXECUTE_PERMISSION.
+
+The collector should run with all of the -32, -n32 and -64 ABIs. Remember to
+define the AS macro in the Makefile to be "as -64", or "as -n32".
+
+If you use -DREDIRECT_MALLOC=GC_malloc with C++ code, your code should make
+at least one explicit call to malloc instead of new to ensure that the proper
+version of malloc is linked in.
+
+Sproc threads are not supported in this version, though there may exist other
+ports.
+
+Pthreads support is provided. This requires that:
+
+1) You compile the collector with -DGC_IRIX_THREADS specified in the Makefile.
+
+2) You have the latest pthreads patches installed.
+
+(Though the collector makes only documented pthread calls,
+it relies on signal/threads interactions working just right in ways
+that are not required by the standard. It is unlikely that this code
+will run on other pthreads platforms. But please tell me if it does.)
+
+3) Every file that makes thread calls should define IRIX_THREADS and then
+include gc.h. Gc.h redefines some of the pthread primitives as macros which
+also provide the collector with information it requires.
+
+4) pthread_cond_wait and pthread_cond_timed_wait should be prepared for
+premature wakeups. (I believe the pthreads and realted standards require this
+anyway. Irix pthreads often terminate a wait if a signal arrives.
+The garbage collector uses signals to stop threads.)
+
+5) It is expensive to stop a thread waiting in IO at the time the request is
+initiated. Applications with many such threads may not exhibit acceptable
+performance with the collector. (Increasing the heap size may help.)
+
+6) The collector should not be compiled with -DREDIRECT_MALLOC. This
+confuses some library calls made by the pthreads implementation, which
+expect the standard malloc.
+
--- /dev/null
+The collector supports both incremental collection and threads under
+Solaris 2. The incremental collector normally retrieves page dirty information
+through the appropriate /proc calls. But it can also be configured
+(by defining MPROTECT_VDB instead of PROC_VDB in gcconfig.h) to use mprotect
+and signals. This may result in shorter pause times, but it is no longer
+safe to issue arbitrary system calls that write to the heap.
+
+Under other UNIX versions,
+the collector normally obtains memory through sbrk. There is some reason
+to expect that this is not safe if the client program also calls the system
+malloc, or especially realloc. The sbrk man page strongly suggests this is
+not safe: "Many library routines use malloc() internally, so use brk()
+and sbrk() only when you know that malloc() definitely will not be used by
+any library routine." This doesn't make a lot of sense to me, since there
+seems to be no documentation as to which routines can transitively call malloc.
+Nonetheless, under Solaris2, the collector now (since 4.12) allocates
+memory using mmap by default. (It defines USE_MMAP in gcconfig.h.)
+You may want to reverse this decisions if you use -DREDIRECT_MALLOC=...
+
+
+SOLARIS THREADS:
+
+The collector must be compiled with -DGC_SOLARIS_THREADS (thr_ functions)
+or -DGC_SOLARIS_PTHREADS (pthread_ functions) to be thread safe.
+It is also essential that gc.h be included in files that call thr_create,
+thr_join, thr_suspend, thr_continue, or dlopen. Gc.h macro defines
+these to also do GC bookkeeping, etc. Gc.h must be included with
+one or both of these macros defined, otherwise
+these replacements are not visible.
+A collector built in this way way only be used by programs that are
+linked with the threads library.
+
+In this mode, the collector contains various workarounds for older Solaris
+bugs. Mostly, these should not be noticeable unless you look at system
+call traces. However, it cannot protect a guard page at the end of
+a thread stack. If you know that you will only be running Solaris2.5
+or later, it should be possible to fix this by compiling the collector
+with -DSOLARIS23_MPROTECT_BUG_FIXED.
+
+Since 5.0 alpha5, dlopen disables collection temporarily,
+unless USE_PROC_FOR_LIBRARIES is defined. In some unlikely cases, this
+can result in unpleasant heap growth. But it seems better than the
+race/deadlock issues we had before.
+
+If solaris_threads are used on an X86 processor with malloc redirected to
+GC_malloc, it is necessary to call GC_thr_init explicitly before forking the
+first thread. (This avoids a deadlock arising from calling GC_thr_init
+with the allocation lock held.)
+
+It appears that there is a problem in using gc_cpp.h in conjunction with
+Solaris threads and Sun's C++ runtime. Apparently the overloaded new operator
+is invoked by some iostream initialization code before threads are correctly
+initialized. As a result, call to thr_self() in garbage collector
+initialization segfaults. Currently the only known workaround is to not
+invoke the garbage collector from a user defined global operator new, or to
+have it invoke the garbage-collector's allocators only after main has started.
+(Note that the latter requires a moderately expensive test in operator
+delete.)
+
+Hans-J. Boehm
+(The above contains my personal opinions, which are probably not shared
+by anyone else.)
--- /dev/null
+Alistair Crooks supplied the port. He used Lexa C version 2.1.3 with
+-Xa to compile.
--- /dev/null
+The collector has at various times been compiled under Windows 95 & NT,
+with the original Microsoft SDK, with Visual C++ 2.0, 4.0, and 6, with
+the GNU win32 environment, with Borland 4.5, with Watcom C, and recently
+with the Digital Mars compiler. It is likely that some of these have been
+broken in the meantime. Patches are appreciated.
+
+It runs under both win32s and win32, but with different semantics.
+Under win32, all writable pages outside of the heaps and stack are
+scanned for roots. Thus the collector sees pointers in DLL data
+segments. Under win32s, only the main data segment is scanned.
+(The main data segment should always be scanned. Under some
+versions of win32s, other regions may also be scanned.)
+Thus all accessible objects should be accessible from local variables
+or variables in the main data segment. Alternatively, other data
+segments (e.g. in DLLs) may be registered with the collector by
+calling GC_init() and then GC_register_root_section(a), where
+a is the address of some variable inside the data segment. (Duplicate
+registrations are ignored, but not terribly quickly.)
+
+(There are two reasons for this. We didn't want to see many 16:16
+pointers. And the VirtualQuery call has different semantics under
+the two systems, and under different versions of win32s.)
+
+Win32 applications compiled with some flavor of gcc currently behave
+like win32s applications, in that dynamic library data segments are
+not scanned. (Gcc does not directly support Microsoft's "structured
+exception handling". It turns out that use of this feature is
+unavoidable if you scan arbitrary memory segments obtained from
+VirtualQuery.)
+
+The collector test program "gctest" is linked as a GUI application,
+but does not open any windows. Its output appears in the file
+"gc.log". It may be started from the file manager. The hour glass
+cursor may appear as long as it's running. If it is started from the
+command line, it will usually run in the background. Wait a few
+minutes (a few seconds on a modern machine) before you check the output.
+You should see either a failure indication or a "Collector appears to
+work" message.
+
+The cord test program has not been ported (but should port
+easily). A toy editor (cord/de.exe) based on cords (heavyweight
+strings represented as trees) has been ported and is included.
+It runs fine under either win32 or win32S. It serves as an example
+of a true Windows application, except that it was written by a
+nonexpert Windows programmer. (There are some peculiarities
+in the way files are displayed. The <cr> is displayed explicitly
+for standard DOS text files. As in the UNIX version, control
+characters are displayed explicitly, but in this case as red text.
+This may be suboptimal for some tastes and/or sets of default
+window colors.)
+
+In general -DREDIRECT_MALLOC is unlikely to work unless the
+application is completely statically linked.
+
+The collector normally allocates memory from the OS with VirtualAlloc.
+This appears to cause problems under Windows NT and Windows 2000 (but
+not Windows 95/98) if the memory is later passed to CreateDIBitmap.
+To work around this problem, build the collector with -DUSE_GLOBAL_ALLOC.
+This is currently incompatible with -DUSE_MUNMAP. (Thanks to Jonathan
+Clark for tracking this down. There's some chance this may be fixed
+in 6.1alpha4, since we now separate heap sections with an unused page.)
+
+For Microsoft development tools, rename NT_MAKEFILE as
+MAKEFILE. (Make sure that the CPU environment variable is defined
+to be i386.) In order to use the gc_cpp.h C++ interface, all
+client code should include gc_cpp.h.
+
+If you would prefer a VC++.NET project file, ask boehm@acm.org. One has
+been contributed, but it seems to contain some absolute paths etc., so
+it can presumably only be a starting point, and is not in the standard
+distribution. It is unclear (to me, Hans Boehm) whether it is feasible to
+change that.
+
+Clients may need to define GC_NOT_DLL before including gc.h, if the
+collector was built as a static library (as it normally is in the
+absence of thread support).
+
+For GNU-win32, use the regular makefile, possibly after uncommenting
+the line "include Makefile.DLLs". The latter should be necessary only
+if you want to package the collector as a DLL. The GNU-win32 port is
+believed to work only for b18, not b19, probably due to linker changes
+in b19. This is probably fixable with a different definition of
+DATASTART and DATAEND in gcconfig.h.
+
+For Borland tools, use BCC_MAKEFILE. Note that
+Borland's compiler defaults to 1 byte alignment in structures (-a1),
+whereas Visual C++ appears to default to 8 byte alignment (/Zp8).
+The garbage collector in its default configuration EXPECTS AT
+LEAST 4 BYTE ALIGNMENT. Thus the BORLAND DEFAULT MUST
+BE OVERRIDDEN. (In my opinion, it should usually be anyway.
+I expect that -a1 introduces major performance penalties on a
+486 or Pentium.) Note that this changes structure layouts. (As a last
+resort, gcconfig.h can be changed to allow 1 byte alignment. But
+this has significant negative performance implications.)
+The Makefile is set up to assume Borland 4.5. If you have another
+version, change the line near the top. By default, it does not
+require the assembler. If you do have the assembler, I recommend
+removing the -DUSE_GENERIC.
+
+There is some support for incremental collection. This is
+currently pretty simple-minded. Pages are protected. Protection
+faults are caught by a handler installed at the bottom of the handler
+stack. This is both slow and interacts poorly with a debugger.
+Whenever possible, I recommend adding a call to
+GC_enable_incremental at the last possible moment, after most
+debugging is complete. Unlike the UNIX versions, no system
+calls are wrapped by the collector itself. It may be necessary
+to wrap ReadFile calls that use a buffer in the heap, so that the
+call does not encounter a protection fault while it's running.
+(As usual, none of this is an issue unless GC_enable_incremental
+is called.)
+
+Note that incremental collection is disabled with -DSMALL_CONFIG.
+
+James Clark has contributed the necessary code to support win32 threads.
+Use NT_THREADS_MAKEFILE (a.k.a gc.mak) instead of NT_MAKEFILE
+to build this version. Note that this requires some files whose names
+are more than 8 + 3 characters long. Thus you should unpack the tar file
+so that long file names are preserved. To build the garbage collector
+test with VC++ from the command line, use
+
+nmake /F ".\gc.mak" CFG="gctest - Win32 Release"
+
+This requires that the subdirectory gctest\Release exist.
+The test program and DLL will reside in the Release directory.
+
+This version relies on the collector residing in a dll.
+
+This version currently supports incremental collection only if it is
+enabled before any additional threads are created.
+Version 4.13 attempts to fix some of the earlier problems, but there
+may be other issues. If you need solid support for win32 threads, you
+might check with Geodesic Systems. Their collector must be licensed,
+but they have invested far more time in win32-specific issues.
+
+Hans
+
+Ivan V. Demakov's README for the Watcom port:
+
+The collector has been compiled with Watcom C 10.6 and 11.0.
+It runs under win32, win32s, and even under msdos with dos4gw
+dos-extender. It should also run under OS/2, though this isn't
+tested. Under win32 the collector can be built either as dll
+or as static library.
+
+Note that all compilations were done under Windows 95 or NT.
+For unknown reason compiling under Windows 3.11 for NT (one
+attempt has been made) leads to broken executables.
+
+Incremental collection is not supported.
+
+cord is not ported.
+
+Before compiling you may need to edit WCC_MAKEFILE to set target
+platform, library type (dynamic or static), calling conventions, and
+optimization options.
+
+To compile the collector and testing programs use the command:
+ wmake -f WCC_MAKEFILE
+
+All programs using gc should be compiled with 4-byte alignment.
+For further explanations on this see comments about Borland.
+
+If gc compiled as dll, the macro ``GC_DLL'' should be defined before
+including "gc.h" (for example, with -DGC_DLL compiler option). It's
+important, otherwise resulting programs will not run.
+
+Ivan Demakov (email: ivan@tgrad.nsk.su)
+
+
--- /dev/null
+This is an ASCII diagram of the data structure used to check pointer
+validity. It was provided by Dave Barrett <barrett@asgard.cs.colorado.edu>,
+and should be of use to others attempting to understand the code.
+The data structure in GC4.X is essentially the same. -HB
+
+
+
+
+ Data Structure used by GC_base in gc3.7:
+ 21-Apr-94
+
+
+
+
+ 63 LOG_TOP_SZ[11] LOG_BOTTOM_SZ[10] LOG_HBLKSIZE[13]
+ +------------------+----------------+------------------+------------------+
+ p:| | TL_HASH(hi) | | HBLKDISPL(p) |
+ +------------------+----------------+------------------+------------------+
+ \-----------------------HBLKPTR(p)-------------------/
+ \------------hi-------------------/
+ \______ ________/ \________ _______/ \________ _______/
+ V V V
+ | | |
+ GC_top_index[] | | |
+ --- +--------------+ | | |
+ ^ | | | | |
+ | | | | | |
+ TOP +--------------+<--+ | |
+ _SZ +-<| [] | * | |
+(items)| +--------------+ if 0 < bi< HBLKSIZE | |
+ | | | | then large object | |
+ | | | | starts at the bi'th | |
+ v | | | HBLK before p. | i |
+ --- | +--------------+ | (word- |
+ v | aligned) |
+ bi= |GET_BI(p){->hash_link}->key==hi | |
+ v | |
+ | (bottom_index) \ scratch_alloc'd | |
+ | ( struct bi ) / by get_index() | |
+ --- +->+--------------+ | |
+ ^ | | | |
+ ^ | | | |
+ BOTTOM | | ha=GET_HDR_ADDR(p) | |
+_SZ(items)+--------------+<----------------------+ +-------+
+ | +--<| index[] | |
+ | | +--------------+ GC_obj_map: v
+ | | | | from / +-+-+-----+-+-+-+-+ ---
+ v | | | GC_add < 0| | | | | | | | ^
+ --- | +--------------+ _map_entry \ +-+-+-----+-+-+-+-+ |
+ | | asc_link | +-+-+-----+-+-+-+-+ MAXOBJSZ
+ | +--------------+ +-->| | | j | | | | | +1
+ | | key | | +-+-+-----+-+-+-+-+ |
+ | +--------------+ | +-+-+-----+-+-+-+-+ |
+ | | hash_link | | | | | | | | | | v
+ | +--------------+ | +-+-+-----+-+-+-+-+ ---
+ | | |<--MAX_OFFSET--->|
+ | | (bytes)
+HDR(p)| GC_find_header(p) | |<--MAP_ENTRIES-->|
+ | \ from | =HBLKSIZE/WORDSZ
+ | (hdr) (struct hblkhdr) / alloc_hdr() | (1024 on Alpha)
+ +-->+----------------------+ | (8/16 bits each)
+GET_HDR(p)| word hb_sz (words) | |
+ +----------------------+ |
+ | struct hblk *hb_next | |
+ +----------------------+ |
+ |mark_proc hb_mark_proc| |
+ +----------------------+ |
+ | char * hb_map |>-------------+
+ +----------------------+
+ | ushort hb_obj_kind |
+ +----------------------+
+ | hb_last_reclaimed |
+ --- +----------------------+
+ ^ | |
+ MARK_BITS| hb_marks[] | *if hdr is free, hb_sz + DISCARD_WORDS
+_SZ(words)| | is the size of a heap chunk (struct hblk)
+ v | | of at least MININCR*HBLKSIZE bytes (below),
+ --- +----------------------+ otherwise, size of each object in chunk.
+
+Dynamic data structures above are interleaved throughout the heap in blocks of
+size MININCR * HBLKSIZE bytes as done by gc_scratch_alloc which cannot be
+freed; free lists are used (e.g. alloc_hdr). HBLKs's below are collected.
+
+ (struct hblk)
+ --- +----------------------+ < HBLKSIZE --- --- DISCARD_
+ ^ |garbage[DISCARD_WORDS]| aligned ^ ^ HDR_BYTES WORDS
+ | | | | v (bytes) (words)
+ | +-----hb_body----------+ < WORDSZ | --- ---
+ | | | aligned | ^ ^
+ | | Object 0 | | hb_sz |
+ | | | i |(word- (words)|
+ | | | (bytes)|aligned) v |
+ | + - - - - - - - - - - -+ --- | --- |
+ | | | ^ | ^ |
+ n * | | j (words) | hb_sz BODY_SZ
+ HBLKSIZE | Object 1 | v v | (words)
+ (bytes) | |--------------- v MAX_OFFSET
+ | + - - - - - - - - - - -+ --- (bytes)
+ | | | !All_INTERIOR_PTRS ^ |
+ | | | sets j only for hb_sz |
+ | | Object N | valid object offsets. | |
+ v | | All objects WORDSZ v v
+ --- +----------------------+ aligned. --- ---
+
+DISCARD_WORDS is normally zero. Indeed the collector has not been tested
+with another value in ages.
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>Debugging Garbage Collector Related Problems</title>
+</head>
+<BODY>
+<H1>Debugging Garbage Collector Related Problems</h1>
+This page contains some hints on
+debugging issues specific to
+the Boehm-Demers-Weiser conservative garbage collector.
+It applies both to debugging issues in client code that manifest themselves
+as collector misbehavior, and to debugging the collector itself.
+<P>
+If you suspect a bug in the collector itself, it is strongly recommended
+that you try the latest collector release, even if it is labelled as "alpha",
+before proceeding.
+<H2>Bus Errors and Segmentation Violations</h2>
+<P>
+If the fault occurred in GC_find_limit, or with incremental collection enabled,
+this is probably normal. The collector installs handlers to take care of
+these. You will not see these unless you are using a debugger.
+Your debugger <I>should</i> allow you to continue.
+It's often preferable to tell the debugger to ignore SIGBUS and SIGSEGV
+("<TT>handle SIGSEGV SIGBUS nostop noprint</tt>" in gdb,
+"<TT>ignore SIGSEGV SIGBUS</tt>" in most versions of dbx)
+and set a breakpoint in <TT>abort</tt>.
+The collector will call abort if the signal had another cause,
+and there was not other handler previously installed.
+<P>
+We recommend debugging without incremental collection if possible.
+(This applies directly to UNIX systems.
+Debugging with incremental collection under win32 is worse. See README.win32.)
+<P>
+If the application generates an unhandled SIGSEGV or equivalent, it may
+often be easiest to set the environment variable GC_LOOP_ON_ABORT. On many
+platforms, this will cause the collector to loop in a handler when the
+SIGSEGV is encountered (or when the collector aborts for some other reason),
+and a debugger can then be attached to the looping
+process. This sidesteps common operating system problems related
+to incomplete core files for multithreaded applications, etc.
+<H2>Other Signals</h2>
+On most platforms, the multithreaded version of the collector needs one or
+two other signals for internal use by the collector in stopping threads.
+It is normally wise to tell the debugger to ignore these. On Linux,
+the collector currently uses SIGPWR and SIGXCPU by default.
+<H2>Warning Messages About Needing to Allocate Blacklisted Blocks</h2>
+The garbage collector generates warning messages of the form
+<PRE>
+Needed to allocate blacklisted block at 0x...
+</pre>
+when it needs to allocate a block at a location that it knows to be
+referenced by a false pointer. These false pointers can be either permanent
+(<I>e.g.</i> a static integer variable that never changes) or temporary.
+In the latter case, the warning is largely spurious, and the block will
+eventually be reclaimed normally.
+In the former case, the program will still run correctly, but the block
+will never be reclaimed. Unless the block is intended to be
+permanent, the warning indicates a memory leak.
+<OL>
+<LI>Ignore these warnings while you are using GC_DEBUG. Some of the routines
+mentioned below don't have debugging equivalents. (Alternatively, write
+the missing routines and send them to me.)
+<LI>Replace allocator calls that request large blocks with calls to
+<TT>GC_malloc_ignore_off_page</tt> or
+<TT>GC_malloc_atomic_ignore_off_page</tt>. You may want to set a
+breakpoint in <TT>GC_default_warn_proc</tt> to help you identify such calls.
+Make sure that a pointer to somewhere near the beginning of the resulting block
+is maintained in a (preferably volatile) variable as long as
+the block is needed.
+<LI>
+If the large blocks are allocated with realloc, we suggest instead allocating
+them with something like the following. Note that the realloc size increment
+should be fairly large (e.g. a factor of 3/2) for this to exhibit reasonable
+performance. But we all know we should do that anyway.
+<PRE>
+void * big_realloc(void *p, size_t new_size)
+{
+ size_t old_size = GC_size(p);
+ void * result;
+
+ if (new_size <= 10000) return(GC_realloc(p, new_size));
+ if (new_size <= old_size) return(p);
+ result = GC_malloc_ignore_off_page(new_size);
+ if (result == 0) return(0);
+ memcpy(result,p,old_size);
+ GC_free(p);
+ return(result);
+}
+</pre>
+
+<LI> In the unlikely case that even relatively small object
+(<20KB) allocations are triggering these warnings, then your address
+space contains lots of "bogus pointers", i.e. values that appear to
+be pointers but aren't. Usually this can be solved by using GC_malloc_atomic
+or the routines in gc_typed.h to allocate large pointer-free regions of bitmaps, etc. Sometimes the problem can be solved with trivial changes of encoding
+in certain values. It is possible, to identify the source of the bogus
+pointers by building the collector with <TT>-DPRINT_BLACK_LIST</tt>,
+which will cause it to print the "bogus pointers", along with their location.
+
+<LI> If you get only a fixed number of these warnings, you are probably only
+introducing a bounded leak by ignoring them. If the data structures being
+allocated are intended to be permanent, then it is also safe to ignore them.
+The warnings can be turned off by calling GC_set_warn_proc with a procedure
+that ignores these warnings (e.g. by doing absolutely nothing).
+</ol>
+
+<H2>The Collector References a Bad Address in <TT>GC_malloc</tt></h2>
+
+This typically happens while the collector is trying to remove an entry from
+its free list, and the free list pointer is bad because the free list link
+in the last allocated object was bad.
+<P>
+With > 99% probability, you wrote past the end of an allocated object.
+Try setting <TT>GC_DEBUG</tt> before including <TT>gc.h</tt> and
+allocating with <TT>GC_MALLOC</tt>. This will try to detect such
+overwrite errors.
+
+<H2>Unexpectedly Large Heap</h2>
+
+Unexpected heap growth can be due to one of the following:
+<OL>
+<LI> Data structures that are being unintentionally retained. This
+is commonly caused by data structures that are no longer being used,
+but were not cleared, or by caches growing without bounds.
+<LI> Pointer misidentification. The garbage collector is interpreting
+integers or other data as pointers and retaining the "referenced"
+objects.
+<LI> Heap fragmentation. This should never result in unbounded growth,
+but it may account for larger heaps. This is most commonly caused
+by allocation of large objects. On some platforms it can be reduced
+by building with -DUSE_MUNMAP, which will cause the collector to unmap
+memory corresponding to pages that have not been recently used.
+<LI> Per object overhead. This is usually a relatively minor effect, but
+it may be worth considering. If the collector recognizes interior
+pointers, object sizes are increased, so that one-past-the-end pointers
+are correctly recognized. The collector can be configured not to do this
+(<TT>-DDONT_ADD_BYTE_AT_END</tt>).
+<P>
+The collector rounds up object sizes so the result fits well into the
+chunk size (<TT>HBLKSIZE</tt>, normally 4K on 32 bit machines, 8K
+on 64 bit machines) used by the collector. Thus it may be worth avoiding
+objects of size 2K + 1 (or 2K if a byte is being added at the end.)
+</ol>
+The last two cases can often be identified by looking at the output
+of a call to <TT>GC_dump()</tt>. Among other things, it will print the
+list of free heap blocks, and a very brief description of all chunks in
+the heap, the object sizes they correspond to, and how many live objects
+were found in the chunk at the last collection.
+<P>
+Growing data structures can usually be identified by
+<OL>
+<LI> Building the collector with <TT>-DKEEP_BACK_PTRS</tt>,
+<LI> Preferably using debugging allocation (defining <TT>GC_DEBUG</tt>
+before including <TT>gc.h</tt> and allocating with <TT>GC_MALLOC</tt>),
+so that objects will be identified by their allocation site,
+<LI> Running the application long enough so
+that most of the heap is composed of "leaked" memory, and
+<LI> Then calling <TT>GC_generate_random_backtrace()</tt> from backptr.h
+a few times to determine why some randomly sampled objects in the heap are
+being retained.
+</ol>
+<P>
+The same technique can often be used to identify problems with false
+pointers, by noting whether the reference chains printed by
+<TT>GC_generate_random_backtrace()</tt> involve any misidentified pointers.
+An alternate technique is to build the collector with
+<TT>-DPRINT_BLACK_LIST</tt> which will cause it to report values that
+are almost, but not quite, look like heap pointers. It is very likely that
+actual false pointers will come from similar sources.
+<P>
+In the unlikely case that false pointers are an issue, it can usually
+be resolved using one or more of the following techniques:
+<OL>
+<LI> Use <TT>GC_malloc_atomic</tt> for objects containing no pointers.
+This is especially important for large arrays containing compressed data,
+pseudo-random numbers, and the like. It is also likely to improve GC
+performance, perhaps drastically so if the application is paging.
+<LI> If you allocate large objects containing only
+one or two pointers at the beginning, either try the typed allocation
+primitives is <TT>gc_typed.h</tt>, or separate out the pointerfree component.
+<LI> Consider using <TT>GC_malloc_ignore_off_page()</tt>
+to allocate large objects. (See <TT>gc.h</tt> and above for details.
+Large means > 100K in most environments.)
+</ol>
+<H2>Prematurely Reclaimed Objects</h2>
+The usual symptom of this is a segmentation fault, or an obviously overwritten
+value in a heap object. This should, of course, be impossible. In practice,
+it may happen for reasons like the following:
+<OL>
+<LI> The collector did not intercept the creation of threads correctly in
+a multithreaded application, <I>e.g.</i> because the client called
+<TT>pthread_create</tt> without including <TT>gc.h</tt>, which redefines it.
+<LI> The last pointer to an object in the garbage collected heap was stored
+somewhere were the collector couldn't see it, <I>e.g.</i> in an
+object allocated with system <TT>malloc</tt>, in certain types of
+<TT>mmap</tt>ed files,
+or in some data structure visible only to the OS. (On some platforms,
+thread-local storage is one of these.)
+<LI> The last pointer to an object was somehow disguised, <I>e.g.</i> by
+XORing it with another pointer.
+<LI> Incorrect use of <TT>GC_malloc_atomic</tt> or typed allocation.
+<LI> An incorrect <TT>GC_free</tt> call.
+<LI> The client program overwrote an internal garbage collector data structure.
+<LI> A garbage collector bug.
+<LI> (Empirically less likely than any of the above.) A compiler optimization
+that disguised the last pointer.
+</ol>
+The following relatively simple techniques should be tried first to narrow
+down the problem:
+<OL>
+<LI> If you are using the incremental collector try turning it off for
+debugging.
+<LI> If you are using shared libraries, try linking statically. If that works,
+ensure that DYNAMIC_LOADING is defined on your platform.
+<LI> Try to reproduce the problem with fully debuggable unoptimized code.
+This will eliminate the last possibility, as well as making debugging easier.
+<LI> Try replacing any suspect typed allocation and <TT>GC_malloc_atomic</tt>
+calls with calls to <TT>GC_malloc</tt>.
+<LI> Try removing any GC_free calls (<I>e.g.</i> with a suitable
+<TT>#define</tt>).
+<LI> Rebuild the collector with <TT>-DGC_ASSERTIONS</tt>.
+<LI> If the following works on your platform (i.e. if gctest still works
+if you do this), try building the collector with
+<TT>-DREDIRECT_MALLOC=GC_malloc_uncollectable</tt>. This will cause
+the collector to scan memory allocated with malloc.
+</ol>
+If all else fails, you will have to attack this with a debugger.
+Suggested steps:
+<OL>
+<LI> Call <TT>GC_dump()</tt> from the debugger around the time of the failure. Verify
+that the collectors idea of the root set (i.e. static data regions which
+it should scan for pointers) looks plausible. If not, i.e. if it doesn't
+include some static variables, report this as
+a collector bug. Be sure to describe your platform precisely, since this sort
+of problem is nearly always very platform dependent.
+<LI> Especially if the failure is not deterministic, try to isolate it to
+a relatively small test case.
+<LI> Set a break point in <TT>GC_finish_collection</tt>. This is a good
+point to examine what has been marked, i.e. found reachable, by the
+collector.
+<LI> If the failure is deterministic, run the process
+up to the last collection before the failure.
+Note that the variable <TT>GC_gc_no</tt> counts collections and can be used
+to set a conditional breakpoint in the right one. It is incremented just
+before the call to GC_finish_collection.
+If object <TT>p</tt> was prematurely recycled, it may be helpful to
+look at <TT>*GC_find_header(p)</tt> at the failure point.
+The <TT>hb_last_reclaimed</tt> field will identify the collection number
+during which its block was last swept.
+<LI> Verify that the offending object still has its correct contents at
+this point.
+Then call <TT>GC_is_marked(p)</tt> from the debugger to verify that the
+object has not been marked, and is about to be reclaimed. Note that
+<TT>GC_is_marked(p)</tt> expects the real address of an object (the
+address of the debug header if there is one), and thus it may
+be more appropriate to call <TT>GC_is_marked(GC_base(p))</tt>
+instead.
+<LI> Determine a path from a root, i.e. static variable, stack, or
+register variable,
+to the reclaimed object. Call <TT>GC_is_marked(q)</tt> for each object
+<TT>q</tt> along the path, trying to locate the first unmarked object, say
+<TT>r</tt>.
+<LI> If <TT>r</tt> is pointed to by a static root,
+verify that the location
+pointing to it is part of the root set printed by <TT>GC_dump()</tt>. If it
+is on the stack in the main (or only) thread, verify that
+<TT>GC_stackbottom</tt> is set correctly to the base of the stack. If it is
+in another thread stack, check the collector's thread data structure
+(<TT>GC_thread[]</tt> on several platforms) to make sure that stack bounds
+are set correctly.
+<LI> If <TT>r</tt> is pointed to by heap object <TT>s</tt>, check that the
+collector's layout description for <TT>s</tt> is such that the pointer field
+will be scanned. Call <TT>*GC_find_header(s)</tt> to look at the descriptor
+for the heap chunk. The <TT>hb_descr</tt> field specifies the layout
+of objects in that chunk. See gc_mark.h for the meaning of the descriptor.
+(If it's low order 2 bits are zero, then it is just the length of the
+object prefix to be scanned. This form is always used for objects allocated
+with <TT>GC_malloc</tt> or <TT>GC_malloc_atomic</tt>.)
+<LI> If the failure is not deterministic, you may still be able to apply some
+of the above technique at the point of failure. But remember that objects
+allocated since the last collection will not have been marked, even if the
+collector is functioning properly. On some platforms, the collector
+can be configured to save call chains in objects for debugging.
+Enabling this feature will also cause it to save the call stack at the
+point of the last GC in GC_arrays._last_stack.
+<LI> When looking at GC internal data structures remember that a number
+of <TT>GC_</tt><I>xxx</i> variables are really macro defined to
+<TT>GC_arrays._</tt><I>xxx</i>, so that
+the collector can avoid scanning them.
+</ol>
+</body>
+</html>
+
+
+
+
--- /dev/null
+.TH GC_MALLOC 1L "12 February 1996"
+.SH NAME
+GC_malloc, GC_malloc_atomic, GC_free, GC_realloc, GC_enable_incremental, GC_register_finalizer, GC_malloc_ignore_off_page, GC_malloc_atomic_ignore_off_page, GC_set_warn_proc \- Garbage collecting malloc replacement
+.SH SYNOPSIS
+#include "gc.h"
+.br
+# define malloc(n) GC_malloc(n)
+.br
+... malloc(...) ...
+.br
+.sp
+cc ... gc.a
+.LP
+.SH DESCRIPTION
+.I GC_malloc
+and
+.I GC_free
+are plug-in replacements for standard malloc and free. However,
+.I
+GC_malloc
+will attempt to reclaim inaccessible space automatically by invoking a conservative garbage collector at appropriate points. The collector traverses all data structures accessible by following pointers from the machines registers, stack(s), data, and bss segments. Inaccessible structures will be reclaimed. A machine word is considered to be a valid pointer if it is an address inside an object allocated by
+.I
+GC_malloc
+or friends.
+.LP
+See the documentation in the include file gc_cpp.h for an alternate, C++ specific interface to the garbage collector.
+.LP
+Unlike the standard implementations of malloc,
+.I
+GC_malloc
+clears the newly allocated storage.
+.I
+GC_malloc_atomic
+does not. Furthermore, it informs the collector that the resulting object will never contain any pointers, and should therefore not be scanned by the collector.
+.LP
+.I
+GC_free
+can be used to deallocate objects, but its use is optional, and generally discouraged.
+.I
+GC_realloc
+has the standard realloc semantics. It preserves pointer-free-ness.
+.I
+GC_register_finalizer
+allows for registration of functions that are invoked when an object becomes inaccessible.
+.LP
+The garbage collector tries to avoid allocating memory at locations that already appear to be referenced before allocation. (Such apparent ``pointers'' are usually large integers and the like that just happen to look like an address.) This may make it hard to allocate very large objects. An attempt to do so may generate a warning.
+.LP
+.I
+GC_malloc_ignore_off_page
+and
+.I
+GC_malloc_atomic_ignore_off_page
+inform the collector that the client code will always maintain a pointer to near the beginning of the object (within the first 512 bytes), and that pointers beyond that can be ignored by the collector. This makes it much easier for the collector to place large objects. These are recommended for large object allocation. (Objects expected to be larger than about 100KBytes should be allocated this way.)
+.LP
+It is also possible to use the collector to find storage leaks in programs destined to be run with standard malloc/free. The collector can be compiled for thread-safe operation. Unlike standard malloc, it is safe to call malloc after a previous malloc call was interrupted by a signal, provided the original malloc call is not resumed.
+.LP
+The collector may, on rare occasion produce warning messages. On UNIX machines these appear on stderr. Warning messages can be filtered, redirected, or ignored with
+.I
+GC_set_warn_proc.
+This is recommended for production code. See gc.h for details.
+.LP
+Debugging versions of many of the above routines are provided as macros. Their names are identical to the above, but consist of all capital letters. If GC_DEBUG is defined before gc.h is included, these routines do additional checking, and allow the leak detecting version of the collector to produce slightly more useful output. Without GC_DEBUG defined, they behave exactly like the lower-case versions.
+.LP
+On some machines, collection will be performed incrementally after a call to
+.I
+GC_enable_incremental.
+This may temporarily write protect pages in the heap. See the README file for more information on how this interacts with system calls that write to the heap.
+.LP
+Other facilities not discussed here include limited facilities to support incremental collection on machines without appropriate VM support, provisions for providing more explicit object layout information to the garbage collector, more direct support for ``weak'' pointers, support for ``abortable'' garbage collections during idle time, etc.
+.LP
+.SH "SEE ALSO"
+The README and gc.h files in the distribution. More detailed definitions of the functions exported by the collector are given there. (The above list is not complete.)
+.LP
+Boehm, H., and M. Weiser, "Garbage Collection in an Uncooperative Environment",
+\fISoftware Practice & Experience\fP, September 1988, pp. 807-820.
+.LP
+The malloc(3) man page.
+.LP
+.SH AUTHOR
+Hans-J. Boehm (boehm@parc.xerox.com). Some of the code was written by others, most notably Alan Demers.
--- /dev/null
+<HTML>
+<HEAD>
+ <TITLE> Conservative GC Algorithmic Overview </TITLE>
+ <AUTHOR> Hans-J. Boehm, HP Labs (Much of this was written at SGI)</author>
+</HEAD>
+<BODY>
+<H1> <I>This is under construction</i> </h1>
+<H1> Conservative GC Algorithmic Overview </h1>
+<P>
+This is a description of the algorithms and data structures used in our
+conservative garbage collector. I expect the level of detail to increase
+with time. For a survey of GC algorithms, see for example
+<A HREF="ftp://ftp.cs.utexas.edu/pub/garbage/gcsurvey.ps"> Paul Wilson's
+excellent paper</a>. For an overview of the collector interface,
+see <A HREF="gcinterface.html">here</a>.
+<P>
+This description is targeted primarily at someone trying to understand the
+source code. It specifically refers to variable and function names.
+It may also be useful for understanding the algorithms at a higher level.
+<P>
+The description here assumes that the collector is used in default mode.
+In particular, we assume that it used as a garbage collector, and not just
+a leak detector. We initially assume that it is used in stop-the-world,
+non-incremental mode, though the presence of the incremental collector
+will be apparent in the design.
+We assume the default finalization model, but the code affected by that
+is very localized.
+<H2> Introduction </h2>
+The garbage collector uses a modified mark-sweep algorithm. Conceptually
+it operates roughly in four phases:
+
+<OL>
+
+<LI>
+<I>Preparation</i> Clear all mark bits, indicating that all objects
+are potentially unreachable.
+
+<LI>
+<I>Mark phase</i> Marks all objects that can be reachable via chains of
+pointers from variables. Normally the collector has no real information
+about the location of pointer variables in the heap, so it
+views all static data areas, stacks and registers as potentially containing
+containing pointers. Any bit patterns that represent addresses inside
+heap objects managed by the collector are viewed as pointers.
+Unless the client program has made heap object layout information
+available to the collector, any heap objects found to be reachable from
+variables are again scanned similarly.
+
+<LI>
+<I>Sweep phase</i> Scans the heap for inaccessible, and hence unmarked,
+objects, and returns them to an appropriate free list for reuse. This is
+not really a separate phase; even in non incremental mode this is operation
+is usually performed on demand during an allocation that discovers an empty
+free list. Thus the sweep phase is very unlikely to touch a page that
+would not have been touched shortly thereafter anyway.
+
+<LI>
+<I>Finalization phase</i> Unreachable objects which had been registered
+for finalization are enqueued for finalization outside the collector.
+
+</ol>
+
+<P>
+The remaining sections describe the memory allocation data structures,
+and then the last 3 collection phases in more detail. We conclude by
+outlining some of the additional features implemented in the collector.
+
+<H2>Allocation</h2>
+The collector includes its own memory allocator. The allocator obtains
+memory from the system in a platform-dependent way. Under UNIX, it
+uses either <TT>malloc</tt>, <TT>sbrk</tt>, or <TT>mmap</tt>.
+<P>
+Most static data used by the allocator, as well as that needed by the
+rest of the garbage collector is stored inside the
+<TT>_GC_arrays</tt> structure.
+This allows the garbage collector to easily ignore the collectors own
+data structures when it searches for root pointers. Other allocator
+and collector internal data structures are allocated dynamically
+with <TT>GC_scratch_alloc</tt>. <TT>GC_scratch_alloc</tt> does not
+allow for deallocation, and is therefore used only for permanent data
+structures.
+<P>
+The allocator allocates objects of different <I>kinds</i>.
+Different kinds are handled somewhat differently by certain parts
+of the garbage collector. Certain kinds are scanned for pointers,
+others are not. Some may have per-object type descriptors that
+determine pointer locations. Or a specific kind may correspond
+to one specific object layout. Two built-in kinds are uncollectable.
+One (<TT>STUBBORN</tt>) is immutable without special precautions.
+In spite of that, it is very likely that most applications currently
+use at most two kinds: <TT>NORMAL</tt> and <TT>PTRFREE</tt> objects.
+<P>
+The collector uses a two level allocator. A large block is defined to
+be one larger than half of <TT>HBLKSIZE</tt>, which is a power of 2,
+typically on the order of the page size.
+<P>
+Large block sizes are rounded up to
+the next multiple of <TT>HBLKSIZE</tt> and then allocated by
+<TT>GC_allochblk</tt>. Recent versions of the collector
+use an approximate best fit algorithm by keeping free lists for
+several large block sizes.
+The actual
+implementation of <TT>GC_allochblk</tt>
+is significantly complicated by black-listing issues
+(see below).
+<P>
+Small blocks are allocated in chunks of size <TT>HBLKSIZE</tt>.
+Each chunk is
+dedicated to only one object size and kind. The allocator maintains
+separate free lists for each size and kind of object.
+<P>
+Once a large block is split for use in smaller objects, it can only
+be used for objects of that size, unless the collector discovers a completely
+empty chunk. Completely empty chunks are restored to the appropriate
+large block free list.
+<P>
+In order to avoid allocating blocks for too many distinct object sizes,
+the collector normally does not directly allocate objects of every possible
+request size. Instead request are rounded up to one of a smaller number
+of allocated sizes, for which free lists are maintained. The exact
+allocated sizes are computed on demand, but subject to the constraint
+that they increase roughly in geometric progression. Thus objects
+requested early in the execution are likely to be allocated with exactly
+the requested size, subject to alignment constraints.
+See <TT>GC_init_size_map</tt> for details.
+<P>
+The actual size rounding operation during small object allocation is
+implemented as a table lookup in <TT>GC_size_map</tt>.
+<P>
+Both collector initialization and computation of allocated sizes are
+handled carefully so that they do not slow down the small object fast
+allocation path. An attempt to allocate before the collector is initialized,
+or before the appropriate <TT>GC_size_map</tt> entry is computed,
+will take the same path as an allocation attempt with an empty free list.
+This results in a call to the slow path code (<TT>GC_generic_malloc_inner</tt>)
+which performs the appropriate initialization checks.
+<P>
+In non-incremental mode, we make a decision about whether to garbage collect
+whenever an allocation would otherwise have failed with the current heap size.
+If the total amount of allocation since the last collection is less than
+the heap size divided by <TT>GC_free_space_divisor</tt>, we try to
+expand the heap. Otherwise, we initiate a garbage collection. This ensures
+that the amount of garbage collection work per allocated byte remains
+constant.
+<P>
+The above is in fact an oversimplification of the real heap expansion
+and GC triggering heuristic, which adjusts slightly for root size
+and certain kinds of
+fragmentation. In particular:
+<UL>
+<LI> Programs with a large root set size and
+little live heap memory will expand the heap to amortize the cost of
+scanning the roots.
+<LI> Versions 5.x of the collector actually collect more frequently in
+nonincremental mode. The large block allocator usually refuses to split
+large heap blocks once the garbage collection threshold is
+reached. This often has the effect of collecting well before the
+heap fills up, thus reducing fragmentation and working set size at the
+expense of GC time. Versions 6.x choose an intermediate strategy depending
+on how much large object allocation has taken place in the past.
+(If the collector is configured to unmap unused pages, versions 6.x
+use the 5.x strategy.)
+<LI> In calculating the amount of allocation since the last collection we
+give partial credit for objects we expect to be explicitly deallocated.
+Even if all objects are explicitly managed, it is often desirable to collect
+on rare occasion, since that is our only mechanism for coalescing completely
+empty chunks.
+</ul>
+<P>
+It has been suggested that this should be adjusted so that we favor
+expansion if the resulting heap still fits into physical memory.
+In many cases, that would no doubt help. But it is tricky to do this
+in a way that remains robust if multiple application are contending
+for a single pool of physical memory.
+
+<H2>Mark phase</h2>
+
+The marker maintains an explicit stack of memory regions that are known
+to be accessible, but that have not yet been searched for contained pointers.
+Each stack entry contains the starting address of the block to be scanned,
+as well as a descriptor of the block. If no layout information is
+available for the block, then the descriptor is simply a length.
+(For other possibilities, see <TT>gc_mark.h</tt>.)
+<P>
+At the beginning of the mark phase, all root segments are pushed on the
+stack by <TT>GC_push_roots</tt>. If <TT>ALL_INTERIOR_PTRS</tt> is not
+defined, then stack roots require special treatment. In this case, the
+normal marking code ignores interior pointers, but <TT>GC_push_all_stack</tt>
+explicitly checks for interior pointers and pushes descriptors for target
+objects.
+<P>
+The marker is structured to allow incremental marking.
+Each call to <TT>GC_mark_some</tt> performs a small amount of
+work towards marking the heap.
+It maintains
+explicit state in the form of <TT>GC_mark_state</tt>, which
+identifies a particular sub-phase. Some other pieces of state, most
+notably the mark stack, identify how much work remains to be done
+in each sub-phase. The normal progression of mark states for
+a stop-the-world collection is:
+<OL>
+<LI> <TT>MS_INVALID</tt> indicating that there may be accessible unmarked
+objects. In this case <TT>GC_objects_are_marked</tt> will simultaneously
+be false, so the mark state is advanced to
+<LI> <TT>MS_PUSH_UNCOLLECTABLE</tt> indicating that it suffices to push
+uncollectable objects, roots, and then mark everything reachable from them.
+<TT>Scan_ptr</tt> is advanced through the heap until all uncollectable
+objects are pushed, and objects reachable from them are marked.
+At that point, the next call to <TT>GC_mark_some</tt> calls
+<TT>GC_push_roots</tt> to push the roots. It the advances the
+mark state to
+<LI> <TT>MS_ROOTS_PUSHED</tt> asserting that once the mark stack is
+empty, all reachable objects are marked. Once in this state, we work
+only on emptying the mark stack. Once this is completed, the state
+changes to
+<LI> <TT>MS_NONE</tt> indicating that reachable objects are marked.
+</ol>
+
+The core mark routine <TT>GC_mark_from</tt>, is called
+repeatedly by several of the sub-phases when the mark stack starts to fill
+up. It is also called repeatedly in <TT>MS_ROOTS_PUSHED</tt> state
+to empty the mark stack.
+The routine is designed to only perform a limited amount of marking at
+each call, so that it can also be used by the incremental collector.
+It is fairly carefully tuned, since it usually consumes a large majority
+of the garbage collection time.
+<P>
+The fact that it perform a only a small amount of work per call also
+allows it to be used as the core routine of the parallel marker. In that
+case it is normally invoked on thread-private mark stacks instead of the
+global mark stack. More details can be found in
+<A HREF="scale.html">scale.html</a>
+<P>
+The marker correctly handles mark stack overflows. Whenever the mark stack
+overflows, the mark state is reset to <TT>MS_INVALID</tt>.
+Since there are already marked objects in the heap,
+this eventually forces a complete
+scan of the heap, searching for pointers, during which any unmarked objects
+referenced by marked objects are again pushed on the mark stack. This
+process is repeated until the mark phase completes without a stack overflow.
+Each time the stack overflows, an attempt is made to grow the mark stack.
+All pieces of the collector that push regions onto the mark stack have to be
+careful to ensure forward progress, even in case of repeated mark stack
+overflows. Every mark attempt results in additional marked objects.
+<P>
+Each mark stack entry is processed by examining all candidate pointers
+in the range described by the entry. If the region has no associated
+type information, then this typically requires that each 4-byte aligned
+quantity (8-byte aligned with 64-bit pointers) be considered a candidate
+pointer.
+<P>
+We determine whether a candidate pointer is actually the address of
+a heap block. This is done in the following steps:
+<NL>
+<LI> The candidate pointer is checked against rough heap bounds.
+These heap bounds are maintained such that all actual heap objects
+fall between them. In order to facilitate black-listing (see below)
+we also include address regions that the heap is likely to expand into.
+Most non-pointers fail this initial test.
+<LI> The candidate pointer is divided into two pieces; the most significant
+bits identify a <TT>HBLKSIZE</tt>-sized page in the address space, and
+the least significant bits specify an offset within that page.
+(A hardware page may actually consist of multiple such pages.
+HBLKSIZE is usually the page size divided by a small power of two.)
+<LI>
+The page address part of the candidate pointer is looked up in a
+<A HREF="tree.html">table</a>.
+Each table entry contains either 0, indicating that the page is not part
+of the garbage collected heap, a small integer <I>n</i>, indicating
+that the page is part of large object, starting at least <I>n</i> pages
+back, or a pointer to a descriptor for the page. In the first case,
+the candidate pointer i not a true pointer and can be safely ignored.
+In the last two cases, we can obtain a descriptor for the page containing
+the beginning of the object.
+<LI>
+The starting address of the referenced object is computed.
+The page descriptor contains the size of the object(s)
+in that page, the object kind, and the necessary mark bits for those
+objects. The size information can be used to map the candidate pointer
+to the object starting address. To accelerate this process, the page header
+also contains a pointer to a precomputed map of page offsets to displacements
+from the beginning of an object. The use of this map avoids a
+potentially slow integer remainder operation in computing the object
+start address.
+<LI>
+The mark bit for the target object is checked and set. If the object
+was previously unmarked, the object is pushed on the mark stack.
+The descriptor is read from the page descriptor. (This is computed
+from information <TT>GC_obj_kinds</tt> when the page is first allocated.)
+</nl>
+<P>
+At the end of the mark phase, mark bits for left-over free lists are cleared,
+in case a free list was accidentally marked due to a stray pointer.
+
+<H2>Sweep phase</h2>
+
+At the end of the mark phase, all blocks in the heap are examined.
+Unmarked large objects are immediately returned to the large object free list.
+Each small object page is checked to see if all mark bits are clear.
+If so, the entire page is returned to the large object free list.
+Small object pages containing some reachable object are queued for later
+sweeping, unless we determine that the page contains very little free
+space, in which case it is not examined further.
+<P>
+This initial sweep pass touches only block headers, not
+the blocks themselves. Thus it does not require significant paging, even
+if large sections of the heap are not in physical memory.
+<P>
+Nonempty small object pages are swept when an allocation attempt
+encounters an empty free list for that object size and kind.
+Pages for the correct size and kind are repeatedly swept until at
+least one empty block is found. Sweeping such a page involves
+scanning the mark bit array in the page header, and building a free
+list linked through the first words in the objects themselves.
+This does involve touching the appropriate data page, but in most cases
+it will be touched only just before it is used for allocation.
+Hence any paging is essentially unavoidable.
+<P>
+Except in the case of pointer-free objects, we maintain the invariant
+that any object in a small object free list is cleared (except possibly
+for the link field). Thus it becomes the burden of the small object
+sweep routine to clear objects. This has the advantage that we can
+easily recover from accidentally marking a free list, though that could
+also be handled by other means. The collector currently spends a fair
+amount of time clearing objects, and this approach should probably be
+revisited.
+<P>
+In most configurations, we use specialized sweep routines to handle common
+small object sizes. Since we allocate one mark bit per word, it becomes
+easier to examine the relevant mark bits if the object size divides
+the word length evenly. We also suitably unroll the inner sweep loop
+in each case. (It is conceivable that profile-based procedure cloning
+in the compiler could make this unnecessary and counterproductive. I
+know of no existing compiler to which this applies.)
+<P>
+The sweeping of small object pages could be avoided completely at the expense
+of examining mark bits directly in the allocator. This would probably
+be more expensive, since each allocation call would have to reload
+a large amount of state (e.g. next object address to be swept, position
+in mark bit table) before it could do its work. The current scheme
+keeps the allocator simple and allows useful optimizations in the sweeper.
+
+<H2>Finalization</h2>
+Both <TT>GC_register_disappearing_link</tt> and
+<TT>GC_register_finalizer</tt> add the request to a corresponding hash
+table. The hash table is allocated out of collected memory, but
+the reference to the finalizable object is hidden from the collector.
+Currently finalization requests are processed non-incrementally at the
+end of a mark cycle.
+<P>
+The collector makes an initial pass over the table of finalizable objects,
+pushing the contents of unmarked objects onto the mark stack.
+After pushing each object, the marker is invoked to mark all objects
+reachable from it. The object itself is not explicitly marked.
+This assures that objects on which a finalizer depends are neither
+collected nor finalized.
+<P>
+If in the process of marking from an object the
+object itself becomes marked, we have uncovered
+a cycle involving the object. This usually results in a warning from the
+collector. Such objects are not finalized, since it may be
+unsafe to do so. See the more detailed
+<A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/finalization.html"> discussion of finalization semantics</a>.
+<P>
+Any objects remaining unmarked at the end of this process are added to
+a queue of objects whose finalizers can be run. Depending on collector
+configuration, finalizers are dequeued and run either implicitly during
+allocation calls, or explicitly in response to a user request.
+(Note that the former is unfortunately both the default and not generally safe.
+If finalizers perform synchronization, it may result in deadlocks.
+Nontrivial finalizers generally need to perform synchronization, and
+thus require a different collector configuration.)
+<P>
+The collector provides a mechanism for replacing the procedure that is
+used to mark through objects. This is used both to provide support for
+Java-style unordered finalization, and to ignore certain kinds of cycles,
+<I>e.g.</i> those arising from C++ implementations of virtual inheritance.
+
+<H2>Generational Collection and Dirty Bits</h2>
+We basically use the concurrent and generational GC algorithm described in
+<A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/papers/pldi91.ps.Z">"Mostly Parallel Garbage Collection"</a>,
+by Boehm, Demers, and Shenker.
+<P>
+The most significant modification is that
+the collector always starts running in the allocating thread.
+There is no separate garbage collector thread. (If parallel GC is
+enabled, helper threads may also be woken up.)
+If an allocation attempt either requests a large object, or encounters
+an empty small object free list, and notices that there is a collection
+in progress, it immediately performs a small amount of marking work
+as described above.
+<P>
+This change was made both because we wanted to easily accommodate
+single-threaded environments, and because a separate GC thread requires
+very careful control over the scheduler to prevent the mutator from
+out-running the collector, and hence provoking unneeded heap growth.
+<P>
+In incremental mode, the heap is always expanded when we encounter
+insufficient space for an allocation. Garbage collection is triggered
+whenever we notice that more than
+<TT>GC_heap_size</tt>/2 * <TT>GC_free_space_divisor</tt>
+bytes of allocation have taken place.
+After <TT>GC_full_freq</tt> minor collections a major collection
+is started.
+<P>
+All collections initially run interrupted until a predetermined
+amount of time (50 msecs by default) has expired. If this allows
+the collection to complete entirely, we can avoid correcting
+for data structure modifications during the collection. If it does
+not complete, we return control to the mutator, and perform small
+amounts of additional GC work during those later allocations that
+cannot be satisfied from small object free lists. When marking completes,
+the set of modified pages is retrieved, and we mark once again from
+marked objects on those pages, this time with the mutator stopped.
+<P>
+We keep track of modified pages using one of several distinct mechanisms:
+<OL>
+<LI>
+Through explicit mutator cooperation. Currently this requires
+the use of <TT>GC_malloc_stubborn</tt>, and is rarely used.
+<LI>
+(<TT>MPROTECT_VDB</tt>) By write-protecting physical pages and
+catching write faults. This is
+implemented for many Unix-like systems and for win32. It is not possible
+in a few environments.
+<LI>
+(<TT>PROC_VDB</tt>) By retrieving dirty bit information from /proc.
+(Currently only Sun's
+Solaris supports this. Though this is considerably cleaner, performance
+may actually be better with mprotect and signals.)
+<LI>
+(<TT>PCR_VDB</tt>) By relying on an external dirty bit implementation, in this
+case the one in Xerox PCR.
+<LI>
+(<TT>DEFAULT_VDB</tt>) By treating all pages as dirty. This is the default if
+none of the other techniques is known to be usable, and
+<TT>GC_malloc_stubborn</tt> is not used. Practical only for testing, or if
+the vast majority of objects use <TT>GC_malloc_stubborn</tt>.
+</ol>
+
+<H2>Black-listing</h2>
+
+The collector implements <I>black-listing</i> of pages, as described
+in
+<A HREF="http://www.acm.org/pubs/citations/proceedings/pldi/155090/p197-boehm/">
+Boehm, ``Space Efficient Conservative Collection'', PLDI '93</a>, also available
+<A HREF="papers/pldi93.ps.Z">here</a>.
+<P>
+During the mark phase, the collector tracks ``near misses'', i.e. attempts
+to follow a ``pointer'' to just outside the garbage-collected heap, or
+to a currently unallocated page inside the heap. Pages that have been
+the targets of such near misses are likely to be the targets of
+misidentified ``pointers'' in the future. To minimize the future
+damage caused by such misidentifications they will be allocated only to
+small pointerfree objects.
+<P>
+The collector understands two different kinds of black-listing. A
+page may be black listed for interior pointer references
+(<TT>GC_add_to_black_list_stack</tt>), if it was the target of a near
+miss from a location that requires interior pointer recognition,
+<I>e.g.</i> the stack, or the heap if <TT>GC_all_interior_pointers</tt>
+is set. In this case, we also avoid allocating large blocks that include
+this page.
+<P>
+If the near miss came from a source that did not require interior
+pointer recognition, it is black-listed with
+<TT>GC_add_to_black_list_normal</tt>.
+A page black-listed in this way may appear inside a large object,
+so long as it is not the first page of a large object.
+<P>
+The <TT>GC_allochblk</tt> routine respects black-listing when assigning
+a block to a particular object kind and size. It occasionally
+drops (i.e. allocates and forgets) blocks that are completely black-listed
+in order to avoid excessively long large block free lists containing
+only unusable blocks. This would otherwise become an issue
+if there is low demand for small pointerfree objects.
+
+<H2>Thread support</h2>
+We support several different threading models. Unfortunately Pthreads,
+the only reasonably well standardized thread model, supports too narrow
+an interface for conservative garbage collection. There appears to be
+no completely portable way to allow the collector to coexist with various Pthreads
+implementations. Hence we currently support only a few of the more
+common Pthreads implementations.
+<P>
+In particular, it is very difficult for the collector to stop all other
+threads in the system and examine the register contents. This is currently
+accomplished with very different mechanisms for some Pthreads
+implementations. The Solaris implementation temporarily disables much
+of the user-level threads implementation by stopping kernel-level threads
+("lwp"s). The Linux/HPUX/OSF1 and Irix implementations sends signals to
+individual Pthreads and has them wait in the signal handler.
+<P>
+The Linux and Irix implementations use
+only documented Pthreads calls, but rely on extensions to their semantics.
+The Linux implementation <TT>linux_threads.c</tt> relies on only very
+mild extensions to the pthreads semantics, and already supports a large number
+of other Unix-like pthreads implementations. Our goal is to make this the
+only pthread support in the collector.
+<P>
+(The Irix implementation is separate only for historical reasons and should
+clearly be merged. The current Solaris implementation probably performs
+better in the uniprocessor case, but does not support thread operations in the
+collector. Hence it cannot support the parallel marker.)
+<P>
+All implementations must
+intercept thread creation and a few other thread-specific calls to allow
+enumeration of threads and location of thread stacks. This is current
+accomplished with <TT># define</tt>'s in <TT>gc.h</tt>
+(really <TT>gc_pthread_redirects.h</tt>), or optionally
+by using ld's function call wrapping mechanism under Linux.
+<P>
+Comments are appreciated. Please send mail to
+<A HREF="mailto:boehm@acm.org"><TT>boehm@acm.org</tt></a> or
+<A HREF="mailto:Hans.Boehm@hp.com"><TT>Hans.Boehm@hp.com</tt></a>
+<P>
+This is a modified copy of a page written while the author was at SGI.
+The original was <A HREF="http://reality.sgi.com/boehm/gcdescr.html">here</a>.
+</body>
+</html>
--- /dev/null
+<!DOCTYPE HTML>
+<HEAD>
+<TITLE>Garbage Collector Interface</TITLE>
+</HEAD>
+<BODY>
+<H1>C Interface</h1>
+On many platforms, a single-threaded garbage collector library can be built
+to act as a plug-in malloc replacement. (Build with -DREDIRECT_MALLOC=GC_malloc
+-DIGNORE_FREE.) This is often the best way to deal with third-party libraries
+which leak or prematurely free objects. -DREDIRECT_MALLOC is intended
+primarily as an easy way to adapt old code, not for new development.
+<P>
+New code should use the interface discussed below.
+<P>
+Code must be linked against the GC library. On most UNIX platforms,
+this will be gc.a.
+<P>
+The following describes the standard C interface to the garbage collector.
+It is not a complete definition of the interface. It describes only the
+most commonly used functionality, approximately in decreasing order of
+frequency of use. The description assumes an ANSI C compiler.
+The full interface is described in
+<A HREF="http://hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gch.txt">gc.h</a>
+or <TT>gc.h</tt> in the distribution.
+<P>
+Clients should include gc.h.
+<P>
+In the case of multithreaded code,
+gc.h should be included after the threads header file, and
+after defining the appropriate GC_XXXX_THREADS macro.
+(For 6.2alpha4 and later, simply defining GC_THREADS should suffice.)
+Gc.h must be included
+in files that use either GC or threads primitives, since threads primitives
+will be redefined to cooperate with the GC on many platforms.
+<DL>
+<DT> <B>void * GC_MALLOC(size_t <I>nbytes</i>)</b>
+<DD>
+Allocates and clears <I>nbytes</i> of storage.
+Requires (amortized) time proportional to <I>nbytes</i>.
+The resulting object will be automatically deallocated when unreferenced.
+References from objects allocated with the system malloc are usually not
+considered by the collector. (See GC_MALLOC_UNCOLLECTABLE, however.)
+GC_MALLOC is a macro which invokes GC_malloc by default or, if GC_DEBUG
+is defined before gc.h is included, a debugging version that checks
+occasionally for overwrite errors, and the like.
+<DT> <B>void * GC_MALLOC_ATOMIC(size_t <I>nbytes</i>)</b>
+<DD>
+Allocates <I>nbytes</i> of storage.
+Requires (amortized) time proportional to <I>nbytes</i>.
+The resulting object will be automatically deallocated when unreferenced.
+The client promises that the resulting object will never contain any pointers.
+The memory is not cleared.
+This is the preferred way to allocate strings, floating point arrays,
+bitmaps, etc.
+More precise information about pointer locations can be communicated to the
+collector using the interface in
+<A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gc_typedh.txt">gc_typed.h</a> in the distribution.
+<DT> <B>void * GC_MALLOC_UNCOLLECTABLE(size_t <I>nbytes</i>)</b>
+<DD>
+Identical to GC_MALLOC, except that the resulting object is not automatically
+deallocated. Unlike the system-provided malloc, the collector does
+scan the object for pointers to garbage-collectable memory, even if the
+block itself does not appear to be reachable. (Objects allocated in this way
+are effectively treated as roots by the collector.)
+<DT> <B> void * GC_REALLOC(void *old, size_t new_size) </b>
+<DD>
+Allocate a new object of the indicated size and copy (a prefix of) the
+old object into the new object. The old object is reused in place if
+convenient. If the original object was allocated with GC_malloc_atomic,
+the new object is subject to the same constraints. If it was allocated
+as an uncollectable object, then the new object is uncollectable, and
+the old object (if different) is deallocated.
+(Use GC_REALLOC with GC_MALLOC, etc.)
+<DT> <B> void GC_FREE(void *dead) </b>
+<DD>
+Explicitly deallocate an object. Typically not useful for small
+collectable objects. (Use GC_FREE with GC_MALLOC, etc.)
+<DT> <B> void * GC_MALLOC_IGNORE_OFF_PAGE(size_t <I>nbytes</i>) </b>
+<DD>
+<DT> <B> void * GC_MALLOC_ATOMIC_IGNORE_OFF_PAGE(size_t <I>nbytes</i>) </b>
+<DD>
+Analogous to GC_MALLOC and GC_MALLOC_ATOMIC, except that the client
+guarantees that as long
+as the resulting object is of use, a pointer is maintained to someplace
+inside the first 512 bytes of the object. This pointer should be declared
+volatile to avoid interference from compiler optimizations.
+(Other nonvolatile pointers to the object may exist as well.)
+This is the
+preferred way to allocate objects that are likely to be > 100KBytes in size.
+It greatly reduces the risk that such objects will be accidentally retained
+when they are no longer needed. Thus space usage may be significantly reduced.
+<DT> <B> void GC_gcollect(void) </b>
+<DD>
+Explicitly force a garbage collection.
+<DT> <B> void GC_enable_incremental(void) </b>
+<DD>
+Cause the garbage collector to perform a small amount of work
+every few invocations of GC_malloc or the like, instead of performing
+an entire collection at once. This is likely to increase total
+running time. It will improve response on a platform that either has
+suitable support in the garbage collector (Irix and most other Unix
+versions, win32 if the collector was suitably built) or if "stubborn"
+allocation is used (see <A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gch.txt">gc.h</a>).
+On many platforms this interacts poorly with system calls
+that write to the garbage collected heap.
+<DT> <B> GC_warn_proc GC_set_warn_proc(GC_warn_proc p) </b>
+<DD>
+Replace the default procedure used by the collector to print warnings.
+The collector
+may otherwise write to sterr, most commonly because GC_malloc was used
+in a situation in which GC_malloc_ignore_off_page would have been more
+appropriate. See <A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gch.txt">gc.h</a> for details.
+<DT> <B> void GC_register_finalizer(...) </b>
+<DD>
+Register a function to be called when an object becomes inaccessible.
+This is often useful as a backup method for releasing system resources
+(<I>e.g.</i> closing files) when the object referencing them becomes
+inaccessible.
+It is not an acceptable method to perform actions that must be performed
+in a timely fashion.
+See <A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gch.txt">gc.h</a> for details of the interface.
+See <A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/finalization.html">here</a> for a more detailed discussion
+of the design.
+<P>
+Note that an object may become inaccessible before client code is done
+operating on its fields. Suitable synchronization is usually required.
+See <A HREF="http://portal.acm.org/citation.cfm?doid=604131.604153">here</a>
+or <A HREF="http://www.hpl.hp.com/techreports/2002/HPL-2002-335.html">here</a>
+for details.
+</dl>
+<P>
+If you are concerned with multiprocessor performance and scalability,
+you should consider enabling and using thread local allocation (<I>e.g.</i>
+GC_LOCAL_MALLOC, see <TT>gc_local_alloc.h</tt>. If your platform
+supports it, you should build the collector with parallel marking support
+(-DPARALLEL_MARK, or --enable-parallel-mark).
+<P>
+If the collector is used in an environment in which pointer location
+information for heap objects is easily available, this can be passed on
+to the colllector using the interfaces in either <TT>gc_typed.h</tt>
+or <TT>gc_gcj.h</tt>.
+<P>
+The collector distribution also includes a <B>string package</b> that takes
+advantage of the collector. For details see
+<A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/cordh.txt">cord.h</a>
+
+<H1>C++ Interface</h1>
+There are three distinct ways to use the collector from C++:
+<DL>
+<DT> <B> STL allocators </b>
+<DD>
+Users of the <A HREF="http://www.sgi.com/tech/stl">SGI extended STL</a>
+can include <TT>new_gc_alloc.h</tt> before including
+STL header files.
+(<TT>gc_alloc.h</tt> corresponds to now obsolete versions of the
+SGI STL.)
+This defines SGI-style allocators
+<UL>
+<LI> alloc
+<LI> single_client_alloc
+<LI> gc_alloc
+<LI> single_client_gc_alloc
+</ul>
+which may be used either directly to allocate memory or to instantiate
+container templates. The first two allocate uncollectable but traced
+memory, while the second two allocate collectable memory.
+The single_client versions are not safe for concurrent access by
+multiple threads, but are faster.
+<P>
+For an example, click <A HREF="http://hpl.hp.com/personal/Hans_Boehm/gc/gc_alloc_exC.txt">here</a>.
+<P>
+Recent versions of the collector also include a more standard-conforming
+allocator implemention in <TT>gc_allocator.h</tt>. It defines
+<UL>
+<LI> traceable_allocator
+<LI> gc_allocator
+</ul>
+Again the former allocates uncollectable but traced memory.
+This should work with any fully standard-conforming C++ compiler.
+<DT> <B> Class inheritance based interface </b>
+<DD>
+Users may include gc_cpp.h and then cause members of certain classes to
+be allocated in garbage collectable memory by inheriting from class gc.
+For details see <A HREF="http://hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gc_cpph.txt">gc_cpp.h</a>.
+<DT> <B> C interface </b>
+<DD>
+It is also possible to use the C interface from
+<A HREF="http://hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gch.txt">gc.h</a> directly.
+On platforms which use malloc to implement ::new, it should usually be possible
+to use a version of the collector that has been compiled as a malloc
+replacement. It is also possible to replace ::new and other allocation
+functions suitably.
+<P>
+Note that user-implemented small-block allocation often works poorly with
+an underlying garbage-collected large block allocator, since the collector
+has to view all objects accessible from the user's free list as reachable.
+This is likely to cause problems if GC_malloc is used with something like
+the original HP version of STL.
+This approach works with the SGI versions of the STL only if the
+<TT>malloc_alloc</tt> allocator is used.
+</dl>
+</body>
+</html>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>Using the Garbage Collector as Leak Detector</title>
+</head>
+<BODY>
+<H1>Using the Garbage Collector as Leak Detector</h1>
+The garbage collector may be used as a leak detector.
+In this case, the primary function of the collector is to report
+objects that were allocated (typically with <TT>GC_MALLOC</tt>),
+not deallocated (normally with <TT>GC_FREE</tt>), but are
+no longer accessible. Since the object is no longer accessible,
+there in normally no way to deallocate the object at a later time;
+thus it can safely be assumed that the object has been "leaked".
+<P>
+This is substantially different from counting leak detectors,
+which simply verify that all allocated objects are eventually
+deallocated. A garbage-collector based leak detector can provide
+somewhat more precise information when an object was leaked.
+More importantly, it does not report objects that are never
+deallocated because they are part of "permanent" data structures.
+Thus it does not require all objects to be deallocated at process
+exit time, a potentially useless activity that often triggers
+large amounts of paging.
+<P>
+All non-ancient versions of the garbage collector provide
+leak detection support. Version 5.3 adds the following
+features:
+<OL>
+<LI> Leak detection mode can be initiated at run-time by
+setting GC_find_leak instead of building the collector with FIND_LEAK
+defined. This variable should be set to a nonzero value
+at program startup.
+<LI> Leaked objects should be reported and then correctly garbage collected.
+Prior versions either reported leaks or functioned as a garbage collector.
+</ol>
+For the rest of this description we will give instructions that work
+with any reasonable version of the collector.
+<P>
+To use the collector as a leak detector, follow the following steps:
+<OL>
+<LI> Build the collector with -DFIND_LEAK. Otherwise use default
+build options.
+<LI> Change the program so that all allocation and deallocation goes
+through the garbage collector.
+<LI> Arrange to call <TT>GC_gcollect</tt> at appropriate points to check
+for leaks.
+(For sufficiently long running programs, this will happen implicitly,
+but probably not with sufficient frequency.)
+</ol>
+The second step can usually be accomplished with the
+<TT>-DREDIRECT_MALLOC=GC_malloc</tt> option when the collector is built,
+or by defining <TT>malloc</tt>, <TT>calloc</tt>,
+<TT>realloc</tt> and <TT>free</tt>
+to call the corresponding garbage collector functions.
+But this, by itself, will not yield very informative diagnostics,
+since the collector does not keep track of information about
+how objects were allocated. The error reports will include
+only object addresses.
+<P>
+For more precise error reports, as much of the program as possible
+should use the all uppercase variants of these functions, after
+defining <TT>GC_DEBUG</tt>, and then including <TT>gc.h</tt>.
+In this environment <TT>GC_MALLOC</tt> is a macro which causes
+at least the file name and line number at the allocation point to
+be saved as part of the object. Leak reports will then also include
+this information.
+<P>
+Many collector features (<I>e.g</i> stubborn objects, finalization,
+and disappearing links) are less useful in this context, and are not
+fully supported. Their use will usually generate additional bogus
+leak reports, since the collector itself drops some associated objects.
+<P>
+The same is generally true of thread support. However, as of 6.0alpha4,
+correct leak reports should be generated with linuxthreads.
+<P>
+On a few platforms (currently Solaris/SPARC, Irix, and, with -DSAVE_CALL_CHAIN,
+Linux/X86), <TT>GC_MALLOC</tt>
+also causes some more information about its call stack to be saved
+in the object. Such information is reproduced in the error
+reports in very non-symbolic form, but it can be very useful with the
+aid of a debugger.
+<H2>An Example</h2>
+The following header file <TT>leak_detector.h</tt> is included in the
+"include" subdirectory of the distribution:
+<PRE>
+#define GC_DEBUG
+#include "gc.h"
+#define malloc(n) GC_MALLOC(n)
+#define calloc(m,n) GC_MALLOC((m)*(n))
+#define free(p) GC_FREE(p)
+#define realloc(p,n) GC_REALLOC((p),(n))
+#define CHECK_LEAKS() GC_gcollect()
+</pre>
+<P>
+Assume the collector has been built with -DFIND_LEAK. (For very
+new versions of the collector, we could instead add the statement
+<TT>GC_find_leak = 1</tt> as the first statement in <TT>main</tt>.
+<P>
+The program to be tested for leaks can then look like:
+<PRE>
+#include "leak_detector.h"
+
+main() {
+ int *p[10];
+ int i;
+ /* GC_find_leak = 1; for new collector versions not */
+ /* compiled with -DFIND_LEAK. */
+ for (i = 0; i < 10; ++i) {
+ p[i] = malloc(sizeof(int)+i);
+ }
+ for (i = 1; i < 10; ++i) {
+ free(p[i]);
+ }
+ for (i = 0; i < 9; ++i) {
+ p[i] = malloc(sizeof(int)+i);
+ }
+ CHECK_LEAKS();
+}
+</pre>
+<P>
+On an Intel X86 Linux system this produces on the stderr stream:
+<PRE>
+Leaked composite object at 0x806dff0 (leak_test.c:8, sz=4)
+</pre>
+(On most unmentioned operating systems, the output is similar to this.
+If the collector had been built on Linux/X86 with -DSAVE_CALL_CHAIN,
+the output would be closer to the Solaris example. For this to work,
+the program should not be compiled with -fomit_frame_pointer.)
+<P>
+On Irix it reports
+<PRE>
+Leaked composite object at 0x10040fe0 (leak_test.c:8, sz=4)
+ Caller at allocation:
+ ##PC##= 0x10004910
+</pre>
+and on Solaris the error report is
+<PRE>
+Leaked composite object at 0xef621fc8 (leak_test.c:8, sz=4)
+ Call chain at allocation:
+ args: 4 (0x4), 200656 (0x30FD0)
+ ##PC##= 0x14ADC
+ args: 1 (0x1), -268436012 (0xEFFFFDD4)
+ ##PC##= 0x14A64
+</pre>
+In the latter two cases some additional information is given about
+how malloc was called when the leaked object was allocated. For
+Solaris, the first line specifies the arguments to <TT>GC_debug_malloc</tt>
+(the actual allocation routine), The second the program counter inside
+main, the third the arguments to <TT>main</tt>, and finally the program
+counter inside the caller to main (i.e. in the C startup code).
+<P>
+In the Irix case, only the address inside the caller to main is given.
+<P>
+In many cases, a debugger is needed to interpret the additional information.
+On systems supporting the "adb" debugger, the <TT>callprocs</tt> script
+can be used to replace program counter values with symbolic names.
+As of version 6.1, the collector tries to generate symbolic names for
+call stacks if it knows how to do so on the platform. This is true on
+Linux/X86, but not on most other platforms.
+<H2>Simplified leak detection under Linux</h2>
+Since version 6.1, it should be possible to run the collector in leak
+detection mode on a program a.out under Linux/X86 as follows:
+<OL>
+<LI> Ensure that a.out is a single-threaded executable. This doesn't yet work
+for multithreaded programs.
+<LI> If possible, ensure that the addr2line program is installed in
+/usr/bin. (It comes with RedHat Linux.)
+<LI> If possible, compile a.out with full debug information.
+This will improve the quality of the leak reports. With this approach, it is
+no longer necessary to call GC_ routines explicitly, though that can also
+improve the quality of the leak reports.
+<LI> Build the collector and install it in directory <I>foo</i> as follows:
+<UL>
+<LI> configure --prefix=<I>foo</i> --enable-full-debug --enable-redirect-malloc
+--disable-threads
+<LI> make
+<LI> make install
+</ul>
+<LI> Set environment variables as follows:
+<UL>
+<LI> LD_PRELOAD=<I>foo</i>/lib/libgc.so
+<LI> GC_FIND_LEAK
+<LI> You may also want to set GC_PRINT_STATS (to confirm that the collector
+is running) and/or GC_LOOP_ON_ABORT (to facilitate debugging from another
+window if something goes wrong).
+</ul
+<LI> Simply run a.out as you normally would. Note that if you run anything
+else (<I>e.g.</i> your editor) with those environment variables set,
+it will also be leak tested. This may or may not be useful and/or
+embarrassing. It can generate
+mountains of leak reports if the application wasn't designed to avoid leaks,
+<I>e.g.</i> because it's always short-lived.
+</ol>
+This has not yet been thropughly tested on large applications, but it's known
+to do the right thing on at least some small ones.
+</body>
+</html>
--- /dev/null
+<HTML>
+<HEAD>
+<TITLE>Garbage collector scalability</TITLE>
+</HEAD>
+<BODY>
+<H1>Garbage collector scalability</h1>
+In its default configuration, the Boehm-Demers-Weiser garbage collector
+is not thread-safe. It can be made thread-safe for a number of environments
+by building the collector with the appropriate
+<TT>-D</tt><I>XXX</i><TT>-THREADS</tt> compilation
+flag. This has primarily two effects:
+<OL>
+<LI> It causes the garbage collector to stop all other threads when
+it needs to see a consistent memory state.
+<LI> It causes the collector to acquire a lock around essentially all
+allocation and garbage collection activity.
+</ol>
+Since a single lock is used for all allocation-related activity, only one
+thread can be allocating or collecting at one point. This inherently
+limits performance of multi-threaded applications on multiprocessors.
+<P>
+On most platforms, the allocator/collector lock is implemented as a
+spin lock with exponential back-off. Longer wait times are implemented
+by yielding and/or sleeping. If a collection is in progress, the pure
+spinning stage is skipped. This has the advantage that uncontested and
+thus most uniprocessor lock acquisitions are very cheap. It has the
+disadvantage that the application may sleep for small periods of time
+even when there is work to be done. And threads may be unnecessarily
+woken up for short periods. Nonetheless, this scheme empirically
+outperforms native queue-based mutual exclusion implementations in most
+cases, sometimes drastically so.
+<H2>Options for enhanced scalability</h2>
+Version 6.0 of the collector adds two facilities to enhance collector
+scalability on multiprocessors. As of 6.0alpha1, these are supported
+only under Linux on X86 and IA64 processors, though ports to other
+otherwise supported Pthreads platforms should be straightforward.
+They are intended to be used together.
+<UL>
+<LI>
+Building the collector with <TT>-DPARALLEL_MARK</tt> allows the collector to
+run the mark phase in parallel in multiple threads, and thus on multiple
+processors. The mark phase typically consumes the large majority of the
+collection time. Thus this largely parallelizes the garbage collector
+itself, though not the allocation process. Currently the marking is
+performed by the thread that triggered the collection, together with
+<I>N</i>-1 dedicated
+threads, where <I>N</i> is the number of processors detected by the collector.
+The dedicated threads are created once at initialization time.
+<P>
+A second effect of this flag is to switch to a more concurrent
+implementation of <TT>GC_malloc_many</tt>, so that free lists can be
+built, and memory can be cleared, by more than one thread concurrently.
+<LI>
+Building the collector with -DTHREAD_LOCAL_ALLOC adds support for thread
+local allocation. It does not, by itself, cause thread local allocation
+to be used. It simply allows the use of the interface in
+<TT>gc_local_alloc.h</tt>.
+<P>
+Memory returned from thread-local allocators is completely interchangeable
+with that returned by the standard allocators. It may be used by other
+threads. The only difference is that, if the thread allocates enough
+memory of a certain kind, it will build a thread-local free list for
+objects of that kind, and allocate from that. This greatly reduces
+locking. The thread-local free lists are refilled using
+<TT>GC_malloc_many</tt>.
+<P>
+An important side effect of this flag is to replace the default
+spin-then-sleep lock to be replace by a spin-then-queue based implementation.
+This <I>reduces performance</i> for the standard allocation functions,
+though it usually improves performance when thread-local allocation is
+used heavily, and thus the number of short-duration lock acquisitions
+is greatly reduced.
+</ul>
+<P>
+The easiest way to switch an application to thread-local allocation is to
+<OL>
+<LI> Define the macro <TT>GC_REDIRECT_TO_LOCAL</tt>,
+and then include the <TT>gc.h</tt>
+header in each client source file.
+<LI> Invoke <TT>GC_thr_init()</tt> before any allocation.
+<LI> Allocate using <TT>GC_MALLOC</tt>, <TT>GC_MALLOC_ATOMIC</tt>,
+and/or <TT>GC_GCJ_MALLOC</tt>.
+</ol>
+<H2>The Parallel Marking Algorithm</h2>
+We use an algorithm similar to
+<A HREF="http://www.yl.is.s.u-tokyo.ac.jp/gc/">that developed by
+Endo, Taura, and Yonezawa</a> at the University of Tokyo.
+However, the data structures and implementation are different,
+and represent a smaller change to the original collector source,
+probably at the expense of extreme scalability. Some of
+the refinements they suggest, <I>e.g.</i> splitting large
+objects, were also incorporated into out approach.
+<P>
+The global mark stack is transformed into a global work queue.
+Unlike the usual case, it never shrinks during a mark phase.
+The mark threads remove objects from the queue by copying them to a
+local mark stack and changing the global descriptor to zero, indicating
+that there is no more work to be done for this entry.
+This removal
+is done with no synchronization. Thus it is possible for more than
+one worker to remove the same entry, resulting in some work duplication.
+<P>
+The global work queue grows only if a marker thread decides to
+return some of its local mark stack to the global one. This
+is done if the global queue appears to be running low, or if
+the local stack is in danger of overflowing. It does require
+synchronization, but should be relatively rare.
+<P>
+The sequential marking code is reused to process local mark stacks.
+Hence the amount of additional code required for parallel marking
+is minimal.
+<P>
+It should be possible to use generational collection in the presence of the
+parallel collector, by calling <TT>GC_enable_incremental()</tt>.
+This does not result in fully incremental collection, since parallel mark
+phases cannot currently be interrupted, and doing so may be too
+expensive.
+<P>
+Gcj-style mark descriptors do not currently mix with the combination
+of local allocation and incremental collection. They should work correctly
+with one or the other, but not both.
+<P>
+The number of marker threads is set on startup to the number of
+available processors (or to the value of the <TT>GC_NPROCS</tt>
+environment variable). If only a single processor is detected,
+parallel marking is disabled.
+<P>
+Note that setting GC_NPROCS to 1 also causes some lock acquisitions inside
+the collector to immediately yield the processor instead of busy waiting
+first. In the case of a multiprocessor and a client with multiple
+simultaneously runnable threads, this may have disastrous performance
+consequences (e.g. a factor of 10 slowdown).
+<H2>Performance</h2>
+We conducted some simple experiments with a version of
+<A HREF="gc_bench.html">our GC benchmark</a> that was slightly modified to
+run multiple concurrent client threads in the same address space.
+Each client thread does the same work as the original benchmark, but they share
+a heap.
+This benchmark involves very little work outside of memory allocation.
+This was run with GC 6.0alpha3 on a dual processor Pentium III/500 machine
+under Linux 2.2.12.
+<P>
+Running with a thread-unsafe collector, the benchmark ran in 9
+seconds. With the simple thread-safe collector,
+built with <TT>-DLINUX_THREADS</tt>, the execution time
+increased to 10.3 seconds, or 23.5 elapsed seconds with two clients.
+(The times for the <TT>malloc</tt>/i<TT>free</tt> version
+with glibc <TT>malloc</tt>
+are 10.51 (standard library, pthreads not linked),
+20.90 (one thread, pthreads linked),
+and 24.55 seconds respectively. The benchmark favors a
+garbage collector, since most objects are small.)
+<P>
+The following table gives execution times for the collector built
+with parallel marking and thread-local allocation support
+(<TT>-DGC_LINUX_THREADS -DPARALLEL_MARK -DTHREAD_LOCAL_ALLOC</tt>). We tested
+the client using either one or two marker threads, and running
+one or two client threads. Note that the client uses thread local
+allocation exclusively. With -DTHREAD_LOCAL_ALLOC the collector
+switches to a locking strategy that is better tuned to less frequent
+lock acquisition. The standard allocation primitives thus peform
+slightly worse than without -DTHREAD_LOCAL_ALLOC, and should be
+avoided in time-critical code.
+<P>
+(The results using <TT>pthread_mutex_lock</tt>
+directly for allocation locking would have been worse still, at
+least for older versions of linuxthreads.
+With THREAD_LOCAL_ALLOC, we first repeatedly try to acquire the
+lock with pthread_mutex_try_lock(), busy_waiting between attempts.
+After a fixed number of attempts, we use pthread_mutex_lock().)
+<P>
+These measurements do not use incremental collection, nor was prefetching
+enabled in the marker. We used the C version of the benchmark.
+All measurements are in elapsed seconds on an unloaded machine.
+<P>
+<TABLE BORDER ALIGN="CENTER">
+<TR><TH>Number of threads</th><TH>1 marker thread (secs.)</th>
+<TH>2 marker threads (secs.)</th></tr>
+<TR><TD>1 client</td><TD ALIGN="CENTER">10.45</td><TD ALIGN="CENTER">7.85</td>
+<TR><TD>2 clients</td><TD ALIGN="CENTER">19.95</td><TD ALIGN="CENTER">12.3</td>
+</table>
+<PP>
+The execution time for the single threaded case is slightly worse than with
+simple locking. However, even the single-threaded benchmark runs faster than
+even the thread-unsafe version if a second processor is available.
+The execution time for two clients with thread local allocation time is
+only 1.4 times the sequential execution time for a single thread in a
+thread-unsafe environment, even though it involves twice the client work.
+That represents close to a
+factor of 2 improvement over the 2 client case with the old collector.
+The old collector clearly
+still suffered from some contention overhead, in spite of the fact that the
+locking scheme had been fairly well tuned.
+<P>
+Full linear speedup (i.e. the same execution time for 1 client on one
+processor as 2 clients on 2 processors)
+is probably not achievable on this kind of
+hardware even with such a small number of processors,
+since the memory system is
+a major constraint for the garbage collector,
+the processors usually share a single memory bus, and thus
+the aggregate memory bandwidth does not increase in
+proportion to the number of processors.
+<P>
+These results are likely to be very sensitive to both hardware and OS
+issues. Preliminary experiments with an older Pentium Pro machine running
+an older kernel were far less encouraging.
+
+</body>
+</html>
--- /dev/null
+<HTML>
+<HEAD>
+ <TITLE> Two-Level Tree Structure for Fast Pointer Lookup</TITLE>
+ <AUTHOR> Hans-J. Boehm, Silicon Graphics (now at HP)</author>
+</HEAD>
+<BODY>
+<H1>Two-Level Tree Structure for Fast Pointer Lookup</h1>
+<P>
+The conservative garbage collector described
+<A HREF="http://www.hpl.hp.com/personal/Hans_Boehm/gc/">here</a>
+uses a 2-level tree
+data structure to aid in fast pointer identification.
+This data structure is described in a bit more detail here, since
+<OL>
+<LI> Variations of the data structure are more generally useful.
+<LI> It appears to be hard to understand by reading the code.
+<LI> Some other collectors appear to use inferior data structures to
+solve the same problem.
+<LI> It is central to fast collector operation.
+</ol>
+A candidate pointer is divided into three sections, the <I>high</i>,
+<I>middle</i>, and <I>low</i> bits. The exact division between these
+three groups of bits is dependent on the detailed collector configuration.
+<P>
+The high and middle bits are used to look up an entry in the table described
+here. The resulting table entry consists of either a block descriptor
+(<TT>struct hblkhdr *</tt> or <TT>hdr *</tt>)
+identifying the layout of objects in the block, or an indication that this
+address range corresponds to the middle of a large block, together with a
+hint for locating the actual block descriptor. Such a hint consist
+of a displacement that can be subtracted from the middle bits of the candidate
+pointer without leaving the object.
+<P>
+In either case, the block descriptor (<TT>struct hblkhdr</tt>)
+refers to a table of object starting addresses (the <TT>hb_map</tt> field).
+The starting address table is indexed by the low bits if the candidate pointer.
+The resulting entry contains a displacement to the beginning of the object,
+or an indication that this cannot be a valid object pointer.
+(If all interior pointer are recognized, pointers into large objects
+are handled specially, as appropriate.)
+
+<H2>The Tree</h2>
+<P>
+The rest of this discussion focuses on the two level data structure
+used to map the high and middle bits to the block descriptor.
+<P>
+The high bits are used as an index into the <TT>GC_top_index</tt> (really
+<TT>GC_arrays._top_index</tt>) array. Each entry points to a
+<TT>bottom_index</tt> data structure. This structure in turn consists
+mostly of an array <TT>index</tt> indexed by the middle bits of
+the candidate pointer. The <TT>index</tt> array contains the actual
+<TT>hdr</tt> pointers.
+<P>
+Thus a pointer lookup consists primarily of a handful of memory references,
+and can be quite fast:
+<OL>
+<LI> The appropriate <TT>bottom_index</tt> pointer is looked up in
+<TT>GC_top_index</tt>, based on the high bits of the candidate pointer.
+<LI> The appropriate <TT>hdr</tt> pointer is looked up in the
+<TT>bottom_index</tt> structure, based on the middle bits.
+<LI> The block layout map pointer is retrieved from the <TT>hdr</tt>
+structure. (This memory reference is necessary since we try to share
+block layout maps.)
+<LI> The displacement to the beginning of the object is retrieved from the
+above map.
+</ol>
+<P>
+In order to conserve space, not all <TT>GC_top_index</tt> entries in fact
+point to distinct <TT>bottom_index</tt> structures. If no address with
+the corresponding high bits is part of the heap, then the entry points
+to <TT>GC_all_nils</tt>, a single <TT>bottom_index</tt> structure consisting
+only of NULL <TT>hdr</tt> pointers.
+<P>
+<TT>Bottom_index</tt> structures contain slightly more information than
+just <TT>hdr</tt> pointers. The <TT>asc_link</tt> field is used to link
+all <TT>bottom_index</tt> structures in ascending order for fast traversal.
+This list is pointed to be <TT>GC_all_bottom_indices</tt>.
+It is maintained with the aid of <TT>key</tt> field that contains the
+high bits corresponding to the <TT>bottom_index</tt>.
+
+<H2>64 bit addresses</h2>
+<P>
+In the case of 64 bit addresses, this picture is complicated slightly
+by the fact that one of the index structures would have to be huge to
+cover the entire address space with a two level tree. We deal with this
+by turning <TT>GC_top_index</tt> into a chained hash table, instead of
+a simple array. This adds a <TT>hash_link</tt> field to the
+<TT>bottom_index</tt> structure.
+<P>
+The "hash function" consists of dropping the high bits. This is cheap to
+compute, and guarantees that there will be no collisions if the heap
+is contiguous and not excessively large.
+
+<H2>A picture</h2>
+<P>
+The following is an ASCII diagram of the data structure.
+This was contributed by Dave Barrett several years ago.
+<PRE>
+
+ Data Structure used by GC_base in gc3.7:
+ 21-Apr-94
+
+
+
+
+ 63 LOG_TOP_SZ[11] LOG_BOTTOM_SZ[10] LOG_HBLKSIZE[13]
+ +------------------+----------------+------------------+------------------+
+ p:| | TL_HASH(hi) | | HBLKDISPL(p) |
+ +------------------+----------------+------------------+------------------+
+ \-----------------------HBLKPTR(p)-------------------/
+ \------------hi-------------------/
+ \______ ________/ \________ _______/ \________ _______/
+ V V V
+ | | |
+ GC_top_index[] | | |
+ --- +--------------+ | | |
+ ^ | | | | |
+ | | | | | |
+ TOP +--------------+<--+ | |
+ _SZ +-<| [] | * | |
+(items)| +--------------+ if 0 < bi< HBLKSIZE | |
+ | | | | then large object | |
+ | | | | starts at the bi'th | |
+ v | | | HBLK before p. | i |
+ --- | +--------------+ | (word- |
+ v | aligned) |
+ bi= |GET_BI(p){->hash_link}->key==hi | |
+ v | |
+ | (bottom_index) \ scratch_alloc'd | |
+ | ( struct bi ) / by get_index() | |
+ --- +->+--------------+ | |
+ ^ | | | |
+ ^ | | | |
+ BOTTOM | | ha=GET_HDR_ADDR(p) | |
+_SZ(items)+--------------+<----------------------+ +-------+
+ | +--<| index[] | |
+ | | +--------------+ GC_obj_map: v
+ | | | | from / +-+-+-----+-+-+-+-+ ---
+ v | | | GC_add < 0| | | | | | | | ^
+ --- | +--------------+ _map_entry \ +-+-+-----+-+-+-+-+ |
+ | | asc_link | +-+-+-----+-+-+-+-+ MAXOBJSZ
+ | +--------------+ +-->| | | j | | | | | +1
+ | | key | | +-+-+-----+-+-+-+-+ |
+ | +--------------+ | +-+-+-----+-+-+-+-+ |
+ | | hash_link | | | | | | | | | | v
+ | +--------------+ | +-+-+-----+-+-+-+-+ ---
+ | | |<--MAX_OFFSET--->|
+ | | (bytes)
+HDR(p)| GC_find_header(p) | |<--MAP_ENTRIES-->|
+ | \ from | =HBLKSIZE/WORDSZ
+ | (hdr) (struct hblkhdr) / alloc_hdr() | (1024 on Alpha)
+ +-->+----------------------+ | (8/16 bits each)
+GET_HDR(p)| word hb_sz (words) | |
+ +----------------------+ |
+ | struct hblk *hb_next | |
+ +----------------------+ |
+ |mark_proc hb_mark_proc| |
+ +----------------------+ |
+ | char * hb_map |>-------------+
+ +----------------------+
+ | ushort hb_obj_kind |
+ +----------------------+
+ | hb_last_reclaimed |
+ --- +----------------------+
+ ^ | |
+ MARK_BITS| hb_marks[] | *if hdr is free, hb_sz + DISCARD_WORDS
+_SZ(words)| | is the size of a heap chunk (struct hblk)
+ v | | of at least MININCR*HBLKSIZE bytes (below),
+ --- +----------------------+ otherwise, size of each object in chunk.
+
+Dynamic data structures above are interleaved throughout the heap in blocks of
+size MININCR * HBLKSIZE bytes as done by gc_scratch_alloc which cannot be
+freed; free lists are used (e.g. alloc_hdr). HBLK's below are collected.
+
+ (struct hblk)
+ --- +----------------------+ < HBLKSIZE --- --- DISCARD_
+ ^ |garbage[DISCARD_WORDS]| aligned ^ ^ HDR_BYTES WORDS
+ | | | | v (bytes) (words)
+ | +-----hb_body----------+ < WORDSZ | --- ---
+ | | | aligned | ^ ^
+ | | Object 0 | | hb_sz |
+ | | | i |(word- (words)|
+ | | | (bytes)|aligned) v |
+ | + - - - - - - - - - - -+ --- | --- |
+ | | | ^ | ^ |
+ n * | | j (words) | hb_sz BODY_SZ
+ HBLKSIZE | Object 1 | v v | (words)
+ (bytes) | |--------------- v MAX_OFFSET
+ | + - - - - - - - - - - -+ --- (bytes)
+ | | | !All_INTERIOR_PTRS ^ |
+ | | | sets j only for hb_sz |
+ | | Object N | valid object offsets. | |
+ v | | All objects WORDSZ v v
+ --- +----------------------+ aligned. --- ---
+
+DISCARD_WORDS is normally zero. Indeed the collector has not been tested
+with another value in ages.
+</pre>
+</body>
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1997 by Silicon Graphics. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Original author: Bill Janssen
+ * Heavily modified by Hans Boehm and others
+ */
+
+/*
+ * This is incredibly OS specific code for tracking down data sections in
+ * dynamic libraries. There appears to be no way of doing this quickly
+ * without groveling through undocumented data structures. We would argue
+ * that this is a bug in the design of the dlopen interface. THIS CODE
+ * MAY BREAK IN FUTURE OS RELEASES. If this matters to you, don't hesitate
+ * to let your vendor know ...
+ *
+ * None of this is safe with dlclose and incremental collection.
+ * But then not much of anything is safe in the presence of dlclose.
+ */
+#if defined(__linux__) && !defined(_GNU_SOURCE)
+ /* Can't test LINUX, since this must be define before other includes */
+# define _GNU_SOURCE
+#endif
+#if !defined(MACOS) && !defined(_WIN32_WCE)
+# include <sys/types.h>
+#endif
+#include "private/gc_priv.h"
+
+/* BTL: avoid circular redefinition of dlopen if GC_SOLARIS_THREADS defined */
+# if (defined(GC_PTHREADS) || defined(GC_SOLARIS_THREADS)) \
+ && defined(dlopen) && !defined(GC_USE_LD_WRAP)
+ /* To support threads in Solaris, gc.h interposes on dlopen by */
+ /* defining "dlopen" to be "GC_dlopen", which is implemented below. */
+ /* However, both GC_FirstDLOpenedLinkMap() and GC_dlopen() use the */
+ /* real system dlopen() in their implementation. We first remove */
+ /* gc.h's dlopen definition and restore it later, after GC_dlopen(). */
+# undef dlopen
+# define GC_must_restore_redefined_dlopen
+# else
+# undef GC_must_restore_redefined_dlopen
+# endif
+
+#if (defined(DYNAMIC_LOADING) || defined(MSWIN32) || defined(MSWINCE)) \
+ && !defined(PCR)
+#if !defined(SUNOS4) && !defined(SUNOS5DL) && !defined(IRIX5) && \
+ !defined(MSWIN32) && !defined(MSWINCE) && \
+ !(defined(ALPHA) && defined(OSF1)) && \
+ !defined(HPUX) && !(defined(LINUX) && defined(__ELF__)) && \
+ !defined(RS6000) && !defined(SCO_ELF) && !defined(DGUX) && \
+ !(defined(FREEBSD) && defined(__ELF__)) && \
+ !(defined(NETBSD) && defined(__ELF__)) && !defined(HURD) && \
+ !defined(MACOSX)
+ --> We only know how to find data segments of dynamic libraries for the
+ --> above. Additional SVR4 variants might not be too
+ --> hard to add.
+#endif
+
+#include <stdio.h>
+#ifdef SUNOS5DL
+# include <sys/elf.h>
+# include <dlfcn.h>
+# include <link.h>
+#endif
+#ifdef SUNOS4
+# include <dlfcn.h>
+# include <link.h>
+# include <a.out.h>
+ /* struct link_map field overrides */
+# define l_next lm_next
+# define l_addr lm_addr
+# define l_name lm_name
+#endif
+
+#if defined(LINUX) && defined(__ELF__) || defined(SCO_ELF) || \
+ (defined(FREEBSD) && defined(__ELF__)) || defined(DGUX) || \
+ (defined(NETBSD) && defined(__ELF__)) || defined(HURD)
+# include <stddef.h>
+# include <elf.h>
+# include <link.h>
+#endif
+
+/* Newer versions of GNU/Linux define this macro. We
+ * define it similarly for any ELF systems that don't. */
+# ifndef ElfW
+# if !defined(ELF_CLASS) || ELF_CLASS == ELFCLASS32
+# define ElfW(type) Elf32_##type
+# else
+# define ElfW(type) Elf64_##type
+# endif
+# endif
+
+#if defined(SUNOS5DL) && !defined(USE_PROC_FOR_LIBRARIES)
+
+#ifdef LINT
+ Elf32_Dyn _DYNAMIC;
+#endif
+
+static struct link_map *
+GC_FirstDLOpenedLinkMap()
+{
+ extern ElfW(Dyn) _DYNAMIC;
+ ElfW(Dyn) *dp;
+ struct r_debug *r;
+ static struct link_map * cachedResult = 0;
+ static ElfW(Dyn) *dynStructureAddr = 0;
+ /* BTL: added to avoid Solaris 5.3 ld.so _DYNAMIC bug */
+
+# ifdef SUNOS53_SHARED_LIB
+ /* BTL: Avoid the Solaris 5.3 bug that _DYNAMIC isn't being set */
+ /* up properly in dynamically linked .so's. This means we have */
+ /* to use its value in the set of original object files loaded */
+ /* at program startup. */
+ if( dynStructureAddr == 0 ) {
+ void* startupSyms = dlopen(0, RTLD_LAZY);
+ dynStructureAddr = (ElfW(Dyn)*)dlsym(startupSyms, "_DYNAMIC");
+ }
+# else
+ dynStructureAddr = &_DYNAMIC;
+# endif
+
+ if( dynStructureAddr == 0) {
+ return(0);
+ }
+ if( cachedResult == 0 ) {
+ int tag;
+ for( dp = ((ElfW(Dyn) *)(&_DYNAMIC)); (tag = dp->d_tag) != 0; dp++ ) {
+ if( tag == DT_DEBUG ) {
+ struct link_map *lm
+ = ((struct r_debug *)(dp->d_un.d_ptr))->r_map;
+ if( lm != 0 ) cachedResult = lm->l_next; /* might be NIL */
+ break;
+ }
+ }
+ }
+ return cachedResult;
+}
+
+#endif /* SUNOS5DL ... */
+
+/* BTL: added to fix circular dlopen definition if GC_SOLARIS_THREADS defined */
+# if defined(GC_must_restore_redefined_dlopen)
+# define dlopen GC_dlopen
+# endif
+
+#if defined(SUNOS4) && !defined(USE_PROC_FOR_LIBRARIES)
+
+#ifdef LINT
+ struct link_dynamic _DYNAMIC;
+#endif
+
+static struct link_map *
+GC_FirstDLOpenedLinkMap()
+{
+ extern struct link_dynamic _DYNAMIC;
+
+ if( &_DYNAMIC == 0) {
+ return(0);
+ }
+ return(_DYNAMIC.ld_un.ld_1->ld_loaded);
+}
+
+/* Return the address of the ld.so allocated common symbol */
+/* with the least address, or 0 if none. */
+static ptr_t GC_first_common()
+{
+ ptr_t result = 0;
+ extern struct link_dynamic _DYNAMIC;
+ struct rtc_symb * curr_symbol;
+
+ if( &_DYNAMIC == 0) {
+ return(0);
+ }
+ curr_symbol = _DYNAMIC.ldd -> ldd_cp;
+ for (; curr_symbol != 0; curr_symbol = curr_symbol -> rtc_next) {
+ if (result == 0
+ || (ptr_t)(curr_symbol -> rtc_sp -> n_value) < result) {
+ result = (ptr_t)(curr_symbol -> rtc_sp -> n_value);
+ }
+ }
+ return(result);
+}
+
+#endif /* SUNOS4 ... */
+
+# if defined(SUNOS4) || defined(SUNOS5DL)
+/* Add dynamic library data sections to the root set. */
+# if !defined(PCR) && !defined(GC_SOLARIS_THREADS) && defined(THREADS)
+# ifndef SRC_M3
+ --> fix mutual exclusion with dlopen
+# endif /* We assume M3 programs don't call dlopen for now */
+# endif
+
+# ifndef USE_PROC_FOR_LIBRARIES
+void GC_register_dynamic_libraries()
+{
+ struct link_map *lm = GC_FirstDLOpenedLinkMap();
+
+
+ for (lm = GC_FirstDLOpenedLinkMap();
+ lm != (struct link_map *) 0; lm = lm->l_next)
+ {
+# ifdef SUNOS4
+ struct exec *e;
+
+ e = (struct exec *) lm->lm_addr;
+ GC_add_roots_inner(
+ ((char *) (N_DATOFF(*e) + lm->lm_addr)),
+ ((char *) (N_BSSADDR(*e) + e->a_bss + lm->lm_addr)),
+ TRUE);
+# endif
+# ifdef SUNOS5DL
+ ElfW(Ehdr) * e;
+ ElfW(Phdr) * p;
+ unsigned long offset;
+ char * start;
+ register int i;
+
+ e = (ElfW(Ehdr) *) lm->l_addr;
+ p = ((ElfW(Phdr) *)(((char *)(e)) + e->e_phoff));
+ offset = ((unsigned long)(lm->l_addr));
+ for( i = 0; i < (int)(e->e_phnum); ((i++),(p++)) ) {
+ switch( p->p_type ) {
+ case PT_LOAD:
+ {
+ if( !(p->p_flags & PF_W) ) break;
+ start = ((char *)(p->p_vaddr)) + offset;
+ GC_add_roots_inner(
+ start,
+ start + p->p_memsz,
+ TRUE
+ );
+ }
+ break;
+ default:
+ break;
+ }
+ }
+# endif
+ }
+# ifdef SUNOS4
+ {
+ static ptr_t common_start = 0;
+ ptr_t common_end;
+ extern ptr_t GC_find_limit();
+
+ if (common_start == 0) common_start = GC_first_common();
+ if (common_start != 0) {
+ common_end = GC_find_limit(common_start, TRUE);
+ GC_add_roots_inner((char *)common_start, (char *)common_end, TRUE);
+ }
+ }
+# endif
+}
+
+# endif /* !USE_PROC ... */
+# endif /* SUNOS */
+
+#if defined(LINUX) && defined(__ELF__) || defined(SCO_ELF) || \
+ (defined(FREEBSD) && defined(__ELF__)) || defined(DGUX) || \
+ (defined(NETBSD) && defined(__ELF__)) || defined(HURD)
+
+
+#ifdef USE_PROC_FOR_LIBRARIES
+
+#include <string.h>
+
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+
+#define MAPS_BUF_SIZE (32*1024)
+
+extern ssize_t GC_repeat_read(int fd, char *buf, size_t count);
+ /* Repeatedly read until buffer is filled, or EOF is encountered */
+ /* Defined in os_dep.c. */
+
+static char *parse_map_entry(char *buf_ptr, word *start, word *end,
+ char *prot_buf, unsigned int *maj_dev);
+
+void GC_register_dynamic_libraries()
+{
+ int f;
+ int result;
+ char prot_buf[5];
+ int maps_size;
+ char maps_temp[32768];
+ char *maps_buf;
+ char *buf_ptr;
+ int count;
+ word start, end;
+ unsigned int maj_dev, min_dev;
+ word least_ha, greatest_ha;
+ unsigned i;
+ word datastart = (word)(DATASTART);
+
+ /* Read /proc/self/maps */
+ /* Note that we may not allocate, and thus can't use stdio. */
+ f = open("/proc/self/maps", O_RDONLY);
+ if (-1 == f) ABORT("Couldn't open /proc/self/maps");
+ /* stat() doesn't work for /proc/self/maps, so we have to
+ read it to find out how large it is... */
+ maps_size = 0;
+ do {
+ result = GC_repeat_read(f, maps_temp, sizeof(maps_temp));
+ if (result <= 0) ABORT("Couldn't read /proc/self/maps");
+ maps_size += result;
+ } while (result == sizeof(maps_temp));
+
+ if (maps_size > sizeof(maps_temp)) {
+ /* If larger than our buffer, close and re-read it. */
+ close(f);
+ f = open("/proc/self/maps", O_RDONLY);
+ if (-1 == f) ABORT("Couldn't open /proc/self/maps");
+ maps_buf = alloca(maps_size);
+ if (NULL == maps_buf) ABORT("/proc/self/maps alloca failed");
+ result = GC_repeat_read(f, maps_buf, maps_size);
+ if (result <= 0) ABORT("Couldn't read /proc/self/maps");
+ } else {
+ /* Otherwise use the fixed size buffer */
+ maps_buf = maps_temp;
+ }
+
+ close(f);
+ maps_buf[result] = '\0';
+ buf_ptr = maps_buf;
+ /* Compute heap bounds. Should be done by add_to_heap? */
+ least_ha = (word)(-1);
+ greatest_ha = 0;
+ for (i = 0; i < GC_n_heap_sects; ++i) {
+ word sect_start = (word)GC_heap_sects[i].hs_start;
+ word sect_end = sect_start + GC_heap_sects[i].hs_bytes;
+ if (sect_start < least_ha) least_ha = sect_start;
+ if (sect_end > greatest_ha) greatest_ha = sect_end;
+ }
+ if (greatest_ha < (word)GC_scratch_last_end_ptr)
+ greatest_ha = (word)GC_scratch_last_end_ptr;
+ for (;;) {
+
+ buf_ptr = parse_map_entry(buf_ptr, &start, &end, prot_buf, &maj_dev);
+ if (buf_ptr == NULL) return;
+
+ if (prot_buf[1] == 'w') {
+ /* This is a writable mapping. Add it to */
+ /* the root set unless it is already otherwise */
+ /* accounted for. */
+ if (start <= (word)GC_stackbottom && end >= (word)GC_stackbottom) {
+ /* Stack mapping; discard */
+ continue;
+ }
+# ifdef THREADS
+ if (GC_segment_is_thread_stack(start, end)) continue;
+# endif
+ /* The rest of this assumes that there is no mapping */
+ /* spanning the beginning of the data segment, or extending */
+ /* beyond the entire heap at both ends. */
+ /* Empirically these assumptions hold. */
+
+ if (start < (word)DATAEND && end > (word)DATAEND) {
+ /* Rld may use space at the end of the main data */
+ /* segment. Thus we add that in. */
+ start = (word)DATAEND;
+ }
+ if (start < least_ha && end > least_ha) {
+ end = least_ha;
+ }
+ if (start < greatest_ha && end > greatest_ha) {
+ start = greatest_ha;
+ }
+ if (start >= least_ha && end <= greatest_ha) continue;
+ GC_add_roots_inner((char *)start, (char *)end, TRUE);
+ }
+ }
+}
+
+/* We now take care of the main data segment ourselves: */
+GC_bool GC_register_main_static_data()
+{
+ return FALSE;
+}
+
+# define HAVE_REGISTER_MAIN_STATIC_DATA
+//
+// parse_map_entry parses an entry from /proc/self/maps so we can
+// locate all writable data segments that belong to shared libraries.
+// The format of one of these entries and the fields we care about
+// is as follows:
+// XXXXXXXX-XXXXXXXX r-xp 00000000 30:05 260537 name of mapping...\n
+// ^^^^^^^^ ^^^^^^^^ ^^^^ ^^
+// start end prot maj_dev
+// 0 9 18 32
+//
+// For 64 bit ABIs:
+// 0 17 34 56
+//
+// The parser is called with a pointer to the entry and the return value
+// is either NULL or is advanced to the next entry(the byte after the
+// trailing '\n'.)
+//
+#if CPP_WORDSZ == 32
+# define OFFSET_MAP_START 0
+# define OFFSET_MAP_END 9
+# define OFFSET_MAP_PROT 18
+# define OFFSET_MAP_MAJDEV 32
+# define ADDR_WIDTH 8
+#endif
+
+#if CPP_WORDSZ == 64
+# define OFFSET_MAP_START 0
+# define OFFSET_MAP_END 17
+# define OFFSET_MAP_PROT 34
+# define OFFSET_MAP_MAJDEV 56
+# define ADDR_WIDTH 16
+#endif
+
+static char *parse_map_entry(char *buf_ptr, word *start, word *end,
+ char *prot_buf, unsigned int *maj_dev)
+{
+ int i;
+ char *tok;
+
+ if (buf_ptr == NULL || *buf_ptr == '\0') {
+ return NULL;
+ }
+
+ memcpy(prot_buf, buf_ptr+OFFSET_MAP_PROT, 4); // do the protections first
+ prot_buf[4] = '\0';
+
+ if (prot_buf[1] == 'w') { // we can skip all of this if it's not writable
+
+ tok = buf_ptr;
+ buf_ptr[OFFSET_MAP_START+ADDR_WIDTH] = '\0';
+ *start = strtoul(tok, NULL, 16);
+
+ tok = buf_ptr+OFFSET_MAP_END;
+ buf_ptr[OFFSET_MAP_END+ADDR_WIDTH] = '\0';
+ *end = strtoul(tok, NULL, 16);
+
+ buf_ptr += OFFSET_MAP_MAJDEV;
+ tok = buf_ptr;
+ while (*buf_ptr != ':') buf_ptr++;
+ *buf_ptr++ = '\0';
+ *maj_dev = strtoul(tok, NULL, 16);
+ }
+
+ while (*buf_ptr && *buf_ptr++ != '\n');
+
+ return buf_ptr;
+}
+
+#endif /* USE_PROC_FOR_LIBRARIES */
+
+#if !defined(USE_PROC_FOR_LIBRARIES)
+/* The following is the preferred way to walk dynamic libraries */
+/* For glibc 2.2.4+. Unfortunately, it doesn't work for older */
+/* versions. Thanks to Jakub Jelinek for most of the code. */
+
+# if defined(LINUX) /* Are others OK here, too? */ \
+ && (__GLIBC__ > 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ > 2) \
+ || (__GLIBC__ == 2 && __GLIBC_MINOR__ == 2 && defined(DT_CONFIG)))
+
+/* We have the header files for a glibc that includes dl_iterate_phdr. */
+/* It may still not be available in the library on the target system. */
+/* Thus we also treat it as a weak symbol. */
+#define HAVE_DL_ITERATE_PHDR
+
+static int GC_register_dynlib_callback(info, size, ptr)
+ struct dl_phdr_info * info;
+ size_t size;
+ void * ptr;
+{
+ const ElfW(Phdr) * p;
+ char * start;
+ register int i;
+
+ /* Make sure struct dl_phdr_info is at least as big as we need. */
+ if (size < offsetof (struct dl_phdr_info, dlpi_phnum)
+ + sizeof (info->dlpi_phnum))
+ return -1;
+
+ p = info->dlpi_phdr;
+ for( i = 0; i < (int)(info->dlpi_phnum); ((i++),(p++)) ) {
+ switch( p->p_type ) {
+ case PT_LOAD:
+ {
+ if( !(p->p_flags & PF_W) ) break;
+ start = ((char *)(p->p_vaddr)) + info->dlpi_addr;
+ GC_add_roots_inner(start, start + p->p_memsz, TRUE);
+ }
+ break;
+ default:
+ break;
+ }
+ }
+
+ * (int *)ptr = 1; /* Signal that we were called */
+ return 0;
+}
+
+/* Return TRUE if we succeed, FALSE if dl_iterate_phdr wasn't there. */
+
+#pragma weak dl_iterate_phdr
+
+GC_bool GC_register_dynamic_libraries_dl_iterate_phdr()
+{
+ if (dl_iterate_phdr) {
+ int did_something = 0;
+ dl_iterate_phdr(GC_register_dynlib_callback, &did_something);
+ if (!did_something) {
+ /* dl_iterate_phdr may forget the static data segment in */
+ /* statically linked executables. */
+ GC_add_roots_inner(DATASTART, (char *)(DATAEND), TRUE);
+# if defined(DATASTART2)
+ GC_add_roots_inner(DATASTART2, (char *)(DATAEND2), TRUE);
+# endif
+ }
+
+ return TRUE;
+ } else {
+ return FALSE;
+ }
+}
+
+/* Do we need to separately register the main static data segment? */
+GC_bool GC_register_main_static_data()
+{
+ return (dl_iterate_phdr == 0);
+}
+
+#define HAVE_REGISTER_MAIN_STATIC_DATA
+
+# else /* !LINUX || version(glibc) < 2.2.4 */
+
+/* Dynamic loading code for Linux running ELF. Somewhat tested on
+ * Linux/x86, untested but hopefully should work on Linux/Alpha.
+ * This code was derived from the Solaris/ELF support. Thanks to
+ * whatever kind soul wrote that. - Patrick Bridges */
+
+/* This doesn't necessarily work in all cases, e.g. with preloaded
+ * dynamic libraries. */
+
+#if defined(NETBSD)
+# include <sys/exec_elf.h>
+#else
+# include <elf.h>
+#endif
+#include <link.h>
+
+# endif
+
+#ifdef __GNUC__
+# pragma weak _DYNAMIC
+#endif
+extern ElfW(Dyn) _DYNAMIC[];
+
+static struct link_map *
+GC_FirstDLOpenedLinkMap()
+{
+ ElfW(Dyn) *dp;
+ struct r_debug *r;
+ static struct link_map *cachedResult = 0;
+
+ if( _DYNAMIC == 0) {
+ return(0);
+ }
+ if( cachedResult == 0 ) {
+ int tag;
+ for( dp = _DYNAMIC; (tag = dp->d_tag) != 0; dp++ ) {
+ if( tag == DT_DEBUG ) {
+ struct link_map *lm
+ = ((struct r_debug *)(dp->d_un.d_ptr))->r_map;
+ if( lm != 0 ) cachedResult = lm->l_next; /* might be NIL */
+ break;
+ }
+ }
+ }
+ return cachedResult;
+}
+
+
+void GC_register_dynamic_libraries()
+{
+ struct link_map *lm;
+
+
+# ifdef HAVE_DL_ITERATE_PHDR
+ if (GC_register_dynamic_libraries_dl_iterate_phdr()) {
+ return;
+ }
+# endif
+ lm = GC_FirstDLOpenedLinkMap();
+ for (lm = GC_FirstDLOpenedLinkMap();
+ lm != (struct link_map *) 0; lm = lm->l_next)
+ {
+ ElfW(Ehdr) * e;
+ ElfW(Phdr) * p;
+ unsigned long offset;
+ char * start;
+ register int i;
+
+ e = (ElfW(Ehdr) *) lm->l_addr;
+ p = ((ElfW(Phdr) *)(((char *)(e)) + e->e_phoff));
+ offset = ((unsigned long)(lm->l_addr));
+ for( i = 0; i < (int)(e->e_phnum); ((i++),(p++)) ) {
+ switch( p->p_type ) {
+ case PT_LOAD:
+ {
+ if( !(p->p_flags & PF_W) ) break;
+ start = ((char *)(p->p_vaddr)) + offset;
+ GC_add_roots_inner(start, start + p->p_memsz, TRUE);
+ }
+ break;
+ default:
+ break;
+ }
+ }
+ }
+}
+
+#endif /* !USE_PROC_FOR_LIBRARIES */
+
+#endif /* LINUX */
+
+#if defined(IRIX5) || (defined(USE_PROC_FOR_LIBRARIES) && !defined(LINUX))
+
+#include <sys/procfs.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <elf.h>
+#include <errno.h>
+#include <signal.h> /* Only for the following test. */
+#ifndef _sigargs
+# define IRIX6
+#endif
+
+extern void * GC_roots_present();
+ /* The type is a lie, since the real type doesn't make sense here, */
+ /* and we only test for NULL. */
+
+
+/* We use /proc to track down all parts of the address space that are */
+/* mapped by the process, and throw out regions we know we shouldn't */
+/* worry about. This may also work under other SVR4 variants. */
+void GC_register_dynamic_libraries()
+{
+ static int fd = -1;
+ char buf[30];
+ static prmap_t * addr_map = 0;
+ static int current_sz = 0; /* Number of records currently in addr_map */
+ static int needed_sz; /* Required size of addr_map */
+ register int i;
+ register long flags;
+ register ptr_t start;
+ register ptr_t limit;
+ ptr_t heap_start = (ptr_t)HEAP_START;
+ ptr_t heap_end = heap_start;
+
+# ifdef SUNOS5DL
+# define MA_PHYS 0
+# endif /* SUNOS5DL */
+
+ if (fd < 0) {
+ sprintf(buf, "/proc/%d", getpid());
+ /* The above generates a lint complaint, since pid_t varies. */
+ /* It's unclear how to improve this. */
+ fd = open(buf, O_RDONLY);
+ if (fd < 0) {
+ ABORT("/proc open failed");
+ }
+ }
+ if (ioctl(fd, PIOCNMAP, &needed_sz) < 0) {
+ GC_err_printf2("fd = %d, errno = %d\n", fd, errno);
+ ABORT("/proc PIOCNMAP ioctl failed");
+ }
+ if (needed_sz >= current_sz) {
+ current_sz = needed_sz * 2 + 1;
+ /* Expansion, plus room for 0 record */
+ addr_map = (prmap_t *)GC_scratch_alloc((word)
+ (current_sz * sizeof(prmap_t)));
+ }
+ if (ioctl(fd, PIOCMAP, addr_map) < 0) {
+ GC_err_printf4("fd = %d, errno = %d, needed_sz = %d, addr_map = 0x%X\n",
+ fd, errno, needed_sz, addr_map);
+ ABORT("/proc PIOCMAP ioctl failed");
+ };
+ if (GC_n_heap_sects > 0) {
+ heap_end = GC_heap_sects[GC_n_heap_sects-1].hs_start
+ + GC_heap_sects[GC_n_heap_sects-1].hs_bytes;
+ if (heap_end < GC_scratch_last_end_ptr) heap_end = GC_scratch_last_end_ptr;
+ }
+ for (i = 0; i < needed_sz; i++) {
+ flags = addr_map[i].pr_mflags;
+ if ((flags & (MA_BREAK | MA_STACK | MA_PHYS)) != 0) goto irrelevant;
+ if ((flags & (MA_READ | MA_WRITE)) != (MA_READ | MA_WRITE))
+ goto irrelevant;
+ /* The latter test is empirically useless in very old Irix */
+ /* versions. Other than the */
+ /* main data and stack segments, everything appears to be */
+ /* mapped readable, writable, executable, and shared(!!). */
+ /* This makes no sense to me. - HB */
+ start = (ptr_t)(addr_map[i].pr_vaddr);
+ if (GC_roots_present(start)) goto irrelevant;
+ if (start < heap_end && start >= heap_start)
+ goto irrelevant;
+# ifdef MMAP_STACKS
+ if (GC_is_thread_stack(start)) goto irrelevant;
+# endif /* MMAP_STACKS */
+
+ limit = start + addr_map[i].pr_size;
+ /* The following seemed to be necessary for very old versions */
+ /* of Irix, but it has been reported to discard relevant */
+ /* segments under Irix 6.5. */
+# ifndef IRIX6
+ if (addr_map[i].pr_off == 0 && strncmp(start, ELFMAG, 4) == 0) {
+ /* Discard text segments, i.e. 0-offset mappings against */
+ /* executable files which appear to have ELF headers. */
+ caddr_t arg;
+ int obj;
+# define MAP_IRR_SZ 10
+ static ptr_t map_irr[MAP_IRR_SZ];
+ /* Known irrelevant map entries */
+ static int n_irr = 0;
+ struct stat buf;
+ register int i;
+
+ for (i = 0; i < n_irr; i++) {
+ if (map_irr[i] == start) goto irrelevant;
+ }
+ arg = (caddr_t)start;
+ obj = ioctl(fd, PIOCOPENM, &arg);
+ if (obj >= 0) {
+ fstat(obj, &buf);
+ close(obj);
+ if ((buf.st_mode & 0111) != 0) {
+ if (n_irr < MAP_IRR_SZ) {
+ map_irr[n_irr++] = start;
+ }
+ goto irrelevant;
+ }
+ }
+ }
+# endif /* !IRIX6 */
+ GC_add_roots_inner(start, limit, TRUE);
+ irrelevant: ;
+ }
+ /* Dont keep cached descriptor, for now. Some kernels don't like us */
+ /* to keep a /proc file descriptor around during kill -9. */
+ if (close(fd) < 0) ABORT("Couldnt close /proc file");
+ fd = -1;
+}
+
+# endif /* USE_PROC || IRIX5 */
+
+# if defined(MSWIN32) || defined(MSWINCE)
+
+# define WIN32_LEAN_AND_MEAN
+# define NOSERVICE
+# include <windows.h>
+# include <stdlib.h>
+
+ /* We traverse the entire address space and register all segments */
+ /* that could possibly have been written to. */
+
+ extern GC_bool GC_is_heap_base (ptr_t p);
+
+# ifdef GC_WIN32_THREADS
+ extern void GC_get_next_stack(char *start, char **lo, char **hi);
+ void GC_cond_add_roots(char *base, char * limit)
+ {
+ char * curr_base = base;
+ char * next_stack_lo;
+ char * next_stack_hi;
+
+ if (base == limit) return;
+ for(;;) {
+ GC_get_next_stack(curr_base, &next_stack_lo, &next_stack_hi);
+ if (next_stack_lo >= limit) break;
+ GC_add_roots_inner(curr_base, next_stack_lo, TRUE);
+ curr_base = next_stack_hi;
+ }
+ if (curr_base < limit) GC_add_roots_inner(curr_base, limit, TRUE);
+ }
+# else
+ void GC_cond_add_roots(char *base, char * limit)
+ {
+ char dummy;
+ char * stack_top
+ = (char *) ((word)(&dummy) & ~(GC_sysinfo.dwAllocationGranularity-1));
+ if (base == limit) return;
+ if (limit > stack_top && base < GC_stackbottom) {
+ /* Part of the stack; ignore it. */
+ return;
+ }
+ GC_add_roots_inner(base, limit, TRUE);
+ }
+# endif
+
+# ifdef MSWINCE
+ /* Do we need to separately register the main static data segment? */
+ GC_bool GC_register_main_static_data()
+ {
+ return FALSE;
+ }
+# else /* win32 */
+ extern GC_bool GC_no_win32_dlls;
+
+ GC_bool GC_register_main_static_data()
+ {
+ return GC_no_win32_dlls;
+ }
+# endif /* win32 */
+
+# define HAVE_REGISTER_MAIN_STATIC_DATA
+
+ void GC_register_dynamic_libraries()
+ {
+ MEMORY_BASIC_INFORMATION buf;
+ DWORD result;
+ DWORD protect;
+ LPVOID p;
+ char * base;
+ char * limit, * new_limit;
+
+# ifdef MSWIN32
+ if (GC_no_win32_dlls) return;
+# endif
+ base = limit = p = GC_sysinfo.lpMinimumApplicationAddress;
+# if defined(MSWINCE) && !defined(_WIN32_WCE_EMULATION)
+ /* Only the first 32 MB of address space belongs to the current process */
+ while (p < (LPVOID)0x02000000) {
+ result = VirtualQuery(p, &buf, sizeof(buf));
+ if (result == 0) {
+ /* Page is free; advance to the next possible allocation base */
+ new_limit = (char *)
+ (((DWORD) p + GC_sysinfo.dwAllocationGranularity)
+ & ~(GC_sysinfo.dwAllocationGranularity-1));
+ } else
+# else
+ while (p < GC_sysinfo.lpMaximumApplicationAddress) {
+ result = VirtualQuery(p, &buf, sizeof(buf));
+# endif
+ {
+ if (result != sizeof(buf)) {
+ ABORT("Weird VirtualQuery result");
+ }
+ new_limit = (char *)p + buf.RegionSize;
+ protect = buf.Protect;
+ if (buf.State == MEM_COMMIT
+ && (protect == PAGE_EXECUTE_READWRITE
+ || protect == PAGE_READWRITE)
+ && !GC_is_heap_base(buf.AllocationBase)) {
+ if ((char *)p != limit) {
+ GC_cond_add_roots(base, limit);
+ base = p;
+ }
+ limit = new_limit;
+ }
+ }
+ if (p > (LPVOID)new_limit /* overflow */) break;
+ p = (LPVOID)new_limit;
+ }
+ GC_cond_add_roots(base, limit);
+ }
+
+#endif /* MSWIN32 || MSWINCE */
+
+#if defined(ALPHA) && defined(OSF1)
+
+#include <loader.h>
+
+void GC_register_dynamic_libraries()
+{
+ int status;
+ ldr_process_t mypid;
+
+ /* module */
+ ldr_module_t moduleid = LDR_NULL_MODULE;
+ ldr_module_info_t moduleinfo;
+ size_t moduleinfosize = sizeof(moduleinfo);
+ size_t modulereturnsize;
+
+ /* region */
+ ldr_region_t region;
+ ldr_region_info_t regioninfo;
+ size_t regioninfosize = sizeof(regioninfo);
+ size_t regionreturnsize;
+
+ /* Obtain id of this process */
+ mypid = ldr_my_process();
+
+ /* For each module */
+ while (TRUE) {
+
+ /* Get the next (first) module */
+ status = ldr_next_module(mypid, &moduleid);
+
+ /* Any more modules? */
+ if (moduleid == LDR_NULL_MODULE)
+ break; /* No more modules */
+
+ /* Check status AFTER checking moduleid because */
+ /* of a bug in the non-shared ldr_next_module stub */
+ if (status != 0 ) {
+ GC_printf1("dynamic_load: status = %ld\n", (long)status);
+ {
+ extern char *sys_errlist[];
+ extern int sys_nerr;
+ extern int errno;
+ if (errno <= sys_nerr) {
+ GC_printf1("dynamic_load: %s\n", (long)sys_errlist[errno]);
+ } else {
+ GC_printf1("dynamic_load: %d\n", (long)errno);
+ }
+ }
+ ABORT("ldr_next_module failed");
+ }
+
+ /* Get the module information */
+ status = ldr_inq_module(mypid, moduleid, &moduleinfo,
+ moduleinfosize, &modulereturnsize);
+ if (status != 0 )
+ ABORT("ldr_inq_module failed");
+
+ /* is module for the main program (i.e. nonshared portion)? */
+ if (moduleinfo.lmi_flags & LDR_MAIN)
+ continue; /* skip the main module */
+
+# ifdef VERBOSE
+ GC_printf("---Module---\n");
+ GC_printf("Module ID = %16ld\n", moduleinfo.lmi_modid);
+ GC_printf("Count of regions = %16d\n", moduleinfo.lmi_nregion);
+ GC_printf("flags for module = %16lx\n", moduleinfo.lmi_flags);
+ GC_printf("pathname of module = \"%s\"\n", moduleinfo.lmi_name);
+# endif
+
+ /* For each region in this module */
+ for (region = 0; region < moduleinfo.lmi_nregion; region++) {
+
+ /* Get the region information */
+ status = ldr_inq_region(mypid, moduleid, region, ®ioninfo,
+ regioninfosize, ®ionreturnsize);
+ if (status != 0 )
+ ABORT("ldr_inq_region failed");
+
+ /* only process writable (data) regions */
+ if (! (regioninfo.lri_prot & LDR_W))
+ continue;
+
+# ifdef VERBOSE
+ GC_printf("--- Region ---\n");
+ GC_printf("Region number = %16ld\n",
+ regioninfo.lri_region_no);
+ GC_printf("Protection flags = %016x\n", regioninfo.lri_prot);
+ GC_printf("Virtual address = %16p\n", regioninfo.lri_vaddr);
+ GC_printf("Mapped address = %16p\n", regioninfo.lri_mapaddr);
+ GC_printf("Region size = %16ld\n", regioninfo.lri_size);
+ GC_printf("Region name = \"%s\"\n", regioninfo.lri_name);
+# endif
+
+ /* register region as a garbage collection root */
+ GC_add_roots_inner (
+ (char *)regioninfo.lri_mapaddr,
+ (char *)regioninfo.lri_mapaddr + regioninfo.lri_size,
+ TRUE);
+
+ }
+ }
+}
+#endif
+
+#if defined(HPUX)
+
+#include <errno.h>
+#include <dl.h>
+
+extern int errno;
+extern char *sys_errlist[];
+extern int sys_nerr;
+
+void GC_register_dynamic_libraries()
+{
+ int status;
+ int index = 1; /* Ordinal position in shared library search list */
+ struct shl_descriptor *shl_desc; /* Shared library info, see dl.h */
+
+ /* For each dynamic library loaded */
+ while (TRUE) {
+
+ /* Get info about next shared library */
+ status = shl_get(index, &shl_desc);
+
+ /* Check if this is the end of the list or if some error occured */
+ if (status != 0) {
+# ifdef GC_HPUX_THREADS
+ /* I've seen errno values of 0. The man page is not clear */
+ /* as to whether errno should get set on a -1 return. */
+ break;
+# else
+ if (errno == EINVAL) {
+ break; /* Moved past end of shared library list --> finished */
+ } else {
+ if (errno <= sys_nerr) {
+ GC_printf1("dynamic_load: %s\n", (long) sys_errlist[errno]);
+ } else {
+ GC_printf1("dynamic_load: %d\n", (long) errno);
+ }
+ ABORT("shl_get failed");
+ }
+# endif
+ }
+
+# ifdef VERBOSE
+ GC_printf0("---Shared library---\n");
+ GC_printf1("\tfilename = \"%s\"\n", shl_desc->filename);
+ GC_printf1("\tindex = %d\n", index);
+ GC_printf1("\thandle = %08x\n",
+ (unsigned long) shl_desc->handle);
+ GC_printf1("\ttext seg. start = %08x\n", shl_desc->tstart);
+ GC_printf1("\ttext seg. end = %08x\n", shl_desc->tend);
+ GC_printf1("\tdata seg. start = %08x\n", shl_desc->dstart);
+ GC_printf1("\tdata seg. end = %08x\n", shl_desc->dend);
+ GC_printf1("\tref. count = %lu\n", shl_desc->ref_count);
+# endif
+
+ /* register shared library's data segment as a garbage collection root */
+ GC_add_roots_inner((char *) shl_desc->dstart,
+ (char *) shl_desc->dend, TRUE);
+
+ index++;
+ }
+}
+#endif /* HPUX */
+
+#ifdef RS6000
+#pragma alloca
+#include <sys/ldr.h>
+#include <sys/errno.h>
+void GC_register_dynamic_libraries()
+{
+ int len;
+ char *ldibuf;
+ int ldibuflen;
+ struct ld_info *ldi;
+
+ ldibuf = alloca(ldibuflen = 8192);
+
+ while ( (len = loadquery(L_GETINFO,ldibuf,ldibuflen)) < 0) {
+ if (errno != ENOMEM) {
+ ABORT("loadquery failed");
+ }
+ ldibuf = alloca(ldibuflen *= 2);
+ }
+
+ ldi = (struct ld_info *)ldibuf;
+ while (ldi) {
+ len = ldi->ldinfo_next;
+ GC_add_roots_inner(
+ ldi->ldinfo_dataorg,
+ (unsigned long)ldi->ldinfo_dataorg
+ + ldi->ldinfo_datasize,
+ TRUE);
+ ldi = len ? (struct ld_info *)((char *)ldi + len) : 0;
+ }
+}
+#endif /* RS6000 */
+
+#ifdef MACOSX
+
+#include <mach-o/dyld.h>
+#include <mach-o/getsect.h>
+
+/*#define MACOSX_DEBUG */
+
+void GC_register_dynamic_libraries()
+{
+ unsigned long image_count;
+ const struct mach_header *mach_header;
+ const struct section *sec;
+ unsigned long slide;
+ unsigned long filetype;
+ int i,j;
+ unsigned long start;
+ unsigned long end;
+
+ static struct {
+ const char *seg;
+ const char *sect;
+ } sections[] = {
+ { SEG_DATA, SECT_DATA },
+ { SEG_DATA, SECT_BSS },
+ { SEG_DATA, SECT_COMMON }
+ };
+
+ image_count = _dyld_image_count();
+ for(i=0;i<image_count;i++)
+ {
+ mach_header = _dyld_get_image_header(i);
+ slide = _dyld_get_image_vmaddr_slide(i);
+ filetype = mach_header->filetype;
+
+ for(j=0;j<sizeof(sections)/sizeof(sections[0]);j++) {
+ sec = getsectbynamefromheader(mach_header,sections[j].seg,sections[j].sect);
+ if(sec == NULL || sec->size == 0) continue;
+ start = slide + sec->addr;
+ end = start + sec->size;
+# ifdef MACOSX_DEBUG
+ GC_printf4("Adding section at %p-%p (%lu bytes) from image %s\n",
+ start,end,sec->size,_dyld_get_image_name(i));
+# endif
+
+ GC_add_roots_inner((char*)start,(char*)end,
+ filetype == MH_EXECUTE ? FALSE : TRUE);
+ }
+ }
+}
+
+#define HAVE_REGISTER_MAIN_STATIC_DATA
+GC_bool GC_register_main_static_data()
+{
+ return FALSE;
+}
+
+#endif /* MACOSX */
+
+#else /* !DYNAMIC_LOADING */
+
+#ifdef PCR
+
+# include "il/PCR_IL.h"
+# include "th/PCR_ThCtl.h"
+# include "mm/PCR_MM.h"
+
+void GC_register_dynamic_libraries()
+{
+ /* Add new static data areas of dynamically loaded modules. */
+ {
+ PCR_IL_LoadedFile * p = PCR_IL_GetLastLoadedFile();
+ PCR_IL_LoadedSegment * q;
+
+ /* Skip uncommited files */
+ while (p != NIL && !(p -> lf_commitPoint)) {
+ /* The loading of this file has not yet been committed */
+ /* Hence its description could be inconsistent. */
+ /* Furthermore, it hasn't yet been run. Hence its data */
+ /* segments can't possibly reference heap allocated */
+ /* objects. */
+ p = p -> lf_prev;
+ }
+ for (; p != NIL; p = p -> lf_prev) {
+ for (q = p -> lf_ls; q != NIL; q = q -> ls_next) {
+ if ((q -> ls_flags & PCR_IL_SegFlags_Traced_MASK)
+ == PCR_IL_SegFlags_Traced_on) {
+ GC_add_roots_inner
+ ((char *)(q -> ls_addr),
+ (char *)(q -> ls_addr) + q -> ls_bytes,
+ TRUE);
+ }
+ }
+ }
+ }
+}
+
+
+#else /* !PCR */
+
+void GC_register_dynamic_libraries(){}
+
+int GC_no_dynamic_loading;
+
+#endif /* !PCR */
+
+#endif /* !DYNAMIC_LOADING */
+
+#ifndef HAVE_REGISTER_MAIN_STATIC_DATA
+
+/* Do we need to separately register the main static data segment? */
+GC_bool GC_register_main_static_data()
+{
+ return TRUE;
+}
+#endif /* HAVE_REGISTER_MAIN_STATIC_DATA */
+
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1996 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved.
+
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, February 1, 1996 1:19 pm PST */
+# define I_HIDE_POINTERS
+# include "private/gc_pmark.h"
+
+# ifdef FINALIZE_ON_DEMAND
+ int GC_finalize_on_demand = 1;
+# else
+ int GC_finalize_on_demand = 0;
+# endif
+
+# ifdef JAVA_FINALIZATION
+ int GC_java_finalization = 1;
+# else
+ int GC_java_finalization = 0;
+# endif
+
+/* Type of mark procedure used for marking from finalizable object. */
+/* This procedure normally does not mark the object, only its */
+/* descendents. */
+typedef void finalization_mark_proc(/* ptr_t finalizable_obj_ptr */);
+
+# define HASH3(addr,size,log_size) \
+ ((((word)(addr) >> 3) ^ ((word)(addr) >> (3+(log_size)))) \
+ & ((size) - 1))
+#define HASH2(addr,log_size) HASH3(addr, 1 << log_size, log_size)
+
+struct hash_chain_entry {
+ word hidden_key;
+ struct hash_chain_entry * next;
+};
+
+unsigned GC_finalization_failures = 0;
+ /* Number of finalization requests that failed for lack of memory. */
+
+static struct disappearing_link {
+ struct hash_chain_entry prolog;
+# define dl_hidden_link prolog.hidden_key
+ /* Field to be cleared. */
+# define dl_next(x) (struct disappearing_link *)((x) -> prolog.next)
+# define dl_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
+
+ word dl_hidden_obj; /* Pointer to object base */
+} **dl_head = 0;
+
+static signed_word log_dl_table_size = -1;
+ /* Binary log of */
+ /* current size of array pointed to by dl_head. */
+ /* -1 ==> size is 0. */
+
+word GC_dl_entries = 0; /* Number of entries currently in disappearing */
+ /* link table. */
+
+static struct finalizable_object {
+ struct hash_chain_entry prolog;
+# define fo_hidden_base prolog.hidden_key
+ /* Pointer to object base. */
+ /* No longer hidden once object */
+ /* is on finalize_now queue. */
+# define fo_next(x) (struct finalizable_object *)((x) -> prolog.next)
+# define fo_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
+ GC_finalization_proc fo_fn; /* Finalizer. */
+ ptr_t fo_client_data;
+ word fo_object_size; /* In bytes. */
+ finalization_mark_proc * fo_mark_proc; /* Mark-through procedure */
+} **fo_head = 0;
+
+struct finalizable_object * GC_finalize_now = 0;
+ /* LIst of objects that should be finalized now. */
+
+static signed_word log_fo_table_size = -1;
+
+word GC_fo_entries = 0;
+
+void GC_push_finalizer_structures GC_PROTO((void))
+{
+ GC_push_all((ptr_t)(&dl_head), (ptr_t)(&dl_head) + sizeof(word));
+ GC_push_all((ptr_t)(&fo_head), (ptr_t)(&fo_head) + sizeof(word));
+ GC_push_all((ptr_t)(&GC_finalize_now),
+ (ptr_t)(&GC_finalize_now) + sizeof(word));
+}
+
+/* Double the size of a hash table. *size_ptr is the log of its current */
+/* size. May be a noop. */
+/* *table is a pointer to an array of hash headers. If we succeed, we */
+/* update both *table and *log_size_ptr. */
+/* Lock is held. Signals are disabled. */
+void GC_grow_table(table, log_size_ptr)
+struct hash_chain_entry ***table;
+signed_word * log_size_ptr;
+{
+ register word i;
+ register struct hash_chain_entry *p;
+ int log_old_size = *log_size_ptr;
+ register int log_new_size = log_old_size + 1;
+ word old_size = ((log_old_size == -1)? 0: (1 << log_old_size));
+ register word new_size = 1 << log_new_size;
+ struct hash_chain_entry **new_table = (struct hash_chain_entry **)
+ GC_INTERNAL_MALLOC_IGNORE_OFF_PAGE(
+ (size_t)new_size * sizeof(struct hash_chain_entry *), NORMAL);
+
+ if (new_table == 0) {
+ if (table == 0) {
+ ABORT("Insufficient space for initial table allocation");
+ } else {
+ return;
+ }
+ }
+ for (i = 0; i < old_size; i++) {
+ p = (*table)[i];
+ while (p != 0) {
+ register ptr_t real_key = (ptr_t)REVEAL_POINTER(p -> hidden_key);
+ register struct hash_chain_entry *next = p -> next;
+ register int new_hash = HASH3(real_key, new_size, log_new_size);
+
+ p -> next = new_table[new_hash];
+ new_table[new_hash] = p;
+ p = next;
+ }
+ }
+ *log_size_ptr = log_new_size;
+ *table = new_table;
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ int GC_register_disappearing_link(GC_PTR * link)
+# else
+ int GC_register_disappearing_link(link)
+ GC_PTR * link;
+# endif
+{
+ ptr_t base;
+
+ base = (ptr_t)GC_base((GC_PTR)link);
+ if (base == 0)
+ ABORT("Bad arg to GC_register_disappearing_link");
+ return(GC_general_register_disappearing_link(link, base));
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ int GC_general_register_disappearing_link(GC_PTR * link,
+ GC_PTR obj)
+# else
+ int GC_general_register_disappearing_link(link, obj)
+ GC_PTR * link;
+ GC_PTR obj;
+# endif
+
+{
+ struct disappearing_link *curr_dl;
+ int index;
+ struct disappearing_link * new_dl;
+ DCL_LOCK_STATE;
+
+ if ((word)link & (ALIGNMENT-1))
+ ABORT("Bad arg to GC_general_register_disappearing_link");
+# ifdef THREADS
+ DISABLE_SIGNALS();
+ LOCK();
+# endif
+ if (log_dl_table_size == -1
+ || GC_dl_entries > ((word)1 << log_dl_table_size)) {
+# ifndef THREADS
+ DISABLE_SIGNALS();
+# endif
+ GC_grow_table((struct hash_chain_entry ***)(&dl_head),
+ &log_dl_table_size);
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Grew dl table to %lu entries\n",
+ (unsigned long)(1 << log_dl_table_size));
+ }
+# endif
+# ifndef THREADS
+ ENABLE_SIGNALS();
+# endif
+ }
+ index = HASH2(link, log_dl_table_size);
+ curr_dl = dl_head[index];
+ for (curr_dl = dl_head[index]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
+ if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
+ curr_dl -> dl_hidden_obj = HIDE_POINTER(obj);
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ return(1);
+ }
+ }
+ new_dl = (struct disappearing_link *)
+ GC_INTERNAL_MALLOC(sizeof(struct disappearing_link),NORMAL);
+ if (0 == new_dl) {
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ new_dl = (struct disappearing_link *)
+ GC_oom_fn(sizeof(struct disappearing_link));
+ if (0 == new_dl) {
+ GC_finalization_failures++;
+ return(0);
+ }
+ /* It's not likely we'll make it here, but ... */
+# ifdef THREADS
+ DISABLE_SIGNALS();
+ LOCK();
+# endif
+ }
+ new_dl -> dl_hidden_obj = HIDE_POINTER(obj);
+ new_dl -> dl_hidden_link = HIDE_POINTER(link);
+ dl_set_next(new_dl, dl_head[index]);
+ dl_head[index] = new_dl;
+ GC_dl_entries++;
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ return(0);
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ int GC_unregister_disappearing_link(GC_PTR * link)
+# else
+ int GC_unregister_disappearing_link(link)
+ GC_PTR * link;
+# endif
+{
+ struct disappearing_link *curr_dl, *prev_dl;
+ int index;
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ index = HASH2(link, log_dl_table_size);
+ if (((unsigned long)link & (ALIGNMENT-1))) goto out;
+ prev_dl = 0; curr_dl = dl_head[index];
+ while (curr_dl != 0) {
+ if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
+ if (prev_dl == 0) {
+ dl_head[index] = dl_next(curr_dl);
+ } else {
+ dl_set_next(prev_dl, dl_next(curr_dl));
+ }
+ GC_dl_entries--;
+ UNLOCK();
+ ENABLE_SIGNALS();
+# ifdef DBG_HDRS_ALL
+ dl_set_next(curr_dl, 0);
+# else
+ GC_free((GC_PTR)curr_dl);
+# endif
+ return(1);
+ }
+ prev_dl = curr_dl;
+ curr_dl = dl_next(curr_dl);
+ }
+out:
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return(0);
+}
+
+/* Possible finalization_marker procedures. Note that mark stack */
+/* overflow is handled by the caller, and is not a disaster. */
+GC_API void GC_normal_finalize_mark_proc(p)
+ptr_t p;
+{
+ hdr * hhdr = HDR(p);
+
+ PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top,
+ &(GC_mark_stack[GC_mark_stack_size]));
+}
+
+/* This only pays very partial attention to the mark descriptor. */
+/* It does the right thing for normal and atomic objects, and treats */
+/* most others as normal. */
+GC_API void GC_ignore_self_finalize_mark_proc(p)
+ptr_t p;
+{
+ hdr * hhdr = HDR(p);
+ word descr = hhdr -> hb_descr;
+ ptr_t q, r;
+ ptr_t scan_limit;
+ ptr_t target_limit = p + WORDS_TO_BYTES(hhdr -> hb_sz) - 1;
+
+ if ((descr & GC_DS_TAGS) == GC_DS_LENGTH) {
+ scan_limit = p + descr - sizeof(word);
+ } else {
+ scan_limit = target_limit + 1 - sizeof(word);
+ }
+ for (q = p; q <= scan_limit; q += ALIGNMENT) {
+ r = *(ptr_t *)q;
+ if (r < p || r > target_limit) {
+ GC_PUSH_ONE_HEAP((word)r, q);
+ }
+ }
+}
+
+/*ARGSUSED*/
+GC_API void GC_null_finalize_mark_proc(p)
+ptr_t p;
+{
+}
+
+
+
+/* Register a finalization function. See gc.h for details. */
+/* in the nonthreads case, we try to avoid disabling signals, */
+/* since it can be expensive. Threads packages typically */
+/* make it cheaper. */
+/* The last parameter is a procedure that determines */
+/* marking for finalization ordering. Any objects marked */
+/* by that procedure will be guaranteed to not have been */
+/* finalized when this finalizer is invoked. */
+GC_API void GC_register_finalizer_inner(obj, fn, cd, ofn, ocd, mp)
+GC_PTR obj;
+GC_finalization_proc fn;
+GC_PTR cd;
+GC_finalization_proc * ofn;
+GC_PTR * ocd;
+finalization_mark_proc * mp;
+{
+ ptr_t base;
+ struct finalizable_object * curr_fo, * prev_fo;
+ int index;
+ struct finalizable_object *new_fo;
+ hdr *hhdr;
+ DCL_LOCK_STATE;
+
+# ifdef THREADS
+ DISABLE_SIGNALS();
+ LOCK();
+# endif
+ if (log_fo_table_size == -1
+ || GC_fo_entries > ((word)1 << log_fo_table_size)) {
+# ifndef THREADS
+ DISABLE_SIGNALS();
+# endif
+ GC_grow_table((struct hash_chain_entry ***)(&fo_head),
+ &log_fo_table_size);
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Grew fo table to %lu entries\n",
+ (unsigned long)(1 << log_fo_table_size));
+ }
+# endif
+# ifndef THREADS
+ ENABLE_SIGNALS();
+# endif
+ }
+ /* in the THREADS case signals are disabled and we hold allocation */
+ /* lock; otherwise neither is true. Proceed carefully. */
+ base = (ptr_t)obj;
+ index = HASH2(base, log_fo_table_size);
+ prev_fo = 0; curr_fo = fo_head[index];
+ while (curr_fo != 0) {
+ if (curr_fo -> fo_hidden_base == HIDE_POINTER(base)) {
+ /* Interruption by a signal in the middle of this */
+ /* should be safe. The client may see only *ocd */
+ /* updated, but we'll declare that to be his */
+ /* problem. */
+ if (ocd) *ocd = (GC_PTR) curr_fo -> fo_client_data;
+ if (ofn) *ofn = curr_fo -> fo_fn;
+ /* Delete the structure for base. */
+ if (prev_fo == 0) {
+ fo_head[index] = fo_next(curr_fo);
+ } else {
+ fo_set_next(prev_fo, fo_next(curr_fo));
+ }
+ if (fn == 0) {
+ GC_fo_entries--;
+ /* May not happen if we get a signal. But a high */
+ /* estimate will only make the table larger than */
+ /* necessary. */
+# if !defined(THREADS) && !defined(DBG_HDRS_ALL)
+ GC_free((GC_PTR)curr_fo);
+# endif
+ } else {
+ curr_fo -> fo_fn = fn;
+ curr_fo -> fo_client_data = (ptr_t)cd;
+ curr_fo -> fo_mark_proc = mp;
+ /* Reinsert it. We deleted it first to maintain */
+ /* consistency in the event of a signal. */
+ if (prev_fo == 0) {
+ fo_head[index] = curr_fo;
+ } else {
+ fo_set_next(prev_fo, curr_fo);
+ }
+ }
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ return;
+ }
+ prev_fo = curr_fo;
+ curr_fo = fo_next(curr_fo);
+ }
+ if (ofn) *ofn = 0;
+ if (ocd) *ocd = 0;
+ if (fn == 0) {
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ return;
+ }
+ GET_HDR(base, hhdr);
+ if (0 == hhdr) {
+ /* We won't collect it, hence finalizer wouldn't be run. */
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ return;
+ }
+ new_fo = (struct finalizable_object *)
+ GC_INTERNAL_MALLOC(sizeof(struct finalizable_object),NORMAL);
+ if (0 == new_fo) {
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ new_fo = (struct finalizable_object *)
+ GC_oom_fn(sizeof(struct finalizable_object));
+ if (0 == new_fo) {
+ GC_finalization_failures++;
+ return;
+ }
+ /* It's not likely we'll make it here, but ... */
+# ifdef THREADS
+ DISABLE_SIGNALS();
+ LOCK();
+# endif
+ }
+ new_fo -> fo_hidden_base = (word)HIDE_POINTER(base);
+ new_fo -> fo_fn = fn;
+ new_fo -> fo_client_data = (ptr_t)cd;
+ new_fo -> fo_object_size = hhdr -> hb_sz;
+ new_fo -> fo_mark_proc = mp;
+ fo_set_next(new_fo, fo_head[index]);
+ GC_fo_entries++;
+ fo_head[index] = new_fo;
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+}
+
+# if defined(__STDC__)
+ void GC_register_finalizer(void * obj,
+ GC_finalization_proc fn, void * cd,
+ GC_finalization_proc *ofn, void ** ocd)
+# else
+ void GC_register_finalizer(obj, fn, cd, ofn, ocd)
+ GC_PTR obj;
+ GC_finalization_proc fn;
+ GC_PTR cd;
+ GC_finalization_proc * ofn;
+ GC_PTR * ocd;
+# endif
+{
+ GC_register_finalizer_inner(obj, fn, cd, ofn,
+ ocd, GC_normal_finalize_mark_proc);
+}
+
+# if defined(__STDC__)
+ void GC_register_finalizer_ignore_self(void * obj,
+ GC_finalization_proc fn, void * cd,
+ GC_finalization_proc *ofn, void ** ocd)
+# else
+ void GC_register_finalizer_ignore_self(obj, fn, cd, ofn, ocd)
+ GC_PTR obj;
+ GC_finalization_proc fn;
+ GC_PTR cd;
+ GC_finalization_proc * ofn;
+ GC_PTR * ocd;
+# endif
+{
+ GC_register_finalizer_inner(obj, fn, cd, ofn,
+ ocd, GC_ignore_self_finalize_mark_proc);
+}
+
+# if defined(__STDC__)
+ void GC_register_finalizer_no_order(void * obj,
+ GC_finalization_proc fn, void * cd,
+ GC_finalization_proc *ofn, void ** ocd)
+# else
+ void GC_register_finalizer_no_order(obj, fn, cd, ofn, ocd)
+ GC_PTR obj;
+ GC_finalization_proc fn;
+ GC_PTR cd;
+ GC_finalization_proc * ofn;
+ GC_PTR * ocd;
+# endif
+{
+ GC_register_finalizer_inner(obj, fn, cd, ofn,
+ ocd, GC_null_finalize_mark_proc);
+}
+
+#ifndef NO_DEBUGGING
+void GC_dump_finalization()
+{
+ struct disappearing_link * curr_dl;
+ struct finalizable_object * curr_fo;
+ ptr_t real_ptr, real_link;
+ int dl_size = (log_dl_table_size == -1 ) ? 0 : (1 << log_dl_table_size);
+ int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
+ int i;
+
+ GC_printf0("Disappearing links:\n");
+ for (i = 0; i < dl_size; i++) {
+ for (curr_dl = dl_head[i]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
+ real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
+ real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
+ GC_printf2("Object: 0x%lx, Link:0x%lx\n", real_ptr, real_link);
+ }
+ }
+ GC_printf0("Finalizers:\n");
+ for (i = 0; i < fo_size; i++) {
+ for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
+ real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
+ GC_printf1("Finalizable object: 0x%lx\n", real_ptr);
+ }
+ }
+}
+#endif
+
+/* Called with world stopped. Cause disappearing links to disappear, */
+/* and invoke finalizers. */
+void GC_finalize()
+{
+ struct disappearing_link * curr_dl, * prev_dl, * next_dl;
+ struct finalizable_object * curr_fo, * prev_fo, * next_fo;
+ ptr_t real_ptr, real_link;
+ register int i;
+ int dl_size = (log_dl_table_size == -1 ) ? 0 : (1 << log_dl_table_size);
+ int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
+
+ /* Make disappearing links disappear */
+ for (i = 0; i < dl_size; i++) {
+ curr_dl = dl_head[i];
+ prev_dl = 0;
+ while (curr_dl != 0) {
+ real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
+ real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
+ if (!GC_is_marked(real_ptr)) {
+ *(word *)real_link = 0;
+ next_dl = dl_next(curr_dl);
+ if (prev_dl == 0) {
+ dl_head[i] = next_dl;
+ } else {
+ dl_set_next(prev_dl, next_dl);
+ }
+ GC_clear_mark_bit((ptr_t)curr_dl);
+ GC_dl_entries--;
+ curr_dl = next_dl;
+ } else {
+ prev_dl = curr_dl;
+ curr_dl = dl_next(curr_dl);
+ }
+ }
+ }
+ /* Mark all objects reachable via chains of 1 or more pointers */
+ /* from finalizable objects. */
+ GC_ASSERT(GC_mark_state == MS_NONE);
+ for (i = 0; i < fo_size; i++) {
+ for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
+ real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
+ if (!GC_is_marked(real_ptr)) {
+ GC_MARKED_FOR_FINALIZATION(real_ptr);
+ GC_MARK_FO(real_ptr, curr_fo -> fo_mark_proc);
+ if (GC_is_marked(real_ptr)) {
+ WARN("Finalization cycle involving %lx\n", real_ptr);
+ }
+ }
+ }
+ }
+ /* Enqueue for finalization all objects that are still */
+ /* unreachable. */
+ GC_words_finalized = 0;
+ for (i = 0; i < fo_size; i++) {
+ curr_fo = fo_head[i];
+ prev_fo = 0;
+ while (curr_fo != 0) {
+ real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
+ if (!GC_is_marked(real_ptr)) {
+ if (!GC_java_finalization) {
+ GC_set_mark_bit(real_ptr);
+ }
+ /* Delete from hash table */
+ next_fo = fo_next(curr_fo);
+ if (prev_fo == 0) {
+ fo_head[i] = next_fo;
+ } else {
+ fo_set_next(prev_fo, next_fo);
+ }
+ GC_fo_entries--;
+ /* Add to list of objects awaiting finalization. */
+ fo_set_next(curr_fo, GC_finalize_now);
+ GC_finalize_now = curr_fo;
+ /* unhide object pointer so any future collections will */
+ /* see it. */
+ curr_fo -> fo_hidden_base =
+ (word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
+ GC_words_finalized +=
+ ALIGNED_WORDS(curr_fo -> fo_object_size)
+ + ALIGNED_WORDS(sizeof(struct finalizable_object));
+ GC_ASSERT(GC_is_marked(GC_base((ptr_t)curr_fo)));
+ curr_fo = next_fo;
+ } else {
+ prev_fo = curr_fo;
+ curr_fo = fo_next(curr_fo);
+ }
+ }
+ }
+
+ if (GC_java_finalization) {
+ /* make sure we mark everything reachable from objects finalized
+ using the no_order mark_proc */
+ for (curr_fo = GC_finalize_now;
+ curr_fo != NULL; curr_fo = fo_next(curr_fo)) {
+ real_ptr = (ptr_t)curr_fo -> fo_hidden_base;
+ if (!GC_is_marked(real_ptr)) {
+ if (curr_fo -> fo_mark_proc == GC_null_finalize_mark_proc) {
+ GC_MARK_FO(real_ptr, GC_normal_finalize_mark_proc);
+ }
+ GC_set_mark_bit(real_ptr);
+ }
+ }
+ }
+
+ /* Remove dangling disappearing links. */
+ for (i = 0; i < dl_size; i++) {
+ curr_dl = dl_head[i];
+ prev_dl = 0;
+ while (curr_dl != 0) {
+ real_link = GC_base((ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link));
+ if (real_link != 0 && !GC_is_marked(real_link)) {
+ next_dl = dl_next(curr_dl);
+ if (prev_dl == 0) {
+ dl_head[i] = next_dl;
+ } else {
+ dl_set_next(prev_dl, next_dl);
+ }
+ GC_clear_mark_bit((ptr_t)curr_dl);
+ GC_dl_entries--;
+ curr_dl = next_dl;
+ } else {
+ prev_dl = curr_dl;
+ curr_dl = dl_next(curr_dl);
+ }
+ }
+ }
+}
+
+#ifndef JAVA_FINALIZATION_NOT_NEEDED
+
+/* Enqueue all remaining finalizers to be run - Assumes lock is
+ * held, and signals are disabled */
+void GC_enqueue_all_finalizers()
+{
+ struct finalizable_object * curr_fo, * prev_fo, * next_fo;
+ ptr_t real_ptr;
+ register int i;
+ int fo_size;
+
+ fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
+ GC_words_finalized = 0;
+ for (i = 0; i < fo_size; i++) {
+ curr_fo = fo_head[i];
+ prev_fo = 0;
+ while (curr_fo != 0) {
+ real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
+ GC_MARK_FO(real_ptr, GC_normal_finalize_mark_proc);
+ GC_set_mark_bit(real_ptr);
+
+ /* Delete from hash table */
+ next_fo = fo_next(curr_fo);
+ if (prev_fo == 0) {
+ fo_head[i] = next_fo;
+ } else {
+ fo_set_next(prev_fo, next_fo);
+ }
+ GC_fo_entries--;
+
+ /* Add to list of objects awaiting finalization. */
+ fo_set_next(curr_fo, GC_finalize_now);
+ GC_finalize_now = curr_fo;
+
+ /* unhide object pointer so any future collections will */
+ /* see it. */
+ curr_fo -> fo_hidden_base =
+ (word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
+
+ GC_words_finalized +=
+ ALIGNED_WORDS(curr_fo -> fo_object_size)
+ + ALIGNED_WORDS(sizeof(struct finalizable_object));
+ curr_fo = next_fo;
+ }
+ }
+
+ return;
+}
+
+/* Invoke all remaining finalizers that haven't yet been run.
+ * This is needed for strict compliance with the Java standard,
+ * which can make the runtime guarantee that all finalizers are run.
+ * Unfortunately, the Java standard implies we have to keep running
+ * finalizers until there are no more left, a potential infinite loop.
+ * YUCK.
+ * Note that this is even more dangerous than the usual Java
+ * finalizers, in that objects reachable from static variables
+ * may have been finalized when these finalizers are run.
+ * Finalizers run at this point must be prepared to deal with a
+ * mostly broken world.
+ * This routine is externally callable, so is called without
+ * the allocation lock.
+ */
+GC_API void GC_finalize_all()
+{
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ while (GC_fo_entries > 0) {
+ GC_enqueue_all_finalizers();
+ UNLOCK();
+ ENABLE_SIGNALS();
+ GC_INVOKE_FINALIZERS();
+ DISABLE_SIGNALS();
+ LOCK();
+ }
+ UNLOCK();
+ ENABLE_SIGNALS();
+}
+#endif
+
+/* Returns true if it is worth calling GC_invoke_finalizers. (Useful if */
+/* finalizers can only be called from some kind of `safe state' and */
+/* getting into that safe state is expensive.) */
+int GC_should_invoke_finalizers GC_PROTO((void))
+{
+ return GC_finalize_now != 0;
+}
+
+/* Invoke finalizers for all objects that are ready to be finalized. */
+/* Should be called without allocation lock. */
+int GC_invoke_finalizers()
+{
+ struct finalizable_object * curr_fo;
+ int count = 0;
+ word mem_freed_before;
+ GC_bool first_time = TRUE;
+ DCL_LOCK_STATE;
+
+ while (GC_finalize_now != 0) {
+# ifdef THREADS
+ DISABLE_SIGNALS();
+ LOCK();
+# endif
+ if (first_time) {
+ mem_freed_before = GC_mem_freed;
+ first_time = FALSE;
+ }
+ curr_fo = GC_finalize_now;
+# ifdef THREADS
+ if (curr_fo != 0) GC_finalize_now = fo_next(curr_fo);
+ UNLOCK();
+ ENABLE_SIGNALS();
+ if (curr_fo == 0) break;
+# else
+ GC_finalize_now = fo_next(curr_fo);
+# endif
+ fo_set_next(curr_fo, 0);
+ (*(curr_fo -> fo_fn))((ptr_t)(curr_fo -> fo_hidden_base),
+ curr_fo -> fo_client_data);
+ curr_fo -> fo_client_data = 0;
+ ++count;
+# ifdef UNDEFINED
+ /* This is probably a bad idea. It throws off accounting if */
+ /* nearly all objects are finalizable. O.w. it shouldn't */
+ /* matter. */
+ GC_free((GC_PTR)curr_fo);
+# endif
+ }
+ if (mem_freed_before != GC_mem_freed) {
+ LOCK();
+ GC_finalizer_mem_freed += (GC_mem_freed - mem_freed_before);
+ UNLOCK();
+ }
+ return count;
+}
+
+void (* GC_finalizer_notifier)() = (void (*) GC_PROTO((void)))0;
+
+static GC_word last_finalizer_notification = 0;
+
+void GC_notify_or_invoke_finalizers GC_PROTO((void))
+{
+ if (GC_finalize_now == 0) return;
+ if (!GC_finalize_on_demand) {
+ (void) GC_invoke_finalizers();
+# ifndef THREADS
+ GC_ASSERT(GC_finalize_now == 0);
+# endif /* Otherwise GC can run concurrently and add more */
+ return;
+ }
+ if (GC_finalizer_notifier != (void (*) GC_PROTO((void)))0
+ && last_finalizer_notification != GC_gc_no) {
+ last_finalizer_notification = GC_gc_no;
+ GC_finalizer_notifier();
+ }
+}
+
+# ifdef __STDC__
+ GC_PTR GC_call_with_alloc_lock(GC_fn_type fn,
+ GC_PTR client_data)
+# else
+ GC_PTR GC_call_with_alloc_lock(fn, client_data)
+ GC_fn_type fn;
+ GC_PTR client_data;
+# endif
+{
+ GC_PTR result;
+ DCL_LOCK_STATE;
+
+# ifdef THREADS
+ DISABLE_SIGNALS();
+ LOCK();
+ SET_LOCK_HOLDER();
+# endif
+ result = (*fn)(client_data);
+# ifdef THREADS
+# ifndef GC_ASSERTIONS
+ UNSET_LOCK_HOLDER();
+# endif /* o.w. UNLOCK() does it implicitly */
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ return(result);
+}
+
+#if !defined(NO_DEBUGGING)
+
+void GC_print_finalization_stats()
+{
+ struct finalizable_object *fo = GC_finalize_now;
+ size_t ready = 0;
+
+ GC_printf2("%lu finalization table entries; %lu disappearing links\n",
+ GC_fo_entries, GC_dl_entries);
+ for (; 0 != fo; fo = fo_next(fo)) ++ready;
+ GC_printf1("%lu objects are eligible for immediate finalization\n", ready);
+}
+
+#endif /* NO_DEBUGGING */
--- /dev/null
+# Microsoft Developer Studio Generated NMAKE File, Format Version 4.10
+# This has been hand-edited way too many times.
+# A clean, manually generated makefile would be an improvement.
+
+# TARGTYPE "Win32 (x86) Application" 0x0101
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+
+!IF "$(CFG)" == ""
+CFG=gctest - Win32 Release
+!MESSAGE No configuration specified. Defaulting to cord - Win32 Debug.
+!ENDIF
+
+!IF "$(CFG)" != "gc - Win32 Release" && "$(CFG)" != "gc - Win32 Debug" &&\
+ "$(CFG)" != "gctest - Win32 Release" && "$(CFG)" != "gctest - Win32 Debug" &&\
+ "$(CFG)" != "cord - Win32 Release" && "$(CFG)" != "cord - Win32 Debug"
+!MESSAGE Invalid configuration "$(CFG)" specified.
+!MESSAGE You can specify a configuration when running NMAKE on this makefile
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "gc.mak" CFG="cord - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "gc - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "gc - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "gctest - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "gctest - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE "cord - Win32 Release" (based on "Win32 (x86) Application")
+!MESSAGE "cord - Win32 Debug" (based on "Win32 (x86) Application")
+!MESSAGE
+!ERROR An invalid configuration is specified.
+!ENDIF
+
+!IF "$(OS)" == "Windows_NT"
+NULL=
+!ELSE
+NULL=nul
+!ENDIF
+################################################################################
+# Begin Project
+# PROP Target_Last_Scanned "gctest - Win32 Debug"
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Target_Dir ""
+OUTDIR=.\Release
+INTDIR=.\Release
+
+ALL : ".\Release\gc.dll" ".\Release\gc.bsc"
+
+CLEAN :
+ -@erase ".\Release\allchblk.obj"
+ -@erase ".\Release\allchblk.sbr"
+ -@erase ".\Release\alloc.obj"
+ -@erase ".\Release\alloc.sbr"
+ -@erase ".\Release\blacklst.obj"
+ -@erase ".\Release\blacklst.sbr"
+ -@erase ".\Release\checksums.obj"
+ -@erase ".\Release\checksums.sbr"
+ -@erase ".\Release\dbg_mlc.obj"
+ -@erase ".\Release\dbg_mlc.sbr"
+ -@erase ".\Release\dyn_load.obj"
+ -@erase ".\Release\dyn_load.sbr"
+ -@erase ".\Release\finalize.obj"
+ -@erase ".\Release\finalize.sbr"
+ -@erase ".\Release\gc.bsc"
+ -@erase ".\Release\gc_cpp.obj"
+ -@erase ".\Release\gc_cpp.sbr"
+ -@erase ".\Release\gc.dll"
+ -@erase ".\Release\gc.exp"
+ -@erase ".\Release\gc.lib"
+ -@erase ".\Release\headers.obj"
+ -@erase ".\Release\headers.sbr"
+ -@erase ".\Release\mach_dep.obj"
+ -@erase ".\Release\mach_dep.sbr"
+ -@erase ".\Release\malloc.obj"
+ -@erase ".\Release\malloc.sbr"
+ -@erase ".\Release\mallocx.obj"
+ -@erase ".\Release\mallocx.sbr"
+ -@erase ".\Release\mark.obj"
+ -@erase ".\Release\mark.sbr"
+ -@erase ".\Release\mark_rts.obj"
+ -@erase ".\Release\mark_rts.sbr"
+ -@erase ".\Release\misc.obj"
+ -@erase ".\Release\misc.sbr"
+ -@erase ".\Release\new_hblk.obj"
+ -@erase ".\Release\new_hblk.sbr"
+ -@erase ".\Release\obj_map.obj"
+ -@erase ".\Release\obj_map.sbr"
+ -@erase ".\Release\os_dep.obj"
+ -@erase ".\Release\os_dep.sbr"
+ -@erase ".\Release\ptr_chck.obj"
+ -@erase ".\Release\ptr_chck.sbr"
+ -@erase ".\Release\reclaim.obj"
+ -@erase ".\Release\reclaim.sbr"
+ -@erase ".\Release\stubborn.obj"
+ -@erase ".\Release\stubborn.sbr"
+ -@erase ".\Release\typd_mlc.obj"
+ -@erase ".\Release\typd_mlc.sbr"
+ -@erase ".\Release\win32_threads.obj"
+ -@erase ".\Release\win32_threads.sbr"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /I include /D "NDEBUG" /D "SILENT" /D "GC_BUILD" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /I include /D "NDEBUG" /D "SILENT" /D "GC_BUILD" /D\
+ "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D\
+ "GC_WIN32_THREADS" /FR"$(INTDIR)/" /Fp"$(INTDIR)/gc.pch" /YX /Fo"$(INTDIR)/" /c
+CPP_OBJS=.\Release/
+CPP_SBRS=.\Release/
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gc.bsc"
+BSC32_SBRS= \
+ ".\Release\allchblk.sbr" \
+ ".\Release\alloc.sbr" \
+ ".\Release\blacklst.sbr" \
+ ".\Release\checksums.sbr" \
+ ".\Release\dbg_mlc.sbr" \
+ ".\Release\dyn_load.sbr" \
+ ".\Release\finalize.sbr" \
+ ".\Release\gc_cpp.sbr" \
+ ".\Release\headers.sbr" \
+ ".\Release\mach_dep.sbr" \
+ ".\Release\malloc.sbr" \
+ ".\Release\mallocx.sbr" \
+ ".\Release\mark.sbr" \
+ ".\Release\mark_rts.sbr" \
+ ".\Release\misc.sbr" \
+ ".\Release\new_hblk.sbr" \
+ ".\Release\obj_map.sbr" \
+ ".\Release\os_dep.sbr" \
+ ".\Release\ptr_chck.sbr" \
+ ".\Release\reclaim.sbr" \
+ ".\Release\stubborn.sbr" \
+ ".\Release\typd_mlc.sbr" \
+ ".\Release\win32_threads.sbr"
+
+".\Release\gc.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+ $(BSC32) @<<
+ $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /dll /incremental:no\
+ /pdb:"$(OUTDIR)/gc.pdb" /machine:I386 /out:"$(OUTDIR)/gc.dll"\
+ /implib:"$(OUTDIR)/gc.lib"
+LINK32_OBJS= \
+ ".\Release\allchblk.obj" \
+ ".\Release\alloc.obj" \
+ ".\Release\blacklst.obj" \
+ ".\Release\checksums.obj" \
+ ".\Release\dbg_mlc.obj" \
+ ".\Release\dyn_load.obj" \
+ ".\Release\finalize.obj" \
+ ".\Release\gc_cpp.obj" \
+ ".\Release\headers.obj" \
+ ".\Release\mach_dep.obj" \
+ ".\Release\malloc.obj" \
+ ".\Release\mallocx.obj" \
+ ".\Release\mark.obj" \
+ ".\Release\mark_rts.obj" \
+ ".\Release\misc.obj" \
+ ".\Release\new_hblk.obj" \
+ ".\Release\obj_map.obj" \
+ ".\Release\os_dep.obj" \
+ ".\Release\ptr_chck.obj" \
+ ".\Release\reclaim.obj" \
+ ".\Release\stubborn.obj" \
+ ".\Release\typd_mlc.obj" \
+ ".\Release\win32_threads.obj"
+
+".\Release\gc.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Target_Dir ""
+OUTDIR=.\Debug
+INTDIR=.\Debug
+
+ALL : ".\Debug\gc.dll" ".\Debug\gc.bsc"
+
+CLEAN :
+ -@erase ".\Debug\allchblk.obj"
+ -@erase ".\Debug\allchblk.sbr"
+ -@erase ".\Debug\alloc.obj"
+ -@erase ".\Debug\alloc.sbr"
+ -@erase ".\Debug\blacklst.obj"
+ -@erase ".\Debug\blacklst.sbr"
+ -@erase ".\Debug\checksums.obj"
+ -@erase ".\Debug\checksums.sbr"
+ -@erase ".\Debug\dbg_mlc.obj"
+ -@erase ".\Debug\dbg_mlc.sbr"
+ -@erase ".\Debug\dyn_load.obj"
+ -@erase ".\Debug\dyn_load.sbr"
+ -@erase ".\Debug\finalize.obj"
+ -@erase ".\Debug\finalize.sbr"
+ -@erase ".\Debug\gc_cpp.obj"
+ -@erase ".\Debug\gc_cpp.sbr"
+ -@erase ".\Debug\gc.bsc"
+ -@erase ".\Debug\gc.dll"
+ -@erase ".\Debug\gc.exp"
+ -@erase ".\Debug\gc.lib"
+ -@erase ".\Debug\gc.map"
+ -@erase ".\Debug\gc.pdb"
+ -@erase ".\Debug\headers.obj"
+ -@erase ".\Debug\headers.sbr"
+ -@erase ".\Debug\mach_dep.obj"
+ -@erase ".\Debug\mach_dep.sbr"
+ -@erase ".\Debug\malloc.obj"
+ -@erase ".\Debug\malloc.sbr"
+ -@erase ".\Debug\mallocx.obj"
+ -@erase ".\Debug\mallocx.sbr"
+ -@erase ".\Debug\mark.obj"
+ -@erase ".\Debug\mark.sbr"
+ -@erase ".\Debug\mark_rts.obj"
+ -@erase ".\Debug\mark_rts.sbr"
+ -@erase ".\Debug\misc.obj"
+ -@erase ".\Debug\misc.sbr"
+ -@erase ".\Debug\new_hblk.obj"
+ -@erase ".\Debug\new_hblk.sbr"
+ -@erase ".\Debug\obj_map.obj"
+ -@erase ".\Debug\obj_map.sbr"
+ -@erase ".\Debug\os_dep.obj"
+ -@erase ".\Debug\os_dep.sbr"
+ -@erase ".\Debug\ptr_chck.obj"
+ -@erase ".\Debug\ptr_chck.sbr"
+ -@erase ".\Debug\reclaim.obj"
+ -@erase ".\Debug\reclaim.sbr"
+ -@erase ".\Debug\stubborn.obj"
+ -@erase ".\Debug\stubborn.sbr"
+ -@erase ".\Debug\typd_mlc.obj"
+ -@erase ".\Debug\typd_mlc.sbr"
+ -@erase ".\Debug\vc40.idb"
+ -@erase ".\Debug\vc40.pdb"
+ -@erase ".\Debug\win32_threads.obj"
+ -@erase ".\Debug\win32_threads.sbr"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I include /D "_DEBUG" /D "SILENT" /D "GC_BUILD" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /I include /D "_DEBUG" /D "SILENT" /D "GC_BUILD"\
+ /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D\
+ "GC_WIN32_THREADS" /FR"$(INTDIR)/" /Fp"$(INTDIR)/gc.pch" /YX /Fo"$(INTDIR)/"\
+ /Fd"$(INTDIR)/" /c
+CPP_OBJS=.\Debug/
+CPP_SBRS=.\Debug/
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gc.bsc"
+BSC32_SBRS= \
+ ".\Debug\allchblk.sbr" \
+ ".\Debug\alloc.sbr" \
+ ".\Debug\blacklst.sbr" \
+ ".\Debug\checksums.sbr" \
+ ".\Debug\dbg_mlc.sbr" \
+ ".\Debug\dyn_load.sbr" \
+ ".\Debug\finalize.sbr" \
+ ".\Debug\gc_cpp.sbr" \
+ ".\Debug\headers.sbr" \
+ ".\Debug\mach_dep.sbr" \
+ ".\Debug\malloc.sbr" \
+ ".\Debug\mallocx.sbr" \
+ ".\Debug\mark.sbr" \
+ ".\Debug\mark_rts.sbr" \
+ ".\Debug\misc.sbr" \
+ ".\Debug\new_hblk.sbr" \
+ ".\Debug\obj_map.sbr" \
+ ".\Debug\os_dep.sbr" \
+ ".\Debug\ptr_chck.sbr" \
+ ".\Debug\reclaim.sbr" \
+ ".\Debug\stubborn.sbr" \
+ ".\Debug\typd_mlc.sbr" \
+ ".\Debug\win32_threads.sbr"
+
+".\Debug\gc.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+ $(BSC32) @<<
+ $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /incremental:no /map /debug /machine:I386
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /dll /incremental:no\
+ /pdb:"$(OUTDIR)/gc.pdb" /map:"$(INTDIR)/gc.map" /debug /machine:I386\
+ /out:"$(OUTDIR)/gc.dll" /implib:"$(OUTDIR)/gc.lib"
+LINK32_OBJS= \
+ ".\Debug\allchblk.obj" \
+ ".\Debug\alloc.obj" \
+ ".\Debug\blacklst.obj" \
+ ".\Debug\checksums.obj" \
+ ".\Debug\dbg_mlc.obj" \
+ ".\Debug\dyn_load.obj" \
+ ".\Debug\finalize.obj" \
+ ".\Debug\gc_cpp.obj" \
+ ".\Debug\headers.obj" \
+ ".\Debug\mach_dep.obj" \
+ ".\Debug\malloc.obj" \
+ ".\Debug\mallocx.obj" \
+ ".\Debug\mark.obj" \
+ ".\Debug\mark_rts.obj" \
+ ".\Debug\misc.obj" \
+ ".\Debug\new_hblk.obj" \
+ ".\Debug\obj_map.obj" \
+ ".\Debug\os_dep.obj" \
+ ".\Debug\ptr_chck.obj" \
+ ".\Debug\reclaim.obj" \
+ ".\Debug\stubborn.obj" \
+ ".\Debug\typd_mlc.obj" \
+ ".\Debug\win32_threads.obj"
+
+".\Debug\gc.dll" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "gctest\Release"
+# PROP BASE Intermediate_Dir "gctest\Release"
+# PROP BASE Target_Dir "gctest"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "gctest\Release"
+# PROP Intermediate_Dir "gctest\Release"
+# PROP Target_Dir "gctest"
+OUTDIR=.\gctest\Release
+INTDIR=.\gctest\Release
+
+ALL : "gc - Win32 Release" ".\Release\gctest.exe"
+
+CLEAN :
+ -@erase ".\gctest\Release\test.obj"
+ -@erase ".\Release\gctest.exe"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+test.c : tests\test.c
+ copy tests\test.c test.c
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /I include /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /I include /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D\
+ "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS"\
+ /Fp"$(INTDIR)/gctest.pch" /YX /Fo"$(INTDIR)/" /c
+CPP_OBJS=.\gctest\Release/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gctest.bsc"
+BSC32_SBRS= \
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /out:"Release/gctest.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no\
+ /pdb:"$(OUTDIR)/gctest.pdb" /machine:I386 /out:"Release/gctest.exe"
+LINK32_OBJS= \
+ ".\gctest\Release\test.obj" \
+ ".\Release\gc.lib"
+
+".\Release\gctest.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "gctest\Debug"
+# PROP BASE Intermediate_Dir "gctest\Debug"
+# PROP BASE Target_Dir "gctest"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "gctest\Debug"
+# PROP Intermediate_Dir "gctest\Debug"
+# PROP Target_Dir "gctest"
+OUTDIR=.\gctest\Debug
+INTDIR=.\gctest\Debug
+
+ALL : "gc - Win32 Debug" ".\Debug\gctest.exe" ".\gctest\Debug\gctest.bsc"
+
+CLEAN :
+ -@erase ".\Debug\gctest.exe"
+ -@erase ".\gctest\Debug\gctest.bsc"
+ -@erase ".\gctest\Debug\gctest.map"
+ -@erase ".\gctest\Debug\gctest.pdb"
+ -@erase ".\gctest\Debug\test.obj"
+ -@erase ".\gctest\Debug\test.sbr"
+ -@erase ".\gctest\Debug\vc40.idb"
+ -@erase ".\gctest\Debug\vc40.pdb"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /FR /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /I include /D "_DEBUG" /D "WIN32" /D "_WINDOWS"\
+ /D "ALL_INTERIOR_POINTERS" /D "__STDC__" /D "GC_WIN32_THREADS" /FR"$(INTDIR)/"\
+ /Fp"$(INTDIR)/gctest.pch" /YX /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c
+CPP_OBJS=.\gctest\Debug/
+CPP_SBRS=.\gctest\Debug/
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/gctest.bsc"
+BSC32_SBRS= \
+ ".\gctest\Debug\test.sbr"
+
+".\gctest\Debug\gctest.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
+ $(BSC32) @<<
+ $(BSC32_FLAGS) $(BSC32_SBRS)
+<<
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /incremental:no /map /debug /machine:I386 /out:"Debug/gctest.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no\
+ /pdb:"$(OUTDIR)/gctest.pdb" /map:"$(INTDIR)/gctest.map" /debug /machine:I386\
+ /out:"Debug/gctest.exe"
+LINK32_OBJS= \
+ ".\Debug\gc.lib" \
+ ".\gctest\Debug\test.obj"
+
+".\Debug\gctest.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "cord - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "cord\Release"
+# PROP BASE Intermediate_Dir "cord\Release"
+# PROP BASE Target_Dir "cord"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "cord\Release"
+# PROP Intermediate_Dir "cord\Release"
+# PROP Target_Dir "cord"
+OUTDIR=.\cord\Release
+INTDIR=.\cord\Release
+
+ALL : "gc - Win32 Release" ".\Release\de.exe"
+
+CLEAN :
+ -@erase ".\cord\Release\cordbscs.obj"
+ -@erase ".\cord\Release\cordxtra.obj"
+ -@erase ".\cord\Release\de.obj"
+ -@erase ".\cord\Release\de_win.obj"
+ -@erase ".\cord\Release\de_win.res"
+ -@erase ".\Release\de.exe"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MD /W3 /GX /O2 /I "." /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /YX /c
+CPP_PROJ=/nologo /MD /W3 /GX /O2 /I "." /I include /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D\
+ "ALL_INTERIOR_POINTERS" /Fp"$(INTDIR)/cord.pch" /YX /Fo"$(INTDIR)/" /c
+CPP_OBJS=.\cord\Release/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /win32
+MTL_PROJ=/nologo /D "NDEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "NDEBUG"
+# ADD RSC /l 0x809 /d "NDEBUG"
+RSC_PROJ=/l 0x809 /fo"$(INTDIR)/de_win.res" /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/cord.bsc"
+BSC32_SBRS= \
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /machine:I386 /out:"Release/de.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:no /pdb:"$(OUTDIR)/de.pdb"\
+ /machine:I386 /out:"Release/de.exe"
+LINK32_OBJS= \
+ ".\cord\Release\cordbscs.obj" \
+ ".\cord\Release\cordxtra.obj" \
+ ".\cord\Release\de.obj" \
+ ".\cord\Release\de_win.obj" \
+ ".\cord\Release\de_win.res" \
+ ".\Release\gc.lib"
+
+".\Release\de.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "cord\Debug"
+# PROP BASE Intermediate_Dir "cord\Debug"
+# PROP BASE Target_Dir "cord"
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "cord\Debug"
+# PROP Intermediate_Dir "cord\Debug"
+# PROP Target_Dir "cord"
+OUTDIR=.\cord\Debug
+INTDIR=.\cord\Debug
+
+ALL : "gc - Win32 Debug" ".\Debug\de.exe"
+
+CLEAN :
+ -@erase ".\cord\Debug\cordbscs.obj"
+ -@erase ".\cord\Debug\cordxtra.obj"
+ -@erase ".\cord\Debug\de.obj"
+ -@erase ".\cord\Debug\de.pdb"
+ -@erase ".\cord\Debug\de_win.obj"
+ -@erase ".\cord\Debug\de_win.res"
+ -@erase ".\cord\Debug\vc40.idb"
+ -@erase ".\cord\Debug\vc40.pdb"
+ -@erase ".\Debug\de.exe"
+ -@erase ".\Debug\de.ilk"
+
+"$(OUTDIR)" :
+ if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
+
+CPP=cl.exe
+# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "." /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /YX /c
+CPP_PROJ=/nologo /MDd /W3 /Gm /GX /Zi /Od /I "." /I include /D "_DEBUG" /D "WIN32" /D\
+ "_WINDOWS" /D "ALL_INTERIOR_POINTERS" /Fp"$(INTDIR)/cord.pch" /YX\
+ /Fo"$(INTDIR)/" /Fd"$(INTDIR)/" /c
+CPP_OBJS=.\cord\Debug/
+CPP_SBRS=.\.
+
+.c{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_OBJS)}.obj:
+ $(CPP) $(CPP_PROJ) $<
+
+.c{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cpp{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+.cxx{$(CPP_SBRS)}.sbr:
+ $(CPP) $(CPP_PROJ) $<
+
+MTL=mktyplib.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /win32
+MTL_PROJ=/nologo /D "_DEBUG" /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x809 /d "_DEBUG"
+# ADD RSC /l 0x809 /d "_DEBUG"
+RSC_PROJ=/l 0x809 /fo"$(INTDIR)/de_win.res" /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+BSC32_FLAGS=/nologo /o"$(OUTDIR)/cord.bsc"
+BSC32_SBRS= \
+
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /debug /machine:I386 /out:"Debug/de.exe"
+LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
+ advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\
+ odbccp32.lib /nologo /subsystem:windows /incremental:yes\
+ /pdb:"$(OUTDIR)/de.pdb" /debug /machine:I386 /out:"Debug/de.exe"
+LINK32_OBJS= \
+ ".\cord\Debug\cordbscs.obj" \
+ ".\cord\Debug\cordxtra.obj" \
+ ".\cord\Debug\de.obj" \
+ ".\cord\Debug\de_win.obj" \
+ ".\cord\Debug\de_win.res" \
+ ".\Debug\gc.lib"
+
+".\Debug\de.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
+ $(LINK32) @<<
+ $(LINK32_FLAGS) $(LINK32_OBJS)
+<<
+
+!ENDIF
+
+################################################################################
+# Begin Target
+
+# Name "gc - Win32 Release"
+# Name "gc - Win32 Debug"
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+!ENDIF
+
+################################################################################
+# Begin Source File
+
+SOURCE=.\gc_cpp.cpp
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_RECLA=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_cpp.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_RECLA=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\gc_cpp.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Release\gc_cpp.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_RECLA=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_cpp.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_RECLA=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\gc_cpp.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Debug\gc_cpp.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\reclaim.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_RECLA=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_RECLA=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\reclaim.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Release\reclaim.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_RECLA=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_RECLA=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\reclaim.obj" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+".\Debug\reclaim.sbr" : $(SOURCE) $(DEP_CPP_RECLA) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+
+################################################################################
+# Begin Source File
+
+SOURCE=.\os_dep.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_OS_DE=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\STAT.H"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_OS_DE=\
+ ".\il\PCR_IL.h"\
+ ".\mm\PCR_MM.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+ ".\vd\PCR_VD.h"\
+
+
+".\Release\os_dep.obj" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+".\Release\os_dep.sbr" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_OS_DE=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\STAT.H"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_OS_DE=\
+ ".\il\PCR_IL.h"\
+ ".\mm\PCR_MM.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+ ".\vd\PCR_VD.h"\
+
+
+".\Debug\os_dep.obj" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+".\Debug\os_dep.sbr" : $(SOURCE) $(DEP_CPP_OS_DE) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\misc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MISC_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MISC_=\
+ ".\il\PCR_IL.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\misc.obj" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+".\Release\misc.sbr" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MISC_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MISC_=\
+ ".\il\PCR_IL.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\misc.obj" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+".\Debug\misc.sbr" : $(SOURCE) $(DEP_CPP_MISC_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mark_rts.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MARK_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MARK_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\mark_rts.obj" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+".\Release\mark_rts.sbr" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MARK_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MARK_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\mark_rts.obj" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+".\Debug\mark_rts.sbr" : $(SOURCE) $(DEP_CPP_MARK_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mach_dep.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MACH_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MACH_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\mach_dep.obj" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+".\Release\mach_dep.sbr" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MACH_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MACH_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\mach_dep.obj" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+".\Debug\mach_dep.sbr" : $(SOURCE) $(DEP_CPP_MACH_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\headers.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_HEADE=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_HEADE=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\headers.obj" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+".\Release\headers.sbr" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_HEADE=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_HEADE=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\headers.obj" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+".\Debug\headers.sbr" : $(SOURCE) $(DEP_CPP_HEADE) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\alloc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_ALLOC=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_ALLOC=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\alloc.obj" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+".\Release\alloc.sbr" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_ALLOC=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_ALLOC=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\alloc.obj" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+".\Debug\alloc.sbr" : $(SOURCE) $(DEP_CPP_ALLOC) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\allchblk.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_ALLCH=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_ALLCH=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\allchblk.obj" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+".\Release\allchblk.sbr" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_ALLCH=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_ALLCH=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\allchblk.obj" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+".\Debug\allchblk.sbr" : $(SOURCE) $(DEP_CPP_ALLCH) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\stubborn.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_STUBB=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_STUBB=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\stubborn.obj" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+".\Release\stubborn.sbr" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_STUBB=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_STUBB=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\stubborn.obj" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+".\Debug\stubborn.sbr" : $(SOURCE) $(DEP_CPP_STUBB) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\obj_map.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_OBJ_M=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_OBJ_M=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\obj_map.obj" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+".\Release\obj_map.sbr" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_OBJ_M=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_OBJ_M=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\obj_map.obj" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+".\Debug\obj_map.sbr" : $(SOURCE) $(DEP_CPP_OBJ_M) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\new_hblk.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_NEW_H=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_NEW_H=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\new_hblk.obj" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+".\Release\new_hblk.sbr" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_NEW_H=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_NEW_H=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\new_hblk.obj" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+".\Debug\new_hblk.sbr" : $(SOURCE) $(DEP_CPP_NEW_H) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mark.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MARK_C=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MARK_C=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\mark.obj" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+".\Release\mark.sbr" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MARK_C=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MARK_C=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\mark.obj" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+".\Debug\mark.sbr" : $(SOURCE) $(DEP_CPP_MARK_C) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\malloc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MALLO=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MALLO=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\malloc.obj" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+".\Release\malloc.sbr" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MALLO=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MALLO=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\malloc.obj" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+".\Debug\malloc.sbr" : $(SOURCE) $(DEP_CPP_MALLO) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\mallocx.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_MALLX=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MALLX=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\mallocx.obj" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+".\Release\mallocx.sbr" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_MALLX=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_MALLX=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\mallocx.obj" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+".\Debug\mallocx.sbr" : $(SOURCE) $(DEP_CPP_MALLX) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\finalize.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_FINAL=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_FINAL=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\finalize.obj" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+".\Release\finalize.sbr" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_FINAL=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_FINAL=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\finalize.obj" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+".\Debug\finalize.sbr" : $(SOURCE) $(DEP_CPP_FINAL) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\dbg_mlc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_DBG_M=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_DBG_M=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\dbg_mlc.obj" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+".\Release\dbg_mlc.sbr" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_DBG_M=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_DBG_M=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\dbg_mlc.obj" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+".\Debug\dbg_mlc.sbr" : $(SOURCE) $(DEP_CPP_DBG_M) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\blacklst.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_BLACK=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_BLACK=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\blacklst.obj" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+".\Release\blacklst.sbr" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_BLACK=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_BLACK=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\blacklst.obj" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+".\Debug\blacklst.sbr" : $(SOURCE) $(DEP_CPP_BLACK) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\typd_mlc.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_TYPD_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_typed.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_TYPD_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\typd_mlc.obj" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+".\Release\typd_mlc.sbr" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_TYPD_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_typed.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_TYPD_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\typd_mlc.obj" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+".\Debug\typd_mlc.sbr" : $(SOURCE) $(DEP_CPP_TYPD_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\ptr_chck.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_PTR_C=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_PTR_C=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\ptr_chck.obj" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+".\Release\ptr_chck.sbr" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_PTR_C=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_pmark.h"\
+ ".\include\gc_mark.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_PTR_C=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\ptr_chck.obj" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+".\Debug\ptr_chck.sbr" : $(SOURCE) $(DEP_CPP_PTR_C) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\dyn_load.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_DYN_L=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\STAT.H"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_DYN_L=\
+ ".\il\PCR_IL.h"\
+ ".\mm\PCR_MM.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\dyn_load.obj" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+".\Release\dyn_load.sbr" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_DYN_L=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\STAT.H"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_DYN_L=\
+ ".\il\PCR_IL.h"\
+ ".\mm\PCR_MM.h"\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\dyn_load.obj" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+".\Debug\dyn_load.sbr" : $(SOURCE) $(DEP_CPP_DYN_L) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\win32_threads.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_WIN32=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_WIN32=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\win32_threads.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+".\Release\win32_threads.sbr" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_WIN32=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_WIN32=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\win32_threads.obj" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+".\Debug\win32_threads.sbr" : $(SOURCE) $(DEP_CPP_WIN32) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\checksums.c
+
+!IF "$(CFG)" == "gc - Win32 Release"
+
+DEP_CPP_CHECK=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_CHECK=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Release\checksums.obj" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+".\Release\checksums.sbr" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gc - Win32 Debug"
+
+DEP_CPP_CHECK=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_CHECK=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+".\Debug\checksums.obj" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+".\Debug\checksums.sbr" : $(SOURCE) $(DEP_CPP_CHECK) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+# End Target
+################################################################################
+# Begin Target
+
+# Name "gctest - Win32 Release"
+# Name "gctest - Win32 Debug"
+
+!IF "$(CFG)" == "gctest - Win32 Release"
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Debug"
+
+!ENDIF
+
+################################################################################
+# Begin Project Dependency
+
+# Project_Dep_Name "gc"
+
+!IF "$(CFG)" == "gctest - Win32 Release"
+
+"gc - Win32 Release" :
+ $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Release"
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Debug"
+
+"gc - Win32 Debug" :
+ $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Debug"
+
+!ENDIF
+
+# End Project Dependency
+################################################################################
+# Begin Source File
+
+SOURCE=.\tests\test.c
+DEP_CPP_TEST_=\
+ ".\include\private\gcconfig.h"\
+ ".\include\gc.h"\
+ ".\include\private\gc_hdrs.h"\
+ ".\include\private\gc_priv.h"\
+ ".\include\gc_typed.h"\
+ {$(INCLUDE)}"\sys\TYPES.H"\
+
+NODEP_CPP_TEST_=\
+ ".\th\PCR_Th.h"\
+ ".\th\PCR_ThCrSec.h"\
+ ".\th\PCR_ThCtl.h"\
+
+
+!IF "$(CFG)" == "gctest - Win32 Release"
+
+
+".\gctest\Release\test.obj" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+
+!ELSEIF "$(CFG)" == "gctest - Win32 Debug"
+
+
+".\gctest\Debug\test.obj" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+".\gctest\Debug\test.sbr" : $(SOURCE) $(DEP_CPP_TEST_) "$(INTDIR)"
+
+
+!ENDIF
+
+# End Source File
+# End Target
+################################################################################
+# Begin Target
+
+# Name "cord - Win32 Release"
+# Name "cord - Win32 Debug"
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+!ENDIF
+
+################################################################################
+# Begin Project Dependency
+
+# Project_Dep_Name "gc"
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+"gc - Win32 Release" :
+ $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Release"
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+"gc - Win32 Debug" :
+ $(MAKE) /$(MAKEFLAGS) /F ".\gc.mak" CFG="gc - Win32 Debug"
+
+!ENDIF
+
+# End Project Dependency
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de_win.c
+DEP_CPP_DE_WI=\
+ ".\include\cord.h"\
+ ".\cord\de_cmds.h"\
+ ".\cord\de_win.h"\
+ ".\include\private\cord_pos.h"\
+
+NODEP_CPP_DE_WI=\
+ ".\include\gc.h"\
+
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de_win.obj" : $(SOURCE) $(DEP_CPP_DE_WI) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de_win.obj" : $(SOURCE) $(DEP_CPP_DE_WI) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de.c
+DEP_CPP_DE_C2e=\
+ ".\include\cord.h"\
+ ".\cord\de_cmds.h"\
+ ".\cord\de_win.h"\
+ ".\include\private\cord_pos.h"\
+
+NODEP_CPP_DE_C2e=\
+ ".\include\gc.h"\
+
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de.obj" : $(SOURCE) $(DEP_CPP_DE_C2e) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de.obj" : $(SOURCE) $(DEP_CPP_DE_C2e) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\cordxtra.c
+DEP_CPP_CORDX=\
+ ".\include\cord.h"\
+ ".\include\ec.h"\
+ ".\include\private\cord_pos.h"\
+
+NODEP_CPP_CORDX=\
+ ".\include\gc.h"\
+
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\cordxtra.obj" : $(SOURCE) $(DEP_CPP_CORDX) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\cordxtra.obj" : $(SOURCE) $(DEP_CPP_CORDX) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\cordbscs.c
+DEP_CPP_CORDB=\
+ ".\include\cord.h"\
+ ".\include\private\cord_pos.h"\
+
+NODEP_CPP_CORDB=\
+ ".\include\gc.h"\
+
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\cordbscs.obj" : $(SOURCE) $(DEP_CPP_CORDB) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\cordbscs.obj" : $(SOURCE) $(DEP_CPP_CORDB) "$(INTDIR)"
+ $(CPP) $(CPP_PROJ) $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+################################################################################
+# Begin Source File
+
+SOURCE=.\cord\de_win.RC
+
+!IF "$(CFG)" == "cord - Win32 Release"
+
+
+".\cord\Release\de_win.res" : $(SOURCE) "$(INTDIR)"
+ $(RSC) /l 0x809 /fo"$(INTDIR)/de_win.res" /i "cord" /d "NDEBUG" $(SOURCE)
+
+
+!ELSEIF "$(CFG)" == "cord - Win32 Debug"
+
+
+".\cord\Debug\de_win.res" : $(SOURCE) "$(INTDIR)"
+ $(RSC) /l 0x809 /fo"$(INTDIR)/de_win.res" /i "cord" /d "_DEBUG" $(SOURCE)
+
+
+!ENDIF
+
+# End Source File
+# End Target
+# End Project
+################################################################################
--- /dev/null
+/*************************************************************************
+Copyright (c) 1994 by Xerox Corporation. All rights reserved.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+
+ Last modified on Sat Nov 19 19:31:14 PST 1994 by ellis
+ on Sat Jun 8 15:10:00 PST 1994 by boehm
+
+Permission is hereby granted to copy this code for any purpose,
+provided the above notices are retained on all copies.
+
+This implementation module for gc_c++.h provides an implementation of
+the global operators "new" and "delete" that calls the Boehm
+allocator. All objects allocated by this implementation will be
+non-collectable but part of the root set of the collector.
+
+You should ensure (using implementation-dependent techniques) that the
+linker finds this module before the library that defines the default
+built-in "new" and "delete".
+
+Authors: John R. Ellis and Jesse Hull
+
+**************************************************************************/
+/* Boehm, December 20, 1994 7:26 pm PST */
+
+#include "gc_cpp.h"
+
+void* operator new( size_t size ) {
+ return GC_MALLOC_UNCOLLECTABLE( size );}
+
+void operator delete( void* obj ) {
+ GC_FREE( obj );}
+
+#ifdef GC_OPERATOR_NEW_ARRAY
+
+void* operator new[]( size_t size ) {
+ return GC_MALLOC_UNCOLLECTABLE( size );}
+
+void operator delete[]( void* obj ) {
+ GC_FREE( obj );}
+
+#endif /* GC_OPERATOR_NEW_ARRAY */
+
+#ifdef _MSC_VER
+
+// This new operator is used by VC++ in case of Debug builds !
+void* operator new( size_t size,
+ int ,//nBlockUse,
+ const char * szFileName,
+ int nLine )
+{
+#ifndef GC_DEBUG
+ return GC_malloc_uncollectable( size );
+#else
+ return GC_debug_malloc_uncollectable(size, szFileName, nLine);
+#endif
+}
+
+#endif /* _MSC_VER */
+
--- /dev/null
+// Visual C++ seems to prefer a .cpp extension to .cc
+#include "gc_cpp.cc"
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1997 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Original author: Bill Janssen
+ * Heavily modified by Hans Boehm and others
+ */
+
+/*
+ * This used to be in dyn_load.c. It was extracted into a separate file
+ * to avoid having to link against libdl.{a,so} if the client doesn't call
+ * dlopen. Of course this fails if the collector is in a dynamic
+ * library. -HB
+ */
+
+#include "private/gc_priv.h"
+
+# if (defined(GC_PTHREADS) && !defined(GC_MACOSX_THREADS)) \
+ || defined(GC_SOLARIS_THREADS)
+
+# if defined(dlopen) && !defined(GC_USE_LD_WRAP)
+ /* To support various threads pkgs, gc.h interposes on dlopen by */
+ /* defining "dlopen" to be "GC_dlopen", which is implemented below. */
+ /* However, both GC_FirstDLOpenedLinkMap() and GC_dlopen() use the */
+ /* real system dlopen() in their implementation. We first remove */
+ /* gc.h's dlopen definition and restore it later, after GC_dlopen(). */
+# undef dlopen
+# endif
+
+ /* Make sure we're not in the middle of a collection, and make */
+ /* sure we don't start any. Returns previous value of GC_dont_gc. */
+ /* This is invoked prior to a dlopen call to avoid synchronization */
+ /* issues. We can't just acquire the allocation lock, since startup */
+ /* code in dlopen may try to allocate. */
+ /* This solution risks heap growth in the presence of many dlopen */
+ /* calls in either a multithreaded environment, or if the library */
+ /* initialization code allocates substantial amounts of GC'ed memory. */
+ /* But I don't know of a better solution. */
+ static void disable_gc_for_dlopen()
+ {
+ LOCK();
+ while (GC_incremental && GC_collection_in_progress()) {
+ GC_collect_a_little_inner(1000);
+ }
+ ++GC_dont_gc;
+ UNLOCK();
+ }
+
+ /* Redefine dlopen to guarantee mutual exclusion with */
+ /* GC_register_dynamic_libraries. */
+ /* Should probably happen for other operating systems, too. */
+
+#include <dlfcn.h>
+
+#ifdef GC_USE_LD_WRAP
+ void * __wrap_dlopen(const char *path, int mode)
+#else
+ void * GC_dlopen(path, mode)
+ GC_CONST char * path;
+ int mode;
+#endif
+{
+ void * result;
+
+# ifndef USE_PROC_FOR_LIBRARIES
+ disable_gc_for_dlopen();
+# endif
+# ifdef GC_USE_LD_WRAP
+ result = (void *)__real_dlopen(path, mode);
+# else
+ result = dlopen(path, mode);
+# endif
+# ifndef USE_PROC_FOR_LIBRARIES
+ GC_enable(); /* undoes disable_gc_for_dlopen */
+# endif
+ return(result);
+}
+# endif /* GC_PTHREADS || GC_SOLARIS_THREADS ... */
+
+
+
--- /dev/null
+/***************************************************************************
+
+Interface between g++ and Boehm GC
+
+ Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+
+ THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+
+ Permission is hereby granted to copy this code for any purpose,
+ provided the above notices are retained on all copies.
+
+ Last modified on Sun Jul 16 23:21:14 PDT 1995 by ellis
+
+This module provides runtime support for implementing the
+Ellis/Detlefs GC proposal, "Safe, Efficient Garbage Collection for
+C++", within g++, using its -fgc-keyword extension. It defines
+versions of __builtin_new, __builtin_new_gc, __builtin_vec_new,
+__builtin_vec_new_gc, __builtin_delete, and __builtin_vec_delete that
+invoke the Bohem GC. It also implements the WeakPointer.h interface.
+
+This module assumes the following configuration options of the Boehm GC:
+
+ -DALL_INTERIOR_POINTERS
+ -DDONT_ADD_BYTE_AT_END
+
+This module adds its own required padding to the end of objects to
+support C/C++ "one-past-the-object" pointer semantics.
+
+****************************************************************************/
+
+#include <stddef.h>
+#include "gc.h"
+
+#if defined(__STDC__)
+# define PROTO( args ) args
+#else
+# define PROTO( args ) ()
+# endif
+
+#define BITSPERBYTE 8
+ /* What's the portable way to do this? */
+
+
+typedef void (*vfp) PROTO(( void ));
+extern vfp __new_handler;
+extern void __default_new_handler PROTO(( void ));
+
+
+/* A destructor_proc is the compiler generated procedure representing a
+C++ destructor. The "flag" argument is a hidden argument following some
+compiler convention. */
+
+typedef (*destructor_proc) PROTO(( void* this, int flag ));
+
+
+/***************************************************************************
+
+A BI_header is the header the compiler adds to the front of
+new-allocated arrays of objects with destructors. The header is
+padded out to a double, because that's what the compiler does to
+ensure proper alignment of array elements on some architectures.
+
+int NUM_ARRAY_ELEMENTS (void* o)
+ returns the number of array elements for array object o.
+
+char* FIRST_ELEMENT_P (void* o)
+ returns the address of the first element of array object o.
+
+***************************************************************************/
+
+typedef struct BI_header {
+ int nelts;
+ char padding [sizeof( double ) - sizeof( int )];
+ /* Better way to do this? */
+} BI_header;
+
+#define NUM_ARRAY_ELEMENTS( o ) \
+ (((BI_header*) o)->nelts)
+
+#define FIRST_ELEMENT_P( o ) \
+ ((char*) o + sizeof( BI_header ))
+
+
+/***************************************************************************
+
+The __builtin_new routines add a descriptor word to the end of each
+object. The descriptor serves two purposes.
+
+First, the descriptor acts as padding, implementing C/C++ pointer
+semantics. C and C++ allow a valid array pointer to be incremented
+one past the end of an object. The extra padding ensures that the
+collector will recognize that such a pointer points to the object and
+not the next object in memory.
+
+Second, the descriptor stores three extra pieces of information,
+whether an object has a registered finalizer (destructor), whether it
+may have any weak pointers referencing it, and for collectible arrays,
+the element size of the array. The element size is required for the
+array's finalizer to iterate through the elements of the array. (An
+alternative design would have the compiler generate a finalizer
+procedure for each different array type. But given the overhead of
+finalization, there isn't any efficiency to be gained by that.)
+
+The descriptor must be added to non-collectible as well as collectible
+objects, since the Ellis/Detlefs proposal allows "pointer to gc T" to
+be assigned to a "pointer to T", which could then be deleted. Thus,
+__builtin_delete must determine at runtime whether an object is
+collectible, whether it has weak pointers referencing it, and whether
+it may have a finalizer that needs unregistering. Though
+GC_REGISTER_FINALIZER doesn't care if you ask it to unregister a
+finalizer for an object that doesn't have one, it is a non-trivial
+procedure that does a hash look-up, etc. The descriptor trades a
+little extra space for a significant increase in time on the fast path
+through delete. (A similar argument applies to
+GC_UNREGISTER_DISAPPEARING_LINK).
+
+For non-array types, the space for the descriptor could be shrunk to a
+single byte for storing the "has finalizer" flag. But this would save
+space only on arrays of char (whose size is not a multiple of the word
+size) and structs whose largest member is less than a word in size
+(very infrequent). And it would require that programmers actually
+remember to call "delete[]" instead of "delete" (which they should,
+but there are probably lots of buggy programs out there). For the
+moment, the space savings seems not worthwhile, especially considering
+that the Boehm GC is already quite space competitive with other
+malloc's.
+
+
+Given a pointer o to the base of an object:
+
+Descriptor* DESCRIPTOR (void* o)
+ returns a pointer to the descriptor for o.
+
+The implementation of descriptors relies on the fact that the GC
+implementation allocates objects in units of the machine's natural
+word size (e.g. 32 bits on a SPARC, 64 bits on an Alpha).
+
+**************************************************************************/
+
+typedef struct Descriptor {
+ unsigned has_weak_pointers: 1;
+ unsigned has_finalizer: 1;
+ unsigned element_size: BITSPERBYTE * sizeof( unsigned ) - 2;
+} Descriptor;
+
+#define DESCRIPTOR( o ) \
+ ((Descriptor*) ((char*)(o) + GC_size( o ) - sizeof( Descriptor )))
+
+
+/**************************************************************************
+
+Implementations of global operator new() and operator delete()
+
+***************************************************************************/
+
+
+void* __builtin_new( size )
+ size_t size;
+ /*
+ For non-gc non-array types, the compiler generates calls to
+ __builtin_new, which allocates non-collected storage via
+ GC_MALLOC_UNCOLLECTABLE. This ensures that the non-collected
+ storage will be part of the collector's root set, required by the
+ Ellis/Detlefs semantics. */
+{
+ vfp handler = __new_handler ? __new_handler : __default_new_handler;
+
+ while (1) {
+ void* o = GC_MALLOC_UNCOLLECTABLE( size + sizeof( Descriptor ) );
+ if (o != 0) return o;
+ (*handler) ();}}
+
+
+void* __builtin_vec_new( size )
+ size_t size;
+ /*
+ For non-gc array types, the compiler generates calls to
+ __builtin_vec_new. */
+{
+ return __builtin_new( size );}
+
+
+void* __builtin_new_gc( size )
+ size_t size;
+ /*
+ For gc non-array types, the compiler generates calls to
+ __builtin_new_gc, which allocates collected storage via
+ GC_MALLOC. */
+{
+ vfp handler = __new_handler ? __new_handler : __default_new_handler;
+
+ while (1) {
+ void* o = GC_MALLOC( size + sizeof( Descriptor ) );
+ if (o != 0) return o;
+ (*handler) ();}}
+
+
+void* __builtin_new_gc_a( size )
+ size_t size;
+ /*
+ For non-pointer-containing gc non-array types, the compiler
+ generates calls to __builtin_new_gc_a, which allocates collected
+ storage via GC_MALLOC_ATOMIC. */
+{
+ vfp handler = __new_handler ? __new_handler : __default_new_handler;
+
+ while (1) {
+ void* o = GC_MALLOC_ATOMIC( size + sizeof( Descriptor ) );
+ if (o != 0) return o;
+ (*handler) ();}}
+
+
+void* __builtin_vec_new_gc( size )
+ size_t size;
+ /*
+ For gc array types, the compiler generates calls to
+ __builtin_vec_new_gc. */
+{
+ return __builtin_new_gc( size );}
+
+
+void* __builtin_vec_new_gc_a( size )
+ size_t size;
+ /*
+ For non-pointer-containing gc array types, the compiler generates
+ calls to __builtin_vec_new_gc_a. */
+{
+ return __builtin_new_gc_a( size );}
+
+
+static void call_destructor( o, data )
+ void* o;
+ void* data;
+ /*
+ call_destructor is the GC finalizer proc registered for non-array
+ gc objects with destructors. Its client data is the destructor
+ proc, which it calls with the magic integer 2, a special flag
+ obeying the compiler convention for destructors. */
+{
+ ((destructor_proc) data)( o, 2 );}
+
+
+void* __builtin_new_gc_dtor( o, d )
+ void* o;
+ destructor_proc d;
+ /*
+ The compiler generates a call to __builtin_new_gc_dtor to register
+ the destructor "d" of a non-array gc object "o" as a GC finalizer.
+ The destructor is registered via
+ GC_REGISTER_FINALIZER_IGNORE_SELF, which causes the collector to
+ ignore pointers from the object to itself when determining when
+ the object can be finalized. This is necessary due to the self
+ pointers used in the internal representation of multiply-inherited
+ objects. */
+{
+ Descriptor* desc = DESCRIPTOR( o );
+
+ GC_REGISTER_FINALIZER_IGNORE_SELF( o, call_destructor, d, 0, 0 );
+ desc->has_finalizer = 1;}
+
+
+static void call_array_destructor( o, data )
+ void* o;
+ void* data;
+ /*
+ call_array_destructor is the GC finalizer proc registered for gc
+ array objects whose elements have destructors. Its client data is
+ the destructor proc. It iterates through the elements of the
+ array in reverse order, calling the destructor on each. */
+{
+ int num = NUM_ARRAY_ELEMENTS( o );
+ Descriptor* desc = DESCRIPTOR( o );
+ size_t size = desc->element_size;
+ char* first_p = FIRST_ELEMENT_P( o );
+ char* p = first_p + (num - 1) * size;
+
+ if (num > 0) {
+ while (1) {
+ ((destructor_proc) data)( p, 2 );
+ if (p == first_p) break;
+ p -= size;}}}
+
+
+void* __builtin_vec_new_gc_dtor( first_elem, d, element_size )
+ void* first_elem;
+ destructor_proc d;
+ size_t element_size;
+ /*
+ The compiler generates a call to __builtin_vec_new_gc_dtor to
+ register the destructor "d" of a gc array object as a GC
+ finalizer. "first_elem" points to the first element of the array,
+ *not* the beginning of the object (this makes the generated call
+ to this function smaller). The elements of the array are of size
+ "element_size". The destructor is registered as in
+ _builtin_new_gc_dtor. */
+{
+ void* o = (char*) first_elem - sizeof( BI_header );
+ Descriptor* desc = DESCRIPTOR( o );
+
+ GC_REGISTER_FINALIZER_IGNORE_SELF( o, call_array_destructor, d, 0, 0 );
+ desc->element_size = element_size;
+ desc->has_finalizer = 1;}
+
+
+void __builtin_delete( o )
+ void* o;
+ /*
+ The compiler generates calls to __builtin_delete for operator
+ delete(). The GC currently requires that any registered
+ finalizers be unregistered before explicitly freeing an object.
+ If the object has any weak pointers referencing it, we can't
+ actually free it now. */
+{
+ if (o != 0) {
+ Descriptor* desc = DESCRIPTOR( o );
+ if (desc->has_finalizer) GC_REGISTER_FINALIZER( o, 0, 0, 0, 0 );
+ if (! desc->has_weak_pointers) GC_FREE( o );}}
+
+
+void __builtin_vec_delete( o )
+ void* o;
+ /*
+ The compiler generates calls to __builitn_vec_delete for operator
+ delete[](). */
+{
+ __builtin_delete( o );}
+
+
+/**************************************************************************
+
+Implementations of the template class WeakPointer from WeakPointer.h
+
+***************************************************************************/
+
+typedef struct WeakPointer {
+ void* pointer;
+} WeakPointer;
+
+
+void* _WeakPointer_New( t )
+ void* t;
+{
+ if (t == 0) {
+ return 0;}
+ else {
+ void* base = GC_base( t );
+ WeakPointer* wp =
+ (WeakPointer*) GC_MALLOC_ATOMIC( sizeof( WeakPointer ) );
+ Descriptor* desc = DESCRIPTOR( base );
+
+ wp->pointer = t;
+ desc->has_weak_pointers = 1;
+ GC_general_register_disappearing_link( &wp->pointer, base );
+ return wp;}}
+
+
+static void* PointerWithLock( wp )
+ WeakPointer* wp;
+{
+ if (wp == 0 || wp->pointer == 0) {
+ return 0;}
+ else {
+ return (void*) wp->pointer;}}
+
+
+void* _WeakPointer_Pointer( wp )
+ WeakPointer* wp;
+{
+ return (void*) GC_call_with_alloc_lock( PointerWithLock, wp );}
+
+
+typedef struct EqualClosure {
+ WeakPointer* wp1;
+ WeakPointer* wp2;
+} EqualClosure;
+
+
+static void* EqualWithLock( ec )
+ EqualClosure* ec;
+{
+ if (ec->wp1 == 0 || ec->wp2 == 0) {
+ return (void*) (ec->wp1 == ec->wp2);}
+ else {
+ return (void*) (ec->wp1->pointer == ec->wp2->pointer);}}
+
+
+int _WeakPointer_Equal( wp1, wp2 )
+ WeakPointer* wp1;
+ WeakPointer* wp2;
+{
+ EqualClosure ec;
+
+ ec.wp1 = wp1;
+ ec.wp2 = wp2;
+ return (int) GC_call_with_alloc_lock( EqualWithLock, &ec );}
+
+
+int _WeakPointer_Hash( wp )
+ WeakPointer* wp;
+{
+ return (int) _WeakPointer_Pointer( wp );}
+
+
+/**************************************************************************
+
+Implementations of the template class CleanUp from WeakPointer.h
+
+***************************************************************************/
+
+typedef struct Closure {
+ void (*c) PROTO(( void* d, void* t ));
+ ptrdiff_t t_offset;
+ void* d;
+} Closure;
+
+
+static void _CleanUp_CallClosure( obj, data )
+ void* obj;
+ void* data;
+{
+ Closure* closure = (Closure*) data;
+ closure->c( closure->d, (char*) obj + closure->t_offset );}
+
+
+void _CleanUp_Set( t, c, d )
+ void* t;
+ void (*c) PROTO(( void* d, void* t ));
+ void* d;
+{
+ void* base = GC_base( t );
+ Descriptor* desc = DESCRIPTOR( t );
+
+ if (c == 0) {
+ GC_REGISTER_FINALIZER_IGNORE_SELF( base, 0, 0, 0, 0 );
+ desc->has_finalizer = 0;}
+ else {
+ Closure* closure = (Closure*) GC_MALLOC( sizeof( Closure ) );
+ closure->c = c;
+ closure->t_offset = (char*) t - (char*) base;
+ closure->d = d;
+ GC_REGISTER_FINALIZER_IGNORE_SELF( base, _CleanUp_CallClosure,
+ closure, 0, 0 );
+ desc->has_finalizer = 1;}}
+
+
+void _CleanUp_Call( t )
+ void* t;
+{
+ /* ? Aren't we supposed to deactivate weak pointers to t too?
+ Why? */
+ void* base = GC_base( t );
+ void* d;
+ GC_finalization_proc f;
+
+ GC_REGISTER_FINALIZER( base, 0, 0, &f, &d );
+ f( base, d );}
+
+
+typedef struct QueueElem {
+ void* o;
+ GC_finalization_proc f;
+ void* d;
+ struct QueueElem* next;
+} QueueElem;
+
+
+void* _CleanUp_Queue_NewHead()
+{
+ return GC_MALLOC( sizeof( QueueElem ) );}
+
+
+static void _CleanUp_Queue_Enqueue( obj, data )
+ void* obj;
+ void* data;
+{
+ QueueElem* q = (QueueElem*) data;
+ QueueElem* head = q->next;
+
+ q->o = obj;
+ q->next = head->next;
+ head->next = q;}
+
+
+void _CleanUp_Queue_Set( h, t )
+ void* h;
+ void* t;
+{
+ QueueElem* head = (QueueElem*) h;
+ void* base = GC_base( t );
+ void* d;
+ GC_finalization_proc f;
+ QueueElem* q = (QueueElem*) GC_MALLOC( sizeof( QueueElem ) );
+
+ GC_REGISTER_FINALIZER( base, _CleanUp_Queue_Enqueue, q, &f, &d );
+ q->f = f;
+ q->d = d;
+ q->next = head;}
+
+
+int _CleanUp_Queue_Call( h )
+ void* h;
+{
+ QueueElem* head = (QueueElem*) h;
+ QueueElem* q = head->next;
+
+ if (q == 0) {
+ return 0;}
+ else {
+ head->next = q->next;
+ q->next = 0;
+ if (q->f != 0) q->f( q->o, q->d );
+ return 1;}}
+
+
+
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+/* Boehm, July 31, 1995 5:02 pm PDT */
+
+#ifdef GC_GCJ_SUPPORT
+
+/*
+ * This is an allocator interface tuned for gcj (the GNU static
+ * java compiler).
+ *
+ * Each allocated object has a pointer in its first word to a vtable,
+ * which for our purposes is simply a structure describing the type of
+ * the object.
+ * This descriptor structure contains a GC marking descriptor at offset
+ * MARK_DESCR_OFFSET.
+ *
+ * It is hoped that this interface may also be useful for other systems,
+ * possibly with some tuning of the constants. But the immediate goal
+ * is to get better gcj performance.
+ *
+ * We assume:
+ * 1) We have an ANSI conforming C compiler.
+ * 2) Counting on explicit initialization of this interface is OK.
+ * 3) FASTLOCK is not a significant win.
+ */
+
+#include "private/gc_pmark.h"
+#include "gc_gcj.h"
+#include "private/dbg_mlc.h"
+
+GC_bool GC_gcj_malloc_initialized = FALSE;
+
+int GC_gcj_kind; /* Object kind for objects with descriptors */
+ /* in "vtable". */
+int GC_gcj_debug_kind; /* The kind of objects that is always marked */
+ /* with a mark proc call. */
+
+ptr_t * GC_gcjobjfreelist;
+ptr_t * GC_gcjdebugobjfreelist;
+
+/* Caller does not hold allocation lock. */
+void GC_init_gcj_malloc(int mp_index, void * /* really GC_mark_proc */mp)
+{
+ register int i;
+ GC_bool ignore_gcj_info;
+ DCL_LOCK_STATE;
+
+ GC_init(); /* In case it's not already done. */
+ DISABLE_SIGNALS();
+ LOCK();
+ if (GC_gcj_malloc_initialized) {
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return;
+ }
+ GC_gcj_malloc_initialized = TRUE;
+ ignore_gcj_info = (0 != GETENV("GC_IGNORE_GCJ_INFO"));
+# ifdef CONDPRINT
+ if (GC_print_stats && ignore_gcj_info) {
+ GC_printf0("Gcj-style type information is disabled!\n");
+ }
+# endif
+ GC_mark_procs[mp_index] = (GC_mark_proc)mp;
+ if (mp_index >= GC_n_mark_procs) ABORT("GC_init_gcj_malloc: bad index");
+ /* Set up object kind gcj-style indirect descriptor. */
+ GC_gcjobjfreelist = (ptr_t *)
+ GC_INTERNAL_MALLOC((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+ if (GC_gcjobjfreelist == 0) ABORT("Couldn't allocate GC_gcjobjfreelist");
+ BZERO(GC_gcjobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+ GC_gcj_kind = GC_n_kinds++;
+ GC_obj_kinds[GC_gcj_kind].ok_freelist = GC_gcjobjfreelist;
+ GC_obj_kinds[GC_gcj_kind].ok_reclaim_list = 0;
+ if (ignore_gcj_info) {
+ /* Use a simple length-based descriptor, thus forcing a fully */
+ /* conservative scan. */
+ GC_obj_kinds[GC_gcj_kind].ok_descriptor = (0 | GC_DS_LENGTH);
+ GC_obj_kinds[GC_gcj_kind].ok_relocate_descr = TRUE;
+ } else {
+ GC_obj_kinds[GC_gcj_kind].ok_descriptor =
+ (((word)(-MARK_DESCR_OFFSET - GC_INDIR_PER_OBJ_BIAS))
+ | GC_DS_PER_OBJECT);
+ GC_obj_kinds[GC_gcj_kind].ok_relocate_descr = FALSE;
+ }
+ GC_obj_kinds[GC_gcj_kind].ok_init = TRUE;
+ /* Set up object kind for objects that require mark proc call. */
+ GC_gcjdebugobjfreelist = (ptr_t *)
+ GC_INTERNAL_MALLOC((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+ if (GC_gcjdebugobjfreelist == 0)
+ ABORT("Couldn't allocate GC_gcjdebugobjfreelist");
+ BZERO(GC_gcjdebugobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+ GC_gcj_debug_kind = GC_n_kinds++;
+ GC_obj_kinds[GC_gcj_debug_kind].ok_freelist = GC_gcjdebugobjfreelist;
+ GC_obj_kinds[GC_gcj_debug_kind].ok_reclaim_list = 0;
+ if (ignore_gcj_info) {
+ GC_obj_kinds[GC_gcj_kind].ok_descriptor = (0 | GC_DS_LENGTH);
+ GC_obj_kinds[GC_gcj_kind].ok_relocate_descr = TRUE;
+ } else {
+ GC_obj_kinds[GC_gcj_debug_kind].ok_descriptor =
+ GC_MAKE_PROC(mp_index, 1 /* allocated with debug info */);
+ GC_obj_kinds[GC_gcj_debug_kind].ok_relocate_descr = FALSE;
+ }
+ GC_obj_kinds[GC_gcj_debug_kind].ok_init = TRUE;
+ UNLOCK();
+ ENABLE_SIGNALS();
+}
+
+ptr_t GC_clear_stack();
+
+#define GENERAL_MALLOC(lb,k) \
+ (GC_PTR)GC_clear_stack(GC_generic_malloc_inner((word)lb, k))
+
+#define GENERAL_MALLOC_IOP(lb,k) \
+ (GC_PTR)GC_clear_stack(GC_generic_malloc_inner_ignore_off_page(lb, k))
+
+/* Allocate an object, clear it, and store the pointer to the */
+/* type structure (vtable in gcj). */
+/* This adds a byte at the end of the object if GC_malloc would.*/
+void * GC_gcj_malloc(size_t lb, void * ptr_to_struct_containing_descr)
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+ if( EXPECT(SMALL_OBJ(lb), 1) ) {
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_gcjobjfreelist[lw]);
+ LOCK();
+ op = *opp;
+ if( EXPECT(op == 0, 0)) {
+ op = (ptr_t)GENERAL_MALLOC((word)lb, GC_gcj_kind);
+ if (0 == op) {
+ UNLOCK();
+ return(GC_oom_fn(lb));
+ }
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb]; /* May have been uninitialized. */
+# endif
+ } else {
+ *opp = obj_link(op);
+ GC_words_allocd += lw;
+ }
+ *(void **)op = ptr_to_struct_containing_descr;
+ GC_ASSERT(((void **)op)[1] == 0);
+ UNLOCK();
+ } else {
+ LOCK();
+ op = (ptr_t)GENERAL_MALLOC((word)lb, GC_gcj_kind);
+ if (0 == op) {
+ UNLOCK();
+ return(GC_oom_fn(lb));
+ }
+ *(void **)op = ptr_to_struct_containing_descr;
+ UNLOCK();
+ }
+ return((GC_PTR) op);
+}
+
+/* Similar to GC_gcj_malloc, but add debug info. This is allocated */
+/* with GC_gcj_debug_kind. */
+GC_PTR GC_debug_gcj_malloc(size_t lb, void * ptr_to_struct_containing_descr,
+ GC_EXTRA_PARAMS)
+{
+ GC_PTR result;
+
+ /* We clone the code from GC_debug_gcj_malloc, so that we */
+ /* dont end up with extra frames on the stack, which could */
+ /* confuse the backtrace. */
+ LOCK();
+ result = GC_generic_malloc_inner(lb + DEBUG_BYTES, GC_gcj_debug_kind);
+ if (result == 0) {
+ UNLOCK();
+ GC_err_printf2("GC_debug_gcj_malloc(%ld, 0x%lx) returning NIL (",
+ (unsigned long) lb,
+ (unsigned long) ptr_to_struct_containing_descr);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return(GC_oom_fn(lb));
+ }
+ *((void **)((ptr_t)result + sizeof(oh))) = ptr_to_struct_containing_descr;
+ UNLOCK();
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+/* Similar to GC_gcj_malloc, but the size is in words, and we don't */
+/* adjust it. The size is assumed to be such that it can be */
+/* allocated as a small object. */
+void * GC_gcj_fast_malloc(size_t lw, void * ptr_to_struct_containing_descr)
+{
+ptr_t op;
+ptr_t * opp;
+DCL_LOCK_STATE;
+
+ opp = &(GC_gcjobjfreelist[lw]);
+ LOCK();
+ op = *opp;
+ if( EXPECT(op == 0, 0) ) {
+ op = (ptr_t)GC_clear_stack(
+ GC_generic_malloc_words_small_inner(lw, GC_gcj_kind));
+ if (0 == op) {
+ UNLOCK();
+ return GC_oom_fn(WORDS_TO_BYTES(lw));
+ }
+ } else {
+ *opp = obj_link(op);
+ GC_words_allocd += lw;
+ }
+ *(void **)op = ptr_to_struct_containing_descr;
+ UNLOCK();
+ return((GC_PTR) op);
+}
+
+/* And a debugging version of the above: */
+void * GC_debug_gcj_fast_malloc(size_t lw,
+ void * ptr_to_struct_containing_descr,
+ GC_EXTRA_PARAMS)
+{
+ GC_PTR result;
+ size_t lb = WORDS_TO_BYTES(lw);
+
+ /* We clone the code from GC_debug_gcj_malloc, so that we */
+ /* dont end up with extra frames on the stack, which could */
+ /* confuse the backtrace. */
+ LOCK();
+ result = GC_generic_malloc_inner(lb + DEBUG_BYTES, GC_gcj_debug_kind);
+ if (result == 0) {
+ UNLOCK();
+ GC_err_printf2("GC_debug_gcj_fast_malloc(%ld, 0x%lx) returning NIL (",
+ (unsigned long) lw,
+ (unsigned long) ptr_to_struct_containing_descr);
+ GC_err_puts(s);
+ GC_err_printf1(":%ld)\n", (unsigned long)i);
+ return GC_oom_fn(WORDS_TO_BYTES(lw));
+ }
+ *((void **)((ptr_t)result + sizeof(oh))) = ptr_to_struct_containing_descr;
+ UNLOCK();
+ if (!GC_debugging_started) {
+ GC_start_debugging();
+ }
+ ADD_CALL_CHAIN(result, ra);
+ return (GC_store_debug_info(result, (word)lb, s, (word)i));
+}
+
+void * GC_gcj_malloc_ignore_off_page(size_t lb,
+ void * ptr_to_struct_containing_descr)
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+ if( SMALL_OBJ(lb) ) {
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_gcjobjfreelist[lw]);
+ LOCK();
+ if( (op = *opp) == 0 ) {
+ op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_gcj_kind);
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb]; /* May have been uninitialized. */
+# endif
+ } else {
+ *opp = obj_link(op);
+ GC_words_allocd += lw;
+ }
+ *(void **)op = ptr_to_struct_containing_descr;
+ UNLOCK();
+ } else {
+ op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_gcj_kind);
+ if (0 != op) {
+ *(void **)op = ptr_to_struct_containing_descr;
+ }
+ UNLOCK();
+ }
+ return((GC_PTR) op);
+}
+
+#else
+
+char GC_no_gcj_support;
+
+#endif /* GC_GCJ_SUPPORT */
--- /dev/null
+#include <stdio.h>
+#include "version.h"
+
+int main()
+{
+ if (GC_ALPHA_VERSION == GC_NOT_ALPHA) {
+ printf("gc%d.%d", GC_VERSION_MAJOR, GC_VERSION_MINOR);
+ } else {
+ printf("gc%d.%dalpha%d", GC_VERSION_MAJOR,
+ GC_VERSION_MINOR, GC_ALPHA_VERSION);
+ }
+ return 0;
+}
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * This implements:
+ * 1. allocation of heap block headers
+ * 2. A map from addresses to heap block addresses to heap block headers
+ *
+ * Access speed is crucial. We implement an index structure based on a 2
+ * level tree.
+ */
+
+# include "private/gc_priv.h"
+
+bottom_index * GC_all_bottom_indices = 0;
+ /* Pointer to first (lowest addr) */
+ /* bottom_index. */
+
+bottom_index * GC_all_bottom_indices_end = 0;
+ /* Pointer to last (highest addr) */
+ /* bottom_index. */
+
+/* Non-macro version of header location routine */
+hdr * GC_find_header(h)
+ptr_t h;
+{
+# ifdef HASH_TL
+ register hdr * result;
+ GET_HDR(h, result);
+ return(result);
+# else
+ return(HDR_INNER(h));
+# endif
+}
+
+/* Routines to dynamically allocate collector data structures that will */
+/* never be freed. */
+
+static ptr_t scratch_free_ptr = 0;
+
+/* GC_scratch_last_end_ptr is end point of last obtained scratch area. */
+/* GC_scratch_end_ptr is end point of current scratch area. */
+
+ptr_t GC_scratch_alloc(bytes)
+register word bytes;
+{
+ register ptr_t result = scratch_free_ptr;
+
+# ifdef ALIGN_DOUBLE
+# define GRANULARITY (2 * sizeof(word))
+# else
+# define GRANULARITY sizeof(word)
+# endif
+ bytes += GRANULARITY-1;
+ bytes &= ~(GRANULARITY-1);
+ scratch_free_ptr += bytes;
+ if (scratch_free_ptr <= GC_scratch_end_ptr) {
+ return(result);
+ }
+ {
+ word bytes_to_get = MINHINCR * HBLKSIZE;
+
+ if (bytes_to_get <= bytes) {
+ /* Undo the damage, and get memory directly */
+ bytes_to_get = bytes;
+# ifdef USE_MMAP
+ bytes_to_get += GC_page_size - 1;
+ bytes_to_get &= ~(GC_page_size - 1);
+# endif
+ result = (ptr_t)GET_MEM(bytes_to_get);
+ scratch_free_ptr -= bytes;
+ GC_scratch_last_end_ptr = result + bytes;
+ return(result);
+ }
+ result = (ptr_t)GET_MEM(bytes_to_get);
+ if (result == 0) {
+# ifdef PRINTSTATS
+ GC_printf0("Out of memory - trying to allocate less\n");
+# endif
+ scratch_free_ptr -= bytes;
+ bytes_to_get = bytes;
+# ifdef USE_MMAP
+ bytes_to_get += GC_page_size - 1;
+ bytes_to_get &= ~(GC_page_size - 1);
+# endif
+ return((ptr_t)GET_MEM(bytes_to_get));
+ }
+ scratch_free_ptr = result;
+ GC_scratch_end_ptr = scratch_free_ptr + bytes_to_get;
+ GC_scratch_last_end_ptr = GC_scratch_end_ptr;
+ return(GC_scratch_alloc(bytes));
+ }
+}
+
+static hdr * hdr_free_list = 0;
+
+/* Return an uninitialized header */
+static hdr * alloc_hdr()
+{
+ register hdr * result;
+
+ if (hdr_free_list == 0) {
+ result = (hdr *) GC_scratch_alloc((word)(sizeof(hdr)));
+ } else {
+ result = hdr_free_list;
+ hdr_free_list = (hdr *) (result -> hb_next);
+ }
+ return(result);
+}
+
+static void free_hdr(hhdr)
+hdr * hhdr;
+{
+ hhdr -> hb_next = (struct hblk *) hdr_free_list;
+ hdr_free_list = hhdr;
+}
+
+hdr * GC_invalid_header;
+
+#ifdef USE_HDR_CACHE
+ word GC_hdr_cache_hits = 0;
+ word GC_hdr_cache_misses = 0;
+#endif
+
+void GC_init_headers()
+{
+ register unsigned i;
+
+ GC_all_nils = (bottom_index *)GC_scratch_alloc((word)sizeof(bottom_index));
+ BZERO(GC_all_nils, sizeof(bottom_index));
+ for (i = 0; i < TOP_SZ; i++) {
+ GC_top_index[i] = GC_all_nils;
+ }
+ GC_invalid_header = alloc_hdr();
+ GC_invalidate_map(GC_invalid_header);
+}
+
+/* Make sure that there is a bottom level index block for address addr */
+/* Return FALSE on failure. */
+static GC_bool get_index(addr)
+word addr;
+{
+ word hi = (word)(addr) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
+ bottom_index * r;
+ bottom_index * p;
+ bottom_index ** prev;
+ bottom_index *pi;
+
+# ifdef HASH_TL
+ unsigned i = TL_HASH(hi);
+ bottom_index * old;
+
+ old = p = GC_top_index[i];
+ while(p != GC_all_nils) {
+ if (p -> key == hi) return(TRUE);
+ p = p -> hash_link;
+ }
+ r = (bottom_index*)GC_scratch_alloc((word)(sizeof (bottom_index)));
+ if (r == 0) return(FALSE);
+ BZERO(r, sizeof (bottom_index));
+ r -> hash_link = old;
+ GC_top_index[i] = r;
+# else
+ if (GC_top_index[hi] != GC_all_nils) return(TRUE);
+ r = (bottom_index*)GC_scratch_alloc((word)(sizeof (bottom_index)));
+ if (r == 0) return(FALSE);
+ GC_top_index[hi] = r;
+ BZERO(r, sizeof (bottom_index));
+# endif
+ r -> key = hi;
+ /* Add it to the list of bottom indices */
+ prev = &GC_all_bottom_indices; /* pointer to p */
+ pi = 0; /* bottom_index preceding p */
+ while ((p = *prev) != 0 && p -> key < hi) {
+ pi = p;
+ prev = &(p -> asc_link);
+ }
+ r -> desc_link = pi;
+ if (0 == p) {
+ GC_all_bottom_indices_end = r;
+ } else {
+ p -> desc_link = r;
+ }
+ r -> asc_link = p;
+ *prev = r;
+ return(TRUE);
+}
+
+/* Install a header for block h. */
+/* The header is uninitialized. */
+/* Returns the header or 0 on failure. */
+struct hblkhdr * GC_install_header(h)
+register struct hblk * h;
+{
+ hdr * result;
+
+ if (!get_index((word) h)) return(FALSE);
+ result = alloc_hdr();
+ SET_HDR(h, result);
+# ifdef USE_MUNMAP
+ result -> hb_last_reclaimed = GC_gc_no;
+# endif
+ return(result);
+}
+
+/* Set up forwarding counts for block h of size sz */
+GC_bool GC_install_counts(h, sz)
+register struct hblk * h;
+register word sz; /* bytes */
+{
+ register struct hblk * hbp;
+ register int i;
+
+ for (hbp = h; (char *)hbp < (char *)h + sz; hbp += BOTTOM_SZ) {
+ if (!get_index((word) hbp)) return(FALSE);
+ }
+ if (!get_index((word)h + sz - 1)) return(FALSE);
+ for (hbp = h + 1; (char *)hbp < (char *)h + sz; hbp += 1) {
+ i = HBLK_PTR_DIFF(hbp, h);
+ SET_HDR(hbp, (hdr *)(i > MAX_JUMP? MAX_JUMP : i));
+ }
+ return(TRUE);
+}
+
+/* Remove the header for block h */
+void GC_remove_header(h)
+register struct hblk * h;
+{
+ hdr ** ha;
+
+ GET_HDR_ADDR(h, ha);
+ free_hdr(*ha);
+ *ha = 0;
+}
+
+/* Remove forwarding counts for h */
+void GC_remove_counts(h, sz)
+register struct hblk * h;
+register word sz; /* bytes */
+{
+ register struct hblk * hbp;
+
+ for (hbp = h+1; (char *)hbp < (char *)h + sz; hbp += 1) {
+ SET_HDR(hbp, 0);
+ }
+}
+
+/* Apply fn to all allocated blocks */
+/*VARARGS1*/
+void GC_apply_to_all_blocks(fn, client_data)
+void (*fn) GC_PROTO((struct hblk *h, word client_data));
+word client_data;
+{
+ register int j;
+ register bottom_index * index_p;
+
+ for (index_p = GC_all_bottom_indices; index_p != 0;
+ index_p = index_p -> asc_link) {
+ for (j = BOTTOM_SZ-1; j >= 0;) {
+ if (!IS_FORWARDING_ADDR_OR_NIL(index_p->index[j])) {
+ if (index_p->index[j]->hb_map != GC_invalid_map) {
+ (*fn)(((struct hblk *)
+ (((index_p->key << LOG_BOTTOM_SZ) + (word)j)
+ << LOG_HBLKSIZE)),
+ client_data);
+ }
+ j--;
+ } else if (index_p->index[j] == 0) {
+ j--;
+ } else {
+ j -= (word)(index_p->index[j]);
+ }
+ }
+ }
+}
+
+/* Get the next valid block whose address is at least h */
+/* Return 0 if there is none. */
+struct hblk * GC_next_used_block(h)
+struct hblk * h;
+{
+ register bottom_index * bi;
+ register word j = ((word)h >> LOG_HBLKSIZE) & (BOTTOM_SZ-1);
+
+ GET_BI(h, bi);
+ if (bi == GC_all_nils) {
+ register word hi = (word)h >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
+ bi = GC_all_bottom_indices;
+ while (bi != 0 && bi -> key < hi) bi = bi -> asc_link;
+ j = 0;
+ }
+ while(bi != 0) {
+ while (j < BOTTOM_SZ) {
+ hdr * hhdr = bi -> index[j];
+ if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ j++;
+ } else {
+ if (hhdr->hb_map != GC_invalid_map) {
+ return((struct hblk *)
+ (((bi -> key << LOG_BOTTOM_SZ) + j)
+ << LOG_HBLKSIZE));
+ } else {
+ j += divHBLKSZ(hhdr -> hb_sz);
+ }
+ }
+ }
+ j = 0;
+ bi = bi -> asc_link;
+ }
+ return(0);
+}
+
+/* Get the last (highest address) block whose address is */
+/* at most h. Return 0 if there is none. */
+/* Unlike the above, this may return a free block. */
+struct hblk * GC_prev_block(h)
+struct hblk * h;
+{
+ register bottom_index * bi;
+ register signed_word j = ((word)h >> LOG_HBLKSIZE) & (BOTTOM_SZ-1);
+
+ GET_BI(h, bi);
+ if (bi == GC_all_nils) {
+ register word hi = (word)h >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
+ bi = GC_all_bottom_indices_end;
+ while (bi != 0 && bi -> key > hi) bi = bi -> desc_link;
+ j = BOTTOM_SZ - 1;
+ }
+ while(bi != 0) {
+ while (j >= 0) {
+ hdr * hhdr = bi -> index[j];
+ if (0 == hhdr) {
+ --j;
+ } else if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ j -= (signed_word)hhdr;
+ } else {
+ return((struct hblk *)
+ (((bi -> key << LOG_BOTTOM_SZ) + j)
+ << LOG_HBLKSIZE));
+ }
+ }
+ j = BOTTOM_SZ - 1;
+ bi = bi -> desc_link;
+ }
+ return(0);
+}
--- /dev/null
+ .SPACE $PRIVATE$
+ .SUBSPA $DATA$,QUAD=1,ALIGN=8,ACCESS=31
+ .SUBSPA $BSS$,QUAD=1,ALIGN=8,ACCESS=31,ZERO,SORT=82
+ .SPACE $TEXT$
+ .SUBSPA $LIT$,QUAD=0,ALIGN=8,ACCESS=44
+ .SUBSPA $CODE$,QUAD=0,ALIGN=8,ACCESS=44,CODE_ONLY
+ .IMPORT $global$,DATA
+ .IMPORT $$dyncall,MILLICODE
+ .SPACE $TEXT$
+ .SUBSPA $CODE$
+
+ .align 4
+ .EXPORT GC_test_and_clear,ENTRY,PRIV_LEV=3,ARGW0=GR,RTNVAL=GR
+GC_test_and_clear
+ .PROC
+ .CALLINFO FRAME=0,NO_CALLS
+ .ENTRY
+ ldcw,co (%r26),%r28
+ bv,n 0(%r2)
+ .EXIT
+ .PROCEND
--- /dev/null
+ .text
+ .align 16
+ .global GC_save_regs_in_stack
+ .proc GC_save_regs_in_stack
+GC_save_regs_in_stack:
+ .body
+ flushrs
+ ;;
+ mov r8=ar.bsp
+ br.ret.sptk.few rp
+ .endp GC_save_regs_in_stack
+
--- /dev/null
+/* Conditionally execute a command based on machine and OS from gcconfig.h */
+
+# include "private/gcconfig.h"
+# include <stdio.h>
+# include <string.h>
+# include <unistd.h>
+
+int main(argc, argv, envp)
+int argc;
+char ** argv;
+char ** envp;
+{
+ if (argc < 4) goto Usage;
+ if (strcmp(MACH_TYPE, argv[1]) != 0) return(0);
+ if (strcmp(OS_TYPE, "") != 0 && strcmp(argv[2], "") != 0
+ && strcmp(OS_TYPE, argv[2]) != 0) return(0);
+ fprintf(stderr, "^^^^Starting command^^^^\n");
+ fflush(stdout);
+ execvp(argv[3], argv+3);
+ perror("Couldn't execute");
+
+Usage:
+ fprintf(stderr, "Usage: %s mach_type os_type command\n", argv[0]);
+ fprintf(stderr, "Currently mach_type = %s, os_type = %s\n",
+ MACH_TYPE, OS_TYPE);
+ return(1);
+}
+
--- /dev/null
+/* Conditionally execute a command based if the file argv[1] doesn't exist */
+/* Except for execvp, we stick to ANSI C. */
+# include "private/gcconfig.h"
+# include <stdio.h>
+# include <stdlib.h>
+# include <unistd.h>
+
+int main(argc, argv, envp)
+int argc;
+char ** argv;
+char ** envp;
+{
+ FILE * f;
+ if (argc < 3) goto Usage;
+ if ((f = fopen(argv[1], "rb")) != 0
+ || (f = fopen(argv[1], "r")) != 0) {
+ fclose(f);
+ return(0);
+ }
+ printf("^^^^Starting command^^^^\n");
+ fflush(stdout);
+ execvp(argv[2], argv+2);
+ exit(1);
+
+Usage:
+ fprintf(stderr, "Usage: %s file_name command\n", argv[0]);
+ return(1);
+}
+
--- /dev/null
+#
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+
+## Process this file with automake to produce Makefile.in.
+
+# installed headers
+#
+pkginclude_HEADERS = gc.h gc_typed.h gc_inl.h \
+ gc_inline.h gc_mark.h gc_cpp.h \
+ weakpointer.h gc_alloc.h new_gc_alloc.h \
+ gc_allocator.h gc_backptr.h \
+ gc_gcj.h gc_local_alloc.h leak_detector.h \
+ gc_amiga_redirects.h gc_pthread_redirects.h \
+ gc_config_macros.h
+
+# headers which are not installed
+#
+dist_noinst_HEADERS = private/gc_hdrs.h \
+ private/gc_priv.h private/gcconfig.h \
+ private/gc_pmark.h private/gc_locks.h \
+ private/solaris_threads.h private/dbg_mlc.h \
+ private/specific.h private/cord_pos.h \
+ cord.h ec.h javaxfc.h
--- /dev/null
+# Makefile.in generated by automake 1.6.3 from Makefile.am.
+# @configure_input@
+
+# Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+# Free Software Foundation, Inc.
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+@SET_MAKE@
+
+#
+#
+# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+# OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+#
+# Permission is hereby granted to use or copy this program
+# for any purpose, provided the above notices are retained on all copies.
+# Permission to modify the code and to distribute modified code is granted,
+# provided the above notices are retained, and a notice that the code was
+# modified is included with the above copyright notice.
+#
+# Modified by: Grzegorz Jakacki <jakacki at acm dot org>
+SHELL = @SHELL@
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+bindir = @bindir@
+sbindir = @sbindir@
+libexecdir = @libexecdir@
+datadir = @datadir@
+sysconfdir = @sysconfdir@
+sharedstatedir = @sharedstatedir@
+localstatedir = @localstatedir@
+libdir = @libdir@
+infodir = @infodir@
+mandir = @mandir@
+includedir = @includedir@
+oldincludedir = /usr/include
+pkgdatadir = $(datadir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+top_builddir = ..
+
+ACLOCAL = @ACLOCAL@
+AUTOCONF = @AUTOCONF@
+AUTOMAKE = @AUTOMAKE@
+AUTOHEADER = @AUTOHEADER@
+
+am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+install_sh_DATA = $(install_sh) -c -m 644
+install_sh_PROGRAM = $(install_sh) -c
+install_sh_SCRIPT = $(install_sh) -c
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+INSTALL_HEADER = $(INSTALL_DATA)
+transform = @program_transform_name@
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+host_alias = @host_alias@
+host_triplet = @host@
+
+EXEEXT = @EXEEXT@
+OBJEXT = @OBJEXT@
+PATH_SEPARATOR = @PATH_SEPARATOR@
+AMTAR = @AMTAR@
+AR = @AR@
+AS = @AS@
+AWK = @AWK@
+CC = @CC@
+CCAS = @CCAS@
+CCASFLAGS = @CCASFLAGS@
+CFLAGS = @CFLAGS@
+CXX = @CXX@
+CXXFLAGS = @CXXFLAGS@
+CXXINCLUDES = @CXXINCLUDES@
+DEPDIR = @DEPDIR@
+DLLTOOL = @DLLTOOL@
+ECHO = @ECHO@
+EXTRA_TEST_LIBS = @EXTRA_TEST_LIBS@
+GC_CFLAGS = @GC_CFLAGS@
+GC_VERSION = @GC_VERSION@
+INCLUDES = @INCLUDES@
+INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
+LIBTOOL = @LIBTOOL@
+LN_S = @LN_S@
+MAINT = @MAINT@
+MY_CFLAGS = @MY_CFLAGS@
+OBJDUMP = @OBJDUMP@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+STRIP = @STRIP@
+THREADLIBS = @THREADLIBS@
+VERSION = @VERSION@
+addincludes = @addincludes@
+addobjs = @addobjs@
+addtests = @addtests@
+am__include = @am__include@
+am__quote = @am__quote@
+install_sh = @install_sh@
+target_all = @target_all@
+
+# installed headers
+#
+pkginclude_HEADERS = gc.h gc_typed.h gc_inl.h \
+ gc_inline.h gc_mark.h gc_cpp.h \
+ weakpointer.h gc_alloc.h new_gc_alloc.h \
+ gc_allocator.h gc_backptr.h \
+ gc_gcj.h gc_local_alloc.h leak_detector.h \
+ gc_amiga_redirects.h gc_pthread_redirects.h \
+ gc_config_macros.h
+
+
+# headers which are not installed
+#
+dist_noinst_HEADERS = private/gc_hdrs.h \
+ private/gc_priv.h private/gcconfig.h \
+ private/gc_pmark.h private/gc_locks.h \
+ private/solaris_threads.h private/dbg_mlc.h \
+ private/specific.h private/cord_pos.h \
+ cord.h ec.h javaxfc.h
+
+subdir = include
+mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
+CONFIG_CLEAN_FILES =
+DIST_SOURCES =
+HEADERS = $(dist_noinst_HEADERS) $(pkginclude_HEADERS)
+
+DIST_COMMON = $(dist_noinst_HEADERS) $(pkginclude_HEADERS) Makefile.am \
+ Makefile.in
+all: all-am
+
+.SUFFIXES:
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4)
+ cd $(top_srcdir) && \
+ $(AUTOMAKE) --gnu include/Makefile
+Makefile: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.in $(top_builddir)/config.status
+ cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)
+
+mostlyclean-libtool:
+ -rm -f *.lo
+
+clean-libtool:
+ -rm -rf .libs _libs
+
+distclean-libtool:
+ -rm -f libtool
+uninstall-info-am:
+pkgincludeHEADERS_INSTALL = $(INSTALL_HEADER)
+install-pkgincludeHEADERS: $(pkginclude_HEADERS)
+ @$(NORMAL_INSTALL)
+ $(mkinstalldirs) $(DESTDIR)$(pkgincludedir)
+ @list='$(pkginclude_HEADERS)'; for p in $$list; do \
+ if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+ f="`echo $$p | sed -e 's|^.*/||'`"; \
+ echo " $(pkgincludeHEADERS_INSTALL) $$d$$p $(DESTDIR)$(pkgincludedir)/$$f"; \
+ $(pkgincludeHEADERS_INSTALL) $$d$$p $(DESTDIR)$(pkgincludedir)/$$f; \
+ done
+
+uninstall-pkgincludeHEADERS:
+ @$(NORMAL_UNINSTALL)
+ @list='$(pkginclude_HEADERS)'; for p in $$list; do \
+ f="`echo $$p | sed -e 's|^.*/||'`"; \
+ echo " rm -f $(DESTDIR)$(pkgincludedir)/$$f"; \
+ rm -f $(DESTDIR)$(pkgincludedir)/$$f; \
+ done
+
+ETAGS = etags
+ETAGSFLAGS =
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
+ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
+ unique=`for i in $$list; do \
+ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+ done | \
+ $(AWK) ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ mkid -fID $$unique
+
+TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
+ $(TAGS_FILES) $(LISP)
+ tags=; \
+ here=`pwd`; \
+ list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
+ unique=`for i in $$list; do \
+ if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
+ done | \
+ $(AWK) ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ test -z "$(ETAGS_ARGS)$$tags$$unique" \
+ || $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+ $$tags $$unique
+
+GTAGS:
+ here=`$(am__cd) $(top_builddir) && pwd` \
+ && cd $(top_srcdir) \
+ && gtags -i $(GTAGS_ARGS) $$here
+
+distclean-tags:
+ -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH
+DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
+
+top_distdir = ..
+distdir = $(top_distdir)/$(PACKAGE)-$(VERSION)
+
+distdir: $(DISTFILES)
+ $(mkinstalldirs) $(distdir)/private
+ @list='$(DISTFILES)'; for file in $$list; do \
+ if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
+ dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \
+ if test "$$dir" != "$$file" && test "$$dir" != "."; then \
+ dir="/$$dir"; \
+ $(mkinstalldirs) "$(distdir)$$dir"; \
+ else \
+ dir=''; \
+ fi; \
+ if test -d $$d/$$file; then \
+ if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
+ cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \
+ fi; \
+ cp -pR $$d/$$file $(distdir)$$dir || exit 1; \
+ else \
+ test -f $(distdir)/$$file \
+ || cp -p $$d/$$file $(distdir)/$$file \
+ || exit 1; \
+ fi; \
+ done
+check-am: all-am
+check: check-am
+all-am: Makefile $(HEADERS)
+
+installdirs:
+ $(mkinstalldirs) $(DESTDIR)$(pkgincludedir)
+
+install: install-am
+install-exec: install-exec-am
+install-data: install-data-am
+uninstall: uninstall-am
+
+install-am: all-am
+ @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+
+installcheck: installcheck-am
+install-strip:
+ $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
+ INSTALL_STRIP_FLAG=-s \
+ `test -z '$(STRIP)' || \
+ echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+ -rm -f Makefile $(CONFIG_CLEAN_FILES)
+
+maintainer-clean-generic:
+ @echo "This command is intended for maintainers to use"
+ @echo "it deletes files that may require special tools to rebuild."
+clean: clean-am
+
+clean-am: clean-generic clean-libtool mostlyclean-am
+
+distclean: distclean-am
+
+distclean-am: clean-am distclean-generic distclean-libtool \
+ distclean-tags
+
+dvi: dvi-am
+
+dvi-am:
+
+info: info-am
+
+info-am:
+
+install-data-am: install-pkgincludeHEADERS
+
+install-exec-am:
+
+install-info: install-info-am
+
+install-man:
+
+installcheck-am:
+
+maintainer-clean: maintainer-clean-am
+
+maintainer-clean-am: distclean-am maintainer-clean-generic
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-generic mostlyclean-libtool
+
+uninstall-am: uninstall-info-am uninstall-pkgincludeHEADERS
+
+.PHONY: GTAGS all all-am check check-am clean clean-generic \
+ clean-libtool distclean distclean-generic distclean-libtool \
+ distclean-tags distdir dvi dvi-am info info-am install \
+ install-am install-data install-data-am install-exec \
+ install-exec-am install-info install-info-am install-man \
+ install-pkgincludeHEADERS install-strip installcheck \
+ installcheck-am installdirs maintainer-clean \
+ maintainer-clean-generic mostlyclean mostlyclean-generic \
+ mostlyclean-libtool tags uninstall uninstall-am \
+ uninstall-info-am uninstall-pkgincludeHEADERS
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
--- /dev/null
+/*
+ * Copyright (c) 1993-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * Author: Hans-J. Boehm (boehm@parc.xerox.com)
+ */
+/* Boehm, October 5, 1995 4:20 pm PDT */
+
+/*
+ * Cords are immutable character strings. A number of operations
+ * on long cords are much more efficient than their strings.h counterpart.
+ * In particular, concatenation takes constant time independent of the length
+ * of the arguments. (Cords are represented as trees, with internal
+ * nodes representing concatenation and leaves consisting of either C
+ * strings or a functional description of the string.)
+ *
+ * The following are reasonable applications of cords. They would perform
+ * unacceptably if C strings were used:
+ * - A compiler that produces assembly language output by repeatedly
+ * concatenating instructions onto a cord representing the output file.
+ * - A text editor that converts the input file to a cord, and then
+ * performs editing operations by producing a new cord representing
+ * the file after echa character change (and keeping the old ones in an
+ * edit history)
+ *
+ * For optimal performance, cords should be built by
+ * concatenating short sections.
+ * This interface is designed for maximum compatibility with C strings.
+ * ASCII NUL characters may be embedded in cords using CORD_from_fn.
+ * This is handled correctly, but CORD_to_char_star will produce a string
+ * with embedded NULs when given such a cord.
+ *
+ * This interface is fairly big, largely for performance reasons.
+ * The most basic constants and functions:
+ *
+ * CORD - the type of a cord;
+ * CORD_EMPTY - empty cord;
+ * CORD_len(cord) - length of a cord;
+ * CORD_cat(cord1,cord2) - concatenation of two cords;
+ * CORD_substr(cord, start, len) - substring (or subcord);
+ * CORD_pos i; CORD_FOR(i, cord) { ... CORD_pos_fetch(i) ... } -
+ * examine each character in a cord. CORD_pos_fetch(i) is the char.
+ * CORD_fetch(int i) - Retrieve i'th character (slowly).
+ * CORD_cmp(cord1, cord2) - compare two cords.
+ * CORD_from_file(FILE * f) - turn a read-only file into a cord.
+ * CORD_to_char_star(cord) - convert to C string.
+ * (Non-NULL C constant strings are cords.)
+ * CORD_printf (etc.) - cord version of printf. Use %r for cords.
+ */
+# ifndef CORD_H
+
+# define CORD_H
+# include <stddef.h>
+# include <stdio.h>
+/* Cords have type const char *. This is cheating quite a bit, and not */
+/* 100% portable. But it means that nonempty character string */
+/* constants may be used as cords directly, provided the string is */
+/* never modified in place. The empty cord is represented by, and */
+/* can be written as, 0. */
+
+typedef const char * CORD;
+
+/* An empty cord is always represented as nil */
+# define CORD_EMPTY 0
+
+/* Is a nonempty cord represented as a C string? */
+#define CORD_IS_STRING(s) (*(s) != '\0')
+
+/* Concatenate two cords. If the arguments are C strings, they may */
+/* not be subsequently altered. */
+CORD CORD_cat(CORD x, CORD y);
+
+/* Concatenate a cord and a C string with known length. Except for the */
+/* empty string case, this is a special case of CORD_cat. Since the */
+/* length is known, it can be faster. */
+/* The string y is shared with the resulting CORD. Hence it should */
+/* not be altered by the caller. */
+CORD CORD_cat_char_star(CORD x, const char * y, size_t leny);
+
+/* Compute the length of a cord */
+size_t CORD_len(CORD x);
+
+/* Cords may be represented by functions defining the ith character */
+typedef char (* CORD_fn)(size_t i, void * client_data);
+
+/* Turn a functional description into a cord. */
+CORD CORD_from_fn(CORD_fn fn, void * client_data, size_t len);
+
+/* Return the substring (subcord really) of x with length at most n, */
+/* starting at position i. (The initial character has position 0.) */
+CORD CORD_substr(CORD x, size_t i, size_t n);
+
+/* Return the argument, but rebalanced to allow more efficient */
+/* character retrieval, substring operations, and comparisons. */
+/* This is useful only for cords that were built using repeated */
+/* concatenation. Guarantees log time access to the result, unless */
+/* x was obtained through a large number of repeated substring ops */
+/* or the embedded functional descriptions take longer to evaluate. */
+/* May reallocate significant parts of the cord. The argument is not */
+/* modified; only the result is balanced. */
+CORD CORD_balance(CORD x);
+
+/* The following traverse a cord by applying a function to each */
+/* character. This is occasionally appropriate, especially where */
+/* speed is crucial. But, since C doesn't have nested functions, */
+/* clients of this sort of traversal are clumsy to write. Consider */
+/* the functions that operate on cord positions instead. */
+
+/* Function to iteratively apply to individual characters in cord. */
+typedef int (* CORD_iter_fn)(char c, void * client_data);
+
+/* Function to apply to substrings of a cord. Each substring is a */
+/* a C character string, not a general cord. */
+typedef int (* CORD_batched_iter_fn)(const char * s, void * client_data);
+# define CORD_NO_FN ((CORD_batched_iter_fn)0)
+
+/* Apply f1 to each character in the cord, in ascending order, */
+/* starting at position i. If */
+/* f2 is not CORD_NO_FN, then multiple calls to f1 may be replaced by */
+/* a single call to f2. The parameter f2 is provided only to allow */
+/* some optimization by the client. This terminates when the right */
+/* end of this string is reached, or when f1 or f2 return != 0. In the */
+/* latter case CORD_iter returns != 0. Otherwise it returns 0. */
+/* The specified value of i must be < CORD_len(x). */
+int CORD_iter5(CORD x, size_t i, CORD_iter_fn f1,
+ CORD_batched_iter_fn f2, void * client_data);
+
+/* A simpler version that starts at 0, and without f2: */
+int CORD_iter(CORD x, CORD_iter_fn f1, void * client_data);
+# define CORD_iter(x, f1, cd) CORD_iter5(x, 0, f1, CORD_NO_FN, cd)
+
+/* Similar to CORD_iter5, but end-to-beginning. No provisions for */
+/* CORD_batched_iter_fn. */
+int CORD_riter4(CORD x, size_t i, CORD_iter_fn f1, void * client_data);
+
+/* A simpler version that starts at the end: */
+int CORD_riter(CORD x, CORD_iter_fn f1, void * client_data);
+
+/* Functions that operate on cord positions. The easy way to traverse */
+/* cords. A cord position is logically a pair consisting of a cord */
+/* and an index into that cord. But it is much faster to retrieve a */
+/* charcter based on a position than on an index. Unfortunately, */
+/* positions are big (order of a few 100 bytes), so allocate them with */
+/* caution. */
+/* Things in cord_pos.h should be treated as opaque, except as */
+/* described below. Also note that */
+/* CORD_pos_fetch, CORD_next and CORD_prev have both macro and function */
+/* definitions. The former may evaluate their argument more than once. */
+# include "private/cord_pos.h"
+
+/*
+ Visible definitions from above:
+
+ typedef <OPAQUE but fairly big> CORD_pos[1];
+
+ * Extract the cord from a position:
+ CORD CORD_pos_to_cord(CORD_pos p);
+
+ * Extract the current index from a position:
+ size_t CORD_pos_to_index(CORD_pos p);
+
+ * Fetch the character located at the given position:
+ char CORD_pos_fetch(CORD_pos p);
+
+ * Initialize the position to refer to the given cord and index.
+ * Note that this is the most expensive function on positions:
+ void CORD_set_pos(CORD_pos p, CORD x, size_t i);
+
+ * Advance the position to the next character.
+ * P must be initialized and valid.
+ * Invalidates p if past end:
+ void CORD_next(CORD_pos p);
+
+ * Move the position to the preceding character.
+ * P must be initialized and valid.
+ * Invalidates p if past beginning:
+ void CORD_prev(CORD_pos p);
+
+ * Is the position valid, i.e. inside the cord?
+ int CORD_pos_valid(CORD_pos p);
+*/
+# define CORD_FOR(pos, cord) \
+ for (CORD_set_pos(pos, cord, 0); CORD_pos_valid(pos); CORD_next(pos))
+
+
+/* An out of memory handler to call. May be supplied by client. */
+/* Must not return. */
+extern void (* CORD_oom_fn)(void);
+
+/* Dump the representation of x to stdout in an implementation defined */
+/* manner. Intended for debugging only. */
+void CORD_dump(CORD x);
+
+/* The following could easily be implemented by the client. They are */
+/* provided in cordxtra.c for convenience. */
+
+/* Concatenate a character to the end of a cord. */
+CORD CORD_cat_char(CORD x, char c);
+
+/* Concatenate n cords. */
+CORD CORD_catn(int n, /* CORD */ ...);
+
+/* Return the character in CORD_substr(x, i, 1) */
+char CORD_fetch(CORD x, size_t i);
+
+/* Return < 0, 0, or > 0, depending on whether x < y, x = y, x > y */
+int CORD_cmp(CORD x, CORD y);
+
+/* A generalization that takes both starting positions for the */
+/* comparison, and a limit on the number of characters to be compared. */
+int CORD_ncmp(CORD x, size_t x_start, CORD y, size_t y_start, size_t len);
+
+/* Find the first occurrence of s in x at position start or later. */
+/* Return the position of the first character of s in x, or */
+/* CORD_NOT_FOUND if there is none. */
+size_t CORD_str(CORD x, size_t start, CORD s);
+
+/* Return a cord consisting of i copies of (possibly NUL) c. Dangerous */
+/* in conjunction with CORD_to_char_star. */
+/* The resulting representation takes constant space, independent of i. */
+CORD CORD_chars(char c, size_t i);
+# define CORD_nul(i) CORD_chars('\0', (i))
+
+/* Turn a file into cord. The file must be seekable. Its contents */
+/* must remain constant. The file may be accessed as an immediate */
+/* result of this call and/or as a result of subsequent accesses to */
+/* the cord. Short files are likely to be immediately read, but */
+/* long files are likely to be read on demand, possibly relying on */
+/* stdio for buffering. */
+/* We must have exclusive access to the descriptor f, i.e. we may */
+/* read it at any time, and expect the file pointer to be */
+/* where we left it. Normally this should be invoked as */
+/* CORD_from_file(fopen(...)) */
+/* CORD_from_file arranges to close the file descriptor when it is no */
+/* longer needed (e.g. when the result becomes inaccessible). */
+/* The file f must be such that ftell reflects the actual character */
+/* position in the file, i.e. the number of characters that can be */
+/* or were read with fread. On UNIX systems this is always true. On */
+/* MS Windows systems, f must be opened in binary mode. */
+CORD CORD_from_file(FILE * f);
+
+/* Equivalent to the above, except that the entire file will be read */
+/* and the file pointer will be closed immediately. */
+/* The binary mode restriction from above does not apply. */
+CORD CORD_from_file_eager(FILE * f);
+
+/* Equivalent to the above, except that the file will be read on demand.*/
+/* The binary mode restriction applies. */
+CORD CORD_from_file_lazy(FILE * f);
+
+/* Turn a cord into a C string. The result shares no structure with */
+/* x, and is thus modifiable. */
+char * CORD_to_char_star(CORD x);
+
+/* Turn a C string into a CORD. The C string is copied, and so may */
+/* subsequently be modified. */
+CORD CORD_from_char_star(const char *s);
+
+/* Identical to the above, but the result may share structure with */
+/* the argument and is thus not modifiable. */
+const char * CORD_to_const_char_star(CORD x);
+
+/* Write a cord to a file, starting at the current position. No */
+/* trailing NULs are newlines are added. */
+/* Returns EOF if a write error occurs, 1 otherwise. */
+int CORD_put(CORD x, FILE * f);
+
+/* "Not found" result for the following two functions. */
+# define CORD_NOT_FOUND ((size_t)(-1))
+
+/* A vague analog of strchr. Returns the position (an integer, not */
+/* a pointer) of the first occurrence of (char) c inside x at position */
+/* i or later. The value i must be < CORD_len(x). */
+size_t CORD_chr(CORD x, size_t i, int c);
+
+/* A vague analog of strrchr. Returns index of the last occurrence */
+/* of (char) c inside x at position i or earlier. The value i */
+/* must be < CORD_len(x). */
+size_t CORD_rchr(CORD x, size_t i, int c);
+
+
+/* The following are also not primitive, but are implemented in */
+/* cordprnt.c. They provide functionality similar to the ANSI C */
+/* functions with corresponding names, but with the following */
+/* additions and changes: */
+/* 1. A %r conversion specification specifies a CORD argument. Field */
+/* width, precision, etc. have the same semantics as for %s. */
+/* (Note that %c,%C, and %S were already taken.) */
+/* 2. The format string is represented as a CORD. */
+/* 3. CORD_sprintf and CORD_vsprintf assign the result through the 1st */ /* argument. Unlike their ANSI C versions, there is no need to guess */
+/* the correct buffer size. */
+/* 4. Most of the conversions are implement through the native */
+/* vsprintf. Hence they are usually no faster, and */
+/* idiosyncracies of the native printf are preserved. However, */
+/* CORD arguments to CORD_sprintf and CORD_vsprintf are NOT copied; */
+/* the result shares the original structure. This may make them */
+/* very efficient in some unusual applications. */
+/* The format string is copied. */
+/* All functions return the number of characters generated or -1 on */
+/* error. This complies with the ANSI standard, but is inconsistent */
+/* with some older implementations of sprintf. */
+
+/* The implementation of these is probably less portable than the rest */
+/* of this package. */
+
+#ifndef CORD_NO_IO
+
+#include <stdarg.h>
+
+int CORD_sprintf(CORD * out, CORD format, ...);
+int CORD_vsprintf(CORD * out, CORD format, va_list args);
+int CORD_fprintf(FILE * f, CORD format, ...);
+int CORD_vfprintf(FILE * f, CORD format, va_list args);
+int CORD_printf(CORD format, ...);
+int CORD_vprintf(CORD format, va_list args);
+
+#endif /* CORD_NO_IO */
+
+# endif /* CORD_H */
--- /dev/null
+# ifndef EC_H
+# define EC_H
+
+# ifndef CORD_H
+# include "cord.h"
+# endif
+
+/* Extensible cords are strings that may be destructively appended to. */
+/* They allow fast construction of cords from characters that are */
+/* being read from a stream. */
+/*
+ * A client might look like:
+ *
+ * {
+ * CORD_ec x;
+ * CORD result;
+ * char c;
+ * FILE *f;
+ *
+ * ...
+ * CORD_ec_init(x);
+ * while(...) {
+ * c = getc(f);
+ * ...
+ * CORD_ec_append(x, c);
+ * }
+ * result = CORD_balance(CORD_ec_to_cord(x));
+ *
+ * If a C string is desired as the final result, the call to CORD_balance
+ * may be replaced by a call to CORD_to_char_star.
+ */
+
+# ifndef CORD_BUFSZ
+# define CORD_BUFSZ 128
+# endif
+
+typedef struct CORD_ec_struct {
+ CORD ec_cord;
+ char * ec_bufptr;
+ char ec_buf[CORD_BUFSZ+1];
+} CORD_ec[1];
+
+/* This structure represents the concatenation of ec_cord with */
+/* ec_buf[0 ... (ec_bufptr-ec_buf-1)] */
+
+/* Flush the buffer part of the extended chord into ec_cord. */
+/* Note that this is almost the only real function, and it is */
+/* implemented in 6 lines in cordxtra.c */
+void CORD_ec_flush_buf(CORD_ec x);
+
+/* Convert an extensible cord to a cord. */
+# define CORD_ec_to_cord(x) (CORD_ec_flush_buf(x), (x)[0].ec_cord)
+
+/* Initialize an extensible cord. */
+# define CORD_ec_init(x) ((x)[0].ec_cord = 0, (x)[0].ec_bufptr = (x)[0].ec_buf)
+
+/* Append a character to an extensible cord. */
+# define CORD_ec_append(x, c) \
+ { \
+ if ((x)[0].ec_bufptr == (x)[0].ec_buf + CORD_BUFSZ) { \
+ CORD_ec_flush_buf(x); \
+ } \
+ *((x)[0].ec_bufptr)++ = (c); \
+ }
+
+/* Append a cord to an extensible cord. Structure remains shared with */
+/* original. */
+void CORD_ec_append_cord(CORD_ec x, CORD s);
+
+# endif /* EC_H */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+ * Copyright 1996-1999 by Silicon Graphics. All rights reserved.
+ * Copyright 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * Note that this defines a large number of tuning hooks, which can
+ * safely be ignored in nearly all cases. For normal use it suffices
+ * to call only GC_MALLOC and perhaps GC_REALLOC.
+ * For better performance, also look at GC_MALLOC_ATOMIC, and
+ * GC_enable_incremental. If you need an action to be performed
+ * immediately before an object is collected, look at GC_register_finalizer.
+ * If you are using Solaris threads, look at the end of this file.
+ * Everything else is best ignored unless you encounter performance
+ * problems.
+ */
+
+#ifndef _GC_H
+
+# define _GC_H
+
+# include "gc_config_macros.h"
+
+# if defined(__STDC__) || defined(__cplusplus)
+# define GC_PROTO(args) args
+ typedef void * GC_PTR;
+# define GC_CONST const
+# else
+# define GC_PROTO(args) ()
+ typedef char * GC_PTR;
+# define GC_CONST
+# endif
+
+# ifdef __cplusplus
+ extern "C" {
+# endif
+
+
+/* Define word and signed_word to be unsigned and signed types of the */
+/* size as char * or void *. There seems to be no way to do this */
+/* even semi-portably. The following is probably no better/worse */
+/* than almost anything else. */
+/* The ANSI standard suggests that size_t and ptr_diff_t might be */
+/* better choices. But those appear to have incorrect definitions */
+/* on may systems. Notably "typedef int size_t" seems to be both */
+/* frequent and WRONG. */
+typedef unsigned long GC_word;
+typedef long GC_signed_word;
+
+/* Public read-only variables */
+
+GC_API GC_word GC_gc_no;/* Counter incremented per collection. */
+ /* Includes empty GCs at startup. */
+
+GC_API int GC_parallel; /* GC is parallelized for performance on */
+ /* multiprocessors. Currently set only */
+ /* implicitly if collector is built with */
+ /* -DPARALLEL_MARK and if either: */
+ /* Env variable GC_NPROC is set to > 1, or */
+ /* GC_NPROC is not set and this is an MP. */
+ /* If GC_parallel is set, incremental */
+ /* collection is only partially functional, */
+ /* and may not be desirable. */
+
+
+/* Public R/W variables */
+
+GC_API GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested));
+ /* When there is insufficient memory to satisfy */
+ /* an allocation request, we return */
+ /* (*GC_oom_fn)(). By default this just */
+ /* returns 0. */
+ /* If it returns, it must return 0 or a valid */
+ /* pointer to a previously allocated heap */
+ /* object. */
+
+GC_API int GC_find_leak;
+ /* Do not actually garbage collect, but simply */
+ /* report inaccessible memory that was not */
+ /* deallocated with GC_free. Initial value */
+ /* is determined by FIND_LEAK macro. */
+
+GC_API int GC_all_interior_pointers;
+ /* Arrange for pointers to object interiors to */
+ /* be recognized as valid. May not be changed */
+ /* after GC initialization. */
+ /* Initial value is determined by */
+ /* -DALL_INTERIOR_POINTERS. */
+ /* Unless DONT_ADD_BYTE_AT_END is defined, this */
+ /* also affects whether sizes are increased by */
+ /* at least a byte to allow "off the end" */
+ /* pointer recognition. */
+ /* MUST BE 0 or 1. */
+
+GC_API int GC_quiet; /* Disable statistics output. Only matters if */
+ /* collector has been compiled with statistics */
+ /* enabled. This involves a performance cost, */
+ /* and is thus not the default. */
+
+GC_API int GC_finalize_on_demand;
+ /* If nonzero, finalizers will only be run in */
+ /* response to an explicit GC_invoke_finalizers */
+ /* call. The default is determined by whether */
+ /* the FINALIZE_ON_DEMAND macro is defined */
+ /* when the collector is built. */
+
+GC_API int GC_java_finalization;
+ /* Mark objects reachable from finalizable */
+ /* objects in a separate postpass. This makes */
+ /* it a bit safer to use non-topologically- */
+ /* ordered finalization. Default value is */
+ /* determined by JAVA_FINALIZATION macro. */
+
+GC_API void (* GC_finalizer_notifier)();
+ /* Invoked by the collector when there are */
+ /* objects to be finalized. Invoked at most */
+ /* once per GC cycle. Never invoked unless */
+ /* GC_finalize_on_demand is set. */
+ /* Typically this will notify a finalization */
+ /* thread, which will call GC_invoke_finalizers */
+ /* in response. */
+
+GC_API int GC_dont_gc; /* != 0 ==> Dont collect. In versions 7.2a1+, */
+ /* this overrides explicit GC_gcollect() calls. */
+ /* Used as a counter, so that nested enabling */
+ /* and disabling work correctly. Should */
+ /* normally be updated with GC_enable() and */
+ /* GC_disable() calls. */
+ /* Direct assignment to GC_dont_gc is */
+ /* deprecated. */
+
+GC_API int GC_dont_expand;
+ /* Dont expand heap unless explicitly requested */
+ /* or forced to. */
+
+GC_API int GC_use_entire_heap;
+ /* Causes the nonincremental collector to use the */
+ /* entire heap before collecting. This was the only */
+ /* option for GC versions < 5.0. This sometimes */
+ /* results in more large block fragmentation, since */
+ /* very larg blocks will tend to get broken up */
+ /* during each GC cycle. It is likely to result in a */
+ /* larger working set, but lower collection */
+ /* frequencies, and hence fewer instructions executed */
+ /* in the collector. */
+
+GC_API int GC_full_freq; /* Number of partial collections between */
+ /* full collections. Matters only if */
+ /* GC_incremental is set. */
+ /* Full collections are also triggered if */
+ /* the collector detects a substantial */
+ /* increase in the number of in-use heap */
+ /* blocks. Values in the tens are now */
+ /* perfectly reasonable, unlike for */
+ /* earlier GC versions. */
+
+GC_API GC_word GC_non_gc_bytes;
+ /* Bytes not considered candidates for collection. */
+ /* Used only to control scheduling of collections. */
+ /* Updated by GC_malloc_uncollectable and GC_free. */
+ /* Wizards only. */
+
+GC_API int GC_no_dls;
+ /* Don't register dynamic library data segments. */
+ /* Wizards only. Should be used only if the */
+ /* application explicitly registers all roots. */
+ /* In Microsoft Windows environments, this will */
+ /* usually also prevent registration of the */
+ /* main data segment as part of the root set. */
+
+GC_API GC_word GC_free_space_divisor;
+ /* We try to make sure that we allocate at */
+ /* least N/GC_free_space_divisor bytes between */
+ /* collections, where N is the heap size plus */
+ /* a rough estimate of the root set size. */
+ /* Initially, GC_free_space_divisor = 4. */
+ /* Increasing its value will use less space */
+ /* but more collection time. Decreasing it */
+ /* will appreciably decrease collection time */
+ /* at the expense of space. */
+ /* GC_free_space_divisor = 1 will effectively */
+ /* disable collections. */
+
+GC_API GC_word GC_max_retries;
+ /* The maximum number of GCs attempted before */
+ /* reporting out of memory after heap */
+ /* expansion fails. Initially 0. */
+
+
+GC_API char *GC_stackbottom; /* Cool end of user stack. */
+ /* May be set in the client prior to */
+ /* calling any GC_ routines. This */
+ /* avoids some overhead, and */
+ /* potentially some signals that can */
+ /* confuse debuggers. Otherwise the */
+ /* collector attempts to set it */
+ /* automatically. */
+ /* For multithreaded code, this is the */
+ /* cold end of the stack for the */
+ /* primordial thread. */
+
+GC_API int GC_dont_precollect; /* Don't collect as part of */
+ /* initialization. Should be set only */
+ /* if the client wants a chance to */
+ /* manually initialize the root set */
+ /* before the first collection. */
+ /* Interferes with blacklisting. */
+ /* Wizards only. */
+
+GC_API unsigned long GC_time_limit;
+ /* If incremental collection is enabled, */
+ /* We try to terminate collections */
+ /* after this many milliseconds. Not a */
+ /* hard time bound. Setting this to */
+ /* GC_TIME_UNLIMITED will essentially */
+ /* disable incremental collection while */
+ /* leaving generational collection */
+ /* enabled. */
+# define GC_TIME_UNLIMITED 999999
+ /* Setting GC_time_limit to this value */
+ /* will disable the "pause time exceeded"*/
+ /* tests. */
+
+/* Public procedures */
+
+/* Initialize the collector. This is only required when using thread-local
+ * allocation, since unlike the regular allocation routines, GC_local_malloc
+ * is not self-initializing. If you use GC_local_malloc you should arrange
+ * to call this somehow (e.g. from a constructor) before doing any allocation.
+ */
+GC_API void GC_init GC_PROTO((void));
+
+/*
+ * general purpose allocation routines, with roughly malloc calling conv.
+ * The atomic versions promise that no relevant pointers are contained
+ * in the object. The nonatomic versions guarantee that the new object
+ * is cleared. GC_malloc_stubborn promises that no changes to the object
+ * will occur after GC_end_stubborn_change has been called on the
+ * result of GC_malloc_stubborn. GC_malloc_uncollectable allocates an object
+ * that is scanned for pointers to collectable objects, but is not itself
+ * collectable. The object is scanned even if it does not appear to
+ * be reachable. GC_malloc_uncollectable and GC_free called on the resulting
+ * object implicitly update GC_non_gc_bytes appropriately.
+ *
+ * Note that the GC_malloc_stubborn support is stubbed out by default
+ * starting in 6.0. GC_malloc_stubborn is an alias for GC_malloc unless
+ * the collector is built with STUBBORN_ALLOC defined.
+ */
+GC_API GC_PTR GC_malloc GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_atomic GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_uncollectable GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_malloc_stubborn GC_PROTO((size_t size_in_bytes));
+
+/* The following is only defined if the library has been suitably */
+/* compiled: */
+GC_API GC_PTR GC_malloc_atomic_uncollectable GC_PROTO((size_t size_in_bytes));
+
+/* Explicitly deallocate an object. Dangerous if used incorrectly. */
+/* Requires a pointer to the base of an object. */
+/* If the argument is stubborn, it should not be changeable when freed. */
+/* An object should not be enable for finalization when it is */
+/* explicitly deallocated. */
+/* GC_free(0) is a no-op, as required by ANSI C for free. */
+GC_API void GC_free GC_PROTO((GC_PTR object_addr));
+
+/*
+ * Stubborn objects may be changed only if the collector is explicitly informed.
+ * The collector is implicitly informed of coming change when such
+ * an object is first allocated. The following routines inform the
+ * collector that an object will no longer be changed, or that it will
+ * once again be changed. Only nonNIL pointer stores into the object
+ * are considered to be changes. The argument to GC_end_stubborn_change
+ * must be exacly the value returned by GC_malloc_stubborn or passed to
+ * GC_change_stubborn. (In the second case it may be an interior pointer
+ * within 512 bytes of the beginning of the objects.)
+ * There is a performance penalty for allowing more than
+ * one stubborn object to be changed at once, but it is acceptable to
+ * do so. The same applies to dropping stubborn objects that are still
+ * changeable.
+ */
+GC_API void GC_change_stubborn GC_PROTO((GC_PTR));
+GC_API void GC_end_stubborn_change GC_PROTO((GC_PTR));
+
+/* Return a pointer to the base (lowest address) of an object given */
+/* a pointer to a location within the object. */
+/* I.e. map an interior pointer to the corresponding bas pointer. */
+/* Note that with debugging allocation, this returns a pointer to the */
+/* actual base of the object, i.e. the debug information, not to */
+/* the base of the user object. */
+/* Return 0 if displaced_pointer doesn't point to within a valid */
+/* object. */
+GC_API GC_PTR GC_base GC_PROTO((GC_PTR displaced_pointer));
+
+/* Given a pointer to the base of an object, return its size in bytes. */
+/* The returned size may be slightly larger than what was originally */
+/* requested. */
+GC_API size_t GC_size GC_PROTO((GC_PTR object_addr));
+
+/* For compatibility with C library. This is occasionally faster than */
+/* a malloc followed by a bcopy. But if you rely on that, either here */
+/* or with the standard C library, your code is broken. In my */
+/* opinion, it shouldn't have been invented, but now we're stuck. -HB */
+/* The resulting object has the same kind as the original. */
+/* If the argument is stubborn, the result will have changes enabled. */
+/* It is an error to have changes enabled for the original object. */
+/* Follows ANSI comventions for NULL old_object. */
+GC_API GC_PTR GC_realloc
+ GC_PROTO((GC_PTR old_object, size_t new_size_in_bytes));
+
+/* Explicitly increase the heap size. */
+/* Returns 0 on failure, 1 on success. */
+GC_API int GC_expand_hp GC_PROTO((size_t number_of_bytes));
+
+/* Limit the heap size to n bytes. Useful when you're debugging, */
+/* especially on systems that don't handle running out of memory well. */
+/* n == 0 ==> unbounded. This is the default. */
+GC_API void GC_set_max_heap_size GC_PROTO((GC_word n));
+
+/* Inform the collector that a certain section of statically allocated */
+/* memory contains no pointers to garbage collected memory. Thus it */
+/* need not be scanned. This is sometimes important if the application */
+/* maps large read/write files into the address space, which could be */
+/* mistaken for dynamic library data segments on some systems. */
+GC_API void GC_exclude_static_roots GC_PROTO((GC_PTR start, GC_PTR finish));
+
+/* Clear the set of root segments. Wizards only. */
+GC_API void GC_clear_roots GC_PROTO((void));
+
+/* Add a root segment. Wizards only. */
+GC_API void GC_add_roots GC_PROTO((char * low_address,
+ char * high_address_plus_1));
+
+/* Add a displacement to the set of those considered valid by the */
+/* collector. GC_register_displacement(n) means that if p was returned */
+/* by GC_malloc, then (char *)p + n will be considered to be a valid */
+/* pointer to n. N must be small and less than the size of p. */
+/* (All pointers to the interior of objects from the stack are */
+/* considered valid in any case. This applies to heap objects and */
+/* static data.) */
+/* Preferably, this should be called before any other GC procedures. */
+/* Calling it later adds to the probability of excess memory */
+/* retention. */
+/* This is a no-op if the collector was compiled with recognition of */
+/* arbitrary interior pointers enabled, which is now the default. */
+GC_API void GC_register_displacement GC_PROTO((GC_word n));
+
+/* The following version should be used if any debugging allocation is */
+/* being done. */
+GC_API void GC_debug_register_displacement GC_PROTO((GC_word n));
+
+/* Explicitly trigger a full, world-stop collection. */
+GC_API void GC_gcollect GC_PROTO((void));
+
+/* Trigger a full world-stopped collection. Abort the collection if */
+/* and when stop_func returns a nonzero value. Stop_func will be */
+/* called frequently, and should be reasonably fast. This works even */
+/* if virtual dirty bits, and hence incremental collection is not */
+/* available for this architecture. Collections can be aborted faster */
+/* than normal pause times for incremental collection. However, */
+/* aborted collections do no useful work; the next collection needs */
+/* to start from the beginning. */
+/* Return 0 if the collection was aborted, 1 if it succeeded. */
+typedef int (* GC_stop_func) GC_PROTO((void));
+GC_API int GC_try_to_collect GC_PROTO((GC_stop_func stop_func));
+
+/* Return the number of bytes in the heap. Excludes collector private */
+/* data structures. Includes empty blocks and fragmentation loss. */
+/* Includes some pages that were allocated but never written. */
+GC_API size_t GC_get_heap_size GC_PROTO((void));
+
+/* Return a lower bound on the number of free bytes in the heap. */
+GC_API size_t GC_get_free_bytes GC_PROTO((void));
+
+/* Return the number of bytes allocated since the last collection. */
+GC_API size_t GC_get_bytes_since_gc GC_PROTO((void));
+
+/* Return the total number of bytes allocated in this process. */
+/* Never decreases, except due to wrapping. */
+GC_API size_t GC_get_total_bytes GC_PROTO((void));
+
+/* Disable garbage collection. Even GC_gcollect calls will be */
+/* ineffective. */
+GC_API void GC_disable GC_PROTO((void));
+
+/* Reenable garbage collection. GC_diable() and GC_enable() calls */
+/* nest. Garbage collection is enabled if the number of calls to both */
+/* both functions is equal. */
+GC_API void GC_enable GC_PROTO((void));
+
+/* Enable incremental/generational collection. */
+/* Not advisable unless dirty bits are */
+/* available or most heap objects are */
+/* pointerfree(atomic) or immutable. */
+/* Don't use in leak finding mode. */
+/* Ignored if GC_dont_gc is true. */
+/* Only the generational piece of this is */
+/* functional if GC_parallel is TRUE */
+/* or if GC_time_limit is GC_TIME_UNLIMITED. */
+/* Causes GC_local_gcj_malloc() to revert to */
+/* locked allocation. Must be called */
+/* before any GC_local_gcj_malloc() calls. */
+GC_API void GC_enable_incremental GC_PROTO((void));
+
+/* Does incremental mode write-protect pages? Returns zero or */
+/* more of the following, or'ed together: */
+#define GC_PROTECTS_POINTER_HEAP 1 /* May protect non-atomic objs. */
+#define GC_PROTECTS_PTRFREE_HEAP 2
+#define GC_PROTECTS_STATIC_DATA 4 /* Curently never. */
+#define GC_PROTECTS_STACK 8 /* Probably impractical. */
+
+#define GC_PROTECTS_NONE 0
+GC_API int GC_incremental_protection_needs GC_PROTO((void));
+
+/* Perform some garbage collection work, if appropriate. */
+/* Return 0 if there is no more work to be done. */
+/* Typically performs an amount of work corresponding roughly */
+/* to marking from one page. May do more work if further */
+/* progress requires it, e.g. if incremental collection is */
+/* disabled. It is reasonable to call this in a wait loop */
+/* until it returns 0. */
+GC_API int GC_collect_a_little GC_PROTO((void));
+
+/* Allocate an object of size lb bytes. The client guarantees that */
+/* as long as the object is live, it will be referenced by a pointer */
+/* that points to somewhere within the first 256 bytes of the object. */
+/* (This should normally be declared volatile to prevent the compiler */
+/* from invalidating this assertion.) This routine is only useful */
+/* if a large array is being allocated. It reduces the chance of */
+/* accidentally retaining such an array as a result of scanning an */
+/* integer that happens to be an address inside the array. (Actually, */
+/* it reduces the chance of the allocator not finding space for such */
+/* an array, since it will try hard to avoid introducing such a false */
+/* reference.) On a SunOS 4.X or MS Windows system this is recommended */
+/* for arrays likely to be larger than 100K or so. For other systems, */
+/* or if the collector is not configured to recognize all interior */
+/* pointers, the threshold is normally much higher. */
+GC_API GC_PTR GC_malloc_ignore_off_page GC_PROTO((size_t lb));
+GC_API GC_PTR GC_malloc_atomic_ignore_off_page GC_PROTO((size_t lb));
+
+#if defined(__sgi) && !defined(__GNUC__) && _COMPILER_VERSION >= 720
+# define GC_ADD_CALLER
+# define GC_RETURN_ADDR (GC_word)__return_address
+#endif
+
+#ifdef __linux__
+# include <features.h>
+# if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 1 || __GLIBC__ > 2) \
+ && !defined(__ia64__)
+# define GC_HAVE_BUILTIN_BACKTRACE
+# define GC_CAN_SAVE_CALL_STACKS
+# endif
+# if defined(__i386__) || defined(__x86_64__)
+# define GC_CAN_SAVE_CALL_STACKS
+# endif
+#endif
+
+#if defined(__sparc__)
+# define GC_CAN_SAVE_CALL_STACKS
+#endif
+
+/* If we're on an a platform on which we can't save call stacks, but */
+/* gcc is normally used, we go ahead and define GC_ADD_CALLER. */
+/* We make this decision independent of whether gcc is actually being */
+/* used, in order to keep the interface consistent, and allow mixing */
+/* of compilers. */
+/* This may also be desirable if it is possible but expensive to */
+/* retrieve the call chain. */
+#if (defined(__linux__) || defined(__NetBSD__) || defined(__OpenBSD__) \
+ || defined(__FreeBSD__)) & !defined(GC_CAN_SAVE_CALL_STACKS)
+# define GC_ADD_CALLER
+# if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95)
+ /* gcc knows how to retrieve return address, but we don't know */
+ /* how to generate call stacks. */
+# define GC_RETURN_ADDR (GC_word)__builtin_return_address(0)
+# else
+ /* Just pass 0 for gcc compatibility. */
+# define GC_RETURN_ADDR 0
+# endif
+#endif
+
+#ifdef GC_ADD_CALLER
+# define GC_EXTRAS GC_RETURN_ADDR, __FILE__, __LINE__
+# define GC_EXTRA_PARAMS GC_word ra, GC_CONST char * s, int i
+#else
+# define GC_EXTRAS __FILE__, __LINE__
+# define GC_EXTRA_PARAMS GC_CONST char * s, int i
+#endif
+
+/* Debugging (annotated) allocation. GC_gcollect will check */
+/* objects allocated in this way for overwrites, etc. */
+GC_API GC_PTR GC_debug_malloc
+ GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_atomic
+ GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_uncollectable
+ GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_stubborn
+ GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_ignore_off_page
+ GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API GC_PTR GC_debug_malloc_atomic_ignore_off_page
+ GC_PROTO((size_t size_in_bytes, GC_EXTRA_PARAMS));
+GC_API void GC_debug_free GC_PROTO((GC_PTR object_addr));
+GC_API GC_PTR GC_debug_realloc
+ GC_PROTO((GC_PTR old_object, size_t new_size_in_bytes,
+ GC_EXTRA_PARAMS));
+GC_API void GC_debug_change_stubborn GC_PROTO((GC_PTR));
+GC_API void GC_debug_end_stubborn_change GC_PROTO((GC_PTR));
+
+/* Routines that allocate objects with debug information (like the */
+/* above), but just fill in dummy file and line number information. */
+/* Thus they can serve as drop-in malloc/realloc replacements. This */
+/* can be useful for two reasons: */
+/* 1) It allows the collector to be built with DBG_HDRS_ALL defined */
+/* even if some allocation calls come from 3rd party libraries */
+/* that can't be recompiled. */
+/* 2) On some platforms, the file and line information is redundant, */
+/* since it can be reconstructed from a stack trace. On such */
+/* platforms it may be more convenient not to recompile, e.g. for */
+/* leak detection. This can be accomplished by instructing the */
+/* linker to replace malloc/realloc with these. */
+GC_API GC_PTR GC_debug_malloc_replacement GC_PROTO((size_t size_in_bytes));
+GC_API GC_PTR GC_debug_realloc_replacement
+ GC_PROTO((GC_PTR object_addr, size_t size_in_bytes));
+
+# ifdef GC_DEBUG
+# define GC_MALLOC(sz) GC_debug_malloc(sz, GC_EXTRAS)
+# define GC_MALLOC_ATOMIC(sz) GC_debug_malloc_atomic(sz, GC_EXTRAS)
+# define GC_MALLOC_UNCOLLECTABLE(sz) \
+ GC_debug_malloc_uncollectable(sz, GC_EXTRAS)
+# define GC_MALLOC_IGNORE_OFF_PAGE(sz) \
+ GC_debug_malloc_ignore_off_page(sz, GC_EXTRAS)
+# define GC_MALLOC_ATOMIC_IGNORE_OFF_PAGE(sz) \
+ GC_debug_malloc_atomic_ignore_off_page(sz, GC_EXTRAS)
+# define GC_REALLOC(old, sz) GC_debug_realloc(old, sz, GC_EXTRAS)
+# define GC_FREE(p) GC_debug_free(p)
+# define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+ GC_debug_register_finalizer(p, f, d, of, od)
+# define GC_REGISTER_FINALIZER_IGNORE_SELF(p, f, d, of, od) \
+ GC_debug_register_finalizer_ignore_self(p, f, d, of, od)
+# define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
+ GC_debug_register_finalizer_no_order(p, f, d, of, od)
+# define GC_MALLOC_STUBBORN(sz) GC_debug_malloc_stubborn(sz, GC_EXTRAS);
+# define GC_CHANGE_STUBBORN(p) GC_debug_change_stubborn(p)
+# define GC_END_STUBBORN_CHANGE(p) GC_debug_end_stubborn_change(p)
+# define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
+ GC_general_register_disappearing_link(link, GC_base(obj))
+# define GC_REGISTER_DISPLACEMENT(n) GC_debug_register_displacement(n)
+# else
+# define GC_MALLOC(sz) GC_malloc(sz)
+# define GC_MALLOC_ATOMIC(sz) GC_malloc_atomic(sz)
+# define GC_MALLOC_UNCOLLECTABLE(sz) GC_malloc_uncollectable(sz)
+# define GC_MALLOC_IGNORE_OFF_PAGE(sz) \
+ GC_malloc_ignore_off_page(sz)
+# define GC_MALLOC_ATOMIC_IGNORE_OFF_PAGE(sz) \
+ GC_malloc_atomic_ignore_off_page(sz)
+# define GC_REALLOC(old, sz) GC_realloc(old, sz)
+# define GC_FREE(p) GC_free(p)
+# define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+ GC_register_finalizer(p, f, d, of, od)
+# define GC_REGISTER_FINALIZER_IGNORE_SELF(p, f, d, of, od) \
+ GC_register_finalizer_ignore_self(p, f, d, of, od)
+# define GC_REGISTER_FINALIZER_NO_ORDER(p, f, d, of, od) \
+ GC_register_finalizer_no_order(p, f, d, of, od)
+# define GC_MALLOC_STUBBORN(sz) GC_malloc_stubborn(sz)
+# define GC_CHANGE_STUBBORN(p) GC_change_stubborn(p)
+# define GC_END_STUBBORN_CHANGE(p) GC_end_stubborn_change(p)
+# define GC_GENERAL_REGISTER_DISAPPEARING_LINK(link, obj) \
+ GC_general_register_disappearing_link(link, obj)
+# define GC_REGISTER_DISPLACEMENT(n) GC_register_displacement(n)
+# endif
+/* The following are included because they are often convenient, and */
+/* reduce the chance for a misspecifed size argument. But calls may */
+/* expand to something syntactically incorrect if t is a complicated */
+/* type expression. */
+# define GC_NEW(t) (t *)GC_MALLOC(sizeof (t))
+# define GC_NEW_ATOMIC(t) (t *)GC_MALLOC_ATOMIC(sizeof (t))
+# define GC_NEW_STUBBORN(t) (t *)GC_MALLOC_STUBBORN(sizeof (t))
+# define GC_NEW_UNCOLLECTABLE(t) (t *)GC_MALLOC_UNCOLLECTABLE(sizeof (t))
+
+/* Finalization. Some of these primitives are grossly unsafe. */
+/* The idea is to make them both cheap, and sufficient to build */
+/* a safer layer, closer to PCedar finalization. */
+/* The interface represents my conclusions from a long discussion */
+/* with Alan Demers, Dan Greene, Carl Hauser, Barry Hayes, */
+/* Christian Jacobi, and Russ Atkinson. It's not perfect, and */
+/* probably nobody else agrees with it. Hans-J. Boehm 3/13/92 */
+typedef void (*GC_finalization_proc)
+ GC_PROTO((GC_PTR obj, GC_PTR client_data));
+
+GC_API void GC_register_finalizer
+ GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer
+ GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR *ocd));
+ /* When obj is no longer accessible, invoke */
+ /* (*fn)(obj, cd). If a and b are inaccessible, and */
+ /* a points to b (after disappearing links have been */
+ /* made to disappear), then only a will be */
+ /* finalized. (If this does not create any new */
+ /* pointers to b, then b will be finalized after the */
+ /* next collection.) Any finalizable object that */
+ /* is reachable from itself by following one or more */
+ /* pointers will not be finalized (or collected). */
+ /* Thus cycles involving finalizable objects should */
+ /* be avoided, or broken by disappearing links. */
+ /* All but the last finalizer registered for an object */
+ /* is ignored. */
+ /* Finalization may be removed by passing 0 as fn. */
+ /* Finalizers are implicitly unregistered just before */
+ /* they are invoked. */
+ /* The old finalizer and client data are stored in */
+ /* *ofn and *ocd. */
+ /* Fn is never invoked on an accessible object, */
+ /* provided hidden pointers are converted to real */
+ /* pointers only if the allocation lock is held, and */
+ /* such conversions are not performed by finalization */
+ /* routines. */
+ /* If GC_register_finalizer is aborted as a result of */
+ /* a signal, the object may be left with no */
+ /* finalization, even if neither the old nor new */
+ /* finalizer were NULL. */
+ /* Obj should be the nonNULL starting address of an */
+ /* object allocated by GC_malloc or friends. */
+ /* Note that any garbage collectable object referenced */
+ /* by cd will be considered accessible until the */
+ /* finalizer is invoked. */
+
+/* Another versions of the above follow. It ignores */
+/* self-cycles, i.e. pointers from a finalizable object to */
+/* itself. There is a stylistic argument that this is wrong, */
+/* but it's unavoidable for C++, since the compiler may */
+/* silently introduce these. It's also benign in that specific */
+/* case. And it helps if finalizable objects are split to */
+/* avoid cycles. */
+/* Note that cd will still be viewed as accessible, even if it */
+/* refers to the object itself. */
+GC_API void GC_register_finalizer_ignore_self
+ GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer_ignore_self
+ GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR *ocd));
+
+/* Another version of the above. It ignores all cycles. */
+/* It should probably only be used by Java implementations. */
+/* Note that cd will still be viewed as accessible, even if it */
+/* refers to the object itself. */
+GC_API void GC_register_finalizer_no_order
+ GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR *ocd));
+GC_API void GC_debug_register_finalizer_no_order
+ GC_PROTO((GC_PTR obj, GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR *ocd));
+
+
+/* The following routine may be used to break cycles between */
+/* finalizable objects, thus causing cyclic finalizable */
+/* objects to be finalized in the correct order. Standard */
+/* use involves calling GC_register_disappearing_link(&p), */
+/* where p is a pointer that is not followed by finalization */
+/* code, and should not be considered in determining */
+/* finalization order. */
+GC_API int GC_register_disappearing_link GC_PROTO((GC_PTR * /* link */));
+ /* Link should point to a field of a heap allocated */
+ /* object obj. *link will be cleared when obj is */
+ /* found to be inaccessible. This happens BEFORE any */
+ /* finalization code is invoked, and BEFORE any */
+ /* decisions about finalization order are made. */
+ /* This is useful in telling the finalizer that */
+ /* some pointers are not essential for proper */
+ /* finalization. This may avoid finalization cycles. */
+ /* Note that obj may be resurrected by another */
+ /* finalizer, and thus the clearing of *link may */
+ /* be visible to non-finalization code. */
+ /* There's an argument that an arbitrary action should */
+ /* be allowed here, instead of just clearing a pointer. */
+ /* But this causes problems if that action alters, or */
+ /* examines connectivity. */
+ /* Returns 1 if link was already registered, 0 */
+ /* otherwise. */
+ /* Only exists for backward compatibility. See below: */
+
+GC_API int GC_general_register_disappearing_link
+ GC_PROTO((GC_PTR * /* link */, GC_PTR obj));
+ /* A slight generalization of the above. *link is */
+ /* cleared when obj first becomes inaccessible. This */
+ /* can be used to implement weak pointers easily and */
+ /* safely. Typically link will point to a location */
+ /* holding a disguised pointer to obj. (A pointer */
+ /* inside an "atomic" object is effectively */
+ /* disguised.) In this way soft */
+ /* pointers are broken before any object */
+ /* reachable from them are finalized. Each link */
+ /* May be registered only once, i.e. with one obj */
+ /* value. This was added after a long email discussion */
+ /* with John Ellis. */
+ /* Obj must be a pointer to the first word of an object */
+ /* we allocated. It is unsafe to explicitly deallocate */
+ /* the object containing link. Explicitly deallocating */
+ /* obj may or may not cause link to eventually be */
+ /* cleared. */
+GC_API int GC_unregister_disappearing_link GC_PROTO((GC_PTR * /* link */));
+ /* Returns 0 if link was not actually registered. */
+ /* Undoes a registration by either of the above two */
+ /* routines. */
+
+/* Returns !=0 if GC_invoke_finalizers has something to do. */
+GC_API int GC_should_invoke_finalizers GC_PROTO((void));
+
+GC_API int GC_invoke_finalizers GC_PROTO((void));
+ /* Run finalizers for all objects that are ready to */
+ /* be finalized. Return the number of finalizers */
+ /* that were run. Normally this is also called */
+ /* implicitly during some allocations. If */
+ /* GC-finalize_on_demand is nonzero, it must be called */
+ /* explicitly. */
+
+/* GC_set_warn_proc can be used to redirect or filter warning messages. */
+/* p may not be a NULL pointer. */
+typedef void (*GC_warn_proc) GC_PROTO((char *msg, GC_word arg));
+GC_API GC_warn_proc GC_set_warn_proc GC_PROTO((GC_warn_proc p));
+ /* Returns old warning procedure. */
+
+GC_API GC_word GC_set_free_space_divisor GC_PROTO((GC_word value));
+ /* Set free_space_divisor. See above for definition. */
+ /* Returns old value. */
+
+/* The following is intended to be used by a higher level */
+/* (e.g. Java-like) finalization facility. It is expected */
+/* that finalization code will arrange for hidden pointers to */
+/* disappear. Otherwise objects can be accessed after they */
+/* have been collected. */
+/* Note that putting pointers in atomic objects or in */
+/* nonpointer slots of "typed" objects is equivalent to */
+/* disguising them in this way, and may have other advantages. */
+# if defined(I_HIDE_POINTERS) || defined(GC_I_HIDE_POINTERS)
+ typedef GC_word GC_hidden_pointer;
+# define HIDE_POINTER(p) (~(GC_hidden_pointer)(p))
+# define REVEAL_POINTER(p) ((GC_PTR)(HIDE_POINTER(p)))
+ /* Converting a hidden pointer to a real pointer requires verifying */
+ /* that the object still exists. This involves acquiring the */
+ /* allocator lock to avoid a race with the collector. */
+# endif /* I_HIDE_POINTERS */
+
+typedef GC_PTR (*GC_fn_type) GC_PROTO((GC_PTR client_data));
+GC_API GC_PTR GC_call_with_alloc_lock
+ GC_PROTO((GC_fn_type fn, GC_PTR client_data));
+
+/* The following routines are primarily intended for use with a */
+/* preprocessor which inserts calls to check C pointer arithmetic. */
+
+/* Check that p and q point to the same object. */
+/* Fail conspicuously if they don't. */
+/* Returns the first argument. */
+/* Succeeds if neither p nor q points to the heap. */
+/* May succeed if both p and q point to between heap objects. */
+GC_API GC_PTR GC_same_obj GC_PROTO((GC_PTR p, GC_PTR q));
+
+/* Checked pointer pre- and post- increment operations. Note that */
+/* the second argument is in units of bytes, not multiples of the */
+/* object size. This should either be invoked from a macro, or the */
+/* call should be automatically generated. */
+GC_API GC_PTR GC_pre_incr GC_PROTO((GC_PTR *p, size_t how_much));
+GC_API GC_PTR GC_post_incr GC_PROTO((GC_PTR *p, size_t how_much));
+
+/* Check that p is visible */
+/* to the collector as a possibly pointer containing location. */
+/* If it isn't fail conspicuously. */
+/* Returns the argument in all cases. May erroneously succeed */
+/* in hard cases. (This is intended for debugging use with */
+/* untyped allocations. The idea is that it should be possible, though */
+/* slow, to add such a call to all indirect pointer stores.) */
+/* Currently useless for multithreaded worlds. */
+GC_API GC_PTR GC_is_visible GC_PROTO((GC_PTR p));
+
+/* Check that if p is a pointer to a heap page, then it points to */
+/* a valid displacement within a heap object. */
+/* Fail conspicuously if this property does not hold. */
+/* Uninteresting with GC_all_interior_pointers. */
+/* Always returns its argument. */
+GC_API GC_PTR GC_is_valid_displacement GC_PROTO((GC_PTR p));
+
+/* Safer, but slow, pointer addition. Probably useful mainly with */
+/* a preprocessor. Useful only for heap pointers. */
+#ifdef GC_DEBUG
+# define GC_PTR_ADD3(x, n, type_of_result) \
+ ((type_of_result)GC_same_obj((x)+(n), (x)))
+# define GC_PRE_INCR3(x, n, type_of_result) \
+ ((type_of_result)GC_pre_incr(&(x), (n)*sizeof(*x))
+# define GC_POST_INCR2(x, type_of_result) \
+ ((type_of_result)GC_post_incr(&(x), sizeof(*x))
+# ifdef __GNUC__
+# define GC_PTR_ADD(x, n) \
+ GC_PTR_ADD3(x, n, typeof(x))
+# define GC_PRE_INCR(x, n) \
+ GC_PRE_INCR3(x, n, typeof(x))
+# define GC_POST_INCR(x, n) \
+ GC_POST_INCR3(x, typeof(x))
+# else
+ /* We can't do this right without typeof, which ANSI */
+ /* decided was not sufficiently useful. Repeatedly */
+ /* mentioning the arguments seems too dangerous to be */
+ /* useful. So does not casting the result. */
+# define GC_PTR_ADD(x, n) ((x)+(n))
+# endif
+#else /* !GC_DEBUG */
+# define GC_PTR_ADD3(x, n, type_of_result) ((x)+(n))
+# define GC_PTR_ADD(x, n) ((x)+(n))
+# define GC_PRE_INCR3(x, n, type_of_result) ((x) += (n))
+# define GC_PRE_INCR(x, n) ((x) += (n))
+# define GC_POST_INCR2(x, n, type_of_result) ((x)++)
+# define GC_POST_INCR(x, n) ((x)++)
+#endif
+
+/* Safer assignment of a pointer to a nonstack location. */
+#ifdef GC_DEBUG
+# ifdef __STDC__
+# define GC_PTR_STORE(p, q) \
+ (*(void **)GC_is_visible(p) = GC_is_valid_displacement(q))
+# else
+# define GC_PTR_STORE(p, q) \
+ (*(char **)GC_is_visible(p) = GC_is_valid_displacement(q))
+# endif
+#else /* !GC_DEBUG */
+# define GC_PTR_STORE(p, q) *((p) = (q))
+#endif
+
+/* Fynctions called to report pointer checking errors */
+GC_API void (*GC_same_obj_print_proc) GC_PROTO((GC_PTR p, GC_PTR q));
+
+GC_API void (*GC_is_valid_displacement_print_proc)
+ GC_PROTO((GC_PTR p));
+
+GC_API void (*GC_is_visible_print_proc)
+ GC_PROTO((GC_PTR p));
+
+
+/* For pthread support, we generally need to intercept a number of */
+/* thread library calls. We do that here by macro defining them. */
+
+#if !defined(GC_USE_LD_WRAP) && \
+ (defined(GC_PTHREADS) || defined(GC_SOLARIS_THREADS))
+# include "gc_pthread_redirects.h"
+#endif
+
+# if defined(PCR) || defined(GC_SOLARIS_THREADS) || \
+ defined(GC_PTHREADS) || defined(GC_WIN32_THREADS)
+ /* Any flavor of threads except SRC_M3. */
+/* This returns a list of objects, linked through their first */
+/* word. Its use can greatly reduce lock contention problems, since */
+/* the allocation lock can be acquired and released many fewer times. */
+/* lb must be large enough to hold the pointer field. */
+/* It is used internally by gc_local_alloc.h, which provides a simpler */
+/* programming interface on Linux. */
+GC_PTR GC_malloc_many(size_t lb);
+#define GC_NEXT(p) (*(GC_PTR *)(p)) /* Retrieve the next element */
+ /* in returned list. */
+extern void GC_thr_init(); /* Needed for Solaris/X86 */
+
+#endif /* THREADS && !SRC_M3 */
+
+#if defined(GC_WIN32_THREADS)
+# include <windows.h>
+# include <winbase.h>
+
+ /*
+ * All threads must be created using GC_CreateThread, so that they will be
+ * recorded in the thread table. For backwards compatibility, this is not
+ * technically true if the GC is built as a dynamic library, since it can
+ * and does then use DllMain to keep track of thread creations. But new code
+ * should be built to call GC_CreateThread.
+ */
+ HANDLE WINAPI GC_CreateThread(
+ LPSECURITY_ATTRIBUTES lpThreadAttributes,
+ DWORD dwStackSize, LPTHREAD_START_ROUTINE lpStartAddress,
+ LPVOID lpParameter, DWORD dwCreationFlags, LPDWORD lpThreadId );
+
+# if defined(_WIN32_WCE)
+ /*
+ * win32_threads.c implements the real WinMain, which will start a new thread
+ * to call GC_WinMain after initializing the garbage collector.
+ */
+ int WINAPI GC_WinMain(
+ HINSTANCE hInstance,
+ HINSTANCE hPrevInstance,
+ LPWSTR lpCmdLine,
+ int nCmdShow );
+
+# ifndef GC_BUILD
+# define WinMain GC_WinMain
+# define CreateThread GC_CreateThread
+# endif
+# endif /* defined(_WIN32_WCE) */
+
+#endif /* defined(GC_WIN32_THREADS) */
+
+/*
+ * If you are planning on putting
+ * the collector in a SunOS 5 dynamic library, you need to call GC_INIT()
+ * from the statically loaded program section.
+ * This circumvents a Solaris 2.X (X<=4) linker bug.
+ */
+#if defined(sparc) || defined(__sparc)
+# define GC_INIT() { extern end, etext; \
+ GC_noop(&end, &etext); }
+#else
+# if defined(__CYGWIN32__) && defined(GC_USE_DLL) || defined (_AIX)
+ /*
+ * Similarly gnu-win32 DLLs need explicit initialization from
+ * the main program, as does AIX.
+ */
+# define GC_INIT() { GC_add_roots(DATASTART, DATAEND); }
+# else
+# define GC_INIT()
+# endif
+#endif
+
+#if !defined(_WIN32_WCE) \
+ && ((defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \
+ || defined(_WIN32) && !defined(__CYGWIN32__) && !defined(__CYGWIN__))
+ /* win32S may not free all resources on process exit. */
+ /* This explicitly deallocates the heap. */
+ GC_API void GC_win32_free_heap ();
+#endif
+
+#if ( defined(_AMIGA) && !defined(GC_AMIGA_MAKINGLIB) )
+ /* Allocation really goes through GC_amiga_allocwrapper_do */
+# include "gc_amiga_redirects.h"
+#endif
+
+#if defined(GC_REDIRECT_TO_LOCAL) && !defined(GC_LOCAL_ALLOC_H)
+# include "gc_local_alloc.h"
+#endif
+
+#ifdef __cplusplus
+ } /* end of extern "C" */
+#endif
+
+#endif /* _GC_H */
--- /dev/null
+/*
+ * Copyright (c) 1996-1998 by Silicon Graphics. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+//
+// This is a C++ header file that is intended to replace the SGI STL
+// alloc.h. This assumes SGI STL version < 3.0.
+//
+// This assumes the collector has been compiled with -DATOMIC_UNCOLLECTABLE
+// and -DALL_INTERIOR_POINTERS. We also recommend
+// -DREDIRECT_MALLOC=GC_uncollectable_malloc.
+//
+// Some of this could be faster in the explicit deallocation case. In particular,
+// we spend too much time clearing objects on the free lists. That could be avoided.
+//
+// This uses template classes with static members, and hence does not work
+// with g++ 2.7.2 and earlier.
+//
+// This code assumes that the collector itself has been compiled with a
+// compiler that defines __STDC__ .
+//
+
+#include "gc.h"
+
+#ifndef GC_ALLOC_H
+
+#define GC_ALLOC_H
+#define __ALLOC_H // Prevent inclusion of the default version. Ugly.
+#define __SGI_STL_ALLOC_H
+#define __SGI_STL_INTERNAL_ALLOC_H
+
+#ifndef __ALLOC
+# define __ALLOC alloc
+#endif
+
+#include <stddef.h>
+#include <string.h>
+
+// The following is just replicated from the conventional SGI alloc.h:
+
+template<class T, class alloc>
+class simple_alloc {
+
+public:
+ static T *allocate(size_t n)
+ { return 0 == n? 0 : (T*) alloc::allocate(n * sizeof (T)); }
+ static T *allocate(void)
+ { return (T*) alloc::allocate(sizeof (T)); }
+ static void deallocate(T *p, size_t n)
+ { if (0 != n) alloc::deallocate(p, n * sizeof (T)); }
+ static void deallocate(T *p)
+ { alloc::deallocate(p, sizeof (T)); }
+};
+
+#include "gc.h"
+
+// The following need to match collector data structures.
+// We can't include gc_priv.h, since that pulls in way too much stuff.
+// This should eventually be factored out into another include file.
+
+extern "C" {
+ extern void ** const GC_objfreelist_ptr;
+ extern void ** const GC_aobjfreelist_ptr;
+ extern void ** const GC_uobjfreelist_ptr;
+ extern void ** const GC_auobjfreelist_ptr;
+
+ extern void GC_incr_words_allocd(size_t words);
+ extern void GC_incr_mem_freed(size_t words);
+
+ extern char * GC_generic_malloc_words_small(size_t word, int kind);
+}
+
+// Object kinds; must match PTRFREE, NORMAL, UNCOLLECTABLE, and
+// AUNCOLLECTABLE in gc_priv.h.
+
+enum { GC_PTRFREE = 0, GC_NORMAL = 1, GC_UNCOLLECTABLE = 2,
+ GC_AUNCOLLECTABLE = 3 };
+
+enum { GC_max_fast_bytes = 255 };
+
+enum { GC_bytes_per_word = sizeof(char *) };
+
+enum { GC_byte_alignment = 8 };
+
+enum { GC_word_alignment = GC_byte_alignment/GC_bytes_per_word };
+
+inline void * &GC_obj_link(void * p)
+{ return *(void **)p; }
+
+// Compute a number of words >= n+1 bytes.
+// The +1 allows for pointers one past the end.
+inline size_t GC_round_up(size_t n)
+{
+ return ((n + GC_byte_alignment)/GC_byte_alignment)*GC_word_alignment;
+}
+
+// The same but don't allow for extra byte.
+inline size_t GC_round_up_uncollectable(size_t n)
+{
+ return ((n + GC_byte_alignment - 1)/GC_byte_alignment)*GC_word_alignment;
+}
+
+template <int dummy>
+class GC_aux_template {
+public:
+ // File local count of allocated words. Occasionally this is
+ // added into the global count. A separate count is necessary since the
+ // real one must be updated with a procedure call.
+ static size_t GC_words_recently_allocd;
+
+ // Same for uncollectable mmory. Not yet reflected in either
+ // GC_words_recently_allocd or GC_non_gc_bytes.
+ static size_t GC_uncollectable_words_recently_allocd;
+
+ // Similar counter for explicitly deallocated memory.
+ static size_t GC_mem_recently_freed;
+
+ // Again for uncollectable memory.
+ static size_t GC_uncollectable_mem_recently_freed;
+
+ static void * GC_out_of_line_malloc(size_t nwords, int kind);
+};
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_mem_recently_freed = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_mem_recently_freed = 0;
+
+template <int dummy>
+void * GC_aux_template<dummy>::GC_out_of_line_malloc(size_t nwords, int kind)
+{
+ GC_words_recently_allocd += GC_uncollectable_words_recently_allocd;
+ GC_non_gc_bytes +=
+ GC_bytes_per_word * GC_uncollectable_words_recently_allocd;
+ GC_uncollectable_words_recently_allocd = 0;
+
+ GC_mem_recently_freed += GC_uncollectable_mem_recently_freed;
+ GC_non_gc_bytes -=
+ GC_bytes_per_word * GC_uncollectable_mem_recently_freed;
+ GC_uncollectable_mem_recently_freed = 0;
+
+ GC_incr_words_allocd(GC_words_recently_allocd);
+ GC_words_recently_allocd = 0;
+
+ GC_incr_mem_freed(GC_mem_recently_freed);
+ GC_mem_recently_freed = 0;
+
+ return GC_generic_malloc_words_small(nwords, kind);
+}
+
+typedef GC_aux_template<0> GC_aux;
+
+// A fast, single-threaded, garbage-collected allocator
+// We assume the first word will be immediately overwritten.
+// In this version, deallocation is not a noop, and explicit
+// deallocation is likely to help performance.
+template <int dummy>
+class single_client_gc_alloc_template {
+ public:
+ static void * allocate(size_t n)
+ {
+ size_t nwords = GC_round_up(n);
+ void ** flh;
+ void * op;
+
+ if (n > GC_max_fast_bytes) return GC_malloc(n);
+ flh = GC_objfreelist_ptr + nwords;
+ if (0 == (op = *flh)) {
+ return GC_aux::GC_out_of_line_malloc(nwords, GC_NORMAL);
+ }
+ *flh = GC_obj_link(op);
+ GC_aux::GC_words_recently_allocd += nwords;
+ return op;
+ }
+ static void * ptr_free_allocate(size_t n)
+ {
+ size_t nwords = GC_round_up(n);
+ void ** flh;
+ void * op;
+
+ if (n > GC_max_fast_bytes) return GC_malloc_atomic(n);
+ flh = GC_aobjfreelist_ptr + nwords;
+ if (0 == (op = *flh)) {
+ return GC_aux::GC_out_of_line_malloc(nwords, GC_PTRFREE);
+ }
+ *flh = GC_obj_link(op);
+ GC_aux::GC_words_recently_allocd += nwords;
+ return op;
+ }
+ static void deallocate(void *p, size_t n)
+ {
+ size_t nwords = GC_round_up(n);
+ void ** flh;
+
+ if (n > GC_max_fast_bytes) {
+ GC_free(p);
+ } else {
+ flh = GC_objfreelist_ptr + nwords;
+ GC_obj_link(p) = *flh;
+ memset((char *)p + GC_bytes_per_word, 0,
+ GC_bytes_per_word * (nwords - 1));
+ *flh = p;
+ GC_aux::GC_mem_recently_freed += nwords;
+ }
+ }
+ static void ptr_free_deallocate(void *p, size_t n)
+ {
+ size_t nwords = GC_round_up(n);
+ void ** flh;
+
+ if (n > GC_max_fast_bytes) {
+ GC_free(p);
+ } else {
+ flh = GC_aobjfreelist_ptr + nwords;
+ GC_obj_link(p) = *flh;
+ *flh = p;
+ GC_aux::GC_mem_recently_freed += nwords;
+ }
+ }
+};
+
+typedef single_client_gc_alloc_template<0> single_client_gc_alloc;
+
+// Once more, for uncollectable objects.
+template <int dummy>
+class single_client_alloc_template {
+ public:
+ static void * allocate(size_t n)
+ {
+ size_t nwords = GC_round_up_uncollectable(n);
+ void ** flh;
+ void * op;
+
+ if (n > GC_max_fast_bytes) return GC_malloc_uncollectable(n);
+ flh = GC_uobjfreelist_ptr + nwords;
+ if (0 == (op = *flh)) {
+ return GC_aux::GC_out_of_line_malloc(nwords, GC_UNCOLLECTABLE);
+ }
+ *flh = GC_obj_link(op);
+ GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+ return op;
+ }
+ static void * ptr_free_allocate(size_t n)
+ {
+ size_t nwords = GC_round_up_uncollectable(n);
+ void ** flh;
+ void * op;
+
+ if (n > GC_max_fast_bytes) return GC_malloc_atomic_uncollectable(n);
+ flh = GC_auobjfreelist_ptr + nwords;
+ if (0 == (op = *flh)) {
+ return GC_aux::GC_out_of_line_malloc(nwords, GC_AUNCOLLECTABLE);
+ }
+ *flh = GC_obj_link(op);
+ GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+ return op;
+ }
+ static void deallocate(void *p, size_t n)
+ {
+ size_t nwords = GC_round_up_uncollectable(n);
+ void ** flh;
+
+ if (n > GC_max_fast_bytes) {
+ GC_free(p);
+ } else {
+ flh = GC_uobjfreelist_ptr + nwords;
+ GC_obj_link(p) = *flh;
+ *flh = p;
+ GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+ }
+ }
+ static void ptr_free_deallocate(void *p, size_t n)
+ {
+ size_t nwords = GC_round_up_uncollectable(n);
+ void ** flh;
+
+ if (n > GC_max_fast_bytes) {
+ GC_free(p);
+ } else {
+ flh = GC_auobjfreelist_ptr + nwords;
+ GC_obj_link(p) = *flh;
+ *flh = p;
+ GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+ }
+ }
+};
+
+typedef single_client_alloc_template<0> single_client_alloc;
+
+template < int dummy >
+class gc_alloc_template {
+ public:
+ static void * allocate(size_t n) { return GC_malloc(n); }
+ static void * ptr_free_allocate(size_t n)
+ { return GC_malloc_atomic(n); }
+ static void deallocate(void *, size_t) { }
+ static void ptr_free_deallocate(void *, size_t) { }
+};
+
+typedef gc_alloc_template < 0 > gc_alloc;
+
+template < int dummy >
+class alloc_template {
+ public:
+ static void * allocate(size_t n) { return GC_malloc_uncollectable(n); }
+ static void * ptr_free_allocate(size_t n)
+ { return GC_malloc_atomic_uncollectable(n); }
+ static void deallocate(void *p, size_t) { GC_free(p); }
+ static void ptr_free_deallocate(void *p, size_t) { GC_free(p); }
+};
+
+typedef alloc_template < 0 > alloc;
+
+#ifdef _SGI_SOURCE
+
+// We want to specialize simple_alloc so that it does the right thing
+// for all pointerfree types. At the moment there is no portable way to
+// even approximate that. The following approximation should work for
+// SGI compilers, and perhaps some others.
+
+# define __GC_SPECIALIZE(T,alloc) \
+class simple_alloc<T, alloc> { \
+public: \
+ static T *allocate(size_t n) \
+ { return 0 == n? 0 : \
+ (T*) alloc::ptr_free_allocate(n * sizeof (T)); } \
+ static T *allocate(void) \
+ { return (T*) alloc::ptr_free_allocate(sizeof (T)); } \
+ static void deallocate(T *p, size_t n) \
+ { if (0 != n) alloc::ptr_free_deallocate(p, n * sizeof (T)); } \
+ static void deallocate(T *p) \
+ { alloc::ptr_free_deallocate(p, sizeof (T)); } \
+};
+
+__GC_SPECIALIZE(char, gc_alloc)
+__GC_SPECIALIZE(int, gc_alloc)
+__GC_SPECIALIZE(unsigned, gc_alloc)
+__GC_SPECIALIZE(float, gc_alloc)
+__GC_SPECIALIZE(double, gc_alloc)
+
+__GC_SPECIALIZE(char, alloc)
+__GC_SPECIALIZE(int, alloc)
+__GC_SPECIALIZE(unsigned, alloc)
+__GC_SPECIALIZE(float, alloc)
+__GC_SPECIALIZE(double, alloc)
+
+__GC_SPECIALIZE(char, single_client_gc_alloc)
+__GC_SPECIALIZE(int, single_client_gc_alloc)
+__GC_SPECIALIZE(unsigned, single_client_gc_alloc)
+__GC_SPECIALIZE(float, single_client_gc_alloc)
+__GC_SPECIALIZE(double, single_client_gc_alloc)
+
+__GC_SPECIALIZE(char, single_client_alloc)
+__GC_SPECIALIZE(int, single_client_alloc)
+__GC_SPECIALIZE(unsigned, single_client_alloc)
+__GC_SPECIALIZE(float, single_client_alloc)
+__GC_SPECIALIZE(double, single_client_alloc)
+
+#ifdef __STL_USE_STD_ALLOCATORS
+
+???copy stuff from stl_alloc.h or remove it to a different file ???
+
+#endif /* __STL_USE_STD_ALLOCATORS */
+
+#endif /* _SGI_SOURCE */
+
+#endif /* GC_ALLOC_H */
--- /dev/null
+/*
+ * Copyright (c) 1996-1997
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 2002
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+/*
+ * This implements standard-conforming allocators that interact with
+ * the garbage collector. Gc_alloctor<T> allocates garbage-collectable
+ * objects of type T. Traceable_allocator<T> allocates objects that
+ * are not temselves garbage collected, but are scanned by the
+ * collector for pointers to collectable objects. Traceable_alloc
+ * should be used for explicitly managed STL containers that may
+ * point to collectable objects.
+ *
+ * This code was derived from an earlier version of the GNU C++ standard
+ * library, which itself was derived from the SGI STL implementation.
+ */
+
+#include "gc.h" // For size_t
+
+/* First some helpers to allow us to dispatch on whether or not a type
+ * is known to be pointerfree.
+ * These are private, except that the client may invoke the
+ * GC_DECLARE_PTRFREE macro.
+ */
+
+struct GC_true_type {};
+struct GC_false_type {};
+
+template <class GC_tp>
+struct GC_type_traits {
+ GC_false_type GC_is_ptr_free;
+};
+
+# define GC_DECLARE_PTRFREE(T) \
+template<> struct GC_type_traits<T> { GC_true_type GC_is_ptr_free; }
+
+GC_DECLARE_PTRFREE(signed char);
+GC_DECLARE_PTRFREE(unsigned char);
+GC_DECLARE_PTRFREE(signed short);
+GC_DECLARE_PTRFREE(unsigned short);
+GC_DECLARE_PTRFREE(signed int);
+GC_DECLARE_PTRFREE(unsigned int);
+GC_DECLARE_PTRFREE(signed long);
+GC_DECLARE_PTRFREE(unsigned long);
+GC_DECLARE_PTRFREE(float);
+GC_DECLARE_PTRFREE(double);
+/* The client may want to add others. */
+
+// In the following GC_Tp is GC_true_type iff we are allocating a
+// pointerfree object.
+template <class GC_Tp>
+inline void * GC_selective_alloc(size_t n, GC_Tp) {
+ return GC_MALLOC(n);
+}
+
+template <>
+inline void * GC_selective_alloc<GC_true_type>(size_t n, GC_true_type) {
+ return GC_MALLOC_ATOMIC(n);
+}
+
+/* Now the public gc_allocator<T> class:
+ */
+template <class GC_Tp>
+class gc_allocator {
+public:
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef GC_Tp* pointer;
+ typedef const GC_Tp* const_pointer;
+ typedef GC_Tp& reference;
+ typedef const GC_Tp& const_reference;
+ typedef GC_Tp value_type;
+
+ template <class GC_Tp1> struct rebind {
+ typedef gc_allocator<GC_Tp1> other;
+ };
+
+ gc_allocator() {}
+# ifndef _MSC_VER
+ // I'm not sure why this is needed here in addition to the following.
+ // The standard specifies it for the standard allocator, but VC++ rejects
+ // it. -HB
+ gc_allocator(const gc_allocator&) throw() {}
+# endif
+ template <class GC_Tp1> gc_allocator(const gc_allocator<GC_Tp1>&) throw() {}
+ ~gc_allocator() throw() {}
+
+ pointer address(reference GC_x) const { return &GC_x; }
+ const_pointer address(const_reference GC_x) const { return &GC_x; }
+
+ // GC_n is permitted to be 0. The C++ standard says nothing about what
+ // the return value is when GC_n == 0.
+ GC_Tp* allocate(size_type GC_n, const void* = 0) {
+ GC_type_traits<GC_Tp> traits;
+ return static_cast<GC_Tp *>
+ (GC_selective_alloc(GC_n * sizeof(GC_Tp),
+ traits.GC_is_ptr_free));
+ }
+
+ // __p is not permitted to be a null pointer.
+ void deallocate(pointer __p, size_type GC_n)
+ { GC_FREE(__p); }
+
+ size_type max_size() const throw()
+ { return size_t(-1) / sizeof(GC_Tp); }
+
+ void construct(pointer __p, const GC_Tp& __val) { new(__p) GC_Tp(__val); }
+ void destroy(pointer __p) { __p->~GC_Tp(); }
+};
+
+template<>
+class gc_allocator<void> {
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef void* pointer;
+ typedef const void* const_pointer;
+ typedef void value_type;
+
+ template <class GC_Tp1> struct rebind {
+ typedef gc_allocator<GC_Tp1> other;
+ };
+};
+
+
+template <class GC_T1, class GC_T2>
+inline bool operator==(const gc_allocator<GC_T1>&, const gc_allocator<GC_T2>&)
+{
+ return true;
+}
+
+template <class GC_T1, class GC_T2>
+inline bool operator!=(const gc_allocator<GC_T1>&, const gc_allocator<GC_T2>&)
+{
+ return false;
+}
+
+/*
+ * And the public traceable_allocator class.
+ */
+
+// Note that we currently don't specialize the pointer-free case, since a
+// pointer-free traceable container doesn't make that much sense,
+// though it could become an issue due to abstraction boundaries.
+template <class GC_Tp>
+class traceable_allocator {
+public:
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef GC_Tp* pointer;
+ typedef const GC_Tp* const_pointer;
+ typedef GC_Tp& reference;
+ typedef const GC_Tp& const_reference;
+ typedef GC_Tp value_type;
+
+ template <class GC_Tp1> struct rebind {
+ typedef traceable_allocator<GC_Tp1> other;
+ };
+
+ traceable_allocator() throw() {}
+# ifndef _MSC_VER
+ traceable_allocator(const traceable_allocator&) throw() {}
+# endif
+ template <class GC_Tp1> traceable_allocator
+ (const traceable_allocator<GC_Tp1>&) throw() {}
+ ~traceable_allocator() throw() {}
+
+ pointer address(reference GC_x) const { return &GC_x; }
+ const_pointer address(const_reference GC_x) const { return &GC_x; }
+
+ // GC_n is permitted to be 0. The C++ standard says nothing about what
+ // the return value is when GC_n == 0.
+ GC_Tp* allocate(size_type GC_n, const void* = 0) {
+ return static_cast<GC_Tp*>(GC_MALLOC_UNCOLLECTABLE(GC_n * sizeof(GC_Tp)));
+ }
+
+ // __p is not permitted to be a null pointer.
+ void deallocate(pointer __p, size_type GC_n)
+ { GC_FREE(__p); }
+
+ size_type max_size() const throw()
+ { return size_t(-1) / sizeof(GC_Tp); }
+
+ void construct(pointer __p, const GC_Tp& __val) { new(__p) GC_Tp(__val); }
+ void destroy(pointer __p) { __p->~GC_Tp(); }
+};
+
+template<>
+class traceable_allocator<void> {
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef void* pointer;
+ typedef const void* const_pointer;
+ typedef void value_type;
+
+ template <class GC_Tp1> struct rebind {
+ typedef traceable_allocator<GC_Tp1> other;
+ };
+};
+
+
+template <class GC_T1, class GC_T2>
+inline bool operator==(const traceable_allocator<GC_T1>&, const traceable_allocator<GC_T2>&)
+{
+ return true;
+}
+
+template <class GC_T1, class GC_T2>
+inline bool operator!=(const traceable_allocator<GC_T1>&, const traceable_allocator<GC_T2>&)
+{
+ return false;
+}
+
--- /dev/null
+#ifndef GC_AMIGA_REDIRECTS_H
+
+# define GC_AMIGA_REDIRECTS_H
+
+# if ( defined(_AMIGA) && !defined(GC_AMIGA_MAKINGLIB) )
+ extern void *GC_amiga_realloc(void *old_object,size_t new_size_in_bytes);
+# define GC_realloc(a,b) GC_amiga_realloc(a,b)
+ extern void GC_amiga_set_toany(void (*func)(void));
+ extern int GC_amiga_free_space_divisor_inc;
+ extern void *(*GC_amiga_allocwrapper_do) \
+ (size_t size,void *(*AllocFunction)(size_t size2));
+# define GC_malloc(a) \
+ (*GC_amiga_allocwrapper_do)(a,GC_malloc)
+# define GC_malloc_atomic(a) \
+ (*GC_amiga_allocwrapper_do)(a,GC_malloc_atomic)
+# define GC_malloc_uncollectable(a) \
+ (*GC_amiga_allocwrapper_do)(a,GC_malloc_uncollectable)
+# define GC_malloc_stubborn(a) \
+ (*GC_amiga_allocwrapper_do)(a,GC_malloc_stubborn)
+# define GC_malloc_atomic_uncollectable(a) \
+ (*GC_amiga_allocwrapper_do)(a,GC_malloc_atomic_uncollectable)
+# define GC_malloc_ignore_off_page(a) \
+ (*GC_amiga_allocwrapper_do)(a,GC_malloc_ignore_off_page)
+# define GC_malloc_atomic_ignore_off_page(a) \
+ (*GC_amiga_allocwrapper_do)(a,GC_malloc_atomic_ignore_off_page)
+# endif /* _AMIGA && !GC_AMIGA_MAKINGLIB */
+
+#endif /* GC_AMIGA_REDIRECTS_H */
+
+
--- /dev/null
+/*
+ * This is a simple API to implement pointer back tracing, i.e.
+ * to answer questions such as "who is pointing to this" or
+ * "why is this object being retained by the collector"
+ *
+ * This API assumes that we have an ANSI C compiler.
+ *
+ * Most of these calls yield useful information on only after
+ * a garbage collection. Usually the client will first force
+ * a full collection and then gather information, preferably
+ * before much intervening allocation.
+ *
+ * The implementation of the interface is only about 99.9999%
+ * correct. It is intended to be good enough for profiling,
+ * but is not intended to be used with production code.
+ *
+ * Results are likely to be much more useful if all allocation is
+ * accomplished through the debugging allocators.
+ *
+ * The implementation idea is due to A. Demers.
+ */
+
+#ifndef GC_BACKPTR_H
+#define GC_BACKPTR_H
+/* Store information about the object referencing dest in *base_p */
+/* and *offset_p. */
+/* If multiple objects or roots point to dest, the one reported */
+/* will be the last on used by the garbage collector to trace the */
+/* object. */
+/* source is root ==> *base_p = address, *offset_p = 0 */
+/* source is heap object ==> *base_p != 0, *offset_p = offset */
+/* Returns 1 on success, 0 if source couldn't be determined. */
+/* Dest can be any address within a heap object. */
+typedef enum { GC_UNREFERENCED, /* No reference info available. */
+ GC_NO_SPACE, /* Dest not allocated with debug alloc */
+ GC_REFD_FROM_ROOT, /* Referenced directly by root *base_p */
+ GC_REFD_FROM_REG, /* Referenced from a register, i.e. */
+ /* a root without an address. */
+ GC_REFD_FROM_HEAP, /* Referenced from another heap obj. */
+ GC_FINALIZER_REFD /* Finalizable and hence accessible. */
+} GC_ref_kind;
+
+GC_ref_kind GC_get_back_ptr_info(void *dest, void **base_p, size_t *offset_p);
+
+/* Generate a random heap address. */
+/* The resulting address is in the heap, but */
+/* not necessarily inside a valid object. */
+void * GC_generate_random_heap_address(void);
+
+/* Generate a random address inside a valid marked heap object. */
+void * GC_generate_random_valid_address(void);
+
+/* Force a garbage collection and generate a backtrace from a */
+/* random heap address. */
+/* This uses the GC logging mechanism (GC_printf) to produce */
+/* output. It can often be called from a debugger. The */
+/* source in dbg_mlc.c also serves as a sample client. */
+void GC_generate_random_backtrace(void);
+
+/* Print a backtrace from a specific address. Used by the */
+/* above. The client should call GC_gcollect() immediately */
+/* before invocation. */
+void GC_print_backtrace(void *);
+
+#endif /* GC_BACKPTR_H */
--- /dev/null
+/*
+ * This should never be included directly. It is included only from gc.h.
+ * We separate it only to make gc.h more suitable as documentation.
+ *
+ * Some tests for old macros. These violate our namespace rules and will
+ * disappear shortly. Use the GC_ names.
+ */
+#if defined(SOLARIS_THREADS) || defined(_SOLARIS_THREADS)
+# define GC_SOLARIS_THREADS
+#endif
+#if defined(_SOLARIS_PTHREADS)
+# define GC_SOLARIS_PTHREADS
+#endif
+#if defined(IRIX_THREADS)
+# define GC_IRIX_THREADS
+#endif
+#if defined(DGUX_THREADS)
+# if !defined(GC_DGUX386_THREADS)
+# define GC_DGUX386_THREADS
+# endif
+#endif
+#if defined(HPUX_THREADS)
+# define GC_HPUX_THREADS
+#endif
+#if defined(OSF1_THREADS)
+# define GC_OSF1_THREADS
+#endif
+#if defined(LINUX_THREADS)
+# define GC_LINUX_THREADS
+#endif
+#if defined(WIN32_THREADS)
+# define GC_WIN32_THREADS
+#endif
+#if defined(USE_LD_WRAP)
+# define GC_USE_LD_WRAP
+#endif
+
+#if !defined(_REENTRANT) && (defined(GC_SOLARIS_THREADS) \
+ || defined(GC_SOLARIS_PTHREADS) \
+ || defined(GC_HPUX_THREADS) \
+ || defined(GC_LINUX_THREADS))
+# define _REENTRANT
+ /* Better late than never. This fails if system headers that */
+ /* depend on this were previously included. */
+#endif
+
+#if defined(GC_DGUX386_THREADS) && !defined(_POSIX4A_DRAFT10_SOURCE)
+# define _POSIX4A_DRAFT10_SOURCE 1
+#endif
+
+# if defined(GC_SOLARIS_PTHREADS) || defined(GC_FREEBSD_THREADS) || \
+ defined(GC_IRIX_THREADS) || defined(GC_LINUX_THREADS) || \
+ defined(GC_HPUX_THREADS) || defined(GC_OSF1_THREADS) || \
+ defined(GC_DGUX386_THREADS) || defined(GC_MACOSX_THREADS) || \
+ (defined(GC_WIN32_THREADS) && defined(__CYGWIN32__))
+# define GC_PTHREADS
+# endif
+
+#if defined(GC_THREADS) && !defined(GC_PTHREADS)
+# if defined(__linux__)
+# define GC_LINUX_THREADS
+# define GC_PTHREADS
+# endif
+# if !defined(LINUX) && (defined(_PA_RISC1_1) || defined(_PA_RISC2_0) \
+ || defined(hppa) || defined(__HPPA))
+# define GC_HPUX_THREADS
+# define GC_PTHREADS
+# endif
+# if !defined(__linux__) && (defined(__alpha) || defined(__alpha__))
+# define GC_OSF1_THREADS
+# define GC_PTHREADS
+# endif
+# if defined(__mips) && !defined(__linux__)
+# define GC_IRIX_THREADS
+# define GC_PTHREADS
+# endif
+# if defined(__sparc) && !defined(__linux__)
+# define GC_SOLARIS_PTHREADS
+# define GC_PTHREADS
+# endif
+# if defined(__APPLE__) && defined(__MACH__) && defined(__ppc__)
+# define GC_MACOSX_THREADS
+# define GC_PTHREADS
+# endif
+# if !defined(GC_PTHREADS) && defined(__FreeBSD__)
+# define GC_FREEBSD_THREADS
+# define GC_PTHREADS
+# endif
+# if defined(DGUX) && (defined(i386) || defined(__i386__))
+# define GC_DGUX386_THREADS
+# define GC_PTHREADS
+# endif
+#endif /* GC_THREADS */
+
+#if defined(GC_THREADS) && !defined(GC_PTHREADS) && defined(MSWIN32)
+# define GC_WIN32_THREADS
+#endif
+
+#if defined(GC_SOLARIS_PTHREADS) && !defined(GC_SOLARIS_THREADS)
+# define GC_SOLARIS_THREADS
+#endif
+
+# define __GC
+# include <stddef.h>
+# ifdef _WIN32_WCE
+/* Yet more kluges for WinCE */
+# include <stdlib.h> /* size_t is defined here */
+ typedef long ptrdiff_t; /* ptrdiff_t is not defined */
+# endif
+
+#if defined(__MINGW32__) && defined(_DLL) && !defined(GC_NOT_DLL)
+# ifdef GC_BUILD
+# define GC_API __declspec(dllexport)
+# else
+# define GC_API __declspec(dllimport)
+# endif
+#endif
+
+#if (defined(__DMC__) || defined(_MSC_VER)) \
+ && (defined(_DLL) && !defined(GC_NOT_DLL) \
+ || defined(GC_DLL))
+# ifdef GC_BUILD
+# define GC_API extern __declspec(dllexport)
+# else
+# define GC_API __declspec(dllimport)
+# endif
+#endif
+
+#if defined(__WATCOMC__) && defined(GC_DLL)
+# ifdef GC_BUILD
+# define GC_API extern __declspec(dllexport)
+# else
+# define GC_API extern __declspec(dllimport)
+# endif
+#endif
+
+#ifndef GC_API
+#define GC_API extern
+#endif
+
--- /dev/null
+#ifndef GC_CPP_H
+#define GC_CPP_H
+/****************************************************************************
+Copyright (c) 1994 by Xerox Corporation. All rights reserved.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+
+Permission is hereby granted to use or copy this program for any
+purpose, provided the above notices are retained on all copies.
+Permission to modify the code and to distribute modified code is
+granted, provided the above notices are retained, and a notice that
+the code was modified is included with the above copyright notice.
+****************************************************************************
+
+C++ Interface to the Boehm Collector
+
+ John R. Ellis and Jesse Hull
+
+This interface provides access to the Boehm collector. It provides
+basic facilities similar to those described in "Safe, Efficient
+Garbage Collection for C++", by John R. Elis and David L. Detlefs
+(ftp://ftp.parc.xerox.com/pub/ellis/gc).
+
+All heap-allocated objects are either "collectable" or
+"uncollectable". Programs must explicitly delete uncollectable
+objects, whereas the garbage collector will automatically delete
+collectable objects when it discovers them to be inaccessible.
+Collectable objects may freely point at uncollectable objects and vice
+versa.
+
+Objects allocated with the built-in "::operator new" are uncollectable.
+
+Objects derived from class "gc" are collectable. For example:
+
+ class A: public gc {...};
+ A* a = new A; // a is collectable.
+
+Collectable instances of non-class types can be allocated using the GC
+(or UseGC) placement:
+
+ typedef int A[ 10 ];
+ A* a = new (GC) A;
+
+Uncollectable instances of classes derived from "gc" can be allocated
+using the NoGC placement:
+
+ class A: public gc {...};
+ A* a = new (NoGC) A; // a is uncollectable.
+
+Both uncollectable and collectable objects can be explicitly deleted
+with "delete", which invokes an object's destructors and frees its
+storage immediately.
+
+A collectable object may have a clean-up function, which will be
+invoked when the collector discovers the object to be inaccessible.
+An object derived from "gc_cleanup" or containing a member derived
+from "gc_cleanup" has a default clean-up function that invokes the
+object's destructors. Explicit clean-up functions may be specified as
+an additional placement argument:
+
+ A* a = ::new (GC, MyCleanup) A;
+
+An object is considered "accessible" by the collector if it can be
+reached by a path of pointers from static variables, automatic
+variables of active functions, or from some object with clean-up
+enabled; pointers from an object to itself are ignored.
+
+Thus, if objects A and B both have clean-up functions, and A points at
+B, B is considered accessible. After A's clean-up is invoked and its
+storage released, B will then become inaccessible and will have its
+clean-up invoked. If A points at B and B points to A, forming a
+cycle, then that's considered a storage leak, and neither will be
+collectable. See the interface gc.h for low-level facilities for
+handling such cycles of objects with clean-up.
+
+The collector cannot guarrantee that it will find all inaccessible
+objects. In practice, it finds almost all of them.
+
+
+Cautions:
+
+1. Be sure the collector has been augmented with "make c++".
+
+2. If your compiler supports the new "operator new[]" syntax, then
+add -DGC_OPERATOR_NEW_ARRAY to the Makefile.
+
+If your compiler doesn't support "operator new[]", beware that an
+array of type T, where T is derived from "gc", may or may not be
+allocated as a collectable object (it depends on the compiler). Use
+the explicit GC placement to make the array collectable. For example:
+
+ class A: public gc {...};
+ A* a1 = new A[ 10 ]; // collectable or uncollectable?
+ A* a2 = new (GC) A[ 10 ]; // collectable
+
+3. The destructors of collectable arrays of objects derived from
+"gc_cleanup" will not be invoked properly. For example:
+
+ class A: public gc_cleanup {...};
+ A* a = new (GC) A[ 10 ]; // destructors not invoked correctly
+
+Typically, only the destructor for the first element of the array will
+be invoked when the array is garbage-collected. To get all the
+destructors of any array executed, you must supply an explicit
+clean-up function:
+
+ A* a = new (GC, MyCleanUp) A[ 10 ];
+
+(Implementing clean-up of arrays correctly, portably, and in a way
+that preserves the correct exception semantics requires a language
+extension, e.g. the "gc" keyword.)
+
+4. Compiler bugs:
+
+* Solaris 2's CC (SC3.0) doesn't implement t->~T() correctly, so the
+destructors of classes derived from gc_cleanup won't be invoked.
+You'll have to explicitly register a clean-up function with
+new-placement syntax.
+
+* Evidently cfront 3.0 does not allow destructors to be explicitly
+invoked using the ANSI-conforming syntax t->~T(). If you're using
+cfront 3.0, you'll have to comment out the class gc_cleanup, which
+uses explicit invocation.
+
+5. GC name conflicts:
+
+Many other systems seem to use the identifier "GC" as an abbreviation
+for "Graphics Context". Since version 5.0, GC placement has been replaced
+by UseGC. GC is an alias for UseGC, unless GC_NAME_CONFLICT is defined.
+
+****************************************************************************/
+
+#include "gc.h"
+
+#ifndef THINK_CPLUS
+# define GC_cdecl
+#else
+# define GC_cdecl _cdecl
+#endif
+
+#if ! defined( GC_NO_OPERATOR_NEW_ARRAY ) \
+ && !defined(_ENABLE_ARRAYNEW) /* Digimars */ \
+ && (defined(__BORLANDC__) && (__BORLANDC__ < 0x450) \
+ || (defined(__GNUC__) && \
+ (__GNUC__ < 2 || __GNUC__ == 2 && __GNUC_MINOR__ < 6)) \
+ || (defined(__WATCOMC__) && __WATCOMC__ < 1050))
+# define GC_NO_OPERATOR_NEW_ARRAY
+#endif
+
+#if !defined(GC_NO_OPERATOR_NEW_ARRAY) && !defined(GC_OPERATOR_NEW_ARRAY)
+# define GC_OPERATOR_NEW_ARRAY
+#endif
+
+enum GCPlacement {UseGC,
+#ifndef GC_NAME_CONFLICT
+ GC=UseGC,
+#endif
+ NoGC, PointerFreeGC};
+
+class gc {public:
+ inline void* operator new( size_t size );
+ inline void* operator new( size_t size, GCPlacement gcp );
+ inline void* operator new( size_t size, void *p );
+ /* Must be redefined here, since the other overloadings */
+ /* hide the global definition. */
+ inline void operator delete( void* obj );
+# ifndef __BORLANDC__ /* Confuses the Borland compiler. */
+ inline void operator delete( void*, void* );
+# endif
+
+#ifdef GC_OPERATOR_NEW_ARRAY
+ inline void* operator new[]( size_t size );
+ inline void* operator new[]( size_t size, GCPlacement gcp );
+ inline void* operator new[]( size_t size, void *p );
+ inline void operator delete[]( void* obj );
+# ifndef __BORLANDC__
+ inline void gc::operator delete[]( void*, void* );
+# endif
+#endif /* GC_OPERATOR_NEW_ARRAY */
+ };
+ /*
+ Instances of classes derived from "gc" will be allocated in the
+ collected heap by default, unless an explicit NoGC placement is
+ specified. */
+
+class gc_cleanup: virtual public gc {public:
+ inline gc_cleanup();
+ inline virtual ~gc_cleanup();
+private:
+ inline static void GC_cdecl cleanup( void* obj, void* clientData );};
+ /*
+ Instances of classes derived from "gc_cleanup" will be allocated
+ in the collected heap by default. When the collector discovers an
+ inaccessible object derived from "gc_cleanup" or containing a
+ member derived from "gc_cleanup", its destructors will be
+ invoked. */
+
+extern "C" {typedef void (*GCCleanUpFunc)( void* obj, void* clientData );}
+
+#ifdef _MSC_VER
+ // Disable warning that "no matching operator delete found; memory will
+ // not be freed if initialization throws an exception"
+# pragma warning(disable:4291)
+#endif
+
+inline void* operator new(
+ size_t size,
+ GCPlacement gcp,
+ GCCleanUpFunc cleanup = 0,
+ void* clientData = 0 );
+ /*
+ Allocates a collectable or uncollected object, according to the
+ value of "gcp".
+
+ For collectable objects, if "cleanup" is non-null, then when the
+ allocated object "obj" becomes inaccessible, the collector will
+ invoke the function "cleanup( obj, clientData )" but will not
+ invoke the object's destructors. It is an error to explicitly
+ delete an object allocated with a non-null "cleanup".
+
+ It is an error to specify a non-null "cleanup" with NoGC or for
+ classes derived from "gc_cleanup" or containing members derived
+ from "gc_cleanup". */
+
+
+#ifdef _MSC_VER
+ /** This ensures that the system default operator new[] doesn't get
+ * undefined, which is what seems to happen on VC++ 6 for some reason
+ * if we define a multi-argument operator new[].
+ * There seems to be really redirect new in this environment without
+ * including this everywhere.
+ */
+ void *operator new[]( size_t size );
+
+ void operator delete[](void* obj);
+
+ void* operator new( size_t size);
+
+ void operator delete(void* obj);
+
+ // This new operator is used by VC++ in case of Debug builds !
+ void* operator new( size_t size,
+ int ,//nBlockUse,
+ const char * szFileName,
+ int nLine );
+#endif /* _MSC_VER */
+
+
+#ifdef GC_OPERATOR_NEW_ARRAY
+
+inline void* operator new[](
+ size_t size,
+ GCPlacement gcp,
+ GCCleanUpFunc cleanup = 0,
+ void* clientData = 0 );
+ /*
+ The operator new for arrays, identical to the above. */
+
+#endif /* GC_OPERATOR_NEW_ARRAY */
+
+/****************************************************************************
+
+Inline implementation
+
+****************************************************************************/
+
+inline void* gc::operator new( size_t size ) {
+ return GC_MALLOC( size );}
+
+inline void* gc::operator new( size_t size, GCPlacement gcp ) {
+ if (gcp == UseGC)
+ return GC_MALLOC( size );
+ else if (gcp == PointerFreeGC)
+ return GC_MALLOC_ATOMIC( size );
+ else
+ return GC_MALLOC_UNCOLLECTABLE( size );}
+
+inline void* gc::operator new( size_t size, void *p ) {
+ return p;}
+
+inline void gc::operator delete( void* obj ) {
+ GC_FREE( obj );}
+
+#ifndef __BORLANDC__
+ inline void gc::operator delete( void*, void* ) {}
+#endif
+
+#ifdef GC_OPERATOR_NEW_ARRAY
+
+inline void* gc::operator new[]( size_t size ) {
+ return gc::operator new( size );}
+
+inline void* gc::operator new[]( size_t size, GCPlacement gcp ) {
+ return gc::operator new( size, gcp );}
+
+inline void* gc::operator new[]( size_t size, void *p ) {
+ return p;}
+
+inline void gc::operator delete[]( void* obj ) {
+ gc::operator delete( obj );}
+
+#ifndef __BORLANDC__
+ inline void gc::operator delete[]( void*, void* ) {}
+#endif
+
+#endif /* GC_OPERATOR_NEW_ARRAY */
+
+
+inline gc_cleanup::~gc_cleanup() {
+ GC_register_finalizer_ignore_self( GC_base(this), 0, 0, 0, 0 );}
+
+inline void gc_cleanup::cleanup( void* obj, void* displ ) {
+ ((gc_cleanup*) ((char*) obj + (ptrdiff_t) displ))->~gc_cleanup();}
+
+inline gc_cleanup::gc_cleanup() {
+ GC_finalization_proc oldProc;
+ void* oldData;
+ void* base = GC_base( (void *) this );
+ if (0 != base) {
+ // Don't call the debug version, since this is a real base address.
+ GC_register_finalizer_ignore_self(
+ base, (GC_finalization_proc)cleanup, (void*) ((char*) this - (char*) base),
+ &oldProc, &oldData );
+ if (0 != oldProc) {
+ GC_register_finalizer_ignore_self( base, oldProc, oldData, 0, 0 );}}}
+
+inline void* operator new(
+ size_t size,
+ GCPlacement gcp,
+ GCCleanUpFunc cleanup,
+ void* clientData )
+{
+ void* obj;
+
+ if (gcp == UseGC) {
+ obj = GC_MALLOC( size );
+ if (cleanup != 0)
+ GC_REGISTER_FINALIZER_IGNORE_SELF(
+ obj, cleanup, clientData, 0, 0 );}
+ else if (gcp == PointerFreeGC) {
+ obj = GC_MALLOC_ATOMIC( size );}
+ else {
+ obj = GC_MALLOC_UNCOLLECTABLE( size );};
+ return obj;}
+
+
+#ifdef GC_OPERATOR_NEW_ARRAY
+
+inline void* operator new[](
+ size_t size,
+ GCPlacement gcp,
+ GCCleanUpFunc cleanup,
+ void* clientData )
+{
+ return ::operator new( size, gcp, cleanup, clientData );}
+
+#endif /* GC_OPERATOR_NEW_ARRAY */
+
+
+#endif /* GC_CPP_H */
+
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+ * Copyright 1996-1999 by Silicon Graphics. All rights reserved.
+ * Copyright 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/* This file assumes the collector has been compiled with GC_GCJ_SUPPORT */
+/* and that an ANSI C compiler is available. */
+
+/*
+ * We allocate objects whose first word contains a pointer to a struct
+ * describing the object type. This struct contains a garbage collector mark
+ * descriptor at offset MARK_DESCR_OFFSET. Alternatively, the objects
+ * may be marked by the mark procedure passed to GC_init_gcj_malloc.
+ */
+
+#ifndef GC_GCJ_H
+
+#define GC_GCJ_H
+
+#ifndef MARK_DESCR_OFFSET
+# define MARK_DESCR_OFFSET sizeof(word)
+#endif
+ /* Gcj keeps GC descriptor as second word of vtable. This */
+ /* probably needs to be adjusted for other clients. */
+ /* We currently assume that this offset is such that: */
+ /* - all objects of this kind are large enough to have */
+ /* a value at that offset, and */
+ /* - it is not zero. */
+ /* These assumptions allow objects on the free list to be */
+ /* marked normally. */
+
+#ifndef _GC_H
+# include "gc.h"
+#endif
+
+/* The following allocators signal an out of memory condition with */
+/* return GC_oom_fn(bytes); */
+
+/* The following function must be called before the gcj allocators */
+/* can be invoked. */
+/* mp_index and mp are the index and mark_proc (see gc_mark.h) */
+/* respectively for the allocated objects. Mark_proc will be */
+/* used to build the descriptor for objects allocated through the */
+/* debugging interface. The mark_proc will be invoked on all such */
+/* objects with an "environment" value of 1. The client may chose */
+/* to use the same mark_proc for some of its generated mark descriptors.*/
+/* In that case, it should use a different "environment" value to */
+/* detect the presence or absence of the debug header. */
+/* Mp is really of type mark_proc, as defined in gc_mark.h. We don't */
+/* want to include that here for namespace pollution reasons. */
+extern void GC_init_gcj_malloc(int mp_index, void * /* really mark_proc */mp);
+
+/* Allocate an object, clear it, and store the pointer to the */
+/* type structure (vtable in gcj). */
+/* This adds a byte at the end of the object if GC_malloc would.*/
+extern void * GC_gcj_malloc(size_t lb, void * ptr_to_struct_containing_descr);
+/* The debug versions allocate such that the specified mark_proc */
+/* is always invoked. */
+extern void * GC_debug_gcj_malloc(size_t lb,
+ void * ptr_to_struct_containing_descr,
+ GC_EXTRA_PARAMS);
+
+/* Similar to the above, but the size is in words, and we don't */
+/* adjust it. The size is assumed to be such that it can be */
+/* allocated as a small object. */
+/* Unless it is known that the collector is not configured */
+/* with USE_MARK_BYTES and unless it is known that the object */
+/* has weak alignment requirements, lw must be even. */
+extern void * GC_gcj_fast_malloc(size_t lw,
+ void * ptr_to_struct_containing_descr);
+extern void * GC_debug_gcj_fast_malloc(size_t lw,
+ void * ptr_to_struct_containing_descr,
+ GC_EXTRA_PARAMS);
+
+/* Similar to GC_gcj_malloc, but assumes that a pointer to near the */
+/* beginning of the resulting object is always maintained. */
+extern void * GC_gcj_malloc_ignore_off_page(size_t lb,
+ void * ptr_to_struct_containing_descr);
+
+# ifdef GC_DEBUG
+# define GC_GCJ_MALLOC(s,d) GC_debug_gcj_malloc(s,d,GC_EXTRAS)
+# define GC_GCJ_FAST_MALLOC(s,d) GC_debug_gcj_fast_malloc(s,d,GC_EXTRAS)
+# define GC_GCJ_MALLOC_IGNORE_OFF_PAGE(s,d) GC_debug_gcj_malloc(s,d,GC_EXTRAS)
+# else
+# define GC_GCJ_MALLOC(s,d) GC_gcj_malloc(s,d)
+# define GC_GCJ_FAST_MALLOC(s,d) GC_gcj_fast_malloc(s,d)
+# define GC_GCJ_MALLOC_IGNORE_OFF_PAGE(s,d) \
+ GC_gcj_malloc_ignore_off_page(s,d)
+# endif
+
+#endif /* GC_GCJ_H */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, October 3, 1995 2:07 pm PDT */
+
+# ifndef GC_PRIVATE_H
+# include "private/gc_priv.h"
+# endif
+
+/* USE OF THIS FILE IS NOT RECOMMENDED unless GC_all_interior_pointers */
+/* is always set, or the collector has been built with */
+/* -DDONT_ADD_BYTE_AT_END, or the specified size includes a pointerfree */
+/* word at the end. In the standard collector configuration, */
+/* the final word of each object may not be scanned. */
+/* This iinterface is most useful for compilers that generate C. */
+/* Manual use is hereby discouraged. */
+
+/* Allocate n words (NOT BYTES). X is made to point to the result. */
+/* It is assumed that n < MAXOBJSZ, and */
+/* that n > 0. On machines requiring double word alignment of some */
+/* data, we also assume that n is 1 or even. */
+/* If the collector is built with -DUSE_MARK_BYTES or -DPARALLEL_MARK, */
+/* the n = 1 case is also disallowed. */
+/* Effectively this means that portable code should make sure n is even.*/
+/* This bypasses the */
+/* MERGE_SIZES mechanism. In order to minimize the number of distinct */
+/* free lists that are maintained, the caller should ensure that a */
+/* small number of distinct values of n are used. (The MERGE_SIZES */
+/* mechanism normally does this by ensuring that only the leading three */
+/* bits of n may be nonzero. See misc.c for details.) We really */
+/* recommend this only in cases in which n is a constant, and no */
+/* locking is required. */
+/* In that case it may allow the compiler to perform substantial */
+/* additional optimizations. */
+# define GC_MALLOC_WORDS(result,n) \
+{ \
+ register ptr_t op; \
+ register ptr_t *opp; \
+ DCL_LOCK_STATE; \
+ \
+ opp = &(GC_objfreelist[n]); \
+ FASTLOCK(); \
+ if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) { \
+ FASTUNLOCK(); \
+ (result) = GC_generic_malloc_words_small((n), NORMAL); \
+ } else { \
+ *opp = obj_link(op); \
+ obj_link(op) = 0; \
+ GC_words_allocd += (n); \
+ FASTUNLOCK(); \
+ (result) = (GC_PTR) op; \
+ } \
+}
+
+
+/* The same for atomic objects: */
+# define GC_MALLOC_ATOMIC_WORDS(result,n) \
+{ \
+ register ptr_t op; \
+ register ptr_t *opp; \
+ DCL_LOCK_STATE; \
+ \
+ opp = &(GC_aobjfreelist[n]); \
+ FASTLOCK(); \
+ if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) { \
+ FASTUNLOCK(); \
+ (result) = GC_generic_malloc_words_small((n), PTRFREE); \
+ } else { \
+ *opp = obj_link(op); \
+ obj_link(op) = 0; \
+ GC_words_allocd += (n); \
+ FASTUNLOCK(); \
+ (result) = (GC_PTR) op; \
+ } \
+}
+
+/* And once more for two word initialized objects: */
+# define GC_CONS(result, first, second) \
+{ \
+ register ptr_t op; \
+ register ptr_t *opp; \
+ DCL_LOCK_STATE; \
+ \
+ opp = &(GC_objfreelist[2]); \
+ FASTLOCK(); \
+ if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) { \
+ FASTUNLOCK(); \
+ op = GC_generic_malloc_words_small(2, NORMAL); \
+ } else { \
+ *opp = obj_link(op); \
+ GC_words_allocd += 2; \
+ FASTUNLOCK(); \
+ } \
+ ((word *)op)[0] = (word)(first); \
+ ((word *)op)[1] = (word)(second); \
+ (result) = (GC_PTR) op; \
+}
--- /dev/null
+# include "gc_inl.h"
--- /dev/null
+/*
+ * Copyright (c) 2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * Interface for thread local allocation. Memory obtained
+ * this way can be used by all threads, as though it were obtained
+ * from an allocator like GC_malloc. The difference is that GC_local_malloc
+ * counts the number of allocations of a given size from the current thread,
+ * and uses GC_malloc_many to perform the allocations once a threashold
+ * is exceeded. Thus far less synchronization may be needed.
+ * Allocation of known large objects should not use this interface.
+ * This interface is designed primarily for fast allocation of small
+ * objects on multiprocessors, e.g. for a JVM running on an MP server.
+ *
+ * If this file is included with GC_GCJ_SUPPORT defined, GCJ-style
+ * bitmap allocation primitives will also be included.
+ *
+ * If this file is included with GC_REDIRECT_TO_LOCAL defined, then
+ * GC_MALLOC, GC_MALLOC_ATOMIC, and possibly GC_GCJ_MALLOC will
+ * be redefined to use the thread local allocatoor.
+ *
+ * The interface is available only if the collector is built with
+ * -DTHREAD_LOCAL_ALLOC, which is currently supported only on Linux.
+ *
+ * The debugging allocators use standard, not thread-local allocation.
+ *
+ * These routines normally require an explicit call to GC_init(), though
+ * that may be done from a constructor function.
+ */
+
+#ifndef GC_LOCAL_ALLOC_H
+#define GC_LOCAL_ALLOC_H
+
+#ifndef _GC_H
+# include "gc.h"
+#endif
+
+#if defined(GC_GCJ_SUPPORT) && !defined(GC_GCJ_H)
+# include "gc_gcj.h"
+#endif
+
+/* We assume ANSI C for this interface. */
+
+GC_PTR GC_local_malloc(size_t bytes);
+
+GC_PTR GC_local_malloc_atomic(size_t bytes);
+
+#if defined(GC_GCJ_SUPPORT)
+ GC_PTR GC_local_gcj_malloc(size_t bytes,
+ void * ptr_to_struct_containing_descr);
+#endif
+
+# ifdef GC_DEBUG
+# define GC_LOCAL_MALLOC(s) GC_debug_malloc(s,GC_EXTRAS)
+# define GC_LOCAL_MALLOC_ATOMIC(s) GC_debug_malloc_atomic(s,GC_EXTRAS)
+# ifdef GC_GCJ_SUPPORT
+# define GC_LOCAL_GCJ_MALLOC(s,d) GC_debug_gcj_malloc(s,d,GC_EXTRAS)
+# endif
+# else
+# define GC_LOCAL_MALLOC(s) GC_local_malloc(s)
+# define GC_LOCAL_MALLOC_ATOMIC(s) GC_local_malloc_atomic(s)
+# ifdef GC_GCJ_SUPPORT
+# define GC_LOCAL_GCJ_MALLOC(s,d) GC_local_gcj_malloc(s,d)
+# endif
+# endif
+
+# ifdef GC_REDIRECT_TO_LOCAL
+# undef GC_MALLOC
+# define GC_MALLOC(s) GC_LOCAL_MALLOC(s)
+# undef GC_MALLOC_ATOMIC
+# define GC_MALLOC_ATOMIC(s) GC_LOCAL_MALLOC_ATOMIC(s)
+# ifdef GC_GCJ_SUPPORT
+# undef GC_GCJ_MALLOC
+# define GC_GCJ_MALLOC(s,d) GC_LOCAL_GCJ_MALLOC(s,d)
+# endif
+# endif
+
+#endif /* GC_LOCAL_ALLOC_H */
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 2001 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+
+/*
+ * This contains interfaces to the GC marker that are likely to be useful to
+ * clients that provide detailed heap layout information to the collector.
+ * This interface should not be used by normal C or C++ clients.
+ * It will be useful to runtimes for other languages.
+ *
+ * Note that this file is not "namespace-clean", i.e. it introduces names
+ * not prefixed with GC_, which may collide with the client's names. It
+ * should be included only in those few places that directly provide
+ * information to the collector.
+ */
+#ifndef GC_MARK_H
+# define GC_MARK_H
+
+# ifndef GC_H
+# include "gc.h"
+# endif
+
+/* A client supplied mark procedure. Returns new mark stack pointer. */
+/* Primary effect should be to push new entries on the mark stack. */
+/* Mark stack pointer values are passed and returned explicitly. */
+/* Global variables decribing mark stack are not necessarily valid. */
+/* (This usually saves a few cycles by keeping things in registers.) */
+/* Assumed to scan about GC_PROC_BYTES on average. If it needs to do */
+/* much more work than that, it should do it in smaller pieces by */
+/* pushing itself back on the mark stack. */
+/* Note that it should always do some work (defined as marking some */
+/* objects) before pushing more than one entry on the mark stack. */
+/* This is required to ensure termination in the event of mark stack */
+/* overflows. */
+/* This procedure is always called with at least one empty entry on the */
+/* mark stack. */
+/* Currently we require that mark procedures look for pointers in a */
+/* subset of the places the conservative marker would. It must be safe */
+/* to invoke the normal mark procedure instead. */
+/* WARNING: Such a mark procedure may be invoked on an unused object */
+/* residing on a free list. Such objects are cleared, except for a */
+/* free list link field in the first word. Thus mark procedures may */
+/* not count on the presence of a type descriptor, and must handle this */
+/* case correctly somehow. */
+# define GC_PROC_BYTES 100
+struct GC_ms_entry;
+typedef struct GC_ms_entry * (*GC_mark_proc) GC_PROTO((
+ GC_word * addr, struct GC_ms_entry * mark_stack_ptr,
+ struct GC_ms_entry * mark_stack_limit, GC_word env));
+
+# define GC_LOG_MAX_MARK_PROCS 6
+# define GC_MAX_MARK_PROCS (1 << GC_LOG_MAX_MARK_PROCS)
+
+/* In a few cases it's necessary to assign statically known indices to */
+/* certain mark procs. Thus we reserve a few for well known clients. */
+/* (This is necessary if mark descriptors are compiler generated.) */
+#define GC_RESERVED_MARK_PROCS 8
+# define GC_GCJ_RESERVED_MARK_PROC_INDEX 0
+
+/* Object descriptors on mark stack or in objects. Low order two */
+/* bits are tags distinguishing among the following 4 possibilities */
+/* for the high order 30 bits. */
+#define GC_DS_TAG_BITS 2
+#define GC_DS_TAGS ((1 << GC_DS_TAG_BITS) - 1)
+#define GC_DS_LENGTH 0 /* The entire word is a length in bytes that */
+ /* must be a multiple of 4. */
+#define GC_DS_BITMAP 1 /* 30 (62) bits are a bitmap describing pointer */
+ /* fields. The msb is 1 iff the first word */
+ /* is a pointer. */
+ /* (This unconventional ordering sometimes */
+ /* makes the marker slightly faster.) */
+ /* Zeroes indicate definite nonpointers. Ones */
+ /* indicate possible pointers. */
+ /* Only usable if pointers are word aligned. */
+#define GC_DS_PROC 2
+ /* The objects referenced by this object can be */
+ /* pushed on the mark stack by invoking */
+ /* PROC(descr). ENV(descr) is passed as the */
+ /* last argument. */
+# define GC_MAKE_PROC(proc_index, env) \
+ (((((env) << GC_LOG_MAX_MARK_PROCS) \
+ | (proc_index)) << GC_DS_TAG_BITS) | GC_DS_PROC)
+#define GC_DS_PER_OBJECT 3 /* The real descriptor is at the */
+ /* byte displacement from the beginning of the */
+ /* object given by descr & ~DS_TAGS */
+ /* If the descriptor is negative, the real */
+ /* descriptor is at (*<object_start>) - */
+ /* (descr & ~DS_TAGS) - GC_INDIR_PER_OBJ_BIAS */
+ /* The latter alternative can be used if each */
+ /* object contains a type descriptor in the */
+ /* first word. */
+ /* Note that in multithreaded environments */
+ /* per object descriptors maust be located in */
+ /* either the first two or last two words of */
+ /* the object, since only those are guaranteed */
+ /* to be cleared while the allocation lock is */
+ /* held. */
+#define GC_INDIR_PER_OBJ_BIAS 0x10
+
+extern GC_PTR GC_least_plausible_heap_addr;
+extern GC_PTR GC_greatest_plausible_heap_addr;
+ /* Bounds on the heap. Guaranteed valid */
+ /* Likely to include future heap expansion. */
+
+/* Handle nested references in a custom mark procedure. */
+/* Check if obj is a valid object. If so, ensure that it is marked. */
+/* If it was not previously marked, push its contents onto the mark */
+/* stack for future scanning. The object will then be scanned using */
+/* its mark descriptor. */
+/* Returns the new mark stack pointer. */
+/* Handles mark stack overflows correctly. */
+/* Since this marks first, it makes progress even if there are mark */
+/* stack overflows. */
+/* Src is the address of the pointer to obj, which is used only */
+/* for back pointer-based heap debugging. */
+/* It is strongly recommended that most objects be handled without mark */
+/* procedures, e.g. with bitmap descriptors, and that mark procedures */
+/* be reserved for exceptional cases. That will ensure that */
+/* performance of this call is not extremely performance critical. */
+/* (Otherwise we would need to inline GC_mark_and_push completely, */
+/* which would tie the client code to a fixed collector version.) */
+/* Note that mark procedures should explicitly call FIXUP_POINTER() */
+/* if required. */
+struct GC_ms_entry *GC_mark_and_push
+ GC_PROTO((GC_PTR obj,
+ struct GC_ms_entry * mark_stack_ptr,
+ struct GC_ms_entry * mark_stack_limit, GC_PTR *src));
+
+#define GC_MARK_AND_PUSH(obj, msp, lim, src) \
+ (((GC_word)obj >= (GC_word)GC_least_plausible_heap_addr && \
+ (GC_word)obj <= (GC_word)GC_greatest_plausible_heap_addr)? \
+ GC_mark_and_push(obj, msp, lim, src) : \
+ msp)
+
+#endif /* GC_MARK_H */
+
--- /dev/null
+/* Our pthread support normally needs to intercept a number of thread */
+/* calls. We arrange to do that here, if appropriate. */
+
+#ifndef GC_PTHREAD_REDIRECTS_H
+
+#define GC_PTHREAD_REDIRECTS_H
+
+#if defined(GC_SOLARIS_THREADS)
+/* We need to intercept calls to many of the threads primitives, so */
+/* that we can locate thread stacks and stop the world. */
+/* Note also that the collector cannot see thread specific data. */
+/* Thread specific data should generally consist of pointers to */
+/* uncollectable objects (allocated with GC_malloc_uncollectable, */
+/* not the system malloc), which are deallocated using the destructor */
+/* facility in thr_keycreate. Alternatively, keep a redundant pointer */
+/* to thread specific data on the thread stack. */
+# include <thread.h>
+ int GC_thr_create(void *stack_base, size_t stack_size,
+ void *(*start_routine)(void *), void *arg, long flags,
+ thread_t *new_thread);
+ int GC_thr_join(thread_t wait_for, thread_t *departed, void **status);
+ int GC_thr_suspend(thread_t target_thread);
+ int GC_thr_continue(thread_t target_thread);
+ void * GC_dlopen(const char *path, int mode);
+# define thr_create GC_thr_create
+# define thr_join GC_thr_join
+# define thr_suspend GC_thr_suspend
+# define thr_continue GC_thr_continue
+#endif /* GC_SOLARIS_THREADS */
+
+#if defined(GC_SOLARIS_PTHREADS)
+# include <pthread.h>
+# include <signal.h>
+ extern int GC_pthread_create(pthread_t *new_thread,
+ const pthread_attr_t *attr,
+ void * (*thread_execp)(void *), void *arg);
+ extern int GC_pthread_join(pthread_t wait_for, void **status);
+# define pthread_join GC_pthread_join
+# define pthread_create GC_pthread_create
+#endif
+
+#if defined(GC_SOLARIS_PTHREADS) || defined(GC_SOLARIS_THREADS)
+# define dlopen GC_dlopen
+#endif /* SOLARIS_THREADS || SOLARIS_PTHREADS */
+
+
+#if !defined(GC_USE_LD_WRAP) && defined(GC_PTHREADS) && !defined(GC_SOLARIS_PTHREADS)
+/* We treat these similarly. */
+# include <pthread.h>
+# include <signal.h>
+
+ int GC_pthread_create(pthread_t *new_thread,
+ const pthread_attr_t *attr,
+ void *(*start_routine)(void *), void *arg);
+ int GC_pthread_sigmask(int how, const sigset_t *set, sigset_t *oset);
+ int GC_pthread_join(pthread_t thread, void **retval);
+ int GC_pthread_detach(pthread_t thread);
+
+# define pthread_create GC_pthread_create
+# define pthread_sigmask GC_pthread_sigmask
+# define pthread_join GC_pthread_join
+# define pthread_detach GC_pthread_detach
+# define dlopen GC_dlopen
+
+#endif /* GC_xxxxx_THREADS */
+
+#endif /* GC_PTHREAD_REDIRECTS_H */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright 1996 Silicon Graphics. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Some simple primitives for allocation with explicit type information.
+ * Facilities for dynamic type inference may be added later.
+ * Should be used only for extremely performance critical applications,
+ * or if conservative collector leakage is otherwise a problem (unlikely).
+ * Note that this is implemented completely separately from the rest
+ * of the collector, and is not linked in unless referenced.
+ * This does not currently support GC_DEBUG in any interesting way.
+ */
+/* Boehm, May 19, 1994 2:13 pm PDT */
+
+#ifndef _GC_TYPED_H
+# define _GC_TYPED_H
+# ifndef _GC_H
+# include "gc.h"
+# endif
+
+#ifdef __cplusplus
+ extern "C" {
+#endif
+typedef GC_word * GC_bitmap;
+ /* The least significant bit of the first word is one if */
+ /* the first word in the object may be a pointer. */
+
+# define GC_WORDSZ (8*sizeof(GC_word))
+# define GC_get_bit(bm, index) \
+ (((bm)[index/GC_WORDSZ] >> (index%GC_WORDSZ)) & 1)
+# define GC_set_bit(bm, index) \
+ (bm)[index/GC_WORDSZ] |= ((GC_word)1 << (index%GC_WORDSZ))
+# define GC_WORD_OFFSET(t, f) (offsetof(t,f)/sizeof(GC_word))
+# define GC_WORD_LEN(t) (sizeof(t)/ sizeof(GC_word))
+# define GC_BITMAP_SIZE(t) ((GC_WORD_LEN(t) + GC_WORDSZ-1)/GC_WORDSZ)
+
+typedef GC_word GC_descr;
+
+GC_API GC_descr GC_make_descriptor GC_PROTO((GC_bitmap bm, size_t len));
+ /* Return a type descriptor for the object whose layout */
+ /* is described by the argument. */
+ /* The least significant bit of the first word is one */
+ /* if the first word in the object may be a pointer. */
+ /* The second argument specifies the number of */
+ /* meaningful bits in the bitmap. The actual object */
+ /* may be larger (but not smaller). Any additional */
+ /* words in the object are assumed not to contain */
+ /* pointers. */
+ /* Returns a conservative approximation in the */
+ /* (unlikely) case of insufficient memory to build */
+ /* the descriptor. Calls to GC_make_descriptor */
+ /* may consume some amount of a finite resource. This */
+ /* is intended to be called once per type, not once */
+ /* per allocation. */
+
+/* It is possible to generate a descriptor for a C type T with */
+/* word aligned pointer fields f1, f2, ... as follows: */
+/* */
+/* GC_descr T_descr;
+/* GC_word T_bitmap[GC_BITMAP_SIZE(T)] = {0}; */
+/* GC_set_bit(T_bitmap, GC_WORD_OFFSET(T,f1)); */
+/* GC_set_bit(T_bitmap, GC_WORD_OFFSET(T,f2)); */
+/* ... */
+/* T_descr = GC_make_descriptor(T_bitmap, GC_WORD_LEN(T)); */
+
+GC_API GC_PTR GC_malloc_explicitly_typed
+ GC_PROTO((size_t size_in_bytes, GC_descr d));
+ /* Allocate an object whose layout is described by d. */
+ /* The resulting object MAY NOT BE PASSED TO REALLOC. */
+ /* The returned object is cleared. */
+
+GC_API GC_PTR GC_malloc_explicitly_typed_ignore_off_page
+ GC_PROTO((size_t size_in_bytes, GC_descr d));
+
+GC_API GC_PTR GC_calloc_explicitly_typed
+ GC_PROTO((size_t nelements,
+ size_t element_size_in_bytes,
+ GC_descr d));
+ /* Allocate an array of nelements elements, each of the */
+ /* given size, and with the given descriptor. */
+ /* The elemnt size must be a multiple of the byte */
+ /* alignment required for pointers. E.g. on a 32-bit */
+ /* machine with 16-bit aligned pointers, size_in_bytes */
+ /* must be a multiple of 2. */
+ /* Returned object is cleared. */
+
+#ifdef GC_DEBUG
+# define GC_MALLOC_EXPLICITLY_TYPED(bytes, d) GC_MALLOC(bytes)
+# define GC_CALLOC_EXPLICITLY_TYPED(n, bytes, d) GC_MALLOC(n*bytes)
+#else
+# define GC_MALLOC_EXPLICITLY_TYPED(bytes, d) \
+ GC_malloc_explicitly_typed(bytes, d)
+# define GC_CALLOC_EXPLICITLY_TYPED(n, bytes, d) \
+ GC_calloc_explicitly_typed(n, bytes, d)
+#endif /* !GC_DEBUG */
+
+#ifdef __cplusplus
+ } /* matches extern "C" */
+#endif
+
+#endif /* _GC_TYPED_H */
+
--- /dev/null
+# ifndef GC_H
+# include "gc.h"
+# endif
+
+/*
+ * Invoke all remaining finalizers that haven't yet been run.
+ * This is needed for strict compliance with the Java standard,
+ * which can make the runtime guarantee that all finalizers are run.
+ * This is problematic for several reasons:
+ * 1) It means that finalizers, and all methods calle by them,
+ * must be prepared to deal with objects that have been finalized in
+ * spite of the fact that they are still referenced by statically
+ * allocated pointer variables.
+ * 1) It may mean that we get stuck in an infinite loop running
+ * finalizers which create new finalizable objects, though that's
+ * probably unlikely.
+ * Thus this is not recommended for general use.
+ */
+void GC_finalize_all();
+
+/*
+ * A version of GC_register_finalizer that allows the object to be
+ * finalized before the objects it references. This is again error
+ * prone, in that it makes it easy to accidentally reference finalized
+ * objects. Again, recommended only for JVM implementors.
+ */
+void GC_register_finalizer_no_order(GC_PTR obj,
+ GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR * ocd);
+
+void GC_debug_register_finalizer_no_order(GC_PTR obj,
+ GC_finalization_proc fn, GC_PTR cd,
+ GC_finalization_proc *ofn, GC_PTR * ocd);
+
+#ifdef GC_DEBUG
+# define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+ GC_debug_register_finalizer_no_order(p, f, d, of, od)
+#else
+# define GC_REGISTER_FINALIZER(p, f, d, of, od) \
+ GC_register_finalizer_no_order(p, f, d, of, od)
+#endif
--- /dev/null
+#define GC_DEBUG
+#include "gc.h"
+#define malloc(n) GC_MALLOC(n)
+#define calloc(m,n) GC_MALLOC((m)*(n))
+#define free(p) GC_FREE(p)
+#define realloc(p,n) GC_REALLOC((p),(n))
+#define CHECK_LEAKS() GC_gcollect()
--- /dev/null
+/*
+ * Copyright (c) 1996-1998 by Silicon Graphics. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+//
+// This is a revision of gc_alloc.h for SGI STL versions > 3.0
+// Unlike earlier versions, it supplements the standard "alloc.h"
+// instead of replacing it.
+//
+// This is sloppy about variable names used in header files.
+// It also doesn't yet understand the new header file names or
+// namespaces.
+//
+// This assumes the collector has been compiled with -DATOMIC_UNCOLLECTABLE.
+// The user should also consider -DREDIRECT_MALLOC=GC_uncollectable_malloc,
+// to ensure that object allocated through malloc are traced.
+//
+// Some of this could be faster in the explicit deallocation case.
+// In particular, we spend too much time clearing objects on the
+// free lists. That could be avoided.
+//
+// This uses template classes with static members, and hence does not work
+// with g++ 2.7.2 and earlier.
+//
+// Unlike its predecessor, this one simply defines
+// gc_alloc
+// single_client_gc_alloc
+// traceable_alloc
+// single_client_traceable_alloc
+//
+// It does not redefine alloc. Nor does it change the default allocator,
+// though the user may wish to do so. (The argument against changing
+// the default allocator is that it may introduce subtle link compatibility
+// problems. The argument for changing it is that the usual default
+// allocator is usually a very bad choice for a garbage collected environment.)
+//
+// This code assumes that the collector itself has been compiled with a
+// compiler that defines __STDC__ .
+//
+
+#ifndef GC_ALLOC_H
+
+#include "gc.h"
+
+#if (__GNUC__ < 3)
+# include <stack> // A more portable way to get stl_alloc.h .
+#else
+# include <bits/stl_alloc.h>
+# ifndef __STL_BEGIN_NAMESPACE
+# define __STL_BEGIN_NAMESPACE namespace std {
+# define __STL_END_NAMESPACE };
+# endif
+#ifndef __STL_USE_STD_ALLOCATORS
+#define __STL_USE_STD_ALLOCATORS
+#endif
+#endif
+
+/* A hack to deal with gcc 3.1. If you are using gcc3.1 and later, */
+/* you should probably really use gc_allocator.h instead. */
+#if defined (__GNUC__) && \
+ (__GNUC > 3 || (__GNUC__ == 3 && (__GNUC_MINOR__ >= 1)))
+# define simple_alloc __simple_alloc
+#endif
+
+
+
+#define GC_ALLOC_H
+
+#include <stddef.h>
+#include <string.h>
+
+// The following need to match collector data structures.
+// We can't include gc_priv.h, since that pulls in way too much stuff.
+// This should eventually be factored out into another include file.
+
+extern "C" {
+ extern void ** const GC_objfreelist_ptr;
+ extern void ** const GC_aobjfreelist_ptr;
+ extern void ** const GC_uobjfreelist_ptr;
+ extern void ** const GC_auobjfreelist_ptr;
+
+ extern void GC_incr_words_allocd(size_t words);
+ extern void GC_incr_mem_freed(size_t words);
+
+ extern char * GC_generic_malloc_words_small(size_t word, int kind);
+}
+
+// Object kinds; must match PTRFREE, NORMAL, UNCOLLECTABLE, and
+// AUNCOLLECTABLE in gc_priv.h.
+
+enum { GC_PTRFREE = 0, GC_NORMAL = 1, GC_UNCOLLECTABLE = 2,
+ GC_AUNCOLLECTABLE = 3 };
+
+enum { GC_max_fast_bytes = 255 };
+
+enum { GC_bytes_per_word = sizeof(char *) };
+
+enum { GC_byte_alignment = 8 };
+
+enum { GC_word_alignment = GC_byte_alignment/GC_bytes_per_word };
+
+inline void * &GC_obj_link(void * p)
+{ return *(void **)p; }
+
+// Compute a number of words >= n+1 bytes.
+// The +1 allows for pointers one past the end.
+inline size_t GC_round_up(size_t n)
+{
+ return ((n + GC_byte_alignment)/GC_byte_alignment)*GC_word_alignment;
+}
+
+// The same but don't allow for extra byte.
+inline size_t GC_round_up_uncollectable(size_t n)
+{
+ return ((n + GC_byte_alignment - 1)/GC_byte_alignment)*GC_word_alignment;
+}
+
+template <int dummy>
+class GC_aux_template {
+public:
+ // File local count of allocated words. Occasionally this is
+ // added into the global count. A separate count is necessary since the
+ // real one must be updated with a procedure call.
+ static size_t GC_words_recently_allocd;
+
+ // Same for uncollectable mmory. Not yet reflected in either
+ // GC_words_recently_allocd or GC_non_gc_bytes.
+ static size_t GC_uncollectable_words_recently_allocd;
+
+ // Similar counter for explicitly deallocated memory.
+ static size_t GC_mem_recently_freed;
+
+ // Again for uncollectable memory.
+ static size_t GC_uncollectable_mem_recently_freed;
+
+ static void * GC_out_of_line_malloc(size_t nwords, int kind);
+};
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_words_recently_allocd = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_mem_recently_freed = 0;
+
+template <int dummy>
+size_t GC_aux_template<dummy>::GC_uncollectable_mem_recently_freed = 0;
+
+template <int dummy>
+void * GC_aux_template<dummy>::GC_out_of_line_malloc(size_t nwords, int kind)
+{
+ GC_words_recently_allocd += GC_uncollectable_words_recently_allocd;
+ GC_non_gc_bytes +=
+ GC_bytes_per_word * GC_uncollectable_words_recently_allocd;
+ GC_uncollectable_words_recently_allocd = 0;
+
+ GC_mem_recently_freed += GC_uncollectable_mem_recently_freed;
+ GC_non_gc_bytes -=
+ GC_bytes_per_word * GC_uncollectable_mem_recently_freed;
+ GC_uncollectable_mem_recently_freed = 0;
+
+ GC_incr_words_allocd(GC_words_recently_allocd);
+ GC_words_recently_allocd = 0;
+
+ GC_incr_mem_freed(GC_mem_recently_freed);
+ GC_mem_recently_freed = 0;
+
+ return GC_generic_malloc_words_small(nwords, kind);
+}
+
+typedef GC_aux_template<0> GC_aux;
+
+// A fast, single-threaded, garbage-collected allocator
+// We assume the first word will be immediately overwritten.
+// In this version, deallocation is not a noop, and explicit
+// deallocation is likely to help performance.
+template <int dummy>
+class single_client_gc_alloc_template {
+ public:
+ static void * allocate(size_t n)
+ {
+ size_t nwords = GC_round_up(n);
+ void ** flh;
+ void * op;
+
+ if (n > GC_max_fast_bytes) return GC_malloc(n);
+ flh = GC_objfreelist_ptr + nwords;
+ if (0 == (op = *flh)) {
+ return GC_aux::GC_out_of_line_malloc(nwords, GC_NORMAL);
+ }
+ *flh = GC_obj_link(op);
+ GC_aux::GC_words_recently_allocd += nwords;
+ return op;
+ }
+ static void * ptr_free_allocate(size_t n)
+ {
+ size_t nwords = GC_round_up(n);
+ void ** flh;
+ void * op;
+
+ if (n > GC_max_fast_bytes) return GC_malloc_atomic(n);
+ flh = GC_aobjfreelist_ptr + nwords;
+ if (0 == (op = *flh)) {
+ return GC_aux::GC_out_of_line_malloc(nwords, GC_PTRFREE);
+ }
+ *flh = GC_obj_link(op);
+ GC_aux::GC_words_recently_allocd += nwords;
+ return op;
+ }
+ static void deallocate(void *p, size_t n)
+ {
+ size_t nwords = GC_round_up(n);
+ void ** flh;
+
+ if (n > GC_max_fast_bytes) {
+ GC_free(p);
+ } else {
+ flh = GC_objfreelist_ptr + nwords;
+ GC_obj_link(p) = *flh;
+ memset((char *)p + GC_bytes_per_word, 0,
+ GC_bytes_per_word * (nwords - 1));
+ *flh = p;
+ GC_aux::GC_mem_recently_freed += nwords;
+ }
+ }
+ static void ptr_free_deallocate(void *p, size_t n)
+ {
+ size_t nwords = GC_round_up(n);
+ void ** flh;
+
+ if (n > GC_max_fast_bytes) {
+ GC_free(p);
+ } else {
+ flh = GC_aobjfreelist_ptr + nwords;
+ GC_obj_link(p) = *flh;
+ *flh = p;
+ GC_aux::GC_mem_recently_freed += nwords;
+ }
+ }
+};
+
+typedef single_client_gc_alloc_template<0> single_client_gc_alloc;
+
+// Once more, for uncollectable objects.
+template <int dummy>
+class single_client_traceable_alloc_template {
+ public:
+ static void * allocate(size_t n)
+ {
+ size_t nwords = GC_round_up_uncollectable(n);
+ void ** flh;
+ void * op;
+
+ if (n > GC_max_fast_bytes) return GC_malloc_uncollectable(n);
+ flh = GC_uobjfreelist_ptr + nwords;
+ if (0 == (op = *flh)) {
+ return GC_aux::GC_out_of_line_malloc(nwords, GC_UNCOLLECTABLE);
+ }
+ *flh = GC_obj_link(op);
+ GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+ return op;
+ }
+ static void * ptr_free_allocate(size_t n)
+ {
+ size_t nwords = GC_round_up_uncollectable(n);
+ void ** flh;
+ void * op;
+
+ if (n > GC_max_fast_bytes) return GC_malloc_atomic_uncollectable(n);
+ flh = GC_auobjfreelist_ptr + nwords;
+ if (0 == (op = *flh)) {
+ return GC_aux::GC_out_of_line_malloc(nwords, GC_AUNCOLLECTABLE);
+ }
+ *flh = GC_obj_link(op);
+ GC_aux::GC_uncollectable_words_recently_allocd += nwords;
+ return op;
+ }
+ static void deallocate(void *p, size_t n)
+ {
+ size_t nwords = GC_round_up_uncollectable(n);
+ void ** flh;
+
+ if (n > GC_max_fast_bytes) {
+ GC_free(p);
+ } else {
+ flh = GC_uobjfreelist_ptr + nwords;
+ GC_obj_link(p) = *flh;
+ *flh = p;
+ GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+ }
+ }
+ static void ptr_free_deallocate(void *p, size_t n)
+ {
+ size_t nwords = GC_round_up_uncollectable(n);
+ void ** flh;
+
+ if (n > GC_max_fast_bytes) {
+ GC_free(p);
+ } else {
+ flh = GC_auobjfreelist_ptr + nwords;
+ GC_obj_link(p) = *flh;
+ *flh = p;
+ GC_aux::GC_uncollectable_mem_recently_freed += nwords;
+ }
+ }
+};
+
+typedef single_client_traceable_alloc_template<0> single_client_traceable_alloc;
+
+template < int dummy >
+class gc_alloc_template {
+ public:
+ static void * allocate(size_t n) { return GC_malloc(n); }
+ static void * ptr_free_allocate(size_t n)
+ { return GC_malloc_atomic(n); }
+ static void deallocate(void *, size_t) { }
+ static void ptr_free_deallocate(void *, size_t) { }
+};
+
+typedef gc_alloc_template < 0 > gc_alloc;
+
+template < int dummy >
+class traceable_alloc_template {
+ public:
+ static void * allocate(size_t n) { return GC_malloc_uncollectable(n); }
+ static void * ptr_free_allocate(size_t n)
+ { return GC_malloc_atomic_uncollectable(n); }
+ static void deallocate(void *p, size_t) { GC_free(p); }
+ static void ptr_free_deallocate(void *p, size_t) { GC_free(p); }
+};
+
+typedef traceable_alloc_template < 0 > traceable_alloc;
+
+// We want to specialize simple_alloc so that it does the right thing
+// for all pointerfree types. At the moment there is no portable way to
+// even approximate that. The following approximation should work for
+// SGI compilers, and recent versions of g++.
+
+# define __GC_SPECIALIZE(T,alloc) \
+class simple_alloc<T, alloc> { \
+public: \
+ static T *allocate(size_t n) \
+ { return 0 == n? 0 : \
+ (T*) alloc::ptr_free_allocate(n * sizeof (T)); } \
+ static T *allocate(void) \
+ { return (T*) alloc::ptr_free_allocate(sizeof (T)); } \
+ static void deallocate(T *p, size_t n) \
+ { if (0 != n) alloc::ptr_free_deallocate(p, n * sizeof (T)); } \
+ static void deallocate(T *p) \
+ { alloc::ptr_free_deallocate(p, sizeof (T)); } \
+};
+
+__STL_BEGIN_NAMESPACE
+
+__GC_SPECIALIZE(char, gc_alloc)
+__GC_SPECIALIZE(int, gc_alloc)
+__GC_SPECIALIZE(unsigned, gc_alloc)
+__GC_SPECIALIZE(float, gc_alloc)
+__GC_SPECIALIZE(double, gc_alloc)
+
+__GC_SPECIALIZE(char, traceable_alloc)
+__GC_SPECIALIZE(int, traceable_alloc)
+__GC_SPECIALIZE(unsigned, traceable_alloc)
+__GC_SPECIALIZE(float, traceable_alloc)
+__GC_SPECIALIZE(double, traceable_alloc)
+
+__GC_SPECIALIZE(char, single_client_gc_alloc)
+__GC_SPECIALIZE(int, single_client_gc_alloc)
+__GC_SPECIALIZE(unsigned, single_client_gc_alloc)
+__GC_SPECIALIZE(float, single_client_gc_alloc)
+__GC_SPECIALIZE(double, single_client_gc_alloc)
+
+__GC_SPECIALIZE(char, single_client_traceable_alloc)
+__GC_SPECIALIZE(int, single_client_traceable_alloc)
+__GC_SPECIALIZE(unsigned, single_client_traceable_alloc)
+__GC_SPECIALIZE(float, single_client_traceable_alloc)
+__GC_SPECIALIZE(double, single_client_traceable_alloc)
+
+__STL_END_NAMESPACE
+
+#ifdef __STL_USE_STD_ALLOCATORS
+
+__STL_BEGIN_NAMESPACE
+
+template <class _T>
+struct _Alloc_traits<_T, gc_alloc >
+{
+ static const bool _S_instanceless = true;
+ typedef simple_alloc<_T, gc_alloc > _Alloc_type;
+ typedef __allocator<_T, gc_alloc > allocator_type;
+};
+
+inline bool operator==(const gc_alloc&,
+ const gc_alloc&)
+{
+ return true;
+}
+
+inline bool operator!=(const gc_alloc&,
+ const gc_alloc&)
+{
+ return false;
+}
+
+template <class _T>
+struct _Alloc_traits<_T, single_client_gc_alloc >
+{
+ static const bool _S_instanceless = true;
+ typedef simple_alloc<_T, single_client_gc_alloc > _Alloc_type;
+ typedef __allocator<_T, single_client_gc_alloc > allocator_type;
+};
+
+inline bool operator==(const single_client_gc_alloc&,
+ const single_client_gc_alloc&)
+{
+ return true;
+}
+
+inline bool operator!=(const single_client_gc_alloc&,
+ const single_client_gc_alloc&)
+{
+ return false;
+}
+
+template <class _T>
+struct _Alloc_traits<_T, traceable_alloc >
+{
+ static const bool _S_instanceless = true;
+ typedef simple_alloc<_T, traceable_alloc > _Alloc_type;
+ typedef __allocator<_T, traceable_alloc > allocator_type;
+};
+
+inline bool operator==(const traceable_alloc&,
+ const traceable_alloc&)
+{
+ return true;
+}
+
+inline bool operator!=(const traceable_alloc&,
+ const traceable_alloc&)
+{
+ return false;
+}
+
+template <class _T>
+struct _Alloc_traits<_T, single_client_traceable_alloc >
+{
+ static const bool _S_instanceless = true;
+ typedef simple_alloc<_T, single_client_traceable_alloc > _Alloc_type;
+ typedef __allocator<_T, single_client_traceable_alloc > allocator_type;
+};
+
+inline bool operator==(const single_client_traceable_alloc&,
+ const single_client_traceable_alloc&)
+{
+ return true;
+}
+
+inline bool operator!=(const single_client_traceable_alloc&,
+ const single_client_traceable_alloc&)
+{
+ return false;
+}
+
+__STL_END_NAMESPACE
+
+#endif /* __STL_USE_STD_ALLOCATORS */
+
+#endif /* GC_ALLOC_H */
--- /dev/null
+/*
+ * Copyright (c) 1993-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, May 19, 1994 2:23 pm PDT */
+# ifndef CORD_POSITION_H
+
+/* The representation of CORD_position. This is private to the */
+/* implementation, but the size is known to clients. Also */
+/* the implementation of some exported macros relies on it. */
+/* Don't use anything defined here and not in cord.h. */
+
+# define MAX_DEPTH 48
+ /* The maximum depth of a balanced cord + 1. */
+ /* We don't let cords get deeper than MAX_DEPTH. */
+
+struct CORD_pe {
+ CORD pe_cord;
+ size_t pe_start_pos;
+};
+
+/* A structure describing an entry on the path from the root */
+/* to current position. */
+typedef struct CORD_Pos {
+ size_t cur_pos;
+ int path_len;
+# define CORD_POS_INVALID (0x55555555)
+ /* path_len == INVALID <==> position invalid */
+ const char *cur_leaf; /* Current leaf, if it is a string. */
+ /* If the current leaf is a function, */
+ /* then this may point to function_buf */
+ /* containing the next few characters. */
+ /* Always points to a valid string */
+ /* containing the current character */
+ /* unless cur_end is 0. */
+ size_t cur_start; /* Start position of cur_leaf */
+ size_t cur_end; /* Ending position of cur_leaf */
+ /* 0 if cur_leaf is invalid. */
+ struct CORD_pe path[MAX_DEPTH + 1];
+ /* path[path_len] is the leaf corresponding to cur_pos */
+ /* path[0].pe_cord is the cord we point to. */
+# define FUNCTION_BUF_SZ 8
+ char function_buf[FUNCTION_BUF_SZ]; /* Space for next few chars */
+ /* from function node. */
+} CORD_pos[1];
+
+/* Extract the cord from a position: */
+CORD CORD_pos_to_cord(CORD_pos p);
+
+/* Extract the current index from a position: */
+size_t CORD_pos_to_index(CORD_pos p);
+
+/* Fetch the character located at the given position: */
+char CORD_pos_fetch(CORD_pos p);
+
+/* Initialize the position to refer to the give cord and index. */
+/* Note that this is the most expensive function on positions: */
+void CORD_set_pos(CORD_pos p, CORD x, size_t i);
+
+/* Advance the position to the next character. */
+/* P must be initialized and valid. */
+/* Invalidates p if past end: */
+void CORD_next(CORD_pos p);
+
+/* Move the position to the preceding character. */
+/* P must be initialized and valid. */
+/* Invalidates p if past beginning: */
+void CORD_prev(CORD_pos p);
+
+/* Is the position valid, i.e. inside the cord? */
+int CORD_pos_valid(CORD_pos p);
+
+char CORD__pos_fetch(CORD_pos);
+void CORD__next(CORD_pos);
+void CORD__prev(CORD_pos);
+
+#define CORD_pos_fetch(p) \
+ (((p)[0].cur_end != 0)? \
+ (p)[0].cur_leaf[(p)[0].cur_pos - (p)[0].cur_start] \
+ : CORD__pos_fetch(p))
+
+#define CORD_next(p) \
+ (((p)[0].cur_pos + 1 < (p)[0].cur_end)? \
+ (p)[0].cur_pos++ \
+ : (CORD__next(p), 0))
+
+#define CORD_prev(p) \
+ (((p)[0].cur_end != 0 && (p)[0].cur_pos > (p)[0].cur_start)? \
+ (p)[0].cur_pos-- \
+ : (CORD__prev(p), 0))
+
+#define CORD_pos_to_index(p) ((p)[0].cur_pos)
+
+#define CORD_pos_to_cord(p) ((p)[0].path[0].pe_cord)
+
+#define CORD_pos_valid(p) ((p)[0].path_len != CORD_POS_INVALID)
+
+/* Some grubby stuff for performance-critical friends: */
+#define CORD_pos_chars_left(p) ((long)((p)[0].cur_end) - (long)((p)[0].cur_pos))
+ /* Number of characters in cache. <= 0 ==> none */
+
+#define CORD_pos_advance(p,n) ((p)[0].cur_pos += (n) - 1, CORD_next(p))
+ /* Advance position by n characters */
+ /* 0 < n < CORD_pos_chars_left(p) */
+
+#define CORD_pos_cur_char_addr(p) \
+ (p)[0].cur_leaf + ((p)[0].cur_pos - (p)[0].cur_start)
+ /* address of current character in cache. */
+
+#endif
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1997 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * This is mostly an internal header file. Typical clients should
+ * not use it. Clients that define their own object kinds with
+ * debugging allocators will probably want to include this, however.
+ * No attempt is made to keep the namespace clean. This should not be
+ * included from header files that are frequently included by clients.
+ */
+
+#ifndef _DBG_MLC_H
+
+#define _DBG_MLC_H
+
+# define I_HIDE_POINTERS
+# include "gc_priv.h"
+# ifdef KEEP_BACK_PTRS
+# include "gc_backptr.h"
+# endif
+
+#ifndef HIDE_POINTER
+ /* Gc.h was previously included, and hence the I_HIDE_POINTERS */
+ /* definition had no effect. Repeat the gc.h definitions here to */
+ /* get them anyway. */
+ typedef GC_word GC_hidden_pointer;
+# define HIDE_POINTER(p) (~(GC_hidden_pointer)(p))
+# define REVEAL_POINTER(p) ((GC_PTR)(HIDE_POINTER(p)))
+#endif /* HIDE_POINTER */
+
+# define START_FLAG ((word)0xfedcedcb)
+# define END_FLAG ((word)0xbcdecdef)
+ /* Stored both one past the end of user object, and one before */
+ /* the end of the object as seen by the allocator. */
+
+# if defined(KEEP_BACK_PTRS) || defined(PRINT_BLACK_LIST) \
+ || defined(MAKE_BACK_GRAPH)
+ /* Pointer "source"s that aren't real locations. */
+ /* Used in oh_back_ptr fields and as "source" */
+ /* argument to some marking functions. */
+# define NOT_MARKED (ptr_t)(0)
+# define MARKED_FOR_FINALIZATION (ptr_t)(2)
+ /* Object was marked because it is finalizable. */
+# define MARKED_FROM_REGISTER (ptr_t)(4)
+ /* Object was marked from a rgister. Hence the */
+ /* source of the reference doesn't have an address. */
+# endif /* KEEP_BACK_PTRS || PRINT_BLACK_LIST */
+
+/* Object header */
+typedef struct {
+# if defined(KEEP_BACK_PTRS) || defined(MAKE_BACK_GRAPH)
+ /* We potentially keep two different kinds of back */
+ /* pointers. KEEP_BACK_PTRS stores a single back */
+ /* pointer in each reachable object to allow reporting */
+ /* of why an object was retained. MAKE_BACK_GRAPH */
+ /* builds a graph containing the inverse of all */
+ /* "points-to" edges including those involving */
+ /* objects that have just become unreachable. This */
+ /* allows detection of growing chains of unreachable */
+ /* objects. It may be possible to eventually combine */
+ /* both, but for now we keep them separate. Both */
+ /* kinds of back pointers are hidden using the */
+ /* following macros. In both cases, the plain version */
+ /* is constrained to have an least significant bit of 1,*/
+ /* to allow it to be distinguished from a free list */
+ /* link. This means the plain version must have an */
+ /* lsb of 0. */
+ /* Note that blocks dropped by black-listing will */
+ /* also have the lsb clear once debugging has */
+ /* started. */
+ /* We're careful never to overwrite a value with lsb 0. */
+# if ALIGNMENT == 1
+ /* Fudge back pointer to be even. */
+# define HIDE_BACK_PTR(p) HIDE_POINTER(~1 & (GC_word)(p))
+# else
+# define HIDE_BACK_PTR(p) HIDE_POINTER(p)
+# endif
+
+# ifdef KEEP_BACK_PTRS
+ GC_hidden_pointer oh_back_ptr;
+# endif
+# ifdef MAKE_BACK_GRAPH
+ GC_hidden_pointer oh_bg_ptr;
+# endif
+# if defined(ALIGN_DOUBLE) && \
+ (defined(KEEP_BACK_PTRS) != defined(MAKE_BACK_GRAPH))
+ word oh_dummy;
+# endif
+# endif
+ GC_CONST char * oh_string; /* object descriptor string */
+ word oh_int; /* object descriptor integers */
+# ifdef NEED_CALLINFO
+ struct callinfo oh_ci[NFRAMES];
+# endif
+# ifndef SHORT_DBG_HDRS
+ word oh_sz; /* Original malloc arg. */
+ word oh_sf; /* start flag */
+# endif /* SHORT_DBG_HDRS */
+} oh;
+/* The size of the above structure is assumed not to dealign things, */
+/* and to be a multiple of the word length. */
+
+#ifdef SHORT_DBG_HDRS
+# define DEBUG_BYTES (sizeof (oh))
+# define UNCOLLECTABLE_DEBUG_BYTES DEBUG_BYTES
+#else
+ /* Add space for END_FLAG, but use any extra space that was already */
+ /* added to catch off-the-end pointers. */
+ /* For uncollectable objects, the extra byte is not added. */
+# define UNCOLLECTABLE_DEBUG_BYTES (sizeof (oh) + sizeof (word))
+# define DEBUG_BYTES (UNCOLLECTABLE_DEBUG_BYTES - EXTRA_BYTES)
+#endif
+#define USR_PTR_FROM_BASE(p) ((ptr_t)(p) + sizeof(oh))
+
+/* Round bytes to words without adding extra byte at end. */
+#define SIMPLE_ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1) - 1)
+
+/* ADD_CALL_CHAIN stores a (partial) call chain into an object */
+/* header. It may be called with or without the allocation */
+/* lock. */
+/* PRINT_CALL_CHAIN prints the call chain stored in an object */
+/* to stderr. It requires that we do not hold the lock. */
+#ifdef SAVE_CALL_CHAIN
+# define ADD_CALL_CHAIN(base, ra) GC_save_callers(((oh *)(base)) -> oh_ci)
+# define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
+#else
+# ifdef GC_ADD_CALLER
+# define ADD_CALL_CHAIN(base, ra) ((oh *)(base)) -> oh_ci[0].ci_pc = (ra)
+# define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
+# else
+# define ADD_CALL_CHAIN(base, ra)
+# define PRINT_CALL_CHAIN(base)
+# endif
+#endif
+
+# ifdef GC_ADD_CALLER
+# define OPT_RA ra,
+# else
+# define OPT_RA
+# endif
+
+
+/* Check whether object with base pointer p has debugging info */
+/* p is assumed to point to a legitimate object in our part */
+/* of the heap. */
+#ifdef SHORT_DBG_HDRS
+# define GC_has_other_debug_info(p) TRUE
+#else
+ GC_bool GC_has_other_debug_info(/* p */);
+#endif
+
+#if defined(KEEP_BACK_PTRS) || defined(MAKE_BACK_GRAPH)
+# define GC_HAS_DEBUG_INFO(p) \
+ ((*((word *)p) & 1) && GC_has_other_debug_info(p))
+#else
+# define GC_HAS_DEBUG_INFO(p) GC_has_other_debug_info(p)
+#endif
+
+/* Store debugging info into p. Return displaced pointer. */
+/* Assumes we don't hold allocation lock. */
+ptr_t GC_store_debug_info(/* p, sz, string, integer */);
+
+#endif /* _DBG_MLC_H */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, July 11, 1995 11:54 am PDT */
+# ifndef GC_HEADERS_H
+# define GC_HEADERS_H
+typedef struct hblkhdr hdr;
+
+# if CPP_WORDSZ != 32 && CPP_WORDSZ < 36
+ --> Get a real machine.
+# endif
+
+/*
+ * The 2 level tree data structure that is used to find block headers.
+ * If there are more than 32 bits in a pointer, the top level is a hash
+ * table.
+ *
+ * This defines HDR, GET_HDR, and SET_HDR, the main macros used to
+ * retrieve and set object headers.
+ *
+ * Since 5.0 alpha 5, we can also take advantage of a header lookup
+ * cache. This is a locally declared direct mapped cache, used inside
+ * the marker. The HC_GET_HDR macro uses and maintains this
+ * cache. Assuming we get reasonable hit rates, this shaves a few
+ * memory references from each pointer validation.
+ */
+
+# if CPP_WORDSZ > 32
+# define HASH_TL
+# endif
+
+/* Define appropriate out-degrees for each of the two tree levels */
+# ifdef SMALL_CONFIG
+# define LOG_BOTTOM_SZ 11
+ /* Keep top index size reasonable with smaller blocks. */
+# else
+# define LOG_BOTTOM_SZ 10
+# endif
+# ifndef HASH_TL
+# define LOG_TOP_SZ (WORDSZ - LOG_BOTTOM_SZ - LOG_HBLKSIZE)
+# else
+# define LOG_TOP_SZ 11
+# endif
+# define TOP_SZ (1 << LOG_TOP_SZ)
+# define BOTTOM_SZ (1 << LOG_BOTTOM_SZ)
+
+#ifndef SMALL_CONFIG
+# define USE_HDR_CACHE
+#endif
+
+/* #define COUNT_HDR_CACHE_HITS */
+
+extern hdr * GC_invalid_header; /* header for an imaginary block */
+ /* containing no objects. */
+
+
+/* Check whether p and corresponding hhdr point to long or invalid */
+/* object. If so, advance hhdr to */
+/* beginning of block, or set hhdr to GC_invalid_header. */
+#define ADVANCE(p, hhdr, source) \
+ { \
+ hdr * new_hdr = GC_invalid_header; \
+ p = GC_find_start(p, hhdr, &new_hdr); \
+ hhdr = new_hdr; \
+ }
+
+#ifdef USE_HDR_CACHE
+
+# ifdef COUNT_HDR_CACHE_HITS
+ extern word GC_hdr_cache_hits;
+ extern word GC_hdr_cache_misses;
+# define HC_HIT() ++GC_hdr_cache_hits
+# define HC_MISS() ++GC_hdr_cache_misses
+# else
+# define HC_HIT()
+# define HC_MISS()
+# endif
+
+ typedef struct hce {
+ word block_addr; /* right shifted by LOG_HBLKSIZE */
+ hdr * hce_hdr;
+ } hdr_cache_entry;
+
+# define HDR_CACHE_SIZE 8 /* power of 2 */
+
+# define DECLARE_HDR_CACHE \
+ hdr_cache_entry hdr_cache[HDR_CACHE_SIZE]
+
+# define INIT_HDR_CACHE BZERO(hdr_cache, sizeof(hdr_cache));
+
+# define HCE(h) hdr_cache + (((word)(h) >> LOG_HBLKSIZE) & (HDR_CACHE_SIZE-1))
+
+# define HCE_VALID_FOR(hce,h) ((hce) -> block_addr == \
+ ((word)(h) >> LOG_HBLKSIZE))
+
+# define HCE_HDR(h) ((hce) -> hce_hdr)
+
+
+/* Analogous to GET_HDR, except that in the case of large objects, it */
+/* Returns the header for the object beginning, and updates p. */
+/* Returns &GC_bad_header instead of 0. All of this saves a branch */
+/* in the fast path. */
+# define HC_GET_HDR(p, hhdr, source) \
+ { \
+ hdr_cache_entry * hce = HCE(p); \
+ if (HCE_VALID_FOR(hce, p)) { \
+ HC_HIT(); \
+ hhdr = hce -> hce_hdr; \
+ } else { \
+ HC_MISS(); \
+ GET_HDR(p, hhdr); \
+ if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) { \
+ ADVANCE(p, hhdr, source); \
+ } else { \
+ hce -> block_addr = (word)(p) >> LOG_HBLKSIZE; \
+ hce -> hce_hdr = hhdr; \
+ } \
+ } \
+ }
+
+#else /* !USE_HDR_CACHE */
+
+# define DECLARE_HDR_CACHE
+
+# define INIT_HDR_CACHE
+
+# define HC_GET_HDR(p, hhdr, source) \
+ { \
+ GET_HDR(p, hhdr); \
+ if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) { \
+ ADVANCE(p, hhdr, source); \
+ } \
+ }
+#endif
+
+typedef struct bi {
+ hdr * index[BOTTOM_SZ];
+ /*
+ * The bottom level index contains one of three kinds of values:
+ * 0 means we're not responsible for this block,
+ * or this is a block other than the first one in a free block.
+ * 1 < (long)X <= MAX_JUMP means the block starts at least
+ * X * HBLKSIZE bytes before the current address.
+ * A valid pointer points to a hdr structure. (The above can't be
+ * valid pointers due to the GET_MEM return convention.)
+ */
+ struct bi * asc_link; /* All indices are linked in */
+ /* ascending order... */
+ struct bi * desc_link; /* ... and in descending order. */
+ word key; /* high order address bits. */
+# ifdef HASH_TL
+ struct bi * hash_link; /* Hash chain link. */
+# endif
+} bottom_index;
+
+/* extern bottom_index GC_all_nils; - really part of GC_arrays */
+
+/* extern bottom_index * GC_top_index []; - really part of GC_arrays */
+ /* Each entry points to a bottom_index. */
+ /* On a 32 bit machine, it points to */
+ /* the index for a set of high order */
+ /* bits equal to the index. For longer */
+ /* addresses, we hash the high order */
+ /* bits to compute the index in */
+ /* GC_top_index, and each entry points */
+ /* to a hash chain. */
+ /* The last entry in each chain is */
+ /* GC_all_nils. */
+
+
+# define MAX_JUMP (HBLKSIZE - 1)
+
+# define HDR_FROM_BI(bi, p) \
+ ((bi)->index[((word)(p) >> LOG_HBLKSIZE) & (BOTTOM_SZ - 1)])
+# ifndef HASH_TL
+# define BI(p) (GC_top_index \
+ [(word)(p) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE)])
+# define HDR_INNER(p) HDR_FROM_BI(BI(p),p)
+# ifdef SMALL_CONFIG
+# define HDR(p) GC_find_header((ptr_t)(p))
+# else
+# define HDR(p) HDR_INNER(p)
+# endif
+# define GET_BI(p, bottom_indx) (bottom_indx) = BI(p)
+# define GET_HDR(p, hhdr) (hhdr) = HDR(p)
+# define SET_HDR(p, hhdr) HDR_INNER(p) = (hhdr)
+# define GET_HDR_ADDR(p, ha) (ha) = &(HDR_INNER(p))
+# else /* hash */
+/* Hash function for tree top level */
+# define TL_HASH(hi) ((hi) & (TOP_SZ - 1))
+/* Set bottom_indx to point to the bottom index for address p */
+# define GET_BI(p, bottom_indx) \
+ { \
+ register word hi = \
+ (word)(p) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE); \
+ register bottom_index * _bi = GC_top_index[TL_HASH(hi)]; \
+ \
+ while (_bi -> key != hi && _bi != GC_all_nils) \
+ _bi = _bi -> hash_link; \
+ (bottom_indx) = _bi; \
+ }
+# define GET_HDR_ADDR(p, ha) \
+ { \
+ register bottom_index * bi; \
+ \
+ GET_BI(p, bi); \
+ (ha) = &(HDR_FROM_BI(bi, p)); \
+ }
+# define GET_HDR(p, hhdr) { register hdr ** _ha; GET_HDR_ADDR(p, _ha); \
+ (hhdr) = *_ha; }
+# define SET_HDR(p, hhdr) { register hdr ** _ha; GET_HDR_ADDR(p, _ha); \
+ *_ha = (hhdr); }
+# define HDR(p) GC_find_header((ptr_t)(p))
+# endif
+
+/* Is the result a forwarding address to someplace closer to the */
+/* beginning of the block or NIL? */
+# define IS_FORWARDING_ADDR_OR_NIL(hhdr) ((unsigned long) (hhdr) <= MAX_JUMP)
+
+/* Get an HBLKSIZE aligned address closer to the beginning of the block */
+/* h. Assumes hhdr == HDR(h) and IS_FORWARDING_ADDR(hhdr). */
+# define FORWARDED_ADDR(h, hhdr) ((struct hblk *)(h) - (unsigned long)(hhdr))
+# endif /* GC_HEADERS_H */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+#ifndef GC_LOCKS_H
+#define GC_LOCKS_H
+
+/*
+ * Mutual exclusion between allocator/collector routines.
+ * Needed if there is more than one allocator thread.
+ * FASTLOCK() is assumed to try to acquire the lock in a cheap and
+ * dirty way that is acceptable for a few instructions, e.g. by
+ * inhibiting preemption. This is assumed to have succeeded only
+ * if a subsequent call to FASTLOCK_SUCCEEDED() returns TRUE.
+ * FASTUNLOCK() is called whether or not FASTLOCK_SUCCEEDED().
+ * If signals cannot be tolerated with the FASTLOCK held, then
+ * FASTLOCK should disable signals. The code executed under
+ * FASTLOCK is otherwise immune to interruption, provided it is
+ * not restarted.
+ * DCL_LOCK_STATE declares any local variables needed by LOCK and UNLOCK
+ * and/or DISABLE_SIGNALS and ENABLE_SIGNALS and/or FASTLOCK.
+ * (There is currently no equivalent for FASTLOCK.)
+ *
+ * In the PARALLEL_MARK case, we also need to define a number of
+ * other inline finctions here:
+ * GC_bool GC_compare_and_exchange( volatile GC_word *addr,
+ * GC_word old, GC_word new )
+ * GC_word GC_atomic_add( volatile GC_word *addr, GC_word how_much )
+ * void GC_memory_barrier( )
+ *
+ */
+# ifdef THREADS
+ void GC_noop1 GC_PROTO((word));
+# ifdef PCR_OBSOLETE /* Faster, but broken with multiple lwp's */
+# include "th/PCR_Th.h"
+# include "th/PCR_ThCrSec.h"
+ extern struct PCR_Th_MLRep GC_allocate_ml;
+# define DCL_LOCK_STATE PCR_sigset_t GC_old_sig_mask
+# define LOCK() PCR_Th_ML_Acquire(&GC_allocate_ml)
+# define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
+# define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
+# define FASTLOCK() PCR_ThCrSec_EnterSys()
+ /* Here we cheat (a lot): */
+# define FASTLOCK_SUCCEEDED() (*(int *)(&GC_allocate_ml) == 0)
+ /* TRUE if nobody currently holds the lock */
+# define FASTUNLOCK() PCR_ThCrSec_ExitSys()
+# endif
+# ifdef PCR
+# include <base/PCR_Base.h>
+# include <th/PCR_Th.h>
+ extern PCR_Th_ML GC_allocate_ml;
+# define DCL_LOCK_STATE \
+ PCR_ERes GC_fastLockRes; PCR_sigset_t GC_old_sig_mask
+# define LOCK() PCR_Th_ML_Acquire(&GC_allocate_ml)
+# define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
+# define FASTLOCK() (GC_fastLockRes = PCR_Th_ML_Try(&GC_allocate_ml))
+# define FASTLOCK_SUCCEEDED() (GC_fastLockRes == PCR_ERes_okay)
+# define FASTUNLOCK() {\
+ if( FASTLOCK_SUCCEEDED() ) PCR_Th_ML_Release(&GC_allocate_ml); }
+# endif
+# ifdef SRC_M3
+ extern GC_word RT0u__inCritical;
+# define LOCK() RT0u__inCritical++
+# define UNLOCK() RT0u__inCritical--
+# endif
+# ifdef GC_SOLARIS_THREADS
+# include <thread.h>
+# include <signal.h>
+ extern mutex_t GC_allocate_ml;
+# define LOCK() mutex_lock(&GC_allocate_ml);
+# define UNLOCK() mutex_unlock(&GC_allocate_ml);
+# endif
+
+/* Try to define GC_TEST_AND_SET and a matching GC_CLEAR for spin lock */
+/* acquisition and release. We need this for correct operation of the */
+/* incremental GC. */
+# ifdef __GNUC__
+# if defined(I386)
+ inline static int GC_test_and_set(volatile unsigned int *addr) {
+ int oldval;
+ /* Note: the "xchg" instruction does not need a "lock" prefix */
+ __asm__ __volatile__("xchgl %0, %1"
+ : "=r"(oldval), "=m"(*(addr))
+ : "0"(1), "m"(*(addr)) : "memory");
+ return oldval;
+ }
+# define GC_TEST_AND_SET_DEFINED
+# endif
+# if defined(IA64)
+ inline static int GC_test_and_set(volatile unsigned int *addr) {
+ long oldval, n = 1;
+ __asm__ __volatile__("xchg4 %0=%1,%2"
+ : "=r"(oldval), "=m"(*addr)
+ : "r"(n), "1"(*addr) : "memory");
+ return oldval;
+ }
+# define GC_TEST_AND_SET_DEFINED
+ /* Should this handle post-increment addressing?? */
+ inline static void GC_clear(volatile unsigned int *addr) {
+ __asm__ __volatile__("st4.rel %0=r0" : "=m" (*addr) : : "memory");
+ }
+# define GC_CLEAR_DEFINED
+# endif
+# ifdef SPARC
+ inline static int GC_test_and_set(volatile unsigned int *addr) {
+ int oldval;
+
+ __asm__ __volatile__("ldstub %1,%0"
+ : "=r"(oldval), "=m"(*addr)
+ : "m"(*addr) : "memory");
+ return oldval;
+ }
+# define GC_TEST_AND_SET_DEFINED
+# endif
+# ifdef M68K
+ /* Contributed by Tony Mantler. I'm not sure how well it was */
+ /* tested. */
+ inline static int GC_test_and_set(volatile unsigned int *addr) {
+ char oldval; /* this must be no longer than 8 bits */
+
+ /* The return value is semi-phony. */
+ /* 'tas' sets bit 7 while the return */
+ /* value pretends bit 0 was set */
+ __asm__ __volatile__(
+ "tas %1@; sne %0; negb %0"
+ : "=d" (oldval)
+ : "a" (addr) : "memory");
+ return oldval;
+ }
+# define GC_TEST_AND_SET_DEFINED
+# endif
+# if defined(POWERPC)
+ inline static int GC_test_and_set(volatile unsigned int *addr) {
+ int oldval;
+ int temp = 1; /* locked value */
+
+ __asm__ __volatile__(
+ "1:\tlwarx %0,0,%3\n" /* load and reserve */
+ "\tcmpwi %0, 0\n" /* if load is */
+ "\tbne 2f\n" /* non-zero, return already set */
+ "\tstwcx. %2,0,%1\n" /* else store conditional */
+ "\tbne- 1b\n" /* retry if lost reservation */
+ "2:\t\n" /* oldval is zero if we set */
+ : "=&r"(oldval), "=p"(addr)
+ : "r"(temp), "1"(addr)
+ : "memory");
+ return oldval;
+ }
+# define GC_TEST_AND_SET_DEFINED
+ inline static void GC_clear(volatile unsigned int *addr) {
+ __asm__ __volatile__("eieio" : : : "memory");
+ *(addr) = 0;
+ }
+# define GC_CLEAR_DEFINED
+# endif
+# if defined(ALPHA)
+ inline static int GC_test_and_set(volatile unsigned int * addr)
+ {
+ unsigned long oldvalue;
+ unsigned long temp;
+
+ __asm__ __volatile__(
+ "1: ldl_l %0,%1\n"
+ " and %0,%3,%2\n"
+ " bne %2,2f\n"
+ " xor %0,%3,%0\n"
+ " stl_c %0,%1\n"
+ " beq %0,3f\n"
+ " mb\n"
+ "2:\n"
+ ".section .text2,\"ax\"\n"
+ "3: br 1b\n"
+ ".previous"
+ :"=&r" (temp), "=m" (*addr), "=&r" (oldvalue)
+ :"Ir" (1), "m" (*addr)
+ :"memory");
+
+ return oldvalue;
+ }
+# define GC_TEST_AND_SET_DEFINED
+ inline static void GC_clear(volatile unsigned int *addr) {
+ __asm__ __volatile__("mb" : : : "memory");
+ *(addr) = 0;
+ }
+# define GC_CLEAR_DEFINED
+# endif /* ALPHA */
+# ifdef ARM32
+ inline static int GC_test_and_set(volatile unsigned int *addr) {
+ int oldval;
+ /* SWP on ARM is very similar to XCHG on x86. Doesn't lock the
+ * bus because there are no SMP ARM machines. If/when there are,
+ * this code will likely need to be updated. */
+ /* See linuxthreads/sysdeps/arm/pt-machine.h in glibc-2.1 */
+ __asm__ __volatile__("swp %0, %1, [%2]"
+ : "=r"(oldval)
+ : "r"(1), "r"(addr)
+ : "memory");
+ return oldval;
+ }
+# define GC_TEST_AND_SET_DEFINED
+# endif /* ARM32 */
+# ifdef S390
+ inline static int GC_test_and_set(volatile unsigned int *addr) {
+ int ret;
+ __asm__ __volatile__ (
+ " l %0,0(%2)\n"
+ "0: cs %0,%1,0(%2)\n"
+ " jl 0b"
+ : "=&d" (ret)
+ : "d" (1), "a" (addr)
+ : "cc", "memory");
+ return ret;
+ }
+# endif
+# endif /* __GNUC__ */
+# if (defined(ALPHA) && !defined(__GNUC__))
+# ifndef OSF1
+ --> We currently assume that if gcc is not used, we are
+ --> running under Tru64.
+# endif
+# include <machine/builtins.h>
+# include <c_asm.h>
+# define GC_test_and_set(addr) __ATOMIC_EXCH_LONG(addr, 1)
+# define GC_TEST_AND_SET_DEFINED
+# define GC_clear(addr) { asm("mb"); *(volatile unsigned *)addr = 0; }
+# define GC_CLEAR_DEFINED
+# endif
+# if defined(MSWIN32)
+# define GC_test_and_set(addr) InterlockedExchange((LPLONG)addr,1)
+# define GC_TEST_AND_SET_DEFINED
+# endif
+# ifdef MIPS
+# ifdef LINUX
+# include <sys/tas.h>
+# define GC_test_and_set(addr) _test_and_set((int *) addr,1)
+# define GC_TEST_AND_SET_DEFINED
+# elif __mips < 3 || !(defined (_ABIN32) || defined(_ABI64)) \
+ || !defined(_COMPILER_VERSION) || _COMPILER_VERSION < 700
+# ifdef __GNUC__
+# define GC_test_and_set(addr) _test_and_set(addr,1)
+# else
+# define GC_test_and_set(addr) test_and_set(addr,1)
+# endif
+# else
+# define GC_test_and_set(addr) __test_and_set(addr,1)
+# define GC_clear(addr) __lock_release(addr);
+# define GC_CLEAR_DEFINED
+# endif
+# define GC_TEST_AND_SET_DEFINED
+# endif /* MIPS */
+# if 0 /* defined(HP_PA) */
+ /* The official recommendation seems to be to not use ldcw from */
+ /* user mode. Since multithreaded incremental collection doesn't */
+ /* work anyway on HP_PA, this shouldn't be a major loss. */
+
+ /* "set" means 0 and "clear" means 1 here. */
+# define GC_test_and_set(addr) !GC_test_and_clear(addr);
+# define GC_TEST_AND_SET_DEFINED
+# define GC_clear(addr) GC_noop1((word)(addr)); *(volatile unsigned int *)addr = 1;
+ /* The above needs a memory barrier! */
+# define GC_CLEAR_DEFINED
+# endif
+# if defined(GC_TEST_AND_SET_DEFINED) && !defined(GC_CLEAR_DEFINED)
+# ifdef __GNUC__
+ inline static void GC_clear(volatile unsigned int *addr) {
+ /* Try to discourage gcc from moving anything past this. */
+ __asm__ __volatile__(" " : : : "memory");
+ *(addr) = 0;
+ }
+# else
+ /* The function call in the following should prevent the */
+ /* compiler from moving assignments to below the UNLOCK. */
+# define GC_clear(addr) GC_noop1((word)(addr)); \
+ *((volatile unsigned int *)(addr)) = 0;
+# endif
+# define GC_CLEAR_DEFINED
+# endif /* !GC_CLEAR_DEFINED */
+
+# if !defined(GC_TEST_AND_SET_DEFINED)
+# define USE_PTHREAD_LOCKS
+# endif
+
+# if defined(GC_PTHREADS) && !defined(GC_SOLARIS_THREADS) \
+ && !defined(GC_IRIX_THREADS) && !defined(GC_WIN32_THREADS)
+# define NO_THREAD (pthread_t)(-1)
+# include <pthread.h>
+# if defined(PARALLEL_MARK)
+ /* We need compare-and-swap to update mark bits, where it's */
+ /* performance critical. If USE_MARK_BYTES is defined, it is */
+ /* no longer needed for this purpose. However we use it in */
+ /* either case to implement atomic fetch-and-add, though that's */
+ /* less performance critical, and could perhaps be done with */
+ /* a lock. */
+# if defined(GENERIC_COMPARE_AND_SWAP)
+ /* Probably not useful, except for debugging. */
+ /* We do use GENERIC_COMPARE_AND_SWAP on PA_RISC, but we */
+ /* minimize its use. */
+ extern pthread_mutex_t GC_compare_and_swap_lock;
+
+ /* Note that if GC_word updates are not atomic, a concurrent */
+ /* reader should acquire GC_compare_and_swap_lock. On */
+ /* currently supported platforms, such updates are atomic. */
+ extern GC_bool GC_compare_and_exchange(volatile GC_word *addr,
+ GC_word old, GC_word new_val);
+# endif /* GENERIC_COMPARE_AND_SWAP */
+# if defined(I386)
+# if !defined(GENERIC_COMPARE_AND_SWAP)
+ /* Returns TRUE if the comparison succeeded. */
+ inline static GC_bool GC_compare_and_exchange(volatile GC_word *addr,
+ GC_word old,
+ GC_word new_val)
+ {
+ char result;
+ __asm__ __volatile__("lock; cmpxchgl %2, %0; setz %1"
+ : "=m"(*(addr)), "=r"(result)
+ : "r" (new_val), "0"(*(addr)), "a"(old) : "memory");
+ return (GC_bool) result;
+ }
+# endif /* !GENERIC_COMPARE_AND_SWAP */
+ inline static void GC_memory_barrier()
+ {
+ /* We believe the processor ensures at least processor */
+ /* consistent ordering. Thus a compiler barrier */
+ /* should suffice. */
+ __asm__ __volatile__("" : : : "memory");
+ }
+# endif /* I386 */
+# if defined(IA64)
+# if !defined(GENERIC_COMPARE_AND_SWAP)
+ inline static GC_bool GC_compare_and_exchange(volatile GC_word *addr,
+ GC_word old, GC_word new_val)
+ {
+ unsigned long oldval;
+ __asm__ __volatile__("mov ar.ccv=%4 ;; cmpxchg8.rel %0=%1,%2,ar.ccv"
+ : "=r"(oldval), "=m"(*addr)
+ : "r"(new_val), "1"(*addr), "r"(old) : "memory");
+ return (oldval == old);
+ }
+# endif /* !GENERIC_COMPARE_AND_SWAP */
+# if 0
+ /* Shouldn't be needed; we use volatile stores instead. */
+ inline static void GC_memory_barrier()
+ {
+ __asm__ __volatile__("mf" : : : "memory");
+ }
+# endif /* 0 */
+# endif /* IA64 */
+# if defined(ALPHA)
+# if !defined(GENERIC_COMPARE_AND_SWAP)
+# if defined(__GNUC__)
+ inline static GC_bool GC_compare_and_exchange(volatile GC_word *addr,
+ GC_word old, GC_word new_val)
+ {
+ unsigned long was_equal;
+ unsigned long temp;
+
+ __asm__ __volatile__(
+ "1: ldq_l %0,%1\n"
+ " cmpeq %0,%4,%2\n"
+ " mov %3,%0\n"
+ " beq %2,2f\n"
+ " stq_c %0,%1\n"
+ " beq %0,1b\n"
+ "2:\n"
+ " mb\n"
+ :"=&r" (temp), "=m" (*addr), "=&r" (was_equal)
+ : "r" (new_val), "Ir" (old)
+ :"memory");
+ return was_equal;
+ }
+# else /* !__GNUC__ */
+ inline static GC_bool GC_compare_and_exchange(volatile GC_word *addr,
+ GC_word old, GC_word new_val)
+ {
+ return __CMP_STORE_QUAD(addr, old, new_val, addr);
+ }
+# endif /* !__GNUC__ */
+# endif /* !GENERIC_COMPARE_AND_SWAP */
+# ifdef __GNUC__
+ inline static void GC_memory_barrier()
+ {
+ __asm__ __volatile__("mb" : : : "memory");
+ }
+# else
+# define GC_memory_barrier() asm("mb")
+# endif /* !__GNUC__ */
+# endif /* ALPHA */
+# if defined(S390)
+# if !defined(GENERIC_COMPARE_AND_SWAP)
+ inline static GC_bool GC_compare_and_exchange(volatile C_word *addr,
+ GC_word old, GC_word new_val)
+ {
+ int retval;
+ __asm__ __volatile__ (
+# ifndef __s390x__
+ " cs %1,%2,0(%3)\n"
+# else
+ " csg %1,%2,0(%3)\n"
+# endif
+ " ipm %0\n"
+ " srl %0,28\n"
+ : "=&d" (retval), "+d" (old)
+ : "d" (new_val), "a" (addr)
+ : "cc", "memory");
+ return retval == 0;
+ }
+# endif
+# endif
+# if !defined(GENERIC_COMPARE_AND_SWAP)
+ /* Returns the original value of *addr. */
+ inline static GC_word GC_atomic_add(volatile GC_word *addr,
+ GC_word how_much)
+ {
+ GC_word old;
+ do {
+ old = *addr;
+ } while (!GC_compare_and_exchange(addr, old, old+how_much));
+ return old;
+ }
+# else /* GENERIC_COMPARE_AND_SWAP */
+ /* So long as a GC_word can be atomically updated, it should */
+ /* be OK to read *addr without a lock. */
+ extern GC_word GC_atomic_add(volatile GC_word *addr, GC_word how_much);
+# endif /* GENERIC_COMPARE_AND_SWAP */
+
+# endif /* PARALLEL_MARK */
+
+# if !defined(THREAD_LOCAL_ALLOC) && !defined(USE_PTHREAD_LOCKS)
+ /* In the THREAD_LOCAL_ALLOC case, the allocation lock tends to */
+ /* be held for long periods, if it is held at all. Thus spinning */
+ /* and sleeping for fixed periods are likely to result in */
+ /* significant wasted time. We thus rely mostly on queued locks. */
+# define USE_SPIN_LOCK
+ extern volatile unsigned int GC_allocate_lock;
+ extern void GC_lock(void);
+ /* Allocation lock holder. Only set if acquired by client through */
+ /* GC_call_with_alloc_lock. */
+# ifdef GC_ASSERTIONS
+# define LOCK() \
+ { if (GC_test_and_set(&GC_allocate_lock)) GC_lock(); \
+ SET_LOCK_HOLDER(); }
+# define UNLOCK() \
+ { GC_ASSERT(I_HOLD_LOCK()); UNSET_LOCK_HOLDER(); \
+ GC_clear(&GC_allocate_lock); }
+# else
+# define LOCK() \
+ { if (GC_test_and_set(&GC_allocate_lock)) GC_lock(); }
+# define UNLOCK() \
+ GC_clear(&GC_allocate_lock)
+# endif /* !GC_ASSERTIONS */
+# if 0
+ /* Another alternative for OSF1 might be: */
+# include <sys/mman.h>
+ extern msemaphore GC_allocate_semaphore;
+# define LOCK() { if (msem_lock(&GC_allocate_semaphore, MSEM_IF_NOWAIT) \
+ != 0) GC_lock(); else GC_allocate_lock = 1; }
+ /* The following is INCORRECT, since the memory model is too weak. */
+ /* Is this true? Presumably msem_unlock has the right semantics? */
+ /* - HB */
+# define UNLOCK() { GC_allocate_lock = 0; \
+ msem_unlock(&GC_allocate_semaphore, 0); }
+# endif /* 0 */
+# else /* THREAD_LOCAL_ALLOC || USE_PTHREAD_LOCKS */
+# ifndef USE_PTHREAD_LOCKS
+# define USE_PTHREAD_LOCKS
+# endif
+# endif /* THREAD_LOCAL_ALLOC */
+# ifdef USE_PTHREAD_LOCKS
+# include <pthread.h>
+ extern pthread_mutex_t GC_allocate_ml;
+# ifdef GC_ASSERTIONS
+# define LOCK() \
+ { GC_lock(); \
+ SET_LOCK_HOLDER(); }
+# define UNLOCK() \
+ { GC_ASSERT(I_HOLD_LOCK()); UNSET_LOCK_HOLDER(); \
+ pthread_mutex_unlock(&GC_allocate_ml); }
+# else /* !GC_ASSERTIONS */
+# define LOCK() \
+ { if (0 != pthread_mutex_trylock(&GC_allocate_ml)) GC_lock(); }
+# define UNLOCK() pthread_mutex_unlock(&GC_allocate_ml)
+# endif /* !GC_ASSERTIONS */
+# endif /* USE_PTHREAD_LOCKS */
+# define SET_LOCK_HOLDER() GC_lock_holder = pthread_self()
+# define UNSET_LOCK_HOLDER() GC_lock_holder = NO_THREAD
+# define I_HOLD_LOCK() (pthread_equal(GC_lock_holder, pthread_self()))
+ extern VOLATILE GC_bool GC_collecting;
+# define ENTER_GC() GC_collecting = 1;
+# define EXIT_GC() GC_collecting = 0;
+ extern void GC_lock(void);
+ extern pthread_t GC_lock_holder;
+# ifdef GC_ASSERTIONS
+ extern pthread_t GC_mark_lock_holder;
+# endif
+# endif /* GC_PTHREADS with linux_threads.c implementation */
+# if defined(GC_IRIX_THREADS)
+# include <pthread.h>
+ /* This probably should never be included, but I can't test */
+ /* on Irix anymore. */
+# include <mutex.h>
+
+ extern unsigned long GC_allocate_lock;
+ /* This is not a mutex because mutexes that obey the (optional) */
+ /* POSIX scheduling rules are subject to convoys in high contention */
+ /* applications. This is basically a spin lock. */
+ extern pthread_t GC_lock_holder;
+ extern void GC_lock(void);
+ /* Allocation lock holder. Only set if acquired by client through */
+ /* GC_call_with_alloc_lock. */
+# define SET_LOCK_HOLDER() GC_lock_holder = pthread_self()
+# define NO_THREAD (pthread_t)(-1)
+# define UNSET_LOCK_HOLDER() GC_lock_holder = NO_THREAD
+# define I_HOLD_LOCK() (pthread_equal(GC_lock_holder, pthread_self()))
+# define LOCK() { if (GC_test_and_set(&GC_allocate_lock)) GC_lock(); }
+# define UNLOCK() GC_clear(&GC_allocate_lock);
+ extern VOLATILE GC_bool GC_collecting;
+# define ENTER_GC() \
+ { \
+ GC_collecting = 1; \
+ }
+# define EXIT_GC() GC_collecting = 0;
+# endif /* GC_IRIX_THREADS */
+# if defined(GC_WIN32_THREADS)
+# if defined(GC_PTHREADS)
+# include <pthread.h>
+ extern pthread_mutex_t GC_allocate_ml;
+# define LOCK() pthread_mutex_lock(&GC_allocate_ml)
+# define UNLOCK() pthread_mutex_unlock(&GC_allocate_ml)
+# else
+# include <windows.h>
+ GC_API CRITICAL_SECTION GC_allocate_ml;
+# define LOCK() EnterCriticalSection(&GC_allocate_ml);
+# define UNLOCK() LeaveCriticalSection(&GC_allocate_ml);
+# endif
+# endif
+# ifndef SET_LOCK_HOLDER
+# define SET_LOCK_HOLDER()
+# define UNSET_LOCK_HOLDER()
+# define I_HOLD_LOCK() FALSE
+ /* Used on platforms were locks can be reacquired, */
+ /* so it doesn't matter if we lie. */
+# endif
+# else /* !THREADS */
+# define LOCK()
+# define UNLOCK()
+# endif /* !THREADS */
+# ifndef SET_LOCK_HOLDER
+# define SET_LOCK_HOLDER()
+# define UNSET_LOCK_HOLDER()
+# define I_HOLD_LOCK() FALSE
+ /* Used on platforms were locks can be reacquired, */
+ /* so it doesn't matter if we lie. */
+# endif
+# ifndef ENTER_GC
+# define ENTER_GC()
+# define EXIT_GC()
+# endif
+
+# ifndef DCL_LOCK_STATE
+# define DCL_LOCK_STATE
+# endif
+# ifndef FASTLOCK
+# define FASTLOCK() LOCK()
+# define FASTLOCK_SUCCEEDED() TRUE
+# define FASTUNLOCK() UNLOCK()
+# endif
+
+#endif /* GC_LOCKS_H */
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 2001 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+
+/* Private declarations of GC marker data structures and macros */
+
+/*
+ * Declarations of mark stack. Needed by marker and client supplied mark
+ * routines. Transitively include gc_priv.h.
+ * (Note that gc_priv.h should not be included before this, since this
+ * includes dbg_mlc.h, which wants to include gc_priv.h AFTER defining
+ * I_HIDE_POINTERS.)
+ */
+#ifndef GC_PMARK_H
+# define GC_PMARK_H
+
+# if defined(KEEP_BACK_PTRS) || defined(PRINT_BLACK_LIST)
+# include "dbg_mlc.h"
+# endif
+# ifndef GC_MARK_H
+# include "../gc_mark.h"
+# endif
+# ifndef GC_PRIVATE_H
+# include "gc_priv.h"
+# endif
+
+/* The real declarations of the following is in gc_priv.h, so that */
+/* we can avoid scanning the following table. */
+/*
+extern mark_proc GC_mark_procs[MAX_MARK_PROCS];
+*/
+
+/*
+ * Mark descriptor stuff that should remain private for now, mostly
+ * because it's hard to export WORDSZ without including gcconfig.h.
+ */
+# define BITMAP_BITS (WORDSZ - GC_DS_TAG_BITS)
+# define PROC(descr) \
+ (GC_mark_procs[((descr) >> GC_DS_TAG_BITS) & (GC_MAX_MARK_PROCS-1)])
+# define ENV(descr) \
+ ((descr) >> (GC_DS_TAG_BITS + GC_LOG_MAX_MARK_PROCS))
+# define MAX_ENV \
+ (((word)1 << (WORDSZ - GC_DS_TAG_BITS - GC_LOG_MAX_MARK_PROCS)) - 1)
+
+
+extern word GC_n_mark_procs;
+
+/* Number of mark stack entries to discard on overflow. */
+#define GC_MARK_STACK_DISCARDS (INITIAL_MARK_STACK_SIZE/8)
+
+typedef struct GC_ms_entry {
+ GC_word * mse_start; /* First word of object */
+ GC_word mse_descr; /* Descriptor; low order two bits are tags, */
+ /* identifying the upper 30 bits as one of the */
+ /* following: */
+} mse;
+
+extern word GC_mark_stack_size;
+
+extern mse * GC_mark_stack_limit;
+
+#ifdef PARALLEL_MARK
+ extern mse * VOLATILE GC_mark_stack_top;
+#else
+ extern mse * GC_mark_stack_top;
+#endif
+
+extern mse * GC_mark_stack;
+
+#ifdef PARALLEL_MARK
+ /*
+ * Allow multiple threads to participate in the marking process.
+ * This works roughly as follows:
+ * The main mark stack never shrinks, but it can grow.
+ *
+ * The initiating threads holds the GC lock, and sets GC_help_wanted.
+ *
+ * Other threads:
+ * 1) update helper_count (while holding mark_lock.)
+ * 2) allocate a local mark stack
+ * repeatedly:
+ * 3) Steal a global mark stack entry by atomically replacing
+ * its descriptor with 0.
+ * 4) Copy it to the local stack.
+ * 5) Mark on the local stack until it is empty, or
+ * it may be profitable to copy it back.
+ * 6) If necessary, copy local stack to global one,
+ * holding mark lock.
+ * 7) Stop when the global mark stack is empty.
+ * 8) decrement helper_count (holding mark_lock).
+ *
+ * This is an experiment to see if we can do something along the lines
+ * of the University of Tokyo SGC in a less intrusive, though probably
+ * also less performant, way.
+ */
+ void GC_do_parallel_mark();
+ /* inititate parallel marking. */
+
+ extern GC_bool GC_help_wanted; /* Protected by mark lock */
+ extern unsigned GC_helper_count; /* Number of running helpers. */
+ /* Protected by mark lock */
+ extern unsigned GC_active_count; /* Number of active helpers. */
+ /* Protected by mark lock */
+ /* May increase and decrease */
+ /* within each mark cycle. But */
+ /* once it returns to 0, it */
+ /* stays zero for the cycle. */
+ /* GC_mark_stack_top is also protected by mark lock. */
+ extern mse * VOLATILE GC_first_nonempty;
+ /* Lowest entry on mark stack */
+ /* that may be nonempty. */
+ /* Updated only by initiating */
+ /* thread. */
+ /*
+ * GC_notify_all_marker() is used when GC_help_wanted is first set,
+ * when the last helper becomes inactive,
+ * when something is added to the global mark stack, and just after
+ * GC_mark_no is incremented.
+ * This could be split into multiple CVs (and probably should be to
+ * scale to really large numbers of processors.)
+ */
+#endif /* PARALLEL_MARK */
+
+/* Return a pointer to within 1st page of object. */
+/* Set *new_hdr_p to corr. hdr. */
+#ifdef __STDC__
+# ifdef PRINT_BLACK_LIST
+ ptr_t GC_find_start(ptr_t current, hdr *hhdr, hdr **new_hdr_p,
+ word source);
+# else
+ ptr_t GC_find_start(ptr_t current, hdr *hhdr, hdr **new_hdr_p);
+# endif
+#else
+ ptr_t GC_find_start();
+#endif
+
+mse * GC_signal_mark_stack_overflow GC_PROTO((mse *msp));
+
+# ifdef GATHERSTATS
+# define ADD_TO_ATOMIC(sz) GC_atomic_in_use += (sz)
+# define ADD_TO_COMPOSITE(sz) GC_composite_in_use += (sz)
+# else
+# define ADD_TO_ATOMIC(sz)
+# define ADD_TO_COMPOSITE(sz)
+# endif
+
+/* Push the object obj with corresponding heap block header hhdr onto */
+/* the mark stack. */
+# define PUSH_OBJ(obj, hhdr, mark_stack_top, mark_stack_limit) \
+{ \
+ register word _descr = (hhdr) -> hb_descr; \
+ \
+ if (_descr == 0) { \
+ ADD_TO_ATOMIC((hhdr) -> hb_sz); \
+ } else { \
+ ADD_TO_COMPOSITE((hhdr) -> hb_sz); \
+ mark_stack_top++; \
+ if (mark_stack_top >= mark_stack_limit) { \
+ mark_stack_top = GC_signal_mark_stack_overflow(mark_stack_top); \
+ } \
+ mark_stack_top -> mse_start = (obj); \
+ mark_stack_top -> mse_descr = _descr; \
+ } \
+}
+
+/* Push the contents of current onto the mark stack if it is a valid */
+/* ptr to a currently unmarked object. Mark it. */
+/* If we assumed a standard-conforming compiler, we could probably */
+/* generate the exit_label transparently. */
+# define PUSH_CONTENTS(current, mark_stack_top, mark_stack_limit, \
+ source, exit_label) \
+{ \
+ hdr * my_hhdr; \
+ ptr_t my_current = current; \
+ \
+ GET_HDR(my_current, my_hhdr); \
+ if (IS_FORWARDING_ADDR_OR_NIL(my_hhdr)) { \
+ hdr * new_hdr = GC_invalid_header; \
+ my_current = GC_find_start(my_current, my_hhdr, &new_hdr); \
+ my_hhdr = new_hdr; \
+ } \
+ PUSH_CONTENTS_HDR(my_current, mark_stack_top, mark_stack_limit, \
+ source, exit_label, my_hhdr); \
+exit_label: ; \
+}
+
+/* As above, but use header cache for header lookup. */
+# define HC_PUSH_CONTENTS(current, mark_stack_top, mark_stack_limit, \
+ source, exit_label) \
+{ \
+ hdr * my_hhdr; \
+ ptr_t my_current = current; \
+ \
+ HC_GET_HDR(my_current, my_hhdr, source); \
+ PUSH_CONTENTS_HDR(my_current, mark_stack_top, mark_stack_limit, \
+ source, exit_label, my_hhdr); \
+exit_label: ; \
+}
+
+/* Set mark bit, exit if it was already set. */
+
+# ifdef USE_MARK_BYTES
+ /* Unlike the mark bit case, there is a race here, and we may set */
+ /* the bit twice in the concurrent case. This can result in the */
+ /* object being pushed twice. But that's only a performance issue. */
+# define SET_MARK_BIT_EXIT_IF_SET(hhdr,displ,exit_label) \
+ { \
+ register VOLATILE char * mark_byte_addr = \
+ hhdr -> hb_marks + ((displ) >> 1); \
+ register char mark_byte = *mark_byte_addr; \
+ \
+ if (mark_byte) goto exit_label; \
+ *mark_byte_addr = 1; \
+ }
+# else
+# define SET_MARK_BIT_EXIT_IF_SET(hhdr,displ,exit_label) \
+ { \
+ register word * mark_word_addr = hhdr -> hb_marks + divWORDSZ(displ); \
+ \
+ OR_WORD_EXIT_IF_SET(mark_word_addr, (word)1 << modWORDSZ(displ), \
+ exit_label); \
+ }
+# endif /* USE_MARK_BYTES */
+
+/* If the mark bit corresponding to current is not set, set it, and */
+/* push the contents of the object on the mark stack. For a small */
+/* object we assume that current is the (possibly interior) pointer */
+/* to the object. For large objects we assume that current points */
+/* to somewhere inside the first page of the object. If */
+/* GC_all_interior_pointers is set, it may have been previously */
+/* adjusted to make that true. */
+# define PUSH_CONTENTS_HDR(current, mark_stack_top, mark_stack_limit, \
+ source, exit_label, hhdr) \
+{ \
+ int displ; /* Displacement in block; first bytes, then words */ \
+ int map_entry; \
+ \
+ displ = HBLKDISPL(current); \
+ map_entry = MAP_ENTRY((hhdr -> hb_map), displ); \
+ displ = BYTES_TO_WORDS(displ); \
+ if (map_entry > CPP_MAX_OFFSET) { \
+ if (map_entry == OFFSET_TOO_BIG) { \
+ map_entry = displ % (hhdr -> hb_sz); \
+ displ -= map_entry; \
+ if (displ + (hhdr -> hb_sz) > BYTES_TO_WORDS(HBLKSIZE)) { \
+ GC_ADD_TO_BLACK_LIST_NORMAL((word)current, source); \
+ goto exit_label; \
+ } \
+ } else { \
+ GC_ADD_TO_BLACK_LIST_NORMAL((word)current, source); goto exit_label; \
+ } \
+ } else { \
+ displ -= map_entry; \
+ } \
+ GC_ASSERT(displ >= 0 && displ < MARK_BITS_PER_HBLK); \
+ SET_MARK_BIT_EXIT_IF_SET(hhdr, displ, exit_label); \
+ GC_STORE_BACK_PTR((ptr_t)source, (ptr_t)HBLKPTR(current) \
+ + WORDS_TO_BYTES(displ)); \
+ PUSH_OBJ(((word *)(HBLKPTR(current)) + displ), hhdr, \
+ mark_stack_top, mark_stack_limit) \
+}
+
+#if defined(PRINT_BLACK_LIST) || defined(KEEP_BACK_PTRS)
+# define PUSH_ONE_CHECKED_STACK(p, source) \
+ GC_mark_and_push_stack(p, (ptr_t)(source))
+#else
+# define PUSH_ONE_CHECKED_STACK(p, source) \
+ GC_mark_and_push_stack(p)
+#endif
+
+/*
+ * Push a single value onto mark stack. Mark from the object pointed to by p.
+ * Invoke FIXUP_POINTER(p) before any further processing.
+ * P is considered valid even if it is an interior pointer.
+ * Previously marked objects are not pushed. Hence we make progress even
+ * if the mark stack overflows.
+ */
+
+# if NEED_FIXUP_POINTER
+ /* Try both the raw version and the fixed up one. */
+# define GC_PUSH_ONE_STACK(p, source) \
+ if ((ptr_t)(p) >= (ptr_t)GC_least_plausible_heap_addr \
+ && (ptr_t)(p) < (ptr_t)GC_greatest_plausible_heap_addr) { \
+ PUSH_ONE_CHECKED_STACK(p, source); \
+ } \
+ FIXUP_POINTER(p); \
+ if ((ptr_t)(p) >= (ptr_t)GC_least_plausible_heap_addr \
+ && (ptr_t)(p) < (ptr_t)GC_greatest_plausible_heap_addr) { \
+ PUSH_ONE_CHECKED_STACK(p, source); \
+ }
+# else /* !NEED_FIXUP_POINTER */
+# define GC_PUSH_ONE_STACK(p, source) \
+ if ((ptr_t)(p) >= (ptr_t)GC_least_plausible_heap_addr \
+ && (ptr_t)(p) < (ptr_t)GC_greatest_plausible_heap_addr) { \
+ PUSH_ONE_CHECKED_STACK(p, source); \
+ }
+# endif
+
+
+/*
+ * As above, but interior pointer recognition as for
+ * normal for heap pointers.
+ */
+# define GC_PUSH_ONE_HEAP(p,source) \
+ FIXUP_POINTER(p); \
+ if ((ptr_t)(p) >= (ptr_t)GC_least_plausible_heap_addr \
+ && (ptr_t)(p) < (ptr_t)GC_greatest_plausible_heap_addr) { \
+ GC_mark_stack_top = GC_mark_and_push( \
+ (GC_PTR)(p), GC_mark_stack_top, \
+ GC_mark_stack_limit, (GC_PTR *)(source)); \
+ }
+
+/* Mark starting at mark stack entry top (incl.) down to */
+/* mark stack entry bottom (incl.). Stop after performing */
+/* about one page worth of work. Return the new mark stack */
+/* top entry. */
+mse * GC_mark_from GC_PROTO((mse * top, mse * bottom, mse *limit));
+
+#define MARK_FROM_MARK_STACK() \
+ GC_mark_stack_top = GC_mark_from(GC_mark_stack_top, \
+ GC_mark_stack, \
+ GC_mark_stack + GC_mark_stack_size);
+
+/*
+ * Mark from one finalizable object using the specified
+ * mark proc. May not mark the object pointed to by
+ * real_ptr. That is the job of the caller, if appropriate
+ */
+# define GC_MARK_FO(real_ptr, mark_proc) \
+{ \
+ (*(mark_proc))(real_ptr); \
+ while (!GC_mark_stack_empty()) MARK_FROM_MARK_STACK(); \
+ if (GC_mark_state != MS_NONE) { \
+ GC_set_mark_bit(real_ptr); \
+ while (!GC_mark_some((ptr_t)0)) {} \
+ } \
+}
+
+extern GC_bool GC_mark_stack_too_small;
+ /* We need a larger mark stack. May be */
+ /* set by client supplied mark routines.*/
+
+typedef int mark_state_t; /* Current state of marking, as follows:*/
+ /* Used to remember where we are during */
+ /* concurrent marking. */
+
+ /* We say something is dirty if it was */
+ /* written since the last time we */
+ /* retrieved dirty bits. We say it's */
+ /* grungy if it was marked dirty in the */
+ /* last set of bits we retrieved. */
+
+ /* Invariant I: all roots and marked */
+ /* objects p are either dirty, or point */
+ /* to objects q that are either marked */
+ /* or a pointer to q appears in a range */
+ /* on the mark stack. */
+
+# define MS_NONE 0 /* No marking in progress. I holds. */
+ /* Mark stack is empty. */
+
+# define MS_PUSH_RESCUERS 1 /* Rescuing objects are currently */
+ /* being pushed. I holds, except */
+ /* that grungy roots may point to */
+ /* unmarked objects, as may marked */
+ /* grungy objects above scan_ptr. */
+
+# define MS_PUSH_UNCOLLECTABLE 2
+ /* I holds, except that marked */
+ /* uncollectable objects above scan_ptr */
+ /* may point to unmarked objects. */
+ /* Roots may point to unmarked objects */
+
+# define MS_ROOTS_PUSHED 3 /* I holds, mark stack may be nonempty */
+
+# define MS_PARTIALLY_INVALID 4 /* I may not hold, e.g. because of M.S. */
+ /* overflow. However marked heap */
+ /* objects below scan_ptr point to */
+ /* marked or stacked objects. */
+
+# define MS_INVALID 5 /* I may not hold. */
+
+extern mark_state_t GC_mark_state;
+
+#endif /* GC_PMARK_H */
+
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999-2001 by Hewlett-Packard Company. All rights reserved.
+ *
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+
+# ifndef GC_PRIVATE_H
+# define GC_PRIVATE_H
+
+#if defined(mips) && defined(SYSTYPE_BSD) && defined(sony_news)
+ /* sony RISC NEWS, NEWSOS 4 */
+# define BSD_TIME
+/* typedef long ptrdiff_t; -- necessary on some really old systems */
+#endif
+
+#if defined(mips) && defined(SYSTYPE_BSD43)
+ /* MIPS RISCOS 4 */
+# define BSD_TIME
+#endif
+
+#ifdef DGUX
+# include <sys/types.h>
+# include <sys/time.h>
+# include <sys/resource.h>
+#endif /* DGUX */
+
+#ifdef BSD_TIME
+# include <sys/types.h>
+# include <sys/time.h>
+# include <sys/resource.h>
+#endif /* BSD_TIME */
+
+# ifndef GC_H
+# include "gc.h"
+# endif
+
+# ifndef GC_MARK_H
+# include "../gc_mark.h"
+# endif
+
+typedef GC_word word;
+typedef GC_signed_word signed_word;
+
+typedef int GC_bool;
+# define TRUE 1
+# define FALSE 0
+
+typedef char * ptr_t; /* A generic pointer to which we can add */
+ /* byte displacements. */
+ /* Preferably identical to caddr_t, if it */
+ /* exists. */
+
+# ifndef GCCONFIG_H
+# include "gcconfig.h"
+# endif
+
+# ifndef HEADERS_H
+# include "gc_hdrs.h"
+# endif
+
+#if defined(__STDC__)
+# include <stdlib.h>
+# if !(defined( sony_news ) )
+# include <stddef.h>
+# endif
+# define VOLATILE volatile
+#else
+# ifdef MSWIN32
+# include <stdlib.h>
+# endif
+# define VOLATILE
+#endif
+
+#if 0 /* defined(__GNUC__) doesn't work yet */
+# define EXPECT(expr, outcome) __builtin_expect(expr,outcome)
+ /* Equivalent to (expr), but predict that usually (expr)==outcome. */
+#else
+# define EXPECT(expr, outcome) (expr)
+#endif /* __GNUC__ */
+
+# ifndef GC_LOCKS_H
+# include "gc_locks.h"
+# endif
+
+# ifdef STACK_GROWS_DOWN
+# define COOLER_THAN >
+# define HOTTER_THAN <
+# define MAKE_COOLER(x,y) if ((word)(x)+(y) > (word)(x)) {(x) += (y);} \
+ else {(x) = (word)ONES;}
+# define MAKE_HOTTER(x,y) (x) -= (y)
+# else
+# define COOLER_THAN <
+# define HOTTER_THAN >
+# define MAKE_COOLER(x,y) if ((word)(x)-(y) < (word)(x)) {(x) -= (y);} else {(x) = 0;}
+# define MAKE_HOTTER(x,y) (x) += (y)
+# endif
+
+#if defined(AMIGA) && defined(__SASC)
+# define GC_FAR __far
+#else
+# define GC_FAR
+#endif
+
+
+/*********************************/
+/* */
+/* Definitions for conservative */
+/* collector */
+/* */
+/*********************************/
+
+/*********************************/
+/* */
+/* Easily changeable parameters */
+/* */
+/*********************************/
+
+/* #define STUBBORN_ALLOC */
+ /* Enable stubborm allocation, and thus a limited */
+ /* form of incremental collection w/o dirty bits. */
+
+/* #define ALL_INTERIOR_POINTERS */
+ /* Forces all pointers into the interior of an */
+ /* object to be considered valid. Also causes the */
+ /* sizes of all objects to be inflated by at least */
+ /* one byte. This should suffice to guarantee */
+ /* that in the presence of a compiler that does */
+ /* not perform garbage-collector-unsafe */
+ /* optimizations, all portable, strictly ANSI */
+ /* conforming C programs should be safely usable */
+ /* with malloc replaced by GC_malloc and free */
+ /* calls removed. There are several disadvantages: */
+ /* 1. There are probably no interesting, portable, */
+ /* strictly ANSI conforming C programs. */
+ /* 2. This option makes it hard for the collector */
+ /* to allocate space that is not ``pointed to'' */
+ /* by integers, etc. Under SunOS 4.X with a */
+ /* statically linked libc, we empiricaly */
+ /* observed that it would be difficult to */
+ /* allocate individual objects larger than 100K. */
+ /* Even if only smaller objects are allocated, */
+ /* more swap space is likely to be needed. */
+ /* Fortunately, much of this will never be */
+ /* touched. */
+ /* If you can easily avoid using this option, do. */
+ /* If not, try to keep individual objects small. */
+ /* This is now really controlled at startup, */
+ /* through GC_all_interior_pointers. */
+
+#define PRINTSTATS /* Print garbage collection statistics */
+ /* For less verbose output, undefine in reclaim.c */
+
+#define PRINTTIMES /* Print the amount of time consumed by each garbage */
+ /* collection. */
+
+#define PRINTBLOCKS /* Print object sizes associated with heap blocks, */
+ /* whether the objects are atomic or composite, and */
+ /* whether or not the block was found to be empty */
+ /* during the reclaim phase. Typically generates */
+ /* about one screenful per garbage collection. */
+#undef PRINTBLOCKS
+
+#ifdef SILENT
+# ifdef PRINTSTATS
+# undef PRINTSTATS
+# endif
+# ifdef PRINTTIMES
+# undef PRINTTIMES
+# endif
+# ifdef PRINTNBLOCKS
+# undef PRINTNBLOCKS
+# endif
+#endif
+
+#if defined(PRINTSTATS) && !defined(GATHERSTATS)
+# define GATHERSTATS
+#endif
+
+#if defined(PRINTSTATS) || !defined(SMALL_CONFIG)
+# define CONDPRINT /* Print some things if GC_print_stats is set */
+#endif
+
+#define GC_INVOKE_FINALIZERS() GC_notify_or_invoke_finalizers()
+
+#define MERGE_SIZES /* Round up some object sizes, so that fewer distinct */
+ /* free lists are actually maintained. This applies */
+ /* only to the top level routines in misc.c, not to */
+ /* user generated code that calls GC_allocobj and */
+ /* GC_allocaobj directly. */
+ /* Slows down average programs slightly. May however */
+ /* substantially reduce fragmentation if allocation */
+ /* request sizes are widely scattered. */
+ /* May save significant amounts of space for obj_map */
+ /* entries. */
+
+#if defined(USE_MARK_BYTES) && !defined(ALIGN_DOUBLE)
+# define ALIGN_DOUBLE
+ /* We use one byte for every 2 words, which doesn't allow for */
+ /* odd numbered words to have mark bits. */
+#endif
+
+#if defined(GC_GCJ_SUPPORT) && ALIGNMENT < 8 && !defined(ALIGN_DOUBLE)
+ /* GCJ's Hashtable synchronization code requires 64-bit alignment. */
+# define ALIGN_DOUBLE
+#endif
+
+/* ALIGN_DOUBLE requires MERGE_SIZES at present. */
+# if defined(ALIGN_DOUBLE) && !defined(MERGE_SIZES)
+# define MERGE_SIZES
+# endif
+
+#if !defined(DONT_ADD_BYTE_AT_END)
+# define EXTRA_BYTES GC_all_interior_pointers
+#else
+# define EXTRA_BYTES 0
+#endif
+
+
+# ifndef LARGE_CONFIG
+# define MINHINCR 16 /* Minimum heap increment, in blocks of HBLKSIZE */
+ /* Must be multiple of largest page size. */
+# define MAXHINCR 2048 /* Maximum heap increment, in blocks */
+# else
+# define MINHINCR 64
+# define MAXHINCR 4096
+# endif
+
+# define TIME_LIMIT 50 /* We try to keep pause times from exceeding */
+ /* this by much. In milliseconds. */
+
+# define BL_LIMIT GC_black_list_spacing
+ /* If we need a block of N bytes, and we have */
+ /* a block of N + BL_LIMIT bytes available, */
+ /* and N > BL_LIMIT, */
+ /* but all possible positions in it are */
+ /* blacklisted, we just use it anyway (and */
+ /* print a warning, if warnings are enabled). */
+ /* This risks subsequently leaking the block */
+ /* due to a false reference. But not using */
+ /* the block risks unreasonable immediate */
+ /* heap growth. */
+
+/*********************************/
+/* */
+/* Stack saving for debugging */
+/* */
+/*********************************/
+
+#ifdef SAVE_CALL_CHAIN
+
+/* Fill in the pc and argument information for up to NFRAMES of my */
+/* callers. Ignore my frame and my callers frame. */
+struct callinfo;
+void GC_save_callers GC_PROTO((struct callinfo info[NFRAMES]));
+
+void GC_print_callers GC_PROTO((struct callinfo info[NFRAMES]));
+
+#endif
+
+#ifdef NEED_CALLINFO
+ struct callinfo {
+ word ci_pc; /* Caller, not callee, pc */
+# if NARGS > 0
+ word ci_arg[NARGS]; /* bit-wise complement to avoid retention */
+# endif
+# if defined(ALIGN_DOUBLE) && (NFRAMES * (NARGS + 1)) % 2 == 1
+ /* Likely alignment problem. */
+ word ci_dummy;
+# endif
+ };
+#endif
+
+
+/*********************************/
+/* */
+/* OS interface routines */
+/* */
+/*********************************/
+
+#ifdef BSD_TIME
+# undef CLOCK_TYPE
+# undef GET_TIME
+# undef MS_TIME_DIFF
+# define CLOCK_TYPE struct timeval
+# define GET_TIME(x) { struct rusage rusage; \
+ getrusage (RUSAGE_SELF, &rusage); \
+ x = rusage.ru_utime; }
+# define MS_TIME_DIFF(a,b) ((double) (a.tv_sec - b.tv_sec) * 1000.0 \
+ + (double) (a.tv_usec - b.tv_usec) / 1000.0)
+#else /* !BSD_TIME */
+# if defined(MSWIN32) || defined(MSWINCE)
+# include <windows.h>
+# include <winbase.h>
+# define CLOCK_TYPE DWORD
+# define GET_TIME(x) x = GetTickCount()
+# define MS_TIME_DIFF(a,b) ((long)((a)-(b)))
+# else /* !MSWIN32, !MSWINCE, !BSD_TIME */
+# include <time.h>
+# if !defined(__STDC__) && defined(SPARC) && defined(SUNOS4)
+ clock_t clock(); /* Not in time.h, where it belongs */
+# endif
+# if defined(FREEBSD) && !defined(CLOCKS_PER_SEC)
+# include <machine/limits.h>
+# define CLOCKS_PER_SEC CLK_TCK
+# endif
+# if !defined(CLOCKS_PER_SEC)
+# define CLOCKS_PER_SEC 1000000
+/*
+ * This is technically a bug in the implementation. ANSI requires that
+ * CLOCKS_PER_SEC be defined. But at least under SunOS4.1.1, it isn't.
+ * Also note that the combination of ANSI C and POSIX is incredibly gross
+ * here. The type clock_t is used by both clock() and times(). But on
+ * some machines these use different notions of a clock tick, CLOCKS_PER_SEC
+ * seems to apply only to clock. Hence we use it here. On many machines,
+ * including SunOS, clock actually uses units of microseconds (which are
+ * not really clock ticks).
+ */
+# endif
+# define CLOCK_TYPE clock_t
+# define GET_TIME(x) x = clock()
+# define MS_TIME_DIFF(a,b) ((unsigned long) \
+ (1000.0*(double)((a)-(b))/(double)CLOCKS_PER_SEC))
+# endif /* !MSWIN32 */
+#endif /* !BSD_TIME */
+
+/* We use bzero and bcopy internally. They may not be available. */
+# if defined(SPARC) && defined(SUNOS4)
+# define BCOPY_EXISTS
+# endif
+# if defined(M68K) && defined(AMIGA)
+# define BCOPY_EXISTS
+# endif
+# if defined(M68K) && defined(NEXT)
+# define BCOPY_EXISTS
+# endif
+# if defined(VAX)
+# define BCOPY_EXISTS
+# endif
+# if defined(AMIGA)
+# include <string.h>
+# define BCOPY_EXISTS
+# endif
+# if defined(MACOSX)
+# define BCOPY_EXISTS
+# endif
+
+# ifndef BCOPY_EXISTS
+# include <string.h>
+# define BCOPY(x,y,n) memcpy(y, x, (size_t)(n))
+# define BZERO(x,n) memset(x, 0, (size_t)(n))
+# else
+# define BCOPY(x,y,n) bcopy((char *)(x),(char *)(y),(int)(n))
+# define BZERO(x,n) bzero((char *)(x),(int)(n))
+# endif
+
+/* Delay any interrupts or signals that may abort this thread. Data */
+/* structures are in a consistent state outside this pair of calls. */
+/* ANSI C allows both to be empty (though the standard isn't very */
+/* clear on that point). Standard malloc implementations are usually */
+/* neither interruptable nor thread-safe, and thus correspond to */
+/* empty definitions. */
+/* It probably doesn't make any sense to declare these to be nonempty */
+/* if the code is being optimized, since signal safety relies on some */
+/* ordering constraints that are typically not obeyed by optimizing */
+/* compilers. */
+# ifdef PCR
+# define DISABLE_SIGNALS() \
+ PCR_Th_SetSigMask(PCR_allSigsBlocked,&GC_old_sig_mask)
+# define ENABLE_SIGNALS() \
+ PCR_Th_SetSigMask(&GC_old_sig_mask, NIL)
+# else
+# if defined(THREADS) || defined(AMIGA) \
+ || defined(MSWIN32) || defined(MSWINCE) || defined(MACOS) \
+ || defined(DJGPP) || defined(NO_SIGNALS)
+ /* Also useful for debugging. */
+ /* Should probably use thr_sigsetmask for GC_SOLARIS_THREADS. */
+# define DISABLE_SIGNALS()
+# define ENABLE_SIGNALS()
+# else
+# define DISABLE_SIGNALS() GC_disable_signals()
+ void GC_disable_signals();
+# define ENABLE_SIGNALS() GC_enable_signals()
+ void GC_enable_signals();
+# endif
+# endif
+
+/*
+ * Stop and restart mutator threads.
+ */
+# ifdef PCR
+# include "th/PCR_ThCtl.h"
+# define STOP_WORLD() \
+ PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_stopNormal, \
+ PCR_allSigsBlocked, \
+ PCR_waitForever)
+# define START_WORLD() \
+ PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_null, \
+ PCR_allSigsBlocked, \
+ PCR_waitForever);
+# else
+# if defined(GC_SOLARIS_THREADS) || defined(GC_WIN32_THREADS) \
+ || defined(GC_PTHREADS)
+ void GC_stop_world();
+ void GC_start_world();
+# define STOP_WORLD() GC_stop_world()
+# define START_WORLD() GC_start_world()
+# else
+# define STOP_WORLD()
+# define START_WORLD()
+# endif
+# endif
+
+/* Abandon ship */
+# ifdef PCR
+# define ABORT(s) PCR_Base_Panic(s)
+# else
+# ifdef SMALL_CONFIG
+# define ABORT(msg) abort();
+# else
+ GC_API void GC_abort GC_PROTO((GC_CONST char * msg));
+# define ABORT(msg) GC_abort(msg);
+# endif
+# endif
+
+/* Exit abnormally, but without making a mess (e.g. out of memory) */
+# ifdef PCR
+# define EXIT() PCR_Base_Exit(1,PCR_waitForever)
+# else
+# define EXIT() (void)exit(1)
+# endif
+
+/* Print warning message, e.g. almost out of memory. */
+# define WARN(msg,arg) (*GC_current_warn_proc)("GC Warning: " msg, (GC_word)(arg))
+extern GC_warn_proc GC_current_warn_proc;
+
+/* Get environment entry */
+#if !defined(NO_GETENV)
+# define GETENV(name) getenv(name)
+#else
+# define GETENV(name) 0
+#endif
+
+/*********************************/
+/* */
+/* Word-size-dependent defines */
+/* */
+/*********************************/
+
+#if CPP_WORDSZ == 32
+# define WORDS_TO_BYTES(x) ((x)<<2)
+# define BYTES_TO_WORDS(x) ((x)>>2)
+# define LOGWL ((word)5) /* log[2] of CPP_WORDSZ */
+# define modWORDSZ(n) ((n) & 0x1f) /* n mod size of word */
+# if ALIGNMENT != 4
+# define UNALIGNED
+# endif
+#endif
+
+#if CPP_WORDSZ == 64
+# define WORDS_TO_BYTES(x) ((x)<<3)
+# define BYTES_TO_WORDS(x) ((x)>>3)
+# define LOGWL ((word)6) /* log[2] of CPP_WORDSZ */
+# define modWORDSZ(n) ((n) & 0x3f) /* n mod size of word */
+# if ALIGNMENT != 8
+# define UNALIGNED
+# endif
+#endif
+
+#define WORDSZ ((word)CPP_WORDSZ)
+#define SIGNB ((word)1 << (WORDSZ-1))
+#define BYTES_PER_WORD ((word)(sizeof (word)))
+#define ONES ((word)(signed_word)(-1))
+#define divWORDSZ(n) ((n) >> LOGWL) /* divide n by size of word */
+
+/*********************/
+/* */
+/* Size Parameters */
+/* */
+/*********************/
+
+/* heap block size, bytes. Should be power of 2 */
+
+#ifndef HBLKSIZE
+# ifdef SMALL_CONFIG
+# define CPP_LOG_HBLKSIZE 10
+# else
+# if (CPP_WORDSZ == 32) || (defined(HPUX) && defined(HP_PA))
+ /* HPUX/PA seems to use 4K pages with the 64 bit ABI */
+# define CPP_LOG_HBLKSIZE 12
+# else
+# define CPP_LOG_HBLKSIZE 13
+# endif
+# endif
+#else
+# if HBLKSIZE == 512
+# define CPP_LOG_HBLKSIZE 9
+# endif
+# if HBLKSIZE == 1024
+# define CPP_LOG_HBLKSIZE 10
+# endif
+# if HBLKSIZE == 2048
+# define CPP_LOG_HBLKSIZE 11
+# endif
+# if HBLKSIZE == 4096
+# define CPP_LOG_HBLKSIZE 12
+# endif
+# if HBLKSIZE == 8192
+# define CPP_LOG_HBLKSIZE 13
+# endif
+# if HBLKSIZE == 16384
+# define CPP_LOG_HBLKSIZE 14
+# endif
+# ifndef CPP_LOG_HBLKSIZE
+ --> fix HBLKSIZE
+# endif
+# undef HBLKSIZE
+#endif
+# define CPP_HBLKSIZE (1 << CPP_LOG_HBLKSIZE)
+# define LOG_HBLKSIZE ((word)CPP_LOG_HBLKSIZE)
+# define HBLKSIZE ((word)CPP_HBLKSIZE)
+
+
+/* max size objects supported by freelist (larger objects may be */
+/* allocated, but less efficiently) */
+
+#define CPP_MAXOBJBYTES (CPP_HBLKSIZE/2)
+#define MAXOBJBYTES ((word)CPP_MAXOBJBYTES)
+#define CPP_MAXOBJSZ BYTES_TO_WORDS(CPP_HBLKSIZE/2)
+#define MAXOBJSZ ((word)CPP_MAXOBJSZ)
+
+# define divHBLKSZ(n) ((n) >> LOG_HBLKSIZE)
+
+# define HBLK_PTR_DIFF(p,q) divHBLKSZ((ptr_t)p - (ptr_t)q)
+ /* Equivalent to subtracting 2 hblk pointers. */
+ /* We do it this way because a compiler should */
+ /* find it hard to use an integer division */
+ /* instead of a shift. The bundled SunOS 4.1 */
+ /* o.w. sometimes pessimizes the subtraction to */
+ /* involve a call to .div. */
+
+# define modHBLKSZ(n) ((n) & (HBLKSIZE-1))
+
+# define HBLKPTR(objptr) ((struct hblk *)(((word) (objptr)) & ~(HBLKSIZE-1)))
+
+# define HBLKDISPL(objptr) (((word) (objptr)) & (HBLKSIZE-1))
+
+/* Round up byte allocation requests to integral number of words, etc. */
+# define ROUNDED_UP_WORDS(n) \
+ BYTES_TO_WORDS((n) + (WORDS_TO_BYTES(1) - 1 + EXTRA_BYTES))
+# ifdef ALIGN_DOUBLE
+# define ALIGNED_WORDS(n) \
+ (BYTES_TO_WORDS((n) + WORDS_TO_BYTES(2) - 1 + EXTRA_BYTES) & ~1)
+# else
+# define ALIGNED_WORDS(n) ROUNDED_UP_WORDS(n)
+# endif
+# define SMALL_OBJ(bytes) ((bytes) < (MAXOBJBYTES - EXTRA_BYTES))
+# define ADD_SLOP(bytes) ((bytes) + EXTRA_BYTES)
+# ifndef MIN_WORDS
+ /* MIN_WORDS is the size of the smallest allocated object. */
+ /* 1 and 2 are the only valid values. */
+ /* 2 must be used if: */
+ /* - GC_gcj_malloc can be used for objects of requested */
+ /* size smaller than 2 words, or */
+ /* - USE_MARK_BYTES is defined. */
+# if defined(USE_MARK_BYTES) || defined(GC_GCJ_SUPPORT)
+# define MIN_WORDS 2 /* Smallest allocated object. */
+# else
+# define MIN_WORDS 1
+# endif
+# endif
+
+
+/*
+ * Hash table representation of sets of pages. This assumes it is
+ * OK to add spurious entries to sets.
+ * Used by black-listing code, and perhaps by dirty bit maintenance code.
+ */
+
+# ifdef LARGE_CONFIG
+# define LOG_PHT_ENTRIES 20 /* Collisions likely at 1M blocks, */
+ /* which is >= 4GB. Each table takes */
+ /* 128KB, some of which may never be */
+ /* touched. */
+# else
+# ifdef SMALL_CONFIG
+# define LOG_PHT_ENTRIES 14 /* Collisions are likely if heap grows */
+ /* to more than 16K hblks = 64MB. */
+ /* Each hash table occupies 2K bytes. */
+# else /* default "medium" configuration */
+# define LOG_PHT_ENTRIES 16 /* Collisions are likely if heap grows */
+ /* to more than 64K hblks >= 256MB. */
+ /* Each hash table occupies 8K bytes. */
+# endif
+# endif
+# define PHT_ENTRIES ((word)1 << LOG_PHT_ENTRIES)
+# define PHT_SIZE (PHT_ENTRIES >> LOGWL)
+typedef word page_hash_table[PHT_SIZE];
+
+# define PHT_HASH(addr) ((((word)(addr)) >> LOG_HBLKSIZE) & (PHT_ENTRIES - 1))
+
+# define get_pht_entry_from_index(bl, index) \
+ (((bl)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
+# define set_pht_entry_from_index(bl, index) \
+ (bl)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
+# define clear_pht_entry_from_index(bl, index) \
+ (bl)[divWORDSZ(index)] &= ~((word)1 << modWORDSZ(index))
+/* And a dumb but thread-safe version of set_pht_entry_from_index. */
+/* This sets (many) extra bits. */
+# define set_pht_entry_from_index_safe(bl, index) \
+ (bl)[divWORDSZ(index)] = ONES
+
+
+
+/********************************************/
+/* */
+/* H e a p B l o c k s */
+/* */
+/********************************************/
+
+/* heap block header */
+#define HBLKMASK (HBLKSIZE-1)
+
+#define BITS_PER_HBLK (CPP_HBLKSIZE * 8)
+
+#define MARK_BITS_PER_HBLK (BITS_PER_HBLK/CPP_WORDSZ)
+ /* upper bound */
+ /* We allocate 1 bit/word, unless USE_MARK_BYTES */
+ /* is defined. Only the first word */
+ /* in each object is actually marked. */
+
+# ifdef USE_MARK_BYTES
+# define MARK_BITS_SZ (MARK_BITS_PER_HBLK/2)
+ /* Unlike the other case, this is in units of bytes. */
+ /* We actually allocate only every second mark bit, since we */
+ /* force all objects to be doubleword aligned. */
+ /* However, each mark bit is allocated as a byte. */
+# else
+# define MARK_BITS_SZ (MARK_BITS_PER_HBLK/CPP_WORDSZ)
+# endif
+
+/* We maintain layout maps for heap blocks containing objects of a given */
+/* size. Each entry in this map describes a byte offset and has the */
+/* following type. */
+typedef unsigned char map_entry_type;
+
+struct hblkhdr {
+ word hb_sz; /* If in use, size in words, of objects in the block. */
+ /* if free, the size in bytes of the whole block */
+ struct hblk * hb_next; /* Link field for hblk free list */
+ /* and for lists of chunks waiting to be */
+ /* reclaimed. */
+ struct hblk * hb_prev; /* Backwards link for free list. */
+ word hb_descr; /* object descriptor for marking. See */
+ /* mark.h. */
+ map_entry_type * hb_map;
+ /* A pointer to a pointer validity map of the block. */
+ /* See GC_obj_map. */
+ /* Valid for all blocks with headers. */
+ /* Free blocks point to GC_invalid_map. */
+ unsigned char hb_obj_kind;
+ /* Kind of objects in the block. Each kind */
+ /* identifies a mark procedure and a set of */
+ /* list headers. Sometimes called regions. */
+ unsigned char hb_flags;
+# define IGNORE_OFF_PAGE 1 /* Ignore pointers that do not */
+ /* point to the first page of */
+ /* this object. */
+# define WAS_UNMAPPED 2 /* This is a free block, which has */
+ /* been unmapped from the address */
+ /* space. */
+ /* GC_remap must be invoked on it */
+ /* before it can be reallocated. */
+ /* Only set with USE_MUNMAP. */
+ unsigned short hb_last_reclaimed;
+ /* Value of GC_gc_no when block was */
+ /* last allocated or swept. May wrap. */
+ /* For a free block, this is maintained */
+ /* only for USE_MUNMAP, and indicates */
+ /* when the header was allocated, or */
+ /* when the size of the block last */
+ /* changed. */
+# ifdef USE_MARK_BYTES
+ union {
+ char _hb_marks[MARK_BITS_SZ];
+ /* The i'th byte is 1 if the object */
+ /* starting at word 2i is marked, 0 o.w. */
+ word dummy; /* Force word alignment of mark bytes. */
+ } _mark_byte_union;
+# define hb_marks _mark_byte_union._hb_marks
+# else
+ word hb_marks[MARK_BITS_SZ];
+ /* Bit i in the array refers to the */
+ /* object starting at the ith word (header */
+ /* INCLUDED) in the heap block. */
+ /* The lsb of word 0 is numbered 0. */
+ /* Unused bits are invalid, and are */
+ /* occasionally set, e.g for uncollectable */
+ /* objects. */
+# endif /* !USE_MARK_BYTES */
+};
+
+/* heap block body */
+
+# define BODY_SZ (HBLKSIZE/sizeof(word))
+
+struct hblk {
+ word hb_body[BODY_SZ];
+};
+
+# define HBLK_IS_FREE(hdr) ((hdr) -> hb_map == GC_invalid_map)
+
+# define OBJ_SZ_TO_BLOCKS(sz) \
+ divHBLKSZ(WORDS_TO_BYTES(sz) + HBLKSIZE-1)
+ /* Size of block (in units of HBLKSIZE) needed to hold objects of */
+ /* given sz (in words). */
+
+/* Object free list link */
+# define obj_link(p) (*(ptr_t *)(p))
+
+# define LOG_MAX_MARK_PROCS 6
+# define MAX_MARK_PROCS (1 << LOG_MAX_MARK_PROCS)
+
+/* Root sets. Logically private to mark_rts.c. But we don't want the */
+/* tables scanned, so we put them here. */
+/* MAX_ROOT_SETS is the maximum number of ranges that can be */
+/* registered as static roots. */
+# ifdef LARGE_CONFIG
+# define MAX_ROOT_SETS 4096
+# else
+# ifdef PCR
+# define MAX_ROOT_SETS 1024
+# else
+# if defined(MSWIN32) || defined(MSWINCE)
+# define MAX_ROOT_SETS 1024
+ /* Under NT, we add only written pages, which can result */
+ /* in many small root sets. */
+# else
+# define MAX_ROOT_SETS 256
+# endif
+# endif
+# endif
+
+# define MAX_EXCLUSIONS (MAX_ROOT_SETS/4)
+/* Maximum number of segments that can be excluded from root sets. */
+
+/*
+ * Data structure for excluded static roots.
+ */
+struct exclusion {
+ ptr_t e_start;
+ ptr_t e_end;
+};
+
+/* Data structure for list of root sets. */
+/* We keep a hash table, so that we can filter out duplicate additions. */
+/* Under Win32, we need to do a better job of filtering overlaps, so */
+/* we resort to sequential search, and pay the price. */
+struct roots {
+ ptr_t r_start;
+ ptr_t r_end;
+# if !defined(MSWIN32) && !defined(MSWINCE)
+ struct roots * r_next;
+# endif
+ GC_bool r_tmp;
+ /* Delete before registering new dynamic libraries */
+};
+
+#if !defined(MSWIN32) && !defined(MSWINCE)
+ /* Size of hash table index to roots. */
+# define LOG_RT_SIZE 6
+# define RT_SIZE (1 << LOG_RT_SIZE) /* Power of 2, may be != MAX_ROOT_SETS */
+#endif
+
+/* Lists of all heap blocks and free lists */
+/* as well as other random data structures */
+/* that should not be scanned by the */
+/* collector. */
+/* These are grouped together in a struct */
+/* so that they can be easily skipped by the */
+/* GC_mark routine. */
+/* The ordering is weird to make GC_malloc */
+/* faster by keeping the important fields */
+/* sufficiently close together that a */
+/* single load of a base register will do. */
+/* Scalars that could easily appear to */
+/* be pointers are also put here. */
+/* The main fields should precede any */
+/* conditionally included fields, so that */
+/* gc_inl.h will work even if a different set */
+/* of macros is defined when the client is */
+/* compiled. */
+
+struct _GC_arrays {
+ word _heapsize;
+ word _max_heapsize;
+ word _requested_heapsize; /* Heap size due to explicit expansion */
+ ptr_t _last_heap_addr;
+ ptr_t _prev_heap_addr;
+ word _large_free_bytes;
+ /* Total bytes contained in blocks on large object free */
+ /* list. */
+ word _large_allocd_bytes;
+ /* Total number of bytes in allocated large objects blocks. */
+ /* For the purposes of this counter and the next one only, a */
+ /* large object is one that occupies a block of at least */
+ /* 2*HBLKSIZE. */
+ word _max_large_allocd_bytes;
+ /* Maximum number of bytes that were ever allocated in */
+ /* large object blocks. This is used to help decide when it */
+ /* is safe to split up a large block. */
+ word _words_allocd_before_gc;
+ /* Number of words allocated before this */
+ /* collection cycle. */
+# ifndef SEPARATE_GLOBALS
+ word _words_allocd;
+ /* Number of words allocated during this collection cycle */
+# endif
+ word _words_wasted;
+ /* Number of words wasted due to internal fragmentation */
+ /* in large objects, or due to dropping blacklisted */
+ /* blocks, since last gc. Approximate. */
+ word _words_finalized;
+ /* Approximate number of words in objects (and headers) */
+ /* That became ready for finalization in the last */
+ /* collection. */
+ word _non_gc_bytes_at_gc;
+ /* Number of explicitly managed bytes of storage */
+ /* at last collection. */
+ word _mem_freed;
+ /* Number of explicitly deallocated words of memory */
+ /* since last collection. */
+ word _finalizer_mem_freed;
+ /* Words of memory explicitly deallocated while */
+ /* finalizers were running. Used to approximate mem. */
+ /* explicitly deallocated by finalizers. */
+ ptr_t _scratch_end_ptr;
+ ptr_t _scratch_last_end_ptr;
+ /* Used by headers.c, and can easily appear to point to */
+ /* heap. */
+ GC_mark_proc _mark_procs[MAX_MARK_PROCS];
+ /* Table of user-defined mark procedures. There is */
+ /* a small number of these, which can be referenced */
+ /* by DS_PROC mark descriptors. See gc_mark.h. */
+
+# ifndef SEPARATE_GLOBALS
+ ptr_t _objfreelist[MAXOBJSZ+1];
+ /* free list for objects */
+ ptr_t _aobjfreelist[MAXOBJSZ+1];
+ /* free list for atomic objs */
+# endif
+
+ ptr_t _uobjfreelist[MAXOBJSZ+1];
+ /* uncollectable but traced objs */
+ /* objects on this and auobjfreelist */
+ /* are always marked, except during */
+ /* garbage collections. */
+# ifdef ATOMIC_UNCOLLECTABLE
+ ptr_t _auobjfreelist[MAXOBJSZ+1];
+# endif
+ /* uncollectable but traced objs */
+
+# ifdef GATHERSTATS
+ word _composite_in_use;
+ /* Number of words in accessible composite */
+ /* objects. */
+ word _atomic_in_use;
+ /* Number of words in accessible atomic */
+ /* objects. */
+# endif
+# ifdef USE_MUNMAP
+ word _unmapped_bytes;
+# endif
+# ifdef MERGE_SIZES
+ unsigned _size_map[WORDS_TO_BYTES(MAXOBJSZ+1)];
+ /* Number of words to allocate for a given allocation request in */
+ /* bytes. */
+# endif
+
+# ifdef STUBBORN_ALLOC
+ ptr_t _sobjfreelist[MAXOBJSZ+1];
+# endif
+ /* free list for immutable objects */
+ map_entry_type * _obj_map[MAXOBJSZ+1];
+ /* If not NIL, then a pointer to a map of valid */
+ /* object addresses. _obj_map[sz][i] is j if the */
+ /* address block_start+i is a valid pointer */
+ /* to an object at block_start + */
+ /* WORDS_TO_BYTES(BYTES_TO_WORDS(i) - j) */
+ /* I.e. j is a word displacement from the */
+ /* object beginning. */
+ /* The entry is OBJ_INVALID if the corresponding */
+ /* address is not a valid pointer. It is */
+ /* OFFSET_TOO_BIG if the value j would be too */
+ /* large to fit in the entry. (Note that the */
+ /* size of these entries matters, both for */
+ /* space consumption and for cache utilization. */
+# define OFFSET_TOO_BIG 0xfe
+# define OBJ_INVALID 0xff
+# define MAP_ENTRY(map, bytes) (map)[bytes]
+# define MAP_ENTRIES HBLKSIZE
+# define MAP_SIZE MAP_ENTRIES
+# define CPP_MAX_OFFSET (OFFSET_TOO_BIG - 1)
+# define MAX_OFFSET ((word)CPP_MAX_OFFSET)
+ /* The following are used only if GC_all_interior_ptrs != 0 */
+# define VALID_OFFSET_SZ \
+ (CPP_MAX_OFFSET > WORDS_TO_BYTES(CPP_MAXOBJSZ)? \
+ CPP_MAX_OFFSET+1 \
+ : WORDS_TO_BYTES(CPP_MAXOBJSZ)+1)
+ char _valid_offsets[VALID_OFFSET_SZ];
+ /* GC_valid_offsets[i] == TRUE ==> i */
+ /* is registered as a displacement. */
+# define OFFSET_VALID(displ) \
+ (GC_all_interior_pointers || GC_valid_offsets[displ])
+ char _modws_valid_offsets[sizeof(word)];
+ /* GC_valid_offsets[i] ==> */
+ /* GC_modws_valid_offsets[i%sizeof(word)] */
+# ifdef STUBBORN_ALLOC
+ page_hash_table _changed_pages;
+ /* Stubborn object pages that were changes since last call to */
+ /* GC_read_changed. */
+ page_hash_table _prev_changed_pages;
+ /* Stubborn object pages that were changes before last call to */
+ /* GC_read_changed. */
+# endif
+# if defined(PROC_VDB) || defined(MPROTECT_VDB)
+ page_hash_table _grungy_pages; /* Pages that were dirty at last */
+ /* GC_read_dirty. */
+# endif
+# ifdef MPROTECT_VDB
+ VOLATILE page_hash_table _dirty_pages;
+ /* Pages dirtied since last GC_read_dirty. */
+# endif
+# ifdef PROC_VDB
+ page_hash_table _written_pages; /* Pages ever dirtied */
+# endif
+# ifdef LARGE_CONFIG
+# if CPP_WORDSZ > 32
+# define MAX_HEAP_SECTS 4096 /* overflows at roughly 64 GB */
+# else
+# define MAX_HEAP_SECTS 768 /* Separately added heap sections. */
+# endif
+# else
+# ifdef SMALL_CONFIG
+# define MAX_HEAP_SECTS 128 /* Roughly 1GB */
+# else
+# define MAX_HEAP_SECTS 384 /* Roughly 3GB */
+# endif
+# endif
+ struct HeapSect {
+ ptr_t hs_start; word hs_bytes;
+ } _heap_sects[MAX_HEAP_SECTS];
+# if defined(MSWIN32) || defined(MSWINCE)
+ ptr_t _heap_bases[MAX_HEAP_SECTS];
+ /* Start address of memory regions obtained from kernel. */
+# endif
+# ifdef MSWINCE
+ word _heap_lengths[MAX_HEAP_SECTS];
+ /* Commited lengths of memory regions obtained from kernel. */
+# endif
+ struct roots _static_roots[MAX_ROOT_SETS];
+# if !defined(MSWIN32) && !defined(MSWINCE)
+ struct roots * _root_index[RT_SIZE];
+# endif
+ struct exclusion _excl_table[MAX_EXCLUSIONS];
+ /* Block header index; see gc_headers.h */
+ bottom_index * _all_nils;
+ bottom_index * _top_index [TOP_SZ];
+#ifdef SAVE_CALL_CHAIN
+ struct callinfo _last_stack[NFRAMES]; /* Stack at last garbage collection.*/
+ /* Useful for debugging mysterious */
+ /* object disappearances. */
+ /* In the multithreaded case, we */
+ /* currently only save the calling */
+ /* stack. */
+#endif
+};
+
+GC_API GC_FAR struct _GC_arrays GC_arrays;
+
+# ifndef SEPARATE_GLOBALS
+# define GC_objfreelist GC_arrays._objfreelist
+# define GC_aobjfreelist GC_arrays._aobjfreelist
+# define GC_words_allocd GC_arrays._words_allocd
+# endif
+# define GC_uobjfreelist GC_arrays._uobjfreelist
+# ifdef ATOMIC_UNCOLLECTABLE
+# define GC_auobjfreelist GC_arrays._auobjfreelist
+# endif
+# define GC_sobjfreelist GC_arrays._sobjfreelist
+# define GC_valid_offsets GC_arrays._valid_offsets
+# define GC_modws_valid_offsets GC_arrays._modws_valid_offsets
+# ifdef STUBBORN_ALLOC
+# define GC_changed_pages GC_arrays._changed_pages
+# define GC_prev_changed_pages GC_arrays._prev_changed_pages
+# endif
+# define GC_obj_map GC_arrays._obj_map
+# define GC_last_heap_addr GC_arrays._last_heap_addr
+# define GC_prev_heap_addr GC_arrays._prev_heap_addr
+# define GC_words_wasted GC_arrays._words_wasted
+# define GC_large_free_bytes GC_arrays._large_free_bytes
+# define GC_large_allocd_bytes GC_arrays._large_allocd_bytes
+# define GC_max_large_allocd_bytes GC_arrays._max_large_allocd_bytes
+# define GC_words_finalized GC_arrays._words_finalized
+# define GC_non_gc_bytes_at_gc GC_arrays._non_gc_bytes_at_gc
+# define GC_mem_freed GC_arrays._mem_freed
+# define GC_finalizer_mem_freed GC_arrays._finalizer_mem_freed
+# define GC_scratch_end_ptr GC_arrays._scratch_end_ptr
+# define GC_scratch_last_end_ptr GC_arrays._scratch_last_end_ptr
+# define GC_mark_procs GC_arrays._mark_procs
+# define GC_heapsize GC_arrays._heapsize
+# define GC_max_heapsize GC_arrays._max_heapsize
+# define GC_requested_heapsize GC_arrays._requested_heapsize
+# define GC_words_allocd_before_gc GC_arrays._words_allocd_before_gc
+# define GC_heap_sects GC_arrays._heap_sects
+# define GC_last_stack GC_arrays._last_stack
+# ifdef USE_MUNMAP
+# define GC_unmapped_bytes GC_arrays._unmapped_bytes
+# endif
+# if defined(MSWIN32) || defined(MSWINCE)
+# define GC_heap_bases GC_arrays._heap_bases
+# endif
+# ifdef MSWINCE
+# define GC_heap_lengths GC_arrays._heap_lengths
+# endif
+# define GC_static_roots GC_arrays._static_roots
+# define GC_root_index GC_arrays._root_index
+# define GC_excl_table GC_arrays._excl_table
+# define GC_all_nils GC_arrays._all_nils
+# define GC_top_index GC_arrays._top_index
+# if defined(PROC_VDB) || defined(MPROTECT_VDB)
+# define GC_grungy_pages GC_arrays._grungy_pages
+# endif
+# ifdef MPROTECT_VDB
+# define GC_dirty_pages GC_arrays._dirty_pages
+# endif
+# ifdef PROC_VDB
+# define GC_written_pages GC_arrays._written_pages
+# endif
+# ifdef GATHERSTATS
+# define GC_composite_in_use GC_arrays._composite_in_use
+# define GC_atomic_in_use GC_arrays._atomic_in_use
+# endif
+# ifdef MERGE_SIZES
+# define GC_size_map GC_arrays._size_map
+# endif
+
+# define beginGC_arrays ((ptr_t)(&GC_arrays))
+# define endGC_arrays (((ptr_t)(&GC_arrays)) + (sizeof GC_arrays))
+
+#define USED_HEAP_SIZE (GC_heapsize - GC_large_free_bytes)
+
+/* Object kinds: */
+# define MAXOBJKINDS 16
+
+extern struct obj_kind {
+ ptr_t *ok_freelist; /* Array of free listheaders for this kind of object */
+ /* Point either to GC_arrays or to storage allocated */
+ /* with GC_scratch_alloc. */
+ struct hblk **ok_reclaim_list;
+ /* List headers for lists of blocks waiting to be */
+ /* swept. */
+ word ok_descriptor; /* Descriptor template for objects in this */
+ /* block. */
+ GC_bool ok_relocate_descr;
+ /* Add object size in bytes to descriptor */
+ /* template to obtain descriptor. Otherwise */
+ /* template is used as is. */
+ GC_bool ok_init; /* Clear objects before putting them on the free list. */
+} GC_obj_kinds[MAXOBJKINDS];
+
+# define beginGC_obj_kinds ((ptr_t)(&GC_obj_kinds))
+# define endGC_obj_kinds (beginGC_obj_kinds + (sizeof GC_obj_kinds))
+
+/* Variables that used to be in GC_arrays, but need to be accessed by */
+/* inline allocation code. If they were in GC_arrays, the inlined */
+/* allocation code would include GC_arrays offsets (as it did), which */
+/* introduce maintenance problems. */
+
+#ifdef SEPARATE_GLOBALS
+ word GC_words_allocd;
+ /* Number of words allocated during this collection cycle */
+ ptr_t GC_objfreelist[MAXOBJSZ+1];
+ /* free list for NORMAL objects */
+# define beginGC_objfreelist ((ptr_t)(&GC_objfreelist))
+# define endGC_objfreelist (beginGC_objfreelist + sizeof(GC_objfreelist))
+
+ ptr_t GC_aobjfreelist[MAXOBJSZ+1];
+ /* free list for atomic (PTRFREE) objs */
+# define beginGC_aobjfreelist ((ptr_t)(&GC_aobjfreelist))
+# define endGC_aobjfreelist (beginGC_aobjfreelist + sizeof(GC_aobjfreelist))
+#endif
+
+/* Predefined kinds: */
+# define PTRFREE 0
+# define NORMAL 1
+# define UNCOLLECTABLE 2
+# ifdef ATOMIC_UNCOLLECTABLE
+# define AUNCOLLECTABLE 3
+# define STUBBORN 4
+# define IS_UNCOLLECTABLE(k) (((k) & ~1) == UNCOLLECTABLE)
+# else
+# define STUBBORN 3
+# define IS_UNCOLLECTABLE(k) ((k) == UNCOLLECTABLE)
+# endif
+
+extern int GC_n_kinds;
+
+GC_API word GC_fo_entries;
+
+extern word GC_n_heap_sects; /* Number of separately added heap */
+ /* sections. */
+
+extern word GC_page_size;
+
+# if defined(MSWIN32) || defined(MSWINCE)
+ struct _SYSTEM_INFO;
+ extern struct _SYSTEM_INFO GC_sysinfo;
+ extern word GC_n_heap_bases; /* See GC_heap_bases. */
+# endif
+
+extern word GC_total_stack_black_listed;
+ /* Number of bytes on stack blacklist. */
+
+extern word GC_black_list_spacing;
+ /* Average number of bytes between blacklisted */
+ /* blocks. Approximate. */
+ /* Counts only blocks that are */
+ /* "stack-blacklisted", i.e. that are */
+ /* problematic in the interior of an object. */
+
+extern map_entry_type * GC_invalid_map;
+ /* Pointer to the nowhere valid hblk map */
+ /* Blocks pointing to this map are free. */
+
+extern struct hblk * GC_hblkfreelist[];
+ /* List of completely empty heap blocks */
+ /* Linked through hb_next field of */
+ /* header structure associated with */
+ /* block. */
+
+extern GC_bool GC_objects_are_marked; /* There are marked objects in */
+ /* the heap. */
+
+#ifndef SMALL_CONFIG
+ extern GC_bool GC_incremental;
+ /* Using incremental/generational collection. */
+# define TRUE_INCREMENTAL \
+ (GC_incremental && GC_time_limit != GC_TIME_UNLIMITED)
+ /* True incremental, not just generational, mode */
+#else
+# define GC_incremental FALSE
+ /* Hopefully allow optimizer to remove some code. */
+# define TRUE_INCREMENTAL FALSE
+#endif
+
+extern GC_bool GC_dirty_maintained;
+ /* Dirty bits are being maintained, */
+ /* either for incremental collection, */
+ /* or to limit the root set. */
+
+extern word GC_root_size; /* Total size of registered root sections */
+
+extern GC_bool GC_debugging_started; /* GC_debug_malloc has been called. */
+
+extern long GC_large_alloc_warn_interval;
+ /* Interval between unsuppressed warnings. */
+
+extern long GC_large_alloc_warn_suppressed;
+ /* Number of warnings suppressed so far. */
+
+/* Operations */
+# ifndef abs
+# define abs(x) ((x) < 0? (-(x)) : (x))
+# endif
+
+
+/* Marks are in a reserved area in */
+/* each heap block. Each word has one mark bit associated */
+/* with it. Only those corresponding to the beginning of an */
+/* object are used. */
+
+/* Set mark bit correctly, even if mark bits may be concurrently */
+/* accessed. */
+#ifdef PARALLEL_MARK
+# define OR_WORD(addr, bits) \
+ { word old; \
+ do { \
+ old = *((volatile word *)addr); \
+ } while (!GC_compare_and_exchange((addr), old, old | (bits))); \
+ }
+# define OR_WORD_EXIT_IF_SET(addr, bits, exit_label) \
+ { word old; \
+ word my_bits = (bits); \
+ do { \
+ old = *((volatile word *)addr); \
+ if (old & my_bits) goto exit_label; \
+ } while (!GC_compare_and_exchange((addr), old, old | my_bits)); \
+ }
+#else
+# define OR_WORD(addr, bits) *(addr) |= (bits)
+# define OR_WORD_EXIT_IF_SET(addr, bits, exit_label) \
+ { \
+ word old = *(addr); \
+ word my_bits = (bits); \
+ if (old & my_bits) goto exit_label; \
+ *(addr) = (old | my_bits); \
+ }
+#endif
+
+/* Mark bit operations */
+
+/*
+ * Retrieve, set, clear the mark bit corresponding
+ * to the nth word in a given heap block.
+ *
+ * (Recall that bit n corresponds to object beginning at word n
+ * relative to the beginning of the block, including unused words)
+ */
+
+#ifdef USE_MARK_BYTES
+# define mark_bit_from_hdr(hhdr,n) ((hhdr)->hb_marks[(n) >> 1])
+# define set_mark_bit_from_hdr(hhdr,n) ((hhdr)->hb_marks[(n)>>1]) = 1
+# define clear_mark_bit_from_hdr(hhdr,n) ((hhdr)->hb_marks[(n)>>1]) = 0
+#else /* !USE_MARK_BYTES */
+# define mark_bit_from_hdr(hhdr,n) (((hhdr)->hb_marks[divWORDSZ(n)] \
+ >> (modWORDSZ(n))) & (word)1)
+# define set_mark_bit_from_hdr(hhdr,n) \
+ OR_WORD((hhdr)->hb_marks+divWORDSZ(n), \
+ (word)1 << modWORDSZ(n))
+# define clear_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
+ &= ~((word)1 << modWORDSZ(n))
+#endif /* !USE_MARK_BYTES */
+
+/* Important internal collector routines */
+
+ptr_t GC_approx_sp GC_PROTO((void));
+
+GC_bool GC_should_collect GC_PROTO((void));
+
+void GC_apply_to_all_blocks GC_PROTO(( \
+ void (*fn) GC_PROTO((struct hblk *h, word client_data)), \
+ word client_data));
+ /* Invoke fn(hbp, client_data) for each */
+ /* allocated heap block. */
+struct hblk * GC_next_used_block GC_PROTO((struct hblk * h));
+ /* Return first in-use block >= h */
+struct hblk * GC_prev_block GC_PROTO((struct hblk * h));
+ /* Return last block <= h. Returned block */
+ /* is managed by GC, but may or may not be in */
+ /* use. */
+void GC_mark_init GC_PROTO((void));
+void GC_clear_marks GC_PROTO((void)); /* Clear mark bits for all heap objects. */
+void GC_invalidate_mark_state GC_PROTO((void));
+ /* Tell the marker that marked */
+ /* objects may point to unmarked */
+ /* ones, and roots may point to */
+ /* unmarked objects. */
+ /* Reset mark stack. */
+GC_bool GC_mark_stack_empty GC_PROTO((void));
+GC_bool GC_mark_some GC_PROTO((ptr_t cold_gc_frame));
+ /* Perform about one pages worth of marking */
+ /* work of whatever kind is needed. Returns */
+ /* quickly if no collection is in progress. */
+ /* Return TRUE if mark phase finished. */
+void GC_initiate_gc GC_PROTO((void));
+ /* initiate collection. */
+ /* If the mark state is invalid, this */
+ /* becomes full colleection. Otherwise */
+ /* it's partial. */
+void GC_push_all GC_PROTO((ptr_t bottom, ptr_t top));
+ /* Push everything in a range */
+ /* onto mark stack. */
+void GC_push_selected GC_PROTO(( \
+ ptr_t bottom, \
+ ptr_t top, \
+ int (*dirty_fn) GC_PROTO((struct hblk *h)), \
+ void (*push_fn) GC_PROTO((ptr_t bottom, ptr_t top)) ));
+ /* Push all pages h in [b,t) s.t. */
+ /* select_fn(h) != 0 onto mark stack. */
+#ifndef SMALL_CONFIG
+ void GC_push_conditional GC_PROTO((ptr_t b, ptr_t t, GC_bool all));
+#else
+# define GC_push_conditional(b, t, all) GC_push_all(b, t)
+#endif
+ /* Do either of the above, depending */
+ /* on the third arg. */
+void GC_push_all_stack GC_PROTO((ptr_t b, ptr_t t));
+ /* As above, but consider */
+ /* interior pointers as valid */
+void GC_push_all_eager GC_PROTO((ptr_t b, ptr_t t));
+ /* Same as GC_push_all_stack, but */
+ /* ensures that stack is scanned */
+ /* immediately, not just scheduled */
+ /* for scanning. */
+#ifndef THREADS
+ void GC_push_all_stack_partially_eager GC_PROTO(( \
+ ptr_t bottom, ptr_t top, ptr_t cold_gc_frame ));
+ /* Similar to GC_push_all_eager, but only the */
+ /* part hotter than cold_gc_frame is scanned */
+ /* immediately. Needed to ensure that callee- */
+ /* save registers are not missed. */
+#else
+ /* In the threads case, we push part of the current thread stack */
+ /* with GC_push_all_eager when we push the registers. This gets the */
+ /* callee-save registers that may disappear. The remainder of the */
+ /* stacks are scheduled for scanning in *GC_push_other_roots, which */
+ /* is thread-package-specific. */
+#endif
+void GC_push_current_stack GC_PROTO((ptr_t cold_gc_frame));
+ /* Push enough of the current stack eagerly to */
+ /* ensure that callee-save registers saved in */
+ /* GC frames are scanned. */
+ /* In the non-threads case, schedule entire */
+ /* stack for scanning. */
+void GC_push_roots GC_PROTO((GC_bool all, ptr_t cold_gc_frame));
+ /* Push all or dirty roots. */
+extern void (*GC_push_other_roots) GC_PROTO((void));
+ /* Push system or application specific roots */
+ /* onto the mark stack. In some environments */
+ /* (e.g. threads environments) this is */
+ /* predfined to be non-zero. A client supplied */
+ /* replacement should also call the original */
+ /* function. */
+extern void GC_push_gc_structures GC_PROTO((void));
+ /* Push GC internal roots. These are normally */
+ /* included in the static data segment, and */
+ /* Thus implicitly pushed. But we must do this */
+ /* explicitly if normal root processing is */
+ /* disabled. Calls the following: */
+ extern void GC_push_finalizer_structures GC_PROTO((void));
+ extern void GC_push_stubborn_structures GC_PROTO((void));
+# ifdef THREADS
+ extern void GC_push_thread_structures GC_PROTO((void));
+# endif
+extern void (*GC_start_call_back) GC_PROTO((void));
+ /* Called at start of full collections. */
+ /* Not called if 0. Called with allocation */
+ /* lock held. */
+ /* 0 by default. */
+# if defined(USE_GENERIC_PUSH_REGS)
+ void GC_generic_push_regs GC_PROTO((ptr_t cold_gc_frame));
+# else
+ void GC_push_regs GC_PROTO((void));
+# endif
+ /* Push register contents onto mark stack. */
+ /* If NURSERY is defined, the default push */
+ /* action can be overridden with GC_push_proc */
+
+# ifdef NURSERY
+ extern void (*GC_push_proc)(ptr_t);
+# endif
+# if defined(MSWIN32) || defined(MSWINCE)
+ void __cdecl GC_push_one GC_PROTO((word p));
+# else
+ void GC_push_one GC_PROTO((word p));
+ /* If p points to an object, mark it */
+ /* and push contents on the mark stack */
+ /* Pointer recognition test always */
+ /* accepts interior pointers, i.e. this */
+ /* is appropriate for pointers found on */
+ /* stack. */
+# endif
+# if defined(PRINT_BLACK_LIST) || defined(KEEP_BACK_PTRS)
+ void GC_mark_and_push_stack GC_PROTO((word p, ptr_t source));
+ /* Ditto, omits plausibility test */
+# else
+ void GC_mark_and_push_stack GC_PROTO((word p));
+# endif
+void GC_push_marked GC_PROTO((struct hblk * h, hdr * hhdr));
+ /* Push contents of all marked objects in h onto */
+ /* mark stack. */
+#ifdef SMALL_CONFIG
+# define GC_push_next_marked_dirty(h) GC_push_next_marked(h)
+#else
+ struct hblk * GC_push_next_marked_dirty GC_PROTO((struct hblk * h));
+ /* Invoke GC_push_marked on next dirty block above h. */
+ /* Return a pointer just past the end of this block. */
+#endif /* !SMALL_CONFIG */
+struct hblk * GC_push_next_marked GC_PROTO((struct hblk * h));
+ /* Ditto, but also mark from clean pages. */
+struct hblk * GC_push_next_marked_uncollectable GC_PROTO((struct hblk * h));
+ /* Ditto, but mark only from uncollectable pages. */
+GC_bool GC_stopped_mark GC_PROTO((GC_stop_func stop_func));
+ /* Stop world and mark from all roots */
+ /* and rescuers. */
+void GC_clear_hdr_marks GC_PROTO((hdr * hhdr));
+ /* Clear the mark bits in a header */
+void GC_set_hdr_marks GC_PROTO((hdr * hhdr));
+ /* Set the mark bits in a header */
+void GC_set_fl_marks GC_PROTO((ptr_t p));
+ /* Set all mark bits associated with */
+ /* a free list. */
+void GC_add_roots_inner GC_PROTO((char * b, char * e, GC_bool tmp));
+GC_bool GC_is_static_root GC_PROTO((ptr_t p));
+ /* Is the address p in one of the registered static */
+ /* root sections? */
+# if defined(MSWIN32) || defined(_WIN32_WCE_EMULATION)
+GC_bool GC_is_tmp_root GC_PROTO((ptr_t p));
+ /* Is the address p in one of the temporary static */
+ /* root sections? */
+# endif
+void GC_register_dynamic_libraries GC_PROTO((void));
+ /* Add dynamic library data sections to the root set. */
+
+GC_bool GC_register_main_static_data GC_PROTO((void));
+ /* We need to register the main data segment. Returns */
+ /* TRUE unless this is done implicitly as part of */
+ /* dynamic library registration. */
+
+/* Machine dependent startup routines */
+ptr_t GC_get_stack_base GC_PROTO((void)); /* Cold end of stack */
+#ifdef IA64
+ ptr_t GC_get_register_stack_base GC_PROTO((void));
+ /* Cold end of register stack. */
+#endif
+void GC_register_data_segments GC_PROTO((void));
+
+/* Black listing: */
+void GC_bl_init GC_PROTO((void));
+# ifdef PRINT_BLACK_LIST
+ void GC_add_to_black_list_normal GC_PROTO((word p, ptr_t source));
+ /* Register bits as a possible future false */
+ /* reference from the heap or static data */
+# define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+ if (GC_all_interior_pointers) { \
+ GC_add_to_black_list_stack(bits, (ptr_t)(source)); \
+ } else { \
+ GC_add_to_black_list_normal(bits, (ptr_t)(source)); \
+ }
+# else
+ void GC_add_to_black_list_normal GC_PROTO((word p));
+# define GC_ADD_TO_BLACK_LIST_NORMAL(bits, source) \
+ if (GC_all_interior_pointers) { \
+ GC_add_to_black_list_stack(bits); \
+ } else { \
+ GC_add_to_black_list_normal(bits); \
+ }
+# endif
+
+# ifdef PRINT_BLACK_LIST
+ void GC_add_to_black_list_stack GC_PROTO((word p, ptr_t source));
+# else
+ void GC_add_to_black_list_stack GC_PROTO((word p));
+# endif
+struct hblk * GC_is_black_listed GC_PROTO((struct hblk * h, word len));
+ /* If there are likely to be false references */
+ /* to a block starting at h of the indicated */
+ /* length, then return the next plausible */
+ /* starting location for h that might avoid */
+ /* these false references. */
+void GC_promote_black_lists GC_PROTO((void));
+ /* Declare an end to a black listing phase. */
+void GC_unpromote_black_lists GC_PROTO((void));
+ /* Approximately undo the effect of the above. */
+ /* This actually loses some information, but */
+ /* only in a reasonably safe way. */
+word GC_number_stack_black_listed GC_PROTO(( \
+ struct hblk *start, struct hblk *endp1));
+ /* Return the number of (stack) blacklisted */
+ /* blocks in the range for statistical */
+ /* purposes. */
+
+ptr_t GC_scratch_alloc GC_PROTO((word bytes));
+ /* GC internal memory allocation for */
+ /* small objects. Deallocation is not */
+ /* possible. */
+
+/* Heap block layout maps: */
+void GC_invalidate_map GC_PROTO((hdr * hhdr));
+ /* Remove the object map associated */
+ /* with the block. This identifies */
+ /* the block as invalid to the mark */
+ /* routines. */
+GC_bool GC_add_map_entry GC_PROTO((word sz));
+ /* Add a heap block map for objects of */
+ /* size sz to obj_map. */
+ /* Return FALSE on failure. */
+void GC_register_displacement_inner GC_PROTO((word offset));
+ /* Version of GC_register_displacement */
+ /* that assumes lock is already held */
+ /* and signals are already disabled. */
+
+/* hblk allocation: */
+void GC_new_hblk GC_PROTO((word size_in_words, int kind));
+ /* Allocate a new heap block, and build */
+ /* a free list in it. */
+
+ptr_t GC_build_fl GC_PROTO((struct hblk *h, word sz,
+ GC_bool clear, ptr_t list));
+ /* Build a free list for objects of */
+ /* size sz in block h. Append list to */
+ /* end of the free lists. Possibly */
+ /* clear objects on the list. Normally */
+ /* called by GC_new_hblk, but also */
+ /* called explicitly without GC lock. */
+
+struct hblk * GC_allochblk GC_PROTO(( \
+ word size_in_words, int kind, unsigned flags));
+ /* Allocate a heap block, inform */
+ /* the marker that block is valid */
+ /* for objects of indicated size. */
+
+ptr_t GC_alloc_large GC_PROTO((word lw, int k, unsigned flags));
+ /* Allocate a large block of size lw words. */
+ /* The block is not cleared. */
+ /* Flags is 0 or IGNORE_OFF_PAGE. */
+ /* Calls GC_allchblk to do the actual */
+ /* allocation, but also triggers GC and/or */
+ /* heap expansion as appropriate. */
+ /* Does not update GC_words_allocd, but does */
+ /* other accounting. */
+
+ptr_t GC_alloc_large_and_clear GC_PROTO((word lw, int k, unsigned flags));
+ /* As above, but clear block if appropriate */
+ /* for kind k. */
+
+void GC_freehblk GC_PROTO((struct hblk * p));
+ /* Deallocate a heap block and mark it */
+ /* as invalid. */
+
+/* Misc GC: */
+void GC_init_inner GC_PROTO((void));
+GC_bool GC_expand_hp_inner GC_PROTO((word n));
+void GC_start_reclaim GC_PROTO((int abort_if_found));
+ /* Restore unmarked objects to free */
+ /* lists, or (if abort_if_found is */
+ /* TRUE) report them. */
+ /* Sweeping of small object pages is */
+ /* largely deferred. */
+void GC_continue_reclaim GC_PROTO((word sz, int kind));
+ /* Sweep pages of the given size and */
+ /* kind, as long as possible, and */
+ /* as long as the corr. free list is */
+ /* empty. */
+void GC_reclaim_or_delete_all GC_PROTO((void));
+ /* Arrange for all reclaim lists to be */
+ /* empty. Judiciously choose between */
+ /* sweeping and discarding each page. */
+GC_bool GC_reclaim_all GC_PROTO((GC_stop_func stop_func, GC_bool ignore_old));
+ /* Reclaim all blocks. Abort (in a */
+ /* consistent state) if f returns TRUE. */
+GC_bool GC_block_empty GC_PROTO((hdr * hhdr));
+ /* Block completely unmarked? */
+GC_bool GC_never_stop_func GC_PROTO((void));
+ /* Returns FALSE. */
+GC_bool GC_try_to_collect_inner GC_PROTO((GC_stop_func f));
+
+ /* Collect; caller must have acquired */
+ /* lock and disabled signals. */
+ /* Collection is aborted if f returns */
+ /* TRUE. Returns TRUE if it completes */
+ /* successfully. */
+# define GC_gcollect_inner() \
+ (void) GC_try_to_collect_inner(GC_never_stop_func)
+void GC_finish_collection GC_PROTO((void));
+ /* Finish collection. Mark bits are */
+ /* consistent and lock is still held. */
+GC_bool GC_collect_or_expand GC_PROTO(( \
+ word needed_blocks, GC_bool ignore_off_page));
+ /* Collect or expand heap in an attempt */
+ /* make the indicated number of free */
+ /* blocks available. Should be called */
+ /* until the blocks are available or */
+ /* until it fails by returning FALSE. */
+
+extern GC_bool GC_is_initialized; /* GC_init() has been run. */
+
+#if defined(MSWIN32) || defined(MSWINCE)
+ void GC_deinit GC_PROTO((void));
+ /* Free any resources allocated by */
+ /* GC_init */
+#endif
+
+void GC_collect_a_little_inner GC_PROTO((int n));
+ /* Do n units worth of garbage */
+ /* collection work, if appropriate. */
+ /* A unit is an amount appropriate for */
+ /* HBLKSIZE bytes of allocation. */
+ptr_t GC_generic_malloc GC_PROTO((word lb, int k));
+ /* Allocate an object of the given */
+ /* kind. By default, there are only */
+ /* a few kinds: composite(pointerfree), */
+ /* atomic, uncollectable, etc. */
+ /* We claim it's possible for clever */
+ /* client code that understands GC */
+ /* internals to add more, e.g. to */
+ /* communicate object layout info */
+ /* to the collector. */
+ptr_t GC_generic_malloc_ignore_off_page GC_PROTO((size_t b, int k));
+ /* As above, but pointers past the */
+ /* first page of the resulting object */
+ /* are ignored. */
+ptr_t GC_generic_malloc_inner GC_PROTO((word lb, int k));
+ /* Ditto, but I already hold lock, etc. */
+ptr_t GC_generic_malloc_words_small GC_PROTO((size_t lw, int k));
+ /* As above, but size in units of words */
+ /* Bypasses MERGE_SIZES. Assumes */
+ /* words <= MAXOBJSZ. */
+ptr_t GC_generic_malloc_inner_ignore_off_page GC_PROTO((size_t lb, int k));
+ /* Allocate an object, where */
+ /* the client guarantees that there */
+ /* will always be a pointer to the */
+ /* beginning of the object while the */
+ /* object is live. */
+ptr_t GC_allocobj GC_PROTO((word sz, int kind));
+ /* Make the indicated */
+ /* free list nonempty, and return its */
+ /* head. */
+
+void GC_init_headers GC_PROTO((void));
+struct hblkhdr * GC_install_header GC_PROTO((struct hblk *h));
+ /* Install a header for block h. */
+ /* Return 0 on failure, or the header */
+ /* otherwise. */
+GC_bool GC_install_counts GC_PROTO((struct hblk * h, word sz));
+ /* Set up forwarding counts for block */
+ /* h of size sz. */
+ /* Return FALSE on failure. */
+void GC_remove_header GC_PROTO((struct hblk * h));
+ /* Remove the header for block h. */
+void GC_remove_counts GC_PROTO((struct hblk * h, word sz));
+ /* Remove forwarding counts for h. */
+hdr * GC_find_header GC_PROTO((ptr_t h)); /* Debugging only. */
+
+void GC_finalize GC_PROTO((void));
+ /* Perform all indicated finalization actions */
+ /* on unmarked objects. */
+ /* Unreachable finalizable objects are enqueued */
+ /* for processing by GC_invoke_finalizers. */
+ /* Invoked with lock. */
+
+void GC_notify_or_invoke_finalizers GC_PROTO((void));
+ /* If GC_finalize_on_demand is not set, invoke */
+ /* eligible finalizers. Otherwise: */
+ /* Call *GC_finalizer_notifier if there are */
+ /* finalizers to be run, and we haven't called */
+ /* this procedure yet this GC cycle. */
+
+GC_API GC_PTR GC_make_closure GC_PROTO((GC_finalization_proc fn, GC_PTR data));
+GC_API void GC_debug_invoke_finalizer GC_PROTO((GC_PTR obj, GC_PTR data));
+ /* Auxiliary fns to make finalization work */
+ /* correctly with displaced pointers introduced */
+ /* by the debugging allocators. */
+
+void GC_add_to_heap GC_PROTO((struct hblk *p, word bytes));
+ /* Add a HBLKSIZE aligned chunk to the heap. */
+
+void GC_print_obj GC_PROTO((ptr_t p));
+ /* P points to somewhere inside an object with */
+ /* debugging info. Print a human readable */
+ /* description of the object to stderr. */
+extern void (*GC_check_heap) GC_PROTO((void));
+ /* Check that all objects in the heap with */
+ /* debugging info are intact. */
+ /* Add any that are not to GC_smashed list. */
+extern void (*GC_print_all_smashed) GC_PROTO((void));
+ /* Print GC_smashed if it's not empty. */
+ /* Clear GC_smashed list. */
+extern void GC_print_all_errors GC_PROTO((void));
+ /* Print smashed and leaked objects, if any. */
+ /* Clear the lists of such objects. */
+extern void (*GC_print_heap_obj) GC_PROTO((ptr_t p));
+ /* If possible print s followed by a more */
+ /* detailed description of the object */
+ /* referred to by p. */
+#if defined(LINUX) && defined(__ELF__) && !defined(SMALL_CONFIG)
+ void GC_print_address_map GC_PROTO((void));
+ /* Print an address map of the process. */
+#endif
+
+extern GC_bool GC_have_errors; /* We saw a smashed or leaked object. */
+ /* Call error printing routine */
+ /* occasionally. */
+extern GC_bool GC_print_stats; /* Produce at least some logging output */
+ /* Set from environment variable. */
+
+#ifndef NO_DEBUGGING
+ extern GC_bool GC_dump_regularly; /* Generate regular debugging dumps. */
+# define COND_DUMP if (GC_dump_regularly) GC_dump();
+#else
+# define COND_DUMP
+#endif
+
+/* Macros used for collector internal allocation. */
+/* These assume the collector lock is held. */
+#ifdef DBG_HDRS_ALL
+ extern GC_PTR GC_debug_generic_malloc_inner(size_t lb, int k);
+ extern GC_PTR GC_debug_generic_malloc_inner_ignore_off_page(size_t lb,
+ int k);
+# define GC_INTERNAL_MALLOC GC_debug_generic_malloc_inner
+# define GC_INTERNAL_MALLOC_IGNORE_OFF_PAGE \
+ GC_debug_generic_malloc_inner_ignore_off_page
+# ifdef THREADS
+# define GC_INTERNAL_FREE GC_debug_free_inner
+# else
+# define GC_INTERNAL_FREE GC_debug_free
+# endif
+#else
+# define GC_INTERNAL_MALLOC GC_generic_malloc_inner
+# define GC_INTERNAL_MALLOC_IGNORE_OFF_PAGE \
+ GC_generic_malloc_inner_ignore_off_page
+# ifdef THREADS
+# define GC_INTERNAL_FREE GC_free_inner
+# else
+# define GC_INTERNAL_FREE GC_free
+# endif
+#endif
+
+/* Memory unmapping: */
+#ifdef USE_MUNMAP
+ void GC_unmap_old(void);
+ void GC_merge_unmapped(void);
+ void GC_unmap(ptr_t start, word bytes);
+ void GC_remap(ptr_t start, word bytes);
+ void GC_unmap_gap(ptr_t start1, word bytes1, ptr_t start2, word bytes2);
+#endif
+
+/* Virtual dirty bit implementation: */
+/* Each implementation exports the following: */
+void GC_read_dirty GC_PROTO((void));
+ /* Retrieve dirty bits. */
+GC_bool GC_page_was_dirty GC_PROTO((struct hblk *h));
+ /* Read retrieved dirty bits. */
+GC_bool GC_page_was_ever_dirty GC_PROTO((struct hblk *h));
+ /* Could the page contain valid heap pointers? */
+void GC_is_fresh GC_PROTO((struct hblk *h, word n));
+ /* Assert the region currently contains no */
+ /* valid pointers. */
+void GC_remove_protection GC_PROTO((struct hblk *h, word nblocks,
+ GC_bool pointerfree));
+ /* h is about to be writteni or allocated. Ensure */
+ /* that it's not write protected by the virtual */
+ /* dirty bit implementation. */
+
+void GC_dirty_init GC_PROTO((void));
+
+/* Slow/general mark bit manipulation: */
+GC_API GC_bool GC_is_marked GC_PROTO((ptr_t p));
+void GC_clear_mark_bit GC_PROTO((ptr_t p));
+void GC_set_mark_bit GC_PROTO((ptr_t p));
+
+/* Stubborn objects: */
+void GC_read_changed GC_PROTO((void)); /* Analogous to GC_read_dirty */
+GC_bool GC_page_was_changed GC_PROTO((struct hblk * h));
+ /* Analogous to GC_page_was_dirty */
+void GC_clean_changing_list GC_PROTO((void));
+ /* Collect obsolete changing list entries */
+void GC_stubborn_init GC_PROTO((void));
+
+/* Debugging print routines: */
+void GC_print_block_list GC_PROTO((void));
+void GC_print_hblkfreelist GC_PROTO((void));
+void GC_print_heap_sects GC_PROTO((void));
+void GC_print_static_roots GC_PROTO((void));
+void GC_print_finalization_stats GC_PROTO((void));
+void GC_dump GC_PROTO((void));
+
+#ifdef KEEP_BACK_PTRS
+ void GC_store_back_pointer(ptr_t source, ptr_t dest);
+ void GC_marked_for_finalization(ptr_t dest);
+# define GC_STORE_BACK_PTR(source, dest) GC_store_back_pointer(source, dest)
+# define GC_MARKED_FOR_FINALIZATION(dest) GC_marked_for_finalization(dest)
+#else
+# define GC_STORE_BACK_PTR(source, dest)
+# define GC_MARKED_FOR_FINALIZATION(dest)
+#endif
+
+/* Make arguments appear live to compiler */
+# ifdef __WATCOMC__
+ void GC_noop(void*, ...);
+# else
+# ifdef __DMC__
+ GC_API void GC_noop(...);
+# else
+ GC_API void GC_noop();
+# endif
+# endif
+
+void GC_noop1 GC_PROTO((word));
+
+/* Logging and diagnostic output: */
+GC_API void GC_printf GC_PROTO((GC_CONST char * format, long, long, long, long, long, long));
+ /* A version of printf that doesn't allocate, */
+ /* is restricted to long arguments, and */
+ /* (unfortunately) doesn't use varargs for */
+ /* portability. Restricted to 6 args and */
+ /* 1K total output length. */
+ /* (We use sprintf. Hopefully that doesn't */
+ /* allocate for long arguments.) */
+# define GC_printf0(f) GC_printf(f, 0l, 0l, 0l, 0l, 0l, 0l)
+# define GC_printf1(f,a) GC_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
+# define GC_printf2(f,a,b) GC_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
+# define GC_printf3(f,a,b,c) GC_printf(f, (long)a, (long)b, (long)c, 0l, 0l, 0l)
+# define GC_printf4(f,a,b,c,d) GC_printf(f, (long)a, (long)b, (long)c, \
+ (long)d, 0l, 0l)
+# define GC_printf5(f,a,b,c,d,e) GC_printf(f, (long)a, (long)b, (long)c, \
+ (long)d, (long)e, 0l)
+# define GC_printf6(f,a,b,c,d,e,g) GC_printf(f, (long)a, (long)b, (long)c, \
+ (long)d, (long)e, (long)g)
+
+GC_API void GC_err_printf GC_PROTO((GC_CONST char * format, long, long, long, long, long, long));
+# define GC_err_printf0(f) GC_err_puts(f)
+# define GC_err_printf1(f,a) GC_err_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
+# define GC_err_printf2(f,a,b) GC_err_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
+# define GC_err_printf3(f,a,b,c) GC_err_printf(f, (long)a, (long)b, (long)c, \
+ 0l, 0l, 0l)
+# define GC_err_printf4(f,a,b,c,d) GC_err_printf(f, (long)a, (long)b, \
+ (long)c, (long)d, 0l, 0l)
+# define GC_err_printf5(f,a,b,c,d,e) GC_err_printf(f, (long)a, (long)b, \
+ (long)c, (long)d, \
+ (long)e, 0l)
+# define GC_err_printf6(f,a,b,c,d,e,g) GC_err_printf(f, (long)a, (long)b, \
+ (long)c, (long)d, \
+ (long)e, (long)g)
+ /* Ditto, writes to stderr. */
+
+void GC_err_puts GC_PROTO((GC_CONST char *s));
+ /* Write s to stderr, don't buffer, don't add */
+ /* newlines, don't ... */
+
+#if defined(LINUX) && !defined(SMALL_CONFIG)
+ void GC_err_write GC_PROTO((GC_CONST char *buf, size_t len));
+ /* Write buf to stderr, don't buffer, don't add */
+ /* newlines, don't ... */
+#endif
+
+
+# ifdef GC_ASSERTIONS
+# define GC_ASSERT(expr) if(!(expr)) {\
+ GC_err_printf2("Assertion failure: %s:%ld\n", \
+ __FILE__, (unsigned long)__LINE__); \
+ ABORT("assertion failure"); }
+# else
+# define GC_ASSERT(expr)
+# endif
+
+# if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ /* We need additional synchronization facilities from the thread */
+ /* support. We believe these are less performance critical */
+ /* than the main garbage collector lock; standard pthreads-based */
+ /* implementations should be sufficient. */
+
+ /* The mark lock and condition variable. If the GC lock is also */
+ /* acquired, the GC lock must be acquired first. The mark lock is */
+ /* used to both protect some variables used by the parallel */
+ /* marker, and to protect GC_fl_builder_count, below. */
+ /* GC_notify_all_marker() is called when */
+ /* the state of the parallel marker changes */
+ /* in some significant way (see gc_mark.h for details). The */
+ /* latter set of events includes incrementing GC_mark_no. */
+ /* GC_notify_all_builder() is called when GC_fl_builder_count */
+ /* reaches 0. */
+
+ extern void GC_acquire_mark_lock();
+ extern void GC_release_mark_lock();
+ extern void GC_notify_all_builder();
+ /* extern void GC_wait_builder(); */
+ extern void GC_wait_for_reclaim();
+
+ extern word GC_fl_builder_count; /* Protected by mark lock. */
+# endif /* PARALLEL_MARK || THREAD_LOCAL_ALLOC */
+# ifdef PARALLEL_MARK
+ extern void GC_notify_all_marker();
+ extern void GC_wait_marker();
+ extern word GC_mark_no; /* Protected by mark lock. */
+
+ extern void GC_help_marker(word my_mark_no);
+ /* Try to help out parallel marker for mark cycle */
+ /* my_mark_no. Returns if the mark cycle finishes or */
+ /* was already done, or there was nothing to do for */
+ /* some other reason. */
+# endif /* PARALLEL_MARK */
+
+# if defined(GC_PTHREADS) && !defined(GC_SOLARIS_THREADS)
+ /* We define the thread suspension signal here, so that we can refer */
+ /* to it in the dirty bit implementation, if necessary. Ideally we */
+ /* would allocate a (real-time ?) signal using the standard mechanism.*/
+ /* unfortunately, there is no standard mechanism. (There is one */
+ /* in Linux glibc, but it's not exported.) Thus we continue to use */
+ /* the same hard-coded signals we've always used. */
+# if !defined(SIG_SUSPEND)
+# if defined(GC_LINUX_THREADS) || defined(GC_DGUX386_THREADS)
+# if defined(SPARC) && !defined(SIGPWR)
+ /* SPARC/Linux doesn't properly define SIGPWR in <signal.h>.
+ * It is aliased to SIGLOST in asm/signal.h, though. */
+# define SIG_SUSPEND SIGLOST
+# else
+ /* Linuxthreads itself uses SIGUSR1 and SIGUSR2. */
+# define SIG_SUSPEND SIGPWR
+# endif
+# else /* !GC_LINUX_THREADS */
+# if defined(_SIGRTMIN)
+# define SIG_SUSPEND _SIGRTMIN + 6
+# else
+# define SIG_SUSPEND SIGRTMIN + 6
+# endif
+# endif
+# endif /* !SIG_SUSPEND */
+
+# endif
+
+# endif /* GC_PRIVATE_H */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * This header is private to the gc. It is almost always included from
+ * gc_priv.h. However it is possible to include it by itself if just the
+ * configuration macros are needed. In that
+ * case, a few declarations relying on types declared in gc_priv.h will be
+ * omitted.
+ */
+
+#ifndef GCCONFIG_H
+
+# define GCCONFIG_H
+
+/* Machine dependent parameters. Some tuning parameters can be found */
+/* near the top of gc_private.h. */
+
+/* Machine specific parts contributed by various people. See README file. */
+
+/* First a unified test for Linux: */
+# if defined(linux) || defined(__linux__)
+# define LINUX
+# endif
+
+/* And one for NetBSD: */
+# if defined(__NetBSD__)
+# define NETBSD
+# endif
+
+/* And one for OpenBSD: */
+# if defined(__OpenBSD__)
+# define OPENBSD
+# endif
+
+/* And one for FreeBSD: */
+# if defined(__FreeBSD__)
+# define FREEBSD
+# endif
+
+/* Determine the machine type: */
+# if defined(__XSCALE__)
+# define ARM32
+# if !defined(LINUX)
+# define NOSYS
+# define mach_type_known
+# endif
+# endif
+# if defined(sun) && defined(mc68000)
+# define M68K
+# define SUNOS4
+# define mach_type_known
+# endif
+# if defined(hp9000s300)
+# define M68K
+# define HP
+# define mach_type_known
+# endif
+# if defined(OPENBSD) && defined(m68k)
+# define M68K
+# define mach_type_known
+# endif
+# if defined(OPENBSD) && defined(__sparc__)
+# define SPARC
+# define mach_type_known
+# endif
+# if defined(NETBSD) && defined(m68k)
+# define M68K
+# define mach_type_known
+# endif
+# if defined(NETBSD) && defined(__powerpc__)
+# define POWERPC
+# define mach_type_known
+# endif
+# if defined(NETBSD) && defined(__arm32__)
+# define ARM32
+# define mach_type_known
+# endif
+# if defined(vax)
+# define VAX
+# ifdef ultrix
+# define ULTRIX
+# else
+# define BSD
+# endif
+# define mach_type_known
+# endif
+# if defined(mips) || defined(__mips) || defined(_mips)
+# define MIPS
+# if defined(nec_ews) || defined(_nec_ews)
+# define EWS4800
+# endif
+# if !defined(LINUX) && !defined(EWS4800)
+# if defined(ultrix) || defined(__ultrix) || defined(__NetBSD__)
+# define ULTRIX
+# else
+# if defined(_SYSTYPE_SVR4) || defined(SYSTYPE_SVR4) \
+ || defined(__SYSTYPE_SVR4__)
+# define IRIX5 /* or IRIX 6.X */
+# else
+# define RISCOS /* or IRIX 4.X */
+# endif
+# endif
+# endif /* !LINUX */
+# if defined(__NetBSD__) && defined(__MIPSEL__)
+# undef ULTRIX
+# endif
+# define mach_type_known
+# endif
+# if defined(DGUX) && (defined(i386) || defined(__i386__))
+# define I386
+# ifndef _USING_DGUX
+# define _USING_DGUX
+# endif
+# define mach_type_known
+# endif
+# if defined(sequent) && (defined(i386) || defined(__i386__))
+# define I386
+# define SEQUENT
+# define mach_type_known
+# endif
+# if defined(sun) && (defined(i386) || defined(__i386__))
+# define I386
+# define SUNOS5
+# define mach_type_known
+# endif
+# if (defined(__OS2__) || defined(__EMX__)) && defined(__32BIT__)
+# define I386
+# define OS2
+# define mach_type_known
+# endif
+# if defined(ibm032)
+# define RT
+# define mach_type_known
+# endif
+# if defined(sun) && (defined(sparc) || defined(__sparc))
+# define SPARC
+ /* Test for SunOS 5.x */
+# include <errno.h>
+# ifdef ECHRNG
+# define SUNOS5
+# else
+# define SUNOS4
+# endif
+# define mach_type_known
+# endif
+# if defined(sparc) && defined(unix) && !defined(sun) && !defined(linux) \
+ && !defined(__OpenBSD__) && !(__NetBSD__)
+# define SPARC
+# define DRSNX
+# define mach_type_known
+# endif
+# if defined(_IBMR2)
+# define RS6000
+# define mach_type_known
+# endif
+# if defined(__NetBSD__) && defined(__sparc__)
+# define SPARC
+# define mach_type_known
+# endif
+# if defined(_M_XENIX) && defined(_M_SYSV) && defined(_M_I386)
+ /* The above test may need refinement */
+# define I386
+# if defined(_SCO_ELF)
+# define SCO_ELF
+# else
+# define SCO
+# endif
+# define mach_type_known
+# endif
+# if defined(_AUX_SOURCE)
+# define M68K
+# define SYSV
+# define mach_type_known
+# endif
+# if defined(_PA_RISC1_0) || defined(_PA_RISC1_1) || defined(_PA_RISC2_0) \
+ || defined(hppa) || defined(__hppa__)
+# define HP_PA
+# ifndef LINUX
+# define HPUX
+# endif
+# define mach_type_known
+# endif
+# if defined(__ia64) && defined(_HPUX_SOURCE)
+# define IA64
+# define HPUX
+# define mach_type_known
+# endif
+# if defined(__BEOS__) && defined(_X86_)
+# define I386
+# define BEOS
+# define mach_type_known
+# endif
+# if defined(LINUX) && (defined(i386) || defined(__i386__))
+# define I386
+# define mach_type_known
+# endif
+# if defined(LINUX) && defined(__x86_64__)
+# define X86_64
+# define mach_type_known
+# endif
+# if defined(LINUX) && (defined(__ia64__) || defined(__ia64))
+# define IA64
+# define mach_type_known
+# endif
+# if defined(LINUX) && defined(__arm__)
+# define ARM32
+# define mach_type_known
+# endif
+# if defined(LINUX) && (defined(powerpc) || defined(__powerpc__))
+# define POWERPC
+# define mach_type_known
+# endif
+# if defined(LINUX) && defined(__mc68000__)
+# define M68K
+# define mach_type_known
+# endif
+# if defined(LINUX) && (defined(sparc) || defined(__sparc__))
+# define SPARC
+# define mach_type_known
+# endif
+# if defined(LINUX) && defined(__arm__)
+# define ARM32
+# define mach_type_known
+# endif
+# if defined(LINUX) && defined(__sh__)
+# define SH
+# define mach_type_known
+# endif
+# if defined(__alpha) || defined(__alpha__)
+# define ALPHA
+# if !defined(LINUX) && !defined(NETBSD) && !defined(OPENBSD) && !defined(FREEBSD)
+# define OSF1 /* a.k.a Digital Unix */
+# endif
+# define mach_type_known
+# endif
+# if defined(_AMIGA) && !defined(AMIGA)
+# define AMIGA
+# endif
+# ifdef AMIGA
+# define M68K
+# define mach_type_known
+# endif
+# if defined(THINK_C) || defined(__MWERKS__) && !defined(__powerc)
+# define M68K
+# define MACOS
+# define mach_type_known
+# endif
+# if defined(__MWERKS__) && defined(__powerc) && !defined(__MACH__)
+# define POWERPC
+# define MACOS
+# define mach_type_known
+# endif
+# if defined(macosx) || \
+ defined(__APPLE__) && defined(__MACH__) && defined(__ppc__)
+# define MACOSX
+# define POWERPC
+# define mach_type_known
+# endif
+# if defined(__APPLE__) && defined(__MACH__) && defined(__i386__)
+# define MACOSX
+# define I386
+ --> Not really supported, but at least we recognize it.
+# endif
+# if defined(NeXT) && defined(mc68000)
+# define M68K
+# define NEXT
+# define mach_type_known
+# endif
+# if defined(NeXT) && (defined(i386) || defined(__i386__))
+# define I386
+# define NEXT
+# define mach_type_known
+# endif
+# if defined(__OpenBSD__) && (defined(i386) || defined(__i386__))
+# define I386
+# define OPENBSD
+# define mach_type_known
+# endif
+# if defined(FREEBSD) && (defined(i386) || defined(__i386__))
+# define I386
+# define mach_type_known
+# endif
+# if defined(__NetBSD__) && (defined(i386) || defined(__i386__))
+# define I386
+# define mach_type_known
+# endif
+# if defined(bsdi) && (defined(i386) || defined(__i386__))
+# define I386
+# define BSDI
+# define mach_type_known
+# endif
+# if !defined(mach_type_known) && defined(__386BSD__)
+# define I386
+# define THREE86BSD
+# define mach_type_known
+# endif
+# if defined(_CX_UX) && defined(_M88K)
+# define M88K
+# define CX_UX
+# define mach_type_known
+# endif
+# if defined(DGUX) && defined(m88k)
+# define M88K
+ /* DGUX defined */
+# define mach_type_known
+# endif
+# if defined(_WIN32_WCE)
+ /* SH3, SH4, MIPS already defined for corresponding architectures */
+# if defined(SH3) || defined(SH4)
+# define SH
+# endif
+# if defined(x86)
+# define I386
+# endif
+# if defined(ARM)
+# define ARM32
+# endif
+# define MSWINCE
+# define mach_type_known
+# else
+# if (defined(_MSDOS) || defined(_MSC_VER)) && (_M_IX86 >= 300) \
+ || defined(_WIN32) && !defined(__CYGWIN32__) && !defined(__CYGWIN__)
+# define I386
+# define MSWIN32 /* or Win32s */
+# define mach_type_known
+# endif
+# endif
+# if defined(__DJGPP__)
+# define I386
+# ifndef DJGPP
+# define DJGPP /* MSDOS running the DJGPP port of GCC */
+# endif
+# define mach_type_known
+# endif
+# if defined(__CYGWIN32__) || defined(__CYGWIN__)
+# define I386
+# define CYGWIN32
+# define mach_type_known
+# endif
+# if defined(__MINGW32__)
+# define I386
+# define MSWIN32
+# define mach_type_known
+# endif
+# if defined(__BORLANDC__)
+# define I386
+# define MSWIN32
+# define mach_type_known
+# endif
+# if defined(_UTS) && !defined(mach_type_known)
+# define S370
+# define UTS4
+# define mach_type_known
+# endif
+# if defined(__pj__)
+# define PJ
+# define mach_type_known
+# endif
+# if defined(__embedded__) && defined(PPC)
+# define POWERPC
+# define NOSYS
+# define mach_type_known
+# endif
+/* Ivan Demakov */
+# if defined(__WATCOMC__) && defined(__386__)
+# define I386
+# if !defined(OS2) && !defined(MSWIN32) && !defined(DOS4GW)
+# if defined(__OS2__)
+# define OS2
+# else
+# if defined(__WINDOWS_386__) || defined(__NT__)
+# define MSWIN32
+# else
+# define DOS4GW
+# endif
+# endif
+# endif
+# define mach_type_known
+# endif
+# if defined(__s390__) && defined(LINUX)
+# define S390
+# define mach_type_known
+# endif
+# if defined(__GNU__)
+# if defined(__i386__)
+/* The Debian Hurd running on generic PC */
+# define HURD
+# define I386
+# define mach_type_known
+# endif
+# endif
+
+/* Feel free to add more clauses here */
+
+/* Or manually define the machine type here. A machine type is */
+/* characterized by the architecture. Some */
+/* machine types are further subdivided by OS. */
+/* the macros ULTRIX, RISCOS, and BSD to distinguish. */
+/* Note that SGI IRIX is treated identically to RISCOS. */
+/* SYSV on an M68K actually means A/UX. */
+/* The distinction in these cases is usually the stack starting address */
+# ifndef mach_type_known
+ --> unknown machine type
+# endif
+ /* Mapping is: M68K ==> Motorola 680X0 */
+ /* (SUNOS4,HP,NEXT, and SYSV (A/UX), */
+ /* MACOS and AMIGA variants) */
+ /* I386 ==> Intel 386 */
+ /* (SEQUENT, OS2, SCO, LINUX, NETBSD, */
+ /* FREEBSD, THREE86BSD, MSWIN32, */
+ /* BSDI,SUNOS5, NEXT, other variants) */
+ /* NS32K ==> Encore Multimax */
+ /* MIPS ==> R2000 or R3000 */
+ /* (RISCOS, ULTRIX variants) */
+ /* VAX ==> DEC VAX */
+ /* (BSD, ULTRIX variants) */
+ /* RS6000 ==> IBM RS/6000 AIX3.X */
+ /* RT ==> IBM PC/RT */
+ /* HP_PA ==> HP9000/700 & /800 */
+ /* HP/UX, LINUX */
+ /* SPARC ==> SPARC v7/v8/v9 */
+ /* (SUNOS4, SUNOS5, LINUX, */
+ /* DRSNX variants) */
+ /* ALPHA ==> DEC Alpha */
+ /* (OSF1 and LINUX variants) */
+ /* M88K ==> Motorola 88XX0 */
+ /* (CX_UX and DGUX) */
+ /* S370 ==> 370-like machine */
+ /* running Amdahl UTS4 */
+ /* S390 ==> 390-like machine */
+ /* running LINUX */
+ /* ARM32 ==> Intel StrongARM */
+ /* IA64 ==> Intel IPF */
+ /* (e.g. Itanium) */
+ /* (LINUX and HPUX) */
+ /* SH ==> Hitachi SuperH */
+ /* (LINUX & MSWINCE) */
+ /* X86_64 ==> AMD x86-64 */
+
+
+/*
+ * For each architecture and OS, the following need to be defined:
+ *
+ * CPP_WORD_SZ is a simple integer constant representing the word size.
+ * in bits. We assume byte addressibility, where a byte has 8 bits.
+ * We also assume CPP_WORD_SZ is either 32 or 64.
+ * (We care about the length of pointers, not hardware
+ * bus widths. Thus a 64 bit processor with a C compiler that uses
+ * 32 bit pointers should use CPP_WORD_SZ of 32, not 64. Default is 32.)
+ *
+ * MACH_TYPE is a string representation of the machine type.
+ * OS_TYPE is analogous for the OS.
+ *
+ * ALIGNMENT is the largest N, such that
+ * all pointer are guaranteed to be aligned on N byte boundaries.
+ * defining it to be 1 will always work, but perform poorly.
+ *
+ * DATASTART is the beginning of the data segment.
+ * On some platforms SEARCH_FOR_DATA_START is defined.
+ * SEARCH_FOR_DATASTART will cause GC_data_start to
+ * be set to an address determined by accessing data backwards from _end
+ * until an unmapped page is found. DATASTART will be defined to be
+ * GC_data_start.
+ * On UNIX-like systems, the collector will scan the area between DATASTART
+ * and DATAEND for root pointers.
+ *
+ * DATAEND, if not `end' where `end' is defined as ``extern int end[];''.
+ * RTH suggests gaining access to linker script synth'd values with
+ * this idiom instead of `&end' where `end' is defined as ``extern int end;'' .
+ *
+ * ALIGN_DOUBLE of GC_malloc should return blocks aligned to twice
+ * the pointer size.
+ *
+ * STACKBOTTOM is the cool end of the stack, which is usually the
+ * highest address in the stack.
+ * Under PCR or OS/2, we have other ways of finding thread stacks.
+ * For each machine, the following should:
+ * 1) define STACK_GROWS_UP if the stack grows toward higher addresses, and
+ * 2) define exactly one of
+ * STACKBOTTOM (should be defined to be an expression)
+ * LINUX_STACKBOTTOM
+ * HEURISTIC1
+ * HEURISTIC2
+ * If STACKBOTTOM is defined, then it's value will be used directly as the
+ * stack base. If LINUX_STACKBOTTOM is defined, then it will be determined
+ * with a method appropriate for most Linux systems. Currently we look
+ * first for __libc_stack_end, and if that fails read it from /proc.
+ * If either of the last two macros are defined, then STACKBOTTOM is computed
+ * during collector startup using one of the following two heuristics:
+ * HEURISTIC1: Take an address inside GC_init's frame, and round it up to
+ * the next multiple of STACK_GRAN.
+ * HEURISTIC2: Take an address inside GC_init's frame, increment it repeatedly
+ * in small steps (decrement if STACK_GROWS_UP), and read the value
+ * at each location. Remember the value when the first
+ * Segmentation violation or Bus error is signalled. Round that
+ * to the nearest plausible page boundary, and use that instead
+ * of STACKBOTTOM.
+ *
+ * Gustavo Rodriguez-Rivera points out that on most (all?) Unix machines,
+ * the value of environ is a pointer that can serve as STACKBOTTOM.
+ * I expect that HEURISTIC2 can be replaced by this approach, which
+ * interferes far less with debugging. However it has the disadvantage
+ * that it's confused by a putenv call before the collector is initialized.
+ * This could be dealt with by intercepting putenv ...
+ *
+ * If no expression for STACKBOTTOM can be found, and neither of the above
+ * heuristics are usable, the collector can still be used with all of the above
+ * undefined, provided one of the following is done:
+ * 1) GC_mark_roots can be changed to somehow mark from the correct stack(s)
+ * without reference to STACKBOTTOM. This is appropriate for use in
+ * conjunction with thread packages, since there will be multiple stacks.
+ * (Allocating thread stacks in the heap, and treating them as ordinary
+ * heap data objects is also possible as a last resort. However, this is
+ * likely to introduce significant amounts of excess storage retention
+ * unless the dead parts of the thread stacks are periodically cleared.)
+ * 2) Client code may set GC_stackbottom before calling any GC_ routines.
+ * If the author of the client code controls the main program, this is
+ * easily accomplished by introducing a new main program, setting
+ * GC_stackbottom to the address of a local variable, and then calling
+ * the original main program. The new main program would read something
+ * like:
+ *
+ * # include "gc_private.h"
+ *
+ * main(argc, argv, envp)
+ * int argc;
+ * char **argv, **envp;
+ * {
+ * int dummy;
+ *
+ * GC_stackbottom = (ptr_t)(&dummy);
+ * return(real_main(argc, argv, envp));
+ * }
+ *
+ *
+ * Each architecture may also define the style of virtual dirty bit
+ * implementation to be used:
+ * MPROTECT_VDB: Write protect the heap and catch faults.
+ * PROC_VDB: Use the SVR4 /proc primitives to read dirty bits.
+ *
+ * An architecture may define DYNAMIC_LOADING if dynamic_load.c
+ * defined GC_register_dynamic_libraries() for the architecture.
+ *
+ * An architecture may define PREFETCH(x) to preload the cache with *x.
+ * This defaults to a no-op.
+ *
+ * PREFETCH_FOR_WRITE(x) is used if *x is about to be written.
+ *
+ * An architecture may also define CLEAR_DOUBLE(x) to be a fast way to
+ * clear the two words at GC_malloc-aligned address x. By default,
+ * word stores of 0 are used instead.
+ *
+ * HEAP_START may be defined as the initial address hint for mmap-based
+ * allocation.
+ */
+
+/* If we are using a recent version of gcc, we can use __builtin_unwind_init()
+ * to push the relevant registers onto the stack. This generally makes
+ * USE_GENERIC_PUSH_REGS the preferred approach for marking from registers.
+ */
+# if defined(__GNUC__) && ((__GNUC__ >= 3) || \
+ (__GNUC__ == 2 && __GNUC_MINOR__ >= 8))
+# define HAVE_BUILTIN_UNWIND_INIT
+# endif
+
+# define STACK_GRAN 0x1000000
+# ifdef M68K
+# define MACH_TYPE "M68K"
+# define ALIGNMENT 2
+# ifdef OPENBSD
+# define OS_TYPE "OPENBSD"
+# define HEURISTIC2
+ extern char etext[];
+# define DATASTART ((ptr_t)(etext))
+# endif
+# ifdef NETBSD
+# define OS_TYPE "NETBSD"
+# define HEURISTIC2
+ extern char etext[];
+# define DATASTART ((ptr_t)(etext))
+# endif
+# ifdef LINUX
+# define OS_TYPE "LINUX"
+# define STACKBOTTOM ((ptr_t)0xf0000000)
+/* # define MPROTECT_VDB - Reported to not work 9/17/01 */
+# ifdef __ELF__
+# define DYNAMIC_LOADING
+# include <features.h>
+# if defined(__GLIBC__)&& __GLIBC__>=2
+# define SEARCH_FOR_DATA_START
+# else /* !GLIBC2 */
+ extern char **__environ;
+# define DATASTART ((ptr_t)(&__environ))
+ /* hideous kludge: __environ is the first */
+ /* word in crt0.o, and delimits the start */
+ /* of the data segment, no matter which */
+ /* ld options were passed through. */
+ /* We could use _etext instead, but that */
+ /* would include .rodata, which may */
+ /* contain large read-only data tables */
+ /* that we'd rather not scan. */
+# endif /* !GLIBC2 */
+ extern int _end[];
+# define DATAEND (_end)
+# else
+ extern int etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0xfff) & ~0xfff))
+# endif
+# endif
+# ifdef SUNOS4
+# define OS_TYPE "SUNOS4"
+ extern char etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0x1ffff) & ~0x1ffff))
+# define HEURISTIC1 /* differs */
+# define DYNAMIC_LOADING
+# endif
+# ifdef HP
+# define OS_TYPE "HP"
+ extern char etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0xfff) & ~0xfff))
+# define STACKBOTTOM ((ptr_t) 0xffeffffc)
+ /* empirically determined. seems to work. */
+# include <unistd.h>
+# define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
+# endif
+# ifdef SYSV
+# define OS_TYPE "SYSV"
+ extern etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0x3fffff) \
+ & ~0x3fffff) \
+ +((word)etext & 0x1fff))
+ /* This only works for shared-text binaries with magic number 0413.
+ The other sorts of SysV binaries put the data at the end of the text,
+ in which case the default of etext would work. Unfortunately,
+ handling both would require having the magic-number available.
+ -- Parag
+ */
+# define STACKBOTTOM ((ptr_t)0xFFFFFFFE)
+ /* The stack starts at the top of memory, but */
+ /* 0x0 cannot be used as setjump_test complains */
+ /* that the stack direction is incorrect. Two */
+ /* bytes down from 0x0 should be safe enough. */
+ /* --Parag */
+# include <sys/mmu.h>
+# define GETPAGESIZE() PAGESIZE /* Is this still right? */
+# endif
+# ifdef AMIGA
+# define OS_TYPE "AMIGA"
+ /* STACKBOTTOM and DATASTART handled specially */
+ /* in os_dep.c */
+# define DATAEND /* not needed */
+# define GETPAGESIZE() 4096
+# endif
+# ifdef MACOS
+# ifndef __LOWMEM__
+# include <LowMem.h>
+# endif
+# define OS_TYPE "MACOS"
+ /* see os_dep.c for details of global data segments. */
+# define STACKBOTTOM ((ptr_t) LMGetCurStackBase())
+# define DATAEND /* not needed */
+# define GETPAGESIZE() 4096
+# endif
+# ifdef NEXT
+# define OS_TYPE "NEXT"
+# define DATASTART ((ptr_t) get_etext())
+# define STACKBOTTOM ((ptr_t) 0x4000000)
+# define DATAEND /* not needed */
+# endif
+# endif
+
+# ifdef POWERPC
+# define MACH_TYPE "POWERPC"
+# ifdef MACOS
+# define ALIGNMENT 2 /* Still necessary? Could it be 4? */
+# ifndef __LOWMEM__
+# include <LowMem.h>
+# endif
+# define OS_TYPE "MACOS"
+ /* see os_dep.c for details of global data segments. */
+# define STACKBOTTOM ((ptr_t) LMGetCurStackBase())
+# define DATAEND /* not needed */
+# endif
+# ifdef LINUX
+# define ALIGNMENT 4 /* Guess. Can someone verify? */
+ /* This was 2, but that didn't sound right. */
+# define OS_TYPE "LINUX"
+ /* HEURISTIC1 has been reliably reported to fail for a 32-bit */
+ /* executable on a 64 bit kernel. */
+# define LINUX_STACKBOTTOM
+# define DYNAMIC_LOADING
+# undef STACK_GRAN
+# define STACK_GRAN 0x10000000
+ /* Stack usually starts at 0x80000000 */
+# define SEARCH_FOR_DATA_START
+ extern int _end[];
+# define DATAEND (_end)
+# endif
+# ifdef MACOSX
+ /* There are reasons to suspect this may not be reliable. */
+# define ALIGNMENT 4
+# define OS_TYPE "MACOSX"
+# ifdef GC_MACOSX_THREADS
+# define SIG_SUSPEND SIGXCPU
+# define SIG_THR_RESTART SIGXFSZ
+# endif
+# define DYNAMIC_LOADING
+ /* XXX: see get_end(3), get_etext() and get_end() should not be used */
+# define DATASTART ((ptr_t) get_etext())
+# define STACKBOTTOM ((ptr_t) 0xc0000000)
+# define DATAEND ((ptr_t) get_end())
+# define USE_MMAP
+# define USE_MMAP_ANON
+/* # define MPROTECT_VDB -- There is some evidence that this breaks
+ * on some minor versions of MACOSX, i.e. 10.2.3. In theory,
+ * it should be OK */
+# include <unistd.h>
+# define GETPAGESIZE() getpagesize()
+# if defined(USE_PPC_PREFETCH) && defined(__GNUC__)
+ /* The performance impact of prefetches is untested */
+# define PREFETCH(x) \
+ __asm__ __volatile__ ("dcbt 0,%0" : : "r" ((const void *) (x)))
+# define PREFETCH_FOR_WRITE(x) \
+ __asm__ __volatile__ ("dcbtst 0,%0" : : "r" ((const void *) (x)))
+# endif
+# endif
+# ifdef NETBSD
+# define ALIGNMENT 4
+# define OS_TYPE "NETBSD"
+# define HEURISTIC2
+ extern char etext[];
+# define DATASTART GC_data_start
+# define DYNAMIC_LOADING
+# endif
+# ifdef NOSYS
+# define ALIGNMENT 4
+# define OS_TYPE "NOSYS"
+ extern void __end[], __dso_handle[];
+# define DATASTART (__dso_handle) /* OK, that's ugly. */
+# define DATAEND (__end)
+ /* Stack starts at 0xE0000000 for the simulator. */
+# undef STACK_GRAN
+# define STACK_GRAN 0x10000000
+# define HEURISTIC1
+# endif
+# endif
+
+# ifdef VAX
+# define MACH_TYPE "VAX"
+# define ALIGNMENT 4 /* Pointers are longword aligned by 4.2 C compiler */
+ extern char etext[];
+# define DATASTART ((ptr_t)(etext))
+# ifdef BSD
+# define OS_TYPE "BSD"
+# define HEURISTIC1
+ /* HEURISTIC2 may be OK, but it's hard to test. */
+# endif
+# ifdef ULTRIX
+# define OS_TYPE "ULTRIX"
+# define STACKBOTTOM ((ptr_t) 0x7fffc800)
+# endif
+# endif
+
+# ifdef RT
+# define MACH_TYPE "RT"
+# define ALIGNMENT 4
+# define DATASTART ((ptr_t) 0x10000000)
+# define STACKBOTTOM ((ptr_t) 0x1fffd800)
+# endif
+
+# ifdef SPARC
+# define MACH_TYPE "SPARC"
+# if defined(__arch64__) || defined(__sparcv9)
+# define ALIGNMENT 8
+# define CPP_WORDSZ 64
+# define ELF_CLASS ELFCLASS64
+# else
+# define ALIGNMENT 4 /* Required by hardware */
+# define CPP_WORDSZ 32
+# endif
+# define ALIGN_DOUBLE
+# ifdef SUNOS5
+# define OS_TYPE "SUNOS5"
+ extern int _etext[];
+ extern int _end[];
+ extern ptr_t GC_SysVGetDataStart();
+# define DATASTART GC_SysVGetDataStart(0x10000, _etext)
+# define DATAEND (_end)
+# if !defined(USE_MMAP) && defined(REDIRECT_MALLOC)
+# define USE_MMAP
+ /* Otherwise we now use calloc. Mmap may result in the */
+ /* heap interleaved with thread stacks, which can result in */
+ /* excessive blacklisting. Sbrk is unusable since it */
+ /* doesn't interact correctly with the system malloc. */
+# endif
+# ifdef USE_MMAP
+# define HEAP_START (ptr_t)0x40000000
+# else
+# define HEAP_START DATAEND
+# endif
+# define PROC_VDB
+/* HEURISTIC1 reportedly no longer works under 2.7. */
+/* HEURISTIC2 probably works, but this appears to be preferable. */
+/* Apparently USRSTACK is defined to be USERLIMIT, but in some */
+/* installations that's undefined. We work around this with a */
+/* gross hack: */
+# include <sys/vmparam.h>
+# ifdef USERLIMIT
+ /* This should work everywhere, but doesn't. */
+# define STACKBOTTOM USRSTACK
+# else
+# define HEURISTIC2
+# endif
+# include <unistd.h>
+# define GETPAGESIZE() sysconf(_SC_PAGESIZE)
+ /* getpagesize() appeared to be missing from at least one */
+ /* Solaris 5.4 installation. Weird. */
+# define DYNAMIC_LOADING
+# endif
+# ifdef SUNOS4
+# define OS_TYPE "SUNOS4"
+ /* [If you have a weak stomach, don't read this.] */
+ /* We would like to use: */
+/* # define DATASTART ((ptr_t)((((word) (etext)) + 0x1fff) & ~0x1fff)) */
+ /* This fails occasionally, due to an ancient, but very */
+ /* persistent ld bug. etext is set 32 bytes too high. */
+ /* We instead read the text segment size from the a.out */
+ /* header, which happens to be mapped into our address space */
+ /* at the start of the text segment. The detective work here */
+ /* was done by Robert Ehrlich, Manuel Serrano, and Bernard */
+ /* Serpette of INRIA. */
+ /* This assumes ZMAGIC, i.e. demand-loadable executables. */
+# define TEXTSTART 0x2000
+# define DATASTART ((ptr_t)(*(int *)(TEXTSTART+0x4)+TEXTSTART))
+# define MPROTECT_VDB
+# define HEURISTIC1
+# define DYNAMIC_LOADING
+# endif
+# ifdef DRSNX
+# define OS_TYPE "DRSNX"
+ extern ptr_t GC_SysVGetDataStart();
+ extern int etext[];
+# define DATASTART GC_SysVGetDataStart(0x10000, etext)
+# define MPROTECT_VDB
+# define STACKBOTTOM ((ptr_t) 0xdfff0000)
+# define DYNAMIC_LOADING
+# endif
+# ifdef LINUX
+# define OS_TYPE "LINUX"
+# ifdef __ELF__
+# define DYNAMIC_LOADING
+# else
+ Linux Sparc/a.out not supported
+# endif
+ extern int _end[];
+ extern int _etext[];
+# define DATAEND (_end)
+# define SVR4
+ extern ptr_t GC_SysVGetDataStart();
+# ifdef __arch64__
+# define DATASTART GC_SysVGetDataStart(0x100000, _etext)
+ /* libc_stack_end is not set reliably for sparc64 */
+# define STACKBOTTOM ((ptr_t) 0x80000000000ULL)
+# else
+# define DATASTART GC_SysVGetDataStart(0x10000, _etext)
+# define LINUX_STACKBOTTOM
+# endif
+# endif
+# ifdef OPENBSD
+# define OS_TYPE "OPENBSD"
+# define STACKBOTTOM ((ptr_t) 0xf8000000)
+ extern int etext[];
+# define DATASTART ((ptr_t)(etext))
+# endif
+# ifdef NETBSD
+# define OS_TYPE "NETBSD"
+# define HEURISTIC2
+# ifdef __ELF__
+# define DATASTART GC_data_start
+# define DYNAMIC_LOADING
+# else
+ extern char etext[];
+# define DATASTART ((ptr_t)(etext))
+# endif
+# endif
+# endif
+
+# ifdef I386
+# define MACH_TYPE "I386"
+# define ALIGNMENT 4 /* Appears to hold for all "32 bit" compilers */
+ /* except Borland. The -a4 option fixes */
+ /* Borland. */
+ /* Ivan Demakov: For Watcom the option is -zp4. */
+# ifndef SMALL_CONFIG
+# define ALIGN_DOUBLE /* Not strictly necessary, but may give speed */
+ /* improvement on Pentiums. */
+# endif
+# ifdef HAVE_BUILTIN_UNWIND_INIT
+# define USE_GENERIC_PUSH_REGS
+# endif
+# ifdef SEQUENT
+# define OS_TYPE "SEQUENT"
+ extern int etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0xfff) & ~0xfff))
+# define STACKBOTTOM ((ptr_t) 0x3ffff000)
+# endif
+# ifdef BEOS
+# define OS_TYPE "BEOS"
+# include <OS.h>
+# define GETPAGESIZE() B_PAGE_SIZE
+ extern int etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0xfff) & ~0xfff))
+# endif
+# ifdef SUNOS5
+# define OS_TYPE "SUNOS5"
+ extern int _etext[], _end[];
+ extern ptr_t GC_SysVGetDataStart();
+# define DATASTART GC_SysVGetDataStart(0x1000, _etext)
+# define DATAEND (_end)
+/* # define STACKBOTTOM ((ptr_t)(_start)) worked through 2.7, */
+/* but reportedly breaks under 2.8. It appears that the stack */
+/* base is a property of the executable, so this should not break */
+/* old executables. */
+/* HEURISTIC2 probably works, but this appears to be preferable. */
+# include <sys/vm.h>
+# define STACKBOTTOM USRSTACK
+/* At least in Solaris 2.5, PROC_VDB gives wrong values for dirty bits. */
+/* It appears to be fixed in 2.8 and 2.9. */
+# ifdef SOLARIS25_PROC_VDB_BUG_FIXED
+# define PROC_VDB
+# endif
+# define DYNAMIC_LOADING
+# if !defined(USE_MMAP) && defined(REDIRECT_MALLOC)
+# define USE_MMAP
+ /* Otherwise we now use calloc. Mmap may result in the */
+ /* heap interleaved with thread stacks, which can result in */
+ /* excessive blacklisting. Sbrk is unusable since it */
+ /* doesn't interact correctly with the system malloc. */
+# endif
+# ifdef USE_MMAP
+# define HEAP_START (ptr_t)0x40000000
+# else
+# define HEAP_START DATAEND
+# endif
+# endif
+# ifdef SCO
+# define OS_TYPE "SCO"
+ extern int etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0x3fffff) \
+ & ~0x3fffff) \
+ +((word)etext & 0xfff))
+# define STACKBOTTOM ((ptr_t) 0x7ffffffc)
+# endif
+# ifdef SCO_ELF
+# define OS_TYPE "SCO_ELF"
+ extern int etext[];
+# define DATASTART ((ptr_t)(etext))
+# define STACKBOTTOM ((ptr_t) 0x08048000)
+# define DYNAMIC_LOADING
+# define ELF_CLASS ELFCLASS32
+# endif
+# ifdef DGUX
+# define OS_TYPE "DGUX"
+ extern int _etext, _end;
+ extern ptr_t GC_SysVGetDataStart();
+# define DATASTART GC_SysVGetDataStart(0x1000, &_etext)
+# define DATAEND (&_end)
+# define STACK_GROWS_DOWN
+# define HEURISTIC2
+# include <unistd.h>
+# define GETPAGESIZE() sysconf(_SC_PAGESIZE)
+# define DYNAMIC_LOADING
+# ifndef USE_MMAP
+# define USE_MMAP
+# endif /* USE_MMAP */
+# define MAP_FAILED (void *) -1
+# ifdef USE_MMAP
+# define HEAP_START (ptr_t)0x40000000
+# else /* USE_MMAP */
+# define HEAP_START DATAEND
+# endif /* USE_MMAP */
+# endif /* DGUX */
+
+# ifdef LINUX
+# ifndef __GNUC__
+ /* The Intel compiler doesn't like inline assembly */
+# define USE_GENERIC_PUSH_REGS
+# endif
+# define OS_TYPE "LINUX"
+# define LINUX_STACKBOTTOM
+# if 0
+# define HEURISTIC1
+# undef STACK_GRAN
+# define STACK_GRAN 0x10000000
+ /* STACKBOTTOM is usually 0xc0000000, but this changes with */
+ /* different kernel configurations. In particular, systems */
+ /* with 2GB physical memory will usually move the user */
+ /* address space limit, and hence initial SP to 0x80000000. */
+# endif
+# if !defined(GC_LINUX_THREADS) || !defined(REDIRECT_MALLOC)
+# define MPROTECT_VDB
+# else
+ /* We seem to get random errors in incremental mode, */
+ /* possibly because Linux threads is itself a malloc client */
+ /* and can't deal with the signals. */
+# endif
+# define HEAP_START 0x1000
+ /* This encourages mmap to give us low addresses, */
+ /* thus allowing the heap to grow to ~3GB */
+# ifdef __ELF__
+# define DYNAMIC_LOADING
+# ifdef UNDEFINED /* includes ro data */
+ extern int _etext[];
+# define DATASTART ((ptr_t)((((word) (_etext)) + 0xfff) & ~0xfff))
+# endif
+# include <features.h>
+# if defined(__GLIBC__) && __GLIBC__ >= 2
+# define SEARCH_FOR_DATA_START
+# else
+ extern char **__environ;
+# define DATASTART ((ptr_t)(&__environ))
+ /* hideous kludge: __environ is the first */
+ /* word in crt0.o, and delimits the start */
+ /* of the data segment, no matter which */
+ /* ld options were passed through. */
+ /* We could use _etext instead, but that */
+ /* would include .rodata, which may */
+ /* contain large read-only data tables */
+ /* that we'd rather not scan. */
+# endif
+ extern int _end[];
+# define DATAEND (_end)
+# else
+ extern int etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0xfff) & ~0xfff))
+# endif
+# ifdef USE_I686_PREFETCH
+# define PREFETCH(x) \
+ __asm__ __volatile__ (" prefetchnta %0": : "m"(*(char *)(x)))
+ /* Empirically prefetcht0 is much more effective at reducing */
+ /* cache miss stalls for the targetted load instructions. But it */
+ /* seems to interfere enough with other cache traffic that the net */
+ /* result is worse than prefetchnta. */
+# if 0
+ /* Using prefetches for write seems to have a slight negative */
+ /* impact on performance, at least for a PIII/500. */
+# define PREFETCH_FOR_WRITE(x) \
+ __asm__ __volatile__ (" prefetcht0 %0": : "m"(*(char *)(x)))
+# endif
+# endif
+# ifdef USE_3DNOW_PREFETCH
+# define PREFETCH(x) \
+ __asm__ __volatile__ (" prefetch %0": : "m"(*(char *)(x)))
+# define PREFETCH_FOR_WRITE(x) \
+ __asm__ __volatile__ (" prefetchw %0": : "m"(*(char *)(x)))
+# endif
+# endif
+# ifdef CYGWIN32
+# define OS_TYPE "CYGWIN32"
+ extern int _data_start__[];
+ extern int _data_end__[];
+ extern int _bss_start__[];
+ extern int _bss_end__[];
+ /* For binutils 2.9.1, we have */
+ /* DATASTART = _data_start__ */
+ /* DATAEND = _bss_end__ */
+ /* whereas for some earlier versions it was */
+ /* DATASTART = _bss_start__ */
+ /* DATAEND = _data_end__ */
+ /* To get it right for both, we take the */
+ /* minumum/maximum of the two. */
+# define MAX(x,y) ((x) > (y) ? (x) : (y))
+# define MIN(x,y) ((x) < (y) ? (x) : (y))
+# define DATASTART ((ptr_t) MIN(_data_start__, _bss_start__))
+# define DATAEND ((ptr_t) MAX(_data_end__, _bss_end__))
+# undef STACK_GRAN
+# define STACK_GRAN 0x10000
+# define HEURISTIC1
+# endif
+# ifdef OS2
+# define OS_TYPE "OS2"
+ /* STACKBOTTOM and DATASTART are handled specially in */
+ /* os_dep.c. OS2 actually has the right */
+ /* system call! */
+# define DATAEND /* not needed */
+# define USE_GENERIC_PUSH_REGS
+# endif
+# ifdef MSWIN32
+# define OS_TYPE "MSWIN32"
+ /* STACKBOTTOM and DATASTART are handled specially in */
+ /* os_dep.c. */
+# ifndef __WATCOMC__
+# define MPROTECT_VDB
+# endif
+# define DATAEND /* not needed */
+# endif
+# ifdef MSWINCE
+# define OS_TYPE "MSWINCE"
+# define DATAEND /* not needed */
+# endif
+# ifdef DJGPP
+# define OS_TYPE "DJGPP"
+# include "stubinfo.h"
+ extern int etext[];
+ extern int _stklen;
+ extern int __djgpp_stack_limit;
+# define DATASTART ((ptr_t)((((word) (etext)) + 0x1ff) & ~0x1ff))
+/* # define STACKBOTTOM ((ptr_t)((word) _stubinfo + _stubinfo->size \
+ + _stklen)) */
+# define STACKBOTTOM ((ptr_t)((word) __djgpp_stack_limit + _stklen))
+ /* This may not be right. */
+# endif
+# ifdef OPENBSD
+# define OS_TYPE "OPENBSD"
+# endif
+# ifdef FREEBSD
+# define OS_TYPE "FREEBSD"
+# ifndef GC_FREEBSD_THREADS
+# define MPROTECT_VDB
+# endif
+# define SIG_SUSPEND SIGUSR1
+# define SIG_THR_RESTART SIGUSR2
+# define FREEBSD_STACKBOTTOM
+# ifdef __ELF__
+# define DYNAMIC_LOADING
+# endif
+ extern char etext[];
+ extern char * GC_FreeBSDGetDataStart();
+# define DATASTART GC_FreeBSDGetDataStart(0x1000, &etext)
+# endif
+# ifdef NETBSD
+# define OS_TYPE "NETBSD"
+# ifdef __ELF__
+# define DYNAMIC_LOADING
+# endif
+# endif
+# ifdef THREE86BSD
+# define OS_TYPE "THREE86BSD"
+# endif
+# ifdef BSDI
+# define OS_TYPE "BSDI"
+# endif
+# if defined(OPENBSD) || defined(NETBSD) \
+ || defined(THREE86BSD) || defined(BSDI)
+# define HEURISTIC2
+ extern char etext[];
+# define DATASTART ((ptr_t)(etext))
+# endif
+# ifdef NEXT
+# define OS_TYPE "NEXT"
+# define DATASTART ((ptr_t) get_etext())
+# define STACKBOTTOM ((ptr_t)0xc0000000)
+# define DATAEND /* not needed */
+# endif
+# ifdef DOS4GW
+# define OS_TYPE "DOS4GW"
+ extern long __nullarea;
+ extern char _end;
+ extern char *_STACKTOP;
+ /* Depending on calling conventions Watcom C either precedes
+ or does not precedes with undescore names of C-variables.
+ Make sure startup code variables always have the same names. */
+ #pragma aux __nullarea "*";
+ #pragma aux _end "*";
+# define STACKBOTTOM ((ptr_t) _STACKTOP)
+ /* confused? me too. */
+# define DATASTART ((ptr_t) &__nullarea)
+# define DATAEND ((ptr_t) &_end)
+# endif
+# ifdef HURD
+# define OS_TYPE "HURD"
+# define STACK_GROWS_DOWN
+# define HEURISTIC2
+ extern int __data_start[];
+# define DATASTART ( (ptr_t) (__data_start))
+ extern int _end[];
+# define DATAEND ( (ptr_t) (_end))
+/* # define MPROTECT_VDB Not quite working yet? */
+# define DYNAMIC_LOADING
+# endif
+# endif
+
+# ifdef NS32K
+# define MACH_TYPE "NS32K"
+# define ALIGNMENT 4
+ extern char **environ;
+# define DATASTART ((ptr_t)(&environ))
+ /* hideous kludge: environ is the first */
+ /* word in crt0.o, and delimits the start */
+ /* of the data segment, no matter which */
+ /* ld options were passed through. */
+# define STACKBOTTOM ((ptr_t) 0xfffff000) /* for Encore */
+# endif
+
+# ifdef MIPS
+# define MACH_TYPE "MIPS"
+# ifdef LINUX
+ /* This was developed for a linuxce style platform. Probably */
+ /* needs to be tweaked for workstation class machines. */
+# define OS_TYPE "LINUX"
+# define DYNAMIC_LOADING
+ extern int _end[];
+# define DATAEND (_end)
+ extern int __data_start[];
+# define DATASTART ((ptr_t)(__data_start))
+# define ALIGNMENT 4
+# define USE_GENERIC_PUSH_REGS
+# if __GLIBC__ == 2 && __GLIBC_MINOR__ >= 2 || __GLIBC__ > 2
+# define LINUX_STACKBOTTOM
+# else
+# define STACKBOTTOM 0x80000000
+# endif
+# endif /* Linux */
+# ifdef EWS4800
+# define HEURISTIC2
+# if defined(_MIPS_SZPTR) && (_MIPS_SZPTR == 64)
+ extern int _fdata[], _end[];
+# define DATASTART ((ptr_t)_fdata)
+# define DATAEND ((ptr_t)_end)
+# define CPP_WORDSZ _MIPS_SZPTR
+# define ALIGNMENT (_MIPS_SZPTR/8)
+# else
+ extern int etext[], edata[], end[];
+ extern int _DYNAMIC_LINKING[], _gp[];
+# define DATASTART ((ptr_t)((((word)etext + 0x3ffff) & ~0x3ffff) \
+ + ((word)etext & 0xffff)))
+# define DATAEND (edata)
+# define DATASTART2 (_DYNAMIC_LINKING \
+ ? (ptr_t)(((word)_gp + 0x8000 + 0x3ffff) & ~0x3ffff) \
+ : (ptr_t)edata)
+# define DATAEND2 (end)
+# define ALIGNMENT 4
+# endif
+# define OS_TYPE "EWS4800"
+# define USE_GENERIC_PUSH_REGS 1
+# endif
+# ifdef ULTRIX
+# define HEURISTIC2
+# define DATASTART (ptr_t)0x10000000
+ /* Could probably be slightly higher since */
+ /* startup code allocates lots of stuff. */
+# define OS_TYPE "ULTRIX"
+# define ALIGNMENT 4
+# endif
+# ifdef RISCOS
+# define HEURISTIC2
+# define DATASTART (ptr_t)0x10000000
+# define OS_TYPE "RISCOS"
+# define ALIGNMENT 4 /* Required by hardware */
+# endif
+# ifdef IRIX5
+# define HEURISTIC2
+ extern int _fdata[];
+# define DATASTART ((ptr_t)(_fdata))
+# ifdef USE_MMAP
+# define HEAP_START (ptr_t)0x30000000
+# else
+# define HEAP_START DATASTART
+# endif
+ /* Lowest plausible heap address. */
+ /* In the MMAP case, we map there. */
+ /* In either case it is used to identify */
+ /* heap sections so they're not */
+ /* considered as roots. */
+# define OS_TYPE "IRIX5"
+# define MPROTECT_VDB
+# ifdef _MIPS_SZPTR
+# define CPP_WORDSZ _MIPS_SZPTR
+# define ALIGNMENT (_MIPS_SZPTR/8)
+# if CPP_WORDSZ != 64
+# define ALIGN_DOUBLE
+# endif
+# else
+# define ALIGNMENT 4
+# define ALIGN_DOUBLE
+# endif
+# define DYNAMIC_LOADING
+# endif
+# ifdef MSWINCE
+# define OS_TYPE "MSWINCE"
+# define ALIGNMENT 4
+# define DATAEND /* not needed */
+# endif
+# if defined(NETBSD)
+ /* This also checked for __MIPSEL__ . Why? NETBSD recognition */
+ /* should be handled at the top of the file. */
+# define ALIGNMENT 4
+# define OS_TYPE "NETBSD"
+# define HEURISTIC2
+# define USE_GENERIC_PUSH_REGS
+# ifdef __ELF__
+ extern int etext[];
+# define DATASTART GC_data_start
+# define NEED_FIND_LIMIT
+# define DYNAMIC_LOADING
+# else
+# define DATASTART ((ptr_t) 0x10000000)
+# define STACKBOTTOM ((ptr_t) 0x7ffff000)
+# endif /* _ELF_ */
+# endif
+# endif
+
+# ifdef RS6000
+# define MACH_TYPE "RS6000"
+# ifdef __64BIT__
+# define ALIGNMENT 8
+# define CPP_WORDSZ 64
+# define STACKBOTTOM 0x1000000000000000
+# else
+# define ALIGNMENT 4
+# define CPP_WORDSZ 32
+# define STACKBOTTOM ((ptr_t)((ulong)&errno))
+# endif
+ extern int _data[], _end[];
+# define DATASTART ((ptr_t)((ulong)_data))
+# define DATAEND ((ptr_t)((ulong)_end))
+ extern int errno;
+# define USE_GENERIC_PUSH_REGS
+# define DYNAMIC_LOADING
+ /* For really old versions of AIX, this may have to be removed. */
+# endif
+
+# ifdef HP_PA
+# define MACH_TYPE "HP_PA"
+# ifdef __LP64__
+# define CPP_WORDSZ 64
+# define ALIGNMENT 8
+# else
+# define CPP_WORDSZ 32
+# define ALIGNMENT 4
+# define ALIGN_DOUBLE
+# endif
+# if !defined(GC_HPUX_THREADS) && !defined(GC_LINUX_THREADS)
+# ifndef LINUX /* For now. */
+# define MPROTECT_VDB
+# endif
+# else
+# define GENERIC_COMPARE_AND_SWAP
+ /* No compare-and-swap instruction. Use pthread mutexes */
+ /* when we absolutely have to. */
+# ifdef PARALLEL_MARK
+# define USE_MARK_BYTES
+ /* Minimize compare-and-swap usage. */
+# endif
+# endif
+# define STACK_GROWS_UP
+# ifdef HPUX
+# define OS_TYPE "HPUX"
+ extern int __data_start[];
+# define DATASTART ((ptr_t)(__data_start))
+# if 0
+ /* The following appears to work for 7xx systems running HP/UX */
+ /* 9.xx Furthermore, it might result in much faster */
+ /* collections than HEURISTIC2, which may involve scanning */
+ /* segments that directly precede the stack. It is not the */
+ /* default, since it may not work on older machine/OS */
+ /* combinations. (Thanks to Raymond X.T. Nijssen for uncovering */
+ /* this.) */
+# define STACKBOTTOM ((ptr_t) 0x7b033000) /* from /etc/conf/h/param.h */
+# else
+ /* Gustavo Rodriguez-Rivera suggested changing HEURISTIC2 */
+ /* to this. Note that the GC must be initialized before the */
+ /* first putenv call. */
+ extern char ** environ;
+# define STACKBOTTOM ((ptr_t)environ)
+# endif
+# define DYNAMIC_LOADING
+# include <unistd.h>
+# define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
+# ifndef __GNUC__
+# define PREFETCH(x) { \
+ register long addr = (long)(x); \
+ (void) _asm ("LDW", 0, 0, addr, 0); \
+ }
+# endif
+# endif /* HPUX */
+# ifdef LINUX
+# define OS_TYPE "LINUX"
+# define LINUX_STACKBOTTOM
+# define DYNAMIC_LOADING
+# define SEARCH_FOR_DATA_START
+ extern int _end[];
+# define DATAEND (&_end)
+# endif /* LINUX */
+# endif /* HP_PA */
+
+# ifdef ALPHA
+# define MACH_TYPE "ALPHA"
+# define ALIGNMENT 8
+# define CPP_WORDSZ 64
+# ifndef LINUX
+# define USE_GENERIC_PUSH_REGS
+ /* Gcc and probably the DEC/Compaq compiler spill pointers to preserved */
+ /* fp registers in some cases when the target is a 21264. The assembly */
+ /* code doesn't handle that yet, and version dependencies make that a */
+ /* bit tricky. Do the easy thing for now. */
+# endif
+# ifdef NETBSD
+# define OS_TYPE "NETBSD"
+# define HEURISTIC2
+# define DATASTART GC_data_start
+# define ELFCLASS32 32
+# define ELFCLASS64 64
+# define ELF_CLASS ELFCLASS64
+# define DYNAMIC_LOADING
+# endif
+# ifdef OPENBSD
+# define OS_TYPE "OPENBSD"
+# define HEURISTIC2
+# ifdef __ELF__ /* since OpenBSD/Alpha 2.9 */
+# define DATASTART GC_data_start
+# define ELFCLASS32 32
+# define ELFCLASS64 64
+# define ELF_CLASS ELFCLASS64
+# else /* ECOFF, until OpenBSD/Alpha 2.7 */
+# define DATASTART ((ptr_t) 0x140000000)
+# endif
+# endif
+# ifdef FREEBSD
+# define OS_TYPE "FREEBSD"
+/* MPROTECT_VDB is not yet supported at all on FreeBSD/alpha. */
+# define SIG_SUSPEND SIGUSR1
+# define SIG_THR_RESTART SIGUSR2
+# define FREEBSD_STACKBOTTOM
+# ifdef __ELF__
+# define DYNAMIC_LOADING
+# endif
+/* Handle unmapped hole alpha*-*-freebsd[45]* puts between etext and edata. */
+ extern char etext[];
+ extern char edata[];
+ extern char end[];
+# define NEED_FIND_LIMIT
+# define DATASTART ((ptr_t)(&etext))
+# define DATAEND (GC_find_limit (DATASTART, TRUE))
+# define DATASTART2 ((ptr_t)(&edata))
+# define DATAEND2 ((ptr_t)(&end))
+# endif
+# ifdef OSF1
+# define OS_TYPE "OSF1"
+# define DATASTART ((ptr_t) 0x140000000)
+ extern int _end[];
+# define DATAEND ((ptr_t) &_end)
+ extern char ** environ;
+ /* round up from the value of environ to the nearest page boundary */
+ /* Probably breaks if putenv is called before collector */
+ /* initialization. */
+# define STACKBOTTOM ((ptr_t)(((word)(environ) | (getpagesize()-1))+1))
+/* # define HEURISTIC2 */
+ /* Normally HEURISTIC2 is too conervative, since */
+ /* the text segment immediately follows the stack. */
+ /* Hence we give an upper pound. */
+ /* This is currently unused, since we disabled HEURISTIC2 */
+ extern int __start[];
+# define HEURISTIC2_LIMIT ((ptr_t)((word)(__start) & ~(getpagesize()-1)))
+# ifndef GC_OSF1_THREADS
+ /* Unresolved signal issues with threads. */
+# define MPROTECT_VDB
+# endif
+# define DYNAMIC_LOADING
+# endif
+# ifdef LINUX
+# define OS_TYPE "LINUX"
+# define STACKBOTTOM ((ptr_t) 0x120000000)
+# ifdef __ELF__
+# define SEARCH_FOR_DATA_START
+# define DYNAMIC_LOADING
+# else
+# define DATASTART ((ptr_t) 0x140000000)
+# endif
+ extern int _end[];
+# define DATAEND (_end)
+# define MPROTECT_VDB
+ /* Has only been superficially tested. May not */
+ /* work on all versions. */
+# endif
+# endif
+
+# ifdef IA64
+# define MACH_TYPE "IA64"
+# define USE_GENERIC_PUSH_REGS
+ /* We need to get preserved registers in addition to register */
+ /* windows. That's easiest to do with setjmp. */
+# ifdef PARALLEL_MARK
+# define USE_MARK_BYTES
+ /* Compare-and-exchange is too expensive to use for */
+ /* setting mark bits. */
+# endif
+# ifdef HPUX
+# ifdef _ILP32
+# define CPP_WORDSZ 32
+# define ALIGN_DOUBLE
+ /* Requires 8 byte alignment for malloc */
+# define ALIGNMENT 4
+# else
+# ifndef _LP64
+ ---> unknown ABI
+# endif
+# define CPP_WORDSZ 64
+# define ALIGN_DOUBLE
+ /* Requires 16 byte alignment for malloc */
+# define ALIGNMENT 8
+# endif
+# define OS_TYPE "HPUX"
+ extern int __data_start[];
+# define DATASTART ((ptr_t)(__data_start))
+ /* Gustavo Rodriguez-Rivera suggested changing HEURISTIC2 */
+ /* to this. Note that the GC must be initialized before the */
+ /* first putenv call. */
+ extern char ** environ;
+# define STACKBOTTOM ((ptr_t)environ)
+# define DYNAMIC_LOADING
+# include <unistd.h>
+# define GETPAGESIZE() sysconf(_SC_PAGE_SIZE)
+ /* The following was empirically determined, and is probably */
+ /* not very robust. */
+ /* Note that the backing store base seems to be at a nice */
+ /* address minus one page. */
+# define BACKING_STORE_DISPLACEMENT 0x1000000
+# define BACKING_STORE_ALIGNMENT 0x1000
+# define BACKING_STORE_BASE \
+ (ptr_t)(((word)GC_stackbottom - BACKING_STORE_DISPLACEMENT - 1) \
+ & ~(BACKING_STORE_ALIGNMENT - 1))
+# endif
+# ifdef LINUX
+# define CPP_WORDSZ 64
+# define ALIGN_DOUBLE
+ /* Requires 16 byte alignment for malloc */
+# define ALIGNMENT 8
+# define OS_TYPE "LINUX"
+ /* The following works on NUE and older kernels: */
+/* # define STACKBOTTOM ((ptr_t) 0xa000000000000000l) */
+ /* This does not work on NUE: */
+# define LINUX_STACKBOTTOM
+ /* We also need the base address of the register stack */
+ /* backing store. This is computed in */
+ /* GC_linux_register_stack_base based on the following */
+ /* constants: */
+# define BACKING_STORE_ALIGNMENT 0x100000
+# define BACKING_STORE_DISPLACEMENT 0x80000000
+ extern char * GC_register_stackbottom;
+# define BACKING_STORE_BASE ((ptr_t)GC_register_stackbottom)
+# define SEARCH_FOR_DATA_START
+# ifdef __GNUC__
+# define DYNAMIC_LOADING
+# else
+ /* In the Intel compiler environment, we seem to end up with */
+ /* statically linked executables and an undefined reference */
+ /* to _DYNAMIC */
+# endif
+# define MPROTECT_VDB
+ /* Requires Linux 2.3.47 or later. */
+ extern int _end[];
+# define DATAEND (_end)
+# ifdef __GNUC__
+# define PREFETCH(x) \
+ __asm__ (" lfetch [%0]": : "r"((void *)(x)))
+# define PREFETCH_FOR_WRITE(x) \
+ __asm__ (" lfetch.excl [%0]": : "r"((void *)(x)))
+# define CLEAR_DOUBLE(x) \
+ __asm__ (" stf.spill [%0]=f0": : "r"((void *)(x)))
+# endif
+# endif
+# endif
+
+# ifdef M88K
+# define MACH_TYPE "M88K"
+# define ALIGNMENT 4
+# define ALIGN_DOUBLE
+ extern int etext[];
+# ifdef CX_UX
+# define OS_TYPE "CX_UX"
+# define DATASTART ((((word)etext + 0x3fffff) & ~0x3fffff) + 0x10000)
+# endif
+# ifdef DGUX
+# define OS_TYPE "DGUX"
+ extern ptr_t GC_SysVGetDataStart();
+# define DATASTART GC_SysVGetDataStart(0x10000, etext)
+# endif
+# define STACKBOTTOM ((char*)0xf0000000) /* determined empirically */
+# endif
+
+# ifdef S370
+ /* If this still works, and if anyone cares, this should probably */
+ /* be moved to the S390 category. */
+# define MACH_TYPE "S370"
+# define ALIGNMENT 4 /* Required by hardware */
+# define USE_GENERIC_PUSH_REGS
+# ifdef UTS4
+# define OS_TYPE "UTS4"
+ extern int etext[];
+ extern int _etext[];
+ extern int _end[];
+ extern ptr_t GC_SysVGetDataStart();
+# define DATASTART GC_SysVGetDataStart(0x10000, _etext)
+# define DATAEND (_end)
+# define HEURISTIC2
+# endif
+# endif
+
+# ifdef S390
+# define MACH_TYPE "S390"
+# define USE_GENERIC_PUSH_REGS
+# ifndef __s390x__
+# define ALIGNMENT 4
+# define CPP_WORDSZ 32
+# else
+# define ALIGNMENT 8
+# define CPP_WORDSZ 64
+# define HBLKSIZE 4096
+# endif
+# ifdef LINUX
+# define OS_TYPE "LINUX"
+# define LINUX_STACKBOTTOM
+# define DYNAMIC_LOADING
+ extern int __data_start[];
+# define DATASTART ((ptr_t)(__data_start))
+ extern int _end[];
+# define DATAEND (_end)
+# define CACHE_LINE_SIZE 256
+# define GETPAGESIZE() 4096
+# endif
+# endif
+
+# if defined(PJ)
+# define ALIGNMENT 4
+ extern int _etext[];
+# define DATASTART ((ptr_t)(_etext))
+# define HEURISTIC1
+# endif
+
+# ifdef ARM32
+# define CPP_WORDSZ 32
+# define MACH_TYPE "ARM32"
+# define ALIGNMENT 4
+# ifdef NETBSD
+# define OS_TYPE "NETBSD"
+# define HEURISTIC2
+ extern char etext[];
+# define DATASTART ((ptr_t)(etext))
+# define USE_GENERIC_PUSH_REGS
+# endif
+# ifdef LINUX
+# define OS_TYPE "LINUX"
+# define HEURISTIC1
+# undef STACK_GRAN
+# define STACK_GRAN 0x10000000
+# define USE_GENERIC_PUSH_REGS
+# ifdef __ELF__
+# define DYNAMIC_LOADING
+# include <features.h>
+# if defined(__GLIBC__) && __GLIBC__ >= 2
+# define SEARCH_FOR_DATA_START
+# else
+ extern char **__environ;
+# define DATASTART ((ptr_t)(&__environ))
+ /* hideous kludge: __environ is the first */
+ /* word in crt0.o, and delimits the start */
+ /* of the data segment, no matter which */
+ /* ld options were passed through. */
+ /* We could use _etext instead, but that */
+ /* would include .rodata, which may */
+ /* contain large read-only data tables */
+ /* that we'd rather not scan. */
+# endif
+ extern int _end[];
+# define DATAEND (_end)
+# else
+ extern int etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0xfff) & ~0xfff))
+# endif
+# endif
+# ifdef MSWINCE
+# define OS_TYPE "MSWINCE"
+# define DATAEND /* not needed */
+# endif
+# ifdef NOSYS
+ /* __data_start is usually defined in the target linker script. */
+ extern int __data_start[];
+# define DATASTART (ptr_t)(__data_start)
+# define USE_GENERIC_PUSH_REGS
+ /* __stack_base__ is set in newlib/libc/sys/arm/crt0.S */
+ extern void *__stack_base__;
+# define STACKBOTTOM ((ptr_t) (__stack_base__))
+# endif
+#endif
+
+# ifdef SH
+# define MACH_TYPE "SH"
+# define ALIGNMENT 4
+# ifdef MSWINCE
+# define OS_TYPE "MSWINCE"
+# define DATAEND /* not needed */
+# endif
+# ifdef LINUX
+# define OS_TYPE "LINUX"
+# define STACKBOTTOM ((ptr_t) 0x7c000000)
+# define USE_GENERIC_PUSH_REGS
+# define DYNAMIC_LOADING
+# define SEARCH_FOR_DATA_START
+ extern int _end[];
+# define DATAEND (_end)
+# endif
+# endif
+
+# ifdef SH4
+# define MACH_TYPE "SH4"
+# define OS_TYPE "MSWINCE"
+# define ALIGNMENT 4
+# define DATAEND /* not needed */
+# endif
+
+# ifdef X86_64
+# define MACH_TYPE "X86_64"
+# define ALIGNMENT 8
+# define CPP_WORDSZ 64
+# ifndef HBLKSIZE
+# define HBLKSIZE 4096
+# endif
+# define CACHE_LINE_SIZE 64
+# define USE_GENERIC_PUSH_REGS
+# ifdef LINUX
+# define OS_TYPE "LINUX"
+# define LINUX_STACKBOTTOM
+# if !defined(GC_LINUX_THREADS) || !defined(REDIRECT_MALLOC)
+# define MPROTECT_VDB
+# else
+ /* We seem to get random errors in incremental mode, */
+ /* possibly because Linux threads is itself a malloc client */
+ /* and can't deal with the signals. */
+# endif
+# ifdef __ELF__
+# define DYNAMIC_LOADING
+# ifdef UNDEFINED /* includes ro data */
+ extern int _etext[];
+# define DATASTART ((ptr_t)((((word) (_etext)) + 0xfff) & ~0xfff))
+# endif
+# include <features.h>
+# define SEARCH_FOR_DATA_START
+ extern int _end[];
+# define DATAEND (_end)
+# else
+ extern int etext[];
+# define DATASTART ((ptr_t)((((word) (etext)) + 0xfff) & ~0xfff))
+# endif
+# define PREFETCH(x) \
+ __asm__ __volatile__ (" prefetch %0": : "m"(*(char *)(x)))
+# define PREFETCH_FOR_WRITE(x) \
+ __asm__ __volatile__ (" prefetchw %0": : "m"(*(char *)(x)))
+# endif
+# endif
+
+#if defined(LINUX) && defined(REDIRECT_MALLOC)
+ /* Rld appears to allocate some memory with its own allocator, and */
+ /* some through malloc, which might be redirected. To make this */
+ /* work with collectable memory, we have to scan memory allocated */
+ /* by rld's internal malloc. */
+# define USE_PROC_FOR_LIBRARIES
+#endif
+
+# ifndef STACK_GROWS_UP
+# define STACK_GROWS_DOWN
+# endif
+
+# ifndef CPP_WORDSZ
+# define CPP_WORDSZ 32
+# endif
+
+# ifndef OS_TYPE
+# define OS_TYPE ""
+# endif
+
+# ifndef DATAEND
+ extern int end[];
+# define DATAEND (end)
+# endif
+
+# if defined(SVR4) && !defined(GETPAGESIZE)
+# include <unistd.h>
+# define GETPAGESIZE() sysconf(_SC_PAGESIZE)
+# endif
+
+# ifndef GETPAGESIZE
+# if defined(SUNOS5) || defined(IRIX5)
+# include <unistd.h>
+# endif
+# define GETPAGESIZE() getpagesize()
+# endif
+
+# if defined(SUNOS5) || defined(DRSNX) || defined(UTS4)
+ /* OS has SVR4 generic features. Probably others also qualify. */
+# define SVR4
+# endif
+
+# if defined(SUNOS5) || defined(DRSNX)
+ /* OS has SUNOS5 style semi-undocumented interface to dynamic */
+ /* loader. */
+# define SUNOS5DL
+ /* OS has SUNOS5 style signal handlers. */
+# define SUNOS5SIGS
+# endif
+
+# if defined(HPUX)
+# define SUNOS5SIGS
+# endif
+
+# if defined(SVR4) || defined(LINUX) || defined(IRIX) || defined(HPUX) \
+ || defined(OPENBSD) || defined(NETBSD) || defined(FREEBSD) || defined(DGUX) \
+ || defined(BSD) || defined(AIX) || defined(MACOSX) || defined(OSF1)
+# define UNIX_LIKE /* Basic Unix-like system calls work. */
+# endif
+
+# if CPP_WORDSZ != 32 && CPP_WORDSZ != 64
+ -> bad word size
+# endif
+
+# ifdef PCR
+# undef DYNAMIC_LOADING
+# undef STACKBOTTOM
+# undef HEURISTIC1
+# undef HEURISTIC2
+# undef PROC_VDB
+# undef MPROTECT_VDB
+# define PCR_VDB
+# endif
+
+# ifdef SRC_M3
+ /* Postponed for now. */
+# undef PROC_VDB
+# undef MPROTECT_VDB
+# endif
+
+# ifdef SMALL_CONFIG
+ /* Presumably not worth the space it takes. */
+# undef PROC_VDB
+# undef MPROTECT_VDB
+# endif
+
+# ifdef USE_MUNMAP
+# undef MPROTECT_VDB /* Can't deal with address space holes. */
+# endif
+
+# ifdef PARALLEL_MARK
+# undef MPROTECT_VDB /* For now. */
+# endif
+
+# if !defined(PCR_VDB) && !defined(PROC_VDB) && !defined(MPROTECT_VDB)
+# define DEFAULT_VDB
+# endif
+
+# ifndef PREFETCH
+# define PREFETCH(x)
+# define NO_PREFETCH
+# endif
+
+# ifndef PREFETCH_FOR_WRITE
+# define PREFETCH_FOR_WRITE(x)
+# define NO_PREFETCH_FOR_WRITE
+# endif
+
+# ifndef CACHE_LINE_SIZE
+# define CACHE_LINE_SIZE 32 /* Wild guess */
+# endif
+
+# ifdef LINUX
+# define REGISTER_LIBRARIES_EARLY
+ /* We sometimes use dl_iterate_phdr, which may acquire an internal */
+ /* lock. This isn't safe after the world has stopped. So we must */
+ /* call GC_register_dynamic_libraries before stopping the world. */
+ /* For performance reasons, this may be beneficial on other */
+ /* platforms as well, though it should be avoided in win32. */
+# endif /* LINUX */
+
+# if defined(SEARCH_FOR_DATA_START) && defined(GC_PRIVATE_H)
+ extern ptr_t GC_data_start;
+# define DATASTART GC_data_start
+# endif
+
+# ifndef CLEAR_DOUBLE
+# define CLEAR_DOUBLE(x) \
+ ((word*)x)[0] = 0; \
+ ((word*)x)[1] = 0;
+# endif /* CLEAR_DOUBLE */
+
+ /* Internally we use GC_SOLARIS_THREADS to test for either old or pthreads. */
+# if defined(GC_SOLARIS_PTHREADS) && !defined(GC_SOLARIS_THREADS)
+# define GC_SOLARIS_THREADS
+# endif
+
+# if defined(GC_IRIX_THREADS) && !defined(IRIX5)
+ --> inconsistent configuration
+# endif
+# if defined(GC_LINUX_THREADS) && !defined(LINUX)
+ --> inconsistent configuration
+# endif
+# if defined(GC_SOLARIS_THREADS) && !defined(SUNOS5)
+ --> inconsistent configuration
+# endif
+# if defined(GC_HPUX_THREADS) && !defined(HPUX)
+ --> inconsistent configuration
+# endif
+# if defined(GC_WIN32_THREADS) && !defined(MSWIN32) && !defined(CYGWIN32)
+ --> inconsistent configuration
+# endif
+
+# if defined(PCR) || defined(SRC_M3) || \
+ defined(GC_SOLARIS_THREADS) || defined(GC_WIN32_THREADS) || \
+ defined(GC_PTHREADS)
+# define THREADS
+# endif
+
+# if defined(HP_PA) || defined(M88K) || defined(POWERPC) && !defined(MACOSX) \
+ || defined(LINT) || defined(MSWINCE) || defined(ARM32) \
+ || (defined(I386) && defined(__LCC__))
+ /* Use setjmp based hack to mark from callee-save registers. */
+ /* The define should move to the individual platform */
+ /* descriptions. */
+# define USE_GENERIC_PUSH_REGS
+# endif
+
+# if defined(SPARC)
+# define ASM_CLEAR_CODE /* Stack clearing is crucial, and we */
+ /* include assembly code to do it well. */
+# endif
+
+ /* Can we save call chain in objects for debugging? */
+ /* SET NFRAMES (# of saved frames) and NARGS (#of args for each */
+ /* frame) to reasonable values for the platform. */
+ /* Set SAVE_CALL_CHAIN if we can. SAVE_CALL_COUNT can be specified */
+ /* at build time, though we feel free to adjust it slightly. */
+ /* Define NEED_CALLINFO if we either save the call stack or */
+ /* GC_ADD_CALLER is defined. */
+ /* GC_CAN_SAVE_CALL_STACKS is set in gc.h. */
+
+#if defined(SPARC)
+# define CAN_SAVE_CALL_ARGS
+#endif
+#if (defined(I386) || defined(X86_64)) && defined(LINUX)
+ /* SAVE_CALL_CHAIN is supported if the code is compiled to save */
+ /* frame pointers by default, i.e. no -fomit-frame-pointer flag. */
+# define CAN_SAVE_CALL_ARGS
+#endif
+
+# if defined(SAVE_CALL_COUNT) && !defined(GC_ADD_CALLER) \
+ && defined(GC_CAN_SAVE_CALL_STACKS)
+# define SAVE_CALL_CHAIN
+# endif
+# ifdef SAVE_CALL_CHAIN
+# if defined(SAVE_CALL_NARGS) && defined(CAN_SAVE_CALL_ARGS)
+# define NARGS SAVE_CALL_NARGS
+# else
+# define NARGS 0 /* Number of arguments to save for each call. */
+# endif
+# endif
+# ifdef SAVE_CALL_CHAIN
+# ifndef SAVE_CALL_COUNT
+# define NFRAMES 6 /* Number of frames to save. Even for */
+ /* alignment reasons. */
+# else
+# define NFRAMES ((SAVE_CALL_COUNT + 1) & ~1)
+# endif
+# define NEED_CALLINFO
+# endif /* SAVE_CALL_CHAIN */
+# ifdef GC_ADD_CALLER
+# define NFRAMES 1
+# define NARGS 0
+# define NEED_CALLINFO
+# endif
+
+# if defined(MAKE_BACK_GRAPH) && !defined(DBG_HDRS_ALL)
+# define DBG_HDRS_ALL
+# endif
+
+# if defined(POINTER_MASK) && !defined(POINTER_SHIFT)
+# define POINTER_SHIFT 0
+# endif
+
+# if defined(POINTER_SHIFT) && !defined(POINTER_MASK)
+# define POINTER_MASK ((GC_word)(-1))
+# endif
+
+# if !defined(FIXUP_POINTER) && defined(POINTER_MASK)
+# define FIXUP_POINTER(p) (p) = ((p) & (POINTER_MASK) << POINTER_SHIFT)
+# endif
+
+# if defined(FIXUP_POINTER)
+# define NEED_FIXUP_POINTER 1
+# else
+# define NEED_FIXUP_POINTER 0
+# define FIXUP_POINTER(p)
+# endif
+
+#ifdef GC_PRIVATE_H
+ /* This relies on some type definitions from gc_priv.h, from */
+ /* where it's normally included. */
+ /* */
+ /* How to get heap memory from the OS: */
+ /* Note that sbrk()-like allocation is preferred, since it */
+ /* usually makes it possible to merge consecutively allocated */
+ /* chunks. It also avoids unintented recursion with */
+ /* -DREDIRECT_MALLOC. */
+ /* GET_MEM() returns a HLKSIZE aligned chunk. */
+ /* 0 is taken to mean failure. */
+ /* In the case os USE_MMAP, the argument must also be a */
+ /* physical page size. */
+ /* GET_MEM is currently not assumed to retrieve 0 filled space, */
+ /* though we should perhaps take advantage of the case in which */
+ /* does. */
+ struct hblk; /* See gc_priv.h. */
+# ifdef PCR
+ char * real_malloc();
+# define GET_MEM(bytes) HBLKPTR(real_malloc((size_t)bytes + GC_page_size) \
+ + GC_page_size-1)
+# else
+# ifdef OS2
+ void * os2_alloc(size_t bytes);
+# define GET_MEM(bytes) HBLKPTR((ptr_t)os2_alloc((size_t)bytes \
+ + GC_page_size) \
+ + GC_page_size-1)
+# else
+# if defined(NEXT) || defined(DOS4GW) || \
+ (defined(AMIGA) && !defined(GC_AMIGA_FASTALLOC)) || \
+ (defined(SUNOS5) && !defined(USE_MMAP))
+# define GET_MEM(bytes) HBLKPTR((size_t) \
+ calloc(1, (size_t)bytes + GC_page_size) \
+ + GC_page_size-1)
+# else
+# ifdef MSWIN32
+# ifdef GC_PRIVATE_H
+ extern ptr_t GC_win32_get_mem();
+# endif
+# define GET_MEM(bytes) (struct hblk *)GC_win32_get_mem(bytes)
+# else
+# ifdef MACOS
+# if defined(USE_TEMPORARY_MEMORY)
+ extern Ptr GC_MacTemporaryNewPtr(size_t size,
+ Boolean clearMemory);
+# define GET_MEM(bytes) HBLKPTR( \
+ GC_MacTemporaryNewPtr(bytes + GC_page_size, true) \
+ + GC_page_size-1)
+# else
+# define GET_MEM(bytes) HBLKPTR( \
+ NewPtrClear(bytes + GC_page_size) + GC_page_size-1)
+# endif
+# else
+# ifdef MSWINCE
+# ifdef GC_PRIVATE_H
+ extern ptr_t GC_wince_get_mem();
+# endif
+# define GET_MEM(bytes) (struct hblk *)GC_wince_get_mem(bytes)
+# else
+# if defined(AMIGA) && defined(GC_AMIGA_FASTALLOC)
+ extern void *GC_amiga_get_mem(size_t size);
+ define GET_MEM(bytes) HBLKPTR((size_t) \
+ GC_amiga_get_mem((size_t)bytes + GC_page_size) \
+ + GC_page_size-1)
+# else
+# ifdef GC_PRIVATE_H
+ extern ptr_t GC_unix_get_mem();
+# endif
+# define GET_MEM(bytes) (struct hblk *)GC_unix_get_mem(bytes)
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+
+#endif /* GC_PRIVATE_H */
+
+# endif /* GCCONFIG_H */
--- /dev/null
+#ifdef GC_SOLARIS_THREADS
+
+/* The set of all known threads. We intercept thread creation and */
+/* joins. We never actually create detached threads. We allocate all */
+/* new thread stacks ourselves. These allow us to maintain this */
+/* data structure. */
+/* Protected by GC_thr_lock. */
+/* Some of this should be declared volatile, but that's incosnsistent */
+/* with some library routine declarations. In particular, the */
+/* definition of cond_t doesn't mention volatile! */
+ typedef struct GC_Thread_Rep {
+ struct GC_Thread_Rep * next;
+ thread_t id;
+ word flags;
+# define FINISHED 1 /* Thread has exited. */
+# define DETACHED 2 /* Thread is intended to be detached. */
+# define CLIENT_OWNS_STACK 4
+ /* Stack was supplied by client. */
+# define SUSPNDED 8 /* Currently suspended. */
+ /* SUSPENDED is used insystem header. */
+ ptr_t stack;
+ size_t stack_size;
+ cond_t join_cv;
+ void * status;
+ } * GC_thread;
+ extern GC_thread GC_new_thread(thread_t id);
+
+ extern GC_bool GC_thr_initialized;
+ extern volatile GC_thread GC_threads[];
+ extern size_t GC_min_stack_sz;
+ extern size_t GC_page_sz;
+ extern void GC_thr_init(void);
+
+# endif /* GC_SOLARIS_THREADS */
+
--- /dev/null
+/*
+ * This is a reimplementation of a subset of the pthread_getspecific/setspecific
+ * interface. This appears to outperform the standard linuxthreads one
+ * by a significant margin.
+ * The major restriction is that each thread may only make a single
+ * pthread_setspecific call on a single key. (The current data structure
+ * doesn't really require that. The restriction should be easily removable.)
+ * We don't currently support the destruction functions, though that
+ * could be done.
+ * We also currently assume that only one pthread_setspecific call
+ * can be executed at a time, though that assumption would be easy to remove
+ * by adding a lock.
+ */
+
+#include <errno.h>
+
+/* Called during key creation or setspecific. */
+/* For the GC we already hold lock. */
+/* Currently allocated objects leak on thread exit. */
+/* That's hard to fix, but OK if we allocate garbage */
+/* collected memory. */
+#define MALLOC_CLEAR(n) GC_INTERNAL_MALLOC(n, NORMAL)
+#define PREFIXED(name) GC_##name
+
+#define TS_CACHE_SIZE 1024
+#define CACHE_HASH(n) (((((long)n) >> 8) ^ (long)n) & (TS_CACHE_SIZE - 1))
+#define TS_HASH_SIZE 1024
+#define HASH(n) (((((long)n) >> 8) ^ (long)n) & (TS_HASH_SIZE - 1))
+
+/* An entry describing a thread-specific value for a given thread. */
+/* All such accessible structures preserve the invariant that if either */
+/* thread is a valid pthread id or qtid is a valid "quick tread id" */
+/* for a thread, then value holds the corresponding thread specific */
+/* value. This invariant must be preserved at ALL times, since */
+/* asynchronous reads are allowed. */
+typedef struct thread_specific_entry {
+ unsigned long qtid; /* quick thread id, only for cache */
+ void * value;
+ struct thread_specific_entry *next;
+ pthread_t thread;
+} tse;
+
+
+/* We represent each thread-specific datum as two tables. The first is */
+/* a cache, indexed by a "quick thread identifier". The "quick" thread */
+/* identifier is an easy to compute value, which is guaranteed to */
+/* determine the thread, though a thread may correspond to more than */
+/* one value. We typically use the address of a page in the stack. */
+/* The second is a hash table, indexed by pthread_self(). It is used */
+/* only as a backup. */
+
+/* Return the "quick thread id". Default version. Assumes page size, */
+/* or at least thread stack separation, is at least 4K. */
+/* Must be defined so that it never returns 0. (Page 0 can't really */
+/* be part of any stack, since that would make 0 a valid stack pointer.)*/
+static __inline__ unsigned long quick_thread_id() {
+ int dummy;
+ return (unsigned long)(&dummy) >> 12;
+}
+
+#define INVALID_QTID ((unsigned long)0)
+#define INVALID_THREADID ((pthread_t)0)
+
+typedef struct thread_specific_data {
+ tse * volatile cache[TS_CACHE_SIZE];
+ /* A faster index to the hash table */
+ tse * hash[TS_HASH_SIZE];
+ pthread_mutex_t lock;
+} tsd;
+
+typedef tsd * PREFIXED(key_t);
+
+extern int PREFIXED(key_create) (tsd ** key_ptr, void (* destructor)(void *));
+
+extern int PREFIXED(setspecific) (tsd * key, void * value);
+
+extern void PREFIXED(remove_specific) (tsd * key);
+
+/* An internal version of getspecific that assumes a cache miss. */
+void * PREFIXED(slow_getspecific) (tsd * key, unsigned long qtid,
+ tse * volatile * cache_entry);
+
+static __inline__ void * PREFIXED(getspecific) (tsd * key) {
+ long qtid = quick_thread_id();
+ unsigned hash_val = CACHE_HASH(qtid);
+ tse * volatile * entry_ptr = key -> cache + hash_val;
+ tse * entry = *entry_ptr; /* Must be loaded only once. */
+ if (EXPECT(entry -> qtid == qtid, 1)) {
+ GC_ASSERT(entry -> thread == pthread_self());
+ return entry -> value;
+ }
+ return PREFIXED(slow_getspecific) (key, qtid, entry_ptr);
+}
+
+
--- /dev/null
+#ifndef _weakpointer_h_
+#define _weakpointer_h_
+
+/****************************************************************************
+
+WeakPointer and CleanUp
+
+ Copyright (c) 1991 by Xerox Corporation. All rights reserved.
+
+ THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+
+ Permission is hereby granted to copy this code for any purpose,
+ provided the above notices are retained on all copies.
+
+ Last modified on Mon Jul 17 18:16:01 PDT 1995 by ellis
+
+****************************************************************************/
+
+/****************************************************************************
+
+WeakPointer
+
+A weak pointer is a pointer to a heap-allocated object that doesn't
+prevent the object from being garbage collected. Weak pointers can be
+used to track which objects haven't yet been reclaimed by the
+collector. A weak pointer is deactivated when the collector discovers
+its referent object is unreachable by normal pointers (reachability
+and deactivation are defined more precisely below). A deactivated weak
+pointer remains deactivated forever.
+
+****************************************************************************/
+
+
+template< class T > class WeakPointer {
+public:
+
+WeakPointer( T* t = 0 )
+ /* Constructs a weak pointer for *t. t may be null. It is an error
+ if t is non-null and *t is not a collected object. */
+ {impl = _WeakPointer_New( t );}
+
+T* Pointer()
+ /* wp.Pointer() returns a pointer to the referent object of wp or
+ null if wp has been deactivated (because its referent object
+ has been discovered unreachable by the collector). */
+ {return (T*) _WeakPointer_Pointer( this->impl );}
+
+int operator==( WeakPointer< T > wp2 )
+ /* Given weak pointers wp1 and wp2, if wp1 == wp2, then wp1 and
+ wp2 refer to the same object. If wp1 != wp2, then either wp1
+ and wp2 don't refer to the same object, or if they do, one or
+ both of them has been deactivated. (Note: If objects t1 and t2
+ are never made reachable by their clean-up functions, then
+ WeakPointer<T>(t1) == WeakPointer<T>(t2) if and only t1 == t2.) */
+ {return _WeakPointer_Equal( this->impl, wp2.impl );}
+
+int Hash()
+ /* Returns a hash code suitable for use by multiplicative- and
+ division-based hash tables. If wp1 == wp2, then wp1.Hash() ==
+ wp2.Hash(). */
+ {return _WeakPointer_Hash( this->impl );}
+
+private:
+void* impl;
+};
+
+/*****************************************************************************
+
+CleanUp
+
+A garbage-collected object can have an associated clean-up function
+that will be invoked some time after the collector discovers the
+object is unreachable via normal pointers. Clean-up functions can be
+used to release resources such as open-file handles or window handles
+when their containing objects become unreachable. If a C++ object has
+a non-empty explicit destructor (i.e. it contains programmer-written
+code), the destructor will be automatically registered as the object's
+initial clean-up function.
+
+There is no guarantee that the collector will detect every unreachable
+object (though it will find almost all of them). Clients should not
+rely on clean-up to cause some action to occur immediately -- clean-up
+is only a mechanism for improving resource usage.
+
+Every object with a clean-up function also has a clean-up queue. When
+the collector finds the object is unreachable, it enqueues it on its
+queue. The clean-up function is applied when the object is removed
+from the queue. By default, objects are enqueued on the garbage
+collector's queue, and the collector removes all objects from its
+queue after each collection. If a client supplies another queue for
+objects, it is his responsibility to remove objects (and cause their
+functions to be called) by polling it periodically.
+
+Clean-up queues allow clean-up functions accessing global data to
+synchronize with the main program. Garbage collection can occur at any
+time, and clean-ups invoked by the collector might access data in an
+inconsistent state. A client can control this by defining an explicit
+queue for objects and polling it at safe points.
+
+The following definitions are used by the specification below:
+
+Given a pointer t to a collected object, the base object BO(t) is the
+value returned by new when it created the object. (Because of multiple
+inheritance, t and BO(t) may not be the same address.)
+
+A weak pointer wp references an object *t if BO(wp.Pointer()) ==
+BO(t).
+
+***************************************************************************/
+
+template< class T, class Data > class CleanUp {
+public:
+
+static void Set( T* t, void c( Data* d, T* t ), Data* d = 0 )
+ /* Sets the clean-up function of object BO(t) to be <c, d>,
+ replacing any previously defined clean-up function for BO(t); c
+ and d can be null, but t cannot. Sets the clean-up queue for
+ BO(t) to be the collector's queue. When t is removed from its
+ clean-up queue, its clean-up will be applied by calling c(d,
+ t). It is an error if *t is not a collected object. */
+ {_CleanUp_Set( t, c, d );}
+
+static void Call( T* t )
+ /* Sets the new clean-up function for BO(t) to be null and, if the
+ old one is non-null, calls it immediately, even if BO(t) is
+ still reachable. Deactivates any weak pointers to BO(t). */
+ {_CleanUp_Call( t );}
+
+class Queue {public:
+ Queue()
+ /* Constructs a new queue. */
+ {this->head = _CleanUp_Queue_NewHead();}
+
+ void Set( T* t )
+ /* q.Set(t) sets the clean-up queue of BO(t) to be q. */
+ {_CleanUp_Queue_Set( this->head, t );}
+
+ int Call()
+ /* If q is non-empty, q.Call() removes the first object and
+ calls its clean-up function; does nothing if q is
+ empty. Returns true if there are more objects in the
+ queue. */
+ {return _CleanUp_Queue_Call( this->head );}
+
+ private:
+ void* head;
+ };
+};
+
+/**********************************************************************
+
+Reachability and Clean-up
+
+An object O is reachable if it can be reached via a non-empty path of
+normal pointers from the registers, stacks, global variables, or an
+object with a non-null clean-up function (including O itself),
+ignoring pointers from an object to itself.
+
+This definition of reachability ensures that if object B is accessible
+from object A (and not vice versa) and if both A and B have clean-up
+functions, then A will always be cleaned up before B. Note that as
+long as an object with a clean-up function is contained in a cycle of
+pointers, it will always be reachable and will never be cleaned up or
+collected.
+
+When the collector finds an unreachable object with a null clean-up
+function, it atomically deactivates all weak pointers referencing the
+object and recycles its storage. If object B is accessible from object
+A via a path of normal pointers, A will be discovered unreachable no
+later than B, and a weak pointer to A will be deactivated no later
+than a weak pointer to B.
+
+When the collector finds an unreachable object with a non-null
+clean-up function, the collector atomically deactivates all weak
+pointers referencing the object, redefines its clean-up function to be
+null, and enqueues it on its clean-up queue. The object then becomes
+reachable again and remains reachable at least until its clean-up
+function executes.
+
+The clean-up function is assured that its argument is the only
+accessible pointer to the object. Nothing prevents the function from
+redefining the object's clean-up function or making the object
+reachable again (for example, by storing the pointer in a global
+variable).
+
+If the clean-up function does not make its object reachable again and
+does not redefine its clean-up function, then the object will be
+collected by a subsequent collection (because the object remains
+unreachable and now has a null clean-up function). If the clean-up
+function does make its object reachable again and a clean-up function
+is subsequently redefined for the object, then the new clean-up
+function will be invoked the next time the collector finds the object
+unreachable.
+
+Note that a destructor for a collected object cannot safely redefine a
+clean-up function for its object, since after the destructor executes,
+the object has been destroyed into "raw memory". (In most
+implementations, destroying an object mutates its vtbl.)
+
+Finally, note that calling delete t on a collected object first
+deactivates any weak pointers to t and then invokes its clean-up
+function (destructor).
+
+**********************************************************************/
+
+extern "C" {
+ void* _WeakPointer_New( void* t );
+ void* _WeakPointer_Pointer( void* wp );
+ int _WeakPointer_Equal( void* wp1, void* wp2 );
+ int _WeakPointer_Hash( void* wp );
+ void _CleanUp_Set( void* t, void (*c)( void* d, void* t ), void* d );
+ void _CleanUp_Call( void* t );
+ void* _CleanUp_Queue_NewHead ();
+ void _CleanUp_Queue_Set( void* h, void* t );
+ int _CleanUp_Queue_Call( void* h );
+}
+
+#endif /* _weakpointer_h_ */
+
+
--- /dev/null
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission. M.I.T. makes no representations about the
+# suitability of this software for any purpose. It is provided "as is"
+# without express or implied warranty.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch. It can only install one file at a time, a restriction
+# shared with many OS's install programs.
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -d) dir_arg=true
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ -t=*) transformarg=`echo $1 | sed 's/-t=//'`
+ shift
+ continue;;
+
+ -b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ # this colon is to work around a 386BSD /bin/sh bug
+ :
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+else
+ :
+fi
+
+if [ x"$dir_arg" != x ]; then
+ dst=$src
+ src=""
+
+ if [ -d $dst ]; then
+ instcmd=:
+ chmodcmd=""
+ else
+ instcmd=$mkdirprog
+ fi
+else
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad
+# if $src (and thus $dsttmp) contains '*'.
+
+ if [ -f $src -o -d $src ]
+ then
+ :
+ else
+ echo "install: $src does not exist"
+ exit 1
+ fi
+
+ if [ x"$dst" = x ]
+ then
+ echo "install: no destination specified"
+ exit 1
+ else
+ :
+ fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+ if [ -d $dst ]
+ then
+ dst="$dst"/`basename $src`
+ else
+ :
+ fi
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+# this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='
+ '
+IFS="${IFS-${defaultIFS}}"
+
+oIFS="${IFS}"
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS="${oIFS}"
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+ pathcomp="${pathcomp}${1}"
+ shift
+
+ if [ ! -d "${pathcomp}" ] ;
+ then
+ $mkdirprog "${pathcomp}"
+ else
+ :
+ fi
+
+ pathcomp="${pathcomp}/"
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+ $doit $instcmd $dst &&
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else : ; fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else : ; fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else : ; fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else : ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+ if [ x"$transformarg" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ dstfile=`basename $dst $transformbasename |
+ sed $transformarg`$transformbasename
+ fi
+
+# don't allow the sed command to completely eliminate the filename
+
+ if [ x"$dstfile" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ :
+ fi
+
+# Make a temp file name in the proper directory.
+
+ dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+ $doit $instcmd $src $dsttmp &&
+
+ trap "rm -f ${dsttmp}" 0 &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing. If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else :;fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else :;fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else :;fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else :;fi &&
+
+# Now rename the file to the real destination.
+
+ $doit $rmcmd -f $dstdir/$dstfile &&
+ $doit $mvcmd $dsttmp $dstdir/$dstfile
+
+fi &&
+
+
+exit 0
--- /dev/null
+/*
+ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Support code for Irix (>=6.2) Pthreads. This relies on properties
+ * not guaranteed by the Pthread standard. It may or may not be portable
+ * to other implementations.
+ *
+ * This now also includes an initial attempt at thread support for
+ * HP/UX 11.
+ *
+ * Note that there is a lot of code duplication between linux_threads.c
+ * and irix_threads.c; any changes made here may need to be reflected
+ * there too.
+ */
+
+# if defined(GC_IRIX_THREADS)
+
+# include "private/gc_priv.h"
+# include <pthread.h>
+# include <semaphore.h>
+# include <time.h>
+# include <errno.h>
+# include <unistd.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+
+#undef pthread_create
+#undef pthread_sigmask
+#undef pthread_join
+#undef pthread_detach
+
+#ifdef HANDLE_FORK
+ --> Not yet supported. Try porting the code from linux_threads.c.
+#endif
+
+void GC_thr_init();
+
+#if 0
+void GC_print_sig_mask()
+{
+ sigset_t blocked;
+ int i;
+
+ if (pthread_sigmask(SIG_BLOCK, NULL, &blocked) != 0)
+ ABORT("pthread_sigmask");
+ GC_printf0("Blocked: ");
+ for (i = 1; i <= MAXSIG; i++) {
+ if (sigismember(&blocked, i)) { GC_printf1("%ld ",(long) i); }
+ }
+ GC_printf0("\n");
+}
+#endif
+
+/* We use the allocation lock to protect thread-related data structures. */
+
+/* The set of all known threads. We intercept thread creation and */
+/* joins. We never actually create detached threads. We allocate all */
+/* new thread stacks ourselves. These allow us to maintain this */
+/* data structure. */
+/* Protected by GC_thr_lock. */
+/* Some of this should be declared volatile, but that's incosnsistent */
+/* with some library routine declarations. */
+typedef struct GC_Thread_Rep {
+ struct GC_Thread_Rep * next; /* More recently allocated threads */
+ /* with a given pthread id come */
+ /* first. (All but the first are */
+ /* guaranteed to be dead, but we may */
+ /* not yet have registered the join.) */
+ pthread_t id;
+ word stop;
+# define NOT_STOPPED 0
+# define PLEASE_STOP 1
+# define STOPPED 2
+ word flags;
+# define FINISHED 1 /* Thread has exited. */
+# define DETACHED 2 /* Thread is intended to be detached. */
+# define CLIENT_OWNS_STACK 4
+ /* Stack was supplied by client. */
+ ptr_t stack;
+ ptr_t stack_ptr; /* Valid only when stopped. */
+ /* But must be within stack region at */
+ /* all times. */
+ size_t stack_size; /* 0 for original thread. */
+ void * status; /* Used only to avoid premature */
+ /* reclamation of any data it might */
+ /* reference. */
+} * GC_thread;
+
+GC_thread GC_lookup_thread(pthread_t id);
+
+/*
+ * The only way to suspend threads given the pthread interface is to send
+ * signals. Unfortunately, this means we have to reserve
+ * a signal, and intercept client calls to change the signal mask.
+ * We use SIG_SUSPEND, defined in gc_priv.h.
+ */
+
+pthread_mutex_t GC_suspend_lock = PTHREAD_MUTEX_INITIALIZER;
+ /* Number of threads stopped so far */
+pthread_cond_t GC_suspend_ack_cv = PTHREAD_COND_INITIALIZER;
+pthread_cond_t GC_continue_cv = PTHREAD_COND_INITIALIZER;
+
+void GC_suspend_handler(int sig)
+{
+ int dummy;
+ GC_thread me;
+ sigset_t all_sigs;
+ sigset_t old_sigs;
+ int i;
+
+ if (sig != SIG_SUSPEND) ABORT("Bad signal in suspend_handler");
+ me = GC_lookup_thread(pthread_self());
+ /* The lookup here is safe, since I'm doing this on behalf */
+ /* of a thread which holds the allocation lock in order */
+ /* to stop the world. Thus concurrent modification of the */
+ /* data structure is impossible. */
+ if (PLEASE_STOP != me -> stop) {
+ /* Misdirected signal. */
+ pthread_mutex_unlock(&GC_suspend_lock);
+ return;
+ }
+ pthread_mutex_lock(&GC_suspend_lock);
+ me -> stack_ptr = (ptr_t)(&dummy);
+ me -> stop = STOPPED;
+ pthread_cond_signal(&GC_suspend_ack_cv);
+ pthread_cond_wait(&GC_continue_cv, &GC_suspend_lock);
+ pthread_mutex_unlock(&GC_suspend_lock);
+ /* GC_printf1("Continuing 0x%x\n", pthread_self()); */
+}
+
+
+GC_bool GC_thr_initialized = FALSE;
+
+size_t GC_min_stack_sz;
+
+# define N_FREE_LISTS 25
+ptr_t GC_stack_free_lists[N_FREE_LISTS] = { 0 };
+ /* GC_stack_free_lists[i] is free list for stacks of */
+ /* size GC_min_stack_sz*2**i. */
+ /* Free lists are linked through first word. */
+
+/* Return a stack of size at least *stack_size. *stack_size is */
+/* replaced by the actual stack size. */
+/* Caller holds allocation lock. */
+ptr_t GC_stack_alloc(size_t * stack_size)
+{
+ register size_t requested_sz = *stack_size;
+ register size_t search_sz = GC_min_stack_sz;
+ register int index = 0; /* = log2(search_sz/GC_min_stack_sz) */
+ register ptr_t result;
+
+ while (search_sz < requested_sz) {
+ search_sz *= 2;
+ index++;
+ }
+ if ((result = GC_stack_free_lists[index]) == 0
+ && (result = GC_stack_free_lists[index+1]) != 0) {
+ /* Try next size up. */
+ search_sz *= 2; index++;
+ }
+ if (result != 0) {
+ GC_stack_free_lists[index] = *(ptr_t *)result;
+ } else {
+ result = (ptr_t) GC_scratch_alloc(search_sz + 2*GC_page_size);
+ result = (ptr_t)(((word)result + GC_page_size) & ~(GC_page_size - 1));
+ /* Protect hottest page to detect overflow. */
+# ifdef STACK_GROWS_UP
+ /* mprotect(result + search_sz, GC_page_size, PROT_NONE); */
+# else
+ /* mprotect(result, GC_page_size, PROT_NONE); */
+ result += GC_page_size;
+# endif
+ }
+ *stack_size = search_sz;
+ return(result);
+}
+
+/* Caller holds allocation lock. */
+void GC_stack_free(ptr_t stack, size_t size)
+{
+ register int index = 0;
+ register size_t search_sz = GC_min_stack_sz;
+
+ while (search_sz < size) {
+ search_sz *= 2;
+ index++;
+ }
+ if (search_sz != size) ABORT("Bad stack size");
+ *(ptr_t *)stack = GC_stack_free_lists[index];
+ GC_stack_free_lists[index] = stack;
+}
+
+
+
+# define THREAD_TABLE_SZ 128 /* Must be power of 2 */
+volatile GC_thread GC_threads[THREAD_TABLE_SZ];
+
+void GC_push_thread_structures GC_PROTO((void))
+{
+ GC_push_all((ptr_t)(GC_threads), (ptr_t)(GC_threads)+sizeof(GC_threads));
+}
+
+/* Add a thread to GC_threads. We assume it wasn't already there. */
+/* Caller holds allocation lock. */
+GC_thread GC_new_thread(pthread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ GC_thread result;
+ static struct GC_Thread_Rep first_thread;
+ static GC_bool first_thread_used = FALSE;
+
+ if (!first_thread_used) {
+ result = &first_thread;
+ first_thread_used = TRUE;
+ /* Dont acquire allocation lock, since we may already hold it. */
+ } else {
+ result = (struct GC_Thread_Rep *)
+ GC_INTERNAL_MALLOC(sizeof(struct GC_Thread_Rep), NORMAL);
+ }
+ if (result == 0) return(0);
+ result -> id = id;
+ result -> next = GC_threads[hv];
+ GC_threads[hv] = result;
+ /* result -> flags = 0; */
+ /* result -> stop = 0; */
+ return(result);
+}
+
+/* Delete a thread from GC_threads. We assume it is there. */
+/* (The code intentionally traps if it wasn't.) */
+/* Caller holds allocation lock. */
+void GC_delete_thread(pthread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ register GC_thread p = GC_threads[hv];
+ register GC_thread prev = 0;
+
+ while (!pthread_equal(p -> id, id)) {
+ prev = p;
+ p = p -> next;
+ }
+ if (prev == 0) {
+ GC_threads[hv] = p -> next;
+ } else {
+ prev -> next = p -> next;
+ }
+}
+
+/* If a thread has been joined, but we have not yet */
+/* been notified, then there may be more than one thread */
+/* in the table with the same pthread id. */
+/* This is OK, but we need a way to delete a specific one. */
+void GC_delete_gc_thread(pthread_t id, GC_thread gc_id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ register GC_thread p = GC_threads[hv];
+ register GC_thread prev = 0;
+
+ while (p != gc_id) {
+ prev = p;
+ p = p -> next;
+ }
+ if (prev == 0) {
+ GC_threads[hv] = p -> next;
+ } else {
+ prev -> next = p -> next;
+ }
+}
+
+/* Return a GC_thread corresponding to a given thread_t. */
+/* Returns 0 if it's not there. */
+/* Caller holds allocation lock or otherwise inhibits */
+/* updates. */
+/* If there is more than one thread with the given id we */
+/* return the most recent one. */
+GC_thread GC_lookup_thread(pthread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ register GC_thread p = GC_threads[hv];
+
+ while (p != 0 && !pthread_equal(p -> id, id)) p = p -> next;
+ return(p);
+}
+
+
+/* Caller holds allocation lock. */
+void GC_stop_world()
+{
+ pthread_t my_thread = pthread_self();
+ register int i;
+ register GC_thread p;
+ register int result;
+ struct timespec timeout;
+
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (p -> id != my_thread) {
+ if (p -> flags & FINISHED) {
+ p -> stop = STOPPED;
+ continue;
+ }
+ p -> stop = PLEASE_STOP;
+ result = pthread_kill(p -> id, SIG_SUSPEND);
+ /* GC_printf1("Sent signal to 0x%x\n", p -> id); */
+ switch(result) {
+ case ESRCH:
+ /* Not really there anymore. Possible? */
+ p -> stop = STOPPED;
+ break;
+ case 0:
+ break;
+ default:
+ ABORT("pthread_kill failed");
+ }
+ }
+ }
+ }
+ pthread_mutex_lock(&GC_suspend_lock);
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ while (p -> id != my_thread && p -> stop != STOPPED) {
+ clock_gettime(CLOCK_REALTIME, &timeout);
+ timeout.tv_nsec += 50000000; /* 50 msecs */
+ if (timeout.tv_nsec >= 1000000000) {
+ timeout.tv_nsec -= 1000000000;
+ ++timeout.tv_sec;
+ }
+ result = pthread_cond_timedwait(&GC_suspend_ack_cv,
+ &GC_suspend_lock,
+ &timeout);
+ if (result == ETIMEDOUT) {
+ /* Signal was lost or misdirected. Try again. */
+ /* Duplicate signals should be benign. */
+ result = pthread_kill(p -> id, SIG_SUSPEND);
+ }
+ }
+ }
+ }
+ pthread_mutex_unlock(&GC_suspend_lock);
+ /* GC_printf1("World stopped 0x%x\n", pthread_self()); */
+}
+
+/* Caller holds allocation lock. */
+void GC_start_world()
+{
+ GC_thread p;
+ unsigned i;
+
+ /* GC_printf0("World starting\n"); */
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ p -> stop = NOT_STOPPED;
+ }
+ }
+ pthread_mutex_lock(&GC_suspend_lock);
+ /* All other threads are at pthread_cond_wait in signal handler. */
+ /* Otherwise we couldn't have acquired the lock. */
+ pthread_mutex_unlock(&GC_suspend_lock);
+ pthread_cond_broadcast(&GC_continue_cv);
+}
+
+# ifdef MMAP_STACKS
+--> not really supported yet.
+int GC_is_thread_stack(ptr_t addr)
+{
+ register int i;
+ register GC_thread p;
+
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (p -> stack_size != 0) {
+ if (p -> stack <= addr &&
+ addr < p -> stack + p -> stack_size)
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+# endif
+
+/* We hold allocation lock. Should do exactly the right thing if the */
+/* world is stopped. Should not fail if it isn't. */
+void GC_push_all_stacks()
+{
+ register int i;
+ register GC_thread p;
+ register ptr_t sp = GC_approx_sp();
+ register ptr_t hot, cold;
+ pthread_t me = pthread_self();
+
+ if (!GC_thr_initialized) GC_thr_init();
+ /* GC_printf1("Pushing stacks from thread 0x%x\n", me); */
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (p -> flags & FINISHED) continue;
+ if (pthread_equal(p -> id, me)) {
+ hot = GC_approx_sp();
+ } else {
+ hot = p -> stack_ptr;
+ }
+ if (p -> stack_size != 0) {
+# ifdef STACK_GROWS_UP
+ cold = p -> stack;
+# else
+ cold = p -> stack + p -> stack_size;
+# endif
+ } else {
+ /* The original stack. */
+ cold = GC_stackbottom;
+ }
+# ifdef STACK_GROWS_UP
+ GC_push_all_stack(cold, hot);
+# else
+ GC_push_all_stack(hot, cold);
+# endif
+ }
+ }
+}
+
+
+/* We hold the allocation lock. */
+void GC_thr_init()
+{
+ GC_thread t;
+ struct sigaction act;
+
+ if (GC_thr_initialized) return;
+ GC_thr_initialized = TRUE;
+ GC_min_stack_sz = HBLKSIZE;
+ (void) sigaction(SIG_SUSPEND, 0, &act);
+ if (act.sa_handler != SIG_DFL)
+ ABORT("Previously installed SIG_SUSPEND handler");
+ /* Install handler. */
+ act.sa_handler = GC_suspend_handler;
+ act.sa_flags = SA_RESTART;
+ (void) sigemptyset(&act.sa_mask);
+ if (0 != sigaction(SIG_SUSPEND, &act, 0))
+ ABORT("Failed to install SIG_SUSPEND handler");
+ /* Add the initial thread, so we can stop it. */
+ t = GC_new_thread(pthread_self());
+ t -> stack_size = 0;
+ t -> stack_ptr = (ptr_t)(&t);
+ t -> flags = DETACHED;
+}
+
+int GC_pthread_sigmask(int how, const sigset_t *set, sigset_t *oset)
+{
+ sigset_t fudged_set;
+
+ if (set != NULL && (how == SIG_BLOCK || how == SIG_SETMASK)) {
+ fudged_set = *set;
+ sigdelset(&fudged_set, SIG_SUSPEND);
+ set = &fudged_set;
+ }
+ return(pthread_sigmask(how, set, oset));
+}
+
+struct start_info {
+ void *(*start_routine)(void *);
+ void *arg;
+ word flags;
+ ptr_t stack;
+ size_t stack_size;
+ sem_t registered; /* 1 ==> in our thread table, but */
+ /* parent hasn't yet noticed. */
+};
+
+void GC_thread_exit_proc(void *arg)
+{
+ GC_thread me;
+
+ LOCK();
+ me = GC_lookup_thread(pthread_self());
+ if (me -> flags & DETACHED) {
+ GC_delete_thread(pthread_self());
+ } else {
+ me -> flags |= FINISHED;
+ }
+ UNLOCK();
+}
+
+int GC_pthread_join(pthread_t thread, void **retval)
+{
+ int result;
+ GC_thread thread_gc_id;
+
+ LOCK();
+ thread_gc_id = GC_lookup_thread(thread);
+ /* This is guaranteed to be the intended one, since the thread id */
+ /* cant have been recycled by pthreads. */
+ UNLOCK();
+ result = pthread_join(thread, retval);
+ /* Some versions of the Irix pthreads library can erroneously */
+ /* return EINTR when the call succeeds. */
+ if (EINTR == result) result = 0;
+ if (result == 0) {
+ LOCK();
+ /* Here the pthread thread id may have been recycled. */
+ GC_delete_gc_thread(thread, thread_gc_id);
+ UNLOCK();
+ }
+ return result;
+}
+
+int GC_pthread_detach(pthread_t thread)
+{
+ int result;
+ GC_thread thread_gc_id;
+
+ LOCK();
+ thread_gc_id = GC_lookup_thread(thread);
+ UNLOCK();
+ result = pthread_detach(thread);
+ if (result == 0) {
+ LOCK();
+ thread_gc_id -> flags |= DETACHED;
+ /* Here the pthread thread id may have been recycled. */
+ if (thread_gc_id -> flags & FINISHED) {
+ GC_delete_gc_thread(thread, thread_gc_id);
+ }
+ UNLOCK();
+ }
+ return result;
+}
+
+void * GC_start_routine(void * arg)
+{
+ struct start_info * si = arg;
+ void * result;
+ GC_thread me;
+ pthread_t my_pthread;
+ void *(*start)(void *);
+ void *start_arg;
+
+ my_pthread = pthread_self();
+ /* If a GC occurs before the thread is registered, that GC will */
+ /* ignore this thread. That's fine, since it will block trying to */
+ /* acquire the allocation lock, and won't yet hold interesting */
+ /* pointers. */
+ LOCK();
+ /* We register the thread here instead of in the parent, so that */
+ /* we don't need to hold the allocation lock during pthread_create. */
+ /* Holding the allocation lock there would make REDIRECT_MALLOC */
+ /* impossible. It probably still doesn't work, but we're a little */
+ /* closer ... */
+ /* This unfortunately means that we have to be careful the parent */
+ /* doesn't try to do a pthread_join before we're registered. */
+ me = GC_new_thread(my_pthread);
+ me -> flags = si -> flags;
+ me -> stack = si -> stack;
+ me -> stack_size = si -> stack_size;
+ me -> stack_ptr = (ptr_t)si -> stack + si -> stack_size - sizeof(word);
+ UNLOCK();
+ start = si -> start_routine;
+ start_arg = si -> arg;
+ sem_post(&(si -> registered));
+ pthread_cleanup_push(GC_thread_exit_proc, 0);
+ result = (*start)(start_arg);
+ me -> status = result;
+ me -> flags |= FINISHED;
+ pthread_cleanup_pop(1);
+ /* This involves acquiring the lock, ensuring that we can't exit */
+ /* while a collection that thinks we're alive is trying to stop */
+ /* us. */
+ return(result);
+}
+
+# define copy_attr(pa_ptr, source) *(pa_ptr) = *(source)
+
+int
+GC_pthread_create(pthread_t *new_thread,
+ const pthread_attr_t *attr,
+ void *(*start_routine)(void *), void *arg)
+{
+ int result;
+ GC_thread t;
+ void * stack;
+ size_t stacksize;
+ pthread_attr_t new_attr;
+ int detachstate;
+ word my_flags = 0;
+ struct start_info * si = GC_malloc(sizeof(struct start_info));
+ /* This is otherwise saved only in an area mmapped by the thread */
+ /* library, which isn't visible to the collector. */
+
+ if (0 == si) return(ENOMEM);
+ if (0 != sem_init(&(si -> registered), 0, 0)) {
+ ABORT("sem_init failed");
+ }
+ si -> start_routine = start_routine;
+ si -> arg = arg;
+ LOCK();
+ if (!GC_is_initialized) GC_init();
+ if (NULL == attr) {
+ stack = 0;
+ (void) pthread_attr_init(&new_attr);
+ } else {
+ copy_attr(&new_attr, attr);
+ pthread_attr_getstackaddr(&new_attr, &stack);
+ }
+ pthread_attr_getstacksize(&new_attr, &stacksize);
+ pthread_attr_getdetachstate(&new_attr, &detachstate);
+ if (stacksize < GC_min_stack_sz) ABORT("Stack too small");
+ if (0 == stack) {
+ stack = (void *)GC_stack_alloc(&stacksize);
+ if (0 == stack) {
+ UNLOCK();
+ return(ENOMEM);
+ }
+ pthread_attr_setstackaddr(&new_attr, stack);
+ } else {
+ my_flags |= CLIENT_OWNS_STACK;
+ }
+ if (PTHREAD_CREATE_DETACHED == detachstate) my_flags |= DETACHED;
+ si -> flags = my_flags;
+ si -> stack = stack;
+ si -> stack_size = stacksize;
+ result = pthread_create(new_thread, &new_attr, GC_start_routine, si);
+ if (0 == new_thread && !(my_flags & CLIENT_OWNS_STACK)) {
+ GC_stack_free(stack, stacksize);
+ }
+ UNLOCK();
+ /* Wait until child has been added to the thread table. */
+ /* This also ensures that we hold onto si until the child is done */
+ /* with it. Thus it doesn't matter whether it is otherwise */
+ /* visible to the collector. */
+ while (0 != sem_wait(&(si -> registered))) {
+ if (errno != EINTR) {
+ GC_printf1("Sem_wait: errno = %ld\n", (unsigned long) errno);
+ ABORT("sem_wait failed");
+ }
+ }
+ sem_destroy(&(si -> registered));
+ pthread_attr_destroy(&new_attr); /* Probably unnecessary under Irix */
+ return(result);
+}
+
+VOLATILE GC_bool GC_collecting = 0;
+ /* A hint that we're in the collector and */
+ /* holding the allocation lock for an */
+ /* extended period. */
+
+/* Reasonably fast spin locks. Basically the same implementation */
+/* as STL alloc.h. */
+
+#define SLEEP_THRESHOLD 3
+
+unsigned long GC_allocate_lock = 0;
+# define GC_TRY_LOCK() !GC_test_and_set(&GC_allocate_lock)
+# define GC_LOCK_TAKEN GC_allocate_lock
+
+void GC_lock()
+{
+# define low_spin_max 30 /* spin cycles if we suspect uniprocessor */
+# define high_spin_max 1000 /* spin cycles for multiprocessor */
+ static unsigned spin_max = low_spin_max;
+ unsigned my_spin_max;
+ static unsigned last_spins = 0;
+ unsigned my_last_spins;
+ volatile unsigned junk;
+# define PAUSE junk *= junk; junk *= junk; junk *= junk; junk *= junk
+ int i;
+
+ if (GC_TRY_LOCK()) {
+ return;
+ }
+ junk = 0;
+ my_spin_max = spin_max;
+ my_last_spins = last_spins;
+ for (i = 0; i < my_spin_max; i++) {
+ if (GC_collecting) goto yield;
+ if (i < my_last_spins/2 || GC_LOCK_TAKEN) {
+ PAUSE;
+ continue;
+ }
+ if (GC_TRY_LOCK()) {
+ /*
+ * got it!
+ * Spinning worked. Thus we're probably not being scheduled
+ * against the other process with which we were contending.
+ * Thus it makes sense to spin longer the next time.
+ */
+ last_spins = i;
+ spin_max = high_spin_max;
+ return;
+ }
+ }
+ /* We are probably being scheduled against the other process. Sleep. */
+ spin_max = low_spin_max;
+yield:
+ for (i = 0;; ++i) {
+ if (GC_TRY_LOCK()) {
+ return;
+ }
+ if (i < SLEEP_THRESHOLD) {
+ sched_yield();
+ } else {
+ struct timespec ts;
+
+ if (i > 26) i = 26;
+ /* Don't wait for more than about 60msecs, even */
+ /* under extreme contention. */
+ ts.tv_sec = 0;
+ ts.tv_nsec = 1 << i;
+ nanosleep(&ts, 0);
+ }
+ }
+}
+
+# else
+
+#ifndef LINT
+ int GC_no_Irix_threads;
+#endif
+
+# endif /* GC_IRIX_THREADS */
+
--- /dev/null
+# libtool.m4 - Configure libtool for the host system. -*-Shell-script-*-
+## Copyright 1996, 1997, 1998, 1999, 2000, 2001
+## Free Software Foundation, Inc.
+## Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+## General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; if not, write to the Free Software
+## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+##
+## As a special exception to the GNU General Public License, if you
+## distribute this file as part of a program that contains a
+## configuration script generated by Autoconf, you may include it under
+## the same distribution terms that you use for the rest of that program.
+
+# serial 46 AC_PROG_LIBTOOL
+
+AC_DEFUN([AC_PROG_LIBTOOL],
+[AC_REQUIRE([AC_LIBTOOL_SETUP])dnl
+
+# This can be used to rebuild libtool when needed
+LIBTOOL_DEPS="$ac_aux_dir/ltmain.sh"
+
+# Always use our own libtool.
+LIBTOOL='$(SHELL) $(top_builddir)/libtool'
+AC_SUBST(LIBTOOL)dnl
+
+# Prevent multiple expansion
+define([AC_PROG_LIBTOOL], [])
+])
+
+AC_DEFUN([AC_LIBTOOL_SETUP],
+[AC_PREREQ(2.13)dnl
+AC_REQUIRE([AC_ENABLE_SHARED])dnl
+AC_REQUIRE([AC_ENABLE_STATIC])dnl
+AC_REQUIRE([AC_ENABLE_FAST_INSTALL])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_PROG_LD])dnl
+AC_REQUIRE([AC_PROG_LD_RELOAD_FLAG])dnl
+AC_REQUIRE([AC_PROG_NM])dnl
+AC_REQUIRE([AC_PROG_LN_S])dnl
+AC_REQUIRE([AC_DEPLIBS_CHECK_METHOD])dnl
+AC_REQUIRE([AC_OBJEXT])dnl
+AC_REQUIRE([AC_EXEEXT])dnl
+dnl
+
+_LT_AC_PROG_ECHO_BACKSLASH
+# Only perform the check for file, if the check method requires it
+case $deplibs_check_method in
+file_magic*)
+ if test "$file_magic_cmd" = '$MAGIC_CMD'; then
+ AC_PATH_MAGIC
+ fi
+ ;;
+esac
+
+AC_CHECK_TOOL(RANLIB, ranlib, :)
+AC_CHECK_TOOL(STRIP, strip, :)
+
+ifdef([AC_PROVIDE_AC_LIBTOOL_DLOPEN], enable_dlopen=yes, enable_dlopen=no)
+ifdef([AC_PROVIDE_AC_LIBTOOL_WIN32_DLL],
+enable_win32_dll=yes, enable_win32_dll=no)
+
+AC_ARG_ENABLE(libtool-lock,
+ [ --disable-libtool-lock avoid locking (might break parallel builds)])
+test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes
+
+# Some flags need to be propagated to the compiler or linker for good
+# libtool support.
+case $host in
+*-*-irix6*)
+ # Find out which ABI we are using.
+ echo '[#]line __oline__ "configure"' > conftest.$ac_ext
+ if AC_TRY_EVAL(ac_compile); then
+ case `/usr/bin/file conftest.$ac_objext` in
+ *32-bit*)
+ LD="${LD-ld} -32"
+ ;;
+ *N32*)
+ LD="${LD-ld} -n32"
+ ;;
+ *64-bit*)
+ LD="${LD-ld} -64"
+ ;;
+ esac
+ fi
+ rm -rf conftest*
+ ;;
+
+*-*-sco3.2v5*)
+ # On SCO OpenServer 5, we need -belf to get full-featured binaries.
+ SAVE_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -belf"
+ AC_CACHE_CHECK([whether the C compiler needs -belf], lt_cv_cc_needs_belf,
+ [AC_LANG_SAVE
+ AC_LANG_C
+ AC_TRY_LINK([],[],[lt_cv_cc_needs_belf=yes],[lt_cv_cc_needs_belf=no])
+ AC_LANG_RESTORE])
+ if test x"$lt_cv_cc_needs_belf" != x"yes"; then
+ # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
+ CFLAGS="$SAVE_CFLAGS"
+ fi
+ ;;
+
+ifdef([AC_PROVIDE_AC_LIBTOOL_WIN32_DLL],
+[*-*-cygwin* | *-*-mingw* | *-*-pw32*)
+ AC_CHECK_TOOL(DLLTOOL, dlltool, false)
+ AC_CHECK_TOOL(AS, as, false)
+ AC_CHECK_TOOL(OBJDUMP, objdump, false)
+
+ # recent cygwin and mingw systems supply a stub DllMain which the user
+ # can override, but on older systems we have to supply one
+ AC_CACHE_CHECK([if libtool should supply DllMain function], lt_cv_need_dllmain,
+ [AC_TRY_LINK([],
+ [extern int __attribute__((__stdcall__)) DllMain(void*, int, void*);
+ DllMain (0, 0, 0);],
+ [lt_cv_need_dllmain=no],[lt_cv_need_dllmain=yes])])
+
+ case $host/$CC in
+ *-*-cygwin*/gcc*-mno-cygwin*|*-*-mingw*)
+ # old mingw systems require "-dll" to link a DLL, while more recent ones
+ # require "-mdll"
+ SAVE_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -mdll"
+ AC_CACHE_CHECK([how to link DLLs], lt_cv_cc_dll_switch,
+ [AC_TRY_LINK([], [], [lt_cv_cc_dll_switch=-mdll],[lt_cv_cc_dll_switch=-dll])])
+ CFLAGS="$SAVE_CFLAGS" ;;
+ *-*-cygwin* | *-*-pw32*)
+ # cygwin systems need to pass --dll to the linker, and not link
+ # crt.o which will require a WinMain@16 definition.
+ lt_cv_cc_dll_switch="-Wl,--dll -nostartfiles" ;;
+ esac
+ ;;
+ ])
+esac
+
+_LT_AC_LTCONFIG_HACK
+
+])
+
+# AC_LIBTOOL_HEADER_ASSERT
+# ------------------------
+AC_DEFUN([AC_LIBTOOL_HEADER_ASSERT],
+[AC_CACHE_CHECK([whether $CC supports assert without backlinking],
+ [lt_cv_func_assert_works],
+ [case $host in
+ *-*-solaris*)
+ if test "$GCC" = yes && test "$with_gnu_ld" != yes; then
+ case `$CC --version 2>/dev/null` in
+ [[12]].*) lt_cv_func_assert_works=no ;;
+ *) lt_cv_func_assert_works=yes ;;
+ esac
+ fi
+ ;;
+ esac])
+
+if test "x$lt_cv_func_assert_works" = xyes; then
+ AC_CHECK_HEADERS(assert.h)
+fi
+])# AC_LIBTOOL_HEADER_ASSERT
+
+# _LT_AC_CHECK_DLFCN
+# --------------------
+AC_DEFUN([_LT_AC_CHECK_DLFCN],
+[AC_CHECK_HEADERS(dlfcn.h)
+])# _LT_AC_CHECK_DLFCN
+
+# AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE
+# ---------------------------------
+AC_DEFUN([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE],
+[AC_REQUIRE([AC_CANONICAL_HOST])
+AC_REQUIRE([AC_PROG_NM])
+AC_REQUIRE([AC_OBJEXT])
+# Check for command to grab the raw symbol name followed by C symbol from nm.
+AC_MSG_CHECKING([command to parse $NM output])
+AC_CACHE_VAL([lt_cv_sys_global_symbol_pipe], [dnl
+
+# These are sane defaults that work on at least a few old systems.
+# [They come from Ultrix. What could be older than Ultrix?!! ;)]
+
+# Character class describing NM global symbol codes.
+symcode='[[BCDEGRST]]'
+
+# Regexp to match symbols that can be accessed directly from C.
+sympat='\([[_A-Za-z]][[_A-Za-z0-9]]*\)'
+
+# Transform the above into a raw symbol and a C symbol.
+symxfrm='\1 \2\3 \3'
+
+# Transform an extracted symbol line into a proper C declaration
+lt_cv_global_symbol_to_cdecl="sed -n -e 's/^. .* \(.*\)$/extern char \1;/p'"
+
+# Transform an extracted symbol line into symbol name and symbol address
+lt_cv_global_symbol_to_c_name_address="sed -n -e 's/^: \([[^ ]]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode \([[^ ]]*\) \([[^ ]]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'"
+
+# Define system-specific variables.
+case $host_os in
+aix*)
+ symcode='[[BCDT]]'
+ ;;
+cygwin* | mingw* | pw32*)
+ symcode='[[ABCDGISTW]]'
+ ;;
+hpux*) # Its linker distinguishes data from code symbols
+ lt_cv_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern char \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'"
+ lt_cv_global_symbol_to_c_name_address="sed -n -e 's/^: \([[^ ]]*\) $/ {\\\"\1\\\", (lt_ptr) 0},/p' -e 's/^$symcode* \([[^ ]]*\) \([[^ ]]*\)$/ {\"\2\", (lt_ptr) \&\2},/p'"
+ ;;
+irix*)
+ symcode='[[BCDEGRST]]'
+ ;;
+solaris* | sysv5*)
+ symcode='[[BDT]]'
+ ;;
+sysv4)
+ symcode='[[DFNSTU]]'
+ ;;
+esac
+
+# Handle CRLF in mingw tool chain
+opt_cr=
+case $host_os in
+mingw*)
+ opt_cr=`echo 'x\{0,1\}' | tr x '\015'` # option cr in regexp
+ ;;
+esac
+
+# If we're using GNU nm, then use its standard symbol codes.
+if $NM -V 2>&1 | egrep '(GNU|with BFD)' > /dev/null; then
+ symcode='[[ABCDGISTW]]'
+fi
+
+# Try without a prefix undercore, then with it.
+for ac_symprfx in "" "_"; do
+
+ # Write the raw and C identifiers.
+lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[[ ]]\($symcode$symcode*\)[[ ]][[ ]]*\($ac_symprfx\)$sympat$opt_cr$/$symxfrm/p'"
+
+ # Check to see that the pipe works correctly.
+ pipe_works=no
+ rm -f conftest*
+ cat > conftest.$ac_ext <<EOF
+#ifdef __cplusplus
+extern "C" {
+#endif
+char nm_test_var;
+void nm_test_func(){}
+#ifdef __cplusplus
+}
+#endif
+int main(){nm_test_var='a';nm_test_func();return(0);}
+EOF
+
+ if AC_TRY_EVAL(ac_compile); then
+ # Now try to grab the symbols.
+ nlist=conftest.nm
+ if AC_TRY_EVAL(NM conftest.$ac_objext \| $lt_cv_sys_global_symbol_pipe \> $nlist) && test -s "$nlist"; then
+ # Try sorting and uniquifying the output.
+ if sort "$nlist" | uniq > "$nlist"T; then
+ mv -f "$nlist"T "$nlist"
+ else
+ rm -f "$nlist"T
+ fi
+
+ # Make sure that we snagged all the symbols we need.
+ if egrep ' nm_test_var$' "$nlist" >/dev/null; then
+ if egrep ' nm_test_func$' "$nlist" >/dev/null; then
+ cat <<EOF > conftest.$ac_ext
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+EOF
+ # Now generate the symbol file.
+ eval "$lt_cv_global_symbol_to_cdecl"' < "$nlist" >> conftest.$ac_ext'
+
+ cat <<EOF >> conftest.$ac_ext
+#if defined (__STDC__) && __STDC__
+# define lt_ptr void *
+#else
+# define lt_ptr char *
+# define const
+#endif
+
+/* The mapping between symbol names and symbols. */
+const struct {
+ const char *name;
+ lt_ptr address;
+}
+lt_preloaded_symbols[[]] =
+{
+EOF
+ sed "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (lt_ptr) \&\2},/" < "$nlist" >> conftest.$ac_ext
+ cat <<\EOF >> conftest.$ac_ext
+ {0, (lt_ptr) 0}
+};
+
+#ifdef __cplusplus
+}
+#endif
+EOF
+ # Now try linking the two files.
+ mv conftest.$ac_objext conftstm.$ac_objext
+ save_LIBS="$LIBS"
+ save_CFLAGS="$CFLAGS"
+ LIBS="conftstm.$ac_objext"
+ CFLAGS="$CFLAGS$no_builtin_flag"
+ if AC_TRY_EVAL(ac_link) && test -s conftest; then
+ pipe_works=yes
+ fi
+ LIBS="$save_LIBS"
+ CFLAGS="$save_CFLAGS"
+ else
+ echo "cannot find nm_test_func in $nlist" >&AC_FD_CC
+ fi
+ else
+ echo "cannot find nm_test_var in $nlist" >&AC_FD_CC
+ fi
+ else
+ echo "cannot run $lt_cv_sys_global_symbol_pipe" >&AC_FD_CC
+ fi
+ else
+ echo "$progname: failed program was:" >&AC_FD_CC
+ cat conftest.$ac_ext >&5
+ fi
+ rm -f conftest* conftst*
+
+ # Do not use the global_symbol_pipe unless it works.
+ if test "$pipe_works" = yes; then
+ break
+ else
+ lt_cv_sys_global_symbol_pipe=
+ fi
+done
+])
+global_symbol_pipe="$lt_cv_sys_global_symbol_pipe"
+if test -z "$lt_cv_sys_global_symbol_pipe"; then
+ global_symbol_to_cdecl=
+ global_symbol_to_c_name_address=
+else
+ global_symbol_to_cdecl="$lt_cv_global_symbol_to_cdecl"
+ global_symbol_to_c_name_address="$lt_cv_global_symbol_to_c_name_address"
+fi
+if test -z "$global_symbol_pipe$global_symbol_to_cdec$global_symbol_to_c_name_address";
+then
+ AC_MSG_RESULT(failed)
+else
+ AC_MSG_RESULT(ok)
+fi
+]) # AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE
+
+# _LT_AC_LIBTOOL_SYS_PATH_SEPARATOR
+# ---------------------------------
+AC_DEFUN([_LT_AC_LIBTOOL_SYS_PATH_SEPARATOR],
+[# Find the correct PATH separator. Usually this is `:', but
+# DJGPP uses `;' like DOS.
+if test "X${PATH_SEPARATOR+set}" != Xset; then
+ UNAME=${UNAME-`uname 2>/dev/null`}
+ case X$UNAME in
+ *-DOS) lt_cv_sys_path_separator=';' ;;
+ *) lt_cv_sys_path_separator=':' ;;
+ esac
+ PATH_SEPARATOR=$lt_cv_sys_path_separator
+fi
+])# _LT_AC_LIBTOOL_SYS_PATH_SEPARATOR
+
+# _LT_AC_PROG_ECHO_BACKSLASH
+# --------------------------
+# Add some code to the start of the generated configure script which
+# will find an echo command which doesn't interpret backslashes.
+AC_DEFUN([_LT_AC_PROG_ECHO_BACKSLASH],
+[ifdef([AC_DIVERSION_NOTICE], [AC_DIVERT_PUSH(AC_DIVERSION_NOTICE)],
+ [AC_DIVERT_PUSH(NOTICE)])
+_LT_AC_LIBTOOL_SYS_PATH_SEPARATOR
+
+# Check that we are running under the correct shell.
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+case X$ECHO in
+X*--fallback-echo)
+ # Remove one level of quotation (which was required for Make).
+ ECHO=`echo "$ECHO" | sed 's,\\\\\[$]\\[$]0,'[$]0','`
+ ;;
+esac
+
+echo=${ECHO-echo}
+if test "X[$]1" = X--no-reexec; then
+ # Discard the --no-reexec flag, and continue.
+ shift
+elif test "X[$]1" = X--fallback-echo; then
+ # Avoid inline document here, it may be left over
+ :
+elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then
+ # Yippee, $echo works!
+ :
+else
+ # Restart under the correct shell.
+ exec $SHELL "[$]0" --no-reexec ${1+"[$]@"}
+fi
+
+if test "X[$]1" = X--fallback-echo; then
+ # used as fallback echo
+ shift
+ cat <<EOF
+$*
+EOF
+ exit 0
+fi
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+if test "X${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
+
+if test -z "$ECHO"; then
+if test "X${echo_test_string+set}" != Xset; then
+# find a string as large as possible, as long as the shell can cope with it
+ for cmd in 'sed 50q "[$]0"' 'sed 20q "[$]0"' 'sed 10q "[$]0"' 'sed 2q "[$]0"' 'echo test'; do
+ # expected sizes: less than 2Kb, 1Kb, 512 bytes, 16 bytes, ...
+ if (echo_test_string="`eval $cmd`") 2>/dev/null &&
+ echo_test_string="`eval $cmd`" &&
+ (test "X$echo_test_string" = "X$echo_test_string") 2>/dev/null
+ then
+ break
+ fi
+ done
+fi
+
+if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ :
+else
+ # The Solaris, AIX, and Digital Unix default echo programs unquote
+ # backslashes. This makes it impossible to quote backslashes using
+ # echo "$something" | sed 's/\\/\\\\/g'
+ #
+ # So, first we look for a working echo in the user's PATH.
+
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for dir in $PATH /usr/ucb; do
+ if (test -f $dir/echo || test -f $dir/echo$ac_exeext) &&
+ test "X`($dir/echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($dir/echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ echo="$dir/echo"
+ break
+ fi
+ done
+ IFS="$save_ifs"
+
+ if test "X$echo" = Xecho; then
+ # We didn't find a better echo, so look for alternatives.
+ if test "X`(print -r '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`(print -r "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ # This shell has a builtin print -r that does the trick.
+ echo='print -r'
+ elif (test -f /bin/ksh || test -f /bin/ksh$ac_exeext) &&
+ test "X$CONFIG_SHELL" != X/bin/ksh; then
+ # If we have ksh, try running configure again with it.
+ ORIGINAL_CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
+ export ORIGINAL_CONFIG_SHELL
+ CONFIG_SHELL=/bin/ksh
+ export CONFIG_SHELL
+ exec $CONFIG_SHELL "[$]0" --no-reexec ${1+"[$]@"}
+ else
+ # Try using printf.
+ echo='printf %s\n'
+ if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
+ echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ # Cool, printf works
+ :
+ elif echo_testing_string=`($ORIGINAL_CONFIG_SHELL "[$]0" --fallback-echo '\t') 2>/dev/null` &&
+ test "X$echo_testing_string" = 'X\t' &&
+ echo_testing_string=`($ORIGINAL_CONFIG_SHELL "[$]0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ CONFIG_SHELL=$ORIGINAL_CONFIG_SHELL
+ export CONFIG_SHELL
+ SHELL="$CONFIG_SHELL"
+ export SHELL
+ echo="$CONFIG_SHELL [$]0 --fallback-echo"
+ elif echo_testing_string=`($CONFIG_SHELL "[$]0" --fallback-echo '\t') 2>/dev/null` &&
+ test "X$echo_testing_string" = 'X\t' &&
+ echo_testing_string=`($CONFIG_SHELL "[$]0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
+ test "X$echo_testing_string" = "X$echo_test_string"; then
+ echo="$CONFIG_SHELL [$]0 --fallback-echo"
+ else
+ # maybe with a smaller string...
+ prev=:
+
+ for cmd in 'echo test' 'sed 2q "[$]0"' 'sed 10q "[$]0"' 'sed 20q "[$]0"' 'sed 50q "[$]0"'; do
+ if (test "X$echo_test_string" = "X`eval $cmd`") 2>/dev/null
+ then
+ break
+ fi
+ prev="$cmd"
+ done
+
+ if test "$prev" != 'sed 50q "[$]0"'; then
+ echo_test_string=`eval $prev`
+ export echo_test_string
+ exec ${ORIGINAL_CONFIG_SHELL-${CONFIG_SHELL-/bin/sh}} "[$]0" ${1+"[$]@"}
+ else
+ # Oops. We lost completely, so just stick with echo.
+ echo=echo
+ fi
+ fi
+ fi
+ fi
+fi
+fi
+
+# Copy echo and quote the copy suitably for passing to libtool from
+# the Makefile, instead of quoting the original, which is used later.
+ECHO=$echo
+if test "X$ECHO" = "X$CONFIG_SHELL [$]0 --fallback-echo"; then
+ ECHO="$CONFIG_SHELL \\\$\[$]0 --fallback-echo"
+fi
+
+AC_SUBST(ECHO)
+AC_DIVERT_POP
+])# _LT_AC_PROG_ECHO_BACKSLASH
+
+# _LT_AC_TRY_DLOPEN_SELF (ACTION-IF-TRUE, ACTION-IF-TRUE-W-USCORE,
+# ACTION-IF-FALSE, ACTION-IF-CROSS-COMPILING)
+# ------------------------------------------------------------------
+AC_DEFUN([_LT_AC_TRY_DLOPEN_SELF],
+[if test "$cross_compiling" = yes; then :
+ [$4]
+else
+ AC_REQUIRE([_LT_AC_CHECK_DLFCN])dnl
+ lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
+ lt_status=$lt_dlunknown
+ cat > conftest.$ac_ext <<EOF
+[#line __oline__ "configure"
+#include "confdefs.h"
+
+#if HAVE_DLFCN_H
+#include <dlfcn.h>
+#endif
+
+#include <stdio.h>
+
+#ifdef RTLD_GLOBAL
+# define LT_DLGLOBAL RTLD_GLOBAL
+#else
+# ifdef DL_GLOBAL
+# define LT_DLGLOBAL DL_GLOBAL
+# else
+# define LT_DLGLOBAL 0
+# endif
+#endif
+
+/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
+ find out it does not work in some platform. */
+#ifndef LT_DLLAZY_OR_NOW
+# ifdef RTLD_LAZY
+# define LT_DLLAZY_OR_NOW RTLD_LAZY
+# else
+# ifdef DL_LAZY
+# define LT_DLLAZY_OR_NOW DL_LAZY
+# else
+# ifdef RTLD_NOW
+# define LT_DLLAZY_OR_NOW RTLD_NOW
+# else
+# ifdef DL_NOW
+# define LT_DLLAZY_OR_NOW DL_NOW
+# else
+# define LT_DLLAZY_OR_NOW 0
+# endif
+# endif
+# endif
+# endif
+#endif
+
+#ifdef __cplusplus
+extern "C" void exit (int);
+#endif
+
+void fnord() { int i=42;}
+int main ()
+{
+ void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
+ int status = $lt_dlunknown;
+
+ if (self)
+ {
+ if (dlsym (self,"fnord")) status = $lt_dlno_uscore;
+ else if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore;
+ /* dlclose (self); */
+ }
+
+ exit (status);
+}]
+EOF
+ if AC_TRY_EVAL(ac_link) && test -s conftest${ac_exeext} 2>/dev/null; then
+ (./conftest; exit; ) 2>/dev/null
+ lt_status=$?
+ case x$lt_status in
+ x$lt_dlno_uscore) $1 ;;
+ x$lt_dlneed_uscore) $2 ;;
+ x$lt_unknown|x*) $3 ;;
+ esac
+ else :
+ # compilation failed
+ $3
+ fi
+fi
+rm -fr conftest*
+])# _LT_AC_TRY_DLOPEN_SELF
+
+# AC_LIBTOOL_DLOPEN_SELF
+# -------------------
+AC_DEFUN([AC_LIBTOOL_DLOPEN_SELF],
+[if test "x$enable_dlopen" != xyes; then
+ enable_dlopen=unknown
+ enable_dlopen_self=unknown
+ enable_dlopen_self_static=unknown
+else
+ lt_cv_dlopen=no
+ lt_cv_dlopen_libs=
+
+ case $host_os in
+ beos*)
+ lt_cv_dlopen="load_add_on"
+ lt_cv_dlopen_libs=
+ lt_cv_dlopen_self=yes
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ lt_cv_dlopen="LoadLibrary"
+ lt_cv_dlopen_libs=
+ ;;
+
+ *)
+ AC_CHECK_FUNC([shl_load],
+ [lt_cv_dlopen="shl_load"],
+ [AC_CHECK_LIB([dld], [shl_load],
+ [lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-dld"],
+ [AC_CHECK_FUNC([dlopen],
+ [lt_cv_dlopen="dlopen"],
+ [AC_CHECK_LIB([dl], [dlopen],
+ [lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"],
+ [AC_CHECK_LIB([svld], [dlopen],
+ [lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld"],
+ [AC_CHECK_LIB([dld], [dld_link],
+ [lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-dld"])
+ ])
+ ])
+ ])
+ ])
+ ])
+ ;;
+ esac
+
+ if test "x$lt_cv_dlopen" != xno; then
+ enable_dlopen=yes
+ else
+ enable_dlopen=no
+ fi
+
+ case $lt_cv_dlopen in
+ dlopen)
+ save_CPPFLAGS="$CPPFLAGS"
+ AC_REQUIRE([_LT_AC_CHECK_DLFCN])dnl
+ test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
+
+ save_LDFLAGS="$LDFLAGS"
+ eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
+
+ save_LIBS="$LIBS"
+ LIBS="$lt_cv_dlopen_libs $LIBS"
+
+ AC_CACHE_CHECK([whether a program can dlopen itself],
+ lt_cv_dlopen_self, [dnl
+ _LT_AC_TRY_DLOPEN_SELF(
+ lt_cv_dlopen_self=yes, lt_cv_dlopen_self=yes,
+ lt_cv_dlopen_self=no, lt_cv_dlopen_self=cross)
+ ])
+
+ if test "x$lt_cv_dlopen_self" = xyes; then
+ LDFLAGS="$LDFLAGS $link_static_flag"
+ AC_CACHE_CHECK([whether a statically linked program can dlopen itself],
+ lt_cv_dlopen_self_static, [dnl
+ _LT_AC_TRY_DLOPEN_SELF(
+ lt_cv_dlopen_self_static=yes, lt_cv_dlopen_self_static=yes,
+ lt_cv_dlopen_self_static=no, lt_cv_dlopen_self_static=cross)
+ ])
+ fi
+
+ CPPFLAGS="$save_CPPFLAGS"
+ LDFLAGS="$save_LDFLAGS"
+ LIBS="$save_LIBS"
+ ;;
+ esac
+
+ case $lt_cv_dlopen_self in
+ yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
+ *) enable_dlopen_self=unknown ;;
+ esac
+
+ case $lt_cv_dlopen_self_static in
+ yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
+ *) enable_dlopen_self_static=unknown ;;
+ esac
+fi
+])# AC_LIBTOOL_DLOPEN_SELF
+
+AC_DEFUN([_LT_AC_LTCONFIG_HACK],
+[AC_REQUIRE([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE])dnl
+# Sed substitution that helps us do robust quoting. It backslashifies
+# metacharacters that are still active within double-quoted strings.
+Xsed='sed -e s/^X//'
+sed_quote_subst='s/\([[\\"\\`$\\\\]]\)/\\\1/g'
+
+# Same as above, but do not quote variable references.
+double_quote_subst='s/\([[\\"\\`\\\\]]\)/\\\1/g'
+
+# Sed substitution to delay expansion of an escaped shell variable in a
+# double_quote_subst'ed string.
+delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
+
+# Constants:
+rm="rm -f"
+
+# Global variables:
+default_ofile=libtool
+can_build_shared=yes
+
+# All known linkers require a `.a' archive for static linking (except M$VC,
+# which needs '.lib').
+libext=a
+ltmain="$ac_aux_dir/ltmain.sh"
+ofile="$default_ofile"
+with_gnu_ld="$lt_cv_prog_gnu_ld"
+need_locks="$enable_libtool_lock"
+
+old_CC="$CC"
+old_CFLAGS="$CFLAGS"
+
+# Set sane defaults for various variables
+test -z "$AR" && AR=ar
+test -z "$AR_FLAGS" && AR_FLAGS=cru
+test -z "$AS" && AS=as
+test -z "$CC" && CC=cc
+test -z "$DLLTOOL" && DLLTOOL=dlltool
+test -z "$LD" && LD=ld
+test -z "$LN_S" && LN_S="ln -s"
+test -z "$MAGIC_CMD" && MAGIC_CMD=file
+test -z "$NM" && NM=nm
+test -z "$OBJDUMP" && OBJDUMP=objdump
+test -z "$RANLIB" && RANLIB=:
+test -z "$STRIP" && STRIP=:
+test -z "$ac_objext" && ac_objext=o
+
+if test x"$host" != x"$build"; then
+ ac_tool_prefix=${host_alias}-
+else
+ ac_tool_prefix=
+fi
+
+# Transform linux* to *-*-linux-gnu*, to support old configure scripts.
+case $host_os in
+linux-gnu*) ;;
+linux*) host=`echo $host | sed 's/^\(.*-.*-linux\)\(.*\)$/\1-gnu\2/'`
+esac
+
+case $host_os in
+aix3*)
+ # AIX sometimes has problems with the GCC collect2 program. For some
+ # reason, if we set the COLLECT_NAMES environment variable, the problems
+ # vanish in a puff of smoke.
+ if test "X${COLLECT_NAMES+set}" != Xset; then
+ COLLECT_NAMES=
+ export COLLECT_NAMES
+ fi
+ ;;
+esac
+
+# Determine commands to create old-style static archives.
+old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs$old_deplibs'
+old_postinstall_cmds='chmod 644 $oldlib'
+old_postuninstall_cmds=
+
+if test -n "$RANLIB"; then
+ case $host_os in
+ openbsd*)
+ old_postinstall_cmds="\$RANLIB -t \$oldlib~$old_postinstall_cmds"
+ ;;
+ *)
+ old_postinstall_cmds="\$RANLIB \$oldlib~$old_postinstall_cmds"
+ ;;
+ esac
+ old_archive_cmds="$old_archive_cmds~\$RANLIB \$oldlib"
+fi
+
+# Allow CC to be a program name with arguments.
+set dummy $CC
+compiler="[$]2"
+
+## FIXME: this should be a separate macro
+##
+AC_MSG_CHECKING([for objdir])
+rm -f .libs 2>/dev/null
+mkdir .libs 2>/dev/null
+if test -d .libs; then
+ objdir=.libs
+else
+ # MS-DOS does not allow filenames that begin with a dot.
+ objdir=_libs
+fi
+rmdir .libs 2>/dev/null
+AC_MSG_RESULT($objdir)
+##
+## END FIXME
+
+
+## FIXME: this should be a separate macro
+##
+AC_ARG_WITH(pic,
+[ --with-pic try to use only PIC/non-PIC objects [default=use both]],
+pic_mode="$withval", pic_mode=default)
+test -z "$pic_mode" && pic_mode=default
+
+# We assume here that the value for lt_cv_prog_cc_pic will not be cached
+# in isolation, and that seeing it set (from the cache) indicates that
+# the associated values are set (in the cache) correctly too.
+AC_MSG_CHECKING([for $compiler option to produce PIC])
+AC_CACHE_VAL(lt_cv_prog_cc_pic,
+[ lt_cv_prog_cc_pic=
+ lt_cv_prog_cc_shlib=
+ lt_cv_prog_cc_wl=
+ lt_cv_prog_cc_static=
+ lt_cv_prog_cc_no_builtin=
+ lt_cv_prog_cc_can_build_shared=$can_build_shared
+
+ if test "$GCC" = yes; then
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-static'
+
+ case $host_os in
+ aix*)
+ # Below there is a dirty hack to force normal static linking with -ldl
+ # The problem is because libdl dynamically linked with both libc and
+ # libC (AIX C++ library), which obviously doesn't included in libraries
+ # list by gcc. This cause undefined symbols with -static flags.
+ # This hack allows C programs to be linked with "-static -ldl", but
+ # not sure about C++ programs.
+ lt_cv_prog_cc_static="$lt_cv_prog_cc_static ${lt_cv_prog_cc_wl}-lC"
+ ;;
+ amigaos*)
+ # FIXME: we need at least 68020 code to build shared libraries, but
+ # adding the `-m68020' flag to GCC prevents building anything better,
+ # like `-m68040'.
+ lt_cv_prog_cc_pic='-m68020 -resident32 -malways-restore-a4'
+ ;;
+ beos* | irix5* | irix6* | osf3* | osf4* | osf5*)
+ # PIC is the default for these OSes.
+ ;;
+ darwin* | rhapsody*)
+ # PIC is the default on this platform
+ # Common symbols not allowed in MH_DYLIB files
+ lt_cv_prog_cc_pic='-fno-common'
+ ;;
+ cygwin* | mingw* | pw32* | os2*)
+ # This hack is so that the source file can tell whether it is being
+ # built for inclusion in a dll (and should export symbols for example).
+ lt_cv_prog_cc_pic='-DDLL_EXPORT'
+ ;;
+ sysv4*MP*)
+ if test -d /usr/nec; then
+ lt_cv_prog_cc_pic=-Kconform_pic
+ fi
+ ;;
+ *)
+ lt_cv_prog_cc_pic='-fPIC'
+ ;;
+ esac
+ else
+ # PORTME Check for PIC flags for the system compiler.
+ case $host_os in
+ aix3* | aix4* | aix5*)
+ lt_cv_prog_cc_wl='-Wl,'
+ # All AIX code is PIC.
+ if test "$host_cpu" = ia64; then
+ # AIX 5 now supports IA64 processor
+ lt_cv_prog_cc_static='-Bstatic'
+ else
+ lt_cv_prog_cc_static='-bnso -bI:/lib/syscalls.exp'
+ fi
+ ;;
+
+ hpux9* | hpux10* | hpux11*)
+ # Is there a better lt_cv_prog_cc_static that works with the bundled CC?
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static="${lt_cv_prog_cc_wl}-a ${lt_cv_prog_cc_wl}archive"
+ lt_cv_prog_cc_pic='+Z'
+ ;;
+
+ irix5* | irix6*)
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-non_shared'
+ # PIC (with -KPIC) is the default.
+ ;;
+
+ cygwin* | mingw* | pw32* | os2*)
+ # This hack is so that the source file can tell whether it is being
+ # built for inclusion in a dll (and should export symbols for example).
+ lt_cv_prog_cc_pic='-DDLL_EXPORT'
+ ;;
+
+ newsos6)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ ;;
+
+ osf3* | osf4* | osf5*)
+ # All OSF/1 code is PIC.
+ lt_cv_prog_cc_wl='-Wl,'
+ lt_cv_prog_cc_static='-non_shared'
+ ;;
+
+ sco3.2v5*)
+ lt_cv_prog_cc_pic='-Kpic'
+ lt_cv_prog_cc_static='-dn'
+ lt_cv_prog_cc_shlib='-belf'
+ ;;
+
+ solaris*)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ lt_cv_prog_cc_wl='-Wl,'
+ ;;
+
+ sunos4*)
+ lt_cv_prog_cc_pic='-PIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ lt_cv_prog_cc_wl='-Qoption ld '
+ ;;
+
+ sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ lt_cv_prog_cc_pic='-KPIC'
+ lt_cv_prog_cc_static='-Bstatic'
+ if test "x$host_vendor" = xsni; then
+ lt_cv_prog_cc_wl='-LD'
+ else
+ lt_cv_prog_cc_wl='-Wl,'
+ fi
+ ;;
+
+ uts4*)
+ lt_cv_prog_cc_pic='-pic'
+ lt_cv_prog_cc_static='-Bstatic'
+ ;;
+
+ sysv4*MP*)
+ if test -d /usr/nec ;then
+ lt_cv_prog_cc_pic='-Kconform_pic'
+ lt_cv_prog_cc_static='-Bstatic'
+ fi
+ ;;
+
+ *)
+ lt_cv_prog_cc_can_build_shared=no
+ ;;
+ esac
+ fi
+])
+if test -z "$lt_cv_prog_cc_pic"; then
+ AC_MSG_RESULT([none])
+else
+ AC_MSG_RESULT([$lt_cv_prog_cc_pic])
+
+ # Check to make sure the pic_flag actually works.
+ AC_MSG_CHECKING([if $compiler PIC flag $lt_cv_prog_cc_pic works])
+ AC_CACHE_VAL(lt_cv_prog_cc_pic_works, [dnl
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS $lt_cv_prog_cc_pic -DPIC"
+ AC_TRY_COMPILE([], [], [dnl
+ case $host_os in
+ hpux9* | hpux10* | hpux11*)
+ # On HP-UX, both CC and GCC only warn that PIC is supported... then
+ # they create non-PIC objects. So, if there were any warnings, we
+ # assume that PIC is not supported.
+ if test -s conftest.err; then
+ lt_cv_prog_cc_pic_works=no
+ else
+ lt_cv_prog_cc_pic_works=yes
+ fi
+ ;;
+ *)
+ lt_cv_prog_cc_pic_works=yes
+ ;;
+ esac
+ ], [dnl
+ lt_cv_prog_cc_pic_works=no
+ ])
+ CFLAGS="$save_CFLAGS"
+ ])
+
+ if test "X$lt_cv_prog_cc_pic_works" = Xno; then
+ lt_cv_prog_cc_pic=
+ lt_cv_prog_cc_can_build_shared=no
+ else
+ lt_cv_prog_cc_pic=" $lt_cv_prog_cc_pic"
+ fi
+
+ AC_MSG_RESULT([$lt_cv_prog_cc_pic_works])
+fi
+##
+## END FIXME
+
+# Check for any special shared library compilation flags.
+if test -n "$lt_cv_prog_cc_shlib"; then
+ AC_MSG_WARN([\`$CC' requires \`$lt_cv_prog_cc_shlib' to build shared libraries])
+ if echo "$old_CC $old_CFLAGS " | egrep -e "[[ ]]$lt_cv_prog_cc_shlib[[ ]]" >/dev/null; then :
+ else
+ AC_MSG_WARN([add \`$lt_cv_prog_cc_shlib' to the CC or CFLAGS env variable and reconfigure])
+ lt_cv_prog_cc_can_build_shared=no
+ fi
+fi
+
+## FIXME: this should be a separate macro
+##
+AC_MSG_CHECKING([if $compiler static flag $lt_cv_prog_cc_static works])
+AC_CACHE_VAL([lt_cv_prog_cc_static_works], [dnl
+ lt_cv_prog_cc_static_works=no
+ save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS $lt_cv_prog_cc_static"
+ AC_TRY_LINK([], [], [lt_cv_prog_cc_static_works=yes])
+ LDFLAGS="$save_LDFLAGS"
+])
+
+# Belt *and* braces to stop my trousers falling down:
+test "X$lt_cv_prog_cc_static_works" = Xno && lt_cv_prog_cc_static=
+AC_MSG_RESULT([$lt_cv_prog_cc_static_works])
+
+pic_flag="$lt_cv_prog_cc_pic"
+special_shlib_compile_flags="$lt_cv_prog_cc_shlib"
+wl="$lt_cv_prog_cc_wl"
+link_static_flag="$lt_cv_prog_cc_static"
+no_builtin_flag="$lt_cv_prog_cc_no_builtin"
+can_build_shared="$lt_cv_prog_cc_can_build_shared"
+##
+## END FIXME
+
+
+## FIXME: this should be a separate macro
+##
+# Check to see if options -o and -c are simultaneously supported by compiler
+AC_MSG_CHECKING([if $compiler supports -c -o file.$ac_objext])
+AC_CACHE_VAL([lt_cv_compiler_c_o], [
+$rm -r conftest 2>/dev/null
+mkdir conftest
+cd conftest
+echo "int some_variable = 0;" > conftest.$ac_ext
+mkdir out
+# According to Tom Tromey, Ian Lance Taylor reported there are C compilers
+# that will create temporary files in the current directory regardless of
+# the output directory. Thus, making CWD read-only will cause this test
+# to fail, enabling locking or at least warning the user not to do parallel
+# builds.
+chmod -w .
+save_CFLAGS="$CFLAGS"
+CFLAGS="$CFLAGS -o out/conftest2.$ac_objext"
+compiler_c_o=no
+if { (eval echo configure:__oline__: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>out/conftest.err; } && test -s out/conftest2.$ac_objext; then
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s out/conftest.err; then
+ lt_cv_compiler_c_o=no
+ else
+ lt_cv_compiler_c_o=yes
+ fi
+else
+ # Append any errors to the config.log.
+ cat out/conftest.err 1>&AC_FD_CC
+ lt_cv_compiler_c_o=no
+fi
+CFLAGS="$save_CFLAGS"
+chmod u+w .
+$rm conftest* out/*
+rmdir out
+cd ..
+rmdir conftest
+$rm -r conftest 2>/dev/null
+])
+compiler_c_o=$lt_cv_compiler_c_o
+AC_MSG_RESULT([$compiler_c_o])
+
+if test x"$compiler_c_o" = x"yes"; then
+ # Check to see if we can write to a .lo
+ AC_MSG_CHECKING([if $compiler supports -c -o file.lo])
+ AC_CACHE_VAL([lt_cv_compiler_o_lo], [
+ lt_cv_compiler_o_lo=no
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -c -o conftest.lo"
+ save_objext="$ac_objext"
+ ac_objext=lo
+ AC_TRY_COMPILE([], [int some_variable = 0;], [dnl
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s conftest.err; then
+ lt_cv_compiler_o_lo=no
+ else
+ lt_cv_compiler_o_lo=yes
+ fi
+ ])
+ ac_objext="$save_objext"
+ CFLAGS="$save_CFLAGS"
+ ])
+ compiler_o_lo=$lt_cv_compiler_o_lo
+ AC_MSG_RESULT([$compiler_o_lo])
+else
+ compiler_o_lo=no
+fi
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+# Check to see if we can do hard links to lock some files if needed
+hard_links="nottested"
+if test "$compiler_c_o" = no && test "$need_locks" != no; then
+ # do not overwrite the value of need_locks provided by the user
+ AC_MSG_CHECKING([if we can lock with hard links])
+ hard_links=yes
+ $rm conftest*
+ ln conftest.a conftest.b 2>/dev/null && hard_links=no
+ touch conftest.a
+ ln conftest.a conftest.b 2>&5 || hard_links=no
+ ln conftest.a conftest.b 2>/dev/null && hard_links=no
+ AC_MSG_RESULT([$hard_links])
+ if test "$hard_links" = no; then
+ AC_MSG_WARN([\`$CC' does not support \`-c -o', so \`make -j' may be unsafe])
+ need_locks=warn
+ fi
+else
+ need_locks=no
+fi
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+if test "$GCC" = yes; then
+ # Check to see if options -fno-rtti -fno-exceptions are supported by compiler
+ AC_MSG_CHECKING([if $compiler supports -fno-rtti -fno-exceptions])
+ echo "int some_variable = 0;" > conftest.$ac_ext
+ save_CFLAGS="$CFLAGS"
+ CFLAGS="$CFLAGS -fno-rtti -fno-exceptions -c conftest.$ac_ext"
+ compiler_rtti_exceptions=no
+ AC_TRY_COMPILE([], [int some_variable = 0;], [dnl
+ # The compiler can only warn and ignore the option if not recognized
+ # So say no if there are warnings
+ if test -s conftest.err; then
+ compiler_rtti_exceptions=no
+ else
+ compiler_rtti_exceptions=yes
+ fi
+ ])
+ CFLAGS="$save_CFLAGS"
+ AC_MSG_RESULT([$compiler_rtti_exceptions])
+
+ if test "$compiler_rtti_exceptions" = "yes"; then
+ no_builtin_flag=' -fno-builtin -fno-rtti -fno-exceptions'
+ else
+ no_builtin_flag=' -fno-builtin'
+ fi
+fi
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+# See if the linker supports building shared libraries.
+AC_MSG_CHECKING([whether the linker ($LD) supports shared libraries])
+
+allow_undefined_flag=
+no_undefined_flag=
+need_lib_prefix=unknown
+need_version=unknown
+# when you set need_version to no, make sure it does not cause -set_version
+# flags to be left without arguments
+archive_cmds=
+archive_expsym_cmds=
+old_archive_from_new_cmds=
+old_archive_from_expsyms_cmds=
+export_dynamic_flag_spec=
+whole_archive_flag_spec=
+thread_safe_flag_spec=
+hardcode_into_libs=no
+hardcode_libdir_flag_spec=
+hardcode_libdir_separator=
+hardcode_direct=no
+hardcode_minus_L=no
+hardcode_shlibpath_var=unsupported
+runpath_var=
+link_all_deplibs=unknown
+always_export_symbols=no
+export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | sed '\''s/.* //'\'' | sort | uniq > $export_symbols'
+# include_expsyms should be a list of space-separated symbols to be *always*
+# included in the symbol list
+include_expsyms=
+# exclude_expsyms can be an egrep regular expression of symbols to exclude
+# it will be wrapped by ` (' and `)$', so one must not match beginning or
+# end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
+# as well as any symbol that contains `d'.
+exclude_expsyms="_GLOBAL_OFFSET_TABLE_"
+# Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
+# platforms (ab)use it in PIC code, but their linkers get confused if
+# the symbol is explicitly referenced. Since portable code cannot
+# rely on this symbol name, it's probably fine to never include it in
+# preloaded symbol tables.
+extract_expsyms_cmds=
+
+case $host_os in
+cygwin* | mingw* | pw32*)
+ # FIXME: the MSVC++ port hasn't been tested in a loooong time
+ # When not using gcc, we currently assume that we are using
+ # Microsoft Visual C++.
+ if test "$GCC" != yes; then
+ with_gnu_ld=no
+ fi
+ ;;
+openbsd*)
+ with_gnu_ld=no
+ ;;
+esac
+
+ld_shlibs=yes
+if test "$with_gnu_ld" = yes; then
+ # If archive_cmds runs LD, not CC, wlarc should be empty
+ wlarc='${wl}'
+
+ # See if GNU ld supports shared libraries.
+ case $host_os in
+ aix3* | aix4* | aix5*)
+ # On AIX, the GNU linker is very broken
+ # Note:Check GNU linker on AIX 5-IA64 when/if it becomes available.
+ ld_shlibs=no
+ cat <<EOF 1>&2
+
+*** Warning: the GNU linker, at least up to release 2.9.1, is reported
+*** to be unable to reliably create shared libraries on AIX.
+*** Therefore, libtool is disabling shared libraries support. If you
+*** really care for shared libraries, you may want to modify your PATH
+*** so that a non-GNU linker is found, and then restart.
+
+EOF
+ ;;
+
+ amigaos*)
+ archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+
+ # Samuel A. Falvo II <kc5tja@dolphin.openprojects.net> reports
+ # that the semantics of dynamic libraries on AmigaOS, at least up
+ # to version 4, is to share data among multiple programs linked
+ # with the same dynamic library. Since this doesn't match the
+ # behavior of shared libraries on other platforms, we can use
+ # them.
+ ld_shlibs=no
+ ;;
+
+ beos*)
+ if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ allow_undefined_flag=unsupported
+ # Joseph Beckenbach <jrb3@best.com> says some releases of gcc
+ # support --undefined. This deserves some investigation. FIXME
+ archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ # hardcode_libdir_flag_spec is actually meaningless, as there is
+ # no search path for DLLs.
+ hardcode_libdir_flag_spec='-L$libdir'
+ allow_undefined_flag=unsupported
+ always_export_symbols=yes
+
+ extract_expsyms_cmds='test -f $output_objdir/impgen.c || \
+ sed -e "/^# \/\* impgen\.c starts here \*\//,/^# \/\* impgen.c ends here \*\// { s/^# //;s/^# *$//; p; }" -e d < $''0 > $output_objdir/impgen.c~
+ test -f $output_objdir/impgen.exe || (cd $output_objdir && \
+ if test "x$HOST_CC" != "x" ; then $HOST_CC -o impgen impgen.c ; \
+ else $CC -o impgen impgen.c ; fi)~
+ $output_objdir/impgen $dir/$soroot > $output_objdir/$soname-def'
+
+ old_archive_from_expsyms_cmds='$DLLTOOL --as=$AS --dllname $soname --def $output_objdir/$soname-def --output-lib $output_objdir/$newlib'
+
+ # cygwin and mingw dlls have different entry points and sets of symbols
+ # to exclude.
+ # FIXME: what about values for MSVC?
+ dll_entry=__cygwin_dll_entry@12
+ dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12~
+ case $host_os in
+ mingw*)
+ # mingw values
+ dll_entry=_DllMainCRTStartup@12
+ dll_exclude_symbols=DllMain@12,DllMainCRTStartup@12,DllEntryPoint@12~
+ ;;
+ esac
+
+ # mingw and cygwin differ, and it's simplest to just exclude the union
+ # of the two symbol sets.
+ dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12,DllMainCRTStartup@12,DllEntryPoint@12
+
+ # recent cygwin and mingw systems supply a stub DllMain which the user
+ # can override, but on older systems we have to supply one (in ltdll.c)
+ if test "x$lt_cv_need_dllmain" = "xyes"; then
+ ltdll_obj='$output_objdir/$soname-ltdll.'"$ac_objext "
+ ltdll_cmds='test -f $output_objdir/$soname-ltdll.c || sed -e "/^# \/\* ltdll\.c starts here \*\//,/^# \/\* ltdll.c ends here \*\// { s/^# //; p; }" -e d < $''0 > $output_objdir/$soname-ltdll.c~
+ test -f $output_objdir/$soname-ltdll.$ac_objext || (cd $output_objdir && $CC -c $soname-ltdll.c)~'
+ else
+ ltdll_obj=
+ ltdll_cmds=
+ fi
+
+ # Extract the symbol export list from an `--export-all' def file,
+ # then regenerate the def file from the symbol export list, so that
+ # the compiled dll only exports the symbol export list.
+ # Be careful not to strip the DATA tag left be newer dlltools.
+ export_symbols_cmds="$ltdll_cmds"'
+ $DLLTOOL --export-all --exclude-symbols '$dll_exclude_symbols' --output-def $output_objdir/$soname-def '$ltdll_obj'$libobjs $convenience~
+ sed -e "1,/EXPORTS/d" -e "s/ @ [[0-9]]*//" -e "s/ *;.*$//" < $output_objdir/$soname-def > $export_symbols'
+
+ # If the export-symbols file already is a .def file (1st line
+ # is EXPORTS), use it as is.
+ # If DATA tags from a recent dlltool are present, honour them!
+ archive_expsym_cmds='if test "x`head -1 $export_symbols`" = xEXPORTS; then
+ cp $export_symbols $output_objdir/$soname-def;
+ else
+ echo EXPORTS > $output_objdir/$soname-def;
+ _lt_hint=1;
+ cat $export_symbols | while read symbol; do
+ set dummy \$symbol;
+ case \[$]# in
+ 2) echo " \[$]2 @ \$_lt_hint ; " >> $output_objdir/$soname-def;;
+ *) echo " \[$]2 @ \$_lt_hint \[$]3 ; " >> $output_objdir/$soname-def;;
+ esac;
+ _lt_hint=`expr 1 + \$_lt_hint`;
+ done;
+ fi~
+ '"$ltdll_cmds"'
+ $CC -Wl,--base-file,$output_objdir/$soname-base '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags~
+ $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp~
+ $CC -Wl,--base-file,$output_objdir/$soname-base $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags~
+ $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp --output-lib $output_objdir/$libname.dll.a~
+ $CC $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $output_objdir/$soname '$ltdll_obj'$libobjs $deplibs $compiler_flags'
+ ;;
+
+ netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
+ wlarc=
+ else
+ archive_cmds='$CC -shared -nodefaultlibs $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared -nodefaultlibs $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ fi
+ ;;
+
+ solaris* | sysv5*)
+ if $LD -v 2>&1 | egrep 'BFD 2\.8' > /dev/null; then
+ ld_shlibs=no
+ cat <<EOF 1>&2
+
+*** Warning: The releases 2.8.* of the GNU linker cannot reliably
+*** create shared libraries on Solaris systems. Therefore, libtool
+*** is disabling shared libraries support. We urge you to upgrade GNU
+*** binutils to release 2.9.1 or newer. Another option is to modify
+*** your PATH or compiler configuration so that the native linker is
+*** used, and then restart.
+
+EOF
+ elif $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+
+ sunos4*)
+ archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ wlarc=
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ *)
+ if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
+ archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
+ else
+ ld_shlibs=no
+ fi
+ ;;
+ esac
+
+ if test "$ld_shlibs" = yes; then
+ runpath_var=LD_RUN_PATH
+ hardcode_libdir_flag_spec='${wl}--rpath ${wl}$libdir'
+ export_dynamic_flag_spec='${wl}--export-dynamic'
+ case $host_os in
+ cygwin* | mingw* | pw32*)
+ # dlltool doesn't understand --whole-archive et. al.
+ whole_archive_flag_spec=
+ ;;
+ *)
+ # ancient GNU ld didn't support --whole-archive et. al.
+ if $LD --help 2>&1 | egrep 'no-whole-archive' > /dev/null; then
+ whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
+ else
+ whole_archive_flag_spec=
+ fi
+ ;;
+ esac
+ fi
+else
+ # PORTME fill in a description of your system's linker (not GNU ld)
+ case $host_os in
+ aix3*)
+ allow_undefined_flag=unsupported
+ always_export_symbols=yes
+ archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
+ # Note: this linker hardcodes the directories in LIBPATH if there
+ # are no directories specified by -L.
+ hardcode_minus_L=yes
+ if test "$GCC" = yes && test -z "$link_static_flag"; then
+ # Neither direct hardcoding nor static linking is supported with a
+ # broken collect2.
+ hardcode_direct=unsupported
+ fi
+ ;;
+
+ aix4* | aix5*)
+ if test "$host_cpu" = ia64; then
+ # On IA64, the linker does run time linking by default, so we don't
+ # have to do anything special.
+ aix_use_runtimelinking=no
+ exp_sym_flag='-Bexport'
+ no_entry_flag=""
+ else
+ aix_use_runtimelinking=no
+
+ # Test if we are trying to use run time linking or normal
+ # AIX style linking. If -brtl is somewhere in LDFLAGS, we
+ # need to do runtime linking.
+ case $host_os in aix4.[[23]]|aix4.[[23]].*|aix5*)
+ for ld_flag in $LDFLAGS; do
+ if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
+ aix_use_runtimelinking=yes
+ break
+ fi
+ done
+ esac
+
+ exp_sym_flag='-bexport'
+ no_entry_flag='-bnoentry'
+ fi
+
+ # When large executables or shared objects are built, AIX ld can
+ # have problems creating the table of contents. If linking a library
+ # or program results in "error TOC overflow" add -mminimal-toc to
+ # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
+ # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
+
+ hardcode_direct=yes
+ archive_cmds=''
+ hardcode_libdir_separator=':'
+ if test "$GCC" = yes; then
+ case $host_os in aix4.[[012]]|aix4.[[012]].*)
+ collect2name=`${CC} -print-prog-name=collect2`
+ if test -f "$collect2name" && \
+ strings "$collect2name" | grep resolve_lib_name >/dev/null
+ then
+ # We have reworked collect2
+ hardcode_direct=yes
+ else
+ # We have old collect2
+ hardcode_direct=unsupported
+ # It fails to find uninstalled libraries when the uninstalled
+ # path is not listed in the libpath. Setting hardcode_minus_L
+ # to unsupported forces relinking
+ hardcode_minus_L=yes
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_libdir_separator=
+ fi
+ esac
+
+ shared_flag='-shared'
+ else
+ # not using gcc
+ if test "$host_cpu" = ia64; then
+ shared_flag='${wl}-G'
+ else
+ if test "$aix_use_runtimelinking" = yes; then
+ shared_flag='${wl}-G'
+ else
+ shared_flag='${wl}-bM:SRE'
+ fi
+ fi
+ fi
+
+ # It seems that -bexpall can do strange things, so it is better to
+ # generate a list of symbols to export.
+ always_export_symbols=yes
+ if test "$aix_use_runtimelinking" = yes; then
+ # Warning - without using the other runtime loading flags (-brtl),
+ # -berok will link without error, but may produce a broken library.
+ allow_undefined_flag='-berok'
+ hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:/usr/lib:/lib'
+ archive_expsym_cmds="\$CC"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then echo "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols $shared_flag"
+ else
+ if test "$host_cpu" = ia64; then
+ hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib'
+ allow_undefined_flag="-z nodefs"
+ archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname ${wl}-h$soname $libobjs $deplibs $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols"
+ else
+ hardcode_libdir_flag_spec='${wl}-bnolibpath ${wl}-blibpath:$libdir:/usr/lib:/lib'
+ # Warning - without using the other run time loading flags,
+ # -berok will link without error, but may produce a broken library.
+ allow_undefined_flag='${wl}-berok'
+ # This is a bit strange, but is similar to how AIX traditionally builds
+ # it's shared libraries.
+ archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags ${allow_undefined_flag} '"\${wl}$no_entry_flag \${wl}$exp_sym_flag:\$export_symbols"' ~$AR -crlo $objdir/$libname$release.a $objdir/$soname'
+ fi
+ fi
+ ;;
+
+ amigaos*)
+ archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+ # see comment about different semantics on the GNU ld section
+ ld_shlibs=no
+ ;;
+
+ cygwin* | mingw* | pw32*)
+ # When not using gcc, we currently assume that we are using
+ # Microsoft Visual C++.
+ # hardcode_libdir_flag_spec is actually meaningless, as there is
+ # no search path for DLLs.
+ hardcode_libdir_flag_spec=' '
+ allow_undefined_flag=unsupported
+ # Tell ltmain to make .lib files, not .a files.
+ libext=lib
+ # FIXME: Setting linknames here is a bad hack.
+ archive_cmds='$CC -o $lib $libobjs $compiler_flags `echo "$deplibs" | sed -e '\''s/ -lc$//'\''` -link -dll~linknames='
+ # The linker will automatically build a .lib file if we build a DLL.
+ old_archive_from_new_cmds='true'
+ # FIXME: Should let the user specify the lib program.
+ old_archive_cmds='lib /OUT:$oldlib$oldobjs$old_deplibs'
+ fix_srcfile_path='`cygpath -w "$srcfile"`'
+ ;;
+
+ darwin* | rhapsody*)
+ case "$host_os" in
+ rhapsody* | darwin1.[[012]])
+ allow_undefined_flag='-undefined suppress'
+ ;;
+ *) # Darwin 1.3 on
+ allow_undefined_flag='-flat_namespace -undefined suppress'
+ ;;
+ esac
+ # FIXME: Relying on posixy $() will cause problems for
+ # cross-compilation, but unfortunately the echo tests do not
+ # yet detect zsh echo's removal of \ escapes.
+ archive_cmds='$nonopt $(test "x$module" = xyes && echo -bundle || echo -dynamiclib) $allow_undefined_flag -o $lib $libobjs $deplibs$linker_flags -install_name $rpath/$soname $verstring'
+ # We need to add '_' to the symbols in $export_symbols first
+ #archive_expsym_cmds="$archive_cmds"' && strip -s $export_symbols'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ whole_archive_flag_spec='-all_load $convenience'
+ ;;
+
+ freebsd1*)
+ ld_shlibs=no
+ ;;
+
+ # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
+ # support. Future versions do this automatically, but an explicit c++rt0.o
+ # does not break anything, and helps significantly (at the cost of a little
+ # extra space).
+ freebsd2.2*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ # Unfortunately, older versions of FreeBSD 2 do not have this feature.
+ freebsd2*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
+ freebsd*)
+ archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ hpux9* | hpux10* | hpux11*)
+ case $host_os in
+ hpux9*) archive_cmds='$rm $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' ;;
+ *) archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' ;;
+ esac
+ hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+ hardcode_libdir_separator=:
+ hardcode_direct=yes
+ hardcode_minus_L=yes # Not in the search PATH, but as the default
+ # location of the library.
+ export_dynamic_flag_spec='${wl}-E'
+ ;;
+
+ irix5* | irix6*)
+ if test "$GCC" = yes; then
+ archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ else
+ archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ fi
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ link_all_deplibs=yes
+ ;;
+
+ netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out
+ else
+ archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF
+ fi
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ newsos6)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ hardcode_shlibpath_var=no
+ ;;
+
+ openbsd*)
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+ export_dynamic_flag_spec='${wl}-E'
+ else
+ case "$host_os" in
+ openbsd[[01]].* | openbsd2.[[0-7]] | openbsd2.[[0-7]].*)
+ archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-R$libdir'
+ ;;
+ *)
+ archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
+ ;;
+ esac
+ fi
+ ;;
+
+ os2*)
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_minus_L=yes
+ allow_undefined_flag=unsupported
+ archive_cmds='$echo "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$echo "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$echo DATA >> $output_objdir/$libname.def~$echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~$echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
+ old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
+ ;;
+
+ osf3*)
+ if test "$GCC" = yes; then
+ allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+ archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ else
+ allow_undefined_flag=' -expect_unresolved \*'
+ archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ fi
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ ;;
+
+ osf4* | osf5*) # as osf3* with the addition of -msym flag
+ if test "$GCC" = yes; then
+ allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
+ archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ else
+ allow_undefined_flag=' -expect_unresolved \*'
+ archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
+ archive_expsym_cmds='for i in `cat $export_symbols`; do printf "-exported_symbol " >> $lib.exp; echo "\$i" >> $lib.exp; done; echo "-hidden">> $lib.exp~
+ $LD -shared${allow_undefined_flag} -input $lib.exp $linker_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${objdir}/so_locations -o $lib~$rm $lib.exp'
+
+ #Both c and cxx compiler support -rpath directly
+ hardcode_libdir_flag_spec='-rpath $libdir'
+ fi
+ hardcode_libdir_separator=:
+ ;;
+
+ sco3.2v5*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ runpath_var=LD_RUN_PATH
+ hardcode_runpath_var=yes
+ export_dynamic_flag_spec='${wl}-Bexport'
+ ;;
+
+ solaris*)
+ # gcc --version < 3.0 without binutils cannot create self contained
+ # shared libraries reliably, requiring libgcc.a to resolve some of
+ # the object symbols generated in some cases. Libraries that use
+ # assert need libgcc.a to resolve __eprintf, for example. Linking
+ # a copy of libgcc.a into every shared library to guarantee resolving
+ # such symbols causes other problems: According to Tim Van Holder
+ # <tim.van.holder@pandora.be>, C++ libraries end up with a separate
+ # (to the application) exception stack for one thing.
+ no_undefined_flag=' -z defs'
+ if test "$GCC" = yes; then
+ case `$CC --version 2>/dev/null` in
+ [[12]].*)
+ cat <<EOF 1>&2
+
+*** Warning: Releases of GCC earlier than version 3.0 cannot reliably
+*** create self contained shared libraries on Solaris systems, without
+*** introducing a dependency on libgcc.a. Therefore, libtool is disabling
+*** -no-undefined support, which will at least allow you to build shared
+*** libraries. However, you may find that when you link such libraries
+*** into an application without using GCC, you have to manually add
+*** \`gcc --print-libgcc-file-name\` to the link command. We urge you to
+*** upgrade to a newer version of GCC. Another option is to rebuild your
+*** current GCC to use the GNU linker from GNU binutils 2.9.1 or newer.
+
+EOF
+ no_undefined_flag=
+ ;;
+ esac
+ fi
+ # $CC -shared without GNU ld will not create a library from C++
+ # object files and a static libstdc++, better avoid it by now
+ archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
+ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_shlibpath_var=no
+ case $host_os in
+ solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
+ *) # Supported since Solaris 2.6 (maybe 2.5.1?)
+ whole_archive_flag_spec='-z allextract$convenience -z defaultextract' ;;
+ esac
+ link_all_deplibs=yes
+ ;;
+
+ sunos4*)
+ if test "x$host_vendor" = xsequent; then
+ # Use $CC to link under sequent, because it throws in some extra .o
+ # files that make .init and .fini sections work.
+ archive_cmds='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags'
+ else
+ archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
+ fi
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4)
+ if test "x$host_vendor" = xsno; then
+ archive_cmds='$LD -G -Bsymbolic -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes # is this really true???
+ else
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=no #Motorola manual says yes, but my tests say they lie
+ fi
+ runpath_var='LD_RUN_PATH'
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4.3*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ export_dynamic_flag_spec='-Bexport'
+ ;;
+
+ sysv5*)
+ no_undefined_flag=' -z text'
+ # $CC -shared without GNU ld will not create a library from C++
+ # object files and a static libstdc++, better avoid it by now
+ archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
+ $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
+ hardcode_libdir_flag_spec=
+ hardcode_shlibpath_var=no
+ runpath_var='LD_RUN_PATH'
+ ;;
+
+ uts4*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_shlibpath_var=no
+ ;;
+
+ dgux*)
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_shlibpath_var=no
+ ;;
+
+ sysv4*MP*)
+ if test -d /usr/nec; then
+ archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_shlibpath_var=no
+ runpath_var=LD_RUN_PATH
+ hardcode_runpath_var=yes
+ ld_shlibs=yes
+ fi
+ ;;
+
+ sysv4.2uw2*)
+ archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags'
+ hardcode_direct=yes
+ hardcode_minus_L=no
+ hardcode_shlibpath_var=no
+ hardcode_runpath_var=yes
+ runpath_var=LD_RUN_PATH
+ ;;
+
+ sysv5uw7* | unixware7*)
+ no_undefined_flag='${wl}-z ${wl}text'
+ if test "$GCC" = yes; then
+ archive_cmds='$CC -shared ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
+ else
+ archive_cmds='$CC -G ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
+ fi
+ runpath_var='LD_RUN_PATH'
+ hardcode_shlibpath_var=no
+ ;;
+
+ *)
+ ld_shlibs=no
+ ;;
+ esac
+fi
+AC_MSG_RESULT([$ld_shlibs])
+test "$ld_shlibs" = no && can_build_shared=no
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+# Check hardcoding attributes.
+AC_MSG_CHECKING([how to hardcode library paths into programs])
+hardcode_action=
+if test -n "$hardcode_libdir_flag_spec" || \
+ test -n "$runpath_var"; then
+
+ # We can hardcode non-existant directories.
+ if test "$hardcode_direct" != no &&
+ # If the only mechanism to avoid hardcoding is shlibpath_var, we
+ # have to relink, otherwise we might link with an installed library
+ # when we should be linking with a yet-to-be-installed one
+ ## test "$hardcode_shlibpath_var" != no &&
+ test "$hardcode_minus_L" != no; then
+ # Linking always hardcodes the temporary library directory.
+ hardcode_action=relink
+ else
+ # We can link without hardcoding, and we can hardcode nonexisting dirs.
+ hardcode_action=immediate
+ fi
+else
+ # We cannot hardcode anything, or else we can only hardcode existing
+ # directories.
+ hardcode_action=unsupported
+fi
+AC_MSG_RESULT([$hardcode_action])
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+striplib=
+old_striplib=
+AC_MSG_CHECKING([whether stripping libraries is possible])
+if test -n "$STRIP" && $STRIP -V 2>&1 | grep "GNU strip" >/dev/null; then
+ test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
+ test -z "$striplib" && striplib="$STRIP --strip-unneeded"
+ AC_MSG_RESULT([yes])
+else
+ AC_MSG_RESULT([no])
+fi
+##
+## END FIXME
+
+reload_cmds='$LD$reload_flag -o $output$reload_objs'
+test -z "$deplibs_check_method" && deplibs_check_method=unknown
+
+## FIXME: this should be a separate macro
+##
+# PORTME Fill in your ld.so characteristics
+AC_MSG_CHECKING([dynamic linker characteristics])
+library_names_spec=
+libname_spec='lib$name'
+soname_spec=
+postinstall_cmds=
+postuninstall_cmds=
+finish_cmds=
+finish_eval=
+shlibpath_var=
+shlibpath_overrides_runpath=unknown
+version_type=none
+dynamic_linker="$host_os ld.so"
+sys_lib_dlsearch_path_spec="/lib /usr/lib"
+sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
+
+case $host_os in
+aix3*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix $libname.a'
+ shlibpath_var=LIBPATH
+
+ # AIX has no versioning support, so we append a major version to the name.
+ soname_spec='${libname}${release}.so$major'
+ ;;
+
+aix4* | aix5*)
+ version_type=linux
+ if test "$host_cpu" = ia64; then
+ # AIX 5 supports IA64
+ library_names_spec='${libname}${release}.so$major ${libname}${release}.so$versuffix $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ else
+ # With GCC up to 2.95.x, collect2 would create an import file
+ # for dependence libraries. The import file would start with
+ # the line `#! .'. This would cause the generated library to
+ # depend on `.', always an invalid library. This was fixed in
+ # development snapshots of GCC prior to 3.0.
+ case $host_os in
+ aix4 | aix4.[[01]] | aix4.[[01]].*)
+ if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
+ echo ' yes '
+ echo '#endif'; } | ${CC} -E - | grep yes > /dev/null; then
+ :
+ else
+ can_build_shared=no
+ fi
+ ;;
+ esac
+ # AIX (on Power*) has no versioning support, so currently we can
+ # not hardcode correct soname into executable. Probably we can
+ # add versioning support to collect2, so additional links can
+ # be useful in future.
+ if test "$aix_use_runtimelinking" = yes; then
+ # If using run time linking (on AIX 4.2 or later) use lib<name>.so
+ # instead of lib<name>.a to let people know that these are not
+ # typical AIX shared libraries.
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ else
+ # We preserve .a as extension for shared libraries through AIX4.2
+ # and later when we are not doing run time linking.
+ library_names_spec='${libname}${release}.a $libname.a'
+ soname_spec='${libname}${release}.so$major'
+ fi
+ shlibpath_var=LIBPATH
+ fi
+ ;;
+
+amigaos*)
+ library_names_spec='$libname.ixlibrary $libname.a'
+ # Create ${libname}_ixlibrary.a entries in /sys/libs.
+ finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([[^/]]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "(cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a)"; (cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a) || exit 1; done'
+ ;;
+
+beos*)
+ library_names_spec='${libname}.so'
+ dynamic_linker="$host_os ld.so"
+ shlibpath_var=LIBRARY_PATH
+ ;;
+
+bsdi4*)
+ version_type=linux
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
+ sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
+ export_dynamic_flag_spec=-rdynamic
+ # the default ld.so.conf also contains /usr/contrib/lib and
+ # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
+ # libtool to hard-code these into programs
+ ;;
+
+cygwin* | mingw* | pw32*)
+ version_type=windows
+ need_version=no
+ need_lib_prefix=no
+ case $GCC,$host_os in
+ yes,cygwin*)
+ library_names_spec='$libname.dll.a'
+ soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | sed -e 's/[[.]]/-/g'`${versuffix}.dll'
+ postinstall_cmds='dlpath=`bash 2>&1 -c '\''. $dir/${file}i;echo \$dlname'\''`~
+ dldir=$destdir/`dirname \$dlpath`~
+ test -d \$dldir || mkdir -p \$dldir~
+ $install_prog .libs/$dlname \$dldir/$dlname'
+ postuninstall_cmds='dldll=`bash 2>&1 -c '\''. $file; echo \$dlname'\''`~
+ dlpath=$dir/\$dldll~
+ $rm \$dlpath'
+ ;;
+ yes,mingw*)
+ library_names_spec='${libname}`echo ${release} | sed -e 's/[[.]]/-/g'`${versuffix}.dll'
+ sys_lib_search_path_spec=`$CC -print-search-dirs | grep "^libraries:" | sed -e "s/^libraries://" -e "s/;/ /g"`
+ ;;
+ yes,pw32*)
+ library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll'
+ ;;
+ *)
+ library_names_spec='${libname}`echo ${release} | sed -e 's/[[.]]/-/g'`${versuffix}.dll $libname.lib'
+ ;;
+ esac
+ dynamic_linker='Win32 ld.exe'
+ # FIXME: first we should search . and the directory the executable is in
+ shlibpath_var=PATH
+ ;;
+
+darwin* | rhapsody*)
+ dynamic_linker="$host_os dyld"
+ version_type=darwin
+ need_lib_prefix=no
+ need_version=no
+ # FIXME: Relying on posixy $() will cause problems for
+ # cross-compilation, but unfortunately the echo tests do not
+ # yet detect zsh echo's removal of \ escapes.
+ library_names_spec='${libname}${release}${versuffix}.$(test .$module = .yes && echo so || echo dylib) ${libname}${release}${major}.$(test .$module = .yes && echo so || echo dylib) ${libname}.$(test .$module = .yes && echo so || echo dylib)'
+ soname_spec='${libname}${release}${major}.$(test .$module = .yes && echo so || echo dylib)'
+ shlibpath_overrides_runpath=yes
+ shlibpath_var=DYLD_LIBRARY_PATH
+ ;;
+
+freebsd1*)
+ dynamic_linker=no
+ ;;
+
+freebsd*)
+ objformat=`test -x /usr/bin/objformat && /usr/bin/objformat || echo aout`
+ version_type=freebsd-$objformat
+ case $version_type in
+ freebsd-elf*)
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
+ need_version=no
+ need_lib_prefix=no
+ ;;
+ freebsd-*)
+ library_names_spec='${libname}${release}.so$versuffix $libname.so$versuffix'
+ need_version=yes
+ ;;
+ esac
+ shlibpath_var=LD_LIBRARY_PATH
+ case $host_os in
+ freebsd2*)
+ shlibpath_overrides_runpath=yes
+ ;;
+ *)
+ shlibpath_overrides_runpath=no
+ hardcode_into_libs=yes
+ ;;
+ esac
+ ;;
+
+gnu*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so${major} ${libname}.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ hardcode_into_libs=yes
+ ;;
+
+hpux9* | hpux10* | hpux11*)
+ # Give a soname corresponding to the major version so that dld.sl refuses to
+ # link against other versions.
+ dynamic_linker="$host_os dld.sl"
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ shlibpath_var=SHLIB_PATH
+ shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
+ library_names_spec='${libname}${release}.sl$versuffix ${libname}${release}.sl$major $libname.sl'
+ soname_spec='${libname}${release}.sl$major'
+ # HP-UX runs *really* slowly unless shared libraries are mode 555.
+ postinstall_cmds='chmod 555 $lib'
+ ;;
+
+irix5* | irix6*)
+ version_type=irix
+ need_lib_prefix=no
+ need_version=no
+ soname_spec='${libname}${release}.so$major'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major ${libname}${release}.so $libname.so'
+ case $host_os in
+ irix5*)
+ libsuff= shlibsuff=
+ ;;
+ *)
+ case $LD in # libtool.m4 will add one of these switches to LD
+ *-32|*"-32 ") libsuff= shlibsuff= libmagic=32-bit;;
+ *-n32|*"-n32 ") libsuff=32 shlibsuff=N32 libmagic=N32;;
+ *-64|*"-64 ") libsuff=64 shlibsuff=64 libmagic=64-bit;;
+ *) libsuff= shlibsuff= libmagic=never-match;;
+ esac
+ ;;
+ esac
+ shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
+ shlibpath_overrides_runpath=no
+ sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
+ sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
+ ;;
+
+# No shared lib support for Linux oldld, aout, or coff.
+linux-gnuoldld* | linux-gnuaout* | linux-gnucoff*)
+ dynamic_linker=no
+ ;;
+
+# This must be Linux ELF.
+linux-gnu*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=no
+ # This implies no fast_install, which is unacceptable.
+ # Some rework will be needed to allow for fast_install
+ # before this can be enabled.
+ hardcode_into_libs=yes
+
+ # We used to test for /lib/ld.so.1 and disable shared libraries on
+ # powerpc, because MkLinux only supported shared libraries with the
+ # GNU dynamic linker. Since this was broken with cross compilers,
+ # most powerpc-linux boxes support dynamic linking these days and
+ # people can always --disable-shared, the test was removed, and we
+ # assume the GNU/Linux dynamic linker is in use.
+ dynamic_linker='GNU/Linux ld.so'
+ ;;
+
+netbsd*)
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+ dynamic_linker='NetBSD (a.out) ld.so'
+ else
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major ${libname}${release}.so ${libname}.so'
+ soname_spec='${libname}${release}.so$major'
+ dynamic_linker='NetBSD ld.elf_so'
+ fi
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ hardcode_into_libs=yes
+ ;;
+
+newsos6)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ ;;
+
+openbsd*)
+ version_type=sunos
+ need_lib_prefix=no
+ need_version=no
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ case "$host_os" in
+ openbsd2.[[89]] | openbsd2.[[89]].*)
+ shlibpath_overrides_runpath=no
+ ;;
+ *)
+ shlibpath_overrides_runpath=yes
+ ;;
+ esac
+ else
+ shlibpath_overrides_runpath=yes
+ fi
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+os2*)
+ libname_spec='$name'
+ need_lib_prefix=no
+ library_names_spec='$libname.dll $libname.a'
+ dynamic_linker='OS/2 ld.exe'
+ shlibpath_var=LIBPATH
+ ;;
+
+osf3* | osf4* | osf5*)
+ version_type=osf
+ need_version=no
+ soname_spec='${libname}${release}.so'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
+ sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
+ ;;
+
+sco3.2v5*)
+ version_type=osf
+ soname_spec='${libname}${release}.so$major'
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+solaris*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ hardcode_into_libs=yes
+ # ldd complains unless libraries are executable
+ postinstall_cmds='chmod +x $lib'
+ ;;
+
+sunos4*)
+ version_type=sunos
+ library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
+ finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ shlibpath_overrides_runpath=yes
+ if test "$with_gnu_ld" = yes; then
+ need_lib_prefix=no
+ fi
+ need_version=yes
+ ;;
+
+sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ case $host_vendor in
+ sni)
+ shlibpath_overrides_runpath=no
+ ;;
+ motorola)
+ need_lib_prefix=no
+ need_version=no
+ shlibpath_overrides_runpath=no
+ sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
+ ;;
+ esac
+ ;;
+
+uts4*)
+ version_type=linux
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+dgux*)
+ version_type=linux
+ need_lib_prefix=no
+ need_version=no
+ library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
+ soname_spec='${libname}${release}.so$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+sysv4*MP*)
+ if test -d /usr/nec ;then
+ version_type=linux
+ library_names_spec='$libname.so.$versuffix $libname.so.$major $libname.so'
+ soname_spec='$libname.so.$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ fi
+ ;;
+
+*)
+ dynamic_linker=no
+ ;;
+esac
+AC_MSG_RESULT([$dynamic_linker])
+test "$dynamic_linker" = no && can_build_shared=no
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+# Report the final consequences.
+AC_MSG_CHECKING([if libtool supports shared libraries])
+AC_MSG_RESULT([$can_build_shared])
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+AC_MSG_CHECKING([whether to build shared libraries])
+test "$can_build_shared" = "no" && enable_shared=no
+
+# On AIX, shared libraries and static libraries use the same namespace, and
+# are all built from PIC.
+case "$host_os" in
+aix3*)
+ test "$enable_shared" = yes && enable_static=no
+ if test -n "$RANLIB"; then
+ archive_cmds="$archive_cmds~\$RANLIB \$lib"
+ postinstall_cmds='$RANLIB $lib'
+ fi
+ ;;
+
+aix4*)
+ if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
+ test "$enable_shared" = yes && enable_static=no
+ fi
+ ;;
+esac
+AC_MSG_RESULT([$enable_shared])
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+AC_MSG_CHECKING([whether to build static libraries])
+# Make sure either enable_shared or enable_static is yes.
+test "$enable_shared" = yes || enable_static=yes
+AC_MSG_RESULT([$enable_static])
+##
+## END FIXME
+
+if test "$hardcode_action" = relink; then
+ # Fast installation is not supported
+ enable_fast_install=no
+elif test "$shlibpath_overrides_runpath" = yes ||
+ test "$enable_shared" = no; then
+ # Fast installation is not necessary
+ enable_fast_install=needless
+fi
+
+variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
+if test "$GCC" = yes; then
+ variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
+fi
+
+AC_LIBTOOL_DLOPEN_SELF
+
+## FIXME: this should be a separate macro
+##
+if test "$enable_shared" = yes && test "$GCC" = yes; then
+ case $archive_cmds in
+ *'~'*)
+ # FIXME: we may have to deal with multi-command sequences.
+ ;;
+ '$CC '*)
+ # Test whether the compiler implicitly links with -lc since on some
+ # systems, -lgcc has to come before -lc. If gcc already passes -lc
+ # to ld, don't add -lc before -lgcc.
+ AC_MSG_CHECKING([whether -lc should be explicitly linked in])
+ AC_CACHE_VAL([lt_cv_archive_cmds_need_lc],
+ [$rm conftest*
+ echo 'static int dummy;' > conftest.$ac_ext
+
+ if AC_TRY_EVAL(ac_compile); then
+ soname=conftest
+ lib=conftest
+ libobjs=conftest.$ac_objext
+ deplibs=
+ wl=$lt_cv_prog_cc_wl
+ compiler_flags=-v
+ linker_flags=-v
+ verstring=
+ output_objdir=.
+ libname=conftest
+ save_allow_undefined_flag=$allow_undefined_flag
+ allow_undefined_flag=
+ if AC_TRY_EVAL(archive_cmds 2\>\&1 \| grep \" -lc \" \>/dev/null 2\>\&1)
+ then
+ lt_cv_archive_cmds_need_lc=no
+ else
+ lt_cv_archive_cmds_need_lc=yes
+ fi
+ allow_undefined_flag=$save_allow_undefined_flag
+ else
+ cat conftest.err 1>&5
+ fi])
+ AC_MSG_RESULT([$lt_cv_archive_cmds_need_lc])
+ ;;
+ esac
+fi
+need_lc=${lt_cv_archive_cmds_need_lc-yes}
+##
+## END FIXME
+
+## FIXME: this should be a separate macro
+##
+# The second clause should only fire when bootstrapping the
+# libtool distribution, otherwise you forgot to ship ltmain.sh
+# with your package, and you will get complaints that there are
+# no rules to generate ltmain.sh.
+if test -f "$ltmain"; then
+ :
+else
+ # If there is no Makefile yet, we rely on a make rule to execute
+ # `config.status --recheck' to rerun these tests and create the
+ # libtool script then.
+ test -f Makefile && make "$ltmain"
+fi
+
+if test -f "$ltmain"; then
+ trap "$rm \"${ofile}T\"; exit 1" 1 2 15
+ $rm -f "${ofile}T"
+
+ echo creating $ofile
+
+ # Now quote all the things that may contain metacharacters while being
+ # careful not to overquote the AC_SUBSTed values. We take copies of the
+ # variables and quote the copies for generation of the libtool script.
+ for var in echo old_CC old_CFLAGS \
+ AR AR_FLAGS CC LD LN_S NM SHELL \
+ reload_flag reload_cmds wl \
+ pic_flag link_static_flag no_builtin_flag export_dynamic_flag_spec \
+ thread_safe_flag_spec whole_archive_flag_spec libname_spec \
+ library_names_spec soname_spec \
+ RANLIB old_archive_cmds old_archive_from_new_cmds old_postinstall_cmds \
+ old_postuninstall_cmds archive_cmds archive_expsym_cmds postinstall_cmds \
+ postuninstall_cmds extract_expsyms_cmds old_archive_from_expsyms_cmds \
+ old_striplib striplib file_magic_cmd export_symbols_cmds \
+ deplibs_check_method allow_undefined_flag no_undefined_flag \
+ finish_cmds finish_eval global_symbol_pipe global_symbol_to_cdecl \
+ global_symbol_to_c_name_address \
+ hardcode_libdir_flag_spec hardcode_libdir_separator \
+ sys_lib_search_path_spec sys_lib_dlsearch_path_spec \
+ compiler_c_o compiler_o_lo need_locks exclude_expsyms include_expsyms; do
+
+ case $var in
+ reload_cmds | old_archive_cmds | old_archive_from_new_cmds | \
+ old_postinstall_cmds | old_postuninstall_cmds | \
+ export_symbols_cmds | archive_cmds | archive_expsym_cmds | \
+ extract_expsyms_cmds | old_archive_from_expsyms_cmds | \
+ postinstall_cmds | postuninstall_cmds | \
+ finish_cmds | sys_lib_search_path_spec | sys_lib_dlsearch_path_spec)
+ # Double-quote double-evaled strings.
+ eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\""
+ ;;
+ *)
+ eval "lt_$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\""
+ ;;
+ esac
+ done
+
+ cat <<__EOF__ > "${ofile}T"
+#! $SHELL
+
+# `$echo "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
+# Generated automatically by $PROGRAM (GNU $PACKAGE $VERSION$TIMESTAMP)
+# NOTE: Changes made to this file will be lost: look at ltmain.sh.
+#
+# Copyright (C) 1996-2000 Free Software Foundation, Inc.
+# Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Sed that helps us avoid accidentally triggering echo(1) options like -n.
+Xsed="sed -e s/^X//"
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+if test "X\${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
+
+# ### BEGIN LIBTOOL CONFIG
+
+# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+
+# Shell to use when invoking shell scripts.
+SHELL=$lt_SHELL
+
+# Whether or not to build shared libraries.
+build_libtool_libs=$enable_shared
+
+# Whether or not to build static libraries.
+build_old_libs=$enable_static
+
+# Whether or not to add -lc for building shared libraries.
+build_libtool_need_lc=$need_lc
+
+# Whether or not to optimize for fast installation.
+fast_install=$enable_fast_install
+
+# The host system.
+host_alias=$host_alias
+host=$host
+
+# An echo program that does not interpret backslashes.
+echo=$lt_echo
+
+# The archiver.
+AR=$lt_AR
+AR_FLAGS=$lt_AR_FLAGS
+
+# The default C compiler.
+CC=$lt_CC
+
+# Is the compiler the GNU C compiler?
+with_gcc=$GCC
+
+# The linker used to build libraries.
+LD=$lt_LD
+
+# Whether we need hard or soft links.
+LN_S=$lt_LN_S
+
+# A BSD-compatible nm program.
+NM=$lt_NM
+
+# A symbol stripping program
+STRIP=$STRIP
+
+# Used to examine libraries when file_magic_cmd begins "file"
+MAGIC_CMD=$MAGIC_CMD
+
+# Used on cygwin: DLL creation program.
+DLLTOOL="$DLLTOOL"
+
+# Used on cygwin: object dumper.
+OBJDUMP="$OBJDUMP"
+
+# Used on cygwin: assembler.
+AS="$AS"
+
+# The name of the directory that contains temporary libtool files.
+objdir=$objdir
+
+# How to create reloadable object files.
+reload_flag=$lt_reload_flag
+reload_cmds=$lt_reload_cmds
+
+# How to pass a linker flag through the compiler.
+wl=$lt_wl
+
+# Object file suffix (normally "o").
+objext="$ac_objext"
+
+# Old archive suffix (normally "a").
+libext="$libext"
+
+# Executable file suffix (normally "").
+exeext="$exeext"
+
+# Additional compiler flags for building library objects.
+pic_flag=$lt_pic_flag
+pic_mode=$pic_mode
+
+# Does compiler simultaneously support -c and -o options?
+compiler_c_o=$lt_compiler_c_o
+
+# Can we write directly to a .lo ?
+compiler_o_lo=$lt_compiler_o_lo
+
+# Must we lock files when doing compilation ?
+need_locks=$lt_need_locks
+
+# Do we need the lib prefix for modules?
+need_lib_prefix=$need_lib_prefix
+
+# Do we need a version for libraries?
+need_version=$need_version
+
+# Whether dlopen is supported.
+dlopen_support=$enable_dlopen
+
+# Whether dlopen of programs is supported.
+dlopen_self=$enable_dlopen_self
+
+# Whether dlopen of statically linked programs is supported.
+dlopen_self_static=$enable_dlopen_self_static
+
+# Compiler flag to prevent dynamic linking.
+link_static_flag=$lt_link_static_flag
+
+# Compiler flag to turn off builtin functions.
+no_builtin_flag=$lt_no_builtin_flag
+
+# Compiler flag to allow reflexive dlopens.
+export_dynamic_flag_spec=$lt_export_dynamic_flag_spec
+
+# Compiler flag to generate shared objects directly from archives.
+whole_archive_flag_spec=$lt_whole_archive_flag_spec
+
+# Compiler flag to generate thread-safe objects.
+thread_safe_flag_spec=$lt_thread_safe_flag_spec
+
+# Library versioning type.
+version_type=$version_type
+
+# Format of library name prefix.
+libname_spec=$lt_libname_spec
+
+# List of archive names. First name is the real one, the rest are links.
+# The last name is the one that the linker finds with -lNAME.
+library_names_spec=$lt_library_names_spec
+
+# The coded name of the library, if different from the real name.
+soname_spec=$lt_soname_spec
+
+# Commands used to build and install an old-style archive.
+RANLIB=$lt_RANLIB
+old_archive_cmds=$lt_old_archive_cmds
+old_postinstall_cmds=$lt_old_postinstall_cmds
+old_postuninstall_cmds=$lt_old_postuninstall_cmds
+
+# Create an old-style archive from a shared archive.
+old_archive_from_new_cmds=$lt_old_archive_from_new_cmds
+
+# Create a temporary old-style archive to link instead of a shared archive.
+old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds
+
+# Commands used to build and install a shared archive.
+archive_cmds=$lt_archive_cmds
+archive_expsym_cmds=$lt_archive_expsym_cmds
+postinstall_cmds=$lt_postinstall_cmds
+postuninstall_cmds=$lt_postuninstall_cmds
+
+# Commands to strip libraries.
+old_striplib=$lt_old_striplib
+striplib=$lt_striplib
+
+# Method to check whether dependent libraries are shared objects.
+deplibs_check_method=$lt_deplibs_check_method
+
+# Command to use when deplibs_check_method == file_magic.
+file_magic_cmd=$lt_file_magic_cmd
+
+# Flag that allows shared libraries with undefined symbols to be built.
+allow_undefined_flag=$lt_allow_undefined_flag
+
+# Flag that forces no undefined symbols.
+no_undefined_flag=$lt_no_undefined_flag
+
+# Commands used to finish a libtool library installation in a directory.
+finish_cmds=$lt_finish_cmds
+
+# Same as above, but a single script fragment to be evaled but not shown.
+finish_eval=$lt_finish_eval
+
+# Take the output of nm and produce a listing of raw symbols and C names.
+global_symbol_pipe=$lt_global_symbol_pipe
+
+# Transform the output of nm in a proper C declaration
+global_symbol_to_cdecl=$lt_global_symbol_to_cdecl
+
+# Transform the output of nm in a C name address pair
+global_symbol_to_c_name_address=$lt_global_symbol_to_c_name_address
+
+# This is the shared library runtime path variable.
+runpath_var=$runpath_var
+
+# This is the shared library path variable.
+shlibpath_var=$shlibpath_var
+
+# Is shlibpath searched before the hard-coded library search path?
+shlibpath_overrides_runpath=$shlibpath_overrides_runpath
+
+# How to hardcode a shared library path into an executable.
+hardcode_action=$hardcode_action
+
+# Whether we should hardcode library paths into libraries.
+hardcode_into_libs=$hardcode_into_libs
+
+# Flag to hardcode \$libdir into a binary during linking.
+# This must work even if \$libdir does not exist.
+hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec
+
+# Whether we need a single -rpath flag with a separated argument.
+hardcode_libdir_separator=$lt_hardcode_libdir_separator
+
+# Set to yes if using DIR/libNAME.so during linking hardcodes DIR into the
+# resulting binary.
+hardcode_direct=$hardcode_direct
+
+# Set to yes if using the -LDIR flag during linking hardcodes DIR into the
+# resulting binary.
+hardcode_minus_L=$hardcode_minus_L
+
+# Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into
+# the resulting binary.
+hardcode_shlibpath_var=$hardcode_shlibpath_var
+
+# Variables whose values should be saved in libtool wrapper scripts and
+# restored at relink time.
+variables_saved_for_relink="$variables_saved_for_relink"
+
+# Whether libtool must link a program against all its dependency libraries.
+link_all_deplibs=$link_all_deplibs
+
+# Compile-time system search path for libraries
+sys_lib_search_path_spec=$lt_sys_lib_search_path_spec
+
+# Run-time system search path for libraries
+sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec
+
+# Fix the shell variable \$srcfile for the compiler.
+fix_srcfile_path="$fix_srcfile_path"
+
+# Set to yes if exported symbols are required.
+always_export_symbols=$always_export_symbols
+
+# The commands to list exported symbols.
+export_symbols_cmds=$lt_export_symbols_cmds
+
+# The commands to extract the exported symbol list from a shared archive.
+extract_expsyms_cmds=$lt_extract_expsyms_cmds
+
+# Symbols that should not be listed in the preloaded symbols.
+exclude_expsyms=$lt_exclude_expsyms
+
+# Symbols that must always be exported.
+include_expsyms=$lt_include_expsyms
+
+# ### END LIBTOOL CONFIG
+
+__EOF__
+
+ case $host_os in
+ aix3*)
+ cat <<\EOF >> "${ofile}T"
+
+# AIX sometimes has problems with the GCC collect2 program. For some
+# reason, if we set the COLLECT_NAMES environment variable, the problems
+# vanish in a puff of smoke.
+if test "X${COLLECT_NAMES+set}" != Xset; then
+ COLLECT_NAMES=
+ export COLLECT_NAMES
+fi
+EOF
+ ;;
+ esac
+
+ case $host_os in
+ cygwin* | mingw* | pw32* | os2*)
+ cat <<'EOF' >> "${ofile}T"
+ # This is a source program that is used to create dlls on Windows
+ # Don't remove nor modify the starting and closing comments
+# /* ltdll.c starts here */
+# #define WIN32_LEAN_AND_MEAN
+# #include <windows.h>
+# #undef WIN32_LEAN_AND_MEAN
+# #include <stdio.h>
+#
+# #ifndef __CYGWIN__
+# # ifdef __CYGWIN32__
+# # define __CYGWIN__ __CYGWIN32__
+# # endif
+# #endif
+#
+# #ifdef __cplusplus
+# extern "C" {
+# #endif
+# BOOL APIENTRY DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved);
+# #ifdef __cplusplus
+# }
+# #endif
+#
+# #ifdef __CYGWIN__
+# #include <cygwin/cygwin_dll.h>
+# DECLARE_CYGWIN_DLL( DllMain );
+# #endif
+# HINSTANCE __hDllInstance_base;
+#
+# BOOL APIENTRY
+# DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved)
+# {
+# __hDllInstance_base = hInst;
+# return TRUE;
+# }
+# /* ltdll.c ends here */
+ # This is a source program that is used to create import libraries
+ # on Windows for dlls which lack them. Don't remove nor modify the
+ # starting and closing comments
+# /* impgen.c starts here */
+# /* Copyright (C) 1999-2000 Free Software Foundation, Inc.
+#
+# This file is part of GNU libtool.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# */
+#
+# #include <stdio.h> /* for printf() */
+# #include <unistd.h> /* for open(), lseek(), read() */
+# #include <fcntl.h> /* for O_RDONLY, O_BINARY */
+# #include <string.h> /* for strdup() */
+#
+# /* O_BINARY isn't required (or even defined sometimes) under Unix */
+# #ifndef O_BINARY
+# #define O_BINARY 0
+# #endif
+#
+# static unsigned int
+# pe_get16 (fd, offset)
+# int fd;
+# int offset;
+# {
+# unsigned char b[2];
+# lseek (fd, offset, SEEK_SET);
+# read (fd, b, 2);
+# return b[0] + (b[1]<<8);
+# }
+#
+# static unsigned int
+# pe_get32 (fd, offset)
+# int fd;
+# int offset;
+# {
+# unsigned char b[4];
+# lseek (fd, offset, SEEK_SET);
+# read (fd, b, 4);
+# return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
+# }
+#
+# static unsigned int
+# pe_as32 (ptr)
+# void *ptr;
+# {
+# unsigned char *b = ptr;
+# return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
+# }
+#
+# int
+# main (argc, argv)
+# int argc;
+# char *argv[];
+# {
+# int dll;
+# unsigned long pe_header_offset, opthdr_ofs, num_entries, i;
+# unsigned long export_rva, export_size, nsections, secptr, expptr;
+# unsigned long name_rvas, nexp;
+# unsigned char *expdata, *erva;
+# char *filename, *dll_name;
+#
+# filename = argv[1];
+#
+# dll = open(filename, O_RDONLY|O_BINARY);
+# if (dll < 1)
+# return 1;
+#
+# dll_name = filename;
+#
+# for (i=0; filename[i]; i++)
+# if (filename[i] == '/' || filename[i] == '\\' || filename[i] == ':')
+# dll_name = filename + i +1;
+#
+# pe_header_offset = pe_get32 (dll, 0x3c);
+# opthdr_ofs = pe_header_offset + 4 + 20;
+# num_entries = pe_get32 (dll, opthdr_ofs + 92);
+#
+# if (num_entries < 1) /* no exports */
+# return 1;
+#
+# export_rva = pe_get32 (dll, opthdr_ofs + 96);
+# export_size = pe_get32 (dll, opthdr_ofs + 100);
+# nsections = pe_get16 (dll, pe_header_offset + 4 +2);
+# secptr = (pe_header_offset + 4 + 20 +
+# pe_get16 (dll, pe_header_offset + 4 + 16));
+#
+# expptr = 0;
+# for (i = 0; i < nsections; i++)
+# {
+# char sname[8];
+# unsigned long secptr1 = secptr + 40 * i;
+# unsigned long vaddr = pe_get32 (dll, secptr1 + 12);
+# unsigned long vsize = pe_get32 (dll, secptr1 + 16);
+# unsigned long fptr = pe_get32 (dll, secptr1 + 20);
+# lseek(dll, secptr1, SEEK_SET);
+# read(dll, sname, 8);
+# if (vaddr <= export_rva && vaddr+vsize > export_rva)
+# {
+# expptr = fptr + (export_rva - vaddr);
+# if (export_rva + export_size > vaddr + vsize)
+# export_size = vsize - (export_rva - vaddr);
+# break;
+# }
+# }
+#
+# expdata = (unsigned char*)malloc(export_size);
+# lseek (dll, expptr, SEEK_SET);
+# read (dll, expdata, export_size);
+# erva = expdata - export_rva;
+#
+# nexp = pe_as32 (expdata+24);
+# name_rvas = pe_as32 (expdata+32);
+#
+# printf ("EXPORTS\n");
+# for (i = 0; i<nexp; i++)
+# {
+# unsigned long name_rva = pe_as32 (erva+name_rvas+i*4);
+# printf ("\t%s @ %ld ;\n", erva+name_rva, 1+ i);
+# }
+#
+# return 0;
+# }
+# /* impgen.c ends here */
+
+EOF
+ ;;
+ esac
+
+ # We use sed instead of cat because bash on DJGPP gets confused if
+ # if finds mixed CR/LF and LF-only lines. Since sed operates in
+ # text mode, it properly converts lines to CR/LF. This bash problem
+ # is reportedly fixed, but why not run on old versions too?
+ sed '$q' "$ltmain" >> "${ofile}T" || (rm -f "${ofile}T"; exit 1)
+
+ mv -f "${ofile}T" "$ofile" || \
+ (rm -f "$ofile" && cp "${ofile}T" "$ofile" && rm -f "${ofile}T")
+ chmod +x "$ofile"
+fi
+##
+## END FIXME
+
+])# _LT_AC_LTCONFIG_HACK
+
+# AC_LIBTOOL_DLOPEN - enable checks for dlopen support
+AC_DEFUN([AC_LIBTOOL_DLOPEN], [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])])
+
+# AC_LIBTOOL_WIN32_DLL - declare package support for building win32 dll's
+AC_DEFUN([AC_LIBTOOL_WIN32_DLL], [AC_BEFORE([$0], [AC_LIBTOOL_SETUP])])
+
+# AC_ENABLE_SHARED - implement the --enable-shared flag
+# Usage: AC_ENABLE_SHARED[(DEFAULT)]
+# Where DEFAULT is either `yes' or `no'. If omitted, it defaults to
+# `yes'.
+AC_DEFUN([AC_ENABLE_SHARED],
+[define([AC_ENABLE_SHARED_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(shared,
+changequote(<<, >>)dnl
+<< --enable-shared[=PKGS] build shared libraries [default=>>AC_ENABLE_SHARED_DEFAULT],
+changequote([, ])dnl
+[p=${PACKAGE-default}
+case $enableval in
+yes) enable_shared=yes ;;
+no) enable_shared=no ;;
+*)
+ enable_shared=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_shared=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac],
+enable_shared=AC_ENABLE_SHARED_DEFAULT)dnl
+])
+
+# AC_DISABLE_SHARED - set the default shared flag to --disable-shared
+AC_DEFUN([AC_DISABLE_SHARED],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_SHARED(no)])
+
+# AC_ENABLE_STATIC - implement the --enable-static flag
+# Usage: AC_ENABLE_STATIC[(DEFAULT)]
+# Where DEFAULT is either `yes' or `no'. If omitted, it defaults to
+# `yes'.
+AC_DEFUN([AC_ENABLE_STATIC],
+[define([AC_ENABLE_STATIC_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(static,
+changequote(<<, >>)dnl
+<< --enable-static[=PKGS] build static libraries [default=>>AC_ENABLE_STATIC_DEFAULT],
+changequote([, ])dnl
+[p=${PACKAGE-default}
+case $enableval in
+yes) enable_static=yes ;;
+no) enable_static=no ;;
+*)
+ enable_static=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_static=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac],
+enable_static=AC_ENABLE_STATIC_DEFAULT)dnl
+])
+
+# AC_DISABLE_STATIC - set the default static flag to --disable-static
+AC_DEFUN([AC_DISABLE_STATIC],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_STATIC(no)])
+
+
+# AC_ENABLE_FAST_INSTALL - implement the --enable-fast-install flag
+# Usage: AC_ENABLE_FAST_INSTALL[(DEFAULT)]
+# Where DEFAULT is either `yes' or `no'. If omitted, it defaults to
+# `yes'.
+AC_DEFUN([AC_ENABLE_FAST_INSTALL],
+[define([AC_ENABLE_FAST_INSTALL_DEFAULT], ifelse($1, no, no, yes))dnl
+AC_ARG_ENABLE(fast-install,
+changequote(<<, >>)dnl
+<< --enable-fast-install[=PKGS] optimize for fast installation [default=>>AC_ENABLE_FAST_INSTALL_DEFAULT],
+changequote([, ])dnl
+[p=${PACKAGE-default}
+case $enableval in
+yes) enable_fast_install=yes ;;
+no) enable_fast_install=no ;;
+*)
+ enable_fast_install=no
+ # Look at the argument we got. We use all the common list separators.
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
+ for pkg in $enableval; do
+ if test "X$pkg" = "X$p"; then
+ enable_fast_install=yes
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac],
+enable_fast_install=AC_ENABLE_FAST_INSTALL_DEFAULT)dnl
+])
+
+# AC_DISABLE_FAST_INSTALL - set the default to --disable-fast-install
+AC_DEFUN([AC_DISABLE_FAST_INSTALL],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+AC_ENABLE_FAST_INSTALL(no)])
+
+# AC_LIBTOOL_PICMODE - implement the --with-pic flag
+# Usage: AC_LIBTOOL_PICMODE[(MODE)]
+# Where MODE is either `yes' or `no'. If omitted, it defaults to
+# `both'.
+AC_DEFUN([AC_LIBTOOL_PICMODE],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+pic_mode=ifelse($#,1,$1,default)])
+
+
+# AC_PATH_TOOL_PREFIX - find a file program which can recognise shared library
+AC_DEFUN([AC_PATH_TOOL_PREFIX],
+[AC_MSG_CHECKING([for $1])
+AC_CACHE_VAL(lt_cv_path_MAGIC_CMD,
+[case $MAGIC_CMD in
+ /*)
+ lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a dos path.
+ ;;
+ *)
+ ac_save_MAGIC_CMD="$MAGIC_CMD"
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+dnl $ac_dummy forces splitting on constant user-supplied paths.
+dnl POSIX.2 word splitting is done only on the output of word expansions,
+dnl not every word. This closes a longstanding sh security hole.
+ ac_dummy="ifelse([$2], , $PATH, [$2])"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$1; then
+ lt_cv_path_MAGIC_CMD="$ac_dir/$1"
+ if test -n "$file_magic_test_file"; then
+ case $deplibs_check_method in
+ "file_magic "*)
+ file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
+ MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+ if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
+ egrep "$file_magic_regex" > /dev/null; then
+ :
+ else
+ cat <<EOF 1>&2
+
+*** Warning: the command libtool uses to detect shared libraries,
+*** $file_magic_cmd, produces output that libtool cannot recognize.
+*** The result is that libtool may fail to recognize shared libraries
+*** as such. This will affect the creation of libtool libraries that
+*** depend on shared libraries, but programs linked with such libtool
+*** libraries will work regardless of this problem. Nevertheless, you
+*** may want to report the problem to your system manager and/or to
+*** bug-libtool@gnu.org
+
+EOF
+ fi ;;
+ esac
+ fi
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ MAGIC_CMD="$ac_save_MAGIC_CMD"
+ ;;
+esac])
+MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
+if test -n "$MAGIC_CMD"; then
+ AC_MSG_RESULT($MAGIC_CMD)
+else
+ AC_MSG_RESULT(no)
+fi
+])
+
+
+# AC_PATH_MAGIC - find a file program which can recognise a shared library
+AC_DEFUN([AC_PATH_MAGIC],
+[AC_REQUIRE([AC_CHECK_TOOL_PREFIX])dnl
+AC_PATH_TOOL_PREFIX(${ac_tool_prefix}file, /usr/bin:$PATH)
+if test -z "$lt_cv_path_MAGIC_CMD"; then
+ if test -n "$ac_tool_prefix"; then
+ AC_PATH_TOOL_PREFIX(file, /usr/bin:$PATH)
+ else
+ MAGIC_CMD=:
+ fi
+fi
+])
+
+
+# AC_PROG_LD - find the path to the GNU or non-GNU linker
+AC_DEFUN([AC_PROG_LD],
+[AC_ARG_WITH(gnu-ld,
+[ --with-gnu-ld assume the C compiler uses GNU ld [default=no]],
+test "$withval" = no || with_gnu_ld=yes, with_gnu_ld=no)
+AC_REQUIRE([AC_PROG_CC])dnl
+AC_REQUIRE([AC_CANONICAL_HOST])dnl
+AC_REQUIRE([AC_CANONICAL_BUILD])dnl
+AC_REQUIRE([_LT_AC_LIBTOOL_SYS_PATH_SEPARATOR])dnl
+ac_prog=ld
+if test "$GCC" = yes; then
+ # Check if gcc -print-prog-name=ld gives a path.
+ AC_MSG_CHECKING([for ld used by GCC])
+ case $host in
+ *-*-mingw*)
+ # gcc leaves a trailing carriage return which upsets mingw
+ ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
+ *)
+ ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
+ esac
+ case $ac_prog in
+ # Accept absolute paths.
+ [[\\/]]* | [[A-Za-z]]:[[\\/]]*)
+ re_direlt='/[[^/]][[^/]]*/\.\./'
+ # Canonicalize the path of ld
+ ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
+ while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
+ ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
+ done
+ test -z "$LD" && LD="$ac_prog"
+ ;;
+ "")
+ # If it fails, then pretend we aren't using GCC.
+ ac_prog=ld
+ ;;
+ *)
+ # If it is relative, then search for the first ld in PATH.
+ with_gnu_ld=unknown
+ ;;
+ esac
+elif test "$with_gnu_ld" = yes; then
+ AC_MSG_CHECKING([for GNU ld])
+else
+ AC_MSG_CHECKING([for non-GNU ld])
+fi
+AC_CACHE_VAL(lt_cv_path_LD,
+[if test -z "$LD"; then
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
+ lt_cv_path_LD="$ac_dir/$ac_prog"
+ # Check to see if the program is GNU ld. I'd rather use --version,
+ # but apparently some GNU ld's only accept -v.
+ # Break only if it was the GNU/non-GNU ld that we prefer.
+ if "$lt_cv_path_LD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then
+ test "$with_gnu_ld" != no && break
+ else
+ test "$with_gnu_ld" != yes && break
+ fi
+ fi
+ done
+ IFS="$ac_save_ifs"
+else
+ lt_cv_path_LD="$LD" # Let the user override the test with a path.
+fi])
+LD="$lt_cv_path_LD"
+if test -n "$LD"; then
+ AC_MSG_RESULT($LD)
+else
+ AC_MSG_RESULT(no)
+fi
+test -z "$LD" && AC_MSG_ERROR([no acceptable ld found in \$PATH])
+AC_PROG_LD_GNU
+])
+
+# AC_PROG_LD_GNU -
+AC_DEFUN([AC_PROG_LD_GNU],
+[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], lt_cv_prog_gnu_ld,
+[# I'd rather use --version here, but apparently some GNU ld's only accept -v.
+if $LD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then
+ lt_cv_prog_gnu_ld=yes
+else
+ lt_cv_prog_gnu_ld=no
+fi])
+with_gnu_ld=$lt_cv_prog_gnu_ld
+])
+
+# AC_PROG_LD_RELOAD_FLAG - find reload flag for linker
+# -- PORTME Some linkers may need a different reload flag.
+AC_DEFUN([AC_PROG_LD_RELOAD_FLAG],
+[AC_CACHE_CHECK([for $LD option to reload object files], lt_cv_ld_reload_flag,
+[lt_cv_ld_reload_flag='-r'])
+reload_flag=$lt_cv_ld_reload_flag
+test -n "$reload_flag" && reload_flag=" $reload_flag"
+])
+
+# AC_DEPLIBS_CHECK_METHOD - how to check for library dependencies
+# -- PORTME fill in with the dynamic library characteristics
+AC_DEFUN([AC_DEPLIBS_CHECK_METHOD],
+[AC_CACHE_CHECK([how to recognise dependant libraries],
+lt_cv_deplibs_check_method,
+[lt_cv_file_magic_cmd='$MAGIC_CMD'
+lt_cv_file_magic_test_file=
+lt_cv_deplibs_check_method='unknown'
+# Need to set the preceding variable on all platforms that support
+# interlibrary dependencies.
+# 'none' -- dependencies not supported.
+# `unknown' -- same as none, but documents that we really don't know.
+# 'pass_all' -- all dependencies passed with no checks.
+# 'test_compile' -- check by making test program.
+# 'file_magic [[regex]]' -- check by looking for files in library path
+# which responds to the $file_magic_cmd with a given egrep regex.
+# If you have `file' or equivalent on your system and you're not sure
+# whether `pass_all' will *always* work, you probably want this one.
+
+case $host_os in
+aix4* | aix5*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+beos*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+bsdi4*)
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib)'
+ lt_cv_file_magic_cmd='/usr/bin/file -L'
+ lt_cv_file_magic_test_file=/shlib/libc.so
+ ;;
+
+cygwin* | mingw* | pw32*)
+ lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?'
+ lt_cv_file_magic_cmd='$OBJDUMP -f'
+ ;;
+
+darwin* | rhapsody*)
+ lt_cv_deplibs_check_method='file_magic Mach-O dynamically linked shared library'
+ lt_cv_file_magic_cmd='/usr/bin/file -L'
+ case "$host_os" in
+ rhapsody* | darwin1.[[012]])
+ lt_cv_file_magic_test_file=`echo /System/Library/Frameworks/System.framework/Versions/*/System | head -1`
+ ;;
+ *) # Darwin 1.3 on
+ lt_cv_file_magic_test_file='/usr/lib/libSystem.dylib'
+ ;;
+ esac
+ ;;
+
+freebsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ > /dev/null; then
+ case $host_cpu in
+ i*86 )
+ # Not sure whether the presence of OpenBSD here was a mistake.
+ # Let's accept both of them until this is cleared up.
+ lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD)/i[[3-9]]86 (compact )?demand paged shared library'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+ ;;
+ esac
+ else
+ lt_cv_deplibs_check_method=pass_all
+ fi
+ ;;
+
+gnu*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+hpux10.20*|hpux11*)
+ lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|PA-RISC[[0-9]].[[0-9]]) shared library'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=/usr/lib/libc.sl
+ ;;
+
+irix5* | irix6*)
+ case $host_os in
+ irix5*)
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method="file_magic ELF 32-bit MSB dynamic lib MIPS - version 1"
+ ;;
+ *)
+ case $LD in
+ *-32|*"-32 ") libmagic=32-bit;;
+ *-n32|*"-n32 ") libmagic=N32;;
+ *-64|*"-64 ") libmagic=64-bit;;
+ *) libmagic=never-match;;
+ esac
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method="file_magic ELF ${libmagic} MSB mips-[[1234]] dynamic lib MIPS - version 1"
+ ;;
+ esac
+ lt_cv_file_magic_test_file=`echo /lib${libsuff}/libc.so*`
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+# This must be Linux ELF.
+linux-gnu*)
+ case $host_cpu in
+ alpha* | hppa* | i*86 | powerpc* | sparc* | ia64* )
+ lt_cv_deplibs_check_method=pass_all ;;
+ *)
+ # glibc up to 2.1.1 does not perform some relocations on ARM
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB (shared object|dynamic lib )' ;;
+ esac
+ lt_cv_file_magic_test_file=`echo /lib/libc.so* /lib/libc-*.so`
+ ;;
+
+netbsd*)
+ if echo __ELF__ | $CC -E - | grep __ELF__ > /dev/null; then
+ lt_cv_deplibs_check_method='match_pattern /lib[[^/\.]]+\.so\.[[0-9]]+\.[[0-9]]+$'
+ else
+ lt_cv_deplibs_check_method='match_pattern /lib[[^/\.]]+\.so$'
+ fi
+ ;;
+
+newos6*)
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (executable|dynamic lib)'
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=/usr/lib/libnls.so
+ ;;
+
+openbsd*)
+ lt_cv_file_magic_cmd=/usr/bin/file
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
+ if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB shared object'
+ else
+ lt_cv_deplibs_check_method='file_magic OpenBSD.* shared library'
+ fi
+ ;;
+
+osf3* | osf4* | osf5*)
+ # this will be overridden with pass_all, but let us keep it just in case
+ lt_cv_deplibs_check_method='file_magic COFF format alpha shared library'
+ lt_cv_file_magic_test_file=/shlib/libc.so
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+sco3.2v5*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+solaris*)
+ lt_cv_deplibs_check_method=pass_all
+ lt_cv_file_magic_test_file=/lib/libc.so
+ ;;
+
+sysv5uw[[78]]* | sysv4*uw2*)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+
+sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
+ case $host_vendor in
+ motorola)
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib) M[[0-9]][[0-9]]* Version [[0-9]]'
+ lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
+ ;;
+ ncr)
+ lt_cv_deplibs_check_method=pass_all
+ ;;
+ sequent)
+ lt_cv_file_magic_cmd='/bin/file'
+ lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB (shared object|dynamic lib )'
+ ;;
+ sni)
+ lt_cv_file_magic_cmd='/bin/file'
+ lt_cv_deplibs_check_method="file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB dynamic lib"
+ lt_cv_file_magic_test_file=/lib/libc.so
+ ;;
+ esac
+ ;;
+esac
+])
+file_magic_cmd=$lt_cv_file_magic_cmd
+deplibs_check_method=$lt_cv_deplibs_check_method
+])
+
+
+# AC_PROG_NM - find the path to a BSD-compatible name lister
+AC_DEFUN([AC_PROG_NM],
+[AC_REQUIRE([_LT_AC_LIBTOOL_SYS_PATH_SEPARATOR])dnl
+AC_MSG_CHECKING([for BSD-compatible nm])
+AC_CACHE_VAL(lt_cv_path_NM,
+[if test -n "$NM"; then
+ # Let the user override the test.
+ lt_cv_path_NM="$NM"
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
+ for ac_dir in $PATH /usr/ccs/bin /usr/ucb /bin; do
+ test -z "$ac_dir" && ac_dir=.
+ tmp_nm=$ac_dir/${ac_tool_prefix}nm
+ if test -f $tmp_nm || test -f $tmp_nm$ac_exeext ; then
+ # Check to see if the nm accepts a BSD-compat flag.
+ # Adding the `sed 1q' prevents false positives on HP-UX, which says:
+ # nm: unknown option "B" ignored
+ # Tru64's nm complains that /dev/null is an invalid object file
+ if ($tmp_nm -B /dev/null 2>&1 | sed '1q'; exit 0) | egrep '(/dev/null|Invalid file or object type)' >/dev/null; then
+ lt_cv_path_NM="$tmp_nm -B"
+ break
+ elif ($tmp_nm -p /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then
+ lt_cv_path_NM="$tmp_nm -p"
+ break
+ else
+ lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
+ continue # so that we can try to find one that supports BSD flags
+ fi
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$lt_cv_path_NM" && lt_cv_path_NM=nm
+fi])
+NM="$lt_cv_path_NM"
+AC_MSG_RESULT([$NM])
+])
+
+# AC_CHECK_LIBM - check for math library
+AC_DEFUN([AC_CHECK_LIBM],
+[AC_REQUIRE([AC_CANONICAL_HOST])dnl
+LIBM=
+case $host in
+*-*-beos* | *-*-cygwin* | *-*-pw32*)
+ # These system don't have libm
+ ;;
+*-ncr-sysv4.3*)
+ AC_CHECK_LIB(mw, _mwvalidcheckl, LIBM="-lmw")
+ AC_CHECK_LIB(m, main, LIBM="$LIBM -lm")
+ ;;
+*)
+ AC_CHECK_LIB(m, main, LIBM="-lm")
+ ;;
+esac
+])
+
+# AC_LIBLTDL_CONVENIENCE[(dir)] - sets LIBLTDL to the link flags for
+# the libltdl convenience library and INCLTDL to the include flags for
+# the libltdl header and adds --enable-ltdl-convenience to the
+# configure arguments. Note that LIBLTDL and INCLTDL are not
+# AC_SUBSTed, nor is AC_CONFIG_SUBDIRS called. If DIR is not
+# provided, it is assumed to be `libltdl'. LIBLTDL will be prefixed
+# with '${top_builddir}/' and INCLTDL will be prefixed with
+# '${top_srcdir}/' (note the single quotes!). If your package is not
+# flat and you're not using automake, define top_builddir and
+# top_srcdir appropriately in the Makefiles.
+AC_DEFUN([AC_LIBLTDL_CONVENIENCE],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+ case $enable_ltdl_convenience in
+ no) AC_MSG_ERROR([this package needs a convenience libltdl]) ;;
+ "") enable_ltdl_convenience=yes
+ ac_configure_args="$ac_configure_args --enable-ltdl-convenience" ;;
+ esac
+ LIBLTDL='${top_builddir}/'ifelse($#,1,[$1],['libltdl'])/libltdlc.la
+ INCLTDL='-I${top_srcdir}/'ifelse($#,1,[$1],['libltdl'])
+])
+
+# AC_LIBLTDL_INSTALLABLE[(dir)] - sets LIBLTDL to the link flags for
+# the libltdl installable library and INCLTDL to the include flags for
+# the libltdl header and adds --enable-ltdl-install to the configure
+# arguments. Note that LIBLTDL and INCLTDL are not AC_SUBSTed, nor is
+# AC_CONFIG_SUBDIRS called. If DIR is not provided and an installed
+# libltdl is not found, it is assumed to be `libltdl'. LIBLTDL will
+# be prefixed with '${top_builddir}/' and INCLTDL will be prefixed
+# with '${top_srcdir}/' (note the single quotes!). If your package is
+# not flat and you're not using automake, define top_builddir and
+# top_srcdir appropriately in the Makefiles.
+# In the future, this macro may have to be called after AC_PROG_LIBTOOL.
+AC_DEFUN([AC_LIBLTDL_INSTALLABLE],
+[AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
+ AC_CHECK_LIB(ltdl, main,
+ [test x"$enable_ltdl_install" != xyes && enable_ltdl_install=no],
+ [if test x"$enable_ltdl_install" = xno; then
+ AC_MSG_WARN([libltdl not installed, but installation disabled])
+ else
+ enable_ltdl_install=yes
+ fi
+ ])
+ if test x"$enable_ltdl_install" = x"yes"; then
+ ac_configure_args="$ac_configure_args --enable-ltdl-install"
+ LIBLTDL='${top_builddir}/'ifelse($#,1,[$1],['libltdl'])/libltdl.la
+ INCLTDL='-I${top_srcdir}/'ifelse($#,1,[$1],['libltdl'])
+ else
+ ac_configure_args="$ac_configure_args --enable-ltdl-install=no"
+ LIBLTDL="-lltdl"
+ INCLTDL=
+ fi
+])
+
+# old names
+AC_DEFUN([AM_PROG_LIBTOOL], [AC_PROG_LIBTOOL])
+AC_DEFUN([AM_ENABLE_SHARED], [AC_ENABLE_SHARED($@)])
+AC_DEFUN([AM_ENABLE_STATIC], [AC_ENABLE_STATIC($@)])
+AC_DEFUN([AM_DISABLE_SHARED], [AC_DISABLE_SHARED($@)])
+AC_DEFUN([AM_DISABLE_STATIC], [AC_DISABLE_STATIC($@)])
+AC_DEFUN([AM_PROG_LD], [AC_PROG_LD])
+AC_DEFUN([AM_PROG_NM], [AC_PROG_NM])
+
+# This is just to silence aclocal about the macro not being used
+ifelse([AC_DISABLE_FAST_INSTALL])
--- /dev/null
+/*
+ * Copyright (c) 1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1998 by Fergus Henderson. All rights reserved.
+ * Copyright (c) 2000-2001 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Support code for LinuxThreads, the clone()-based kernel
+ * thread package for Linux which is included in libc6.
+ *
+ * This code relies on implementation details of LinuxThreads,
+ * (i.e. properties not guaranteed by the Pthread standard),
+ * though this version now does less of that than the other Pthreads
+ * support code.
+ *
+ * Note that there is a lot of code duplication between linux_threads.c
+ * and thread support for some of the other Posix platforms; any changes
+ * made here may need to be reflected there too.
+ */
+ /* DG/UX ix86 support <takis@xfree86.org> */
+/*
+ * Linux_threads.c now also includes some code to support HPUX and
+ * OSF1 (Compaq Tru64 Unix, really). The OSF1 support is not yet
+ * functional. The OSF1 code is based on Eric Benson's
+ * patch, though that was originally against hpux_irix_threads. The code
+ * here is completely untested. With 0.0000001% probability, it might
+ * actually work.
+ *
+ * Eric also suggested an alternate basis for a lock implementation in
+ * his code:
+ * + #elif defined(OSF1)
+ * + unsigned long GC_allocate_lock = 0;
+ * + msemaphore GC_allocate_semaphore;
+ * + # define GC_TRY_LOCK() \
+ * + ((msem_lock(&GC_allocate_semaphore, MSEM_IF_NOWAIT) == 0) \
+ * + ? (GC_allocate_lock = 1) \
+ * + : 0)
+ * + # define GC_LOCK_TAKEN GC_allocate_lock
+ */
+
+/* #define DEBUG_THREADS 1 */
+
+/* ANSI C requires that a compilation unit contains something */
+
+# include "gc.h"
+
+# if defined(GC_PTHREADS) && !defined(GC_SOLARIS_THREADS) \
+ && !defined(GC_IRIX_THREADS) && !defined(GC_WIN32_THREADS)
+
+# include "private/gc_priv.h"
+
+# if defined(GC_HPUX_THREADS) && !defined(USE_PTHREAD_SPECIFIC) \
+ && !defined(USE_HPUX_TLS)
+# define USE_HPUX_TLS
+# endif
+
+# if (defined(GC_DGUX386_THREADS) || defined(GC_OSF1_THREADS)) \
+ && !defined(USE_PTHREAD_SPECIFIC)
+# define USE_PTHREAD_SPECIFIC
+# endif
+
+# if defined(GC_DGUX386_THREADS) && !defined(_POSIX4A_DRAFT10_SOURCE)
+# define _POSIX4A_DRAFT10_SOURCE 1
+# endif
+
+# if defined(GC_DGUX386_THREADS) && !defined(_USING_POSIX4A_DRAFT10)
+# define _USING_POSIX4A_DRAFT10 1
+# endif
+
+# ifdef THREAD_LOCAL_ALLOC
+# if !defined(USE_PTHREAD_SPECIFIC) && !defined(USE_HPUX_TLS)
+# include "private/specific.h"
+# endif
+# if defined(USE_PTHREAD_SPECIFIC)
+# define GC_getspecific pthread_getspecific
+# define GC_setspecific pthread_setspecific
+# define GC_key_create pthread_key_create
+ typedef pthread_key_t GC_key_t;
+# endif
+# if defined(USE_HPUX_TLS)
+# define GC_getspecific(x) (x)
+# define GC_setspecific(key, v) ((key) = (v), 0)
+# define GC_key_create(key, d) 0
+ typedef void * GC_key_t;
+# endif
+# endif
+# include <stdlib.h>
+# include <pthread.h>
+# include <sched.h>
+# include <time.h>
+# include <errno.h>
+# include <unistd.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+# include <semaphore.h>
+# include <signal.h>
+# include <sys/types.h>
+# include <sys/stat.h>
+# include <fcntl.h>
+
+#if defined(GC_MACOSX_THREADS)
+# include <sys/sysctl.h>
+#endif /* GC_MACOSX_THREADS */
+
+#if defined(GC_DGUX386_THREADS)
+# include <sys/dg_sys_info.h>
+# include <sys/_int_psem.h>
+ /* sem_t is an uint in DG/UX */
+ typedef unsigned int sem_t;
+#endif /* GC_DGUX386_THREADS */
+
+#ifndef __GNUC__
+# define __inline__
+#endif
+
+#ifdef GC_USE_LD_WRAP
+# define WRAP_FUNC(f) __wrap_##f
+# define REAL_FUNC(f) __real_##f
+#else
+# define WRAP_FUNC(f) GC_##f
+# if !defined(GC_DGUX386_THREADS)
+# define REAL_FUNC(f) f
+# else /* GC_DGUX386_THREADS */
+# define REAL_FUNC(f) __d10_##f
+# endif /* GC_DGUX386_THREADS */
+# undef pthread_create
+# undef pthread_sigmask
+# undef pthread_join
+# undef pthread_detach
+#endif
+
+
+void GC_thr_init();
+
+#if DEBUG_THREADS
+
+#ifndef NSIG
+# if defined(MAXSIG)
+# define NSIG (MAXSIG+1)
+# elif defined(_NSIG)
+# define NSIG _NSIG
+# elif defined(__SIGRTMAX)
+# define NSIG (__SIGRTMAX+1)
+# else
+ --> please fix it
+# endif
+#endif
+
+void GC_print_sig_mask()
+{
+ sigset_t blocked;
+ int i;
+
+ if (pthread_sigmask(SIG_BLOCK, NULL, &blocked) != 0)
+ ABORT("pthread_sigmask");
+ GC_printf0("Blocked: ");
+ for (i = 1; i < NSIG; i++) {
+ if (sigismember(&blocked, i)) { GC_printf1("%ld ",(long) i); }
+ }
+ GC_printf0("\n");
+}
+#endif
+
+word GC_stop_count; /* Incremented at the beginning of GC_stop_world. */
+
+#ifdef GC_OSF1_THREADS
+ GC_bool GC_retry_signals = TRUE;
+#else
+ GC_bool GC_retry_signals = FALSE;
+#endif
+
+/* We use the allocation lock to protect thread-related data structures. */
+
+/* The set of all known threads. We intercept thread creation and */
+/* joins. */
+/* Protected by allocation/GC lock. */
+/* Some of this should be declared volatile, but that's inconsistent */
+/* with some library routine declarations. */
+typedef struct GC_Thread_Rep {
+ struct GC_Thread_Rep * next; /* More recently allocated threads */
+ /* with a given pthread id come */
+ /* first. (All but the first are */
+ /* guaranteed to be dead, but we may */
+ /* not yet have registered the join.) */
+ pthread_t id;
+ short flags;
+# define FINISHED 1 /* Thread has exited. */
+# define DETACHED 2 /* Thread is intended to be detached. */
+# define MAIN_THREAD 4 /* True for the original thread only. */
+ short thread_blocked; /* Protected by GC lock. */
+ /* Treated as a boolean value. If set, */
+ /* thread will acquire GC lock before */
+ /* doing any pointer manipulations, and */
+ /* has set its sp value. Thus it does */
+ /* not need to be sent a signal to stop */
+ /* it. */
+ ptr_t stack_end; /* Cold end of the stack. */
+ ptr_t stack_ptr; /* Valid only when stopped. */
+# ifdef IA64
+ ptr_t backing_store_end;
+ ptr_t backing_store_ptr;
+# endif
+ int signal;
+ void * status; /* The value returned from the thread. */
+ /* Used only to avoid premature */
+ /* reclamation of any data it might */
+ /* reference. */
+ word last_stop_count; /* GC_last_stop_count value when thread */
+ /* last successfully handled a suspend */
+ /* signal. */
+# ifdef THREAD_LOCAL_ALLOC
+# if CPP_WORDSZ == 64 && defined(ALIGN_DOUBLE)
+# define GRANULARITY 16
+# define NFREELISTS 49
+# else
+# define GRANULARITY 8
+# define NFREELISTS 65
+# endif
+ /* The ith free list corresponds to size i*GRANULARITY */
+# define INDEX_FROM_BYTES(n) ((ADD_SLOP(n) + GRANULARITY - 1)/GRANULARITY)
+# define BYTES_FROM_INDEX(i) ((i) * GRANULARITY - EXTRA_BYTES)
+# define SMALL_ENOUGH(bytes) (ADD_SLOP(bytes) <= \
+ (NFREELISTS-1)*GRANULARITY)
+ ptr_t ptrfree_freelists[NFREELISTS];
+ ptr_t normal_freelists[NFREELISTS];
+# ifdef GC_GCJ_SUPPORT
+ ptr_t gcj_freelists[NFREELISTS];
+# endif
+ /* Free lists contain either a pointer or a small count */
+ /* reflecting the number of granules allocated at that */
+ /* size. */
+ /* 0 ==> thread-local allocation in use, free list */
+ /* empty. */
+ /* > 0, <= DIRECT_GRANULES ==> Using global allocation, */
+ /* too few objects of this size have been */
+ /* allocated by this thread. */
+ /* >= HBLKSIZE => pointer to nonempty free list. */
+ /* > DIRECT_GRANULES, < HBLKSIZE ==> transition to */
+ /* local alloc, equivalent to 0. */
+# define DIRECT_GRANULES (HBLKSIZE/GRANULARITY)
+ /* Don't use local free lists for up to this much */
+ /* allocation. */
+# endif
+} * GC_thread;
+
+GC_thread GC_lookup_thread(pthread_t id);
+
+static GC_bool parallel_initialized = FALSE;
+
+void GC_init_parallel();
+
+# if defined(THREAD_LOCAL_ALLOC) && !defined(DBG_HDRS_ALL)
+
+/* We don't really support thread-local allocation with DBG_HDRS_ALL */
+
+#ifdef USE_HPUX_TLS
+ __thread
+#endif
+GC_key_t GC_thread_key;
+
+static GC_bool keys_initialized;
+
+/* Recover the contents of the freelist array fl into the global one gfl.*/
+/* Note that the indexing scheme differs, in that gfl has finer size */
+/* resolution, even if not all entries are used. */
+/* We hold the allocator lock. */
+static void return_freelists(ptr_t *fl, ptr_t *gfl)
+{
+ int i;
+ ptr_t q, *qptr;
+ size_t nwords;
+
+ for (i = 1; i < NFREELISTS; ++i) {
+ nwords = i * (GRANULARITY/sizeof(word));
+ qptr = fl + i;
+ q = *qptr;
+ if ((word)q >= HBLKSIZE) {
+ if (gfl[nwords] == 0) {
+ gfl[nwords] = q;
+ } else {
+ /* Concatenate: */
+ for (; (word)q >= HBLKSIZE; qptr = &(obj_link(q)), q = *qptr);
+ GC_ASSERT(0 == q);
+ *qptr = gfl[nwords];
+ gfl[nwords] = fl[i];
+ }
+ }
+ /* Clear fl[i], since the thread structure may hang around. */
+ /* Do it in a way that is likely to trap if we access it. */
+ fl[i] = (ptr_t)HBLKSIZE;
+ }
+}
+
+/* We statically allocate a single "size 0" object. It is linked to */
+/* itself, and is thus repeatedly reused for all size 0 allocation */
+/* requests. (Size 0 gcj allocation requests are incorrect, and */
+/* we arrange for those to fault asap.) */
+static ptr_t size_zero_object = (ptr_t)(&size_zero_object);
+
+/* Each thread structure must be initialized. */
+/* This call must be made from the new thread. */
+/* Caller holds allocation lock. */
+void GC_init_thread_local(GC_thread p)
+{
+ int i;
+
+ if (!keys_initialized) {
+ if (0 != GC_key_create(&GC_thread_key, 0)) {
+ ABORT("Failed to create key for local allocator");
+ }
+ keys_initialized = TRUE;
+ }
+ if (0 != GC_setspecific(GC_thread_key, p)) {
+ ABORT("Failed to set thread specific allocation pointers");
+ }
+ for (i = 1; i < NFREELISTS; ++i) {
+ p -> ptrfree_freelists[i] = (ptr_t)1;
+ p -> normal_freelists[i] = (ptr_t)1;
+# ifdef GC_GCJ_SUPPORT
+ p -> gcj_freelists[i] = (ptr_t)1;
+# endif
+ }
+ /* Set up the size 0 free lists. */
+ p -> ptrfree_freelists[0] = (ptr_t)(&size_zero_object);
+ p -> normal_freelists[0] = (ptr_t)(&size_zero_object);
+# ifdef GC_GCJ_SUPPORT
+ p -> gcj_freelists[0] = (ptr_t)(-1);
+# endif
+}
+
+#ifdef GC_GCJ_SUPPORT
+ extern ptr_t * GC_gcjobjfreelist;
+#endif
+
+/* We hold the allocator lock. */
+void GC_destroy_thread_local(GC_thread p)
+{
+ /* We currently only do this from the thread itself or from */
+ /* the fork handler for a child process. */
+# ifndef HANDLE_FORK
+ GC_ASSERT(GC_getspecific(GC_thread_key) == (void *)p);
+# endif
+ return_freelists(p -> ptrfree_freelists, GC_aobjfreelist);
+ return_freelists(p -> normal_freelists, GC_objfreelist);
+# ifdef GC_GCJ_SUPPORT
+ return_freelists(p -> gcj_freelists, GC_gcjobjfreelist);
+# endif
+}
+
+extern GC_PTR GC_generic_malloc_many();
+
+GC_PTR GC_local_malloc(size_t bytes)
+{
+ if (EXPECT(!SMALL_ENOUGH(bytes),0)) {
+ return(GC_malloc(bytes));
+ } else {
+ int index = INDEX_FROM_BYTES(bytes);
+ ptr_t * my_fl;
+ ptr_t my_entry;
+ GC_key_t k = GC_thread_key;
+ void * tsd;
+
+# if defined(REDIRECT_MALLOC) && !defined(USE_PTHREAD_SPECIFIC)
+ if (EXPECT(0 == k, 0)) {
+ /* This can happen if we get called when the world is */
+ /* being initialized. Whether we can actually complete */
+ /* the initialization then is unclear. */
+ GC_init_parallel();
+ k = GC_thread_key;
+ }
+# endif
+ tsd = GC_getspecific(GC_thread_key);
+# ifdef GC_ASSERTIONS
+ LOCK();
+ GC_ASSERT(tsd == (void *)GC_lookup_thread(pthread_self()));
+ UNLOCK();
+# endif
+ my_fl = ((GC_thread)tsd) -> normal_freelists + index;
+ my_entry = *my_fl;
+ if (EXPECT((word)my_entry >= HBLKSIZE, 1)) {
+ ptr_t next = obj_link(my_entry);
+ GC_PTR result = (GC_PTR)my_entry;
+ *my_fl = next;
+ obj_link(my_entry) = 0;
+ PREFETCH_FOR_WRITE(next);
+ return result;
+ } else if ((word)my_entry - 1 < DIRECT_GRANULES) {
+ *my_fl = my_entry + index + 1;
+ return GC_malloc(bytes);
+ } else {
+ GC_generic_malloc_many(BYTES_FROM_INDEX(index), NORMAL, my_fl);
+ if (*my_fl == 0) return GC_oom_fn(bytes);
+ return GC_local_malloc(bytes);
+ }
+ }
+}
+
+GC_PTR GC_local_malloc_atomic(size_t bytes)
+{
+ if (EXPECT(!SMALL_ENOUGH(bytes), 0)) {
+ return(GC_malloc_atomic(bytes));
+ } else {
+ int index = INDEX_FROM_BYTES(bytes);
+ ptr_t * my_fl = ((GC_thread)GC_getspecific(GC_thread_key))
+ -> ptrfree_freelists + index;
+ ptr_t my_entry = *my_fl;
+ if (EXPECT((word)my_entry >= HBLKSIZE, 1)) {
+ GC_PTR result = (GC_PTR)my_entry;
+ *my_fl = obj_link(my_entry);
+ return result;
+ } else if ((word)my_entry - 1 < DIRECT_GRANULES) {
+ *my_fl = my_entry + index + 1;
+ return GC_malloc_atomic(bytes);
+ } else {
+ GC_generic_malloc_many(BYTES_FROM_INDEX(index), PTRFREE, my_fl);
+ /* *my_fl is updated while the collector is excluded; */
+ /* the free list is always visible to the collector as */
+ /* such. */
+ if (*my_fl == 0) return GC_oom_fn(bytes);
+ return GC_local_malloc_atomic(bytes);
+ }
+ }
+}
+
+#ifdef GC_GCJ_SUPPORT
+
+#include "include/gc_gcj.h"
+
+#ifdef GC_ASSERTIONS
+ extern GC_bool GC_gcj_malloc_initialized;
+#endif
+
+extern int GC_gcj_kind;
+
+GC_PTR GC_local_gcj_malloc(size_t bytes,
+ void * ptr_to_struct_containing_descr)
+{
+ GC_ASSERT(GC_gcj_malloc_initialized);
+ if (EXPECT(!SMALL_ENOUGH(bytes), 0)) {
+ return GC_gcj_malloc(bytes, ptr_to_struct_containing_descr);
+ } else {
+ int index = INDEX_FROM_BYTES(bytes);
+ ptr_t * my_fl = ((GC_thread)GC_getspecific(GC_thread_key))
+ -> gcj_freelists + index;
+ ptr_t my_entry = *my_fl;
+ if (EXPECT((word)my_entry >= HBLKSIZE, 1)) {
+ GC_PTR result = (GC_PTR)my_entry;
+ GC_ASSERT(!GC_incremental);
+ /* We assert that any concurrent marker will stop us. */
+ /* Thus it is impossible for a mark procedure to see the */
+ /* allocation of the next object, but to see this object */
+ /* still containing a free list pointer. Otherwise the */
+ /* marker might find a random "mark descriptor". */
+ *(volatile ptr_t *)my_fl = obj_link(my_entry);
+ /* We must update the freelist before we store the pointer. */
+ /* Otherwise a GC at this point would see a corrupted */
+ /* free list. */
+ /* A memory barrier is probably never needed, since the */
+ /* action of stopping this thread will cause prior writes */
+ /* to complete. */
+ GC_ASSERT(((void * volatile *)result)[1] == 0);
+ *(void * volatile *)result = ptr_to_struct_containing_descr;
+ return result;
+ } else if ((word)my_entry - 1 < DIRECT_GRANULES) {
+ if (!GC_incremental) *my_fl = my_entry + index + 1;
+ /* In the incremental case, we always have to take this */
+ /* path. Thus we leave the counter alone. */
+ return GC_gcj_malloc(bytes, ptr_to_struct_containing_descr);
+ } else {
+ GC_generic_malloc_many(BYTES_FROM_INDEX(index), GC_gcj_kind, my_fl);
+ if (*my_fl == 0) return GC_oom_fn(bytes);
+ return GC_local_gcj_malloc(bytes, ptr_to_struct_containing_descr);
+ }
+ }
+}
+
+#endif /* GC_GCJ_SUPPORT */
+
+# else /* !THREAD_LOCAL_ALLOC && !DBG_HDRS_ALL */
+
+# define GC_destroy_thread_local(t)
+
+# endif /* !THREAD_LOCAL_ALLOC */
+
+/*
+ * We use signals to stop threads during GC.
+ *
+ * Suspended threads wait in signal handler for SIG_THR_RESTART.
+ * That's more portable than semaphores or condition variables.
+ * (We do use sem_post from a signal handler, but that should be portable.)
+ *
+ * The thread suspension signal SIG_SUSPEND is now defined in gc_priv.h.
+ * Note that we can't just stop a thread; we need it to save its stack
+ * pointer(s) and acknowledge.
+ */
+
+#ifndef SIG_THR_RESTART
+# if defined(GC_HPUX_THREADS) || defined(GC_OSF1_THREADS)
+# ifdef _SIGRTMIN
+# define SIG_THR_RESTART _SIGRTMIN + 5
+# else
+# define SIG_THR_RESTART SIGRTMIN + 5
+# endif
+# else
+# define SIG_THR_RESTART SIGXCPU
+# endif
+#endif
+
+#ifdef GC_MACOSX_THREADS
+# include <mach/task.h>
+# include <mach/mach_init.h>
+# include <mach/semaphore.h>
+
+ semaphore_t GC_suspend_ack_sem;
+#else
+ sem_t GC_suspend_ack_sem;
+#endif
+
+#if 0
+/*
+To make sure that we're using LinuxThreads and not some other thread
+package, we generate a dummy reference to `pthread_kill_other_threads_np'
+(was `__pthread_initial_thread_bos' but that disappeared),
+which is a symbol defined in LinuxThreads, but (hopefully) not in other
+thread packages.
+
+We no longer do this, since this code is now portable enough that it might
+actually work for something else.
+*/
+void (*dummy_var_to_force_linux_threads)() = pthread_kill_other_threads_np;
+#endif /* 0 */
+
+#if defined(SPARC) || defined(IA64)
+ extern word GC_save_regs_in_stack();
+#endif
+
+long GC_nprocs = 1; /* Number of processors. We may not have */
+ /* access to all of them, but this is as good */
+ /* a guess as any ... */
+
+#ifdef PARALLEL_MARK
+
+# ifndef MAX_MARKERS
+# define MAX_MARKERS 16
+# endif
+
+static ptr_t marker_sp[MAX_MARKERS] = {0};
+
+void * GC_mark_thread(void * id)
+{
+ word my_mark_no = 0;
+
+ marker_sp[(word)id] = GC_approx_sp();
+ for (;; ++my_mark_no) {
+ /* GC_mark_no is passed only to allow GC_help_marker to terminate */
+ /* promptly. This is important if it were called from the signal */
+ /* handler or from the GC lock acquisition code. Under Linux, it's */
+ /* not safe to call it from a signal handler, since it uses mutexes */
+ /* and condition variables. Since it is called only here, the */
+ /* argument is unnecessary. */
+ if (my_mark_no < GC_mark_no || my_mark_no > GC_mark_no + 2) {
+ /* resynchronize if we get far off, e.g. because GC_mark_no */
+ /* wrapped. */
+ my_mark_no = GC_mark_no;
+ }
+# ifdef DEBUG_THREADS
+ GC_printf1("Starting mark helper for mark number %ld\n", my_mark_no);
+# endif
+ GC_help_marker(my_mark_no);
+ }
+}
+
+extern long GC_markers; /* Number of mark threads we would */
+ /* like to have. Includes the */
+ /* initiating thread. */
+
+pthread_t GC_mark_threads[MAX_MARKERS];
+
+#define PTHREAD_CREATE REAL_FUNC(pthread_create)
+
+static void start_mark_threads()
+{
+ unsigned i;
+ pthread_attr_t attr;
+
+ if (GC_markers > MAX_MARKERS) {
+ WARN("Limiting number of mark threads\n", 0);
+ GC_markers = MAX_MARKERS;
+ }
+ if (0 != pthread_attr_init(&attr)) ABORT("pthread_attr_init failed");
+
+ if (0 != pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED))
+ ABORT("pthread_attr_setdetachstate failed");
+
+# if defined(HPUX) || defined(GC_DGUX386_THREADS)
+ /* Default stack size is usually too small: fix it. */
+ /* Otherwise marker threads or GC may run out of */
+ /* space. */
+# define MIN_STACK_SIZE (8*HBLKSIZE*sizeof(word))
+ {
+ size_t old_size;
+ int code;
+
+ if (pthread_attr_getstacksize(&attr, &old_size) != 0)
+ ABORT("pthread_attr_getstacksize failed\n");
+ if (old_size < MIN_STACK_SIZE) {
+ if (pthread_attr_setstacksize(&attr, MIN_STACK_SIZE) != 0)
+ ABORT("pthread_attr_setstacksize failed\n");
+ }
+ }
+# endif /* HPUX || GC_DGUX386_THREADS */
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Starting %ld marker threads\n", GC_markers - 1);
+ }
+# endif
+ for (i = 0; i < GC_markers - 1; ++i) {
+ if (0 != PTHREAD_CREATE(GC_mark_threads + i, &attr,
+ GC_mark_thread, (void *)(word)i)) {
+ WARN("Marker thread creation failed, errno = %ld.\n", errno);
+ }
+ }
+}
+
+#else /* !PARALLEL_MARK */
+
+static __inline__ void start_mark_threads()
+{
+}
+
+#endif /* !PARALLEL_MARK */
+
+void GC_suspend_handler(int sig)
+{
+ int dummy;
+ pthread_t my_thread = pthread_self();
+ GC_thread me;
+ sigset_t all_sigs;
+ sigset_t old_sigs;
+ int i;
+ sigset_t mask;
+# ifdef PARALLEL_MARK
+ word my_mark_no = GC_mark_no;
+ /* Marker can't proceed until we acknowledge. Thus this is */
+ /* guaranteed to be the mark_no correspending to our */
+ /* suspension, i.e. the marker can't have incremented it yet. */
+# endif
+ word my_stop_count = GC_stop_count;
+
+ if (sig != SIG_SUSPEND) ABORT("Bad signal in suspend_handler");
+
+#if DEBUG_THREADS
+ GC_printf1("Suspending 0x%lx\n", my_thread);
+#endif
+
+ me = GC_lookup_thread(my_thread);
+ /* The lookup here is safe, since I'm doing this on behalf */
+ /* of a thread which holds the allocation lock in order */
+ /* to stop the world. Thus concurrent modification of the */
+ /* data structure is impossible. */
+ if (me -> last_stop_count == my_stop_count) {
+ /* Duplicate signal. OK if we are retrying. */
+ if (!GC_retry_signals) {
+ WARN("Duplicate suspend signal in thread %lx\n",
+ pthread_self());
+ }
+ return;
+ }
+# ifdef SPARC
+ me -> stack_ptr = (ptr_t)GC_save_regs_in_stack();
+# else
+ me -> stack_ptr = (ptr_t)(&dummy);
+# endif
+# ifdef IA64
+ me -> backing_store_ptr = (ptr_t)GC_save_regs_in_stack();
+# endif
+
+ /* Tell the thread that wants to stop the world that this */
+ /* thread has been stopped. Note that sem_post() is */
+ /* the only async-signal-safe primitive in LinuxThreads. */
+# ifdef GC_MACOSX_THREADS
+ semaphore_signal(GC_suspend_ack_sem);
+# else
+ sem_post(&GC_suspend_ack_sem);
+# endif
+ me -> last_stop_count = my_stop_count;
+
+ /* Wait until that thread tells us to restart by sending */
+ /* this thread a SIG_THR_RESTART signal. */
+ /* SIG_THR_RESTART should be masked at this point. Thus there */
+ /* is no race. */
+ if (sigfillset(&mask) != 0) ABORT("sigfillset() failed");
+ if (sigdelset(&mask, SIG_THR_RESTART) != 0) ABORT("sigdelset() failed");
+# ifdef NO_SIGNALS
+ if (sigdelset(&mask, SIGINT) != 0) ABORT("sigdelset() failed");
+ if (sigdelset(&mask, SIGQUIT) != 0) ABORT("sigdelset() failed");
+ if (sigdelset(&mask, SIGTERM) != 0) ABORT("sigdelset() failed");
+ if (sigdelset(&mask, SIGABRT) != 0) ABORT("sigdelset() failed");
+# endif
+ do {
+ me->signal = 0;
+ sigsuspend(&mask); /* Wait for signal */
+ } while (me->signal != SIG_THR_RESTART);
+ /* If the RESTART signal gets lost, we can still lose. That should be */
+ /* less likely than losing the SUSPEND signal, since we don't do much */
+ /* between the sem_post and sigsuspend. */
+ /* We'd need more handshaking to work around that, since we don't want */
+ /* to accidentally leave a RESTART signal pending, thus causing us to */
+ /* continue prematurely in a future round. */
+
+#if DEBUG_THREADS
+ GC_printf1("Continuing 0x%lx\n", my_thread);
+#endif
+}
+
+void GC_restart_handler(int sig)
+{
+ GC_thread me;
+
+ if (sig != SIG_THR_RESTART) ABORT("Bad signal in suspend_handler");
+
+ /* Let the GC_suspend_handler() know that we got a SIG_THR_RESTART. */
+ /* The lookup here is safe, since I'm doing this on behalf */
+ /* of a thread which holds the allocation lock in order */
+ /* to stop the world. Thus concurrent modification of the */
+ /* data structure is impossible. */
+ me = GC_lookup_thread(pthread_self());
+ me->signal = SIG_THR_RESTART;
+
+ /*
+ ** Note: even if we didn't do anything useful here,
+ ** it would still be necessary to have a signal handler,
+ ** rather than ignoring the signals, otherwise
+ ** the signals will not be delivered at all, and
+ ** will thus not interrupt the sigsuspend() above.
+ */
+
+#if DEBUG_THREADS
+ GC_printf1("In GC_restart_handler for 0x%lx\n", pthread_self());
+#endif
+}
+
+/* Defining INSTALL_LOOPING_SEGV_HANDLER causes SIGSEGV and SIGBUS to */
+/* result in an infinite loop in a signal handler. This can be very */
+/* useful for debugging, since (as of RH7) gdb still seems to have */
+/* serious problems with threads. */
+#ifdef INSTALL_LOOPING_SEGV_HANDLER
+void GC_looping_handler(int sig)
+{
+ GC_printf3("Signal %ld in thread %lx, pid %ld\n",
+ sig, pthread_self(), getpid());
+ for (;;);
+}
+#endif
+
+GC_bool GC_thr_initialized = FALSE;
+
+# define THREAD_TABLE_SZ 128 /* Must be power of 2 */
+volatile GC_thread GC_threads[THREAD_TABLE_SZ];
+
+void GC_push_thread_structures GC_PROTO((void))
+{
+ GC_push_all((ptr_t)(GC_threads), (ptr_t)(GC_threads)+sizeof(GC_threads));
+# if defined(THREAD_LOCAL_ALLOC) && !defined(DBG_HDRS_ALL)
+ GC_push_all((ptr_t)(&GC_thread_key),
+ (ptr_t)(&GC_thread_key)+sizeof(&GC_thread_key));
+# endif
+}
+
+#ifdef THREAD_LOCAL_ALLOC
+/* We must explicitly mark ptrfree and gcj free lists, since the free */
+/* list links wouldn't otherwise be found. We also set them in the */
+/* normal free lists, since that involves touching less memory than if */
+/* we scanned them normally. */
+void GC_mark_thread_local_free_lists(void)
+{
+ int i, j;
+ GC_thread p;
+ ptr_t q;
+
+ for (i = 0; i < THREAD_TABLE_SZ; ++i) {
+ for (p = GC_threads[i]; 0 != p; p = p -> next) {
+ for (j = 1; j < NFREELISTS; ++j) {
+ q = p -> ptrfree_freelists[j];
+ if ((word)q > HBLKSIZE) GC_set_fl_marks(q);
+ q = p -> normal_freelists[j];
+ if ((word)q > HBLKSIZE) GC_set_fl_marks(q);
+# ifdef GC_GCJ_SUPPORT
+ q = p -> gcj_freelists[j];
+ if ((word)q > HBLKSIZE) GC_set_fl_marks(q);
+# endif /* GC_GCJ_SUPPORT */
+ }
+ }
+ }
+}
+#endif /* THREAD_LOCAL_ALLOC */
+
+static struct GC_Thread_Rep first_thread;
+
+/* Add a thread to GC_threads. We assume it wasn't already there. */
+/* Caller holds allocation lock. */
+GC_thread GC_new_thread(pthread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ GC_thread result;
+ static GC_bool first_thread_used = FALSE;
+
+ if (!first_thread_used) {
+ result = &first_thread;
+ first_thread_used = TRUE;
+ } else {
+ result = (struct GC_Thread_Rep *)
+ GC_INTERNAL_MALLOC(sizeof(struct GC_Thread_Rep), NORMAL);
+ }
+ if (result == 0) return(0);
+ result -> id = id;
+ result -> next = GC_threads[hv];
+ GC_threads[hv] = result;
+ GC_ASSERT(result -> flags == 0 && result -> thread_blocked == 0);
+ return(result);
+}
+
+/* Delete a thread from GC_threads. We assume it is there. */
+/* (The code intentionally traps if it wasn't.) */
+/* Caller holds allocation lock. */
+void GC_delete_thread(pthread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ register GC_thread p = GC_threads[hv];
+ register GC_thread prev = 0;
+
+ while (!pthread_equal(p -> id, id)) {
+ prev = p;
+ p = p -> next;
+ }
+ if (prev == 0) {
+ GC_threads[hv] = p -> next;
+ } else {
+ prev -> next = p -> next;
+ }
+ GC_INTERNAL_FREE(p);
+}
+
+/* If a thread has been joined, but we have not yet */
+/* been notified, then there may be more than one thread */
+/* in the table with the same pthread id. */
+/* This is OK, but we need a way to delete a specific one. */
+void GC_delete_gc_thread(pthread_t id, GC_thread gc_id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ register GC_thread p = GC_threads[hv];
+ register GC_thread prev = 0;
+
+ while (p != gc_id) {
+ prev = p;
+ p = p -> next;
+ }
+ if (prev == 0) {
+ GC_threads[hv] = p -> next;
+ } else {
+ prev -> next = p -> next;
+ }
+ GC_INTERNAL_FREE(p);
+}
+
+/* Return a GC_thread corresponding to a given thread_t. */
+/* Returns 0 if it's not there. */
+/* Caller holds allocation lock or otherwise inhibits */
+/* updates. */
+/* If there is more than one thread with the given id we */
+/* return the most recent one. */
+GC_thread GC_lookup_thread(pthread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ register GC_thread p = GC_threads[hv];
+
+ while (p != 0 && !pthread_equal(p -> id, id)) p = p -> next;
+ return(p);
+}
+
+#ifdef HANDLE_FORK
+/* Remove all entries from the GC_threads table, except the */
+/* one for the current thread. We need to do this in the child */
+/* process after a fork(), since only the current thread */
+/* survives in the child. */
+void GC_remove_all_threads_but_me(void)
+{
+ pthread_t self = pthread_self();
+ int hv;
+ GC_thread p, next, me;
+
+ for (hv = 0; hv < THREAD_TABLE_SZ; ++hv) {
+ me = 0;
+ for (p = GC_threads[hv]; 0 != p; p = next) {
+ next = p -> next;
+ if (p -> id == self) {
+ me = p;
+ p -> next = 0;
+ } else {
+# ifdef THREAD_LOCAL_ALLOC
+ if (!(p -> flags & FINISHED)) {
+ GC_destroy_thread_local(p);
+ }
+# endif /* THREAD_LOCAL_ALLOC */
+ if (p != &first_thread) GC_INTERNAL_FREE(p);
+ }
+ }
+ GC_threads[hv] = me;
+ }
+}
+#endif /* HANDLE_FORK */
+
+/* There seems to be a very rare thread stopping problem. To help us */
+/* debug that, we save the ids of the stopping thread. */
+pthread_t GC_stopping_thread;
+int GC_stopping_pid;
+
+/* We hold the allocation lock. Suspend all threads that might */
+/* still be running. Return the number of suspend signals that */
+/* were sent. */
+int GC_suspend_all()
+{
+ int n_live_threads = 0;
+ int i;
+ GC_thread p;
+ int result;
+ pthread_t my_thread = pthread_self();
+
+ GC_stopping_thread = my_thread; /* debugging only. */
+ GC_stopping_pid = getpid(); /* debugging only. */
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (p -> id != my_thread) {
+ if (p -> flags & FINISHED) continue;
+ if (p -> last_stop_count == GC_stop_count) continue;
+ if (p -> thread_blocked) /* Will wait */ continue;
+ n_live_threads++;
+ #if DEBUG_THREADS
+ GC_printf1("Sending suspend signal to 0x%lx\n", p -> id);
+ #endif
+ result = pthread_kill(p -> id, SIG_SUSPEND);
+ switch(result) {
+ case ESRCH:
+ /* Not really there anymore. Possible? */
+ n_live_threads--;
+ break;
+ case 0:
+ break;
+ default:
+ ABORT("pthread_kill failed");
+ }
+ }
+ }
+ }
+ return n_live_threads;
+}
+
+/* Caller holds allocation lock. */
+void GC_stop_world()
+{
+ register int i;
+ register int n_live_threads;
+
+ /* Make sure all free list construction has stopped before we start. */
+ /* No new construction can start, since free list construction is */
+ /* required to acquire and release the GC lock before it starts, */
+ /* and we have the lock. */
+# ifdef PARALLEL_MARK
+ GC_acquire_mark_lock();
+ GC_ASSERT(GC_fl_builder_count == 0);
+ /* We should have previously waited for it to become zero. */
+# endif /* PARALLEL_MARK */
+ ++GC_stop_count;
+ n_live_threads = GC_suspend_all();
+ /* sem_getvalue() is not suppored on OS X, and there does not appear */
+ /* to be a mach equivalent, so we disable this code. */
+# ifndef GC_MACOSX_THREADS
+ if (GC_retry_signals) {
+ unsigned long wait_usecs = 0; /* Total wait since retry. */
+# define WAIT_UNIT 3000
+# define RETRY_INTERVAL 100000
+ for (;;) {
+ int ack_count;
+
+ sem_getvalue(&GC_suspend_ack_sem, &ack_count);
+ if (ack_count == n_live_threads) break;
+ if (wait_usecs > RETRY_INTERVAL) {
+ int newly_sent = GC_suspend_all();
+
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Resent %ld signals after timeout\n",
+ newly_sent);
+ }
+# endif
+ sem_getvalue(&GC_suspend_ack_sem, &ack_count);
+ if (newly_sent < n_live_threads - ack_count) {
+ WARN("Lost some threads during GC_stop_world?!\n",0);
+ n_live_threads = ack_count + newly_sent;
+ }
+ wait_usecs = 0;
+ }
+ usleep(WAIT_UNIT);
+ wait_usecs += WAIT_UNIT;
+ }
+ }
+# endif /* GC_MACOSX_THREADS */
+ for (i = 0; i < n_live_threads; i++) {
+# ifdef GC_MACOSX_THREADS
+ if (KERN_SUCCESS != semaphore_wait(GC_suspend_ack_sem))
+ ABORT("semaphore_wait in handler failed");
+# else
+ if (0 != sem_wait(&GC_suspend_ack_sem))
+ ABORT("sem_wait in handler failed");
+# endif
+ }
+# ifdef PARALLEL_MARK
+ GC_release_mark_lock();
+# endif
+ #if DEBUG_THREADS
+ GC_printf1("World stopped from 0x%lx\n", pthread_self());
+ #endif
+ GC_stopping_thread = 0; /* debugging only */
+}
+
+/* Caller holds allocation lock, and has held it continuously since */
+/* the world stopped. */
+void GC_start_world()
+{
+ pthread_t my_thread = pthread_self();
+ register int i;
+ register GC_thread p;
+ register int n_live_threads = 0;
+ register int result;
+
+# if DEBUG_THREADS
+ GC_printf0("World starting\n");
+# endif
+
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (p -> id != my_thread) {
+ if (p -> flags & FINISHED) continue;
+ if (p -> thread_blocked) continue;
+ n_live_threads++;
+ #if DEBUG_THREADS
+ GC_printf1("Sending restart signal to 0x%lx\n", p -> id);
+ #endif
+ result = pthread_kill(p -> id, SIG_THR_RESTART);
+ switch(result) {
+ case ESRCH:
+ /* Not really there anymore. Possible? */
+ n_live_threads--;
+ break;
+ case 0:
+ break;
+ default:
+ ABORT("pthread_kill failed");
+ }
+ }
+ }
+ }
+ #if DEBUG_THREADS
+ GC_printf0("World started\n");
+ #endif
+}
+
+# ifdef IA64
+# define IF_IA64(x) x
+# else
+# define IF_IA64(x)
+# endif
+/* We hold allocation lock. Should do exactly the right thing if the */
+/* world is stopped. Should not fail if it isn't. */
+void GC_push_all_stacks()
+{
+ int i;
+ GC_thread p;
+ ptr_t sp = GC_approx_sp();
+ ptr_t lo, hi;
+ /* On IA64, we also need to scan the register backing store. */
+ IF_IA64(ptr_t bs_lo; ptr_t bs_hi;)
+ pthread_t me = pthread_self();
+
+ if (!GC_thr_initialized) GC_thr_init();
+ #if DEBUG_THREADS
+ GC_printf1("Pushing stacks from thread 0x%lx\n", (unsigned long) me);
+ #endif
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (p -> flags & FINISHED) continue;
+ if (pthread_equal(p -> id, me)) {
+# ifdef SPARC
+ lo = (ptr_t)GC_save_regs_in_stack();
+# else
+ lo = GC_approx_sp();
+# endif
+ IF_IA64(bs_hi = (ptr_t)GC_save_regs_in_stack();)
+ } else {
+ lo = p -> stack_ptr;
+ IF_IA64(bs_hi = p -> backing_store_ptr;)
+ }
+ if ((p -> flags & MAIN_THREAD) == 0) {
+ hi = p -> stack_end;
+ IF_IA64(bs_lo = p -> backing_store_end);
+ } else {
+ /* The original stack. */
+ hi = GC_stackbottom;
+ IF_IA64(bs_lo = BACKING_STORE_BASE;)
+ }
+ #if DEBUG_THREADS
+ GC_printf3("Stack for thread 0x%lx = [%lx,%lx)\n",
+ (unsigned long) p -> id,
+ (unsigned long) lo, (unsigned long) hi);
+ #endif
+ if (0 == lo) ABORT("GC_push_all_stacks: sp not set!\n");
+# ifdef STACK_GROWS_UP
+ /* We got them backwards! */
+ GC_push_all_stack(hi, lo);
+# else
+ GC_push_all_stack(lo, hi);
+# endif
+# ifdef IA64
+ if (pthread_equal(p -> id, me)) {
+ GC_push_all_eager(bs_lo, bs_hi);
+ } else {
+ GC_push_all_stack(bs_lo, bs_hi);
+ }
+# endif
+ }
+ }
+}
+
+#ifdef USE_PROC_FOR_LIBRARIES
+int GC_segment_is_thread_stack(ptr_t lo, ptr_t hi)
+{
+ int i;
+ GC_thread p;
+
+# ifdef PARALLEL_MARK
+ for (i = 0; i < GC_markers; ++i) {
+ if (marker_sp[i] > lo & marker_sp[i] < hi) return 1;
+ }
+# endif
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (0 != p -> stack_end) {
+# ifdef STACK_GROWS_UP
+ if (p -> stack_end >= lo && p -> stack_end < hi) return 1;
+# else /* STACK_GROWS_DOWN */
+ if (p -> stack_end > lo && p -> stack_end <= hi) return 1;
+# endif
+ }
+ }
+ }
+ return 0;
+}
+#endif /* USE_PROC_FOR_LIBRARIES */
+
+#ifdef GC_LINUX_THREADS
+/* Return the number of processors, or i<= 0 if it can't be determined. */
+int GC_get_nprocs()
+{
+ /* Should be "return sysconf(_SC_NPROCESSORS_ONLN);" but that */
+ /* appears to be buggy in many cases. */
+ /* We look for lines "cpu<n>" in /proc/stat. */
+# define STAT_BUF_SIZE 4096
+# if defined(GC_USE_LD_WRAP)
+# define STAT_READ __real_read
+# else
+# define STAT_READ read
+# endif
+ char stat_buf[STAT_BUF_SIZE];
+ int f;
+ char c;
+ word result = 1;
+ /* Some old kernels only have a single "cpu nnnn ..." */
+ /* entry in /proc/stat. We identify those as */
+ /* uniprocessors. */
+ size_t i, len = 0;
+
+ f = open("/proc/stat", O_RDONLY);
+ if (f < 0 || (len = STAT_READ(f, stat_buf, STAT_BUF_SIZE)) < 100) {
+ WARN("Couldn't read /proc/stat\n", 0);
+ return -1;
+ }
+ for (i = 0; i < len - 100; ++i) {
+ if (stat_buf[i] == '\n' && stat_buf[i+1] == 'c'
+ && stat_buf[i+2] == 'p' && stat_buf[i+3] == 'u') {
+ int cpu_no = atoi(stat_buf + i + 4);
+ if (cpu_no >= result) result = cpu_no + 1;
+ }
+ }
+ close(f);
+ return result;
+}
+#endif /* GC_LINUX_THREADS */
+
+/* We hold the GC lock. Wait until an in-progress GC has finished. */
+/* Repeatedly RELEASES GC LOCK in order to wait. */
+/* If wait_for_all is true, then we exit with the GC lock held and no */
+/* collection in progress; otherwise we just wait for the current GC */
+/* to finish. */
+void GC_wait_for_gc_completion(GC_bool wait_for_all)
+{
+ if (GC_incremental && GC_collection_in_progress()) {
+ int old_gc_no = GC_gc_no;
+
+ /* Make sure that no part of our stack is still on the mark stack, */
+ /* since it's about to be unmapped. */
+ while (GC_incremental && GC_collection_in_progress()
+ && (wait_for_all || old_gc_no == GC_gc_no)) {
+ ENTER_GC();
+ GC_collect_a_little_inner(1);
+ EXIT_GC();
+ UNLOCK();
+ sched_yield();
+ LOCK();
+ }
+ }
+}
+
+#ifdef HANDLE_FORK
+/* Procedures called before and after a fork. The goal here is to make */
+/* it safe to call GC_malloc() in a forked child. It's unclear that is */
+/* attainable, since the single UNIX spec seems to imply that one */
+/* should only call async-signal-safe functions, and we probably can't */
+/* quite guarantee that. But we give it our best shot. (That same */
+/* spec also implies that it's not safe to call the system malloc */
+/* between fork() and exec(). Thus we're doing no worse than it. */
+
+/* Called before a fork() */
+void GC_fork_prepare_proc(void)
+{
+ /* Acquire all relevant locks, so that after releasing the locks */
+ /* the child will see a consistent state in which monitor */
+ /* invariants hold. Unfortunately, we can't acquire libc locks */
+ /* we might need, and there seems to be no guarantee that libc */
+ /* must install a suitable fork handler. */
+ /* Wait for an ongoing GC to finish, since we can't finish it in */
+ /* the (one remaining thread in) the child. */
+ LOCK();
+# if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ GC_wait_for_reclaim();
+# endif
+ GC_wait_for_gc_completion(TRUE);
+# if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ GC_acquire_mark_lock();
+# endif
+}
+
+/* Called in parent after a fork() */
+void GC_fork_parent_proc(void)
+{
+# if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ GC_release_mark_lock();
+# endif
+ UNLOCK();
+}
+
+/* Called in child after a fork() */
+void GC_fork_child_proc(void)
+{
+ /* Clean up the thread table, so that just our thread is left. */
+# if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ GC_release_mark_lock();
+# endif
+ GC_remove_all_threads_but_me();
+# ifdef PARALLEL_MARK
+ /* Turn off parallel marking in the child, since we are probably */
+ /* just going to exec, and we would have to restart mark threads. */
+ GC_markers = 1;
+ GC_parallel = FALSE;
+# endif /* PARALLEL_MARK */
+ UNLOCK();
+}
+#endif /* HANDLE_FORK */
+
+#if defined(GC_DGUX386_THREADS)
+/* Return the number of processors, or i<= 0 if it can't be determined. */
+int GC_get_nprocs()
+{
+ /* <takis@XFree86.Org> */
+ int numCpus;
+ struct dg_sys_info_pm_info pm_sysinfo;
+ int status =0;
+
+ status = dg_sys_info((long int *) &pm_sysinfo,
+ DG_SYS_INFO_PM_INFO_TYPE, DG_SYS_INFO_PM_CURRENT_VERSION);
+ if (status < 0)
+ /* set -1 for error */
+ numCpus = -1;
+ else
+ /* Active CPUs */
+ numCpus = pm_sysinfo.idle_vp_count;
+
+# ifdef DEBUG_THREADS
+ GC_printf1("Number of active CPUs in this system: %d\n", numCpus);
+# endif
+ return(numCpus);
+}
+#endif /* GC_DGUX386_THREADS */
+
+/* We hold the allocation lock. */
+void GC_thr_init()
+{
+ int dummy;
+ GC_thread t;
+ struct sigaction act;
+
+ if (GC_thr_initialized) return;
+ GC_thr_initialized = TRUE;
+
+# ifdef GC_MACOSX_THREADS
+ if (semaphore_create(mach_task_self(), &GC_suspend_ack_sem,
+ SYNC_POLICY_FIFO, 0) != KERN_SUCCESS)
+ ABORT("semaphore_create failed");
+# else
+ if (sem_init(&GC_suspend_ack_sem, 0, 0) != 0)
+ ABORT("sem_init failed");
+# endif
+
+ act.sa_flags = SA_RESTART;
+ if (sigfillset(&act.sa_mask) != 0) {
+ ABORT("sigfillset() failed");
+ }
+# ifdef NO_SIGNALS
+ if (sigdelset(&act.sa_mask, SIGINT) != 0
+ || sigdelset(&act.sa_mask, SIGQUIT != 0)
+ || sigdelset(&act.sa_mask, SIGABRT != 0)
+ || sigdelset(&act.sa_mask, SIGTERM != 0)) {
+ ABORT("sigdelset() failed");
+ }
+# endif
+
+ /* SIG_THR_RESTART is unmasked by the handler when necessary. */
+ act.sa_handler = GC_suspend_handler;
+ if (sigaction(SIG_SUSPEND, &act, NULL) != 0) {
+ ABORT("Cannot set SIG_SUSPEND handler");
+ }
+
+ act.sa_handler = GC_restart_handler;
+ if (sigaction(SIG_THR_RESTART, &act, NULL) != 0) {
+ ABORT("Cannot set SIG_THR_RESTART handler");
+ }
+# ifdef HANDLE_FORK
+ /* Prepare for a possible fork. */
+ pthread_atfork(GC_fork_prepare_proc, GC_fork_parent_proc,
+ GC_fork_child_proc);
+# endif /* HANDLE_FORK */
+ /* Add the initial thread, so we can stop it. */
+ t = GC_new_thread(pthread_self());
+ t -> stack_ptr = (ptr_t)(&dummy);
+ t -> flags = DETACHED | MAIN_THREAD;
+
+ /* Check for GC_RETRY_SIGNALS. */
+ if (0 != GETENV("GC_RETRY_SIGNALS")) {
+ GC_retry_signals = TRUE;
+ }
+ if (0 != GETENV("GC_NO_RETRY_SIGNALS")) {
+ GC_retry_signals = FALSE;
+ }
+# ifdef CONDPRINT
+ if (GC_print_stats && GC_retry_signals) {
+ GC_printf0("Will retry suspend signal if necessary.\n");
+ }
+# endif
+
+ /* Set GC_nprocs. */
+ {
+ char * nprocs_string = GETENV("GC_NPROCS");
+ GC_nprocs = -1;
+ if (nprocs_string != NULL) GC_nprocs = atoi(nprocs_string);
+ }
+ if (GC_nprocs <= 0) {
+# if defined(GC_HPUX_THREADS)
+ GC_nprocs = pthread_num_processors_np();
+# endif
+# if defined(GC_OSF1_THREADS)
+ GC_nprocs = sysconf(_SC_NPROCESSORS_ONLN);
+ if (GC_nprocs <= 0) GC_nprocs = 1;
+# endif
+# if defined(GC_FREEBSD_THREADS)
+ GC_nprocs = 1;
+# endif
+# if defined(GC_MACOSX_THREADS)
+ int ncpus = 1;
+ size_t len = sizeof(ncpus);
+ sysctl((int[2]) {CTL_HW, HW_NCPU}, 2, &ncpus, &len, NULL, 0);
+ GC_nprocs = ncpus;
+# endif
+# if defined(GC_LINUX_THREADS) || defined(GC_DGUX386_THREADS)
+ GC_nprocs = GC_get_nprocs();
+# endif
+ }
+ if (GC_nprocs <= 0) {
+ WARN("GC_get_nprocs() returned %ld\n", GC_nprocs);
+ GC_nprocs = 2;
+# ifdef PARALLEL_MARK
+ GC_markers = 1;
+# endif
+ } else {
+# ifdef PARALLEL_MARK
+ {
+ char * markers_string = GETENV("GC_MARKERS");
+ if (markers_string != NULL) {
+ GC_markers = atoi(markers_string);
+ } else {
+ GC_markers = GC_nprocs;
+ }
+ }
+# endif
+ }
+# ifdef PARALLEL_MARK
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf2("Number of processors = %ld, "
+ "number of marker threads = %ld\n", GC_nprocs, GC_markers);
+ }
+# endif
+ if (GC_markers == 1) {
+ GC_parallel = FALSE;
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf0("Single marker thread, turning off parallel marking\n");
+ }
+# endif
+ } else {
+ GC_parallel = TRUE;
+ /* Disable true incremental collection, but generational is OK. */
+ GC_time_limit = GC_TIME_UNLIMITED;
+ }
+# endif
+}
+
+
+/* Perform all initializations, including those that */
+/* may require allocation. */
+/* Called without allocation lock. */
+/* Must be called before a second thread is created. */
+/* Called without allocation lock. */
+void GC_init_parallel()
+{
+ if (parallel_initialized) return;
+ parallel_initialized = TRUE;
+ /* GC_init() calls us back, so set flag first. */
+ if (!GC_is_initialized) GC_init();
+ /* If we are using a parallel marker, start the helper threads. */
+# ifdef PARALLEL_MARK
+ if (GC_parallel) start_mark_threads();
+# endif
+ /* Initialize thread local free lists if used. */
+# if defined(THREAD_LOCAL_ALLOC) && !defined(DBG_HDRS_ALL)
+ LOCK();
+ GC_init_thread_local(GC_lookup_thread(pthread_self()));
+ UNLOCK();
+# endif
+}
+
+
+int WRAP_FUNC(pthread_sigmask)(int how, const sigset_t *set, sigset_t *oset)
+{
+ sigset_t fudged_set;
+
+ if (set != NULL && (how == SIG_BLOCK || how == SIG_SETMASK)) {
+ fudged_set = *set;
+ sigdelset(&fudged_set, SIG_SUSPEND);
+ set = &fudged_set;
+ }
+ return(REAL_FUNC(pthread_sigmask)(how, set, oset));
+}
+
+/* Wrappers for functions that are likely to block for an appreciable */
+/* length of time. Must be called in pairs, if at all. */
+/* Nothing much beyond the system call itself should be executed */
+/* between these. */
+
+void GC_start_blocking(void) {
+# define SP_SLOP 128
+ GC_thread me;
+ LOCK();
+ me = GC_lookup_thread(pthread_self());
+ GC_ASSERT(!(me -> thread_blocked));
+# ifdef SPARC
+ me -> stack_ptr = (ptr_t)GC_save_regs_in_stack();
+# else
+ me -> stack_ptr = (ptr_t)GC_approx_sp();
+# endif
+# ifdef IA64
+ me -> backing_store_ptr = (ptr_t)GC_save_regs_in_stack() + SP_SLOP;
+# endif
+ /* Add some slop to the stack pointer, since the wrapped call may */
+ /* end up pushing more callee-save registers. */
+# ifdef STACK_GROWS_UP
+ me -> stack_ptr += SP_SLOP;
+# else
+ me -> stack_ptr -= SP_SLOP;
+# endif
+ me -> thread_blocked = TRUE;
+ UNLOCK();
+}
+
+GC_end_blocking(void) {
+ GC_thread me;
+ LOCK(); /* This will block if the world is stopped. */
+ me = GC_lookup_thread(pthread_self());
+ GC_ASSERT(me -> thread_blocked);
+ me -> thread_blocked = FALSE;
+ UNLOCK();
+}
+
+#if defined(GC_DGUX386_THREADS)
+#define __d10_sleep sleep
+#endif /* GC_DGUX386_THREADS */
+
+/* A wrapper for the standard C sleep function */
+int WRAP_FUNC(sleep) (unsigned int seconds)
+{
+ int result;
+
+ GC_start_blocking();
+ result = REAL_FUNC(sleep)(seconds);
+ GC_end_blocking();
+ return result;
+}
+
+struct start_info {
+ void *(*start_routine)(void *);
+ void *arg;
+ word flags;
+#ifdef GC_MACOSX_THREADS
+ semaphore_t registered;
+#else
+ sem_t registered; /* 1 ==> in our thread table, but */
+ /* parent hasn't yet noticed. */
+#endif
+};
+
+/* Called at thread exit. */
+/* Never called for main thread. That's OK, since it */
+/* results in at most a tiny one-time leak. And */
+/* linuxthreads doesn't reclaim the main threads */
+/* resources or id anyway. */
+void GC_thread_exit_proc(void *arg)
+{
+ GC_thread me;
+
+ LOCK();
+ me = GC_lookup_thread(pthread_self());
+ GC_destroy_thread_local(me);
+ if (me -> flags & DETACHED) {
+ GC_delete_thread(pthread_self());
+ } else {
+ me -> flags |= FINISHED;
+ }
+# if defined(THREAD_LOCAL_ALLOC) && !defined(USE_PTHREAD_SPECIFIC) \
+ && !defined(USE_HPUX_TLS) && !defined(DBG_HDRS_ALL)
+ GC_remove_specific(GC_thread_key);
+# endif
+ GC_wait_for_gc_completion(FALSE);
+ UNLOCK();
+}
+
+int WRAP_FUNC(pthread_join)(pthread_t thread, void **retval)
+{
+ int result;
+ GC_thread thread_gc_id;
+
+ LOCK();
+ thread_gc_id = GC_lookup_thread(thread);
+ /* This is guaranteed to be the intended one, since the thread id */
+ /* cant have been recycled by pthreads. */
+ UNLOCK();
+ result = REAL_FUNC(pthread_join)(thread, retval);
+# if defined (GC_FREEBSD_THREADS)
+ /* On FreeBSD, the wrapped pthread_join() sometimes returns (what
+ appears to be) a spurious EINTR which caused the test and real code
+ to gratuitously fail. Having looked at system pthread library source
+ code, I see how this return code may be generated. In one path of
+ code, pthread_join() just returns the errno setting of the thread
+ being joined. This does not match the POSIX specification or the
+ local man pages thus I have taken the liberty to catch this one
+ spurious return value properly conditionalized on GC_FREEBSD_THREADS. */
+ if (result == EINTR) result = 0;
+# endif
+ if (result == 0) {
+ LOCK();
+ /* Here the pthread thread id may have been recycled. */
+ GC_delete_gc_thread(thread, thread_gc_id);
+ UNLOCK();
+ }
+ return result;
+}
+
+int
+WRAP_FUNC(pthread_detach)(pthread_t thread)
+{
+ int result;
+ GC_thread thread_gc_id;
+
+ LOCK();
+ thread_gc_id = GC_lookup_thread(thread);
+ UNLOCK();
+ result = REAL_FUNC(pthread_detach)(thread);
+ if (result == 0) {
+ LOCK();
+ thread_gc_id -> flags |= DETACHED;
+ /* Here the pthread thread id may have been recycled. */
+ if (thread_gc_id -> flags & FINISHED) {
+ GC_delete_gc_thread(thread, thread_gc_id);
+ }
+ UNLOCK();
+ }
+ return result;
+}
+
+void * GC_start_routine(void * arg)
+{
+ int dummy;
+ struct start_info * si = arg;
+ void * result;
+ GC_thread me;
+ pthread_t my_pthread;
+ void *(*start)(void *);
+ void *start_arg;
+
+ my_pthread = pthread_self();
+# ifdef DEBUG_THREADS
+ GC_printf1("Starting thread 0x%lx\n", my_pthread);
+ GC_printf1("pid = %ld\n", (long) getpid());
+ GC_printf1("sp = 0x%lx\n", (long) &arg);
+# endif
+ LOCK();
+ me = GC_new_thread(my_pthread);
+ me -> flags = si -> flags;
+ me -> stack_ptr = 0;
+ /* me -> stack_end = GC_linux_stack_base(); -- currently (11/99) */
+ /* doesn't work because the stack base in /proc/self/stat is the */
+ /* one for the main thread. There is a strong argument that that's */
+ /* a kernel bug, but a pervasive one. */
+# ifdef STACK_GROWS_DOWN
+ me -> stack_end = (ptr_t)(((word)(&dummy) + (GC_page_size - 1))
+ & ~(GC_page_size - 1));
+ me -> stack_ptr = me -> stack_end - 0x10;
+ /* Needs to be plausible, since an asynchronous stack mark */
+ /* should not crash. */
+# else
+ me -> stack_end = (ptr_t)((word)(&dummy) & ~(GC_page_size - 1));
+ me -> stack_ptr = me -> stack_end + 0x10;
+# endif
+ /* This is dubious, since we may be more than a page into the stack, */
+ /* and hence skip some of it, though it's not clear that matters. */
+# ifdef IA64
+ me -> backing_store_end = (ptr_t)
+ (GC_save_regs_in_stack() & ~(GC_page_size - 1));
+ /* This is also < 100% convincing. We should also read this */
+ /* from /proc, but the hook to do so isn't there yet. */
+# endif /* IA64 */
+ UNLOCK();
+ start = si -> start_routine;
+# ifdef DEBUG_THREADS
+ GC_printf1("start_routine = 0x%lx\n", start);
+# endif
+ start_arg = si -> arg;
+# ifdef GC_MACOSX_THREADS
+ semaphore_signal(si->registered);
+# else
+ sem_post(&(si -> registered)); /* Last action on si. */
+# endif
+ /* OK to deallocate. */
+ pthread_cleanup_push(GC_thread_exit_proc, 0);
+# if defined(THREAD_LOCAL_ALLOC) && !defined(DBG_HDRS_ALL)
+ LOCK();
+ GC_init_thread_local(me);
+ UNLOCK();
+# endif
+ result = (*start)(start_arg);
+#if DEBUG_THREADS
+ GC_printf1("Finishing thread 0x%x\n", pthread_self());
+#endif
+ me -> status = result;
+ me -> flags |= FINISHED;
+ pthread_cleanup_pop(1);
+ /* Cleanup acquires lock, ensuring that we can't exit */
+ /* while a collection that thinks we're alive is trying to stop */
+ /* us. */
+ return(result);
+}
+
+int
+WRAP_FUNC(pthread_create)(pthread_t *new_thread,
+ const pthread_attr_t *attr,
+ void *(*start_routine)(void *), void *arg)
+{
+ int result;
+ GC_thread t;
+ pthread_t my_new_thread;
+ int detachstate;
+ word my_flags = 0;
+ struct start_info * si;
+ /* This is otherwise saved only in an area mmapped by the thread */
+ /* library, which isn't visible to the collector. */
+
+ /* We resist the temptation to muck with the stack size here, */
+ /* even if the default is unreasonably small. That's the client's */
+ /* responsibility. */
+
+ LOCK();
+ si = (struct start_info *)GC_INTERNAL_MALLOC(sizeof(struct start_info),
+ NORMAL);
+ UNLOCK();
+ if (!parallel_initialized) GC_init_parallel();
+ if (0 == si) return(ENOMEM);
+# ifdef GC_MACOSX_THREADS
+ semaphore_create(mach_task_self(), &si->registered, SYNC_POLICY_FIFO, 0);
+# else
+ sem_init(&(si -> registered), 0, 0);
+# endif
+ si -> start_routine = start_routine;
+ si -> arg = arg;
+ LOCK();
+ if (!GC_thr_initialized) GC_thr_init();
+# ifdef GC_ASSERTIONS
+ {
+ int stack_size;
+ if (NULL == attr) {
+ pthread_attr_t my_attr;
+ pthread_attr_init(&my_attr);
+ pthread_attr_getstacksize(&my_attr, &stack_size);
+ } else {
+ pthread_attr_getstacksize(attr, &stack_size);
+ }
+ GC_ASSERT(stack_size >= (8*HBLKSIZE*sizeof(word)));
+ /* Our threads may need to do some work for the GC. */
+ /* Ridiculously small threads won't work, and they */
+ /* probably wouldn't work anyway. */
+ }
+# endif
+ if (NULL == attr) {
+ detachstate = PTHREAD_CREATE_JOINABLE;
+ } else {
+ pthread_attr_getdetachstate(attr, &detachstate);
+ }
+ if (PTHREAD_CREATE_DETACHED == detachstate) my_flags |= DETACHED;
+ si -> flags = my_flags;
+ UNLOCK();
+# ifdef DEBUG_THREADS
+ GC_printf1("About to start new thread from thread 0x%X\n",
+ pthread_self());
+# endif
+
+ result = REAL_FUNC(pthread_create)(new_thread, attr, GC_start_routine, si);
+# ifdef DEBUG_THREADS
+ GC_printf1("Started thread 0x%X\n", *new_thread);
+# endif
+ /* Wait until child has been added to the thread table. */
+ /* This also ensures that we hold onto si until the child is done */
+ /* with it. Thus it doesn't matter whether it is otherwise */
+ /* visible to the collector. */
+# ifdef GC_MACOSX_THREADS
+ semaphore_wait(si->registered);
+ semaphore_destroy(mach_task_self(), si->registered);
+# else
+ while (0 != sem_wait(&(si -> registered))) {
+ if (EINTR != errno) ABORT("sem_wait failed");
+ }
+ sem_destroy(&(si -> registered));
+# endif
+ LOCK();
+ GC_INTERNAL_FREE(si);
+ UNLOCK();
+
+ return(result);
+}
+
+#ifdef GENERIC_COMPARE_AND_SWAP
+ pthread_mutex_t GC_compare_and_swap_lock = PTHREAD_MUTEX_INITIALIZER;
+
+ GC_bool GC_compare_and_exchange(volatile GC_word *addr,
+ GC_word old, GC_word new_val)
+ {
+ GC_bool result;
+ pthread_mutex_lock(&GC_compare_and_swap_lock);
+ if (*addr == old) {
+ *addr = new_val;
+ result = TRUE;
+ } else {
+ result = FALSE;
+ }
+ pthread_mutex_unlock(&GC_compare_and_swap_lock);
+ return result;
+ }
+
+ GC_word GC_atomic_add(volatile GC_word *addr, GC_word how_much)
+ {
+ GC_word old;
+ pthread_mutex_lock(&GC_compare_and_swap_lock);
+ old = *addr;
+ *addr = old + how_much;
+ pthread_mutex_unlock(&GC_compare_and_swap_lock);
+ return old;
+ }
+
+#endif /* GENERIC_COMPARE_AND_SWAP */
+/* Spend a few cycles in a way that can't introduce contention with */
+/* othre threads. */
+void GC_pause()
+{
+ int i;
+ volatile word dummy = 0;
+
+ for (i = 0; i < 10; ++i) {
+# ifdef __GNUC__
+ __asm__ __volatile__ (" " : : : "memory");
+# else
+ /* Something that's unlikely to be optimized away. */
+ GC_noop(++dummy);
+# endif
+ }
+}
+
+#define SPIN_MAX 1024 /* Maximum number of calls to GC_pause before */
+ /* give up. */
+
+VOLATILE GC_bool GC_collecting = 0;
+ /* A hint that we're in the collector and */
+ /* holding the allocation lock for an */
+ /* extended period. */
+
+#if !defined(USE_SPIN_LOCK) || defined(PARALLEL_MARK)
+/* If we don't want to use the below spinlock implementation, either */
+/* because we don't have a GC_test_and_set implementation, or because */
+/* we don't want to risk sleeping, we can still try spinning on */
+/* pthread_mutex_trylock for a while. This appears to be very */
+/* beneficial in many cases. */
+/* I suspect that under high contention this is nearly always better */
+/* than the spin lock. But it's a bit slower on a uniprocessor. */
+/* Hence we still default to the spin lock. */
+/* This is also used to acquire the mark lock for the parallel */
+/* marker. */
+
+/* Here we use a strict exponential backoff scheme. I don't know */
+/* whether that's better or worse than the above. We eventually */
+/* yield by calling pthread_mutex_lock(); it never makes sense to */
+/* explicitly sleep. */
+
+void GC_generic_lock(pthread_mutex_t * lock)
+{
+ unsigned pause_length = 1;
+ unsigned i;
+
+ if (0 == pthread_mutex_trylock(lock)) return;
+ for (; pause_length <= SPIN_MAX; pause_length <<= 1) {
+ for (i = 0; i < pause_length; ++i) {
+ GC_pause();
+ }
+ switch(pthread_mutex_trylock(lock)) {
+ case 0:
+ return;
+ case EBUSY:
+ break;
+ default:
+ ABORT("Unexpected error from pthread_mutex_trylock");
+ }
+ }
+ pthread_mutex_lock(lock);
+}
+
+#endif /* !USE_SPIN_LOCK || PARALLEL_MARK */
+
+#if defined(USE_SPIN_LOCK)
+
+/* Reasonably fast spin locks. Basically the same implementation */
+/* as STL alloc.h. This isn't really the right way to do this. */
+/* but until the POSIX scheduling mess gets straightened out ... */
+
+volatile unsigned int GC_allocate_lock = 0;
+
+
+void GC_lock()
+{
+# define low_spin_max 30 /* spin cycles if we suspect uniprocessor */
+# define high_spin_max SPIN_MAX /* spin cycles for multiprocessor */
+ static unsigned spin_max = low_spin_max;
+ unsigned my_spin_max;
+ static unsigned last_spins = 0;
+ unsigned my_last_spins;
+ int i;
+
+ if (!GC_test_and_set(&GC_allocate_lock)) {
+ return;
+ }
+ my_spin_max = spin_max;
+ my_last_spins = last_spins;
+ for (i = 0; i < my_spin_max; i++) {
+ if (GC_collecting || GC_nprocs == 1) goto yield;
+ if (i < my_last_spins/2 || GC_allocate_lock) {
+ GC_pause();
+ continue;
+ }
+ if (!GC_test_and_set(&GC_allocate_lock)) {
+ /*
+ * got it!
+ * Spinning worked. Thus we're probably not being scheduled
+ * against the other process with which we were contending.
+ * Thus it makes sense to spin longer the next time.
+ */
+ last_spins = i;
+ spin_max = high_spin_max;
+ return;
+ }
+ }
+ /* We are probably being scheduled against the other process. Sleep. */
+ spin_max = low_spin_max;
+yield:
+ for (i = 0;; ++i) {
+ if (!GC_test_and_set(&GC_allocate_lock)) {
+ return;
+ }
+# define SLEEP_THRESHOLD 12
+ /* Under Linux very short sleeps tend to wait until */
+ /* the current time quantum expires. On old Linux */
+ /* kernels nanosleep(<= 2ms) just spins under Linux. */
+ /* (Under 2.4, this happens only for real-time */
+ /* processes.) We want to minimize both behaviors */
+ /* here. */
+ if (i < SLEEP_THRESHOLD) {
+ sched_yield();
+ } else {
+ struct timespec ts;
+
+ if (i > 24) i = 24;
+ /* Don't wait for more than about 15msecs, even */
+ /* under extreme contention. */
+ ts.tv_sec = 0;
+ ts.tv_nsec = 1 << i;
+ nanosleep(&ts, 0);
+ }
+ }
+}
+
+#else /* !USE_SPINLOCK */
+
+void GC_lock()
+{
+ if (1 == GC_nprocs || GC_collecting) {
+ pthread_mutex_lock(&GC_allocate_ml);
+ } else {
+ GC_generic_lock(&GC_allocate_ml);
+ }
+}
+
+#endif /* !USE_SPINLOCK */
+
+#if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+
+#ifdef GC_ASSERTIONS
+ pthread_t GC_mark_lock_holder = NO_THREAD;
+#endif
+
+#if 0
+ /* Ugly workaround for a linux threads bug in the final versions */
+ /* of glibc2.1. Pthread_mutex_trylock sets the mutex owner */
+ /* field even when it fails to acquire the mutex. This causes */
+ /* pthread_cond_wait to die. Remove for glibc2.2. */
+ /* According to the man page, we should use */
+ /* PTHREAD_ERRORCHECK_MUTEX_INITIALIZER_NP, but that isn't actually */
+ /* defined. */
+ static pthread_mutex_t mark_mutex =
+ {0, 0, 0, PTHREAD_MUTEX_ERRORCHECK_NP, {0, 0}};
+#else
+ static pthread_mutex_t mark_mutex = PTHREAD_MUTEX_INITIALIZER;
+#endif
+
+static pthread_cond_t builder_cv = PTHREAD_COND_INITIALIZER;
+
+void GC_acquire_mark_lock()
+{
+/*
+ if (pthread_mutex_lock(&mark_mutex) != 0) {
+ ABORT("pthread_mutex_lock failed");
+ }
+*/
+ GC_generic_lock(&mark_mutex);
+# ifdef GC_ASSERTIONS
+ GC_mark_lock_holder = pthread_self();
+# endif
+}
+
+void GC_release_mark_lock()
+{
+ GC_ASSERT(GC_mark_lock_holder == pthread_self());
+# ifdef GC_ASSERTIONS
+ GC_mark_lock_holder = NO_THREAD;
+# endif
+ if (pthread_mutex_unlock(&mark_mutex) != 0) {
+ ABORT("pthread_mutex_unlock failed");
+ }
+}
+
+/* Collector must wait for a freelist builders for 2 reasons: */
+/* 1) Mark bits may still be getting examined without lock. */
+/* 2) Partial free lists referenced only by locals may not be scanned */
+/* correctly, e.g. if they contain "pointer-free" objects, since the */
+/* free-list link may be ignored. */
+void GC_wait_builder()
+{
+ GC_ASSERT(GC_mark_lock_holder == pthread_self());
+# ifdef GC_ASSERTIONS
+ GC_mark_lock_holder = NO_THREAD;
+# endif
+ if (pthread_cond_wait(&builder_cv, &mark_mutex) != 0) {
+ ABORT("pthread_cond_wait failed");
+ }
+ GC_ASSERT(GC_mark_lock_holder == NO_THREAD);
+# ifdef GC_ASSERTIONS
+ GC_mark_lock_holder = pthread_self();
+# endif
+}
+
+void GC_wait_for_reclaim()
+{
+ GC_acquire_mark_lock();
+ while (GC_fl_builder_count > 0) {
+ GC_wait_builder();
+ }
+ GC_release_mark_lock();
+}
+
+void GC_notify_all_builder()
+{
+ GC_ASSERT(GC_mark_lock_holder == pthread_self());
+ if (pthread_cond_broadcast(&builder_cv) != 0) {
+ ABORT("pthread_cond_broadcast failed");
+ }
+}
+
+#endif /* PARALLEL_MARK || THREAD_LOCAL_ALLOC */
+
+#ifdef PARALLEL_MARK
+
+static pthread_cond_t mark_cv = PTHREAD_COND_INITIALIZER;
+
+void GC_wait_marker()
+{
+ GC_ASSERT(GC_mark_lock_holder == pthread_self());
+# ifdef GC_ASSERTIONS
+ GC_mark_lock_holder = NO_THREAD;
+# endif
+ if (pthread_cond_wait(&mark_cv, &mark_mutex) != 0) {
+ ABORT("pthread_cond_wait failed");
+ }
+ GC_ASSERT(GC_mark_lock_holder == NO_THREAD);
+# ifdef GC_ASSERTIONS
+ GC_mark_lock_holder = pthread_self();
+# endif
+}
+
+void GC_notify_all_marker()
+{
+ if (pthread_cond_broadcast(&mark_cv) != 0) {
+ ABORT("pthread_cond_broadcast failed");
+ }
+}
+
+#endif /* PARALLEL_MARK */
+
+# endif /* GC_LINUX_THREADS and friends */
+
--- /dev/null
+#!/bin/sh
+# I could find no versions of autoconf that don't invoke ltconfig, but
+# libtool no longer includes an ltconfig. Yuch.
--- /dev/null
+# ltmain.sh - Provide generalized library-building support services.
+# NOTE: Changing this file will not affect anything until you rerun configure.
+#
+# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+# Free Software Foundation, Inc.
+# Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Check that we have a working $echo.
+if test "X$1" = X--no-reexec; then
+ # Discard the --no-reexec flag, and continue.
+ shift
+elif test "X$1" = X--fallback-echo; then
+ # Avoid inline document here, it may be left over
+ :
+elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then
+ # Yippee, $echo works!
+ :
+else
+ # Restart under the correct shell, and then maybe $echo will work.
+ exec $SHELL "$0" --no-reexec ${1+"$@"}
+fi
+
+if test "X$1" = X--fallback-echo; then
+ # used as fallback echo
+ shift
+ cat <<EOF
+$*
+EOF
+ exit 0
+fi
+
+# The name of this program.
+progname=`$echo "$0" | sed 's%^.*/%%'`
+modename="$progname"
+
+# Constants.
+PROGRAM=ltmain.sh
+PACKAGE=libtool
+VERSION=1.4.2
+TIMESTAMP=" (1.922.2.53 2001/09/11 03:18:52)"
+
+default_mode=
+help="Try \`$progname --help' for more information."
+magic="%%%MAGIC variable%%%"
+mkdir="mkdir"
+mv="mv -f"
+rm="rm -f"
+
+# Sed substitution that helps us do robust quoting. It backslashifies
+# metacharacters that are still active within double-quoted strings.
+Xsed='sed -e 1s/^X//'
+sed_quote_subst='s/\([\\`\\"$\\\\]\)/\\\1/g'
+SP2NL='tr \040 \012'
+NL2SP='tr \015\012 \040\040'
+
+# NLS nuisances.
+# Only set LANG and LC_ALL to C if already set.
+# These must not be set unconditionally because not all systems understand
+# e.g. LANG=C (notably SCO).
+# We save the old values to restore during execute mode.
+if test "${LC_ALL+set}" = set; then
+ save_LC_ALL="$LC_ALL"; LC_ALL=C; export LC_ALL
+fi
+if test "${LANG+set}" = set; then
+ save_LANG="$LANG"; LANG=C; export LANG
+fi
+
+# Make sure IFS has a sensible default
+: ${IFS=" "}
+
+if test "$build_libtool_libs" != yes && test "$build_old_libs" != yes; then
+ echo "$modename: not configured to build any kind of library" 1>&2
+ echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2
+ exit 1
+fi
+
+# Global variables.
+mode=$default_mode
+nonopt=
+prev=
+prevopt=
+run=
+show="$echo"
+show_help=
+execute_dlfiles=
+lo2o="s/\\.lo\$/.${objext}/"
+o2lo="s/\\.${objext}\$/.lo/"
+
+# Parse our command line options once, thoroughly.
+while test $# -gt 0
+do
+ arg="$1"
+ shift
+
+ case $arg in
+ -*=*) optarg=`$echo "X$arg" | $Xsed -e 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) optarg= ;;
+ esac
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$prev"; then
+ case $prev in
+ execute_dlfiles)
+ execute_dlfiles="$execute_dlfiles $arg"
+ ;;
+ *)
+ eval "$prev=\$arg"
+ ;;
+ esac
+
+ prev=
+ prevopt=
+ continue
+ fi
+
+ # Have we seen a non-optional argument yet?
+ case $arg in
+ --help)
+ show_help=yes
+ ;;
+
+ --version)
+ echo "$PROGRAM (GNU $PACKAGE) $VERSION$TIMESTAMP"
+ exit 0
+ ;;
+
+ --config)
+ sed -e '1,/^# ### BEGIN LIBTOOL CONFIG/d' -e '/^# ### END LIBTOOL CONFIG/,$d' $0
+ exit 0
+ ;;
+
+ --debug)
+ echo "$progname: enabling shell trace mode"
+ set -x
+ ;;
+
+ --dry-run | -n)
+ run=:
+ ;;
+
+ --features)
+ echo "host: $host"
+ if test "$build_libtool_libs" = yes; then
+ echo "enable shared libraries"
+ else
+ echo "disable shared libraries"
+ fi
+ if test "$build_old_libs" = yes; then
+ echo "enable static libraries"
+ else
+ echo "disable static libraries"
+ fi
+ exit 0
+ ;;
+
+ --finish) mode="finish" ;;
+
+ --mode) prevopt="--mode" prev=mode ;;
+ --mode=*) mode="$optarg" ;;
+
+ --quiet | --silent)
+ show=:
+ ;;
+
+ -dlopen)
+ prevopt="-dlopen"
+ prev=execute_dlfiles
+ ;;
+
+ -*)
+ $echo "$modename: unrecognized option \`$arg'" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ ;;
+
+ *)
+ nonopt="$arg"
+ break
+ ;;
+ esac
+done
+
+if test -n "$prevopt"; then
+ $echo "$modename: option \`$prevopt' requires an argument" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+fi
+
+# If this variable is set in any of the actions, the command in it
+# will be execed at the end. This prevents here-documents from being
+# left over by shells.
+exec_cmd=
+
+if test -z "$show_help"; then
+
+ # Infer the operation mode.
+ if test -z "$mode"; then
+ case $nonopt in
+ *cc | *++ | gcc* | *-gcc*)
+ mode=link
+ for arg
+ do
+ case $arg in
+ -c)
+ mode=compile
+ break
+ ;;
+ esac
+ done
+ ;;
+ *db | *dbx | *strace | *truss)
+ mode=execute
+ ;;
+ *install*|cp|mv)
+ mode=install
+ ;;
+ *rm)
+ mode=uninstall
+ ;;
+ *)
+ # If we have no mode, but dlfiles were specified, then do execute mode.
+ test -n "$execute_dlfiles" && mode=execute
+
+ # Just use the default operation mode.
+ if test -z "$mode"; then
+ if test -n "$nonopt"; then
+ $echo "$modename: warning: cannot infer operation mode from \`$nonopt'" 1>&2
+ else
+ $echo "$modename: warning: cannot infer operation mode without MODE-ARGS" 1>&2
+ fi
+ fi
+ ;;
+ esac
+ fi
+
+ # Only execute mode is allowed to have -dlopen flags.
+ if test -n "$execute_dlfiles" && test "$mode" != execute; then
+ $echo "$modename: unrecognized option \`-dlopen'" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ # Change the help message to a mode-specific one.
+ generic_help="$help"
+ help="Try \`$modename --help --mode=$mode' for more information."
+
+ # These modes are in order of execution frequency so that they run quickly.
+ case $mode in
+ # libtool compile mode
+ compile)
+ modename="$modename: compile"
+ # Get the compilation command and the source file.
+ base_compile=
+ prev=
+ lastarg=
+ srcfile="$nonopt"
+ suppress_output=
+
+ user_target=no
+ for arg
+ do
+ case $prev in
+ "") ;;
+ xcompiler)
+ # Aesthetically quote the previous argument.
+ prev=
+ lastarg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
+
+ case $arg in
+ # Double-quote args containing other shell metacharacters.
+ # Many Bourne shells cannot handle close brackets correctly
+ # in scan sets, so we specify it separately.
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
+ arg="\"$arg\""
+ ;;
+ esac
+
+ # Add the previous argument to base_compile.
+ if test -z "$base_compile"; then
+ base_compile="$lastarg"
+ else
+ base_compile="$base_compile $lastarg"
+ fi
+ continue
+ ;;
+ esac
+
+ # Accept any command-line options.
+ case $arg in
+ -o)
+ if test "$user_target" != "no"; then
+ $echo "$modename: you cannot specify \`-o' more than once" 1>&2
+ exit 1
+ fi
+ user_target=next
+ ;;
+
+ -static)
+ build_old_libs=yes
+ continue
+ ;;
+
+ -prefer-pic)
+ pic_mode=yes
+ continue
+ ;;
+
+ -prefer-non-pic)
+ pic_mode=no
+ continue
+ ;;
+
+ -Xcompiler)
+ prev=xcompiler
+ continue
+ ;;
+
+ -Wc,*)
+ args=`$echo "X$arg" | $Xsed -e "s/^-Wc,//"`
+ lastarg=
+ save_ifs="$IFS"; IFS=','
+ for arg in $args; do
+ IFS="$save_ifs"
+
+ # Double-quote args containing other shell metacharacters.
+ # Many Bourne shells cannot handle close brackets correctly
+ # in scan sets, so we specify it separately.
+ case $arg in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
+ arg="\"$arg\""
+ ;;
+ esac
+ lastarg="$lastarg $arg"
+ done
+ IFS="$save_ifs"
+ lastarg=`$echo "X$lastarg" | $Xsed -e "s/^ //"`
+
+ # Add the arguments to base_compile.
+ if test -z "$base_compile"; then
+ base_compile="$lastarg"
+ else
+ base_compile="$base_compile $lastarg"
+ fi
+ continue
+ ;;
+ esac
+
+ case $user_target in
+ next)
+ # The next one is the -o target name
+ user_target=yes
+ continue
+ ;;
+ yes)
+ # We got the output file
+ user_target=set
+ libobj="$arg"
+ continue
+ ;;
+ esac
+
+ # Accept the current argument as the source file.
+ lastarg="$srcfile"
+ srcfile="$arg"
+
+ # Aesthetically quote the previous argument.
+
+ # Backslashify any backslashes, double quotes, and dollar signs.
+ # These are the only characters that are still specially
+ # interpreted inside of double-quoted scrings.
+ lastarg=`$echo "X$lastarg" | $Xsed -e "$sed_quote_subst"`
+
+ # Double-quote args containing other shell metacharacters.
+ # Many Bourne shells cannot handle close brackets correctly
+ # in scan sets, so we specify it separately.
+ case $lastarg in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
+ lastarg="\"$lastarg\""
+ ;;
+ esac
+
+ # Add the previous argument to base_compile.
+ if test -z "$base_compile"; then
+ base_compile="$lastarg"
+ else
+ base_compile="$base_compile $lastarg"
+ fi
+ done
+
+ case $user_target in
+ set)
+ ;;
+ no)
+ # Get the name of the library object.
+ libobj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%'`
+ ;;
+ *)
+ $echo "$modename: you must specify a target with \`-o'" 1>&2
+ exit 1
+ ;;
+ esac
+
+ # Recognize several different file suffixes.
+ # If the user specifies -o file.o, it is replaced with file.lo
+ xform='[cCFSfmso]'
+ case $libobj in
+ *.ada) xform=ada ;;
+ *.adb) xform=adb ;;
+ *.ads) xform=ads ;;
+ *.asm) xform=asm ;;
+ *.c++) xform=c++ ;;
+ *.cc) xform=cc ;;
+ *.cpp) xform=cpp ;;
+ *.cxx) xform=cxx ;;
+ *.f90) xform=f90 ;;
+ *.for) xform=for ;;
+ esac
+
+ libobj=`$echo "X$libobj" | $Xsed -e "s/\.$xform$/.lo/"`
+
+ case $libobj in
+ *.lo) obj=`$echo "X$libobj" | $Xsed -e "$lo2o"` ;;
+ *)
+ $echo "$modename: cannot determine name of library object from \`$libobj'" 1>&2
+ exit 1
+ ;;
+ esac
+
+ if test -z "$base_compile"; then
+ $echo "$modename: you must specify a compilation command" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ # Delete any leftover library objects.
+ if test "$build_old_libs" = yes; then
+ removelist="$obj $libobj"
+ else
+ removelist="$libobj"
+ fi
+
+ $run $rm $removelist
+ trap "$run $rm $removelist; exit 1" 1 2 15
+
+ # On Cygwin there's no "real" PIC flag so we must build both object types
+ case $host_os in
+ cygwin* | mingw* | pw32* | os2*)
+ pic_mode=default
+ ;;
+ esac
+ if test $pic_mode = no && test "$deplibs_check_method" != pass_all; then
+ # non-PIC code in shared libraries is not supported
+ pic_mode=default
+ fi
+
+ # Calculate the filename of the output object if compiler does
+ # not support -o with -c
+ if test "$compiler_c_o" = no; then
+ output_obj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%' -e 's%\.[^.]*$%%'`.${objext}
+ lockfile="$output_obj.lock"
+ removelist="$removelist $output_obj $lockfile"
+ trap "$run $rm $removelist; exit 1" 1 2 15
+ else
+ need_locks=no
+ lockfile=
+ fi
+
+ # Lock this critical section if it is needed
+ # We use this script file to make the link, it avoids creating a new file
+ if test "$need_locks" = yes; then
+ until $run ln "$0" "$lockfile" 2>/dev/null; do
+ $show "Waiting for $lockfile to be removed"
+ sleep 2
+ done
+ elif test "$need_locks" = warn; then
+ if test -f "$lockfile"; then
+ echo "\
+*** ERROR, $lockfile exists and contains:
+`cat $lockfile 2>/dev/null`
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support \`-c' and \`-o' together. If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+ $run $rm $removelist
+ exit 1
+ fi
+ echo $srcfile > "$lockfile"
+ fi
+
+ if test -n "$fix_srcfile_path"; then
+ eval srcfile=\"$fix_srcfile_path\"
+ fi
+
+ # Only build a PIC object if we are building libtool libraries.
+ if test "$build_libtool_libs" = yes; then
+ # Without this assignment, base_compile gets emptied.
+ fbsd_hideous_sh_bug=$base_compile
+
+ if test "$pic_mode" != no; then
+ # All platforms use -DPIC, to notify preprocessed assembler code.
+ command="$base_compile $srcfile $pic_flag -DPIC"
+ else
+ # Don't build PIC code
+ command="$base_compile $srcfile"
+ fi
+ if test "$build_old_libs" = yes; then
+ lo_libobj="$libobj"
+ dir=`$echo "X$libobj" | $Xsed -e 's%/[^/]*$%%'`
+ if test "X$dir" = "X$libobj"; then
+ dir="$objdir"
+ else
+ dir="$dir/$objdir"
+ fi
+ libobj="$dir/"`$echo "X$libobj" | $Xsed -e 's%^.*/%%'`
+
+ if test -d "$dir"; then
+ $show "$rm $libobj"
+ $run $rm $libobj
+ else
+ $show "$mkdir $dir"
+ $run $mkdir $dir
+ status=$?
+ if test $status -ne 0 && test ! -d $dir; then
+ exit $status
+ fi
+ fi
+ fi
+ if test "$compiler_o_lo" = yes; then
+ output_obj="$libobj"
+ command="$command -o $output_obj"
+ elif test "$compiler_c_o" = yes; then
+ output_obj="$obj"
+ command="$command -o $output_obj"
+ fi
+
+ $run $rm "$output_obj"
+ $show "$command"
+ if $run eval "$command"; then :
+ else
+ test -n "$output_obj" && $run $rm $removelist
+ exit 1
+ fi
+
+ if test "$need_locks" = warn &&
+ test x"`cat $lockfile 2>/dev/null`" != x"$srcfile"; then
+ echo "\
+*** ERROR, $lockfile contains:
+`cat $lockfile 2>/dev/null`
+
+but it should contain:
+$srcfile
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support \`-c' and \`-o' together. If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+ $run $rm $removelist
+ exit 1
+ fi
+
+ # Just move the object if needed, then go on to compile the next one
+ if test x"$output_obj" != x"$libobj"; then
+ $show "$mv $output_obj $libobj"
+ if $run $mv $output_obj $libobj; then :
+ else
+ error=$?
+ $run $rm $removelist
+ exit $error
+ fi
+ fi
+
+ # If we have no pic_flag, then copy the object into place and finish.
+ if (test -z "$pic_flag" || test "$pic_mode" != default) &&
+ test "$build_old_libs" = yes; then
+ # Rename the .lo from within objdir to obj
+ if test -f $obj; then
+ $show $rm $obj
+ $run $rm $obj
+ fi
+
+ $show "$mv $libobj $obj"
+ if $run $mv $libobj $obj; then :
+ else
+ error=$?
+ $run $rm $removelist
+ exit $error
+ fi
+
+ xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'`
+ if test "X$xdir" = "X$obj"; then
+ xdir="."
+ else
+ xdir="$xdir"
+ fi
+ baseobj=`$echo "X$obj" | $Xsed -e "s%.*/%%"`
+ libobj=`$echo "X$baseobj" | $Xsed -e "$o2lo"`
+ # Now arrange that obj and lo_libobj become the same file
+ $show "(cd $xdir && $LN_S $baseobj $libobj)"
+ if $run eval '(cd $xdir && $LN_S $baseobj $libobj)'; then
+ # Unlock the critical section if it was locked
+ if test "$need_locks" != no; then
+ $run $rm "$lockfile"
+ fi
+ exit 0
+ else
+ error=$?
+ $run $rm $removelist
+ exit $error
+ fi
+ fi
+
+ # Allow error messages only from the first compilation.
+ suppress_output=' >/dev/null 2>&1'
+ fi
+
+ # Only build a position-dependent object if we build old libraries.
+ if test "$build_old_libs" = yes; then
+ if test "$pic_mode" != yes; then
+ # Don't build PIC code
+ command="$base_compile $srcfile"
+ else
+ # All platforms use -DPIC, to notify preprocessed assembler code.
+ command="$base_compile $srcfile $pic_flag -DPIC"
+ fi
+ if test "$compiler_c_o" = yes; then
+ command="$command -o $obj"
+ output_obj="$obj"
+ fi
+
+ # Suppress compiler output if we already did a PIC compilation.
+ command="$command$suppress_output"
+ $run $rm "$output_obj"
+ $show "$command"
+ if $run eval "$command"; then :
+ else
+ $run $rm $removelist
+ exit 1
+ fi
+
+ if test "$need_locks" = warn &&
+ test x"`cat $lockfile 2>/dev/null`" != x"$srcfile"; then
+ echo "\
+*** ERROR, $lockfile contains:
+`cat $lockfile 2>/dev/null`
+
+but it should contain:
+$srcfile
+
+This indicates that another process is trying to use the same
+temporary object file, and libtool could not work around it because
+your compiler does not support \`-c' and \`-o' together. If you
+repeat this compilation, it may succeed, by chance, but you had better
+avoid parallel builds (make -j) in this platform, or get a better
+compiler."
+
+ $run $rm $removelist
+ exit 1
+ fi
+
+ # Just move the object if needed
+ if test x"$output_obj" != x"$obj"; then
+ $show "$mv $output_obj $obj"
+ if $run $mv $output_obj $obj; then :
+ else
+ error=$?
+ $run $rm $removelist
+ exit $error
+ fi
+ fi
+
+ # Create an invalid libtool object if no PIC, so that we do not
+ # accidentally link it into a program.
+ if test "$build_libtool_libs" != yes; then
+ $show "echo timestamp > $libobj"
+ $run eval "echo timestamp > \$libobj" || exit $?
+ else
+ # Move the .lo from within objdir
+ $show "$mv $libobj $lo_libobj"
+ if $run $mv $libobj $lo_libobj; then :
+ else
+ error=$?
+ $run $rm $removelist
+ exit $error
+ fi
+ fi
+ fi
+
+ # Unlock the critical section if it was locked
+ if test "$need_locks" != no; then
+ $run $rm "$lockfile"
+ fi
+
+ exit 0
+ ;;
+
+ # libtool link mode
+ link | relink)
+ modename="$modename: link"
+ case $host in
+ *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*)
+ # It is impossible to link a dll without this setting, and
+ # we shouldn't force the makefile maintainer to figure out
+ # which system we are compiling for in order to pass an extra
+ # flag for every libtool invokation.
+ # allow_undefined=no
+
+ # FIXME: Unfortunately, there are problems with the above when trying
+ # to make a dll which has undefined symbols, in which case not
+ # even a static library is built. For now, we need to specify
+ # -no-undefined on the libtool link line when we can be certain
+ # that all symbols are satisfied, otherwise we get a static library.
+ allow_undefined=yes
+ ;;
+ *)
+ allow_undefined=yes
+ ;;
+ esac
+ libtool_args="$nonopt"
+ compile_command="$nonopt"
+ finalize_command="$nonopt"
+
+ compile_rpath=
+ finalize_rpath=
+ compile_shlibpath=
+ finalize_shlibpath=
+ convenience=
+ old_convenience=
+ deplibs=
+ old_deplibs=
+ compiler_flags=
+ linker_flags=
+ dllsearchpath=
+ lib_search_path=`pwd`
+
+ avoid_version=no
+ dlfiles=
+ dlprefiles=
+ dlself=no
+ export_dynamic=no
+ export_symbols=
+ export_symbols_regex=
+ generated=
+ libobjs=
+ ltlibs=
+ module=no
+ no_install=no
+ objs=
+ prefer_static_libs=no
+ preload=no
+ prev=
+ prevarg=
+ release=
+ rpath=
+ xrpath=
+ perm_rpath=
+ temp_rpath=
+ thread_safe=no
+ vinfo=
+
+ # We need to know -static, to get the right output filenames.
+ for arg
+ do
+ case $arg in
+ -all-static | -static)
+ if test "X$arg" = "X-all-static"; then
+ if test "$build_libtool_libs" = yes && test -z "$link_static_flag"; then
+ $echo "$modename: warning: complete static linking is impossible in this configuration" 1>&2
+ fi
+ if test -n "$link_static_flag"; then
+ dlopen_self=$dlopen_self_static
+ fi
+ else
+ if test -z "$pic_flag" && test -n "$link_static_flag"; then
+ dlopen_self=$dlopen_self_static
+ fi
+ fi
+ build_libtool_libs=no
+ build_old_libs=yes
+ prefer_static_libs=yes
+ break
+ ;;
+ esac
+ done
+
+ # See if our shared archives depend on static archives.
+ test -n "$old_archive_from_new_cmds" && build_old_libs=yes
+
+ # Go through the arguments, transforming them on the way.
+ while test $# -gt 0; do
+ arg="$1"
+ shift
+ case $arg in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
+ qarg=\"`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`\" ### testsuite: skip nested quoting test
+ ;;
+ *) qarg=$arg ;;
+ esac
+ libtool_args="$libtool_args $qarg"
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$prev"; then
+ case $prev in
+ output)
+ compile_command="$compile_command @OUTPUT@"
+ finalize_command="$finalize_command @OUTPUT@"
+ ;;
+ esac
+
+ case $prev in
+ dlfiles|dlprefiles)
+ if test "$preload" = no; then
+ # Add the symbol object into the linking commands.
+ compile_command="$compile_command @SYMFILE@"
+ finalize_command="$finalize_command @SYMFILE@"
+ preload=yes
+ fi
+ case $arg in
+ *.la | *.lo) ;; # We handle these cases below.
+ force)
+ if test "$dlself" = no; then
+ dlself=needless
+ export_dynamic=yes
+ fi
+ prev=
+ continue
+ ;;
+ self)
+ if test "$prev" = dlprefiles; then
+ dlself=yes
+ elif test "$prev" = dlfiles && test "$dlopen_self" != yes; then
+ dlself=yes
+ else
+ dlself=needless
+ export_dynamic=yes
+ fi
+ prev=
+ continue
+ ;;
+ *)
+ if test "$prev" = dlfiles; then
+ dlfiles="$dlfiles $arg"
+ else
+ dlprefiles="$dlprefiles $arg"
+ fi
+ prev=
+ continue
+ ;;
+ esac
+ ;;
+ expsyms)
+ export_symbols="$arg"
+ if test ! -f "$arg"; then
+ $echo "$modename: symbol file \`$arg' does not exist"
+ exit 1
+ fi
+ prev=
+ continue
+ ;;
+ expsyms_regex)
+ export_symbols_regex="$arg"
+ prev=
+ continue
+ ;;
+ release)
+ release="-$arg"
+ prev=
+ continue
+ ;;
+ rpath | xrpath)
+ # We need an absolute path.
+ case $arg in
+ [\\/]* | [A-Za-z]:[\\/]*) ;;
+ *)
+ $echo "$modename: only absolute run-paths are allowed" 1>&2
+ exit 1
+ ;;
+ esac
+ if test "$prev" = rpath; then
+ case "$rpath " in
+ *" $arg "*) ;;
+ *) rpath="$rpath $arg" ;;
+ esac
+ else
+ case "$xrpath " in
+ *" $arg "*) ;;
+ *) xrpath="$xrpath $arg" ;;
+ esac
+ fi
+ prev=
+ continue
+ ;;
+ xcompiler)
+ compiler_flags="$compiler_flags $qarg"
+ prev=
+ compile_command="$compile_command $qarg"
+ finalize_command="$finalize_command $qarg"
+ continue
+ ;;
+ xlinker)
+ linker_flags="$linker_flags $qarg"
+ compiler_flags="$compiler_flags $wl$qarg"
+ prev=
+ compile_command="$compile_command $wl$qarg"
+ finalize_command="$finalize_command $wl$qarg"
+ continue
+ ;;
+ *)
+ eval "$prev=\"\$arg\""
+ prev=
+ continue
+ ;;
+ esac
+ fi # test -n $prev
+
+ prevarg="$arg"
+
+ case $arg in
+ -all-static)
+ if test -n "$link_static_flag"; then
+ compile_command="$compile_command $link_static_flag"
+ finalize_command="$finalize_command $link_static_flag"
+ fi
+ continue
+ ;;
+
+ -allow-undefined)
+ # FIXME: remove this flag sometime in the future.
+ $echo "$modename: \`-allow-undefined' is deprecated because it is the default" 1>&2
+ continue
+ ;;
+
+ -avoid-version)
+ avoid_version=yes
+ continue
+ ;;
+
+ -dlopen)
+ prev=dlfiles
+ continue
+ ;;
+
+ -dlpreopen)
+ prev=dlprefiles
+ continue
+ ;;
+
+ -export-dynamic)
+ export_dynamic=yes
+ continue
+ ;;
+
+ -export-symbols | -export-symbols-regex)
+ if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
+ $echo "$modename: more than one -exported-symbols argument is not allowed"
+ exit 1
+ fi
+ if test "X$arg" = "X-export-symbols"; then
+ prev=expsyms
+ else
+ prev=expsyms_regex
+ fi
+ continue
+ ;;
+
+ # The native IRIX linker understands -LANG:*, -LIST:* and -LNO:*
+ # so, if we see these flags be careful not to treat them like -L
+ -L[A-Z][A-Z]*:*)
+ case $with_gcc/$host in
+ no/*-*-irix*)
+ compile_command="$compile_command $arg"
+ finalize_command="$finalize_command $arg"
+ ;;
+ esac
+ continue
+ ;;
+
+ -L*)
+ dir=`$echo "X$arg" | $Xsed -e 's/^-L//'`
+ # We need an absolute path.
+ case $dir in
+ [\\/]* | [A-Za-z]:[\\/]*) ;;
+ *)
+ absdir=`cd "$dir" && pwd`
+ if test -z "$absdir"; then
+ $echo "$modename: cannot determine absolute directory name of \`$dir'" 1>&2
+ exit 1
+ fi
+ dir="$absdir"
+ ;;
+ esac
+ case "$deplibs " in
+ *" -L$dir "*) ;;
+ *)
+ deplibs="$deplibs -L$dir"
+ lib_search_path="$lib_search_path $dir"
+ ;;
+ esac
+ case $host in
+ *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*)
+ case :$dllsearchpath: in
+ *":$dir:"*) ;;
+ *) dllsearchpath="$dllsearchpath:$dir";;
+ esac
+ ;;
+ esac
+ continue
+ ;;
+
+ -l*)
+ if test "X$arg" = "X-lc" || test "X$arg" = "X-lm"; then
+ case $host in
+ *-*-cygwin* | *-*-pw32* | *-*-beos*)
+ # These systems don't actually have a C or math library (as such)
+ continue
+ ;;
+ *-*-mingw* | *-*-os2*)
+ # These systems don't actually have a C library (as such)
+ test "X$arg" = "X-lc" && continue
+ ;;
+ *-*-openbsd*)
+ # Do not include libc due to us having libc/libc_r.
+ test "X$arg" = "X-lc" && continue
+ ;;
+ esac
+ elif test "X$arg" = "X-lc_r"; then
+ case $host in
+ *-*-openbsd*)
+ # Do not include libc_r directly, use -pthread flag.
+ continue
+ ;;
+ esac
+ fi
+ deplibs="$deplibs $arg"
+ continue
+ ;;
+
+ -module)
+ module=yes
+ continue
+ ;;
+
+ -no-fast-install)
+ fast_install=no
+ continue
+ ;;
+
+ -no-install)
+ case $host in
+ *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*)
+ # The PATH hackery in wrapper scripts is required on Windows
+ # in order for the loader to find any dlls it needs.
+ $echo "$modename: warning: \`-no-install' is ignored for $host" 1>&2
+ $echo "$modename: warning: assuming \`-no-fast-install' instead" 1>&2
+ fast_install=no
+ ;;
+ *) no_install=yes ;;
+ esac
+ continue
+ ;;
+
+ -no-undefined)
+ allow_undefined=no
+ continue
+ ;;
+
+ -o) prev=output ;;
+
+ -release)
+ prev=release
+ continue
+ ;;
+
+ -rpath)
+ prev=rpath
+ continue
+ ;;
+
+ -R)
+ prev=xrpath
+ continue
+ ;;
+
+ -R*)
+ dir=`$echo "X$arg" | $Xsed -e 's/^-R//'`
+ # We need an absolute path.
+ case $dir in
+ [\\/]* | [A-Za-z]:[\\/]*) ;;
+ *)
+ $echo "$modename: only absolute run-paths are allowed" 1>&2
+ exit 1
+ ;;
+ esac
+ case "$xrpath " in
+ *" $dir "*) ;;
+ *) xrpath="$xrpath $dir" ;;
+ esac
+ continue
+ ;;
+
+ -static)
+ # The effects of -static are defined in a previous loop.
+ # We used to do the same as -all-static on platforms that
+ # didn't have a PIC flag, but the assumption that the effects
+ # would be equivalent was wrong. It would break on at least
+ # Digital Unix and AIX.
+ continue
+ ;;
+
+ -thread-safe)
+ thread_safe=yes
+ continue
+ ;;
+
+ -version-info)
+ prev=vinfo
+ continue
+ ;;
+
+ -Wc,*)
+ args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wc,//'`
+ arg=
+ save_ifs="$IFS"; IFS=','
+ for flag in $args; do
+ IFS="$save_ifs"
+ case $flag in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
+ flag="\"$flag\""
+ ;;
+ esac
+ arg="$arg $wl$flag"
+ compiler_flags="$compiler_flags $flag"
+ done
+ IFS="$save_ifs"
+ arg=`$echo "X$arg" | $Xsed -e "s/^ //"`
+ ;;
+
+ -Wl,*)
+ args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wl,//'`
+ arg=
+ save_ifs="$IFS"; IFS=','
+ for flag in $args; do
+ IFS="$save_ifs"
+ case $flag in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
+ flag="\"$flag\""
+ ;;
+ esac
+ arg="$arg $wl$flag"
+ compiler_flags="$compiler_flags $wl$flag"
+ linker_flags="$linker_flags $flag"
+ done
+ IFS="$save_ifs"
+ arg=`$echo "X$arg" | $Xsed -e "s/^ //"`
+ ;;
+
+ -Xcompiler)
+ prev=xcompiler
+ continue
+ ;;
+
+ -Xlinker)
+ prev=xlinker
+ continue
+ ;;
+
+ # Some other compiler flag.
+ -* | +*)
+ # Unknown arguments in both finalize_command and compile_command need
+ # to be aesthetically quoted because they are evaled later.
+ arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
+ case $arg in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
+ arg="\"$arg\""
+ ;;
+ esac
+ ;;
+
+ *.lo | *.$objext)
+ # A library or standard object.
+ if test "$prev" = dlfiles; then
+ # This file was specified with -dlopen.
+ if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
+ dlfiles="$dlfiles $arg"
+ prev=
+ continue
+ else
+ # If libtool objects are unsupported, then we need to preload.
+ prev=dlprefiles
+ fi
+ fi
+
+ if test "$prev" = dlprefiles; then
+ # Preload the old-style object.
+ dlprefiles="$dlprefiles "`$echo "X$arg" | $Xsed -e "$lo2o"`
+ prev=
+ else
+ case $arg in
+ *.lo) libobjs="$libobjs $arg" ;;
+ *) objs="$objs $arg" ;;
+ esac
+ fi
+ ;;
+
+ *.$libext)
+ # An archive.
+ deplibs="$deplibs $arg"
+ old_deplibs="$old_deplibs $arg"
+ continue
+ ;;
+
+ *.la)
+ # A libtool-controlled library.
+
+ if test "$prev" = dlfiles; then
+ # This library was specified with -dlopen.
+ dlfiles="$dlfiles $arg"
+ prev=
+ elif test "$prev" = dlprefiles; then
+ # The library was specified with -dlpreopen.
+ dlprefiles="$dlprefiles $arg"
+ prev=
+ else
+ deplibs="$deplibs $arg"
+ fi
+ continue
+ ;;
+
+ # Some other compiler argument.
+ *)
+ # Unknown arguments in both finalize_command and compile_command need
+ # to be aesthetically quoted because they are evaled later.
+ arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
+ case $arg in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
+ arg="\"$arg\""
+ ;;
+ esac
+ ;;
+ esac # arg
+
+ # Now actually substitute the argument into the commands.
+ if test -n "$arg"; then
+ compile_command="$compile_command $arg"
+ finalize_command="$finalize_command $arg"
+ fi
+ done # argument parsing loop
+
+ if test -n "$prev"; then
+ $echo "$modename: the \`$prevarg' option requires an argument" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ if test "$export_dynamic" = yes && test -n "$export_dynamic_flag_spec"; then
+ eval arg=\"$export_dynamic_flag_spec\"
+ compile_command="$compile_command $arg"
+ finalize_command="$finalize_command $arg"
+ fi
+
+ # calculate the name of the file, without its directory
+ outputname=`$echo "X$output" | $Xsed -e 's%^.*/%%'`
+ libobjs_save="$libobjs"
+
+ if test -n "$shlibpath_var"; then
+ # get the directories listed in $shlibpath_var
+ eval shlib_search_path=\`\$echo \"X\${$shlibpath_var}\" \| \$Xsed -e \'s/:/ /g\'\`
+ else
+ shlib_search_path=
+ fi
+ eval sys_lib_search_path=\"$sys_lib_search_path_spec\"
+ eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\"
+
+ output_objdir=`$echo "X$output" | $Xsed -e 's%/[^/]*$%%'`
+ if test "X$output_objdir" = "X$output"; then
+ output_objdir="$objdir"
+ else
+ output_objdir="$output_objdir/$objdir"
+ fi
+ # Create the object directory.
+ if test ! -d $output_objdir; then
+ $show "$mkdir $output_objdir"
+ $run $mkdir $output_objdir
+ status=$?
+ if test $status -ne 0 && test ! -d $output_objdir; then
+ exit $status
+ fi
+ fi
+
+ # Determine the type of output
+ case $output in
+ "")
+ $echo "$modename: you must specify an output file" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ ;;
+ *.$libext) linkmode=oldlib ;;
+ *.lo | *.$objext) linkmode=obj ;;
+ *.la) linkmode=lib ;;
+ *) linkmode=prog ;; # Anything else should be a program.
+ esac
+
+ specialdeplibs=
+ libs=
+ # Find all interdependent deplibs by searching for libraries
+ # that are linked more than once (e.g. -la -lb -la)
+ for deplib in $deplibs; do
+ case "$libs " in
+ *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
+ esac
+ libs="$libs $deplib"
+ done
+ deplibs=
+ newdependency_libs=
+ newlib_search_path=
+ need_relink=no # whether we're linking any uninstalled libtool libraries
+ notinst_deplibs= # not-installed libtool libraries
+ notinst_path= # paths that contain not-installed libtool libraries
+ case $linkmode in
+ lib)
+ passes="conv link"
+ for file in $dlfiles $dlprefiles; do
+ case $file in
+ *.la) ;;
+ *)
+ $echo "$modename: libraries can \`-dlopen' only libtool libraries: $file" 1>&2
+ exit 1
+ ;;
+ esac
+ done
+ ;;
+ prog)
+ compile_deplibs=
+ finalize_deplibs=
+ alldeplibs=no
+ newdlfiles=
+ newdlprefiles=
+ passes="conv scan dlopen dlpreopen link"
+ ;;
+ *) passes="conv"
+ ;;
+ esac
+ for pass in $passes; do
+ if test $linkmode = prog; then
+ # Determine which files to process
+ case $pass in
+ dlopen)
+ libs="$dlfiles"
+ save_deplibs="$deplibs" # Collect dlpreopened libraries
+ deplibs=
+ ;;
+ dlpreopen) libs="$dlprefiles" ;;
+ link) libs="$deplibs %DEPLIBS% $dependency_libs" ;;
+ esac
+ fi
+ for deplib in $libs; do
+ lib=
+ found=no
+ case $deplib in
+ -l*)
+ if test $linkmode = oldlib && test $linkmode = obj; then
+ $echo "$modename: warning: \`-l' is ignored for archives/objects: $deplib" 1>&2
+ continue
+ fi
+ if test $pass = conv; then
+ deplibs="$deplib $deplibs"
+ continue
+ fi
+ name=`$echo "X$deplib" | $Xsed -e 's/^-l//'`
+ for searchdir in $newlib_search_path $lib_search_path $sys_lib_search_path $shlib_search_path; do
+ # Search the libtool library
+ lib="$searchdir/lib${name}.la"
+ if test -f "$lib"; then
+ found=yes
+ break
+ fi
+ done
+ if test "$found" != yes; then
+ # deplib doesn't seem to be a libtool library
+ if test "$linkmode,$pass" = "prog,link"; then
+ compile_deplibs="$deplib $compile_deplibs"
+ finalize_deplibs="$deplib $finalize_deplibs"
+ else
+ deplibs="$deplib $deplibs"
+ test $linkmode = lib && newdependency_libs="$deplib $newdependency_libs"
+ fi
+ continue
+ fi
+ ;; # -l
+ -L*)
+ case $linkmode in
+ lib)
+ deplibs="$deplib $deplibs"
+ test $pass = conv && continue
+ newdependency_libs="$deplib $newdependency_libs"
+ newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`
+ ;;
+ prog)
+ if test $pass = conv; then
+ deplibs="$deplib $deplibs"
+ continue
+ fi
+ if test $pass = scan; then
+ deplibs="$deplib $deplibs"
+ newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`
+ else
+ compile_deplibs="$deplib $compile_deplibs"
+ finalize_deplibs="$deplib $finalize_deplibs"
+ fi
+ ;;
+ *)
+ $echo "$modename: warning: \`-L' is ignored for archives/objects: $deplib" 1>&2
+ ;;
+ esac # linkmode
+ continue
+ ;; # -L
+ -R*)
+ if test $pass = link; then
+ dir=`$echo "X$deplib" | $Xsed -e 's/^-R//'`
+ # Make sure the xrpath contains only unique directories.
+ case "$xrpath " in
+ *" $dir "*) ;;
+ *) xrpath="$xrpath $dir" ;;
+ esac
+ fi
+ deplibs="$deplib $deplibs"
+ continue
+ ;;
+ *.la) lib="$deplib" ;;
+ *.$libext)
+ if test $pass = conv; then
+ deplibs="$deplib $deplibs"
+ continue
+ fi
+ case $linkmode in
+ lib)
+ if test "$deplibs_check_method" != pass_all; then
+ echo
+ echo "*** Warning: This library needs some functionality provided by $deplib."
+ echo "*** I have the capability to make that library automatically link in when"
+ echo "*** you link to this library. But I can only do this if you have a"
+ echo "*** shared version of the library, which you do not appear to have."
+ else
+ echo
+ echo "*** Warning: Linking the shared library $output against the"
+ echo "*** static library $deplib is not portable!"
+ deplibs="$deplib $deplibs"
+ fi
+ continue
+ ;;
+ prog)
+ if test $pass != link; then
+ deplibs="$deplib $deplibs"
+ else
+ compile_deplibs="$deplib $compile_deplibs"
+ finalize_deplibs="$deplib $finalize_deplibs"
+ fi
+ continue
+ ;;
+ esac # linkmode
+ ;; # *.$libext
+ *.lo | *.$objext)
+ if test $pass = dlpreopen || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
+ # If there is no dlopen support or we're linking statically,
+ # we need to preload.
+ newdlprefiles="$newdlprefiles $deplib"
+ compile_deplibs="$deplib $compile_deplibs"
+ finalize_deplibs="$deplib $finalize_deplibs"
+ else
+ newdlfiles="$newdlfiles $deplib"
+ fi
+ continue
+ ;;
+ %DEPLIBS%)
+ alldeplibs=yes
+ continue
+ ;;
+ esac # case $deplib
+ if test $found = yes || test -f "$lib"; then :
+ else
+ $echo "$modename: cannot find the library \`$lib'" 1>&2
+ exit 1
+ fi
+
+ # Check to see that this really is a libtool archive.
+ if (sed -e '2q' $lib | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then :
+ else
+ $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
+ exit 1
+ fi
+
+ ladir=`$echo "X$lib" | $Xsed -e 's%/[^/]*$%%'`
+ test "X$ladir" = "X$lib" && ladir="."
+
+ dlname=
+ dlopen=
+ dlpreopen=
+ libdir=
+ library_names=
+ old_library=
+ # If the library was installed with an old release of libtool,
+ # it will not redefine variable installed.
+ installed=yes
+
+ # Read the .la file
+ case $lib in
+ */* | *\\*) . $lib ;;
+ *) . ./$lib ;;
+ esac
+
+ if test "$linkmode,$pass" = "lib,link" ||
+ test "$linkmode,$pass" = "prog,scan" ||
+ { test $linkmode = oldlib && test $linkmode = obj; }; then
+ # Add dl[pre]opened files of deplib
+ test -n "$dlopen" && dlfiles="$dlfiles $dlopen"
+ test -n "$dlpreopen" && dlprefiles="$dlprefiles $dlpreopen"
+ fi
+
+ if test $pass = conv; then
+ # Only check for convenience libraries
+ deplibs="$lib $deplibs"
+ if test -z "$libdir"; then
+ if test -z "$old_library"; then
+ $echo "$modename: cannot find name of link library for \`$lib'" 1>&2
+ exit 1
+ fi
+ # It is a libtool convenience library, so add in its objects.
+ convenience="$convenience $ladir/$objdir/$old_library"
+ old_convenience="$old_convenience $ladir/$objdir/$old_library"
+ tmp_libs=
+ for deplib in $dependency_libs; do
+ deplibs="$deplib $deplibs"
+ case "$tmp_libs " in
+ *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
+ esac
+ tmp_libs="$tmp_libs $deplib"
+ done
+ elif test $linkmode != prog && test $linkmode != lib; then
+ $echo "$modename: \`$lib' is not a convenience library" 1>&2
+ exit 1
+ fi
+ continue
+ fi # $pass = conv
+
+ # Get the name of the library we link against.
+ linklib=
+ for l in $old_library $library_names; do
+ linklib="$l"
+ done
+ if test -z "$linklib"; then
+ $echo "$modename: cannot find name of link library for \`$lib'" 1>&2
+ exit 1
+ fi
+
+ # This library was specified with -dlopen.
+ if test $pass = dlopen; then
+ if test -z "$libdir"; then
+ $echo "$modename: cannot -dlopen a convenience library: \`$lib'" 1>&2
+ exit 1
+ fi
+ if test -z "$dlname" || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
+ # If there is no dlname, no dlopen support or we're linking
+ # statically, we need to preload.
+ dlprefiles="$dlprefiles $lib"
+ else
+ newdlfiles="$newdlfiles $lib"
+ fi
+ continue
+ fi # $pass = dlopen
+
+ # We need an absolute path.
+ case $ladir in
+ [\\/]* | [A-Za-z]:[\\/]*) abs_ladir="$ladir" ;;
+ *)
+ abs_ladir=`cd "$ladir" && pwd`
+ if test -z "$abs_ladir"; then
+ $echo "$modename: warning: cannot determine absolute directory name of \`$ladir'" 1>&2
+ $echo "$modename: passing it literally to the linker, although it might fail" 1>&2
+ abs_ladir="$ladir"
+ fi
+ ;;
+ esac
+ laname=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
+
+ # Find the relevant object directory and library name.
+ if test "X$installed" = Xyes; then
+ if test ! -f "$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then
+ $echo "$modename: warning: library \`$lib' was moved." 1>&2
+ dir="$ladir"
+ absdir="$abs_ladir"
+ libdir="$abs_ladir"
+ else
+ dir="$libdir"
+ absdir="$libdir"
+ fi
+ else
+ dir="$ladir/$objdir"
+ absdir="$abs_ladir/$objdir"
+ # Remove this search path later
+ notinst_path="$notinst_path $abs_ladir"
+ fi # $installed = yes
+ name=`$echo "X$laname" | $Xsed -e 's/\.la$//' -e 's/^lib//'`
+
+ # This library was specified with -dlpreopen.
+ if test $pass = dlpreopen; then
+ if test -z "$libdir"; then
+ $echo "$modename: cannot -dlpreopen a convenience library: \`$lib'" 1>&2
+ exit 1
+ fi
+ # Prefer using a static library (so that no silly _DYNAMIC symbols
+ # are required to link).
+ if test -n "$old_library"; then
+ newdlprefiles="$newdlprefiles $dir/$old_library"
+ # Otherwise, use the dlname, so that lt_dlopen finds it.
+ elif test -n "$dlname"; then
+ newdlprefiles="$newdlprefiles $dir/$dlname"
+ else
+ newdlprefiles="$newdlprefiles $dir/$linklib"
+ fi
+ fi # $pass = dlpreopen
+
+ if test -z "$libdir"; then
+ # Link the convenience library
+ if test $linkmode = lib; then
+ deplibs="$dir/$old_library $deplibs"
+ elif test "$linkmode,$pass" = "prog,link"; then
+ compile_deplibs="$dir/$old_library $compile_deplibs"
+ finalize_deplibs="$dir/$old_library $finalize_deplibs"
+ else
+ deplibs="$lib $deplibs"
+ fi
+ continue
+ fi
+
+ if test $linkmode = prog && test $pass != link; then
+ newlib_search_path="$newlib_search_path $ladir"
+ deplibs="$lib $deplibs"
+
+ linkalldeplibs=no
+ if test "$link_all_deplibs" != no || test -z "$library_names" ||
+ test "$build_libtool_libs" = no; then
+ linkalldeplibs=yes
+ fi
+
+ tmp_libs=
+ for deplib in $dependency_libs; do
+ case $deplib in
+ -L*) newlib_search_path="$newlib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`;; ### testsuite: skip nested quoting test
+ esac
+ # Need to link against all dependency_libs?
+ if test $linkalldeplibs = yes; then
+ deplibs="$deplib $deplibs"
+ else
+ # Need to hardcode shared library paths
+ # or/and link against static libraries
+ newdependency_libs="$deplib $newdependency_libs"
+ fi
+ case "$tmp_libs " in
+ *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
+ esac
+ tmp_libs="$tmp_libs $deplib"
+ done # for deplib
+ continue
+ fi # $linkmode = prog...
+
+ link_static=no # Whether the deplib will be linked statically
+ if test -n "$library_names" &&
+ { test "$prefer_static_libs" = no || test -z "$old_library"; }; then
+ # Link against this shared library
+
+ if test "$linkmode,$pass" = "prog,link" ||
+ { test $linkmode = lib && test $hardcode_into_libs = yes; }; then
+ # Hardcode the library path.
+ # Skip directories that are in the system default run-time
+ # search path.
+ case " $sys_lib_dlsearch_path " in
+ *" $absdir "*) ;;
+ *)
+ case "$compile_rpath " in
+ *" $absdir "*) ;;
+ *) compile_rpath="$compile_rpath $absdir"
+ esac
+ ;;
+ esac
+ case " $sys_lib_dlsearch_path " in
+ *" $libdir "*) ;;
+ *)
+ case "$finalize_rpath " in
+ *" $libdir "*) ;;
+ *) finalize_rpath="$finalize_rpath $libdir"
+ esac
+ ;;
+ esac
+ if test $linkmode = prog; then
+ # We need to hardcode the library path
+ if test -n "$shlibpath_var"; then
+ # Make sure the rpath contains only unique directories.
+ case "$temp_rpath " in
+ *" $dir "*) ;;
+ *" $absdir "*) ;;
+ *) temp_rpath="$temp_rpath $dir" ;;
+ esac
+ fi
+ fi
+ fi # $linkmode,$pass = prog,link...
+
+ if test "$alldeplibs" = yes &&
+ { test "$deplibs_check_method" = pass_all ||
+ { test "$build_libtool_libs" = yes &&
+ test -n "$library_names"; }; }; then
+ # We only need to search for static libraries
+ continue
+ fi
+
+ if test "$installed" = no; then
+ notinst_deplibs="$notinst_deplibs $lib"
+ need_relink=yes
+ fi
+
+ if test -n "$old_archive_from_expsyms_cmds"; then
+ # figure out the soname
+ set dummy $library_names
+ realname="$2"
+ shift; shift
+ libname=`eval \\$echo \"$libname_spec\"`
+ # use dlname if we got it. it's perfectly good, no?
+ if test -n "$dlname"; then
+ soname="$dlname"
+ elif test -n "$soname_spec"; then
+ # bleh windows
+ case $host in
+ *cygwin*)
+ major=`expr $current - $age`
+ versuffix="-$major"
+ ;;
+ esac
+ eval soname=\"$soname_spec\"
+ else
+ soname="$realname"
+ fi
+
+ # Make a new name for the extract_expsyms_cmds to use
+ soroot="$soname"
+ soname=`echo $soroot | sed -e 's/^.*\///'`
+ newlib="libimp-`echo $soname | sed 's/^lib//;s/\.dll$//'`.a"
+
+ # If the library has no export list, then create one now
+ if test -f "$output_objdir/$soname-def"; then :
+ else
+ $show "extracting exported symbol list from \`$soname'"
+ save_ifs="$IFS"; IFS='~'
+ eval cmds=\"$extract_expsyms_cmds\"
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ fi
+
+ # Create $newlib
+ if test -f "$output_objdir/$newlib"; then :; else
+ $show "generating import library for \`$soname'"
+ save_ifs="$IFS"; IFS='~'
+ eval cmds=\"$old_archive_from_expsyms_cmds\"
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ fi
+ # make sure the library variables are pointing to the new library
+ dir=$output_objdir
+ linklib=$newlib
+ fi # test -n $old_archive_from_expsyms_cmds
+
+ if test $linkmode = prog || test "$mode" != relink; then
+ add_shlibpath=
+ add_dir=
+ add=
+ lib_linked=yes
+ case $hardcode_action in
+ immediate | unsupported)
+ if test "$hardcode_direct" = no; then
+ add="$dir/$linklib"
+ elif test "$hardcode_minus_L" = no; then
+ case $host in
+ *-*-sunos*) add_shlibpath="$dir" ;;
+ esac
+ add_dir="-L$dir"
+ add="-l$name"
+ elif test "$hardcode_shlibpath_var" = no; then
+ add_shlibpath="$dir"
+ add="-l$name"
+ else
+ lib_linked=no
+ fi
+ ;;
+ relink)
+ if test "$hardcode_direct" = yes; then
+ add="$dir/$linklib"
+ elif test "$hardcode_minus_L" = yes; then
+ add_dir="-L$dir"
+ add="-l$name"
+ elif test "$hardcode_shlibpath_var" = yes; then
+ add_shlibpath="$dir"
+ add="-l$name"
+ else
+ lib_linked=no
+ fi
+ ;;
+ *) lib_linked=no ;;
+ esac
+
+ if test "$lib_linked" != yes; then
+ $echo "$modename: configuration error: unsupported hardcode properties"
+ exit 1
+ fi
+
+ if test -n "$add_shlibpath"; then
+ case :$compile_shlibpath: in
+ *":$add_shlibpath:"*) ;;
+ *) compile_shlibpath="$compile_shlibpath$add_shlibpath:" ;;
+ esac
+ fi
+ if test $linkmode = prog; then
+ test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs"
+ test -n "$add" && compile_deplibs="$add $compile_deplibs"
+ else
+ test -n "$add_dir" && deplibs="$add_dir $deplibs"
+ test -n "$add" && deplibs="$add $deplibs"
+ if test "$hardcode_direct" != yes && \
+ test "$hardcode_minus_L" != yes && \
+ test "$hardcode_shlibpath_var" = yes; then
+ case :$finalize_shlibpath: in
+ *":$libdir:"*) ;;
+ *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;;
+ esac
+ fi
+ fi
+ fi
+
+ if test $linkmode = prog || test "$mode" = relink; then
+ add_shlibpath=
+ add_dir=
+ add=
+ # Finalize command for both is simple: just hardcode it.
+ if test "$hardcode_direct" = yes; then
+ add="$libdir/$linklib"
+ elif test "$hardcode_minus_L" = yes; then
+ add_dir="-L$libdir"
+ add="-l$name"
+ elif test "$hardcode_shlibpath_var" = yes; then
+ case :$finalize_shlibpath: in
+ *":$libdir:"*) ;;
+ *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;;
+ esac
+ add="-l$name"
+ else
+ # We cannot seem to hardcode it, guess we'll fake it.
+ add_dir="-L$libdir"
+ add="-l$name"
+ fi
+
+ if test $linkmode = prog; then
+ test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs"
+ test -n "$add" && finalize_deplibs="$add $finalize_deplibs"
+ else
+ test -n "$add_dir" && deplibs="$add_dir $deplibs"
+ test -n "$add" && deplibs="$add $deplibs"
+ fi
+ fi
+ elif test $linkmode = prog; then
+ if test "$alldeplibs" = yes &&
+ { test "$deplibs_check_method" = pass_all ||
+ { test "$build_libtool_libs" = yes &&
+ test -n "$library_names"; }; }; then
+ # We only need to search for static libraries
+ continue
+ fi
+
+ # Try to link the static library
+ # Here we assume that one of hardcode_direct or hardcode_minus_L
+ # is not unsupported. This is valid on all known static and
+ # shared platforms.
+ if test "$hardcode_direct" != unsupported; then
+ test -n "$old_library" && linklib="$old_library"
+ compile_deplibs="$dir/$linklib $compile_deplibs"
+ finalize_deplibs="$dir/$linklib $finalize_deplibs"
+ else
+ compile_deplibs="-l$name -L$dir $compile_deplibs"
+ finalize_deplibs="-l$name -L$dir $finalize_deplibs"
+ fi
+ elif test "$build_libtool_libs" = yes; then
+ # Not a shared library
+ if test "$deplibs_check_method" != pass_all; then
+ # We're trying link a shared library against a static one
+ # but the system doesn't support it.
+
+ # Just print a warning and add the library to dependency_libs so
+ # that the program can be linked against the static library.
+ echo
+ echo "*** Warning: This library needs some functionality provided by $lib."
+ echo "*** I have the capability to make that library automatically link in when"
+ echo "*** you link to this library. But I can only do this if you have a"
+ echo "*** shared version of the library, which you do not appear to have."
+ if test "$module" = yes; then
+ echo "*** Therefore, libtool will create a static module, that should work "
+ echo "*** as long as the dlopening application is linked with the -dlopen flag."
+ if test -z "$global_symbol_pipe"; then
+ echo
+ echo "*** However, this would only work if libtool was able to extract symbol"
+ echo "*** lists from a program, using \`nm' or equivalent, but libtool could"
+ echo "*** not find such a program. So, this module is probably useless."
+ echo "*** \`nm' from GNU binutils and a full rebuild may help."
+ fi
+ if test "$build_old_libs" = no; then
+ build_libtool_libs=module
+ build_old_libs=yes
+ else
+ build_libtool_libs=no
+ fi
+ fi
+ else
+ convenience="$convenience $dir/$old_library"
+ old_convenience="$old_convenience $dir/$old_library"
+ deplibs="$dir/$old_library $deplibs"
+ link_static=yes
+ fi
+ fi # link shared/static library?
+
+ if test $linkmode = lib; then
+ if test -n "$dependency_libs" &&
+ { test $hardcode_into_libs != yes || test $build_old_libs = yes ||
+ test $link_static = yes; }; then
+ # Extract -R from dependency_libs
+ temp_deplibs=
+ for libdir in $dependency_libs; do
+ case $libdir in
+ -R*) temp_xrpath=`$echo "X$libdir" | $Xsed -e 's/^-R//'`
+ case " $xrpath " in
+ *" $temp_xrpath "*) ;;
+ *) xrpath="$xrpath $temp_xrpath";;
+ esac;;
+ *) temp_deplibs="$temp_deplibs $libdir";;
+ esac
+ done
+ dependency_libs="$temp_deplibs"
+ fi
+
+ newlib_search_path="$newlib_search_path $absdir"
+ # Link against this library
+ test "$link_static" = no && newdependency_libs="$abs_ladir/$laname $newdependency_libs"
+ # ... and its dependency_libs
+ tmp_libs=
+ for deplib in $dependency_libs; do
+ newdependency_libs="$deplib $newdependency_libs"
+ case "$tmp_libs " in
+ *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
+ esac
+ tmp_libs="$tmp_libs $deplib"
+ done
+
+ if test $link_all_deplibs != no; then
+ # Add the search paths of all dependency libraries
+ for deplib in $dependency_libs; do
+ case $deplib in
+ -L*) path="$deplib" ;;
+ *.la)
+ dir=`$echo "X$deplib" | $Xsed -e 's%/[^/]*$%%'`
+ test "X$dir" = "X$deplib" && dir="."
+ # We need an absolute path.
+ case $dir in
+ [\\/]* | [A-Za-z]:[\\/]*) absdir="$dir" ;;
+ *)
+ absdir=`cd "$dir" && pwd`
+ if test -z "$absdir"; then
+ $echo "$modename: warning: cannot determine absolute directory name of \`$dir'" 1>&2
+ absdir="$dir"
+ fi
+ ;;
+ esac
+ if grep "^installed=no" $deplib > /dev/null; then
+ path="-L$absdir/$objdir"
+ else
+ eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
+ if test -z "$libdir"; then
+ $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2
+ exit 1
+ fi
+ if test "$absdir" != "$libdir"; then
+ $echo "$modename: warning: \`$deplib' seems to be moved" 1>&2
+ fi
+ path="-L$absdir"
+ fi
+ ;;
+ *) continue ;;
+ esac
+ case " $deplibs " in
+ *" $path "*) ;;
+ *) deplibs="$deplibs $path" ;;
+ esac
+ done
+ fi # link_all_deplibs != no
+ fi # linkmode = lib
+ done # for deplib in $libs
+ if test $pass = dlpreopen; then
+ # Link the dlpreopened libraries before other libraries
+ for deplib in $save_deplibs; do
+ deplibs="$deplib $deplibs"
+ done
+ fi
+ if test $pass != dlopen; then
+ test $pass != scan && dependency_libs="$newdependency_libs"
+ if test $pass != conv; then
+ # Make sure lib_search_path contains only unique directories.
+ lib_search_path=
+ for dir in $newlib_search_path; do
+ case "$lib_search_path " in
+ *" $dir "*) ;;
+ *) lib_search_path="$lib_search_path $dir" ;;
+ esac
+ done
+ newlib_search_path=
+ fi
+
+ if test "$linkmode,$pass" != "prog,link"; then
+ vars="deplibs"
+ else
+ vars="compile_deplibs finalize_deplibs"
+ fi
+ for var in $vars dependency_libs; do
+ # Add libraries to $var in reverse order
+ eval tmp_libs=\"\$$var\"
+ new_libs=
+ for deplib in $tmp_libs; do
+ case $deplib in
+ -L*) new_libs="$deplib $new_libs" ;;
+ *)
+ case " $specialdeplibs " in
+ *" $deplib "*) new_libs="$deplib $new_libs" ;;
+ *)
+ case " $new_libs " in
+ *" $deplib "*) ;;
+ *) new_libs="$deplib $new_libs" ;;
+ esac
+ ;;
+ esac
+ ;;
+ esac
+ done
+ tmp_libs=
+ for deplib in $new_libs; do
+ case $deplib in
+ -L*)
+ case " $tmp_libs " in
+ *" $deplib "*) ;;
+ *) tmp_libs="$tmp_libs $deplib" ;;
+ esac
+ ;;
+ *) tmp_libs="$tmp_libs $deplib" ;;
+ esac
+ done
+ eval $var=\"$tmp_libs\"
+ done # for var
+ fi
+ if test "$pass" = "conv" &&
+ { test "$linkmode" = "lib" || test "$linkmode" = "prog"; }; then
+ libs="$deplibs" # reset libs
+ deplibs=
+ fi
+ done # for pass
+ if test $linkmode = prog; then
+ dlfiles="$newdlfiles"
+ dlprefiles="$newdlprefiles"
+ fi
+
+ case $linkmode in
+ oldlib)
+ if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
+ $echo "$modename: warning: \`-dlopen' is ignored for archives" 1>&2
+ fi
+
+ if test -n "$rpath"; then
+ $echo "$modename: warning: \`-rpath' is ignored for archives" 1>&2
+ fi
+
+ if test -n "$xrpath"; then
+ $echo "$modename: warning: \`-R' is ignored for archives" 1>&2
+ fi
+
+ if test -n "$vinfo"; then
+ $echo "$modename: warning: \`-version-info' is ignored for archives" 1>&2
+ fi
+
+ if test -n "$release"; then
+ $echo "$modename: warning: \`-release' is ignored for archives" 1>&2
+ fi
+
+ if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
+ $echo "$modename: warning: \`-export-symbols' is ignored for archives" 1>&2
+ fi
+
+ # Now set the variables for building old libraries.
+ build_libtool_libs=no
+ oldlibs="$output"
+ objs="$objs$old_deplibs"
+ ;;
+
+ lib)
+ # Make sure we only generate libraries of the form `libNAME.la'.
+ case $outputname in
+ lib*)
+ name=`$echo "X$outputname" | $Xsed -e 's/\.la$//' -e 's/^lib//'`
+ eval libname=\"$libname_spec\"
+ ;;
+ *)
+ if test "$module" = no; then
+ $echo "$modename: libtool library \`$output' must begin with \`lib'" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+ if test "$need_lib_prefix" != no; then
+ # Add the "lib" prefix for modules if required
+ name=`$echo "X$outputname" | $Xsed -e 's/\.la$//'`
+ eval libname=\"$libname_spec\"
+ else
+ libname=`$echo "X$outputname" | $Xsed -e 's/\.la$//'`
+ fi
+ ;;
+ esac
+
+ if test -n "$objs"; then
+ if test "$deplibs_check_method" != pass_all; then
+ $echo "$modename: cannot build libtool library \`$output' from non-libtool objects on this host:$objs" 2>&1
+ exit 1
+ else
+ echo
+ echo "*** Warning: Linking the shared library $output against the non-libtool"
+ echo "*** objects $objs is not portable!"
+ libobjs="$libobjs $objs"
+ fi
+ fi
+
+ if test "$dlself" != no; then
+ $echo "$modename: warning: \`-dlopen self' is ignored for libtool libraries" 1>&2
+ fi
+
+ set dummy $rpath
+ if test $# -gt 2; then
+ $echo "$modename: warning: ignoring multiple \`-rpath's for a libtool library" 1>&2
+ fi
+ install_libdir="$2"
+
+ oldlibs=
+ if test -z "$rpath"; then
+ if test "$build_libtool_libs" = yes; then
+ # Building a libtool convenience library.
+ libext=al
+ oldlibs="$output_objdir/$libname.$libext $oldlibs"
+ build_libtool_libs=convenience
+ build_old_libs=yes
+ fi
+
+ if test -n "$vinfo"; then
+ $echo "$modename: warning: \`-version-info' is ignored for convenience libraries" 1>&2
+ fi
+
+ if test -n "$release"; then
+ $echo "$modename: warning: \`-release' is ignored for convenience libraries" 1>&2
+ fi
+ else
+
+ # Parse the version information argument.
+ save_ifs="$IFS"; IFS=':'
+ set dummy $vinfo 0 0 0
+ IFS="$save_ifs"
+
+ if test -n "$8"; then
+ $echo "$modename: too many parameters to \`-version-info'" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ current="$2"
+ revision="$3"
+ age="$4"
+
+ # Check that each of the things are valid numbers.
+ case $current in
+ 0 | [1-9] | [1-9][0-9] | [1-9][0-9][0-9]) ;;
+ *)
+ $echo "$modename: CURRENT \`$current' is not a nonnegative integer" 1>&2
+ $echo "$modename: \`$vinfo' is not valid version information" 1>&2
+ exit 1
+ ;;
+ esac
+
+ case $revision in
+ 0 | [1-9] | [1-9][0-9] | [1-9][0-9][0-9]) ;;
+ *)
+ $echo "$modename: REVISION \`$revision' is not a nonnegative integer" 1>&2
+ $echo "$modename: \`$vinfo' is not valid version information" 1>&2
+ exit 1
+ ;;
+ esac
+
+ case $age in
+ 0 | [1-9] | [1-9][0-9] | [1-9][0-9][0-9]) ;;
+ *)
+ $echo "$modename: AGE \`$age' is not a nonnegative integer" 1>&2
+ $echo "$modename: \`$vinfo' is not valid version information" 1>&2
+ exit 1
+ ;;
+ esac
+
+ if test $age -gt $current; then
+ $echo "$modename: AGE \`$age' is greater than the current interface number \`$current'" 1>&2
+ $echo "$modename: \`$vinfo' is not valid version information" 1>&2
+ exit 1
+ fi
+
+ # Calculate the version variables.
+ major=
+ versuffix=
+ verstring=
+ case $version_type in
+ none) ;;
+
+ darwin)
+ # Like Linux, but with the current version available in
+ # verstring for coding it into the library header
+ major=.`expr $current - $age`
+ versuffix="$major.$age.$revision"
+ # Darwin ld doesn't like 0 for these options...
+ minor_current=`expr $current + 1`
+ verstring="-compatibility_version $minor_current -current_version $minor_current.$revision"
+ ;;
+
+ freebsd-aout)
+ major=".$current"
+ versuffix=".$current.$revision";
+ ;;
+
+ freebsd-elf)
+ major=".$current"
+ versuffix=".$current";
+ ;;
+
+ irix)
+ major=`expr $current - $age + 1`
+ verstring="sgi$major.$revision"
+
+ # Add in all the interfaces that we are compatible with.
+ loop=$revision
+ while test $loop != 0; do
+ iface=`expr $revision - $loop`
+ loop=`expr $loop - 1`
+ verstring="sgi$major.$iface:$verstring"
+ done
+
+ # Before this point, $major must not contain `.'.
+ major=.$major
+ versuffix="$major.$revision"
+ ;;
+
+ linux)
+ major=.`expr $current - $age`
+ versuffix="$major.$age.$revision"
+ ;;
+
+ osf)
+ major=`expr $current - $age`
+ versuffix=".$current.$age.$revision"
+ verstring="$current.$age.$revision"
+
+ # Add in all the interfaces that we are compatible with.
+ loop=$age
+ while test $loop != 0; do
+ iface=`expr $current - $loop`
+ loop=`expr $loop - 1`
+ verstring="$verstring:${iface}.0"
+ done
+
+ # Make executables depend on our current version.
+ verstring="$verstring:${current}.0"
+ ;;
+
+ sunos)
+ major=".$current"
+ versuffix=".$current.$revision"
+ ;;
+
+ windows)
+ # Use '-' rather than '.', since we only want one
+ # extension on DOS 8.3 filesystems.
+ major=`expr $current - $age`
+ versuffix="-$major"
+ ;;
+
+ *)
+ $echo "$modename: unknown library version type \`$version_type'" 1>&2
+ echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2
+ exit 1
+ ;;
+ esac
+
+ # Clear the version info if we defaulted, and they specified a release.
+ if test -z "$vinfo" && test -n "$release"; then
+ major=
+ verstring="0.0"
+ case $version_type in
+ darwin)
+ # we can't check for "0.0" in archive_cmds due to quoting
+ # problems, so we reset it completely
+ verstring=""
+ ;;
+ *)
+ verstring="0.0"
+ ;;
+ esac
+ if test "$need_version" = no; then
+ versuffix=
+ else
+ versuffix=".0.0"
+ fi
+ fi
+
+ # Remove version info from name if versioning should be avoided
+ if test "$avoid_version" = yes && test "$need_version" = no; then
+ major=
+ versuffix=
+ verstring=""
+ fi
+
+ # Check to see if the archive will have undefined symbols.
+ if test "$allow_undefined" = yes; then
+ if test "$allow_undefined_flag" = unsupported; then
+ $echo "$modename: warning: undefined symbols not allowed in $host shared libraries" 1>&2
+ build_libtool_libs=no
+ build_old_libs=yes
+ fi
+ else
+ # Don't allow undefined symbols.
+ allow_undefined_flag="$no_undefined_flag"
+ fi
+ fi
+
+ if test "$mode" != relink; then
+ # Remove our outputs.
+ $show "${rm}r $output_objdir/$outputname $output_objdir/$libname.* $output_objdir/${libname}${release}.*"
+ $run ${rm}r $output_objdir/$outputname $output_objdir/$libname.* $output_objdir/${libname}${release}.*
+ fi
+
+ # Now set the variables for building old libraries.
+ if test "$build_old_libs" = yes && test "$build_libtool_libs" != convenience ; then
+ oldlibs="$oldlibs $output_objdir/$libname.$libext"
+
+ # Transform .lo files to .o files.
+ oldobjs="$objs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e "$lo2o" | $NL2SP`
+ fi
+
+ # Eliminate all temporary directories.
+ for path in $notinst_path; do
+ lib_search_path=`echo "$lib_search_path " | sed -e 's% $path % %g'`
+ deplibs=`echo "$deplibs " | sed -e 's% -L$path % %g'`
+ dependency_libs=`echo "$dependency_libs " | sed -e 's% -L$path % %g'`
+ done
+
+ if test -n "$xrpath"; then
+ # If the user specified any rpath flags, then add them.
+ temp_xrpath=
+ for libdir in $xrpath; do
+ temp_xrpath="$temp_xrpath -R$libdir"
+ case "$finalize_rpath " in
+ *" $libdir "*) ;;
+ *) finalize_rpath="$finalize_rpath $libdir" ;;
+ esac
+ done
+ if test $hardcode_into_libs != yes || test $build_old_libs = yes; then
+ dependency_libs="$temp_xrpath $dependency_libs"
+ fi
+ fi
+
+ # Make sure dlfiles contains only unique files that won't be dlpreopened
+ old_dlfiles="$dlfiles"
+ dlfiles=
+ for lib in $old_dlfiles; do
+ case " $dlprefiles $dlfiles " in
+ *" $lib "*) ;;
+ *) dlfiles="$dlfiles $lib" ;;
+ esac
+ done
+
+ # Make sure dlprefiles contains only unique files
+ old_dlprefiles="$dlprefiles"
+ dlprefiles=
+ for lib in $old_dlprefiles; do
+ case "$dlprefiles " in
+ *" $lib "*) ;;
+ *) dlprefiles="$dlprefiles $lib" ;;
+ esac
+ done
+
+ if test "$build_libtool_libs" = yes; then
+ if test -n "$rpath"; then
+ case $host in
+ *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-beos*)
+ # these systems don't actually have a c library (as such)!
+ ;;
+ *-*-rhapsody* | *-*-darwin1.[012])
+ # Rhapsody C library is in the System framework
+ deplibs="$deplibs -framework System"
+ ;;
+ *-*-netbsd*)
+ # Don't link with libc until the a.out ld.so is fixed.
+ ;;
+ *-*-openbsd*)
+ # Do not include libc due to us having libc/libc_r.
+ ;;
+ *)
+ # Add libc to deplibs on all other systems if necessary.
+ if test $build_libtool_need_lc = "yes"; then
+ deplibs="$deplibs -lc"
+ fi
+ ;;
+ esac
+ fi
+
+ # Transform deplibs into only deplibs that can be linked in shared.
+ name_save=$name
+ libname_save=$libname
+ release_save=$release
+ versuffix_save=$versuffix
+ major_save=$major
+ # I'm not sure if I'm treating the release correctly. I think
+ # release should show up in the -l (ie -lgmp5) so we don't want to
+ # add it in twice. Is that correct?
+ release=""
+ versuffix=""
+ major=""
+ newdeplibs=
+ droppeddeps=no
+ case $deplibs_check_method in
+ pass_all)
+ # Don't check for shared/static. Everything works.
+ # This might be a little naive. We might want to check
+ # whether the library exists or not. But this is on
+ # osf3 & osf4 and I'm not really sure... Just
+ # implementing what was already the behaviour.
+ newdeplibs=$deplibs
+ ;;
+ test_compile)
+ # This code stresses the "libraries are programs" paradigm to its
+ # limits. Maybe even breaks it. We compile a program, linking it
+ # against the deplibs as a proxy for the library. Then we can check
+ # whether they linked in statically or dynamically with ldd.
+ $rm conftest.c
+ cat > conftest.c <<EOF
+ int main() { return 0; }
+EOF
+ $rm conftest
+ $CC -o conftest conftest.c $deplibs
+ if test $? -eq 0 ; then
+ ldd_output=`ldd conftest`
+ for i in $deplibs; do
+ name="`expr $i : '-l\(.*\)'`"
+ # If $name is empty we are operating on a -L argument.
+ if test -n "$name" && test "$name" != "0"; then
+ libname=`eval \\$echo \"$libname_spec\"`
+ deplib_matches=`eval \\$echo \"$library_names_spec\"`
+ set dummy $deplib_matches
+ deplib_match=$2
+ if test `expr "$ldd_output" : ".*$deplib_match"` -ne 0 ; then
+ newdeplibs="$newdeplibs $i"
+ else
+ droppeddeps=yes
+ echo
+ echo "*** Warning: This library needs some functionality provided by $i."
+ echo "*** I have the capability to make that library automatically link in when"
+ echo "*** you link to this library. But I can only do this if you have a"
+ echo "*** shared version of the library, which you do not appear to have."
+ fi
+ else
+ newdeplibs="$newdeplibs $i"
+ fi
+ done
+ else
+ # Error occured in the first compile. Let's try to salvage the situation:
+ # Compile a seperate program for each library.
+ for i in $deplibs; do
+ name="`expr $i : '-l\(.*\)'`"
+ # If $name is empty we are operating on a -L argument.
+ if test -n "$name" && test "$name" != "0"; then
+ $rm conftest
+ $CC -o conftest conftest.c $i
+ # Did it work?
+ if test $? -eq 0 ; then
+ ldd_output=`ldd conftest`
+ libname=`eval \\$echo \"$libname_spec\"`
+ deplib_matches=`eval \\$echo \"$library_names_spec\"`
+ set dummy $deplib_matches
+ deplib_match=$2
+ if test `expr "$ldd_output" : ".*$deplib_match"` -ne 0 ; then
+ newdeplibs="$newdeplibs $i"
+ else
+ droppeddeps=yes
+ echo
+ echo "*** Warning: This library needs some functionality provided by $i."
+ echo "*** I have the capability to make that library automatically link in when"
+ echo "*** you link to this library. But I can only do this if you have a"
+ echo "*** shared version of the library, which you do not appear to have."
+ fi
+ else
+ droppeddeps=yes
+ echo
+ echo "*** Warning! Library $i is needed by this library but I was not able to"
+ echo "*** make it link in! You will probably need to install it or some"
+ echo "*** library that it depends on before this library will be fully"
+ echo "*** functional. Installing it before continuing would be even better."
+ fi
+ else
+ newdeplibs="$newdeplibs $i"
+ fi
+ done
+ fi
+ ;;
+ file_magic*)
+ set dummy $deplibs_check_method
+ file_magic_regex=`expr "$deplibs_check_method" : "$2 \(.*\)"`
+ for a_deplib in $deplibs; do
+ name="`expr $a_deplib : '-l\(.*\)'`"
+ # If $name is empty we are operating on a -L argument.
+ if test -n "$name" && test "$name" != "0"; then
+ libname=`eval \\$echo \"$libname_spec\"`
+ for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do
+ potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
+ for potent_lib in $potential_libs; do
+ # Follow soft links.
+ if ls -lLd "$potent_lib" 2>/dev/null \
+ | grep " -> " >/dev/null; then
+ continue
+ fi
+ # The statement above tries to avoid entering an
+ # endless loop below, in case of cyclic links.
+ # We might still enter an endless loop, since a link
+ # loop can be closed while we follow links,
+ # but so what?
+ potlib="$potent_lib"
+ while test -h "$potlib" 2>/dev/null; do
+ potliblink=`ls -ld $potlib | sed 's/.* -> //'`
+ case $potliblink in
+ [\\/]* | [A-Za-z]:[\\/]*) potlib="$potliblink";;
+ *) potlib=`$echo "X$potlib" | $Xsed -e 's,[^/]*$,,'`"$potliblink";;
+ esac
+ done
+ if eval $file_magic_cmd \"\$potlib\" 2>/dev/null \
+ | sed 10q \
+ | egrep "$file_magic_regex" > /dev/null; then
+ newdeplibs="$newdeplibs $a_deplib"
+ a_deplib=""
+ break 2
+ fi
+ done
+ done
+ if test -n "$a_deplib" ; then
+ droppeddeps=yes
+ echo
+ echo "*** Warning: This library needs some functionality provided by $a_deplib."
+ echo "*** I have the capability to make that library automatically link in when"
+ echo "*** you link to this library. But I can only do this if you have a"
+ echo "*** shared version of the library, which you do not appear to have."
+ fi
+ else
+ # Add a -L argument.
+ newdeplibs="$newdeplibs $a_deplib"
+ fi
+ done # Gone through all deplibs.
+ ;;
+ match_pattern*)
+ set dummy $deplibs_check_method
+ match_pattern_regex=`expr "$deplibs_check_method" : "$2 \(.*\)"`
+ for a_deplib in $deplibs; do
+ name="`expr $a_deplib : '-l\(.*\)'`"
+ # If $name is empty we are operating on a -L argument.
+ if test -n "$name" && test "$name" != "0"; then
+ libname=`eval \\$echo \"$libname_spec\"`
+ for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do
+ potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
+ for potent_lib in $potential_libs; do
+ if eval echo \"$potent_lib\" 2>/dev/null \
+ | sed 10q \
+ | egrep "$match_pattern_regex" > /dev/null; then
+ newdeplibs="$newdeplibs $a_deplib"
+ a_deplib=""
+ break 2
+ fi
+ done
+ done
+ if test -n "$a_deplib" ; then
+ droppeddeps=yes
+ echo
+ echo "*** Warning: This library needs some functionality provided by $a_deplib."
+ echo "*** I have the capability to make that library automatically link in when"
+ echo "*** you link to this library. But I can only do this if you have a"
+ echo "*** shared version of the library, which you do not appear to have."
+ fi
+ else
+ # Add a -L argument.
+ newdeplibs="$newdeplibs $a_deplib"
+ fi
+ done # Gone through all deplibs.
+ ;;
+ none | unknown | *)
+ newdeplibs=""
+ if $echo "X $deplibs" | $Xsed -e 's/ -lc$//' \
+ -e 's/ -[LR][^ ]*//g' -e 's/[ ]//g' |
+ grep . >/dev/null; then
+ echo
+ if test "X$deplibs_check_method" = "Xnone"; then
+ echo "*** Warning: inter-library dependencies are not supported in this platform."
+ else
+ echo "*** Warning: inter-library dependencies are not known to be supported."
+ fi
+ echo "*** All declared inter-library dependencies are being dropped."
+ droppeddeps=yes
+ fi
+ ;;
+ esac
+ versuffix=$versuffix_save
+ major=$major_save
+ release=$release_save
+ libname=$libname_save
+ name=$name_save
+
+ case $host in
+ *-*-rhapsody* | *-*-darwin1.[012])
+ # On Rhapsody replace the C library is the System framework
+ newdeplibs=`$echo "X $newdeplibs" | $Xsed -e 's/ -lc / -framework System /'`
+ ;;
+ esac
+
+ if test "$droppeddeps" = yes; then
+ if test "$module" = yes; then
+ echo
+ echo "*** Warning: libtool could not satisfy all declared inter-library"
+ echo "*** dependencies of module $libname. Therefore, libtool will create"
+ echo "*** a static module, that should work as long as the dlopening"
+ echo "*** application is linked with the -dlopen flag."
+ if test -z "$global_symbol_pipe"; then
+ echo
+ echo "*** However, this would only work if libtool was able to extract symbol"
+ echo "*** lists from a program, using \`nm' or equivalent, but libtool could"
+ echo "*** not find such a program. So, this module is probably useless."
+ echo "*** \`nm' from GNU binutils and a full rebuild may help."
+ fi
+ if test "$build_old_libs" = no; then
+ oldlibs="$output_objdir/$libname.$libext"
+ build_libtool_libs=module
+ build_old_libs=yes
+ else
+ build_libtool_libs=no
+ fi
+ else
+ echo "*** The inter-library dependencies that have been dropped here will be"
+ echo "*** automatically added whenever a program is linked with this library"
+ echo "*** or is declared to -dlopen it."
+
+ if test $allow_undefined = no; then
+ echo
+ echo "*** Since this library must not contain undefined symbols,"
+ echo "*** because either the platform does not support them or"
+ echo "*** it was explicitly requested with -no-undefined,"
+ echo "*** libtool will only create a static version of it."
+ if test "$build_old_libs" = no; then
+ oldlibs="$output_objdir/$libname.$libext"
+ build_libtool_libs=module
+ build_old_libs=yes
+ else
+ build_libtool_libs=no
+ fi
+ fi
+ fi
+ fi
+ # Done checking deplibs!
+ deplibs=$newdeplibs
+ fi
+
+ # All the library-specific variables (install_libdir is set above).
+ library_names=
+ old_library=
+ dlname=
+
+ # Test again, we may have decided not to build it any more
+ if test "$build_libtool_libs" = yes; then
+ if test $hardcode_into_libs = yes; then
+ # Hardcode the library paths
+ hardcode_libdirs=
+ dep_rpath=
+ rpath="$finalize_rpath"
+ test "$mode" != relink && rpath="$compile_rpath$rpath"
+ for libdir in $rpath; do
+ if test -n "$hardcode_libdir_flag_spec"; then
+ if test -n "$hardcode_libdir_separator"; then
+ if test -z "$hardcode_libdirs"; then
+ hardcode_libdirs="$libdir"
+ else
+ # Just accumulate the unique libdirs.
+ case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
+ *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
+ ;;
+ *)
+ hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
+ ;;
+ esac
+ fi
+ else
+ eval flag=\"$hardcode_libdir_flag_spec\"
+ dep_rpath="$dep_rpath $flag"
+ fi
+ elif test -n "$runpath_var"; then
+ case "$perm_rpath " in
+ *" $libdir "*) ;;
+ *) perm_rpath="$perm_rpath $libdir" ;;
+ esac
+ fi
+ done
+ # Substitute the hardcoded libdirs into the rpath.
+ if test -n "$hardcode_libdir_separator" &&
+ test -n "$hardcode_libdirs"; then
+ libdir="$hardcode_libdirs"
+ eval dep_rpath=\"$hardcode_libdir_flag_spec\"
+ fi
+ if test -n "$runpath_var" && test -n "$perm_rpath"; then
+ # We should set the runpath_var.
+ rpath=
+ for dir in $perm_rpath; do
+ rpath="$rpath$dir:"
+ done
+ eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var"
+ fi
+ test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs"
+ fi
+
+ shlibpath="$finalize_shlibpath"
+ test "$mode" != relink && shlibpath="$compile_shlibpath$shlibpath"
+ if test -n "$shlibpath"; then
+ eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var"
+ fi
+
+ # Get the real and link names of the library.
+ eval library_names=\"$library_names_spec\"
+ set dummy $library_names
+ realname="$2"
+ shift; shift
+
+ if test -n "$soname_spec"; then
+ eval soname=\"$soname_spec\"
+ else
+ soname="$realname"
+ fi
+ test -z "$dlname" && dlname=$soname
+
+ lib="$output_objdir/$realname"
+ for link
+ do
+ linknames="$linknames $link"
+ done
+
+ # Ensure that we have .o objects for linkers which dislike .lo
+ # (e.g. aix) in case we are running --disable-static
+ for obj in $libobjs; do
+ xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'`
+ if test "X$xdir" = "X$obj"; then
+ xdir="."
+ else
+ xdir="$xdir"
+ fi
+ baseobj=`$echo "X$obj" | $Xsed -e 's%^.*/%%'`
+ oldobj=`$echo "X$baseobj" | $Xsed -e "$lo2o"`
+ if test ! -f $xdir/$oldobj; then
+ $show "(cd $xdir && ${LN_S} $baseobj $oldobj)"
+ $run eval '(cd $xdir && ${LN_S} $baseobj $oldobj)' || exit $?
+ fi
+ done
+
+ # Use standard objects if they are pic
+ test -z "$pic_flag" && libobjs=`$echo "X$libobjs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
+
+ # Prepare the list of exported symbols
+ if test -z "$export_symbols"; then
+ if test "$always_export_symbols" = yes || test -n "$export_symbols_regex"; then
+ $show "generating symbol list for \`$libname.la'"
+ export_symbols="$output_objdir/$libname.exp"
+ $run $rm $export_symbols
+ eval cmds=\"$export_symbols_cmds\"
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ if test -n "$export_symbols_regex"; then
+ $show "egrep -e \"$export_symbols_regex\" \"$export_symbols\" > \"${export_symbols}T\""
+ $run eval 'egrep -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
+ $show "$mv \"${export_symbols}T\" \"$export_symbols\""
+ $run eval '$mv "${export_symbols}T" "$export_symbols"'
+ fi
+ fi
+ fi
+
+ if test -n "$export_symbols" && test -n "$include_expsyms"; then
+ $run eval '$echo "X$include_expsyms" | $SP2NL >> "$export_symbols"'
+ fi
+
+ if test -n "$convenience"; then
+ if test -n "$whole_archive_flag_spec"; then
+ eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
+ else
+ gentop="$output_objdir/${outputname}x"
+ $show "${rm}r $gentop"
+ $run ${rm}r "$gentop"
+ $show "mkdir $gentop"
+ $run mkdir "$gentop"
+ status=$?
+ if test $status -ne 0 && test ! -d "$gentop"; then
+ exit $status
+ fi
+ generated="$generated $gentop"
+
+ for xlib in $convenience; do
+ # Extract the objects.
+ case $xlib in
+ [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
+ *) xabs=`pwd`"/$xlib" ;;
+ esac
+ xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
+ xdir="$gentop/$xlib"
+
+ $show "${rm}r $xdir"
+ $run ${rm}r "$xdir"
+ $show "mkdir $xdir"
+ $run mkdir "$xdir"
+ status=$?
+ if test $status -ne 0 && test ! -d "$xdir"; then
+ exit $status
+ fi
+ $show "(cd $xdir && $AR x $xabs)"
+ $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
+
+ libobjs="$libobjs "`find $xdir -name \*.o -print -o -name \*.lo -print | $NL2SP`
+ done
+ fi
+ fi
+
+ if test "$thread_safe" = yes && test -n "$thread_safe_flag_spec"; then
+ eval flag=\"$thread_safe_flag_spec\"
+ linker_flags="$linker_flags $flag"
+ fi
+
+ # Make a backup of the uninstalled library when relinking
+ if test "$mode" = relink; then
+ $run eval '(cd $output_objdir && $rm ${realname}U && $mv $realname ${realname}U)' || exit $?
+ fi
+
+ # Do each of the archive commands.
+ if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
+ eval cmds=\"$archive_expsym_cmds\"
+ else
+ eval cmds=\"$archive_cmds\"
+ fi
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+
+ # Restore the uninstalled library and exit
+ if test "$mode" = relink; then
+ $run eval '(cd $output_objdir && $rm ${realname}T && $mv $realname ${realname}T && $mv "$realname"U $realname)' || exit $?
+ exit 0
+ fi
+
+ # Create links to the real library.
+ for linkname in $linknames; do
+ if test "$realname" != "$linkname"; then
+ $show "(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)"
+ $run eval '(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)' || exit $?
+ fi
+ done
+
+ # If -module or -export-dynamic was specified, set the dlname.
+ if test "$module" = yes || test "$export_dynamic" = yes; then
+ # On all known operating systems, these are identical.
+ dlname="$soname"
+ fi
+ fi
+ ;;
+
+ obj)
+ if test -n "$deplibs"; then
+ $echo "$modename: warning: \`-l' and \`-L' are ignored for objects" 1>&2
+ fi
+
+ if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
+ $echo "$modename: warning: \`-dlopen' is ignored for objects" 1>&2
+ fi
+
+ if test -n "$rpath"; then
+ $echo "$modename: warning: \`-rpath' is ignored for objects" 1>&2
+ fi
+
+ if test -n "$xrpath"; then
+ $echo "$modename: warning: \`-R' is ignored for objects" 1>&2
+ fi
+
+ if test -n "$vinfo"; then
+ $echo "$modename: warning: \`-version-info' is ignored for objects" 1>&2
+ fi
+
+ if test -n "$release"; then
+ $echo "$modename: warning: \`-release' is ignored for objects" 1>&2
+ fi
+
+ case $output in
+ *.lo)
+ if test -n "$objs$old_deplibs"; then
+ $echo "$modename: cannot build library object \`$output' from non-libtool objects" 1>&2
+ exit 1
+ fi
+ libobj="$output"
+ obj=`$echo "X$output" | $Xsed -e "$lo2o"`
+ ;;
+ *)
+ libobj=
+ obj="$output"
+ ;;
+ esac
+
+ # Delete the old objects.
+ $run $rm $obj $libobj
+
+ # Objects from convenience libraries. This assumes
+ # single-version convenience libraries. Whenever we create
+ # different ones for PIC/non-PIC, this we'll have to duplicate
+ # the extraction.
+ reload_conv_objs=
+ gentop=
+ # reload_cmds runs $LD directly, so let us get rid of
+ # -Wl from whole_archive_flag_spec
+ wl=
+
+ if test -n "$convenience"; then
+ if test -n "$whole_archive_flag_spec"; then
+ eval reload_conv_objs=\"\$reload_objs $whole_archive_flag_spec\"
+ else
+ gentop="$output_objdir/${obj}x"
+ $show "${rm}r $gentop"
+ $run ${rm}r "$gentop"
+ $show "mkdir $gentop"
+ $run mkdir "$gentop"
+ status=$?
+ if test $status -ne 0 && test ! -d "$gentop"; then
+ exit $status
+ fi
+ generated="$generated $gentop"
+
+ for xlib in $convenience; do
+ # Extract the objects.
+ case $xlib in
+ [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
+ *) xabs=`pwd`"/$xlib" ;;
+ esac
+ xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
+ xdir="$gentop/$xlib"
+
+ $show "${rm}r $xdir"
+ $run ${rm}r "$xdir"
+ $show "mkdir $xdir"
+ $run mkdir "$xdir"
+ status=$?
+ if test $status -ne 0 && test ! -d "$xdir"; then
+ exit $status
+ fi
+ $show "(cd $xdir && $AR x $xabs)"
+ $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
+
+ reload_conv_objs="$reload_objs "`find $xdir -name \*.o -print -o -name \*.lo -print | $NL2SP`
+ done
+ fi
+ fi
+
+ # Create the old-style object.
+ reload_objs="$objs$old_deplibs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}$'/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`" $reload_conv_objs" ### testsuite: skip nested quoting test
+
+ output="$obj"
+ eval cmds=\"$reload_cmds\"
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+
+ # Exit if we aren't doing a library object file.
+ if test -z "$libobj"; then
+ if test -n "$gentop"; then
+ $show "${rm}r $gentop"
+ $run ${rm}r $gentop
+ fi
+
+ exit 0
+ fi
+
+ if test "$build_libtool_libs" != yes; then
+ if test -n "$gentop"; then
+ $show "${rm}r $gentop"
+ $run ${rm}r $gentop
+ fi
+
+ # Create an invalid libtool object if no PIC, so that we don't
+ # accidentally link it into a program.
+ $show "echo timestamp > $libobj"
+ $run eval "echo timestamp > $libobj" || exit $?
+ exit 0
+ fi
+
+ if test -n "$pic_flag" || test "$pic_mode" != default; then
+ # Only do commands if we really have different PIC objects.
+ reload_objs="$libobjs $reload_conv_objs"
+ output="$libobj"
+ eval cmds=\"$reload_cmds\"
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ else
+ # Just create a symlink.
+ $show $rm $libobj
+ $run $rm $libobj
+ xdir=`$echo "X$libobj" | $Xsed -e 's%/[^/]*$%%'`
+ if test "X$xdir" = "X$libobj"; then
+ xdir="."
+ else
+ xdir="$xdir"
+ fi
+ baseobj=`$echo "X$libobj" | $Xsed -e 's%^.*/%%'`
+ oldobj=`$echo "X$baseobj" | $Xsed -e "$lo2o"`
+ $show "(cd $xdir && $LN_S $oldobj $baseobj)"
+ $run eval '(cd $xdir && $LN_S $oldobj $baseobj)' || exit $?
+ fi
+
+ if test -n "$gentop"; then
+ $show "${rm}r $gentop"
+ $run ${rm}r $gentop
+ fi
+
+ exit 0
+ ;;
+
+ prog)
+ case $host in
+ *cygwin*) output=`echo $output | sed -e 's,.exe$,,;s,$,.exe,'` ;;
+ esac
+ if test -n "$vinfo"; then
+ $echo "$modename: warning: \`-version-info' is ignored for programs" 1>&2
+ fi
+
+ if test -n "$release"; then
+ $echo "$modename: warning: \`-release' is ignored for programs" 1>&2
+ fi
+
+ if test "$preload" = yes; then
+ if test "$dlopen_support" = unknown && test "$dlopen_self" = unknown &&
+ test "$dlopen_self_static" = unknown; then
+ $echo "$modename: warning: \`AC_LIBTOOL_DLOPEN' not used. Assuming no dlopen support."
+ fi
+ fi
+
+ case $host in
+ *-*-rhapsody* | *-*-darwin1.[012])
+ # On Rhapsody replace the C library is the System framework
+ compile_deplibs=`$echo "X $compile_deplibs" | $Xsed -e 's/ -lc / -framework System /'`
+ finalize_deplibs=`$echo "X $finalize_deplibs" | $Xsed -e 's/ -lc / -framework System /'`
+ ;;
+ esac
+
+ compile_command="$compile_command $compile_deplibs"
+ finalize_command="$finalize_command $finalize_deplibs"
+
+ if test -n "$rpath$xrpath"; then
+ # If the user specified any rpath flags, then add them.
+ for libdir in $rpath $xrpath; do
+ # This is the magic to use -rpath.
+ case "$finalize_rpath " in
+ *" $libdir "*) ;;
+ *) finalize_rpath="$finalize_rpath $libdir" ;;
+ esac
+ done
+ fi
+
+ # Now hardcode the library paths
+ rpath=
+ hardcode_libdirs=
+ for libdir in $compile_rpath $finalize_rpath; do
+ if test -n "$hardcode_libdir_flag_spec"; then
+ if test -n "$hardcode_libdir_separator"; then
+ if test -z "$hardcode_libdirs"; then
+ hardcode_libdirs="$libdir"
+ else
+ # Just accumulate the unique libdirs.
+ case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
+ *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
+ ;;
+ *)
+ hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
+ ;;
+ esac
+ fi
+ else
+ eval flag=\"$hardcode_libdir_flag_spec\"
+ rpath="$rpath $flag"
+ fi
+ elif test -n "$runpath_var"; then
+ case "$perm_rpath " in
+ *" $libdir "*) ;;
+ *) perm_rpath="$perm_rpath $libdir" ;;
+ esac
+ fi
+ case $host in
+ *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2*)
+ case :$dllsearchpath: in
+ *":$libdir:"*) ;;
+ *) dllsearchpath="$dllsearchpath:$libdir";;
+ esac
+ ;;
+ esac
+ done
+ # Substitute the hardcoded libdirs into the rpath.
+ if test -n "$hardcode_libdir_separator" &&
+ test -n "$hardcode_libdirs"; then
+ libdir="$hardcode_libdirs"
+ eval rpath=\" $hardcode_libdir_flag_spec\"
+ fi
+ compile_rpath="$rpath"
+
+ rpath=
+ hardcode_libdirs=
+ for libdir in $finalize_rpath; do
+ if test -n "$hardcode_libdir_flag_spec"; then
+ if test -n "$hardcode_libdir_separator"; then
+ if test -z "$hardcode_libdirs"; then
+ hardcode_libdirs="$libdir"
+ else
+ # Just accumulate the unique libdirs.
+ case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
+ *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
+ ;;
+ *)
+ hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
+ ;;
+ esac
+ fi
+ else
+ eval flag=\"$hardcode_libdir_flag_spec\"
+ rpath="$rpath $flag"
+ fi
+ elif test -n "$runpath_var"; then
+ case "$finalize_perm_rpath " in
+ *" $libdir "*) ;;
+ *) finalize_perm_rpath="$finalize_perm_rpath $libdir" ;;
+ esac
+ fi
+ done
+ # Substitute the hardcoded libdirs into the rpath.
+ if test -n "$hardcode_libdir_separator" &&
+ test -n "$hardcode_libdirs"; then
+ libdir="$hardcode_libdirs"
+ eval rpath=\" $hardcode_libdir_flag_spec\"
+ fi
+ finalize_rpath="$rpath"
+
+ if test -n "$libobjs" && test "$build_old_libs" = yes; then
+ # Transform all the library objects into standard objects.
+ compile_command=`$echo "X$compile_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
+ finalize_command=`$echo "X$finalize_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
+ fi
+
+ dlsyms=
+ if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
+ if test -n "$NM" && test -n "$global_symbol_pipe"; then
+ dlsyms="${outputname}S.c"
+ else
+ $echo "$modename: not configured to extract global symbols from dlpreopened files" 1>&2
+ fi
+ fi
+
+ if test -n "$dlsyms"; then
+ case $dlsyms in
+ "") ;;
+ *.c)
+ # Discover the nlist of each of the dlfiles.
+ nlist="$output_objdir/${outputname}.nm"
+
+ $show "$rm $nlist ${nlist}S ${nlist}T"
+ $run $rm "$nlist" "${nlist}S" "${nlist}T"
+
+ # Parse the name list into a source file.
+ $show "creating $output_objdir/$dlsyms"
+
+ test -z "$run" && $echo > "$output_objdir/$dlsyms" "\
+/* $dlsyms - symbol resolution table for \`$outputname' dlsym emulation. */
+/* Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP */
+
+#ifdef __cplusplus
+extern \"C\" {
+#endif
+
+/* Prevent the only kind of declaration conflicts we can make. */
+#define lt_preloaded_symbols some_other_symbol
+
+/* External symbol declarations for the compiler. */\
+"
+
+ if test "$dlself" = yes; then
+ $show "generating symbol list for \`$output'"
+
+ test -z "$run" && $echo ': @PROGRAM@ ' > "$nlist"
+
+ # Add our own program objects to the symbol list.
+ progfiles=`$echo "X$objs$old_deplibs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
+ for arg in $progfiles; do
+ $show "extracting global C symbols from \`$arg'"
+ $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'"
+ done
+
+ if test -n "$exclude_expsyms"; then
+ $run eval 'egrep -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T'
+ $run eval '$mv "$nlist"T "$nlist"'
+ fi
+
+ if test -n "$export_symbols_regex"; then
+ $run eval 'egrep -e "$export_symbols_regex" "$nlist" > "$nlist"T'
+ $run eval '$mv "$nlist"T "$nlist"'
+ fi
+
+ # Prepare the list of exported symbols
+ if test -z "$export_symbols"; then
+ export_symbols="$output_objdir/$output.exp"
+ $run $rm $export_symbols
+ $run eval "sed -n -e '/^: @PROGRAM@$/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"'
+ else
+ $run eval "sed -e 's/\([][.*^$]\)/\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$output.exp"'
+ $run eval 'grep -f "$output_objdir/$output.exp" < "$nlist" > "$nlist"T'
+ $run eval 'mv "$nlist"T "$nlist"'
+ fi
+ fi
+
+ for arg in $dlprefiles; do
+ $show "extracting global C symbols from \`$arg'"
+ name=`echo "$arg" | sed -e 's%^.*/%%'`
+ $run eval 'echo ": $name " >> "$nlist"'
+ $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'"
+ done
+
+ if test -z "$run"; then
+ # Make sure we have at least an empty file.
+ test -f "$nlist" || : > "$nlist"
+
+ if test -n "$exclude_expsyms"; then
+ egrep -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T
+ $mv "$nlist"T "$nlist"
+ fi
+
+ # Try sorting and uniquifying the output.
+ if grep -v "^: " < "$nlist" | sort +2 | uniq > "$nlist"S; then
+ :
+ else
+ grep -v "^: " < "$nlist" > "$nlist"S
+ fi
+
+ if test -f "$nlist"S; then
+ eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$dlsyms"'
+ else
+ echo '/* NONE */' >> "$output_objdir/$dlsyms"
+ fi
+
+ $echo >> "$output_objdir/$dlsyms" "\
+
+#undef lt_preloaded_symbols
+
+#if defined (__STDC__) && __STDC__
+# define lt_ptr void *
+#else
+# define lt_ptr char *
+# define const
+#endif
+
+/* The mapping between symbol names and symbols. */
+const struct {
+ const char *name;
+ lt_ptr address;
+}
+lt_preloaded_symbols[] =
+{\
+"
+
+ eval "$global_symbol_to_c_name_address" < "$nlist" >> "$output_objdir/$dlsyms"
+
+ $echo >> "$output_objdir/$dlsyms" "\
+ {0, (lt_ptr) 0}
+};
+
+/* This works around a problem in FreeBSD linker */
+#ifdef FREEBSD_WORKAROUND
+static const void *lt_preloaded_setup() {
+ return lt_preloaded_symbols;
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif\
+"
+ fi
+
+ pic_flag_for_symtable=
+ case $host in
+ # compiling the symbol table file with pic_flag works around
+ # a FreeBSD bug that causes programs to crash when -lm is
+ # linked before any other PIC object. But we must not use
+ # pic_flag when linking with -static. The problem exists in
+ # FreeBSD 2.2.6 and is fixed in FreeBSD 3.1.
+ *-*-freebsd2*|*-*-freebsd3.0*|*-*-freebsdelf3.0*)
+ case "$compile_command " in
+ *" -static "*) ;;
+ *) pic_flag_for_symtable=" $pic_flag -DPIC -DFREEBSD_WORKAROUND";;
+ esac;;
+ *-*-hpux*)
+ case "$compile_command " in
+ *" -static "*) ;;
+ *) pic_flag_for_symtable=" $pic_flag -DPIC";;
+ esac
+ esac
+
+ # Now compile the dynamic symbol file.
+ $show "(cd $output_objdir && $CC -c$no_builtin_flag$pic_flag_for_symtable \"$dlsyms\")"
+ $run eval '(cd $output_objdir && $CC -c$no_builtin_flag$pic_flag_for_symtable "$dlsyms")' || exit $?
+
+ # Clean up the generated files.
+ $show "$rm $output_objdir/$dlsyms $nlist ${nlist}S ${nlist}T"
+ $run $rm "$output_objdir/$dlsyms" "$nlist" "${nlist}S" "${nlist}T"
+
+ # Transform the symbol file into the correct name.
+ compile_command=`$echo "X$compile_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"`
+ finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"`
+ ;;
+ *)
+ $echo "$modename: unknown suffix for \`$dlsyms'" 1>&2
+ exit 1
+ ;;
+ esac
+ else
+ # We keep going just in case the user didn't refer to
+ # lt_preloaded_symbols. The linker will fail if global_symbol_pipe
+ # really was required.
+
+ # Nullify the symbol file.
+ compile_command=`$echo "X$compile_command" | $Xsed -e "s% @SYMFILE@%%"`
+ finalize_command=`$echo "X$finalize_command" | $Xsed -e "s% @SYMFILE@%%"`
+ fi
+
+ if test $need_relink = no || test "$build_libtool_libs" != yes; then
+ # Replace the output file specification.
+ compile_command=`$echo "X$compile_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'`
+ link_command="$compile_command$compile_rpath"
+
+ # We have no uninstalled library dependencies, so finalize right now.
+ $show "$link_command"
+ $run eval "$link_command"
+ status=$?
+
+ # Delete the generated files.
+ if test -n "$dlsyms"; then
+ $show "$rm $output_objdir/${outputname}S.${objext}"
+ $run $rm "$output_objdir/${outputname}S.${objext}"
+ fi
+
+ exit $status
+ fi
+
+ if test -n "$shlibpath_var"; then
+ # We should set the shlibpath_var
+ rpath=
+ for dir in $temp_rpath; do
+ case $dir in
+ [\\/]* | [A-Za-z]:[\\/]*)
+ # Absolute path.
+ rpath="$rpath$dir:"
+ ;;
+ *)
+ # Relative path: add a thisdir entry.
+ rpath="$rpath\$thisdir/$dir:"
+ ;;
+ esac
+ done
+ temp_rpath="$rpath"
+ fi
+
+ if test -n "$compile_shlibpath$finalize_shlibpath"; then
+ compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command"
+ fi
+ if test -n "$finalize_shlibpath"; then
+ finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command"
+ fi
+
+ compile_var=
+ finalize_var=
+ if test -n "$runpath_var"; then
+ if test -n "$perm_rpath"; then
+ # We should set the runpath_var.
+ rpath=
+ for dir in $perm_rpath; do
+ rpath="$rpath$dir:"
+ done
+ compile_var="$runpath_var=\"$rpath\$$runpath_var\" "
+ fi
+ if test -n "$finalize_perm_rpath"; then
+ # We should set the runpath_var.
+ rpath=
+ for dir in $finalize_perm_rpath; do
+ rpath="$rpath$dir:"
+ done
+ finalize_var="$runpath_var=\"$rpath\$$runpath_var\" "
+ fi
+ fi
+
+ if test "$no_install" = yes; then
+ # We don't need to create a wrapper script.
+ link_command="$compile_var$compile_command$compile_rpath"
+ # Replace the output file specification.
+ link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'`
+ # Delete the old output file.
+ $run $rm $output
+ # Link the executable and exit
+ $show "$link_command"
+ $run eval "$link_command" || exit $?
+ exit 0
+ fi
+
+ if test "$hardcode_action" = relink; then
+ # Fast installation is not supported
+ link_command="$compile_var$compile_command$compile_rpath"
+ relink_command="$finalize_var$finalize_command$finalize_rpath"
+
+ $echo "$modename: warning: this platform does not like uninstalled shared libraries" 1>&2
+ $echo "$modename: \`$output' will be relinked during installation" 1>&2
+ else
+ if test "$fast_install" != no; then
+ link_command="$finalize_var$compile_command$finalize_rpath"
+ if test "$fast_install" = yes; then
+ relink_command=`$echo "X$compile_var$compile_command$compile_rpath" | $Xsed -e 's%@OUTPUT@%\$progdir/\$file%g'`
+ else
+ # fast_install is set to needless
+ relink_command=
+ fi
+ else
+ link_command="$compile_var$compile_command$compile_rpath"
+ relink_command="$finalize_var$finalize_command$finalize_rpath"
+ fi
+ fi
+
+ # Replace the output file specification.
+ link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'`
+
+ # Delete the old output files.
+ $run $rm $output $output_objdir/$outputname $output_objdir/lt-$outputname
+
+ $show "$link_command"
+ $run eval "$link_command" || exit $?
+
+ # Now create the wrapper script.
+ $show "creating $output"
+
+ # Quote the relink command for shipping.
+ if test -n "$relink_command"; then
+ # Preserve any variables that may affect compiler behavior
+ for var in $variables_saved_for_relink; do
+ if eval test -z \"\${$var+set}\"; then
+ relink_command="{ test -z \"\${$var+set}\" || unset $var || { $var=; export $var; }; }; $relink_command"
+ elif eval var_value=\$$var; test -z "$var_value"; then
+ relink_command="$var=; export $var; $relink_command"
+ else
+ var_value=`$echo "X$var_value" | $Xsed -e "$sed_quote_subst"`
+ relink_command="$var=\"$var_value\"; export $var; $relink_command"
+ fi
+ done
+ relink_command="cd `pwd`; $relink_command"
+ relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"`
+ fi
+
+ # Quote $echo for shipping.
+ if test "X$echo" = "X$SHELL $0 --fallback-echo"; then
+ case $0 in
+ [\\/]* | [A-Za-z]:[\\/]*) qecho="$SHELL $0 --fallback-echo";;
+ *) qecho="$SHELL `pwd`/$0 --fallback-echo";;
+ esac
+ qecho=`$echo "X$qecho" | $Xsed -e "$sed_quote_subst"`
+ else
+ qecho=`$echo "X$echo" | $Xsed -e "$sed_quote_subst"`
+ fi
+
+ # Only actually do things if our run command is non-null.
+ if test -z "$run"; then
+ # win32 will think the script is a binary if it has
+ # a .exe suffix, so we strip it off here.
+ case $output in
+ *.exe) output=`echo $output|sed 's,.exe$,,'` ;;
+ esac
+ # test for cygwin because mv fails w/o .exe extensions
+ case $host in
+ *cygwin*) exeext=.exe ;;
+ *) exeext= ;;
+ esac
+ $rm $output
+ trap "$rm $output; exit 1" 1 2 15
+
+ $echo > $output "\
+#! $SHELL
+
+# $output - temporary wrapper script for $objdir/$outputname
+# Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP
+#
+# The $output program cannot be directly executed until all the libtool
+# libraries that it depends on are installed.
+#
+# This wrapper script should never be moved out of the build directory.
+# If it is, it will not operate correctly.
+
+# Sed substitution that helps us do robust quoting. It backslashifies
+# metacharacters that are still active within double-quoted strings.
+Xsed='sed -e 1s/^X//'
+sed_quote_subst='$sed_quote_subst'
+
+# The HP-UX ksh and POSIX shell print the target directory to stdout
+# if CDPATH is set.
+if test \"\${CDPATH+set}\" = set; then CDPATH=:; export CDPATH; fi
+
+relink_command=\"$relink_command\"
+
+# This environment variable determines our operation mode.
+if test \"\$libtool_install_magic\" = \"$magic\"; then
+ # install mode needs the following variable:
+ notinst_deplibs='$notinst_deplibs'
+else
+ # When we are sourced in execute mode, \$file and \$echo are already set.
+ if test \"\$libtool_execute_magic\" != \"$magic\"; then
+ echo=\"$qecho\"
+ file=\"\$0\"
+ # Make sure echo works.
+ if test \"X\$1\" = X--no-reexec; then
+ # Discard the --no-reexec flag, and continue.
+ shift
+ elif test \"X\`(\$echo '\t') 2>/dev/null\`\" = 'X\t'; then
+ # Yippee, \$echo works!
+ :
+ else
+ # Restart under the correct shell, and then maybe \$echo will work.
+ exec $SHELL \"\$0\" --no-reexec \${1+\"\$@\"}
+ fi
+ fi\
+"
+ $echo >> $output "\
+
+ # Find the directory that this script lives in.
+ thisdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*$%%'\`
+ test \"x\$thisdir\" = \"x\$file\" && thisdir=.
+
+ # Follow symbolic links until we get to the real thisdir.
+ file=\`ls -ld \"\$file\" | sed -n 's/.*-> //p'\`
+ while test -n \"\$file\"; do
+ destdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*\$%%'\`
+
+ # If there was a directory component, then change thisdir.
+ if test \"x\$destdir\" != \"x\$file\"; then
+ case \"\$destdir\" in
+ [\\\\/]* | [A-Za-z]:[\\\\/]*) thisdir=\"\$destdir\" ;;
+ *) thisdir=\"\$thisdir/\$destdir\" ;;
+ esac
+ fi
+
+ file=\`\$echo \"X\$file\" | \$Xsed -e 's%^.*/%%'\`
+ file=\`ls -ld \"\$thisdir/\$file\" | sed -n 's/.*-> //p'\`
+ done
+
+ # Try to get the absolute directory name.
+ absdir=\`cd \"\$thisdir\" && pwd\`
+ test -n \"\$absdir\" && thisdir=\"\$absdir\"
+"
+
+ if test "$fast_install" = yes; then
+ echo >> $output "\
+ program=lt-'$outputname'$exeext
+ progdir=\"\$thisdir/$objdir\"
+
+ if test ! -f \"\$progdir/\$program\" || \\
+ { file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | sed 1q\`; \\
+ test \"X\$file\" != \"X\$progdir/\$program\"; }; then
+
+ file=\"\$\$-\$program\"
+
+ if test ! -d \"\$progdir\"; then
+ $mkdir \"\$progdir\"
+ else
+ $rm \"\$progdir/\$file\"
+ fi"
+
+ echo >> $output "\
+
+ # relink executable if necessary
+ if test -n \"\$relink_command\"; then
+ if relink_command_output=\`eval \$relink_command 2>&1\`; then :
+ else
+ $echo \"\$relink_command_output\" >&2
+ $rm \"\$progdir/\$file\"
+ exit 1
+ fi
+ fi
+
+ $mv \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null ||
+ { $rm \"\$progdir/\$program\";
+ $mv \"\$progdir/\$file\" \"\$progdir/\$program\"; }
+ $rm \"\$progdir/\$file\"
+ fi"
+ else
+ echo >> $output "\
+ program='$outputname'
+ progdir=\"\$thisdir/$objdir\"
+"
+ fi
+
+ echo >> $output "\
+
+ if test -f \"\$progdir/\$program\"; then"
+
+ # Export our shlibpath_var if we have one.
+ if test "$shlibpath_overrides_runpath" = yes && test -n "$shlibpath_var" && test -n "$temp_rpath"; then
+ $echo >> $output "\
+ # Add our own library path to $shlibpath_var
+ $shlibpath_var=\"$temp_rpath\$$shlibpath_var\"
+
+ # Some systems cannot cope with colon-terminated $shlibpath_var
+ # The second colon is a workaround for a bug in BeOS R4 sed
+ $shlibpath_var=\`\$echo \"X\$$shlibpath_var\" | \$Xsed -e 's/::*\$//'\`
+
+ export $shlibpath_var
+"
+ fi
+
+ # fixup the dll searchpath if we need to.
+ if test -n "$dllsearchpath"; then
+ $echo >> $output "\
+ # Add the dll search path components to the executable PATH
+ PATH=$dllsearchpath:\$PATH
+"
+ fi
+
+ $echo >> $output "\
+ if test \"\$libtool_execute_magic\" != \"$magic\"; then
+ # Run the actual program with our arguments.
+"
+ case $host in
+ # win32 systems need to use the prog path for dll
+ # lookup to work
+ *-*-cygwin* | *-*-pw32*)
+ $echo >> $output "\
+ exec \$progdir/\$program \${1+\"\$@\"}
+"
+ ;;
+
+ # Backslashes separate directories on plain windows
+ *-*-mingw | *-*-os2*)
+ $echo >> $output "\
+ exec \$progdir\\\\\$program \${1+\"\$@\"}
+"
+ ;;
+
+ *)
+ $echo >> $output "\
+ # Export the path to the program.
+ PATH=\"\$progdir:\$PATH\"
+ export PATH
+
+ exec \$program \${1+\"\$@\"}
+"
+ ;;
+ esac
+ $echo >> $output "\
+ \$echo \"\$0: cannot exec \$program \${1+\"\$@\"}\"
+ exit 1
+ fi
+ else
+ # The program doesn't exist.
+ \$echo \"\$0: error: \$progdir/\$program does not exist\" 1>&2
+ \$echo \"This script is just a wrapper for \$program.\" 1>&2
+ echo \"See the $PACKAGE documentation for more information.\" 1>&2
+ exit 1
+ fi
+fi\
+"
+ chmod +x $output
+ fi
+ exit 0
+ ;;
+ esac
+
+ # See if we need to build an old-fashioned archive.
+ for oldlib in $oldlibs; do
+
+ if test "$build_libtool_libs" = convenience; then
+ oldobjs="$libobjs_save"
+ addlibs="$convenience"
+ build_libtool_libs=no
+ else
+ if test "$build_libtool_libs" = module; then
+ oldobjs="$libobjs_save"
+ build_libtool_libs=no
+ else
+ oldobjs="$objs$old_deplibs "`$echo "X$libobjs_save" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`
+ fi
+ addlibs="$old_convenience"
+ fi
+
+ if test -n "$addlibs"; then
+ gentop="$output_objdir/${outputname}x"
+ $show "${rm}r $gentop"
+ $run ${rm}r "$gentop"
+ $show "mkdir $gentop"
+ $run mkdir "$gentop"
+ status=$?
+ if test $status -ne 0 && test ! -d "$gentop"; then
+ exit $status
+ fi
+ generated="$generated $gentop"
+
+ # Add in members from convenience archives.
+ for xlib in $addlibs; do
+ # Extract the objects.
+ case $xlib in
+ [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
+ *) xabs=`pwd`"/$xlib" ;;
+ esac
+ xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
+ xdir="$gentop/$xlib"
+
+ $show "${rm}r $xdir"
+ $run ${rm}r "$xdir"
+ $show "mkdir $xdir"
+ $run mkdir "$xdir"
+ status=$?
+ if test $status -ne 0 && test ! -d "$xdir"; then
+ exit $status
+ fi
+ $show "(cd $xdir && $AR x $xabs)"
+ $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
+
+ oldobjs="$oldobjs "`find $xdir -name \*.${objext} -print -o -name \*.lo -print | $NL2SP`
+ done
+ fi
+
+ # Do each command in the archive commands.
+ if test -n "$old_archive_from_new_cmds" && test "$build_libtool_libs" = yes; then
+ eval cmds=\"$old_archive_from_new_cmds\"
+ else
+ # Ensure that we have .o objects in place in case we decided
+ # not to build a shared library, and have fallen back to building
+ # static libs even though --disable-static was passed!
+ for oldobj in $oldobjs; do
+ if test ! -f $oldobj; then
+ xdir=`$echo "X$oldobj" | $Xsed -e 's%/[^/]*$%%'`
+ if test "X$xdir" = "X$oldobj"; then
+ xdir="."
+ else
+ xdir="$xdir"
+ fi
+ baseobj=`$echo "X$oldobj" | $Xsed -e 's%^.*/%%'`
+ obj=`$echo "X$baseobj" | $Xsed -e "$o2lo"`
+ $show "(cd $xdir && ${LN_S} $obj $baseobj)"
+ $run eval '(cd $xdir && ${LN_S} $obj $baseobj)' || exit $?
+ fi
+ done
+
+ eval cmds=\"$old_archive_cmds\"
+ fi
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ done
+
+ if test -n "$generated"; then
+ $show "${rm}r$generated"
+ $run ${rm}r$generated
+ fi
+
+ # Now create the libtool archive.
+ case $output in
+ *.la)
+ old_library=
+ test "$build_old_libs" = yes && old_library="$libname.$libext"
+ $show "creating $output"
+
+ # Preserve any variables that may affect compiler behavior
+ for var in $variables_saved_for_relink; do
+ if eval test -z \"\${$var+set}\"; then
+ relink_command="{ test -z \"\${$var+set}\" || unset $var || { $var=; export $var; }; }; $relink_command"
+ elif eval var_value=\$$var; test -z "$var_value"; then
+ relink_command="$var=; export $var; $relink_command"
+ else
+ var_value=`$echo "X$var_value" | $Xsed -e "$sed_quote_subst"`
+ relink_command="$var=\"$var_value\"; export $var; $relink_command"
+ fi
+ done
+ # Quote the link command for shipping.
+ relink_command="cd `pwd`; $SHELL $0 --mode=relink $libtool_args"
+ relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"`
+
+ # Only create the output if not a dry run.
+ if test -z "$run"; then
+ for installed in no yes; do
+ if test "$installed" = yes; then
+ if test -z "$install_libdir"; then
+ break
+ fi
+ output="$output_objdir/$outputname"i
+ # Replace all uninstalled libtool libraries with the installed ones
+ newdependency_libs=
+ for deplib in $dependency_libs; do
+ case $deplib in
+ *.la)
+ name=`$echo "X$deplib" | $Xsed -e 's%^.*/%%'`
+ eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
+ if test -z "$libdir"; then
+ $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2
+ exit 1
+ fi
+ newdependency_libs="$newdependency_libs $libdir/$name"
+ ;;
+ *) newdependency_libs="$newdependency_libs $deplib" ;;
+ esac
+ done
+ dependency_libs="$newdependency_libs"
+ newdlfiles=
+ for lib in $dlfiles; do
+ name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
+ eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
+ if test -z "$libdir"; then
+ $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
+ exit 1
+ fi
+ newdlfiles="$newdlfiles $libdir/$name"
+ done
+ dlfiles="$newdlfiles"
+ newdlprefiles=
+ for lib in $dlprefiles; do
+ name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
+ eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
+ if test -z "$libdir"; then
+ $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
+ exit 1
+ fi
+ newdlprefiles="$newdlprefiles $libdir/$name"
+ done
+ dlprefiles="$newdlprefiles"
+ fi
+ $rm $output
+ # place dlname in correct position for cygwin
+ tdlname=$dlname
+ case $host,$output,$installed,$module,$dlname in
+ *cygwin*,*lai,yes,no,*.dll) tdlname=../bin/$dlname ;;
+ esac
+ $echo > $output "\
+# $outputname - a libtool library file
+# Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP
+#
+# Please DO NOT delete this file!
+# It is necessary for linking the library.
+
+# The name that we can dlopen(3).
+dlname='$tdlname'
+
+# Names of this library.
+library_names='$library_names'
+
+# The name of the static archive.
+old_library='$old_library'
+
+# Libraries that this one depends upon.
+dependency_libs='$dependency_libs'
+
+# Version information for $libname.
+current=$current
+age=$age
+revision=$revision
+
+# Is this an already installed library?
+installed=$installed
+
+# Files to dlopen/dlpreopen
+dlopen='$dlfiles'
+dlpreopen='$dlprefiles'
+
+# Directory that this library needs to be installed in:
+libdir='$install_libdir'"
+ if test "$installed" = no && test $need_relink = yes; then
+ $echo >> $output "\
+relink_command=\"$relink_command\""
+ fi
+ done
+ fi
+
+ # Do a symbolic link so that the libtool archive can be found in
+ # LD_LIBRARY_PATH before the program is installed.
+ $show "(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)"
+ $run eval '(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)' || exit $?
+ ;;
+ esac
+ exit 0
+ ;;
+
+ # libtool install mode
+ install)
+ modename="$modename: install"
+
+ # There may be an optional sh(1) argument at the beginning of
+ # install_prog (especially on Windows NT).
+ if test "$nonopt" = "$SHELL" || test "$nonopt" = /bin/sh ||
+ # Allow the use of GNU shtool's install command.
+ $echo "X$nonopt" | $Xsed | grep shtool > /dev/null; then
+ # Aesthetically quote it.
+ arg=`$echo "X$nonopt" | $Xsed -e "$sed_quote_subst"`
+ case $arg in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*)
+ arg="\"$arg\""
+ ;;
+ esac
+ install_prog="$arg "
+ arg="$1"
+ shift
+ else
+ install_prog=
+ arg="$nonopt"
+ fi
+
+ # The real first argument should be the name of the installation program.
+ # Aesthetically quote it.
+ arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
+ case $arg in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*)
+ arg="\"$arg\""
+ ;;
+ esac
+ install_prog="$install_prog$arg"
+
+ # We need to accept at least all the BSD install flags.
+ dest=
+ files=
+ opts=
+ prev=
+ install_type=
+ isdir=no
+ stripme=
+ for arg
+ do
+ if test -n "$dest"; then
+ files="$files $dest"
+ dest="$arg"
+ continue
+ fi
+
+ case $arg in
+ -d) isdir=yes ;;
+ -f) prev="-f" ;;
+ -g) prev="-g" ;;
+ -m) prev="-m" ;;
+ -o) prev="-o" ;;
+ -s)
+ stripme=" -s"
+ continue
+ ;;
+ -*) ;;
+
+ *)
+ # If the previous option needed an argument, then skip it.
+ if test -n "$prev"; then
+ prev=
+ else
+ dest="$arg"
+ continue
+ fi
+ ;;
+ esac
+
+ # Aesthetically quote the argument.
+ arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
+ case $arg in
+ *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*)
+ arg="\"$arg\""
+ ;;
+ esac
+ install_prog="$install_prog $arg"
+ done
+
+ if test -z "$install_prog"; then
+ $echo "$modename: you must specify an install program" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ if test -n "$prev"; then
+ $echo "$modename: the \`$prev' option requires an argument" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ if test -z "$files"; then
+ if test -z "$dest"; then
+ $echo "$modename: no file or destination specified" 1>&2
+ else
+ $echo "$modename: you must specify a destination" 1>&2
+ fi
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ # Strip any trailing slash from the destination.
+ dest=`$echo "X$dest" | $Xsed -e 's%/$%%'`
+
+ # Check to see that the destination is a directory.
+ test -d "$dest" && isdir=yes
+ if test "$isdir" = yes; then
+ destdir="$dest"
+ destname=
+ else
+ destdir=`$echo "X$dest" | $Xsed -e 's%/[^/]*$%%'`
+ test "X$destdir" = "X$dest" && destdir=.
+ destname=`$echo "X$dest" | $Xsed -e 's%^.*/%%'`
+
+ # Not a directory, so check to see that there is only one file specified.
+ set dummy $files
+ if test $# -gt 2; then
+ $echo "$modename: \`$dest' is not a directory" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+ fi
+ case $destdir in
+ [\\/]* | [A-Za-z]:[\\/]*) ;;
+ *)
+ for file in $files; do
+ case $file in
+ *.lo) ;;
+ *)
+ $echo "$modename: \`$destdir' must be an absolute directory name" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ ;;
+ esac
+ done
+ ;;
+ esac
+
+ # This variable tells wrapper scripts just to set variables rather
+ # than running their programs.
+ libtool_install_magic="$magic"
+
+ staticlibs=
+ future_libdirs=
+ current_libdirs=
+ for file in $files; do
+
+ # Do each installation.
+ case $file in
+ *.$libext)
+ # Do the static libraries later.
+ staticlibs="$staticlibs $file"
+ ;;
+
+ *.la)
+ # Check to see that this really is a libtool archive.
+ if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then :
+ else
+ $echo "$modename: \`$file' is not a valid libtool archive" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ library_names=
+ old_library=
+ relink_command=
+ # If there is no directory component, then add one.
+ case $file in
+ */* | *\\*) . $file ;;
+ *) . ./$file ;;
+ esac
+
+ # Add the libdir to current_libdirs if it is the destination.
+ if test "X$destdir" = "X$libdir"; then
+ case "$current_libdirs " in
+ *" $libdir "*) ;;
+ *) current_libdirs="$current_libdirs $libdir" ;;
+ esac
+ else
+ # Note the libdir as a future libdir.
+ case "$future_libdirs " in
+ *" $libdir "*) ;;
+ *) future_libdirs="$future_libdirs $libdir" ;;
+ esac
+ fi
+
+ dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`/
+ test "X$dir" = "X$file/" && dir=
+ dir="$dir$objdir"
+
+ if test -n "$relink_command"; then
+ $echo "$modename: warning: relinking \`$file'" 1>&2
+ $show "$relink_command"
+ if $run eval "$relink_command"; then :
+ else
+ $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2
+ continue
+ fi
+ fi
+
+ # See the names of the shared library.
+ set dummy $library_names
+ if test -n "$2"; then
+ realname="$2"
+ shift
+ shift
+
+ srcname="$realname"
+ test -n "$relink_command" && srcname="$realname"T
+
+ # Install the shared library and build the symlinks.
+ $show "$install_prog $dir/$srcname $destdir/$realname"
+ $run eval "$install_prog $dir/$srcname $destdir/$realname" || exit $?
+ if test -n "$stripme" && test -n "$striplib"; then
+ $show "$striplib $destdir/$realname"
+ $run eval "$striplib $destdir/$realname" || exit $?
+ fi
+
+ if test $# -gt 0; then
+ # Delete the old symlinks, and create new ones.
+ for linkname
+ do
+ if test "$linkname" != "$realname"; then
+ $show "(cd $destdir && $rm $linkname && $LN_S $realname $linkname)"
+ $run eval "(cd $destdir && $rm $linkname && $LN_S $realname $linkname)"
+ fi
+ done
+ fi
+
+ # Do each command in the postinstall commands.
+ lib="$destdir/$realname"
+ eval cmds=\"$postinstall_cmds\"
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ fi
+
+ # Install the pseudo-library for information purposes.
+ name=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
+ instname="$dir/$name"i
+ $show "$install_prog $instname $destdir/$name"
+ $run eval "$install_prog $instname $destdir/$name" || exit $?
+
+ # Maybe install the static library, too.
+ test -n "$old_library" && staticlibs="$staticlibs $dir/$old_library"
+ ;;
+
+ *.lo)
+ # Install (i.e. copy) a libtool object.
+
+ # Figure out destination file name, if it wasn't already specified.
+ if test -n "$destname"; then
+ destfile="$destdir/$destname"
+ else
+ destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
+ destfile="$destdir/$destfile"
+ fi
+
+ # Deduce the name of the destination old-style object file.
+ case $destfile in
+ *.lo)
+ staticdest=`$echo "X$destfile" | $Xsed -e "$lo2o"`
+ ;;
+ *.$objext)
+ staticdest="$destfile"
+ destfile=
+ ;;
+ *)
+ $echo "$modename: cannot copy a libtool object to \`$destfile'" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ ;;
+ esac
+
+ # Install the libtool object if requested.
+ if test -n "$destfile"; then
+ $show "$install_prog $file $destfile"
+ $run eval "$install_prog $file $destfile" || exit $?
+ fi
+
+ # Install the old object if enabled.
+ if test "$build_old_libs" = yes; then
+ # Deduce the name of the old-style object file.
+ staticobj=`$echo "X$file" | $Xsed -e "$lo2o"`
+
+ $show "$install_prog $staticobj $staticdest"
+ $run eval "$install_prog \$staticobj \$staticdest" || exit $?
+ fi
+ exit 0
+ ;;
+
+ *)
+ # Figure out destination file name, if it wasn't already specified.
+ if test -n "$destname"; then
+ destfile="$destdir/$destname"
+ else
+ destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
+ destfile="$destdir/$destfile"
+ fi
+
+ # Do a test to see if this is really a libtool program.
+ if (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
+ notinst_deplibs=
+ relink_command=
+
+ # If there is no directory component, then add one.
+ case $file in
+ */* | *\\*) . $file ;;
+ *) . ./$file ;;
+ esac
+
+ # Check the variables that should have been set.
+ if test -z "$notinst_deplibs"; then
+ $echo "$modename: invalid libtool wrapper script \`$file'" 1>&2
+ exit 1
+ fi
+
+ finalize=yes
+ for lib in $notinst_deplibs; do
+ # Check to see that each library is installed.
+ libdir=
+ if test -f "$lib"; then
+ # If there is no directory component, then add one.
+ case $lib in
+ */* | *\\*) . $lib ;;
+ *) . ./$lib ;;
+ esac
+ fi
+ libfile="$libdir/"`$echo "X$lib" | $Xsed -e 's%^.*/%%g'` ### testsuite: skip nested quoting test
+ if test -n "$libdir" && test ! -f "$libfile"; then
+ $echo "$modename: warning: \`$lib' has not been installed in \`$libdir'" 1>&2
+ finalize=no
+ fi
+ done
+
+ relink_command=
+ # If there is no directory component, then add one.
+ case $file in
+ */* | *\\*) . $file ;;
+ *) . ./$file ;;
+ esac
+
+ outputname=
+ if test "$fast_install" = no && test -n "$relink_command"; then
+ if test "$finalize" = yes && test -z "$run"; then
+ tmpdir="/tmp"
+ test -n "$TMPDIR" && tmpdir="$TMPDIR"
+ tmpdir="$tmpdir/libtool-$$"
+ if $mkdir -p "$tmpdir" && chmod 700 "$tmpdir"; then :
+ else
+ $echo "$modename: error: cannot create temporary directory \`$tmpdir'" 1>&2
+ continue
+ fi
+ file=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
+ outputname="$tmpdir/$file"
+ # Replace the output file specification.
+ relink_command=`$echo "X$relink_command" | $Xsed -e 's%@OUTPUT@%'"$outputname"'%g'`
+
+ $show "$relink_command"
+ if $run eval "$relink_command"; then :
+ else
+ $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2
+ ${rm}r "$tmpdir"
+ continue
+ fi
+ file="$outputname"
+ else
+ $echo "$modename: warning: cannot relink \`$file'" 1>&2
+ fi
+ else
+ # Install the binary that we compiled earlier.
+ file=`$echo "X$file" | $Xsed -e "s%\([^/]*\)$%$objdir/\1%"`
+ fi
+ fi
+
+ # remove .exe since cygwin /usr/bin/install will append another
+ # one anyways
+ case $install_prog,$host in
+ /usr/bin/install*,*cygwin*)
+ case $file:$destfile in
+ *.exe:*.exe)
+ # this is ok
+ ;;
+ *.exe:*)
+ destfile=$destfile.exe
+ ;;
+ *:*.exe)
+ destfile=`echo $destfile | sed -e 's,.exe$,,'`
+ ;;
+ esac
+ ;;
+ esac
+ $show "$install_prog$stripme $file $destfile"
+ $run eval "$install_prog\$stripme \$file \$destfile" || exit $?
+ test -n "$outputname" && ${rm}r "$tmpdir"
+ ;;
+ esac
+ done
+
+ for file in $staticlibs; do
+ name=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
+
+ # Set up the ranlib parameters.
+ oldlib="$destdir/$name"
+
+ $show "$install_prog $file $oldlib"
+ $run eval "$install_prog \$file \$oldlib" || exit $?
+
+ if test -n "$stripme" && test -n "$striplib"; then
+ $show "$old_striplib $oldlib"
+ $run eval "$old_striplib $oldlib" || exit $?
+ fi
+
+ # Do each command in the postinstall commands.
+ eval cmds=\"$old_postinstall_cmds\"
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ done
+
+ if test -n "$future_libdirs"; then
+ $echo "$modename: warning: remember to run \`$progname --finish$future_libdirs'" 1>&2
+ fi
+
+ if test -n "$current_libdirs"; then
+ # Maybe just do a dry run.
+ test -n "$run" && current_libdirs=" -n$current_libdirs"
+ exec_cmd='$SHELL $0 --finish$current_libdirs'
+ else
+ exit 0
+ fi
+ ;;
+
+ # libtool finish mode
+ finish)
+ modename="$modename: finish"
+ libdirs="$nonopt"
+ admincmds=
+
+ if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
+ for dir
+ do
+ libdirs="$libdirs $dir"
+ done
+
+ for libdir in $libdirs; do
+ if test -n "$finish_cmds"; then
+ # Do each command in the finish commands.
+ eval cmds=\"$finish_cmds\"
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || admincmds="$admincmds
+ $cmd"
+ done
+ IFS="$save_ifs"
+ fi
+ if test -n "$finish_eval"; then
+ # Do the single finish_eval.
+ eval cmds=\"$finish_eval\"
+ $run eval "$cmds" || admincmds="$admincmds
+ $cmds"
+ fi
+ done
+ fi
+
+ # Exit here if they wanted silent mode.
+ test "$show" = ":" && exit 0
+
+ echo "----------------------------------------------------------------------"
+ echo "Libraries have been installed in:"
+ for libdir in $libdirs; do
+ echo " $libdir"
+ done
+ echo
+ echo "If you ever happen to want to link against installed libraries"
+ echo "in a given directory, LIBDIR, you must either use libtool, and"
+ echo "specify the full pathname of the library, or use the \`-LLIBDIR'"
+ echo "flag during linking and do at least one of the following:"
+ if test -n "$shlibpath_var"; then
+ echo " - add LIBDIR to the \`$shlibpath_var' environment variable"
+ echo " during execution"
+ fi
+ if test -n "$runpath_var"; then
+ echo " - add LIBDIR to the \`$runpath_var' environment variable"
+ echo " during linking"
+ fi
+ if test -n "$hardcode_libdir_flag_spec"; then
+ libdir=LIBDIR
+ eval flag=\"$hardcode_libdir_flag_spec\"
+
+ echo " - use the \`$flag' linker flag"
+ fi
+ if test -n "$admincmds"; then
+ echo " - have your system administrator run these commands:$admincmds"
+ fi
+ if test -f /etc/ld.so.conf; then
+ echo " - have your system administrator add LIBDIR to \`/etc/ld.so.conf'"
+ fi
+ echo
+ echo "See any operating system documentation about shared libraries for"
+ echo "more information, such as the ld(1) and ld.so(8) manual pages."
+ echo "----------------------------------------------------------------------"
+ exit 0
+ ;;
+
+ # libtool execute mode
+ execute)
+ modename="$modename: execute"
+
+ # The first argument is the command name.
+ cmd="$nonopt"
+ if test -z "$cmd"; then
+ $echo "$modename: you must specify a COMMAND" 1>&2
+ $echo "$help"
+ exit 1
+ fi
+
+ # Handle -dlopen flags immediately.
+ for file in $execute_dlfiles; do
+ if test ! -f "$file"; then
+ $echo "$modename: \`$file' is not a file" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ dir=
+ case $file in
+ *.la)
+ # Check to see that this really is a libtool archive.
+ if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then :
+ else
+ $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ # Read the libtool library.
+ dlname=
+ library_names=
+
+ # If there is no directory component, then add one.
+ case $file in
+ */* | *\\*) . $file ;;
+ *) . ./$file ;;
+ esac
+
+ # Skip this library if it cannot be dlopened.
+ if test -z "$dlname"; then
+ # Warn if it was a shared library.
+ test -n "$library_names" && $echo "$modename: warning: \`$file' was not linked with \`-export-dynamic'"
+ continue
+ fi
+
+ dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`
+ test "X$dir" = "X$file" && dir=.
+
+ if test -f "$dir/$objdir/$dlname"; then
+ dir="$dir/$objdir"
+ else
+ $echo "$modename: cannot find \`$dlname' in \`$dir' or \`$dir/$objdir'" 1>&2
+ exit 1
+ fi
+ ;;
+
+ *.lo)
+ # Just add the directory containing the .lo file.
+ dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`
+ test "X$dir" = "X$file" && dir=.
+ ;;
+
+ *)
+ $echo "$modename: warning \`-dlopen' is ignored for non-libtool libraries and objects" 1>&2
+ continue
+ ;;
+ esac
+
+ # Get the absolute pathname.
+ absdir=`cd "$dir" && pwd`
+ test -n "$absdir" && dir="$absdir"
+
+ # Now add the directory to shlibpath_var.
+ if eval "test -z \"\$$shlibpath_var\""; then
+ eval "$shlibpath_var=\"\$dir\""
+ else
+ eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\""
+ fi
+ done
+
+ # This variable tells wrapper scripts just to set shlibpath_var
+ # rather than running their programs.
+ libtool_execute_magic="$magic"
+
+ # Check if any of the arguments is a wrapper script.
+ args=
+ for file
+ do
+ case $file in
+ -*) ;;
+ *)
+ # Do a test to see if this is really a libtool program.
+ if (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
+ # If there is no directory component, then add one.
+ case $file in
+ */* | *\\*) . $file ;;
+ *) . ./$file ;;
+ esac
+
+ # Transform arg to wrapped name.
+ file="$progdir/$program"
+ fi
+ ;;
+ esac
+ # Quote arguments (to preserve shell metacharacters).
+ file=`$echo "X$file" | $Xsed -e "$sed_quote_subst"`
+ args="$args \"$file\""
+ done
+
+ if test -z "$run"; then
+ if test -n "$shlibpath_var"; then
+ # Export the shlibpath_var.
+ eval "export $shlibpath_var"
+ fi
+
+ # Restore saved enviroment variables
+ if test "${save_LC_ALL+set}" = set; then
+ LC_ALL="$save_LC_ALL"; export LC_ALL
+ fi
+ if test "${save_LANG+set}" = set; then
+ LANG="$save_LANG"; export LANG
+ fi
+
+ # Now prepare to actually exec the command.
+ exec_cmd='"$cmd"$args'
+ else
+ # Display what would be done.
+ if test -n "$shlibpath_var"; then
+ eval "\$echo \"\$shlibpath_var=\$$shlibpath_var\""
+ $echo "export $shlibpath_var"
+ fi
+ $echo "$cmd$args"
+ exit 0
+ fi
+ ;;
+
+ # libtool clean and uninstall mode
+ clean | uninstall)
+ modename="$modename: $mode"
+ rm="$nonopt"
+ files=
+ rmforce=
+ exit_status=0
+
+ # This variable tells wrapper scripts just to set variables rather
+ # than running their programs.
+ libtool_install_magic="$magic"
+
+ for arg
+ do
+ case $arg in
+ -f) rm="$rm $arg"; rmforce=yes ;;
+ -*) rm="$rm $arg" ;;
+ *) files="$files $arg" ;;
+ esac
+ done
+
+ if test -z "$rm"; then
+ $echo "$modename: you must specify an RM program" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ fi
+
+ rmdirs=
+
+ for file in $files; do
+ dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`
+ if test "X$dir" = "X$file"; then
+ dir=.
+ objdir="$objdir"
+ else
+ objdir="$dir/$objdir"
+ fi
+ name=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
+ test $mode = uninstall && objdir="$dir"
+
+ # Remember objdir for removal later, being careful to avoid duplicates
+ if test $mode = clean; then
+ case " $rmdirs " in
+ *" $objdir "*) ;;
+ *) rmdirs="$rmdirs $objdir" ;;
+ esac
+ fi
+
+ # Don't error if the file doesn't exist and rm -f was used.
+ if (test -L "$file") >/dev/null 2>&1 \
+ || (test -h "$file") >/dev/null 2>&1 \
+ || test -f "$file"; then
+ :
+ elif test -d "$file"; then
+ exit_status=1
+ continue
+ elif test "$rmforce" = yes; then
+ continue
+ fi
+
+ rmfiles="$file"
+
+ case $name in
+ *.la)
+ # Possibly a libtool archive, so verify it.
+ if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
+ . $dir/$name
+
+ # Delete the libtool libraries and symlinks.
+ for n in $library_names; do
+ rmfiles="$rmfiles $objdir/$n"
+ done
+ test -n "$old_library" && rmfiles="$rmfiles $objdir/$old_library"
+ test $mode = clean && rmfiles="$rmfiles $objdir/$name $objdir/${name}i"
+
+ if test $mode = uninstall; then
+ if test -n "$library_names"; then
+ # Do each command in the postuninstall commands.
+ eval cmds=\"$postuninstall_cmds\"
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd"
+ if test $? != 0 && test "$rmforce" != yes; then
+ exit_status=1
+ fi
+ done
+ IFS="$save_ifs"
+ fi
+
+ if test -n "$old_library"; then
+ # Do each command in the old_postuninstall commands.
+ eval cmds=\"$old_postuninstall_cmds\"
+ save_ifs="$IFS"; IFS='~'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd"
+ if test $? != 0 && test "$rmforce" != yes; then
+ exit_status=1
+ fi
+ done
+ IFS="$save_ifs"
+ fi
+ # FIXME: should reinstall the best remaining shared library.
+ fi
+ fi
+ ;;
+
+ *.lo)
+ if test "$build_old_libs" = yes; then
+ oldobj=`$echo "X$name" | $Xsed -e "$lo2o"`
+ rmfiles="$rmfiles $dir/$oldobj"
+ fi
+ ;;
+
+ *)
+ # Do a test to see if this is a libtool program.
+ if test $mode = clean &&
+ (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
+ relink_command=
+ . $dir/$file
+
+ rmfiles="$rmfiles $objdir/$name $objdir/${name}S.${objext}"
+ if test "$fast_install" = yes && test -n "$relink_command"; then
+ rmfiles="$rmfiles $objdir/lt-$name"
+ fi
+ fi
+ ;;
+ esac
+ $show "$rm $rmfiles"
+ $run $rm $rmfiles || exit_status=1
+ done
+
+ # Try to remove the ${objdir}s in the directories where we deleted files
+ for dir in $rmdirs; do
+ if test -d "$dir"; then
+ $show "rmdir $dir"
+ $run rmdir $dir >/dev/null 2>&1
+ fi
+ done
+
+ exit $exit_status
+ ;;
+
+ "")
+ $echo "$modename: you must specify a MODE" 1>&2
+ $echo "$generic_help" 1>&2
+ exit 1
+ ;;
+ esac
+
+ if test -z "$exec_cmd"; then
+ $echo "$modename: invalid operation mode \`$mode'" 1>&2
+ $echo "$generic_help" 1>&2
+ exit 1
+ fi
+fi # test -z "$show_help"
+
+if test -n "$exec_cmd"; then
+ eval exec $exec_cmd
+ exit 1
+fi
+
+# We need to display help for each of the modes.
+case $mode in
+"") $echo \
+"Usage: $modename [OPTION]... [MODE-ARG]...
+
+Provide generalized library-building support services.
+
+ --config show all configuration variables
+ --debug enable verbose shell tracing
+-n, --dry-run display commands without modifying any files
+ --features display basic configuration information and exit
+ --finish same as \`--mode=finish'
+ --help display this help message and exit
+ --mode=MODE use operation mode MODE [default=inferred from MODE-ARGS]
+ --quiet same as \`--silent'
+ --silent don't print informational messages
+ --version print version information
+
+MODE must be one of the following:
+
+ clean remove files from the build directory
+ compile compile a source file into a libtool object
+ execute automatically set library path, then run a program
+ finish complete the installation of libtool libraries
+ install install libraries or executables
+ link create a library or an executable
+ uninstall remove libraries from an installed directory
+
+MODE-ARGS vary depending on the MODE. Try \`$modename --help --mode=MODE' for
+a more detailed description of MODE."
+ exit 0
+ ;;
+
+clean)
+ $echo \
+"Usage: $modename [OPTION]... --mode=clean RM [RM-OPTION]... FILE...
+
+Remove files from the build directory.
+
+RM is the name of the program to use to delete files associated with each FILE
+(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
+to RM.
+
+If FILE is a libtool library, object or program, all the files associated
+with it are deleted. Otherwise, only FILE itself is deleted using RM."
+ ;;
+
+compile)
+ $echo \
+"Usage: $modename [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE
+
+Compile a source file into a libtool library object.
+
+This mode accepts the following additional options:
+
+ -o OUTPUT-FILE set the output file name to OUTPUT-FILE
+ -prefer-pic try to building PIC objects only
+ -prefer-non-pic try to building non-PIC objects only
+ -static always build a \`.o' file suitable for static linking
+
+COMPILE-COMMAND is a command to be used in creating a \`standard' object file
+from the given SOURCEFILE.
+
+The output file name is determined by removing the directory component from
+SOURCEFILE, then substituting the C source code suffix \`.c' with the
+library object suffix, \`.lo'."
+ ;;
+
+execute)
+ $echo \
+"Usage: $modename [OPTION]... --mode=execute COMMAND [ARGS]...
+
+Automatically set library path, then run a program.
+
+This mode accepts the following additional options:
+
+ -dlopen FILE add the directory containing FILE to the library path
+
+This mode sets the library path environment variable according to \`-dlopen'
+flags.
+
+If any of the ARGS are libtool executable wrappers, then they are translated
+into their corresponding uninstalled binary, and any of their required library
+directories are added to the library path.
+
+Then, COMMAND is executed, with ARGS as arguments."
+ ;;
+
+finish)
+ $echo \
+"Usage: $modename [OPTION]... --mode=finish [LIBDIR]...
+
+Complete the installation of libtool libraries.
+
+Each LIBDIR is a directory that contains libtool libraries.
+
+The commands that this mode executes may require superuser privileges. Use
+the \`--dry-run' option if you just want to see what would be executed."
+ ;;
+
+install)
+ $echo \
+"Usage: $modename [OPTION]... --mode=install INSTALL-COMMAND...
+
+Install executables or libraries.
+
+INSTALL-COMMAND is the installation command. The first component should be
+either the \`install' or \`cp' program.
+
+The rest of the components are interpreted as arguments to that command (only
+BSD-compatible install options are recognized)."
+ ;;
+
+link)
+ $echo \
+"Usage: $modename [OPTION]... --mode=link LINK-COMMAND...
+
+Link object files or libraries together to form another library, or to
+create an executable program.
+
+LINK-COMMAND is a command using the C compiler that you would use to create
+a program from several object files.
+
+The following components of LINK-COMMAND are treated specially:
+
+ -all-static do not do any dynamic linking at all
+ -avoid-version do not add a version suffix if possible
+ -dlopen FILE \`-dlpreopen' FILE if it cannot be dlopened at runtime
+ -dlpreopen FILE link in FILE and add its symbols to lt_preloaded_symbols
+ -export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3)
+ -export-symbols SYMFILE
+ try to export only the symbols listed in SYMFILE
+ -export-symbols-regex REGEX
+ try to export only the symbols matching REGEX
+ -LLIBDIR search LIBDIR for required installed libraries
+ -lNAME OUTPUT-FILE requires the installed library libNAME
+ -module build a library that can dlopened
+ -no-fast-install disable the fast-install mode
+ -no-install link a not-installable executable
+ -no-undefined declare that a library does not refer to external symbols
+ -o OUTPUT-FILE create OUTPUT-FILE from the specified objects
+ -release RELEASE specify package release information
+ -rpath LIBDIR the created library will eventually be installed in LIBDIR
+ -R[ ]LIBDIR add LIBDIR to the runtime path of programs and libraries
+ -static do not do any dynamic linking of libtool libraries
+ -version-info CURRENT[:REVISION[:AGE]]
+ specify library version info [each variable defaults to 0]
+
+All other options (arguments beginning with \`-') are ignored.
+
+Every other argument is treated as a filename. Files ending in \`.la' are
+treated as uninstalled libtool libraries, other files are standard or library
+object files.
+
+If the OUTPUT-FILE ends in \`.la', then a libtool library is created,
+only library objects (\`.lo' files) may be specified, and \`-rpath' is
+required, except when creating a convenience library.
+
+If OUTPUT-FILE ends in \`.a' or \`.lib', then a standard library is created
+using \`ar' and \`ranlib', or on Windows using \`lib'.
+
+If OUTPUT-FILE ends in \`.lo' or \`.${objext}', then a reloadable object file
+is created, otherwise an executable program is created."
+ ;;
+
+uninstall)
+ $echo \
+"Usage: $modename [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE...
+
+Remove libraries from an installation directory.
+
+RM is the name of the program to use to delete files associated with each FILE
+(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
+to RM.
+
+If FILE is a libtool library, all the files associated with it are deleted.
+Otherwise, only FILE itself is deleted using RM."
+ ;;
+
+*)
+ $echo "$modename: invalid operation mode \`$mode'" 1>&2
+ $echo "$help" 1>&2
+ exit 1
+ ;;
+esac
+
+echo
+$echo "Try \`$modename --help' for more information about other modes."
+
+exit 0
+
+# Local Variables:
+# mode:shell-script
+# sh-indentation:2
+# End:
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, November 17, 1995 12:13 pm PST */
+# include "private/gc_priv.h"
+# include <stdio.h>
+# include <setjmp.h>
+# if defined(OS2) || defined(CX_UX)
+# define _setjmp(b) setjmp(b)
+# define _longjmp(b,v) longjmp(b,v)
+# endif
+# ifdef AMIGA
+# ifndef __GNUC__
+# include <dos.h>
+# else
+# include <machine/reg.h>
+# endif
+# endif
+
+#if defined(__MWERKS__) && !defined(POWERPC)
+
+asm static void PushMacRegisters()
+{
+ sub.w #4,sp // reserve space for one parameter.
+ move.l a2,(sp)
+ jsr GC_push_one
+ move.l a3,(sp)
+ jsr GC_push_one
+ move.l a4,(sp)
+ jsr GC_push_one
+# if !__option(a6frames)
+ // <pcb> perhaps a6 should be pushed if stack frames are not being used.
+ move.l a6,(sp)
+ jsr GC_push_one
+# endif
+ // skip a5 (globals), a6 (frame pointer), and a7 (stack pointer)
+ move.l d2,(sp)
+ jsr GC_push_one
+ move.l d3,(sp)
+ jsr GC_push_one
+ move.l d4,(sp)
+ jsr GC_push_one
+ move.l d5,(sp)
+ jsr GC_push_one
+ move.l d6,(sp)
+ jsr GC_push_one
+ move.l d7,(sp)
+ jsr GC_push_one
+ add.w #4,sp // fix stack.
+ rts
+}
+
+#endif /* __MWERKS__ */
+
+# if defined(SPARC) || defined(IA64)
+ /* Value returned from register flushing routine; either sp (SPARC) */
+ /* or ar.bsp (IA64) */
+ word GC_save_regs_ret_val;
+# endif
+
+/* Routine to mark from registers that are preserved by the C compiler. */
+/* This must be ported to every new architecture. There is a generic */
+/* version at the end, that is likely, but not guaranteed to work */
+/* on your architecture. Run the test_setjmp program to see whether */
+/* there is any chance it will work. */
+
+#ifndef USE_GENERIC_PUSH_REGS
+void GC_push_regs()
+{
+# ifdef RT
+ register long TMP_SP; /* must be bound to r11 */
+# endif
+
+# ifdef VAX
+ /* VAX - generic code below does not work under 4.2 */
+ /* r1 through r5 are caller save, and therefore */
+ /* on the stack or dead. */
+ asm("pushl r11"); asm("calls $1,_GC_push_one");
+ asm("pushl r10"); asm("calls $1,_GC_push_one");
+ asm("pushl r9"); asm("calls $1,_GC_push_one");
+ asm("pushl r8"); asm("calls $1,_GC_push_one");
+ asm("pushl r7"); asm("calls $1,_GC_push_one");
+ asm("pushl r6"); asm("calls $1,_GC_push_one");
+# endif
+# if defined(M68K) && (defined(SUNOS4) || defined(NEXT))
+ /* M68K SUNOS - could be replaced by generic code */
+ /* a0, a1 and d1 are caller save */
+ /* and therefore are on stack or dead. */
+
+ asm("subqw #0x4,sp"); /* allocate word on top of stack */
+
+ asm("movl a2,sp@"); asm("jbsr _GC_push_one");
+ asm("movl a3,sp@"); asm("jbsr _GC_push_one");
+ asm("movl a4,sp@"); asm("jbsr _GC_push_one");
+ asm("movl a5,sp@"); asm("jbsr _GC_push_one");
+ /* Skip frame pointer and stack pointer */
+ asm("movl d1,sp@"); asm("jbsr _GC_push_one");
+ asm("movl d2,sp@"); asm("jbsr _GC_push_one");
+ asm("movl d3,sp@"); asm("jbsr _GC_push_one");
+ asm("movl d4,sp@"); asm("jbsr _GC_push_one");
+ asm("movl d5,sp@"); asm("jbsr _GC_push_one");
+ asm("movl d6,sp@"); asm("jbsr _GC_push_one");
+ asm("movl d7,sp@"); asm("jbsr _GC_push_one");
+
+ asm("addqw #0x4,sp"); /* put stack back where it was */
+# endif
+
+# if defined(M68K) && defined(HP)
+ /* M68K HP - could be replaced by generic code */
+ /* a0, a1 and d1 are caller save. */
+
+ asm("subq.w &0x4,%sp"); /* allocate word on top of stack */
+
+ asm("mov.l %a2,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %a3,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %a4,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %a5,(%sp)"); asm("jsr _GC_push_one");
+ /* Skip frame pointer and stack pointer */
+ asm("mov.l %d1,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d2,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d3,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d4,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d5,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d6,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d7,(%sp)"); asm("jsr _GC_push_one");
+
+ asm("addq.w &0x4,%sp"); /* put stack back where it was */
+# endif /* M68K HP */
+
+# if defined(M68K) && defined(AMIGA)
+ /* AMIGA - could be replaced by generic code */
+ /* a0, a1, d0 and d1 are caller save */
+
+# ifdef __GNUC__
+ asm("subq.w &0x4,%sp"); /* allocate word on top of stack */
+
+ asm("mov.l %a2,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %a3,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %a4,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %a5,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %a6,(%sp)"); asm("jsr _GC_push_one");
+ /* Skip frame pointer and stack pointer */
+ asm("mov.l %d2,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d3,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d4,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d5,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d6,(%sp)"); asm("jsr _GC_push_one");
+ asm("mov.l %d7,(%sp)"); asm("jsr _GC_push_one");
+
+ asm("addq.w &0x4,%sp"); /* put stack back where it was */
+# else /* !__GNUC__ */
+ GC_push_one(getreg(REG_A2));
+ GC_push_one(getreg(REG_A3));
+# ifndef __SASC
+ /* Can probably be changed to #if 0 -Kjetil M. (a4=globals)*/
+ GC_push_one(getreg(REG_A4));
+# endif
+ GC_push_one(getreg(REG_A5));
+ GC_push_one(getreg(REG_A6));
+ /* Skip stack pointer */
+ GC_push_one(getreg(REG_D2));
+ GC_push_one(getreg(REG_D3));
+ GC_push_one(getreg(REG_D4));
+ GC_push_one(getreg(REG_D5));
+ GC_push_one(getreg(REG_D6));
+ GC_push_one(getreg(REG_D7));
+# endif /* !__GNUC__ */
+# endif /* AMIGA */
+
+# if defined(M68K) && defined(MACOS)
+# if defined(THINK_C)
+# define PushMacReg(reg) \
+ move.l reg,(sp) \
+ jsr GC_push_one
+ asm {
+ sub.w #4,sp ; reserve space for one parameter.
+ PushMacReg(a2);
+ PushMacReg(a3);
+ PushMacReg(a4);
+ ; skip a5 (globals), a6 (frame pointer), and a7 (stack pointer)
+ PushMacReg(d2);
+ PushMacReg(d3);
+ PushMacReg(d4);
+ PushMacReg(d5);
+ PushMacReg(d6);
+ PushMacReg(d7);
+ add.w #4,sp ; fix stack.
+ }
+# undef PushMacReg
+# endif /* THINK_C */
+# if defined(__MWERKS__)
+ PushMacRegisters();
+# endif /* __MWERKS__ */
+# endif /* MACOS */
+
+# if defined(I386) &&!defined(OS2) &&!defined(SVR4) \
+ && (defined(__MINGW32__) || !defined(MSWIN32)) \
+ && !defined(SCO) && !defined(SCO_ELF) \
+ && !(defined(LINUX) && defined(__ELF__)) \
+ && !(defined(FREEBSD) && defined(__ELF__)) \
+ && !(defined(NETBSD) && defined(__ELF__)) \
+ && !(defined(OPENBSD) && defined(__ELF__)) \
+ && !(defined(BEOS) && defined(__ELF__)) \
+ && !defined(DOS4GW) && !defined(HURD)
+ /* I386 code, generic code does not appear to work */
+ /* It does appear to work under OS2, and asms dont */
+ /* This is used for some 38g UNIX variants and for CYGWIN32 */
+ asm("pushl %eax"); asm("call _GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %ecx"); asm("call _GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %edx"); asm("call _GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %ebp"); asm("call _GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %esi"); asm("call _GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %edi"); asm("call _GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %ebx"); asm("call _GC_push_one"); asm("addl $4,%esp");
+# endif
+
+# if ( defined(I386) && defined(LINUX) && defined(__ELF__) ) \
+ || ( defined(I386) && defined(FREEBSD) && defined(__ELF__) ) \
+ || ( defined(I386) && defined(NETBSD) && defined(__ELF__) ) \
+ || ( defined(I386) && defined(OPENBSD) && defined(__ELF__) ) \
+ || ( defined(I386) && defined(HURD) && defined(__ELF__) ) \
+ || ( defined(I386) && defined(DGUX) )
+
+ /* This is modified for Linux with ELF (Note: _ELF_ only) */
+ /* This section handles FreeBSD with ELF. */
+ /* Eax is caller-save and dead here. Other caller-save */
+ /* registers could also be skipped. We assume there are no */
+ /* pointers in MMX registers, etc. */
+ /* We combine instructions in a single asm to prevent gcc from */
+ /* inserting code in the middle. */
+ asm("pushl %ecx; call GC_push_one; addl $4,%esp");
+ asm("pushl %edx; call GC_push_one; addl $4,%esp");
+ asm("pushl %ebp; call GC_push_one; addl $4,%esp");
+ asm("pushl %esi; call GC_push_one; addl $4,%esp");
+ asm("pushl %edi; call GC_push_one; addl $4,%esp");
+ asm("pushl %ebx; call GC_push_one; addl $4,%esp");
+# endif
+
+# if ( defined(I386) && defined(BEOS) && defined(__ELF__) )
+ /* As far as I can understand from */
+ /* http://www.beunited.org/articles/jbq/nasm.shtml, */
+ /* only ebp, esi, edi and ebx are not scratch. How MMX */
+ /* etc. registers should be treated, I have no idea. */
+ asm("pushl %ebp; call GC_push_one; addl $4,%esp");
+ asm("pushl %esi; call GC_push_one; addl $4,%esp");
+ asm("pushl %edi; call GC_push_one; addl $4,%esp");
+ asm("pushl %ebx; call GC_push_one; addl $4,%esp");
+# endif
+
+# if defined(I386) && defined(MSWIN32) && !defined(__MINGW32__) \
+ && !defined(USE_GENERIC)
+ /* I386 code, Microsoft variant */
+ __asm push eax
+ __asm call GC_push_one
+ __asm add esp,4
+ __asm push ebx
+ __asm call GC_push_one
+ __asm add esp,4
+ __asm push ecx
+ __asm call GC_push_one
+ __asm add esp,4
+ __asm push edx
+ __asm call GC_push_one
+ __asm add esp,4
+ __asm push ebp
+ __asm call GC_push_one
+ __asm add esp,4
+ __asm push esi
+ __asm call GC_push_one
+ __asm add esp,4
+ __asm push edi
+ __asm call GC_push_one
+ __asm add esp,4
+# endif
+
+# if defined(I386) && (defined(SVR4) || defined(SCO) || defined(SCO_ELF))
+ /* I386 code, SVR4 variant, generic code does not appear to work */
+ asm("pushl %eax"); asm("call GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %ebx"); asm("call GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %ecx"); asm("call GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %edx"); asm("call GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %ebp"); asm("call GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %esi"); asm("call GC_push_one"); asm("addl $4,%esp");
+ asm("pushl %edi"); asm("call GC_push_one"); asm("addl $4,%esp");
+# endif
+
+# ifdef NS32K
+ asm ("movd r3, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+ asm ("movd r4, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+ asm ("movd r5, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+ asm ("movd r6, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+ asm ("movd r7, tos"); asm ("bsr ?_GC_push_one"); asm ("adjspb $-4");
+# endif
+
+# if defined(SPARC)
+ {
+ word GC_save_regs_in_stack();
+
+ GC_save_regs_ret_val = GC_save_regs_in_stack();
+ }
+# endif
+
+# ifdef RT
+ GC_push_one(TMP_SP); /* GC_push_one from r11 */
+
+ asm("cas r11, r6, r0"); GC_push_one(TMP_SP); /* r6 */
+ asm("cas r11, r7, r0"); GC_push_one(TMP_SP); /* through */
+ asm("cas r11, r8, r0"); GC_push_one(TMP_SP); /* r10 */
+ asm("cas r11, r9, r0"); GC_push_one(TMP_SP);
+ asm("cas r11, r10, r0"); GC_push_one(TMP_SP);
+
+ asm("cas r11, r12, r0"); GC_push_one(TMP_SP); /* r12 */
+ asm("cas r11, r13, r0"); GC_push_one(TMP_SP); /* through */
+ asm("cas r11, r14, r0"); GC_push_one(TMP_SP); /* r15 */
+ asm("cas r11, r15, r0"); GC_push_one(TMP_SP);
+# endif
+
+# if defined(M68K) && defined(SYSV)
+ /* Once again similar to SUN and HP, though setjmp appears to work.
+ --Parag
+ */
+# ifdef __GNUC__
+ asm("subqw #0x4,%sp"); /* allocate word on top of stack */
+
+ asm("movl %a2,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %a3,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %a4,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %a5,%sp@"); asm("jbsr GC_push_one");
+ /* Skip frame pointer and stack pointer */
+ asm("movl %d1,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %d2,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %d3,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %d4,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %d5,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %d6,%sp@"); asm("jbsr GC_push_one");
+ asm("movl %d7,%sp@"); asm("jbsr GC_push_one");
+
+ asm("addqw #0x4,%sp"); /* put stack back where it was */
+# else /* !__GNUC__*/
+ asm("subq.w &0x4,%sp"); /* allocate word on top of stack */
+
+ asm("mov.l %a2,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %a3,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %a4,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %a5,(%sp)"); asm("jsr GC_push_one");
+ /* Skip frame pointer and stack pointer */
+ asm("mov.l %d1,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %d2,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %d3,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %d4,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %d5,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %d6,(%sp)"); asm("jsr GC_push_one");
+ asm("mov.l %d7,(%sp)"); asm("jsr GC_push_one");
+
+ asm("addq.w &0x4,%sp"); /* put stack back where it was */
+# endif /* !__GNUC__ */
+# endif /* M68K/SYSV */
+
+# if defined(PJ)
+ {
+ register int * sp asm ("optop");
+ extern int *__libc_stack_end;
+
+ GC_push_all_stack (sp, __libc_stack_end);
+ }
+# endif
+
+ /* other machines... */
+# if !defined(M68K) && !defined(VAX) && !defined(RT)
+# if !defined(SPARC) && !defined(I386) && !defined(NS32K)
+# if !defined(POWERPC) && !defined(UTS4)
+# if !defined(PJ) && !(defined(MIPS) && defined(LINUX))
+ --> bad news <--
+# endif
+# endif
+# endif
+# endif
+}
+#endif /* !USE_GENERIC_PUSH_REGS */
+
+#if defined(USE_GENERIC_PUSH_REGS)
+void GC_generic_push_regs(cold_gc_frame)
+ptr_t cold_gc_frame;
+{
+ {
+# ifdef HAVE_BUILTIN_UNWIND_INIT
+ /* This was suggested by Richard Henderson as the way to */
+ /* force callee-save registers and register windows onto */
+ /* the stack. */
+ __builtin_unwind_init();
+# else /* !HAVE_BUILTIN_UNWIND_INIT */
+ /* Generic code */
+ /* The idea is due to Parag Patel at HP. */
+ /* We're not sure whether he would like */
+ /* to be he acknowledged for it or not. */
+ jmp_buf regs;
+ register word * i = (word *) regs;
+ register ptr_t lim = (ptr_t)(regs) + (sizeof regs);
+
+ /* Setjmp doesn't always clear all of the buffer. */
+ /* That tends to preserve garbage. Clear it. */
+ for (; (char *)i < lim; i++) {
+ *i = 0;
+ }
+# if defined(POWERPC) || defined(MSWIN32) || defined(MSWINCE) \
+ || defined(UTS4) || defined(LINUX) || defined(EWS4800)
+ (void) setjmp(regs);
+# else
+ (void) _setjmp(regs);
+# endif
+# endif /* !HAVE_BUILTIN_UNWIND_INIT */
+# if (defined(SPARC) && !defined(HAVE_BUILTIN_UNWIND_INIT)) \
+ || defined(IA64)
+ /* On a register window machine, we need to save register */
+ /* contents on the stack for this to work. The setjmp */
+ /* is probably not needed on SPARC, since pointers are */
+ /* only stored in windowed or scratch registers. It is */
+ /* needed on IA64, since some non-windowed registers are */
+ /* preserved. */
+ {
+ word GC_save_regs_in_stack();
+
+ GC_save_regs_ret_val = GC_save_regs_in_stack();
+ /* On IA64 gcc, could use __builtin_ia64_flushrs() and */
+ /* __builtin_ia64_flushrs(). The latter will be done */
+ /* implicitly by __builtin_unwind_init() for gcc3.0.1 */
+ /* and later. */
+ }
+# endif
+ GC_push_current_stack(cold_gc_frame);
+ }
+}
+#endif /* USE_GENERIC_PUSH_REGS */
+
+/* On register window machines, we need a way to force registers into */
+/* the stack. Return sp. */
+# ifdef SPARC
+ asm(" .seg \"text\"");
+# ifdef SVR4
+ asm(" .globl GC_save_regs_in_stack");
+ asm("GC_save_regs_in_stack:");
+ asm(" .type GC_save_regs_in_stack,#function");
+# else
+ asm(" .globl _GC_save_regs_in_stack");
+ asm("_GC_save_regs_in_stack:");
+# endif
+# if defined(__arch64__) || defined(__sparcv9)
+ asm(" save %sp,-128,%sp");
+ asm(" flushw");
+ asm(" ret");
+ asm(" restore %sp,2047+128,%o0");
+# else
+ asm(" ta 0x3 ! ST_FLUSH_WINDOWS");
+ asm(" retl");
+ asm(" mov %sp,%o0");
+# endif
+# ifdef SVR4
+ asm(" .GC_save_regs_in_stack_end:");
+ asm(" .size GC_save_regs_in_stack,.GC_save_regs_in_stack_end-GC_save_regs_in_stack");
+# endif
+# ifdef LINT
+ word GC_save_regs_in_stack() { return(0 /* sp really */);}
+# endif
+# endif
+
+/* On IA64, we also need to flush register windows. But they end */
+/* up on the other side of the stack segment. */
+/* Returns the backing store pointer for the register stack. */
+/* We now implement this as a separate assembly file, since inline */
+/* assembly code here doesn't work with either the Intel or HP */
+/* compilers. */
+# if 0
+# ifdef LINUX
+ asm(" .text");
+ asm(" .psr abi64");
+ asm(" .psr lsb");
+ asm(" .lsb");
+ asm("");
+ asm(" .text");
+ asm(" .align 16");
+ asm(" .global GC_save_regs_in_stack");
+ asm(" .proc GC_save_regs_in_stack");
+ asm("GC_save_regs_in_stack:");
+ asm(" .body");
+ asm(" flushrs");
+ asm(" ;;");
+ asm(" mov r8=ar.bsp");
+ asm(" br.ret.sptk.few rp");
+ asm(" .endp GC_save_regs_in_stack");
+# endif /* LINUX */
+# if 0 /* Other alternatives that don't work on HP/UX */
+ word GC_save_regs_in_stack() {
+# if USE_BUILTINS
+ __builtin_ia64_flushrs();
+ return __builtin_ia64_bsp();
+# else
+# ifdef HPUX
+ _asm(" flushrs");
+ _asm(" ;;");
+ _asm(" mov r8=ar.bsp");
+ _asm(" br.ret.sptk.few rp");
+# else
+ asm(" flushrs");
+ asm(" ;;");
+ asm(" mov r8=ar.bsp");
+ asm(" br.ret.sptk.few rp");
+# endif
+# endif
+ }
+# endif
+# endif
+
+/* GC_clear_stack_inner(arg, limit) clears stack area up to limit and */
+/* returns arg. Stack clearing is crucial on SPARC, so we supply */
+/* an assembly version that's more careful. Assumes limit is hotter */
+/* than sp, and limit is 8 byte aligned. */
+#if defined(ASM_CLEAR_CODE)
+#ifndef SPARC
+ --> fix it
+#endif
+# ifdef SUNOS4
+ asm(".globl _GC_clear_stack_inner");
+ asm("_GC_clear_stack_inner:");
+# else
+ asm(".globl GC_clear_stack_inner");
+ asm("GC_clear_stack_inner:");
+ asm(".type GC_save_regs_in_stack,#function");
+# endif
+#if defined(__arch64__) || defined(__sparcv9)
+ asm("mov %sp,%o2"); /* Save sp */
+ asm("add %sp,2047-8,%o3"); /* p = sp+bias-8 */
+ asm("add %o1,-2047-192,%sp"); /* Move sp out of the way, */
+ /* so that traps still work. */
+ /* Includes some extra words */
+ /* so we can be sloppy below. */
+ asm("loop:");
+ asm("stx %g0,[%o3]"); /* *(long *)p = 0 */
+ asm("cmp %o3,%o1");
+ asm("bgu,pt %xcc, loop"); /* if (p > limit) goto loop */
+ asm("add %o3,-8,%o3"); /* p -= 8 (delay slot) */
+ asm("retl");
+ asm("mov %o2,%sp"); /* Restore sp., delay slot */
+#else
+ asm("mov %sp,%o2"); /* Save sp */
+ asm("add %sp,-8,%o3"); /* p = sp-8 */
+ asm("clr %g1"); /* [g0,g1] = 0 */
+ asm("add %o1,-0x60,%sp"); /* Move sp out of the way, */
+ /* so that traps still work. */
+ /* Includes some extra words */
+ /* so we can be sloppy below. */
+ asm("loop:");
+ asm("std %g0,[%o3]"); /* *(long long *)p = 0 */
+ asm("cmp %o3,%o1");
+ asm("bgu loop "); /* if (p > limit) goto loop */
+ asm("add %o3,-8,%o3"); /* p -= 8 (delay slot) */
+ asm("retl");
+ asm("mov %o2,%sp"); /* Restore sp., delay slot */
+#endif /* old SPARC */
+ /* First argument = %o0 = return value */
+# ifdef SVR4
+ asm(" .GC_clear_stack_inner_end:");
+ asm(" .size GC_clear_stack_inner,.GC_clear_stack_inner_end-GC_clear_stack_inner");
+# endif
+
+# ifdef LINT
+ /*ARGSUSED*/
+ ptr_t GC_clear_stack_inner(arg, limit)
+ ptr_t arg; word limit;
+ { return(arg); }
+# endif
+#endif
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, February 7, 1996 4:32 pm PST */
+
+#include <stdio.h>
+#include "private/gc_priv.h"
+
+extern ptr_t GC_clear_stack(); /* in misc.c, behaves like identity */
+void GC_extend_size_map(); /* in misc.c. */
+
+/* Allocate reclaim list for kind: */
+/* Return TRUE on success */
+GC_bool GC_alloc_reclaim_list(kind)
+register struct obj_kind * kind;
+{
+ struct hblk ** result = (struct hblk **)
+ GC_scratch_alloc((MAXOBJSZ+1) * sizeof(struct hblk *));
+ if (result == 0) return(FALSE);
+ BZERO(result, (MAXOBJSZ+1)*sizeof(struct hblk *));
+ kind -> ok_reclaim_list = result;
+ return(TRUE);
+}
+
+/* Allocate a large block of size lw words. */
+/* The block is not cleared. */
+/* Flags is 0 or IGNORE_OFF_PAGE. */
+ptr_t GC_alloc_large(lw, k, flags)
+word lw;
+int k;
+unsigned flags;
+{
+ struct hblk * h;
+ word n_blocks = OBJ_SZ_TO_BLOCKS(lw);
+ ptr_t result;
+
+ if (!GC_is_initialized) GC_init_inner();
+ /* Do our share of marking work */
+ if(GC_incremental && !GC_dont_gc)
+ GC_collect_a_little_inner((int)n_blocks);
+ h = GC_allochblk(lw, k, flags);
+# ifdef USE_MUNMAP
+ if (0 == h) {
+ GC_merge_unmapped();
+ h = GC_allochblk(lw, k, flags);
+ }
+# endif
+ while (0 == h && GC_collect_or_expand(n_blocks, (flags != 0))) {
+ h = GC_allochblk(lw, k, flags);
+ }
+ if (h == 0) {
+ result = 0;
+ } else {
+ int total_bytes = BYTES_TO_WORDS(n_blocks * HBLKSIZE);
+ if (n_blocks > 1) {
+ GC_large_allocd_bytes += n_blocks * HBLKSIZE;
+ if (GC_large_allocd_bytes > GC_max_large_allocd_bytes)
+ GC_max_large_allocd_bytes = GC_large_allocd_bytes;
+ }
+ result = (ptr_t) (h -> hb_body);
+ GC_words_wasted += total_bytes - lw;
+ }
+ return result;
+}
+
+
+/* Allocate a large block of size lb bytes. Clear if appropriate. */
+ptr_t GC_alloc_large_and_clear(lw, k, flags)
+word lw;
+int k;
+unsigned flags;
+{
+ ptr_t result = GC_alloc_large(lw, k, flags);
+ word n_blocks = OBJ_SZ_TO_BLOCKS(lw);
+
+ if (0 == result) return 0;
+ if (GC_debugging_started || GC_obj_kinds[k].ok_init) {
+ /* Clear the whole block, in case of GC_realloc call. */
+ BZERO(result, n_blocks * HBLKSIZE);
+ }
+ return result;
+}
+
+/* allocate lb bytes for an object of kind k. */
+/* Should not be used to directly to allocate */
+/* objects such as STUBBORN objects that */
+/* require special handling on allocation. */
+/* First a version that assumes we already */
+/* hold lock: */
+ptr_t GC_generic_malloc_inner(lb, k)
+register word lb;
+register int k;
+{
+register word lw;
+register ptr_t op;
+register ptr_t *opp;
+
+ if( SMALL_OBJ(lb) ) {
+ register struct obj_kind * kind = GC_obj_kinds + k;
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+ if (lw == 0) lw = MIN_WORDS;
+# endif
+ opp = &(kind -> ok_freelist[lw]);
+ if( (op = *opp) == 0 ) {
+# ifdef MERGE_SIZES
+ if (GC_size_map[lb] == 0) {
+ if (!GC_is_initialized) GC_init_inner();
+ if (GC_size_map[lb] == 0) GC_extend_size_map(lb);
+ return(GC_generic_malloc_inner(lb, k));
+ }
+# else
+ if (!GC_is_initialized) {
+ GC_init_inner();
+ return(GC_generic_malloc_inner(lb, k));
+ }
+# endif
+ if (kind -> ok_reclaim_list == 0) {
+ if (!GC_alloc_reclaim_list(kind)) goto out;
+ }
+ op = GC_allocobj(lw, k);
+ if (op == 0) goto out;
+ }
+ /* Here everything is in a consistent state. */
+ /* We assume the following assignment is */
+ /* atomic. If we get aborted */
+ /* after the assignment, we lose an object, */
+ /* but that's benign. */
+ /* Volatile declarations may need to be added */
+ /* to prevent the compiler from breaking things.*/
+ /* If we only execute the second of the */
+ /* following assignments, we lose the free */
+ /* list, but that should still be OK, at least */
+ /* for garbage collected memory. */
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ } else {
+ lw = ROUNDED_UP_WORDS(lb);
+ op = (ptr_t)GC_alloc_large_and_clear(lw, k, 0);
+ }
+ GC_words_allocd += lw;
+
+out:
+ return op;
+}
+
+/* Allocate a composite object of size n bytes. The caller guarantees */
+/* that pointers past the first page are not relevant. Caller holds */
+/* allocation lock. */
+ptr_t GC_generic_malloc_inner_ignore_off_page(lb, k)
+register size_t lb;
+register int k;
+{
+ register word lw;
+ ptr_t op;
+
+ if (lb <= HBLKSIZE)
+ return(GC_generic_malloc_inner((word)lb, k));
+ lw = ROUNDED_UP_WORDS(lb);
+ op = (ptr_t)GC_alloc_large_and_clear(lw, k, IGNORE_OFF_PAGE);
+ GC_words_allocd += lw;
+ return op;
+}
+
+ptr_t GC_generic_malloc(lb, k)
+register word lb;
+register int k;
+{
+ ptr_t result;
+ DCL_LOCK_STATE;
+
+ if (GC_have_errors) GC_print_all_errors();
+ GC_INVOKE_FINALIZERS();
+ if (SMALL_OBJ(lb)) {
+ DISABLE_SIGNALS();
+ LOCK();
+ result = GC_generic_malloc_inner((word)lb, k);
+ UNLOCK();
+ ENABLE_SIGNALS();
+ } else {
+ word lw;
+ word n_blocks;
+ GC_bool init;
+ lw = ROUNDED_UP_WORDS(lb);
+ n_blocks = OBJ_SZ_TO_BLOCKS(lw);
+ init = GC_obj_kinds[k].ok_init;
+ DISABLE_SIGNALS();
+ LOCK();
+ result = (ptr_t)GC_alloc_large(lw, k, 0);
+ if (0 != result) {
+ if (GC_debugging_started) {
+ BZERO(result, n_blocks * HBLKSIZE);
+ } else {
+# ifdef THREADS
+ /* Clear any memory that might be used for GC descriptors */
+ /* before we release the lock. */
+ ((word *)result)[0] = 0;
+ ((word *)result)[1] = 0;
+ ((word *)result)[lw-1] = 0;
+ ((word *)result)[lw-2] = 0;
+# endif
+ }
+ }
+ GC_words_allocd += lw;
+ UNLOCK();
+ ENABLE_SIGNALS();
+ if (init & !GC_debugging_started && 0 != result) {
+ BZERO(result, n_blocks * HBLKSIZE);
+ }
+ }
+ if (0 == result) {
+ return((*GC_oom_fn)(lb));
+ } else {
+ return(result);
+ }
+}
+
+
+#define GENERAL_MALLOC(lb,k) \
+ (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
+/* We make the GC_clear_stack_call a tail call, hoping to get more of */
+/* the stack. */
+
+/* Allocate lb bytes of atomic (pointerfree) data */
+# ifdef __STDC__
+ GC_PTR GC_malloc_atomic(size_t lb)
+# else
+ GC_PTR GC_malloc_atomic(lb)
+ size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+ if( EXPECT(SMALL_OBJ(lb), 1) ) {
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_aobjfreelist[lw]);
+ FASTLOCK();
+ if( EXPECT(!FASTLOCK_SUCCEEDED() || (op = *opp) == 0, 0) ) {
+ FASTUNLOCK();
+ return(GENERAL_MALLOC((word)lb, PTRFREE));
+ }
+ /* See above comment on signals. */
+ *opp = obj_link(op);
+ GC_words_allocd += lw;
+ FASTUNLOCK();
+ return((GC_PTR) op);
+ } else {
+ return(GENERAL_MALLOC((word)lb, PTRFREE));
+ }
+}
+
+/* Allocate lb bytes of composite (pointerful) data */
+# ifdef __STDC__
+ GC_PTR GC_malloc(size_t lb)
+# else
+ GC_PTR GC_malloc(lb)
+ size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t *opp;
+register word lw;
+DCL_LOCK_STATE;
+
+ if( EXPECT(SMALL_OBJ(lb), 1) ) {
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_objfreelist[lw]);
+ FASTLOCK();
+ if( EXPECT(!FASTLOCK_SUCCEEDED() || (op = *opp) == 0, 0) ) {
+ FASTUNLOCK();
+ return(GENERAL_MALLOC((word)lb, NORMAL));
+ }
+ /* See above comment on signals. */
+ GC_ASSERT(0 == obj_link(op)
+ || (word)obj_link(op)
+ <= (word)GC_greatest_plausible_heap_addr
+ && (word)obj_link(op)
+ >= (word)GC_least_plausible_heap_addr);
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ GC_words_allocd += lw;
+ FASTUNLOCK();
+ return((GC_PTR) op);
+ } else {
+ return(GENERAL_MALLOC((word)lb, NORMAL));
+ }
+}
+
+# ifdef REDIRECT_MALLOC
+# ifdef __STDC__
+ GC_PTR malloc(size_t lb)
+# else
+ GC_PTR malloc(lb)
+ size_t lb;
+# endif
+ {
+ /* It might help to manually inline the GC_malloc call here. */
+ /* But any decent compiler should reduce the extra procedure call */
+ /* to at most a jump instruction in this case. */
+# if defined(I386) && defined(GC_SOLARIS_THREADS)
+ /*
+ * Thread initialisation can call malloc before
+ * we're ready for it.
+ * It's not clear that this is enough to help matters.
+ * The thread implementation may well call malloc at other
+ * inopportune times.
+ */
+ if (!GC_is_initialized) return sbrk(lb);
+# endif /* I386 && GC_SOLARIS_THREADS */
+ return((GC_PTR)REDIRECT_MALLOC(lb));
+ }
+
+# ifdef __STDC__
+ GC_PTR calloc(size_t n, size_t lb)
+# else
+ GC_PTR calloc(n, lb)
+ size_t n, lb;
+# endif
+ {
+ return((GC_PTR)REDIRECT_MALLOC(n*lb));
+ }
+
+#ifndef strdup
+# include <string.h>
+# ifdef __STDC__
+ char *strdup(const char *s)
+# else
+ char *strdup(s)
+ char *s;
+# endif
+ {
+ size_t len = strlen(s) + 1;
+ char * result = ((char *)REDIRECT_MALLOC(len+1));
+ BCOPY(s, result, len+1);
+ return result;
+ }
+#endif /* !defined(strdup) */
+ /* If strdup is macro defined, we assume that it actually calls malloc, */
+ /* and thus the right thing will happen even without overriding it. */
+ /* This seems to be true on most Linux systems. */
+
+# endif /* REDIRECT_MALLOC */
+
+/* Explicitly deallocate an object p. */
+# ifdef __STDC__
+ void GC_free(GC_PTR p)
+# else
+ void GC_free(p)
+ GC_PTR p;
+# endif
+{
+ register struct hblk *h;
+ register hdr *hhdr;
+ register signed_word sz;
+ register ptr_t * flh;
+ register int knd;
+ register struct obj_kind * ok;
+ DCL_LOCK_STATE;
+
+ if (p == 0) return;
+ /* Required by ANSI. It's not my fault ... */
+ h = HBLKPTR(p);
+ hhdr = HDR(h);
+ GC_ASSERT(GC_base(p) == p);
+# if defined(REDIRECT_MALLOC) && \
+ (defined(GC_SOLARIS_THREADS) || defined(GC_LINUX_THREADS) \
+ || defined(__MINGW32__)) /* Should this be MSWIN32 in general? */
+ /* For Solaris, we have to redirect malloc calls during */
+ /* initialization. For the others, this seems to happen */
+ /* implicitly. */
+ /* Don't try to deallocate that memory. */
+ if (0 == hhdr) return;
+# endif
+ knd = hhdr -> hb_obj_kind;
+ sz = hhdr -> hb_sz;
+ ok = &GC_obj_kinds[knd];
+ if (EXPECT((sz <= MAXOBJSZ), 1)) {
+# ifdef THREADS
+ DISABLE_SIGNALS();
+ LOCK();
+# endif
+ GC_mem_freed += sz;
+ /* A signal here can make GC_mem_freed and GC_non_gc_bytes */
+ /* inconsistent. We claim this is benign. */
+ if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
+ /* Its unnecessary to clear the mark bit. If the */
+ /* object is reallocated, it doesn't matter. O.w. the */
+ /* collector will do it, since it's on a free list. */
+ if (ok -> ok_init) {
+ BZERO((word *)p + 1, WORDS_TO_BYTES(sz-1));
+ }
+ flh = &(ok -> ok_freelist[sz]);
+ obj_link(p) = *flh;
+ *flh = (ptr_t)p;
+# ifdef THREADS
+ UNLOCK();
+ ENABLE_SIGNALS();
+# endif
+ } else {
+ DISABLE_SIGNALS();
+ LOCK();
+ GC_mem_freed += sz;
+ if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
+ GC_freehblk(h);
+ UNLOCK();
+ ENABLE_SIGNALS();
+ }
+}
+
+/* Explicitly deallocate an object p when we already hold lock. */
+/* Only used for internally allocated objects, so we can take some */
+/* shortcuts. */
+#ifdef THREADS
+void GC_free_inner(GC_PTR p)
+{
+ register struct hblk *h;
+ register hdr *hhdr;
+ register signed_word sz;
+ register ptr_t * flh;
+ register int knd;
+ register struct obj_kind * ok;
+ DCL_LOCK_STATE;
+
+ h = HBLKPTR(p);
+ hhdr = HDR(h);
+ knd = hhdr -> hb_obj_kind;
+ sz = hhdr -> hb_sz;
+ ok = &GC_obj_kinds[knd];
+ if (sz <= MAXOBJSZ) {
+ GC_mem_freed += sz;
+ if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
+ if (ok -> ok_init) {
+ BZERO((word *)p + 1, WORDS_TO_BYTES(sz-1));
+ }
+ flh = &(ok -> ok_freelist[sz]);
+ obj_link(p) = *flh;
+ *flh = (ptr_t)p;
+ } else {
+ GC_mem_freed += sz;
+ if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
+ GC_freehblk(h);
+ }
+}
+#endif /* THREADS */
+
+# if defined(REDIRECT_MALLOC) && !defined(REDIRECT_FREE)
+# define REDIRECT_FREE GC_free
+# endif
+# ifdef REDIRECT_FREE
+# ifdef __STDC__
+ void free(GC_PTR p)
+# else
+ void free(p)
+ GC_PTR p;
+# endif
+ {
+# ifndef IGNORE_FREE
+ REDIRECT_FREE(p);
+# endif
+ }
+# endif /* REDIRECT_MALLOC */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * These are extra allocation routines which are likely to be less
+ * frequently used than those in malloc.c. They are separate in the
+ * hope that the .o file will be excluded from statically linked
+ * executables. We should probably break this up further.
+ */
+
+#include <stdio.h>
+#include "private/gc_priv.h"
+
+extern ptr_t GC_clear_stack(); /* in misc.c, behaves like identity */
+void GC_extend_size_map(); /* in misc.c. */
+GC_bool GC_alloc_reclaim_list(); /* in malloc.c */
+
+/* Some externally visible but unadvertised variables to allow access to */
+/* free lists from inlined allocators without including gc_priv.h */
+/* or introducing dependencies on internal data structure layouts. */
+ptr_t * GC_CONST GC_objfreelist_ptr = GC_objfreelist;
+ptr_t * GC_CONST GC_aobjfreelist_ptr = GC_aobjfreelist;
+ptr_t * GC_CONST GC_uobjfreelist_ptr = GC_uobjfreelist;
+# ifdef ATOMIC_UNCOLLECTABLE
+ ptr_t * GC_CONST GC_auobjfreelist_ptr = GC_auobjfreelist;
+# endif
+
+
+GC_PTR GC_generic_or_special_malloc(lb,knd)
+word lb;
+int knd;
+{
+ switch(knd) {
+# ifdef STUBBORN_ALLOC
+ case STUBBORN:
+ return(GC_malloc_stubborn((size_t)lb));
+# endif
+ case PTRFREE:
+ return(GC_malloc_atomic((size_t)lb));
+ case NORMAL:
+ return(GC_malloc((size_t)lb));
+ case UNCOLLECTABLE:
+ return(GC_malloc_uncollectable((size_t)lb));
+# ifdef ATOMIC_UNCOLLECTABLE
+ case AUNCOLLECTABLE:
+ return(GC_malloc_atomic_uncollectable((size_t)lb));
+# endif /* ATOMIC_UNCOLLECTABLE */
+ default:
+ return(GC_generic_malloc(lb,knd));
+ }
+}
+
+
+/* Change the size of the block pointed to by p to contain at least */
+/* lb bytes. The object may be (and quite likely will be) moved. */
+/* The kind (e.g. atomic) is the same as that of the old. */
+/* Shrinking of large blocks is not implemented well. */
+# ifdef __STDC__
+ GC_PTR GC_realloc(GC_PTR p, size_t lb)
+# else
+ GC_PTR GC_realloc(p,lb)
+ GC_PTR p;
+ size_t lb;
+# endif
+{
+register struct hblk * h;
+register hdr * hhdr;
+register word sz; /* Current size in bytes */
+register word orig_sz; /* Original sz in bytes */
+int obj_kind;
+
+ if (p == 0) return(GC_malloc(lb)); /* Required by ANSI */
+ h = HBLKPTR(p);
+ hhdr = HDR(h);
+ sz = hhdr -> hb_sz;
+ obj_kind = hhdr -> hb_obj_kind;
+ sz = WORDS_TO_BYTES(sz);
+ orig_sz = sz;
+
+ if (sz > MAXOBJBYTES) {
+ /* Round it up to the next whole heap block */
+ register word descr;
+
+ sz = (sz+HBLKSIZE-1) & (~HBLKMASK);
+ hhdr -> hb_sz = BYTES_TO_WORDS(sz);
+ descr = GC_obj_kinds[obj_kind].ok_descriptor;
+ if (GC_obj_kinds[obj_kind].ok_relocate_descr) descr += sz;
+ hhdr -> hb_descr = descr;
+ if (IS_UNCOLLECTABLE(obj_kind)) GC_non_gc_bytes += (sz - orig_sz);
+ /* Extra area is already cleared by GC_alloc_large_and_clear. */
+ }
+ if (ADD_SLOP(lb) <= sz) {
+ if (lb >= (sz >> 1)) {
+# ifdef STUBBORN_ALLOC
+ if (obj_kind == STUBBORN) GC_change_stubborn(p);
+# endif
+ if (orig_sz > lb) {
+ /* Clear unneeded part of object to avoid bogus pointer */
+ /* tracing. */
+ /* Safe for stubborn objects. */
+ BZERO(((ptr_t)p) + lb, orig_sz - lb);
+ }
+ return(p);
+ } else {
+ /* shrink */
+ GC_PTR result =
+ GC_generic_or_special_malloc((word)lb, obj_kind);
+
+ if (result == 0) return(0);
+ /* Could also return original object. But this */
+ /* gives the client warning of imminent disaster. */
+ BCOPY(p, result, lb);
+# ifndef IGNORE_FREE
+ GC_free(p);
+# endif
+ return(result);
+ }
+ } else {
+ /* grow */
+ GC_PTR result =
+ GC_generic_or_special_malloc((word)lb, obj_kind);
+
+ if (result == 0) return(0);
+ BCOPY(p, result, sz);
+# ifndef IGNORE_FREE
+ GC_free(p);
+# endif
+ return(result);
+ }
+}
+
+# if defined(REDIRECT_MALLOC) && !defined(REDIRECT_REALLOC)
+# define REDIRECT_REALLOC GC_realloc
+# endif
+
+# ifdef REDIRECT_REALLOC
+# ifdef __STDC__
+ GC_PTR realloc(GC_PTR p, size_t lb)
+# else
+ GC_PTR realloc(p,lb)
+ GC_PTR p;
+ size_t lb;
+# endif
+ {
+ return(REDIRECT_REALLOC(p, lb));
+ }
+# endif /* REDIRECT_REALLOC */
+
+
+/* The same thing, except caller does not hold allocation lock. */
+/* We avoid holding allocation lock while we clear memory. */
+ptr_t GC_generic_malloc_ignore_off_page(lb, k)
+register size_t lb;
+register int k;
+{
+ register ptr_t result;
+ word lw;
+ word n_blocks;
+ GC_bool init;
+ DCL_LOCK_STATE;
+
+ if (SMALL_OBJ(lb))
+ return(GC_generic_malloc((word)lb, k));
+ lw = ROUNDED_UP_WORDS(lb);
+ n_blocks = OBJ_SZ_TO_BLOCKS(lw);
+ init = GC_obj_kinds[k].ok_init;
+ if (GC_have_errors) GC_print_all_errors();
+ GC_INVOKE_FINALIZERS();
+ DISABLE_SIGNALS();
+ LOCK();
+ result = (ptr_t)GC_alloc_large(lw, k, IGNORE_OFF_PAGE);
+ if (0 != result) {
+ if (GC_debugging_started) {
+ BZERO(result, n_blocks * HBLKSIZE);
+ } else {
+# ifdef THREADS
+ /* Clear any memory that might be used for GC descriptors */
+ /* before we release the lock. */
+ ((word *)result)[0] = 0;
+ ((word *)result)[1] = 0;
+ ((word *)result)[lw-1] = 0;
+ ((word *)result)[lw-2] = 0;
+# endif
+ }
+ }
+ GC_words_allocd += lw;
+ UNLOCK();
+ ENABLE_SIGNALS();
+ if (0 == result) {
+ return((*GC_oom_fn)(lb));
+ } else {
+ if (init & !GC_debugging_started) {
+ BZERO(result, n_blocks * HBLKSIZE);
+ }
+ return(result);
+ }
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void * GC_malloc_ignore_off_page(size_t lb)
+# else
+ char * GC_malloc_ignore_off_page(lb)
+ register size_t lb;
+# endif
+{
+ return((GC_PTR)GC_generic_malloc_ignore_off_page(lb, NORMAL));
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void * GC_malloc_atomic_ignore_off_page(size_t lb)
+# else
+ char * GC_malloc_atomic_ignore_off_page(lb)
+ register size_t lb;
+# endif
+{
+ return((GC_PTR)GC_generic_malloc_ignore_off_page(lb, PTRFREE));
+}
+
+/* Increment GC_words_allocd from code that doesn't have direct access */
+/* to GC_arrays. */
+# ifdef __STDC__
+void GC_incr_words_allocd(size_t n)
+{
+ GC_words_allocd += n;
+}
+
+/* The same for GC_mem_freed. */
+void GC_incr_mem_freed(size_t n)
+{
+ GC_mem_freed += n;
+}
+# endif /* __STDC__ */
+
+/* Analogous to the above, but assumes a small object size, and */
+/* bypasses MERGE_SIZES mechanism. Used by gc_inline.h. */
+ptr_t GC_generic_malloc_words_small_inner(lw, k)
+register word lw;
+register int k;
+{
+register ptr_t op;
+register ptr_t *opp;
+register struct obj_kind * kind = GC_obj_kinds + k;
+
+ opp = &(kind -> ok_freelist[lw]);
+ if( (op = *opp) == 0 ) {
+ if (!GC_is_initialized) {
+ GC_init_inner();
+ }
+ if (kind -> ok_reclaim_list != 0 || GC_alloc_reclaim_list(kind)) {
+ op = GC_clear_stack(GC_allocobj((word)lw, k));
+ }
+ if (op == 0) {
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return ((*GC_oom_fn)(WORDS_TO_BYTES(lw)));
+ }
+ }
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ GC_words_allocd += lw;
+ return((ptr_t)op);
+}
+
+/* Analogous to the above, but assumes a small object size, and */
+/* bypasses MERGE_SIZES mechanism. Used by gc_inline.h. */
+#ifdef __STDC__
+ ptr_t GC_generic_malloc_words_small(size_t lw, int k)
+#else
+ ptr_t GC_generic_malloc_words_small(lw, k)
+ register word lw;
+ register int k;
+#endif
+{
+register ptr_t op;
+DCL_LOCK_STATE;
+
+ if (GC_have_errors) GC_print_all_errors();
+ GC_INVOKE_FINALIZERS();
+ DISABLE_SIGNALS();
+ LOCK();
+ op = GC_generic_malloc_words_small_inner(lw, k);
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return((ptr_t)op);
+}
+
+#if defined(THREADS) && !defined(SRC_M3)
+
+extern signed_word GC_mem_found; /* Protected by GC lock. */
+
+#ifdef PARALLEL_MARK
+volatile signed_word GC_words_allocd_tmp = 0;
+ /* Number of words of memory allocated since */
+ /* we released the GC lock. Instead of */
+ /* reacquiring the GC lock just to add this in, */
+ /* we add it in the next time we reacquire */
+ /* the lock. (Atomically adding it doesn't */
+ /* work, since we would have to atomically */
+ /* update it in GC_malloc, which is too */
+ /* expensive. */
+#endif /* PARALLEL_MARK */
+
+/* See reclaim.c: */
+extern ptr_t GC_reclaim_generic();
+
+/* Return a list of 1 or more objects of the indicated size, linked */
+/* through the first word in the object. This has the advantage that */
+/* it acquires the allocation lock only once, and may greatly reduce */
+/* time wasted contending for the allocation lock. Typical usage would */
+/* be in a thread that requires many items of the same size. It would */
+/* keep its own free list in thread-local storage, and call */
+/* GC_malloc_many or friends to replenish it. (We do not round up */
+/* object sizes, since a call indicates the intention to consume many */
+/* objects of exactly this size.) */
+/* We return the free-list by assigning it to *result, since it is */
+/* not safe to return, e.g. a linked list of pointer-free objects, */
+/* since the collector would not retain the entire list if it were */
+/* invoked just as we were returning. */
+/* Note that the client should usually clear the link field. */
+void GC_generic_malloc_many(lb, k, result)
+register word lb;
+register int k;
+ptr_t *result;
+{
+ptr_t op;
+ptr_t p;
+ptr_t *opp;
+word lw;
+word my_words_allocd = 0;
+struct obj_kind * ok = &(GC_obj_kinds[k]);
+DCL_LOCK_STATE;
+
+# if defined(GATHERSTATS) || defined(PARALLEL_MARK)
+# define COUNT_ARG , &my_words_allocd
+# else
+# define COUNT_ARG
+# define NEED_TO_COUNT
+# endif
+ if (!SMALL_OBJ(lb)) {
+ op = GC_generic_malloc(lb, k);
+ if(0 != op) obj_link(op) = 0;
+ *result = op;
+ return;
+ }
+ lw = ALIGNED_WORDS(lb);
+ if (GC_have_errors) GC_print_all_errors();
+ GC_INVOKE_FINALIZERS();
+ DISABLE_SIGNALS();
+ LOCK();
+ if (!GC_is_initialized) GC_init_inner();
+ /* Do our share of marking work */
+ if (GC_incremental && !GC_dont_gc) {
+ ENTER_GC();
+ GC_collect_a_little_inner(1);
+ EXIT_GC();
+ }
+ /* First see if we can reclaim a page of objects waiting to be */
+ /* reclaimed. */
+ {
+ struct hblk ** rlh = ok -> ok_reclaim_list;
+ struct hblk * hbp;
+ hdr * hhdr;
+
+ rlh += lw;
+ while ((hbp = *rlh) != 0) {
+ hhdr = HDR(hbp);
+ *rlh = hhdr -> hb_next;
+ hhdr -> hb_last_reclaimed = (unsigned short) GC_gc_no;
+# ifdef PARALLEL_MARK
+ {
+ signed_word my_words_allocd_tmp = GC_words_allocd_tmp;
+
+ GC_ASSERT(my_words_allocd_tmp >= 0);
+ /* We only decrement it while holding the GC lock. */
+ /* Thus we can't accidentally adjust it down in more */
+ /* than one thread simultaneously. */
+ if (my_words_allocd_tmp != 0) {
+ (void)GC_atomic_add(
+ (volatile GC_word *)(&GC_words_allocd_tmp),
+ (GC_word)(-my_words_allocd_tmp));
+ GC_words_allocd += my_words_allocd_tmp;
+ }
+ }
+ GC_acquire_mark_lock();
+ ++ GC_fl_builder_count;
+ UNLOCK();
+ ENABLE_SIGNALS();
+ GC_release_mark_lock();
+# endif
+ op = GC_reclaim_generic(hbp, hhdr, lw,
+ ok -> ok_init, 0 COUNT_ARG);
+ if (op != 0) {
+# ifdef NEED_TO_COUNT
+ /* We are neither gathering statistics, nor marking in */
+ /* parallel. Thus GC_reclaim_generic doesn't count */
+ /* for us. */
+ for (p = op; p != 0; p = obj_link(p)) {
+ my_words_allocd += lw;
+ }
+# endif
+# if defined(GATHERSTATS)
+ /* We also reclaimed memory, so we need to adjust */
+ /* that count. */
+ /* This should be atomic, so the results may be */
+ /* inaccurate. */
+ GC_mem_found += my_words_allocd;
+# endif
+# ifdef PARALLEL_MARK
+ *result = op;
+ (void)GC_atomic_add(
+ (volatile GC_word *)(&GC_words_allocd_tmp),
+ (GC_word)(my_words_allocd));
+ GC_acquire_mark_lock();
+ -- GC_fl_builder_count;
+ if (GC_fl_builder_count == 0) GC_notify_all_builder();
+ GC_release_mark_lock();
+ (void) GC_clear_stack(0);
+ return;
+# else
+ GC_words_allocd += my_words_allocd;
+ goto out;
+# endif
+ }
+# ifdef PARALLEL_MARK
+ GC_acquire_mark_lock();
+ -- GC_fl_builder_count;
+ if (GC_fl_builder_count == 0) GC_notify_all_builder();
+ GC_release_mark_lock();
+ DISABLE_SIGNALS();
+ LOCK();
+ /* GC lock is needed for reclaim list access. We */
+ /* must decrement fl_builder_count before reaquiring GC */
+ /* lock. Hopefully this path is rare. */
+# endif
+ }
+ }
+ /* Next try to use prefix of global free list if there is one. */
+ /* We don't refill it, but we need to use it up before allocating */
+ /* a new block ourselves. */
+ opp = &(GC_obj_kinds[k].ok_freelist[lw]);
+ if ( (op = *opp) != 0 ) {
+ *opp = 0;
+ my_words_allocd = 0;
+ for (p = op; p != 0; p = obj_link(p)) {
+ my_words_allocd += lw;
+ if (my_words_allocd >= BODY_SZ) {
+ *opp = obj_link(p);
+ obj_link(p) = 0;
+ break;
+ }
+ }
+ GC_words_allocd += my_words_allocd;
+ goto out;
+ }
+ /* Next try to allocate a new block worth of objects of this size. */
+ {
+ struct hblk *h = GC_allochblk(lw, k, 0);
+ if (h != 0) {
+ if (IS_UNCOLLECTABLE(k)) GC_set_hdr_marks(HDR(h));
+ GC_words_allocd += BYTES_TO_WORDS(HBLKSIZE)
+ - BYTES_TO_WORDS(HBLKSIZE) % lw;
+# ifdef PARALLEL_MARK
+ GC_acquire_mark_lock();
+ ++ GC_fl_builder_count;
+ UNLOCK();
+ ENABLE_SIGNALS();
+ GC_release_mark_lock();
+# endif
+
+ op = GC_build_fl(h, lw, ok -> ok_init, 0);
+# ifdef PARALLEL_MARK
+ *result = op;
+ GC_acquire_mark_lock();
+ -- GC_fl_builder_count;
+ if (GC_fl_builder_count == 0) GC_notify_all_builder();
+ GC_release_mark_lock();
+ (void) GC_clear_stack(0);
+ return;
+# else
+ goto out;
+# endif
+ }
+ }
+
+ /* As a last attempt, try allocating a single object. Note that */
+ /* this may trigger a collection or expand the heap. */
+ op = GC_generic_malloc_inner(lb, k);
+ if (0 != op) obj_link(op) = 0;
+
+ out:
+ *result = op;
+ UNLOCK();
+ ENABLE_SIGNALS();
+ (void) GC_clear_stack(0);
+}
+
+GC_PTR GC_malloc_many(size_t lb)
+{
+ ptr_t result;
+ GC_generic_malloc_many(lb, NORMAL, &result);
+ return result;
+}
+
+/* Note that the "atomic" version of this would be unsafe, since the */
+/* links would not be seen by the collector. */
+# endif
+
+/* Allocate lb bytes of pointerful, traced, but not collectable data */
+# ifdef __STDC__
+ GC_PTR GC_malloc_uncollectable(size_t lb)
+# else
+ GC_PTR GC_malloc_uncollectable(lb)
+ size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t *opp;
+register word lw;
+DCL_LOCK_STATE;
+
+ if( SMALL_OBJ(lb) ) {
+# ifdef MERGE_SIZES
+ if (EXTRA_BYTES != 0 && lb != 0) lb--;
+ /* We don't need the extra byte, since this won't be */
+ /* collected anyway. */
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_uobjfreelist[lw]);
+ FASTLOCK();
+ if( FASTLOCK_SUCCEEDED() && (op = *opp) != 0 ) {
+ /* See above comment on signals. */
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ GC_words_allocd += lw;
+ /* Mark bit ws already set on free list. It will be */
+ /* cleared only temporarily during a collection, as a */
+ /* result of the normal free list mark bit clearing. */
+ GC_non_gc_bytes += WORDS_TO_BYTES(lw);
+ FASTUNLOCK();
+ return((GC_PTR) op);
+ }
+ FASTUNLOCK();
+ op = (ptr_t)GC_generic_malloc((word)lb, UNCOLLECTABLE);
+ } else {
+ op = (ptr_t)GC_generic_malloc((word)lb, UNCOLLECTABLE);
+ }
+ if (0 == op) return(0);
+ /* We don't need the lock here, since we have an undisguised */
+ /* pointer. We do need to hold the lock while we adjust */
+ /* mark bits. */
+ {
+ register struct hblk * h;
+
+ h = HBLKPTR(op);
+ lw = HDR(h) -> hb_sz;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ GC_set_mark_bit(op);
+ GC_non_gc_bytes += WORDS_TO_BYTES(lw);
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return((GC_PTR) op);
+ }
+}
+
+#ifdef __STDC__
+/* Not well tested nor integrated. */
+/* Debug version is tricky and currently missing. */
+#include <limits.h>
+
+GC_PTR GC_memalign(size_t align, size_t lb)
+{
+ size_t new_lb;
+ size_t offset;
+ ptr_t result;
+
+# ifdef ALIGN_DOUBLE
+ if (align <= WORDS_TO_BYTES(2) && lb > align) return GC_malloc(lb);
+# endif
+ if (align <= WORDS_TO_BYTES(1)) return GC_malloc(lb);
+ if (align >= HBLKSIZE/2 || lb >= HBLKSIZE/2) {
+ if (align > HBLKSIZE) return GC_oom_fn(LONG_MAX-1024) /* Fail */;
+ return GC_malloc(lb <= HBLKSIZE? HBLKSIZE : lb);
+ /* Will be HBLKSIZE aligned. */
+ }
+ /* We could also try to make sure that the real rounded-up object size */
+ /* is a multiple of align. That would be correct up to HBLKSIZE. */
+ new_lb = lb + align - 1;
+ result = GC_malloc(new_lb);
+ offset = (word)result % align;
+ if (offset != 0) {
+ offset = align - offset;
+ if (!GC_all_interior_pointers) {
+ if (offset >= VALID_OFFSET_SZ) return GC_malloc(HBLKSIZE);
+ GC_register_displacement(offset);
+ }
+ }
+ result = (GC_PTR) ((ptr_t)result + offset);
+ GC_ASSERT((word)result % align == 0);
+ return result;
+}
+#endif
+
+# ifdef ATOMIC_UNCOLLECTABLE
+/* Allocate lb bytes of pointerfree, untraced, uncollectable data */
+/* This is normally roughly equivalent to the system malloc. */
+/* But it may be useful if malloc is redefined. */
+# ifdef __STDC__
+ GC_PTR GC_malloc_atomic_uncollectable(size_t lb)
+# else
+ GC_PTR GC_malloc_atomic_uncollectable(lb)
+ size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t *opp;
+register word lw;
+DCL_LOCK_STATE;
+
+ if( SMALL_OBJ(lb) ) {
+# ifdef MERGE_SIZES
+ if (EXTRA_BYTES != 0 && lb != 0) lb--;
+ /* We don't need the extra byte, since this won't be */
+ /* collected anyway. */
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_auobjfreelist[lw]);
+ FASTLOCK();
+ if( FASTLOCK_SUCCEEDED() && (op = *opp) != 0 ) {
+ /* See above comment on signals. */
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ GC_words_allocd += lw;
+ /* Mark bit was already set while object was on free list. */
+ GC_non_gc_bytes += WORDS_TO_BYTES(lw);
+ FASTUNLOCK();
+ return((GC_PTR) op);
+ }
+ FASTUNLOCK();
+ op = (ptr_t)GC_generic_malloc((word)lb, AUNCOLLECTABLE);
+ } else {
+ op = (ptr_t)GC_generic_malloc((word)lb, AUNCOLLECTABLE);
+ }
+ if (0 == op) return(0);
+ /* We don't need the lock here, since we have an undisguised */
+ /* pointer. We do need to hold the lock while we adjust */
+ /* mark bits. */
+ {
+ register struct hblk * h;
+
+ h = HBLKPTR(op);
+ lw = HDR(h) -> hb_sz;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ GC_set_mark_bit(op);
+ GC_non_gc_bytes += WORDS_TO_BYTES(lw);
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return((GC_PTR) op);
+ }
+}
+
+#endif /* ATOMIC_UNCOLLECTABLE */
--- /dev/null
+
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+
+
+# include <stdio.h>
+# include "private/gc_pmark.h"
+
+/* We put this here to minimize the risk of inlining. */
+/*VARARGS*/
+#ifdef __WATCOMC__
+ void GC_noop(void *p, ...) {}
+#else
+ void GC_noop() {}
+#endif
+
+/* Single argument version, robust against whole program analysis. */
+void GC_noop1(x)
+word x;
+{
+ static VOLATILE word sink;
+
+ sink = x;
+}
+
+/* mark_proc GC_mark_procs[MAX_MARK_PROCS] = {0} -- declared in gc_priv.h */
+
+word GC_n_mark_procs = GC_RESERVED_MARK_PROCS;
+
+/* Initialize GC_obj_kinds properly and standard free lists properly. */
+/* This must be done statically since they may be accessed before */
+/* GC_init is called. */
+/* It's done here, since we need to deal with mark descriptors. */
+struct obj_kind GC_obj_kinds[MAXOBJKINDS] = {
+/* PTRFREE */ { &GC_aobjfreelist[0], 0 /* filled in dynamically */,
+ 0 | GC_DS_LENGTH, FALSE, FALSE },
+/* NORMAL */ { &GC_objfreelist[0], 0,
+ 0 | GC_DS_LENGTH, /* Adjusted in GC_init_inner for EXTRA_BYTES */
+ TRUE /* add length to descr */, TRUE },
+/* UNCOLLECTABLE */
+ { &GC_uobjfreelist[0], 0,
+ 0 | GC_DS_LENGTH, TRUE /* add length to descr */, TRUE },
+# ifdef ATOMIC_UNCOLLECTABLE
+ /* AUNCOLLECTABLE */
+ { &GC_auobjfreelist[0], 0,
+ 0 | GC_DS_LENGTH, FALSE /* add length to descr */, FALSE },
+# endif
+# ifdef STUBBORN_ALLOC
+/*STUBBORN*/ { &GC_sobjfreelist[0], 0,
+ 0 | GC_DS_LENGTH, TRUE /* add length to descr */, TRUE },
+# endif
+};
+
+# ifdef ATOMIC_UNCOLLECTABLE
+# ifdef STUBBORN_ALLOC
+ int GC_n_kinds = 5;
+# else
+ int GC_n_kinds = 4;
+# endif
+# else
+# ifdef STUBBORN_ALLOC
+ int GC_n_kinds = 4;
+# else
+ int GC_n_kinds = 3;
+# endif
+# endif
+
+
+# ifndef INITIAL_MARK_STACK_SIZE
+# define INITIAL_MARK_STACK_SIZE (1*HBLKSIZE)
+ /* INITIAL_MARK_STACK_SIZE * sizeof(mse) should be a */
+ /* multiple of HBLKSIZE. */
+ /* The incremental collector actually likes a larger */
+ /* size, since it want to push all marked dirty objs */
+ /* before marking anything new. Currently we let it */
+ /* grow dynamically. */
+# endif
+
+/*
+ * Limits of stack for GC_mark routine.
+ * All ranges between GC_mark_stack(incl.) and GC_mark_stack_top(incl.) still
+ * need to be marked from.
+ */
+
+word GC_n_rescuing_pages; /* Number of dirty pages we marked from */
+ /* excludes ptrfree pages, etc. */
+
+mse * GC_mark_stack;
+
+mse * GC_mark_stack_limit;
+
+word GC_mark_stack_size = 0;
+
+#ifdef PARALLEL_MARK
+ mse * VOLATILE GC_mark_stack_top;
+#else
+ mse * GC_mark_stack_top;
+#endif
+
+static struct hblk * scan_ptr;
+
+mark_state_t GC_mark_state = MS_NONE;
+
+GC_bool GC_mark_stack_too_small = FALSE;
+
+GC_bool GC_objects_are_marked = FALSE; /* Are there collectable marked */
+ /* objects in the heap? */
+
+/* Is a collection in progress? Note that this can return true in the */
+/* nonincremental case, if a collection has been abandoned and the */
+/* mark state is now MS_INVALID. */
+GC_bool GC_collection_in_progress()
+{
+ return(GC_mark_state != MS_NONE);
+}
+
+/* clear all mark bits in the header */
+void GC_clear_hdr_marks(hhdr)
+register hdr * hhdr;
+{
+# ifdef USE_MARK_BYTES
+ BZERO(hhdr -> hb_marks, MARK_BITS_SZ);
+# else
+ BZERO(hhdr -> hb_marks, MARK_BITS_SZ*sizeof(word));
+# endif
+}
+
+/* Set all mark bits in the header. Used for uncollectable blocks. */
+void GC_set_hdr_marks(hhdr)
+register hdr * hhdr;
+{
+ register int i;
+
+ for (i = 0; i < MARK_BITS_SZ; ++i) {
+# ifdef USE_MARK_BYTES
+ hhdr -> hb_marks[i] = 1;
+# else
+ hhdr -> hb_marks[i] = ONES;
+# endif
+ }
+}
+
+/*
+ * Clear all mark bits associated with block h.
+ */
+/*ARGSUSED*/
+# if defined(__STDC__) || defined(__cplusplus)
+ static void clear_marks_for_block(struct hblk *h, word dummy)
+# else
+ static void clear_marks_for_block(h, dummy)
+ struct hblk *h;
+ word dummy;
+# endif
+{
+ register hdr * hhdr = HDR(h);
+
+ if (IS_UNCOLLECTABLE(hhdr -> hb_obj_kind)) return;
+ /* Mark bit for these is cleared only once the object is */
+ /* explicitly deallocated. This either frees the block, or */
+ /* the bit is cleared once the object is on the free list. */
+ GC_clear_hdr_marks(hhdr);
+}
+
+/* Slow but general routines for setting/clearing/asking about mark bits */
+void GC_set_mark_bit(p)
+ptr_t p;
+{
+ register struct hblk *h = HBLKPTR(p);
+ register hdr * hhdr = HDR(h);
+ register int word_no = (word *)p - (word *)h;
+
+ set_mark_bit_from_hdr(hhdr, word_no);
+}
+
+void GC_clear_mark_bit(p)
+ptr_t p;
+{
+ register struct hblk *h = HBLKPTR(p);
+ register hdr * hhdr = HDR(h);
+ register int word_no = (word *)p - (word *)h;
+
+ clear_mark_bit_from_hdr(hhdr, word_no);
+}
+
+GC_bool GC_is_marked(p)
+ptr_t p;
+{
+ register struct hblk *h = HBLKPTR(p);
+ register hdr * hhdr = HDR(h);
+ register int word_no = (word *)p - (word *)h;
+
+ return(mark_bit_from_hdr(hhdr, word_no));
+}
+
+
+/*
+ * Clear mark bits in all allocated heap blocks. This invalidates
+ * the marker invariant, and sets GC_mark_state to reflect this.
+ * (This implicitly starts marking to reestablish the invariant.)
+ */
+void GC_clear_marks()
+{
+ GC_apply_to_all_blocks(clear_marks_for_block, (word)0);
+ GC_objects_are_marked = FALSE;
+ GC_mark_state = MS_INVALID;
+ scan_ptr = 0;
+# ifdef GATHERSTATS
+ /* Counters reflect currently marked objects: reset here */
+ GC_composite_in_use = 0;
+ GC_atomic_in_use = 0;
+# endif
+
+}
+
+/* Initiate a garbage collection. Initiates a full collection if the */
+/* mark state is invalid. */
+/*ARGSUSED*/
+void GC_initiate_gc()
+{
+ if (GC_dirty_maintained) GC_read_dirty();
+# ifdef STUBBORN_ALLOC
+ GC_read_changed();
+# endif
+# ifdef CHECKSUMS
+ {
+ extern void GC_check_dirty();
+
+ if (GC_dirty_maintained) GC_check_dirty();
+ }
+# endif
+ GC_n_rescuing_pages = 0;
+ if (GC_mark_state == MS_NONE) {
+ GC_mark_state = MS_PUSH_RESCUERS;
+ } else if (GC_mark_state != MS_INVALID) {
+ ABORT("unexpected state");
+ } /* else this is really a full collection, and mark */
+ /* bits are invalid. */
+ scan_ptr = 0;
+}
+
+
+static void alloc_mark_stack();
+
+/* Perform a small amount of marking. */
+/* We try to touch roughly a page of memory. */
+/* Return TRUE if we just finished a mark phase. */
+/* Cold_gc_frame is an address inside a GC frame that */
+/* remains valid until all marking is complete. */
+/* A zero value indicates that it's OK to miss some */
+/* register values. */
+GC_bool GC_mark_some(cold_gc_frame)
+ptr_t cold_gc_frame;
+{
+#if defined(MSWIN32) && !defined(__GNUC__)
+ /* Windows 98 appears to asynchronously create and remove writable */
+ /* memory mappings, for reasons we haven't yet understood. Since */
+ /* we look for writable regions to determine the root set, we may */
+ /* try to mark from an address range that disappeared since we */
+ /* started the collection. Thus we have to recover from faults here. */
+ /* This code does not appear to be necessary for Windows 95/NT/2000. */
+ /* Note that this code should never generate an incremental GC write */
+ /* fault. */
+ __try {
+#endif /* defined(MSWIN32) && !defined(__GNUC__) */
+ switch(GC_mark_state) {
+ case MS_NONE:
+ return(FALSE);
+
+ case MS_PUSH_RESCUERS:
+ if (GC_mark_stack_top
+ >= GC_mark_stack_limit - INITIAL_MARK_STACK_SIZE/2) {
+ /* Go ahead and mark, even though that might cause us to */
+ /* see more marked dirty objects later on. Avoid this */
+ /* in the future. */
+ GC_mark_stack_too_small = TRUE;
+ MARK_FROM_MARK_STACK();
+ return(FALSE);
+ } else {
+ scan_ptr = GC_push_next_marked_dirty(scan_ptr);
+ if (scan_ptr == 0) {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Marked from %lu dirty pages\n",
+ (unsigned long)GC_n_rescuing_pages);
+ }
+# endif
+ GC_push_roots(FALSE, cold_gc_frame);
+ GC_objects_are_marked = TRUE;
+ if (GC_mark_state != MS_INVALID) {
+ GC_mark_state = MS_ROOTS_PUSHED;
+ }
+ }
+ }
+ return(FALSE);
+
+ case MS_PUSH_UNCOLLECTABLE:
+ if (GC_mark_stack_top
+ >= GC_mark_stack + GC_mark_stack_size/4) {
+# ifdef PARALLEL_MARK
+ /* Avoid this, since we don't parallelize the marker */
+ /* here. */
+ if (GC_parallel) GC_mark_stack_too_small = TRUE;
+# endif
+ MARK_FROM_MARK_STACK();
+ return(FALSE);
+ } else {
+ scan_ptr = GC_push_next_marked_uncollectable(scan_ptr);
+ if (scan_ptr == 0) {
+ GC_push_roots(TRUE, cold_gc_frame);
+ GC_objects_are_marked = TRUE;
+ if (GC_mark_state != MS_INVALID) {
+ GC_mark_state = MS_ROOTS_PUSHED;
+ }
+ }
+ }
+ return(FALSE);
+
+ case MS_ROOTS_PUSHED:
+# ifdef PARALLEL_MARK
+ /* In the incremental GC case, this currently doesn't */
+ /* quite do the right thing, since it runs to */
+ /* completion. On the other hand, starting a */
+ /* parallel marker is expensive, so perhaps it is */
+ /* the right thing? */
+ /* Eventually, incremental marking should run */
+ /* asynchronously in multiple threads, without grabbing */
+ /* the allocation lock. */
+ if (GC_parallel) {
+ GC_do_parallel_mark();
+ GC_ASSERT(GC_mark_stack_top < GC_first_nonempty);
+ GC_mark_stack_top = GC_mark_stack - 1;
+ if (GC_mark_stack_too_small) {
+ alloc_mark_stack(2*GC_mark_stack_size);
+ }
+ if (GC_mark_state == MS_ROOTS_PUSHED) {
+ GC_mark_state = MS_NONE;
+ return(TRUE);
+ } else {
+ return(FALSE);
+ }
+ }
+# endif
+ if (GC_mark_stack_top >= GC_mark_stack) {
+ MARK_FROM_MARK_STACK();
+ return(FALSE);
+ } else {
+ GC_mark_state = MS_NONE;
+ if (GC_mark_stack_too_small) {
+ alloc_mark_stack(2*GC_mark_stack_size);
+ }
+ return(TRUE);
+ }
+
+ case MS_INVALID:
+ case MS_PARTIALLY_INVALID:
+ if (!GC_objects_are_marked) {
+ GC_mark_state = MS_PUSH_UNCOLLECTABLE;
+ return(FALSE);
+ }
+ if (GC_mark_stack_top >= GC_mark_stack) {
+ MARK_FROM_MARK_STACK();
+ return(FALSE);
+ }
+ if (scan_ptr == 0 && GC_mark_state == MS_INVALID) {
+ /* About to start a heap scan for marked objects. */
+ /* Mark stack is empty. OK to reallocate. */
+ if (GC_mark_stack_too_small) {
+ alloc_mark_stack(2*GC_mark_stack_size);
+ }
+ GC_mark_state = MS_PARTIALLY_INVALID;
+ }
+ scan_ptr = GC_push_next_marked(scan_ptr);
+ if (scan_ptr == 0 && GC_mark_state == MS_PARTIALLY_INVALID) {
+ GC_push_roots(TRUE, cold_gc_frame);
+ GC_objects_are_marked = TRUE;
+ if (GC_mark_state != MS_INVALID) {
+ GC_mark_state = MS_ROOTS_PUSHED;
+ }
+ }
+ return(FALSE);
+ default:
+ ABORT("GC_mark_some: bad state");
+ return(FALSE);
+ }
+#if defined(MSWIN32) && !defined(__GNUC__)
+ } __except (GetExceptionCode() == EXCEPTION_ACCESS_VIOLATION ?
+ EXCEPTION_EXECUTE_HANDLER : EXCEPTION_CONTINUE_SEARCH) {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf0("Caught ACCESS_VIOLATION in marker. "
+ "Memory mapping disappeared.\n");
+ }
+# endif /* CONDPRINT */
+ /* We have bad roots on the stack. Discard mark stack. */
+ /* Rescan from marked objects. Redetermine roots. */
+ GC_invalidate_mark_state();
+ scan_ptr = 0;
+ return FALSE;
+ }
+#endif /* defined(MSWIN32) && !defined(__GNUC__) */
+}
+
+
+GC_bool GC_mark_stack_empty()
+{
+ return(GC_mark_stack_top < GC_mark_stack);
+}
+
+#ifdef PROF_MARKER
+ word GC_prof_array[10];
+# define PROF(n) GC_prof_array[n]++
+#else
+# define PROF(n)
+#endif
+
+/* Given a pointer to someplace other than a small object page or the */
+/* first page of a large object, either: */
+/* - return a pointer to somewhere in the first page of the large */
+/* object, if current points to a large object. */
+/* In this case *hhdr is replaced with a pointer to the header */
+/* for the large object. */
+/* - just return current if it does not point to a large object. */
+/*ARGSUSED*/
+ptr_t GC_find_start(current, hhdr, new_hdr_p)
+register ptr_t current;
+register hdr *hhdr, **new_hdr_p;
+{
+ if (GC_all_interior_pointers) {
+ if (hhdr != 0) {
+ register ptr_t orig = current;
+
+ current = (ptr_t)HBLKPTR(current);
+ do {
+ current = current - HBLKSIZE*(word)hhdr;
+ hhdr = HDR(current);
+ } while(IS_FORWARDING_ADDR_OR_NIL(hhdr));
+ /* current points to the start of the large object */
+ if (hhdr -> hb_flags & IGNORE_OFF_PAGE) return(0);
+ if ((word *)orig - (word *)current
+ >= (ptrdiff_t)(hhdr->hb_sz)) {
+ /* Pointer past the end of the block */
+ return(orig);
+ }
+ *new_hdr_p = hhdr;
+ return(current);
+ } else {
+ return(current);
+ }
+ } else {
+ return(current);
+ }
+}
+
+void GC_invalidate_mark_state()
+{
+ GC_mark_state = MS_INVALID;
+ GC_mark_stack_top = GC_mark_stack-1;
+}
+
+mse * GC_signal_mark_stack_overflow(msp)
+mse * msp;
+{
+ GC_mark_state = MS_INVALID;
+ GC_mark_stack_too_small = TRUE;
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Mark stack overflow; current size = %lu entries\n",
+ GC_mark_stack_size);
+ }
+# endif
+ return(msp - GC_MARK_STACK_DISCARDS);
+}
+
+/*
+ * Mark objects pointed to by the regions described by
+ * mark stack entries between GC_mark_stack and GC_mark_stack_top,
+ * inclusive. Assumes the upper limit of a mark stack entry
+ * is never 0. A mark stack entry never has size 0.
+ * We try to traverse on the order of a hblk of memory before we return.
+ * Caller is responsible for calling this until the mark stack is empty.
+ * Note that this is the most performance critical routine in the
+ * collector. Hence it contains all sorts of ugly hacks to speed
+ * things up. In particular, we avoid procedure calls on the common
+ * path, we take advantage of peculiarities of the mark descriptor
+ * encoding, we optionally maintain a cache for the block address to
+ * header mapping, we prefetch when an object is "grayed", etc.
+ */
+mse * GC_mark_from(mark_stack_top, mark_stack, mark_stack_limit)
+mse * mark_stack_top;
+mse * mark_stack;
+mse * mark_stack_limit;
+{
+ int credit = HBLKSIZE; /* Remaining credit for marking work */
+ register word * current_p; /* Pointer to current candidate ptr. */
+ register word current; /* Candidate pointer. */
+ register word * limit; /* (Incl) limit of current candidate */
+ /* range */
+ register word descr;
+ register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+ register ptr_t least_ha = GC_least_plausible_heap_addr;
+ DECLARE_HDR_CACHE;
+
+# define SPLIT_RANGE_WORDS 128 /* Must be power of 2. */
+
+ GC_objects_are_marked = TRUE;
+ INIT_HDR_CACHE;
+# ifdef OS2 /* Use untweaked version to circumvent compiler problem */
+ while (mark_stack_top >= mark_stack && credit >= 0) {
+# else
+ while ((((ptr_t)mark_stack_top - (ptr_t)mark_stack) | credit)
+ >= 0) {
+# endif
+ current_p = mark_stack_top -> mse_start;
+ descr = mark_stack_top -> mse_descr;
+ retry:
+ /* current_p and descr describe the current object. */
+ /* *mark_stack_top is vacant. */
+ /* The following is 0 only for small objects described by a simple */
+ /* length descriptor. For many applications this is the common */
+ /* case, so we try to detect it quickly. */
+ if (descr & ((~(WORDS_TO_BYTES(SPLIT_RANGE_WORDS) - 1)) | GC_DS_TAGS)) {
+ word tag = descr & GC_DS_TAGS;
+
+ switch(tag) {
+ case GC_DS_LENGTH:
+ /* Large length. */
+ /* Process part of the range to avoid pushing too much on the */
+ /* stack. */
+ GC_ASSERT(descr < (word)GC_greatest_plausible_heap_addr
+ - (word)GC_least_plausible_heap_addr);
+# ifdef PARALLEL_MARK
+# define SHARE_BYTES 2048
+ if (descr > SHARE_BYTES && GC_parallel
+ && mark_stack_top < mark_stack_limit - 1) {
+ int new_size = (descr/2) & ~(sizeof(word)-1);
+ mark_stack_top -> mse_start = current_p;
+ mark_stack_top -> mse_descr = new_size + sizeof(word);
+ /* makes sure we handle */
+ /* misaligned pointers. */
+ mark_stack_top++;
+ current_p = (word *) ((char *)current_p + new_size);
+ descr -= new_size;
+ goto retry;
+ }
+# endif /* PARALLEL_MARK */
+ mark_stack_top -> mse_start =
+ limit = current_p + SPLIT_RANGE_WORDS-1;
+ mark_stack_top -> mse_descr =
+ descr - WORDS_TO_BYTES(SPLIT_RANGE_WORDS-1);
+ /* Make sure that pointers overlapping the two ranges are */
+ /* considered. */
+ limit = (word *)((char *)limit + sizeof(word) - ALIGNMENT);
+ break;
+ case GC_DS_BITMAP:
+ mark_stack_top--;
+ descr &= ~GC_DS_TAGS;
+ credit -= WORDS_TO_BYTES(WORDSZ/2); /* guess */
+ while (descr != 0) {
+ if ((signed_word)descr < 0) {
+ current = *current_p;
+ FIXUP_POINTER(current);
+ if ((ptr_t)current >= least_ha && (ptr_t)current < greatest_ha) {
+ PREFETCH(current);
+ HC_PUSH_CONTENTS((ptr_t)current, mark_stack_top,
+ mark_stack_limit, current_p, exit1);
+ }
+ }
+ descr <<= 1;
+ ++ current_p;
+ }
+ continue;
+ case GC_DS_PROC:
+ mark_stack_top--;
+ credit -= GC_PROC_BYTES;
+ mark_stack_top =
+ (*PROC(descr))
+ (current_p, mark_stack_top,
+ mark_stack_limit, ENV(descr));
+ continue;
+ case GC_DS_PER_OBJECT:
+ if ((signed_word)descr >= 0) {
+ /* Descriptor is in the object. */
+ descr = *(word *)((ptr_t)current_p + descr - GC_DS_PER_OBJECT);
+ } else {
+ /* Descriptor is in type descriptor pointed to by first */
+ /* word in object. */
+ ptr_t type_descr = *(ptr_t *)current_p;
+ /* type_descr is either a valid pointer to the descriptor */
+ /* structure, or this object was on a free list. If it */
+ /* it was anything but the last object on the free list, */
+ /* we will misinterpret the next object on the free list as */
+ /* the type descriptor, and get a 0 GC descriptor, which */
+ /* is ideal. Unfortunately, we need to check for the last */
+ /* object case explicitly. */
+ if (0 == type_descr) {
+ /* Rarely executed. */
+ mark_stack_top--;
+ continue;
+ }
+ descr = *(word *)(type_descr
+ - (descr - (GC_DS_PER_OBJECT
+ - GC_INDIR_PER_OBJ_BIAS)));
+ }
+ if (0 == descr) {
+ /* Can happen either because we generated a 0 descriptor */
+ /* or we saw a pointer to a free object. */
+ mark_stack_top--;
+ continue;
+ }
+ goto retry;
+ }
+ } else /* Small object with length descriptor */ {
+ mark_stack_top--;
+ limit = (word *)(((ptr_t)current_p) + (word)descr);
+ }
+ /* The simple case in which we're scanning a range. */
+ GC_ASSERT(!((word)current_p & (ALIGNMENT-1)));
+ credit -= (ptr_t)limit - (ptr_t)current_p;
+ limit -= 1;
+ {
+# define PREF_DIST 4
+
+# ifndef SMALL_CONFIG
+ word deferred;
+
+ /* Try to prefetch the next pointer to be examined asap. */
+ /* Empirically, this also seems to help slightly without */
+ /* prefetches, at least on linux/X86. Presumably this loop */
+ /* ends up with less register pressure, and gcc thus ends up */
+ /* generating slightly better code. Overall gcc code quality */
+ /* for this loop is still not great. */
+ for(;;) {
+ PREFETCH((ptr_t)limit - PREF_DIST*CACHE_LINE_SIZE);
+ GC_ASSERT(limit >= current_p);
+ deferred = *limit;
+ FIXUP_POINTER(deferred);
+ limit = (word *)((char *)limit - ALIGNMENT);
+ if ((ptr_t)deferred >= least_ha && (ptr_t)deferred < greatest_ha) {
+ PREFETCH(deferred);
+ break;
+ }
+ if (current_p > limit) goto next_object;
+ /* Unroll once, so we don't do too many of the prefetches */
+ /* based on limit. */
+ deferred = *limit;
+ FIXUP_POINTER(deferred);
+ limit = (word *)((char *)limit - ALIGNMENT);
+ if ((ptr_t)deferred >= least_ha && (ptr_t)deferred < greatest_ha) {
+ PREFETCH(deferred);
+ break;
+ }
+ if (current_p > limit) goto next_object;
+ }
+# endif
+
+ while (current_p <= limit) {
+ /* Empirically, unrolling this loop doesn't help a lot. */
+ /* Since HC_PUSH_CONTENTS expands to a lot of code, */
+ /* we don't. */
+ current = *current_p;
+ FIXUP_POINTER(current);
+ PREFETCH((ptr_t)current_p + PREF_DIST*CACHE_LINE_SIZE);
+ if ((ptr_t)current >= least_ha && (ptr_t)current < greatest_ha) {
+ /* Prefetch the contents of the object we just pushed. It's */
+ /* likely we will need them soon. */
+ PREFETCH(current);
+ HC_PUSH_CONTENTS((ptr_t)current, mark_stack_top,
+ mark_stack_limit, current_p, exit2);
+ }
+ current_p = (word *)((char *)current_p + ALIGNMENT);
+ }
+
+# ifndef SMALL_CONFIG
+ /* We still need to mark the entry we previously prefetched. */
+ /* We alrady know that it passes the preliminary pointer */
+ /* validity test. */
+ HC_PUSH_CONTENTS((ptr_t)deferred, mark_stack_top,
+ mark_stack_limit, current_p, exit4);
+ next_object:;
+# endif
+ }
+ }
+ return mark_stack_top;
+}
+
+#ifdef PARALLEL_MARK
+
+/* We assume we have an ANSI C Compiler. */
+GC_bool GC_help_wanted = FALSE;
+unsigned GC_helper_count = 0;
+unsigned GC_active_count = 0;
+mse * VOLATILE GC_first_nonempty;
+word GC_mark_no = 0;
+
+#define LOCAL_MARK_STACK_SIZE HBLKSIZE
+ /* Under normal circumstances, this is big enough to guarantee */
+ /* We don't overflow half of it in a single call to */
+ /* GC_mark_from. */
+
+
+/* Steal mark stack entries starting at mse low into mark stack local */
+/* until we either steal mse high, or we have max entries. */
+/* Return a pointer to the top of the local mark stack. */
+/* *next is replaced by a pointer to the next unscanned mark stack */
+/* entry. */
+mse * GC_steal_mark_stack(mse * low, mse * high, mse * local,
+ unsigned max, mse **next)
+{
+ mse *p;
+ mse *top = local - 1;
+ unsigned i = 0;
+
+ /* Make sure that prior writes to the mark stack are visible. */
+ /* On some architectures, the fact that the reads are */
+ /* volatile should suffice. */
+# if !defined(IA64) && !defined(HP_PA) && !defined(I386)
+ GC_memory_barrier();
+# endif
+ GC_ASSERT(high >= low-1 && high - low + 1 <= GC_mark_stack_size);
+ for (p = low; p <= high && i <= max; ++p) {
+ word descr = *(volatile word *) &(p -> mse_descr);
+ /* In the IA64 memory model, the following volatile store is */
+ /* ordered after this read of descr. Thus a thread must read */
+ /* the original nonzero value. HP_PA appears to be similar, */
+ /* and if I'm reading the P4 spec correctly, X86 is probably */
+ /* also OK. In some other cases we need a barrier. */
+# if !defined(IA64) && !defined(HP_PA) && !defined(I386)
+ GC_memory_barrier();
+# endif
+ if (descr != 0) {
+ *(volatile word *) &(p -> mse_descr) = 0;
+ /* More than one thread may get this entry, but that's only */
+ /* a minor performance problem. */
+ ++top;
+ top -> mse_descr = descr;
+ top -> mse_start = p -> mse_start;
+ GC_ASSERT( top -> mse_descr & GC_DS_TAGS != GC_DS_LENGTH ||
+ top -> mse_descr < GC_greatest_plausible_heap_addr
+ - GC_least_plausible_heap_addr);
+ /* If this is a big object, count it as */
+ /* size/256 + 1 objects. */
+ ++i;
+ if ((descr & GC_DS_TAGS) == GC_DS_LENGTH) i += (descr >> 8);
+ }
+ }
+ *next = p;
+ return top;
+}
+
+/* Copy back a local mark stack. */
+/* low and high are inclusive bounds. */
+void GC_return_mark_stack(mse * low, mse * high)
+{
+ mse * my_top;
+ mse * my_start;
+ size_t stack_size;
+
+ if (high < low) return;
+ stack_size = high - low + 1;
+ GC_acquire_mark_lock();
+ my_top = GC_mark_stack_top;
+ my_start = my_top + 1;
+ if (my_start - GC_mark_stack + stack_size > GC_mark_stack_size) {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf0("No room to copy back mark stack.");
+ }
+# endif
+ GC_mark_state = MS_INVALID;
+ GC_mark_stack_too_small = TRUE;
+ /* We drop the local mark stack. We'll fix things later. */
+ } else {
+ BCOPY(low, my_start, stack_size * sizeof(mse));
+ GC_ASSERT(GC_mark_stack_top = my_top);
+# if !defined(IA64) && !defined(HP_PA)
+ GC_memory_barrier();
+# endif
+ /* On IA64, the volatile write acts as a release barrier. */
+ GC_mark_stack_top = my_top + stack_size;
+ }
+ GC_release_mark_lock();
+ GC_notify_all_marker();
+}
+
+/* Mark from the local mark stack. */
+/* On return, the local mark stack is empty. */
+/* But this may be achieved by copying the */
+/* local mark stack back into the global one. */
+void GC_do_local_mark(mse *local_mark_stack, mse *local_top)
+{
+ unsigned n;
+# define N_LOCAL_ITERS 1
+
+# ifdef GC_ASSERTIONS
+ /* Make sure we don't hold mark lock. */
+ GC_acquire_mark_lock();
+ GC_release_mark_lock();
+# endif
+ for (;;) {
+ for (n = 0; n < N_LOCAL_ITERS; ++n) {
+ local_top = GC_mark_from(local_top, local_mark_stack,
+ local_mark_stack + LOCAL_MARK_STACK_SIZE);
+ if (local_top < local_mark_stack) return;
+ if (local_top - local_mark_stack >= LOCAL_MARK_STACK_SIZE/2) {
+ GC_return_mark_stack(local_mark_stack, local_top);
+ return;
+ }
+ }
+ if (GC_mark_stack_top < GC_first_nonempty &&
+ GC_active_count < GC_helper_count
+ && local_top > local_mark_stack + 1) {
+ /* Try to share the load, since the main stack is empty, */
+ /* and helper threads are waiting for a refill. */
+ /* The entries near the bottom of the stack are likely */
+ /* to require more work. Thus we return those, eventhough */
+ /* it's harder. */
+ mse * p;
+ mse * new_bottom = local_mark_stack
+ + (local_top - local_mark_stack)/2;
+ GC_ASSERT(new_bottom > local_mark_stack
+ && new_bottom < local_top);
+ GC_return_mark_stack(local_mark_stack, new_bottom - 1);
+ memmove(local_mark_stack, new_bottom,
+ (local_top - new_bottom + 1) * sizeof(mse));
+ local_top -= (new_bottom - local_mark_stack);
+ }
+ }
+}
+
+#define ENTRIES_TO_GET 5
+
+long GC_markers = 2; /* Normally changed by thread-library- */
+ /* -specific code. */
+
+/* Mark using the local mark stack until the global mark stack is empty */
+/* and there are no active workers. Update GC_first_nonempty to reflect */
+/* progress. */
+/* Caller does not hold mark lock. */
+/* Caller has already incremented GC_helper_count. We decrement it, */
+/* and maintain GC_active_count. */
+void GC_mark_local(mse *local_mark_stack, int id)
+{
+ mse * my_first_nonempty;
+
+ GC_acquire_mark_lock();
+ GC_active_count++;
+ my_first_nonempty = GC_first_nonempty;
+ GC_ASSERT(GC_first_nonempty >= GC_mark_stack &&
+ GC_first_nonempty <= GC_mark_stack_top + 1);
+# ifdef PRINTSTATS
+ GC_printf1("Starting mark helper %lu\n", (unsigned long)id);
+# endif
+ GC_release_mark_lock();
+ for (;;) {
+ size_t n_on_stack;
+ size_t n_to_get;
+ mse *next;
+ mse * my_top;
+ mse * local_top;
+ mse * global_first_nonempty = GC_first_nonempty;
+
+ GC_ASSERT(my_first_nonempty >= GC_mark_stack &&
+ my_first_nonempty <= GC_mark_stack_top + 1);
+ GC_ASSERT(global_first_nonempty >= GC_mark_stack &&
+ global_first_nonempty <= GC_mark_stack_top + 1);
+ if (my_first_nonempty < global_first_nonempty) {
+ my_first_nonempty = global_first_nonempty;
+ } else if (global_first_nonempty < my_first_nonempty) {
+ GC_compare_and_exchange((word *)(&GC_first_nonempty),
+ (word) global_first_nonempty,
+ (word) my_first_nonempty);
+ /* If this fails, we just go ahead, without updating */
+ /* GC_first_nonempty. */
+ }
+ /* Perhaps we should also update GC_first_nonempty, if it */
+ /* is less. But that would require using atomic updates. */
+ my_top = GC_mark_stack_top;
+ n_on_stack = my_top - my_first_nonempty + 1;
+ if (0 == n_on_stack) {
+ GC_acquire_mark_lock();
+ my_top = GC_mark_stack_top;
+ n_on_stack = my_top - my_first_nonempty + 1;
+ if (0 == n_on_stack) {
+ GC_active_count--;
+ GC_ASSERT(GC_active_count <= GC_helper_count);
+ /* Other markers may redeposit objects */
+ /* on the stack. */
+ if (0 == GC_active_count) GC_notify_all_marker();
+ while (GC_active_count > 0
+ && GC_first_nonempty > GC_mark_stack_top) {
+ /* We will be notified if either GC_active_count */
+ /* reaches zero, or if more objects are pushed on */
+ /* the global mark stack. */
+ GC_wait_marker();
+ }
+ if (GC_active_count == 0 &&
+ GC_first_nonempty > GC_mark_stack_top) {
+ GC_bool need_to_notify = FALSE;
+ /* The above conditions can't be falsified while we */
+ /* hold the mark lock, since neither */
+ /* GC_active_count nor GC_mark_stack_top can */
+ /* change. GC_first_nonempty can only be */
+ /* incremented asynchronously. Thus we know that */
+ /* both conditions actually held simultaneously. */
+ GC_helper_count--;
+ if (0 == GC_helper_count) need_to_notify = TRUE;
+# ifdef PRINTSTATS
+ GC_printf1(
+ "Finished mark helper %lu\n", (unsigned long)id);
+# endif
+ GC_release_mark_lock();
+ if (need_to_notify) GC_notify_all_marker();
+ return;
+ }
+ /* else there's something on the stack again, or */
+ /* another helper may push something. */
+ GC_active_count++;
+ GC_ASSERT(GC_active_count > 0);
+ GC_release_mark_lock();
+ continue;
+ } else {
+ GC_release_mark_lock();
+ }
+ }
+ n_to_get = ENTRIES_TO_GET;
+ if (n_on_stack < 2 * ENTRIES_TO_GET) n_to_get = 1;
+ local_top = GC_steal_mark_stack(my_first_nonempty, my_top,
+ local_mark_stack, n_to_get,
+ &my_first_nonempty);
+ GC_ASSERT(my_first_nonempty >= GC_mark_stack &&
+ my_first_nonempty <= GC_mark_stack_top + 1);
+ GC_do_local_mark(local_mark_stack, local_top);
+ }
+}
+
+/* Perform Parallel mark. */
+/* We hold the GC lock, not the mark lock. */
+/* Currently runs until the mark stack is */
+/* empty. */
+void GC_do_parallel_mark()
+{
+ mse local_mark_stack[LOCAL_MARK_STACK_SIZE];
+ mse * local_top;
+ mse * my_top;
+
+ GC_acquire_mark_lock();
+ GC_ASSERT(I_HOLD_LOCK());
+ /* This could be a GC_ASSERT, but it seems safer to keep it on */
+ /* all the time, especially since it's cheap. */
+ if (GC_help_wanted || GC_active_count != 0 || GC_helper_count != 0)
+ ABORT("Tried to start parallel mark in bad state");
+# ifdef PRINTSTATS
+ GC_printf1("Starting marking for mark phase number %lu\n",
+ (unsigned long)GC_mark_no);
+# endif
+ GC_first_nonempty = GC_mark_stack;
+ GC_active_count = 0;
+ GC_helper_count = 1;
+ GC_help_wanted = TRUE;
+ GC_release_mark_lock();
+ GC_notify_all_marker();
+ /* Wake up potential helpers. */
+ GC_mark_local(local_mark_stack, 0);
+ GC_acquire_mark_lock();
+ GC_help_wanted = FALSE;
+ /* Done; clean up. */
+ while (GC_helper_count > 0) GC_wait_marker();
+ /* GC_helper_count cannot be incremented while GC_help_wanted == FALSE */
+# ifdef PRINTSTATS
+ GC_printf1(
+ "Finished marking for mark phase number %lu\n",
+ (unsigned long)GC_mark_no);
+# endif
+ GC_mark_no++;
+ GC_release_mark_lock();
+ GC_notify_all_marker();
+}
+
+
+/* Try to help out the marker, if it's running. */
+/* We do not hold the GC lock, but the requestor does. */
+void GC_help_marker(word my_mark_no)
+{
+ mse local_mark_stack[LOCAL_MARK_STACK_SIZE];
+ unsigned my_id;
+ mse * my_first_nonempty;
+
+ if (!GC_parallel) return;
+ GC_acquire_mark_lock();
+ while (GC_mark_no < my_mark_no
+ || !GC_help_wanted && GC_mark_no == my_mark_no) {
+ GC_wait_marker();
+ }
+ my_id = GC_helper_count;
+ if (GC_mark_no != my_mark_no || my_id >= GC_markers) {
+ /* Second test is useful only if original threads can also */
+ /* act as helpers. Under Linux they can't. */
+ GC_release_mark_lock();
+ return;
+ }
+ GC_helper_count = my_id + 1;
+ GC_release_mark_lock();
+ GC_mark_local(local_mark_stack, my_id);
+ /* GC_mark_local decrements GC_helper_count. */
+}
+
+#endif /* PARALLEL_MARK */
+
+/* Allocate or reallocate space for mark stack of size s words */
+/* May silently fail. */
+static void alloc_mark_stack(n)
+word n;
+{
+ mse * new_stack = (mse *)GC_scratch_alloc(n * sizeof(struct GC_ms_entry));
+
+ GC_mark_stack_too_small = FALSE;
+ if (GC_mark_stack_size != 0) {
+ if (new_stack != 0) {
+ word displ = (word)GC_mark_stack & (GC_page_size - 1);
+ signed_word size = GC_mark_stack_size * sizeof(struct GC_ms_entry);
+
+ /* Recycle old space */
+ if (0 != displ) displ = GC_page_size - displ;
+ size = (size - displ) & ~(GC_page_size - 1);
+ if (size > 0) {
+ GC_add_to_heap((struct hblk *)
+ ((word)GC_mark_stack + displ), (word)size);
+ }
+ GC_mark_stack = new_stack;
+ GC_mark_stack_size = n;
+ GC_mark_stack_limit = new_stack + n;
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Grew mark stack to %lu frames\n",
+ (unsigned long) GC_mark_stack_size);
+ }
+# endif
+ } else {
+# ifdef CONDPRINT
+ if (GC_print_stats) {
+ GC_printf1("Failed to grow mark stack to %lu frames\n",
+ (unsigned long) n);
+ }
+# endif
+ }
+ } else {
+ if (new_stack == 0) {
+ GC_err_printf0("No space for mark stack\n");
+ EXIT();
+ }
+ GC_mark_stack = new_stack;
+ GC_mark_stack_size = n;
+ GC_mark_stack_limit = new_stack + n;
+ }
+ GC_mark_stack_top = GC_mark_stack-1;
+}
+
+void GC_mark_init()
+{
+ alloc_mark_stack(INITIAL_MARK_STACK_SIZE);
+}
+
+/*
+ * Push all locations between b and t onto the mark stack.
+ * b is the first location to be checked. t is one past the last
+ * location to be checked.
+ * Should only be used if there is no possibility of mark stack
+ * overflow.
+ */
+void GC_push_all(bottom, top)
+ptr_t bottom;
+ptr_t top;
+{
+ register word length;
+
+ bottom = (ptr_t)(((word) bottom + ALIGNMENT-1) & ~(ALIGNMENT-1));
+ top = (ptr_t)(((word) top) & ~(ALIGNMENT-1));
+ if (top == 0 || bottom == top) return;
+ GC_mark_stack_top++;
+ if (GC_mark_stack_top >= GC_mark_stack_limit) {
+ ABORT("unexpected mark stack overflow");
+ }
+ length = top - bottom;
+# if GC_DS_TAGS > ALIGNMENT - 1
+ length += GC_DS_TAGS;
+ length &= ~GC_DS_TAGS;
+# endif
+ GC_mark_stack_top -> mse_start = (word *)bottom;
+ GC_mark_stack_top -> mse_descr = length;
+}
+
+/*
+ * Analogous to the above, but push only those pages h with dirty_fn(h) != 0.
+ * We use push_fn to actually push the block.
+ * Used both to selectively push dirty pages, or to push a block
+ * in piecemeal fashion, to allow for more marking concurrency.
+ * Will not overflow mark stack if push_fn pushes a small fixed number
+ * of entries. (This is invoked only if push_fn pushes a single entry,
+ * or if it marks each object before pushing it, thus ensuring progress
+ * in the event of a stack overflow.)
+ */
+void GC_push_selected(bottom, top, dirty_fn, push_fn)
+ptr_t bottom;
+ptr_t top;
+int (*dirty_fn) GC_PROTO((struct hblk * h));
+void (*push_fn) GC_PROTO((ptr_t bottom, ptr_t top));
+{
+ register struct hblk * h;
+
+ bottom = (ptr_t)(((long) bottom + ALIGNMENT-1) & ~(ALIGNMENT-1));
+ top = (ptr_t)(((long) top) & ~(ALIGNMENT-1));
+
+ if (top == 0 || bottom == top) return;
+ h = HBLKPTR(bottom + HBLKSIZE);
+ if (top <= (ptr_t) h) {
+ if ((*dirty_fn)(h-1)) {
+ (*push_fn)(bottom, top);
+ }
+ return;
+ }
+ if ((*dirty_fn)(h-1)) {
+ (*push_fn)(bottom, (ptr_t)h);
+ }
+ while ((ptr_t)(h+1) <= top) {
+ if ((*dirty_fn)(h)) {
+ if ((word)(GC_mark_stack_top - GC_mark_stack)
+ > 3 * GC_mark_stack_size / 4) {
+ /* Danger of mark stack overflow */
+ (*push_fn)((ptr_t)h, top);
+ return;
+ } else {
+ (*push_fn)((ptr_t)h, (ptr_t)(h+1));
+ }
+ }
+ h++;
+ }
+ if ((ptr_t)h != top) {
+ if ((*dirty_fn)(h)) {
+ (*push_fn)((ptr_t)h, top);
+ }
+ }
+ if (GC_mark_stack_top >= GC_mark_stack_limit) {
+ ABORT("unexpected mark stack overflow");
+ }
+}
+
+# ifndef SMALL_CONFIG
+
+#ifdef PARALLEL_MARK
+ /* Break up root sections into page size chunks to better spread */
+ /* out work. */
+ GC_bool GC_true_func(struct hblk *h) { return TRUE; }
+# define GC_PUSH_ALL(b,t) GC_push_selected(b,t,GC_true_func,GC_push_all);
+#else
+# define GC_PUSH_ALL(b,t) GC_push_all(b,t);
+#endif
+
+
+void GC_push_conditional(bottom, top, all)
+ptr_t bottom;
+ptr_t top;
+int all;
+{
+ if (all) {
+ if (GC_dirty_maintained) {
+# ifdef PROC_VDB
+ /* Pages that were never dirtied cannot contain pointers */
+ GC_push_selected(bottom, top, GC_page_was_ever_dirty, GC_push_all);
+# else
+ GC_push_all(bottom, top);
+# endif
+ } else {
+ GC_push_all(bottom, top);
+ }
+ } else {
+ GC_push_selected(bottom, top, GC_page_was_dirty, GC_push_all);
+ }
+}
+#endif
+
+# if defined(MSWIN32) || defined(MSWINCE)
+ void __cdecl GC_push_one(p)
+# else
+ void GC_push_one(p)
+# endif
+word p;
+{
+ GC_PUSH_ONE_STACK(p, MARKED_FROM_REGISTER);
+}
+
+struct GC_ms_entry *GC_mark_and_push(obj, mark_stack_ptr, mark_stack_limit, src)
+GC_PTR obj;
+struct GC_ms_entry * mark_stack_ptr;
+struct GC_ms_entry * mark_stack_limit;
+GC_PTR *src;
+{
+ PREFETCH(obj);
+ PUSH_CONTENTS(obj, mark_stack_ptr /* modified */, mark_stack_limit, src,
+ was_marked /* internally generated exit label */);
+ return mark_stack_ptr;
+}
+
+# ifdef __STDC__
+# define BASE(p) (word)GC_base((void *)(p))
+# else
+# define BASE(p) (word)GC_base((char *)(p))
+# endif
+
+/* Mark and push (i.e. gray) a single object p onto the main */
+/* mark stack. Consider p to be valid if it is an interior */
+/* pointer. */
+/* The object p has passed a preliminary pointer validity */
+/* test, but we do not definitely know whether it is valid. */
+/* Mark bits are NOT atomically updated. Thus this must be the */
+/* only thread setting them. */
+# if defined(PRINT_BLACK_LIST) || defined(KEEP_BACK_PTRS)
+ void GC_mark_and_push_stack(p, source)
+ ptr_t source;
+# else
+ void GC_mark_and_push_stack(p)
+# define source 0
+# endif
+register word p;
+{
+ register word r;
+ register hdr * hhdr;
+ register int displ;
+
+ GET_HDR(p, hhdr);
+ if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ if (hhdr != 0) {
+ r = BASE(p);
+ hhdr = HDR(r);
+ displ = BYTES_TO_WORDS(HBLKDISPL(r));
+ }
+ } else {
+ register map_entry_type map_entry;
+
+ displ = HBLKDISPL(p);
+ map_entry = MAP_ENTRY((hhdr -> hb_map), displ);
+ if (map_entry >= MAX_OFFSET) {
+ if (map_entry == OFFSET_TOO_BIG || !GC_all_interior_pointers) {
+ r = BASE(p);
+ displ = BYTES_TO_WORDS(HBLKDISPL(r));
+ if (r == 0) hhdr = 0;
+ } else {
+ /* Offset invalid, but map reflects interior pointers */
+ hhdr = 0;
+ }
+ } else {
+ displ = BYTES_TO_WORDS(displ);
+ displ -= map_entry;
+ r = (word)((word *)(HBLKPTR(p)) + displ);
+ }
+ }
+ /* If hhdr != 0 then r == GC_base(p), only we did it faster. */
+ /* displ is the word index within the block. */
+ if (hhdr == 0) {
+# ifdef PRINT_BLACK_LIST
+ GC_add_to_black_list_stack(p, source);
+# else
+ GC_add_to_black_list_stack(p);
+# endif
+# undef source /* In case we had to define it. */
+ } else {
+ if (!mark_bit_from_hdr(hhdr, displ)) {
+ set_mark_bit_from_hdr(hhdr, displ);
+ GC_STORE_BACK_PTR(source, (ptr_t)r);
+ PUSH_OBJ((word *)r, hhdr, GC_mark_stack_top,
+ GC_mark_stack_limit);
+ }
+ }
+}
+
+# ifdef TRACE_BUF
+
+# define TRACE_ENTRIES 1000
+
+struct trace_entry {
+ char * kind;
+ word gc_no;
+ word words_allocd;
+ word arg1;
+ word arg2;
+} GC_trace_buf[TRACE_ENTRIES];
+
+int GC_trace_buf_ptr = 0;
+
+void GC_add_trace_entry(char *kind, word arg1, word arg2)
+{
+ GC_trace_buf[GC_trace_buf_ptr].kind = kind;
+ GC_trace_buf[GC_trace_buf_ptr].gc_no = GC_gc_no;
+ GC_trace_buf[GC_trace_buf_ptr].words_allocd = GC_words_allocd;
+ GC_trace_buf[GC_trace_buf_ptr].arg1 = arg1 ^ 0x80000000;
+ GC_trace_buf[GC_trace_buf_ptr].arg2 = arg2 ^ 0x80000000;
+ GC_trace_buf_ptr++;
+ if (GC_trace_buf_ptr >= TRACE_ENTRIES) GC_trace_buf_ptr = 0;
+}
+
+void GC_print_trace(word gc_no, GC_bool lock)
+{
+ int i;
+ struct trace_entry *p;
+
+ if (lock) LOCK();
+ for (i = GC_trace_buf_ptr-1; i != GC_trace_buf_ptr; i--) {
+ if (i < 0) i = TRACE_ENTRIES-1;
+ p = GC_trace_buf + i;
+ if (p -> gc_no < gc_no || p -> kind == 0) return;
+ printf("Trace:%s (gc:%d,words:%d) 0x%X, 0x%X\n",
+ p -> kind, p -> gc_no, p -> words_allocd,
+ (p -> arg1) ^ 0x80000000, (p -> arg2) ^ 0x80000000);
+ }
+ printf("Trace incomplete\n");
+ if (lock) UNLOCK();
+}
+
+# endif /* TRACE_BUF */
+
+/*
+ * A version of GC_push_all that treats all interior pointers as valid
+ * and scans the entire region immediately, in case the contents
+ * change.
+ */
+void GC_push_all_eager(bottom, top)
+ptr_t bottom;
+ptr_t top;
+{
+ word * b = (word *)(((long) bottom + ALIGNMENT-1) & ~(ALIGNMENT-1));
+ word * t = (word *)(((long) top) & ~(ALIGNMENT-1));
+ register word *p;
+ register word q;
+ register word *lim;
+ register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+ register ptr_t least_ha = GC_least_plausible_heap_addr;
+# define GC_greatest_plausible_heap_addr greatest_ha
+# define GC_least_plausible_heap_addr least_ha
+
+ if (top == 0) return;
+ /* check all pointers in range and push if they appear */
+ /* to be valid. */
+ lim = t - 1 /* longword */;
+ for (p = b; p <= lim; p = (word *)(((char *)p) + ALIGNMENT)) {
+ q = *p;
+ GC_PUSH_ONE_STACK(q, p);
+ }
+# undef GC_greatest_plausible_heap_addr
+# undef GC_least_plausible_heap_addr
+}
+
+#ifndef THREADS
+/*
+ * A version of GC_push_all that treats all interior pointers as valid
+ * and scans part of the area immediately, to make sure that saved
+ * register values are not lost.
+ * Cold_gc_frame delimits the stack section that must be scanned
+ * eagerly. A zero value indicates that no eager scanning is needed.
+ */
+void GC_push_all_stack_partially_eager(bottom, top, cold_gc_frame)
+ptr_t bottom;
+ptr_t top;
+ptr_t cold_gc_frame;
+{
+ if (!NEED_FIXUP_POINTER && GC_all_interior_pointers) {
+# define EAGER_BYTES 1024
+ /* Push the hot end of the stack eagerly, so that register values */
+ /* saved inside GC frames are marked before they disappear. */
+ /* The rest of the marking can be deferred until later. */
+ if (0 == cold_gc_frame) {
+ GC_push_all_stack(bottom, top);
+ return;
+ }
+ GC_ASSERT(bottom <= cold_gc_frame && cold_gc_frame <= top);
+# ifdef STACK_GROWS_DOWN
+ GC_push_all(cold_gc_frame - sizeof(ptr_t), top);
+ GC_push_all_eager(bottom, cold_gc_frame);
+# else /* STACK_GROWS_UP */
+ GC_push_all(bottom, cold_gc_frame + sizeof(ptr_t));
+ GC_push_all_eager(cold_gc_frame, top);
+# endif /* STACK_GROWS_UP */
+ } else {
+ GC_push_all_eager(bottom, top);
+ }
+# ifdef TRACE_BUF
+ GC_add_trace_entry("GC_push_all_stack", bottom, top);
+# endif
+}
+#endif /* !THREADS */
+
+void GC_push_all_stack(bottom, top)
+ptr_t bottom;
+ptr_t top;
+{
+ if (!NEED_FIXUP_POINTER && GC_all_interior_pointers) {
+ GC_push_all(bottom, top);
+ } else {
+ GC_push_all_eager(bottom, top);
+ }
+}
+
+#if !defined(SMALL_CONFIG) && !defined(USE_MARK_BYTES)
+/* Push all objects reachable from marked objects in the given block */
+/* of size 1 objects. */
+void GC_push_marked1(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+ word * mark_word_addr = &(hhdr->hb_marks[0]);
+ register word *p;
+ word *plim;
+ register int i;
+ register word q;
+ register word mark_word;
+ register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+ register ptr_t least_ha = GC_least_plausible_heap_addr;
+ register mse * mark_stack_top = GC_mark_stack_top;
+ register mse * mark_stack_limit = GC_mark_stack_limit;
+# define GC_mark_stack_top mark_stack_top
+# define GC_mark_stack_limit mark_stack_limit
+# define GC_greatest_plausible_heap_addr greatest_ha
+# define GC_least_plausible_heap_addr least_ha
+
+ p = (word *)(h->hb_body);
+ plim = (word *)(((word)h) + HBLKSIZE);
+
+ /* go through all words in block */
+ while( p < plim ) {
+ mark_word = *mark_word_addr++;
+ i = 0;
+ while(mark_word != 0) {
+ if (mark_word & 1) {
+ q = p[i];
+ GC_PUSH_ONE_HEAP(q, p + i);
+ }
+ i++;
+ mark_word >>= 1;
+ }
+ p += WORDSZ;
+ }
+# undef GC_greatest_plausible_heap_addr
+# undef GC_least_plausible_heap_addr
+# undef GC_mark_stack_top
+# undef GC_mark_stack_limit
+ GC_mark_stack_top = mark_stack_top;
+}
+
+
+#ifndef UNALIGNED
+
+/* Push all objects reachable from marked objects in the given block */
+/* of size 2 objects. */
+void GC_push_marked2(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+ word * mark_word_addr = &(hhdr->hb_marks[0]);
+ register word *p;
+ word *plim;
+ register int i;
+ register word q;
+ register word mark_word;
+ register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+ register ptr_t least_ha = GC_least_plausible_heap_addr;
+ register mse * mark_stack_top = GC_mark_stack_top;
+ register mse * mark_stack_limit = GC_mark_stack_limit;
+# define GC_mark_stack_top mark_stack_top
+# define GC_mark_stack_limit mark_stack_limit
+# define GC_greatest_plausible_heap_addr greatest_ha
+# define GC_least_plausible_heap_addr least_ha
+
+ p = (word *)(h->hb_body);
+ plim = (word *)(((word)h) + HBLKSIZE);
+
+ /* go through all words in block */
+ while( p < plim ) {
+ mark_word = *mark_word_addr++;
+ i = 0;
+ while(mark_word != 0) {
+ if (mark_word & 1) {
+ q = p[i];
+ GC_PUSH_ONE_HEAP(q, p + i);
+ q = p[i+1];
+ GC_PUSH_ONE_HEAP(q, p + i);
+ }
+ i += 2;
+ mark_word >>= 2;
+ }
+ p += WORDSZ;
+ }
+# undef GC_greatest_plausible_heap_addr
+# undef GC_least_plausible_heap_addr
+# undef GC_mark_stack_top
+# undef GC_mark_stack_limit
+ GC_mark_stack_top = mark_stack_top;
+}
+
+/* Push all objects reachable from marked objects in the given block */
+/* of size 4 objects. */
+/* There is a risk of mark stack overflow here. But we handle that. */
+/* And only unmarked objects get pushed, so it's not very likely. */
+void GC_push_marked4(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+ word * mark_word_addr = &(hhdr->hb_marks[0]);
+ register word *p;
+ word *plim;
+ register int i;
+ register word q;
+ register word mark_word;
+ register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+ register ptr_t least_ha = GC_least_plausible_heap_addr;
+ register mse * mark_stack_top = GC_mark_stack_top;
+ register mse * mark_stack_limit = GC_mark_stack_limit;
+# define GC_mark_stack_top mark_stack_top
+# define GC_mark_stack_limit mark_stack_limit
+# define GC_greatest_plausible_heap_addr greatest_ha
+# define GC_least_plausible_heap_addr least_ha
+
+ p = (word *)(h->hb_body);
+ plim = (word *)(((word)h) + HBLKSIZE);
+
+ /* go through all words in block */
+ while( p < plim ) {
+ mark_word = *mark_word_addr++;
+ i = 0;
+ while(mark_word != 0) {
+ if (mark_word & 1) {
+ q = p[i];
+ GC_PUSH_ONE_HEAP(q, p + i);
+ q = p[i+1];
+ GC_PUSH_ONE_HEAP(q, p + i + 1);
+ q = p[i+2];
+ GC_PUSH_ONE_HEAP(q, p + i + 2);
+ q = p[i+3];
+ GC_PUSH_ONE_HEAP(q, p + i + 3);
+ }
+ i += 4;
+ mark_word >>= 4;
+ }
+ p += WORDSZ;
+ }
+# undef GC_greatest_plausible_heap_addr
+# undef GC_least_plausible_heap_addr
+# undef GC_mark_stack_top
+# undef GC_mark_stack_limit
+ GC_mark_stack_top = mark_stack_top;
+}
+
+#endif /* UNALIGNED */
+
+#endif /* SMALL_CONFIG */
+
+/* Push all objects reachable from marked objects in the given block */
+void GC_push_marked(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+ register int sz = hhdr -> hb_sz;
+ register int descr = hhdr -> hb_descr;
+ register word * p;
+ register int word_no;
+ register word * lim;
+ register mse * GC_mark_stack_top_reg;
+ register mse * mark_stack_limit = GC_mark_stack_limit;
+
+ /* Some quick shortcuts: */
+ if ((0 | GC_DS_LENGTH) == descr) return;
+ if (GC_block_empty(hhdr)/* nothing marked */) return;
+ GC_n_rescuing_pages++;
+ GC_objects_are_marked = TRUE;
+ if (sz > MAXOBJSZ) {
+ lim = (word *)h;
+ } else {
+ lim = (word *)(h + 1) - sz;
+ }
+
+ switch(sz) {
+# if !defined(SMALL_CONFIG) && !defined(USE_MARK_BYTES)
+ case 1:
+ GC_push_marked1(h, hhdr);
+ break;
+# endif
+# if !defined(SMALL_CONFIG) && !defined(UNALIGNED) && \
+ !defined(USE_MARK_BYTES)
+ case 2:
+ GC_push_marked2(h, hhdr);
+ break;
+ case 4:
+ GC_push_marked4(h, hhdr);
+ break;
+# endif
+ default:
+ GC_mark_stack_top_reg = GC_mark_stack_top;
+ for (p = (word *)h, word_no = 0; p <= lim; p += sz, word_no += sz) {
+ if (mark_bit_from_hdr(hhdr, word_no)) {
+ /* Mark from fields inside the object */
+ PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top_reg, mark_stack_limit);
+# ifdef GATHERSTATS
+ /* Subtract this object from total, since it was */
+ /* added in twice. */
+ GC_composite_in_use -= sz;
+# endif
+ }
+ }
+ GC_mark_stack_top = GC_mark_stack_top_reg;
+ }
+}
+
+#ifndef SMALL_CONFIG
+/* Test whether any page in the given block is dirty */
+GC_bool GC_block_was_dirty(h, hhdr)
+struct hblk *h;
+register hdr * hhdr;
+{
+ register int sz = hhdr -> hb_sz;
+
+ if (sz < MAXOBJSZ) {
+ return(GC_page_was_dirty(h));
+ } else {
+ register ptr_t p = (ptr_t)h;
+ sz = WORDS_TO_BYTES(sz);
+ while (p < (ptr_t)h + sz) {
+ if (GC_page_was_dirty((struct hblk *)p)) return(TRUE);
+ p += HBLKSIZE;
+ }
+ return(FALSE);
+ }
+}
+#endif /* SMALL_CONFIG */
+
+/* Similar to GC_push_next_marked, but return address of next block */
+struct hblk * GC_push_next_marked(h)
+struct hblk *h;
+{
+ register hdr * hhdr;
+
+ h = GC_next_used_block(h);
+ if (h == 0) return(0);
+ hhdr = HDR(h);
+ GC_push_marked(h, hhdr);
+ return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
+}
+
+#ifndef SMALL_CONFIG
+/* Identical to above, but mark only from dirty pages */
+struct hblk * GC_push_next_marked_dirty(h)
+struct hblk *h;
+{
+ register hdr * hhdr;
+
+ if (!GC_dirty_maintained) { ABORT("dirty bits not set up"); }
+ for (;;) {
+ h = GC_next_used_block(h);
+ if (h == 0) return(0);
+ hhdr = HDR(h);
+# ifdef STUBBORN_ALLOC
+ if (hhdr -> hb_obj_kind == STUBBORN) {
+ if (GC_page_was_changed(h) && GC_block_was_dirty(h, hhdr)) {
+ break;
+ }
+ } else {
+ if (GC_block_was_dirty(h, hhdr)) break;
+ }
+# else
+ if (GC_block_was_dirty(h, hhdr)) break;
+# endif
+ h += OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz);
+ }
+ GC_push_marked(h, hhdr);
+ return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
+}
+#endif
+
+/* Similar to above, but for uncollectable pages. Needed since we */
+/* do not clear marks for such pages, even for full collections. */
+struct hblk * GC_push_next_marked_uncollectable(h)
+struct hblk *h;
+{
+ register hdr * hhdr = HDR(h);
+
+ for (;;) {
+ h = GC_next_used_block(h);
+ if (h == 0) return(0);
+ hhdr = HDR(h);
+ if (hhdr -> hb_obj_kind == UNCOLLECTABLE) break;
+ h += OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz);
+ }
+ GC_push_marked(h, hhdr);
+ return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
+}
+
+
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+# include <stdio.h>
+# include "private/gc_priv.h"
+
+/* Data structure for list of root sets. */
+/* We keep a hash table, so that we can filter out duplicate additions. */
+/* Under Win32, we need to do a better job of filtering overlaps, so */
+/* we resort to sequential search, and pay the price. */
+/* This is really declared in gc_priv.h:
+struct roots {
+ ptr_t r_start;
+ ptr_t r_end;
+ # if !defined(MSWIN32) && !defined(MSWINCE)
+ struct roots * r_next;
+ # endif
+ GC_bool r_tmp;
+ -- Delete before registering new dynamic libraries
+};
+
+struct roots GC_static_roots[MAX_ROOT_SETS];
+*/
+
+int GC_no_dls = 0; /* Register dynamic library data segments. */
+
+static int n_root_sets = 0;
+
+ /* GC_static_roots[0..n_root_sets) contains the valid root sets. */
+
+# if !defined(NO_DEBUGGING)
+/* For debugging: */
+void GC_print_static_roots()
+{
+ register int i;
+ size_t total = 0;
+
+ for (i = 0; i < n_root_sets; i++) {
+ GC_printf2("From 0x%lx to 0x%lx ",
+ (unsigned long) GC_static_roots[i].r_start,
+ (unsigned long) GC_static_roots[i].r_end);
+ if (GC_static_roots[i].r_tmp) {
+ GC_printf0(" (temporary)\n");
+ } else {
+ GC_printf0("\n");
+ }
+ total += GC_static_roots[i].r_end - GC_static_roots[i].r_start;
+ }
+ GC_printf1("Total size: %ld\n", (unsigned long) total);
+ if (GC_root_size != total) {
+ GC_printf1("GC_root_size incorrect: %ld!!\n",
+ (unsigned long) GC_root_size);
+ }
+}
+# endif /* NO_DEBUGGING */
+
+/* Primarily for debugging support: */
+/* Is the address p in one of the registered static */
+/* root sections? */
+GC_bool GC_is_static_root(p)
+ptr_t p;
+{
+ static int last_root_set = MAX_ROOT_SETS;
+ register int i;
+
+
+ if (last_root_set < n_root_sets
+ && p >= GC_static_roots[last_root_set].r_start
+ && p < GC_static_roots[last_root_set].r_end) return(TRUE);
+ for (i = 0; i < n_root_sets; i++) {
+ if (p >= GC_static_roots[i].r_start
+ && p < GC_static_roots[i].r_end) {
+ last_root_set = i;
+ return(TRUE);
+ }
+ }
+ return(FALSE);
+}
+
+#if !defined(MSWIN32) && !defined(MSWINCE)
+/*
+# define LOG_RT_SIZE 6
+# define RT_SIZE (1 << LOG_RT_SIZE) -- Power of 2, may be != MAX_ROOT_SETS
+
+ struct roots * GC_root_index[RT_SIZE];
+ -- Hash table header. Used only to check whether a range is
+ -- already present.
+ -- really defined in gc_priv.h
+*/
+
+static int rt_hash(addr)
+char * addr;
+{
+ word result = (word) addr;
+# if CPP_WORDSZ > 8*LOG_RT_SIZE
+ result ^= result >> 8*LOG_RT_SIZE;
+# endif
+# if CPP_WORDSZ > 4*LOG_RT_SIZE
+ result ^= result >> 4*LOG_RT_SIZE;
+# endif
+ result ^= result >> 2*LOG_RT_SIZE;
+ result ^= result >> LOG_RT_SIZE;
+ result &= (RT_SIZE-1);
+ return(result);
+}
+
+/* Is a range starting at b already in the table? If so return a */
+/* pointer to it, else NIL. */
+struct roots * GC_roots_present(b)
+char *b;
+{
+ register int h = rt_hash(b);
+ register struct roots *p = GC_root_index[h];
+
+ while (p != 0) {
+ if (p -> r_start == (ptr_t)b) return(p);
+ p = p -> r_next;
+ }
+ return(FALSE);
+}
+
+/* Add the given root structure to the index. */
+static void add_roots_to_index(p)
+struct roots *p;
+{
+ register int h = rt_hash(p -> r_start);
+
+ p -> r_next = GC_root_index[h];
+ GC_root_index[h] = p;
+}
+
+# else /* MSWIN32 || MSWINCE */
+
+# define add_roots_to_index(p)
+
+# endif
+
+
+
+
+word GC_root_size = 0;
+
+void GC_add_roots(b, e)
+char * b; char * e;
+{
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ GC_add_roots_inner(b, e, FALSE);
+ UNLOCK();
+ ENABLE_SIGNALS();
+}
+
+
+/* Add [b,e) to the root set. Adding the same interval a second time */
+/* is a moderately fast noop, and hence benign. We do not handle */
+/* different but overlapping intervals efficiently. (We do handle */
+/* them correctly.) */
+/* Tmp specifies that the interval may be deleted before */
+/* reregistering dynamic libraries. */
+void GC_add_roots_inner(b, e, tmp)
+char * b; char * e;
+GC_bool tmp;
+{
+ struct roots * old;
+
+# if defined(MSWIN32) || defined(MSWINCE)
+ /* Spend the time to ensure that there are no overlapping */
+ /* or adjacent intervals. */
+ /* This could be done faster with e.g. a */
+ /* balanced tree. But the execution time here is */
+ /* virtually guaranteed to be dominated by the time it */
+ /* takes to scan the roots. */
+ {
+ register int i;
+
+ for (i = 0; i < n_root_sets; i++) {
+ old = GC_static_roots + i;
+ if ((ptr_t)b <= old -> r_end && (ptr_t)e >= old -> r_start) {
+ if ((ptr_t)b < old -> r_start) {
+ old -> r_start = (ptr_t)b;
+ GC_root_size += (old -> r_start - (ptr_t)b);
+ }
+ if ((ptr_t)e > old -> r_end) {
+ old -> r_end = (ptr_t)e;
+ GC_root_size += ((ptr_t)e - old -> r_end);
+ }
+ old -> r_tmp &= tmp;
+ break;
+ }
+ }
+ if (i < n_root_sets) {
+ /* merge other overlapping intervals */
+ struct roots *other;
+
+ for (i++; i < n_root_sets; i++) {
+ other = GC_static_roots + i;
+ b = (char *)(other -> r_start);
+ e = (char *)(other -> r_end);
+ if ((ptr_t)b <= old -> r_end && (ptr_t)e >= old -> r_start) {
+ if ((ptr_t)b < old -> r_start) {
+ old -> r_start = (ptr_t)b;
+ GC_root_size += (old -> r_start - (ptr_t)b);
+ }
+ if ((ptr_t)e > old -> r_end) {
+ old -> r_end = (ptr_t)e;
+ GC_root_size += ((ptr_t)e - old -> r_end);
+ }
+ old -> r_tmp &= other -> r_tmp;
+ /* Delete this entry. */
+ GC_root_size -= (other -> r_end - other -> r_start);
+ other -> r_start = GC_static_roots[n_root_sets-1].r_start;
+ other -> r_end = GC_static_roots[n_root_sets-1].r_end;
+ n_root_sets--;
+ }
+ }
+ return;
+ }
+ }
+# else
+ old = GC_roots_present(b);
+ if (old != 0) {
+ if ((ptr_t)e <= old -> r_end) /* already there */ return;
+ /* else extend */
+ GC_root_size += (ptr_t)e - old -> r_end;
+ old -> r_end = (ptr_t)e;
+ return;
+ }
+# endif
+ if (n_root_sets == MAX_ROOT_SETS) {
+ ABORT("Too many root sets\n");
+ }
+ GC_static_roots[n_root_sets].r_start = (ptr_t)b;
+ GC_static_roots[n_root_sets].r_end = (ptr_t)e;
+ GC_static_roots[n_root_sets].r_tmp = tmp;
+# if !defined(MSWIN32) && !defined(MSWINCE)
+ GC_static_roots[n_root_sets].r_next = 0;
+# endif
+ add_roots_to_index(GC_static_roots + n_root_sets);
+ GC_root_size += (ptr_t)e - (ptr_t)b;
+ n_root_sets++;
+}
+
+static GC_bool roots_were_cleared = FALSE;
+
+void GC_clear_roots GC_PROTO((void))
+{
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ roots_were_cleared = TRUE;
+ n_root_sets = 0;
+ GC_root_size = 0;
+# if !defined(MSWIN32) && !defined(MSWINCE)
+ {
+ register int i;
+
+ for (i = 0; i < RT_SIZE; i++) GC_root_index[i] = 0;
+ }
+# endif
+ UNLOCK();
+ ENABLE_SIGNALS();
+}
+
+/* Internal use only; lock held. */
+void GC_remove_tmp_roots()
+{
+ register int i;
+
+ for (i = 0; i < n_root_sets; ) {
+ if (GC_static_roots[i].r_tmp) {
+ GC_root_size -=
+ (GC_static_roots[i].r_end - GC_static_roots[i].r_start);
+ GC_static_roots[i].r_start = GC_static_roots[n_root_sets-1].r_start;
+ GC_static_roots[i].r_end = GC_static_roots[n_root_sets-1].r_end;
+ GC_static_roots[i].r_tmp = GC_static_roots[n_root_sets-1].r_tmp;
+ n_root_sets--;
+ } else {
+ i++;
+ }
+ }
+# if !defined(MSWIN32) && !defined(MSWINCE)
+ {
+ register int i;
+
+ for (i = 0; i < RT_SIZE; i++) GC_root_index[i] = 0;
+ for (i = 0; i < n_root_sets; i++)
+ add_roots_to_index(GC_static_roots + i);
+ }
+# endif
+
+}
+
+#if defined(MSWIN32) || defined(_WIN32_WCE_EMULATION)
+/* Workaround for the OS mapping and unmapping behind our back: */
+/* Is the address p in one of the temporary static root sections? */
+GC_bool GC_is_tmp_root(p)
+ptr_t p;
+{
+ static int last_root_set = MAX_ROOT_SETS;
+ register int i;
+
+ if (last_root_set < n_root_sets
+ && p >= GC_static_roots[last_root_set].r_start
+ && p < GC_static_roots[last_root_set].r_end)
+ return GC_static_roots[last_root_set].r_tmp;
+ for (i = 0; i < n_root_sets; i++) {
+ if (p >= GC_static_roots[i].r_start
+ && p < GC_static_roots[i].r_end) {
+ last_root_set = i;
+ return GC_static_roots[i].r_tmp;
+ }
+ }
+ return(FALSE);
+}
+#endif /* MSWIN32 || _WIN32_WCE_EMULATION */
+
+ptr_t GC_approx_sp()
+{
+ word dummy;
+
+# ifdef _MSC_VER
+# pragma warning(disable:4172)
+# endif
+ return((ptr_t)(&dummy));
+# ifdef _MSC_VER
+# pragma warning(default:4172)
+# endif
+}
+
+/*
+ * Data structure for excluded static roots.
+ * Real declaration is in gc_priv.h.
+
+struct exclusion {
+ ptr_t e_start;
+ ptr_t e_end;
+};
+
+struct exclusion GC_excl_table[MAX_EXCLUSIONS];
+ -- Array of exclusions, ascending
+ -- address order.
+*/
+
+size_t GC_excl_table_entries = 0; /* Number of entries in use. */
+
+/* Return the first exclusion range that includes an address >= start_addr */
+/* Assumes the exclusion table contains at least one entry (namely the */
+/* GC data structures). */
+struct exclusion * GC_next_exclusion(start_addr)
+ptr_t start_addr;
+{
+ size_t low = 0;
+ size_t high = GC_excl_table_entries - 1;
+ size_t mid;
+
+ while (high > low) {
+ mid = (low + high) >> 1;
+ /* low <= mid < high */
+ if ((word) GC_excl_table[mid].e_end <= (word) start_addr) {
+ low = mid + 1;
+ } else {
+ high = mid;
+ }
+ }
+ if ((word) GC_excl_table[low].e_end <= (word) start_addr) return 0;
+ return GC_excl_table + low;
+}
+
+void GC_exclude_static_roots(start, finish)
+GC_PTR start;
+GC_PTR finish;
+{
+ struct exclusion * next;
+ size_t next_index, i;
+
+ if (0 == GC_excl_table_entries) {
+ next = 0;
+ } else {
+ next = GC_next_exclusion(start);
+ }
+ if (0 != next) {
+ if ((word)(next -> e_start) < (word) finish) {
+ /* incomplete error check. */
+ ABORT("exclusion ranges overlap");
+ }
+ if ((word)(next -> e_start) == (word) finish) {
+ /* extend old range backwards */
+ next -> e_start = (ptr_t)start;
+ return;
+ }
+ next_index = next - GC_excl_table;
+ for (i = GC_excl_table_entries; i > next_index; --i) {
+ GC_excl_table[i] = GC_excl_table[i-1];
+ }
+ } else {
+ next_index = GC_excl_table_entries;
+ }
+ if (GC_excl_table_entries == MAX_EXCLUSIONS) ABORT("Too many exclusions");
+ GC_excl_table[next_index].e_start = (ptr_t)start;
+ GC_excl_table[next_index].e_end = (ptr_t)finish;
+ ++GC_excl_table_entries;
+}
+
+/* Invoke push_conditional on ranges that are not excluded. */
+void GC_push_conditional_with_exclusions(bottom, top, all)
+ptr_t bottom;
+ptr_t top;
+int all;
+{
+ struct exclusion * next;
+ ptr_t excl_start;
+
+ while (bottom < top) {
+ next = GC_next_exclusion(bottom);
+ if (0 == next || (excl_start = next -> e_start) >= top) {
+ GC_push_conditional(bottom, top, all);
+ return;
+ }
+ if (excl_start > bottom) GC_push_conditional(bottom, excl_start, all);
+ bottom = next -> e_end;
+ }
+}
+
+/*
+ * In the absence of threads, push the stack contents.
+ * In the presence of threads, push enough of the current stack
+ * to ensure that callee-save registers saved in collector frames have been
+ * seen.
+ */
+void GC_push_current_stack(cold_gc_frame)
+ptr_t cold_gc_frame;
+{
+# if defined(THREADS)
+ if (0 == cold_gc_frame) return;
+# ifdef STACK_GROWS_DOWN
+ GC_push_all_eager(GC_approx_sp(), cold_gc_frame);
+ /* For IA64, the register stack backing store is handled */
+ /* in the thread-specific code. */
+# else
+ GC_push_all_eager( cold_gc_frame, GC_approx_sp() );
+# endif
+# else
+# ifdef STACK_GROWS_DOWN
+ GC_push_all_stack_partially_eager( GC_approx_sp(), GC_stackbottom,
+ cold_gc_frame );
+# ifdef IA64
+ /* We also need to push the register stack backing store. */
+ /* This should really be done in the same way as the */
+ /* regular stack. For now we fudge it a bit. */
+ /* Note that the backing store grows up, so we can't use */
+ /* GC_push_all_stack_partially_eager. */
+ {
+ extern word GC_save_regs_ret_val;
+ /* Previously set to backing store pointer. */
+ ptr_t bsp = (ptr_t) GC_save_regs_ret_val;
+ ptr_t cold_gc_bs_pointer;
+ if (GC_all_interior_pointers) {
+ cold_gc_bs_pointer = bsp - 2048;
+ if (cold_gc_bs_pointer < BACKING_STORE_BASE) {
+ cold_gc_bs_pointer = BACKING_STORE_BASE;
+ } else {
+ GC_push_all_stack(BACKING_STORE_BASE, cold_gc_bs_pointer);
+ }
+ } else {
+ cold_gc_bs_pointer = BACKING_STORE_BASE;
+ }
+ GC_push_all_eager(cold_gc_bs_pointer, bsp);
+ /* All values should be sufficiently aligned that we */
+ /* dont have to worry about the boundary. */
+ }
+# endif
+# else
+ GC_push_all_stack_partially_eager( GC_stackbottom, GC_approx_sp(),
+ cold_gc_frame );
+# endif
+# endif /* !THREADS */
+}
+
+/*
+ * Push GC internal roots. Only called if there is some reason to believe
+ * these would not otherwise get registered.
+ */
+void GC_push_gc_structures GC_PROTO((void))
+{
+ GC_push_finalizer_structures();
+ GC_push_stubborn_structures();
+# if defined(THREADS)
+ GC_push_thread_structures();
+# endif
+}
+
+#ifdef THREAD_LOCAL_ALLOC
+ void GC_mark_thread_local_free_lists();
+#endif
+
+void GC_cond_register_dynamic_libraries()
+{
+# if (defined(DYNAMIC_LOADING) || defined(MSWIN32) || defined(MSWINCE) \
+ || defined(PCR)) && !defined(SRC_M3)
+ GC_remove_tmp_roots();
+ if (!GC_no_dls) GC_register_dynamic_libraries();
+# else
+ GC_no_dls = TRUE;
+# endif
+}
+
+/*
+ * Call the mark routines (GC_tl_push for a single pointer, GC_push_conditional
+ * on groups of pointers) on every top level accessible pointer.
+ * If all is FALSE, arrange to push only possibly altered values.
+ * Cold_gc_frame is an address inside a GC frame that
+ * remains valid until all marking is complete.
+ * A zero value indicates that it's OK to miss some
+ * register values.
+ */
+void GC_push_roots(all, cold_gc_frame)
+GC_bool all;
+ptr_t cold_gc_frame;
+{
+ int i;
+ int kind;
+
+ /*
+ * Next push static data. This must happen early on, since it's
+ * not robust against mark stack overflow.
+ */
+ /* Reregister dynamic libraries, in case one got added. */
+ /* There is some argument for doing this as late as possible, */
+ /* especially on win32, where it can change asynchronously. */
+ /* In those cases, we do it here. But on other platforms, it's */
+ /* not safe with the world stopped, so we do it earlier. */
+# if !defined(REGISTER_LIBRARIES_EARLY)
+ GC_cond_register_dynamic_libraries();
+# endif
+
+ /* Mark everything in static data areas */
+ for (i = 0; i < n_root_sets; i++) {
+ GC_push_conditional_with_exclusions(
+ GC_static_roots[i].r_start,
+ GC_static_roots[i].r_end, all);
+ }
+
+ /* Mark all free list header blocks, if those were allocated from */
+ /* the garbage collected heap. This makes sure they don't */
+ /* disappear if we are not marking from static data. It also */
+ /* saves us the trouble of scanning them, and possibly that of */
+ /* marking the freelists. */
+ for (kind = 0; kind < GC_n_kinds; kind++) {
+ GC_PTR base = GC_base(GC_obj_kinds[kind].ok_freelist);
+ if (0 != base) {
+ GC_set_mark_bit(base);
+ }
+ }
+
+ /* Mark from GC internal roots if those might otherwise have */
+ /* been excluded. */
+ if (GC_no_dls || roots_were_cleared) {
+ GC_push_gc_structures();
+ }
+
+ /* Mark thread local free lists, even if their mark */
+ /* descriptor excludes the link field. */
+# ifdef THREAD_LOCAL_ALLOC
+ GC_mark_thread_local_free_lists();
+# endif
+
+ /*
+ * Now traverse stacks, and mark from register contents.
+ * These must be done last, since they can legitimately overflow
+ * the mark stack.
+ */
+# ifdef USE_GENERIC_PUSH_REGS
+ GC_generic_push_regs(cold_gc_frame);
+ /* Also pushes stack, so that we catch callee-save registers */
+ /* saved inside the GC_push_regs frame. */
+# else
+ /*
+ * push registers - i.e., call GC_push_one(r) for each
+ * register contents r.
+ */
+ GC_push_regs(); /* usually defined in machine_dep.c */
+ GC_push_current_stack(cold_gc_frame);
+ /* In the threads case, this only pushes collector frames. */
+ /* In the case of linux threads on IA64, the hot section of */
+ /* the main stack is marked here, but the register stack */
+ /* backing store is handled in the threads-specific code. */
+# endif
+ if (GC_push_other_roots != 0) (*GC_push_other_roots)();
+ /* In the threads case, this also pushes thread stacks. */
+ /* Note that without interior pointer recognition lots */
+ /* of stuff may have been pushed already, and this */
+ /* should be careful about mark stack overflows. */
+}
+
--- /dev/null
+#include <sys/regdef.h>
+#include <sys/asm.h>
+
+# define call_push(x) move $4,x; jal GC_push_one
+
+ .option pic2
+ .text
+/* Mark from machine registers that are saved by C compiler */
+# define FRAMESZ 32
+# define RAOFF FRAMESZ-SZREG
+# define GPOFF FRAMESZ-(2*SZREG)
+ NESTED(GC_push_regs, FRAMESZ, ra)
+ .mask 0x80000000,-SZREG # inform debugger of saved ra loc
+ move t0,gp
+ SETUP_GPX(t8)
+ PTR_SUBU sp,FRAMESZ
+# ifdef SETUP_GP64
+ SETUP_GP64(GPOFF, GC_push_regs)
+# endif
+ SAVE_GP(GPOFF)
+ REG_S ra,RAOFF(sp)
+# if (_MIPS_SIM == _MIPS_SIM_ABI32)
+ call_push($2)
+ call_push($3)
+# endif
+ call_push($16)
+ call_push($17)
+ call_push($18)
+ call_push($19)
+ call_push($20)
+ call_push($21)
+ call_push($22)
+ call_push($23)
+ call_push($30)
+ REG_L ra,RAOFF(sp)
+# ifdef RESTORE_GP64
+ RESTORE_GP64
+# endif
+ PTR_ADDU sp,FRAMESZ
+ j ra
+ .end GC_push_regs
--- /dev/null
+# define call_push(x) move $4,x; jal GC_push_one
+
+ .text
+ # Mark from machine registers that are saved by C compiler
+ .globl GC_push_regs
+ .ent GC_push_regs
+GC_push_regs:
+ subu $sp,8 ## Need to save only return address
+ sw $31,4($sp)
+ .mask 0x80000000,-4
+ .frame $sp,8,$31
+ call_push($2)
+ call_push($3)
+ call_push($16)
+ call_push($17)
+ call_push($18)
+ call_push($19)
+ call_push($20)
+ call_push($21)
+ call_push($22)
+ call_push($23)
+ call_push($30)
+ lw $31,4($sp)
+ addu $sp,8
+ j $31
+ .end GC_push_regs
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1999-2001 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, July 31, 1995 5:02 pm PDT */
+
+
+#include <stdio.h>
+#include <limits.h>
+#ifndef _WIN32_WCE
+#include <signal.h>
+#endif
+
+#define I_HIDE_POINTERS /* To make GC_call_with_alloc_lock visible */
+#include "private/gc_pmark.h"
+
+#ifdef GC_SOLARIS_THREADS
+# include <sys/syscall.h>
+#endif
+#if defined(MSWIN32) || defined(MSWINCE)
+# define WIN32_LEAN_AND_MEAN
+# define NOSERVICE
+# include <windows.h>
+# include <tchar.h>
+#endif
+
+# ifdef THREADS
+# ifdef PCR
+# include "il/PCR_IL.h"
+ PCR_Th_ML GC_allocate_ml;
+# else
+# ifdef SRC_M3
+ /* Critical section counter is defined in the M3 runtime */
+ /* That's all we use. */
+# else
+# ifdef GC_SOLARIS_THREADS
+ mutex_t GC_allocate_ml; /* Implicitly initialized. */
+# else
+# if defined(GC_WIN32_THREADS)
+# if defined(GC_PTHREADS)
+ pthread_mutex_t GC_allocate_ml = PTHREAD_MUTEX_INITIALIZER;
+# elif !defined(GC_NOT_DLL) && (defined(_DLL) || defined(GC_DLL))
+ __declspec(dllexport) CRITICAL_SECTION GC_allocate_ml;
+# else
+ CRITICAL_SECTION GC_allocate_ml;
+# endif
+# else
+# if defined(GC_PTHREADS) && !defined(GC_SOLARIS_THREADS)
+# if defined(USE_SPIN_LOCK)
+ pthread_t GC_lock_holder = NO_THREAD;
+# else
+ pthread_mutex_t GC_allocate_ml = PTHREAD_MUTEX_INITIALIZER;
+ pthread_t GC_lock_holder = NO_THREAD;
+ /* Used only for assertions, and to prevent */
+ /* recursive reentry in the system call wrapper. */
+# endif
+# else
+ --> declare allocator lock here
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+
+#if defined(NOSYS) || defined(ECOS)
+#undef STACKBASE
+#endif
+
+/* Dont unnecessarily call GC_register_main_static_data() in case */
+/* dyn_load.c isn't linked in. */
+#ifdef DYNAMIC_LOADING
+# define GC_REGISTER_MAIN_STATIC_DATA() GC_register_main_static_data()
+#else
+# define GC_REGISTER_MAIN_STATIC_DATA() TRUE
+#endif
+
+GC_FAR struct _GC_arrays GC_arrays /* = { 0 } */;
+
+
+GC_bool GC_debugging_started = FALSE;
+ /* defined here so we don't have to load debug_malloc.o */
+
+void (*GC_check_heap) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0;
+void (*GC_print_all_smashed) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0;
+
+void (*GC_start_call_back) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0;
+
+ptr_t GC_stackbottom = 0;
+
+#ifdef IA64
+ ptr_t GC_register_stackbottom = 0;
+#endif
+
+GC_bool GC_dont_gc = 0;
+
+GC_bool GC_dont_precollect = 0;
+
+GC_bool GC_quiet = 0;
+
+GC_bool GC_print_stats = 0;
+
+GC_bool GC_print_back_height = 0;
+
+#ifndef NO_DEBUGGING
+ GC_bool GC_dump_regularly = 0; /* Generate regular debugging dumps. */
+#endif
+
+#ifdef FIND_LEAK
+ int GC_find_leak = 1;
+#else
+ int GC_find_leak = 0;
+#endif
+
+#ifdef ALL_INTERIOR_POINTERS
+ int GC_all_interior_pointers = 1;
+#else
+ int GC_all_interior_pointers = 0;
+#endif
+
+long GC_large_alloc_warn_interval = 5;
+ /* Interval between unsuppressed warnings. */
+
+long GC_large_alloc_warn_suppressed = 0;
+ /* Number of warnings suppressed so far. */
+
+/*ARGSUSED*/
+GC_PTR GC_default_oom_fn GC_PROTO((size_t bytes_requested))
+{
+ return(0);
+}
+
+GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested)) = GC_default_oom_fn;
+
+extern signed_word GC_mem_found;
+
+void * GC_project2(arg1, arg2)
+void *arg1;
+void *arg2;
+{
+ return arg2;
+}
+
+# ifdef MERGE_SIZES
+ /* Set things up so that GC_size_map[i] >= words(i), */
+ /* but not too much bigger */
+ /* and so that size_map contains relatively few distinct entries */
+ /* This is stolen from Russ Atkinson's Cedar quantization */
+ /* alogrithm (but we precompute it). */
+
+
+ void GC_init_size_map()
+ {
+ register unsigned i;
+
+ /* Map size 0 to something bigger. */
+ /* This avoids problems at lower levels. */
+ /* One word objects don't have to be 2 word aligned, */
+ /* unless we're using mark bytes. */
+ for (i = 0; i < sizeof(word); i++) {
+ GC_size_map[i] = MIN_WORDS;
+ }
+# if MIN_WORDS > 1
+ GC_size_map[sizeof(word)] = MIN_WORDS;
+# else
+ GC_size_map[sizeof(word)] = ROUNDED_UP_WORDS(sizeof(word));
+# endif
+ for (i = sizeof(word) + 1; i <= 8 * sizeof(word); i++) {
+ GC_size_map[i] = ALIGNED_WORDS(i);
+ }
+ for (i = 8*sizeof(word) + 1; i <= 16 * sizeof(word); i++) {
+ GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
+ }
+# ifdef GC_GCJ_SUPPORT
+ /* Make all sizes up to 32 words predictable, so that a */
+ /* compiler can statically perform the same computation, */
+ /* or at least a computation that results in similar size */
+ /* classes. */
+ for (i = 16*sizeof(word) + 1; i <= 32 * sizeof(word); i++) {
+ GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 3) & (~3);
+ }
+# endif
+ /* We leave the rest of the array to be filled in on demand. */
+ }
+
+ /* Fill in additional entries in GC_size_map, including the ith one */
+ /* We assume the ith entry is currently 0. */
+ /* Note that a filled in section of the array ending at n always */
+ /* has length at least n/4. */
+ void GC_extend_size_map(i)
+ word i;
+ {
+ word orig_word_sz = ROUNDED_UP_WORDS(i);
+ word word_sz = orig_word_sz;
+ register word byte_sz = WORDS_TO_BYTES(word_sz);
+ /* The size we try to preserve. */
+ /* Close to to i, unless this would */
+ /* introduce too many distinct sizes. */
+ word smaller_than_i = byte_sz - (byte_sz >> 3);
+ word much_smaller_than_i = byte_sz - (byte_sz >> 2);
+ register word low_limit; /* The lowest indexed entry we */
+ /* initialize. */
+ register word j;
+
+ if (GC_size_map[smaller_than_i] == 0) {
+ low_limit = much_smaller_than_i;
+ while (GC_size_map[low_limit] != 0) low_limit++;
+ } else {
+ low_limit = smaller_than_i + 1;
+ while (GC_size_map[low_limit] != 0) low_limit++;
+ word_sz = ROUNDED_UP_WORDS(low_limit);
+ word_sz += word_sz >> 3;
+ if (word_sz < orig_word_sz) word_sz = orig_word_sz;
+ }
+# ifdef ALIGN_DOUBLE
+ word_sz += 1;
+ word_sz &= ~1;
+# endif
+ if (word_sz > MAXOBJSZ) {
+ word_sz = MAXOBJSZ;
+ }
+ /* If we can fit the same number of larger objects in a block, */
+ /* do so. */
+ {
+ size_t number_of_objs = BODY_SZ/word_sz;
+ word_sz = BODY_SZ/number_of_objs;
+# ifdef ALIGN_DOUBLE
+ word_sz &= ~1;
+# endif
+ }
+ byte_sz = WORDS_TO_BYTES(word_sz);
+ if (GC_all_interior_pointers) {
+ /* We need one extra byte; don't fill in GC_size_map[byte_sz] */
+ byte_sz--;
+ }
+
+ for (j = low_limit; j <= byte_sz; j++) GC_size_map[j] = word_sz;
+ }
+# endif
+
+
+/*
+ * The following is a gross hack to deal with a problem that can occur
+ * on machines that are sloppy about stack frame sizes, notably SPARC.
+ * Bogus pointers may be written to the stack and not cleared for
+ * a LONG time, because they always fall into holes in stack frames
+ * that are not written. We partially address this by clearing
+ * sections of the stack whenever we get control.
+ */
+word GC_stack_last_cleared = 0; /* GC_no when we last did this */
+# ifdef THREADS
+# define BIG_CLEAR_SIZE 2048 /* Clear this much now and then. */
+# define SMALL_CLEAR_SIZE 256 /* Clear this much every time. */
+# endif
+# define CLEAR_SIZE 213 /* Granularity for GC_clear_stack_inner */
+# define DEGRADE_RATE 50
+
+word GC_min_sp; /* Coolest stack pointer value from which we've */
+ /* already cleared the stack. */
+
+word GC_high_water;
+ /* "hottest" stack pointer value we have seen */
+ /* recently. Degrades over time. */
+
+word GC_words_allocd_at_reset;
+
+#if defined(ASM_CLEAR_CODE)
+ extern ptr_t GC_clear_stack_inner();
+#else
+/* Clear the stack up to about limit. Return arg. */
+/*ARGSUSED*/
+ptr_t GC_clear_stack_inner(arg, limit)
+ptr_t arg;
+word limit;
+{
+ word dummy[CLEAR_SIZE];
+
+ BZERO(dummy, CLEAR_SIZE*sizeof(word));
+ if ((word)(dummy) COOLER_THAN limit) {
+ (void) GC_clear_stack_inner(arg, limit);
+ }
+ /* Make sure the recursive call is not a tail call, and the bzero */
+ /* call is not recognized as dead code. */
+ GC_noop1((word)dummy);
+ return(arg);
+}
+#endif
+
+/* Clear some of the inaccessible part of the stack. Returns its */
+/* argument, so it can be used in a tail call position, hence clearing */
+/* another frame. */
+ptr_t GC_clear_stack(arg)
+ptr_t arg;
+{
+ register word sp = (word)GC_approx_sp(); /* Hotter than actual sp */
+# ifdef THREADS
+ word dummy[SMALL_CLEAR_SIZE];
+ static unsigned random_no = 0;
+ /* Should be more random than it is ... */
+ /* Used to occasionally clear a bigger */
+ /* chunk. */
+# endif
+ register word limit;
+
+# define SLOP 400
+ /* Extra bytes we clear every time. This clears our own */
+ /* activation record, and should cause more frequent */
+ /* clearing near the cold end of the stack, a good thing. */
+# define GC_SLOP 4000
+ /* We make GC_high_water this much hotter than we really saw */
+ /* saw it, to cover for GC noise etc. above our current frame. */
+# define CLEAR_THRESHOLD 100000
+ /* We restart the clearing process after this many bytes of */
+ /* allocation. Otherwise very heavily recursive programs */
+ /* with sparse stacks may result in heaps that grow almost */
+ /* without bounds. As the heap gets larger, collection */
+ /* frequency decreases, thus clearing frequency would decrease, */
+ /* thus more junk remains accessible, thus the heap gets */
+ /* larger ... */
+# ifdef THREADS
+ if (++random_no % 13 == 0) {
+ limit = sp;
+ MAKE_HOTTER(limit, BIG_CLEAR_SIZE*sizeof(word));
+ limit &= ~0xf; /* Make it sufficiently aligned for assembly */
+ /* implementations of GC_clear_stack_inner. */
+ return GC_clear_stack_inner(arg, limit);
+ } else {
+ BZERO(dummy, SMALL_CLEAR_SIZE*sizeof(word));
+ return arg;
+ }
+# else
+ if (GC_gc_no > GC_stack_last_cleared) {
+ /* Start things over, so we clear the entire stack again */
+ if (GC_stack_last_cleared == 0) GC_high_water = (word) GC_stackbottom;
+ GC_min_sp = GC_high_water;
+ GC_stack_last_cleared = GC_gc_no;
+ GC_words_allocd_at_reset = GC_words_allocd;
+ }
+ /* Adjust GC_high_water */
+ MAKE_COOLER(GC_high_water, WORDS_TO_BYTES(DEGRADE_RATE) + GC_SLOP);
+ if (sp HOTTER_THAN GC_high_water) {
+ GC_high_water = sp;
+ }
+ MAKE_HOTTER(GC_high_water, GC_SLOP);
+ limit = GC_min_sp;
+ MAKE_HOTTER(limit, SLOP);
+ if (sp COOLER_THAN limit) {
+ limit &= ~0xf; /* Make it sufficiently aligned for assembly */
+ /* implementations of GC_clear_stack_inner. */
+ GC_min_sp = sp;
+ return(GC_clear_stack_inner(arg, limit));
+ } else if (WORDS_TO_BYTES(GC_words_allocd - GC_words_allocd_at_reset)
+ > CLEAR_THRESHOLD) {
+ /* Restart clearing process, but limit how much clearing we do. */
+ GC_min_sp = sp;
+ MAKE_HOTTER(GC_min_sp, CLEAR_THRESHOLD/4);
+ if (GC_min_sp HOTTER_THAN GC_high_water) GC_min_sp = GC_high_water;
+ GC_words_allocd_at_reset = GC_words_allocd;
+ }
+ return(arg);
+# endif
+}
+
+
+/* Return a pointer to the base address of p, given a pointer to a */
+/* an address within an object. Return 0 o.w. */
+# ifdef __STDC__
+ GC_PTR GC_base(GC_PTR p)
+# else
+ GC_PTR GC_base(p)
+ GC_PTR p;
+# endif
+{
+ register word r;
+ register struct hblk *h;
+ register bottom_index *bi;
+ register hdr *candidate_hdr;
+ register word limit;
+
+ r = (word)p;
+ if (!GC_is_initialized) return 0;
+ h = HBLKPTR(r);
+ GET_BI(r, bi);
+ candidate_hdr = HDR_FROM_BI(bi, r);
+ if (candidate_hdr == 0) return(0);
+ /* If it's a pointer to the middle of a large object, move it */
+ /* to the beginning. */
+ while (IS_FORWARDING_ADDR_OR_NIL(candidate_hdr)) {
+ h = FORWARDED_ADDR(h,candidate_hdr);
+ r = (word)h;
+ candidate_hdr = HDR(h);
+ }
+ if (candidate_hdr -> hb_map == GC_invalid_map) return(0);
+ /* Make sure r points to the beginning of the object */
+ r &= ~(WORDS_TO_BYTES(1) - 1);
+ {
+ register int offset = HBLKDISPL(r);
+ register signed_word sz = candidate_hdr -> hb_sz;
+ register signed_word map_entry;
+
+ map_entry = MAP_ENTRY((candidate_hdr -> hb_map), offset);
+ if (map_entry > CPP_MAX_OFFSET) {
+ map_entry = (signed_word)(BYTES_TO_WORDS(offset)) % sz;
+ }
+ r -= WORDS_TO_BYTES(map_entry);
+ limit = r + WORDS_TO_BYTES(sz);
+ if (limit > (word)(h + 1)
+ && sz <= BYTES_TO_WORDS(HBLKSIZE)) {
+ return(0);
+ }
+ if ((word)p >= limit) return(0);
+ }
+ return((GC_PTR)r);
+}
+
+
+/* Return the size of an object, given a pointer to its base. */
+/* (For small obects this also happens to work from interior pointers, */
+/* but that shouldn't be relied upon.) */
+# ifdef __STDC__
+ size_t GC_size(GC_PTR p)
+# else
+ size_t GC_size(p)
+ GC_PTR p;
+# endif
+{
+ register int sz;
+ register hdr * hhdr = HDR(p);
+
+ sz = WORDS_TO_BYTES(hhdr -> hb_sz);
+ return(sz);
+}
+
+size_t GC_get_heap_size GC_PROTO(())
+{
+ return ((size_t) GC_heapsize);
+}
+
+size_t GC_get_free_bytes GC_PROTO(())
+{
+ return ((size_t) GC_large_free_bytes);
+}
+
+size_t GC_get_bytes_since_gc GC_PROTO(())
+{
+ return ((size_t) WORDS_TO_BYTES(GC_words_allocd));
+}
+
+size_t GC_get_total_bytes GC_PROTO(())
+{
+ return ((size_t) WORDS_TO_BYTES(GC_words_allocd+GC_words_allocd_before_gc));
+}
+
+GC_bool GC_is_initialized = FALSE;
+
+void GC_init()
+{
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+
+#if defined(GC_WIN32_THREADS) && !defined(GC_PTHREADS)
+ if (!GC_is_initialized) InitializeCriticalSection(&GC_allocate_ml);
+#endif /* MSWIN32 */
+
+ LOCK();
+ GC_init_inner();
+ UNLOCK();
+ ENABLE_SIGNALS();
+
+# if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ /* Make sure marker threads and started and thread local */
+ /* allocation is initialized, in case we didn't get */
+ /* called from GC_init_parallel(); */
+ {
+ extern void GC_init_parallel(void);
+ GC_init_parallel();
+ }
+# endif /* PARALLEL_MARK || THREAD_LOCAL_ALLOC */
+}
+
+#if defined(MSWIN32) || defined(MSWINCE)
+ CRITICAL_SECTION GC_write_cs;
+#endif
+
+#ifdef MSWIN32
+ extern void GC_init_win32 GC_PROTO((void));
+#endif
+
+extern void GC_setpagesize();
+
+#ifdef UNIX_LIKE
+
+extern void GC_set_and_save_fault_handler GC_PROTO((void (*handler)(int)));
+
+static void looping_handler(sig)
+int sig;
+{
+ GC_err_printf1("Caught signal %d: looping in handler\n", sig);
+ for(;;);
+}
+#endif
+
+#ifdef MSWIN32
+extern GC_bool GC_no_win32_dlls;
+#else
+# define GC_no_win32_dlls FALSE
+#endif
+
+void GC_exit_check GC_PROTO((void))
+{
+ GC_gcollect();
+}
+
+#ifdef SEARCH_FOR_DATA_START
+ extern void GC_init_linux_data_start GC_PROTO((void));
+#endif
+
+void GC_init_inner()
+{
+# if !defined(THREADS) && defined(GC_ASSERTIONS)
+ word dummy;
+# endif
+ word initial_heap_sz = (word)MINHINCR;
+
+ if (GC_is_initialized) return;
+# ifdef PRINTSTATS
+ GC_print_stats = 1;
+# endif
+# if defined(MSWIN32) || defined(MSWINCE)
+ InitializeCriticalSection(&GC_write_cs);
+# endif
+ if (0 != GETENV("GC_PRINT_STATS")) {
+ GC_print_stats = 1;
+ }
+# ifndef NO_DEBUGGING
+ if (0 != GETENV("GC_DUMP_REGULARLY")) {
+ GC_dump_regularly = 1;
+ }
+# endif
+ if (0 != GETENV("GC_FIND_LEAK")) {
+ GC_find_leak = 1;
+# ifdef __STDC__
+ atexit(GC_exit_check);
+# endif
+ }
+ if (0 != GETENV("GC_ALL_INTERIOR_POINTERS")) {
+ GC_all_interior_pointers = 1;
+ }
+ if (0 != GETENV("GC_DONT_GC")) {
+ GC_dont_gc = 1;
+ }
+ if (0 != GETENV("GC_PRINT_BACK_HEIGHT")) {
+ GC_print_back_height = 1;
+ }
+ if (0 != GETENV("GC_NO_BLACKLIST_WARNING")) {
+ GC_large_alloc_warn_interval = LONG_MAX;
+ }
+ {
+ char * time_limit_string = GETENV("GC_PAUSE_TIME_TARGET");
+ if (0 != time_limit_string) {
+ long time_limit = atol(time_limit_string);
+ if (time_limit < 5) {
+ WARN("GC_PAUSE_TIME_TARGET environment variable value too small "
+ "or bad syntax: Ignoring\n", 0);
+ } else {
+ GC_time_limit = time_limit;
+ }
+ }
+ }
+ {
+ char * interval_string = GETENV("GC_LARGE_ALLOC_WARN_INTERVAL");
+ if (0 != interval_string) {
+ long interval = atol(interval_string);
+ if (interval <= 0) {
+ WARN("GC_LARGE_ALLOC_WARN_INTERVAL environment variable has "
+ "bad value: Ignoring\n", 0);
+ } else {
+ GC_large_alloc_warn_interval = interval;
+ }
+ }
+ }
+# ifdef UNIX_LIKE
+ if (0 != GETENV("GC_LOOP_ON_ABORT")) {
+ GC_set_and_save_fault_handler(looping_handler);
+ }
+# endif
+ /* Adjust normal object descriptor for extra allocation. */
+ if (ALIGNMENT > GC_DS_TAGS && EXTRA_BYTES != 0) {
+ GC_obj_kinds[NORMAL].ok_descriptor = ((word)(-ALIGNMENT) | GC_DS_LENGTH);
+ }
+ GC_setpagesize();
+ GC_exclude_static_roots(beginGC_arrays, endGC_arrays);
+ GC_exclude_static_roots(beginGC_obj_kinds, endGC_obj_kinds);
+# ifdef SEPARATE_GLOBALS
+ GC_exclude_static_roots(beginGC_objfreelist, endGC_objfreelist);
+ GC_exclude_static_roots(beginGC_aobjfreelist, endGC_aobjfreelist);
+# endif
+# ifdef MSWIN32
+ GC_init_win32();
+# endif
+# if defined(SEARCH_FOR_DATA_START)
+ GC_init_linux_data_start();
+# endif
+# if (defined(NETBSD) || defined(OPENBSD)) && defined(__ELF__)
+ GC_init_netbsd_elf();
+# endif
+# if defined(GC_PTHREADS) || defined(GC_SOLARIS_THREADS)
+ GC_thr_init();
+# endif
+# ifdef GC_SOLARIS_THREADS
+ /* We need dirty bits in order to find live stack sections. */
+ GC_dirty_init();
+# endif
+# if !defined(THREADS) || defined(GC_PTHREADS) || defined(GC_WIN32_THREADS) \
+ || defined(GC_SOLARIS_THREADS)
+ if (GC_stackbottom == 0) {
+ GC_stackbottom = GC_get_stack_base();
+# if defined(LINUX) && defined(IA64)
+ GC_register_stackbottom = GC_get_register_stack_base();
+# endif
+ } else {
+# if defined(LINUX) && defined(IA64)
+ if (GC_register_stackbottom == 0) {
+ WARN("GC_register_stackbottom should be set with GC_stackbottom", 0);
+ /* The following is likely to fail, since we rely on */
+ /* alignment properties that may not hold with a user set */
+ /* GC_stackbottom. */
+ GC_register_stackbottom = GC_get_register_stack_base();
+ }
+# endif
+ }
+# endif
+ GC_ASSERT(sizeof (ptr_t) == sizeof(word));
+ GC_ASSERT(sizeof (signed_word) == sizeof(word));
+ GC_ASSERT(sizeof (struct hblk) == HBLKSIZE);
+# ifndef THREADS
+# if defined(STACK_GROWS_UP) && defined(STACK_GROWS_DOWN)
+ ABORT(
+ "Only one of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
+# endif
+# if !defined(STACK_GROWS_UP) && !defined(STACK_GROWS_DOWN)
+ ABORT(
+ "One of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
+# endif
+# ifdef STACK_GROWS_DOWN
+ GC_ASSERT((word)(&dummy) <= (word)GC_stackbottom);
+# else
+ GC_ASSERT((word)(&dummy) >= (word)GC_stackbottom);
+# endif
+# endif
+# if !defined(_AUX_SOURCE) || defined(__GNUC__)
+ GC_ASSERT((word)(-1) > (word)0);
+ /* word should be unsigned */
+# endif
+ GC_ASSERT((signed_word)(-1) < (signed_word)0);
+
+ /* Add initial guess of root sets. Do this first, since sbrk(0) */
+ /* might be used. */
+ if (GC_REGISTER_MAIN_STATIC_DATA()) GC_register_data_segments();
+ GC_init_headers();
+ GC_bl_init();
+ GC_mark_init();
+ {
+ char * sz_str = GETENV("GC_INITIAL_HEAP_SIZE");
+ if (sz_str != NULL) {
+ initial_heap_sz = atoi(sz_str);
+ if (initial_heap_sz <= MINHINCR * HBLKSIZE) {
+ WARN("Bad initial heap size %s - ignoring it.\n",
+ sz_str);
+ }
+ initial_heap_sz = divHBLKSZ(initial_heap_sz);
+ }
+ }
+ {
+ char * sz_str = GETENV("GC_MAXIMUM_HEAP_SIZE");
+ if (sz_str != NULL) {
+ word max_heap_sz = (word)atol(sz_str);
+ if (max_heap_sz < initial_heap_sz * HBLKSIZE) {
+ WARN("Bad maximum heap size %s - ignoring it.\n",
+ sz_str);
+ }
+ if (0 == GC_max_retries) GC_max_retries = 2;
+ GC_set_max_heap_size(max_heap_sz);
+ }
+ }
+ if (!GC_expand_hp_inner(initial_heap_sz)) {
+ GC_err_printf0("Can't start up: not enough memory\n");
+ EXIT();
+ }
+ /* Preallocate large object map. It's otherwise inconvenient to */
+ /* deal with failure. */
+ if (!GC_add_map_entry((word)0)) {
+ GC_err_printf0("Can't start up: not enough memory\n");
+ EXIT();
+ }
+ GC_register_displacement_inner(0L);
+# ifdef MERGE_SIZES
+ GC_init_size_map();
+# endif
+# ifdef PCR
+ if (PCR_IL_Lock(PCR_Bool_false, PCR_allSigsBlocked, PCR_waitForever)
+ != PCR_ERes_okay) {
+ ABORT("Can't lock load state\n");
+ } else if (PCR_IL_Unlock() != PCR_ERes_okay) {
+ ABORT("Can't unlock load state\n");
+ }
+ PCR_IL_Unlock();
+ GC_pcr_install();
+# endif
+# if !defined(SMALL_CONFIG)
+ if (!GC_no_win32_dlls && 0 != GETENV("GC_ENABLE_INCREMENTAL")) {
+ GC_ASSERT(!GC_incremental);
+ GC_setpagesize();
+# ifndef GC_SOLARIS_THREADS
+ GC_dirty_init();
+# endif
+ GC_ASSERT(GC_words_allocd == 0)
+ GC_incremental = TRUE;
+ }
+# endif /* !SMALL_CONFIG */
+ COND_DUMP;
+ /* Get black list set up and/or incrmental GC started */
+ if (!GC_dont_precollect || GC_incremental) GC_gcollect_inner();
+ GC_is_initialized = TRUE;
+# ifdef STUBBORN_ALLOC
+ GC_stubborn_init();
+# endif
+ /* Convince lint that some things are used */
+# ifdef LINT
+ {
+ extern char * GC_copyright[];
+ extern int GC_read();
+ extern void GC_register_finalizer_no_order();
+
+ GC_noop(GC_copyright, GC_find_header,
+ GC_push_one, GC_call_with_alloc_lock, GC_read,
+ GC_dont_expand,
+# ifndef NO_DEBUGGING
+ GC_dump,
+# endif
+ GC_register_finalizer_no_order);
+ }
+# endif
+}
+
+void GC_enable_incremental GC_PROTO(())
+{
+# if !defined(SMALL_CONFIG)
+ if (!GC_find_leak) {
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ if (GC_incremental) goto out;
+ GC_setpagesize();
+ if (GC_no_win32_dlls) goto out;
+# ifndef GC_SOLARIS_THREADS
+ GC_dirty_init();
+# endif
+ if (!GC_is_initialized) {
+ GC_init_inner();
+ }
+ if (GC_incremental) goto out;
+ if (GC_dont_gc) {
+ /* Can't easily do it. */
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return;
+ }
+ if (GC_words_allocd > 0) {
+ /* There may be unmarked reachable objects */
+ GC_gcollect_inner();
+ } /* else we're OK in assuming everything's */
+ /* clean since nothing can point to an */
+ /* unmarked object. */
+ GC_read_dirty();
+ GC_incremental = TRUE;
+out:
+ UNLOCK();
+ ENABLE_SIGNALS();
+ }
+# endif
+}
+
+
+#if defined(MSWIN32) || defined(MSWINCE)
+# define LOG_FILE _T("gc.log")
+
+ HANDLE GC_stdout = 0;
+
+ void GC_deinit()
+ {
+ if (GC_is_initialized) {
+ DeleteCriticalSection(&GC_write_cs);
+ }
+ }
+
+ int GC_write(buf, len)
+ GC_CONST char * buf;
+ size_t len;
+ {
+ BOOL tmp;
+ DWORD written;
+ if (len == 0)
+ return 0;
+ EnterCriticalSection(&GC_write_cs);
+ if (GC_stdout == INVALID_HANDLE_VALUE) {
+ return -1;
+ } else if (GC_stdout == 0) {
+ GC_stdout = CreateFile(LOG_FILE, GENERIC_WRITE,
+ FILE_SHARE_READ | FILE_SHARE_WRITE,
+ NULL, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH,
+ NULL);
+ if (GC_stdout == INVALID_HANDLE_VALUE) ABORT("Open of log file failed");
+ }
+ tmp = WriteFile(GC_stdout, buf, len, &written, NULL);
+ if (!tmp)
+ DebugBreak();
+ LeaveCriticalSection(&GC_write_cs);
+ return tmp ? (int)written : -1;
+ }
+
+#endif
+
+#if defined(OS2) || defined(MACOS)
+FILE * GC_stdout = NULL;
+FILE * GC_stderr = NULL;
+int GC_tmp; /* Should really be local ... */
+
+ void GC_set_files()
+ {
+ if (GC_stdout == NULL) {
+ GC_stdout = stdout;
+ }
+ if (GC_stderr == NULL) {
+ GC_stderr = stderr;
+ }
+ }
+#endif
+
+#if !defined(OS2) && !defined(MACOS) && !defined(MSWIN32) && !defined(MSWINCE)
+ int GC_stdout = 1;
+ int GC_stderr = 2;
+# if !defined(AMIGA)
+# include <unistd.h>
+# endif
+#endif
+
+#if !defined(MSWIN32) && !defined(MSWINCE) && !defined(OS2) \
+ && !defined(MACOS) && !defined(ECOS) && !defined(NOSYS)
+int GC_write(fd, buf, len)
+int fd;
+GC_CONST char *buf;
+size_t len;
+{
+ register int bytes_written = 0;
+ register int result;
+
+ while (bytes_written < len) {
+# ifdef GC_SOLARIS_THREADS
+ result = syscall(SYS_write, fd, buf + bytes_written,
+ len - bytes_written);
+# else
+ result = write(fd, buf + bytes_written, len - bytes_written);
+# endif
+ if (-1 == result) return(result);
+ bytes_written += result;
+ }
+ return(bytes_written);
+}
+#endif /* UN*X */
+
+#ifdef ECOS
+int GC_write(fd, buf, len)
+{
+ _Jv_diag_write (buf, len);
+ return len;
+}
+#endif
+
+#ifdef NOSYS
+int GC_write(fd, buf, len)
+{
+ /* No writing. */
+ return len;
+}
+#endif
+
+
+#if defined(MSWIN32) || defined(MSWINCE)
+# define WRITE(f, buf, len) GC_write(buf, len)
+#else
+# if defined(OS2) || defined(MACOS)
+# define WRITE(f, buf, len) (GC_set_files(), \
+ GC_tmp = fwrite((buf), 1, (len), (f)), \
+ fflush(f), GC_tmp)
+# else
+# define WRITE(f, buf, len) GC_write((f), (buf), (len))
+# endif
+#endif
+
+/* A version of printf that is unlikely to call malloc, and is thus safer */
+/* to call from the collector in case malloc has been bound to GC_malloc. */
+/* Assumes that no more than 1023 characters are written at once. */
+/* Assumes that all arguments have been converted to something of the */
+/* same size as long, and that the format conversions expect something */
+/* of that size. */
+void GC_printf(format, a, b, c, d, e, f)
+GC_CONST char * format;
+long a, b, c, d, e, f;
+{
+ char buf[1025];
+
+ if (GC_quiet) return;
+ buf[1024] = 0x15;
+ (void) sprintf(buf, format, a, b, c, d, e, f);
+ if (buf[1024] != 0x15) ABORT("GC_printf clobbered stack");
+ if (WRITE(GC_stdout, buf, strlen(buf)) < 0) ABORT("write to stdout failed");
+}
+
+void GC_err_printf(format, a, b, c, d, e, f)
+GC_CONST char * format;
+long a, b, c, d, e, f;
+{
+ char buf[1025];
+
+ buf[1024] = 0x15;
+ (void) sprintf(buf, format, a, b, c, d, e, f);
+ if (buf[1024] != 0x15) ABORT("GC_err_printf clobbered stack");
+ if (WRITE(GC_stderr, buf, strlen(buf)) < 0) ABORT("write to stderr failed");
+}
+
+void GC_err_puts(s)
+GC_CONST char *s;
+{
+ if (WRITE(GC_stderr, s, strlen(s)) < 0) ABORT("write to stderr failed");
+}
+
+#if defined(LINUX) && !defined(SMALL_CONFIG)
+void GC_err_write(buf, len)
+GC_CONST char *buf;
+size_t len;
+{
+ if (WRITE(GC_stderr, buf, len) < 0) ABORT("write to stderr failed");
+}
+#endif
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_default_warn_proc(char *msg, GC_word arg)
+# else
+ void GC_default_warn_proc(msg, arg)
+ char *msg;
+ GC_word arg;
+# endif
+{
+ GC_err_printf1(msg, (unsigned long)arg);
+}
+
+GC_warn_proc GC_current_warn_proc = GC_default_warn_proc;
+
+# if defined(__STDC__) || defined(__cplusplus)
+ GC_warn_proc GC_set_warn_proc(GC_warn_proc p)
+# else
+ GC_warn_proc GC_set_warn_proc(p)
+ GC_warn_proc p;
+# endif
+{
+ GC_warn_proc result;
+
+ LOCK();
+ result = GC_current_warn_proc;
+ GC_current_warn_proc = p;
+ UNLOCK();
+ return(result);
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ GC_word GC_set_free_space_divisor (GC_word value)
+# else
+ GC_word GC_set_free_space_divisor (value)
+ GC_word value;
+# endif
+{
+ GC_word old = GC_free_space_divisor;
+ GC_free_space_divisor = value;
+ return old;
+}
+
+#ifndef PCR
+void GC_abort(msg)
+GC_CONST char * msg;
+{
+# if defined(MSWIN32)
+ (void) MessageBoxA(NULL, msg, "Fatal error in gc", MB_ICONERROR|MB_OK);
+ DebugBreak();
+# else
+ GC_err_printf1("%s\n", msg);
+# endif
+ if (GETENV("GC_LOOP_ON_ABORT") != NULL) {
+ /* In many cases it's easier to debug a running process. */
+ /* It's arguably nicer to sleep, but that makes it harder */
+ /* to look at the thread if the debugger doesn't know much */
+ /* about threads. */
+ for(;;) {}
+ }
+# ifdef MSWIN32
+ DebugBreak();
+# else
+ (void) abort();
+# endif
+}
+#endif
+
+void GC_enable()
+{
+ LOCK();
+ GC_dont_gc--;
+ UNLOCK();
+}
+
+void GC_disable()
+{
+ LOCK();
+ GC_dont_gc++;
+ UNLOCK();
+}
+
+#if !defined(NO_DEBUGGING)
+
+void GC_dump()
+{
+ GC_printf0("***Static roots:\n");
+ GC_print_static_roots();
+ GC_printf0("\n***Heap sections:\n");
+ GC_print_heap_sects();
+ GC_printf0("\n***Free blocks:\n");
+ GC_print_hblkfreelist();
+ GC_printf0("\n***Blocks in use:\n");
+ GC_print_block_list();
+ GC_printf0("\n***Finalization statistics:\n");
+ GC_print_finalization_stats();
+}
+
+#endif /* NO_DEBUGGING */
--- /dev/null
+#! /bin/sh
+# Common stub for a few missing GNU programs while installing.
+# Copyright 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
+# Originally by Fran,cois Pinard <pinard@iro.umontreal.ca>, 1996.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+if test $# -eq 0; then
+ echo 1>&2 "Try \`$0 --help' for more information"
+ exit 1
+fi
+
+run=:
+
+# In the cases where this matters, `missing' is being run in the
+# srcdir already.
+if test -f configure.ac; then
+ configure_ac=configure.ac
+else
+ configure_ac=configure.in
+fi
+
+case "$1" in
+--run)
+ # Try to run requested program, and just exit if it succeeds.
+ run=
+ shift
+ "$@" && exit 0
+ ;;
+esac
+
+# If it does not exist, or fails to run (possibly an outdated version),
+# try to emulate it.
+case "$1" in
+
+ -h|--h|--he|--hel|--help)
+ echo "\
+$0 [OPTION]... PROGRAM [ARGUMENT]...
+
+Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an
+error status if there is no known handling for PROGRAM.
+
+Options:
+ -h, --help display this help and exit
+ -v, --version output version information and exit
+ --run try to run the given command, and emulate it if it fails
+
+Supported PROGRAM values:
+ aclocal touch file \`aclocal.m4'
+ autoconf touch file \`configure'
+ autoheader touch file \`config.h.in'
+ automake touch all \`Makefile.in' files
+ bison create \`y.tab.[ch]', if possible, from existing .[ch]
+ flex create \`lex.yy.c', if possible, from existing .c
+ help2man touch the output file
+ lex create \`lex.yy.c', if possible, from existing .c
+ makeinfo touch the output file
+ tar try tar, gnutar, gtar, then tar without non-portable flags
+ yacc create \`y.tab.[ch]', if possible, from existing .[ch]"
+ ;;
+
+ -v|--v|--ve|--ver|--vers|--versi|--versio|--version)
+ echo "missing 0.4 - GNU automake"
+ ;;
+
+ -*)
+ echo 1>&2 "$0: Unknown \`$1' option"
+ echo 1>&2 "Try \`$0 --help' for more information"
+ exit 1
+ ;;
+
+ aclocal*)
+ if test -z "$run" && ($1 --version) > /dev/null 2>&1; then
+ # We have it, but it failed.
+ exit 1
+ fi
+
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified \`acinclude.m4' or \`${configure_ac}'. You might want
+ to install the \`Automake' and \`Perl' packages. Grab them from
+ any GNU archive site."
+ touch aclocal.m4
+ ;;
+
+ autoconf)
+ if test -z "$run" && ($1 --version) > /dev/null 2>&1; then
+ # We have it, but it failed.
+ exit 1
+ fi
+
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified \`${configure_ac}'. You might want to install the
+ \`Autoconf' and \`GNU m4' packages. Grab them from any GNU
+ archive site."
+ touch configure
+ ;;
+
+ autoheader)
+ if test -z "$run" && ($1 --version) > /dev/null 2>&1; then
+ # We have it, but it failed.
+ exit 1
+ fi
+
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified \`acconfig.h' or \`${configure_ac}'. You might want
+ to install the \`Autoconf' and \`GNU m4' packages. Grab them
+ from any GNU archive site."
+ files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' ${configure_ac}`
+ test -z "$files" && files="config.h"
+ touch_files=
+ for f in $files; do
+ case "$f" in
+ *:*) touch_files="$touch_files "`echo "$f" |
+ sed -e 's/^[^:]*://' -e 's/:.*//'`;;
+ *) touch_files="$touch_files $f.in";;
+ esac
+ done
+ touch $touch_files
+ ;;
+
+ automake*)
+ if test -z "$run" && ($1 --version) > /dev/null 2>&1; then
+ # We have it, but it failed.
+ exit 1
+ fi
+
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified \`Makefile.am', \`acinclude.m4' or \`${configure_ac}'.
+ You might want to install the \`Automake' and \`Perl' packages.
+ Grab them from any GNU archive site."
+ find . -type f -name Makefile.am -print |
+ sed 's/\.am$/.in/' |
+ while read f; do touch "$f"; done
+ ;;
+
+ autom4te)
+ if test -z "$run" && ($1 --version) > /dev/null 2>&1; then
+ # We have it, but it failed.
+ exit 1
+ fi
+
+ echo 1>&2 "\
+WARNING: \`$1' is needed, and you do not seem to have it handy on your
+ system. You might have modified some files without having the
+ proper tools for further handling them.
+ You can get \`$1Help2man' as part of \`Autoconf' from any GNU
+ archive site."
+
+ file=`echo "$*" | sed -n 's/.*--output[ =]*\([^ ]*\).*/\1/p'`
+ test -z "$file" && file=`echo "$*" | sed -n 's/.*-o[ ]*\([^ ]*\).*/\1/p'`
+ if test -f "$file"; then
+ touch $file
+ else
+ test -z "$file" || exec >$file
+ echo "#! /bin/sh"
+ echo "# Created by GNU Automake missing as a replacement of"
+ echo "# $ $@"
+ echo "exit 0"
+ chmod +x $file
+ exit 1
+ fi
+ ;;
+
+ bison|yacc)
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified a \`.y' file. You may need the \`Bison' package
+ in order for those modifications to take effect. You can get
+ \`Bison' from any GNU archive site."
+ rm -f y.tab.c y.tab.h
+ if [ $# -ne 1 ]; then
+ eval LASTARG="\${$#}"
+ case "$LASTARG" in
+ *.y)
+ SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'`
+ if [ -f "$SRCFILE" ]; then
+ cp "$SRCFILE" y.tab.c
+ fi
+ SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'`
+ if [ -f "$SRCFILE" ]; then
+ cp "$SRCFILE" y.tab.h
+ fi
+ ;;
+ esac
+ fi
+ if [ ! -f y.tab.h ]; then
+ echo >y.tab.h
+ fi
+ if [ ! -f y.tab.c ]; then
+ echo 'main() { return 0; }' >y.tab.c
+ fi
+ ;;
+
+ lex|flex)
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified a \`.l' file. You may need the \`Flex' package
+ in order for those modifications to take effect. You can get
+ \`Flex' from any GNU archive site."
+ rm -f lex.yy.c
+ if [ $# -ne 1 ]; then
+ eval LASTARG="\${$#}"
+ case "$LASTARG" in
+ *.l)
+ SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'`
+ if [ -f "$SRCFILE" ]; then
+ cp "$SRCFILE" lex.yy.c
+ fi
+ ;;
+ esac
+ fi
+ if [ ! -f lex.yy.c ]; then
+ echo 'main() { return 0; }' >lex.yy.c
+ fi
+ ;;
+
+ help2man)
+ if test -z "$run" && ($1 --version) > /dev/null 2>&1; then
+ # We have it, but it failed.
+ exit 1
+ fi
+
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified a dependency of a manual page. You may need the
+ \`Help2man' package in order for those modifications to take
+ effect. You can get \`Help2man' from any GNU archive site."
+
+ file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'`
+ if test -z "$file"; then
+ file=`echo "$*" | sed -n 's/.*--output=\([^ ]*\).*/\1/p'`
+ fi
+ if [ -f "$file" ]; then
+ touch $file
+ else
+ test -z "$file" || exec >$file
+ echo ".ab help2man is required to generate this page"
+ exit 1
+ fi
+ ;;
+
+ makeinfo)
+ if test -z "$run" && (makeinfo --version) > /dev/null 2>&1; then
+ # We have makeinfo, but it failed.
+ exit 1
+ fi
+
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified a \`.texi' or \`.texinfo' file, or any other file
+ indirectly affecting the aspect of the manual. The spurious
+ call might also be the consequence of using a buggy \`make' (AIX,
+ DU, IRIX). You might want to install the \`Texinfo' package or
+ the \`GNU make' package. Grab either from any GNU archive site."
+ file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'`
+ if test -z "$file"; then
+ file=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'`
+ file=`sed -n '/^@setfilename/ { s/.* \([^ ]*\) *$/\1/; p; q; }' $file`
+ fi
+ touch $file
+ ;;
+
+ tar)
+ shift
+ if test -n "$run"; then
+ echo 1>&2 "ERROR: \`tar' requires --run"
+ exit 1
+ fi
+
+ # We have already tried tar in the generic part.
+ # Look for gnutar/gtar before invocation to avoid ugly error
+ # messages.
+ if (gnutar --version > /dev/null 2>&1); then
+ gnutar ${1+"$@"} && exit 0
+ fi
+ if (gtar --version > /dev/null 2>&1); then
+ gtar ${1+"$@"} && exit 0
+ fi
+ firstarg="$1"
+ if shift; then
+ case "$firstarg" in
+ *o*)
+ firstarg=`echo "$firstarg" | sed s/o//`
+ tar "$firstarg" ${1+"$@"} && exit 0
+ ;;
+ esac
+ case "$firstarg" in
+ *h*)
+ firstarg=`echo "$firstarg" | sed s/h//`
+ tar "$firstarg" ${1+"$@"} && exit 0
+ ;;
+ esac
+ fi
+
+ echo 1>&2 "\
+WARNING: I can't seem to be able to run \`tar' with the given arguments.
+ You may want to install GNU tar or Free paxutils, or check the
+ command line arguments."
+ exit 1
+ ;;
+
+ *)
+ echo 1>&2 "\
+WARNING: \`$1' is needed, and you do not seem to have it handy on your
+ system. You might have modified some files without having the
+ proper tools for further handling them. Check the \`README' file,
+ it often tells you about the needed prerequirements for installing
+ this package. You may also peek at any GNU archive site, in case
+ some other package would contain this missing \`$1' program."
+ exit 1
+ ;;
+esac
+
+exit 0
--- /dev/null
+#! /bin/sh
+# mkinstalldirs --- make directory hierarchy
+# Author: Noah Friedman <friedman@prep.ai.mit.edu>
+# Created: 1993-05-16
+# Public domain
+
+# $Id: mkinstalldirs,v 1.13 1999/01/05 03:18:55 bje Exp $
+
+errstatus=0
+dirmode=""
+
+usage="\
+Usage: mkinstalldirs [-h] [--help] [-m mode] dir ..."
+
+# process command line arguments
+while test $# -gt 0 ; do
+ case "${1}" in
+ -h | --help | --h* ) # -h for help
+ echo "${usage}" 1>&2; exit 0 ;;
+ -m ) # -m PERM arg
+ shift
+ test $# -eq 0 && { echo "${usage}" 1>&2; exit 1; }
+ dirmode="${1}"
+ shift ;;
+ -- ) shift; break ;; # stop option processing
+ -* ) echo "${usage}" 1>&2; exit 1 ;; # unknown option
+ * ) break ;; # first non-opt arg
+ esac
+done
+
+for file
+do
+ if test -d "$file"; then
+ shift
+ else
+ break
+ fi
+done
+
+case $# in
+0) exit 0 ;;
+esac
+
+case $dirmode in
+'')
+ if mkdir -p -- . 2>/dev/null; then
+ echo "mkdir -p -- $*"
+ exec mkdir -p -- "$@"
+ fi ;;
+*)
+ if mkdir -m "$dirmode" -p -- . 2>/dev/null; then
+ echo "mkdir -m $dirmode -p -- $*"
+ exec mkdir -m "$dirmode" -p -- "$@"
+ fi ;;
+esac
+
+for file
+do
+ set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
+ shift
+
+ pathcomp=
+ for d
+ do
+ pathcomp="$pathcomp$d"
+ case "$pathcomp" in
+ -* ) pathcomp=./$pathcomp ;;
+ esac
+
+ if test ! -d "$pathcomp"; then
+ echo "mkdir $pathcomp"
+
+ mkdir "$pathcomp" || lasterr=$?
+
+ if test ! -d "$pathcomp"; then
+ errstatus=$lasterr
+ else
+ if test ! -z "$dirmode"; then
+ echo "chmod $dirmode $pathcomp"
+
+ lasterr=""
+ chmod "$dirmode" "$pathcomp" || lasterr=$?
+
+ if test ! -z "$lasterr"; then
+ errstatus=$lasterr
+ fi
+ fi
+ fi
+ fi
+
+ pathcomp="$pathcomp/"
+ done
+done
+
+exit $errstatus
+
+# Local Variables:
+# mode: shell-script
+# sh-indentation: 3
+# End:
+# mkinstalldirs ends here
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ * This file contains the functions:
+ * ptr_t GC_build_flXXX(h, old_fl)
+ * void GC_new_hblk(n)
+ */
+/* Boehm, May 19, 1994 2:09 pm PDT */
+
+
+# include <stdio.h>
+# include "private/gc_priv.h"
+
+#ifndef SMALL_CONFIG
+/*
+ * Build a free list for size 1 objects inside hblk h. Set the last link to
+ * be ofl. Return a pointer tpo the first free list entry.
+ */
+ptr_t GC_build_fl1(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+ register word * p = h -> hb_body;
+ register word * lim = (word *)(h + 1);
+
+ p[0] = (word)ofl;
+ p[1] = (word)(p);
+ p[2] = (word)(p+1);
+ p[3] = (word)(p+2);
+ p += 4;
+ for (; p < lim; p += 4) {
+ p[0] = (word)(p-1);
+ p[1] = (word)(p);
+ p[2] = (word)(p+1);
+ p[3] = (word)(p+2);
+ };
+ return((ptr_t)(p-1));
+}
+
+/* The same for size 2 cleared objects */
+ptr_t GC_build_fl_clear2(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+ register word * p = h -> hb_body;
+ register word * lim = (word *)(h + 1);
+
+ p[0] = (word)ofl;
+ p[1] = 0;
+ p[2] = (word)p;
+ p[3] = 0;
+ p += 4;
+ for (; p < lim; p += 4) {
+ p[0] = (word)(p-2);
+ p[1] = 0;
+ p[2] = (word)p;
+ p[3] = 0;
+ };
+ return((ptr_t)(p-2));
+}
+
+/* The same for size 3 cleared objects */
+ptr_t GC_build_fl_clear3(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+ register word * p = h -> hb_body;
+ register word * lim = (word *)(h + 1) - 2;
+
+ p[0] = (word)ofl;
+ p[1] = 0;
+ p[2] = 0;
+ p += 3;
+ for (; p < lim; p += 3) {
+ p[0] = (word)(p-3);
+ p[1] = 0;
+ p[2] = 0;
+ };
+ return((ptr_t)(p-3));
+}
+
+/* The same for size 4 cleared objects */
+ptr_t GC_build_fl_clear4(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+ register word * p = h -> hb_body;
+ register word * lim = (word *)(h + 1);
+
+ p[0] = (word)ofl;
+ p[1] = 0;
+ p[2] = 0;
+ p[3] = 0;
+ p += 4;
+ for (; p < lim; p += 4) {
+ PREFETCH_FOR_WRITE(p+64);
+ p[0] = (word)(p-4);
+ p[1] = 0;
+ CLEAR_DOUBLE(p+2);
+ };
+ return((ptr_t)(p-4));
+}
+
+/* The same for size 2 uncleared objects */
+ptr_t GC_build_fl2(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+ register word * p = h -> hb_body;
+ register word * lim = (word *)(h + 1);
+
+ p[0] = (word)ofl;
+ p[2] = (word)p;
+ p += 4;
+ for (; p < lim; p += 4) {
+ p[0] = (word)(p-2);
+ p[2] = (word)p;
+ };
+ return((ptr_t)(p-2));
+}
+
+/* The same for size 4 uncleared objects */
+ptr_t GC_build_fl4(h, ofl)
+struct hblk *h;
+ptr_t ofl;
+{
+ register word * p = h -> hb_body;
+ register word * lim = (word *)(h + 1);
+
+ p[0] = (word)ofl;
+ p[4] = (word)p;
+ p += 8;
+ for (; p < lim; p += 8) {
+ PREFETCH_FOR_WRITE(p+64);
+ p[0] = (word)(p-4);
+ p[4] = (word)p;
+ };
+ return((ptr_t)(p-4));
+}
+
+#endif /* !SMALL_CONFIG */
+
+
+/* Build a free list for objects of size sz inside heap block h. */
+/* Clear objects inside h if clear is set. Add list to the end of */
+/* the free list we build. Return the new free list. */
+/* This could be called without the main GC lock, if we ensure that */
+/* there is no concurrent collection which might reclaim objects that */
+/* we have not yet allocated. */
+ptr_t GC_build_fl(h, sz, clear, list)
+struct hblk *h;
+word sz;
+GC_bool clear;
+ptr_t list;
+{
+ word *p, *prev;
+ word *last_object; /* points to last object in new hblk */
+
+ /* Do a few prefetches here, just because its cheap. */
+ /* If we were more serious about it, these should go inside */
+ /* the loops. But write prefetches usually don't seem to */
+ /* matter much. */
+ PREFETCH_FOR_WRITE((char *)h);
+ PREFETCH_FOR_WRITE((char *)h + 128);
+ PREFETCH_FOR_WRITE((char *)h + 256);
+ PREFETCH_FOR_WRITE((char *)h + 378);
+ /* Handle small objects sizes more efficiently. For larger objects */
+ /* the difference is less significant. */
+# ifndef SMALL_CONFIG
+ switch (sz) {
+ case 1: return GC_build_fl1(h, list);
+ case 2: if (clear) {
+ return GC_build_fl_clear2(h, list);
+ } else {
+ return GC_build_fl2(h, list);
+ }
+ case 3: if (clear) {
+ return GC_build_fl_clear3(h, list);
+ } else {
+ /* It's messy to do better than the default here. */
+ break;
+ }
+ case 4: if (clear) {
+ return GC_build_fl_clear4(h, list);
+ } else {
+ return GC_build_fl4(h, list);
+ }
+ default:
+ break;
+ }
+# endif /* !SMALL_CONFIG */
+
+ /* Clear the page if necessary. */
+ if (clear) BZERO(h, HBLKSIZE);
+
+ /* Add objects to free list */
+ p = &(h -> hb_body[sz]); /* second object in *h */
+ prev = &(h -> hb_body[0]); /* One object behind p */
+ last_object = (word *)((char *)h + HBLKSIZE);
+ last_object -= sz;
+ /* Last place for last object to start */
+
+ /* make a list of all objects in *h with head as last object */
+ while (p <= last_object) {
+ /* current object's link points to last object */
+ obj_link(p) = (ptr_t)prev;
+ prev = p;
+ p += sz;
+ }
+ p -= sz; /* p now points to last object */
+
+ /*
+ * put p (which is now head of list of objects in *h) as first
+ * pointer in the appropriate free list for this size.
+ */
+ obj_link(h -> hb_body) = list;
+ return ((ptr_t)p);
+}
+
+/*
+ * Allocate a new heapblock for small objects of size n.
+ * Add all of the heapblock's objects to the free list for objects
+ * of that size.
+ * Set all mark bits if objects are uncollectable.
+ * Will fail to do anything if we are out of memory.
+ */
+void GC_new_hblk(sz, kind)
+register word sz;
+int kind;
+{
+ register struct hblk *h; /* the new heap block */
+ register GC_bool clear = GC_obj_kinds[kind].ok_init;
+
+# ifdef PRINTSTATS
+ if ((sizeof (struct hblk)) > HBLKSIZE) {
+ ABORT("HBLK SZ inconsistency");
+ }
+# endif
+ if (GC_debugging_started) clear = TRUE;
+
+ /* Allocate a new heap block */
+ h = GC_allochblk(sz, kind, 0);
+ if (h == 0) return;
+
+ /* Mark all objects if appropriate. */
+ if (IS_UNCOLLECTABLE(kind)) GC_set_hdr_marks(HDR(h));
+
+ /* Build the free list */
+ GC_obj_kinds[kind].ok_freelist[sz] =
+ GC_build_fl(h, sz, clear, GC_obj_kinds[kind].ok_freelist[sz]);
+}
+
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991, 1992 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1999-2001 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/* Routines for maintaining maps describing heap block
+ * layouts for various object sizes. Allows fast pointer validity checks
+ * and fast location of object start locations on machines (such as SPARC)
+ * with slow division.
+ */
+
+# include "private/gc_priv.h"
+
+map_entry_type * GC_invalid_map = 0;
+
+/* Invalidate the object map associated with a block. Free blocks */
+/* are identified by invalid maps. */
+void GC_invalidate_map(hhdr)
+hdr *hhdr;
+{
+ register int displ;
+
+ if (GC_invalid_map == 0) {
+ GC_invalid_map = (map_entry_type *)GC_scratch_alloc(MAP_SIZE);
+ if (GC_invalid_map == 0) {
+ GC_err_printf0(
+ "Cant initialize GC_invalid_map: insufficient memory\n");
+ EXIT();
+ }
+ for (displ = 0; displ < HBLKSIZE; displ++) {
+ MAP_ENTRY(GC_invalid_map, displ) = OBJ_INVALID;
+ }
+ }
+ hhdr -> hb_map = GC_invalid_map;
+}
+
+/* Consider pointers that are offset bytes displaced from the beginning */
+/* of an object to be valid. */
+
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_register_displacement(GC_word offset)
+# else
+ void GC_register_displacement(offset)
+ GC_word offset;
+# endif
+{
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ GC_register_displacement_inner(offset);
+ UNLOCK();
+ ENABLE_SIGNALS();
+}
+
+void GC_register_displacement_inner(offset)
+word offset;
+{
+ register unsigned i;
+ word map_entry = BYTES_TO_WORDS(offset);
+
+ if (offset >= VALID_OFFSET_SZ) {
+ ABORT("Bad argument to GC_register_displacement");
+ }
+ if (map_entry > MAX_OFFSET) map_entry = OFFSET_TOO_BIG;
+ if (!GC_valid_offsets[offset]) {
+ GC_valid_offsets[offset] = TRUE;
+ GC_modws_valid_offsets[offset % sizeof(word)] = TRUE;
+ if (!GC_all_interior_pointers) {
+ for (i = 0; i <= MAXOBJSZ; i++) {
+ if (GC_obj_map[i] != 0) {
+ if (i == 0) {
+ GC_obj_map[i][offset] = (map_entry_type)map_entry;
+ } else {
+ register unsigned j;
+ register unsigned lb = WORDS_TO_BYTES(i);
+
+ if (offset < lb) {
+ for (j = offset; j < HBLKSIZE; j += lb) {
+ GC_obj_map[i][j] = (map_entry_type)map_entry;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
+
+/* Add a heap block map for objects of size sz to obj_map. */
+/* Return FALSE on failure. */
+GC_bool GC_add_map_entry(sz)
+word sz;
+{
+ register unsigned obj_start;
+ register unsigned displ;
+ register map_entry_type * new_map;
+ word map_entry;
+
+ if (sz > MAXOBJSZ) sz = 0;
+ if (GC_obj_map[sz] != 0) {
+ return(TRUE);
+ }
+ new_map = (map_entry_type *)GC_scratch_alloc(MAP_SIZE);
+ if (new_map == 0) return(FALSE);
+# ifdef PRINTSTATS
+ GC_printf1("Adding block map for size %lu\n", (unsigned long)sz);
+# endif
+ for (displ = 0; displ < HBLKSIZE; displ++) {
+ MAP_ENTRY(new_map,displ) = OBJ_INVALID;
+ }
+ if (sz == 0) {
+ for(displ = 0; displ <= HBLKSIZE; displ++) {
+ if (OFFSET_VALID(displ)) {
+ map_entry = BYTES_TO_WORDS(displ);
+ if (map_entry > MAX_OFFSET) map_entry = OFFSET_TOO_BIG;
+ MAP_ENTRY(new_map,displ) = (map_entry_type)map_entry;
+ }
+ }
+ } else {
+ for (obj_start = 0;
+ obj_start + WORDS_TO_BYTES(sz) <= HBLKSIZE;
+ obj_start += WORDS_TO_BYTES(sz)) {
+ for (displ = 0; displ < WORDS_TO_BYTES(sz); displ++) {
+ if (OFFSET_VALID(displ)) {
+ map_entry = BYTES_TO_WORDS(displ);
+ if (map_entry > MAX_OFFSET) map_entry = OFFSET_TOO_BIG;
+ MAP_ENTRY(new_map, obj_start + displ) =
+ (map_entry_type)map_entry;
+ }
+ }
+ }
+ }
+ GC_obj_map[sz] = new_map;
+ return(TRUE);
+}
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+# include "private/gc_priv.h"
+
+# if defined(LINUX) && !defined(POWERPC)
+# include <linux/version.h>
+# if (LINUX_VERSION_CODE <= 0x10400)
+ /* Ugly hack to get struct sigcontext_struct definition. Required */
+ /* for some early 1.3.X releases. Will hopefully go away soon. */
+ /* in some later Linux releases, asm/sigcontext.h may have to */
+ /* be included instead. */
+# define __KERNEL__
+# include <asm/signal.h>
+# undef __KERNEL__
+# else
+ /* Kernels prior to 2.1.1 defined struct sigcontext_struct instead of */
+ /* struct sigcontext. libc6 (glibc2) uses "struct sigcontext" in */
+ /* prototypes, so we have to include the top-level sigcontext.h to */
+ /* make sure the former gets defined to be the latter if appropriate. */
+# include <features.h>
+# if 2 <= __GLIBC__
+# if 2 == __GLIBC__ && 0 == __GLIBC_MINOR__
+ /* glibc 2.1 no longer has sigcontext.h. But signal.h */
+ /* has the right declaration for glibc 2.1. */
+# include <sigcontext.h>
+# endif /* 0 == __GLIBC_MINOR__ */
+# else /* not 2 <= __GLIBC__ */
+ /* libc5 doesn't have <sigcontext.h>: go directly with the kernel */
+ /* one. Check LINUX_VERSION_CODE to see which we should reference. */
+# include <asm/sigcontext.h>
+# endif /* 2 <= __GLIBC__ */
+# endif
+# endif
+# if !defined(OS2) && !defined(PCR) && !defined(AMIGA) && !defined(MACOS) \
+ && !defined(MSWINCE)
+# include <sys/types.h>
+# if !defined(MSWIN32) && !defined(SUNOS4)
+# include <unistd.h>
+# endif
+# endif
+
+# include <stdio.h>
+# if defined(MSWINCE)
+# define SIGSEGV 0 /* value is irrelevant */
+# else
+# include <signal.h>
+# endif
+
+/* Blatantly OS dependent routines, except for those that are related */
+/* to dynamic loading. */
+
+# if defined(HEURISTIC2) || defined(SEARCH_FOR_DATA_START)
+# define NEED_FIND_LIMIT
+# endif
+
+# if !defined(STACKBOTTOM) && defined(HEURISTIC2)
+# define NEED_FIND_LIMIT
+# endif
+
+# if (defined(SUNOS4) && defined(DYNAMIC_LOADING)) && !defined(PCR)
+# define NEED_FIND_LIMIT
+# endif
+
+# if (defined(SVR4) || defined(AUX) || defined(DGUX) \
+ || (defined(LINUX) && defined(SPARC))) && !defined(PCR)
+# define NEED_FIND_LIMIT
+# endif
+
+#if defined(FREEBSD) && defined(I386)
+# include <machine/trap.h>
+# if !defined(PCR)
+# define NEED_FIND_LIMIT
+# endif
+#endif
+
+#ifdef NEED_FIND_LIMIT
+# include <setjmp.h>
+#endif
+
+#ifdef AMIGA
+# define GC_AMIGA_DEF
+# include "AmigaOS.c"
+# undef GC_AMIGA_DEF
+#endif
+
+#if defined(MSWIN32) || defined(MSWINCE)
+# define WIN32_LEAN_AND_MEAN
+# define NOSERVICE
+# include <windows.h>
+#endif
+
+#ifdef MACOS
+# include <Processes.h>
+#endif
+
+#ifdef IRIX5
+# include <sys/uio.h>
+# include <malloc.h> /* for locking */
+#endif
+#ifdef USE_MMAP
+# include <sys/types.h>
+# include <sys/mman.h>
+# include <sys/stat.h>
+#endif
+
+#ifdef UNIX_LIKE
+# include <fcntl.h>
+#endif
+
+#if defined(SUNOS5SIGS) || defined (HURD) || defined(LINUX)
+# ifdef SUNOS5SIGS
+# include <sys/siginfo.h>
+# endif
+# undef setjmp
+# undef longjmp
+# define setjmp(env) sigsetjmp(env, 1)
+# define longjmp(env, val) siglongjmp(env, val)
+# define jmp_buf sigjmp_buf
+#endif
+
+#ifdef DJGPP
+ /* Apparently necessary for djgpp 2.01. May cause problems with */
+ /* other versions. */
+ typedef long unsigned int caddr_t;
+#endif
+
+#ifdef PCR
+# include "il/PCR_IL.h"
+# include "th/PCR_ThCtl.h"
+# include "mm/PCR_MM.h"
+#endif
+
+#if !defined(NO_EXECUTE_PERMISSION)
+# define OPT_PROT_EXEC PROT_EXEC
+#else
+# define OPT_PROT_EXEC 0
+#endif
+
+#if defined(SEARCH_FOR_DATA_START)
+ /* The I386 case can be handled without a search. The Alpha case */
+ /* used to be handled differently as well, but the rules changed */
+ /* for recent Linux versions. This seems to be the easiest way to */
+ /* cover all versions. */
+
+# ifdef LINUX
+ /* Some Linux distributions arrange to define __data_start. Some */
+ /* define data_start as a weak symbol. The latter is technically */
+ /* broken, since the user program may define data_start, in which */
+ /* case we lose. Nonetheless, we try both, prefering __data_start. */
+ /* We assume gcc-compatible pragmas. */
+# pragma weak __data_start
+ extern int __data_start[];
+# pragma weak data_start
+ extern int data_start[];
+# endif /* LINUX */
+ extern int _end[];
+
+ ptr_t GC_data_start;
+
+ void GC_init_linux_data_start()
+ {
+ extern ptr_t GC_find_limit();
+
+# ifdef LINUX
+ /* Try the easy approaches first: */
+ if ((ptr_t)__data_start != 0) {
+ GC_data_start = (ptr_t)(__data_start);
+ return;
+ }
+ if ((ptr_t)data_start != 0) {
+ GC_data_start = (ptr_t)(data_start);
+ return;
+ }
+# endif /* LINUX */
+ GC_data_start = GC_find_limit((ptr_t)(_end), FALSE);
+ }
+#endif
+
+# ifdef ECOS
+
+# ifndef ECOS_GC_MEMORY_SIZE
+# define ECOS_GC_MEMORY_SIZE (448 * 1024)
+# endif /* ECOS_GC_MEMORY_SIZE */
+
+// setjmp() function, as described in ANSI para 7.6.1.1
+#define setjmp( __env__ ) hal_setjmp( __env__ )
+
+// FIXME: This is a simple way of allocating memory which is
+// compatible with ECOS early releases. Later releases use a more
+// sophisticated means of allocating memory than this simple static
+// allocator, but this method is at least bound to work.
+static char memory[ECOS_GC_MEMORY_SIZE];
+static char *brk = memory;
+
+static void *tiny_sbrk(ptrdiff_t increment)
+{
+ void *p = brk;
+
+ brk += increment;
+
+ if (brk > memory + sizeof memory)
+ {
+ brk -= increment;
+ return NULL;
+ }
+
+ return p;
+}
+#define sbrk tiny_sbrk
+# endif /* ECOS */
+
+#if (defined(NETBSD) || defined(OPENBSD)) && defined(__ELF__)
+ ptr_t GC_data_start;
+
+ void GC_init_netbsd_elf()
+ {
+ extern ptr_t GC_find_limit();
+ extern char **environ;
+ /* This may need to be environ, without the underscore, for */
+ /* some versions. */
+ GC_data_start = GC_find_limit((ptr_t)&environ, FALSE);
+ }
+#endif
+
+# ifdef OS2
+
+# include <stddef.h>
+
+# if !defined(__IBMC__) && !defined(__WATCOMC__) /* e.g. EMX */
+
+struct exe_hdr {
+ unsigned short magic_number;
+ unsigned short padding[29];
+ long new_exe_offset;
+};
+
+#define E_MAGIC(x) (x).magic_number
+#define EMAGIC 0x5A4D
+#define E_LFANEW(x) (x).new_exe_offset
+
+struct e32_exe {
+ unsigned char magic_number[2];
+ unsigned char byte_order;
+ unsigned char word_order;
+ unsigned long exe_format_level;
+ unsigned short cpu;
+ unsigned short os;
+ unsigned long padding1[13];
+ unsigned long object_table_offset;
+ unsigned long object_count;
+ unsigned long padding2[31];
+};
+
+#define E32_MAGIC1(x) (x).magic_number[0]
+#define E32MAGIC1 'L'
+#define E32_MAGIC2(x) (x).magic_number[1]
+#define E32MAGIC2 'X'
+#define E32_BORDER(x) (x).byte_order
+#define E32LEBO 0
+#define E32_WORDER(x) (x).word_order
+#define E32LEWO 0
+#define E32_CPU(x) (x).cpu
+#define E32CPU286 1
+#define E32_OBJTAB(x) (x).object_table_offset
+#define E32_OBJCNT(x) (x).object_count
+
+struct o32_obj {
+ unsigned long size;
+ unsigned long base;
+ unsigned long flags;
+ unsigned long pagemap;
+ unsigned long mapsize;
+ unsigned long reserved;
+};
+
+#define O32_FLAGS(x) (x).flags
+#define OBJREAD 0x0001L
+#define OBJWRITE 0x0002L
+#define OBJINVALID 0x0080L
+#define O32_SIZE(x) (x).size
+#define O32_BASE(x) (x).base
+
+# else /* IBM's compiler */
+
+/* A kludge to get around what appears to be a header file bug */
+# ifndef WORD
+# define WORD unsigned short
+# endif
+# ifndef DWORD
+# define DWORD unsigned long
+# endif
+
+# define EXE386 1
+# include <newexe.h>
+# include <exe386.h>
+
+# endif /* __IBMC__ */
+
+# define INCL_DOSEXCEPTIONS
+# define INCL_DOSPROCESS
+# define INCL_DOSERRORS
+# define INCL_DOSMODULEMGR
+# define INCL_DOSMEMMGR
+# include <os2.h>
+
+
+/* Disable and enable signals during nontrivial allocations */
+
+void GC_disable_signals(void)
+{
+ ULONG nest;
+
+ DosEnterMustComplete(&nest);
+ if (nest != 1) ABORT("nested GC_disable_signals");
+}
+
+void GC_enable_signals(void)
+{
+ ULONG nest;
+
+ DosExitMustComplete(&nest);
+ if (nest != 0) ABORT("GC_enable_signals");
+}
+
+
+# else
+
+# if !defined(PCR) && !defined(AMIGA) && !defined(MSWIN32) \
+ && !defined(MSWINCE) \
+ && !defined(MACOS) && !defined(DJGPP) && !defined(DOS4GW) \
+ && !defined(NOSYS) && !defined(ECOS)
+
+# if defined(sigmask) && !defined(UTS4) && !defined(HURD)
+ /* Use the traditional BSD interface */
+# define SIGSET_T int
+# define SIG_DEL(set, signal) (set) &= ~(sigmask(signal))
+# define SIG_FILL(set) (set) = 0x7fffffff
+ /* Setting the leading bit appears to provoke a bug in some */
+ /* longjmp implementations. Most systems appear not to have */
+ /* a signal 32. */
+# define SIGSETMASK(old, new) (old) = sigsetmask(new)
+# else
+ /* Use POSIX/SYSV interface */
+# define SIGSET_T sigset_t
+# define SIG_DEL(set, signal) sigdelset(&(set), (signal))
+# define SIG_FILL(set) sigfillset(&set)
+# define SIGSETMASK(old, new) sigprocmask(SIG_SETMASK, &(new), &(old))
+# endif
+
+static GC_bool mask_initialized = FALSE;
+
+static SIGSET_T new_mask;
+
+static SIGSET_T old_mask;
+
+static SIGSET_T dummy;
+
+#if defined(PRINTSTATS) && !defined(THREADS)
+# define CHECK_SIGNALS
+ int GC_sig_disabled = 0;
+#endif
+
+void GC_disable_signals()
+{
+ if (!mask_initialized) {
+ SIG_FILL(new_mask);
+
+ SIG_DEL(new_mask, SIGSEGV);
+ SIG_DEL(new_mask, SIGILL);
+ SIG_DEL(new_mask, SIGQUIT);
+# ifdef SIGBUS
+ SIG_DEL(new_mask, SIGBUS);
+# endif
+# ifdef SIGIOT
+ SIG_DEL(new_mask, SIGIOT);
+# endif
+# ifdef SIGEMT
+ SIG_DEL(new_mask, SIGEMT);
+# endif
+# ifdef SIGTRAP
+ SIG_DEL(new_mask, SIGTRAP);
+# endif
+ mask_initialized = TRUE;
+ }
+# ifdef CHECK_SIGNALS
+ if (GC_sig_disabled != 0) ABORT("Nested disables");
+ GC_sig_disabled++;
+# endif
+ SIGSETMASK(old_mask,new_mask);
+}
+
+void GC_enable_signals()
+{
+# ifdef CHECK_SIGNALS
+ if (GC_sig_disabled != 1) ABORT("Unmatched enable");
+ GC_sig_disabled--;
+# endif
+ SIGSETMASK(dummy,old_mask);
+}
+
+# endif /* !PCR */
+
+# endif /*!OS/2 */
+
+/* Ivan Demakov: simplest way (to me) */
+#if defined (DOS4GW)
+ void GC_disable_signals() { }
+ void GC_enable_signals() { }
+#endif
+
+/* Find the page size */
+word GC_page_size;
+
+# if defined(MSWIN32) || defined(MSWINCE)
+ void GC_setpagesize()
+ {
+ GetSystemInfo(&GC_sysinfo);
+ GC_page_size = GC_sysinfo.dwPageSize;
+ }
+
+# else
+# if defined(MPROTECT_VDB) || defined(PROC_VDB) || defined(USE_MMAP) \
+ || defined(USE_MUNMAP)
+ void GC_setpagesize()
+ {
+ GC_page_size = GETPAGESIZE();
+ }
+# else
+ /* It's acceptable to fake it. */
+ void GC_setpagesize()
+ {
+ GC_page_size = HBLKSIZE;
+ }
+# endif
+# endif
+
+/*
+ * Find the base of the stack.
+ * Used only in single-threaded environment.
+ * With threads, GC_mark_roots needs to know how to do this.
+ * Called with allocator lock held.
+ */
+# if defined(MSWIN32) || defined(MSWINCE)
+# define is_writable(prot) ((prot) == PAGE_READWRITE \
+ || (prot) == PAGE_WRITECOPY \
+ || (prot) == PAGE_EXECUTE_READWRITE \
+ || (prot) == PAGE_EXECUTE_WRITECOPY)
+/* Return the number of bytes that are writable starting at p. */
+/* The pointer p is assumed to be page aligned. */
+/* If base is not 0, *base becomes the beginning of the */
+/* allocation region containing p. */
+word GC_get_writable_length(ptr_t p, ptr_t *base)
+{
+ MEMORY_BASIC_INFORMATION buf;
+ word result;
+ word protect;
+
+ result = VirtualQuery(p, &buf, sizeof(buf));
+ if (result != sizeof(buf)) ABORT("Weird VirtualQuery result");
+ if (base != 0) *base = (ptr_t)(buf.AllocationBase);
+ protect = (buf.Protect & ~(PAGE_GUARD | PAGE_NOCACHE));
+ if (!is_writable(protect)) {
+ return(0);
+ }
+ if (buf.State != MEM_COMMIT) return(0);
+ return(buf.RegionSize);
+}
+
+ptr_t GC_get_stack_base()
+{
+ int dummy;
+ ptr_t sp = (ptr_t)(&dummy);
+ ptr_t trunc_sp = (ptr_t)((word)sp & ~(GC_page_size - 1));
+ word size = GC_get_writable_length(trunc_sp, 0);
+
+ return(trunc_sp + size);
+}
+
+
+# endif /* MS Windows */
+
+# ifdef BEOS
+# include <kernel/OS.h>
+ptr_t GC_get_stack_base(){
+ thread_info th;
+ get_thread_info(find_thread(NULL),&th);
+ return th.stack_end;
+}
+# endif /* BEOS */
+
+
+# ifdef OS2
+
+ptr_t GC_get_stack_base()
+{
+ PTIB ptib;
+ PPIB ppib;
+
+ if (DosGetInfoBlocks(&ptib, &ppib) != NO_ERROR) {
+ GC_err_printf0("DosGetInfoBlocks failed\n");
+ ABORT("DosGetInfoBlocks failed\n");
+ }
+ return((ptr_t)(ptib -> tib_pstacklimit));
+}
+
+# endif /* OS2 */
+
+# ifdef AMIGA
+# define GC_AMIGA_SB
+# include "AmigaOS.c"
+# undef GC_AMIGA_SB
+# endif /* AMIGA */
+
+# if defined(NEED_FIND_LIMIT) || defined(UNIX_LIKE)
+
+# ifdef __STDC__
+ typedef void (*handler)(int);
+# else
+ typedef void (*handler)();
+# endif
+
+# if defined(SUNOS5SIGS) || defined(IRIX5) || defined(OSF1) || defined(HURD)
+ static struct sigaction old_segv_act;
+# if defined(_sigargs) /* !Irix6.x */ || defined(HPUX) || defined(HURD)
+ static struct sigaction old_bus_act;
+# endif
+# else
+ static handler old_segv_handler, old_bus_handler;
+# endif
+
+# ifdef __STDC__
+ void GC_set_and_save_fault_handler(handler h)
+# else
+ void GC_set_and_save_fault_handler(h)
+ handler h;
+# endif
+ {
+# if defined(SUNOS5SIGS) || defined(IRIX5) \
+ || defined(OSF1) || defined(HURD)
+ struct sigaction act;
+
+ act.sa_handler = h;
+# ifdef SUNOS5SIGS
+ act.sa_flags = SA_RESTART | SA_NODEFER;
+# else
+ act.sa_flags = SA_RESTART;
+# endif
+ /* The presence of SA_NODEFER represents yet another gross */
+ /* hack. Under Solaris 2.3, siglongjmp doesn't appear to */
+ /* interact correctly with -lthread. We hide the confusion */
+ /* by making sure that signal handling doesn't affect the */
+ /* signal mask. */
+
+ (void) sigemptyset(&act.sa_mask);
+# ifdef GC_IRIX_THREADS
+ /* Older versions have a bug related to retrieving and */
+ /* and setting a handler at the same time. */
+ (void) sigaction(SIGSEGV, 0, &old_segv_act);
+ (void) sigaction(SIGSEGV, &act, 0);
+# else
+ (void) sigaction(SIGSEGV, &act, &old_segv_act);
+# if defined(IRIX5) && defined(_sigargs) /* Irix 5.x, not 6.x */ \
+ || defined(HPUX) || defined(HURD)
+ /* Under Irix 5.x or HP/UX, we may get SIGBUS. */
+ /* Pthreads doesn't exist under Irix 5.x, so we */
+ /* don't have to worry in the threads case. */
+ (void) sigaction(SIGBUS, &act, &old_bus_act);
+# endif
+# endif /* GC_IRIX_THREADS */
+# else
+ old_segv_handler = signal(SIGSEGV, h);
+# ifdef SIGBUS
+ old_bus_handler = signal(SIGBUS, h);
+# endif
+# endif
+ }
+# endif /* NEED_FIND_LIMIT || UNIX_LIKE */
+
+# ifdef NEED_FIND_LIMIT
+ /* Some tools to implement HEURISTIC2 */
+# define MIN_PAGE_SIZE 256 /* Smallest conceivable page size, bytes */
+ /* static */ jmp_buf GC_jmp_buf;
+
+ /*ARGSUSED*/
+ void GC_fault_handler(sig)
+ int sig;
+ {
+ longjmp(GC_jmp_buf, 1);
+ }
+
+ void GC_setup_temporary_fault_handler()
+ {
+ GC_set_and_save_fault_handler(GC_fault_handler);
+ }
+
+ void GC_reset_fault_handler()
+ {
+# if defined(SUNOS5SIGS) || defined(IRIX5) \
+ || defined(OSF1) || defined(HURD)
+ (void) sigaction(SIGSEGV, &old_segv_act, 0);
+# if defined(IRIX5) && defined(_sigargs) /* Irix 5.x, not 6.x */ \
+ || defined(HPUX) || defined(HURD)
+ (void) sigaction(SIGBUS, &old_bus_act, 0);
+# endif
+# else
+ (void) signal(SIGSEGV, old_segv_handler);
+# ifdef SIGBUS
+ (void) signal(SIGBUS, old_bus_handler);
+# endif
+# endif
+ }
+
+ /* Return the first nonaddressible location > p (up) or */
+ /* the smallest location q s.t. [q,p) is addressable (!up). */
+ /* We assume that p (up) or p-1 (!up) is addressable. */
+ ptr_t GC_find_limit(p, up)
+ ptr_t p;
+ GC_bool up;
+ {
+ static VOLATILE ptr_t result;
+ /* Needs to be static, since otherwise it may not be */
+ /* preserved across the longjmp. Can safely be */
+ /* static since it's only called once, with the */
+ /* allocation lock held. */
+
+
+ GC_setup_temporary_fault_handler();
+ if (setjmp(GC_jmp_buf) == 0) {
+ result = (ptr_t)(((word)(p))
+ & ~(MIN_PAGE_SIZE-1));
+ for (;;) {
+ if (up) {
+ result += MIN_PAGE_SIZE;
+ } else {
+ result -= MIN_PAGE_SIZE;
+ }
+ GC_noop1((word)(*result));
+ }
+ }
+ GC_reset_fault_handler();
+ if (!up) {
+ result += MIN_PAGE_SIZE;
+ }
+ return(result);
+ }
+# endif
+
+#if defined(ECOS) || defined(NOSYS)
+ ptr_t GC_get_stack_base()
+ {
+ return STACKBOTTOM;
+ }
+#endif
+
+#ifdef LINUX_STACKBOTTOM
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <ctype.h>
+
+# define STAT_SKIP 27 /* Number of fields preceding startstack */
+ /* field in /proc/self/stat */
+
+# pragma weak __libc_stack_end
+ extern ptr_t __libc_stack_end;
+
+# ifdef IA64
+# pragma weak __libc_ia64_register_backing_store_base
+ extern ptr_t __libc_ia64_register_backing_store_base;
+
+ ptr_t GC_get_register_stack_base(void)
+ {
+ if (0 != &__libc_ia64_register_backing_store_base
+ && 0 != __libc_ia64_register_backing_store_base) {
+ /* Glibc 2.2.4 has a bug such that for dynamically linked */
+ /* executables __libc_ia64_register_backing_store_base is */
+ /* defined but ininitialized during constructor calls. */
+ /* Hence we check for both nonzero address and value. */
+ return __libc_ia64_register_backing_store_base;
+ } else {
+ word result = (word)GC_stackbottom - BACKING_STORE_DISPLACEMENT;
+ result += BACKING_STORE_ALIGNMENT - 1;
+ result &= ~(BACKING_STORE_ALIGNMENT - 1);
+ return (ptr_t)result;
+ }
+ }
+# endif
+
+ ptr_t GC_linux_stack_base(void)
+ {
+ /* We read the stack base value from /proc/self/stat. We do this */
+ /* using direct I/O system calls in order to avoid calling malloc */
+ /* in case REDIRECT_MALLOC is defined. */
+# define STAT_BUF_SIZE 4096
+# if defined(GC_USE_LD_WRAP)
+# define STAT_READ __real_read
+# else
+# define STAT_READ read
+# endif
+ char stat_buf[STAT_BUF_SIZE];
+ int f;
+ char c;
+ word result = 0;
+ size_t i, buf_offset = 0;
+
+ /* First try the easy way. This should work for glibc 2.2 */
+ if (0 != &__libc_stack_end) {
+# ifdef IA64
+ /* Some versions of glibc set the address 16 bytes too */
+ /* low while the initialization code is running. */
+ if (((word)__libc_stack_end & 0xfff) + 0x10 < 0x1000) {
+ return __libc_stack_end + 0x10;
+ } /* Otherwise it's not safe to add 16 bytes and we fall */
+ /* back to using /proc. */
+# else
+ return __libc_stack_end;
+# endif
+ }
+ f = open("/proc/self/stat", O_RDONLY);
+ if (f < 0 || STAT_READ(f, stat_buf, STAT_BUF_SIZE) < 2 * STAT_SKIP) {
+ ABORT("Couldn't read /proc/self/stat");
+ }
+ c = stat_buf[buf_offset++];
+ /* Skip the required number of fields. This number is hopefully */
+ /* constant across all Linux implementations. */
+ for (i = 0; i < STAT_SKIP; ++i) {
+ while (isspace(c)) c = stat_buf[buf_offset++];
+ while (!isspace(c)) c = stat_buf[buf_offset++];
+ }
+ while (isspace(c)) c = stat_buf[buf_offset++];
+ while (isdigit(c)) {
+ result *= 10;
+ result += c - '0';
+ c = stat_buf[buf_offset++];
+ }
+ close(f);
+ if (result < 0x10000000) ABORT("Absurd stack bottom value");
+ return (ptr_t)result;
+ }
+
+#endif /* LINUX_STACKBOTTOM */
+
+#ifdef FREEBSD_STACKBOTTOM
+
+/* This uses an undocumented sysctl call, but at least one expert */
+/* believes it will stay. */
+
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/sysctl.h>
+
+ ptr_t GC_freebsd_stack_base(void)
+ {
+ int nm[2] = {CTL_KERN, KERN_USRSTACK};
+ ptr_t base;
+ size_t len = sizeof(ptr_t);
+ int r = sysctl(nm, 2, &base, &len, NULL, 0);
+
+ if (r) ABORT("Error getting stack base");
+
+ return base;
+ }
+
+#endif /* FREEBSD_STACKBOTTOM */
+
+#if !defined(BEOS) && !defined(AMIGA) && !defined(MSWIN32) \
+ && !defined(MSWINCE) && !defined(OS2)
+
+ptr_t GC_get_stack_base()
+{
+ word dummy;
+ ptr_t result;
+
+# define STACKBOTTOM_ALIGNMENT_M1 ((word)STACK_GRAN - 1)
+
+# ifdef STACKBOTTOM
+ return(STACKBOTTOM);
+# else
+# ifdef HEURISTIC1
+# ifdef STACK_GROWS_DOWN
+ result = (ptr_t)((((word)(&dummy))
+ + STACKBOTTOM_ALIGNMENT_M1)
+ & ~STACKBOTTOM_ALIGNMENT_M1);
+# else
+ result = (ptr_t)(((word)(&dummy))
+ & ~STACKBOTTOM_ALIGNMENT_M1);
+# endif
+# endif /* HEURISTIC1 */
+# ifdef LINUX_STACKBOTTOM
+ result = GC_linux_stack_base();
+# endif
+# ifdef FREEBSD_STACKBOTTOM
+ result = GC_freebsd_stack_base();
+# endif
+# ifdef HEURISTIC2
+# ifdef STACK_GROWS_DOWN
+ result = GC_find_limit((ptr_t)(&dummy), TRUE);
+# ifdef HEURISTIC2_LIMIT
+ if (result > HEURISTIC2_LIMIT
+ && (ptr_t)(&dummy) < HEURISTIC2_LIMIT) {
+ result = HEURISTIC2_LIMIT;
+ }
+# endif
+# else
+ result = GC_find_limit((ptr_t)(&dummy), FALSE);
+# ifdef HEURISTIC2_LIMIT
+ if (result < HEURISTIC2_LIMIT
+ && (ptr_t)(&dummy) > HEURISTIC2_LIMIT) {
+ result = HEURISTIC2_LIMIT;
+ }
+# endif
+# endif
+
+# endif /* HEURISTIC2 */
+# ifdef STACK_GROWS_DOWN
+ if (result == 0) result = (ptr_t)(signed_word)(-sizeof(ptr_t));
+# endif
+ return(result);
+# endif /* STACKBOTTOM */
+}
+
+# endif /* ! AMIGA, !OS 2, ! MS Windows, !BEOS */
+
+/*
+ * Register static data segment(s) as roots.
+ * If more data segments are added later then they need to be registered
+ * add that point (as we do with SunOS dynamic loading),
+ * or GC_mark_roots needs to check for them (as we do with PCR).
+ * Called with allocator lock held.
+ */
+
+# ifdef OS2
+
+void GC_register_data_segments()
+{
+ PTIB ptib;
+ PPIB ppib;
+ HMODULE module_handle;
+# define PBUFSIZ 512
+ UCHAR path[PBUFSIZ];
+ FILE * myexefile;
+ struct exe_hdr hdrdos; /* MSDOS header. */
+ struct e32_exe hdr386; /* Real header for my executable */
+ struct o32_obj seg; /* Currrent segment */
+ int nsegs;
+
+
+ if (DosGetInfoBlocks(&ptib, &ppib) != NO_ERROR) {
+ GC_err_printf0("DosGetInfoBlocks failed\n");
+ ABORT("DosGetInfoBlocks failed\n");
+ }
+ module_handle = ppib -> pib_hmte;
+ if (DosQueryModuleName(module_handle, PBUFSIZ, path) != NO_ERROR) {
+ GC_err_printf0("DosQueryModuleName failed\n");
+ ABORT("DosGetInfoBlocks failed\n");
+ }
+ myexefile = fopen(path, "rb");
+ if (myexefile == 0) {
+ GC_err_puts("Couldn't open executable ");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Failed to open executable\n");
+ }
+ if (fread((char *)(&hdrdos), 1, sizeof hdrdos, myexefile) < sizeof hdrdos) {
+ GC_err_puts("Couldn't read MSDOS header from ");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Couldn't read MSDOS header");
+ }
+ if (E_MAGIC(hdrdos) != EMAGIC) {
+ GC_err_puts("Executable has wrong DOS magic number: ");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Bad DOS magic number");
+ }
+ if (fseek(myexefile, E_LFANEW(hdrdos), SEEK_SET) != 0) {
+ GC_err_puts("Seek to new header failed in ");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Bad DOS magic number");
+ }
+ if (fread((char *)(&hdr386), 1, sizeof hdr386, myexefile) < sizeof hdr386) {
+ GC_err_puts("Couldn't read MSDOS header from ");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Couldn't read OS/2 header");
+ }
+ if (E32_MAGIC1(hdr386) != E32MAGIC1 || E32_MAGIC2(hdr386) != E32MAGIC2) {
+ GC_err_puts("Executable has wrong OS/2 magic number:");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Bad OS/2 magic number");
+ }
+ if ( E32_BORDER(hdr386) != E32LEBO || E32_WORDER(hdr386) != E32LEWO) {
+ GC_err_puts("Executable %s has wrong byte order: ");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Bad byte order");
+ }
+ if ( E32_CPU(hdr386) == E32CPU286) {
+ GC_err_puts("GC can't handle 80286 executables: ");
+ GC_err_puts(path); GC_err_puts("\n");
+ EXIT();
+ }
+ if (fseek(myexefile, E_LFANEW(hdrdos) + E32_OBJTAB(hdr386),
+ SEEK_SET) != 0) {
+ GC_err_puts("Seek to object table failed: ");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Seek to object table failed");
+ }
+ for (nsegs = E32_OBJCNT(hdr386); nsegs > 0; nsegs--) {
+ int flags;
+ if (fread((char *)(&seg), 1, sizeof seg, myexefile) < sizeof seg) {
+ GC_err_puts("Couldn't read obj table entry from ");
+ GC_err_puts(path); GC_err_puts("\n");
+ ABORT("Couldn't read obj table entry");
+ }
+ flags = O32_FLAGS(seg);
+ if (!(flags & OBJWRITE)) continue;
+ if (!(flags & OBJREAD)) continue;
+ if (flags & OBJINVALID) {
+ GC_err_printf0("Object with invalid pages?\n");
+ continue;
+ }
+ GC_add_roots_inner(O32_BASE(seg), O32_BASE(seg)+O32_SIZE(seg), FALSE);
+ }
+}
+
+# else /* !OS2 */
+
+# if defined(MSWIN32) || defined(MSWINCE)
+
+# ifdef MSWIN32
+ /* Unfortunately, we have to handle win32s very differently from NT, */
+ /* Since VirtualQuery has very different semantics. In particular, */
+ /* under win32s a VirtualQuery call on an unmapped page returns an */
+ /* invalid result. Under NT, GC_register_data_segments is a noop and */
+ /* all real work is done by GC_register_dynamic_libraries. Under */
+ /* win32s, we cannot find the data segments associated with dll's. */
+ /* We register the main data segment here. */
+# ifdef __GCC__
+ GC_bool GC_no_win32_dlls = TRUE;
+ /* GCC can't do SEH, so we can't use VirtualQuery */
+# else
+ GC_bool GC_no_win32_dlls = FALSE;
+# endif
+
+ void GC_init_win32()
+ {
+ /* if we're running under win32s, assume that no DLLs will be loaded */
+ DWORD v = GetVersion();
+ GC_no_win32_dlls |= ((v & 0x80000000) && (v & 0xff) <= 3);
+ }
+
+ /* Return the smallest address a such that VirtualQuery */
+ /* returns correct results for all addresses between a and start. */
+ /* Assumes VirtualQuery returns correct information for start. */
+ ptr_t GC_least_described_address(ptr_t start)
+ {
+ MEMORY_BASIC_INFORMATION buf;
+ DWORD result;
+ LPVOID limit;
+ ptr_t p;
+ LPVOID q;
+
+ limit = GC_sysinfo.lpMinimumApplicationAddress;
+ p = (ptr_t)((word)start & ~(GC_page_size - 1));
+ for (;;) {
+ q = (LPVOID)(p - GC_page_size);
+ if ((ptr_t)q > (ptr_t)p /* underflow */ || q < limit) break;
+ result = VirtualQuery(q, &buf, sizeof(buf));
+ if (result != sizeof(buf) || buf.AllocationBase == 0) break;
+ p = (ptr_t)(buf.AllocationBase);
+ }
+ return(p);
+ }
+# endif
+
+# ifndef REDIRECT_MALLOC
+ /* We maintain a linked list of AllocationBase values that we know */
+ /* correspond to malloc heap sections. Currently this is only called */
+ /* during a GC. But there is some hope that for long running */
+ /* programs we will eventually see most heap sections. */
+
+ /* In the long run, it would be more reliable to occasionally walk */
+ /* the malloc heap with HeapWalk on the default heap. But that */
+ /* apparently works only for NT-based Windows. */
+
+ /* In the long run, a better data structure would also be nice ... */
+ struct GC_malloc_heap_list {
+ void * allocation_base;
+ struct GC_malloc_heap_list *next;
+ } *GC_malloc_heap_l = 0;
+
+ /* Is p the base of one of the malloc heap sections we already know */
+ /* about? */
+ GC_bool GC_is_malloc_heap_base(ptr_t p)
+ {
+ struct GC_malloc_heap_list *q = GC_malloc_heap_l;
+
+ while (0 != q) {
+ if (q -> allocation_base == p) return TRUE;
+ q = q -> next;
+ }
+ return FALSE;
+ }
+
+ void *GC_get_allocation_base(void *p)
+ {
+ MEMORY_BASIC_INFORMATION buf;
+ DWORD result = VirtualQuery(p, &buf, sizeof(buf));
+ if (result != sizeof(buf)) {
+ ABORT("Weird VirtualQuery result");
+ }
+ return buf.AllocationBase;
+ }
+
+ size_t GC_max_root_size = 100000; /* Appr. largest root size. */
+
+ void GC_add_current_malloc_heap()
+ {
+ struct GC_malloc_heap_list *new_l =
+ malloc(sizeof(struct GC_malloc_heap_list));
+ void * candidate = GC_get_allocation_base(new_l);
+
+ if (new_l == 0) return;
+ if (GC_is_malloc_heap_base(candidate)) {
+ /* Try a little harder to find malloc heap. */
+ size_t req_size = 10000;
+ do {
+ void *p = malloc(req_size);
+ if (0 == p) { free(new_l); return; }
+ candidate = GC_get_allocation_base(p);
+ free(p);
+ req_size *= 2;
+ } while (GC_is_malloc_heap_base(candidate)
+ && req_size < GC_max_root_size/10 && req_size < 500000);
+ if (GC_is_malloc_heap_base(candidate)) {
+ free(new_l); return;
+ }
+ }
+# ifdef CONDPRINT
+ if (GC_print_stats)
+ GC_printf1("Found new system malloc AllocationBase at 0x%lx\n",
+ candidate);
+# endif
+ new_l -> allocation_base = candidate;
+ new_l -> next = GC_malloc_heap_l;
+ GC_malloc_heap_l = new_l;
+ }
+# endif /* REDIRECT_MALLOC */
+
+ /* Is p the start of either the malloc heap, or of one of our */
+ /* heap sections? */
+ GC_bool GC_is_heap_base (ptr_t p)
+ {
+
+ unsigned i;
+
+# ifndef REDIRECT_MALLOC
+ static word last_gc_no = -1;
+
+ if (last_gc_no != GC_gc_no) {
+ GC_add_current_malloc_heap();
+ last_gc_no = GC_gc_no;
+ }
+ if (GC_root_size > GC_max_root_size) GC_max_root_size = GC_root_size;
+ if (GC_is_malloc_heap_base(p)) return TRUE;
+# endif
+ for (i = 0; i < GC_n_heap_bases; i++) {
+ if (GC_heap_bases[i] == p) return TRUE;
+ }
+ return FALSE ;
+ }
+
+# ifdef MSWIN32
+ void GC_register_root_section(ptr_t static_root)
+ {
+ MEMORY_BASIC_INFORMATION buf;
+ DWORD result;
+ DWORD protect;
+ LPVOID p;
+ char * base;
+ char * limit, * new_limit;
+
+ if (!GC_no_win32_dlls) return;
+ p = base = limit = GC_least_described_address(static_root);
+ while (p < GC_sysinfo.lpMaximumApplicationAddress) {
+ result = VirtualQuery(p, &buf, sizeof(buf));
+ if (result != sizeof(buf) || buf.AllocationBase == 0
+ || GC_is_heap_base(buf.AllocationBase)) break;
+ new_limit = (char *)p + buf.RegionSize;
+ protect = buf.Protect;
+ if (buf.State == MEM_COMMIT
+ && is_writable(protect)) {
+ if ((char *)p == limit) {
+ limit = new_limit;
+ } else {
+ if (base != limit) GC_add_roots_inner(base, limit, FALSE);
+ base = p;
+ limit = new_limit;
+ }
+ }
+ if (p > (LPVOID)new_limit /* overflow */) break;
+ p = (LPVOID)new_limit;
+ }
+ if (base != limit) GC_add_roots_inner(base, limit, FALSE);
+ }
+#endif
+
+ void GC_register_data_segments()
+ {
+# ifdef MSWIN32
+ static char dummy;
+ GC_register_root_section((ptr_t)(&dummy));
+# endif
+ }
+
+# else /* !OS2 && !Windows */
+
+# if (defined(SVR4) || defined(AUX) || defined(DGUX) \
+ || (defined(LINUX) && defined(SPARC))) && !defined(PCR)
+ptr_t GC_SysVGetDataStart(max_page_size, etext_addr)
+int max_page_size;
+int * etext_addr;
+{
+ word text_end = ((word)(etext_addr) + sizeof(word) - 1)
+ & ~(sizeof(word) - 1);
+ /* etext rounded to word boundary */
+ word next_page = ((text_end + (word)max_page_size - 1)
+ & ~((word)max_page_size - 1));
+ word page_offset = (text_end & ((word)max_page_size - 1));
+ VOLATILE char * result = (char *)(next_page + page_offset);
+ /* Note that this isnt equivalent to just adding */
+ /* max_page_size to &etext if &etext is at a page boundary */
+
+ GC_setup_temporary_fault_handler();
+ if (setjmp(GC_jmp_buf) == 0) {
+ /* Try writing to the address. */
+ *result = *result;
+ GC_reset_fault_handler();
+ } else {
+ GC_reset_fault_handler();
+ /* We got here via a longjmp. The address is not readable. */
+ /* This is known to happen under Solaris 2.4 + gcc, which place */
+ /* string constants in the text segment, but after etext. */
+ /* Use plan B. Note that we now know there is a gap between */
+ /* text and data segments, so plan A bought us something. */
+ result = (char *)GC_find_limit((ptr_t)(DATAEND), FALSE);
+ }
+ return((ptr_t)result);
+}
+# endif
+
+# if defined(FREEBSD) && defined(I386) && !defined(PCR)
+/* Its unclear whether this should be identical to the above, or */
+/* whether it should apply to non-X86 architectures. */
+/* For now we don't assume that there is always an empty page after */
+/* etext. But in some cases there actually seems to be slightly more. */
+/* This also deals with holes between read-only data and writable data. */
+ptr_t GC_FreeBSDGetDataStart(max_page_size, etext_addr)
+int max_page_size;
+int * etext_addr;
+{
+ word text_end = ((word)(etext_addr) + sizeof(word) - 1)
+ & ~(sizeof(word) - 1);
+ /* etext rounded to word boundary */
+ VOLATILE word next_page = (text_end + (word)max_page_size - 1)
+ & ~((word)max_page_size - 1);
+ VOLATILE ptr_t result = (ptr_t)text_end;
+ GC_setup_temporary_fault_handler();
+ if (setjmp(GC_jmp_buf) == 0) {
+ /* Try reading at the address. */
+ /* This should happen before there is another thread. */
+ for (; next_page < (word)(DATAEND); next_page += (word)max_page_size)
+ *(VOLATILE char *)next_page;
+ GC_reset_fault_handler();
+ } else {
+ GC_reset_fault_handler();
+ /* As above, we go to plan B */
+ result = GC_find_limit((ptr_t)(DATAEND), FALSE);
+ }
+ return(result);
+}
+
+# endif
+
+
+#ifdef AMIGA
+
+# define GC_AMIGA_DS
+# include "AmigaOS.c"
+# undef GC_AMIGA_DS
+
+#else /* !OS2 && !Windows && !AMIGA */
+
+void GC_register_data_segments()
+{
+# if !defined(PCR) && !defined(SRC_M3) && !defined(MACOS)
+# if defined(REDIRECT_MALLOC) && defined(GC_SOLARIS_THREADS)
+ /* As of Solaris 2.3, the Solaris threads implementation */
+ /* allocates the data structure for the initial thread with */
+ /* sbrk at process startup. It needs to be scanned, so that */
+ /* we don't lose some malloc allocated data structures */
+ /* hanging from it. We're on thin ice here ... */
+ extern caddr_t sbrk();
+
+ GC_add_roots_inner(DATASTART, (char *)sbrk(0), FALSE);
+# else
+ GC_add_roots_inner(DATASTART, (char *)(DATAEND), FALSE);
+# if defined(DATASTART2)
+ GC_add_roots_inner(DATASTART2, (char *)(DATAEND2), FALSE);
+# endif
+# endif
+# endif
+# if defined(MACOS)
+ {
+# if defined(THINK_C)
+ extern void* GC_MacGetDataStart(void);
+ /* globals begin above stack and end at a5. */
+ GC_add_roots_inner((ptr_t)GC_MacGetDataStart(),
+ (ptr_t)LMGetCurrentA5(), FALSE);
+# else
+# if defined(__MWERKS__)
+# if !__POWERPC__
+ extern void* GC_MacGetDataStart(void);
+ /* MATTHEW: Function to handle Far Globals (CW Pro 3) */
+# if __option(far_data)
+ extern void* GC_MacGetDataEnd(void);
+# endif
+ /* globals begin above stack and end at a5. */
+ GC_add_roots_inner((ptr_t)GC_MacGetDataStart(),
+ (ptr_t)LMGetCurrentA5(), FALSE);
+ /* MATTHEW: Handle Far Globals */
+# if __option(far_data)
+ /* Far globals follow he QD globals: */
+ GC_add_roots_inner((ptr_t)LMGetCurrentA5(),
+ (ptr_t)GC_MacGetDataEnd(), FALSE);
+# endif
+# else
+ extern char __data_start__[], __data_end__[];
+ GC_add_roots_inner((ptr_t)&__data_start__,
+ (ptr_t)&__data_end__, FALSE);
+# endif /* __POWERPC__ */
+# endif /* __MWERKS__ */
+# endif /* !THINK_C */
+ }
+# endif /* MACOS */
+
+ /* Dynamic libraries are added at every collection, since they may */
+ /* change. */
+}
+
+# endif /* ! AMIGA */
+# endif /* ! MSWIN32 && ! MSWINCE*/
+# endif /* ! OS2 */
+
+/*
+ * Auxiliary routines for obtaining memory from OS.
+ */
+
+# if !defined(OS2) && !defined(PCR) && !defined(AMIGA) \
+ && !defined(MSWIN32) && !defined(MSWINCE) \
+ && !defined(MACOS) && !defined(DOS4GW)
+
+# ifdef SUNOS4
+ extern caddr_t sbrk();
+# endif
+# ifdef __STDC__
+# define SBRK_ARG_T ptrdiff_t
+# else
+# define SBRK_ARG_T int
+# endif
+
+
+# ifdef RS6000
+/* The compiler seems to generate speculative reads one past the end of */
+/* an allocated object. Hence we need to make sure that the page */
+/* following the last heap page is also mapped. */
+ptr_t GC_unix_get_mem(bytes)
+word bytes;
+{
+ caddr_t cur_brk = (caddr_t)sbrk(0);
+ caddr_t result;
+ SBRK_ARG_T lsbs = (word)cur_brk & (GC_page_size-1);
+ static caddr_t my_brk_val = 0;
+
+ if ((SBRK_ARG_T)bytes < 0) return(0); /* too big */
+ if (lsbs != 0) {
+ if((caddr_t)(sbrk(GC_page_size - lsbs)) == (caddr_t)(-1)) return(0);
+ }
+ if (cur_brk == my_brk_val) {
+ /* Use the extra block we allocated last time. */
+ result = (ptr_t)sbrk((SBRK_ARG_T)bytes);
+ if (result == (caddr_t)(-1)) return(0);
+ result -= GC_page_size;
+ } else {
+ result = (ptr_t)sbrk(GC_page_size + (SBRK_ARG_T)bytes);
+ if (result == (caddr_t)(-1)) return(0);
+ }
+ my_brk_val = result + bytes + GC_page_size; /* Always page aligned */
+ return((ptr_t)result);
+}
+
+#else /* Not RS6000 */
+
+#if defined(USE_MMAP)
+/* Tested only under Linux, IRIX5 and Solaris 2 */
+
+#ifdef USE_MMAP_FIXED
+# define GC_MMAP_FLAGS MAP_FIXED | MAP_PRIVATE
+ /* Seems to yield better performance on Solaris 2, but can */
+ /* be unreliable if something is already mapped at the address. */
+#else
+# define GC_MMAP_FLAGS MAP_PRIVATE
+#endif
+
+#ifndef HEAP_START
+# define HEAP_START 0
+#endif
+
+ptr_t GC_unix_get_mem(bytes)
+word bytes;
+{
+ void *result;
+ static ptr_t last_addr = HEAP_START;
+
+# ifndef USE_MMAP_ANON
+ static GC_bool initialized = FALSE;
+ static int fd;
+
+ if (!initialized) {
+ fd = open("/dev/zero", O_RDONLY);
+ fcntl(fd, F_SETFD, FD_CLOEXEC);
+ initialized = TRUE;
+ }
+# endif
+
+ if (bytes & (GC_page_size -1)) ABORT("Bad GET_MEM arg");
+# ifdef USE_MMAP_ANON
+ result = mmap(last_addr, bytes, PROT_READ | PROT_WRITE | OPT_PROT_EXEC,
+ GC_MMAP_FLAGS | MAP_ANON, -1, 0/* offset */);
+# else
+ result = mmap(last_addr, bytes, PROT_READ | PROT_WRITE | OPT_PROT_EXEC,
+ GC_MMAP_FLAGS, fd, 0/* offset */);
+# endif
+ if (result == MAP_FAILED) return(0);
+ last_addr = (ptr_t)result + bytes + GC_page_size - 1;
+ last_addr = (ptr_t)((word)last_addr & ~(GC_page_size - 1));
+# if !defined(LINUX)
+ if (last_addr == 0) {
+ /* Oops. We got the end of the address space. This isn't */
+ /* usable by arbitrary C code, since one-past-end pointers */
+ /* don't work, so we discard it and try again. */
+ munmap(result, (size_t)(-GC_page_size) - (size_t)result);
+ /* Leave last page mapped, so we can't repeat. */
+ return GC_unix_get_mem(bytes);
+ }
+# else
+ GC_ASSERT(last_addr != 0);
+# endif
+ return((ptr_t)result);
+}
+
+#else /* Not RS6000, not USE_MMAP */
+ptr_t GC_unix_get_mem(bytes)
+word bytes;
+{
+ ptr_t result;
+# ifdef IRIX5
+ /* Bare sbrk isn't thread safe. Play by malloc rules. */
+ /* The equivalent may be needed on other systems as well. */
+ __LOCK_MALLOC();
+# endif
+ {
+ ptr_t cur_brk = (ptr_t)sbrk(0);
+ SBRK_ARG_T lsbs = (word)cur_brk & (GC_page_size-1);
+
+ if ((SBRK_ARG_T)bytes < 0) return(0); /* too big */
+ if (lsbs != 0) {
+ if((ptr_t)sbrk(GC_page_size - lsbs) == (ptr_t)(-1)) return(0);
+ }
+ result = (ptr_t)sbrk((SBRK_ARG_T)bytes);
+ if (result == (ptr_t)(-1)) result = 0;
+ }
+# ifdef IRIX5
+ __UNLOCK_MALLOC();
+# endif
+ return(result);
+}
+
+#endif /* Not USE_MMAP */
+#endif /* Not RS6000 */
+
+# endif /* UN*X */
+
+# ifdef OS2
+
+void * os2_alloc(size_t bytes)
+{
+ void * result;
+
+ if (DosAllocMem(&result, bytes, PAG_EXECUTE | PAG_READ |
+ PAG_WRITE | PAG_COMMIT)
+ != NO_ERROR) {
+ return(0);
+ }
+ if (result == 0) return(os2_alloc(bytes));
+ return(result);
+}
+
+# endif /* OS2 */
+
+
+# if defined(MSWIN32) || defined(MSWINCE)
+SYSTEM_INFO GC_sysinfo;
+# endif
+
+# ifdef MSWIN32
+
+# ifdef USE_GLOBAL_ALLOC
+# define GLOBAL_ALLOC_TEST 1
+# else
+# define GLOBAL_ALLOC_TEST GC_no_win32_dlls
+# endif
+
+word GC_n_heap_bases = 0;
+
+ptr_t GC_win32_get_mem(bytes)
+word bytes;
+{
+ ptr_t result;
+
+ if (GLOBAL_ALLOC_TEST) {
+ /* VirtualAlloc doesn't like PAGE_EXECUTE_READWRITE. */
+ /* There are also unconfirmed rumors of other */
+ /* problems, so we dodge the issue. */
+ result = (ptr_t) GlobalAlloc(0, bytes + HBLKSIZE);
+ result = (ptr_t)(((word)result + HBLKSIZE) & ~(HBLKSIZE-1));
+ } else {
+ /* VirtualProtect only works on regions returned by a */
+ /* single VirtualAlloc call. Thus we allocate one */
+ /* extra page, which will prevent merging of blocks */
+ /* in separate regions, and eliminate any temptation */
+ /* to call VirtualProtect on a range spanning regions. */
+ /* This wastes a small amount of memory, and risks */
+ /* increased fragmentation. But better alternatives */
+ /* would require effort. */
+ result = (ptr_t) VirtualAlloc(NULL, bytes + 1,
+ MEM_COMMIT | MEM_RESERVE,
+ PAGE_EXECUTE_READWRITE);
+ }
+ if (HBLKDISPL(result) != 0) ABORT("Bad VirtualAlloc result");
+ /* If I read the documentation correctly, this can */
+ /* only happen if HBLKSIZE > 64k or not a power of 2. */
+ if (GC_n_heap_bases >= MAX_HEAP_SECTS) ABORT("Too many heap sections");
+ GC_heap_bases[GC_n_heap_bases++] = result;
+ return(result);
+}
+
+void GC_win32_free_heap ()
+{
+ if (GC_no_win32_dlls) {
+ while (GC_n_heap_bases > 0) {
+ GlobalFree (GC_heap_bases[--GC_n_heap_bases]);
+ GC_heap_bases[GC_n_heap_bases] = 0;
+ }
+ }
+}
+# endif
+
+#ifdef AMIGA
+# define GC_AMIGA_AM
+# include "AmigaOS.c"
+# undef GC_AMIGA_AM
+#endif
+
+
+# ifdef MSWINCE
+word GC_n_heap_bases = 0;
+
+ptr_t GC_wince_get_mem(bytes)
+word bytes;
+{
+ ptr_t result;
+ word i;
+
+ /* Round up allocation size to multiple of page size */
+ bytes = (bytes + GC_page_size-1) & ~(GC_page_size-1);
+
+ /* Try to find reserved, uncommitted pages */
+ for (i = 0; i < GC_n_heap_bases; i++) {
+ if (((word)(-(signed_word)GC_heap_lengths[i])
+ & (GC_sysinfo.dwAllocationGranularity-1))
+ >= bytes) {
+ result = GC_heap_bases[i] + GC_heap_lengths[i];
+ break;
+ }
+ }
+
+ if (i == GC_n_heap_bases) {
+ /* Reserve more pages */
+ word res_bytes = (bytes + GC_sysinfo.dwAllocationGranularity-1)
+ & ~(GC_sysinfo.dwAllocationGranularity-1);
+ /* If we ever support MPROTECT_VDB here, we will probably need to */
+ /* ensure that res_bytes is strictly > bytes, so that VirtualProtect */
+ /* never spans regions. It seems to be OK for a VirtualFree argument */
+ /* to span regions, so we should be OK for now. */
+ result = (ptr_t) VirtualAlloc(NULL, res_bytes,
+ MEM_RESERVE | MEM_TOP_DOWN,
+ PAGE_EXECUTE_READWRITE);
+ if (HBLKDISPL(result) != 0) ABORT("Bad VirtualAlloc result");
+ /* If I read the documentation correctly, this can */
+ /* only happen if HBLKSIZE > 64k or not a power of 2. */
+ if (GC_n_heap_bases >= MAX_HEAP_SECTS) ABORT("Too many heap sections");
+ GC_heap_bases[GC_n_heap_bases] = result;
+ GC_heap_lengths[GC_n_heap_bases] = 0;
+ GC_n_heap_bases++;
+ }
+
+ /* Commit pages */
+ result = (ptr_t) VirtualAlloc(result, bytes,
+ MEM_COMMIT,
+ PAGE_EXECUTE_READWRITE);
+ if (result != NULL) {
+ if (HBLKDISPL(result) != 0) ABORT("Bad VirtualAlloc result");
+ GC_heap_lengths[i] += bytes;
+ }
+
+ return(result);
+}
+# endif
+
+#ifdef USE_MUNMAP
+
+/* For now, this only works on Win32/WinCE and some Unix-like */
+/* systems. If you have something else, don't define */
+/* USE_MUNMAP. */
+/* We assume ANSI C to support this feature. */
+
+#if !defined(MSWIN32) && !defined(MSWINCE)
+
+#include <unistd.h>
+#include <sys/mman.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+
+#endif
+
+/* Compute a page aligned starting address for the unmap */
+/* operation on a block of size bytes starting at start. */
+/* Return 0 if the block is too small to make this feasible. */
+ptr_t GC_unmap_start(ptr_t start, word bytes)
+{
+ ptr_t result = start;
+ /* Round start to next page boundary. */
+ result += GC_page_size - 1;
+ result = (ptr_t)((word)result & ~(GC_page_size - 1));
+ if (result + GC_page_size > start + bytes) return 0;
+ return result;
+}
+
+/* Compute end address for an unmap operation on the indicated */
+/* block. */
+ptr_t GC_unmap_end(ptr_t start, word bytes)
+{
+ ptr_t end_addr = start + bytes;
+ end_addr = (ptr_t)((word)end_addr & ~(GC_page_size - 1));
+ return end_addr;
+}
+
+/* Under Win32/WinCE we commit (map) and decommit (unmap) */
+/* memory using VirtualAlloc and VirtualFree. These functions */
+/* work on individual allocations of virtual memory, made */
+/* previously using VirtualAlloc with the MEM_RESERVE flag. */
+/* The ranges we need to (de)commit may span several of these */
+/* allocations; therefore we use VirtualQuery to check */
+/* allocation lengths, and split up the range as necessary. */
+
+/* We assume that GC_remap is called on exactly the same range */
+/* as a previous call to GC_unmap. It is safe to consistently */
+/* round the endpoints in both places. */
+void GC_unmap(ptr_t start, word bytes)
+{
+ ptr_t start_addr = GC_unmap_start(start, bytes);
+ ptr_t end_addr = GC_unmap_end(start, bytes);
+ word len = end_addr - start_addr;
+ if (0 == start_addr) return;
+# if defined(MSWIN32) || defined(MSWINCE)
+ while (len != 0) {
+ MEMORY_BASIC_INFORMATION mem_info;
+ GC_word free_len;
+ if (VirtualQuery(start_addr, &mem_info, sizeof(mem_info))
+ != sizeof(mem_info))
+ ABORT("Weird VirtualQuery result");
+ free_len = (len < mem_info.RegionSize) ? len : mem_info.RegionSize;
+ if (!VirtualFree(start_addr, free_len, MEM_DECOMMIT))
+ ABORT("VirtualFree failed");
+ GC_unmapped_bytes += free_len;
+ start_addr += free_len;
+ len -= free_len;
+ }
+# else
+ if (munmap(start_addr, len) != 0) ABORT("munmap failed");
+ GC_unmapped_bytes += len;
+# endif
+}
+
+
+void GC_remap(ptr_t start, word bytes)
+{
+ static int zero_descr = -1;
+ ptr_t start_addr = GC_unmap_start(start, bytes);
+ ptr_t end_addr = GC_unmap_end(start, bytes);
+ word len = end_addr - start_addr;
+ ptr_t result;
+
+# if defined(MSWIN32) || defined(MSWINCE)
+ if (0 == start_addr) return;
+ while (len != 0) {
+ MEMORY_BASIC_INFORMATION mem_info;
+ GC_word alloc_len;
+ if (VirtualQuery(start_addr, &mem_info, sizeof(mem_info))
+ != sizeof(mem_info))
+ ABORT("Weird VirtualQuery result");
+ alloc_len = (len < mem_info.RegionSize) ? len : mem_info.RegionSize;
+ result = VirtualAlloc(start_addr, alloc_len,
+ MEM_COMMIT,
+ PAGE_EXECUTE_READWRITE);
+ if (result != start_addr) {
+ ABORT("VirtualAlloc remapping failed");
+ }
+ GC_unmapped_bytes -= alloc_len;
+ start_addr += alloc_len;
+ len -= alloc_len;
+ }
+# else
+ if (-1 == zero_descr) zero_descr = open("/dev/zero", O_RDWR);
+ fcntl(zero_descr, F_SETFD, FD_CLOEXEC);
+ if (0 == start_addr) return;
+ result = mmap(start_addr, len, PROT_READ | PROT_WRITE | OPT_PROT_EXEC,
+ MAP_FIXED | MAP_PRIVATE, zero_descr, 0);
+ if (result != start_addr) {
+ ABORT("mmap remapping failed");
+ }
+ GC_unmapped_bytes -= len;
+# endif
+}
+
+/* Two adjacent blocks have already been unmapped and are about to */
+/* be merged. Unmap the whole block. This typically requires */
+/* that we unmap a small section in the middle that was not previously */
+/* unmapped due to alignment constraints. */
+void GC_unmap_gap(ptr_t start1, word bytes1, ptr_t start2, word bytes2)
+{
+ ptr_t start1_addr = GC_unmap_start(start1, bytes1);
+ ptr_t end1_addr = GC_unmap_end(start1, bytes1);
+ ptr_t start2_addr = GC_unmap_start(start2, bytes2);
+ ptr_t end2_addr = GC_unmap_end(start2, bytes2);
+ ptr_t start_addr = end1_addr;
+ ptr_t end_addr = start2_addr;
+ word len;
+ GC_ASSERT(start1 + bytes1 == start2);
+ if (0 == start1_addr) start_addr = GC_unmap_start(start1, bytes1 + bytes2);
+ if (0 == start2_addr) end_addr = GC_unmap_end(start1, bytes1 + bytes2);
+ if (0 == start_addr) return;
+ len = end_addr - start_addr;
+# if defined(MSWIN32) || defined(MSWINCE)
+ while (len != 0) {
+ MEMORY_BASIC_INFORMATION mem_info;
+ GC_word free_len;
+ if (VirtualQuery(start_addr, &mem_info, sizeof(mem_info))
+ != sizeof(mem_info))
+ ABORT("Weird VirtualQuery result");
+ free_len = (len < mem_info.RegionSize) ? len : mem_info.RegionSize;
+ if (!VirtualFree(start_addr, free_len, MEM_DECOMMIT))
+ ABORT("VirtualFree failed");
+ GC_unmapped_bytes += free_len;
+ start_addr += free_len;
+ len -= free_len;
+ }
+# else
+ if (len != 0 && munmap(start_addr, len) != 0) ABORT("munmap failed");
+ GC_unmapped_bytes += len;
+# endif
+}
+
+#endif /* USE_MUNMAP */
+
+/* Routine for pushing any additional roots. In THREADS */
+/* environment, this is also responsible for marking from */
+/* thread stacks. */
+#ifndef THREADS
+void (*GC_push_other_roots)() = 0;
+#else /* THREADS */
+
+# ifdef PCR
+PCR_ERes GC_push_thread_stack(PCR_Th_T *t, PCR_Any dummy)
+{
+ struct PCR_ThCtl_TInfoRep info;
+ PCR_ERes result;
+
+ info.ti_stkLow = info.ti_stkHi = 0;
+ result = PCR_ThCtl_GetInfo(t, &info);
+ GC_push_all_stack((ptr_t)(info.ti_stkLow), (ptr_t)(info.ti_stkHi));
+ return(result);
+}
+
+/* Push the contents of an old object. We treat this as stack */
+/* data only becasue that makes it robust against mark stack */
+/* overflow. */
+PCR_ERes GC_push_old_obj(void *p, size_t size, PCR_Any data)
+{
+ GC_push_all_stack((ptr_t)p, (ptr_t)p + size);
+ return(PCR_ERes_okay);
+}
+
+
+void GC_default_push_other_roots GC_PROTO((void))
+{
+ /* Traverse data allocated by previous memory managers. */
+ {
+ extern struct PCR_MM_ProcsRep * GC_old_allocator;
+
+ if ((*(GC_old_allocator->mmp_enumerate))(PCR_Bool_false,
+ GC_push_old_obj, 0)
+ != PCR_ERes_okay) {
+ ABORT("Old object enumeration failed");
+ }
+ }
+ /* Traverse all thread stacks. */
+ if (PCR_ERes_IsErr(
+ PCR_ThCtl_ApplyToAllOtherThreads(GC_push_thread_stack,0))
+ || PCR_ERes_IsErr(GC_push_thread_stack(PCR_Th_CurrThread(), 0))) {
+ ABORT("Thread stack marking failed\n");
+ }
+}
+
+# endif /* PCR */
+
+# ifdef SRC_M3
+
+# ifdef ALL_INTERIOR_POINTERS
+ --> misconfigured
+# endif
+
+void GC_push_thread_structures GC_PROTO((void))
+{
+ /* Not our responsibibility. */
+}
+
+extern void ThreadF__ProcessStacks();
+
+void GC_push_thread_stack(start, stop)
+word start, stop;
+{
+ GC_push_all_stack((ptr_t)start, (ptr_t)stop + sizeof(word));
+}
+
+/* Push routine with M3 specific calling convention. */
+GC_m3_push_root(dummy1, p, dummy2, dummy3)
+word *p;
+ptr_t dummy1, dummy2;
+int dummy3;
+{
+ word q = *p;
+
+ GC_PUSH_ONE_STACK(q, p);
+}
+
+/* M3 set equivalent to RTHeap.TracedRefTypes */
+typedef struct { int elts[1]; } RefTypeSet;
+RefTypeSet GC_TracedRefTypes = {{0x1}};
+
+void GC_default_push_other_roots GC_PROTO((void))
+{
+ /* Use the M3 provided routine for finding static roots. */
+ /* This is a bit dubious, since it presumes no C roots. */
+ /* We handle the collector roots explicitly in GC_push_roots */
+ RTMain__GlobalMapProc(GC_m3_push_root, 0, GC_TracedRefTypes);
+ if (GC_words_allocd > 0) {
+ ThreadF__ProcessStacks(GC_push_thread_stack);
+ }
+ /* Otherwise this isn't absolutely necessary, and we have */
+ /* startup ordering problems. */
+}
+
+# endif /* SRC_M3 */
+
+# if defined(GC_SOLARIS_THREADS) || defined(GC_PTHREADS) || \
+ defined(GC_WIN32_THREADS)
+
+extern void GC_push_all_stacks();
+
+void GC_default_push_other_roots GC_PROTO((void))
+{
+ GC_push_all_stacks();
+}
+
+# endif /* GC_SOLARIS_THREADS || GC_PTHREADS */
+
+void (*GC_push_other_roots) GC_PROTO((void)) = GC_default_push_other_roots;
+
+#endif /* THREADS */
+
+/*
+ * Routines for accessing dirty bits on virtual pages.
+ * We plan to eventually implement four strategies for doing so:
+ * DEFAULT_VDB: A simple dummy implementation that treats every page
+ * as possibly dirty. This makes incremental collection
+ * useless, but the implementation is still correct.
+ * PCR_VDB: Use PPCRs virtual dirty bit facility.
+ * PROC_VDB: Use the /proc facility for reading dirty bits. Only
+ * works under some SVR4 variants. Even then, it may be
+ * too slow to be entirely satisfactory. Requires reading
+ * dirty bits for entire address space. Implementations tend
+ * to assume that the client is a (slow) debugger.
+ * MPROTECT_VDB:Protect pages and then catch the faults to keep track of
+ * dirtied pages. The implementation (and implementability)
+ * is highly system dependent. This usually fails when system
+ * calls write to a protected page. We prevent the read system
+ * call from doing so. It is the clients responsibility to
+ * make sure that other system calls are similarly protected
+ * or write only to the stack.
+ */
+
+GC_bool GC_dirty_maintained = FALSE;
+
+# ifdef DEFAULT_VDB
+
+/* All of the following assume the allocation lock is held, and */
+/* signals are disabled. */
+
+/* The client asserts that unallocated pages in the heap are never */
+/* written. */
+
+/* Initialize virtual dirty bit implementation. */
+void GC_dirty_init()
+{
+ GC_dirty_maintained = TRUE;
+}
+
+/* Retrieve system dirty bits for heap to a local buffer. */
+/* Restore the systems notion of which pages are dirty. */
+void GC_read_dirty()
+{}
+
+/* Is the HBLKSIZE sized page at h marked dirty in the local buffer? */
+/* If the actual page size is different, this returns TRUE if any */
+/* of the pages overlapping h are dirty. This routine may err on the */
+/* side of labelling pages as dirty (and this implementation does). */
+/*ARGSUSED*/
+GC_bool GC_page_was_dirty(h)
+struct hblk *h;
+{
+ return(TRUE);
+}
+
+/*
+ * The following two routines are typically less crucial. They matter
+ * most with large dynamic libraries, or if we can't accurately identify
+ * stacks, e.g. under Solaris 2.X. Otherwise the following default
+ * versions are adequate.
+ */
+
+/* Could any valid GC heap pointer ever have been written to this page? */
+/*ARGSUSED*/
+GC_bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+ return(TRUE);
+}
+
+/* Reset the n pages starting at h to "was never dirty" status. */
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+}
+
+/* A call that: */
+/* I) hints that [h, h+nblocks) is about to be written. */
+/* II) guarantees that protection is removed. */
+/* (I) may speed up some dirty bit implementations. */
+/* (II) may be essential if we need to ensure that */
+/* pointer-free system call buffers in the heap are */
+/* not protected. */
+/*ARGSUSED*/
+void GC_remove_protection(h, nblocks, is_ptrfree)
+struct hblk *h;
+word nblocks;
+GC_bool is_ptrfree;
+{
+}
+
+# endif /* DEFAULT_VDB */
+
+
+# ifdef MPROTECT_VDB
+
+/*
+ * See DEFAULT_VDB for interface descriptions.
+ */
+
+/*
+ * This implementation maintains dirty bits itself by catching write
+ * faults and keeping track of them. We assume nobody else catches
+ * SIGBUS or SIGSEGV. We assume no write faults occur in system calls.
+ * This means that clients must ensure that system calls don't write
+ * to the write-protected heap. Probably the best way to do this is to
+ * ensure that system calls write at most to POINTERFREE objects in the
+ * heap, and do even that only if we are on a platform on which those
+ * are not protected. Another alternative is to wrap system calls
+ * (see example for read below), but the current implementation holds
+ * a lock across blocking calls, making it problematic for multithreaded
+ * applications.
+ * We assume the page size is a multiple of HBLKSIZE.
+ * We prefer them to be the same. We avoid protecting POINTERFREE
+ * objects only if they are the same.
+ */
+
+# if !defined(MSWIN32) && !defined(MSWINCE)
+
+# include <sys/mman.h>
+# include <signal.h>
+# include <sys/syscall.h>
+
+# define PROTECT(addr, len) \
+ if (mprotect((caddr_t)(addr), (size_t)(len), \
+ PROT_READ | OPT_PROT_EXEC) < 0) { \
+ ABORT("mprotect failed"); \
+ }
+# define UNPROTECT(addr, len) \
+ if (mprotect((caddr_t)(addr), (size_t)(len), \
+ PROT_WRITE | PROT_READ | OPT_PROT_EXEC ) < 0) { \
+ ABORT("un-mprotect failed"); \
+ }
+
+# else
+
+# ifndef MSWINCE
+# include <signal.h>
+# endif
+
+ static DWORD protect_junk;
+# define PROTECT(addr, len) \
+ if (!VirtualProtect((addr), (len), PAGE_EXECUTE_READ, \
+ &protect_junk)) { \
+ DWORD last_error = GetLastError(); \
+ GC_printf1("Last error code: %lx\n", last_error); \
+ ABORT("VirtualProtect failed"); \
+ }
+# define UNPROTECT(addr, len) \
+ if (!VirtualProtect((addr), (len), PAGE_EXECUTE_READWRITE, \
+ &protect_junk)) { \
+ ABORT("un-VirtualProtect failed"); \
+ }
+
+# endif
+
+#if defined(SUNOS4) || defined(FREEBSD)
+ typedef void (* SIG_PF)();
+#endif
+#if defined(SUNOS5SIGS) || defined(OSF1) || defined(LINUX) \
+ || defined(MACOSX) || defined(HURD)
+# ifdef __STDC__
+ typedef void (* SIG_PF)(int);
+# else
+ typedef void (* SIG_PF)();
+# endif
+#endif
+#if defined(MSWIN32)
+ typedef LPTOP_LEVEL_EXCEPTION_FILTER SIG_PF;
+# undef SIG_DFL
+# define SIG_DFL (LPTOP_LEVEL_EXCEPTION_FILTER) (-1)
+#endif
+#if defined(MSWINCE)
+ typedef LONG (WINAPI *SIG_PF)(struct _EXCEPTION_POINTERS *);
+# undef SIG_DFL
+# define SIG_DFL (SIG_PF) (-1)
+#endif
+
+#if defined(IRIX5) || defined(OSF1) || defined(HURD)
+ typedef void (* REAL_SIG_PF)(int, int, struct sigcontext *);
+#endif
+#if defined(SUNOS5SIGS)
+# ifdef HPUX
+# define SIGINFO __siginfo
+# else
+# define SIGINFO siginfo
+# endif
+# ifdef __STDC__
+ typedef void (* REAL_SIG_PF)(int, struct SIGINFO *, void *);
+# else
+ typedef void (* REAL_SIG_PF)();
+# endif
+#endif
+#if defined(LINUX)
+# if __GLIBC__ > 2 || __GLIBC__ == 2 && __GLIBC_MINOR__ >= 2
+ typedef struct sigcontext s_c;
+# else /* glibc < 2.2 */
+# include <linux/version.h>
+# if (LINUX_VERSION_CODE >= 0x20100) && !defined(M68K) || defined(ALPHA) || defined(ARM32)
+ typedef struct sigcontext s_c;
+# else
+ typedef struct sigcontext_struct s_c;
+# endif
+# endif /* glibc < 2.2 */
+# if defined(ALPHA) || defined(M68K)
+ typedef void (* REAL_SIG_PF)(int, int, s_c *);
+# else
+# if defined(IA64) || defined(HP_PA)
+ typedef void (* REAL_SIG_PF)(int, siginfo_t *, s_c *);
+# else
+ typedef void (* REAL_SIG_PF)(int, s_c);
+# endif
+# endif
+# ifdef ALPHA
+ /* Retrieve fault address from sigcontext structure by decoding */
+ /* instruction. */
+ char * get_fault_addr(s_c *sc) {
+ unsigned instr;
+ word faultaddr;
+
+ instr = *((unsigned *)(sc->sc_pc));
+ faultaddr = sc->sc_regs[(instr >> 16) & 0x1f];
+ faultaddr += (word) (((int)instr << 16) >> 16);
+ return (char *)faultaddr;
+ }
+# endif /* !ALPHA */
+# endif
+
+# if defined(MACOSX) /* Should also test for PowerPC? */
+ typedef void (* REAL_SIG_PF)(int, int, struct sigcontext *);
+
+/* Decodes the machine instruction which was responsible for the sending of the
+ SIGBUS signal. Sadly this is the only way to find the faulting address because
+ the signal handler doesn't get it directly from the kernel (although it is
+ available on the Mach level, but droppped by the BSD personality before it
+ calls our signal handler...)
+ This code should be able to deal correctly with all PPCs starting from the
+ 601 up to and including the G4s (including Velocity Engine). */
+#define EXTRACT_OP1(iw) (((iw) & 0xFC000000) >> 26)
+#define EXTRACT_OP2(iw) (((iw) & 0x000007FE) >> 1)
+#define EXTRACT_REGA(iw) (((iw) & 0x001F0000) >> 16)
+#define EXTRACT_REGB(iw) (((iw) & 0x03E00000) >> 21)
+#define EXTRACT_REGC(iw) (((iw) & 0x0000F800) >> 11)
+#define EXTRACT_DISP(iw) ((short *) &(iw))[1]
+
+static char *get_fault_addr(struct sigcontext *scp)
+{
+ unsigned int instr = *((unsigned int *) scp->sc_ir);
+ unsigned int * regs = &((unsigned int *) scp->sc_regs)[2];
+ int disp = 0, tmp;
+ unsigned int baseA = 0, baseB = 0;
+ unsigned int addr, alignmask = 0xFFFFFFFF;
+
+#ifdef GC_DEBUG_DECODER
+ GC_err_printf1("Instruction: 0x%lx\n", instr);
+ GC_err_printf1("Opcode 1: d\n", (int)EXTRACT_OP1(instr));
+#endif
+ switch(EXTRACT_OP1(instr)) {
+ case 38: /* stb */
+ case 39: /* stbu */
+ case 54: /* stfd */
+ case 55: /* stfdu */
+ case 52: /* stfs */
+ case 53: /* stfsu */
+ case 44: /* sth */
+ case 45: /* sthu */
+ case 47: /* stmw */
+ case 36: /* stw */
+ case 37: /* stwu */
+ tmp = EXTRACT_REGA(instr);
+ if(tmp > 0)
+ baseA = regs[tmp];
+ disp = EXTRACT_DISP(instr);
+ break;
+ case 31:
+#ifdef GC_DEBUG_DECODER
+ GC_err_printf1("Opcode 2: %d\n", (int)EXTRACT_OP2(instr));
+#endif
+ switch(EXTRACT_OP2(instr)) {
+ case 86: /* dcbf */
+ case 54: /* dcbst */
+ case 1014: /* dcbz */
+ case 247: /* stbux */
+ case 215: /* stbx */
+ case 759: /* stfdux */
+ case 727: /* stfdx */
+ case 983: /* stfiwx */
+ case 695: /* stfsux */
+ case 663: /* stfsx */
+ case 918: /* sthbrx */
+ case 439: /* sthux */
+ case 407: /* sthx */
+ case 661: /* stswx */
+ case 662: /* stwbrx */
+ case 150: /* stwcx. */
+ case 183: /* stwux */
+ case 151: /* stwx */
+ case 135: /* stvebx */
+ case 167: /* stvehx */
+ case 199: /* stvewx */
+ case 231: /* stvx */
+ case 487: /* stvxl */
+ tmp = EXTRACT_REGA(instr);
+ if(tmp > 0)
+ baseA = regs[tmp];
+ baseB = regs[EXTRACT_REGC(instr)];
+ /* determine Altivec alignment mask */
+ switch(EXTRACT_OP2(instr)) {
+ case 167: /* stvehx */
+ alignmask = 0xFFFFFFFE;
+ break;
+ case 199: /* stvewx */
+ alignmask = 0xFFFFFFFC;
+ break;
+ case 231: /* stvx */
+ alignmask = 0xFFFFFFF0;
+ break;
+ case 487: /* stvxl */
+ alignmask = 0xFFFFFFF0;
+ break;
+ }
+ break;
+ case 725: /* stswi */
+ tmp = EXTRACT_REGA(instr);
+ if(tmp > 0)
+ baseA = regs[tmp];
+ break;
+ default: /* ignore instruction */
+#ifdef GC_DEBUG_DECODER
+ GC_err_printf("Ignored by inner handler\n");
+#endif
+ return NULL;
+ break;
+ }
+ break;
+ default: /* ignore instruction */
+#ifdef GC_DEBUG_DECODER
+ GC_err_printf("Ignored by main handler\n");
+#endif
+ return NULL;
+ break;
+ }
+
+ addr = (baseA + baseB) + disp;
+ addr &= alignmask;
+#ifdef GC_DEBUG_DECODER
+ GC_err_printf1("BaseA: %d\n", baseA);
+ GC_err_printf1("BaseB: %d\n", baseB);
+ GC_err_printf1("Disp: %d\n", disp);
+ GC_err_printf1("Address: %d\n", addr);
+#endif
+ return (char *)addr;
+}
+#endif /* MACOSX */
+
+SIG_PF GC_old_bus_handler;
+SIG_PF GC_old_segv_handler; /* Also old MSWIN32 ACCESS_VIOLATION filter */
+
+#ifdef THREADS
+/* We need to lock around the bitmap update in the write fault handler */
+/* in order to avoid the risk of losing a bit. We do this with a */
+/* test-and-set spin lock if we know how to do that. Otherwise we */
+/* check whether we are already in the handler and use the dumb but */
+/* safe fallback algorithm of setting all bits in the word. */
+/* Contention should be very rare, so we do the minimum to handle it */
+/* correctly. */
+#ifdef GC_TEST_AND_SET_DEFINED
+ static VOLATILE unsigned int fault_handler_lock = 0;
+ void async_set_pht_entry_from_index(VOLATILE page_hash_table db, int index) {
+ while (GC_test_and_set(&fault_handler_lock)) {}
+ /* Could also revert to set_pht_entry_from_index_safe if initial */
+ /* GC_test_and_set fails. */
+ set_pht_entry_from_index(db, index);
+ GC_clear(&fault_handler_lock);
+ }
+#else /* !GC_TEST_AND_SET_DEFINED */
+ /* THIS IS INCORRECT! The dirty bit vector may be temporarily wrong, */
+ /* just before we notice the conflict and correct it. We may end up */
+ /* looking at it while it's wrong. But this requires contention */
+ /* exactly when a GC is triggered, which seems far less likely to */
+ /* fail than the old code, which had no reported failures. Thus we */
+ /* leave it this way while we think of something better, or support */
+ /* GC_test_and_set on the remaining platforms. */
+ static VOLATILE word currently_updating = 0;
+ void async_set_pht_entry_from_index(VOLATILE page_hash_table db, int index) {
+ unsigned int update_dummy;
+ currently_updating = (word)(&update_dummy);
+ set_pht_entry_from_index(db, index);
+ /* If we get contention in the 10 or so instruction window here, */
+ /* and we get stopped by a GC between the two updates, we lose! */
+ if (currently_updating != (word)(&update_dummy)) {
+ set_pht_entry_from_index_safe(db, index);
+ /* We claim that if two threads concurrently try to update the */
+ /* dirty bit vector, the first one to execute UPDATE_START */
+ /* will see it changed when UPDATE_END is executed. (Note that */
+ /* &update_dummy must differ in two distinct threads.) It */
+ /* will then execute set_pht_entry_from_index_safe, thus */
+ /* returning us to a safe state, though not soon enough. */
+ }
+ }
+#endif /* !GC_TEST_AND_SET_DEFINED */
+#else /* !THREADS */
+# define async_set_pht_entry_from_index(db, index) \
+ set_pht_entry_from_index(db, index)
+#endif /* !THREADS */
+
+/*ARGSUSED*/
+# if defined (SUNOS4) || defined(FREEBSD)
+ void GC_write_fault_handler(sig, code, scp, addr)
+ int sig, code;
+ struct sigcontext *scp;
+ char * addr;
+# ifdef SUNOS4
+# define SIG_OK (sig == SIGSEGV || sig == SIGBUS)
+# define CODE_OK (FC_CODE(code) == FC_PROT \
+ || (FC_CODE(code) == FC_OBJERR \
+ && FC_ERRNO(code) == FC_PROT))
+# endif
+# ifdef FREEBSD
+# define SIG_OK (sig == SIGBUS)
+# define CODE_OK (code == BUS_PAGE_FAULT)
+# endif
+# endif
+# if defined(IRIX5) || defined(OSF1) || defined(HURD)
+# include <errno.h>
+ void GC_write_fault_handler(int sig, int code, struct sigcontext *scp)
+# ifdef OSF1
+# define SIG_OK (sig == SIGSEGV)
+# define CODE_OK (code == 2 /* experimentally determined */)
+# endif
+# ifdef IRIX5
+# define SIG_OK (sig == SIGSEGV)
+# define CODE_OK (code == EACCES)
+# endif
+# ifdef HURD
+# define SIG_OK (sig == SIGBUS || sig == SIGSEGV)
+# define CODE_OK TRUE
+# endif
+# endif
+# if defined(LINUX)
+# if defined(ALPHA) || defined(M68K)
+ void GC_write_fault_handler(int sig, int code, s_c * sc)
+# else
+# if defined(IA64) || defined(HP_PA)
+ void GC_write_fault_handler(int sig, siginfo_t * si, s_c * scp)
+# else
+# if defined(ARM32)
+ void GC_write_fault_handler(int sig, int a2, int a3, int a4, s_c sc)
+# else
+ void GC_write_fault_handler(int sig, s_c sc)
+# endif
+# endif
+# endif
+# define SIG_OK (sig == SIGSEGV)
+# define CODE_OK TRUE
+ /* Empirically c.trapno == 14, on IA32, but is that useful? */
+ /* Should probably consider alignment issues on other */
+ /* architectures. */
+# endif
+# if defined(SUNOS5SIGS)
+# ifdef __STDC__
+ void GC_write_fault_handler(int sig, struct SIGINFO *scp, void * context)
+# else
+ void GC_write_fault_handler(sig, scp, context)
+ int sig;
+ struct SIGINFO *scp;
+ void * context;
+# endif
+# ifdef HPUX
+# define SIG_OK (sig == SIGSEGV || sig == SIGBUS)
+# define CODE_OK (scp -> si_code == SEGV_ACCERR) \
+ || (scp -> si_code == BUS_ADRERR) \
+ || (scp -> si_code == BUS_UNKNOWN) \
+ || (scp -> si_code == SEGV_UNKNOWN) \
+ || (scp -> si_code == BUS_OBJERR)
+# else
+# define SIG_OK (sig == SIGSEGV)
+# define CODE_OK (scp -> si_code == SEGV_ACCERR)
+# endif
+# endif
+
+# if defined(MACOSX)
+ void GC_write_fault_handler(int sig, int code, struct sigcontext *scp)
+# define SIG_OK (sig == SIGBUS)
+# define CODE_OK (code == 0 /* experimentally determined */)
+# endif
+
+# if defined(MSWIN32) || defined(MSWINCE)
+ LONG WINAPI GC_write_fault_handler(struct _EXCEPTION_POINTERS *exc_info)
+# define SIG_OK (exc_info -> ExceptionRecord -> ExceptionCode == \
+ STATUS_ACCESS_VIOLATION)
+# define CODE_OK (exc_info -> ExceptionRecord -> ExceptionInformation[0] == 1)
+ /* Write fault */
+# endif
+{
+ register unsigned i;
+# if defined(HURD)
+ char *addr = (char *) code;
+# endif
+# ifdef IRIX5
+ char * addr = (char *) (size_t) (scp -> sc_badvaddr);
+# endif
+# if defined(OSF1) && defined(ALPHA)
+ char * addr = (char *) (scp -> sc_traparg_a0);
+# endif
+# ifdef SUNOS5SIGS
+ char * addr = (char *) (scp -> si_addr);
+# endif
+# ifdef LINUX
+# if defined(I386) || defined (X86_64)
+ char * addr = (char *) (sc.cr2);
+# else
+# if defined(M68K)
+ char * addr = NULL;
+
+ struct sigcontext *scp = (struct sigcontext *)(sc);
+
+ int format = (scp->sc_formatvec >> 12) & 0xf;
+ unsigned long *framedata = (unsigned long *)(scp + 1);
+ unsigned long ea;
+
+ if (format == 0xa || format == 0xb) {
+ /* 68020/030 */
+ ea = framedata[2];
+ } else if (format == 7) {
+ /* 68040 */
+ ea = framedata[3];
+ if (framedata[1] & 0x08000000) {
+ /* correct addr on misaligned access */
+ ea = (ea+4095)&(~4095);
+ }
+ } else if (format == 4) {
+ /* 68060 */
+ ea = framedata[0];
+ if (framedata[1] & 0x08000000) {
+ /* correct addr on misaligned access */
+ ea = (ea+4095)&(~4095);
+ }
+ }
+ addr = (char *)ea;
+# else
+# ifdef ALPHA
+ char * addr = get_fault_addr(sc);
+# else
+# if defined(IA64) || defined(HP_PA)
+ char * addr = si -> si_addr;
+ /* I believe this is claimed to work on all platforms for */
+ /* Linux 2.3.47 and later. Hopefully we don't have to */
+ /* worry about earlier kernels on IA64. */
+# else
+# if defined(POWERPC)
+ char * addr = (char *) (sc.regs->dar);
+# else
+# if defined(ARM32)
+ char * addr = (char *)sc.fault_address;
+# else
+ --> architecture not supported
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# if defined(MACOSX)
+ char * addr = get_fault_addr(scp);
+# endif
+# if defined(MSWIN32) || defined(MSWINCE)
+ char * addr = (char *) (exc_info -> ExceptionRecord
+ -> ExceptionInformation[1]);
+# define sig SIGSEGV
+# endif
+
+ if (SIG_OK && CODE_OK) {
+ register struct hblk * h =
+ (struct hblk *)((word)addr & ~(GC_page_size-1));
+ GC_bool in_allocd_block;
+
+# ifdef SUNOS5SIGS
+ /* Address is only within the correct physical page. */
+ in_allocd_block = FALSE;
+ for (i = 0; i < divHBLKSZ(GC_page_size); i++) {
+ if (HDR(h+i) != 0) {
+ in_allocd_block = TRUE;
+ }
+ }
+# else
+ in_allocd_block = (HDR(addr) != 0);
+# endif
+ if (!in_allocd_block) {
+ /* Heap blocks now begin and end on page boundaries */
+ SIG_PF old_handler;
+
+ if (sig == SIGSEGV) {
+ old_handler = GC_old_segv_handler;
+ } else {
+ old_handler = GC_old_bus_handler;
+ }
+ if (old_handler == SIG_DFL) {
+# if !defined(MSWIN32) && !defined(MSWINCE)
+ GC_err_printf1("Segfault at 0x%lx\n", addr);
+ ABORT("Unexpected bus error or segmentation fault");
+# else
+ return(EXCEPTION_CONTINUE_SEARCH);
+# endif
+ } else {
+# if defined (SUNOS4) || defined(FREEBSD)
+ (*old_handler) (sig, code, scp, addr);
+ return;
+# endif
+# if defined (SUNOS5SIGS)
+ (*(REAL_SIG_PF)old_handler) (sig, scp, context);
+ return;
+# endif
+# if defined (LINUX)
+# if defined(ALPHA) || defined(M68K)
+ (*(REAL_SIG_PF)old_handler) (sig, code, sc);
+# else
+# if defined(IA64) || defined(HP_PA)
+ (*(REAL_SIG_PF)old_handler) (sig, si, scp);
+# else
+ (*(REAL_SIG_PF)old_handler) (sig, sc);
+# endif
+# endif
+ return;
+# endif
+# if defined (IRIX5) || defined(OSF1) || defined(HURD)
+ (*(REAL_SIG_PF)old_handler) (sig, code, scp);
+ return;
+# endif
+# ifdef MACOSX
+ (*(REAL_SIG_PF)old_handler) (sig, code, scp);
+# endif
+# ifdef MSWIN32
+ return((*old_handler)(exc_info));
+# endif
+ }
+ }
+ UNPROTECT(h, GC_page_size);
+ /* We need to make sure that no collection occurs between */
+ /* the UNPROTECT and the setting of the dirty bit. Otherwise */
+ /* a write by a third thread might go unnoticed. Reversing */
+ /* the order is just as bad, since we would end up unprotecting */
+ /* a page in a GC cycle during which it's not marked. */
+ /* Currently we do this by disabling the thread stopping */
+ /* signals while this handler is running. An alternative might */
+ /* be to record the fact that we're about to unprotect, or */
+ /* have just unprotected a page in the GC's thread structure, */
+ /* and then to have the thread stopping code set the dirty */
+ /* flag, if necessary. */
+ for (i = 0; i < divHBLKSZ(GC_page_size); i++) {
+ register int index = PHT_HASH(h+i);
+
+ async_set_pht_entry_from_index(GC_dirty_pages, index);
+ }
+# if defined(OSF1)
+ /* These reset the signal handler each time by default. */
+ signal(SIGSEGV, (SIG_PF) GC_write_fault_handler);
+# endif
+ /* The write may not take place before dirty bits are read. */
+ /* But then we'll fault again ... */
+# if defined(MSWIN32) || defined(MSWINCE)
+ return(EXCEPTION_CONTINUE_EXECUTION);
+# else
+ return;
+# endif
+ }
+#if defined(MSWIN32) || defined(MSWINCE)
+ return EXCEPTION_CONTINUE_SEARCH;
+#else
+ GC_err_printf1("Segfault at 0x%lx\n", addr);
+ ABORT("Unexpected bus error or segmentation fault");
+#endif
+}
+
+/*
+ * We hold the allocation lock. We expect block h to be written
+ * shortly. Ensure that all pages containing any part of the n hblks
+ * starting at h are no longer protected. If is_ptrfree is false,
+ * also ensure that they will subsequently appear to be dirty.
+ */
+void GC_remove_protection(h, nblocks, is_ptrfree)
+struct hblk *h;
+word nblocks;
+GC_bool is_ptrfree;
+{
+ struct hblk * h_trunc; /* Truncated to page boundary */
+ struct hblk * h_end; /* Page boundary following block end */
+ struct hblk * current;
+ GC_bool found_clean;
+
+ if (!GC_dirty_maintained) return;
+ h_trunc = (struct hblk *)((word)h & ~(GC_page_size-1));
+ h_end = (struct hblk *)(((word)(h + nblocks) + GC_page_size-1)
+ & ~(GC_page_size-1));
+ found_clean = FALSE;
+ for (current = h_trunc; current < h_end; ++current) {
+ int index = PHT_HASH(current);
+
+ if (!is_ptrfree || current < h || current >= h + nblocks) {
+ async_set_pht_entry_from_index(GC_dirty_pages, index);
+ }
+ }
+ UNPROTECT(h_trunc, (ptr_t)h_end - (ptr_t)h_trunc);
+}
+
+void GC_dirty_init()
+{
+# if defined(SUNOS5SIGS) || defined(IRIX5) || defined(LINUX) || \
+ defined(OSF1) || defined(HURD)
+ struct sigaction act, oldact;
+ /* We should probably specify SA_SIGINFO for Linux, and handle */
+ /* the different architectures more uniformly. */
+# if defined(IRIX5) || defined(LINUX) || defined(OSF1) || defined(HURD)
+ act.sa_flags = SA_RESTART;
+ act.sa_handler = (SIG_PF)GC_write_fault_handler;
+# else
+ act.sa_flags = SA_RESTART | SA_SIGINFO;
+ act.sa_sigaction = GC_write_fault_handler;
+# endif
+ (void)sigemptyset(&act.sa_mask);
+# ifdef SIG_SUSPEND
+ /* Arrange to postpone SIG_SUSPEND while we're in a write fault */
+ /* handler. This effectively makes the handler atomic w.r.t. */
+ /* stopping the world for GC. */
+ (void)sigaddset(&act.sa_mask, SIG_SUSPEND);
+# endif /* SIG_SUSPEND */
+# endif
+# if defined(MACOSX)
+ struct sigaction act, oldact;
+
+ act.sa_flags = SA_RESTART;
+ act.sa_handler = GC_write_fault_handler;
+ sigemptyset(&act.sa_mask);
+# endif
+# ifdef PRINTSTATS
+ GC_printf0("Inititalizing mprotect virtual dirty bit implementation\n");
+# endif
+ GC_dirty_maintained = TRUE;
+ if (GC_page_size % HBLKSIZE != 0) {
+ GC_err_printf0("Page size not multiple of HBLKSIZE\n");
+ ABORT("Page size not multiple of HBLKSIZE");
+ }
+# if defined(SUNOS4) || defined(FREEBSD)
+ GC_old_bus_handler = signal(SIGBUS, GC_write_fault_handler);
+ if (GC_old_bus_handler == SIG_IGN) {
+ GC_err_printf0("Previously ignored bus error!?");
+ GC_old_bus_handler = SIG_DFL;
+ }
+ if (GC_old_bus_handler != SIG_DFL) {
+# ifdef PRINTSTATS
+ GC_err_printf0("Replaced other SIGBUS handler\n");
+# endif
+ }
+# endif
+# if defined(SUNOS4)
+ GC_old_segv_handler = signal(SIGSEGV, (SIG_PF)GC_write_fault_handler);
+ if (GC_old_segv_handler == SIG_IGN) {
+ GC_err_printf0("Previously ignored segmentation violation!?");
+ GC_old_segv_handler = SIG_DFL;
+ }
+ if (GC_old_segv_handler != SIG_DFL) {
+# ifdef PRINTSTATS
+ GC_err_printf0("Replaced other SIGSEGV handler\n");
+# endif
+ }
+# endif
+# if defined(SUNOS5SIGS) || defined(IRIX5) || defined(LINUX) \
+ || defined(OSF1) || defined(HURD)
+ /* SUNOS5SIGS includes HPUX */
+# if defined(GC_IRIX_THREADS)
+ sigaction(SIGSEGV, 0, &oldact);
+ sigaction(SIGSEGV, &act, 0);
+# else
+ sigaction(SIGSEGV, &act, &oldact);
+# endif
+# if defined(_sigargs) || defined(HURD) || !defined(SA_SIGINFO)
+ /* This is Irix 5.x, not 6.x. Irix 5.x does not have */
+ /* sa_sigaction. */
+ GC_old_segv_handler = oldact.sa_handler;
+# else /* Irix 6.x or SUNOS5SIGS or LINUX */
+ if (oldact.sa_flags & SA_SIGINFO) {
+ GC_old_segv_handler = (SIG_PF)(oldact.sa_sigaction);
+ } else {
+ GC_old_segv_handler = oldact.sa_handler;
+ }
+# endif
+ if (GC_old_segv_handler == SIG_IGN) {
+ GC_err_printf0("Previously ignored segmentation violation!?");
+ GC_old_segv_handler = SIG_DFL;
+ }
+ if (GC_old_segv_handler != SIG_DFL) {
+# ifdef PRINTSTATS
+ GC_err_printf0("Replaced other SIGSEGV handler\n");
+# endif
+ }
+# endif
+# if defined(MACOSX) || defined(HPUX) || defined(LINUX) || defined(HURD)
+ sigaction(SIGBUS, &act, &oldact);
+ GC_old_bus_handler = oldact.sa_handler;
+ if (GC_old_bus_handler == SIG_IGN) {
+ GC_err_printf0("Previously ignored bus error!?");
+ GC_old_bus_handler = SIG_DFL;
+ }
+ if (GC_old_bus_handler != SIG_DFL) {
+# ifdef PRINTSTATS
+ GC_err_printf0("Replaced other SIGBUS handler\n");
+# endif
+ }
+# endif /* MACOS || HPUX || LINUX */
+# if defined(MSWIN32)
+ GC_old_segv_handler = SetUnhandledExceptionFilter(GC_write_fault_handler);
+ if (GC_old_segv_handler != NULL) {
+# ifdef PRINTSTATS
+ GC_err_printf0("Replaced other UnhandledExceptionFilter\n");
+# endif
+ } else {
+ GC_old_segv_handler = SIG_DFL;
+ }
+# endif
+}
+
+int GC_incremental_protection_needs()
+{
+ if (GC_page_size == HBLKSIZE) {
+ return GC_PROTECTS_POINTER_HEAP;
+ } else {
+ return GC_PROTECTS_POINTER_HEAP | GC_PROTECTS_PTRFREE_HEAP;
+ }
+}
+
+#define HAVE_INCREMENTAL_PROTECTION_NEEDS
+
+#define IS_PTRFREE(hhdr) ((hhdr)->hb_descr == 0)
+
+#define PAGE_ALIGNED(x) !((word)(x) & (GC_page_size - 1))
+void GC_protect_heap()
+{
+ ptr_t start;
+ word len;
+ struct hblk * current;
+ struct hblk * current_start; /* Start of block to be protected. */
+ struct hblk * limit;
+ unsigned i;
+ GC_bool protect_all =
+ (0 != (GC_incremental_protection_needs() & GC_PROTECTS_PTRFREE_HEAP));
+ for (i = 0; i < GC_n_heap_sects; i++) {
+ start = GC_heap_sects[i].hs_start;
+ len = GC_heap_sects[i].hs_bytes;
+ if (protect_all) {
+ PROTECT(start, len);
+ } else {
+ GC_ASSERT(PAGE_ALIGNED(len))
+ GC_ASSERT(PAGE_ALIGNED(start))
+ current_start = current = (struct hblk *)start;
+ limit = (struct hblk *)(start + len);
+ while (current < limit) {
+ hdr * hhdr;
+ word nhblks;
+ GC_bool is_ptrfree;
+
+ GC_ASSERT(PAGE_ALIGNED(current));
+ GET_HDR(current, hhdr);
+ if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ /* This can happen only if we're at the beginning of a */
+ /* heap segment, and a block spans heap segments. */
+ /* We will handle that block as part of the preceding */
+ /* segment. */
+ GC_ASSERT(current_start == current);
+ current_start = ++current;
+ continue;
+ }
+ if (HBLK_IS_FREE(hhdr)) {
+ GC_ASSERT(PAGE_ALIGNED(hhdr -> hb_sz));
+ nhblks = divHBLKSZ(hhdr -> hb_sz);
+ is_ptrfree = TRUE; /* dirty on alloc */
+ } else {
+ nhblks = OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz);
+ is_ptrfree = IS_PTRFREE(hhdr);
+ }
+ if (is_ptrfree) {
+ if (current_start < current) {
+ PROTECT(current_start, (ptr_t)current - (ptr_t)current_start);
+ }
+ current_start = (current += nhblks);
+ } else {
+ current += nhblks;
+ }
+ }
+ if (current_start < current) {
+ PROTECT(current_start, (ptr_t)current - (ptr_t)current_start);
+ }
+ }
+ }
+}
+
+/* We assume that either the world is stopped or its OK to lose dirty */
+/* bits while this is happenning (as in GC_enable_incremental). */
+void GC_read_dirty()
+{
+ BCOPY((word *)GC_dirty_pages, GC_grungy_pages,
+ (sizeof GC_dirty_pages));
+ BZERO((word *)GC_dirty_pages, (sizeof GC_dirty_pages));
+ GC_protect_heap();
+}
+
+GC_bool GC_page_was_dirty(h)
+struct hblk * h;
+{
+ register word index = PHT_HASH(h);
+
+ return(HDR(h) == 0 || get_pht_entry_from_index(GC_grungy_pages, index));
+}
+
+/*
+ * Acquiring the allocation lock here is dangerous, since this
+ * can be called from within GC_call_with_alloc_lock, and the cord
+ * package does so. On systems that allow nested lock acquisition, this
+ * happens to work.
+ * On other systems, SET_LOCK_HOLDER and friends must be suitably defined.
+ */
+
+static GC_bool syscall_acquired_lock = FALSE; /* Protected by GC lock. */
+
+void GC_begin_syscall()
+{
+ if (!I_HOLD_LOCK()) {
+ LOCK();
+ syscall_acquired_lock = TRUE;
+ }
+}
+
+void GC_end_syscall()
+{
+ if (syscall_acquired_lock) {
+ syscall_acquired_lock = FALSE;
+ UNLOCK();
+ }
+}
+
+void GC_unprotect_range(addr, len)
+ptr_t addr;
+word len;
+{
+ struct hblk * start_block;
+ struct hblk * end_block;
+ register struct hblk *h;
+ ptr_t obj_start;
+
+ if (!GC_dirty_maintained) return;
+ obj_start = GC_base(addr);
+ if (obj_start == 0) return;
+ if (GC_base(addr + len - 1) != obj_start) {
+ ABORT("GC_unprotect_range(range bigger than object)");
+ }
+ start_block = (struct hblk *)((word)addr & ~(GC_page_size - 1));
+ end_block = (struct hblk *)((word)(addr + len - 1) & ~(GC_page_size - 1));
+ end_block += GC_page_size/HBLKSIZE - 1;
+ for (h = start_block; h <= end_block; h++) {
+ register word index = PHT_HASH(h);
+
+ async_set_pht_entry_from_index(GC_dirty_pages, index);
+ }
+ UNPROTECT(start_block,
+ ((ptr_t)end_block - (ptr_t)start_block) + HBLKSIZE);
+}
+
+#if 0
+
+/* We no longer wrap read by default, since that was causing too many */
+/* problems. It is preferred that the client instead avoids writing */
+/* to the write-protected heap with a system call. */
+/* This still serves as sample code if you do want to wrap system calls.*/
+
+#if !defined(MSWIN32) && !defined(MSWINCE) && !defined(GC_USE_LD_WRAP)
+/* Replacement for UNIX system call. */
+/* Other calls that write to the heap should be handled similarly. */
+/* Note that this doesn't work well for blocking reads: It will hold */
+/* the allocation lock for the entire duration of the call. Multithreaded */
+/* clients should really ensure that it won't block, either by setting */
+/* the descriptor nonblocking, or by calling select or poll first, to */
+/* make sure that input is available. */
+/* Another, preferred alternative is to ensure that system calls never */
+/* write to the protected heap (see above). */
+# if defined(__STDC__) && !defined(SUNOS4)
+# include <unistd.h>
+# include <sys/uio.h>
+ ssize_t read(int fd, void *buf, size_t nbyte)
+# else
+# ifndef LINT
+ int read(fd, buf, nbyte)
+# else
+ int GC_read(fd, buf, nbyte)
+# endif
+ int fd;
+ char *buf;
+ int nbyte;
+# endif
+{
+ int result;
+
+ GC_begin_syscall();
+ GC_unprotect_range(buf, (word)nbyte);
+# if defined(IRIX5) || defined(GC_LINUX_THREADS)
+ /* Indirect system call may not always be easily available. */
+ /* We could call _read, but that would interfere with the */
+ /* libpthread interception of read. */
+ /* On Linux, we have to be careful with the linuxthreads */
+ /* read interception. */
+ {
+ struct iovec iov;
+
+ iov.iov_base = buf;
+ iov.iov_len = nbyte;
+ result = readv(fd, &iov, 1);
+ }
+# else
+# if defined(HURD)
+ result = __read(fd, buf, nbyte);
+# else
+ /* The two zero args at the end of this list are because one
+ IA-64 syscall() implementation actually requires six args
+ to be passed, even though they aren't always used. */
+ result = syscall(SYS_read, fd, buf, nbyte, 0, 0);
+# endif /* !HURD */
+# endif
+ GC_end_syscall();
+ return(result);
+}
+#endif /* !MSWIN32 && !MSWINCE && !GC_LINUX_THREADS */
+
+#if defined(GC_USE_LD_WRAP) && !defined(THREADS)
+ /* We use the GNU ld call wrapping facility. */
+ /* This requires that the linker be invoked with "--wrap read". */
+ /* This can be done by passing -Wl,"--wrap read" to gcc. */
+ /* I'm not sure that this actually wraps whatever version of read */
+ /* is called by stdio. That code also mentions __read. */
+# include <unistd.h>
+ ssize_t __wrap_read(int fd, void *buf, size_t nbyte)
+ {
+ int result;
+
+ GC_begin_syscall();
+ GC_unprotect_range(buf, (word)nbyte);
+ result = __real_read(fd, buf, nbyte);
+ GC_end_syscall();
+ return(result);
+ }
+
+ /* We should probably also do this for __read, or whatever stdio */
+ /* actually calls. */
+#endif
+
+#endif /* 0 */
+
+/*ARGSUSED*/
+GC_bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+ return(TRUE);
+}
+
+/* Reset the n pages starting at h to "was never dirty" status. */
+/*ARGSUSED*/
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+}
+
+# else /* !MPROTECT_VDB */
+
+# ifdef GC_USE_LD_WRAP
+ ssize_t __wrap_read(int fd, void *buf, size_t nbyte)
+ { return __real_read(fd, buf, nbyte); }
+# endif
+
+# endif /* MPROTECT_VDB */
+
+# ifdef PROC_VDB
+
+/*
+ * See DEFAULT_VDB for interface descriptions.
+ */
+
+/*
+ * This implementaion assumes a Solaris 2.X like /proc pseudo-file-system
+ * from which we can read page modified bits. This facility is far from
+ * optimal (e.g. we would like to get the info for only some of the
+ * address space), but it avoids intercepting system calls.
+ */
+
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/signal.h>
+#include <sys/fault.h>
+#include <sys/syscall.h>
+#include <sys/procfs.h>
+#include <sys/stat.h>
+
+#define INITIAL_BUF_SZ 4096
+word GC_proc_buf_size = INITIAL_BUF_SZ;
+char *GC_proc_buf;
+
+#ifdef GC_SOLARIS_THREADS
+/* We don't have exact sp values for threads. So we count on */
+/* occasionally declaring stack pages to be fresh. Thus we */
+/* need a real implementation of GC_is_fresh. We can't clear */
+/* entries in GC_written_pages, since that would declare all */
+/* pages with the given hash address to be fresh. */
+# define MAX_FRESH_PAGES 8*1024 /* Must be power of 2 */
+ struct hblk ** GC_fresh_pages; /* A direct mapped cache. */
+ /* Collisions are dropped. */
+
+# define FRESH_PAGE_SLOT(h) (divHBLKSZ((word)(h)) & (MAX_FRESH_PAGES-1))
+# define ADD_FRESH_PAGE(h) \
+ GC_fresh_pages[FRESH_PAGE_SLOT(h)] = (h)
+# define PAGE_IS_FRESH(h) \
+ (GC_fresh_pages[FRESH_PAGE_SLOT(h)] == (h) && (h) != 0)
+#endif
+
+/* Add all pages in pht2 to pht1 */
+void GC_or_pages(pht1, pht2)
+page_hash_table pht1, pht2;
+{
+ register int i;
+
+ for (i = 0; i < PHT_SIZE; i++) pht1[i] |= pht2[i];
+}
+
+int GC_proc_fd;
+
+void GC_dirty_init()
+{
+ int fd;
+ char buf[30];
+
+ GC_dirty_maintained = TRUE;
+ if (GC_words_allocd != 0 || GC_words_allocd_before_gc != 0) {
+ register int i;
+
+ for (i = 0; i < PHT_SIZE; i++) GC_written_pages[i] = (word)(-1);
+# ifdef PRINTSTATS
+ GC_printf1("Allocated words:%lu:all pages may have been written\n",
+ (unsigned long)
+ (GC_words_allocd + GC_words_allocd_before_gc));
+# endif
+ }
+ sprintf(buf, "/proc/%d", getpid());
+ fd = open(buf, O_RDONLY);
+ if (fd < 0) {
+ ABORT("/proc open failed");
+ }
+ GC_proc_fd = syscall(SYS_ioctl, fd, PIOCOPENPD, 0);
+ close(fd);
+ syscall(SYS_fcntl, GC_proc_fd, F_SETFD, FD_CLOEXEC);
+ if (GC_proc_fd < 0) {
+ ABORT("/proc ioctl failed");
+ }
+ GC_proc_buf = GC_scratch_alloc(GC_proc_buf_size);
+# ifdef GC_SOLARIS_THREADS
+ GC_fresh_pages = (struct hblk **)
+ GC_scratch_alloc(MAX_FRESH_PAGES * sizeof (struct hblk *));
+ if (GC_fresh_pages == 0) {
+ GC_err_printf0("No space for fresh pages\n");
+ EXIT();
+ }
+ BZERO(GC_fresh_pages, MAX_FRESH_PAGES * sizeof (struct hblk *));
+# endif
+}
+
+/* Ignore write hints. They don't help us here. */
+/*ARGSUSED*/
+void GC_remove_protection(h, nblocks, is_ptrfree)
+struct hblk *h;
+word nblocks;
+GC_bool is_ptrfree;
+{
+}
+
+#ifdef GC_SOLARIS_THREADS
+# define READ(fd,buf,nbytes) syscall(SYS_read, fd, buf, nbytes)
+#else
+# define READ(fd,buf,nbytes) read(fd, buf, nbytes)
+#endif
+
+void GC_read_dirty()
+{
+ unsigned long ps, np;
+ int nmaps;
+ ptr_t vaddr;
+ struct prasmap * map;
+ char * bufp;
+ ptr_t current_addr, limit;
+ int i;
+int dummy;
+
+ BZERO(GC_grungy_pages, (sizeof GC_grungy_pages));
+
+ bufp = GC_proc_buf;
+ if (READ(GC_proc_fd, bufp, GC_proc_buf_size) <= 0) {
+# ifdef PRINTSTATS
+ GC_printf1("/proc read failed: GC_proc_buf_size = %lu\n",
+ GC_proc_buf_size);
+# endif
+ {
+ /* Retry with larger buffer. */
+ word new_size = 2 * GC_proc_buf_size;
+ char * new_buf = GC_scratch_alloc(new_size);
+
+ if (new_buf != 0) {
+ GC_proc_buf = bufp = new_buf;
+ GC_proc_buf_size = new_size;
+ }
+ if (syscall(SYS_read, GC_proc_fd, bufp, GC_proc_buf_size) <= 0) {
+ WARN("Insufficient space for /proc read\n", 0);
+ /* Punt: */
+ memset(GC_grungy_pages, 0xff, sizeof (page_hash_table));
+ memset(GC_written_pages, 0xff, sizeof(page_hash_table));
+# ifdef GC_SOLARIS_THREADS
+ BZERO(GC_fresh_pages,
+ MAX_FRESH_PAGES * sizeof (struct hblk *));
+# endif
+ return;
+ }
+ }
+ }
+ /* Copy dirty bits into GC_grungy_pages */
+ nmaps = ((struct prpageheader *)bufp) -> pr_nmap;
+ /* printf( "nmaps = %d, PG_REFERENCED = %d, PG_MODIFIED = %d\n",
+ nmaps, PG_REFERENCED, PG_MODIFIED); */
+ bufp = bufp + sizeof(struct prpageheader);
+ for (i = 0; i < nmaps; i++) {
+ map = (struct prasmap *)bufp;
+ vaddr = (ptr_t)(map -> pr_vaddr);
+ ps = map -> pr_pagesize;
+ np = map -> pr_npage;
+ /* printf("vaddr = 0x%X, ps = 0x%X, np = 0x%X\n", vaddr, ps, np); */
+ limit = vaddr + ps * np;
+ bufp += sizeof (struct prasmap);
+ for (current_addr = vaddr;
+ current_addr < limit; current_addr += ps){
+ if ((*bufp++) & PG_MODIFIED) {
+ register struct hblk * h = (struct hblk *) current_addr;
+
+ while ((ptr_t)h < current_addr + ps) {
+ register word index = PHT_HASH(h);
+
+ set_pht_entry_from_index(GC_grungy_pages, index);
+# ifdef GC_SOLARIS_THREADS
+ {
+ register int slot = FRESH_PAGE_SLOT(h);
+
+ if (GC_fresh_pages[slot] == h) {
+ GC_fresh_pages[slot] = 0;
+ }
+ }
+# endif
+ h++;
+ }
+ }
+ }
+ bufp += sizeof(long) - 1;
+ bufp = (char *)((unsigned long)bufp & ~(sizeof(long)-1));
+ }
+ /* Update GC_written_pages. */
+ GC_or_pages(GC_written_pages, GC_grungy_pages);
+# ifdef GC_SOLARIS_THREADS
+ /* Make sure that old stacks are considered completely clean */
+ /* unless written again. */
+ GC_old_stacks_are_fresh();
+# endif
+}
+
+#undef READ
+
+GC_bool GC_page_was_dirty(h)
+struct hblk *h;
+{
+ register word index = PHT_HASH(h);
+ register GC_bool result;
+
+ result = get_pht_entry_from_index(GC_grungy_pages, index);
+# ifdef GC_SOLARIS_THREADS
+ if (result && PAGE_IS_FRESH(h)) result = FALSE;
+ /* This happens only if page was declared fresh since */
+ /* the read_dirty call, e.g. because it's in an unused */
+ /* thread stack. It's OK to treat it as clean, in */
+ /* that case. And it's consistent with */
+ /* GC_page_was_ever_dirty. */
+# endif
+ return(result);
+}
+
+GC_bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+ register word index = PHT_HASH(h);
+ register GC_bool result;
+
+ result = get_pht_entry_from_index(GC_written_pages, index);
+# ifdef GC_SOLARIS_THREADS
+ if (result && PAGE_IS_FRESH(h)) result = FALSE;
+# endif
+ return(result);
+}
+
+/* Caller holds allocation lock. */
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+
+ register word index;
+
+# ifdef GC_SOLARIS_THREADS
+ register word i;
+
+ if (GC_fresh_pages != 0) {
+ for (i = 0; i < n; i++) {
+ ADD_FRESH_PAGE(h + i);
+ }
+ }
+# endif
+}
+
+# endif /* PROC_VDB */
+
+
+# ifdef PCR_VDB
+
+# include "vd/PCR_VD.h"
+
+# define NPAGES (32*1024) /* 128 MB */
+
+PCR_VD_DB GC_grungy_bits[NPAGES];
+
+ptr_t GC_vd_base; /* Address corresponding to GC_grungy_bits[0] */
+ /* HBLKSIZE aligned. */
+
+void GC_dirty_init()
+{
+ GC_dirty_maintained = TRUE;
+ /* For the time being, we assume the heap generally grows up */
+ GC_vd_base = GC_heap_sects[0].hs_start;
+ if (GC_vd_base == 0) {
+ ABORT("Bad initial heap segment");
+ }
+ if (PCR_VD_Start(HBLKSIZE, GC_vd_base, NPAGES*HBLKSIZE)
+ != PCR_ERes_okay) {
+ ABORT("dirty bit initialization failed");
+ }
+}
+
+void GC_read_dirty()
+{
+ /* lazily enable dirty bits on newly added heap sects */
+ {
+ static int onhs = 0;
+ int nhs = GC_n_heap_sects;
+ for( ; onhs < nhs; onhs++ ) {
+ PCR_VD_WriteProtectEnable(
+ GC_heap_sects[onhs].hs_start,
+ GC_heap_sects[onhs].hs_bytes );
+ }
+ }
+
+
+ if (PCR_VD_Clear(GC_vd_base, NPAGES*HBLKSIZE, GC_grungy_bits)
+ != PCR_ERes_okay) {
+ ABORT("dirty bit read failed");
+ }
+}
+
+GC_bool GC_page_was_dirty(h)
+struct hblk *h;
+{
+ if((ptr_t)h < GC_vd_base || (ptr_t)h >= GC_vd_base + NPAGES*HBLKSIZE) {
+ return(TRUE);
+ }
+ return(GC_grungy_bits[h - (struct hblk *)GC_vd_base] & PCR_VD_DB_dirtyBit);
+}
+
+/*ARGSUSED*/
+void GC_remove_protection(h, nblocks, is_ptrfree)
+struct hblk *h;
+word nblocks;
+GC_bool is_ptrfree;
+{
+ PCR_VD_WriteProtectDisable(h, nblocks*HBLKSIZE);
+ PCR_VD_WriteProtectEnable(h, nblocks*HBLKSIZE);
+}
+
+# endif /* PCR_VDB */
+
+# ifndef HAVE_INCREMENTAL_PROTECTION_NEEDS
+ int GC_incremental_protection_needs()
+ {
+ return GC_PROTECTS_NONE;
+ }
+# endif /* !HAVE_INCREMENTAL_PROTECTION_NEEDS */
+
+/*
+ * Call stack save code for debugging.
+ * Should probably be in mach_dep.c, but that requires reorganization.
+ */
+
+/* I suspect the following works for most X86 *nix variants, so */
+/* long as the frame pointer is explicitly stored. In the case of gcc, */
+/* compiler flags (e.g. -fomit-frame-pointer) determine whether it is. */
+#if defined(I386) && defined(LINUX) && defined(SAVE_CALL_CHAIN)
+# include <features.h>
+
+ struct frame {
+ struct frame *fr_savfp;
+ long fr_savpc;
+ long fr_arg[NARGS]; /* All the arguments go here. */
+ };
+#endif
+
+#if defined(SPARC)
+# if defined(LINUX)
+# include <features.h>
+
+ struct frame {
+ long fr_local[8];
+ long fr_arg[6];
+ struct frame *fr_savfp;
+ long fr_savpc;
+# ifndef __arch64__
+ char *fr_stret;
+# endif
+ long fr_argd[6];
+ long fr_argx[0];
+ };
+# else
+# if defined(SUNOS4)
+# include <machine/frame.h>
+# else
+# if defined (DRSNX)
+# include <sys/sparc/frame.h>
+# else
+# if defined(OPENBSD) || defined(NETBSD)
+# include <frame.h>
+# else
+# include <sys/frame.h>
+# endif
+# endif
+# endif
+# endif
+# if NARGS > 6
+ --> We only know how to to get the first 6 arguments
+# endif
+#endif /* SPARC */
+
+#ifdef NEED_CALLINFO
+/* Fill in the pc and argument information for up to NFRAMES of my */
+/* callers. Ignore my frame and my callers frame. */
+
+#ifdef LINUX
+# include <unistd.h>
+#endif
+
+#endif /* NEED_CALLINFO */
+
+#ifdef SAVE_CALL_CHAIN
+
+#if NARGS == 0 && NFRAMES % 2 == 0 /* No padding */ \
+ && defined(GC_HAVE_BUILTIN_BACKTRACE)
+
+#include <execinfo.h>
+
+void GC_save_callers (info)
+struct callinfo info[NFRAMES];
+{
+ void * tmp_info[NFRAMES + 1];
+ int npcs, i;
+# define IGNORE_FRAMES 1
+
+ /* We retrieve NFRAMES+1 pc values, but discard the first, since it */
+ /* points to our own frame. */
+ GC_ASSERT(sizeof(struct callinfo) == sizeof(void *));
+ npcs = backtrace((void **)tmp_info, NFRAMES + IGNORE_FRAMES);
+ BCOPY(tmp_info+IGNORE_FRAMES, info, (npcs - IGNORE_FRAMES) * sizeof(void *));
+ for (i = npcs - IGNORE_FRAMES; i < NFRAMES; ++i) info[i].ci_pc = 0;
+}
+
+#else /* No builtin backtrace; do it ourselves */
+
+#if (defined(OPENBSD) || defined(NETBSD)) && defined(SPARC)
+# define FR_SAVFP fr_fp
+# define FR_SAVPC fr_pc
+#else
+# define FR_SAVFP fr_savfp
+# define FR_SAVPC fr_savpc
+#endif
+
+#if defined(SPARC) && (defined(__arch64__) || defined(__sparcv9))
+# define BIAS 2047
+#else
+# define BIAS 0
+#endif
+
+void GC_save_callers (info)
+struct callinfo info[NFRAMES];
+{
+ struct frame *frame;
+ struct frame *fp;
+ int nframes = 0;
+# ifdef I386
+ /* We assume this is turned on only with gcc as the compiler. */
+ asm("movl %%ebp,%0" : "=r"(frame));
+ fp = frame;
+# else
+ word GC_save_regs_in_stack();
+
+ frame = (struct frame *) GC_save_regs_in_stack ();
+ fp = (struct frame *)((long) frame -> FR_SAVFP + BIAS);
+#endif
+
+ for (; (!(fp HOTTER_THAN frame) && !(GC_stackbottom HOTTER_THAN (ptr_t)fp)
+ && (nframes < NFRAMES));
+ fp = (struct frame *)((long) fp -> FR_SAVFP + BIAS), nframes++) {
+ register int i;
+
+ info[nframes].ci_pc = fp->FR_SAVPC;
+# if NARGS > 0
+ for (i = 0; i < NARGS; i++) {
+ info[nframes].ci_arg[i] = ~(fp->fr_arg[i]);
+ }
+# endif /* NARGS > 0 */
+ }
+ if (nframes < NFRAMES) info[nframes].ci_pc = 0;
+}
+
+#endif /* No builtin backtrace */
+
+#endif /* SAVE_CALL_CHAIN */
+
+#ifdef NEED_CALLINFO
+
+/* Print info to stderr. We do NOT hold the allocation lock */
+void GC_print_callers (info)
+struct callinfo info[NFRAMES];
+{
+ register int i;
+ static int reentry_count = 0;
+ GC_bool stop = FALSE;
+
+ LOCK();
+ ++reentry_count;
+ UNLOCK();
+
+# if NFRAMES == 1
+ GC_err_printf0("\tCaller at allocation:\n");
+# else
+ GC_err_printf0("\tCall chain at allocation:\n");
+# endif
+ for (i = 0; i < NFRAMES && !stop ; i++) {
+ if (info[i].ci_pc == 0) break;
+# if NARGS > 0
+ {
+ int j;
+
+ GC_err_printf0("\t\targs: ");
+ for (j = 0; j < NARGS; j++) {
+ if (j != 0) GC_err_printf0(", ");
+ GC_err_printf2("%d (0x%X)", ~(info[i].ci_arg[j]),
+ ~(info[i].ci_arg[j]));
+ }
+ GC_err_printf0("\n");
+ }
+# endif
+ if (reentry_count > 1) {
+ /* We were called during an allocation during */
+ /* a previous GC_print_callers call; punt. */
+ GC_err_printf1("\t\t##PC##= 0x%lx\n", info[i].ci_pc);
+ continue;
+ }
+ {
+# ifdef LINUX
+ FILE *pipe;
+# endif
+# if defined(GC_HAVE_BUILTIN_BACKTRACE)
+ char **sym_name =
+ backtrace_symbols((void **)(&(info[i].ci_pc)), 1);
+ char *name = sym_name[0];
+# else
+ char buf[40];
+ char *name = buf;
+ sprintf(buf, "##PC##= 0x%lx", info[i].ci_pc);
+# endif
+# if defined(LINUX) && !defined(SMALL_CONFIG)
+ /* Try for a line number. */
+ {
+# define EXE_SZ 100
+ static char exe_name[EXE_SZ];
+# define CMD_SZ 200
+ char cmd_buf[CMD_SZ];
+# define RESULT_SZ 200
+ static char result_buf[RESULT_SZ];
+ size_t result_len;
+ static GC_bool found_exe_name = FALSE;
+ static GC_bool will_fail = FALSE;
+ int ret_code;
+ /* Try to get it via a hairy and expensive scheme. */
+ /* First we get the name of the executable: */
+ if (will_fail) goto out;
+ if (!found_exe_name) {
+ ret_code = readlink("/proc/self/exe", exe_name, EXE_SZ);
+ if (ret_code < 0 || ret_code >= EXE_SZ
+ || exe_name[0] != '/') {
+ will_fail = TRUE; /* Dont try again. */
+ goto out;
+ }
+ exe_name[ret_code] = '\0';
+ found_exe_name = TRUE;
+ }
+ /* Then we use popen to start addr2line -e <exe> <addr> */
+ /* There are faster ways to do this, but hopefully this */
+ /* isn't time critical. */
+ sprintf(cmd_buf, "/usr/bin/addr2line -f -e %s 0x%lx", exe_name,
+ (unsigned long)info[i].ci_pc);
+ pipe = popen(cmd_buf, "r");
+ if (pipe == NULL
+ || (result_len = fread(result_buf, 1, RESULT_SZ - 1, pipe))
+ == 0) {
+ if (pipe != NULL) pclose(pipe);
+ will_fail = TRUE;
+ goto out;
+ }
+ if (result_buf[result_len - 1] == '\n') --result_len;
+ result_buf[result_len] = 0;
+ if (result_buf[0] == '?'
+ || result_buf[result_len-2] == ':'
+ && result_buf[result_len-1] == '0') {
+ pclose(pipe);
+ goto out;
+ }
+ /* Get rid of embedded newline, if any. Test for "main" */
+ {
+ char * nl = strchr(result_buf, '\n');
+ if (nl != NULL && nl < result_buf + result_len) {
+ *nl = ':';
+ }
+ if (strncmp(result_buf, "main", nl - result_buf) == 0) {
+ stop = TRUE;
+ }
+ }
+ if (result_len < RESULT_SZ - 25) {
+ /* Add in hex address */
+ sprintf(result_buf + result_len, " [0x%lx]",
+ (unsigned long)info[i].ci_pc);
+ }
+ name = result_buf;
+ pclose(pipe);
+ out:
+ }
+# endif /* LINUX */
+ GC_err_printf1("\t\t%s\n", name);
+# if defined(GC_HAVE_BUILTIN_BACKTRACE)
+ free(sym_name); /* May call GC_free; that's OK */
+# endif
+ }
+ }
+ LOCK();
+ --reentry_count;
+ UNLOCK();
+}
+
+#endif /* NEED_CALLINFO */
+
+#if defined(LINUX) && defined(__ELF__) && \
+ (!defined(SMALL_CONFIG) || defined(USE_PROC_FOR_LIBRARIES))
+#ifdef GC_USE_LD_WRAP
+# define READ __real_read
+#else
+# define READ read
+#endif
+
+
+/* Repeatedly perform a read call until the buffer is filled or */
+/* we encounter EOF. */
+ssize_t GC_repeat_read(int fd, char *buf, size_t count)
+{
+ ssize_t num_read = 0;
+ ssize_t result;
+
+ while (num_read < count) {
+ result = READ(fd, buf + num_read, count - num_read);
+ if (result < 0) return result;
+ if (result == 0) break;
+ num_read += result;
+ }
+ return num_read;
+}
+#endif /* LINUX && ... */
+
+
+#if defined(LINUX) && defined(__ELF__) && !defined(SMALL_CONFIG)
+
+/* Dump /proc/self/maps to GC_stderr, to enable looking up names for
+ addresses in FIND_LEAK output. */
+
+void GC_print_address_map()
+{
+ int f;
+ int result;
+ char maps_temp[32768];
+ GC_err_printf0("---------- Begin address map ----------\n");
+ f = open("/proc/self/maps", O_RDONLY);
+ if (-1 == f) ABORT("Couldn't open /proc/self/maps");
+ do {
+ result = GC_repeat_read(f, maps_temp, sizeof(maps_temp));
+ if (result <= 0) ABORT("Couldn't read /proc/self/maps");
+ GC_err_write(maps_temp, result);
+ } while (result == sizeof(maps_temp));
+ close(f);
+ GC_err_printf0("---------- End address map ----------\n");
+}
+
+#endif
+
+
--- /dev/null
+solaris_threads.c
+solaris_pthreads.c
+irix_threads.c
+pcr_interface.c
+real_malloc.c
+mips_mach_dep.s
+rs6000_mach_dep.s
+alpha_mach_dep.s
+sparc_mach_dep.s
+PCR-Makefile
+setjmp_t.c
+callprocs
+doc/gc.man
+pc_excludes
+barrett_diagram
+include/gc_c++.h
+include/gc_inline.h
+doc/README.hp
+doc/README.rs6000
+doc/README.sgi
+
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+# include "private/gc_priv.h"
+
+# ifdef PCR
+/*
+ * Note that POSIX PCR requires an ANSI C compiler. Hence we are allowed
+ * to make the same assumption here.
+ * We wrap all of the allocator functions to avoid questions of
+ * compatibility between the prototyped and nonprototyped versions of the f
+ */
+# include "config/PCR_StdTypes.h"
+# include "mm/PCR_MM.h"
+# include <errno.h>
+
+# define MY_MAGIC 17L
+# define MY_DEBUGMAGIC 42L
+
+void * GC_AllocProc(size_t size, PCR_Bool ptrFree, PCR_Bool clear )
+{
+ if (ptrFree) {
+ void * result = (void *)GC_malloc_atomic(size);
+ if (clear && result != 0) BZERO(result, size);
+ return(result);
+ } else {
+ return((void *)GC_malloc(size));
+ }
+}
+
+void * GC_DebugAllocProc(size_t size, PCR_Bool ptrFree, PCR_Bool clear )
+{
+ if (ptrFree) {
+ void * result = (void *)GC_debug_malloc_atomic(size, __FILE__,
+ __LINE__);
+ if (clear && result != 0) BZERO(result, size);
+ return(result);
+ } else {
+ return((void *)GC_debug_malloc(size, __FILE__, __LINE__));
+ }
+}
+
+# define GC_ReallocProc GC_realloc
+void * GC_DebugReallocProc(void * old_object, size_t new_size_in_bytes)
+{
+ return(GC_debug_realloc(old_object, new_size_in_bytes, __FILE__, __LINE__));
+}
+
+# define GC_FreeProc GC_free
+# define GC_DebugFreeProc GC_debug_free
+
+typedef struct {
+ PCR_ERes (*ed_proc)(void *p, size_t size, PCR_Any data);
+ GC_bool ed_pointerfree;
+ PCR_ERes ed_fail_code;
+ PCR_Any ed_client_data;
+} enumerate_data;
+
+void GC_enumerate_block(h, ed)
+register struct hblk *h;
+enumerate_data * ed;
+{
+ register hdr * hhdr;
+ register int sz;
+ word *p;
+ word * lim;
+
+ hhdr = HDR(h);
+ sz = hhdr -> hb_sz;
+ if (sz >= 0 && ed -> ed_pointerfree
+ || sz <= 0 && !(ed -> ed_pointerfree)) return;
+ if (sz < 0) sz = -sz;
+ lim = (word *)(h+1) - sz;
+ p = (word *)h;
+ do {
+ if (PCR_ERes_IsErr(ed -> ed_fail_code)) return;
+ ed -> ed_fail_code =
+ (*(ed -> ed_proc))(p, WORDS_TO_BYTES(sz), ed -> ed_client_data);
+ p+= sz;
+ } while (p <= lim);
+}
+
+struct PCR_MM_ProcsRep * GC_old_allocator = 0;
+
+PCR_ERes GC_EnumerateProc(
+ PCR_Bool ptrFree,
+ PCR_ERes (*proc)(void *p, size_t size, PCR_Any data),
+ PCR_Any data
+)
+{
+ enumerate_data ed;
+
+ ed.ed_proc = proc;
+ ed.ed_pointerfree = ptrFree;
+ ed.ed_fail_code = PCR_ERes_okay;
+ ed.ed_client_data = data;
+ GC_apply_to_all_blocks(GC_enumerate_block, &ed);
+ if (ed.ed_fail_code != PCR_ERes_okay) {
+ return(ed.ed_fail_code);
+ } else {
+ /* Also enumerate objects allocated by my predecessors */
+ return((*(GC_old_allocator->mmp_enumerate))(ptrFree, proc, data));
+ }
+}
+
+void GC_DummyFreeProc(void *p) {}
+
+void GC_DummyShutdownProc(void) {}
+
+struct PCR_MM_ProcsRep GC_Rep = {
+ MY_MAGIC,
+ GC_AllocProc,
+ GC_ReallocProc,
+ GC_DummyFreeProc, /* mmp_free */
+ GC_FreeProc, /* mmp_unsafeFree */
+ GC_EnumerateProc,
+ GC_DummyShutdownProc /* mmp_shutdown */
+};
+
+struct PCR_MM_ProcsRep GC_DebugRep = {
+ MY_DEBUGMAGIC,
+ GC_DebugAllocProc,
+ GC_DebugReallocProc,
+ GC_DummyFreeProc, /* mmp_free */
+ GC_DebugFreeProc, /* mmp_unsafeFree */
+ GC_EnumerateProc,
+ GC_DummyShutdownProc /* mmp_shutdown */
+};
+
+GC_bool GC_use_debug = 0;
+
+void GC_pcr_install()
+{
+ PCR_MM_Install((GC_use_debug? &GC_DebugRep : &GC_Rep), &GC_old_allocator);
+}
+
+PCR_ERes
+PCR_GC_Setup(void)
+{
+ return PCR_ERes_okay;
+}
+
+PCR_ERes
+PCR_GC_Run(void)
+{
+
+ if( !PCR_Base_TestPCRArg("-nogc") ) {
+ GC_quiet = ( PCR_Base_TestPCRArg("-gctrace") ? 0 : 1 );
+ GC_use_debug = (GC_bool)PCR_Base_TestPCRArg("-debug_alloc");
+ GC_init();
+ if( !PCR_Base_TestPCRArg("-nogc_incremental") ) {
+ /*
+ * awful hack to test whether VD is implemented ...
+ */
+ if( PCR_VD_Start( 0, NIL, 0) != PCR_ERes_FromErr(ENOSYS) ) {
+ GC_enable_incremental();
+ }
+ }
+ }
+ return PCR_ERes_okay;
+}
+
+void GC_push_thread_structures(void)
+{
+ /* PCR doesn't work unless static roots are pushed. Can't get here. */
+ ABORT("In GC_push_thread_structures()");
+}
+
+# endif
--- /dev/null
+
+.text
+
+ .set linkageArea,24
+ .set params,4
+ .set alignment,4
+
+ .set spaceToSave,linkageArea+params+alignment
+ .set spaceToSave8,spaceToSave+8
+
+; Mark from machine registers that are saved by C compiler
+ .globl _GC_push_regs
+_GC_push_regs:
+ ; PROLOG
+ mflr r0 ; get return address
+ stw r0,8(r1) ; save return address
+ stwu r1,-spaceToSave(r1) ; skip over caller save area
+ ;
+ mr r3,r2 ; mark from r2. Well Im not really sure
+ ; that this is necessary or even the right
+ ; thing to do - at least it doesnt harm...
+ ; According to Apples docs it points to
+ ; the direct data area, whatever that is...
+ bl L_GC_push_one$stub
+ mr r3,r13 ; mark from r13-r31
+ bl L_GC_push_one$stub
+ mr r3,r14
+ bl L_GC_push_one$stub
+ mr r3,r15
+ bl L_GC_push_one$stub
+ mr r3,r16
+ bl L_GC_push_one$stub
+ mr r3,r17
+ bl L_GC_push_one$stub
+ mr r3,r18
+ bl L_GC_push_one$stub
+ mr r3,r19
+ bl L_GC_push_one$stub
+ mr r3,r20
+ bl L_GC_push_one$stub
+ mr r3,r21
+ bl L_GC_push_one$stub
+ mr r3,r22
+ bl L_GC_push_one$stub
+ mr r3,r23
+ bl L_GC_push_one$stub
+ mr r3,r24
+ bl L_GC_push_one$stub
+ mr r3,r25
+ bl L_GC_push_one$stub
+ mr r3,r26
+ bl L_GC_push_one$stub
+ mr r3,r27
+ bl L_GC_push_one$stub
+ mr r3,r28
+ bl L_GC_push_one$stub
+ mr r3,r29
+ bl L_GC_push_one$stub
+ mr r3,r30
+ bl L_GC_push_one$stub
+ mr r3,r31
+ bl L_GC_push_one$stub
+ ; EPILOG
+ lwz r0,spaceToSave8(r1) ; get return address back
+ mtlr r0 ; reset link register
+ addic r1,r1,spaceToSave ; restore stack pointer
+ blr
+
+.data
+.picsymbol_stub
+L_GC_push_one$stub:
+ .indirect_symbol _GC_push_one
+ mflr r0
+ bcl 20,31,L0$_GC_push_one
+L0$_GC_push_one:
+ mflr r11
+ addis r11,r11,ha16(L_GC_push_one$lazy_ptr-L0$_GC_push_one)
+ mtlr r0
+ lwz r12,lo16(L_GC_push_one$lazy_ptr-L0$_GC_push_one)(r11)
+ mtctr r12
+ addi r11,r11,lo16(L_GC_push_one$lazy_ptr-L0$_GC_push_one)
+ bctr
+.data
+.lazy_symbol_pointer
+L_GC_push_one$lazy_ptr:
+ .indirect_symbol _GC_push_one
+ .long dyld_stub_binding_helper
+.non_lazy_symbol_pointer
+L_GC_push_one$non_lazy_ptr:
+ .indirect_symbol _GC_push_one
+ .long 0
+
+
+
+
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/*
+ * These are checking routines calls to which could be inserted by a
+ * preprocessor to validate C pointer arithmetic.
+ */
+
+#include "private/gc_pmark.h"
+
+#ifdef __STDC__
+void GC_default_same_obj_print_proc(GC_PTR p, GC_PTR q)
+#else
+void GC_default_same_obj_print_proc (p, q)
+GC_PTR p, q;
+#endif
+{
+ GC_err_printf2("0x%lx and 0x%lx are not in the same object\n",
+ (unsigned long)p, (unsigned long)q);
+ ABORT("GC_same_obj test failed");
+}
+
+void (*GC_same_obj_print_proc) GC_PROTO((GC_PTR, GC_PTR))
+ = GC_default_same_obj_print_proc;
+
+/* Check that p and q point to the same object. Call */
+/* *GC_same_obj_print_proc if they don't. */
+/* Returns the first argument. (Return value may be hard */
+/* to use,due to typing issues. But if we had a suitable */
+/* preprocessor ...) */
+/* Succeeds if neither p nor q points to the heap. */
+/* We assume this is performance critical. (It shouldn't */
+/* be called by production code, but this can easily make */
+/* debugging intolerably slow.) */
+#ifdef __STDC__
+ GC_PTR GC_same_obj(register void *p, register void *q)
+#else
+ GC_PTR GC_same_obj(p, q)
+ register char *p, *q;
+#endif
+{
+ register struct hblk *h;
+ register hdr *hhdr;
+ register ptr_t base, limit;
+ register word sz;
+
+ if (!GC_is_initialized) GC_init();
+ hhdr = HDR((word)p);
+ if (hhdr == 0) {
+ if (divHBLKSZ((word)p) != divHBLKSZ((word)q)
+ && HDR((word)q) != 0) {
+ goto fail;
+ }
+ return(p);
+ }
+ /* If it's a pointer to the middle of a large object, move it */
+ /* to the beginning. */
+ if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ h = HBLKPTR(p) - (word)hhdr;
+ hhdr = HDR(h);
+ while (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ h = FORWARDED_ADDR(h, hhdr);
+ hhdr = HDR(h);
+ }
+ limit = (ptr_t)((word *)h + hhdr -> hb_sz);
+ if ((ptr_t)p >= limit || (ptr_t)q >= limit || (ptr_t)q < (ptr_t)h ) {
+ goto fail;
+ }
+ return(p);
+ }
+ sz = WORDS_TO_BYTES(hhdr -> hb_sz);
+ if (sz > WORDS_TO_BYTES(MAXOBJSZ)) {
+ base = (ptr_t)HBLKPTR(p);
+ limit = base + sz;
+ if ((ptr_t)p >= limit) {
+ goto fail;
+ }
+ } else {
+ register int map_entry;
+ register int pdispl = HBLKDISPL(p);
+
+ map_entry = MAP_ENTRY((hhdr -> hb_map), pdispl);
+ if (map_entry > CPP_MAX_OFFSET) {
+ map_entry = BYTES_TO_WORDS(pdispl) % BYTES_TO_WORDS(sz);
+ if (HBLKPTR(p) != HBLKPTR(q)) goto fail;
+ /* W/o this check, we might miss an error if */
+ /* q points to the first object on a page, and */
+ /* points just before the page. */
+ }
+ base = (char *)((word)p & ~(WORDS_TO_BYTES(1) - 1));
+ base -= WORDS_TO_BYTES(map_entry);
+ limit = base + sz;
+ }
+ /* [base, limit) delimits the object containing p, if any. */
+ /* If p is not inside a valid object, then either q is */
+ /* also outside any valid object, or it is outside */
+ /* [base, limit). */
+ if ((ptr_t)q >= limit || (ptr_t)q < base) {
+ goto fail;
+ }
+ return(p);
+fail:
+ (*GC_same_obj_print_proc)((ptr_t)p, (ptr_t)q);
+ return(p);
+}
+
+#ifdef __STDC__
+void GC_default_is_valid_displacement_print_proc (GC_PTR p)
+#else
+void GC_default_is_valid_displacement_print_proc (p)
+GC_PTR p;
+#endif
+{
+ GC_err_printf1("0x%lx does not point to valid object displacement\n",
+ (unsigned long)p);
+ ABORT("GC_is_valid_displacement test failed");
+}
+
+void (*GC_is_valid_displacement_print_proc) GC_PROTO((GC_PTR)) =
+ GC_default_is_valid_displacement_print_proc;
+
+/* Check that if p is a pointer to a heap page, then it points to */
+/* a valid displacement within a heap object. */
+/* Uninteresting with GC_all_interior_pointers. */
+/* Always returns its argument. */
+/* Note that we don't lock, since nothing relevant about the header */
+/* should change while we have a valid object pointer to the block. */
+#ifdef __STDC__
+ void * GC_is_valid_displacement(void *p)
+#else
+ char *GC_is_valid_displacement(p)
+ char *p;
+#endif
+{
+ register hdr *hhdr;
+ register word pdispl;
+ register struct hblk *h;
+ register map_entry_type map_entry;
+ register word sz;
+
+ if (!GC_is_initialized) GC_init();
+ hhdr = HDR((word)p);
+ if (hhdr == 0) return(p);
+ h = HBLKPTR(p);
+ if (GC_all_interior_pointers) {
+ while (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ h = FORWARDED_ADDR(h, hhdr);
+ hhdr = HDR(h);
+ }
+ }
+ if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
+ goto fail;
+ }
+ sz = WORDS_TO_BYTES(hhdr -> hb_sz);
+ pdispl = HBLKDISPL(p);
+ map_entry = MAP_ENTRY((hhdr -> hb_map), pdispl);
+ if (map_entry == OBJ_INVALID
+ || sz > MAXOBJSZ && (ptr_t)p >= (ptr_t)h + sz) {
+ goto fail;
+ }
+ return(p);
+fail:
+ (*GC_is_valid_displacement_print_proc)((ptr_t)p);
+ return(p);
+}
+
+#ifdef __STDC__
+void GC_default_is_visible_print_proc(GC_PTR p)
+#else
+void GC_default_is_visible_print_proc(p)
+GC_PTR p;
+#endif
+{
+ GC_err_printf1("0x%lx is not a GC visible pointer location\n",
+ (unsigned long)p);
+ ABORT("GC_is_visible test failed");
+}
+
+void (*GC_is_visible_print_proc) GC_PROTO((GC_PTR p)) =
+ GC_default_is_visible_print_proc;
+
+/* Could p be a stack address? */
+GC_bool GC_on_stack(p)
+ptr_t p;
+{
+# ifdef THREADS
+ return(TRUE);
+# else
+ int dummy;
+# ifdef STACK_GROWS_DOWN
+ if ((ptr_t)p >= (ptr_t)(&dummy) && (ptr_t)p < GC_stackbottom ) {
+ return(TRUE);
+ }
+# else
+ if ((ptr_t)p <= (ptr_t)(&dummy) && (ptr_t)p > GC_stackbottom ) {
+ return(TRUE);
+ }
+# endif
+ return(FALSE);
+# endif
+}
+
+/* Check that p is visible */
+/* to the collector as a possibly pointer containing location. */
+/* If it isn't invoke *GC_is_visible_print_proc. */
+/* Returns the argument in all cases. May erroneously succeed */
+/* in hard cases. (This is intended for debugging use with */
+/* untyped allocations. The idea is that it should be possible, though */
+/* slow, to add such a call to all indirect pointer stores.) */
+/* Currently useless for multithreaded worlds. */
+#ifdef __STDC__
+ void * GC_is_visible(void *p)
+#else
+ char *GC_is_visible(p)
+ char *p;
+#endif
+{
+ register hdr *hhdr;
+
+ if ((word)p & (ALIGNMENT - 1)) goto fail;
+ if (!GC_is_initialized) GC_init();
+# ifdef THREADS
+ hhdr = HDR((word)p);
+ if (hhdr != 0 && GC_base(p) == 0) {
+ goto fail;
+ } else {
+ /* May be inside thread stack. We can't do much. */
+ return(p);
+ }
+# else
+ /* Check stack first: */
+ if (GC_on_stack(p)) return(p);
+ hhdr = HDR((word)p);
+ if (hhdr == 0) {
+ GC_bool result;
+
+ if (GC_is_static_root(p)) return(p);
+ /* Else do it again correctly: */
+# if (defined(DYNAMIC_LOADING) || defined(MSWIN32) || \
+ defined(MSWINCE) || defined(PCR)) \
+ && !defined(SRC_M3)
+ DISABLE_SIGNALS();
+ GC_register_dynamic_libraries();
+ result = GC_is_static_root(p);
+ ENABLE_SIGNALS();
+ if (result) return(p);
+# endif
+ goto fail;
+ } else {
+ /* p points to the heap. */
+ word descr;
+ ptr_t base = GC_base(p); /* Should be manually inlined? */
+
+ if (base == 0) goto fail;
+ if (HBLKPTR(base) != HBLKPTR(p)) hhdr = HDR((word)p);
+ descr = hhdr -> hb_descr;
+ retry:
+ switch(descr & GC_DS_TAGS) {
+ case GC_DS_LENGTH:
+ if ((word)((ptr_t)p - (ptr_t)base) > (word)descr) goto fail;
+ break;
+ case GC_DS_BITMAP:
+ if ((ptr_t)p - (ptr_t)base
+ >= WORDS_TO_BYTES(BITMAP_BITS)
+ || ((word)p & (sizeof(word) - 1))) goto fail;
+ if (!((1 << (WORDSZ - ((ptr_t)p - (ptr_t)base) - 1))
+ & descr)) goto fail;
+ break;
+ case GC_DS_PROC:
+ /* We could try to decipher this partially. */
+ /* For now we just punt. */
+ break;
+ case GC_DS_PER_OBJECT:
+ if ((signed_word)descr >= 0) {
+ descr = *(word *)((ptr_t)base + (descr & ~GC_DS_TAGS));
+ } else {
+ ptr_t type_descr = *(ptr_t *)base;
+ descr = *(word *)(type_descr
+ - (descr - (GC_DS_PER_OBJECT
+ - GC_INDIR_PER_OBJ_BIAS)));
+ }
+ goto retry;
+ }
+ return(p);
+ }
+# endif
+fail:
+ (*GC_is_visible_print_proc)((ptr_t)p);
+ return(p);
+}
+
+
+GC_PTR GC_pre_incr (p, how_much)
+GC_PTR *p;
+size_t how_much;
+{
+ GC_PTR initial = *p;
+ GC_PTR result = GC_same_obj((GC_PTR)((word)initial + how_much), initial);
+
+ if (!GC_all_interior_pointers) {
+ (void) GC_is_valid_displacement(result);
+ }
+ return (*p = result);
+}
+
+GC_PTR GC_post_incr (p, how_much)
+GC_PTR *p;
+size_t how_much;
+{
+ GC_PTR initial = *p;
+ GC_PTR result = GC_same_obj((GC_PTR)((word)initial + how_much), initial);
+
+ if (!GC_all_interior_pointers) {
+ (void) GC_is_valid_displacement(result);
+ }
+ *p = result;
+ return(initial);
+}
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, May 19, 1994 2:04 pm PDT */
+
+
+# ifdef PCR
+/*
+ * This definition should go in its own file that includes no other
+ * header files. Otherwise, we risk not getting the underlying system
+ * malloc.
+ */
+# define PCR_NO_RENAME
+# include <stdlib.h>
+
+# ifdef __STDC__
+ char * real_malloc(size_t size)
+# else
+ char * real_malloc()
+ int size;
+# endif
+{
+ return((char *)malloc(size));
+}
+#endif /* PCR */
+
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1996 by Xerox Corporation. All rights reserved.
+ * Copyright (c) 1996-1999 by Silicon Graphics. All rights reserved.
+ * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+#include <stdio.h>
+#include "private/gc_priv.h"
+
+signed_word GC_mem_found = 0;
+ /* Number of words of memory reclaimed */
+
+#if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ word GC_fl_builder_count = 0;
+ /* Number of threads currently building free lists without */
+ /* holding GC lock. It is not safe to collect if this is */
+ /* nonzero. */
+#endif /* PARALLEL_MARK */
+
+/* We defer printing of leaked objects until we're done with the GC */
+/* cycle, since the routine for printing objects needs to run outside */
+/* the collector, e.g. without the allocation lock. */
+#define MAX_LEAKED 40
+ptr_t GC_leaked[MAX_LEAKED];
+unsigned GC_n_leaked = 0;
+
+GC_bool GC_have_errors = FALSE;
+
+void GC_add_leaked(leaked)
+ptr_t leaked;
+{
+ if (GC_n_leaked < MAX_LEAKED) {
+ GC_have_errors = TRUE;
+ GC_leaked[GC_n_leaked++] = leaked;
+ /* Make sure it's not reclaimed this cycle */
+ GC_set_mark_bit(leaked);
+ }
+}
+
+static GC_bool printing_errors = FALSE;
+/* Print all objects on the list after printing any smashed objs. */
+/* Clear both lists. */
+void GC_print_all_errors ()
+{
+ unsigned i;
+
+ LOCK();
+ if (printing_errors) {
+ UNLOCK();
+ return;
+ }
+ printing_errors = TRUE;
+ UNLOCK();
+ if (GC_debugging_started) GC_print_all_smashed();
+ for (i = 0; i < GC_n_leaked; ++i) {
+ ptr_t p = GC_leaked[i];
+ if (HDR(p) -> hb_obj_kind == PTRFREE) {
+ GC_err_printf0("Leaked atomic object at ");
+ } else {
+ GC_err_printf0("Leaked composite object at ");
+ }
+ GC_print_heap_obj(p);
+ GC_err_printf0("\n");
+ GC_free(p);
+ GC_leaked[i] = 0;
+ }
+ GC_n_leaked = 0;
+ printing_errors = FALSE;
+}
+
+
+# define FOUND_FREE(hblk, word_no) \
+ { \
+ GC_add_leaked((ptr_t)hblk + WORDS_TO_BYTES(word_no)); \
+ }
+
+/*
+ * reclaim phase
+ *
+ */
+
+
+/*
+ * Test whether a block is completely empty, i.e. contains no marked
+ * objects. This does not require the block to be in physical
+ * memory.
+ */
+
+GC_bool GC_block_empty(hhdr)
+register hdr * hhdr;
+{
+ /* We treat hb_marks as an array of words here, even if it is */
+ /* actually an array of bytes. Since we only check for zero, there */
+ /* are no endian-ness issues. */
+ register word *p = (word *)(&(hhdr -> hb_marks[0]));
+ register word * plim =
+ (word *)(&(hhdr -> hb_marks[MARK_BITS_SZ]));
+ while (p < plim) {
+ if (*p++) return(FALSE);
+ }
+ return(TRUE);
+}
+
+/* The following functions sometimes return a DONT_KNOW value. */
+#define DONT_KNOW 2
+
+#ifdef SMALL_CONFIG
+# define GC_block_nearly_full1(hhdr, pat1) DONT_KNOW
+# define GC_block_nearly_full3(hhdr, pat1, pat2) DONT_KNOW
+# define GC_block_nearly_full(hhdr) DONT_KNOW
+#endif
+
+#if !defined(SMALL_CONFIG) && defined(USE_MARK_BYTES)
+
+# define GC_block_nearly_full1(hhdr, pat1) GC_block_nearly_full(hhdr)
+# define GC_block_nearly_full3(hhdr, pat1, pat2) GC_block_nearly_full(hhdr)
+
+
+GC_bool GC_block_nearly_full(hhdr)
+register hdr * hhdr;
+{
+ /* We again treat hb_marks as an array of words, even though it */
+ /* isn't. We first sum up all the words, resulting in a word */
+ /* containing 4 or 8 separate partial sums. */
+ /* We then sum the bytes in the word of partial sums. */
+ /* This is still endian independant. This fails if the partial */
+ /* sums can overflow. */
+# if (BYTES_TO_WORDS(MARK_BITS_SZ)) >= 256
+ --> potential overflow; fix the code
+# endif
+ register word *p = (word *)(&(hhdr -> hb_marks[0]));
+ register word * plim =
+ (word *)(&(hhdr -> hb_marks[MARK_BITS_SZ]));
+ word sum_vector = 0;
+ unsigned sum;
+ while (p < plim) {
+ sum_vector += *p;
+ ++p;
+ }
+ sum = 0;
+ while (sum_vector > 0) {
+ sum += sum_vector & 0xff;
+ sum_vector >>= 8;
+ }
+ return (sum > BYTES_TO_WORDS(7*HBLKSIZE/8)/(hhdr -> hb_sz));
+}
+#endif /* USE_MARK_BYTES */
+
+#if !defined(SMALL_CONFIG) && !defined(USE_MARK_BYTES)
+
+/*
+ * Test whether nearly all of the mark words consist of the same
+ * repeating pattern.
+ */
+#define FULL_THRESHOLD (MARK_BITS_SZ/16)
+
+GC_bool GC_block_nearly_full1(hhdr, pat1)
+hdr *hhdr;
+word pat1;
+{
+ unsigned i;
+ unsigned misses = 0;
+ GC_ASSERT((MARK_BITS_SZ & 1) == 0);
+ for (i = 0; i < MARK_BITS_SZ; ++i) {
+ if ((hhdr -> hb_marks[i] | ~pat1) != ONES) {
+ if (++misses > FULL_THRESHOLD) return FALSE;
+ }
+ }
+ return TRUE;
+}
+
+/*
+ * Test whether the same repeating 3 word pattern occurs in nearly
+ * all the mark bit slots.
+ * This is used as a heuristic, so we're a bit sloppy and ignore
+ * the last one or two words.
+ */
+GC_bool GC_block_nearly_full3(hhdr, pat1, pat2, pat3)
+hdr *hhdr;
+word pat1, pat2, pat3;
+{
+ unsigned i;
+ unsigned misses = 0;
+
+ if (MARK_BITS_SZ < 4) {
+ return DONT_KNOW;
+ }
+ for (i = 0; i < MARK_BITS_SZ - 2; i += 3) {
+ if ((hhdr -> hb_marks[i] | ~pat1) != ONES) {
+ if (++misses > FULL_THRESHOLD) return FALSE;
+ }
+ if ((hhdr -> hb_marks[i+1] | ~pat2) != ONES) {
+ if (++misses > FULL_THRESHOLD) return FALSE;
+ }
+ if ((hhdr -> hb_marks[i+2] | ~pat3) != ONES) {
+ if (++misses > FULL_THRESHOLD) return FALSE;
+ }
+ }
+ return TRUE;
+}
+
+/* Check whether a small object block is nearly full by looking at only */
+/* the mark bits. */
+/* We manually precomputed the mark bit patterns that need to be */
+/* checked for, and we give up on the ones that are unlikely to occur, */
+/* or have period > 3. */
+/* This would be a lot easier with a mark bit per object instead of per */
+/* word, but that would rewuire computing object numbers in the mark */
+/* loop, which would require different data structures ... */
+GC_bool GC_block_nearly_full(hhdr)
+hdr *hhdr;
+{
+ int sz = hhdr -> hb_sz;
+
+# if CPP_WORDSZ != 32 && CPP_WORDSZ != 64
+ return DONT_KNOW; /* Shouldn't be used in any standard config. */
+# endif
+# if CPP_WORDSZ == 32
+ switch(sz) {
+ case 1:
+ return GC_block_nearly_full1(hhdr, 0xffffffffl);
+ case 2:
+ return GC_block_nearly_full1(hhdr, 0x55555555l);
+ case 4:
+ return GC_block_nearly_full1(hhdr, 0x11111111l);
+ case 6:
+ return GC_block_nearly_full3(hhdr, 0x41041041l,
+ 0x10410410l,
+ 0x04104104l);
+ case 8:
+ return GC_block_nearly_full1(hhdr, 0x01010101l);
+ case 12:
+ return GC_block_nearly_full3(hhdr, 0x01001001l,
+ 0x10010010l,
+ 0x00100100l);
+ case 16:
+ return GC_block_nearly_full1(hhdr, 0x00010001l);
+ case 32:
+ return GC_block_nearly_full1(hhdr, 0x00000001l);
+ default:
+ return DONT_KNOW;
+ }
+# endif
+# if CPP_WORDSZ == 64
+ switch(sz) {
+ case 1:
+ return GC_block_nearly_full1(hhdr, 0xffffffffffffffffl);
+ case 2:
+ return GC_block_nearly_full1(hhdr, 0x5555555555555555l);
+ case 4:
+ return GC_block_nearly_full1(hhdr, 0x1111111111111111l);
+ case 6:
+ return GC_block_nearly_full3(hhdr, 0x1041041041041041l,
+ 0x4104104104104104l,
+ 0x0410410410410410l);
+ case 8:
+ return GC_block_nearly_full1(hhdr, 0x0101010101010101l);
+ case 12:
+ return GC_block_nearly_full3(hhdr, 0x1001001001001001l,
+ 0x0100100100100100l,
+ 0x0010010010010010l);
+ case 16:
+ return GC_block_nearly_full1(hhdr, 0x0001000100010001l);
+ case 32:
+ return GC_block_nearly_full1(hhdr, 0x0000000100000001l);
+ default:
+ return DONT_KNOW;
+ }
+# endif
+}
+#endif /* !SMALL_CONFIG && !USE_MARK_BYTES */
+
+/* We keep track of reclaimed memory if we are either asked to, or */
+/* we are using the parallel marker. In the latter case, we assume */
+/* that most allocation goes through GC_malloc_many for scalability. */
+/* GC_malloc_many needs the count anyway. */
+# if defined(GATHERSTATS) || defined(PARALLEL_MARK)
+# define INCR_WORDS(sz) n_words_found += (sz)
+# define COUNT_PARAM , count
+# define COUNT_ARG , count
+# define COUNT_DECL signed_word * count;
+# define NWORDS_DECL signed_word n_words_found = 0;
+# define COUNT_UPDATE *count += n_words_found;
+# define MEM_FOUND_ADDR , &GC_mem_found
+# else
+# define INCR_WORDS(sz)
+# define COUNT_PARAM
+# define COUNT_ARG
+# define COUNT_DECL
+# define NWORDS_DECL
+# define COUNT_UPDATE
+# define MEM_FOUND_ADDR
+# endif
+/*
+ * Restore unmarked small objects in h of size sz to the object
+ * free list. Returns the new list.
+ * Clears unmarked objects.
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_clear(hbp, hhdr, sz, list COUNT_PARAM)
+register struct hblk *hbp; /* ptr to current heap block */
+register hdr * hhdr;
+register ptr_t list;
+register word sz;
+COUNT_DECL
+{
+ register int word_no;
+ register word *p, *q, *plim;
+ NWORDS_DECL
+
+ GC_ASSERT(hhdr == GC_find_header((ptr_t)hbp));
+ p = (word *)(hbp->hb_body);
+ word_no = 0;
+ plim = (word *)((((word)hbp) + HBLKSIZE)
+ - WORDS_TO_BYTES(sz));
+
+ /* go through all words in block */
+ while( p <= plim ) {
+ if( mark_bit_from_hdr(hhdr, word_no) ) {
+ p += sz;
+ } else {
+ INCR_WORDS(sz);
+ /* object is available - put on list */
+ obj_link(p) = list;
+ list = ((ptr_t)p);
+ /* Clear object, advance p to next object in the process */
+ q = p + sz;
+# ifdef USE_MARK_BYTES
+ GC_ASSERT(!(sz & 1)
+ && !((word)p & (2 * sizeof(word) - 1)));
+ p[1] = 0;
+ p += 2;
+ while (p < q) {
+ CLEAR_DOUBLE(p);
+ p += 2;
+ }
+# else
+ p++; /* Skip link field */
+ while (p < q) {
+ *p++ = 0;
+ }
+# endif
+ }
+ word_no += sz;
+ }
+ COUNT_UPDATE
+ return(list);
+}
+
+#if !defined(SMALL_CONFIG) && !defined(USE_MARK_BYTES)
+
+/*
+ * A special case for 2 word composite objects (e.g. cons cells):
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_clear2(hbp, hhdr, list COUNT_PARAM)
+register struct hblk *hbp; /* ptr to current heap block */
+hdr * hhdr;
+register ptr_t list;
+COUNT_DECL
+{
+ register word * mark_word_addr = &(hhdr->hb_marks[0]);
+ register word *p, *plim;
+ register word mark_word;
+ register int i;
+ NWORDS_DECL
+# define DO_OBJ(start_displ) \
+ if (!(mark_word & ((word)1 << start_displ))) { \
+ p[start_displ] = (word)list; \
+ list = (ptr_t)(p+start_displ); \
+ p[start_displ+1] = 0; \
+ INCR_WORDS(2); \
+ }
+
+ p = (word *)(hbp->hb_body);
+ plim = (word *)(((word)hbp) + HBLKSIZE);
+
+ /* go through all words in block */
+ while( p < plim ) {
+ mark_word = *mark_word_addr++;
+ for (i = 0; i < WORDSZ; i += 8) {
+ DO_OBJ(0);
+ DO_OBJ(2);
+ DO_OBJ(4);
+ DO_OBJ(6);
+ p += 8;
+ mark_word >>= 8;
+ }
+ }
+ COUNT_UPDATE
+ return(list);
+# undef DO_OBJ
+}
+
+/*
+ * Another special case for 4 word composite objects:
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_clear4(hbp, hhdr, list COUNT_PARAM)
+register struct hblk *hbp; /* ptr to current heap block */
+hdr * hhdr;
+register ptr_t list;
+COUNT_DECL
+{
+ register word * mark_word_addr = &(hhdr->hb_marks[0]);
+ register word *p, *plim;
+ register word mark_word;
+ NWORDS_DECL
+# define DO_OBJ(start_displ) \
+ if (!(mark_word & ((word)1 << start_displ))) { \
+ p[start_displ] = (word)list; \
+ list = (ptr_t)(p+start_displ); \
+ p[start_displ+1] = 0; \
+ CLEAR_DOUBLE(p + start_displ + 2); \
+ INCR_WORDS(4); \
+ }
+
+ p = (word *)(hbp->hb_body);
+ plim = (word *)(((word)hbp) + HBLKSIZE);
+
+ /* go through all words in block */
+ while( p < plim ) {
+ mark_word = *mark_word_addr++;
+ DO_OBJ(0);
+ DO_OBJ(4);
+ DO_OBJ(8);
+ DO_OBJ(12);
+ DO_OBJ(16);
+ DO_OBJ(20);
+ DO_OBJ(24);
+ DO_OBJ(28);
+# if CPP_WORDSZ == 64
+ DO_OBJ(32);
+ DO_OBJ(36);
+ DO_OBJ(40);
+ DO_OBJ(44);
+ DO_OBJ(48);
+ DO_OBJ(52);
+ DO_OBJ(56);
+ DO_OBJ(60);
+# endif
+ p += WORDSZ;
+ }
+ COUNT_UPDATE
+ return(list);
+# undef DO_OBJ
+}
+
+#endif /* !SMALL_CONFIG && !USE_MARK_BYTES */
+
+/* The same thing, but don't clear objects: */
+/*ARGSUSED*/
+ptr_t GC_reclaim_uninit(hbp, hhdr, sz, list COUNT_PARAM)
+register struct hblk *hbp; /* ptr to current heap block */
+register hdr * hhdr;
+register ptr_t list;
+register word sz;
+COUNT_DECL
+{
+ register int word_no = 0;
+ register word *p, *plim;
+ NWORDS_DECL
+
+ p = (word *)(hbp->hb_body);
+ plim = (word *)((((word)hbp) + HBLKSIZE)
+ - WORDS_TO_BYTES(sz));
+
+ /* go through all words in block */
+ while( p <= plim ) {
+ if( !mark_bit_from_hdr(hhdr, word_no) ) {
+ INCR_WORDS(sz);
+ /* object is available - put on list */
+ obj_link(p) = list;
+ list = ((ptr_t)p);
+ }
+ p += sz;
+ word_no += sz;
+ }
+ COUNT_UPDATE
+ return(list);
+}
+
+/* Don't really reclaim objects, just check for unmarked ones: */
+/*ARGSUSED*/
+void GC_reclaim_check(hbp, hhdr, sz)
+register struct hblk *hbp; /* ptr to current heap block */
+register hdr * hhdr;
+register word sz;
+{
+ register int word_no = 0;
+ register word *p, *plim;
+# ifdef GATHERSTATS
+ register int n_words_found = 0;
+# endif
+
+ p = (word *)(hbp->hb_body);
+ plim = (word *)((((word)hbp) + HBLKSIZE)
+ - WORDS_TO_BYTES(sz));
+
+ /* go through all words in block */
+ while( p <= plim ) {
+ if( !mark_bit_from_hdr(hhdr, word_no) ) {
+ FOUND_FREE(hbp, word_no);
+ }
+ p += sz;
+ word_no += sz;
+ }
+}
+
+#if !defined(SMALL_CONFIG) && !defined(USE_MARK_BYTES)
+/*
+ * Another special case for 2 word atomic objects:
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_uninit2(hbp, hhdr, list COUNT_PARAM)
+register struct hblk *hbp; /* ptr to current heap block */
+hdr * hhdr;
+register ptr_t list;
+COUNT_DECL
+{
+ register word * mark_word_addr = &(hhdr->hb_marks[0]);
+ register word *p, *plim;
+ register word mark_word;
+ register int i;
+ NWORDS_DECL
+# define DO_OBJ(start_displ) \
+ if (!(mark_word & ((word)1 << start_displ))) { \
+ p[start_displ] = (word)list; \
+ list = (ptr_t)(p+start_displ); \
+ INCR_WORDS(2); \
+ }
+
+ p = (word *)(hbp->hb_body);
+ plim = (word *)(((word)hbp) + HBLKSIZE);
+
+ /* go through all words in block */
+ while( p < plim ) {
+ mark_word = *mark_word_addr++;
+ for (i = 0; i < WORDSZ; i += 8) {
+ DO_OBJ(0);
+ DO_OBJ(2);
+ DO_OBJ(4);
+ DO_OBJ(6);
+ p += 8;
+ mark_word >>= 8;
+ }
+ }
+ COUNT_UPDATE
+ return(list);
+# undef DO_OBJ
+}
+
+/*
+ * Another special case for 4 word atomic objects:
+ */
+/*ARGSUSED*/
+ptr_t GC_reclaim_uninit4(hbp, hhdr, list COUNT_PARAM)
+register struct hblk *hbp; /* ptr to current heap block */
+hdr * hhdr;
+register ptr_t list;
+COUNT_DECL
+{
+ register word * mark_word_addr = &(hhdr->hb_marks[0]);
+ register word *p, *plim;
+ register word mark_word;
+ NWORDS_DECL
+# define DO_OBJ(start_displ) \
+ if (!(mark_word & ((word)1 << start_displ))) { \
+ p[start_displ] = (word)list; \
+ list = (ptr_t)(p+start_displ); \
+ INCR_WORDS(4); \
+ }
+
+ p = (word *)(hbp->hb_body);
+ plim = (word *)(((word)hbp) + HBLKSIZE);
+
+ /* go through all words in block */
+ while( p < plim ) {
+ mark_word = *mark_word_addr++;
+ DO_OBJ(0);
+ DO_OBJ(4);
+ DO_OBJ(8);
+ DO_OBJ(12);
+ DO_OBJ(16);
+ DO_OBJ(20);
+ DO_OBJ(24);
+ DO_OBJ(28);
+# if CPP_WORDSZ == 64
+ DO_OBJ(32);
+ DO_OBJ(36);
+ DO_OBJ(40);
+ DO_OBJ(44);
+ DO_OBJ(48);
+ DO_OBJ(52);
+ DO_OBJ(56);
+ DO_OBJ(60);
+# endif
+ p += WORDSZ;
+ }
+ COUNT_UPDATE
+ return(list);
+# undef DO_OBJ
+}
+
+/* Finally the one word case, which never requires any clearing: */
+/*ARGSUSED*/
+ptr_t GC_reclaim1(hbp, hhdr, list COUNT_PARAM)
+register struct hblk *hbp; /* ptr to current heap block */
+hdr * hhdr;
+register ptr_t list;
+COUNT_DECL
+{
+ register word * mark_word_addr = &(hhdr->hb_marks[0]);
+ register word *p, *plim;
+ register word mark_word;
+ register int i;
+ NWORDS_DECL
+# define DO_OBJ(start_displ) \
+ if (!(mark_word & ((word)1 << start_displ))) { \
+ p[start_displ] = (word)list; \
+ list = (ptr_t)(p+start_displ); \
+ INCR_WORDS(1); \
+ }
+
+ p = (word *)(hbp->hb_body);
+ plim = (word *)(((word)hbp) + HBLKSIZE);
+
+ /* go through all words in block */
+ while( p < plim ) {
+ mark_word = *mark_word_addr++;
+ for (i = 0; i < WORDSZ; i += 4) {
+ DO_OBJ(0);
+ DO_OBJ(1);
+ DO_OBJ(2);
+ DO_OBJ(3);
+ p += 4;
+ mark_word >>= 4;
+ }
+ }
+ COUNT_UPDATE
+ return(list);
+# undef DO_OBJ
+}
+
+#endif /* !SMALL_CONFIG && !USE_MARK_BYTES */
+
+/*
+ * Generic procedure to rebuild a free list in hbp.
+ * Also called directly from GC_malloc_many.
+ */
+ptr_t GC_reclaim_generic(hbp, hhdr, sz, init, list COUNT_PARAM)
+struct hblk *hbp; /* ptr to current heap block */
+hdr * hhdr;
+GC_bool init;
+ptr_t list;
+word sz;
+COUNT_DECL
+{
+ ptr_t result = list;
+
+ GC_ASSERT(GC_find_header((ptr_t)hbp) == hhdr);
+ GC_remove_protection(hbp, 1, (hhdr)->hb_descr == 0 /* Pointer-free? */);
+ if (init) {
+ switch(sz) {
+# if !defined(SMALL_CONFIG) && !defined(USE_MARK_BYTES)
+ case 1:
+ /* We now issue the hint even if GC_nearly_full returned */
+ /* DONT_KNOW. */
+ result = GC_reclaim1(hbp, hhdr, list COUNT_ARG);
+ break;
+ case 2:
+ result = GC_reclaim_clear2(hbp, hhdr, list COUNT_ARG);
+ break;
+ case 4:
+ result = GC_reclaim_clear4(hbp, hhdr, list COUNT_ARG);
+ break;
+# endif /* !SMALL_CONFIG && !USE_MARK_BYTES */
+ default:
+ result = GC_reclaim_clear(hbp, hhdr, sz, list COUNT_ARG);
+ break;
+ }
+ } else {
+ GC_ASSERT((hhdr)->hb_descr == 0 /* Pointer-free block */);
+ switch(sz) {
+# if !defined(SMALL_CONFIG) && !defined(USE_MARK_BYTES)
+ case 1:
+ result = GC_reclaim1(hbp, hhdr, list COUNT_ARG);
+ break;
+ case 2:
+ result = GC_reclaim_uninit2(hbp, hhdr, list COUNT_ARG);
+ break;
+ case 4:
+ result = GC_reclaim_uninit4(hbp, hhdr, list COUNT_ARG);
+ break;
+# endif /* !SMALL_CONFIG && !USE_MARK_BYTES */
+ default:
+ result = GC_reclaim_uninit(hbp, hhdr, sz, list COUNT_ARG);
+ break;
+ }
+ }
+ if (IS_UNCOLLECTABLE(hhdr -> hb_obj_kind)) GC_set_hdr_marks(hhdr);
+ return result;
+}
+
+/*
+ * Restore unmarked small objects in the block pointed to by hbp
+ * to the appropriate object free list.
+ * If entirely empty blocks are to be completely deallocated, then
+ * caller should perform that check.
+ */
+void GC_reclaim_small_nonempty_block(hbp, report_if_found COUNT_PARAM)
+register struct hblk *hbp; /* ptr to current heap block */
+int report_if_found; /* Abort if a reclaimable object is found */
+COUNT_DECL
+{
+ hdr *hhdr = HDR(hbp);
+ word sz = hhdr -> hb_sz;
+ int kind = hhdr -> hb_obj_kind;
+ struct obj_kind * ok = &GC_obj_kinds[kind];
+ ptr_t * flh = &(ok -> ok_freelist[sz]);
+
+ hhdr -> hb_last_reclaimed = (unsigned short) GC_gc_no;
+
+ if (report_if_found) {
+ GC_reclaim_check(hbp, hhdr, sz);
+ } else {
+ *flh = GC_reclaim_generic(hbp, hhdr, sz,
+ (ok -> ok_init || GC_debugging_started),
+ *flh MEM_FOUND_ADDR);
+ }
+}
+
+/*
+ * Restore an unmarked large object or an entirely empty blocks of small objects
+ * to the heap block free list.
+ * Otherwise enqueue the block for later processing
+ * by GC_reclaim_small_nonempty_block.
+ * If report_if_found is TRUE, then process any block immediately, and
+ * simply report free objects; do not actually reclaim them.
+ */
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_reclaim_block(register struct hblk *hbp, word report_if_found)
+# else
+ void GC_reclaim_block(hbp, report_if_found)
+ register struct hblk *hbp; /* ptr to current heap block */
+ word report_if_found; /* Abort if a reclaimable object is found */
+# endif
+{
+ register hdr * hhdr;
+ register word sz; /* size of objects in current block */
+ register struct obj_kind * ok;
+ struct hblk ** rlh;
+
+ hhdr = HDR(hbp);
+ sz = hhdr -> hb_sz;
+ ok = &GC_obj_kinds[hhdr -> hb_obj_kind];
+
+ if( sz > MAXOBJSZ ) { /* 1 big object */
+ if( !mark_bit_from_hdr(hhdr, 0) ) {
+ if (report_if_found) {
+ FOUND_FREE(hbp, 0);
+ } else {
+ word blocks = OBJ_SZ_TO_BLOCKS(sz);
+ if (blocks > 1) {
+ GC_large_allocd_bytes -= blocks * HBLKSIZE;
+ }
+# ifdef GATHERSTATS
+ GC_mem_found += sz;
+# endif
+ GC_freehblk(hbp);
+ }
+ }
+ } else {
+ GC_bool empty = GC_block_empty(hhdr);
+ if (report_if_found) {
+ GC_reclaim_small_nonempty_block(hbp, (int)report_if_found
+ MEM_FOUND_ADDR);
+ } else if (empty) {
+# ifdef GATHERSTATS
+ GC_mem_found += BYTES_TO_WORDS(HBLKSIZE);
+# endif
+ GC_freehblk(hbp);
+ } else if (TRUE != GC_block_nearly_full(hhdr)){
+ /* group of smaller objects, enqueue the real work */
+ rlh = &(ok -> ok_reclaim_list[sz]);
+ hhdr -> hb_next = *rlh;
+ *rlh = hbp;
+ } /* else not worth salvaging. */
+ /* We used to do the nearly_full check later, but we */
+ /* already have the right cache context here. Also */
+ /* doing it here avoids some silly lock contention in */
+ /* GC_malloc_many. */
+ }
+}
+
+#if !defined(NO_DEBUGGING)
+/* Routines to gather and print heap block info */
+/* intended for debugging. Otherwise should be called */
+/* with lock. */
+
+struct Print_stats
+{
+ size_t number_of_blocks;
+ size_t total_bytes;
+};
+
+#ifdef USE_MARK_BYTES
+
+/* Return the number of set mark bits in the given header */
+int GC_n_set_marks(hhdr)
+hdr * hhdr;
+{
+ register int result = 0;
+ register int i;
+
+ for (i = 0; i < MARK_BITS_SZ; i++) {
+ result += hhdr -> hb_marks[i];
+ }
+ return(result);
+}
+
+#else
+
+/* Number of set bits in a word. Not performance critical. */
+static int set_bits(n)
+word n;
+{
+ register word m = n;
+ register int result = 0;
+
+ while (m > 0) {
+ if (m & 1) result++;
+ m >>= 1;
+ }
+ return(result);
+}
+
+/* Return the number of set mark bits in the given header */
+int GC_n_set_marks(hhdr)
+hdr * hhdr;
+{
+ register int result = 0;
+ register int i;
+
+ for (i = 0; i < MARK_BITS_SZ; i++) {
+ result += set_bits(hhdr -> hb_marks[i]);
+ }
+ return(result);
+}
+
+#endif /* !USE_MARK_BYTES */
+
+/*ARGSUSED*/
+# if defined(__STDC__) || defined(__cplusplus)
+ void GC_print_block_descr(struct hblk *h, word dummy)
+# else
+ void GC_print_block_descr(h, dummy)
+ struct hblk *h;
+ word dummy;
+# endif
+{
+ register hdr * hhdr = HDR(h);
+ register size_t bytes = WORDS_TO_BYTES(hhdr -> hb_sz);
+ struct Print_stats *ps;
+
+ GC_printf3("(%lu:%lu,%lu)", (unsigned long)(hhdr -> hb_obj_kind),
+ (unsigned long)bytes,
+ (unsigned long)(GC_n_set_marks(hhdr)));
+ bytes += HBLKSIZE-1;
+ bytes &= ~(HBLKSIZE-1);
+
+ ps = (struct Print_stats *)dummy;
+ ps->total_bytes += bytes;
+ ps->number_of_blocks++;
+}
+
+void GC_print_block_list()
+{
+ struct Print_stats pstats;
+
+ GC_printf0("(kind(0=ptrfree,1=normal,2=unc.,3=stubborn):size_in_bytes, #_marks_set)\n");
+ pstats.number_of_blocks = 0;
+ pstats.total_bytes = 0;
+ GC_apply_to_all_blocks(GC_print_block_descr, (word)&pstats);
+ GC_printf2("\nblocks = %lu, bytes = %lu\n",
+ (unsigned long)pstats.number_of_blocks,
+ (unsigned long)pstats.total_bytes);
+}
+
+#endif /* NO_DEBUGGING */
+
+/*
+ * Clear all obj_link pointers in the list of free objects *flp.
+ * Clear *flp.
+ * This must be done before dropping a list of free gcj-style objects,
+ * since may otherwise end up with dangling "descriptor" pointers.
+ * It may help for other pointer-containg objects.
+ */
+void GC_clear_fl_links(flp)
+ptr_t *flp;
+{
+ ptr_t next = *flp;
+
+ while (0 != next) {
+ *flp = 0;
+ flp = &(obj_link(next));
+ next = *flp;
+ }
+}
+
+/*
+ * Perform GC_reclaim_block on the entire heap, after first clearing
+ * small object free lists (if we are not just looking for leaks).
+ */
+void GC_start_reclaim(report_if_found)
+int report_if_found; /* Abort if a GC_reclaimable object is found */
+{
+ int kind;
+
+# if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ GC_ASSERT(0 == GC_fl_builder_count);
+# endif
+ /* Clear reclaim- and free-lists */
+ for (kind = 0; kind < GC_n_kinds; kind++) {
+ ptr_t *fop;
+ ptr_t *lim;
+ struct hblk ** rlp;
+ struct hblk ** rlim;
+ struct hblk ** rlist = GC_obj_kinds[kind].ok_reclaim_list;
+ GC_bool should_clobber = (GC_obj_kinds[kind].ok_descriptor != 0);
+
+ if (rlist == 0) continue; /* This kind not used. */
+ if (!report_if_found) {
+ lim = &(GC_obj_kinds[kind].ok_freelist[MAXOBJSZ+1]);
+ for( fop = GC_obj_kinds[kind].ok_freelist; fop < lim; fop++ ) {
+ if (*fop != 0) {
+ if (should_clobber) {
+ GC_clear_fl_links(fop);
+ } else {
+ *fop = 0;
+ }
+ }
+ }
+ } /* otherwise free list objects are marked, */
+ /* and its safe to leave them */
+ rlim = rlist + MAXOBJSZ+1;
+ for( rlp = rlist; rlp < rlim; rlp++ ) {
+ *rlp = 0;
+ }
+ }
+
+# ifdef PRINTBLOCKS
+ GC_printf0("GC_reclaim: current block sizes:\n");
+ GC_print_block_list();
+# endif
+
+ /* Go through all heap blocks (in hblklist) and reclaim unmarked objects */
+ /* or enqueue the block for later processing. */
+ GC_apply_to_all_blocks(GC_reclaim_block, (word)report_if_found);
+
+# ifdef EAGER_SWEEP
+ /* This is a very stupid thing to do. We make it possible anyway, */
+ /* so that you can convince yourself that it really is very stupid. */
+ GC_reclaim_all((GC_stop_func)0, FALSE);
+# endif
+# if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
+ GC_ASSERT(0 == GC_fl_builder_count);
+# endif
+
+}
+
+/*
+ * Sweep blocks of the indicated object size and kind until either the
+ * appropriate free list is nonempty, or there are no more blocks to
+ * sweep.
+ */
+void GC_continue_reclaim(sz, kind)
+word sz; /* words */
+int kind;
+{
+ register hdr * hhdr;
+ register struct hblk * hbp;
+ register struct obj_kind * ok = &(GC_obj_kinds[kind]);
+ struct hblk ** rlh = ok -> ok_reclaim_list;
+ ptr_t *flh = &(ok -> ok_freelist[sz]);
+
+ if (rlh == 0) return; /* No blocks of this kind. */
+ rlh += sz;
+ while ((hbp = *rlh) != 0) {
+ hhdr = HDR(hbp);
+ *rlh = hhdr -> hb_next;
+ GC_reclaim_small_nonempty_block(hbp, FALSE MEM_FOUND_ADDR);
+ if (*flh != 0) break;
+ }
+}
+
+/*
+ * Reclaim all small blocks waiting to be reclaimed.
+ * Abort and return FALSE when/if (*stop_func)() returns TRUE.
+ * If this returns TRUE, then it's safe to restart the world
+ * with incorrectly cleared mark bits.
+ * If ignore_old is TRUE, then reclaim only blocks that have been
+ * recently reclaimed, and discard the rest.
+ * Stop_func may be 0.
+ */
+GC_bool GC_reclaim_all(stop_func, ignore_old)
+GC_stop_func stop_func;
+GC_bool ignore_old;
+{
+ register word sz;
+ register int kind;
+ register hdr * hhdr;
+ register struct hblk * hbp;
+ register struct obj_kind * ok;
+ struct hblk ** rlp;
+ struct hblk ** rlh;
+# ifdef PRINTTIMES
+ CLOCK_TYPE start_time;
+ CLOCK_TYPE done_time;
+
+ GET_TIME(start_time);
+# endif
+
+ for (kind = 0; kind < GC_n_kinds; kind++) {
+ ok = &(GC_obj_kinds[kind]);
+ rlp = ok -> ok_reclaim_list;
+ if (rlp == 0) continue;
+ for (sz = 1; sz <= MAXOBJSZ; sz++) {
+ rlh = rlp + sz;
+ while ((hbp = *rlh) != 0) {
+ if (stop_func != (GC_stop_func)0 && (*stop_func)()) {
+ return(FALSE);
+ }
+ hhdr = HDR(hbp);
+ *rlh = hhdr -> hb_next;
+ if (!ignore_old || hhdr -> hb_last_reclaimed == GC_gc_no - 1) {
+ /* It's likely we'll need it this time, too */
+ /* It's been touched recently, so this */
+ /* shouldn't trigger paging. */
+ GC_reclaim_small_nonempty_block(hbp, FALSE MEM_FOUND_ADDR);
+ }
+ }
+ }
+ }
+# ifdef PRINTTIMES
+ GET_TIME(done_time);
+ GC_printf1("Disposing of reclaim lists took %lu msecs\n",
+ MS_TIME_DIFF(done_time,start_time));
+# endif
+ return(TRUE);
+}
--- /dev/null
+ .set r0,0
+ .set r1,1
+ .set r2,2
+ .set r3,3
+ .set r4,4
+ .set r5,5
+ .set r6,6
+ .set r7,7
+ .set r8,8
+ .set r9,9
+ .set r10,10
+ .set r11,11
+ .set r12,12
+ .set r13,13
+ .set r14,14
+ .set r15,15
+ .set r16,16
+ .set r17,17
+ .set r18,18
+ .set r19,19
+ .set r20,20
+ .set r21,21
+ .set r22,22
+ .set r23,23
+ .set r24,24
+ .set r25,25
+ .set r26,26
+ .set r27,27
+ .set r28,28
+ .set r29,29
+ .set r30,30
+ .set r31,31
+
+ .extern .GC_push_one
+ # Mark from machine registers that are saved by C compiler
+ .globl .GC_push_regs
+.csect .text[PR]
+ .align 2
+ .globl GC_push_regs
+ .globl .GC_push_regs
+.csect GC_push_regs[DS]
+GC_push_regs:
+ .long .GC_push_regs, TOC[tc0], 0
+.csect .text[PR]
+.GC_push_regs:
+ stu r1,-64(r1) # reserve stack frame
+ mflr r0 # save link register
+ st r0,0x48(r1)
+ oril r3,r2,0x0 # mark from r2
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r13,0x0 # mark from r13-r31
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r14,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r15,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r16,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r17,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r18,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r19,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r20,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r21,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r22,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r23,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r24,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r25,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r26,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r27,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r28,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r29,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r30,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ oril r3,r31,0x0
+ bl .GC_push_one
+ cror 15,15,15
+ l r0,0x48(r1)
+ mtlr r0
+ ai r1,r1,64
+ br
+ .long 0
+ .byte 0,0,0,0,0,0,0,0
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+/* Check whether setjmp actually saves registers in jmp_buf. */
+/* If it doesn't, the generic mark_regs code won't work. */
+/* Compilers vary as to whether they will put x in a */
+/* (callee-save) register without -O. The code is */
+/* contrived such that any decent compiler should put x in */
+/* a callee-save register with -O. Thus it is is */
+/* recommended that this be run optimized. (If the machine */
+/* has no callee-save registers, then the generic code is */
+/* safe, but this will not be noticed by this piece of */
+/* code.) This test appears to be far from perfect. */
+#include <stdio.h>
+#include <setjmp.h>
+#include <string.h>
+#include "private/gcconfig.h"
+
+#ifdef OS2
+/* GETPAGESIZE() is set to getpagesize() by default, but that */
+/* doesn't really exist, and the collector doesn't need it. */
+#define INCL_DOSFILEMGR
+#define INCL_DOSMISC
+#define INCL_DOSERRORS
+#include <os2.h>
+
+int
+getpagesize()
+{
+ ULONG result[1];
+
+ if (DosQuerySysInfo(QSV_PAGE_SIZE, QSV_PAGE_SIZE,
+ (void *)result, sizeof(ULONG)) != NO_ERROR) {
+ fprintf(stderr, "DosQuerySysInfo failed\n");
+ result[0] = 4096;
+ }
+ return((int)(result[0]));
+}
+#endif
+
+struct {char a_a; char * a_b;} a;
+
+int * nested_sp()
+{
+ int dummy;
+
+ return(&dummy);
+}
+
+main()
+{
+ int dummy;
+ long ps = GETPAGESIZE();
+ jmp_buf b;
+ register int x = (int)strlen("a"); /* 1, slightly disguised */
+ static int y = 0;
+
+ printf("This appears to be a %s running %s\n", MACH_TYPE, OS_TYPE);
+ if (nested_sp() < &dummy) {
+ printf("Stack appears to grow down, which is the default.\n");
+ printf("A good guess for STACKBOTTOM on this machine is 0x%lx.\n",
+ ((unsigned long)(&dummy) + ps) & ~(ps-1));
+ } else {
+ printf("Stack appears to grow up.\n");
+ printf("Define STACK_GROWS_UP in gc_private.h\n");
+ printf("A good guess for STACKBOTTOM on this machine is 0x%lx.\n",
+ ((unsigned long)(&dummy) + ps) & ~(ps-1));
+ }
+ printf("Note that this may vary between machines of ostensibly\n");
+ printf("the same architecture (e.g. Sun 3/50s and 3/80s).\n");
+ printf("On many machines the value is not fixed.\n");
+ printf("A good guess for ALIGNMENT on this machine is %ld.\n",
+ (unsigned long)(&(a.a_b))-(unsigned long)(&a));
+
+ /* Encourage the compiler to keep x in a callee-save register */
+ x = 2*x-1;
+ printf("");
+ x = 2*x-1;
+ setjmp(b);
+ if (y == 1) {
+ if (x == 2) {
+ printf("Generic mark_regs code probably wont work\n");
+# if defined(SPARC) || defined(RS6000) || defined(VAX) || defined(MIPS) || defined(M68K) || defined(I386) || defined(NS32K) || defined(RT)
+ printf("Assembly code supplied\n");
+# else
+ printf("Need assembly code\n");
+# endif
+ } else if (x == 1) {
+ printf("Generic mark_regs code may work\n");
+ } else {
+ printf("Very strange setjmp implementation\n");
+ }
+ }
+ y++;
+ x = 2;
+ if (y == 1) longjmp(b,1);
+ return(0);
+}
+
+int g(x)
+int x;
+{
+ return(x);
+}
--- /dev/null
+/*
+ * Copyright (c) 1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Support code for Solaris threads. Provides functionality we wish Sun
+ * had provided. Relies on some information we probably shouldn't rely on.
+ * Modified by Peter C. for Solaris Posix Threads.
+ */
+
+# if defined(GC_SOLARIS_PTHREADS)
+# include "private/gc_priv.h"
+# include <pthread.h>
+# include <thread.h>
+# include <signal.h>
+# include <fcntl.h>
+# include <sys/types.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+# include <sys/resource.h>
+# include <sys/stat.h>
+# include <sys/syscall.h>
+# include <sys/procfs.h>
+# include <sys/lwp.h>
+# include <sys/reg.h>
+# define _CLASSIC_XOPEN_TYPES
+# include <unistd.h>
+# include <errno.h>
+# include "private/solaris_threads.h"
+# include <stdio.h>
+
+#undef pthread_join
+#undef pthread_create
+
+pthread_cond_t GC_prom_join_cv; /* Broadcast when any thread terminates */
+pthread_cond_t GC_create_cv; /* Signalled when a new undetached */
+ /* thread starts. */
+
+extern GC_bool GC_multithreaded;
+
+/* We use the allocation lock to protect thread-related data structures. */
+
+/* We stop the world using /proc primitives. This makes some */
+/* minimal assumptions about the threads implementation. */
+/* We don't play by the rules, since the rules make this */
+/* impossible (as of Solaris 2.3). Also note that as of */
+/* Solaris 2.3 the various thread and lwp suspension */
+/* primitives failed to stop threads by the time the request */
+/* is completed. */
+
+
+
+int GC_pthread_join(pthread_t wait_for, void **status)
+{
+ return GC_thr_join((thread_t)wait_for, NULL, status);
+}
+
+
+int
+GC_pthread_create(pthread_t *new_thread,
+ const pthread_attr_t *attr_in,
+ void * (*thread_execp)(void *), void *arg)
+{
+ int result;
+ GC_thread t;
+ pthread_t my_new_thread;
+ pthread_attr_t attr;
+ word my_flags = 0;
+ int flag;
+ void * stack = 0;
+ size_t stack_size = 0;
+ int n;
+ struct sched_param schedparam;
+
+ (void)pthread_attr_init(&attr);
+ if (attr_in != 0) {
+ (void)pthread_attr_getstacksize(attr_in, &stack_size);
+ (void)pthread_attr_getstackaddr(attr_in, &stack);
+ }
+
+ LOCK();
+ if (!GC_is_initialized) {
+ GC_init_inner();
+ }
+ GC_multithreaded++;
+
+ if (stack == 0) {
+ if (stack_size == 0)
+ stack_size = 1048576;
+ /* ^-- 1 MB (this was GC_min_stack_sz, but that
+ * violates the pthread_create documentation which
+ * says the default value if none is supplied is
+ * 1MB) */
+ else
+ stack_size += thr_min_stack();
+
+ stack = (void *)GC_stack_alloc(&stack_size);
+ if (stack == 0) {
+ GC_multithreaded--;
+ UNLOCK();
+ errno = ENOMEM;
+ return -1;
+ }
+ } else {
+ my_flags |= CLIENT_OWNS_STACK;
+ }
+ (void)pthread_attr_setstacksize(&attr, stack_size);
+ (void)pthread_attr_setstackaddr(&attr, stack);
+ if (attr_in != 0) {
+ (void)pthread_attr_getscope(attr_in, &n);
+ (void)pthread_attr_setscope(&attr, n);
+ (void)pthread_attr_getschedparam(attr_in, &schedparam);
+ (void)pthread_attr_setschedparam(&attr, &schedparam);
+ (void)pthread_attr_getschedpolicy(attr_in, &n);
+ (void)pthread_attr_setschedpolicy(&attr, n);
+ (void)pthread_attr_getinheritsched(attr_in, &n);
+ (void)pthread_attr_setinheritsched(&attr, n);
+
+ (void)pthread_attr_getdetachstate(attr_in, &flag);
+ if (flag == PTHREAD_CREATE_DETACHED) {
+ my_flags |= DETACHED;
+ }
+ (void)pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
+ }
+ /*
+ * thr_create can call malloc(), which if redirected will
+ * attempt to acquire the allocation lock.
+ * Unlock here to prevent deadlock.
+ */
+
+
+#if 0
+#ifdef I386
+ UNLOCK();
+#endif
+#endif
+ result =
+ pthread_create(&my_new_thread, &attr, thread_execp, arg);
+#if 0
+#ifdef I386
+ LOCK();
+#endif
+#endif
+ if (result == 0) {
+ t = GC_new_thread(my_new_thread);
+ t -> flags = my_flags;
+ if (!(my_flags & DETACHED)) cond_init(&(t->join_cv), USYNC_THREAD, 0);
+ t -> stack = stack;
+ t -> stack_size = stack_size;
+ if (new_thread != 0) *new_thread = my_new_thread;
+ pthread_cond_signal(&GC_create_cv);
+ } else {
+ if (!(my_flags & CLIENT_OWNS_STACK)) {
+ GC_stack_free(stack, stack_size);
+ }
+ GC_multithreaded--;
+ }
+ UNLOCK();
+ pthread_attr_destroy(&attr);
+ return(result);
+}
+
+# else
+
+#ifndef LINT
+ int GC_no_sunOS_pthreads;
+#endif
+
+# endif /* GC_SOLARIS_PTHREADS */
+
--- /dev/null
+/*
+ * Copyright (c) 1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/*
+ * Support code for Solaris threads. Provides functionality we wish Sun
+ * had provided. Relies on some information we probably shouldn't rely on.
+ */
+/* Boehm, September 14, 1994 4:44 pm PDT */
+
+# if defined(GC_SOLARIS_THREADS) || defined(GC_SOLARIS_PTHREADS)
+
+# include "private/gc_priv.h"
+# include "private/solaris_threads.h"
+# include <thread.h>
+# include <synch.h>
+# include <signal.h>
+# include <fcntl.h>
+# include <sys/types.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+# include <sys/resource.h>
+# include <sys/stat.h>
+# include <sys/syscall.h>
+# include <sys/procfs.h>
+# include <sys/lwp.h>
+# include <sys/reg.h>
+# define _CLASSIC_XOPEN_TYPES
+# include <unistd.h>
+# include <errno.h>
+
+#ifdef HANDLE_FORK
+ --> Not yet supported. Try porting the code from linux_threads.c.
+#endif
+
+/*
+ * This is the default size of the LWP arrays. If there are more LWPs
+ * than this when a stop-the-world GC happens, set_max_lwps will be
+ * called to cope.
+ * This must be higher than the number of LWPs at startup time.
+ * The threads library creates a thread early on, so the min. is 3
+ */
+# define DEFAULT_MAX_LWPS 4
+
+#undef thr_join
+#undef thr_create
+#undef thr_suspend
+#undef thr_continue
+
+cond_t GC_prom_join_cv; /* Broadcast when any thread terminates */
+cond_t GC_create_cv; /* Signalled when a new undetached */
+ /* thread starts. */
+
+
+#ifdef MMAP_STACKS
+static int GC_zfd;
+#endif /* MMAP_STACKS */
+
+/* We use the allocation lock to protect thread-related data structures. */
+
+/* We stop the world using /proc primitives. This makes some */
+/* minimal assumptions about the threads implementation. */
+/* We don't play by the rules, since the rules make this */
+/* impossible (as of Solaris 2.3). Also note that as of */
+/* Solaris 2.3 the various thread and lwp suspension */
+/* primitives failed to stop threads by the time the request */
+/* is completed. */
+
+
+static sigset_t old_mask;
+
+/* Sleep for n milliseconds, n < 1000 */
+void GC_msec_sleep(int n)
+{
+ struct timespec ts;
+
+ ts.tv_sec = 0;
+ ts.tv_nsec = 1000000*n;
+ if (syscall(SYS_nanosleep, &ts, 0) < 0) {
+ ABORT("nanosleep failed");
+ }
+}
+/* Turn off preemption; gross but effective. */
+/* Caller has allocation lock. */
+/* Actually this is not needed under Solaris 2.3 and */
+/* 2.4, but hopefully that'll change. */
+void preempt_off()
+{
+ sigset_t set;
+
+ (void)sigfillset(&set);
+ sigdelset(&set, SIGABRT);
+ syscall(SYS_sigprocmask, SIG_SETMASK, &set, &old_mask);
+}
+
+void preempt_on()
+{
+ syscall(SYS_sigprocmask, SIG_SETMASK, &old_mask, NULL);
+}
+
+int GC_main_proc_fd = -1;
+
+
+struct lwp_cache_entry {
+ lwpid_t lc_id;
+ int lc_descr; /* /proc file descriptor. */
+} GC_lwp_cache_default[DEFAULT_MAX_LWPS];
+
+static int max_lwps = DEFAULT_MAX_LWPS;
+static struct lwp_cache_entry *GC_lwp_cache = GC_lwp_cache_default;
+
+static prgregset_t GC_lwp_registers_default[DEFAULT_MAX_LWPS];
+static prgregset_t *GC_lwp_registers = GC_lwp_registers_default;
+
+/* Return a file descriptor for the /proc entry corresponding */
+/* to the given lwp. The file descriptor may be stale if the */
+/* lwp exited and a new one was forked. */
+static int open_lwp(lwpid_t id)
+{
+ int result;
+ static int next_victim = 0;
+ register int i;
+
+ for (i = 0; i < max_lwps; i++) {
+ if (GC_lwp_cache[i].lc_id == id) return(GC_lwp_cache[i].lc_descr);
+ }
+ result = syscall(SYS_ioctl, GC_main_proc_fd, PIOCOPENLWP, &id);
+ /*
+ * If PIOCOPENLWP fails, try closing fds in the cache until it succeeds.
+ */
+ if (result < 0 && errno == EMFILE) {
+ for (i = 0; i < max_lwps; i++) {
+ if (GC_lwp_cache[i].lc_id != 0) {
+ (void)syscall(SYS_close, GC_lwp_cache[i].lc_descr);
+ result = syscall(SYS_ioctl, GC_main_proc_fd, PIOCOPENLWP, &id);
+ if (result >= 0 || (result < 0 && errno != EMFILE))
+ break;
+ }
+ }
+ }
+ if (result < 0) {
+ if (errno == EMFILE) {
+ ABORT("Too many open files");
+ }
+ return(-1) /* exited? */;
+ }
+ if (GC_lwp_cache[next_victim].lc_id != 0)
+ (void)syscall(SYS_close, GC_lwp_cache[next_victim].lc_descr);
+ GC_lwp_cache[next_victim].lc_id = id;
+ GC_lwp_cache[next_victim].lc_descr = result;
+ if (++next_victim >= max_lwps)
+ next_victim = 0;
+ return(result);
+}
+
+static void uncache_lwp(lwpid_t id)
+{
+ register int i;
+
+ for (i = 0; i < max_lwps; i++) {
+ if (GC_lwp_cache[i].lc_id == id) {
+ (void)syscall(SYS_close, GC_lwp_cache[id].lc_descr);
+ GC_lwp_cache[i].lc_id = 0;
+ break;
+ }
+ }
+}
+ /* Sequence of current lwp ids */
+static lwpid_t GC_current_ids_default[DEFAULT_MAX_LWPS + 1];
+static lwpid_t *GC_current_ids = GC_current_ids_default;
+
+ /* Temporary used below (can be big if large number of LWPs) */
+static lwpid_t last_ids_default[DEFAULT_MAX_LWPS + 1];
+static lwpid_t *last_ids = last_ids_default;
+
+
+#define ROUNDUP(n) WORDS_TO_BYTES(ROUNDED_UP_WORDS(n))
+
+static void set_max_lwps(GC_word n)
+{
+ char *mem;
+ char *oldmem;
+ int required_bytes = ROUNDUP(n * sizeof(struct lwp_cache_entry))
+ + ROUNDUP(n * sizeof(prgregset_t))
+ + ROUNDUP((n + 1) * sizeof(lwpid_t))
+ + ROUNDUP((n + 1) * sizeof(lwpid_t));
+
+ GC_expand_hp_inner(divHBLKSZ((word)required_bytes));
+ oldmem = mem = GC_scratch_alloc(required_bytes);
+ if (0 == mem) ABORT("No space for lwp data structures");
+
+ /*
+ * We can either flush the old lwp cache or copy it over. Do the latter.
+ */
+ memcpy(mem, GC_lwp_cache, max_lwps * sizeof(struct lwp_cache_entry));
+ GC_lwp_cache = (struct lwp_cache_entry*)mem;
+ mem += ROUNDUP(n * sizeof(struct lwp_cache_entry));
+
+ BZERO(GC_lwp_registers, max_lwps * sizeof(GC_lwp_registers[0]));
+ GC_lwp_registers = (prgregset_t *)mem;
+ mem += ROUNDUP(n * sizeof(prgregset_t));
+
+
+ GC_current_ids = (lwpid_t *)mem;
+ mem += ROUNDUP((n + 1) * sizeof(lwpid_t));
+
+ last_ids = (lwpid_t *)mem;
+ mem += ROUNDUP((n + 1)* sizeof(lwpid_t));
+
+ if (mem > oldmem + required_bytes)
+ ABORT("set_max_lwps buffer overflow");
+
+ max_lwps = n;
+}
+
+
+/* Stop all lwps in process. Assumes preemption is off. */
+/* Caller has allocation lock (and any other locks he may */
+/* need). */
+static void stop_all_lwps()
+{
+ int lwp_fd;
+ char buf[30];
+ prstatus_t status;
+ register int i;
+ GC_bool changed;
+ lwpid_t me = _lwp_self();
+
+ if (GC_main_proc_fd == -1) {
+ sprintf(buf, "/proc/%d", getpid());
+ GC_main_proc_fd = syscall(SYS_open, buf, O_RDONLY);
+ if (GC_main_proc_fd < 0) {
+ if (errno == EMFILE)
+ ABORT("/proc open failed: too many open files");
+ GC_printf1("/proc open failed: errno %d", errno);
+ abort();
+ }
+ }
+ BZERO(GC_lwp_registers, sizeof (prgregset_t) * max_lwps);
+ for (i = 0; i < max_lwps; i++)
+ last_ids[i] = 0;
+ for (;;) {
+ if (syscall(SYS_ioctl, GC_main_proc_fd, PIOCSTATUS, &status) < 0)
+ ABORT("Main PIOCSTATUS failed");
+ if (status.pr_nlwp < 1)
+ ABORT("Invalid number of lwps returned by PIOCSTATUS");
+ if (status.pr_nlwp >= max_lwps) {
+ set_max_lwps(status.pr_nlwp*2 + 10);
+ /*
+ * The data in the old GC_current_ids and
+ * GC_lwp_registers has been trashed. Cleaning out last_ids
+ * will make sure every LWP gets re-examined.
+ */
+ for (i = 0; i < max_lwps; i++)
+ last_ids[i] = 0;
+ continue;
+ }
+ if (syscall(SYS_ioctl, GC_main_proc_fd, PIOCLWPIDS, GC_current_ids) < 0)
+ ABORT("PIOCLWPIDS failed");
+ changed = FALSE;
+ for (i = 0; GC_current_ids[i] != 0 && i < max_lwps; i++) {
+ if (GC_current_ids[i] != last_ids[i]) {
+ changed = TRUE;
+ if (GC_current_ids[i] != me) {
+ /* PIOCSTOP doesn't work without a writable */
+ /* descriptor. And that makes the process */
+ /* undebuggable. */
+ if (_lwp_suspend(GC_current_ids[i]) < 0) {
+ /* Could happen if the lwp exited */
+ uncache_lwp(GC_current_ids[i]);
+ GC_current_ids[i] = me; /* ignore */
+ }
+ }
+ }
+ }
+ /*
+ * In the unlikely event something does a fork between the
+ * PIOCSTATUS and the PIOCLWPIDS.
+ */
+ if (i >= max_lwps)
+ continue;
+ /* All lwps in GC_current_ids != me have been suspended. Note */
+ /* that _lwp_suspend is idempotent. */
+ for (i = 0; GC_current_ids[i] != 0; i++) {
+ if (GC_current_ids[i] != last_ids[i]) {
+ if (GC_current_ids[i] != me) {
+ lwp_fd = open_lwp(GC_current_ids[i]);
+ if (lwp_fd == -1)
+ {
+ GC_current_ids[i] = me;
+ continue;
+ }
+ /* LWP should be stopped. Empirically it sometimes */
+ /* isn't, and more frequently the PR_STOPPED flag */
+ /* is not set. Wait for PR_STOPPED. */
+ if (syscall(SYS_ioctl, lwp_fd,
+ PIOCSTATUS, &status) < 0) {
+ /* Possible if the descriptor was stale, or */
+ /* we encountered the 2.3 _lwp_suspend bug. */
+ uncache_lwp(GC_current_ids[i]);
+ GC_current_ids[i] = me; /* handle next time. */
+ } else {
+ while (!(status.pr_flags & PR_STOPPED)) {
+ GC_msec_sleep(1);
+ if (syscall(SYS_ioctl, lwp_fd,
+ PIOCSTATUS, &status) < 0) {
+ ABORT("Repeated PIOCSTATUS failed");
+ }
+ if (status.pr_flags & PR_STOPPED) break;
+
+ GC_msec_sleep(20);
+ if (syscall(SYS_ioctl, lwp_fd,
+ PIOCSTATUS, &status) < 0) {
+ ABORT("Repeated PIOCSTATUS failed");
+ }
+ }
+ if (status.pr_who != GC_current_ids[i]) {
+ /* can happen if thread was on death row */
+ uncache_lwp(GC_current_ids[i]);
+ GC_current_ids[i] = me; /* handle next time. */
+ continue;
+ }
+ /* Save registers where collector can */
+ /* find them. */
+ BCOPY(status.pr_reg, GC_lwp_registers[i],
+ sizeof (prgregset_t));
+ }
+ }
+ }
+ }
+ if (!changed) break;
+ for (i = 0; i < max_lwps; i++) last_ids[i] = GC_current_ids[i];
+ }
+}
+
+/* Restart all lwps in process. Assumes preemption is off. */
+static void restart_all_lwps()
+{
+ int lwp_fd;
+ register int i;
+ GC_bool changed;
+ lwpid_t me = _lwp_self();
+# define PARANOID
+
+ for (i = 0; GC_current_ids[i] != 0; i++) {
+# ifdef PARANOID
+ if (GC_current_ids[i] != me) {
+ int lwp_fd = open_lwp(GC_current_ids[i]);
+ prstatus_t status;
+
+ if (lwp_fd < 0) ABORT("open_lwp failed");
+ if (syscall(SYS_ioctl, lwp_fd,
+ PIOCSTATUS, &status) < 0) {
+ ABORT("PIOCSTATUS failed in restart_all_lwps");
+ }
+ if (memcmp(status.pr_reg, GC_lwp_registers[i],
+ sizeof (prgregset_t)) != 0) {
+ int j;
+
+ for(j = 0; j < NPRGREG; j++)
+ {
+ GC_printf3("%i: %x -> %x\n", j,
+ GC_lwp_registers[i][j],
+ status.pr_reg[j]);
+ }
+ ABORT("Register contents changed");
+ }
+ if (!status.pr_flags & PR_STOPPED) {
+ ABORT("lwp no longer stopped");
+ }
+#ifdef SPARC
+ {
+ gwindows_t windows;
+ if (syscall(SYS_ioctl, lwp_fd,
+ PIOCGWIN, &windows) < 0) {
+ ABORT("PIOCSTATUS failed in restart_all_lwps");
+ }
+ if (windows.wbcnt > 0) ABORT("unsaved register windows");
+ }
+#endif
+ }
+# endif /* PARANOID */
+ if (GC_current_ids[i] == me) continue;
+ if (_lwp_continue(GC_current_ids[i]) < 0) {
+ ABORT("Failed to restart lwp");
+ }
+ }
+ if (i >= max_lwps) ABORT("Too many lwps");
+}
+
+GC_bool GC_multithreaded = 0;
+
+void GC_stop_world()
+{
+ preempt_off();
+ if (GC_multithreaded)
+ stop_all_lwps();
+}
+
+void GC_start_world()
+{
+ if (GC_multithreaded)
+ restart_all_lwps();
+ preempt_on();
+}
+
+void GC_thr_init(void);
+
+GC_bool GC_thr_initialized = FALSE;
+
+size_t GC_min_stack_sz;
+
+
+/*
+ * stack_head is stored at the top of free stacks
+ */
+struct stack_head {
+ struct stack_head *next;
+ ptr_t base;
+ thread_t owner;
+};
+
+# define N_FREE_LISTS 25
+struct stack_head *GC_stack_free_lists[N_FREE_LISTS] = { 0 };
+ /* GC_stack_free_lists[i] is free list for stacks of */
+ /* size GC_min_stack_sz*2**i. */
+ /* Free lists are linked through stack_head stored */ /* at top of stack. */
+
+/* Return a stack of size at least *stack_size. *stack_size is */
+/* replaced by the actual stack size. */
+/* Caller holds allocation lock. */
+ptr_t GC_stack_alloc(size_t * stack_size)
+{
+ register size_t requested_sz = *stack_size;
+ register size_t search_sz = GC_min_stack_sz;
+ register int index = 0; /* = log2(search_sz/GC_min_stack_sz) */
+ register ptr_t base;
+ register struct stack_head *result;
+
+ while (search_sz < requested_sz) {
+ search_sz *= 2;
+ index++;
+ }
+ if ((result = GC_stack_free_lists[index]) == 0
+ && (result = GC_stack_free_lists[index+1]) != 0) {
+ /* Try next size up. */
+ search_sz *= 2; index++;
+ }
+ if (result != 0) {
+ base = GC_stack_free_lists[index]->base;
+ GC_stack_free_lists[index] = GC_stack_free_lists[index]->next;
+ } else {
+#ifdef MMAP_STACKS
+ base = (ptr_t)mmap(0, search_sz + GC_page_size,
+ PROT_READ|PROT_WRITE, MAP_PRIVATE |MAP_NORESERVE,
+ GC_zfd, 0);
+ if (base == (ptr_t)-1)
+ {
+ *stack_size = 0;
+ return NULL;
+ }
+
+ mprotect(base, GC_page_size, PROT_NONE);
+ /* Should this use divHBLKSZ(search_sz + GC_page_size) ? -- cf */
+ GC_is_fresh((struct hblk *)base, divHBLKSZ(search_sz));
+ base += GC_page_size;
+
+#else
+ base = (ptr_t) GC_scratch_alloc(search_sz + 2*GC_page_size);
+ if (base == NULL)
+ {
+ *stack_size = 0;
+ return NULL;
+ }
+
+ base = (ptr_t)(((word)base + GC_page_size) & ~(GC_page_size - 1));
+ /* Protect hottest page to detect overflow. */
+# ifdef SOLARIS23_MPROTECT_BUG_FIXED
+ mprotect(base, GC_page_size, PROT_NONE);
+# endif
+ GC_is_fresh((struct hblk *)base, divHBLKSZ(search_sz));
+
+ base += GC_page_size;
+#endif
+ }
+ *stack_size = search_sz;
+ return(base);
+}
+
+/* Caller holds allocationlock. */
+void GC_stack_free(ptr_t stack, size_t size)
+{
+ register int index = 0;
+ register size_t search_sz = GC_min_stack_sz;
+ register struct stack_head *head;
+
+#ifdef MMAP_STACKS
+ /* Zero pointers */
+ mmap(stack, size, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_NORESERVE|MAP_FIXED,
+ GC_zfd, 0);
+#endif
+ while (search_sz < size) {
+ search_sz *= 2;
+ index++;
+ }
+ if (search_sz != size) ABORT("Bad stack size");
+
+ head = (struct stack_head *)(stack + search_sz - sizeof(struct stack_head));
+ head->next = GC_stack_free_lists[index];
+ head->base = stack;
+ GC_stack_free_lists[index] = head;
+}
+
+void GC_my_stack_limits();
+
+/* Notify virtual dirty bit implementation that known empty parts of */
+/* stacks do not contain useful data. */
+/* Caller holds allocation lock. */
+void GC_old_stacks_are_fresh()
+{
+/* No point in doing this for MMAP stacks - and pointers are zero'd out */
+/* by the mmap in GC_stack_free */
+#ifndef MMAP_STACKS
+ register int i;
+ register struct stack_head *s;
+ register ptr_t p;
+ register size_t sz;
+ register struct hblk * h;
+ int dummy;
+
+ for (i = 0, sz= GC_min_stack_sz; i < N_FREE_LISTS;
+ i++, sz *= 2) {
+ for (s = GC_stack_free_lists[i]; s != 0; s = s->next) {
+ p = s->base;
+ h = (struct hblk *)(((word)p + HBLKSIZE-1) & ~(HBLKSIZE-1));
+ if ((ptr_t)h == p) {
+ GC_is_fresh((struct hblk *)p, divHBLKSZ(sz));
+ } else {
+ GC_is_fresh((struct hblk *)p, divHBLKSZ(sz) - 1);
+ BZERO(p, (ptr_t)h - p);
+ }
+ }
+ }
+#endif /* MMAP_STACKS */
+ GC_my_stack_limits();
+}
+
+/* The set of all known threads. We intercept thread creation and */
+/* joins. We never actually create detached threads. We allocate all */
+/* new thread stacks ourselves. These allow us to maintain this */
+/* data structure. */
+
+# define THREAD_TABLE_SZ 128 /* Must be power of 2 */
+volatile GC_thread GC_threads[THREAD_TABLE_SZ];
+
+void GC_push_thread_structures GC_PROTO((void))
+{
+ GC_push_all((ptr_t)(GC_threads), (ptr_t)(GC_threads)+sizeof(GC_threads));
+}
+
+/* Add a thread to GC_threads. We assume it wasn't already there. */
+/* Caller holds allocation lock. */
+GC_thread GC_new_thread(thread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ GC_thread result;
+ static struct GC_Thread_Rep first_thread;
+ static GC_bool first_thread_used = FALSE;
+
+ if (!first_thread_used) {
+ result = &first_thread;
+ first_thread_used = TRUE;
+ /* Dont acquire allocation lock, since we may already hold it. */
+ } else {
+ result = (struct GC_Thread_Rep *)
+ GC_INTERNAL_MALLOC(sizeof(struct GC_Thread_Rep), NORMAL);
+ }
+ if (result == 0) return(0);
+ result -> id = id;
+ result -> next = GC_threads[hv];
+ GC_threads[hv] = result;
+ /* result -> finished = 0; */
+ (void) cond_init(&(result->join_cv), USYNC_THREAD, 0);
+ return(result);
+}
+
+/* Delete a thread from GC_threads. We assume it is there. */
+/* (The code intentionally traps if it wasn't.) */
+/* Caller holds allocation lock. */
+void GC_delete_thread(thread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ register GC_thread p = GC_threads[hv];
+ register GC_thread prev = 0;
+
+ while (p -> id != id) {
+ prev = p;
+ p = p -> next;
+ }
+ if (prev == 0) {
+ GC_threads[hv] = p -> next;
+ } else {
+ prev -> next = p -> next;
+ }
+}
+
+/* Return the GC_thread correpsonding to a given thread_t. */
+/* Returns 0 if it's not there. */
+/* Caller holds allocation lock. */
+GC_thread GC_lookup_thread(thread_t id)
+{
+ int hv = ((word)id) % THREAD_TABLE_SZ;
+ register GC_thread p = GC_threads[hv];
+
+ while (p != 0 && p -> id != id) p = p -> next;
+ return(p);
+}
+
+/* Solaris 2/Intel uses an initial stack size limit slightly bigger than the
+ SPARC default of 8 MB. Account for this to warn only if the user has
+ raised the limit beyond the default.
+
+ This is identical to DFLSSIZ defined in <sys/vm_machparam.h>. This file
+ is installed in /usr/platform/`uname -m`/include, which is not in the
+ default include directory list, so copy the definition here. */
+#ifdef I386
+# define MAX_ORIG_STACK_SIZE (8 * 1024 * 1024 + ((USRSTACK) & 0x3FFFFF))
+#else
+# define MAX_ORIG_STACK_SIZE (8 * 1024 * 1024)
+#endif
+
+word GC_get_orig_stack_size() {
+ struct rlimit rl;
+ static int warned = 0;
+ int result;
+
+ if (getrlimit(RLIMIT_STACK, &rl) != 0) ABORT("getrlimit failed");
+ result = (word)rl.rlim_cur & ~(HBLKSIZE-1);
+ if (result > MAX_ORIG_STACK_SIZE) {
+ if (!warned) {
+ WARN("Large stack limit(%ld): only scanning 8 MB\n", result);
+ warned = 1;
+ }
+ result = MAX_ORIG_STACK_SIZE;
+ }
+ return result;
+}
+
+/* Notify dirty bit implementation of unused parts of my stack. */
+/* Caller holds allocation lock. */
+void GC_my_stack_limits()
+{
+ int dummy;
+ register ptr_t hottest = (ptr_t)((word)(&dummy) & ~(HBLKSIZE-1));
+ register GC_thread me = GC_lookup_thread(thr_self());
+ register size_t stack_size = me -> stack_size;
+ register ptr_t stack;
+
+ if (stack_size == 0) {
+ /* original thread */
+ /* Empirically, what should be the stack page with lowest */
+ /* address is actually inaccessible. */
+ stack_size = GC_get_orig_stack_size() - GC_page_size;
+ stack = GC_stackbottom - stack_size + GC_page_size;
+ } else {
+ stack = me -> stack;
+ }
+ if (stack > hottest || stack + stack_size < hottest) {
+ ABORT("sp out of bounds");
+ }
+ GC_is_fresh((struct hblk *)stack, divHBLKSZ(hottest - stack));
+}
+
+
+/* We hold allocation lock. Should do exactly the right thing if the */
+/* world is stopped. Should not fail if it isn't. */
+void GC_push_all_stacks()
+{
+ register int i;
+ register GC_thread p;
+ register ptr_t sp = GC_approx_sp();
+ register ptr_t bottom, top;
+ struct rlimit rl;
+
+# define PUSH(bottom,top) \
+ if (GC_dirty_maintained) { \
+ GC_push_selected((bottom), (top), GC_page_was_ever_dirty, \
+ GC_push_all_stack); \
+ } else { \
+ GC_push_all_stack((bottom), (top)); \
+ }
+ GC_push_all_stack((ptr_t)GC_lwp_registers,
+ (ptr_t)GC_lwp_registers
+ + max_lwps * sizeof(GC_lwp_registers[0]));
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (p -> stack_size != 0) {
+ bottom = p -> stack;
+ top = p -> stack + p -> stack_size;
+ } else {
+ /* The original stack. */
+ bottom = GC_stackbottom - GC_get_orig_stack_size() + GC_page_size;
+ top = GC_stackbottom;
+ }
+ if ((word)sp > (word)bottom && (word)sp < (word)top) bottom = sp;
+ PUSH(bottom, top);
+ }
+ }
+}
+
+
+int GC_is_thread_stack(ptr_t addr)
+{
+ register int i;
+ register GC_thread p;
+ register ptr_t bottom, top;
+
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (p = GC_threads[i]; p != 0; p = p -> next) {
+ if (p -> stack_size != 0) {
+ if (p -> stack <= addr &&
+ addr < p -> stack + p -> stack_size)
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+/* The only thread that ever really performs a thr_join. */
+void * GC_thr_daemon(void * dummy)
+{
+ void *status;
+ thread_t departed;
+ register GC_thread t;
+ register int i;
+ register int result;
+
+ for(;;) {
+ start:
+ result = thr_join((thread_t)0, &departed, &status);
+ LOCK();
+ if (result != 0) {
+ /* No more threads; wait for create. */
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (t = GC_threads[i]; t != 0; t = t -> next) {
+ if (!(t -> flags & (DETACHED | FINISHED))) {
+ UNLOCK();
+ goto start; /* Thread started just before we */
+ /* acquired the lock. */
+ }
+ }
+ }
+ cond_wait(&GC_create_cv, &GC_allocate_ml);
+ UNLOCK();
+ } else {
+ t = GC_lookup_thread(departed);
+ GC_multithreaded--;
+ if (!(t -> flags & CLIENT_OWNS_STACK)) {
+ GC_stack_free(t -> stack, t -> stack_size);
+ }
+ if (t -> flags & DETACHED) {
+ GC_delete_thread(departed);
+ } else {
+ t -> status = status;
+ t -> flags |= FINISHED;
+ cond_signal(&(t -> join_cv));
+ cond_broadcast(&GC_prom_join_cv);
+ }
+ UNLOCK();
+ }
+ }
+}
+
+/* We hold the allocation lock, or caller ensures that 2 instances */
+/* cannot be invoked concurrently. */
+void GC_thr_init(void)
+{
+ GC_thread t;
+ thread_t tid;
+
+ if (GC_thr_initialized)
+ return;
+ GC_thr_initialized = TRUE;
+ GC_min_stack_sz = ((thr_min_stack() + 32*1024 + HBLKSIZE-1)
+ & ~(HBLKSIZE - 1));
+#ifdef MMAP_STACKS
+ GC_zfd = open("/dev/zero", O_RDONLY);
+ if (GC_zfd == -1)
+ ABORT("Can't open /dev/zero");
+#endif /* MMAP_STACKS */
+ cond_init(&GC_prom_join_cv, USYNC_THREAD, 0);
+ cond_init(&GC_create_cv, USYNC_THREAD, 0);
+ /* Add the initial thread, so we can stop it. */
+ t = GC_new_thread(thr_self());
+ t -> stack_size = 0;
+ t -> flags = DETACHED | CLIENT_OWNS_STACK;
+ if (thr_create(0 /* stack */, 0 /* stack_size */, GC_thr_daemon,
+ 0 /* arg */, THR_DETACHED | THR_DAEMON,
+ &tid /* thread_id */) != 0) {
+ ABORT("Cant fork daemon");
+ }
+ thr_setprio(tid, 126);
+}
+
+/* We acquire the allocation lock to prevent races with */
+/* stopping/starting world. */
+/* This is no more correct than the underlying Solaris 2.X */
+/* implementation. Under 2.3 THIS IS BROKEN. */
+int GC_thr_suspend(thread_t target_thread)
+{
+ GC_thread t;
+ int result;
+
+ LOCK();
+ result = thr_suspend(target_thread);
+ if (result == 0) {
+ t = GC_lookup_thread(target_thread);
+ if (t == 0) ABORT("thread unknown to GC");
+ t -> flags |= SUSPNDED;
+ }
+ UNLOCK();
+ return(result);
+}
+
+int GC_thr_continue(thread_t target_thread)
+{
+ GC_thread t;
+ int result;
+
+ LOCK();
+ result = thr_continue(target_thread);
+ if (result == 0) {
+ t = GC_lookup_thread(target_thread);
+ if (t == 0) ABORT("thread unknown to GC");
+ t -> flags &= ~SUSPNDED;
+ }
+ UNLOCK();
+ return(result);
+}
+
+int GC_thr_join(thread_t wait_for, thread_t *departed, void **status)
+{
+ register GC_thread t;
+ int result = 0;
+
+ LOCK();
+ if (wait_for == 0) {
+ register int i;
+ register GC_bool thread_exists;
+
+ for (;;) {
+ thread_exists = FALSE;
+ for (i = 0; i < THREAD_TABLE_SZ; i++) {
+ for (t = GC_threads[i]; t != 0; t = t -> next) {
+ if (!(t -> flags & DETACHED)) {
+ if (t -> flags & FINISHED) {
+ goto found;
+ }
+ thread_exists = TRUE;
+ }
+ }
+ }
+ if (!thread_exists) {
+ result = ESRCH;
+ goto out;
+ }
+ cond_wait(&GC_prom_join_cv, &GC_allocate_ml);
+ }
+ } else {
+ t = GC_lookup_thread(wait_for);
+ if (t == 0 || t -> flags & DETACHED) {
+ result = ESRCH;
+ goto out;
+ }
+ if (wait_for == thr_self()) {
+ result = EDEADLK;
+ goto out;
+ }
+ while (!(t -> flags & FINISHED)) {
+ cond_wait(&(t -> join_cv), &GC_allocate_ml);
+ }
+
+ }
+ found:
+ if (status) *status = t -> status;
+ if (departed) *departed = t -> id;
+ cond_destroy(&(t -> join_cv));
+ GC_delete_thread(t -> id);
+ out:
+ UNLOCK();
+ return(result);
+}
+
+
+int
+GC_thr_create(void *stack_base, size_t stack_size,
+ void *(*start_routine)(void *), void *arg, long flags,
+ thread_t *new_thread)
+{
+ int result;
+ GC_thread t;
+ thread_t my_new_thread;
+ word my_flags = 0;
+ void * stack = stack_base;
+
+ LOCK();
+ if (!GC_is_initialized) GC_init_inner();
+ GC_multithreaded++;
+ if (stack == 0) {
+ if (stack_size == 0) stack_size = 1024*1024;
+ stack = (void *)GC_stack_alloc(&stack_size);
+ if (stack == 0) {
+ GC_multithreaded--;
+ UNLOCK();
+ return(ENOMEM);
+ }
+ } else {
+ my_flags |= CLIENT_OWNS_STACK;
+ }
+ if (flags & THR_DETACHED) my_flags |= DETACHED;
+ if (flags & THR_SUSPENDED) my_flags |= SUSPNDED;
+ result = thr_create(stack, stack_size, start_routine,
+ arg, flags & ~THR_DETACHED, &my_new_thread);
+ if (result == 0) {
+ t = GC_new_thread(my_new_thread);
+ t -> flags = my_flags;
+ if (!(my_flags & DETACHED)) cond_init(&(t -> join_cv), USYNC_THREAD, 0);
+ t -> stack = stack;
+ t -> stack_size = stack_size;
+ if (new_thread != 0) *new_thread = my_new_thread;
+ cond_signal(&GC_create_cv);
+ } else {
+ GC_multithreaded--;
+ if (!(my_flags & CLIENT_OWNS_STACK)) {
+ GC_stack_free(stack, stack_size);
+ }
+ }
+ UNLOCK();
+ return(result);
+}
+
+# else /* !GC_SOLARIS_THREADS */
+
+#ifndef LINT
+ int GC_no_sunOS_threads;
+#endif
+#endif
--- /dev/null
+! SPARCompiler 3.0 and later apparently no longer handles
+! asm outside functions. So we need a separate .s file
+! This is only set up for SunOS 5, not SunOS 4.
+! Assumes this is called before the stack contents are
+! examined.
+
+ .seg "text"
+ .globl GC_save_regs_in_stack
+ .globl GC_push_regs
+GC_save_regs_in_stack:
+GC_push_regs:
+#if defined(__arch64__) || defined(__sparcv9)
+ save %sp,-128,%sp
+ flushw
+ ret
+ restore %sp,2047+128,%o0
+#else /* 32 bit SPARC */
+ ta 0x3 ! ST_FLUSH_WINDOWS
+ mov %sp,%o0
+ retl
+ nop
+#endif /* 32 bit SPARC */
+.GC_save_regs_in_stack_end:
+ .size GC_save_regs_in_stack,.GC_save_regs_in_stack_end-GC_save_regs_in_stack
+
+
+ .globl GC_clear_stack_inner
+GC_clear_stack_inner:
+#if defined(__arch64__) || defined(__sparcv9)
+ mov %sp,%o2 ! Save sp
+ add %sp,2047-8,%o3 ! p = sp+bias-8
+ add %o1,-2047-192,%sp ! Move sp out of the way,
+ ! so that traps still work.
+ ! Includes some extra words
+ ! so we can be sloppy below.
+loop:
+ stx %g0,[%o3] ! *(long *)p = 0
+ cmp %o3,%o1
+ bgu,pt %xcc, loop ! if (p > limit) goto loop
+ add %o3,-8,%o3 ! p -= 8 (delay slot)
+ retl
+ mov %o2,%sp ! Restore sp., delay slot
+#else /* 32 bit SPARC */
+ mov %sp,%o2 ! Save sp
+ add %sp,-8,%o3 ! p = sp-8
+ clr %g1 ! [g0,g1] = 0
+ add %o1,-0x60,%sp ! Move sp out of the way,
+ ! so that traps still work.
+ ! Includes some extra words
+ ! so we can be sloppy below.
+loop:
+ std %g0,[%o3] ! *(long long *)p = 0
+ cmp %o3,%o1
+ bgu loop ! if (p > limit) goto loop
+ add %o3,-8,%o3 ! p -= 8 (delay slot)
+ retl
+ mov %o2,%sp ! Restore sp., delay slot
+#endif /* 32 bit SPARC */
+.GC_clear_stack_inner_end:
+ .size GC_clear_stack_inner,.GC_clear_stack_inner_end-GC_clear_stack_inner
+
+
+
+
+
+
+
--- /dev/null
+! SPARCompiler 3.0 and later apparently no longer handles
+! asm outside functions. So we need a separate .s file
+! This is only set up for SunOS 4.
+! Assumes this is called before the stack contents are
+! examined.
+
+#include "machine/asm.h"
+
+ .seg "text"
+ .globl _C_LABEL(GC_save_regs_in_stack)
+ .globl _C_LABEL(GC_push_regs)
+_C_LABEL(GC_save_regs_in_stack):
+_C_LABEL(GC_push_regs):
+ ta 0x3 ! ST_FLUSH_WINDOWS
+ mov %sp,%o0
+ retl
+ nop
+
+ .globl _C_LABEL(GC_clear_stack_inner)
+_C_LABEL(GC_clear_stack_inner):
+ mov %sp,%o2 ! Save sp
+ add %sp,-8,%o3 ! p = sp-8
+ clr %g1 ! [g0,g1] = 0
+ add %o1,-0x60,%sp ! Move sp out of the way,
+ ! so that traps still work.
+ ! Includes some extra words
+ ! so we can be sloppy below.
+loop:
+ std %g0,[%o3] ! *(long long *)p = 0
+ cmp %o3,%o1
+ bgu loop ! if (p > limit) goto loop
+ add %o3,-8,%o3 ! p -= 8 (delay slot)
+ retl
+ mov %o2,%sp ! Restore sp., delay slot
--- /dev/null
+! SPARCompiler 3.0 and later apparently no longer handles
+! asm outside functions. So we need a separate .s file
+! This is only set up for SunOS 4.
+! Assumes this is called before the stack contents are
+! examined.
+
+ .seg "text"
+ .globl _GC_save_regs_in_stack
+ .globl _GC_push_regs
+_GC_save_regs_in_stack:
+_GC_push_regs:
+ ta 0x3 ! ST_FLUSH_WINDOWS
+ mov %sp,%o0
+ retl
+ nop
+
+ .globl _GC_clear_stack_inner
+_GC_clear_stack_inner:
+ mov %sp,%o2 ! Save sp
+ add %sp,-8,%o3 ! p = sp-8
+ clr %g1 ! [g0,g1] = 0
+ add %o1,-0x60,%sp ! Move sp out of the way,
+ ! so that traps still work.
+ ! Includes some extra words
+ ! so we can be sloppy below.
+loop:
+ std %g0,[%o3] ! *(long long *)p = 0
+ cmp %o3,%o1
+ bgu loop ! if (p > limit) goto loop
+ add %o3,-8,%o3 ! p -= 8 (delay slot)
+ retl
+ mov %o2,%sp ! Restore sp., delay slot
+
+
+
+
+
+
--- /dev/null
+/*
+ * Copyright (c) 2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+#if defined(GC_LINUX_THREADS)
+
+#include "private/gc_priv.h" /* For GC_compare_and_exchange, GC_memory_barrier */
+#include "private/specific.h"
+
+static tse invalid_tse = {INVALID_QTID, 0, 0, INVALID_THREADID};
+ /* A thread-specific data entry which will never */
+ /* appear valid to a reader. Used to fill in empty */
+ /* cache entries to avoid a check for 0. */
+
+int PREFIXED(key_create) (tsd ** key_ptr, void (* destructor)(void *)) {
+ int i;
+ tsd * result = (tsd *)MALLOC_CLEAR(sizeof (tsd));
+
+ /* A quick alignment check, since we need atomic stores */
+ GC_ASSERT((unsigned long)(&invalid_tse.next) % sizeof(tse *) == 0);
+ if (0 == result) return ENOMEM;
+ pthread_mutex_init(&(result -> lock), NULL);
+ for (i = 0; i < TS_CACHE_SIZE; ++i) {
+ result -> cache[i] = &invalid_tse;
+ }
+# ifdef GC_ASSERTIONS
+ for (i = 0; i < TS_HASH_SIZE; ++i) {
+ GC_ASSERT(result -> hash[i] == 0);
+ }
+# endif
+ *key_ptr = result;
+ return 0;
+}
+
+int PREFIXED(setspecific) (tsd * key, void * value) {
+ pthread_t self = pthread_self();
+ int hash_val = HASH(self);
+ volatile tse * entry = (volatile tse *)MALLOC_CLEAR(sizeof (tse));
+
+ GC_ASSERT(self != INVALID_THREADID);
+ if (0 == entry) return ENOMEM;
+ pthread_mutex_lock(&(key -> lock));
+ /* Could easily check for an existing entry here. */
+ entry -> next = key -> hash[hash_val];
+ entry -> thread = self;
+ entry -> value = value;
+ GC_ASSERT(entry -> qtid == INVALID_QTID);
+ /* There can only be one writer at a time, but this needs to be */
+ /* atomic with respect to concurrent readers. */
+ *(volatile tse **)(key -> hash + hash_val) = entry;
+ pthread_mutex_unlock(&(key -> lock));
+ return 0;
+}
+
+/* Remove thread-specific data for this thread. Should be called on */
+/* thread exit. */
+void PREFIXED(remove_specific) (tsd * key) {
+ pthread_t self = pthread_self();
+ unsigned hash_val = HASH(self);
+ tse *entry;
+ tse **link = key -> hash + hash_val;
+
+ pthread_mutex_lock(&(key -> lock));
+ entry = *link;
+ while (entry != NULL && entry -> thread != self) {
+ link = &(entry -> next);
+ entry = *link;
+ }
+ /* Invalidate qtid field, since qtids may be reused, and a later */
+ /* cache lookup could otherwise find this entry. */
+ entry -> qtid = INVALID_QTID;
+ if (entry != NULL) {
+ *link = entry -> next;
+ /* Atomic! concurrent accesses still work. */
+ /* They must, since readers don't lock. */
+ /* We shouldn't need a volatile access here, */
+ /* since both this and the preceding write */
+ /* should become visible no later than */
+ /* the pthread_mutex_unlock() call. */
+ }
+ /* If we wanted to deallocate the entry, we'd first have to clear */
+ /* any cache entries pointing to it. That probably requires */
+ /* additional synchronization, since we can't prevent a concurrent */
+ /* cache lookup, which should still be examining deallocated memory.*/
+ /* This can only happen if the concurrent access is from another */
+ /* thread, and hence has missed the cache, but still... */
+
+ /* With GC, we're done, since the pointers from the cache will */
+ /* be overwritten, all local pointers to the entries will be */
+ /* dropped, and the entry will then be reclaimed. */
+ pthread_mutex_unlock(&(key -> lock));
+}
+
+/* Note that even the slow path doesn't lock. */
+void * PREFIXED(slow_getspecific) (tsd * key, unsigned long qtid,
+ tse * volatile * cache_ptr) {
+ pthread_t self = pthread_self();
+ unsigned hash_val = HASH(self);
+ tse *entry = key -> hash[hash_val];
+
+ GC_ASSERT(qtid != INVALID_QTID);
+ while (entry != NULL && entry -> thread != self) {
+ entry = entry -> next;
+ }
+ if (entry == NULL) return NULL;
+ /* Set cache_entry. */
+ entry -> qtid = qtid;
+ /* It's safe to do this asynchronously. Either value */
+ /* is safe, though may produce spurious misses. */
+ /* We're replacing one qtid with another one for the */
+ /* same thread. */
+ *cache_ptr = entry;
+ /* Again this is safe since pointer assignments are */
+ /* presumed atomic, and either pointer is valid. */
+ return entry -> value;
+}
+
+#endif /* GC_LINUX_THREADS */
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+/* Boehm, July 31, 1995 5:02 pm PDT */
+
+
+#include "private/gc_priv.h"
+
+# ifdef STUBBORN_ALLOC
+/* Stubborn object (hard to change, nearly immutable) allocation. */
+
+extern ptr_t GC_clear_stack(); /* in misc.c, behaves like identity */
+
+#define GENERAL_MALLOC(lb,k) \
+ (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
+
+/* Data structure representing immutable objects that */
+/* are still being initialized. */
+/* This is a bit baroque in order to avoid acquiring */
+/* the lock twice for a typical allocation. */
+
+GC_PTR * GC_changing_list_start;
+
+void GC_push_stubborn_structures GC_PROTO((void))
+{
+ GC_push_all((ptr_t)(&GC_changing_list_start),
+ (ptr_t)(&GC_changing_list_start) + sizeof(GC_PTR *));
+}
+
+# ifdef THREADS
+ VOLATILE GC_PTR * VOLATILE GC_changing_list_current;
+# else
+ GC_PTR * GC_changing_list_current;
+# endif
+ /* Points at last added element. Also (ab)used for */
+ /* synchronization. Updates and reads are assumed atomic. */
+
+GC_PTR * GC_changing_list_limit;
+ /* Points at the last word of the buffer, which is always 0 */
+ /* All entries in (GC_changing_list_current, */
+ /* GC_changing_list_limit] are 0 */
+
+
+void GC_stubborn_init()
+{
+# define INIT_SIZE 10
+
+ GC_changing_list_start = (GC_PTR *)
+ GC_INTERNAL_MALLOC(
+ (word)(INIT_SIZE * sizeof(GC_PTR)),
+ PTRFREE);
+ BZERO(GC_changing_list_start,
+ INIT_SIZE * sizeof(GC_PTR));
+ if (GC_changing_list_start == 0) {
+ GC_err_printf0("Insufficient space to start up\n");
+ ABORT("GC_stubborn_init: put of space");
+ }
+ GC_changing_list_current = GC_changing_list_start;
+ GC_changing_list_limit = GC_changing_list_start + INIT_SIZE - 1;
+ * GC_changing_list_limit = 0;
+}
+
+/* Compact and possibly grow GC_uninit_list. The old copy is */
+/* left alone. Lock must be held. */
+/* When called GC_changing_list_current == GC_changing_list_limit */
+/* which is one past the current element. */
+/* When we finish GC_changing_list_current again points one past last */
+/* element. */
+/* Invariant while this is running: GC_changing_list_current */
+/* points at a word containing 0. */
+/* Returns FALSE on failure. */
+GC_bool GC_compact_changing_list()
+{
+ register GC_PTR *p, *q;
+ register word count = 0;
+ word old_size = (char **)GC_changing_list_limit
+ - (char **)GC_changing_list_start+1;
+ /* The casts are needed as a workaround for an Amiga bug */
+ register word new_size = old_size;
+ GC_PTR * new_list;
+
+ for (p = GC_changing_list_start; p < GC_changing_list_limit; p++) {
+ if (*p != 0) count++;
+ }
+ if (2 * count > old_size) new_size = 2 * count;
+ new_list = (GC_PTR *)
+ GC_INTERNAL_MALLOC(
+ new_size * sizeof(GC_PTR), PTRFREE);
+ /* PTRFREE is a lie. But we don't want the collector to */
+ /* consider these. We do want the list itself to be */
+ /* collectable. */
+ if (new_list == 0) return(FALSE);
+ BZERO(new_list, new_size * sizeof(GC_PTR));
+ q = new_list;
+ for (p = GC_changing_list_start; p < GC_changing_list_limit; p++) {
+ if (*p != 0) *q++ = *p;
+ }
+ GC_changing_list_start = new_list;
+ GC_changing_list_limit = new_list + new_size - 1;
+ GC_changing_list_current = q;
+ return(TRUE);
+}
+
+/* Add p to changing list. Clear p on failure. */
+# define ADD_CHANGING(p) \
+ { \
+ register struct hblk * h = HBLKPTR(p); \
+ register word index = PHT_HASH(h); \
+ \
+ set_pht_entry_from_index(GC_changed_pages, index); \
+ } \
+ if (*GC_changing_list_current != 0 \
+ && ++GC_changing_list_current == GC_changing_list_limit) { \
+ if (!GC_compact_changing_list()) (p) = 0; \
+ } \
+ *GC_changing_list_current = p;
+
+void GC_change_stubborn(p)
+GC_PTR p;
+{
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ ADD_CHANGING(p);
+ UNLOCK();
+ ENABLE_SIGNALS();
+}
+
+void GC_end_stubborn_change(p)
+GC_PTR p;
+{
+# ifdef THREADS
+ register VOLATILE GC_PTR * my_current = GC_changing_list_current;
+# else
+ register GC_PTR * my_current = GC_changing_list_current;
+# endif
+ register GC_bool tried_quick;
+ DCL_LOCK_STATE;
+
+ if (*my_current == p) {
+ /* Hopefully the normal case. */
+ /* Compaction could not have been running when we started. */
+ *my_current = 0;
+# ifdef THREADS
+ if (my_current == GC_changing_list_current) {
+ /* Compaction can't have run in the interim. */
+ /* We got away with the quick and dirty approach. */
+ return;
+ }
+ tried_quick = TRUE;
+# else
+ return;
+# endif
+ } else {
+ tried_quick = FALSE;
+ }
+ DISABLE_SIGNALS();
+ LOCK();
+ my_current = GC_changing_list_current;
+ for (; my_current >= GC_changing_list_start; my_current--) {
+ if (*my_current == p) {
+ *my_current = 0;
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return;
+ }
+ }
+ if (!tried_quick) {
+ GC_err_printf1("Bad arg to GC_end_stubborn_change: 0x%lx\n",
+ (unsigned long)p);
+ ABORT("Bad arg to GC_end_stubborn_change");
+ }
+ UNLOCK();
+ ENABLE_SIGNALS();
+}
+
+/* Allocate lb bytes of composite (pointerful) data */
+/* No pointer fields may be changed after a call to */
+/* GC_end_stubborn_change(p) where p is the value */
+/* returned by GC_malloc_stubborn. */
+# ifdef __STDC__
+ GC_PTR GC_malloc_stubborn(size_t lb)
+# else
+ GC_PTR GC_malloc_stubborn(lb)
+ size_t lb;
+# endif
+{
+register ptr_t op;
+register ptr_t *opp;
+register word lw;
+ptr_t result;
+DCL_LOCK_STATE;
+
+ if( SMALL_OBJ(lb) ) {
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_sobjfreelist[lw]);
+ FASTLOCK();
+ if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+ FASTUNLOCK();
+ result = GC_generic_malloc((word)lb, STUBBORN);
+ goto record;
+ }
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ GC_words_allocd += lw;
+ result = (GC_PTR) op;
+ ADD_CHANGING(result);
+ FASTUNLOCK();
+ return((GC_PTR)result);
+ } else {
+ result = (GC_PTR)
+ GC_generic_malloc((word)lb, STUBBORN);
+ }
+record:
+ DISABLE_SIGNALS();
+ LOCK();
+ ADD_CHANGING(result);
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return((GC_PTR)GC_clear_stack(result));
+}
+
+
+/* Functions analogous to GC_read_dirty and GC_page_was_dirty. */
+/* Report pages on which stubborn objects were changed. */
+void GC_read_changed()
+{
+ register GC_PTR * p = GC_changing_list_start;
+ register GC_PTR q;
+ register struct hblk * h;
+ register word index;
+
+ if (p == 0) /* initializing */ return;
+ BCOPY(GC_changed_pages, GC_prev_changed_pages,
+ (sizeof GC_changed_pages));
+ BZERO(GC_changed_pages, (sizeof GC_changed_pages));
+ for (; p <= GC_changing_list_current; p++) {
+ if ((q = *p) != 0) {
+ h = HBLKPTR(q);
+ index = PHT_HASH(h);
+ set_pht_entry_from_index(GC_changed_pages, index);
+ }
+ }
+}
+
+GC_bool GC_page_was_changed(h)
+struct hblk * h;
+{
+ register word index = PHT_HASH(h);
+
+ return(get_pht_entry_from_index(GC_prev_changed_pages, index));
+}
+
+/* Remove unreachable entries from changed list. Should only be */
+/* called with mark bits consistent and lock held. */
+void GC_clean_changing_list()
+{
+ register GC_PTR * p = GC_changing_list_start;
+ register GC_PTR q;
+ register ptr_t r;
+ register unsigned long count = 0;
+ register unsigned long dropped_count = 0;
+
+ if (p == 0) /* initializing */ return;
+ for (; p <= GC_changing_list_current; p++) {
+ if ((q = *p) != 0) {
+ count++;
+ r = (ptr_t)GC_base(q);
+ if (r == 0 || !GC_is_marked(r)) {
+ *p = 0;
+ dropped_count++;
+ }
+ }
+ }
+# ifdef PRINTSTATS
+ if (count > 0) {
+ GC_printf2("%lu entries in changing list: reclaimed %lu\n",
+ (unsigned long)count, (unsigned long)dropped_count);
+ }
+# endif
+}
+
+#else /* !STUBBORN_ALLOC */
+
+# ifdef __STDC__
+ GC_PTR GC_malloc_stubborn(size_t lb)
+# else
+ GC_PTR GC_malloc_stubborn(lb)
+ size_t lb;
+# endif
+{
+ return(GC_malloc(lb));
+}
+
+/*ARGSUSED*/
+void GC_end_stubborn_change(p)
+GC_PTR p;
+{
+}
+
+/*ARGSUSED*/
+void GC_change_stubborn(p)
+GC_PTR p;
+{
+}
+
+void GC_push_stubborn_structures GC_PROTO((void))
+{
+}
+
+#endif
--- /dev/null
+# include "private/gcconfig.h"
+# include <stdio.h>
+
+int main()
+{
+# if defined(GC_USE_LD_WRAP)
+ printf("-Wl,--wrap -Wl,read -Wl,--wrap -Wl,dlopen "
+ "-Wl,--wrap -Wl,pthread_create -Wl,--wrap -Wl,pthread_join "
+ "-Wl,--wrap -Wl,pthread_detach "
+ "-Wl,--wrap -Wl,pthread_sigmask -Wl,--wrap -Wl,sleep\n");
+# endif
+# if defined(GC_LINUX_THREADS) || defined(GC_IRIX_THREADS) \
+ || defined(GC_FREEBSD_THREADS) || defined(GC_SOLARIS_PTHREADS) \
+ || defined(GC_MACOSX_THREADS)
+ printf("-lpthread\n");
+# endif
+# if defined(GC_HPUX_THREADS) || defined(GC_OSF1_THREADS)
+ printf("-lpthread -lrt\n");
+# endif
+# if defined(GC_SOLARIS_THREADS) && !defined(GC_SOLARIS_PTHREADS)
+ printf("-lthread -ldl\n");
+# endif
+# if defined(GC_WIN32_THREADS) && defined(CYGWIN32)
+ printf("-lpthread\n");
+# endif
+# if defined(GC_OSF1_THREADS)
+ printf("-lpthread -lrt");
+# endif
+ /* You need GCC 3.0.3 to build this one! */
+ /* DG/UX native gcc doesnt know what "-pthread" is */
+# if defined(GC_DGUX386_THREADS)
+ printf("-ldl -pthread\n");
+# endif
+ return 0;
+}
+
--- /dev/null
+/*
+ * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved.
+ * opyright (c) 1999-2000 by Hewlett-Packard Company. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose, provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ *
+ */
+
+
+/*
+ * Some simple primitives for allocation with explicit type information.
+ * Simple objects are allocated such that they contain a GC_descr at the
+ * end (in the last allocated word). This descriptor may be a procedure
+ * which then examines an extended descriptor passed as its environment.
+ *
+ * Arrays are treated as simple objects if they have sufficiently simple
+ * structure. Otherwise they are allocated from an array kind that supplies
+ * a special mark procedure. These arrays contain a pointer to a
+ * complex_descriptor as their last word.
+ * This is done because the environment field is too small, and the collector
+ * must trace the complex_descriptor.
+ *
+ * Note that descriptors inside objects may appear cleared, if we encounter a
+ * false refrence to an object on a free list. In the GC_descr case, this
+ * is OK, since a 0 descriptor corresponds to examining no fields.
+ * In the complex_descriptor case, we explicitly check for that case.
+ *
+ * MAJOR PARTS OF THIS CODE HAVE NOT BEEN TESTED AT ALL and are not testable,
+ * since they are not accessible through the current interface.
+ */
+
+#include "private/gc_pmark.h"
+#include "gc_typed.h"
+
+# define TYPD_EXTRA_BYTES (sizeof(word) - EXTRA_BYTES)
+
+GC_bool GC_explicit_typing_initialized = FALSE;
+
+int GC_explicit_kind; /* Object kind for objects with indirect */
+ /* (possibly extended) descriptors. */
+
+int GC_array_kind; /* Object kind for objects with complex */
+ /* descriptors and GC_array_mark_proc. */
+
+/* Extended descriptors. GC_typed_mark_proc understands these. */
+/* These are used for simple objects that are larger than what */
+/* can be described by a BITMAP_BITS sized bitmap. */
+typedef struct {
+ word ed_bitmap; /* lsb corresponds to first word. */
+ GC_bool ed_continued; /* next entry is continuation. */
+} ext_descr;
+
+/* Array descriptors. GC_array_mark_proc understands these. */
+/* We may eventually need to add provisions for headers and */
+/* trailers. Hence we provide for tree structured descriptors, */
+/* though we don't really use them currently. */
+typedef union ComplexDescriptor {
+ struct LeafDescriptor { /* Describes simple array */
+ word ld_tag;
+# define LEAF_TAG 1
+ word ld_size; /* bytes per element */
+ /* multiple of ALIGNMENT */
+ word ld_nelements; /* Number of elements. */
+ GC_descr ld_descriptor; /* A simple length, bitmap, */
+ /* or procedure descriptor. */
+ } ld;
+ struct ComplexArrayDescriptor {
+ word ad_tag;
+# define ARRAY_TAG 2
+ word ad_nelements;
+ union ComplexDescriptor * ad_element_descr;
+ } ad;
+ struct SequenceDescriptor {
+ word sd_tag;
+# define SEQUENCE_TAG 3
+ union ComplexDescriptor * sd_first;
+ union ComplexDescriptor * sd_second;
+ } sd;
+} complex_descriptor;
+#define TAG ld.ld_tag
+
+ext_descr * GC_ext_descriptors; /* Points to array of extended */
+ /* descriptors. */
+
+word GC_ed_size = 0; /* Current size of above arrays. */
+# define ED_INITIAL_SIZE 100;
+
+word GC_avail_descr = 0; /* Next available slot. */
+
+int GC_typed_mark_proc_index; /* Indices of my mark */
+int GC_array_mark_proc_index; /* procedures. */
+
+/* Add a multiword bitmap to GC_ext_descriptors arrays. Return */
+/* starting index. */
+/* Returns -1 on failure. */
+/* Caller does not hold allocation lock. */
+signed_word GC_add_ext_descriptor(bm, nbits)
+GC_bitmap bm;
+word nbits;
+{
+ register size_t nwords = divWORDSZ(nbits + WORDSZ-1);
+ register signed_word result;
+ register word i;
+ register word last_part;
+ register int extra_bits;
+ DCL_LOCK_STATE;
+
+ DISABLE_SIGNALS();
+ LOCK();
+ while (GC_avail_descr + nwords >= GC_ed_size) {
+ ext_descr * new;
+ size_t new_size;
+ word ed_size = GC_ed_size;
+
+ UNLOCK();
+ ENABLE_SIGNALS();
+ if (ed_size == 0) {
+ new_size = ED_INITIAL_SIZE;
+ } else {
+ new_size = 2 * ed_size;
+ if (new_size > MAX_ENV) return(-1);
+ }
+ new = (ext_descr *) GC_malloc_atomic(new_size * sizeof(ext_descr));
+ if (new == 0) return(-1);
+ DISABLE_SIGNALS();
+ LOCK();
+ if (ed_size == GC_ed_size) {
+ if (GC_avail_descr != 0) {
+ BCOPY(GC_ext_descriptors, new,
+ GC_avail_descr * sizeof(ext_descr));
+ }
+ GC_ed_size = new_size;
+ GC_ext_descriptors = new;
+ } /* else another thread already resized it in the meantime */
+ }
+ result = GC_avail_descr;
+ for (i = 0; i < nwords-1; i++) {
+ GC_ext_descriptors[result + i].ed_bitmap = bm[i];
+ GC_ext_descriptors[result + i].ed_continued = TRUE;
+ }
+ last_part = bm[i];
+ /* Clear irrelevant bits. */
+ extra_bits = nwords * WORDSZ - nbits;
+ last_part <<= extra_bits;
+ last_part >>= extra_bits;
+ GC_ext_descriptors[result + i].ed_bitmap = last_part;
+ GC_ext_descriptors[result + i].ed_continued = FALSE;
+ GC_avail_descr += nwords;
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return(result);
+}
+
+/* Table of bitmap descriptors for n word long all pointer objects. */
+GC_descr GC_bm_table[WORDSZ/2];
+
+/* Return a descriptor for the concatenation of 2 nwords long objects, */
+/* each of which is described by descriptor. */
+/* The result is known to be short enough to fit into a bitmap */
+/* descriptor. */
+/* Descriptor is a GC_DS_LENGTH or GC_DS_BITMAP descriptor. */
+GC_descr GC_double_descr(descriptor, nwords)
+register GC_descr descriptor;
+register word nwords;
+{
+ if ((descriptor & GC_DS_TAGS) == GC_DS_LENGTH) {
+ descriptor = GC_bm_table[BYTES_TO_WORDS((word)descriptor)];
+ };
+ descriptor |= (descriptor & ~GC_DS_TAGS) >> nwords;
+ return(descriptor);
+}
+
+complex_descriptor * GC_make_sequence_descriptor();
+
+/* Build a descriptor for an array with nelements elements, */
+/* each of which can be described by a simple descriptor. */
+/* We try to optimize some common cases. */
+/* If the result is COMPLEX, then a complex_descr* is returned */
+/* in *complex_d. */
+/* If the result is LEAF, then we built a LeafDescriptor in */
+/* the structure pointed to by leaf. */
+/* The tag in the leaf structure is not set. */
+/* If the result is SIMPLE, then a GC_descr */
+/* is returned in *simple_d. */
+/* If the result is NO_MEM, then */
+/* we failed to allocate the descriptor. */
+/* The implementation knows that GC_DS_LENGTH is 0. */
+/* *leaf, *complex_d, and *simple_d may be used as temporaries */
+/* during the construction. */
+# define COMPLEX 2
+# define LEAF 1
+# define SIMPLE 0
+# define NO_MEM (-1)
+int GC_make_array_descriptor(nelements, size, descriptor,
+ simple_d, complex_d, leaf)
+word size;
+word nelements;
+GC_descr descriptor;
+GC_descr *simple_d;
+complex_descriptor **complex_d;
+struct LeafDescriptor * leaf;
+{
+# define OPT_THRESHOLD 50
+ /* For larger arrays, we try to combine descriptors of adjacent */
+ /* descriptors to speed up marking, and to reduce the amount */
+ /* of space needed on the mark stack. */
+ if ((descriptor & GC_DS_TAGS) == GC_DS_LENGTH) {
+ if ((word)descriptor == size) {
+ *simple_d = nelements * descriptor;
+ return(SIMPLE);
+ } else if ((word)descriptor == 0) {
+ *simple_d = (GC_descr)0;
+ return(SIMPLE);
+ }
+ }
+ if (nelements <= OPT_THRESHOLD) {
+ if (nelements <= 1) {
+ if (nelements == 1) {
+ *simple_d = descriptor;
+ return(SIMPLE);
+ } else {
+ *simple_d = (GC_descr)0;
+ return(SIMPLE);
+ }
+ }
+ } else if (size <= BITMAP_BITS/2
+ && (descriptor & GC_DS_TAGS) != GC_DS_PROC
+ && (size & (sizeof(word)-1)) == 0) {
+ int result =
+ GC_make_array_descriptor(nelements/2, 2*size,
+ GC_double_descr(descriptor,
+ BYTES_TO_WORDS(size)),
+ simple_d, complex_d, leaf);
+ if ((nelements & 1) == 0) {
+ return(result);
+ } else {
+ struct LeafDescriptor * one_element =
+ (struct LeafDescriptor *)
+ GC_malloc_atomic(sizeof(struct LeafDescriptor));
+
+ if (result == NO_MEM || one_element == 0) return(NO_MEM);
+ one_element -> ld_tag = LEAF_TAG;
+ one_element -> ld_size = size;
+ one_element -> ld_nelements = 1;
+ one_element -> ld_descriptor = descriptor;
+ switch(result) {
+ case SIMPLE:
+ {
+ struct LeafDescriptor * beginning =
+ (struct LeafDescriptor *)
+ GC_malloc_atomic(sizeof(struct LeafDescriptor));
+ if (beginning == 0) return(NO_MEM);
+ beginning -> ld_tag = LEAF_TAG;
+ beginning -> ld_size = size;
+ beginning -> ld_nelements = 1;
+ beginning -> ld_descriptor = *simple_d;
+ *complex_d = GC_make_sequence_descriptor(
+ (complex_descriptor *)beginning,
+ (complex_descriptor *)one_element);
+ break;
+ }
+ case LEAF:
+ {
+ struct LeafDescriptor * beginning =
+ (struct LeafDescriptor *)
+ GC_malloc_atomic(sizeof(struct LeafDescriptor));
+ if (beginning == 0) return(NO_MEM);
+ beginning -> ld_tag = LEAF_TAG;
+ beginning -> ld_size = leaf -> ld_size;
+ beginning -> ld_nelements = leaf -> ld_nelements;
+ beginning -> ld_descriptor = leaf -> ld_descriptor;
+ *complex_d = GC_make_sequence_descriptor(
+ (complex_descriptor *)beginning,
+ (complex_descriptor *)one_element);
+ break;
+ }
+ case COMPLEX:
+ *complex_d = GC_make_sequence_descriptor(
+ *complex_d,
+ (complex_descriptor *)one_element);
+ break;
+ }
+ return(COMPLEX);
+ }
+ }
+ {
+ leaf -> ld_size = size;
+ leaf -> ld_nelements = nelements;
+ leaf -> ld_descriptor = descriptor;
+ return(LEAF);
+ }
+}
+
+complex_descriptor * GC_make_sequence_descriptor(first, second)
+complex_descriptor * first;
+complex_descriptor * second;
+{
+ struct SequenceDescriptor * result =
+ (struct SequenceDescriptor *)
+ GC_malloc(sizeof(struct SequenceDescriptor));
+ /* Can't result in overly conservative marking, since tags are */
+ /* very small integers. Probably faster than maintaining type */
+ /* info. */
+ if (result != 0) {
+ result -> sd_tag = SEQUENCE_TAG;
+ result -> sd_first = first;
+ result -> sd_second = second;
+ }
+ return((complex_descriptor *)result);
+}
+
+#ifdef UNDEFINED
+complex_descriptor * GC_make_complex_array_descriptor(nelements, descr)
+word nelements;
+complex_descriptor * descr;
+{
+ struct ComplexArrayDescriptor * result =
+ (struct ComplexArrayDescriptor *)
+ GC_malloc(sizeof(struct ComplexArrayDescriptor));
+
+ if (result != 0) {
+ result -> ad_tag = ARRAY_TAG;
+ result -> ad_nelements = nelements;
+ result -> ad_element_descr = descr;
+ }
+ return((complex_descriptor *)result);
+}
+#endif
+
+ptr_t * GC_eobjfreelist;
+
+ptr_t * GC_arobjfreelist;
+
+mse * GC_typed_mark_proc GC_PROTO((register word * addr,
+ register mse * mark_stack_ptr,
+ mse * mark_stack_limit,
+ word env));
+
+mse * GC_array_mark_proc GC_PROTO((register word * addr,
+ register mse * mark_stack_ptr,
+ mse * mark_stack_limit,
+ word env));
+
+GC_descr GC_generic_array_descr;
+
+/* Caller does not hold allocation lock. */
+void GC_init_explicit_typing()
+{
+ register int i;
+ DCL_LOCK_STATE;
+
+
+# ifdef PRINTSTATS
+ if (sizeof(struct LeafDescriptor) % sizeof(word) != 0)
+ ABORT("Bad leaf descriptor size");
+# endif
+ DISABLE_SIGNALS();
+ LOCK();
+ if (GC_explicit_typing_initialized) {
+ UNLOCK();
+ ENABLE_SIGNALS();
+ return;
+ }
+ GC_explicit_typing_initialized = TRUE;
+ /* Set up object kind with simple indirect descriptor. */
+ GC_eobjfreelist = (ptr_t *)
+ GC_INTERNAL_MALLOC((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+ if (GC_eobjfreelist == 0) ABORT("Couldn't allocate GC_eobjfreelist");
+ BZERO(GC_eobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+ GC_explicit_kind = GC_n_kinds++;
+ GC_obj_kinds[GC_explicit_kind].ok_freelist = GC_eobjfreelist;
+ GC_obj_kinds[GC_explicit_kind].ok_reclaim_list = 0;
+ GC_obj_kinds[GC_explicit_kind].ok_descriptor =
+ (((word)WORDS_TO_BYTES(-1)) | GC_DS_PER_OBJECT);
+ GC_obj_kinds[GC_explicit_kind].ok_relocate_descr = TRUE;
+ GC_obj_kinds[GC_explicit_kind].ok_init = TRUE;
+ /* Descriptors are in the last word of the object. */
+ GC_typed_mark_proc_index = GC_n_mark_procs;
+ GC_mark_procs[GC_typed_mark_proc_index] = GC_typed_mark_proc;
+ GC_n_mark_procs++;
+ /* Moving this up breaks DEC AXP compiler. */
+ /* Set up object kind with array descriptor. */
+ GC_arobjfreelist = (ptr_t *)
+ GC_INTERNAL_MALLOC((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+ if (GC_arobjfreelist == 0) ABORT("Couldn't allocate GC_arobjfreelist");
+ BZERO(GC_arobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+ if (GC_n_mark_procs >= MAX_MARK_PROCS)
+ ABORT("No slot for array mark proc");
+ GC_array_mark_proc_index = GC_n_mark_procs++;
+ if (GC_n_kinds >= MAXOBJKINDS)
+ ABORT("No kind available for array objects");
+ GC_array_kind = GC_n_kinds++;
+ GC_obj_kinds[GC_array_kind].ok_freelist = GC_arobjfreelist;
+ GC_obj_kinds[GC_array_kind].ok_reclaim_list = 0;
+ GC_obj_kinds[GC_array_kind].ok_descriptor =
+ GC_MAKE_PROC(GC_array_mark_proc_index, 0);;
+ GC_obj_kinds[GC_array_kind].ok_relocate_descr = FALSE;
+ GC_obj_kinds[GC_array_kind].ok_init = TRUE;
+ /* Descriptors are in the last word of the object. */
+ GC_mark_procs[GC_array_mark_proc_index] = GC_array_mark_proc;
+ for (i = 0; i < WORDSZ/2; i++) {
+ GC_descr d = (((word)(-1)) >> (WORDSZ - i)) << (WORDSZ - i);
+ d |= GC_DS_BITMAP;
+ GC_bm_table[i] = d;
+ }
+ GC_generic_array_descr = GC_MAKE_PROC(GC_array_mark_proc_index, 0);
+ UNLOCK();
+ ENABLE_SIGNALS();
+}
+
+# if defined(__STDC__) || defined(__cplusplus)
+ mse * GC_typed_mark_proc(register word * addr,
+ register mse * mark_stack_ptr,
+ mse * mark_stack_limit,
+ word env)
+# else
+ mse * GC_typed_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
+ register word * addr;
+ register mse * mark_stack_ptr;
+ mse * mark_stack_limit;
+ word env;
+# endif
+{
+ register word bm = GC_ext_descriptors[env].ed_bitmap;
+ register word * current_p = addr;
+ register word current;
+ register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+ register ptr_t least_ha = GC_least_plausible_heap_addr;
+
+ for (; bm != 0; bm >>= 1, current_p++) {
+ if (bm & 1) {
+ current = *current_p;
+ FIXUP_POINTER(current);
+ if ((ptr_t)current >= least_ha && (ptr_t)current <= greatest_ha) {
+ PUSH_CONTENTS((ptr_t)current, mark_stack_ptr,
+ mark_stack_limit, current_p, exit1);
+ }
+ }
+ }
+ if (GC_ext_descriptors[env].ed_continued) {
+ /* Push an entry with the rest of the descriptor back onto the */
+ /* stack. Thus we never do too much work at once. Note that */
+ /* we also can't overflow the mark stack unless we actually */
+ /* mark something. */
+ mark_stack_ptr++;
+ if (mark_stack_ptr >= mark_stack_limit) {
+ mark_stack_ptr = GC_signal_mark_stack_overflow(mark_stack_ptr);
+ }
+ mark_stack_ptr -> mse_start = addr + WORDSZ;
+ mark_stack_ptr -> mse_descr =
+ GC_MAKE_PROC(GC_typed_mark_proc_index, env+1);
+ }
+ return(mark_stack_ptr);
+}
+
+/* Return the size of the object described by d. It would be faster to */
+/* store this directly, or to compute it as part of */
+/* GC_push_complex_descriptor, but hopefully it doesn't matter. */
+word GC_descr_obj_size(d)
+register complex_descriptor *d;
+{
+ switch(d -> TAG) {
+ case LEAF_TAG:
+ return(d -> ld.ld_nelements * d -> ld.ld_size);
+ case ARRAY_TAG:
+ return(d -> ad.ad_nelements
+ * GC_descr_obj_size(d -> ad.ad_element_descr));
+ case SEQUENCE_TAG:
+ return(GC_descr_obj_size(d -> sd.sd_first)
+ + GC_descr_obj_size(d -> sd.sd_second));
+ default:
+ ABORT("Bad complex descriptor");
+ /*NOTREACHED*/ return 0; /*NOTREACHED*/
+ }
+}
+
+/* Push descriptors for the object at addr with complex descriptor d */
+/* onto the mark stack. Return 0 if the mark stack overflowed. */
+mse * GC_push_complex_descriptor(addr, d, msp, msl)
+word * addr;
+register complex_descriptor *d;
+register mse * msp;
+mse * msl;
+{
+ register ptr_t current = (ptr_t) addr;
+ register word nelements;
+ register word sz;
+ register word i;
+
+ switch(d -> TAG) {
+ case LEAF_TAG:
+ {
+ register GC_descr descr = d -> ld.ld_descriptor;
+
+ nelements = d -> ld.ld_nelements;
+ if (msl - msp <= (ptrdiff_t)nelements) return(0);
+ sz = d -> ld.ld_size;
+ for (i = 0; i < nelements; i++) {
+ msp++;
+ msp -> mse_start = (word *)current;
+ msp -> mse_descr = descr;
+ current += sz;
+ }
+ return(msp);
+ }
+ case ARRAY_TAG:
+ {
+ register complex_descriptor *descr = d -> ad.ad_element_descr;
+
+ nelements = d -> ad.ad_nelements;
+ sz = GC_descr_obj_size(descr);
+ for (i = 0; i < nelements; i++) {
+ msp = GC_push_complex_descriptor((word *)current, descr,
+ msp, msl);
+ if (msp == 0) return(0);
+ current += sz;
+ }
+ return(msp);
+ }
+ case SEQUENCE_TAG:
+ {
+ sz = GC_descr_obj_size(d -> sd.sd_first);
+ msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_first,
+ msp, msl);
+ if (msp == 0) return(0);
+ current += sz;
+ msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_second,
+ msp, msl);
+ return(msp);
+ }
+ default:
+ ABORT("Bad complex descriptor");
+ /*NOTREACHED*/ return 0; /*NOTREACHED*/
+ }
+}
+
+/*ARGSUSED*/
+# if defined(__STDC__) || defined(__cplusplus)
+ mse * GC_array_mark_proc(register word * addr,
+ register mse * mark_stack_ptr,
+ mse * mark_stack_limit,
+ word env)
+# else
+ mse * GC_array_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
+ register word * addr;
+ register mse * mark_stack_ptr;
+ mse * mark_stack_limit;
+ word env;
+# endif
+{
+ register hdr * hhdr = HDR(addr);
+ register word sz = hhdr -> hb_sz;
+ register complex_descriptor * descr = (complex_descriptor *)(addr[sz-1]);
+ mse * orig_mark_stack_ptr = mark_stack_ptr;
+ mse * new_mark_stack_ptr;
+
+ if (descr == 0) {
+ /* Found a reference to a free list entry. Ignore it. */
+ return(orig_mark_stack_ptr);
+ }
+ /* In use counts were already updated when array descriptor was */
+ /* pushed. Here we only replace it by subobject descriptors, so */
+ /* no update is necessary. */
+ new_mark_stack_ptr = GC_push_complex_descriptor(addr, descr,
+ mark_stack_ptr,
+ mark_stack_limit-1);
+ if (new_mark_stack_ptr == 0) {
+ /* Doesn't fit. Conservatively push the whole array as a unit */
+ /* and request a mark stack expansion. */
+ /* This cannot cause a mark stack overflow, since it replaces */
+ /* the original array entry. */
+ GC_mark_stack_too_small = TRUE;
+ new_mark_stack_ptr = orig_mark_stack_ptr + 1;
+ new_mark_stack_ptr -> mse_start = addr;
+ new_mark_stack_ptr -> mse_descr = WORDS_TO_BYTES(sz) | GC_DS_LENGTH;
+ } else {
+ /* Push descriptor itself */
+ new_mark_stack_ptr++;
+ new_mark_stack_ptr -> mse_start = addr + sz - 1;
+ new_mark_stack_ptr -> mse_descr = sizeof(word) | GC_DS_LENGTH;
+ }
+ return(new_mark_stack_ptr);
+}
+
+#if defined(__STDC__) || defined(__cplusplus)
+ GC_descr GC_make_descriptor(GC_bitmap bm, size_t len)
+#else
+ GC_descr GC_make_descriptor(bm, len)
+ GC_bitmap bm;
+ size_t len;
+#endif
+{
+ register signed_word last_set_bit = len - 1;
+ register word result;
+ register int i;
+# define HIGH_BIT (((word)1) << (WORDSZ - 1))
+
+ if (!GC_explicit_typing_initialized) GC_init_explicit_typing();
+ while (last_set_bit >= 0 && !GC_get_bit(bm, last_set_bit)) last_set_bit --;
+ if (last_set_bit < 0) return(0 /* no pointers */);
+# if ALIGNMENT == CPP_WORDSZ/8
+ {
+ register GC_bool all_bits_set = TRUE;
+ for (i = 0; i < last_set_bit; i++) {
+ if (!GC_get_bit(bm, i)) {
+ all_bits_set = FALSE;
+ break;
+ }
+ }
+ if (all_bits_set) {
+ /* An initial section contains all pointers. Use length descriptor. */
+ return(WORDS_TO_BYTES(last_set_bit+1) | GC_DS_LENGTH);
+ }
+ }
+# endif
+ if (last_set_bit < BITMAP_BITS) {
+ /* Hopefully the common case. */
+ /* Build bitmap descriptor (with bits reversed) */
+ result = HIGH_BIT;
+ for (i = last_set_bit - 1; i >= 0; i--) {
+ result >>= 1;
+ if (GC_get_bit(bm, i)) result |= HIGH_BIT;
+ }
+ result |= GC_DS_BITMAP;
+ return(result);
+ } else {
+ signed_word index;
+
+ index = GC_add_ext_descriptor(bm, (word)last_set_bit+1);
+ if (index == -1) return(WORDS_TO_BYTES(last_set_bit+1) | GC_DS_LENGTH);
+ /* Out of memory: use conservative */
+ /* approximation. */
+ result = GC_MAKE_PROC(GC_typed_mark_proc_index, (word)index);
+ return(result);
+ }
+}
+
+ptr_t GC_clear_stack();
+
+#define GENERAL_MALLOC(lb,k) \
+ (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
+
+#define GENERAL_MALLOC_IOP(lb,k) \
+ (GC_PTR)GC_clear_stack(GC_generic_malloc_ignore_off_page(lb, k))
+
+#if defined(__STDC__) || defined(__cplusplus)
+ void * GC_malloc_explicitly_typed(size_t lb, GC_descr d)
+#else
+ char * GC_malloc_explicitly_typed(lb, d)
+ size_t lb;
+ GC_descr d;
+#endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+ lb += TYPD_EXTRA_BYTES;
+ if( SMALL_OBJ(lb) ) {
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_eobjfreelist[lw]);
+ FASTLOCK();
+ if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+ FASTUNLOCK();
+ op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
+ if (0 == op) return 0;
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb]; /* May have been uninitialized. */
+# endif
+ } else {
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ GC_words_allocd += lw;
+ FASTUNLOCK();
+ }
+ } else {
+ op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
+ if (op != NULL)
+ lw = BYTES_TO_WORDS(GC_size(op));
+ }
+ if (op != NULL)
+ ((word *)op)[lw - 1] = d;
+ return((GC_PTR) op);
+}
+
+#if defined(__STDC__) || defined(__cplusplus)
+ void * GC_malloc_explicitly_typed_ignore_off_page(size_t lb, GC_descr d)
+#else
+ char * GC_malloc_explicitly_typed_ignore_off_page(lb, d)
+ size_t lb;
+ GC_descr d;
+#endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+ lb += TYPD_EXTRA_BYTES;
+ if( SMALL_OBJ(lb) ) {
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_eobjfreelist[lw]);
+ FASTLOCK();
+ if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+ FASTUNLOCK();
+ op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb]; /* May have been uninitialized. */
+# endif
+ } else {
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ GC_words_allocd += lw;
+ FASTUNLOCK();
+ }
+ } else {
+ op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
+ if (op != NULL)
+ lw = BYTES_TO_WORDS(GC_size(op));
+ }
+ if (op != NULL)
+ ((word *)op)[lw - 1] = d;
+ return((GC_PTR) op);
+}
+
+#if defined(__STDC__) || defined(__cplusplus)
+ void * GC_calloc_explicitly_typed(size_t n,
+ size_t lb,
+ GC_descr d)
+#else
+ char * GC_calloc_explicitly_typed(n, lb, d)
+ size_t n;
+ size_t lb;
+ GC_descr d;
+#endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+GC_descr simple_descr;
+complex_descriptor *complex_descr;
+register int descr_type;
+struct LeafDescriptor leaf;
+DCL_LOCK_STATE;
+
+ descr_type = GC_make_array_descriptor((word)n, (word)lb, d,
+ &simple_descr, &complex_descr, &leaf);
+ switch(descr_type) {
+ case NO_MEM: return(0);
+ case SIMPLE: return(GC_malloc_explicitly_typed(n*lb, simple_descr));
+ case LEAF:
+ lb *= n;
+ lb += sizeof(struct LeafDescriptor) + TYPD_EXTRA_BYTES;
+ break;
+ case COMPLEX:
+ lb *= n;
+ lb += TYPD_EXTRA_BYTES;
+ break;
+ }
+ if( SMALL_OBJ(lb) ) {
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb];
+# else
+ lw = ALIGNED_WORDS(lb);
+# endif
+ opp = &(GC_arobjfreelist[lw]);
+ FASTLOCK();
+ if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+ FASTUNLOCK();
+ op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
+ if (0 == op) return(0);
+# ifdef MERGE_SIZES
+ lw = GC_size_map[lb]; /* May have been uninitialized. */
+# endif
+ } else {
+ *opp = obj_link(op);
+ obj_link(op) = 0;
+ GC_words_allocd += lw;
+ FASTUNLOCK();
+ }
+ } else {
+ op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
+ if (0 == op) return(0);
+ lw = BYTES_TO_WORDS(GC_size(op));
+ }
+ if (descr_type == LEAF) {
+ /* Set up the descriptor inside the object itself. */
+ VOLATILE struct LeafDescriptor * lp =
+ (struct LeafDescriptor *)
+ ((word *)op
+ + lw - (BYTES_TO_WORDS(sizeof(struct LeafDescriptor)) + 1));
+
+ lp -> ld_tag = LEAF_TAG;
+ lp -> ld_size = leaf.ld_size;
+ lp -> ld_nelements = leaf.ld_nelements;
+ lp -> ld_descriptor = leaf.ld_descriptor;
+ ((VOLATILE word *)op)[lw - 1] = (word)lp;
+ } else {
+ extern unsigned GC_finalization_failures;
+ unsigned ff = GC_finalization_failures;
+
+ ((word *)op)[lw - 1] = (word)complex_descr;
+ /* Make sure the descriptor is cleared once there is any danger */
+ /* it may have been collected. */
+ (void)
+ GC_general_register_disappearing_link((GC_PTR *)
+ ((word *)op+lw-1),
+ (GC_PTR) op);
+ if (ff != GC_finalization_failures) {
+ /* Couldn't register it due to lack of memory. Punt. */
+ /* This will probably fail too, but gives the recovery code */
+ /* a chance. */
+ return(GC_malloc(n*lb));
+ }
+ }
+ return((GC_PTR) op);
+}
--- /dev/null
+/* The version here should match that in configure/configure.in */
+/* Eventually this one may become unnecessary. For now we need */
+/* it to keep the old-style build process working. */
+#define GC_TMP_VERSION_MAJOR 6
+#define GC_TMP_VERSION_MINOR 2
+#define GC_TMP_ALPHA_VERSION 4
+
+#if defined(GC_VERSION_MAJOR)
+# if GC_TMP_VERSION_MAJOR != GC_VERSION_MAJOR || \
+ GC_TMP_VERSION_MINOR != GC_VERSION_MINOR || \
+ GC_TMP_ALPHA_VERSION != GC_ALPHA_VERSION
+# error Inconsistent version info. Check version.h and configure.in.
+# endif
+#else
+# define GC_VERSION_MAJOR GC_TMP_VERSION_MAJOR
+# define GC_VERSION_MINOR GC_TMP_VERSION_MINOR
+# define GC_ALPHA_VERSION GC_TMP_ALPHA_VERSION
+#endif
+
+#ifndef GC_NOT_ALPHA
+# define GC_NOT_ALPHA 0xff
+#endif
+
+#ifndef GC_NO_VERSION_VAR
+
+unsigned GC_version = ((GC_VERSION_MAJOR << 16) | (GC_VERSION_MINOR << 8) | GC_ALPHA_VERSION);
+
+#endif /* GC_NO_VERSION_VAR */
--- /dev/null
+#if defined(GC_WIN32_THREADS)
+
+#include "private/gc_priv.h"
+
+#ifdef CYGWIN32
+# include <errno.h>
+
+ /* Cygwin-specific forward decls */
+# undef pthread_create
+# undef pthread_sigmask
+# undef pthread_join
+# undef dlopen
+
+# define DEBUG_CYGWIN_THREADS 0
+
+ GC_bool GC_thr_initialized = FALSE;
+ void * GC_start_routine(void * arg);
+ void GC_thread_exit_proc(void *arg);
+
+#endif
+
+
+#if 0
+#define STRICT
+#include <windows.h>
+#endif
+
+#define MAX_THREADS 64
+
+struct thread_entry {
+ LONG in_use;
+ DWORD id;
+ HANDLE handle;
+ void *stack; /* The cold end of the stack. */
+ /* 0 ==> entry not valid. */
+ /* !in_use ==> stack == 0 */
+ CONTEXT context;
+ GC_bool suspended;
+
+# ifdef CYGWIN32
+ void *status; /* hold exit value until join in case it's a pointer */
+ pthread_t pthread_id;
+# endif
+
+};
+
+volatile GC_bool GC_please_stop = FALSE;
+
+volatile struct thread_entry thread_table[MAX_THREADS];
+
+void GC_push_thread_structures GC_PROTO((void))
+{
+ /* Unlike the other threads implementations, the thread table here */
+ /* contains no pointers to the collectable heap. Thus we have */
+ /* no private structures we need to preserve. */
+# ifdef CYGWIN32
+ { int i; /* pthreads may keep a pointer in the thread exit value */
+ for (i = 0; i < MAX_THREADS; i++)
+ if (thread_table[i].in_use) GC_push_all((ptr_t)&(thread_table[i].status),(ptr_t)(&(thread_table[i].status)+1));
+ }
+# endif
+}
+
+void GC_stop_world()
+{
+ DWORD thread_id = GetCurrentThreadId();
+ int i;
+
+#ifdef CYGWIN32
+ if (!GC_thr_initialized) ABORT("GC_stop_world() called before GC_thr_init()");
+#endif
+
+ GC_please_stop = TRUE;
+ for (i = 0; i < MAX_THREADS; i++)
+ if (thread_table[i].stack != 0
+ && thread_table[i].id != thread_id) {
+# ifdef MSWINCE
+ /* SuspendThread will fail if thread is running kernel code */
+ while (SuspendThread(thread_table[i].handle) == (DWORD)-1)
+ Sleep(10);
+# else
+ /* Apparently the Windows 95 GetOpenFileName call creates */
+ /* a thread that does not properly get cleaned up, and */
+ /* SuspendThread on its descriptor may provoke a crash. */
+ /* This reduces the probability of that event, though it still */
+ /* appears there's a race here. */
+ DWORD exitCode;
+ if (GetExitCodeThread(thread_table[i].handle,&exitCode) &&
+ exitCode != STILL_ACTIVE) {
+ thread_table[i].stack = 0; /* prevent stack from being pushed */
+# ifndef CYGWIN32
+ /* this breaks pthread_join on Cygwin, which is guaranteed to */
+ /* only see user pthreads */
+ thread_table[i].in_use = FALSE;
+ CloseHandle(thread_table[i].handle);
+ BZERO((void *)(&thread_table[i].context), sizeof(CONTEXT));
+# endif
+ continue;
+ }
+ if (SuspendThread(thread_table[i].handle) == (DWORD)-1)
+ ABORT("SuspendThread failed");
+# endif
+ thread_table[i].suspended = TRUE;
+ }
+}
+
+void GC_start_world()
+{
+ DWORD thread_id = GetCurrentThreadId();
+ int i;
+ for (i = 0; i < MAX_THREADS; i++)
+ if (thread_table[i].stack != 0 && thread_table[i].suspended
+ && thread_table[i].id != thread_id) {
+ if (ResumeThread(thread_table[i].handle) == (DWORD)-1)
+ ABORT("ResumeThread failed");
+ thread_table[i].suspended = FALSE;
+ }
+ GC_please_stop = FALSE;
+}
+
+# ifdef _MSC_VER
+# pragma warning(disable:4715)
+# endif
+ptr_t GC_current_stackbottom()
+{
+ DWORD thread_id = GetCurrentThreadId();
+ int i;
+ for (i = 0; i < MAX_THREADS; i++)
+ if (thread_table[i].stack && thread_table[i].id == thread_id)
+ return thread_table[i].stack;
+ ABORT("no thread table entry for current thread");
+}
+# ifdef _MSC_VER
+# pragma warning(default:4715)
+# endif
+
+# ifdef MSWINCE
+ /* The VirtualQuery calls below won't work properly on WinCE, but */
+ /* since each stack is restricted to an aligned 64K region of */
+ /* virtual memory we can just take the next lowest multiple of 64K. */
+# define GC_get_lo_stack_addr(s) \
+ ((ptr_t)(((DWORD)(s) - 1) & 0xFFFF0000))
+# else
+ static ptr_t GC_get_lo_stack_addr(ptr_t s)
+ {
+ ptr_t bottom;
+ MEMORY_BASIC_INFORMATION info;
+ VirtualQuery(s, &info, sizeof(info));
+ do {
+ bottom = info.BaseAddress;
+ VirtualQuery(bottom - 1, &info, sizeof(info));
+ } while ((info.Protect & PAGE_READWRITE)
+ && !(info.Protect & PAGE_GUARD));
+ return(bottom);
+ }
+# endif
+
+void GC_push_all_stacks()
+{
+ DWORD thread_id = GetCurrentThreadId();
+ int i;
+ for (i = 0; i < MAX_THREADS; i++)
+ if (thread_table[i].stack) {
+ ptr_t bottom = GC_get_lo_stack_addr(thread_table[i].stack);
+ if (thread_table[i].id == thread_id)
+ GC_push_all_stack((ptr_t)&i, thread_table[i].stack);
+ else {
+ thread_table[i].context.ContextFlags
+ = (CONTEXT_INTEGER|CONTEXT_CONTROL);
+ if (!GetThreadContext(thread_table[i].handle,
+ /* cast away volatile qualifier */
+ (LPCONTEXT)&thread_table[i].context))
+ ABORT("GetThreadContext failed");
+# ifdef I386
+ GC_push_one ((word) thread_table[i].context.Edi);
+ GC_push_one ((word) thread_table[i].context.Esi);
+ GC_push_one ((word) thread_table[i].context.Ebp);
+ GC_push_one ((word) thread_table[i].context.Ebx);
+ GC_push_one ((word) thread_table[i].context.Edx);
+ GC_push_one ((word) thread_table[i].context.Ecx);
+ GC_push_one ((word) thread_table[i].context.Eax);
+ if (thread_table[i].context.Esp >= (DWORD)thread_table[i].stack
+ || thread_table[i].context.Esp < (DWORD)bottom) {
+ WARN("Thread stack pointer 0x%lx out of range, pushing everything",
+ thread_table[i].context.Esp);
+ GC_push_all_stack((char *) bottom, thread_table[i].stack);
+ } else {
+ GC_push_all_stack((char *) thread_table[i].context.Esp,
+ thread_table[i].stack);
+ }
+# else
+# ifdef ARM32
+ if (thread_table[i].context.Sp >= (DWORD)thread_table[i].stack
+ || thread_table[i].context.Sp < (DWORD)bottom)
+ ABORT("Thread stack pointer out of range");
+ GC_push_one ((word) thread_table[i].context.R0);
+ GC_push_one ((word) thread_table[i].context.R1);
+ GC_push_one ((word) thread_table[i].context.R2);
+ GC_push_one ((word) thread_table[i].context.R3);
+ GC_push_one ((word) thread_table[i].context.R4);
+ GC_push_one ((word) thread_table[i].context.R5);
+ GC_push_one ((word) thread_table[i].context.R6);
+ GC_push_one ((word) thread_table[i].context.R7);
+ GC_push_one ((word) thread_table[i].context.R8);
+ GC_push_one ((word) thread_table[i].context.R9);
+ GC_push_one ((word) thread_table[i].context.R10);
+ GC_push_one ((word) thread_table[i].context.R11);
+ GC_push_one ((word) thread_table[i].context.R12);
+ GC_push_all_stack((char *) thread_table[i].context.Sp,
+ thread_table[i].stack);
+# else
+# ifdef SHx
+ if (thread_table[i].context.R15 >= (DWORD)thread_table[i].stack
+ || thread_table[i].context.R15 < (DWORD)bottom)
+ ABORT("Thread stack pointer out of range");
+ GC_push_one ((word) thread_table[i].context.R0);
+ GC_push_one ((word) thread_table[i].context.R1);
+ GC_push_one ((word) thread_table[i].context.R2);
+ GC_push_one ((word) thread_table[i].context.R3);
+ GC_push_one ((word) thread_table[i].context.R4);
+ GC_push_one ((word) thread_table[i].context.R5);
+ GC_push_one ((word) thread_table[i].context.R6);
+ GC_push_one ((word) thread_table[i].context.R7);
+ GC_push_one ((word) thread_table[i].context.R8);
+ GC_push_one ((word) thread_table[i].context.R9);
+ GC_push_one ((word) thread_table[i].context.R10);
+ GC_push_one ((word) thread_table[i].context.R11);
+ GC_push_one ((word) thread_table[i].context.R12);
+ GC_push_one ((word) thread_table[i].context.R13);
+ GC_push_one ((word) thread_table[i].context.R14);
+ GC_push_all_stack((char *) thread_table[i].context.R15,
+ thread_table[i].stack);
+# else
+# ifdef MIPS
+ if (thread_table[i].context.IntSp >= (DWORD)thread_table[i].stack
+ || thread_table[i].context.IntSp < (DWORD)bottom)
+ ABORT("Thread stack pointer out of range");
+ GC_push_one ((word) thread_table[i].context.IntAt);
+ GC_push_one ((word) thread_table[i].context.IntV0);
+ GC_push_one ((word) thread_table[i].context.IntV1);
+ GC_push_one ((word) thread_table[i].context.IntA0);
+ GC_push_one ((word) thread_table[i].context.IntA1);
+ GC_push_one ((word) thread_table[i].context.IntA2);
+ GC_push_one ((word) thread_table[i].context.IntA3);
+ GC_push_one ((word) thread_table[i].context.IntT0);
+ GC_push_one ((word) thread_table[i].context.IntT1);
+ GC_push_one ((word) thread_table[i].context.IntT2);
+ GC_push_one ((word) thread_table[i].context.IntT3);
+ GC_push_one ((word) thread_table[i].context.IntT4);
+ GC_push_one ((word) thread_table[i].context.IntT5);
+ GC_push_one ((word) thread_table[i].context.IntT6);
+ GC_push_one ((word) thread_table[i].context.IntT7);
+ GC_push_one ((word) thread_table[i].context.IntS0);
+ GC_push_one ((word) thread_table[i].context.IntS1);
+ GC_push_one ((word) thread_table[i].context.IntS2);
+ GC_push_one ((word) thread_table[i].context.IntS3);
+ GC_push_one ((word) thread_table[i].context.IntS4);
+ GC_push_one ((word) thread_table[i].context.IntS5);
+ GC_push_one ((word) thread_table[i].context.IntS6);
+ GC_push_one ((word) thread_table[i].context.IntS7);
+ GC_push_one ((word) thread_table[i].context.IntT8);
+ GC_push_one ((word) thread_table[i].context.IntT9);
+ GC_push_one ((word) thread_table[i].context.IntK0);
+ GC_push_one ((word) thread_table[i].context.IntK1);
+ GC_push_one ((word) thread_table[i].context.IntS8);
+ GC_push_all_stack((char *) thread_table[i].context.IntSp,
+ thread_table[i].stack);
+# else
+# ifdef PPC
+ if (thread_table[i].context.Gpr1 >= (DWORD)thread_table[i].stack
+ || thread_table[i].context.Gpr1 < (DWORD)bottom)
+ ABORT("Thread stack pointer out of range");
+ GC_push_one ((word) thread_table[i].context.Gpr0);
+ /* Gpr1 is stack pointer */
+ /* Gpr2 is global pointer */
+ GC_push_one ((word) thread_table[i].context.Gpr3);
+ GC_push_one ((word) thread_table[i].context.Gpr4);
+ GC_push_one ((word) thread_table[i].context.Gpr5);
+ GC_push_one ((word) thread_table[i].context.Gpr6);
+ GC_push_one ((word) thread_table[i].context.Gpr7);
+ GC_push_one ((word) thread_table[i].context.Gpr8);
+ GC_push_one ((word) thread_table[i].context.Gpr9);
+ GC_push_one ((word) thread_table[i].context.Gpr10);
+ GC_push_one ((word) thread_table[i].context.Gpr11);
+ GC_push_one ((word) thread_table[i].context.Gpr12);
+ /* Gpr13 is reserved for the kernel */
+ GC_push_one ((word) thread_table[i].context.Gpr14);
+ GC_push_one ((word) thread_table[i].context.Gpr15);
+ GC_push_one ((word) thread_table[i].context.Gpr16);
+ GC_push_one ((word) thread_table[i].context.Gpr17);
+ GC_push_one ((word) thread_table[i].context.Gpr18);
+ GC_push_one ((word) thread_table[i].context.Gpr19);
+ GC_push_one ((word) thread_table[i].context.Gpr20);
+ GC_push_one ((word) thread_table[i].context.Gpr21);
+ GC_push_one ((word) thread_table[i].context.Gpr22);
+ GC_push_one ((word) thread_table[i].context.Gpr23);
+ GC_push_one ((word) thread_table[i].context.Gpr24);
+ GC_push_one ((word) thread_table[i].context.Gpr25);
+ GC_push_one ((word) thread_table[i].context.Gpr26);
+ GC_push_one ((word) thread_table[i].context.Gpr27);
+ GC_push_one ((word) thread_table[i].context.Gpr28);
+ GC_push_one ((word) thread_table[i].context.Gpr29);
+ GC_push_one ((word) thread_table[i].context.Gpr30);
+ GC_push_one ((word) thread_table[i].context.Gpr31);
+ GC_push_all_stack((char *) thread_table[i].context.Gpr1,
+ thread_table[i].stack);
+# else
+# ifdef ALPHA
+ if (thread_table[i].context.IntSp >= (DWORD)thread_table[i].stack
+ || thread_table[i].context.IntSp < (DWORD)bottom)
+ ABORT("Thread stack pointer out of range");
+ GC_push_one ((word) thread_table[i].context.IntV0);
+ GC_push_one ((word) thread_table[i].context.IntT0);
+ GC_push_one ((word) thread_table[i].context.IntT1);
+ GC_push_one ((word) thread_table[i].context.IntT2);
+ GC_push_one ((word) thread_table[i].context.IntT3);
+ GC_push_one ((word) thread_table[i].context.IntT4);
+ GC_push_one ((word) thread_table[i].context.IntT5);
+ GC_push_one ((word) thread_table[i].context.IntT6);
+ GC_push_one ((word) thread_table[i].context.IntT7);
+ GC_push_one ((word) thread_table[i].context.IntS0);
+ GC_push_one ((word) thread_table[i].context.IntS1);
+ GC_push_one ((word) thread_table[i].context.IntS2);
+ GC_push_one ((word) thread_table[i].context.IntS3);
+ GC_push_one ((word) thread_table[i].context.IntS4);
+ GC_push_one ((word) thread_table[i].context.IntS5);
+ GC_push_one ((word) thread_table[i].context.IntFp);
+ GC_push_one ((word) thread_table[i].context.IntA0);
+ GC_push_one ((word) thread_table[i].context.IntA1);
+ GC_push_one ((word) thread_table[i].context.IntA2);
+ GC_push_one ((word) thread_table[i].context.IntA3);
+ GC_push_one ((word) thread_table[i].context.IntA4);
+ GC_push_one ((word) thread_table[i].context.IntA5);
+ GC_push_one ((word) thread_table[i].context.IntT8);
+ GC_push_one ((word) thread_table[i].context.IntT9);
+ GC_push_one ((word) thread_table[i].context.IntT10);
+ GC_push_one ((word) thread_table[i].context.IntT11);
+ GC_push_one ((word) thread_table[i].context.IntT12);
+ GC_push_one ((word) thread_table[i].context.IntAt);
+ GC_push_all_stack((char *) thread_table[i].context.IntSp,
+ thread_table[i].stack);
+# else
+ --> architecture not supported
+# endif /* !ALPHA */
+# endif /* !PPC */
+# endif /* !MIPS */
+# endif /* !SHx */
+# endif /* !ARM32 */
+# endif /* !I386 */
+ }
+ }
+}
+
+void GC_get_next_stack(char *start, char **lo, char **hi)
+{
+ int i;
+# define ADDR_LIMIT (char *)(-1L)
+ char * current_min = ADDR_LIMIT;
+
+ for (i = 0; i < MAX_THREADS; i++) {
+ char * s = (char *)thread_table[i].stack;
+
+ if (0 != s && s > start && s < current_min) {
+ current_min = s;
+ }
+ }
+ *hi = current_min;
+ if (current_min == ADDR_LIMIT) {
+ *lo = ADDR_LIMIT;
+ return;
+ }
+ *lo = GC_get_lo_stack_addr(current_min);
+ if (*lo < start) *lo = start;
+}
+
+#if !defined(MSWINCE) && !(defined(__MINGW32__) && !defined(_DLL))
+
+HANDLE WINAPI GC_CreateThread(
+ LPSECURITY_ATTRIBUTES lpThreadAttributes,
+ DWORD dwStackSize, LPTHREAD_START_ROUTINE lpStartAddress,
+ LPVOID lpParameter, DWORD dwCreationFlags, LPDWORD lpThreadId )
+{
+ return CreateThread(lpThreadAttributes, dwStackSize, lpStartAddress,
+ lpParameter, dwCreationFlags, lpThreadId);
+}
+
+#else /* !defined(MSWINCE) && !(defined(__MINGW32__) && !defined(_DLL)) */
+
+typedef struct {
+ HANDLE child_ready_h, parent_ready_h;
+ volatile struct thread_entry * entry;
+ LPTHREAD_START_ROUTINE start;
+ LPVOID param;
+} thread_args;
+
+DWORD WINAPI thread_start(LPVOID arg);
+
+HANDLE WINAPI GC_CreateThread(
+ LPSECURITY_ATTRIBUTES lpThreadAttributes,
+ DWORD dwStackSize, LPTHREAD_START_ROUTINE lpStartAddress,
+ LPVOID lpParameter, DWORD dwCreationFlags, LPDWORD lpThreadId )
+{
+ HANDLE thread_h = NULL;
+ HANDLE child_ready_h, parent_ready_h;
+
+ int i;
+ thread_args args;
+
+ /* allocate thread slot */
+ LOCK();
+ for (i = 0; i != MAX_THREADS && thread_table[i].in_use; i++)
+ ;
+ if (i != MAX_THREADS) {
+ thread_table[i].in_use = TRUE;
+ }
+ UNLOCK();
+
+ if (i != MAX_THREADS) {
+
+ /* create unnamed unsignalled events */
+ if (child_ready_h = CreateEvent(NULL, FALSE, FALSE, NULL)) {
+ if (parent_ready_h = CreateEvent(NULL, FALSE, FALSE, NULL)) {
+
+ /* set up thread arguments */
+ args.child_ready_h = child_ready_h;
+ args.parent_ready_h = parent_ready_h;
+ args.entry = &thread_table[i];
+ args.start = lpStartAddress;
+ args.param = lpParameter;
+
+ thread_h = CreateThread(lpThreadAttributes,
+ dwStackSize, thread_start,
+ &args,
+ dwCreationFlags & ~CREATE_SUSPENDED,
+ lpThreadId);
+
+ if (thread_h) {
+
+ /* fill in ID and handle; tell child this is done */
+ thread_table[i].id = *lpThreadId;
+ thread_table[i].handle = thread_h;
+ SetEvent (parent_ready_h);
+
+ /* wait for child to fill in stack and copy args */
+ WaitForSingleObject (child_ready_h, INFINITE);
+
+ /* suspend the child if requested */
+ if (dwCreationFlags & CREATE_SUSPENDED)
+ SuspendThread (thread_h);
+
+ /* let child call given function now (or when resumed) */
+ SetEvent (parent_ready_h);
+
+ } else {
+ CloseHandle (parent_ready_h);
+ }
+ }
+ }
+
+ CloseHandle (child_ready_h);
+
+ if (thread_h == NULL)
+ thread_table[i].in_use = FALSE;
+
+ } else { /* no thread slot found */
+ SetLastError (ERROR_TOO_MANY_TCBS);
+ }
+
+ return thread_h;
+}
+
+static DWORD WINAPI thread_start(LPVOID arg)
+{
+ DWORD ret = 0;
+ thread_args args = *(thread_args *)arg;
+
+ /* wait for parent to fill in ID and handle */
+ WaitForSingleObject (args.parent_ready_h, INFINITE);
+ ResetEvent (args.parent_ready_h);
+
+ /* fill in stack; tell parent this is done */
+ args.entry->stack = GC_get_stack_base();
+ SetEvent (args.child_ready_h);
+
+ /* wait for parent to tell us to go (in case it needs to suspend us) */
+ WaitForSingleObject (args.parent_ready_h, INFINITE);
+ CloseHandle (args.parent_ready_h);
+
+ /* Clear the thread entry even if we exit with an exception. */
+ /* This is probably pointless, since an uncaught exception is */
+ /* supposed to result in the process being killed. */
+#ifndef __GNUC__
+ __try {
+#endif /* __GNUC__ */
+ ret = args.start (args.param);
+#ifndef __GNUC__
+ } __finally {
+#endif /* __GNUC__ */
+ LOCK();
+ args.entry->stack = 0;
+ args.entry->in_use = FALSE;
+ /* cast away volatile qualifier */
+ BZERO((void *) &args.entry->context, sizeof(CONTEXT));
+ UNLOCK();
+#ifndef __GNUC__
+ }
+#endif /* __GNUC__ */
+
+ return ret;
+}
+#endif /* !defined(MSWINCE) && !(defined(__MINGW32__) && !defined(_DLL)) */
+
+#ifdef MSWINCE
+
+typedef struct {
+ HINSTANCE hInstance;
+ HINSTANCE hPrevInstance;
+ LPWSTR lpCmdLine;
+ int nShowCmd;
+} main_thread_args;
+
+DWORD WINAPI main_thread_start(LPVOID arg);
+
+int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,
+ LPWSTR lpCmdLine, int nShowCmd)
+{
+ DWORD exit_code = 1;
+
+ main_thread_args args = {
+ hInstance, hPrevInstance, lpCmdLine, nShowCmd
+ };
+ HANDLE thread_h;
+ DWORD thread_id;
+
+ /* initialize everything */
+ InitializeCriticalSection(&GC_allocate_ml);
+ GC_init();
+
+ /* start the main thread */
+ thread_h = GC_CreateThread(
+ NULL, 0, main_thread_start, &args, 0, &thread_id);
+
+ if (thread_h != NULL)
+ {
+ WaitForSingleObject (thread_h, INFINITE);
+ GetExitCodeThread (thread_h, &exit_code);
+ CloseHandle (thread_h);
+ }
+
+ GC_deinit();
+ DeleteCriticalSection(&GC_allocate_ml);
+
+ return (int) exit_code;
+}
+
+DWORD WINAPI main_thread_start(LPVOID arg)
+{
+ main_thread_args * args = (main_thread_args *) arg;
+
+ return (DWORD) GC_WinMain (args->hInstance, args->hPrevInstance,
+ args->lpCmdLine, args->nShowCmd);
+}
+
+# else /* !MSWINCE */
+
+LONG WINAPI GC_write_fault_handler(struct _EXCEPTION_POINTERS *exc_info);
+
+/* threadAttach/threadDetach routines used by both CYGWIN and DLL implementation,
+ since both recieve explicit notification on thread creation/destruction
+ */
+void threadAttach() {
+ int i;
+ /* It appears to be unsafe to acquire a lock here, since this */
+ /* code is apparently not preeemptible on some systems. */
+ /* (This is based on complaints, not on Microsoft's official */
+ /* documentation, which says this should perform "only simple */
+ /* inititalization tasks".) */
+ /* Hence we make do with nonblocking synchronization. */
+
+ /* The following should be a noop according to the win32 */
+ /* documentation. There is empirical evidence that it */
+ /* isn't. - HB */
+# if defined(MPROTECT_VDB)
+ if (GC_incremental) SetUnhandledExceptionFilter(GC_write_fault_handler);
+# endif
+ /* cast away volatile qualifier */
+ for (i = 0; InterlockedExchange((LONG*)&thread_table[i].in_use,1) != 0; i++) {
+ /* Compare-and-swap would make this cleaner, but that's not */
+ /* supported before Windows 98 and NT 4.0. In Windows 2000, */
+ /* InterlockedExchange is supposed to be replaced by */
+ /* InterlockedExchangePointer, but that's not really what I */
+ /* want here. */
+ if (i == MAX_THREADS - 1)
+ ABORT("too many threads");
+ }
+ thread_table[i].id = GetCurrentThreadId();
+# ifdef CYGWIN32
+ thread_table[i].pthread_id = pthread_self();
+# endif
+ if (!DuplicateHandle(GetCurrentProcess(),
+ GetCurrentThread(),
+ GetCurrentProcess(),
+ (HANDLE*)&thread_table[i].handle,
+ 0,
+ 0,
+ DUPLICATE_SAME_ACCESS)) {
+ DWORD last_error = GetLastError();
+ GC_printf1("Last error code: %lx\n", last_error);
+ ABORT("DuplicateHandle failed");
+ }
+ thread_table[i].stack = GC_get_stack_base();
+ if (thread_table[i].stack == NULL)
+ ABORT("Failed to find stack base in threadAttach");
+ /* If this thread is being created while we are trying to stop */
+ /* the world, wait here. Hopefully this can't happen on any */
+ /* systems that don't allow us to block here. */
+ while (GC_please_stop) Sleep(20);
+}
+
+void threadDetach(DWORD thread_id) {
+ int i;
+
+ LOCK();
+ for (i = 0;
+ i < MAX_THREADS &&
+ !thread_table[i].in_use || thread_table[i].id != thread_id;
+ i++) {}
+ if (i >= MAX_THREADS ) {
+ WARN("thread %ld not found on detach", (GC_word)thread_id);
+ }
+ else {
+ thread_table[i].stack = 0;
+ thread_table[i].in_use = FALSE;
+ CloseHandle(thread_table[i].handle);
+ /* cast away volatile qualifier */
+ BZERO((void *)&thread_table[i].context, sizeof(CONTEXT));
+ }
+ UNLOCK();
+}
+
+#ifdef CYGWIN32
+
+/* Called by GC_init() - we hold the allocation lock. */
+void GC_thr_init() {
+ if (GC_thr_initialized) return;
+ GC_thr_initialized = TRUE;
+
+#if 0
+ /* this might already be handled in GC_init... */
+ InitializeCriticalSection(&GC_allocate_ml);
+#endif
+
+ /* Add the initial thread, so we can stop it. */
+ threadAttach();
+}
+
+struct start_info {
+ void *(*start_routine)(void *);
+ void *arg;
+};
+
+int GC_pthread_join(pthread_t pthread_id, void **retval) {
+ int result;
+ int i;
+
+# if DEBUG_CYGWIN_THREADS
+ GC_printf3("thread 0x%x(0x%x) is joining thread 0x%x.\n",(int)pthread_self(),
+ GetCurrentThreadId(), (int)pthread_id);
+# endif
+
+ /* Can't do any table lookups here, because thread being joined
+ might not have registered itself yet */
+
+ result = pthread_join(pthread_id, retval);
+
+ LOCK();
+ for (i = 0; !thread_table[i].in_use || thread_table[i].pthread_id != pthread_id;
+ i++) {
+ if (i == MAX_THREADS - 1) {
+ GC_printf1("Failed to find thread 0x%x in pthread_join()\n", pthread_id);
+ ABORT("thread not found on detach");
+ }
+ }
+ UNLOCK();
+ threadDetach(thread_table[i].id);
+
+# if DEBUG_CYGWIN_THREADS
+ GC_printf3("thread 0x%x(0x%x) completed join with thread 0x%x.\n",
+ (int)pthread_self(), GetCurrentThreadId(), (int)pthread_id);
+# endif
+
+ return result;
+}
+
+/* Cygwin-pthreads calls CreateThread internally, but it's not
+ * easily interceptible by us..
+ * so intercept pthread_create instead
+ */
+int
+GC_pthread_create(pthread_t *new_thread,
+ const pthread_attr_t *attr,
+ void *(*start_routine)(void *), void *arg) {
+ int result;
+ struct start_info * si;
+
+ if (!GC_is_initialized) GC_init();
+ /* make sure GC is initialized (i.e. main thread is attached) */
+
+ /* This is otherwise saved only in an area mmapped by the thread */
+ /* library, which isn't visible to the collector. */
+ si = GC_malloc_uncollectable(sizeof(struct start_info));
+ if (0 == si) return(EAGAIN);
+
+ si -> start_routine = start_routine;
+ si -> arg = arg;
+
+# if DEBUG_CYGWIN_THREADS
+ GC_printf2("About to create a thread from 0x%x(0x%x)\n",(int)pthread_self(),
+ GetCurrentThreadId);
+# endif
+ result = pthread_create(new_thread, attr, GC_start_routine, si);
+
+ if (result) { /* failure */
+ GC_free(si);
+ }
+
+ return(result);
+}
+
+void * GC_start_routine(void * arg)
+{
+ struct start_info * si = arg;
+ void * result;
+ void *(*start)(void *);
+ void *start_arg;
+ pthread_t pthread_id;
+ int i;
+
+# if DEBUG_CYGWIN_THREADS
+ GC_printf2("thread 0x%x(0x%x) starting...\n",(int)pthread_self(),
+ GetCurrentThreadId());
+# endif
+
+ /* If a GC occurs before the thread is registered, that GC will */
+ /* ignore this thread. That's fine, since it will block trying to */
+ /* acquire the allocation lock, and won't yet hold interesting */
+ /* pointers. */
+ LOCK();
+ /* We register the thread here instead of in the parent, so that */
+ /* we don't need to hold the allocation lock during pthread_create. */
+ threadAttach();
+ UNLOCK();
+
+ start = si -> start_routine;
+ start_arg = si -> arg;
+ pthread_id = pthread_self();
+
+ GC_free(si); /* was allocated uncollectable */
+
+ pthread_cleanup_push(GC_thread_exit_proc, pthread_id);
+ result = (*start)(start_arg);
+ pthread_cleanup_pop(0);
+
+# if DEBUG_CYGWIN_THREADS
+ GC_printf2("thread 0x%x(0x%x) returned from start routine.\n",
+ (int)pthread_self(),GetCurrentThreadId());
+# endif
+
+ LOCK();
+ for (i = 0; thread_table[i].pthread_id != pthread_id; i++) {
+ if (i == MAX_THREADS - 1)
+ ABORT("thread not found on exit");
+ }
+ thread_table[i].status = result;
+ UNLOCK();
+
+ return(result);
+}
+
+void GC_thread_exit_proc(void *arg)
+{
+ pthread_t pthread_id = (pthread_t)arg;
+ int i;
+
+# if DEBUG_CYGWIN_THREADS
+ GC_printf2("thread 0x%x(0x%x) called pthread_exit().\n",(int)pthread_self(),GetCurrentThreadId());
+# endif
+
+ LOCK();
+ for (i = 0; thread_table[i].pthread_id != pthread_id; i++) {
+ if (i == MAX_THREADS - 1)
+ ABORT("thread not found on exit");
+ }
+ UNLOCK();
+
+#if 0
+ /* TODO: we need a way to get the exit value after a pthread_exit so we can stash it safely away */
+ thread_table[i].status = ???
+#endif
+}
+
+/* nothing required here... */
+int GC_pthread_sigmask(int how, const sigset_t *set, sigset_t *oset) {
+ return pthread_sigmask(how, set, oset);
+}
+int GC_pthread_detach(pthread_t thread) {
+ return pthread_detach(thread);
+}
+#else
+
+/*
+ * We avoid acquiring locks here, since this doesn't seem to be preemptable.
+ * Pontus Rydin suggests wrapping the thread start routine instead.
+ */
+BOOL WINAPI DllMain(HINSTANCE inst, ULONG reason, LPVOID reserved)
+{
+ switch (reason) {
+ case DLL_PROCESS_ATTACH:
+ InitializeCriticalSection(&GC_allocate_ml);
+ GC_init(); /* Force initialization before thread attach. */
+ /* fall through */
+ case DLL_THREAD_ATTACH:
+ threadAttach();
+ break;
+
+ case DLL_THREAD_DETACH:
+ threadDetach(GetCurrentThreadId());
+ break;
+
+ case DLL_PROCESS_DETACH:
+ {
+ int i;
+
+ LOCK();
+ for (i = 0; i < MAX_THREADS; ++i)
+ {
+ if (thread_table[i].in_use)
+ {
+ thread_table[i].stack = 0;
+ thread_table[i].in_use = FALSE;
+ CloseHandle(thread_table[i].handle);
+ BZERO((void *) &thread_table[i].context, sizeof(CONTEXT));
+ }
+ }
+ UNLOCK();
+
+ GC_deinit();
+ DeleteCriticalSection(&GC_allocate_ml);
+ }
+ break;
+
+ }
+ return TRUE;
+}
+#endif /* CYGWIN32 */
+
+# endif /* !MSWINCE */
+
+#endif /* GC_WIN32_THREADS */
-2003-05-31 Juanma Barranquero <lektu@terra.es>
-
- * makefile.w32-in (lisp): Fix references to byte-run.el,
- float-sup.el and map-ynp.el, which are now in emacs-lisp.
-
2003-05-22 Dave Love <fx@gnu.org>
* update-game-score.c (difftime) [!HAVE_DIFFTIME]: Define.
$(lispsource)abbrev.elc \
$(lispsource)buff-menu.elc \
$(lispsource)button.elc \
- $(lispsource)emacs-lisp/byte-run.elc \
+ $(lispsource)byte-run.elc \
$(lispsource)cus-start.elc \
$(lispsource)custom.elc \
$(lispsource)emacs-lisp/backquote.elc \
$(lispsource)format.elc \
$(lispsource)facemenu.elc \
$(MOUSE_SUPPORT) \
- $(lispsource)emacs-lisp/float-sup.elc \
- $(lispsource)frame.elc \
+ $(lispsource)float-sup.elc \
+ $(lispsource)frame.elc\
$(lispsource)help.elc \
$(lispsource)indent.elc \
$(lispsource)isearch.elc \
$(lispsource)loadup.el \
$(lispsource)loaddefs.el \
$(lispsource)bindings.elc \
- $(lispsource)emacs-lisp/map-ynp.elc \
+ $(lispsource)map-ynp.elc \
$(lispsource)menu-bar.elc \
$(lispsource)international/mule.elc \
$(lispsource)international/mule-conf.el \
-2003-05-27 David Ponce <david@dponce.com>
-
- * ruler-mode.el
-
- Version 1.6
-
- Take into account changes made to the display margins, fringes and
- scroll-bar handling.
-
- (ruler-mode-margins-char): Removed. Not used anymore.
- (ruler-mode-pad-face, ruler-mode-fringes-face): New faces.
- (ruler-mode-margins-face): New definition. Moved.
- (ruler-mode-left-fringe-cols)
- (ruler-mode-right-fringe-cols)
- (ruler-mode-left-scroll-bar-cols)
- (ruler-mode-right-scroll-bar-cols): Reimplemented. Moved.
- (ruler-mode-full-window-width)
- (ruler-mode-window-col): New functions.
- (ruler-mode-mouse-set-left-margin)
- (ruler-mode-mouse-set-right-margin)
- (ruler-mode-mouse-add-tab-stop)
- (ruler-mode-mouse-del-tab-stop): Reimplemented.
- (ruler-mode-mouse-current-grab-object): Renamed to...
- (ruler-mode-dragged-symbol): New.
- (ruler-mode-mouse-grab-any-column): Use it. Cleaned up.
- (ruler-mode-mouse-drag-any-column): Likewise.
- (ruler-mode-mouse-drag-any-column-iteration): Simplified.
- (ruler-mode): Restore previous `header-line-format' if
- `ruler-mode-header-line-format-old' has a local binding in current
- buffer.
- (ruler-mode-left-margin-help-echo)
- (ruler-mode-right-margin-help-echo): Removed.
- (ruler-mode-margin-help-echo)
- (ruler-mode-fringe-help-echo): New constants.
- (ruler-mode-ruler): Use them. Reimplemented.
-
-2003-06-01 Jason Rumney <jasonr@gnu.org>
-
- * mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event):
- Default to new wheel-up and wheel-down events on Windows.
-
- * term/w32-win.el: No need to bind wheel events specially.
-
-2003-06-01 Michael Kifer <kifer@cs.stonybrook.edu>
-
- * desktop.el (desktop-create-buffer): Added (desktop-first-buffer) to
- the let-statement to avoid the startup error that desktop-first-buffer
- is undefined.
-
-2003-06-01 Andreas Schwab <schwab@suse.de>
-
- * man.el (Man-name-regexp): Also match Latin-1 soft hyphen.
- (Man-build-references-alist): Handle Latin-1 soft hyphen.
-
-2003-05-31 Stephen Eglen <stephen@gnu.org>
-
- * iswitchb.el (iswitchb-buffer-ignore): Update custom type to
- allow functions.
-
-2003-05-31 Stefan Monnier <monnier@cs.yale.edu>
-
- * view.el (view-file, view-file-other-window, view-file-other-frame):
- Signal an error when trying to visit an inexistent file.
-
- * vc-hooks.el (vc-call-backend): Give better error message
- when a backend function is missing.
- (vc-find-file-hook): USe unless. Merge if and cond.
-
- * vc.el (vc-directory-exclusion-list): Add MCVS and .svn.
- (vc-checkin-hook): Adjust option to new name.
-
- * log-edit.el (log-edit-maximum-comment-ring-size)
- (log-edit-comment-ring, log-edit-comment-ring-index)
- (log-edit-last-comment-match): Rename vars from
- vc-maximum-comment-ring-size, vc-comment-ring, vc-comment-ring-index,
- and vc-last-comment-match.
- (log-edit-new-comment-index, log-edit-previous-comment)
- (log-edit-next-comment, log-edit-comment-search-backward)
- (log-edit-comment-search-forward, log-edit-comment-to-change-log):
- Rename funs from vc-new-comment-index, vc-previous-comment,
- vc-next-comment, vc-comment-search-reverse, vc-comment-search-forward,
- and vc-comment-to-change-log.
-
- * wid-edit.el (widget-specify-insert): Simplify.
- (widget-editable-list-entry-create): Don't assume that %d and %i are
- in the format string.
- (widget-map-buttons): Remove unused var `parent'.
- (widget-move): Remove unused shadowed var `new'.
- (widget-color-action): Remove unused var `pos'.
-
- * cus-edit.el (custom-get-fresh-buffer): New fun.
- (custom-buffer-create, custom-buffer-create-other-window)
- (customize-browse): Use it instead of killing buffers.
- (custom-bury-buffer): Obey the argument.
- (custom-variable-reset-saved, custom-variable-reset-standard):
- Remove unused var `comment-widget'.
- (custom-face-edit-deactivate): Remove unused var `to'.
- (custom-save-variables): Remove unused var `sep'.
-
-2003-05-31 John Paul Wallington <jpw@gnu.org>
-
- * files.el (large-file-warning-threshold): Add type, groups.
-
- * progmodes/delphi.el (delphi-ignore-changes): Defvar; non-constant.
-
-2003-05-31 Kenichi Handa <handa@m17n.org>
-
- * files.el (recover-file): Bind coding-system-for-read to
- auto-save-coding.
-
-2003-05-31 Juanma Barranquero <lektu@terra.es>
-
- * misc.el (mark-beginning-of-buffer, mark-end-of-buffer)
- (upcase-char, forward-to-word, backward-to-word): Moved from unused.el.
-
- * unused.el: Deleted (contents moved to misc.el).
-
- * options.el:
- * emacs-lisp/float.el:
- * textmodes/scribe.el: Moved to obsolete.
-
- * byte-run.el:
- * derived.el:
- * float-sup.el:
- * map-ynp.el:
- * regi.el:
- * timer.el:
- * warnings.el: Moved to emacs-lisp.
-
- * enriched.el: Moved to textmodes.
-
- * textmodes/outline.el: Moved to lisp.
-
- * which-func.el: Moved to progmodes.
-
- * loadup.el: Load byte-run.el, map-ynp.el, timer.el and float-sup.el
- from emacs-lisp.
-
-2003-05-31 Tom Wurgler <twurgler@goodyear.com> (tiny change)
-
- * subr.el (looking-back): New function to check for regular
- expression before point.
-
2003-05-30 Stefan Monnier <monnier@cs.yale.edu>
- * newcomment.el (comment-empty-lines): New var.
- (comment-region-internal): Use it.
-
- * textmodes/tex-mode.el (latex-block-args-alist)
- (latex-block-body-alist): New vars.
- (latex-insert-block): Use them.
- (tex-string-prefix-p): New fun.
- (tex-guess-main-file): Use it to detect when the main file
- is in a parent directory.
- (tex-main-file): Try to find a main-file in parent directories.
- (tex-compile-default): Don't use `gv' on pdf files just because
- `gv' was used recently on a ps file. Remove unused arg `dir'.
- Reuse a previous command as-is if it applied to the same file.
- (tex-compile): Use the right file name when file is not in dir.
-
- * textmodes/refill.el (refill-adjust-ignorable-overlay):
- Don't hardcode pint-min == 1.
- (refill-fill-paragraph-at): Use a more robust method to detect
- when the paragraph is after point. Remove unused var `fill-pfx'.
-
- * xml.el (xml-parse-tag): Return (foo nil) rather than (foo nil "")
- for <foo/>, to make it behave like <foo></foo>.
-
* emacs-lisp/edebug.el (edebug-storing-offsets): Move indent
and debug to inside the macro.
(edebug-read-storing-offsets): Simplify.
--- /dev/null
+;;; byte-run.el --- byte-compiler support for inlining
+
+;; Copyright (C) 1992 Free Software Foundation, Inc.
+
+;; Author: Jamie Zawinski <jwz@lucid.com>
+;; Hallvard Furuseth <hbf@ulrik.uio.no>
+;; Maintainer: FSF
+;; Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; interface to selectively inlining functions.
+;; This only happens when source-code optimization is turned on.
+
+;;; Code:
+
+;; Redefined in byte-optimize.el.
+;; This is not documented--it's not clear that we should promote it.
+(fset 'inline 'progn)
+(put 'inline 'lisp-indent-hook 0)
+
+
+;;; Interface to inline functions.
+
+;; (defmacro proclaim-inline (&rest fns)
+;; "Cause the named functions to be open-coded when called from compiled code.
+;; They will only be compiled open-coded when byte-compile-optimize is true."
+;; (cons 'eval-and-compile
+;; (mapcar '(lambda (x)
+;; (or (memq (get x 'byte-optimizer)
+;; '(nil byte-compile-inline-expand))
+;; (error
+;; "%s already has a byte-optimizer, can't make it inline"
+;; x))
+;; (list 'put (list 'quote x)
+;; ''byte-optimizer ''byte-compile-inline-expand))
+;; fns)))
+
+;; (defmacro proclaim-notinline (&rest fns)
+;; "Cause the named functions to no longer be open-coded."
+;; (cons 'eval-and-compile
+;; (mapcar '(lambda (x)
+;; (if (eq (get x 'byte-optimizer) 'byte-compile-inline-expand)
+;; (put x 'byte-optimizer nil))
+;; (list 'if (list 'eq (list 'get (list 'quote x) ''byte-optimizer)
+;; ''byte-compile-inline-expand)
+;; (list 'put x ''byte-optimizer nil)))
+;; fns)))
+
+;; This has a special byte-hunk-handler in bytecomp.el.
+(defmacro defsubst (name arglist &rest body)
+ "Define an inline function. The syntax is just like that of `defun'."
+ (or (memq (get name 'byte-optimizer)
+ '(nil byte-compile-inline-expand))
+ (error "`%s' is a primitive" name))
+ (list 'prog1
+ (cons 'defun (cons name (cons arglist body)))
+ (list 'eval-and-compile
+ (list 'put (list 'quote name)
+ ''byte-optimizer ''byte-compile-inline-expand))))
+
+(defun make-obsolete (fn new &optional when)
+ "Make the byte-compiler warn that FUNCTION is obsolete.
+The warning will say that NEW should be used instead.
+If NEW is a string, that is the `use instead' message.
+If provided, WHEN should be a string indicating when the function
+was first made obsolete, for example a date or a release number."
+ (interactive "aMake function obsolete: \nxObsoletion replacement: ")
+ (let ((handler (get fn 'byte-compile)))
+ (if (eq 'byte-compile-obsolete handler)
+ (setq handler (nth 1 (get fn 'byte-obsolete-info)))
+ (put fn 'byte-compile 'byte-compile-obsolete))
+ (put fn 'byte-obsolete-info (list new handler when)))
+ fn)
+
+(defun make-obsolete-variable (var new &optional when)
+ "Make the byte-compiler warn that VARIABLE is obsolete,
+and NEW should be used instead. If NEW is a string, then that is the
+`use instead' message.
+If provided, WHEN should be a string indicating when the variable
+was first made obsolete, for example a date or a release number."
+ (interactive
+ (list
+ (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
+ (if (equal str "") (error ""))
+ (intern str))
+ (car (read-from-string (read-string "Obsoletion replacement: ")))))
+ (put var 'byte-obsolete-variable (cons new when))
+ var)
+
+(put 'dont-compile 'lisp-indent-hook 0)
+(defmacro dont-compile (&rest body)
+ "Like `progn', but the body always runs interpreted (not compiled).
+If you think you need this, you're probably making a mistake somewhere."
+ (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
+
+\f
+;;; interface to evaluating things at compile time and/or load time
+;;; these macro must come after any uses of them in this file, as their
+;;; definition in the file overrides the magic definitions on the
+;;; byte-compile-macro-environment.
+
+(put 'eval-when-compile 'lisp-indent-hook 0)
+(defmacro eval-when-compile (&rest body)
+ "Like `progn', but evaluates the body at compile time.
+The result of the body appears to the compiler as a quoted constant."
+ ;; Not necessary because we have it in b-c-initial-macro-environment
+ ;; (list 'quote (eval (cons 'progn body)))
+ (cons 'progn body))
+
+(put 'eval-and-compile 'lisp-indent-hook 0)
+(defmacro eval-and-compile (&rest body)
+ "Like `progn', but evaluates the body at compile time and at load time."
+ ;; Remember, it's magic.
+ (cons 'progn body))
+
+(defun with-no-warnings (&optional first &rest body)
+ "Like `progn', but prevents compiler warnings in the body."
+ ;; The implementation for the interpreter is basically trivial.
+ (if body (car (last body))
+ first))
+
+\f
+;;; I nuked this because it's not a good idea for users to think of using it.
+;;; These options are a matter of installation preference, and have nothing to
+;;; with particular source files; it's a mistake to suggest to users
+;;; they should associate these with particular source files.
+;;; There is hardly any reason to change these parameters, anyway.
+;;; --rms.
+
+;; (put 'byte-compiler-options 'lisp-indent-hook 0)
+;; (defmacro byte-compiler-options (&rest args)
+;; "Set some compilation-parameters for this file. This will affect only the
+;; file in which it appears; this does nothing when evaluated, and when loaded
+;; from a .el file.
+;;
+;; Each argument to this macro must be a list of a key and a value.
+;;
+;; Keys: Values: Corresponding variable:
+;;
+;; verbose t, nil byte-compile-verbose
+;; optimize t, nil, source, byte byte-compile-optimize
+;; warnings list of warnings byte-compile-warnings
+;; Legal elements: (callargs redefine free-vars unresolved)
+;; file-format emacs18, emacs19 byte-compile-compatibility
+;;
+;; For example, this might appear at the top of a source file:
+;;
+;; (byte-compiler-options
+;; (optimize t)
+;; (warnings (- free-vars)) ; Don't warn about free variables
+;; (file-format emacs19))"
+;; nil)
+
+;;; byte-run.el ends here
+++ /dev/null
-
-This directory contains Calc, an advanced desk calculator for GNU
-Emacs.
-
-"Calc" Copyright 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-Written by:
- Dave Gillespie
- c/o Synaptics, Inc.
- 2698 Orchard Parkway
- San Jose CA 95134
- daveg@synaptics.com, uunet!synaptx!daveg
-
-Currently maintained by:
- D. Goel <deego@gnufans.org> and Colin Walters <walters@debian.org>
-
-From the introduction to the manual:
-
- "Calc" is an advanced calculator and mathematical tool that runs as
- part of the GNU Emacs environment. Very roughly based on the HP-28/48
- series of calculators, its many features include:
-
- * Choice of algebraic or RPN (stack-based) entry of calculations.
-
- * Arbitrary precision integers and floating-point numbers.
-
- * Arithmetic on rational numbers, complex numbers (rectangular and
- polar), error forms with standard deviations, open and closed
- intervals, vectors and matrices, dates and times, infinities,
- sets, quantities with units, and algebraic formulas.
-
- * Mathematical operations such as logarithms and trigonometric functions.
-
- * Programmer's features (bitwise operations, non-decimal numbers).
-
- * Financial functions such as future value and internal rate of return.
-
- * Number theoretical features such as prime factorization and
- arithmetic modulo M for any M.
-
- * Algebraic manipulation features, including symbolic calculus.
-
- * Moving data to and from regular editing buffers.
-
- * "Embedded mode" for manipulating Calc formulas and data directly
- inside any editing buffer.
-
- * Graphics using GNUPLOT, a versatile (and free) plotting program.
-
- * Easy programming using keyboard macros, algebraic formulas,
- algebraic rewrite rules, or extended Emacs Lisp.
-
-
-Calc is written entirely in Emacs Lisp, for maximum portability.
-You do not need to recompile Emacs to install and use Calc.
-
-You will need about six megabytes of disk space to install Calc
-and its Info documentation.
-
-See the file INSTALL for installation instructions. The instructions
-may seem long, but on typical systems you will only need to follow the
-steps shown in the first section.
-
-Don't even try to run Calc in uncompiled (.el) form! It's far too slow.
-
-
-I am anxious to hear about your experiences using Calc. Send mail to
-"daveg@synaptics.com". A bug report is most useful if you include the
-exact input and output that occurred, any modes in effect (such as the
-current precision), and so on. If you find Calc is difficult to operate
-in any way, or if you have other suggestions, don't hesitate to let me
-know. If you find errors (including simple typos) in the manual, let
-me know. Even if you find no bugs at all I would love to hear your
-opinions.
-
-The latest Calc tar files and patches are always available for anonymous
-FTP on prep.ai.mit.edu.
-
-Thanks,
-
- -- Dave
-
-
-
-
-
-Summary of changes to "Calc"
-------- -- ------- -- ----
-
-
-Version 2.02f:
-
- * Fixed a bug which broke `I', `H', `K' prefix keys in recent Emacs.
-
- * Fixed a bug in calc.texinfo which prevented "make tex2" from working.
-
- * Updated `C-y' (calc-yank) to understand Emacs 19 generalized kill ring.
-
- * Added a copy of "calccard.tex", the Calc quick reference card.
-
-\f
-Version 2.02e:
-
- * Fixed an installation bug caused by recent changes to `write-region'.
-
-\f
-Version 2.02d:
-
- * Fixed a minor installation problem with a Emacs 19.29 byte-compiler bug.
-
- * Removed archaic "macedit" package (superseded by "edmacro").
-
-\f
-Version 2.02c:
-
- * Patch to port Calc to Lucid Emacs 19; still works with GNU 18 and GNU 19.
-
- * Fixed a bug that broke `C-x C-c' after Calc graphics had been used.
-
-\f
-Version 2.02b:
-
- * Minor patch to port Calc to GNU Emacs 19. Will be superseded by Calc 3.00.
-
-\f
-Version 2.02:
-
- * Revamped the manual a bit; rearranged some sections.
-
- * Added marginal notes for Key/Function Index refs in printed manual.
-
- * Changed `M-# r' to deal more gracefully with blank lines.
-
- * Made reductions like `V R +' and `M-# :' considerably faster.
-
- * Improved parsing and display of cases like "[a + b]".
-
- * Added `t +' and `t -' for doing business date arithmetic.
-
- * Added "syntax tables," the opposite of compositions.
-
- * Added another Rewrites Tutorial exercise.
-
- * Added the "vmatches" function.
-
- * Added the `Modes' variable and `m g' command.
-
- * Improved `u s' to cancel, e.g., "11 mph hr / yd" to get a number.
-
- * Added "quick units" commands "u 0" through "u 9".
-
- * Moved `M-%' to calc.el to avoid autoloading problems.
-
- * Added `M-=' during algebraic entry, acts like `RET ='.
-
- * Made `LFD' prevent evaluation when finishing a calc-edit command.
-
- * Changed calc-store commands to use `t .' mode for trail display.
-
- * Improved integrator to understand forms involving "erf".
-
- * Fixed parser to make sense of "[1....1e2]" input.
-
- * Fixed FORTRAN parser to treat a(i,j) as a_i_j if a is declared matrix.
-
- * Got rid of some version number stamps to reduce size of patches.
-
- * Fixed a bug in defmath treating "<=" and ">=" predicates.
-
- * Fixed a bug in which Calc crashed multiplying two date forms.
-
- * Fixed a bug in line breaker that crashed for large, nested formulas.
-
- * Fixed a bug using ` to edit string("foo").
-
- * Fixed a bug where `M-# y' in Big mode copied stack level number.
-
- * Fixed a bug where `g O' used wrong default directory, no completion.
-
- * Fixed a bug where "foo_bar(i)" parsed in C mode but showed as foo#bar.
-
- * Fixed several bugs where large calculations got "computation too long."
-
-\f
-Version 2.01:
-
- * Added percentage commands `M-%', `b %', and `c %'.
-
- * Changed Big mode to force radix-10 in superscripts.
-
- * Improved display of fractions in various language modes.
-
- * Changed `a n' to work properly with equations and inequalities.
-
- * The problem with cross references to Index nodes in TeX has been fixed.
-
- * Fixed a bug where recursive esc-maps make calc-ext/-aent unloadable.
-
- * Fixed a bug in `M-# k', then `OFF' right away, with fresh Emacs.
-
- * Fixed a bug in which "S_i_j" was formatted wrong after `j s'.
-
- * Fixed a bug in which `h k u c' positioned cursor on wrong line.
-
- * Fixed a bug where `z ?' crashed if `z %' was defined.
-
- * Fixed a bug in `j O' (calc-select-once-maybe).
-
- * Fixed "make private" not to ask "Delete excess versions" and crash.
-
-\f
-Version 2.00:
-
- * First complete posting of Calc since 1.01.
-
- * Most parts of Calc have seen changes since version 1.07. See
- section "New for Calc 2.00" in the manual for a summary. In
- the FTP version of the Calc distribution, the file README.prev
- contains a detailed change history from 1.00 up to 2.00.
-
+++ /dev/null
-
-
-Summary of changes to "Calc" Preceding 2.00
-------- -- ------- -- ---- --------- ----
-
-
-Version 2.00:
-
- * Changed to compile calc-macs/-maint, to allow "cp *.elc new-dir".
-
- * Improved calc-describe-bindings to avoid showing redundant ESC maps.
-
-\f
-Version 2.00 beta 3:
-
- * Removed version numbers from most .el files to reduce size of patches.
-
- * Added a "calc-version" command.
-
- * Changed `M-# ? ?' to allow for modified describe-function.
-
- * Changed date parser to accept "Sept" as an alternative for "Sep".
-
- * Inhibited answers to exercise from showing up in table of contents.
-
- * Changed Makefile to say "texindex calc.[cfkptv]?" to avoid "calc.el".
-
- * Fixed up the Makefile in various other ways.
-
- * Rearranged banner at top of `h h' command's output.
-
- * Changed "make summary" to print "Calc Summary" on the title page.
-
- * Added "IntegSimpRules".
-
- * Added `M-# :', `M-# _', and `M-# Z' options.
-
- * Changed `^' to evaluate "[-3..-1]^-2" properly.
-
- * Improved `f g' to give symbolic answers for, e.g., 101:2 and -3:2.
-
- * Fixed a bug where `h k RET' didn't find the right place on the page.
-
- * Fixed a bug that formatted "x*(y ? a : b)" as "x y ? a : b".
-
- * Fixed a bug where defmath translated (< x 0) as (math-posp x)!
-
- * Fixed a bug that prevented quick-calc from working sometimes.
-
- * Fixed the `z ?' bug again (maybe this time for good?).
-
- * Fixed a bug in which `V ^' (vint) was just plain wrong, wrong, wrong!
-
- * Scanned for and fixed remaining bugs relating to autoloading.
-
-\f
-Version 2.00 beta 2:
-
- * Changed "make info" to try "make texinfo" if "makeinfo" not found.
-
- * Changed to "New for Calc 2.00"; texinfo.tex chokes on apostrophes.
-
- * Added List Tutorial Exercise 14 (just in case there weren't enough!).
-
- * Added a discussion of the `Z F' command to the Programming Tutorial.
-
- * Improved `H a f' not to lose info if input is partially pre-factored.
-
- * Improved simplification of expressions like sqrt(3) + 3^3:2.
-
- * Changed Big mode to omit "*" in expressions like 2 sqrt(3) 5^3:4.
-
- * Replaced European date format D/M/Y with D.M.Y.
-
- * Changed `a N' and `a X' to consider the endpoints of the interval.
-
- * Fixed a bug where TeX mode made c*(1+a/b) look like a function call.
-
- * Fixed a bug formatting top-level evalto's while using selections.
-
- * Fixed a bug that caused `z ?' to crash.
-
- * Fixed a bug where `Z F' broke for argument names "t" and "nil".
-
- * Fixed several bugs relating to autoloading.
-
-\f
-Version 2.00 beta 1:
-
- * Added "What's new in Calc 2.00" to the manual (summary of info below).
-
- * Added support for many GNUPLOT 3.0 features.
-
- * Tweaked the Makefile and calc-compile a bit more.
-
- * Modified to work with Zawinski's/Furuseth's optimizing byte compiler.
-
- * Modified Calc to garbage-collect less often (raised gc-cons-threshold).
-
- * Changed quick-calc to avoid autoloading so many parts of Calc.
-
- * Changed Calc subfiles to work properly if not byte-compiled.
-
- * Renamed `M-# s' to `M-# j', made `M-# s' be equivalent to `h s'.
-
- * Changed calc-quit to avoid reapportioning space among other windows.
-
- * Added `M-DEL' (calc-pop-above) key, to DEL as LFD is to RET.
-
- * Added `{' and `}' to scroll vertically, analogous to `<' and `>'.
-
- * Added `m t' for "total" algebraic mode.
-
- * Added `d , \' option to group digits with "\,".
-
- * Improved support of "prime" accent in "eqn" language mode.
-
- * Changed macedit's read-kbd-macro to accept a string argument in Lisp.
-
- * Changed calc-check-defines to use a more concise run-hooks linkage.
-
- * Changed auto-why mode not to say [w=more] if next msg is not urgent.
-
- * Made `a d' able to differentiate "a?b:c" and "a_i" formulas.
-
- * Changed probability dist. functions to work with `a f' and `a d'.
-
- * Added special constants "phi" and "gamma".
-
- * Added "poly" function, simpler cousin of "gpoly".
-
- * Added "pdeg", "plead", "pcont", "pprim"; cleaned up "pdiv" and "pgcd".
-
- * Added `a p' command for polynomial interpolation.
-
- * Added `a I' command for numerical integration; made IntegLimit variable.
-
- * Added `a f' to factor polynomials; moved old `a f' to `a "'.
-
- * Added `a a' to do partial fraction decompositions.
-
- * Improved `a i' to integrate many more kinds of formulas.
-
- * Modified `a P' to find numerical roots of high-degree polynomials.
-
- * Modified `c 0' through `c 9' to convert int-valued floats to integers.
-
- * Made sinh, arctanh, etc., expandable into exps/logs by `a f'.
-
- * Added more algebraic simplifications having to do with logs and exps.
-
- * Changed `s s', `s t', `s x', `s l' to accept an equation at prompt.
-
- * Changed `s i' not to store Decls if its value is the default, [].
-
- * Changed `s i' to store in `d O' language mode if in Normal or Big mode.
-
- * Rearranged `V M'/`V R' matrix mapping modes.
-
- * Added <#1+#2> notation for lambda expressions.
-
- * Extended `b l' and other binary shifts to have a 2-argument version.
-
- * Changed `u c' and `u t' to give unitless result for unitless input.
-
- * Changed sqrt(1-cos(x)^2)-to-sin(x) to be an unsafe simplification.
-
- * Improved simplification of sqrts, e.g., sqrt(a^2 x + a^2 y).
-
- * Changed solver to treat (x-a)(x-b)(x-c) more intelligently.
-
- * Changed Pascal language mode to use "$FFFF" for hexadecimal numbers.
-
- * Added support for non-decimal display of floats.
-
- * Changed `p' to refresh stack display if current float format uses it.
-
- * Changed Big mode to use subscript notation for log10(x), log(x,b), r#nnn.
-
- * Changed Big mode to format deriv(u,x) and tderiv(u,x) as du/dx.
-
- * Changed Big mode to format integ(1/x,x) as "dx/x" instead of "1/x dx".
-
- * Added "tty" output type for graphics commands.
-
- * Documented Calc's random number generation algorithm in the manual.
-
- * Fixed a bug involving having "(setq calc-timing t)" in .emacs.
-
- * Fixed a bug that incorrectly parsed "|x| - 1" in TeX mode.
-
- * Fixed bugs and made improvements in `a R' when widening the guess.
-
- * Fixed a bug that where `a S' didn't solve (x - a)^2 = (x - b)^2.
-
- * Fixed a bug that sometimes crashed `a P' on systems of equations.
-
- * Fixed a bug that prevented `b p' (calc-pack-bits) from working.
-
- * Fixed some bugs in which certain functions didn't get autoloaded.
-
- * Fixed a bug in which the date <1/1/13> was incorrectly parsed.
-
- * Fixed a bug which prevented `j D' from expanding (a+b)/c.
-
- * Fixed a bug in solver: bad inverses for sinh and cosh.
-
- * Fixed a bug in math-possible-signs that failed for x*0.
-
- * Fixed a bug where sqrt(-a) was rewritten sqrt(a)*i even if a<0.
-
- * Fixed a bug in line breaker when first "word" of line was too long.
-
- * Worked around a makeinfo bug that handled @end group/@group badly.
-
-\f
-Version 2.00 alpha 3:
-
- * Changed logic for locating component .elc files to be even smarter.
-
- * Changed "make install" to "make compile"; added different "make install".
-
- * Improved "make compile" to check file dates and compile only when needed.
-
- * Made output of "make compile" in batch mode more compact and readable.
-
- * Replaced "Quick Overview" in manual with "Demonstration of Calc".
-
- * Changed to use keymaps for dispatching M-# and h prefix keys.
-
- * Added TAGS target to the Calc Makefile.
-
- * Removed most doc strings from functions; new help commands are better.
-
- * Got rid of some crufty "fset" calls that were cluttering the code.
-
- * Split calc-grab-region into two functions, calc-grab-region/-rectangle.
-
- * Swapped positions of stack and trail in full-calc-keypad display.
-
- * Improved line-breaking algorithm for displaying long formulas.
-
- * Improved display of control characters in vectors shown as strings.
-
- * Changed `d o' to allow fraction format to specify desired denominator.
-
- * Changed `M-# y' to respect overwrite mode in target buffer.
-
- * Added `H' prefix to display-mode commands to suppress stack refresh.
-
- * Changed "calc-why" mechanism to display urgent messages automatically.
-
- * Handled taking derivatives of symbolic integrals and vice-versa.
-
- * Handled integrating vectors of formulas.
-
- * Incorporated Ewerlid's polynomial division and GCD functions into Calc.
-
- * Improved algebraic operations on "mod" forms, esp. polynomials.
-
- * Added some more financial functions (sln, syd, ddb).
-
- * Added nest, anest, fixp, and afixp (`H V R' and `H V U') functions.
-
- * Added `a .' (calc-remove-equal) command to take apart equations.
-
- * Generalized dfact to work for negative odd integers; added !! syntax.
-
- * Changed `k f' to factor 1, 0, and negative integers.
-
- * Changed `u M', etc., to accept +/- and [ .. ] forms as distributions.
-
- * Changed `g q' to remove *Gnuplot Commands/Trail* window if present.
-
- * Added support for Francois Pinard's "dumb terminal" driver for GNUPLOT.
-
- * Added ":: remember" feature for rewrite rules.
-
- * Changed rewrites to let pattern "a*b" match "x/2" with a=x, b=1/2.
-
- * Added ability to put function names like "simplify" in rewrite schedule.
-
- * Added "Rewrites Tutorial" to the manual.
-
- * Changed ` to bind RET as newline instead of finish if editing a vector.
-
- * Added some new exercises to the List Tutorial.
-
- * Changed `Z F', `V M', etc. not to remove stored vars from def arg list.
-
- * Added parsing for /1, 2, 3/ notation for Fortran mode vectors.
-
- * Added a "%%" syntax for comments in formulas being read.
-
- * Fixed a bug in which failing `h k' removed an existing Info window.
-
- * Fixed a bug in `j /' operating on subformulas like "a + b".
-
- * Fixed a bug in which "inf = inf" undesirably evaluated to 1.
-
- * Fixed a bug that simplified "0 = 1 + a + 2" to "0 = a".
-
- * Fixed a bug that failed for rewrite patterns like "fib(1 ||| 2)".
-
- * Fixed a bug that arose because rewrite programs are non-reentrant.
-
-\f
-Version 2.00 alpha 2:
-
- * Changed LFD terminating algebraic entry to push in no-simplify mode.
-
- * Changed so that `K -' interprets `-' as calc-minus, not neg prefix arg.
-
- * Improved `h c' command to understand all Calc key sequences.
-
- * Fixed problems with DistribRules, NegateRules, and FitRules.
-
- * Fixed several bad node pointers in the manual.
-
- * Fixed a bug in `h C-w' when used with makeinfo-formatted manuals.
-
- * Fixed a bug in sqrt(-1) when Polar and HMS modes are enabled.
-
- * Fixed/improved dscalar and deven functions; added dodd.
-
- * Fixed a bug in polynomial handling that also affected sum(sin(k),k,1,n).
-
- * Fixed various other glitches in the manual.
-
-\f
-Version 2.00 alpha 1:
-
- * Calc's tar file now creates a calc-(version) directory to unpack into.
-
- * Calc now comes with a Makefile; install with "make install".
-
- * Calc now comes already split into many files; installation is much simpler.
-
- * Changed base file name of the manual from "calc-info" to "calc.info".
-
- * Key binding for `M-# w' was documented but not implemented.
-
- * Bound M-# ' to be synonymous with `M-# f' (used to be `M-# q').
-
- * Changed M-# M-# to use last interface of C or K; E no longer counts.
-
- * Changed `i' (and `M-# i') not to return to Top node unnecessarily.
-
- * Changed `h' to be a prefix key with various help commands.
-
- * Changed `s' to be a prefix key with various store and recall commands.
-
- * Keys `i', `r', and `l' are obsolete (moved to `h' and `s' prefixes).
-
- * Rearranged `K', `X', and `M-RET' keys; `K' is now calc-keep-args.
-
- * Changed quick-calc to display input formula as well as output if room.
-
- * Changed quick-calc to interact with the editing buffer and kill ring.
-
- * Created pack, unpack, unpackt function equivalents of `v p', `v u'.
-
- * Changed to expand (a/b)^x to a^x/b^x only if b > 0 (not if a > 0).
-
- * Changed math-possible-signs to understand sqrt function.
-
- * Changed Z [, rewrites to consider any provably non-zero value as true.
-
- * Changed normal language modes to accept ** as a synonym for ^.
-
- * Added "maple" language mode.
-
- * Changed, e.g., Mathematica "(2 + 3 I)^(1.23*10^20)" to include parens.
-
- * Generalized math-compose-big properties for all language modes.
-
- * Introduced "string" and other function for composing expressions.
-
- * Changed many recursive vector routines to use loops instead.
-
- * Added evalv, evalvn function equivalents to `=', `N'.
-
- * Changed "expr =>" not to evaluate at all if in no-simplify mode.
-
- * Redesigned user interface of `a F' (calc-curve-fit) command.
-
- * Added "phase" feature to the rewrite rule system.
-
- * Added "&&&", "|||", "!!!" to the rewrite rule system.
-
- * Introduced a new notation for rewrites: LHS := RHS :: COND.
-
- * Changed `a r' (but not `j r') to repeat 100 times by default.
-
- * Integrated EvalRules more cleanly into the default simplifications.
-
- * Added `H v l' [mdims] to measure the dimensions of a matrix.
-
- * Changed `u c' to interpret "/units" as "1/units".
-
- * Added `u a' to adjust unit prefix letters automatically.
-
- * Changed `u s' to enable scalar mode while simplifying.
-
- * Changed `c f' [pfloat] not to float integer powers or subscripts.
-
- * Added a three-argument form for the "hms" function.
-
- * Changed, e.g., sin(90) degrees to produce 1 instead of 1.0.
-
- * Changed symbolic mode to prefer sqrt(int): abs([1 2 3]) => sqrt(14).
-
- * Enhanced solver to handle, e.g., x + 1/x = a; exp(x) + exp(-x) = a.
-
- * Enhanced simplifier to handle, e.g., exp(a+2) / e^a => e^2.
-
- * Enhanced `a s' to simplify sqrt(x) - x^1:2 and exp(x) - e^x to 0.
-
- * Added -(a + b) to -a - b as a default simplification.
-
- * Added rules for differentiating sum() and prod() functions.
-
- * Added a few more energy units (due to Przemek Klosowski).
-
- * Added overflow/underflow checking for all floating-point arithmetic.
-
- * Extended error forms to work with complex numbers.
-
- * Generalized GCD to handle fractional arguments.
-
- * Changed graphics routines to evaluate "x" values, e.g., [-pi .. pi].
-
- * Added `g q', like `g K' but without viewing the Gnuplot Trail.
-
- * Changed `g p' and `V M' to display better "Working..." messages.
-
- * Modified `M-# g' to be more robust about grabbing formulas.
-
- * Added `Y' prefix key reserved for user-written extensions.
-
- * Added calc-load-hook and calc-ext-load-hook.
-
- * Prevented calc-install from leaving large ~ files behind.
-
- * Changed @bullet to @bullet{} in manual to conform to texinfo spec.
-
- * Rearranged some chapters in the manual to be a bit more logical.
-
- * Added calc-split-summary command.
-
- * Fixed several bugs in embedded mode.
-
- * Fixed a bug in calc-vector-covariance that required a prefix arg.
-
- * Fixed a bug that prevented parsing "a=>" with no right-hand side.
-
- * Fixed a bug which allowed incorrectly dividing a vector by a vector.
-
- * Fixed a bug formatting sum(...)^2 in Big mode.
-
- * Fixed a bug that prevented Calc from deleting old graphics temp files.
-
- * Fixed some typos calling calc-inverse-func instead of calc-invert-func.
-
- * Fixed bugs in the derivatives of conj, deg, and rad; added re, im.
-
- * Fixed a bug where (r;theta) parsed as r exp(theta i) even in Deg mode.
-
- * Fixed a bug which gave wrong answer for exp of a polar complex number.
-
- * Fixed a bug in `Z F' that failed if formula used non-arg variables.
-
- * Fixed a bad pointer to Info node "Assignments in Embedded Mode".
-
- * Fixed several errors in the Calc Summary.
-
-\f
-Version 1.08 beta 1:
-
- * Calc's copyright has been assigned to FSF, for inclusion in Emacs 19!
-
- * Changed M-# to be a two-key sequence; use M-# M-# to start Calc now.
-
- * Rewrote and expanded the introductory chapter of the manual.
-
- * Added a key and function summary to the manual.
-
- * Changed the manual to take better advantage of TeX's math formatting.
-
- * Changed manual to be printable in @smallbook format.
-
- * Added "calc-embedded" mode.
-
- * Added "=>" [evalto] operator.
-
- * Added facilities for date and date/time arithmetic.
-
- * Added a set of financial functions (pv, fv, etc.).
-
- * Added infinite quantities inf, uinf, and nan (plus infinite intervals).
-
- * Added "EvalRules", "SimpRules", and "ExtSimpRules" variables.
-
- * Added sum and product commands `a +', `a -', `a *', `a T'.
-
- * Enhanced `a S' and `a P' to solve systems of equations.
-
- * Enhanced solver to handle eqns like sin(x) = cos(2 x), sqrt(x) + x = 1.
-
- * Added `a M' (calc-map-equation) command.
-
- * Added new statistical functions: mean, standard deviation, etc.
-
- * Added line, polynomial, and curve fitting commands (`a L' and `a F').
-
- * Added support for composite units, e.g., "mi+ft+in".
-
- * Enhanced "Big" mode to format square roots, choose, and powers better.
-
- * Enhanced "Big" mode to display fractions in large notation.
-
- * Added several alternate formats for matrix display.
-
- * Changed TeX mode to write "(1 + x^2)" instead of "\left(1 + x^2\right)".
-
- * Added support for relational operators in TeX and FORTRAN modes.
-
- * Added recognition of accents like \dot, \tilde, \underline in TeX mode.
-
- * Added "eqn" language mode.
-
- * Added extra control over display justification with `d <', `d =', `d >'.
-
- * Added calc-left-label and calc-right-label (`d {', `d }').
-
- * Added "nn%" syntax for algebraic formulas; equivalent to "nn * .01".
-
- * Added input syntaxes like a = b = c, a != b != c, a <= b < c.
-
- * Changed "_" to mean subscripts; old use of "_" in vars is now "#".
-
- * Introduced "matrix mode" and "scalar mode" (`m v').
-
- * Introduced generic identity matrices (idn(1)).
-
- * Added a method for declaring variables to be real, integer, > 0, etc.
-
- * Added `Z S' command for editing stored value of a variable.
-
- * Added "subst" algebraic function equivalent to the `a b' command.
-
- * Added `a f' command, changed deriv/integ/solve-for to use it.
-
- * Improved `a s' to simplify (x + y) (y + x) to (x + y)^2.
-
- * Improved `a s' to simplify i^2 to -1.
-
- * Improved `a s' to simplify, e.g., sin(pi/3) in Symbolic mode.
-
- * Improved `a s' to simplify sqrt(8) to 2 sqrt(2), 1/sqrt(2) to sqrt(2)/2.
-
- * Moved sin(arccos(x)) from `a e' to `a s'; not unsafe after all!
-
- * Changed (x y)^z => x^z y^z to be a usually-unsafe simplification.
-
- * Added thorough documentation of `a s' and `a e' to the manual.
-
- * Improved `a c' to collect "f(a)" even if "a" also appears elsewhere.
-
- * Introduced lin, linnt, islin, islinnt functions for linearity testing.
-
- * Improved `a x' to use binomial theorem to give simpler answers.
-
- * Improved `j D' to distribute powers of sums: (a + b)^n.
-
- * Improved `j M' to merge products of powers (may need no-simplify mode).
-
- * Changed to use defvar for DistribRules etc. so `Z V' works with them.
-
- * Improved `j *' and `j /' to work properly in a few more cases.
-
- * Improved `V R' to use identity value when reducing empty vectors.
-
- * Improved `v p' and `v u' to support more complex packing operations.
-
- * Disabled automatic simplification of sqrt(2)/2 to 1/sqrt(2).
-
- * Bound SPC and RET to press, TAB to next-menu in *Calc Keypad* buffer.
-
- * Added C-u ' to do algebraic entry with language mode forced to normal.
-
- * Added "$1", "$2", etc. input notation for algebraic entry.
-
- * Changed unary operators like `n', `&' to treat neg prefix args like RET.
-
- * Changed ` (calc-edit) to show full precision regardless of float format.
-
- * Enhanced quick-calc to display integers in several formats.
-
- * Documented `g H' (calc-graph-hide) command (had been left from manual).
-
- * Enhanced floor/ceil/trunc/round in several ways.
-
- * Added rounde and roundu functions.
-
- * Changed `c 1' through `c 9' to change small floats to 0.0; added `c 0'.
-
- * Enhanced set operations to work on sets of intervals.
-
- * Fixed erf(0), utpn(x,x,y), and arccosh(-1) to work properly.
-
- * Changed complex arctan and arctanh to follow Steele 2nd edition.
-
- * Expanded "Branch Cuts" section of the manual with some useful tables.
-
- * Rearranged order of words in mode line to be a bit more logical.
-
- * Changed `m N' (num-simplify) mode to evaluate constant vectors, too.
-
- * Changed `a r'/`j r' to prompt twice for separate LHS/RHS if necessary.
-
- * Enhanced `let(v,x)' in rewrites by allowing arbitrary patterns for v.
-
- * Changed cursor positioning in second prompt for `a b' (calc-substitute).
-
- * Changed `y' to omit line numbers more consistently.
-
- * Changed `o' (calc-realign) to reset horizontal scrolling to zero, also.
-
- * Added "pred" mode for calc-eval.
-
- * Added "calc-report-bug" as an alias for "report-calc-bug".
-
- * Added `Z T' and "calc-pass-errors" to aid debugging Calc-related code.
-
- * Added "calc-load-everything" (`m X' or `M-# L') command.
-
- * Enhanced calc-install to pre-build units table, CommuteRules, etc.
-
- * Changed Calc to interact more gracefully with load-path.
-
- * Changed Lisp Variable Index in manual to include user variables, too.
-
- * Fixed a bug that prevented calc-install from working under VMS.
-
- * Fixed a bug that sometimes crashed rewrites dealing with subtractions.
-
- * Fixed a bug that prevented `a S' from solving "3 - x = 1 + x"!
-
- * Fixed a bug in solver that crashed for certain cubics and quartics.
-
- * Fixed a bug in calc-simplify that crashed for equations and ineqs.
-
- * Fixed a bug which placed the "[" oddly in `d B' + `v /' mode.
-
- * Fixed a bug where finishing calc-edit improperly obeyed language mode.
-
- * Fixed a bug formatting (-1)^n in Big mode after selection commands.
-
- * Fixed a bug that got ">=" and "<=" backwards in rewrite conditions.
-
- * Fixed a bug that broke the `"x"' key in calc-keypad mode.
-
- * Fixed a bug in which `MAP$' in calc-keypad didn't display "Working...".
-
- * Fixed a bug where matrix division gave bad result for singular matrix.
-
- * Fixed a bug which closed Calc window if calc-grab-region got an error.
-
- * Fixed a bug where `a s' failed on formulas containing dimension errors.
-
- * Fixed a bug that caused `m F' to hang.
-
- * Fixed a bug in complex arithmetic that caused problems with solver.
-
- * Fixed a bug which raised intervals to interval powers incorrectly.
-
- * Fixed a bug in utpp/ltpp (order of arguments did not match the manual).
-
- * Fixed a bug in which `t y' rounded yanked data with old precision.
-
- * Fixed a bug in which "in(3, [3 .. 3))" returned true.
-
- * Fixed a bug which simplified abs(abs(x)) incorrectly.
-
- * Fixed a bug in which (a^2)^1:3 was unsafely simplified to a^2:3.
-
- * Fixed a bug in rewrite system which missed pattern "2 sin(x) cos(x)".
-
- * Fixed a bug in rewrite system which missed pattern "a - a cos(x)^2".
-
- * Fixed obsolete trail tags gsmp, gneg, ginv to jsmp, jneg, jinv.
-
- * Fixed some errors and made improvements in units table [Ulrich Mueller].
-
-\f
-Version 1.07:
-
- * Added `m F' (calc-settings-file-name) command.
-
- * Added calc-autoload-directory variable.
-
- * Extended Z ` to accept a prefix argument.
-
- * Added keystrokes (v h, v k) for head, tail, cons.
-
- * Extended `v e' to accept a vector as the filler.
-
- * Changed `V M', `V R' to accept mapping-mode keys in uppercase, too.
-
- * Changed V M ' etc. to accept $, $$, ... as argument indicators.
-
- * Changed `t y' to accept a prefix argument.
-
- * Put in a cleaner and safer random number generator for `k r' et al.
-
- * Fixed a bug which completely broke `a r' command!
-
- * Fixed "0 * matrix" to generate a zero matrix instead of 0.
-
- * Fixed a bug in `a R' which sometimes caused it to crash.
-
- * Fixed a fatal typo in the TeX version of the manual.
-
- * Fixed a bug that prevented C-k, C-w, M-w from working in Trail buffer.
-
- * Fixed another bug in `Z P' command.
-
- * Fixed a bug in `u s' which incorrectly simplified subtractions.
-
- * Fixed an argument-name aliasing bug evaluating lambda( ) formulas.
-
- * Fixed overfull hboxes in the manual.
-
- * Fixed various other bugs in the manual.
-
-\f
-Version 1.06:
-
- * Added "calc-keypad" mode for X window system users (try it!).
-
- * Improved "calc-eval" for calling/operating Calc from user-written Lisp.
-
- * Moved vector accumulate command to `V U' (old `H V R' still supported).
-
- * Added right-to-left reductions: `I V R' and `I V U'.
-
- * Added set operations on vectors: intersect, union, diff, xor.
-
- * Added `I v s' to remove a subvector from a vector.
-
- * Introduced `H |' to append two vectors with no magical special cases.
-
- * Introduced rhead, rtail, and rcons for isolating last vector element.
-
- * Changed `g p' to keep temp files around until data actually change.
-
- * Improved `a S' to solve many higher-order polynomial equations.
-
- * Added `a P' to produce a vector of all solutions to an equation.
-
- * Enhanced `a v' and `j v' to allow top-level-only evaluation.
-
- * Changed `j DEL' to delete a side of an eqn or ineq, leaving other side.
-
- * Fixed binding for keys `j 1' through `j 9'.
-
- * Introduced "let" marker in rewrite rules.
-
- * Enhanced the "sign" function to provide a two-argument version.
-
- * Changed "max-specpdl-size exceeded" error message to be user-friendly.
-
- * Put "<Aborted>" in the trail in above case and when user presses C-g.
-
- * Changed TeX mode to generate \ldots instead of \dots, recognize both.
-
- * Changed "sin(0)" etc. (for integer 0) to generate "0" instead of "0.".
-
- * Enhanced Programming Tutorial exercise 2.
-
- * Fixed an error in the answer to Types Tutorial exercise 3.
-
- * Fixed several bugs relating to head, tail, and cons functions.
-
- * Fixed some other minor typos in the manual.
-
- * Fixed several bugs in `Z P' (calc-user-define-permanent).
-
- * Fixed several bugs that broke the `g P' command.
-
-\f
-Version 1.05:
-
- * Created a calc-install command to ease installation.
-
- * Added lots of exercises to the Tutorial section of the manual.
-
- * Added ability to select and operate on sub-formulas.
-
- * Substantially improved the algebraic rewrite-rule system.
-
- * Added a set of graphing commands that use GNUPLOT.
-
- * Added a command (`a R') for finding numerical roots to equations.
-
- * Added several new math functions, such as erf and Bessel functions.
-
- * Added key bindings for miscellaneous commands using the "f" prefix key.
-
- * Added lots of new vector operations, many of them in the spirit of APL.
-
- * Added more control over vector display, including an abbreviated mode.
-
- * Improved keyboard macro editing; added read-kbd-macro to macedit.el.
-
- * Introduced the `m S' (calc-shift-prefix) command.
-
- * Enhanced the calc-edit command in several ways.
-
- * Made it possible to hit ` (calc-edit) during numeric/algebraic entry.
-
- * Enhanced the calc-solve-for command to handle inequalities.
-
- * Enhanced calc-simplify to handle equations and inequalities.
-
- * Taught log10 and log to look for exact integer or rational results.
-
- * Added ability to take Nth roots directly.
-
- * Added "increment" and "decrement" commands for integers and floats.
-
- * Added "full-help" command, changed "h" key to invoke it.
-
- * Added special help for Inverse and Hyperbolic prefixes.
-
- * Added an optional prefix argument to `o' (calc-realign).
-
- * Changed `t s' and `t r' to use RET as the search exit key.
-
- * Made handling of operator keys for V M, V R, etc. more regular.
-
- * Improved TeX mode; added support for \matrix format.
-
- * Added a variant of `m a' mode that only affects ( and [ keys.
-
- * Fixed "Mismatch" message for algebraic entry of semi-open intervals.
-
- * Trimmed fat from calc.el to speed loading, moved more to calc-ext.el.
-
- * Fixed a bug in which minibuffer entry rounded to out-of-date precision.
-
- * Fixed a bug which crashed Calc 1.04 under Epoch.
-
- * Fixed a bug which messed up Calc Trail's mode line, among other things.
-
- * Fixed a bug which caused trail ">" to show only when in Trail buffer.
-
- * Fixed a bug in which "calc" called "calc-grab-region" with too few args.
-
- * Fixed bugs in both implementation and documentation of calc-perm.
-
- * Fixed a bug in which calc-simplify-extended always used radians.
-
- * Fixed a bug where calc-comma failed to override "polar" mode.
-
- * Fixed a bug doing mixed arithmetic on rectangular+polar complex numbers.
-
- * Fixed several bugs in transcendental functions with complex arguments.
-
- * Fixed a bug in which `a s' simplified "x / .5" to ".5 x".
-
- * Fixed numerous other bugs in various parts of Calc.
-
- * Completed the "Hooks" section of the "Internals" chapter of the manual.
-
-\f
-Version 1.04:
-
- * Included a copy of revision history (from README) in calc.el.
-
- * Added the "calc-split" feature to split calc-ext.el into smaller bits.
-
- * Changed calc-unpack to unpack floats and fractions, too.
-
- * Added "mant", "xpon", and "scf" functions for decomposing floats.
-
- * Fixed a bug in the "y" command with positive prefix arguments.
-
- * Rearranged binary shift/rotate command keys to be a bit more convenient.
-
- * Fixed a bug in which simplifying "(0/0) * 2" crashed with a Lisp error.
-
- * Made `H F' [ffloor] and friends faster for very large arguments.
-
- * Made calc-define-del more robust.
-
- * Handled pasting of data into the Calculator using the mouse under X.
-
- * Made overlay-arrow variables buffer-local to avoid interference.
-
- * Fixed a problem in which Calc Trail buffer got stuck after a C-x C-w.
-
-\f
-Version 1.03:
-
- * Changed math-choose to compute n-choose-m faster when m is large.
-
- * Fixed some problems with TeX mode.
-
- * Fixed a bug that prevented `b s' from working without a prefix argument.
-
- * Added "calc-eval" function.
-
- * Improved calc-grab-region.
-
-\f
-Version 1.02:
-
- * Fixed a bug in Tutorial: telephone pole height/distance were switched!
-
- * Fixed a few other things in the manual.
-
- * Added "full-calc" command.
-
- * Added "calc-insert-variables" (`Z I') command.
-
- * Quick Calc now works even if you are already in the minibuffer.
-
- * Fixed a bug in math-mul-bignum-digit which affected math-and, etc.
-
- * Definition of "Hectares" was wrong in units table.
-
- * Fixed a bug in calc-execute-kbd-macro concerning undo and refresh.
-
- * Bound "calc-undo" to `C-x u' as well as `C-_' and `U'.
-\f
-Version 1.01:
-
- * Added a tutorial section to the manual.
-
- * Next and Prev for node Strings in the manual were reversed; fixed.
-
- * Changed "'bignum" in calc-isqrt-bignum-iter to "'bigpos".
-
- * Fixed a bug that prevented "$" from working during algebraic entry.
-
- * Fixed a bug caused by an X (last-X) command following a K (macro) cmd.
-
- * Fixed a bug in which K command incorrectly formatted stack in Big mode.
-
- * Added space between unary operators and non-flat compositions.
- (Otherwise, "-(a/b)" in Big mode blended the minus sign into the rule!)
-
- * Fixed formatting of (-1)^n in Big mode.
-
- * Fixed some problems relating to "not" operator in Pascal language mode.
-
- * Fixed several bugs relating to V M ' and V M $ sequences.
-
- * Fixed matrix-vector multiplication to produce a vector.
-
- * Introduced Z ` ... Z ' commands; renamed old Z ' to Z #.
-
- * Fixed various other bugs.
-
- * Added calc-settings-file variable suggested by C. Witty.
-
-\f
-Version 1.00:
-
- * First official release of Calc.
-
- * If you used the Beta test version (0.01), you will find that this
- version of Calc is over 50% larger than the original release.
- General areas of improvement include much better algebra features;
- operations on units; language modes; simplification modes; interval
- arithmetic; vector mapping and reduction. Other new commands include
- calc-fraction and calc-grab-region. The program has been split into
- two parts for faster loading, and the manual is more complete.
-
+++ /dev/null
-;;; calc-aent.el --- algebraic entry functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc.el.
-(require 'calc)
-
-(require 'calc-macs)
-(eval-when-compile '(require calc-macs))
-
-(defun calc-Need-calc-aent () nil)
-
-
-(defun calc-do-quick-calc ()
- (calc-check-defines)
- (if (eq major-mode 'calc-mode)
- (calc-algebraic-entry t)
- (let (buf shortbuf)
- (save-excursion
- (calc-create-buffer)
- (let* ((calc-command-flags nil)
- (calc-dollar-values calc-quick-prev-results)
- (calc-dollar-used 0)
- (enable-recursive-minibuffers t)
- (calc-language (if (memq calc-language '(nil big))
- 'flat calc-language))
- (entry (calc-do-alg-entry "" "Quick calc: " t))
- (alg-exp (mapcar (function
- (lambda (x)
- (if (and (not calc-extensions-loaded)
- calc-previous-alg-entry
- (string-match
- "\\`[-0-9._+*/^() ]+\\'"
- calc-previous-alg-entry))
- (calc-normalize x)
- (calc-extensions)
- (math-evaluate-expr x))))
- entry)))
- (when (and (= (length alg-exp) 1)
- (eq (car-safe (car alg-exp)) 'calcFunc-assign)
- (= (length (car alg-exp)) 3)
- (eq (car-safe (nth 1 (car alg-exp))) 'var))
- (calc-extensions)
- (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
- (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
- (setq alg-exp (list (nth 2 (car alg-exp)))))
- (setq calc-quick-prev-results alg-exp
- buf (mapconcat (function (lambda (x)
- (math-format-value x 1000)))
- alg-exp
- " ")
- shortbuf buf)
- (if (and (= (length alg-exp) 1)
- (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
- (< (length buf) 20)
- (= calc-number-radix 10))
- (setq buf (concat buf " ("
- (let ((calc-number-radix 16))
- (math-format-value (car alg-exp) 1000))
- ", "
- (let ((calc-number-radix 8))
- (math-format-value (car alg-exp) 1000))
- (if (and (integerp (car alg-exp))
- (> (car alg-exp) 0)
- (< (car alg-exp) 127))
- (format ", \"%c\"" (car alg-exp))
- "")
- ")")))
- (if (and (< (length buf) (frame-width)) (= (length entry) 1)
- calc-extensions-loaded)
- (let ((long (concat (math-format-value (car entry) 1000)
- " => " buf)))
- (if (<= (length long) (- (frame-width) 8))
- (setq buf long))))
- (calc-handle-whys)
- (message "Result: %s" buf)))
- (if (eq last-command-char 10)
- (insert shortbuf)
- (setq kill-ring (cons shortbuf kill-ring))
- (when (> (length kill-ring) kill-ring-max)
- (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
- (setq kill-ring-yank-pointer kill-ring)))))
-
-(defun calc-do-calc-eval (str separator args)
- (calc-check-defines)
- (catch 'calc-error
- (save-excursion
- (calc-create-buffer)
- (cond
- ((and (consp str) (not (symbolp (car str))))
- (let ((calc-language nil)
- (math-expr-opers math-standard-opers)
- (calc-internal-prec 12)
- (calc-word-size 32)
- (calc-symbolic-mode nil)
- (calc-matrix-mode nil)
- (calc-angle-mode 'deg)
- (calc-number-radix 10)
- (calc-leading-zeros nil)
- (calc-group-digits nil)
- (calc-point-char ".")
- (calc-frac-format '(":" nil))
- (calc-prefer-frac nil)
- (calc-hms-format "%s@ %s' %s\"")
- (calc-date-format '((H ":" mm C SS pp " ")
- Www " " Mmm " " D ", " YYYY))
- (calc-float-format '(float 0))
- (calc-full-float-format '(float 0))
- (calc-complex-format nil)
- (calc-matrix-just nil)
- (calc-full-vectors t)
- (calc-break-vectors nil)
- (calc-vector-commas ",")
- (calc-vector-brackets "[]")
- (calc-matrix-brackets '(R O))
- (calc-complex-mode 'cplx)
- (calc-infinite-mode nil)
- (calc-display-strings nil)
- (calc-simplify-mode nil)
- (calc-display-working-message 'lots)
- (strp (cdr str)))
- (while strp
- (set (car strp) (nth 1 strp))
- (setq strp (cdr (cdr strp))))
- (calc-do-calc-eval (car str) separator args)))
- ((eq separator 'eval)
- (eval str))
- ((eq separator 'macro)
- (calc-extensions)
- (let* ((calc-buffer (current-buffer))
- (calc-window (get-buffer-window calc-buffer))
- (save-window (selected-window)))
- (if calc-window
- (unwind-protect
- (progn
- (select-window calc-window)
- (calc-execute-kbd-macro str nil (car args)))
- (and (window-point save-window)
- (select-window save-window)))
- (save-window-excursion
- (select-window (get-largest-window))
- (switch-to-buffer calc-buffer)
- (calc-execute-kbd-macro str nil (car args)))))
- nil)
- ((eq separator 'pop)
- (or (not (integerp str))
- (= str 0)
- (calc-pop (min str (calc-stack-size))))
- (calc-stack-size))
- ((eq separator 'top)
- (and (integerp str)
- (> str 0)
- (<= str (calc-stack-size))
- (math-format-value (calc-top-n str (car args)) 1000)))
- ((eq separator 'rawtop)
- (and (integerp str)
- (> str 0)
- (<= str (calc-stack-size))
- (calc-top-n str (car args))))
- (t
- (let* ((calc-command-flags nil)
- (calc-next-why nil)
- (calc-language (if (memq calc-language '(nil big))
- 'flat calc-language))
- (calc-dollar-values (mapcar
- (function
- (lambda (x)
- (if (stringp x)
- (progn
- (setq x (math-read-exprs x))
- (if (eq (car-safe x)
- 'error)
- (throw 'calc-error
- (calc-eval-error
- (cdr x)))
- (car x)))
- x)))
- args))
- (calc-dollar-used 0)
- (res (if (stringp str)
- (math-read-exprs str)
- (list str)))
- buf)
- (if (eq (car res) 'error)
- (calc-eval-error (cdr res))
- (setq res (mapcar 'calc-normalize res))
- (and (memq 'clear-message calc-command-flags)
- (message ""))
- (cond ((eq separator 'pred)
- (calc-extensions)
- (if (= (length res) 1)
- (math-is-true (car res))
- (calc-eval-error '(0 "Single value expected"))))
- ((eq separator 'raw)
- (if (= (length res) 1)
- (car res)
- (calc-eval-error '(0 "Single value expected"))))
- ((eq separator 'list)
- res)
- ((memq separator '(num rawnum))
- (if (= (length res) 1)
- (if (math-constp (car res))
- (if (eq separator 'num)
- (math-format-value (car res) 1000)
- (car res))
- (calc-eval-error
- (list 0
- (if calc-next-why
- (calc-explain-why (car calc-next-why))
- "Number expected"))))
- (calc-eval-error '(0 "Single value expected"))))
- ((eq separator 'push)
- (calc-push-list res)
- nil)
- (t (while res
- (setq buf (concat buf
- (and buf (or separator ", "))
- (math-format-value (car res) 1000))
- res (cdr res)))
- buf)))))))))
-
-(defun calc-eval-error (msg)
- (if (and (boundp 'calc-eval-error)
- calc-eval-error)
- (if (eq calc-eval-error 'string)
- (nth 1 msg)
- (error "%s" (nth 1 msg)))
- msg))
-
-
-;;;; Reading an expression in algebraic form.
-
-(defun calc-auto-algebraic-entry (&optional prefix)
- (interactive "P")
- (calc-algebraic-entry prefix t))
-
-(defun calc-algebraic-entry (&optional prefix auto)
- (interactive "P")
- (calc-wrapper
- (let ((calc-language (if prefix nil calc-language))
- (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
- (calc-alg-entry (and auto (char-to-string last-command-char))))))
-
-(defun calc-alg-entry (&optional initial prompt)
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
- (nthcdr calc-stack-top calc-stack)))
- (calc-dollar-used 0)
- (calc-plain-entry t)
- (alg-exp (calc-do-alg-entry initial prompt t)))
- (if (stringp alg-exp)
- (progn
- (calc-extensions)
- (calc-alg-edit alg-exp))
- (let* ((calc-simplify-mode (if (eq last-command-char ?\C-j)
- 'none
- calc-simplify-mode))
- (nvals (mapcar 'calc-normalize alg-exp)))
- (while alg-exp
- (calc-record (if calc-extensions-loaded (car alg-exp) (car nvals))
- "alg'")
- (calc-pop-push-record-list calc-dollar-used
- (and (not (equal (car alg-exp)
- (car nvals)))
- calc-extensions-loaded
- "")
- (list (car nvals)))
- (setq alg-exp (cdr alg-exp)
- nvals (cdr nvals)
- calc-dollar-used 0)))
- (calc-handle-whys))))
-
-(defun calc-do-alg-entry (&optional initial prompt no-normalize)
- (let* ((calc-buffer (current-buffer))
- (blink-paren-function 'calcAlg-blink-matching-open)
- (alg-exp 'error))
- (unless (boundp 'calc-alg-ent-map)
- (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
- (define-key calc-alg-ent-map "'" 'calcAlg-previous)
- (define-key calc-alg-ent-map "`" 'calcAlg-edit)
- (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
- (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
- (or calc-emacs-type-19
- (let ((i 33))
- (setq calc-alg-ent-esc-map (copy-sequence esc-map))
- (while (< i 127)
- (aset calc-alg-ent-esc-map i 'calcAlg-escape)
- (setq i (1+ i))))))
- (unless calc-emacs-type-19
- (define-key calc-alg-ent-map "\e" nil))
- (if (eq calc-algebraic-mode 'total)
- (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
- (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus)
- (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
- (define-key calc-alg-ent-map "\e=" 'calcAlg-equals)
- (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals)
- (define-key calc-alg-ent-map "\e%" 'self-insert-command))
- (setq calc-aborted-prefix nil)
- (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
- (or initial "")
- calc-alg-ent-map nil)))
- (when (eq alg-exp 'error)
- (when (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
- (setq alg-exp nil)))
- (setq calc-aborted-prefix "alg'")
- (or no-normalize
- (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
- alg-exp)))
-
-(defun calcAlg-plus-minus ()
- (interactive)
- (if (calc-minibuffer-contains ".* \\'")
- (insert "+/- ")
- (insert " +/- ")))
-
-(defun calcAlg-mod ()
- (interactive)
- (if (not (calc-minibuffer-contains ".* \\'"))
- (insert " "))
- (if (calc-minibuffer-contains ".* mod +\\'")
- (if calc-previous-modulo
- (insert (math-format-flat-expr calc-previous-modulo 0))
- (beep))
- (insert "mod ")))
-
-(defun calcAlg-previous ()
- (interactive)
- (if (calc-minibuffer-contains "\\`\\'")
- (if calc-previous-alg-entry
- (insert calc-previous-alg-entry)
- (beep))
- (insert "'")))
-
-(defun calcAlg-equals ()
- (interactive)
- (unwind-protect
- (calcAlg-enter)
- (if (consp alg-exp)
- (progn (setq prefix-arg (length alg-exp))
- (calc-unread-command ?=)))))
-
-(defun calcAlg-escape ()
- (interactive)
- (calc-unread-command)
- (save-excursion
- (calc-select-buffer)
- (use-local-map calc-mode-map))
- (calcAlg-enter))
-
-(defvar calc-plain-entry nil)
-(defun calcAlg-edit ()
- (interactive)
- (if (or (not calc-plain-entry)
- (calc-minibuffer-contains
- "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
- (insert "`")
- (setq alg-exp (minibuffer-contents))
- (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
- (exit-minibuffer)))
-
-(defun calcAlg-enter ()
- (interactive)
- (let* ((str (minibuffer-contents))
- (exp (and (> (length str) 0)
- (save-excursion
- (set-buffer calc-buffer)
- (math-read-exprs str)))))
- (if (eq (car-safe exp) 'error)
- (progn
- (goto-char (minibuffer-prompt-end))
- (forward-char (nth 1 exp))
- (beep)
- (calc-temp-minibuffer-message
- (concat " [" (or (nth 2 exp) "Error") "]"))
- (calc-clear-unread-commands))
- (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
- '((incomplete vec))
- exp))
- (and (> (length str) 0) (setq calc-previous-alg-entry str))
- (exit-minibuffer))))
-
-(defun calcAlg-blink-matching-open ()
- (let ((oldpos (point))
- (blinkpos nil))
- (save-excursion
- (condition-case ()
- (setq blinkpos (scan-sexps oldpos -1))
- (error nil)))
- (if (and blinkpos
- (> oldpos (1+ (point-min)))
- (or (and (= (char-after (1- oldpos)) ?\))
- (= (char-after blinkpos) ?\[))
- (and (= (char-after (1- oldpos)) ?\])
- (= (char-after blinkpos) ?\()))
- (save-excursion
- (goto-char blinkpos)
- (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
- (let ((saved (aref (syntax-table) (char-after blinkpos))))
- (unwind-protect
- (progn
- (aset (syntax-table) (char-after blinkpos)
- (+ (logand saved 255)
- (lsh (char-after (1- oldpos)) 8)))
- (blink-matching-open))
- (aset (syntax-table) (char-after blinkpos) saved)))
- (blink-matching-open))))
-
-
-(defun calc-alg-digit-entry ()
- (calc-alg-entry
- (cond ((eq last-command-char ?e)
- (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
- ((eq last-command-char ?#) (format "%d#" calc-number-radix))
- ((eq last-command-char ?_) "-")
- ((eq last-command-char ?@) "0@ ")
- (t (char-to-string last-command-char)))))
-
-(defun calcDigit-algebraic ()
- (interactive)
- (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
- (calcDigit-key)
- (setq calc-digit-value (minibuffer-contents))
- (exit-minibuffer)))
-
-(defun calcDigit-edit ()
- (interactive)
- (calc-unread-command)
- (setq calc-digit-value (minibuffer-contents))
- (exit-minibuffer))
-
-
-;;; Algebraic expression parsing. [Public]
-
-(defun math-read-exprs (exp-str)
- (let ((exp-pos 0)
- (exp-old-pos 0)
- (exp-keep-spaces nil)
- exp-token exp-data)
- (if calc-language-input-filter
- (setq exp-str (funcall calc-language-input-filter exp-str)))
- (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str))
- (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots"
- (substring exp-str (+ exp-token 2)))))
- (math-build-parse-table)
- (math-read-token)
- (let ((val (catch 'syntax (math-read-expr-list))))
- (if (stringp val)
- (list 'error exp-old-pos val)
- (if (equal exp-token 'end)
- val
- (list 'error exp-old-pos "Syntax error"))))))
-
-(defun math-read-expr-list ()
- (let* ((exp-keep-spaces nil)
- (val (list (math-read-expr-level 0)))
- (last val))
- (while (equal exp-data ",")
- (math-read-token)
- (let ((rest (list (math-read-expr-level 0))))
- (setcdr last rest)
- (setq last rest)))
- val))
-
-(defvar calc-user-parse-table nil)
-(defvar calc-last-main-parse-table nil)
-(defvar calc-last-lang-parse-table nil)
-(defvar calc-user-tokens nil)
-(defvar calc-user-token-chars nil)
-
-(defun math-build-parse-table ()
- (let ((mtab (cdr (assq nil calc-user-parse-tables)))
- (ltab (cdr (assq calc-language calc-user-parse-tables))))
- (or (and (eq mtab calc-last-main-parse-table)
- (eq ltab calc-last-lang-parse-table))
- (let ((p (append mtab ltab))
- (toks nil))
- (setq calc-user-parse-table p)
- (setq calc-user-token-chars nil)
- (while p
- (math-find-user-tokens (car (car p)))
- (setq p (cdr p)))
- (setq calc-user-tokens (mapconcat 'identity
- (sort (mapcar 'car toks)
- (function (lambda (x y)
- (> (length x)
- (length y)))))
- "\\|")
- calc-last-main-parse-table mtab
- calc-last-lang-parse-table ltab)))))
-
-(defun math-find-user-tokens (p) ; uses "toks"
- (while p
- (cond ((and (stringp (car p))
- (or (> (length (car p)) 1) (equal (car p) "$")
- (equal (car p) "\""))
- (string-match "[^a-zA-Z0-9]" (car p)))
- (let ((s (regexp-quote (car p))))
- (if (string-match "\\`[a-zA-Z0-9]" s)
- (setq s (concat "\\<" s)))
- (if (string-match "[a-zA-Z0-9]\\'" s)
- (setq s (concat s "\\>")))
- (or (assoc s toks)
- (progn
- (setq toks (cons (list s) toks))
- (or (memq (aref (car p) 0) calc-user-token-chars)
- (setq calc-user-token-chars
- (cons (aref (car p) 0)
- calc-user-token-chars)))))))
- ((consp (car p))
- (math-find-user-tokens (nth 1 (car p)))
- (or (eq (car (car p)) '\?)
- (math-find-user-tokens (nth 2 (car p))))))
- (setq p (cdr p))))
-
-(defun math-read-token ()
- (if (>= exp-pos (length exp-str))
- (setq exp-old-pos exp-pos
- exp-token 'end
- exp-data "\000")
- (let ((ch (aref exp-str exp-pos)))
- (setq exp-old-pos exp-pos)
- (cond ((memq ch '(32 10 9))
- (setq exp-pos (1+ exp-pos))
- (if exp-keep-spaces
- (setq exp-token 'space
- exp-data " ")
- (math-read-token)))
- ((and (memq ch calc-user-token-chars)
- (let ((case-fold-search nil))
- (eq (string-match calc-user-tokens exp-str exp-pos)
- exp-pos)))
- (setq exp-token 'punc
- exp-data (math-match-substring exp-str 0)
- exp-pos (match-end 0)))
- ((or (and (>= ch ?a) (<= ch ?z))
- (and (>= ch ?A) (<= ch ?Z)))
- (string-match (if (memq calc-language '(c fortran pascal maple))
- "[a-zA-Z0-9_#]*"
- "[a-zA-Z0-9'#]*")
- exp-str exp-pos)
- (setq exp-token 'symbol
- exp-pos (match-end 0)
- exp-data (math-restore-dashes
- (math-match-substring exp-str 0)))
- (if (eq calc-language 'eqn)
- (let ((code (assoc exp-data math-eqn-ignore-words)))
- (cond ((null code))
- ((null (cdr code))
- (math-read-token))
- ((consp (nth 1 code))
- (math-read-token)
- (if (assoc exp-data (cdr code))
- (setq exp-data (format "%s %s"
- (car code) exp-data))))
- ((eq (nth 1 code) 'punc)
- (setq exp-token 'punc
- exp-data (nth 2 code)))
- (t
- (math-read-token)
- (math-read-token))))))
- ((or (and (>= ch ?0) (<= ch ?9))
- (and (eq ch '?\.)
- (eq (string-match "\\.[0-9]" exp-str exp-pos) exp-pos))
- (and (eq ch '?_)
- (eq (string-match "_\\.?[0-9]" exp-str exp-pos) exp-pos)
- (or (eq exp-pos 0)
- (and (memq calc-language '(nil flat big unform
- tex eqn))
- (eq (string-match "[^])}\"a-zA-Z0-9'$]_"
- exp-str (1- exp-pos))
- (1- exp-pos))))))
- (or (and (eq calc-language 'c)
- (string-match "0[xX][0-9a-fA-F]+" exp-str exp-pos))
- (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" exp-str exp-pos))
- (setq exp-token 'number
- exp-data (math-match-substring exp-str 0)
- exp-pos (match-end 0)))
- ((eq ch ?\$)
- (if (and (eq calc-language 'pascal)
- (eq (string-match
- "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
- exp-str exp-pos)
- exp-pos))
- (setq exp-token 'number
- exp-data (math-match-substring exp-str 1)
- exp-pos (match-end 1))
- (if (eq (string-match "\\$\\([1-9][0-9]*\\)" exp-str exp-pos)
- exp-pos)
- (setq exp-data (- (string-to-int (math-match-substring
- exp-str 1))))
- (string-match "\\$+" exp-str exp-pos)
- (setq exp-data (- (match-end 0) (match-beginning 0))))
- (setq exp-token 'dollar
- exp-pos (match-end 0))))
- ((eq ch ?\#)
- (if (eq (string-match "#\\([1-9][0-9]*\\)" exp-str exp-pos)
- exp-pos)
- (setq exp-data (string-to-int
- (math-match-substring exp-str 1))
- exp-pos (match-end 0))
- (setq exp-data 1
- exp-pos (1+ exp-pos)))
- (setq exp-token 'hash))
- ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>"
- exp-str exp-pos)
- exp-pos)
- (setq exp-token 'punc
- exp-data (math-match-substring exp-str 0)
- exp-pos (match-end 0)))
- ((and (eq ch ?\")
- (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" exp-str exp-pos))
- (if (eq calc-language 'eqn)
- (progn
- (setq exp-str (copy-sequence exp-str))
- (aset exp-str (match-beginning 1) ?\{)
- (if (< (match-end 1) (length exp-str))
- (aset exp-str (match-end 1) ?\}))
- (math-read-token))
- (setq exp-token 'string
- exp-data (math-match-substring exp-str 1)
- exp-pos (match-end 0))))
- ((and (= ch ?\\) (eq calc-language 'tex)
- (< exp-pos (1- (length exp-str))))
- (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" exp-str exp-pos)
- (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" exp-str exp-pos))
- (setq exp-token 'symbol
- exp-pos (match-end 0)
- exp-data (math-restore-dashes
- (math-match-substring exp-str 1)))
- (let ((code (assoc exp-data math-tex-ignore-words)))
- (cond ((null code))
- ((null (cdr code))
- (math-read-token))
- ((eq (nth 1 code) 'punc)
- (setq exp-token 'punc
- exp-data (nth 2 code)))
- ((and (eq (nth 1 code) 'mat)
- (string-match " *{" exp-str exp-pos))
- (setq exp-pos (match-end 0)
- exp-token 'punc
- exp-data "[")
- (let ((right (string-match "}" exp-str exp-pos)))
- (and right
- (setq exp-str (copy-sequence exp-str))
- (aset exp-str right ?\])))))))
- ((and (= ch ?\.) (eq calc-language 'fortran)
- (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
- exp-str exp-pos) exp-pos))
- (setq exp-token 'punc
- exp-data (upcase (math-match-substring exp-str 0))
- exp-pos (match-end 0)))
- ((and (eq calc-language 'math)
- (eq (string-match "\\[\\[\\|->\\|:>" exp-str exp-pos)
- exp-pos))
- (setq exp-token 'punc
- exp-data (math-match-substring exp-str 0)
- exp-pos (match-end 0)))
- ((and (eq calc-language 'eqn)
- (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
- exp-str exp-pos)
- exp-pos))
- (setq exp-token 'punc
- exp-data (math-match-substring exp-str 0)
- exp-pos (match-end 0))
- (and (eq (string-match "\\\\dots\\." exp-str exp-pos) exp-pos)
- (setq exp-pos (match-end 0)))
- (if (memq (aref exp-data 0) '(?~ ?^))
- (math-read-token)))
- ((eq (string-match "%%.*$" exp-str exp-pos) exp-pos)
- (setq exp-pos (match-end 0))
- (math-read-token))
- (t
- (if (and (eq ch ?\{) (memq calc-language '(tex eqn)))
- (setq ch ?\())
- (if (and (eq ch ?\}) (memq calc-language '(tex eqn)))
- (setq ch ?\)))
- (if (and (eq ch ?\&) (eq calc-language 'tex))
- (setq ch ?\,))
- (setq exp-token 'punc
- exp-data (char-to-string ch)
- exp-pos (1+ exp-pos)))))))
-
-
-(defun math-read-expr-level (exp-prec &optional exp-term)
- (let* ((x (math-read-factor)) (first t) op op2)
- (while (and (or (and calc-user-parse-table
- (setq op (calc-check-user-syntax x exp-prec))
- (setq x op
- op '("2x" ident 999999 -1)))
- (and (setq op (assoc exp-data math-expr-opers))
- (/= (nth 2 op) -1)
- (or (and (setq op2 (assoc
- exp-data
- (cdr (memq op math-expr-opers))))
- (eq (= (nth 3 op) -1)
- (/= (nth 3 op2) -1))
- (eq (= (nth 3 op2) -1)
- (not (math-factor-after)))
- (setq op op2))
- t))
- (and (or (eq (nth 2 op) -1)
- (memq exp-token '(symbol number dollar hash))
- (equal exp-data "(")
- (and (equal exp-data "[")
- (not (eq calc-language 'math))
- (not (and exp-keep-spaces
- (eq (car-safe x) 'vec)))))
- (or (not (setq op (assoc exp-data math-expr-opers)))
- (/= (nth 2 op) -1))
- (or (not calc-user-parse-table)
- (not (eq exp-token 'symbol))
- (let ((p calc-user-parse-table))
- (while (and p
- (or (not (integerp
- (car (car (car p)))))
- (not (equal
- (nth 1 (car (car p)))
- exp-data))))
- (setq p (cdr p)))
- (not p)))
- (setq op (assoc "2x" math-expr-opers))))
- (not (and exp-term (equal exp-data exp-term)))
- (>= (nth 2 op) exp-prec))
- (if (not (equal (car op) "2x"))
- (math-read-token))
- (and (memq (nth 1 op) '(sdev mod))
- (calc-extensions))
- (setq x (cond ((consp (nth 1 op))
- (funcall (car (nth 1 op)) x op))
- ((eq (nth 3 op) -1)
- (if (eq (nth 1 op) 'ident)
- x
- (if (eq (nth 1 op) 'closing)
- (if (eq (nth 2 op) exp-prec)
- (progn
- (setq exp-prec 1000)
- x)
- (throw 'syntax "Mismatched delimiters"))
- (list (nth 1 op) x))))
- ((and (not first)
- (memq (nth 1 op) math-alg-inequalities)
- (memq (car-safe x) math-alg-inequalities))
- (calc-extensions)
- (math-composite-inequalities x op))
- (t (list (nth 1 op)
- x
- (math-read-expr-level (nth 3 op) exp-term))))
- first nil))
- x))
-
-(defun calc-check-user-syntax (&optional x prec)
- (let ((p calc-user-parse-table)
- (matches nil)
- match rule)
- (while (and p
- (or (not (progn
- (setq rule (car (car p)))
- (if x
- (and (integerp (car rule))
- (>= (car rule) prec)
- (equal exp-data
- (car (setq rule (cdr rule)))))
- (equal exp-data (car rule)))))
- (let ((save-exp-pos exp-pos)
- (save-exp-old-pos exp-old-pos)
- (save-exp-token exp-token)
- (save-exp-data exp-data))
- (or (not (listp
- (setq matches (calc-match-user-syntax rule))))
- (let ((args (progn
- (calc-extensions)
- calc-arg-values))
- (conds nil)
- temp)
- (if x
- (setq matches (cons x matches)))
- (setq match (cdr (car p)))
- (while (and (eq (car-safe match)
- 'calcFunc-condition)
- (= (length match) 3))
- (setq conds (append (math-flatten-lands
- (nth 2 match))
- conds)
- match (nth 1 match)))
- (while (and conds match)
- (calc-extensions)
- (cond ((eq (car-safe (car conds))
- 'calcFunc-let)
- (setq temp (car conds))
- (or (= (length temp) 3)
- (and (= (length temp) 2)
- (eq (car-safe (nth 1 temp))
- 'calcFunc-assign)
- (= (length (nth 1 temp)) 3)
- (setq temp (nth 1 temp)))
- (setq match nil))
- (setq matches (cons
- (math-normalize
- (math-multi-subst
- (nth 2 temp)
- args matches))
- matches)
- args (cons (nth 1 temp)
- args)))
- ((and (eq (car-safe (car conds))
- 'calcFunc-matches)
- (= (length (car conds)) 3))
- (setq temp (calcFunc-vmatches
- (math-multi-subst
- (nth 1 (car conds))
- args matches)
- (nth 2 (car conds))))
- (if (eq temp 0)
- (setq match nil)
- (while (setq temp (cdr temp))
- (setq matches (cons (nth 2 (car temp))
- matches)
- args (cons (nth 1 (car temp))
- args)))))
- (t
- (or (math-is-true (math-simplify
- (math-multi-subst
- (car conds)
- args matches)))
- (setq match nil))))
- (setq conds (cdr conds)))
- (if match
- (not (setq match (math-multi-subst
- match args matches)))
- (setq exp-old-pos save-exp-old-pos
- exp-token save-exp-token
- exp-data save-exp-data
- exp-pos save-exp-pos)))))))
- (setq p (cdr p)))
- (and p match)))
-
-(defun calc-match-user-syntax (p &optional term)
- (let ((matches nil)
- (save-exp-pos exp-pos)
- (save-exp-old-pos exp-old-pos)
- (save-exp-token exp-token)
- (save-exp-data exp-data))
- (while (and p
- (cond ((stringp (car p))
- (and (equal exp-data (car p))
- (progn
- (math-read-token)
- t)))
- ((integerp (car p))
- (and (setq m (catch 'syntax
- (math-read-expr-level
- (car p)
- (if (cdr p)
- (if (consp (nth 1 p))
- (car (nth 1 (nth 1 p)))
- (nth 1 p))
- term))))
- (not (stringp m))
- (setq matches (nconc matches (list m)))))
- ((eq (car (car p)) '\?)
- (setq m (calc-match-user-syntax (nth 1 (car p))))
- (or (nth 2 (car p))
- (setq matches
- (nconc matches
- (list
- (cons 'vec (and (listp m) m))))))
- (or (listp m) (not (nth 2 (car p)))
- (not (eq (aref (car (nth 2 (car p))) 0) ?\$))
- (eq exp-token 'end)))
- (t
- (setq m (calc-match-user-syntax (nth 1 (car p))
- (car (nth 2 (car p)))))
- (if (listp m)
- (let ((vec (cons 'vec m))
- opos mm)
- (while (and (listp
- (setq opos exp-pos
- mm (calc-match-user-syntax
- (or (nth 2 (car p))
- (nth 1 (car p)))
- (car (nth 2 (car p))))))
- (> exp-pos opos))
- (setq vec (nconc vec mm)))
- (setq matches (nconc matches (list vec))))
- (and (eq (car (car p)) '*)
- (setq matches (nconc matches (list '(vec)))))))))
- (setq p (cdr p)))
- (if p
- (setq exp-pos save-exp-pos
- exp-old-pos save-exp-old-pos
- exp-token save-exp-token
- exp-data save-exp-data
- matches "Failed"))
- matches))
-
-(defconst math-alg-inequalities
- '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
- calcFunc-eq calcFunc-neq))
-
-(defun math-remove-dashes (x)
- (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
- (math-remove-dashes
- (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
- x))
-
-(defun math-restore-dashes (x)
- (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
- (math-restore-dashes
- (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
- x))
-
-(defun math-read-if (cond op)
- (let ((then (math-read-expr-level 0)))
- (or (equal exp-data ":")
- (throw 'syntax "Expected ':'"))
- (math-read-token)
- (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))))
-
-(defun math-factor-after ()
- (let ((exp-pos exp-pos)
- exp-old-pos exp-token exp-data)
- (math-read-token)
- (or (memq exp-token '(number symbol dollar hash string))
- (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/")))
- (assoc (concat "u" exp-data) math-expr-opers))
- (eq (nth 2 (assoc exp-data math-expr-opers)) -1)
- (assoc exp-data '(("(") ("[") ("{"))))))
-
-(defun math-read-factor ()
- (let (op)
- (cond ((eq exp-token 'number)
- (let ((num (math-read-number exp-data)))
- (if (not num)
- (progn
- (setq exp-old-pos exp-pos)
- (throw 'syntax "Bad format")))
- (math-read-token)
- (if (and math-read-expr-quotes
- (consp num))
- (list 'quote num)
- num)))
- ((and calc-user-parse-table
- (setq op (calc-check-user-syntax)))
- op)
- ((or (equal exp-data "-")
- (equal exp-data "+")
- (equal exp-data "!")
- (equal exp-data "|")
- (equal exp-data "/"))
- (setq exp-data (concat "u" exp-data))
- (math-read-factor))
- ((and (setq op (assoc exp-data math-expr-opers))
- (eq (nth 2 op) -1))
- (if (consp (nth 1 op))
- (funcall (car (nth 1 op)) op)
- (math-read-token)
- (let ((val (math-read-expr-level (nth 3 op))))
- (cond ((eq (nth 1 op) 'ident)
- val)
- ((and (Math-numberp val)
- (equal (car op) "u-"))
- (math-neg val))
- (t (list (nth 1 op) val))))))
- ((eq exp-token 'symbol)
- (let ((sym (intern exp-data)))
- (math-read-token)
- (if (equal exp-data calc-function-open)
- (let ((f (assq sym math-expr-function-mapping)))
- (math-read-token)
- (if (consp (cdr f))
- (funcall (car (cdr f)) f sym)
- (let ((args (if (or (equal exp-data calc-function-close)
- (eq exp-token 'end))
- nil
- (math-read-expr-list))))
- (if (not (or (equal exp-data calc-function-close)
- (eq exp-token 'end)))
- (throw 'syntax "Expected `)'"))
- (math-read-token)
- (if (and (eq calc-language 'fortran) args
- (calc-extensions)
- (let ((calc-matrix-mode 'scalar))
- (math-known-matrixp
- (list 'var sym
- (intern
- (concat "var-"
- (symbol-name sym)))))))
- (math-parse-fortran-subscr sym args)
- (if f
- (setq sym (cdr f))
- (and (= (aref (symbol-name sym) 0) ?\\)
- (< (prefix-numeric-value calc-language-option)
- 0)
- (setq sym (intern (substring (symbol-name sym)
- 1))))
- (or (string-match "-" (symbol-name sym))
- (setq sym (intern
- (concat "calcFunc-"
- (symbol-name sym))))))
- (cons sym args)))))
- (if math-read-expr-quotes
- sym
- (let ((val (list 'var
- (intern (math-remove-dashes
- (symbol-name sym)))
- (if (string-match "-" (symbol-name sym))
- sym
- (intern (concat "var-"
- (symbol-name sym)))))))
- (let ((v (assq (nth 1 val) math-expr-variable-mapping)))
- (and v (setq val (if (consp (cdr v))
- (funcall (car (cdr v)) v val)
- (list 'var
- (intern
- (substring (symbol-name (cdr v))
- 4))
- (cdr v))))))
- (while (and (memq calc-language '(c pascal maple))
- (equal exp-data "["))
- (math-read-token)
- (setq val (append (list 'calcFunc-subscr val)
- (math-read-expr-list)))
- (if (equal exp-data "]")
- (math-read-token)
- (throw 'syntax "Expected ']'")))
- val)))))
- ((eq exp-token 'dollar)
- (let ((abs (if (> exp-data 0) exp-data (- exp-data))))
- (if (>= (length calc-dollar-values) abs)
- (let ((num exp-data))
- (math-read-token)
- (setq calc-dollar-used (max calc-dollar-used num))
- (math-check-complete (nth (1- abs) calc-dollar-values)))
- (throw 'syntax (if calc-dollar-values
- "Too many $'s"
- "$'s not allowed in this context")))))
- ((eq exp-token 'hash)
- (or calc-hashes-used
- (throw 'syntax "#'s not allowed in this context"))
- (calc-extensions)
- (if (<= exp-data (length calc-arg-values))
- (let ((num exp-data))
- (math-read-token)
- (setq calc-hashes-used (max calc-hashes-used num))
- (nth (1- num) calc-arg-values))
- (throw 'syntax "Too many # arguments")))
- ((equal exp-data "(")
- (let* ((exp (let ((exp-keep-spaces nil))
- (math-read-token)
- (if (or (equal exp-data "\\dots")
- (equal exp-data "\\ldots"))
- '(neg (var inf var-inf))
- (math-read-expr-level 0)))))
- (let ((exp-keep-spaces nil))
- (cond
- ((equal exp-data ",")
- (progn
- (math-read-token)
- (let ((exp2 (math-read-expr-level 0)))
- (setq exp
- (if (and exp2 (Math-realp exp) (Math-realp exp2))
- (math-normalize (list 'cplx exp exp2))
- (list '+ exp (list '* exp2 '(var i var-i))))))))
- ((equal exp-data ";")
- (progn
- (math-read-token)
- (let ((exp2 (math-read-expr-level 0)))
- (setq exp (if (and exp2 (Math-realp exp)
- (Math-anglep exp2))
- (math-normalize (list 'polar exp exp2))
- (calc-extensions)
- (list '* exp
- (list 'calcFunc-exp
- (list '*
- (math-to-radians-2 exp2)
- '(var i var-i)))))))))
- ((or (equal exp-data "\\dots")
- (equal exp-data "\\ldots"))
- (progn
- (math-read-token)
- (let ((exp2 (if (or (equal exp-data ")")
- (equal exp-data "]")
- (eq exp-token 'end))
- '(var inf var-inf)
- (math-read-expr-level 0))))
- (setq exp
- (list 'intv
- (if (equal exp-data ")") 0 1)
- exp
- exp2)))))))
- (if (not (or (equal exp-data ")")
- (and (equal exp-data "]") (eq (car-safe exp) 'intv))
- (eq exp-token 'end)))
- (throw 'syntax "Expected `)'"))
- (math-read-token)
- exp))
- ((eq exp-token 'string)
- (calc-extensions)
- (math-read-string))
- ((equal exp-data "[")
- (calc-extensions)
- (math-read-brackets t "]"))
- ((equal exp-data "{")
- (calc-extensions)
- (math-read-brackets nil "}"))
- ((equal exp-data "<")
- (calc-extensions)
- (math-read-angle-brackets))
- (t (throw 'syntax "Expected a number")))))
-
-;;; calc-aent.el ends here
+++ /dev/null
-;;; calc-alg.el --- algebraic functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-alg () nil)
-
-;;; Algebra commands.
-
-(defun calc-alg-evaluate (arg)
- (interactive "p")
- (calc-slow-wrapper
- (calc-with-default-simplification
- (let ((math-simplify-only nil))
- (calc-modify-simplify-mode arg)
- (calc-enter-result 1 "dsmp" (calc-top 1))))))
-
-(defun calc-modify-simplify-mode (arg)
- (if (= (math-abs arg) 2)
- (setq calc-simplify-mode 'alg)
- (if (>= (math-abs arg) 3)
- (setq calc-simplify-mode 'ext)))
- (if (< arg 0)
- (setq calc-simplify-mode (list calc-simplify-mode))))
-
-(defun calc-simplify ()
- (interactive)
- (calc-slow-wrapper
- (calc-with-default-simplification
- (calc-enter-result 1 "simp" (math-simplify (calc-top-n 1))))))
-
-(defun calc-simplify-extended ()
- (interactive)
- (calc-slow-wrapper
- (calc-with-default-simplification
- (calc-enter-result 1 "esmp" (math-simplify-extended (calc-top-n 1))))))
-
-(defun calc-expand-formula (arg)
- (interactive "p")
- (calc-slow-wrapper
- (calc-with-default-simplification
- (let ((math-simplify-only nil))
- (calc-modify-simplify-mode arg)
- (calc-enter-result 1 "expf"
- (if (> arg 0)
- (let ((math-expand-formulas t))
- (calc-top-n 1))
- (let ((top (calc-top-n 1)))
- (or (math-expand-formula top)
- top))))))))
-
-(defun calc-factor (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "fctr" (if (calc-is-hyperbolic)
- 'calcFunc-factors 'calcFunc-factor)
- arg)))
-
-(defun calc-expand (n)
- (interactive "P")
- (calc-slow-wrapper
- (calc-enter-result 1 "expa"
- (append (list 'calcFunc-expand
- (calc-top-n 1))
- (and n (list (prefix-numeric-value n)))))))
-
-(defun calc-collect (&optional var)
- (interactive "sCollect terms involving: ")
- (calc-slow-wrapper
- (if (or (equal var "") (equal var "$") (null var))
- (calc-enter-result 2 "clct" (cons 'calcFunc-collect
- (calc-top-list-n 2)))
- (let ((var (math-read-expr var)))
- (if (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (calc-enter-result 1 "clct" (list 'calcFunc-collect
- (calc-top-n 1)
- var))))))
-
-(defun calc-apart (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "aprt" 'calcFunc-apart arg)))
-
-(defun calc-normalize-rat (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "nrat" 'calcFunc-nrat arg)))
-
-(defun calc-poly-gcd (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "pgcd" 'calcFunc-pgcd arg)))
-
-(defun calc-poly-div (arg)
- (interactive "P")
- (calc-slow-wrapper
- (setq calc-poly-div-remainder nil)
- (calc-binary-op "pdiv" 'calcFunc-pdiv arg)
- (if (and calc-poly-div-remainder (null arg))
- (progn
- (calc-clear-command-flag 'clear-message)
- (calc-record calc-poly-div-remainder "prem")
- (if (not (Math-zerop calc-poly-div-remainder))
- (message "(Remainder was %s)"
- (math-format-flat-expr calc-poly-div-remainder 0))
- (message "(No remainder)"))))))
-
-(defun calc-poly-rem (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "prem" 'calcFunc-prem arg)))
-
-(defun calc-poly-div-rem (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-binary-op "pdvr" 'calcFunc-pdivide arg)
- (calc-binary-op "pdvr" 'calcFunc-pdivrem arg))))
-
-(defun calc-substitute (&optional oldname newname)
- (interactive "sSubstitute old: ")
- (calc-slow-wrapper
- (let (old new (num 1) expr)
- (if (or (equal oldname "") (equal oldname "$") (null oldname))
- (setq new (calc-top-n 1)
- old (calc-top-n 2)
- expr (calc-top-n 3)
- num 3)
- (or newname
- (progn (calc-unread-command ?\C-a)
- (setq newname (read-string (concat "Substitute old: "
- oldname
- ", new: ")
- oldname))))
- (if (or (equal newname "") (equal newname "$") (null newname))
- (setq new (calc-top-n 1)
- expr (calc-top-n 2)
- num 2)
- (setq new (if (stringp newname) (math-read-expr newname) newname))
- (if (eq (car-safe new) 'error)
- (error "Bad format in expression: %s" (nth 1 new)))
- (setq expr (calc-top-n 1)))
- (setq old (if (stringp oldname) (math-read-expr oldname) oldname))
- (if (eq (car-safe old) 'error)
- (error "Bad format in expression: %s" (nth 1 old)))
- (or (math-expr-contains expr old)
- (error "No occurrences found")))
- (calc-enter-result num "sbst" (math-expr-subst expr old new)))))
-
-
-(defun calc-has-rules (name)
- (setq name (calc-var-value name))
- (and (consp name)
- (memq (car name) '(vec calcFunc-assign calcFunc-condition))
- name))
-
-(defun math-recompile-eval-rules ()
- (setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules)
- (math-compile-rewrites
- '(var EvalRules var-EvalRules)))
- math-eval-rules-cache-other (assq nil math-eval-rules-cache)
- math-eval-rules-cache-tag (calc-var-value 'var-EvalRules)))
-
-
-;;; Try to expand a formula according to its definition.
-(defun math-expand-formula (expr)
- (and (consp expr)
- (symbolp (car expr))
- (or (get (car expr) 'calc-user-defn)
- (get (car expr) 'math-expandable))
- (let ((res (let ((math-expand-formulas t))
- (apply (car expr) (cdr expr)))))
- (and (not (eq (car-safe res) (car expr)))
- res))))
-
-
-
-
-;;; True if A comes before B in a canonical ordering of expressions. [P X X]
-(defun math-beforep (a b) ; [Public]
- (cond ((and (Math-realp a) (Math-realp b))
- (let ((comp (math-compare a b)))
- (or (eq comp -1)
- (and (eq comp 0)
- (not (equal a b))
- (> (length (memq (car-safe a)
- '(bigneg nil bigpos frac float)))
- (length (memq (car-safe b)
- '(bigneg nil bigpos frac float))))))))
- ((equal b '(neg (var inf var-inf))) nil)
- ((equal a '(neg (var inf var-inf))) t)
- ((equal a '(var inf var-inf)) nil)
- ((equal b '(var inf var-inf)) t)
- ((Math-realp a)
- (if (and (eq (car-safe b) 'intv) (math-intv-constp b))
- (if (or (math-beforep a (nth 2 b)) (Math-equal a (nth 2 b)))
- t
- nil)
- t))
- ((Math-realp b)
- (if (and (eq (car-safe a) 'intv) (math-intv-constp a))
- (if (math-beforep (nth 2 a) b)
- t
- nil)
- nil))
- ((and (eq (car a) 'intv) (eq (car b) 'intv)
- (math-intv-constp a) (math-intv-constp b))
- (let ((comp (math-compare (nth 2 a) (nth 2 b))))
- (cond ((eq comp -1) t)
- ((eq comp 1) nil)
- ((and (memq (nth 1 a) '(2 3)) (memq (nth 1 b) '(0 1))) t)
- ((and (memq (nth 1 a) '(0 1)) (memq (nth 1 b) '(2 3))) nil)
- ((eq (setq comp (math-compare (nth 3 a) (nth 3 b))) -1) t)
- ((eq comp 1) nil)
- ((and (memq (nth 1 a) '(0 2)) (memq (nth 1 b) '(1 3))) t)
- (t nil))))
- ((not (eq (not (Math-objectp a)) (not (Math-objectp b))))
- (Math-objectp a))
- ((eq (car a) 'var)
- (if (eq (car b) 'var)
- (string-lessp (symbol-name (nth 1 a)) (symbol-name (nth 1 b)))
- (not (Math-numberp b))))
- ((eq (car b) 'var) (Math-numberp a))
- ((eq (car a) (car b))
- (while (and (setq a (cdr a) b (cdr b)) a
- (equal (car a) (car b))))
- (and b
- (or (null a)
- (math-beforep (car a) (car b)))))
- (t (string-lessp (symbol-name (car a)) (symbol-name (car b))))))
-
-
-(defsubst math-simplify-extended (a)
- (let ((math-living-dangerously t))
- (math-simplify a)))
-
-(defalias 'calcFunc-esimplify 'math-simplify-extended)
-
-(defun math-simplify (top-expr)
- (let ((math-simplifying t)
- (top-only (consp calc-simplify-mode))
- (simp-rules (append (and (calc-has-rules 'var-AlgSimpRules)
- '((var AlgSimpRules var-AlgSimpRules)))
- (and math-living-dangerously
- (calc-has-rules 'var-ExtSimpRules)
- '((var ExtSimpRules var-ExtSimpRules)))
- (and math-simplifying-units
- (calc-has-rules 'var-UnitSimpRules)
- '((var UnitSimpRules var-UnitSimpRules)))
- (and math-integrating
- (calc-has-rules 'var-IntegSimpRules)
- '((var IntegSimpRules var-IntegSimpRules)))))
- res)
- (if top-only
- (let ((r simp-rules))
- (setq res (math-simplify-step (math-normalize top-expr))
- calc-simplify-mode '(nil)
- top-expr (math-normalize res))
- (while r
- (setq top-expr (math-rewrite top-expr (car r)
- '(neg (var inf var-inf)))
- r (cdr r))))
- (calc-with-default-simplification
- (while (let ((r simp-rules))
- (setq res (math-normalize top-expr))
- (while r
- (setq res (math-rewrite res (car r))
- r (cdr r)))
- (not (equal top-expr (setq res (math-simplify-step res)))))
- (setq top-expr res)))))
- top-expr)
-
-(defalias 'calcFunc-simplify 'math-simplify)
-
-;;; The following has a "bug" in that if any recursive simplifications
-;;; occur only the first handler will be tried; this doesn't really
-;;; matter, since math-simplify-step is iterated to a fixed point anyway.
-(defun math-simplify-step (a)
- (if (Math-primp a)
- a
- (let ((aa (if (or top-only
- (memq (car a) '(calcFunc-quote calcFunc-condition
- calcFunc-evalto)))
- a
- (cons (car a) (mapcar 'math-simplify-step (cdr a))))))
- (and (symbolp (car aa))
- (let ((handler (get (car aa) 'math-simplify)))
- (and handler
- (while (and handler
- (equal (setq aa (or (funcall (car handler) aa)
- aa))
- a))
- (setq handler (cdr handler))))))
- aa)))
-
-
-;; Placeholder, to synchronize autoloading.
-(defun math-need-std-simps ()
- nil)
-
-(math-defsimplify (+ -)
- (math-simplify-plus))
-
-(defun math-simplify-plus ()
- (cond ((and (memq (car-safe (nth 1 expr)) '(+ -))
- (Math-numberp (nth 2 (nth 1 expr)))
- (not (Math-numberp (nth 2 expr))))
- (let ((x (nth 2 expr))
- (op (car expr)))
- (setcar (cdr (cdr expr)) (nth 2 (nth 1 expr)))
- (setcar expr (car (nth 1 expr)))
- (setcar (cdr (cdr (nth 1 expr))) x)
- (setcar (nth 1 expr) op)))
- ((and (eq (car expr) '+)
- (Math-numberp (nth 1 expr))
- (not (Math-numberp (nth 2 expr))))
- (let ((x (nth 2 expr)))
- (setcar (cdr (cdr expr)) (nth 1 expr))
- (setcar (cdr expr) x))))
- (let ((aa expr)
- aaa temp)
- (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -))
- (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 expr)
- (eq (car aaa) '-) (eq (car expr) '-) t))
- (progn
- (setcar (cdr (cdr expr)) temp)
- (setcar expr '+)
- (setcar (cdr (cdr aaa)) 0)))
- (setq aa (nth 1 aa)))
- (if (setq temp (math-combine-sum aaa (nth 2 expr)
- nil (eq (car expr) '-) t))
- (progn
- (setcar (cdr (cdr expr)) temp)
- (setcar expr '+)
- (setcar (cdr aa) 0)))
- expr))
-
-(math-defsimplify *
- (math-simplify-times))
-
-(defun math-simplify-times ()
- (if (eq (car-safe (nth 2 expr)) '*)
- (and (math-beforep (nth 1 (nth 2 expr)) (nth 1 expr))
- (or (math-known-scalarp (nth 1 expr) t)
- (math-known-scalarp (nth 1 (nth 2 expr)) t))
- (let ((x (nth 1 expr)))
- (setcar (cdr expr) (nth 1 (nth 2 expr)))
- (setcar (cdr (nth 2 expr)) x)))
- (and (math-beforep (nth 2 expr) (nth 1 expr))
- (or (math-known-scalarp (nth 1 expr) t)
- (math-known-scalarp (nth 2 expr) t))
- (let ((x (nth 2 expr)))
- (setcar (cdr (cdr expr)) (nth 1 expr))
- (setcar (cdr expr) x))))
- (let ((aa expr)
- aaa temp
- (safe t) (scalar (math-known-scalarp (nth 1 expr))))
- (if (and (Math-ratp (nth 1 expr))
- (setq temp (math-common-constant-factor (nth 2 expr))))
- (progn
- (setcar (cdr (cdr expr))
- (math-cancel-common-factor (nth 2 expr) temp))
- (setcar (cdr expr) (math-mul (nth 1 expr) temp))))
- (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*)
- safe)
- (if (setq temp (math-combine-prod (nth 1 expr) (nth 1 aaa) nil nil t))
- (progn
- (setcar (cdr expr) temp)
- (setcar (cdr aaa) 1)))
- (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t))
- aa (nth 2 aa)))
- (if (and (setq temp (math-combine-prod aaa (nth 1 expr) nil nil t))
- safe)
- (progn
- (setcar (cdr expr) temp)
- (setcar (cdr (cdr aa)) 1)))
- (if (and (eq (car-safe (nth 1 expr)) 'frac)
- (memq (nth 1 (nth 1 expr)) '(1 -1)))
- (math-div (math-mul (nth 2 expr) (nth 1 (nth 1 expr)))
- (nth 2 (nth 1 expr)))
- expr)))
-
-(math-defsimplify /
- (math-simplify-divide))
-
-(defun math-simplify-divide ()
- (let ((np (cdr expr))
- (nover nil)
- (nn (and (or (eq (car expr) '/) (not (Math-realp (nth 2 expr))))
- (math-common-constant-factor (nth 2 expr))))
- n op)
- (if nn
- (progn
- (setq n (and (or (eq (car expr) '/) (not (Math-realp (nth 1 expr))))
- (math-common-constant-factor (nth 1 expr))))
- (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
- (progn
- (setcar (cdr expr) (math-mul (nth 2 nn) (nth 1 expr)))
- (setcar (cdr (cdr expr))
- (math-cancel-common-factor (nth 2 expr) nn))
- (if (and (math-negp nn)
- (setq op (assq (car expr) calc-tweak-eqn-table)))
- (setcar expr (nth 1 op))))
- (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1)))
- (progn
- (setcar (cdr expr)
- (math-cancel-common-factor (nth 1 expr) n))
- (setcar (cdr (cdr expr))
- (math-cancel-common-factor (nth 2 expr) n))
- (if (and (math-negp n)
- (setq op (assq (car expr) calc-tweak-eqn-table)))
- (setcar expr (nth 1 op))))))))
- (if (and (eq (car-safe (car np)) '/)
- (math-known-scalarp (nth 2 expr) t))
- (progn
- (setq np (cdr (nth 1 expr)))
- (while (eq (car-safe (setq n (car np))) '*)
- (and (math-known-scalarp (nth 2 n) t)
- (math-simplify-divisor (cdr n) (cdr (cdr expr)) nil t))
- (setq np (cdr (cdr n))))
- (math-simplify-divisor np (cdr (cdr expr)) nil t)
- (setq nover t
- np (cdr (cdr (nth 1 expr))))))
- (while (eq (car-safe (setq n (car np))) '*)
- (and (math-known-scalarp (nth 2 n) t)
- (math-simplify-divisor (cdr n) (cdr (cdr expr)) nover t))
- (setq np (cdr (cdr n))))
- (math-simplify-divisor np (cdr (cdr expr)) nover t)
- expr))
-
-(defun math-simplify-divisor (np dp nover dover)
- (cond ((eq (car-safe (car dp)) '/)
- (math-simplify-divisor np (cdr (car dp)) nover dover)
- (and (math-known-scalarp (nth 1 (car dp)) t)
- (math-simplify-divisor np (cdr (cdr (car dp)))
- nover (not dover))))
- ((or (or (eq (car expr) '/)
- (let ((signs (math-possible-signs (car np))))
- (or (memq signs '(1 4))
- (and (memq (car expr) '(calcFunc-eq calcFunc-neq))
- (eq signs 5))
- math-living-dangerously)))
- (math-numberp (car np)))
- (let ((n (car np))
- d dd temp op
- (safe t) (scalar (math-known-scalarp n)))
- (while (and (eq (car-safe (setq d (car dp))) '*)
- safe)
- (math-simplify-one-divisor np (cdr d))
- (setq safe (or scalar (math-known-scalarp (nth 1 d) t))
- dp (cdr (cdr d))))
- (if safe
- (math-simplify-one-divisor np dp))))))
-
-(defun math-simplify-one-divisor (np dp)
- (if (setq temp (math-combine-prod (car np) (car dp) nover dover t))
- (progn
- (and (not (memq (car expr) '(/ calcFunc-eq calcFunc-neq)))
- (math-known-negp (car dp))
- (setq op (assq (car expr) calc-tweak-eqn-table))
- (setcar expr (nth 1 op)))
- (setcar np (if nover (math-div 1 temp) temp))
- (setcar dp 1))
- (and dover (not nover) (eq (car expr) '/)
- (eq (car-safe (car dp)) 'calcFunc-sqrt)
- (Math-integerp (nth 1 (car dp)))
- (progn
- (setcar np (math-mul (car np)
- (list 'calcFunc-sqrt (nth 1 (car dp)))))
- (setcar dp (nth 1 (car dp)))))))
-
-(defun math-common-constant-factor (expr)
- (if (Math-realp expr)
- (if (Math-ratp expr)
- (and (not (memq expr '(0 1 -1)))
- (math-abs expr))
- (if (math-ratp (setq expr (math-to-simple-fraction expr)))
- (math-common-constant-factor expr)))
- (if (memq (car expr) '(+ - cplx sdev))
- (let ((f1 (math-common-constant-factor (nth 1 expr)))
- (f2 (math-common-constant-factor (nth 2 expr))))
- (and f1 f2
- (not (eq (setq f1 (math-frac-gcd f1 f2)) 1))
- f1))
- (if (memq (car expr) '(* polar))
- (math-common-constant-factor (nth 1 expr))
- (if (eq (car expr) '/)
- (or (math-common-constant-factor (nth 1 expr))
- (and (Math-integerp (nth 2 expr))
- (list 'frac 1 (math-abs (nth 2 expr))))))))))
-
-(defun math-cancel-common-factor (expr val)
- (if (memq (car-safe expr) '(+ - cplx sdev))
- (progn
- (setcar (cdr expr) (math-cancel-common-factor (nth 1 expr) val))
- (setcar (cdr (cdr expr)) (math-cancel-common-factor (nth 2 expr) val))
- expr)
- (if (eq (car-safe expr) '*)
- (math-mul (math-cancel-common-factor (nth 1 expr) val) (nth 2 expr))
- (math-div expr val))))
-
-(defun math-frac-gcd (a b)
- (if (Math-zerop a)
- b
- (if (Math-zerop b)
- a
- (if (and (Math-integerp a)
- (Math-integerp b))
- (math-gcd a b)
- (and (Math-integerp a) (setq a (list 'frac a 1)))
- (and (Math-integerp b) (setq b (list 'frac b 1)))
- (math-make-frac (math-gcd (nth 1 a) (nth 1 b))
- (math-gcd (nth 2 a) (nth 2 b)))))))
-
-(math-defsimplify %
- (math-simplify-mod))
-
-(defun math-simplify-mod ()
- (and (Math-realp (nth 2 expr))
- (Math-posp (nth 2 expr))
- (let ((lin (math-is-linear (nth 1 expr)))
- t1 t2 t3)
- (or (and lin
- (or (math-negp (car lin))
- (not (Math-lessp (car lin) (nth 2 expr))))
- (list '%
- (list '+
- (math-mul (nth 1 lin) (nth 2 lin))
- (math-mod (car lin) (nth 2 expr)))
- (nth 2 expr)))
- (and lin
- (not (math-equal-int (nth 1 lin) 1))
- (math-num-integerp (nth 1 lin))
- (math-num-integerp (nth 2 expr))
- (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 expr)))
- (not (math-equal-int t1 1))
- (list '*
- t1
- (list '%
- (list '+
- (math-mul (math-div (nth 1 lin) t1)
- (nth 2 lin))
- (let ((calc-prefer-frac t))
- (math-div (car lin) t1)))
- (math-div (nth 2 expr) t1))))
- (and (math-equal-int (nth 2 expr) 1)
- (math-known-integerp (if lin
- (math-mul (nth 1 lin) (nth 2 lin))
- (nth 1 expr)))
- (if lin (math-mod (car lin) 1) 0))))))
-
-(math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt
- calcFunc-gt calcFunc-leq calcFunc-geq)
- (if (= (length expr) 3)
- (math-simplify-ineq)))
-
-(defun math-simplify-ineq ()
- (let ((np (cdr expr))
- n)
- (while (memq (car-safe (setq n (car np))) '(+ -))
- (math-simplify-add-term (cdr (cdr n)) (cdr (cdr expr))
- (eq (car n) '-) nil)
- (setq np (cdr n)))
- (math-simplify-add-term np (cdr (cdr expr)) nil (eq np (cdr expr)))
- (math-simplify-divide)
- (let ((signs (math-possible-signs (cons '- (cdr expr)))))
- (or (cond ((eq (car expr) 'calcFunc-eq)
- (or (and (eq signs 2) 1)
- (and (memq signs '(1 4 5)) 0)))
- ((eq (car expr) 'calcFunc-neq)
- (or (and (eq signs 2) 0)
- (and (memq signs '(1 4 5)) 1)))
- ((eq (car expr) 'calcFunc-lt)
- (or (and (eq signs 1) 1)
- (and (memq signs '(2 4 6)) 0)))
- ((eq (car expr) 'calcFunc-gt)
- (or (and (eq signs 4) 1)
- (and (memq signs '(1 2 3)) 0)))
- ((eq (car expr) 'calcFunc-leq)
- (or (and (eq signs 4) 0)
- (and (memq signs '(1 2 3)) 1)))
- ((eq (car expr) 'calcFunc-geq)
- (or (and (eq signs 1) 0)
- (and (memq signs '(2 4 6)) 1))))
- expr))))
-
-(defun math-simplify-add-term (np dp minus lplain)
- (or (math-vectorp (car np))
- (let ((rplain t)
- n d dd temp)
- (while (memq (car-safe (setq n (car np) d (car dp))) '(+ -))
- (setq rplain nil)
- (if (setq temp (math-combine-sum n (nth 2 d)
- minus (eq (car d) '+) t))
- (if (or lplain (eq (math-looks-negp temp) minus))
- (progn
- (setcar np (setq n (if minus (math-neg temp) temp)))
- (setcar (cdr (cdr d)) 0))
- (progn
- (setcar np 0)
- (setcar (cdr (cdr d)) (setq n (if (eq (car d) '+)
- (math-neg temp)
- temp))))))
- (setq dp (cdr d)))
- (if (setq temp (math-combine-sum n d minus t t))
- (if (or lplain
- (and (not rplain)
- (eq (math-looks-negp temp) minus)))
- (progn
- (setcar np (setq n (if minus (math-neg temp) temp)))
- (setcar dp 0))
- (progn
- (setcar np 0)
- (setcar dp (setq n (math-neg temp)))))))))
-
-(math-defsimplify calcFunc-sin
- (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
- (nth 1 (nth 1 expr)))
- (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-sin (math-neg (nth 1 expr)))))
- (and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
- (and n
- (math-known-sin (car n) (nth 1 n) 120 0))))
- (and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 expr))))
- (and n
- (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
- (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
- (math-div (nth 1 (nth 1 expr))
- (list 'calcFunc-sqrt
- (math-add 1 (math-sqr (nth 1 (nth 1 expr)))))))
- (let ((m (math-should-expand-trig (nth 1 expr))))
- (and m (integerp (car m))
- (let ((n (car m)) (a (nth 1 m)))
- (list '+
- (list '* (list 'calcFunc-sin (list '* (1- n) a))
- (list 'calcFunc-cos a))
- (list '* (list 'calcFunc-cos (list '* (1- n) a))
- (list 'calcFunc-sin a))))))))
-
-(math-defsimplify calcFunc-cos
- (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
- (nth 1 (nth 1 expr)))
- (and (math-looks-negp (nth 1 expr))
- (list 'calcFunc-cos (math-neg (nth 1 expr))))
- (and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
- (and n
- (math-known-sin (car n) (nth 1 n) 120 300))))
- (and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 expr))))
- (and n
- (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
- (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
- (math-div 1
- (list 'calcFunc-sqrt
- (math-add 1 (math-sqr (nth 1 (nth 1 expr)))))))
- (let ((m (math-should-expand-trig (nth 1 expr))))
- (and m (integerp (car m))
- (let ((n (car m)) (a (nth 1 m)))
- (list '-
- (list '* (list 'calcFunc-cos (list '* (1- n) a))
- (list 'calcFunc-cos a))
- (list '* (list 'calcFunc-sin (list '* (1- n) a))
- (list 'calcFunc-sin a))))))))
-
-(defun math-should-expand-trig (x &optional hyperbolic)
- (let ((m (math-is-multiple x)))
- (and math-living-dangerously
- m (or (and (integerp (car m)) (> (car m) 1))
- (equal (car m) '(frac 1 2)))
- (or math-integrating
- (memq (car-safe (nth 1 m))
- (if hyperbolic
- '(calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)
- '(calcFunc-arcsin calcFunc-arccos calcFunc-arctan)))
- (and (eq (car-safe (nth 1 m)) 'calcFunc-ln)
- (eq hyperbolic 'exp)))
- m)))
-
-(defun math-known-sin (plus n mul off)
- (setq n (math-mul n mul))
- (and (math-num-integerp n)
- (setq n (math-mod (math-add (math-trunc n) off) 240))
- (if (>= n 120)
- (and (setq n (math-known-sin plus (- n 120) 1 0))
- (math-neg n))
- (if (> n 60)
- (setq n (- 120 n)))
- (if (math-zerop plus)
- (and (or calc-symbolic-mode
- (memq n '(0 20 60)))
- (cdr (assq n
- '( (0 . 0)
- (10 . (/ (calcFunc-sqrt
- (- 2 (calcFunc-sqrt 3))) 2))
- (12 . (/ (- (calcFunc-sqrt 5) 1) 4))
- (15 . (/ (calcFunc-sqrt
- (- 2 (calcFunc-sqrt 2))) 2))
- (20 . (/ 1 2))
- (24 . (* (^ (/ 1 2) (/ 3 2))
- (calcFunc-sqrt
- (- 5 (calcFunc-sqrt 5)))))
- (30 . (/ (calcFunc-sqrt 2) 2))
- (36 . (/ (+ (calcFunc-sqrt 5) 1) 4))
- (40 . (/ (calcFunc-sqrt 3) 2))
- (45 . (/ (calcFunc-sqrt
- (+ 2 (calcFunc-sqrt 2))) 2))
- (48 . (* (^ (/ 1 2) (/ 3 2))
- (calcFunc-sqrt
- (+ 5 (calcFunc-sqrt 5)))))
- (50 . (/ (calcFunc-sqrt
- (+ 2 (calcFunc-sqrt 3))) 2))
- (60 . 1)))))
- (cond ((eq n 0) (math-normalize (list 'calcFunc-sin plus)))
- ((eq n 60) (math-normalize (list 'calcFunc-cos plus)))
- (t nil))))))
-
-(math-defsimplify calcFunc-tan
- (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)
- (nth 1 (nth 1 expr)))
- (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-tan (math-neg (nth 1 expr)))))
- (and (eq calc-angle-mode 'rad)
- (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))
- (and n
- (math-known-tan (car n) (nth 1 n) 120))))
- (and (eq calc-angle-mode 'deg)
- (let ((n (math-integer-plus (nth 1 expr))))
- (and n
- (math-known-tan (car n) (nth 1 n) '(frac 2 3)))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)
- (math-div (nth 1 (nth 1 expr))
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)
- (math-div (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))
- (nth 1 (nth 1 expr))))
- (let ((m (math-should-expand-trig (nth 1 expr))))
- (and m
- (if (equal (car m) '(frac 1 2))
- (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m)))
- (list 'calcFunc-sin (nth 1 m)))
- (math-div (list 'calcFunc-sin (nth 1 expr))
- (list 'calcFunc-cos (nth 1 expr))))))))
-
-(defun math-known-tan (plus n mul)
- (setq n (math-mul n mul))
- (and (math-num-integerp n)
- (setq n (math-mod (math-trunc n) 120))
- (if (> n 60)
- (and (setq n (math-known-tan plus (- 120 n) 1))
- (math-neg n))
- (if (math-zerop plus)
- (and (or calc-symbolic-mode
- (memq n '(0 30 60)))
- (cdr (assq n '( (0 . 0)
- (10 . (- 2 (calcFunc-sqrt 3)))
- (12 . (calcFunc-sqrt
- (- 1 (* (/ 2 5) (calcFunc-sqrt 5)))))
- (15 . (- (calcFunc-sqrt 2) 1))
- (20 . (/ (calcFunc-sqrt 3) 3))
- (24 . (calcFunc-sqrt
- (- 5 (* 2 (calcFunc-sqrt 5)))))
- (30 . 1)
- (36 . (calcFunc-sqrt
- (+ 1 (* (/ 2 5) (calcFunc-sqrt 5)))))
- (40 . (calcFunc-sqrt 3))
- (45 . (+ (calcFunc-sqrt 2) 1))
- (48 . (calcFunc-sqrt
- (+ 5 (* 2 (calcFunc-sqrt 5)))))
- (50 . (+ 2 (calcFunc-sqrt 3)))
- (60 . (var uinf var-uinf))))))
- (cond ((eq n 0) (math-normalize (list 'calcFunc-tan plus)))
- ((eq n 60) (math-normalize (list '/ -1
- (list 'calcFunc-tan plus))))
- (t nil))))))
-
-(math-defsimplify calcFunc-sinh
- (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
- (nth 1 (nth 1 expr)))
- (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-sinh (math-neg (nth 1 expr)))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
- math-living-dangerously
- (list 'calcFunc-sqrt (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
- math-living-dangerously
- (math-div (nth 1 (nth 1 expr))
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
- (let ((m (math-should-expand-trig (nth 1 expr) t)))
- (and m (integerp (car m))
- (let ((n (car m)) (a (nth 1 m)))
- (if (> n 1)
- (list '+
- (list '* (list 'calcFunc-sinh (list '* (1- n) a))
- (list 'calcFunc-cosh a))
- (list '* (list 'calcFunc-cosh (list '* (1- n) a))
- (list 'calcFunc-sinh a)))))))))
-
-(math-defsimplify calcFunc-cosh
- (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
- (nth 1 (nth 1 expr)))
- (and (math-looks-negp (nth 1 expr))
- (list 'calcFunc-cosh (math-neg (nth 1 expr))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
- math-living-dangerously
- (list 'calcFunc-sqrt (math-add (math-sqr (nth 1 (nth 1 expr))) 1)))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
- math-living-dangerously
- (math-div 1
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))
- (let ((m (math-should-expand-trig (nth 1 expr) t)))
- (and m (integerp (car m))
- (let ((n (car m)) (a (nth 1 m)))
- (if (> n 1)
- (list '+
- (list '* (list 'calcFunc-cosh (list '* (1- n) a))
- (list 'calcFunc-cosh a))
- (list '* (list 'calcFunc-sinh (list '* (1- n) a))
- (list 'calcFunc-sinh a)))))))))
-
-(math-defsimplify calcFunc-tanh
- (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)
- (nth 1 (nth 1 expr)))
- (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-tanh (math-neg (nth 1 expr)))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)
- math-living-dangerously
- (math-div (nth 1 (nth 1 expr))
- (list 'calcFunc-sqrt
- (math-add (math-sqr (nth 1 (nth 1 expr))) 1))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)
- math-living-dangerously
- (math-div (list 'calcFunc-sqrt
- (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))
- (nth 1 (nth 1 expr))))
- (let ((m (math-should-expand-trig (nth 1 expr) t)))
- (and m
- (if (equal (car m) '(frac 1 2))
- (math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1)
- (list 'calcFunc-sinh (nth 1 m)))
- (math-div (list 'calcFunc-sinh (nth 1 expr))
- (list 'calcFunc-cosh (nth 1 expr))))))))
-
-(math-defsimplify calcFunc-arcsin
- (or (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 expr)))))
- (and (eq (nth 1 expr) 1)
- (math-quarter-circle t))
- (and (equal (nth 1 expr) '(frac 1 2))
- (math-div (math-half-circle t) 6))
- (and math-living-dangerously
- (eq (car-safe (nth 1 expr)) 'calcFunc-sin)
- (nth 1 (nth 1 expr)))
- (and math-living-dangerously
- (eq (car-safe (nth 1 expr)) 'calcFunc-cos)
- (math-sub (math-quarter-circle t)
- (nth 1 (nth 1 expr))))))
-
-(math-defsimplify calcFunc-arccos
- (or (and (eq (nth 1 expr) 0)
- (math-quarter-circle t))
- (and (eq (nth 1 expr) -1)
- (math-half-circle t))
- (and (equal (nth 1 expr) '(frac 1 2))
- (math-div (math-half-circle t) 3))
- (and (equal (nth 1 expr) '(frac -1 2))
- (math-div (math-mul (math-half-circle t) 2) 3))
- (and math-living-dangerously
- (eq (car-safe (nth 1 expr)) 'calcFunc-cos)
- (nth 1 (nth 1 expr)))
- (and math-living-dangerously
- (eq (car-safe (nth 1 expr)) 'calcFunc-sin)
- (math-sub (math-quarter-circle t)
- (nth 1 (nth 1 expr))))))
-
-(math-defsimplify calcFunc-arctan
- (or (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-arctan (math-neg (nth 1 expr)))))
- (and (eq (nth 1 expr) 1)
- (math-div (math-half-circle t) 4))
- (and math-living-dangerously
- (eq (car-safe (nth 1 expr)) 'calcFunc-tan)
- (nth 1 (nth 1 expr)))))
-
-(math-defsimplify calcFunc-arcsinh
- (or (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 expr)))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-sinh)
- (or math-living-dangerously
- (math-known-realp (nth 1 (nth 1 expr))))
- (nth 1 (nth 1 expr)))))
-
-(math-defsimplify calcFunc-arccosh
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh)
- (or math-living-dangerously
- (math-known-realp (nth 1 (nth 1 expr))))
- (nth 1 (nth 1 expr))))
-
-(math-defsimplify calcFunc-arctanh
- (or (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 expr)))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-tanh)
- (or math-living-dangerously
- (math-known-realp (nth 1 (nth 1 expr))))
- (nth 1 (nth 1 expr)))))
-
-(math-defsimplify calcFunc-sqrt
- (math-simplify-sqrt))
-
-(defun math-simplify-sqrt ()
- (or (and (eq (car-safe (nth 1 expr)) 'frac)
- (math-div (list 'calcFunc-sqrt (math-mul (nth 1 (nth 1 expr))
- (nth 2 (nth 1 expr))))
- (nth 2 (nth 1 expr))))
- (let ((fac (if (math-objectp (nth 1 expr))
- (math-squared-factor (nth 1 expr))
- (math-common-constant-factor (nth 1 expr)))))
- (and fac (not (eq fac 1))
- (math-mul (math-normalize (list 'calcFunc-sqrt fac))
- (math-normalize
- (list 'calcFunc-sqrt
- (math-cancel-common-factor (nth 1 expr) fac))))))
- (and math-living-dangerously
- (or (and (eq (car-safe (nth 1 expr)) '-)
- (math-equal-int (nth 1 (nth 1 expr)) 1)
- (eq (car-safe (nth 2 (nth 1 expr))) '^)
- (math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2)
- (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr))))
- 'calcFunc-sin)
- (list 'calcFunc-cos
- (nth 1 (nth 1 (nth 2 (nth 1 expr))))))
- (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr))))
- 'calcFunc-cos)
- (list 'calcFunc-sin
- (nth 1 (nth 1 (nth 2 (nth 1 expr))))))))
- (and (eq (car-safe (nth 1 expr)) '-)
- (math-equal-int (nth 2 (nth 1 expr)) 1)
- (eq (car-safe (nth 1 (nth 1 expr))) '^)
- (math-equal-int (nth 2 (nth 1 (nth 1 expr))) 2)
- (and (eq (car-safe (nth 1 (nth 1 (nth 1 expr))))
- 'calcFunc-cosh)
- (list 'calcFunc-sinh
- (nth 1 (nth 1 (nth 1 (nth 1 expr)))))))
- (and (eq (car-safe (nth 1 expr)) '+)
- (let ((a (nth 1 (nth 1 expr)))
- (b (nth 2 (nth 1 expr))))
- (and (or (and (math-equal-int a 1)
- (setq a b b (nth 1 (nth 1 expr))))
- (math-equal-int b 1))
- (eq (car-safe a) '^)
- (math-equal-int (nth 2 a) 2)
- (or (and (eq (car-safe (nth 1 a)) 'calcFunc-sinh)
- (list 'calcFunc-cosh (nth 1 (nth 1 a))))
- (and (eq (car-safe (nth 1 a)) 'calcFunc-tan)
- (list '/ 1 (list 'calcFunc-cos
- (nth 1 (nth 1 a)))))))))
- (and (eq (car-safe (nth 1 expr)) '^)
- (list '^
- (nth 1 (nth 1 expr))
- (math-div (nth 2 (nth 1 expr)) 2)))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)
- (list '^ (nth 1 (nth 1 expr)) (math-div 1 4)))
- (and (memq (car-safe (nth 1 expr)) '(* /))
- (list (car (nth 1 expr))
- (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))
- (list 'calcFunc-sqrt (nth 2 (nth 1 expr)))))
- (and (memq (car-safe (nth 1 expr)) '(+ -))
- (not (math-any-floats (nth 1 expr)))
- (let ((f (calcFunc-factors (calcFunc-expand
- (nth 1 expr)))))
- (and (math-vectorp f)
- (or (> (length f) 2)
- (> (nth 2 (nth 1 f)) 1))
- (let ((out 1) (rest 1) (sums 1) fac pow)
- (while (setq f (cdr f))
- (setq fac (nth 1 (car f))
- pow (nth 2 (car f)))
- (if (> pow 1)
- (setq out (math-mul out (math-pow
- fac (/ pow 2)))
- pow (% pow 2)))
- (if (> pow 0)
- (if (memq (car-safe fac) '(+ -))
- (setq sums (math-mul-thru sums fac))
- (setq rest (math-mul rest fac)))))
- (and (not (and (eq out 1) (memq rest '(1 -1))))
- (math-mul
- out
- (list 'calcFunc-sqrt
- (math-mul sums rest))))))))))))
-
-;;; Rather than factoring x into primes, just check for the first ten primes.
-(defun math-squared-factor (x)
- (if (Math-integerp x)
- (let ((prsqr '(4 9 25 49 121 169 289 361 529 841))
- (fac 1)
- res)
- (while prsqr
- (if (eq (cdr (setq res (math-idivmod x (car prsqr)))) 0)
- (setq x (car res)
- fac (math-mul fac (car prsqr)))
- (setq prsqr (cdr prsqr))))
- fac)))
-
-(math-defsimplify calcFunc-exp
- (math-simplify-exp (nth 1 expr)))
-
-(defun math-simplify-exp (x)
- (or (and (eq (car-safe x) 'calcFunc-ln)
- (nth 1 x))
- (and math-living-dangerously
- (or (and (eq (car-safe x) 'calcFunc-arcsinh)
- (math-add (nth 1 x)
- (list 'calcFunc-sqrt
- (math-add (math-sqr (nth 1 x)) 1))))
- (and (eq (car-safe x) 'calcFunc-arccosh)
- (math-add (nth 1 x)
- (list 'calcFunc-sqrt
- (math-sub (math-sqr (nth 1 x)) 1))))
- (and (eq (car-safe x) 'calcFunc-arctanh)
- (math-div (list 'calcFunc-sqrt (math-add 1 (nth 1 x)))
- (list 'calcFunc-sqrt (math-sub 1 (nth 1 x)))))
- (let ((m (math-should-expand-trig x 'exp)))
- (and m (integerp (car m))
- (list '^ (list 'calcFunc-exp (nth 1 m)) (car m))))))
- (and calc-symbolic-mode
- (math-known-imagp x)
- (let* ((ip (calcFunc-im x))
- (n (math-linear-in ip '(var pi var-pi)))
- s c)
- (and n
- (setq s (math-known-sin (car n) (nth 1 n) 120 0))
- (setq c (math-known-sin (car n) (nth 1 n) 120 300))
- (list '+ c (list '* s '(var i var-i))))))))
-
-(math-defsimplify calcFunc-ln
- (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp)
- (or math-living-dangerously
- (math-known-realp (nth 1 (nth 1 expr))))
- (nth 1 (nth 1 expr)))
- (and (eq (car-safe (nth 1 expr)) '^)
- (equal (nth 1 (nth 1 expr)) '(var e var-e))
- (or math-living-dangerously
- (math-known-realp (nth 2 (nth 1 expr))))
- (nth 2 (nth 1 expr)))
- (and calc-symbolic-mode
- (math-known-negp (nth 1 expr))
- (math-add (list 'calcFunc-ln (math-neg (nth 1 expr)))
- '(* (var pi var-pi) (var i var-i))))
- (and calc-symbolic-mode
- (math-known-imagp (nth 1 expr))
- (let* ((ip (calcFunc-im (nth 1 expr)))
- (ips (math-possible-signs ip)))
- (or (and (memq ips '(4 6))
- (math-add (list 'calcFunc-ln ip)
- '(/ (* (var pi var-pi) (var i var-i)) 2)))
- (and (memq ips '(1 3))
- (math-sub (list 'calcFunc-ln (math-neg ip))
- '(/ (* (var pi var-pi) (var i var-i)) 2))))))))
-
-(math-defsimplify ^
- (math-simplify-pow))
-
-(defun math-simplify-pow ()
- (or (and math-living-dangerously
- (or (and (eq (car-safe (nth 1 expr)) '^)
- (list '^
- (nth 1 (nth 1 expr))
- (math-mul (nth 2 expr) (nth 2 (nth 1 expr)))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)
- (list '^
- (nth 1 (nth 1 expr))
- (math-div (nth 2 expr) 2)))
- (and (memq (car-safe (nth 1 expr)) '(* /))
- (list (car (nth 1 expr))
- (list '^ (nth 1 (nth 1 expr)) (nth 2 expr))
- (list '^ (nth 2 (nth 1 expr)) (nth 2 expr))))))
- (and (math-equal-int (nth 1 expr) 10)
- (eq (car-safe (nth 2 expr)) 'calcFunc-log10)
- (nth 1 (nth 2 expr)))
- (and (equal (nth 1 expr) '(var e var-e))
- (math-simplify-exp (nth 2 expr)))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp)
- (not math-integrating)
- (list 'calcFunc-exp (math-mul (nth 1 (nth 1 expr)) (nth 2 expr))))
- (and (equal (nth 1 expr) '(var i var-i))
- (math-imaginary-i)
- (math-num-integerp (nth 2 expr))
- (let ((x (math-mod (math-trunc (nth 2 expr)) 4)))
- (cond ((eq x 0) 1)
- ((eq x 1) (nth 1 expr))
- ((eq x 2) -1)
- ((eq x 3) (math-neg (nth 1 expr))))))
- (and math-integrating
- (integerp (nth 2 expr))
- (>= (nth 2 expr) 2)
- (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-cos)
- (math-mul (math-pow (nth 1 expr) (- (nth 2 expr) 2))
- (math-sub 1
- (math-sqr
- (list 'calcFunc-sin
- (nth 1 (nth 1 expr)))))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh)
- (math-mul (math-pow (nth 1 expr) (- (nth 2 expr) 2))
- (math-add 1
- (math-sqr
- (list 'calcFunc-sinh
- (nth 1 (nth 1 expr)))))))))
- (and (eq (car-safe (nth 2 expr)) 'frac)
- (Math-ratp (nth 1 expr))
- (Math-posp (nth 1 expr))
- (if (equal (nth 2 expr) '(frac 1 2))
- (list 'calcFunc-sqrt (nth 1 expr))
- (let ((flr (math-floor (nth 2 expr))))
- (and (not (Math-zerop flr))
- (list '* (list '^ (nth 1 expr) flr)
- (list '^ (nth 1 expr)
- (math-sub (nth 2 expr) flr)))))))
- (and (eq (math-quarter-integer (nth 2 expr)) 2)
- (let ((temp (math-simplify-sqrt)))
- (and temp
- (list '^ temp (math-mul (nth 2 expr) 2)))))))
-
-(math-defsimplify calcFunc-log10
- (and (eq (car-safe (nth 1 expr)) '^)
- (math-equal-int (nth 1 (nth 1 expr)) 10)
- (or math-living-dangerously
- (math-known-realp (nth 2 (nth 1 expr))))
- (nth 2 (nth 1 expr))))
-
-
-(math-defsimplify calcFunc-erf
- (or (and (math-looks-negp (nth 1 expr))
- (math-neg (list 'calcFunc-erf (math-neg (nth 1 expr)))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj)
- (list 'calcFunc-conj (list 'calcFunc-erf (nth 1 (nth 1 expr)))))))
-
-(math-defsimplify calcFunc-erfc
- (or (and (math-looks-negp (nth 1 expr))
- (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 expr)))))
- (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj)
- (list 'calcFunc-conj (list 'calcFunc-erfc (nth 1 (nth 1 expr)))))))
-
-
-(defun math-linear-in (expr term &optional always)
- (if (math-expr-contains expr term)
- (let* ((calc-prefer-frac t)
- (p (math-is-polynomial expr term 1)))
- (and (cdr p)
- p))
- (and always (list expr 0))))
-
-(defun math-multiple-of (expr term)
- (let ((p (math-linear-in expr term)))
- (and p
- (math-zerop (car p))
- (nth 1 p))))
-
-; not perfect, but it'll do
-(defun math-integer-plus (expr)
- (cond ((Math-integerp expr)
- (list 0 expr))
- ((and (memq (car expr) '(+ -))
- (Math-integerp (nth 1 expr)))
- (list (if (eq (car expr) '+) (nth 2 expr) (math-neg (nth 2 expr)))
- (nth 1 expr)))
- ((and (memq (car expr) '(+ -))
- (Math-integerp (nth 2 expr)))
- (list (nth 1 expr)
- (if (eq (car expr) '+) (nth 2 expr) (math-neg (nth 2 expr)))))
- (t nil)))
-
-(defun math-is-linear (expr &optional always)
- (let ((offset nil)
- (coef nil))
- (if (eq (car-safe expr) '+)
- (if (Math-objectp (nth 1 expr))
- (setq offset (nth 1 expr)
- expr (nth 2 expr))
- (if (Math-objectp (nth 2 expr))
- (setq offset (nth 2 expr)
- expr (nth 1 expr))))
- (if (eq (car-safe expr) '-)
- (if (Math-objectp (nth 1 expr))
- (setq offset (nth 1 expr)
- expr (math-neg (nth 2 expr)))
- (if (Math-objectp (nth 2 expr))
- (setq offset (math-neg (nth 2 expr))
- expr (nth 1 expr))))))
- (setq coef (math-is-multiple expr always))
- (if offset
- (list offset (or (car coef) 1) (or (nth 1 coef) expr))
- (if coef
- (cons 0 coef)))))
-
-(defun math-is-multiple (expr &optional always)
- (or (if (eq (car-safe expr) '*)
- (if (Math-objectp (nth 1 expr))
- (list (nth 1 expr) (nth 2 expr)))
- (if (eq (car-safe expr) '/)
- (if (and (Math-objectp (nth 1 expr))
- (not (math-equal-int (nth 1 expr) 1)))
- (list (nth 1 expr) (math-div 1 (nth 2 expr)))
- (if (Math-objectp (nth 2 expr))
- (list (math-div 1 (nth 2 expr)) (nth 1 expr))
- (let ((res (math-is-multiple (nth 1 expr))))
- (if res
- (list (car res)
- (math-div (nth 2 (nth 1 expr)) (nth 2 expr)))
- (setq res (math-is-multiple (nth 2 expr)))
- (if res
- (list (math-div 1 (car res))
- (math-div (nth 1 expr)
- (nth 2 (nth 2 expr)))))))))
- (if (eq (car-safe expr) 'neg)
- (list -1 (nth 1 expr)))))
- (if (Math-objvecp expr)
- (and (eq always 1)
- (list expr 1))
- (and always
- (list 1 expr)))))
-
-(defun calcFunc-lin (expr &optional var)
- (if var
- (let ((res (math-linear-in expr var t)))
- (or res (math-reject-arg expr "Linear term expected"))
- (list 'vec (car res) (nth 1 res) var))
- (let ((res (math-is-linear expr t)))
- (or res (math-reject-arg expr "Linear term expected"))
- (cons 'vec res))))
-
-(defun calcFunc-linnt (expr &optional var)
- (if var
- (let ((res (math-linear-in expr var)))
- (or res (math-reject-arg expr "Linear term expected"))
- (list 'vec (car res) (nth 1 res) var))
- (let ((res (math-is-linear expr)))
- (or res (math-reject-arg expr "Linear term expected"))
- (cons 'vec res))))
-
-(defun calcFunc-islin (expr &optional var)
- (if (and (Math-objvecp expr) (not var))
- 0
- (calcFunc-lin expr var)
- 1))
-
-(defun calcFunc-islinnt (expr &optional var)
- (if (Math-objvecp expr)
- 0
- (calcFunc-linnt expr var)
- 1))
-
-
-
-
-;;; Simple operations on expressions.
-
-;;; Return number of occurrences of thing in expr, or nil if none.
-(defun math-expr-contains-count (expr thing)
- (cond ((equal expr thing) 1)
- ((Math-primp expr) nil)
- (t
- (let ((num 0))
- (while (setq expr (cdr expr))
- (setq num (+ num (or (math-expr-contains-count
- (car expr) thing) 0))))
- (and (> num 0)
- num)))))
-
-(defun math-expr-contains (expr thing)
- (cond ((equal expr thing) 1)
- ((Math-primp expr) nil)
- (t
- (while (and (setq expr (cdr expr))
- (not (math-expr-contains (car expr) thing))))
- expr)))
-
-;;; Return non-nil if any variable of thing occurs in expr.
-(defun math-expr-depends (expr thing)
- (if (Math-primp thing)
- (and (eq (car-safe thing) 'var)
- (math-expr-contains expr thing))
- (while (and (setq thing (cdr thing))
- (not (math-expr-depends expr (car thing)))))
- thing))
-
-;;; Substitute all occurrences of old for new in expr (non-destructive).
-(defun math-expr-subst (expr old new)
- (math-expr-subst-rec expr))
-
-(defalias 'calcFunc-subst 'math-expr-subst)
-
-(defun math-expr-subst-rec (expr)
- (cond ((equal expr old) new)
- ((Math-primp expr) expr)
- ((memq (car expr) '(calcFunc-deriv
- calcFunc-tderiv))
- (if (= (length expr) 2)
- (if (equal (nth 1 expr) old)
- (append expr (list new))
- expr)
- (list (car expr) (nth 1 expr)
- (math-expr-subst-rec (nth 2 expr)))))
- (t
- (cons (car expr)
- (mapcar 'math-expr-subst-rec (cdr expr))))))
-
-;;; Various measures of the size of an expression.
-(defun math-expr-weight (expr)
- (if (Math-primp expr)
- 1
- (let ((w 1))
- (while (setq expr (cdr expr))
- (setq w (+ w (math-expr-weight (car expr)))))
- w)))
-
-(defun math-expr-height (expr)
- (if (Math-primp expr)
- 0
- (let ((h 0))
- (while (setq expr (cdr expr))
- (setq h (max h (math-expr-height (car expr)))))
- (1+ h))))
-
-
-
-
-;;; Polynomial operations (to support the integrator and solve-for).
-
-(defun calcFunc-collect (expr base)
- (let ((p (math-is-polynomial expr base 50 t)))
- (if (cdr p)
- (math-normalize ; fix selection bug
- (math-build-polynomial-expr p base))
- expr)))
-
-;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...),
-;;; else return nil if not in polynomial form. If "loose", coefficients
-;;; may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x.
-(defun math-is-polynomial (expr var &optional degree loose)
- (let* ((math-poly-base-variable (if loose
- (if (eq loose 'gen) var '(var XXX XXX))
- math-poly-base-variable))
- (poly (math-is-poly-rec expr math-poly-neg-powers)))
- (and (or (null degree)
- (<= (length poly) (1+ degree)))
- poly)))
-
-(defun math-is-poly-rec (expr negpow)
- (math-poly-simplify
- (or (cond ((or (equal expr var)
- (eq (car-safe expr) '^))
- (let ((pow 1)
- (expr expr))
- (or (equal expr var)
- (setq pow (nth 2 expr)
- expr (nth 1 expr)))
- (or (eq math-poly-mult-powers 1)
- (setq pow (let ((m (math-is-multiple pow 1)))
- (and (eq (car-safe (car m)) 'cplx)
- (Math-zerop (nth 1 (car m)))
- (setq m (list (nth 2 (car m))
- (math-mul (nth 1 m)
- '(var i var-i)))))
- (and (if math-poly-mult-powers
- (equal math-poly-mult-powers
- (nth 1 m))
- (setq math-poly-mult-powers (nth 1 m)))
- (or (equal expr var)
- (eq math-poly-mult-powers 1))
- (car m)))))
- (if (consp pow)
- (progn
- (setq pow (math-to-simple-fraction pow))
- (and (eq (car-safe pow) 'frac)
- math-poly-frac-powers
- (equal expr var)
- (setq math-poly-frac-powers
- (calcFunc-lcm math-poly-frac-powers
- (nth 2 pow))))))
- (or (memq math-poly-frac-powers '(1 nil))
- (setq pow (math-mul pow math-poly-frac-powers)))
- (if (integerp pow)
- (if (and (= pow 1)
- (equal expr var))
- (list 0 1)
- (if (natnump pow)
- (let ((p1 (if (equal expr var)
- (list 0 1)
- (math-is-poly-rec expr nil)))
- (n pow)
- (accum (list 1)))
- (and p1
- (or (null degree)
- (<= (* (1- (length p1)) n) degree))
- (progn
- (while (>= n 1)
- (setq accum (math-poly-mul accum p1)
- n (1- n)))
- accum)))
- (and negpow
- (math-is-poly-rec expr nil)
- (setq math-poly-neg-powers
- (cons (math-pow expr (- pow))
- math-poly-neg-powers))
- (list (list '^ expr pow))))))))
- ((Math-objectp expr)
- (list expr))
- ((memq (car expr) '(+ -))
- (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
- (and p1
- (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
- (and p2
- (math-poly-mix p1 1 p2
- (if (eq (car expr) '+) 1 -1)))))))
- ((eq (car expr) 'neg)
- (mapcar 'math-neg (math-is-poly-rec (nth 1 expr) negpow)))
- ((eq (car expr) '*)
- (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
- (and p1
- (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
- (and p2
- (or (null degree)
- (<= (- (+ (length p1) (length p2)) 2) degree))
- (math-poly-mul p1 p2))))))
- ((eq (car expr) '/)
- (and (or (not (math-poly-depends (nth 2 expr) var))
- (and negpow
- (math-is-poly-rec (nth 2 expr) nil)
- (setq math-poly-neg-powers
- (cons (nth 2 expr) math-poly-neg-powers))))
- (not (Math-zerop (nth 2 expr)))
- (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
- (mapcar (function (lambda (x) (math-div x (nth 2 expr))))
- p1))))
- ((and (eq (car expr) 'calcFunc-exp)
- (equal var '(var e var-e)))
- (math-is-poly-rec (list '^ var (nth 1 expr)) negpow))
- ((and (eq (car expr) 'calcFunc-sqrt)
- math-poly-frac-powers)
- (math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow))
- (t nil))
- (and (or (not (math-poly-depends expr var))
- loose)
- (not (eq (car expr) 'vec))
- (list expr)))))
-
-;;; Check if expr is a polynomial in var; if so, return its degree.
-(defun math-polynomial-p (expr var)
- (cond ((equal expr var) 1)
- ((Math-primp expr) 0)
- ((memq (car expr) '(+ -))
- (let ((p1 (math-polynomial-p (nth 1 expr) var))
- p2)
- (and p1 (setq p2 (math-polynomial-p (nth 2 expr) var))
- (max p1 p2))))
- ((eq (car expr) '*)
- (let ((p1 (math-polynomial-p (nth 1 expr) var))
- p2)
- (and p1 (setq p2 (math-polynomial-p (nth 2 expr) var))
- (+ p1 p2))))
- ((eq (car expr) 'neg)
- (math-polynomial-p (nth 1 expr) var))
- ((and (eq (car expr) '/)
- (not (math-poly-depends (nth 2 expr) var)))
- (math-polynomial-p (nth 1 expr) var))
- ((and (eq (car expr) '^)
- (natnump (nth 2 expr)))
- (let ((p1 (math-polynomial-p (nth 1 expr) var)))
- (and p1 (* p1 (nth 2 expr)))))
- ((math-poly-depends expr var) nil)
- (t 0)))
-
-(defun math-poly-depends (expr var)
- (if math-poly-base-variable
- (math-expr-contains expr math-poly-base-variable)
- (math-expr-depends expr var)))
-
-;;; Find the variable (or sub-expression) which is the base of polynomial expr.
-(defun math-polynomial-base (mpb-top-expr &optional mpb-pred)
- (or mpb-pred
- (setq mpb-pred (function (lambda (base) (math-polynomial-p
- mpb-top-expr base)))))
- (or (let ((const-ok nil))
- (math-polynomial-base-rec mpb-top-expr))
- (let ((const-ok t))
- (math-polynomial-base-rec mpb-top-expr))))
-
-(defun math-polynomial-base-rec (mpb-expr)
- (and (not (Math-objvecp mpb-expr))
- (or (and (memq (car mpb-expr) '(+ - *))
- (or (math-polynomial-base-rec (nth 1 mpb-expr))
- (math-polynomial-base-rec (nth 2 mpb-expr))))
- (and (memq (car mpb-expr) '(/ neg))
- (math-polynomial-base-rec (nth 1 mpb-expr)))
- (and (eq (car mpb-expr) '^)
- (math-polynomial-base-rec (nth 1 mpb-expr)))
- (and (eq (car mpb-expr) 'calcFunc-exp)
- (math-polynomial-base-rec '(var e var-e)))
- (and (or const-ok (math-expr-contains-vars mpb-expr))
- (funcall mpb-pred mpb-expr)
- mpb-expr))))
-
-;;; Return non-nil if expr refers to any variables.
-(defun math-expr-contains-vars (expr)
- (or (eq (car-safe expr) 'var)
- (and (not (Math-primp expr))
- (progn
- (while (and (setq expr (cdr expr))
- (not (math-expr-contains-vars (car expr)))))
- expr))))
-
-;;; Simplify a polynomial in list form by stripping off high-end zeros.
-;;; This always leaves the constant part, i.e., nil->nil and nonnil->nonnil.
-(defun math-poly-simplify (p)
- (and p
- (if (Math-zerop (nth (1- (length p)) p))
- (let ((pp (copy-sequence p)))
- (while (and (cdr pp)
- (Math-zerop (nth (1- (length pp)) pp)))
- (setcdr (nthcdr (- (length pp) 2) pp) nil))
- pp)
- p)))
-
-;;; Compute ac*a + bc*b for polynomials in list form a, b and
-;;; coefficients ac, bc. Result may be unsimplified.
-(defun math-poly-mix (a ac b bc)
- (and (or a b)
- (cons (math-add (math-mul (or (car a) 0) ac)
- (math-mul (or (car b) 0) bc))
- (math-poly-mix (cdr a) ac (cdr b) bc))))
-
-(defun math-poly-zerop (a)
- (or (null a)
- (and (null (cdr a)) (Math-zerop (car a)))))
-
-;;; Multiply two polynomials in list form.
-(defun math-poly-mul (a b)
- (and a b
- (math-poly-mix b (car a)
- (math-poly-mul (cdr a) (cons 0 b)) 1)))
-
-;;; Build an expression from a polynomial list.
-(defun math-build-polynomial-expr (p var)
- (if p
- (if (Math-numberp var)
- (math-with-extra-prec 1
- (let* ((rp (reverse p))
- (accum (car rp)))
- (while (setq rp (cdr rp))
- (setq accum (math-add (car rp) (math-mul accum var))))
- accum))
- (let* ((rp (reverse p))
- (n (1- (length rp)))
- (accum (math-mul (car rp) (math-pow var n)))
- term)
- (while (setq rp (cdr rp))
- (setq n (1- n))
- (or (math-zerop (car rp))
- (setq accum (list (if (math-looks-negp (car rp)) '- '+)
- accum
- (math-mul (if (math-looks-negp (car rp))
- (math-neg (car rp))
- (car rp))
- (math-pow var n))))))
- accum))
- 0))
-
-
-(defun math-to-simple-fraction (f)
- (or (and (eq (car-safe f) 'float)
- (or (and (>= (nth 2 f) 0)
- (math-scale-int (nth 1 f) (nth 2 f)))
- (and (integerp (nth 1 f))
- (> (nth 1 f) -1000)
- (< (nth 1 f) 1000)
- (math-make-frac (nth 1 f)
- (math-scale-int 1 (- (nth 2 f)))))))
- f))
-
-;;; calc-alg.el ends here
+++ /dev/null
-;;; calc-arith.el --- arithmetic functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-arith () nil)
-
-
-;;; Arithmetic.
-
-(defun calc-min (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "min" 'calcFunc-min arg '(var inf var-inf))))
-
-(defun calc-max (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "max" 'calcFunc-max arg '(neg (var inf var-inf)))))
-
-(defun calc-abs (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "abs" 'calcFunc-abs arg)))
-
-
-(defun calc-idiv (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "\\" 'calcFunc-idiv arg 1)))
-
-
-(defun calc-floor (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (if (calc-is-hyperbolic)
- (calc-unary-op "ceil" 'calcFunc-fceil arg)
- (calc-unary-op "ceil" 'calcFunc-ceil arg))
- (if (calc-is-hyperbolic)
- (calc-unary-op "flor" 'calcFunc-ffloor arg)
- (calc-unary-op "flor" 'calcFunc-floor arg)))))
-
-(defun calc-ceiling (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-floor arg))
-
-(defun calc-round (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (if (calc-is-hyperbolic)
- (calc-unary-op "trnc" 'calcFunc-ftrunc arg)
- (calc-unary-op "trnc" 'calcFunc-trunc arg))
- (if (calc-is-hyperbolic)
- (calc-unary-op "rond" 'calcFunc-fround arg)
- (calc-unary-op "rond" 'calcFunc-round arg)))))
-
-(defun calc-trunc (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-round arg))
-
-(defun calc-mant-part (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "mant" 'calcFunc-mant arg)))
-
-(defun calc-xpon-part (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "xpon" 'calcFunc-xpon arg)))
-
-(defun calc-scale-float (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "scal" 'calcFunc-scf arg)))
-
-(defun calc-abssqr (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "absq" 'calcFunc-abssqr arg)))
-
-(defun calc-sign (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "sign" 'calcFunc-sign arg)))
-
-(defun calc-increment (arg)
- (interactive "p")
- (calc-wrapper
- (calc-enter-result 1 "incr" (list 'calcFunc-incr (calc-top-n 1) arg))))
-
-(defun calc-decrement (arg)
- (interactive "p")
- (calc-wrapper
- (calc-enter-result 1 "decr" (list 'calcFunc-decr (calc-top-n 1) arg))))
-
-
-(defun math-abs-approx (a)
- (cond ((Math-negp a)
- (math-neg a))
- ((Math-anglep a)
- a)
- ((eq (car a) 'cplx)
- (math-add (math-abs (nth 1 a)) (math-abs (nth 2 a))))
- ((eq (car a) 'polar)
- (nth 1 a))
- ((eq (car a) 'sdev)
- (math-abs-approx (nth 1 a)))
- ((eq (car a) 'intv)
- (math-max (math-abs (nth 2 a)) (math-abs (nth 3 a))))
- ((eq (car a) 'date)
- a)
- ((eq (car a) 'vec)
- (math-reduce-vec 'math-add-abs-approx a))
- ((eq (car a) 'calcFunc-abs)
- (car a))
- (t a)))
-
-(defun math-add-abs-approx (a b)
- (math-add (math-abs-approx a) (math-abs-approx b)))
-
-
-;;;; Declarations.
-
-(defvar math-decls-cache-tag nil)
-(defvar math-decls-cache nil)
-(defvar math-decls-all nil)
-
-;;; Math-decls-cache is an a-list where each entry is a list of the form:
-;;; (VAR TYPES RANGE)
-;;; where VAR is a variable name (with var- prefix) or function name;
-;;; TYPES is a list of type symbols (any, int, frac, ...)
-;;; RANGE is a sorted vector of intervals describing the range.
-
-(defun math-setup-declarations ()
- (or (eq math-decls-cache-tag (calc-var-value 'var-Decls))
- (let ((p (calc-var-value 'var-Decls))
- vec type range)
- (setq math-decls-cache-tag p
- math-decls-cache nil)
- (and (eq (car-safe p) 'vec)
- (while (setq p (cdr p))
- (and (eq (car-safe (car p)) 'vec)
- (setq vec (nth 2 (car p)))
- (condition-case err
- (let ((v (nth 1 (car p))))
- (setq type nil range nil)
- (or (eq (car-safe vec) 'vec)
- (setq vec (list 'vec vec)))
- (while (and (setq vec (cdr vec))
- (not (Math-objectp (car vec))))
- (and (eq (car-safe (car vec)) 'var)
- (let ((st (assq (nth 1 (car vec))
- math-super-types)))
- (cond (st (setq type (append type st)))
- ((eq (nth 1 (car vec)) 'pos)
- (setq type (append type
- '(real number))
- range
- '(intv 1 0 (var inf var-inf))))
- ((eq (nth 1 (car vec)) 'nonneg)
- (setq type (append type
- '(real number))
- range
- '(intv 3 0
- (var inf var-inf))))))))
- (if vec
- (setq type (append type '(real number))
- range (math-prepare-set (cons 'vec vec))))
- (setq type (list type range))
- (or (eq (car-safe v) 'vec)
- (setq v (list 'vec v)))
- (while (setq v (cdr v))
- (if (or (eq (car-safe (car v)) 'var)
- (not (Math-primp (car v))))
- (setq math-decls-cache
- (cons (cons (if (eq (car (car v)) 'var)
- (nth 2 (car v))
- (car (car v)))
- type)
- math-decls-cache)))))
- (error nil)))))
- (setq math-decls-all (assq 'var-All math-decls-cache)))))
-
-(defvar math-super-types
- '((int numint rat real number)
- (numint real number)
- (frac rat real number)
- (rat real number)
- (float real number)
- (real number)
- (number)
- (scalar)
- (matrix vector)
- (vector)
- (const)))
-
-(defun math-known-scalarp (a &optional assume-scalar)
- (math-setup-declarations)
- (if (if calc-matrix-mode
- (eq calc-matrix-mode 'scalar)
- assume-scalar)
- (not (math-check-known-matrixp a))
- (math-check-known-scalarp a)))
-
-(defun math-known-matrixp (a)
- (and (not (Math-scalarp a))
- (not (math-known-scalarp a t))))
-
-;;; Try to prove that A is a scalar (i.e., a non-vector).
-(defun math-check-known-scalarp (a)
- (cond ((Math-objectp a) t)
- ((memq (car a) math-scalar-functions)
- t)
- ((memq (car a) math-real-scalar-functions)
- t)
- ((memq (car a) math-scalar-if-args-functions)
- (while (and (setq a (cdr a))
- (math-check-known-scalarp (car a))))
- (null a))
- ((eq (car a) '^)
- (math-check-known-scalarp (nth 1 a)))
- ((math-const-var a) t)
- (t
- (let ((decl (if (eq (car a) 'var)
- (or (assq (nth 2 a) math-decls-cache)
- math-decls-all)
- (assq (car a) math-decls-cache))))
- (memq 'scalar (nth 1 decl))))))
-
-;;; Try to prove that A is *not* a scalar.
-(defun math-check-known-matrixp (a)
- (cond ((Math-objectp a) nil)
- ((memq (car a) math-nonscalar-functions)
- t)
- ((memq (car a) math-scalar-if-args-functions)
- (while (and (setq a (cdr a))
- (not (math-check-known-matrixp (car a)))))
- a)
- ((eq (car a) '^)
- (math-check-known-matrixp (nth 1 a)))
- ((math-const-var a) nil)
- (t
- (let ((decl (if (eq (car a) 'var)
- (or (assq (nth 2 a) math-decls-cache)
- math-decls-all)
- (assq (car a) math-decls-cache))))
- (memq 'vector (nth 1 decl))))))
-
-
-;;; Try to prove that A is a real (i.e., not complex).
-(defun math-known-realp (a)
- (< (math-possible-signs a) 8))
-
-;;; Try to prove that A is real and positive.
-(defun math-known-posp (a)
- (eq (math-possible-signs a) 4))
-
-;;; Try to prove that A is real and negative.
-(defun math-known-negp (a)
- (eq (math-possible-signs a) 1))
-
-;;; Try to prove that A is real and nonnegative.
-(defun math-known-nonnegp (a)
- (memq (math-possible-signs a) '(2 4 6)))
-
-;;; Try to prove that A is real and nonpositive.
-(defun math-known-nonposp (a)
- (memq (math-possible-signs a) '(1 2 3)))
-
-;;; Try to prove that A is nonzero.
-(defun math-known-nonzerop (a)
- (memq (math-possible-signs a) '(1 4 5 8 9 12 13)))
-
-;;; Return true if A is negative, or looks negative but we don't know.
-(defun math-guess-if-neg (a)
- (let ((sgn (math-possible-signs a)))
- (if (memq sgn '(1 3))
- t
- (if (memq sgn '(2 4 6))
- nil
- (math-looks-negp a)))))
-
-;;; Find the possible signs of A, assuming A is a number of some kind.
-;;; Returns an integer with bits: 1 may be negative,
-;;; 2 may be zero,
-;;; 4 may be positive,
-;;; 8 may be nonreal.
-
-(defun math-possible-signs (a &optional origin)
- (cond ((Math-objectp a)
- (if origin (setq a (math-sub a origin)))
- (cond ((Math-posp a) 4)
- ((Math-negp a) 1)
- ((Math-zerop a) 2)
- ((eq (car a) 'intv)
- (cond ((Math-zerop (nth 2 a)) 6)
- ((Math-zerop (nth 3 a)) 3)
- (t 7)))
- ((eq (car a) 'sdev)
- (if (math-known-realp (nth 1 a)) 7 15))
- (t 8)))
- ((memq (car a) '(+ -))
- (cond ((Math-realp (nth 1 a))
- (if (eq (car a) '-)
- (math-neg-signs
- (math-possible-signs (nth 2 a)
- (if origin
- (math-add origin (nth 1 a))
- (nth 1 a))))
- (math-possible-signs (nth 2 a)
- (if origin
- (math-sub origin (nth 1 a))
- (math-neg (nth 1 a))))))
- ((Math-realp (nth 2 a))
- (let ((org (if (eq (car a) '-)
- (nth 2 a)
- (math-neg (nth 2 a)))))
- (math-possible-signs (nth 1 a)
- (if origin
- (math-add origin org)
- org))))
- (t
- (let ((s1 (math-possible-signs (nth 1 a) origin))
- (s2 (math-possible-signs (nth 2 a))))
- (if (eq (car a) '-) (setq s2 (math-neg-signs s2)))
- (cond ((eq s1 s2) s1)
- ((eq s1 2) s2)
- ((eq s2 2) s1)
- ((>= s1 8) 15)
- ((>= s2 8) 15)
- ((and (eq s1 4) (eq s2 6)) 4)
- ((and (eq s2 4) (eq s1 6)) 4)
- ((and (eq s1 1) (eq s2 3)) 1)
- ((and (eq s2 1) (eq s1 3)) 1)
- (t 7))))))
- ((eq (car a) 'neg)
- (math-neg-signs (math-possible-signs
- (nth 1 a)
- (and origin (math-neg origin)))))
- ((and origin (Math-zerop origin) (setq origin nil)
- nil))
- ((and (or (eq (car a) '*)
- (and (eq (car a) '/) origin))
- (Math-realp (nth 1 a)))
- (let ((s (if (eq (car a) '*)
- (if (Math-zerop (nth 1 a))
- (math-possible-signs 0 origin)
- (math-possible-signs (nth 2 a)
- (math-div (or origin 0)
- (nth 1 a))))
- (math-neg-signs
- (math-possible-signs (nth 2 a)
- (math-div (nth 1 a)
- origin))))))
- (if (Math-negp (nth 1 a)) (math-neg-signs s) s)))
- ((and (memq (car a) '(* /)) (Math-realp (nth 2 a)))
- (let ((s (math-possible-signs (nth 1 a)
- (if (eq (car a) '*)
- (math-mul (or origin 0) (nth 2 a))
- (math-div (or origin 0) (nth 2 a))))))
- (if (Math-negp (nth 2 a)) (math-neg-signs s) s)))
- ((eq (car a) 'vec)
- (let ((signs 0))
- (while (and (setq a (cdr a)) (< signs 15))
- (setq signs (logior signs (math-possible-signs
- (car a) origin))))
- signs))
- (t (let ((sign
- (cond
- ((memq (car a) '(* /))
- (let ((s1 (math-possible-signs (nth 1 a)))
- (s2 (math-possible-signs (nth 2 a))))
- (cond ((>= s1 8) 15)
- ((>= s2 8) 15)
- ((and (eq (car a) '/) (memq s2 '(2 3 6 7))) 15)
- (t
- (logior (if (memq s1 '(4 5 6 7)) s2 0)
- (if (memq s1 '(2 3 6 7)) 2 0)
- (if (memq s1 '(1 3 5 7))
- (math-neg-signs s2) 0))))))
- ((eq (car a) '^)
- (let ((s1 (math-possible-signs (nth 1 a)))
- (s2 (math-possible-signs (nth 2 a))))
- (cond ((>= s1 8) 15)
- ((>= s2 8) 15)
- ((eq s1 4) 4)
- ((eq s1 2) (if (eq s2 4) 2 15))
- ((eq s2 2) (if (memq s1 '(1 5)) 2 15))
- ((Math-integerp (nth 2 a))
- (if (math-evenp (nth 2 a))
- (if (memq s1 '(3 6 7)) 6 4)
- s1))
- ((eq s1 6) (if (eq s2 4) 6 15))
- (t 7))))
- ((eq (car a) '%)
- (let ((s2 (math-possible-signs (nth 2 a))))
- (cond ((>= s2 8) 7)
- ((eq s2 2) 2)
- ((memq s2 '(4 6)) 6)
- ((memq s2 '(1 3)) 3)
- (t 7))))
- ((and (memq (car a) '(calcFunc-abs calcFunc-abssqr))
- (= (length a) 2))
- (let ((s1 (math-possible-signs (nth 1 a))))
- (cond ((eq s1 2) 2)
- ((memq s1 '(1 4 5)) 4)
- (t 6))))
- ((and (eq (car a) 'calcFunc-exp) (= (length a) 2))
- (let ((s1 (math-possible-signs (nth 1 a))))
- (if (>= s1 8)
- 15
- (if (or (not origin) (math-negp origin))
- 4
- (setq origin (math-sub (or origin 0) 1))
- (if (Math-zerop origin) (setq origin nil))
- s1))))
- ((or (and (memq (car a) '(calcFunc-ln calcFunc-log10))
- (= (length a) 2))
- (and (eq (car a) 'calcFunc-log)
- (= (length a) 3)
- (math-known-posp (nth 2 a))))
- (if (math-known-nonnegp (nth 1 a))
- (math-possible-signs (nth 1 a) 1)
- 15))
- ((and (eq (car a) 'calcFunc-sqrt) (= (length a) 2))
- (let ((s1 (math-possible-signs (nth 1 a))))
- (if (memq s1 '(2 4 6)) s1 15)))
- ((memq (car a) math-nonnegative-functions) 6)
- ((memq (car a) math-positive-functions) 4)
- ((memq (car a) math-real-functions) 7)
- ((memq (car a) math-real-scalar-functions) 7)
- ((and (memq (car a) math-real-if-arg-functions)
- (= (length a) 2))
- (if (math-known-realp (nth 1 a)) 7 15)))))
- (cond (sign
- (if origin
- (+ (logand sign 8)
- (if (Math-posp origin)
- (if (memq sign '(1 2 3 8 9 10 11)) 1 7)
- (if (memq sign '(2 4 6 8 10 12 14)) 4 7)))
- sign))
- ((math-const-var a)
- (cond ((eq (nth 2 a) 'var-pi)
- (if origin
- (math-possible-signs (math-pi) origin)
- 4))
- ((eq (nth 2 a) 'var-e)
- (if origin
- (math-possible-signs (math-e) origin)
- 4))
- ((eq (nth 2 a) 'var-inf) 4)
- ((eq (nth 2 a) 'var-uinf) 13)
- ((eq (nth 2 a) 'var-i) 8)
- (t 15)))
- (t
- (math-setup-declarations)
- (let ((decl (if (eq (car a) 'var)
- (or (assq (nth 2 a) math-decls-cache)
- math-decls-all)
- (assq (car a) math-decls-cache))))
- (if (and origin
- (memq 'int (nth 1 decl))
- (not (Math-num-integerp origin)))
- 5
- (if (nth 2 decl)
- (math-possible-signs (nth 2 decl) origin)
- (if (memq 'real (nth 1 decl))
- 7
- 15))))))))))
-
-(defun math-neg-signs (s1)
- (if (>= s1 8)
- (+ 8 (math-neg-signs (- s1 8)))
- (+ (if (memq s1 '(1 3 5 7)) 4 0)
- (if (memq s1 '(2 3 6 7)) 2 0)
- (if (memq s1 '(4 5 6 7)) 1 0))))
-
-
-;;; Try to prove that A is an integer.
-(defun math-known-integerp (a)
- (eq (math-possible-types a) 1))
-
-(defun math-known-num-integerp (a)
- (<= (math-possible-types a t) 3))
-
-(defun math-known-imagp (a)
- (= (math-possible-types a) 16))
-
-
-;;; Find the possible types of A.
-;;; Returns an integer with bits: 1 may be integer.
-;;; 2 may be integer-valued float.
-;;; 4 may be fraction.
-;;; 8 may be non-integer-valued float.
-;;; 16 may be imaginary.
-;;; 32 may be non-real, non-imaginary.
-;;; Real infinities count as integers for the purposes of this function.
-(defun math-possible-types (a &optional num)
- (cond ((Math-objectp a)
- (cond ((Math-integerp a) (if num 3 1))
- ((Math-messy-integerp a) (if num 3 2))
- ((eq (car a) 'frac) (if num 12 4))
- ((eq (car a) 'float) (if num 12 8))
- ((eq (car a) 'intv)
- (if (equal (nth 2 a) (nth 3 a))
- (math-possible-types (nth 2 a))
- 15))
- ((eq (car a) 'sdev)
- (if (math-known-realp (nth 1 a)) 15 63))
- ((eq (car a) 'cplx)
- (if (math-zerop (nth 1 a)) 16 32))
- ((eq (car a) 'polar)
- (if (or (Math-equal (nth 2 a) (math-quarter-circle nil))
- (Math-equal (nth 2 a)
- (math-neg (math-quarter-circle nil))))
- 16 48))
- (t 63)))
- ((eq (car a) '/)
- (let* ((t1 (math-possible-types (nth 1 a) num))
- (t2 (math-possible-types (nth 2 a) num))
- (t12 (logior t1 t2)))
- (if (< t12 16)
- (if (> (logand t12 10) 0)
- 10
- (if (or (= t1 4) (= t2 4) calc-prefer-frac)
- 5
- 15))
- (if (< t12 32)
- (if (= t1 16)
- (if (= t2 16) 15
- (if (< t2 16) 16 31))
- (if (= t2 16)
- (if (< t1 16) 16 31)
- 31))
- 63))))
- ((memq (car a) '(+ - * %))
- (let* ((t1 (math-possible-types (nth 1 a) num))
- (t2 (math-possible-types (nth 2 a) num))
- (t12 (logior t1 t2)))
- (if (eq (car a) '%)
- (setq t1 (logand t1 15) t2 (logand t2 15) t12 (logand t12 15)))
- (if (< t12 16)
- (let ((mask (if (<= t12 3)
- 1
- (if (and (or (and (<= t1 3) (= (logand t2 3) 0))
- (and (<= t2 3) (= (logand t1 3) 0)))
- (memq (car a) '(+ -)))
- 4
- 5))))
- (if num
- (* mask 3)
- (logior (if (and (> (logand t1 5) 0) (> (logand t2 5) 0))
- mask 0)
- (if (> (logand t12 10) 0)
- (* mask 2) 0))))
- (if (< t12 32)
- (if (eq (car a) '*)
- (if (= t1 16)
- (if (= t2 16) 15
- (if (< t2 16) 16 31))
- (if (= t2 16)
- (if (< t1 16) 16 31)
- 31))
- (if (= t12 16) 16
- (if (or (and (= t1 16) (< t2 16))
- (and (= t2 16) (< t1 16))) 32 63)))
- 63))))
- ((eq (car a) 'neg)
- (math-possible-types (nth 1 a)))
- ((eq (car a) '^)
- (let* ((t1 (math-possible-types (nth 1 a) num))
- (t2 (math-possible-types (nth 2 a) num))
- (t12 (logior t1 t2)))
- (if (and (<= t2 3) (math-known-nonnegp (nth 2 a)) (< t1 16))
- (let ((mask (logior (if (> (logand t1 3) 0) 1 0)
- (logand t1 4)
- (if (> (logand t1 12) 0) 5 0))))
- (if num
- (* mask 3)
- (logior (if (and (> (logand t1 5) 0) (> (logand t2 5) 0))
- mask 0)
- (if (> (logand t12 10) 0)
- (* mask 2) 0))))
- (if (and (math-known-nonnegp (nth 1 a))
- (math-known-posp (nth 2 a)))
- 15
- 63))))
- ((eq (car a) 'calcFunc-sqrt)
- (let ((t1 (math-possible-signs (nth 1 a))))
- (logior (if (> (logand t1 2) 0) 3 0)
- (if (> (logand t1 1) 0) 16 0)
- (if (> (logand t1 4) 0) 15 0)
- (if (> (logand t1 8) 0) 32 0))))
- ((eq (car a) 'vec)
- (let ((types 0))
- (while (and (setq a (cdr a)) (< types 63))
- (setq types (logior types (math-possible-types (car a) t))))
- types))
- ((or (memq (car a) math-integer-functions)
- (and (memq (car a) math-rounding-functions)
- (math-known-nonnegp (or (nth 2 a) 0))))
- 1)
- ((or (memq (car a) math-num-integer-functions)
- (and (memq (car a) math-float-rounding-functions)
- (math-known-nonnegp (or (nth 2 a) 0))))
- 2)
- ((eq (car a) 'calcFunc-frac)
- 5)
- ((and (eq (car a) 'calcFunc-float) (= (length a) 2))
- (let ((t1 (math-possible-types (nth 1 a))))
- (logior (if (> (logand t1 3) 0) 2 0)
- (if (> (logand t1 12) 0) 8 0)
- (logand t1 48))))
- ((and (memq (car a) '(calcFunc-abs calcFunc-abssqr))
- (= (length a) 2))
- (let ((t1 (math-possible-types (nth 1 a))))
- (if (>= t1 16)
- 15
- t1)))
- ((math-const-var a)
- (cond ((memq (nth 2 a) '(var-e var-pi var-phi var-gamma)) 8)
- ((eq (nth 2 a) 'var-inf) 1)
- ((eq (nth 2 a) 'var-i) 16)
- (t 63)))
- (t
- (math-setup-declarations)
- (let ((decl (if (eq (car a) 'var)
- (or (assq (nth 2 a) math-decls-cache)
- math-decls-all)
- (assq (car a) math-decls-cache))))
- (cond ((memq 'int (nth 1 decl))
- 1)
- ((memq 'numint (nth 1 decl))
- 3)
- ((memq 'frac (nth 1 decl))
- 4)
- ((memq 'rat (nth 1 decl))
- 5)
- ((memq 'float (nth 1 decl))
- 10)
- ((nth 2 decl)
- (math-possible-types (nth 2 decl)))
- ((memq 'real (nth 1 decl))
- 15)
- (t 63))))))
-
-(defun math-known-evenp (a)
- (cond ((Math-integerp a)
- (math-evenp a))
- ((Math-messy-integerp a)
- (or (> (nth 2 a) 0)
- (math-evenp (math-trunc a))))
- ((eq (car a) '*)
- (if (math-known-evenp (nth 1 a))
- (math-known-num-integerp (nth 2 a))
- (if (math-known-num-integerp (nth 1 a))
- (math-known-evenp (nth 2 a)))))
- ((memq (car a) '(+ -))
- (or (and (math-known-evenp (nth 1 a))
- (math-known-evenp (nth 2 a)))
- (and (math-known-oddp (nth 1 a))
- (math-known-oddp (nth 2 a)))))
- ((eq (car a) 'neg)
- (math-known-evenp (nth 1 a)))))
-
-(defun math-known-oddp (a)
- (cond ((Math-integerp a)
- (math-oddp a))
- ((Math-messy-integerp a)
- (and (<= (nth 2 a) 0)
- (math-oddp (math-trunc a))))
- ((memq (car a) '(+ -))
- (or (and (math-known-evenp (nth 1 a))
- (math-known-oddp (nth 2 a)))
- (and (math-known-oddp (nth 1 a))
- (math-known-evenp (nth 2 a)))))
- ((eq (car a) 'neg)
- (math-known-oddp (nth 1 a)))))
-
-
-(defun calcFunc-dreal (expr)
- (let ((types (math-possible-types expr)))
- (if (< types 16) 1
- (if (= (logand types 15) 0) 0
- (math-reject-arg expr 'realp 'quiet)))))
-
-(defun calcFunc-dimag (expr)
- (let ((types (math-possible-types expr)))
- (if (= types 16) 1
- (if (= (logand types 16) 0) 0
- (math-reject-arg expr "Expected an imaginary number")))))
-
-(defun calcFunc-dpos (expr)
- (let ((signs (math-possible-signs expr)))
- (if (eq signs 4) 1
- (if (memq signs '(1 2 3)) 0
- (math-reject-arg expr 'posp 'quiet)))))
-
-(defun calcFunc-dneg (expr)
- (let ((signs (math-possible-signs expr)))
- (if (eq signs 1) 1
- (if (memq signs '(2 4 6)) 0
- (math-reject-arg expr 'negp 'quiet)))))
-
-(defun calcFunc-dnonneg (expr)
- (let ((signs (math-possible-signs expr)))
- (if (memq signs '(2 4 6)) 1
- (if (eq signs 1) 0
- (math-reject-arg expr 'posp 'quiet)))))
-
-(defun calcFunc-dnonzero (expr)
- (let ((signs (math-possible-signs expr)))
- (if (memq signs '(1 4 5 8 9 12 13)) 1
- (if (eq signs 2) 0
- (math-reject-arg expr 'nonzerop 'quiet)))))
-
-(defun calcFunc-dint (expr)
- (let ((types (math-possible-types expr)))
- (if (= types 1) 1
- (if (= (logand types 1) 0) 0
- (math-reject-arg expr 'integerp 'quiet)))))
-
-(defun calcFunc-dnumint (expr)
- (let ((types (math-possible-types expr t)))
- (if (<= types 3) 1
- (if (= (logand types 3) 0) 0
- (math-reject-arg expr 'integerp 'quiet)))))
-
-(defun calcFunc-dnatnum (expr)
- (let ((res (calcFunc-dint expr)))
- (if (eq res 1)
- (calcFunc-dnonneg expr)
- res)))
-
-(defun calcFunc-deven (expr)
- (if (math-known-evenp expr)
- 1
- (if (or (math-known-oddp expr)
- (= (logand (math-possible-types expr) 3) 0))
- 0
- (math-reject-arg expr "Can't tell if expression is odd or even"))))
-
-(defun calcFunc-dodd (expr)
- (if (math-known-oddp expr)
- 1
- (if (or (math-known-evenp expr)
- (= (logand (math-possible-types expr) 3) 0))
- 0
- (math-reject-arg expr "Can't tell if expression is odd or even"))))
-
-(defun calcFunc-drat (expr)
- (let ((types (math-possible-types expr)))
- (if (memq types '(1 4 5)) 1
- (if (= (logand types 5) 0) 0
- (math-reject-arg expr "Rational number expected")))))
-
-(defun calcFunc-drange (expr)
- (math-setup-declarations)
- (let (range)
- (if (Math-realp expr)
- (list 'vec expr)
- (if (eq (car-safe expr) 'intv)
- expr
- (if (eq (car-safe expr) 'var)
- (setq range (nth 2 (or (assq (nth 2 expr) math-decls-cache)
- math-decls-all)))
- (setq range (nth 2 (assq (car-safe expr) math-decls-cache))))
- (if range
- (math-clean-set (copy-sequence range))
- (setq range (math-possible-signs expr))
- (if (< range 8)
- (aref [(vec)
- (intv 2 (neg (var inf var-inf)) 0)
- (vec 0)
- (intv 3 (neg (var inf var-inf)) 0)
- (intv 1 0 (var inf var-inf))
- (vec (intv 2 (neg (var inf var-inf)) 0)
- (intv 1 0 (var inf var-inf)))
- (intv 3 0 (var inf var-inf))
- (intv 3 (neg (var inf var-inf)) (var inf var-inf))] range)
- (math-reject-arg expr 'realp 'quiet)))))))
-
-(defun calcFunc-dscalar (a)
- (if (math-known-scalarp a) 1
- (if (math-known-matrixp a) 0
- (math-reject-arg a 'objectp 'quiet))))
-
-
-;;; The following lists are not exhaustive.
-(defvar math-scalar-functions '(calcFunc-det
- calcFunc-cnorm calcFunc-rnorm
- calcFunc-vlen calcFunc-vcount
- calcFunc-vsum calcFunc-vprod
- calcFunc-vmin calcFunc-vmax))
-
-(defvar math-nonscalar-functions '(vec calcFunc-idn calcFunc-diag
- calcFunc-cvec calcFunc-index
- calcFunc-trn
- | calcFunc-append
- calcFunc-cons calcFunc-rcons
- calcFunc-tail calcFunc-rhead))
-
-(defvar math-scalar-if-args-functions '(+ - * / neg))
-
-(defvar math-real-functions '(calcFunc-arg
- calcFunc-re calcFunc-im
- calcFunc-floor calcFunc-ceil
- calcFunc-trunc calcFunc-round
- calcFunc-rounde calcFunc-roundu
- calcFunc-ffloor calcFunc-fceil
- calcFunc-ftrunc calcFunc-fround
- calcFunc-frounde calcFunc-froundu))
-
-(defvar math-positive-functions '())
-
-(defvar math-nonnegative-functions '(calcFunc-cnorm calcFunc-rnorm
- calcFunc-vlen calcFunc-vcount))
-
-(defvar math-real-scalar-functions '(% calcFunc-idiv calcFunc-abs
- calcFunc-choose calcFunc-perm
- calcFunc-eq calcFunc-neq
- calcFunc-lt calcFunc-gt
- calcFunc-leq calcFunc-geq
- calcFunc-lnot
- calcFunc-max calcFunc-min))
-
-(defvar math-real-if-arg-functions '(calcFunc-sin calcFunc-cos
- calcFunc-tan calcFunc-arctan
- calcFunc-sinh calcFunc-cosh
- calcFunc-tanh calcFunc-exp
- calcFunc-gamma calcFunc-fact))
-
-(defvar math-integer-functions '(calcFunc-idiv
- calcFunc-isqrt calcFunc-ilog
- calcFunc-vlen calcFunc-vcount))
-
-(defvar math-num-integer-functions '())
-
-(defvar math-rounding-functions '(calcFunc-floor
- calcFunc-ceil
- calcFunc-round calcFunc-trunc
- calcFunc-rounde calcFunc-roundu))
-
-(defvar math-float-rounding-functions '(calcFunc-ffloor
- calcFunc-fceil
- calcFunc-fround calcFunc-ftrunc
- calcFunc-frounde calcFunc-froundu))
-
-(defvar math-integer-if-args-functions '(+ - * % neg calcFunc-abs
- calcFunc-min calcFunc-max
- calcFunc-choose calcFunc-perm))
-
-
-;;;; Arithmetic.
-
-(defsubst calcFunc-neg (a)
- (math-normalize (list 'neg a)))
-
-(defun math-neg-fancy (a)
- (cond ((eq (car a) 'polar)
- (list 'polar
- (nth 1 a)
- (if (math-posp (nth 2 a))
- (math-sub (nth 2 a) (math-half-circle nil))
- (math-add (nth 2 a) (math-half-circle nil)))))
- ((eq (car a) 'mod)
- (if (math-zerop (nth 1 a))
- a
- (list 'mod (math-sub (nth 2 a) (nth 1 a)) (nth 2 a))))
- ((eq (car a) 'sdev)
- (list 'sdev (math-neg (nth 1 a)) (nth 2 a)))
- ((eq (car a) 'intv)
- (math-make-intv (aref [0 2 1 3] (nth 1 a))
- (math-neg (nth 3 a))
- (math-neg (nth 2 a))))
- ((and math-simplify-only
- (not (equal a math-simplify-only)))
- (list 'neg a))
- ((eq (car a) '+)
- (math-sub (math-neg (nth 1 a)) (nth 2 a)))
- ((eq (car a) '-)
- (math-sub (nth 2 a) (nth 1 a)))
- ((and (memq (car a) '(* /))
- (math-okay-neg (nth 1 a)))
- (list (car a) (math-neg (nth 1 a)) (nth 2 a)))
- ((and (memq (car a) '(* /))
- (math-okay-neg (nth 2 a)))
- (list (car a) (nth 1 a) (math-neg (nth 2 a))))
- ((and (memq (car a) '(* /))
- (or (math-objectp (nth 1 a))
- (and (eq (car (nth 1 a)) '*)
- (math-objectp (nth 1 (nth 1 a))))))
- (list (car a) (math-neg (nth 1 a)) (nth 2 a)))
- ((and (eq (car a) '/)
- (or (math-objectp (nth 2 a))
- (and (eq (car (nth 2 a)) '*)
- (math-objectp (nth 1 (nth 2 a))))))
- (list (car a) (nth 1 a) (math-neg (nth 2 a))))
- ((and (eq (car a) 'var) (memq (nth 2 a) '(var-uinf var-nan)))
- a)
- ((eq (car a) 'neg)
- (nth 1 a))
- (t (list 'neg a))))
-
-(defun math-okay-neg (a)
- (or (math-looks-negp a)
- (eq (car-safe a) '-)))
-
-(defun math-neg-float (a)
- (list 'float (Math-integer-neg (nth 1 a)) (nth 2 a)))
-
-
-(defun calcFunc-add (&rest rest)
- (if rest
- (let ((a (car rest)))
- (while (setq rest (cdr rest))
- (setq a (list '+ a (car rest))))
- (math-normalize a))
- 0))
-
-(defun calcFunc-sub (&rest rest)
- (if rest
- (let ((a (car rest)))
- (while (setq rest (cdr rest))
- (setq a (list '- a (car rest))))
- (math-normalize a))
- 0))
-
-(defun math-add-objects-fancy (a b)
- (cond ((and (Math-numberp a) (Math-numberp b))
- (let ((aa (math-complex a))
- (bb (math-complex b)))
- (math-normalize
- (let ((res (list 'cplx
- (math-add (nth 1 aa) (nth 1 bb))
- (math-add (nth 2 aa) (nth 2 bb)))))
- (if (math-want-polar a b)
- (math-polar res)
- res)))))
- ((or (Math-vectorp a) (Math-vectorp b))
- (math-map-vec-2 'math-add a b))
- ((eq (car-safe a) 'sdev)
- (if (eq (car-safe b) 'sdev)
- (math-make-sdev (math-add (nth 1 a) (nth 1 b))
- (math-hypot (nth 2 a) (nth 2 b)))
- (and (or (Math-scalarp b)
- (not (Math-objvecp b)))
- (math-make-sdev (math-add (nth 1 a) b) (nth 2 a)))))
- ((and (eq (car-safe b) 'sdev)
- (or (Math-scalarp a)
- (not (Math-objvecp a))))
- (math-make-sdev (math-add a (nth 1 b)) (nth 2 b)))
- ((eq (car-safe a) 'intv)
- (if (eq (car-safe b) 'intv)
- (math-make-intv (logior (logand (nth 1 a) (nth 1 b))
- (if (equal (nth 2 a)
- '(neg (var inf var-inf)))
- (logand (nth 1 a) 2) 0)
- (if (equal (nth 2 b)
- '(neg (var inf var-inf)))
- (logand (nth 1 b) 2) 0)
- (if (equal (nth 3 a) '(var inf var-inf))
- (logand (nth 1 a) 1) 0)
- (if (equal (nth 3 b) '(var inf var-inf))
- (logand (nth 1 b) 1) 0))
- (math-add (nth 2 a) (nth 2 b))
- (math-add (nth 3 a) (nth 3 b)))
- (and (or (Math-anglep b)
- (eq (car b) 'date)
- (not (Math-objvecp b)))
- (math-make-intv (nth 1 a)
- (math-add (nth 2 a) b)
- (math-add (nth 3 a) b)))))
- ((and (eq (car-safe b) 'intv)
- (or (Math-anglep a)
- (eq (car a) 'date)
- (not (Math-objvecp a))))
- (math-make-intv (nth 1 b)
- (math-add a (nth 2 b))
- (math-add a (nth 3 b))))
- ((eq (car-safe a) 'date)
- (cond ((eq (car-safe b) 'date)
- (math-add (nth 1 a) (nth 1 b)))
- ((eq (car-safe b) 'hms)
- (let ((parts (math-date-parts (nth 1 a))))
- (list 'date
- (math-add (car parts) ; this minimizes roundoff
- (math-div (math-add
- (math-add (nth 1 parts)
- (nth 2 parts))
- (math-add
- (math-mul (nth 1 b) 3600)
- (math-add (math-mul (nth 2 b) 60)
- (nth 3 b))))
- 86400)))))
- ((Math-realp b)
- (list 'date (math-add (nth 1 a) b)))
- (t nil)))
- ((eq (car-safe b) 'date)
- (math-add-objects-fancy b a))
- ((and (eq (car-safe a) 'mod)
- (eq (car-safe b) 'mod)
- (equal (nth 2 a) (nth 2 b)))
- (math-make-mod (math-add (nth 1 a) (nth 1 b)) (nth 2 a)))
- ((and (eq (car-safe a) 'mod)
- (Math-anglep b))
- (math-make-mod (math-add (nth 1 a) b) (nth 2 a)))
- ((and (eq (car-safe b) 'mod)
- (Math-anglep a))
- (math-make-mod (math-add a (nth 1 b)) (nth 2 b)))
- ((and (or (eq (car-safe a) 'hms) (eq (car-safe b) 'hms))
- (and (Math-anglep a) (Math-anglep b)))
- (or (eq (car-safe a) 'hms) (setq a (math-to-hms a)))
- (or (eq (car-safe b) 'hms) (setq b (math-to-hms b)))
- (math-normalize
- (if (math-negp a)
- (math-neg (math-add (math-neg a) (math-neg b)))
- (if (math-negp b)
- (let* ((s (math-add (nth 3 a) (nth 3 b)))
- (m (math-add (nth 2 a) (nth 2 b)))
- (h (math-add (nth 1 a) (nth 1 b))))
- (if (math-negp s)
- (setq s (math-add s 60)
- m (math-add m -1)))
- (if (math-negp m)
- (setq m (math-add m 60)
- h (math-add h -1)))
- (if (math-negp h)
- (math-add b a)
- (list 'hms h m s)))
- (let* ((s (math-add (nth 3 a) (nth 3 b)))
- (m (math-add (nth 2 a) (nth 2 b)))
- (h (math-add (nth 1 a) (nth 1 b))))
- (list 'hms h m s))))))
- (t (calc-record-why "*Incompatible arguments for +" a b))))
-
-(defun math-add-symb-fancy (a b)
- (or (and math-simplify-only
- (not (equal a math-simplify-only))
- (list '+ a b))
- (and (eq (car-safe b) '+)
- (math-add (math-add a (nth 1 b))
- (nth 2 b)))
- (and (eq (car-safe b) '-)
- (math-sub (math-add a (nth 1 b))
- (nth 2 b)))
- (and (eq (car-safe b) 'neg)
- (eq (car-safe (nth 1 b)) '+)
- (math-sub (math-sub a (nth 1 (nth 1 b)))
- (nth 2 (nth 1 b))))
- (and (or (and (Math-vectorp a) (math-known-scalarp b))
- (and (Math-vectorp b) (math-known-scalarp a)))
- (math-map-vec-2 'math-add a b))
- (let ((inf (math-infinitep a)))
- (cond
- (inf
- (let ((inf2 (math-infinitep b)))
- (if inf2
- (if (or (memq (nth 2 inf) '(var-uinf var-nan))
- (memq (nth 2 inf2) '(var-uinf var-nan)))
- '(var nan var-nan)
- (let ((dir (math-infinite-dir a inf))
- (dir2 (math-infinite-dir b inf2)))
- (if (and (Math-objectp dir) (Math-objectp dir2))
- (if (Math-equal dir dir2)
- a
- '(var nan var-nan)))))
- (if (and (equal a '(var inf var-inf))
- (eq (car-safe b) 'intv)
- (memq (nth 1 b) '(2 3))
- (equal (nth 2 b) '(neg (var inf var-inf))))
- (list 'intv 3 (nth 2 b) a)
- (if (and (equal a '(neg (var inf var-inf)))
- (eq (car-safe b) 'intv)
- (memq (nth 1 b) '(1 3))
- (equal (nth 3 b) '(var inf var-inf)))
- (list 'intv 3 a (nth 3 b))
- a)))))
- ((math-infinitep b)
- (if (eq (car-safe a) 'intv)
- (math-add b a)
- b))
- ((eq (car-safe a) '+)
- (let ((temp (math-combine-sum (nth 2 a) b nil nil t)))
- (and temp
- (math-add (nth 1 a) temp))))
- ((eq (car-safe a) '-)
- (let ((temp (math-combine-sum (nth 2 a) b t nil t)))
- (and temp
- (math-add (nth 1 a) temp))))
- ((and (Math-objectp a) (Math-objectp b))
- nil)
- (t
- (math-combine-sum a b nil nil nil))))
- (and (Math-looks-negp b)
- (list '- a (math-neg b)))
- (and (Math-looks-negp a)
- (list '- b (math-neg a)))
- (and (eq (car-safe a) 'calcFunc-idn)
- (= (length a) 2)
- (or (and (eq (car-safe b) 'calcFunc-idn)
- (= (length b) 2)
- (list 'calcFunc-idn (math-add (nth 1 a) (nth 1 b))))
- (and (math-square-matrixp b)
- (math-add (math-mimic-ident (nth 1 a) b) b))
- (and (math-known-scalarp b)
- (math-add (nth 1 a) b))))
- (and (eq (car-safe b) 'calcFunc-idn)
- (= (length a) 2)
- (or (and (math-square-matrixp a)
- (math-add a (math-mimic-ident (nth 1 b) a)))
- (and (math-known-scalarp a)
- (math-add a (nth 1 b)))))
- (list '+ a b)))
-
-
-(defun calcFunc-mul (&rest rest)
- (if rest
- (let ((a (car rest)))
- (while (setq rest (cdr rest))
- (setq a (list '* a (car rest))))
- (math-normalize a))
- 1))
-
-(defun math-mul-objects-fancy (a b)
- (cond ((and (Math-numberp a) (Math-numberp b))
- (math-normalize
- (if (math-want-polar a b)
- (let ((a (math-polar a))
- (b (math-polar b)))
- (list 'polar
- (math-mul (nth 1 a) (nth 1 b))
- (math-fix-circular (math-add (nth 2 a) (nth 2 b)))))
- (setq a (math-complex a)
- b (math-complex b))
- (list 'cplx
- (math-sub (math-mul (nth 1 a) (nth 1 b))
- (math-mul (nth 2 a) (nth 2 b)))
- (math-add (math-mul (nth 1 a) (nth 2 b))
- (math-mul (nth 2 a) (nth 1 b)))))))
- ((Math-vectorp a)
- (if (Math-vectorp b)
- (if (math-matrixp a)
- (if (math-matrixp b)
- (if (= (length (nth 1 a)) (length b))
- (math-mul-mats a b)
- (math-dimension-error))
- (if (= (length (nth 1 a)) 2)
- (if (= (length a) (length b))
- (math-mul-mats a (list 'vec b))
- (math-dimension-error))
- (if (= (length (nth 1 a)) (length b))
- (math-mul-mat-vec a b)
- (math-dimension-error))))
- (if (math-matrixp b)
- (if (= (length a) (length b))
- (nth 1 (math-mul-mats (list 'vec a) b))
- (math-dimension-error))
- (if (= (length a) (length b))
- (math-dot-product a b)
- (math-dimension-error))))
- (math-map-vec-2 'math-mul a b)))
- ((Math-vectorp b)
- (math-map-vec-2 'math-mul a b))
- ((eq (car-safe a) 'sdev)
- (if (eq (car-safe b) 'sdev)
- (math-make-sdev (math-mul (nth 1 a) (nth 1 b))
- (math-hypot (math-mul (nth 2 a) (nth 1 b))
- (math-mul (nth 2 b) (nth 1 a))))
- (and (or (Math-scalarp b)
- (not (Math-objvecp b)))
- (math-make-sdev (math-mul (nth 1 a) b)
- (math-mul (nth 2 a) b)))))
- ((and (eq (car-safe b) 'sdev)
- (or (Math-scalarp a)
- (not (Math-objvecp a))))
- (math-make-sdev (math-mul a (nth 1 b)) (math-mul a (nth 2 b))))
- ((and (eq (car-safe a) 'intv) (Math-anglep b))
- (if (Math-negp b)
- (math-neg (math-mul a (math-neg b)))
- (math-make-intv (nth 1 a)
- (math-mul (nth 2 a) b)
- (math-mul (nth 3 a) b))))
- ((and (eq (car-safe b) 'intv) (Math-anglep a))
- (math-mul b a))
- ((and (eq (car-safe a) 'intv) (math-intv-constp a)
- (eq (car-safe b) 'intv) (math-intv-constp b))
- (let ((lo (math-mul a (nth 2 b)))
- (hi (math-mul a (nth 3 b))))
- (or (eq (car-safe lo) 'intv)
- (setq lo (list 'intv (if (memq (nth 1 b) '(2 3)) 3 0) lo lo)))
- (or (eq (car-safe hi) 'intv)
- (setq hi (list 'intv (if (memq (nth 1 b) '(1 3)) 3 0) hi hi)))
- (math-combine-intervals
- (nth 2 lo) (and (or (memq (nth 1 b) '(2 3))
- (math-infinitep (nth 2 lo)))
- (memq (nth 1 lo) '(2 3)))
- (nth 3 lo) (and (or (memq (nth 1 b) '(2 3))
- (math-infinitep (nth 3 lo)))
- (memq (nth 1 lo) '(1 3)))
- (nth 2 hi) (and (or (memq (nth 1 b) '(1 3))
- (math-infinitep (nth 2 hi)))
- (memq (nth 1 hi) '(2 3)))
- (nth 3 hi) (and (or (memq (nth 1 b) '(1 3))
- (math-infinitep (nth 3 hi)))
- (memq (nth 1 hi) '(1 3))))))
- ((and (eq (car-safe a) 'mod)
- (eq (car-safe b) 'mod)
- (equal (nth 2 a) (nth 2 b)))
- (math-make-mod (math-mul (nth 1 a) (nth 1 b)) (nth 2 a)))
- ((and (eq (car-safe a) 'mod)
- (Math-anglep b))
- (math-make-mod (math-mul (nth 1 a) b) (nth 2 a)))
- ((and (eq (car-safe b) 'mod)
- (Math-anglep a))
- (math-make-mod (math-mul a (nth 1 b)) (nth 2 b)))
- ((and (eq (car-safe a) 'hms) (Math-realp b))
- (math-with-extra-prec 2
- (math-to-hms (math-mul (math-from-hms a 'deg) b) 'deg)))
- ((and (eq (car-safe b) 'hms) (Math-realp a))
- (math-mul b a))
- (t (calc-record-why "*Incompatible arguments for *" a b))))
-
-;;; Fast function to multiply floating-point numbers.
-(defun math-mul-float (a b) ; [F F F]
- (math-make-float (math-mul (nth 1 a) (nth 1 b))
- (+ (nth 2 a) (nth 2 b))))
-
-(defun math-sqr-float (a) ; [F F]
- (math-make-float (math-mul (nth 1 a) (nth 1 a))
- (+ (nth 2 a) (nth 2 a))))
-
-(defun math-intv-constp (a &optional finite)
- (and (or (Math-anglep (nth 2 a))
- (and (equal (nth 2 a) '(neg (var inf var-inf)))
- (or (not finite)
- (memq (nth 1 a) '(0 1)))))
- (or (Math-anglep (nth 3 a))
- (and (equal (nth 3 a) '(var inf var-inf))
- (or (not finite)
- (memq (nth 1 a) '(0 2)))))))
-
-(defun math-mul-zero (a b)
- (if (math-known-matrixp b)
- (if (math-vectorp b)
- (math-map-vec-2 'math-mul a b)
- (math-mimic-ident 0 b))
- (if (math-infinitep b)
- '(var nan var-nan)
- (let ((aa nil) (bb nil))
- (if (and (eq (car-safe b) 'intv)
- (progn
- (and (equal (nth 2 b) '(neg (var inf var-inf)))
- (memq (nth 1 b) '(2 3))
- (setq aa (nth 2 b)))
- (and (equal (nth 3 b) '(var inf var-inf))
- (memq (nth 1 b) '(1 3))
- (setq bb (nth 3 b)))
- (or aa bb)))
- (if (or (math-posp a)
- (and (math-zerop a)
- (or (memq calc-infinite-mode '(-1 1))
- (setq aa '(neg (var inf var-inf))
- bb '(var inf var-inf)))))
- (list 'intv 3 (or aa 0) (or bb 0))
- (if (math-negp a)
- (math-neg (list 'intv 3 (or aa 0) (or bb 0)))
- '(var nan var-nan)))
- (if (or (math-floatp a) (math-floatp b)) '(float 0 0) 0))))))
-
-
-(defun math-mul-symb-fancy (a b)
- (or (and math-simplify-only
- (not (equal a math-simplify-only))
- (list '* a b))
- (and (Math-equal-int a 1)
- b)
- (and (Math-equal-int a -1)
- (math-neg b))
- (and (or (and (Math-vectorp a) (math-known-scalarp b))
- (and (Math-vectorp b) (math-known-scalarp a)))
- (math-map-vec-2 'math-mul a b))
- (and (Math-objectp b) (not (Math-objectp a))
- (math-mul b a))
- (and (eq (car-safe a) 'neg)
- (math-neg (math-mul (nth 1 a) b)))
- (and (eq (car-safe b) 'neg)
- (math-neg (math-mul a (nth 1 b))))
- (and (eq (car-safe a) '*)
- (math-mul (nth 1 a)
- (math-mul (nth 2 a) b)))
- (and (eq (car-safe a) '^)
- (Math-looks-negp (nth 2 a))
- (not (and (eq (car-safe b) '^) (Math-looks-negp (nth 2 b))))
- (math-known-scalarp b t)
- (math-div b (math-normalize
- (list '^ (nth 1 a) (math-neg (nth 2 a))))))
- (and (eq (car-safe b) '^)
- (Math-looks-negp (nth 2 b))
- (not (and (eq (car-safe a) '^) (Math-looks-negp (nth 2 a))))
- (math-div a (math-normalize
- (list '^ (nth 1 b) (math-neg (nth 2 b))))))
- (and (eq (car-safe a) '/)
- (or (math-known-scalarp a t) (math-known-scalarp b t))
- (let ((temp (math-combine-prod (nth 2 a) b t nil t)))
- (if temp
- (math-mul (nth 1 a) temp)
- (math-div (math-mul (nth 1 a) b) (nth 2 a)))))
- (and (eq (car-safe b) '/)
- (math-div (math-mul a (nth 1 b)) (nth 2 b)))
- (and (eq (car-safe b) '+)
- (Math-numberp a)
- (or (Math-numberp (nth 1 b))
- (Math-numberp (nth 2 b)))
- (math-add (math-mul a (nth 1 b))
- (math-mul a (nth 2 b))))
- (and (eq (car-safe b) '-)
- (Math-numberp a)
- (or (Math-numberp (nth 1 b))
- (Math-numberp (nth 2 b)))
- (math-sub (math-mul a (nth 1 b))
- (math-mul a (nth 2 b))))
- (and (eq (car-safe b) '*)
- (Math-numberp (nth 1 b))
- (not (Math-numberp a))
- (math-mul (nth 1 b) (math-mul a (nth 2 b))))
- (and (eq (car-safe a) 'calcFunc-idn)
- (= (length a) 2)
- (or (and (eq (car-safe b) 'calcFunc-idn)
- (= (length b) 2)
- (list 'calcFunc-idn (math-mul (nth 1 a) (nth 1 b))))
- (and (math-known-scalarp b)
- (list 'calcFunc-idn (math-mul (nth 1 a) b)))
- (and (math-known-matrixp b)
- (math-mul (nth 1 a) b))))
- (and (eq (car-safe b) 'calcFunc-idn)
- (= (length b) 2)
- (or (and (math-known-scalarp a)
- (list 'calcFunc-idn (math-mul a (nth 1 b))))
- (and (math-known-matrixp a)
- (math-mul a (nth 1 b)))))
- (and (math-looks-negp b)
- (math-mul (math-neg a) (math-neg b)))
- (and (eq (car-safe b) '-)
- (math-looks-negp a)
- (math-mul (math-neg a) (math-neg b)))
- (cond
- ((eq (car-safe b) '*)
- (let ((temp (math-combine-prod a (nth 1 b) nil nil t)))
- (and temp
- (math-mul temp (nth 2 b)))))
- (t
- (math-combine-prod a b nil nil nil)))
- (and (equal a '(var nan var-nan))
- a)
- (and (equal b '(var nan var-nan))
- b)
- (and (equal a '(var uinf var-uinf))
- a)
- (and (equal b '(var uinf var-uinf))
- b)
- (and (equal b '(var inf var-inf))
- (let ((s1 (math-possible-signs a)))
- (cond ((eq s1 4)
- b)
- ((eq s1 6)
- '(intv 3 0 (var inf var-inf)))
- ((eq s1 1)
- (math-neg b))
- ((eq s1 3)
- '(intv 3 (neg (var inf var-inf)) 0))
- ((and (eq (car a) 'intv) (math-intv-constp a))
- '(intv 3 (neg (var inf var-inf)) (var inf var-inf)))
- ((and (eq (car a) 'cplx)
- (math-zerop (nth 1 a)))
- (list '* (list 'cplx 0 (calcFunc-sign (nth 2 a))) b))
- ((eq (car a) 'polar)
- (list '* (list 'polar 1 (nth 2 a)) b)))))
- (and (equal a '(var inf var-inf))
- (math-mul b a))
- (list '* a b)))
-
-
-(defun calcFunc-div (a &rest rest)
- (while rest
- (setq a (list '/ a (car rest))
- rest (cdr rest)))
- (math-normalize a))
-
-(defun math-div-objects-fancy (a b)
- (cond ((and (Math-numberp a) (Math-numberp b))
- (math-normalize
- (cond ((math-want-polar a b)
- (let ((a (math-polar a))
- (b (math-polar b)))
- (list 'polar
- (math-div (nth 1 a) (nth 1 b))
- (math-fix-circular (math-sub (nth 2 a)
- (nth 2 b))))))
- ((Math-realp b)
- (setq a (math-complex a))
- (list 'cplx (math-div (nth 1 a) b)
- (math-div (nth 2 a) b)))
- (t
- (setq a (math-complex a)
- b (math-complex b))
- (math-div
- (list 'cplx
- (math-add (math-mul (nth 1 a) (nth 1 b))
- (math-mul (nth 2 a) (nth 2 b)))
- (math-sub (math-mul (nth 2 a) (nth 1 b))
- (math-mul (nth 1 a) (nth 2 b))))
- (math-add (math-sqr (nth 1 b))
- (math-sqr (nth 2 b))))))))
- ((math-matrixp b)
- (if (math-square-matrixp b)
- (let ((n1 (length b)))
- (if (Math-vectorp a)
- (if (math-matrixp a)
- (if (= (length a) n1)
- (math-lud-solve (math-matrix-lud b) a b)
- (if (= (length (nth 1 a)) n1)
- (math-transpose
- (math-lud-solve (math-matrix-lud
- (math-transpose b))
- (math-transpose a) b))
- (math-dimension-error)))
- (if (= (length a) n1)
- (math-mat-col (math-lud-solve (math-matrix-lud b)
- (math-col-matrix a) b)
- 1)
- (math-dimension-error)))
- (if (Math-equal-int a 1)
- (calcFunc-inv b)
- (math-mul a (calcFunc-inv b)))))
- (math-reject-arg b 'square-matrixp)))
- ((and (Math-vectorp a) (Math-objectp b))
- (math-map-vec-2 'math-div a b))
- ((eq (car-safe a) 'sdev)
- (if (eq (car-safe b) 'sdev)
- (let ((x (math-div (nth 1 a) (nth 1 b))))
- (math-make-sdev x
- (math-div (math-hypot (nth 2 a)
- (math-mul (nth 2 b) x))
- (nth 1 b))))
- (if (or (Math-scalarp b)
- (not (Math-objvecp b)))
- (math-make-sdev (math-div (nth 1 a) b) (math-div (nth 2 a) b))
- (math-reject-arg 'realp b))))
- ((and (eq (car-safe b) 'sdev)
- (or (Math-scalarp a)
- (not (Math-objvecp a))))
- (let ((x (math-div a (nth 1 b))))
- (math-make-sdev x
- (math-div (math-mul (nth 2 b) x) (nth 1 b)))))
- ((and (eq (car-safe a) 'intv) (Math-anglep b))
- (if (Math-negp b)
- (math-neg (math-div a (math-neg b)))
- (math-make-intv (nth 1 a)
- (math-div (nth 2 a) b)
- (math-div (nth 3 a) b))))
- ((and (eq (car-safe b) 'intv) (Math-anglep a))
- (if (or (Math-posp (nth 2 b))
- (and (Math-zerop (nth 2 b)) (or (memq (nth 1 b) '(0 1))
- calc-infinite-mode)))
- (if (Math-negp a)
- (math-neg (math-div (math-neg a) b))
- (let ((calc-infinite-mode 1))
- (math-make-intv (aref [0 2 1 3] (nth 1 b))
- (math-div a (nth 3 b))
- (math-div a (nth 2 b)))))
- (if (or (Math-negp (nth 3 b))
- (and (Math-zerop (nth 3 b)) (or (memq (nth 1 b) '(0 2))
- calc-infinite-mode)))
- (math-neg (math-div a (math-neg b)))
- (if calc-infinite-mode
- '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
- (math-reject-arg b "*Division by zero")))))
- ((and (eq (car-safe a) 'intv) (math-intv-constp a)
- (eq (car-safe b) 'intv) (math-intv-constp b))
- (if (or (Math-posp (nth 2 b))
- (and (Math-zerop (nth 2 b)) (or (memq (nth 1 b) '(0 1))
- calc-infinite-mode)))
- (let* ((calc-infinite-mode 1)
- (lo (math-div a (nth 2 b)))
- (hi (math-div a (nth 3 b))))
- (or (eq (car-safe lo) 'intv)
- (setq lo (list 'intv (if (memq (nth 1 b) '(2 3)) 3 0)
- lo lo)))
- (or (eq (car-safe hi) 'intv)
- (setq hi (list 'intv (if (memq (nth 1 b) '(1 3)) 3 0)
- hi hi)))
- (math-combine-intervals
- (nth 2 lo) (and (or (memq (nth 1 b) '(2 3))
- (and (math-infinitep (nth 2 lo))
- (not (math-zerop (nth 2 b)))))
- (memq (nth 1 lo) '(2 3)))
- (nth 3 lo) (and (or (memq (nth 1 b) '(2 3))
- (and (math-infinitep (nth 3 lo))
- (not (math-zerop (nth 2 b)))))
- (memq (nth 1 lo) '(1 3)))
- (nth 2 hi) (and (or (memq (nth 1 b) '(1 3))
- (and (math-infinitep (nth 2 hi))
- (not (math-zerop (nth 3 b)))))
- (memq (nth 1 hi) '(2 3)))
- (nth 3 hi) (and (or (memq (nth 1 b) '(1 3))
- (and (math-infinitep (nth 3 hi))
- (not (math-zerop (nth 3 b)))))
- (memq (nth 1 hi) '(1 3)))))
- (if (or (Math-negp (nth 3 b))
- (and (Math-zerop (nth 3 b)) (or (memq (nth 1 b) '(0 2))
- calc-infinite-mode)))
- (math-neg (math-div a (math-neg b)))
- (if calc-infinite-mode
- '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
- (math-reject-arg b "*Division by zero")))))
- ((and (eq (car-safe a) 'mod)
- (eq (car-safe b) 'mod)
- (equal (nth 2 a) (nth 2 b)))
- (math-make-mod (math-div-mod (nth 1 a) (nth 1 b) (nth 2 a))
- (nth 2 a)))
- ((and (eq (car-safe a) 'mod)
- (Math-anglep b))
- (math-make-mod (math-div-mod (nth 1 a) b (nth 2 a)) (nth 2 a)))
- ((and (eq (car-safe b) 'mod)
- (Math-anglep a))
- (math-make-mod (math-div-mod a (nth 1 b) (nth 2 b)) (nth 2 b)))
- ((eq (car-safe a) 'hms)
- (if (eq (car-safe b) 'hms)
- (math-with-extra-prec 1
- (math-div (math-from-hms a 'deg)
- (math-from-hms b 'deg)))
- (math-with-extra-prec 2
- (math-to-hms (math-div (math-from-hms a 'deg) b) 'deg))))
- (t (calc-record-why "*Incompatible arguments for /" a b))))
-
-(defun math-div-by-zero (a b)
- (if (math-infinitep a)
- (if (or (equal a '(var nan var-nan))
- (equal b '(var uinf var-uinf))
- (memq calc-infinite-mode '(-1 1)))
- a
- '(var uinf var-uinf))
- (if calc-infinite-mode
- (if (math-zerop a)
- '(var nan var-nan)
- (if (eq calc-infinite-mode 1)
- (math-mul a '(var inf var-inf))
- (if (eq calc-infinite-mode -1)
- (math-mul a '(neg (var inf var-inf)))
- (if (eq (car-safe a) 'intv)
- '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
- '(var uinf var-uinf)))))
- (math-reject-arg a "*Division by zero"))))
-
-(defun math-div-zero (a b)
- (if (math-known-matrixp b)
- (if (math-vectorp b)
- (math-map-vec-2 'math-div a b)
- (math-mimic-ident 0 b))
- (if (equal b '(var nan var-nan))
- b
- (if (and (eq (car-safe b) 'intv) (math-intv-constp b)
- (not (math-posp b)) (not (math-negp b)))
- (if calc-infinite-mode
- (list 'intv 3
- (if (and (math-zerop (nth 2 b))
- (memq calc-infinite-mode '(1 -1)))
- (nth 2 b) '(neg (var inf var-inf)))
- (if (and (math-zerop (nth 3 b))
- (memq calc-infinite-mode '(1 -1)))
- (nth 3 b) '(var inf var-inf)))
- (math-reject-arg b "*Division by zero"))
- a))))
-
-(defun math-div-symb-fancy (a b)
- (or (and math-simplify-only
- (not (equal a math-simplify-only))
- (list '/ a b))
- (and (Math-equal-int b 1) a)
- (and (Math-equal-int b -1) (math-neg a))
- (and (Math-vectorp a) (math-known-scalarp b)
- (math-map-vec-2 'math-div a b))
- (and (eq (car-safe b) '^)
- (or (Math-looks-negp (nth 2 b)) (Math-equal-int a 1))
- (math-mul a (math-normalize
- (list '^ (nth 1 b) (math-neg (nth 2 b))))))
- (and (eq (car-safe a) 'neg)
- (math-neg (math-div (nth 1 a) b)))
- (and (eq (car-safe b) 'neg)
- (math-neg (math-div a (nth 1 b))))
- (and (eq (car-safe a) '/)
- (math-div (nth 1 a) (math-mul (nth 2 a) b)))
- (and (eq (car-safe b) '/)
- (or (math-known-scalarp (nth 1 b) t)
- (math-known-scalarp (nth 2 b) t))
- (math-div (math-mul a (nth 2 b)) (nth 1 b)))
- (and (eq (car-safe b) 'frac)
- (math-mul (math-make-frac (nth 2 b) (nth 1 b)) a))
- (and (eq (car-safe a) '+)
- (or (Math-numberp (nth 1 a))
- (Math-numberp (nth 2 a)))
- (Math-numberp b)
- (math-add (math-div (nth 1 a) b)
- (math-div (nth 2 a) b)))
- (and (eq (car-safe a) '-)
- (or (Math-numberp (nth 1 a))
- (Math-numberp (nth 2 a)))
- (Math-numberp b)
- (math-sub (math-div (nth 1 a) b)
- (math-div (nth 2 a) b)))
- (and (or (eq (car-safe a) '-)
- (math-looks-negp a))
- (math-looks-negp b)
- (math-div (math-neg a) (math-neg b)))
- (and (eq (car-safe b) '-)
- (math-looks-negp a)
- (math-div (math-neg a) (math-neg b)))
- (and (eq (car-safe a) 'calcFunc-idn)
- (= (length a) 2)
- (or (and (eq (car-safe b) 'calcFunc-idn)
- (= (length b) 2)
- (list 'calcFunc-idn (math-div (nth 1 a) (nth 1 b))))
- (and (math-known-scalarp b)
- (list 'calcFunc-idn (math-div (nth 1 a) b)))
- (and (math-known-matrixp b)
- (math-div (nth 1 a) b))))
- (and (eq (car-safe b) 'calcFunc-idn)
- (= (length b) 2)
- (or (and (math-known-scalarp a)
- (list 'calcFunc-idn (math-div a (nth 1 b))))
- (and (math-known-matrixp a)
- (math-div a (nth 1 b)))))
- (if (and calc-matrix-mode
- (or (math-known-matrixp a) (math-known-matrixp b)))
- (math-combine-prod a b nil t nil)
- (if (eq (car-safe a) '*)
- (if (eq (car-safe b) '*)
- (let ((c (math-combine-prod (nth 1 a) (nth 1 b) nil t t)))
- (and c
- (math-div (math-mul c (nth 2 a)) (nth 2 b))))
- (let ((c (math-combine-prod (nth 1 a) b nil t t)))
- (and c
- (math-mul c (nth 2 a)))))
- (if (eq (car-safe b) '*)
- (let ((c (math-combine-prod a (nth 1 b) nil t t)))
- (and c
- (math-div c (nth 2 b))))
- (math-combine-prod a b nil t nil))))
- (and (math-infinitep a)
- (if (math-infinitep b)
- '(var nan var-nan)
- (if (or (equal a '(var nan var-nan))
- (equal a '(var uinf var-uinf)))
- a
- (if (equal a '(var inf var-inf))
- (if (or (math-posp b)
- (and (eq (car-safe b) 'intv)
- (math-zerop (nth 2 b))))
- (if (and (eq (car-safe b) 'intv)
- (not (math-intv-constp b t)))
- '(intv 3 0 (var inf var-inf))
- a)
- (if (or (math-negp b)
- (and (eq (car-safe b) 'intv)
- (math-zerop (nth 3 b))))
- (if (and (eq (car-safe b) 'intv)
- (not (math-intv-constp b t)))
- '(intv 3 (neg (var inf var-inf)) 0)
- (math-neg a))
- (if (and (eq (car-safe b) 'intv)
- (math-negp (nth 2 b)) (math-posp (nth 3 b)))
- '(intv 3 (neg (var inf var-inf))
- (var inf var-inf)))))))))
- (and (math-infinitep b)
- (if (equal b '(var nan var-nan))
- b
- (let ((calc-infinite-mode 1))
- (math-mul-zero b a))))
- (list '/ a b)))
-
-
-(defun calcFunc-mod (a b)
- (math-normalize (list '% a b)))
-
-(defun math-mod-fancy (a b)
- (cond ((equal b '(var inf var-inf))
- (if (or (math-posp a) (math-zerop a))
- a
- (if (math-negp a)
- b
- (if (eq (car-safe a) 'intv)
- (if (math-negp (nth 2 a))
- '(intv 3 0 (var inf var-inf))
- a)
- (list '% a b)))))
- ((and (eq (car-safe a) 'mod) (Math-realp b) (math-posp b))
- (math-make-mod (nth 1 a) b))
- ((and (eq (car-safe a) 'intv) (math-intv-constp a t) (math-posp b))
- (math-mod-intv a b))
- (t
- (if (Math-anglep a)
- (calc-record-why 'anglep b)
- (calc-record-why 'anglep a))
- (list '% a b))))
-
-
-(defun calcFunc-pow (a b)
- (math-normalize (list '^ a b)))
-
-(defun math-pow-of-zero (a b)
- (if (Math-zerop b)
- (if calc-infinite-mode
- '(var nan var-nan)
- (math-reject-arg (list '^ a b) "*Indeterminate form"))
- (if (math-floatp b) (setq a (math-float a)))
- (if (math-posp b)
- a
- (if (math-negp b)
- (math-div 1 a)
- (if (math-infinitep b)
- '(var nan var-nan)
- (if (and (eq (car b) 'intv) (math-intv-constp b)
- calc-infinite-mode)
- '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
- (if (math-objectp b)
- (list '^ a b)
- a)))))))
-
-(defun math-pow-zero (a b)
- (if (eq (car-safe a) 'mod)
- (math-make-mod 1 (nth 2 a))
- (if (math-known-matrixp a)
- (math-mimic-ident 1 a)
- (if (math-infinitep a)
- '(var nan var-nan)
- (if (and (eq (car a) 'intv) (math-intv-constp a)
- (or (and (not (math-posp a)) (not (math-negp a)))
- (not (math-intv-constp a t))))
- '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
- (if (or (math-floatp a) (math-floatp b))
- '(float 1 0) 1))))))
-
-(defun math-pow-fancy (a b)
- (cond ((and (Math-numberp a) (Math-numberp b))
- (or (if (memq (math-quarter-integer b) '(1 2 3))
- (let ((sqrt (math-sqrt (if (math-floatp b)
- (math-float a) a))))
- (and (Math-numberp sqrt)
- (math-pow sqrt (math-mul 2 b))))
- (and (eq (car b) 'frac)
- (integerp (nth 2 b))
- (<= (nth 2 b) 10)
- (let ((root (math-nth-root a (nth 2 b))))
- (and root (math-ipow root (nth 1 b))))))
- (and (or (eq a 10) (equal a '(float 1 1)))
- (math-num-integerp b)
- (calcFunc-scf '(float 1 0) b))
- (and calc-symbolic-mode
- (list '^ a b))
- (math-with-extra-prec 2
- (math-exp-raw
- (math-float (math-mul b (math-ln-raw (math-float a))))))))
- ((or (not (Math-objvecp a))
- (not (Math-objectp b)))
- (let (temp)
- (cond ((and math-simplify-only
- (not (equal a math-simplify-only)))
- (list '^ a b))
- ((and (eq (car-safe a) '*)
- (or (math-known-num-integerp b)
- (math-known-nonnegp (nth 1 a))
- (math-known-nonnegp (nth 2 a))))
- (math-mul (math-pow (nth 1 a) b)
- (math-pow (nth 2 a) b)))
- ((and (eq (car-safe a) '/)
- (or (math-known-num-integerp b)
- (math-known-nonnegp (nth 2 a))))
- (math-div (math-pow (nth 1 a) b)
- (math-pow (nth 2 a) b)))
- ((and (eq (car-safe a) '/)
- (math-known-nonnegp (nth 1 a))
- (not (math-equal-int (nth 1 a) 1)))
- (math-mul (math-pow (nth 1 a) b)
- (math-pow (math-div 1 (nth 2 a)) b)))
- ((and (eq (car-safe a) '^)
- (or (math-known-num-integerp b)
- (math-known-nonnegp (nth 1 a))))
- (math-pow (nth 1 a) (math-mul (nth 2 a) b)))
- ((and (eq (car-safe a) 'calcFunc-sqrt)
- (or (math-known-num-integerp b)
- (math-known-nonnegp (nth 1 a))))
- (math-pow (nth 1 a) (math-div b 2)))
- ((and (eq (car-safe a) '^)
- (math-known-evenp (nth 2 a))
- (memq (math-quarter-integer b) '(1 2 3))
- (math-known-realp (nth 1 a)))
- (math-abs (math-pow (nth 1 a) (math-mul (nth 2 a) b))))
- ((and (math-looks-negp a)
- (math-known-integerp b)
- (setq temp (or (and (math-known-evenp b)
- (math-pow (math-neg a) b))
- (and (math-known-oddp b)
- (math-neg (math-pow (math-neg a)
- b))))))
- temp)
- ((and (eq (car-safe a) 'calcFunc-abs)
- (math-known-realp (nth 1 a))
- (math-known-evenp b))
- (math-pow (nth 1 a) b))
- ((math-infinitep a)
- (cond ((equal a '(var nan var-nan))
- a)
- ((eq (car a) 'neg)
- (math-mul (math-pow -1 b) (math-pow (nth 1 a) b)))
- ((math-posp b)
- a)
- ((math-negp b)
- (if (math-floatp b) '(float 0 0) 0))
- ((and (eq (car-safe b) 'intv)
- (math-intv-constp b))
- '(intv 3 0 (var inf var-inf)))
- (t
- '(var nan var-nan))))
- ((math-infinitep b)
- (let (scale)
- (cond ((math-negp b)
- (math-pow (math-div 1 a) (math-neg b)))
- ((not (math-posp b))
- '(var nan var-nan))
- ((math-equal-int (setq scale (calcFunc-abssqr a)) 1)
- '(var nan var-nan))
- ((Math-lessp scale 1)
- (if (math-floatp a) '(float 0 0) 0))
- ((Math-lessp 1 a)
- b)
- ((Math-lessp a -1)
- '(var uinf var-uinf))
- ((and (eq (car a) 'intv)
- (math-intv-constp a))
- (if (Math-lessp -1 a)
- (if (math-equal-int (nth 3 a) 1)
- '(intv 3 0 1)
- '(intv 3 0 (var inf var-inf)))
- '(intv 3 (neg (var inf var-inf))
- (var inf var-inf))))
- (t (list '^ a b)))))
- ((and (eq (car-safe a) 'calcFunc-idn)
- (= (length a) 2)
- (math-known-num-integerp b))
- (list 'calcFunc-idn (math-pow (nth 1 a) b)))
- (t (if (Math-objectp a)
- (calc-record-why 'objectp b)
- (calc-record-why 'objectp a))
- (list '^ a b)))))
- ((and (eq (car-safe a) 'sdev) (eq (car-safe b) 'sdev))
- (if (and (math-constp a) (math-constp b))
- (math-with-extra-prec 2
- (let* ((ln (math-ln-raw (math-float (nth 1 a))))
- (pow (math-exp-raw
- (math-float (math-mul (nth 1 b) ln)))))
- (math-make-sdev
- pow
- (math-mul
- pow
- (math-hypot (math-mul (nth 2 a)
- (math-div (nth 1 b) (nth 1 a)))
- (math-mul (nth 2 b) ln))))))
- (let ((pow (math-pow (nth 1 a) (nth 1 b))))
- (math-make-sdev
- pow
- (math-mul pow
- (math-hypot (math-mul (nth 2 a)
- (math-div (nth 1 b) (nth 1 a)))
- (math-mul (nth 2 b) (calcFunc-ln
- (nth 1 a)))))))))
- ((and (eq (car-safe a) 'sdev) (Math-numberp b))
- (if (math-constp a)
- (math-with-extra-prec 2
- (let ((pow (math-pow (nth 1 a) (math-sub b 1))))
- (math-make-sdev (math-mul pow (nth 1 a))
- (math-mul pow (math-mul (nth 2 a) b)))))
- (math-make-sdev (math-pow (nth 1 a) b)
- (math-mul (math-pow (nth 1 a) (math-add b -1))
- (math-mul (nth 2 a) b)))))
- ((and (eq (car-safe b) 'sdev) (Math-numberp a))
- (math-with-extra-prec 2
- (let* ((ln (math-ln-raw (math-float a)))
- (pow (calcFunc-exp (math-mul (nth 1 b) ln))))
- (math-make-sdev pow (math-mul pow (math-mul (nth 2 b) ln))))))
- ((and (eq (car-safe a) 'intv) (math-intv-constp a)
- (Math-realp b)
- (or (Math-natnump b)
- (Math-posp (nth 2 a))
- (and (math-zerop (nth 2 a))
- (or (Math-posp b)
- (and (Math-integerp b) calc-infinite-mode)))
- (Math-negp (nth 3 a))
- (and (math-zerop (nth 3 a))
- (or (Math-posp b)
- (and (Math-integerp b) calc-infinite-mode)))))
- (if (math-evenp b)
- (setq a (math-abs a)))
- (let ((calc-infinite-mode (if (math-zerop (nth 3 a)) -1 1)))
- (math-sort-intv (nth 1 a)
- (math-pow (nth 2 a) b)
- (math-pow (nth 3 a) b))))
- ((and (eq (car-safe b) 'intv) (math-intv-constp b)
- (Math-realp a) (Math-posp a))
- (math-sort-intv (nth 1 b)
- (math-pow a (nth 2 b))
- (math-pow a (nth 3 b))))
- ((and (eq (car-safe a) 'intv) (math-intv-constp a)
- (eq (car-safe b) 'intv) (math-intv-constp b)
- (or (and (not (Math-negp (nth 2 a)))
- (not (Math-negp (nth 2 b))))
- (and (Math-posp (nth 2 a))
- (not (Math-posp (nth 3 b))))))
- (let ((lo (math-pow a (nth 2 b)))
- (hi (math-pow a (nth 3 b))))
- (or (eq (car-safe lo) 'intv)
- (setq lo (list 'intv (if (memq (nth 1 b) '(2 3)) 3 0) lo lo)))
- (or (eq (car-safe hi) 'intv)
- (setq hi (list 'intv (if (memq (nth 1 b) '(1 3)) 3 0) hi hi)))
- (math-combine-intervals
- (nth 2 lo) (and (or (memq (nth 1 b) '(2 3))
- (math-infinitep (nth 2 lo)))
- (memq (nth 1 lo) '(2 3)))
- (nth 3 lo) (and (or (memq (nth 1 b) '(2 3))
- (math-infinitep (nth 3 lo)))
- (memq (nth 1 lo) '(1 3)))
- (nth 2 hi) (and (or (memq (nth 1 b) '(1 3))
- (math-infinitep (nth 2 hi)))
- (memq (nth 1 hi) '(2 3)))
- (nth 3 hi) (and (or (memq (nth 1 b) '(1 3))
- (math-infinitep (nth 3 hi)))
- (memq (nth 1 hi) '(1 3))))))
- ((and (eq (car-safe a) 'mod) (eq (car-safe b) 'mod)
- (equal (nth 2 a) (nth 2 b)))
- (math-make-mod (math-pow-mod (nth 1 a) (nth 1 b) (nth 2 a))
- (nth 2 a)))
- ((and (eq (car-safe a) 'mod) (Math-anglep b))
- (math-make-mod (math-pow-mod (nth 1 a) b (nth 2 a)) (nth 2 a)))
- ((and (eq (car-safe b) 'mod) (Math-anglep a))
- (math-make-mod (math-pow-mod a (nth 1 b) (nth 2 b)) (nth 2 b)))
- ((not (Math-numberp a))
- (math-reject-arg a 'numberp))
- (t
- (math-reject-arg b 'numberp))))
-
-(defun math-quarter-integer (x)
- (if (Math-integerp x)
- 0
- (if (math-negp x)
- (progn
- (setq x (math-quarter-integer (math-neg x)))
- (and x (- 4 x)))
- (if (eq (car x) 'frac)
- (if (eq (nth 2 x) 2)
- 2
- (and (eq (nth 2 x) 4)
- (progn
- (setq x (nth 1 x))
- (% (if (consp x) (nth 1 x) x) 4))))
- (if (eq (car x) 'float)
- (if (>= (nth 2 x) 0)
- 0
- (if (= (nth 2 x) -1)
- (progn
- (setq x (nth 1 x))
- (and (= (% (if (consp x) (nth 1 x) x) 10) 5) 2))
- (if (= (nth 2 x) -2)
- (progn
- (setq x (nth 1 x)
- x (% (if (consp x) (nth 1 x) x) 100))
- (if (= x 25) 1
- (if (= x 75) 3)))))))))))
-
-;;; This assumes A < M and M > 0.
-(defun math-pow-mod (a b m) ; [R R R R]
- (if (and (Math-integerp a) (Math-integerp b) (Math-integerp m))
- (if (Math-negp b)
- (math-div-mod 1 (math-pow-mod a (Math-integer-neg b) m) m)
- (if (eq m 1)
- 0
- (math-pow-mod-step a b m)))
- (math-mod (math-pow a b) m)))
-
-(defun math-pow-mod-step (a n m) ; [I I I I]
- (math-working "pow" a)
- (let ((val (cond
- ((eq n 0) 1)
- ((eq n 1) a)
- (t
- (let ((rest (math-pow-mod-step
- (math-imod (math-mul a a) m)
- (math-div2 n)
- m)))
- (if (math-evenp n)
- rest
- (math-mod (math-mul a rest) m)))))))
- (math-working "pow" val)
- val))
-
-
-;;; Compute the minimum of two real numbers. [R R R] [Public]
-(defun math-min (a b)
- (if (and (consp a) (eq (car a) 'intv))
- (if (and (consp b) (eq (car b) 'intv))
- (let ((lo (nth 2 a))
- (lom (memq (nth 1 a) '(2 3)))
- (hi (nth 3 a))
- (him (memq (nth 1 a) '(1 3)))
- res)
- (if (= (setq res (math-compare (nth 2 b) lo)) -1)
- (setq lo (nth 2 b) lom (memq (nth 1 b) '(2 3)))
- (if (= res 0)
- (setq lom (or lom (memq (nth 1 b) '(2 3))))))
- (if (= (setq res (math-compare (nth 3 b) hi)) -1)
- (setq hi (nth 3 b) him (memq (nth 1 b) '(1 3)))
- (if (= res 0)
- (setq him (or him (memq (nth 1 b) '(1 3))))))
- (math-make-intv (+ (if lom 2 0) (if him 1 0)) lo hi))
- (math-min a (list 'intv 3 b b)))
- (if (and (consp b) (eq (car b) 'intv))
- (math-min (list 'intv 3 a a) b)
- (let ((res (math-compare a b)))
- (if (= res 1)
- b
- (if (= res 2)
- '(var nan var-nan)
- a))))))
-
-(defun calcFunc-min (&optional a &rest b)
- (if (not a)
- '(var inf var-inf)
- (if (not (or (Math-anglep a) (eq (car a) 'date)
- (and (eq (car a) 'intv) (math-intv-constp a))
- (math-infinitep a)))
- (math-reject-arg a 'anglep))
- (math-min-list a b)))
-
-(defun math-min-list (a b)
- (if b
- (if (or (Math-anglep (car b)) (eq (car b) 'date)
- (and (eq (car (car b)) 'intv) (math-intv-constp (car b)))
- (math-infinitep (car b)))
- (math-min-list (math-min a (car b)) (cdr b))
- (math-reject-arg (car b) 'anglep))
- a))
-
-;;; Compute the maximum of two real numbers. [R R R] [Public]
-(defun math-max (a b)
- (if (or (and (consp a) (eq (car a) 'intv))
- (and (consp b) (eq (car b) 'intv)))
- (math-neg (math-min (math-neg a) (math-neg b)))
- (let ((res (math-compare a b)))
- (if (= res -1)
- b
- (if (= res 2)
- '(var nan var-nan)
- a)))))
-
-(defun calcFunc-max (&optional a &rest b)
- (if (not a)
- '(neg (var inf var-inf))
- (if (not (or (Math-anglep a) (eq (car a) 'date)
- (and (eq (car a) 'intv) (math-intv-constp a))
- (math-infinitep a)))
- (math-reject-arg a 'anglep))
- (math-max-list a b)))
-
-(defun math-max-list (a b)
- (if b
- (if (or (Math-anglep (car b)) (eq (car b) 'date)
- (and (eq (car (car b)) 'intv) (math-intv-constp (car b)))
- (math-infinitep (car b)))
- (math-max-list (math-max a (car b)) (cdr b))
- (math-reject-arg (car b) 'anglep))
- a))
-
-
-;;; Compute the absolute value of A. [O O; r r] [Public]
-(defun math-abs (a)
- (cond ((Math-negp a)
- (math-neg a))
- ((Math-anglep a)
- a)
- ((eq (car a) 'cplx)
- (math-hypot (nth 1 a) (nth 2 a)))
- ((eq (car a) 'polar)
- (nth 1 a))
- ((eq (car a) 'vec)
- (if (cdr (cdr (cdr a)))
- (math-sqrt (calcFunc-abssqr a))
- (if (cdr (cdr a))
- (math-hypot (nth 1 a) (nth 2 a))
- (if (cdr a)
- (math-abs (nth 1 a))
- a))))
- ((eq (car a) 'sdev)
- (list 'sdev (math-abs (nth 1 a)) (nth 2 a)))
- ((and (eq (car a) 'intv) (math-intv-constp a))
- (if (Math-posp a)
- a
- (let* ((nlo (math-neg (nth 2 a)))
- (res (math-compare nlo (nth 3 a))))
- (cond ((= res 1)
- (math-make-intv (if (memq (nth 1 a) '(0 1)) 2 3) 0 nlo))
- ((= res 0)
- (math-make-intv (if (eq (nth 1 a) 0) 2 3) 0 nlo))
- (t
- (math-make-intv (if (memq (nth 1 a) '(0 2)) 2 3)
- 0 (nth 3 a)))))))
- ((math-looks-negp a)
- (list 'calcFunc-abs (math-neg a)))
- ((let ((signs (math-possible-signs a)))
- (or (and (memq signs '(2 4 6)) a)
- (and (memq signs '(1 3)) (math-neg a)))))
- ((let ((inf (math-infinitep a)))
- (and inf
- (if (equal inf '(var nan var-nan))
- inf
- '(var inf var-inf)))))
- (t (calc-record-why 'numvecp a)
- (list 'calcFunc-abs a))))
-
-(defalias 'calcFunc-abs 'math-abs)
-
-(defun math-float-fancy (a)
- (cond ((eq (car a) 'intv)
- (cons (car a) (cons (nth 1 a) (mapcar 'math-float (nthcdr 2 a)))))
- ((and (memq (car a) '(* /))
- (math-numberp (nth 1 a)))
- (list (car a) (math-float (nth 1 a))
- (list 'calcFunc-float (nth 2 a))))
- ((and (eq (car a) '/)
- (eq (car (nth 1 a)) '*)
- (math-numberp (nth 1 (nth 1 a))))
- (list '* (math-float (nth 1 (nth 1 a)))
- (list 'calcFunc-float (list '/ (nth 2 (nth 1 a)) (nth 2 a)))))
- ((math-infinitep a) a)
- ((eq (car a) 'calcFunc-float) a)
- ((let ((func (assq (car a) '((calcFunc-floor . calcFunc-ffloor)
- (calcFunc-ceil . calcFunc-fceil)
- (calcFunc-trunc . calcFunc-ftrunc)
- (calcFunc-round . calcFunc-fround)
- (calcFunc-rounde . calcFunc-frounde)
- (calcFunc-roundu . calcFunc-froundu)))))
- (and func (cons (cdr func) (cdr a)))))
- (t (math-reject-arg a 'objectp))))
-
-(defalias 'calcFunc-float 'math-float)
-
-(defun math-trunc-fancy (a)
- (cond ((eq (car a) 'frac) (math-quotient (nth 1 a) (nth 2 a)))
- ((eq (car a) 'cplx) (math-trunc (nth 1 a)))
- ((eq (car a) 'polar) (math-trunc (math-complex a)))
- ((eq (car a) 'hms) (list 'hms (nth 1 a) 0 0))
- ((eq (car a) 'date) (list 'date (math-trunc (nth 1 a))))
- ((eq (car a) 'mod)
- (if (math-messy-integerp (nth 2 a))
- (math-trunc (math-make-mod (nth 1 a) (math-trunc (nth 2 a))))
- (math-make-mod (math-trunc (nth 1 a)) (nth 2 a))))
- ((eq (car a) 'intv)
- (math-make-intv (+ (if (and (equal (nth 2 a) '(neg (var inf var-inf)))
- (memq (nth 1 a) '(0 1)))
- 0 2)
- (if (and (equal (nth 3 a) '(var inf var-inf))
- (memq (nth 1 a) '(0 2)))
- 0 1))
- (if (and (Math-negp (nth 2 a))
- (Math-num-integerp (nth 2 a))
- (memq (nth 1 a) '(0 1)))
- (math-add (math-trunc (nth 2 a)) 1)
- (math-trunc (nth 2 a)))
- (if (and (Math-posp (nth 3 a))
- (Math-num-integerp (nth 3 a))
- (memq (nth 1 a) '(0 2)))
- (math-add (math-trunc (nth 3 a)) -1)
- (math-trunc (nth 3 a)))))
- ((math-provably-integerp a) a)
- ((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-trunc x prec))) a))
- ((math-infinitep a)
- (if (or (math-posp a) (math-negp a))
- a
- '(var nan var-nan)))
- ((math-to-integer a))
- (t (math-reject-arg a 'numberp))))
-
-(defun math-trunc-special (a prec)
- (if (Math-messy-integerp prec)
- (setq prec (math-trunc prec)))
- (or (integerp prec)
- (math-reject-arg prec 'fixnump))
- (if (and (<= prec 0)
- (math-provably-integerp a))
- a
- (calcFunc-scf (math-trunc (let ((calc-prefer-frac t))
- (calcFunc-scf a prec)))
- (- prec))))
-
-(defun math-to-integer (a)
- (let ((func (assq (car-safe a) '((calcFunc-ffloor . calcFunc-floor)
- (calcFunc-fceil . calcFunc-ceil)
- (calcFunc-ftrunc . calcFunc-trunc)
- (calcFunc-fround . calcFunc-round)
- (calcFunc-frounde . calcFunc-rounde)
- (calcFunc-froundu . calcFunc-roundu)))))
- (and func (= (length a) 2)
- (cons (cdr func) (cdr a)))))
-
-(defun calcFunc-ftrunc (a &optional prec)
- (if (and (Math-messy-integerp a)
- (or (not prec) (and (integerp prec)
- (<= prec 0))))
- a
- (math-float (math-trunc a prec))))
-
-(defun math-floor-fancy (a)
- (cond ((math-provably-integerp a) a)
- ((eq (car a) 'hms)
- (if (or (math-posp a)
- (and (math-zerop (nth 2 a))
- (math-zerop (nth 3 a))))
- (math-trunc a)
- (math-add (math-trunc a) -1)))
- ((eq (car a) 'date) (list 'date (math-floor (nth 1 a))))
- ((eq (car a) 'intv)
- (math-make-intv (+ (if (and (equal (nth 2 a) '(neg (var inf var-inf)))
- (memq (nth 1 a) '(0 1)))
- 0 2)
- (if (and (equal (nth 3 a) '(var inf var-inf))
- (memq (nth 1 a) '(0 2)))
- 0 1))
- (math-floor (nth 2 a))
- (if (and (Math-num-integerp (nth 3 a))
- (memq (nth 1 a) '(0 2)))
- (math-add (math-floor (nth 3 a)) -1)
- (math-floor (nth 3 a)))))
- ((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-floor x prec))) a))
- ((math-infinitep a)
- (if (or (math-posp a) (math-negp a))
- a
- '(var nan var-nan)))
- ((math-to-integer a))
- (t (math-reject-arg a 'anglep))))
-
-(defun math-floor-special (a prec)
- (if (Math-messy-integerp prec)
- (setq prec (math-trunc prec)))
- (or (integerp prec)
- (math-reject-arg prec 'fixnump))
- (if (and (<= prec 0)
- (math-provably-integerp a))
- a
- (calcFunc-scf (math-floor (let ((calc-prefer-frac t))
- (calcFunc-scf a prec)))
- (- prec))))
-
-(defun calcFunc-ffloor (a &optional prec)
- (if (and (Math-messy-integerp a)
- (or (not prec) (and (integerp prec)
- (<= prec 0))))
- a
- (math-float (math-floor a prec))))
-
-;;; Coerce A to be an integer (by truncation toward plus infinity). [I N]
-(defun math-ceiling (a &optional prec) ; [Public]
- (cond (prec
- (if (Math-messy-integerp prec)
- (setq prec (math-trunc prec)))
- (or (integerp prec)
- (math-reject-arg prec 'fixnump))
- (if (and (<= prec 0)
- (math-provably-integerp a))
- a
- (calcFunc-scf (math-ceiling (let ((calc-prefer-frac t))
- (calcFunc-scf a prec)))
- (- prec))))
- ((Math-integerp a) a)
- ((Math-messy-integerp a) (math-trunc a))
- ((Math-realp a)
- (if (Math-posp a)
- (math-add (math-trunc a) 1)
- (math-trunc a)))
- ((math-provably-integerp a) a)
- ((eq (car a) 'hms)
- (if (or (math-negp a)
- (and (math-zerop (nth 2 a))
- (math-zerop (nth 3 a))))
- (math-trunc a)
- (math-add (math-trunc a) 1)))
- ((eq (car a) 'date) (list 'date (math-ceiling (nth 1 a))))
- ((eq (car a) 'intv)
- (math-make-intv (+ (if (and (equal (nth 2 a) '(neg (var inf var-inf)))
- (memq (nth 1 a) '(0 1)))
- 0 2)
- (if (and (equal (nth 3 a) '(var inf var-inf))
- (memq (nth 1 a) '(0 2)))
- 0 1))
- (if (and (Math-num-integerp (nth 2 a))
- (memq (nth 1 a) '(0 1)))
- (math-add (math-floor (nth 2 a)) 1)
- (math-ceiling (nth 2 a)))
- (math-ceiling (nth 3 a))))
- ((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-ceiling x prec))) a))
- ((math-infinitep a)
- (if (or (math-posp a) (math-negp a))
- a
- '(var nan var-nan)))
- ((math-to-integer a))
- (t (math-reject-arg a 'anglep))))
-
-(defalias 'calcFunc-ceil 'math-ceiling)
-
-(defun calcFunc-fceil (a &optional prec)
- (if (and (Math-messy-integerp a)
- (or (not prec) (and (integerp prec)
- (<= prec 0))))
- a
- (math-float (math-ceiling a prec))))
-
-(defvar math-rounding-mode nil)
-
-;;; Coerce A to be an integer (by rounding to nearest integer). [I N] [Public]
-(defun math-round (a &optional prec)
- (cond (prec
- (if (Math-messy-integerp prec)
- (setq prec (math-trunc prec)))
- (or (integerp prec)
- (math-reject-arg prec 'fixnump))
- (if (and (<= prec 0)
- (math-provably-integerp a))
- a
- (calcFunc-scf (math-round (let ((calc-prefer-frac t))
- (calcFunc-scf a prec)))
- (- prec))))
- ((Math-anglep a)
- (if (Math-num-integerp a)
- (math-trunc a)
- (if (and (Math-negp a) (not (eq math-rounding-mode 'up)))
- (math-neg (math-round (math-neg a)))
- (setq a (let ((calc-angle-mode 'deg)) ; in case of HMS forms
- (math-add a (if (Math-ratp a)
- '(frac 1 2)
- '(float 5 -1)))))
- (if (and (Math-num-integerp a) (eq math-rounding-mode 'even))
- (progn
- (setq a (math-floor a))
- (or (math-evenp a)
- (setq a (math-sub a 1)))
- a)
- (math-floor a)))))
- ((math-provably-integerp a) a)
- ((eq (car a) 'date) (list 'date (math-round (nth 1 a))))
- ((eq (car a) 'intv)
- (math-floor (math-add a '(frac 1 2))))
- ((Math-vectorp a)
- (math-map-vec (function (lambda (x) (math-round x prec))) a))
- ((math-infinitep a)
- (if (or (math-posp a) (math-negp a))
- a
- '(var nan var-nan)))
- ((math-to-integer a))
- (t (math-reject-arg a 'anglep))))
-
-(defalias 'calcFunc-round 'math-round)
-
-(defsubst calcFunc-rounde (a &optional prec)
- (let ((math-rounding-mode 'even))
- (math-round a prec)))
-
-(defsubst calcFunc-roundu (a &optional prec)
- (let ((math-rounding-mode 'up))
- (math-round a prec)))
-
-(defun calcFunc-fround (a &optional prec)
- (if (and (Math-messy-integerp a)
- (or (not prec) (and (integerp prec)
- (<= prec 0))))
- a
- (math-float (math-round a prec))))
-
-(defsubst calcFunc-frounde (a &optional prec)
- (let ((math-rounding-mode 'even))
- (calcFunc-fround a prec)))
-
-(defsubst calcFunc-froundu (a &optional prec)
- (let ((math-rounding-mode 'up))
- (calcFunc-fround a prec)))
-
-;;; Pull floating-point values apart into mantissa and exponent.
-(defun calcFunc-mant (x)
- (if (Math-realp x)
- (if (or (Math-ratp x)
- (eq (nth 1 x) 0))
- x
- (list 'float (nth 1 x) (- 1 (math-numdigs (nth 1 x)))))
- (calc-record-why 'realp x)
- (list 'calcFunc-mant x)))
-
-(defun calcFunc-xpon (x)
- (if (Math-realp x)
- (if (or (Math-ratp x)
- (eq (nth 1 x) 0))
- 0
- (math-normalize (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
- (calc-record-why 'realp x)
- (list 'calcFunc-xpon x)))
-
-(defun calcFunc-scf (x n)
- (if (integerp n)
- (cond ((eq n 0)
- x)
- ((Math-integerp x)
- (if (> n 0)
- (math-scale-int x n)
- (math-div x (math-scale-int 1 (- n)))))
- ((eq (car x) 'frac)
- (if (> n 0)
- (math-make-frac (math-scale-int (nth 1 x) n) (nth 2 x))
- (math-make-frac (nth 1 x) (math-scale-int (nth 2 x) (- n)))))
- ((eq (car x) 'float)
- (math-make-float (nth 1 x) (+ (nth 2 x) n)))
- ((memq (car x) '(cplx sdev))
- (math-normalize
- (list (car x)
- (calcFunc-scf (nth 1 x) n)
- (calcFunc-scf (nth 2 x) n))))
- ((memq (car x) '(polar mod))
- (math-normalize
- (list (car x)
- (calcFunc-scf (nth 1 x) n)
- (nth 2 x))))
- ((eq (car x) 'intv)
- (math-normalize
- (list (car x)
- (nth 1 x)
- (calcFunc-scf (nth 2 x) n)
- (calcFunc-scf (nth 3 x) n))))
- ((eq (car x) 'vec)
- (math-map-vec (function (lambda (x) (calcFunc-scf x n))) x))
- ((math-infinitep x)
- x)
- (t
- (calc-record-why 'realp x)
- (list 'calcFunc-scf x n)))
- (if (math-messy-integerp n)
- (if (< (nth 2 n) 10)
- (calcFunc-scf x (math-trunc n))
- (math-overflow n))
- (if (math-integerp n)
- (math-overflow n)
- (calc-record-why 'integerp n)
- (list 'calcFunc-scf x n)))))
-
-
-(defun calcFunc-incr (x &optional step relative-to)
- (or step (setq step 1))
- (cond ((not (Math-integerp step))
- (math-reject-arg step 'integerp))
- ((Math-integerp x)
- (math-add x step))
- ((eq (car x) 'float)
- (if (and (math-zerop x)
- (eq (car-safe relative-to) 'float))
- (math-mul step
- (calcFunc-scf relative-to (- 1 calc-internal-prec)))
- (math-add-float x (math-make-float
- step
- (+ (nth 2 x)
- (- (math-numdigs (nth 1 x))
- calc-internal-prec))))))
- ((eq (car x) 'date)
- (if (Math-integerp (nth 1 x))
- (math-add x step)
- (math-add x (list 'hms 0 0 step))))
- (t
- (math-reject-arg x 'realp))))
-
-(defsubst calcFunc-decr (x &optional step relative-to)
- (calcFunc-incr x (math-neg (or step 1)) relative-to))
-
-(defun calcFunc-percent (x)
- (if (math-objectp x)
- (let ((calc-prefer-frac nil))
- (math-div x 100))
- (list 'calcFunc-percent x)))
-
-(defun calcFunc-relch (x y)
- (if (and (math-objectp x) (math-objectp y))
- (math-div (math-sub y x) x)
- (list 'calcFunc-relch x y)))
-
-;;; Compute the absolute value squared of A. [F N] [Public]
-(defun calcFunc-abssqr (a)
- (cond ((Math-realp a)
- (math-mul a a))
- ((eq (car a) 'cplx)
- (math-add (math-sqr (nth 1 a))
- (math-sqr (nth 2 a))))
- ((eq (car a) 'polar)
- (math-sqr (nth 1 a)))
- ((and (memq (car a) '(sdev intv)) (math-constp a))
- (math-sqr (math-abs a)))
- ((eq (car a) 'vec)
- (math-reduce-vec 'math-add (math-map-vec 'calcFunc-abssqr a)))
- ((math-known-realp a)
- (math-pow a 2))
- ((let ((inf (math-infinitep a)))
- (and inf
- (math-mul (calcFunc-abssqr (math-infinite-dir a inf)) inf))))
- (t (calc-record-why 'numvecp a)
- (list 'calcFunc-abssqr a))))
-
-(defsubst math-sqr (a)
- (math-mul a a))
-
-;;;; Number theory.
-
-(defun calcFunc-idiv (a b) ; [I I I] [Public]
- (cond ((and (Math-natnump a) (Math-natnump b) (not (eq b 0)))
- (math-quotient a b))
- ((Math-realp a)
- (if (Math-realp b)
- (let ((calc-prefer-frac t))
- (math-floor (math-div a b)))
- (math-reject-arg b 'realp)))
- ((eq (car-safe a) 'hms)
- (if (eq (car-safe b) 'hms)
- (let ((calc-prefer-frac t))
- (math-floor (math-div a b)))
- (math-reject-arg b 'hmsp)))
- ((and (or (eq (car-safe a) 'intv) (Math-realp a))
- (or (eq (car-safe b) 'intv) (Math-realp b)))
- (math-floor (math-div a b)))
- ((or (math-infinitep a)
- (math-infinitep b))
- (math-div a b))
- (t (math-reject-arg a 'anglep))))
-
-
-;;; Combine two terms being added, if possible.
-(defun math-combine-sum (a b nega negb scalar-okay)
- (if (and scalar-okay (Math-objvecp a) (Math-objvecp b))
- (math-add-or-sub a b nega negb)
- (let ((amult 1) (bmult 1))
- (and (consp a)
- (cond ((and (eq (car a) '*)
- (Math-objectp (nth 1 a)))
- (setq amult (nth 1 a)
- a (nth 2 a)))
- ((and (eq (car a) '/)
- (Math-objectp (nth 2 a)))
- (setq amult (if (Math-integerp (nth 2 a))
- (list 'frac 1 (nth 2 a))
- (math-div 1 (nth 2 a)))
- a (nth 1 a)))
- ((eq (car a) 'neg)
- (setq amult -1
- a (nth 1 a)))))
- (and (consp b)
- (cond ((and (eq (car b) '*)
- (Math-objectp (nth 1 b)))
- (setq bmult (nth 1 b)
- b (nth 2 b)))
- ((and (eq (car b) '/)
- (Math-objectp (nth 2 b)))
- (setq bmult (if (Math-integerp (nth 2 b))
- (list 'frac 1 (nth 2 b))
- (math-div 1 (nth 2 b)))
- b (nth 1 b)))
- ((eq (car b) 'neg)
- (setq bmult -1
- b (nth 1 b)))))
- (and (if math-simplifying
- (Math-equal a b)
- (equal a b))
- (progn
- (if nega (setq amult (math-neg amult)))
- (if negb (setq bmult (math-neg bmult)))
- (setq amult (math-add amult bmult))
- (math-mul amult a))))))
-
-(defun math-add-or-sub (a b aneg bneg)
- (if aneg (setq a (math-neg a)))
- (if bneg (setq b (math-neg b)))
- (if (or (Math-vectorp a) (Math-vectorp b))
- (math-normalize (list '+ a b))
- (math-add a b)))
-
-(defvar math-combine-prod-e '(var e var-e))
-
-;;; The following is expanded out four ways for speed.
-(defun math-combine-prod (a b inva invb scalar-okay)
- (cond
- ((or (and inva (Math-zerop a))
- (and invb (Math-zerop b)))
- nil)
- ((and scalar-okay (Math-objvecp a) (Math-objvecp b))
- (setq a (math-mul-or-div a b inva invb))
- (and (Math-objvecp a)
- a))
- ((and (eq (car-safe a) '^)
- inva
- (math-looks-negp (nth 2 a)))
- (math-mul (math-pow (nth 1 a) (math-neg (nth 2 a))) b))
- ((and (eq (car-safe b) '^)
- invb
- (math-looks-negp (nth 2 b)))
- (math-mul a (math-pow (nth 1 b) (math-neg (nth 2 b)))))
- (t (let ((apow 1) (bpow 1))
- (and (consp a)
- (cond ((and (eq (car a) '^)
- (or math-simplifying
- (Math-numberp (nth 2 a))))
- (setq apow (nth 2 a)
- a (nth 1 a)))
- ((eq (car a) 'calcFunc-sqrt)
- (setq apow '(frac 1 2)
- a (nth 1 a)))
- ((and (eq (car a) 'calcFunc-exp)
- (or math-simplifying
- (Math-numberp (nth 1 a))))
- (setq apow (nth 1 a)
- a math-combine-prod-e))))
- (and (consp a) (eq (car a) 'frac)
- (Math-lessp (nth 1 a) (nth 2 a))
- (setq a (math-div 1 a) apow (math-neg apow)))
- (and (consp b)
- (cond ((and (eq (car b) '^)
- (or math-simplifying
- (Math-numberp (nth 2 b))))
- (setq bpow (nth 2 b)
- b (nth 1 b)))
- ((eq (car b) 'calcFunc-sqrt)
- (setq bpow '(frac 1 2)
- b (nth 1 b)))
- ((and (eq (car b) 'calcFunc-exp)
- (or math-simplifying
- (Math-numberp (nth 1 b))))
- (setq bpow (nth 1 b)
- b math-combine-prod-e))))
- (and (consp b) (eq (car b) 'frac)
- (Math-lessp (nth 1 b) (nth 2 b))
- (setq b (math-div 1 b) bpow (math-neg bpow)))
- (if inva (setq apow (math-neg apow)))
- (if invb (setq bpow (math-neg bpow)))
- (or (and (if math-simplifying
- (math-commutative-equal a b)
- (equal a b))
- (let ((sumpow (math-add apow bpow)))
- (and (or (not (Math-integerp a))
- (Math-zerop sumpow)
- (eq (eq (car-safe apow) 'frac)
- (eq (car-safe bpow) 'frac)))
- (progn
- (and (math-looks-negp sumpow)
- (Math-ratp a) (Math-posp a)
- (setq a (math-div 1 a)
- sumpow (math-neg sumpow)))
- (cond ((equal sumpow '(frac 1 2))
- (list 'calcFunc-sqrt a))
- ((equal sumpow '(frac -1 2))
- (math-div 1 (list 'calcFunc-sqrt a)))
- ((and (eq a math-combine-prod-e)
- (eq a b))
- (list 'calcFunc-exp sumpow))
- (t
- (condition-case err
- (math-pow a sumpow)
- (inexact-result (list '^ a sumpow)))))))))
- (and math-simplifying-units
- math-combining-units
- (let* ((ua (math-check-unit-name a))
- ub)
- (and ua
- (eq ua (setq ub (math-check-unit-name b)))
- (progn
- (setq ua (if (eq (nth 1 a) (car ua))
- 1
- (nth 1 (assq (aref (symbol-name (nth 1 a))
- 0)
- math-unit-prefixes)))
- ub (if (eq (nth 1 b) (car ub))
- 1
- (nth 1 (assq (aref (symbol-name (nth 1 b))
- 0)
- math-unit-prefixes))))
- (if (Math-lessp ua ub)
- (let (temp)
- (setq temp a a b b temp
- temp ua ua ub ub temp
- temp apow apow bpow bpow temp)))
- (math-mul (math-pow (math-div ua ub) apow)
- (math-pow b (math-add apow bpow)))))))
- (and (equal apow bpow)
- (Math-natnump a) (Math-natnump b)
- (cond ((equal apow '(frac 1 2))
- (list 'calcFunc-sqrt (math-mul a b)))
- ((equal apow '(frac -1 2))
- (math-div 1 (list 'calcFunc-sqrt (math-mul a b))))
- (t
- (setq a (math-mul a b))
- (condition-case err
- (math-pow a apow)
- (inexact-result (list '^ a apow)))))))))))
-
-(defun math-mul-or-div (a b ainv binv)
- (if (or (Math-vectorp a) (Math-vectorp b))
- (math-normalize
- (if ainv
- (if binv
- (list '/ (math-div 1 a) b)
- (list '/ b a))
- (if binv
- (list '/ a b)
- (list '* a b))))
- (if ainv
- (if binv
- (math-div (math-div 1 a) b)
- (math-div b a))
- (if binv
- (math-div a b)
- (math-mul a b)))))
-
-(defun math-commutative-equal (a b)
- (if (memq (car-safe a) '(+ -))
- (and (memq (car-safe b) '(+ -))
- (let ((bterms nil) aterms p)
- (math-commutative-collect b nil)
- (setq aterms bterms bterms nil)
- (math-commutative-collect a nil)
- (and (= (length aterms) (length bterms))
- (progn
- (while (and aterms
- (progn
- (setq p bterms)
- (while (and p (not (equal (car aterms)
- (car p))))
- (setq p (cdr p)))
- p))
- (setq bterms (delq (car p) bterms)
- aterms (cdr aterms)))
- (not aterms)))))
- (equal a b)))
-
-(defun math-commutative-collect (b neg)
- (if (eq (car-safe b) '+)
- (progn
- (math-commutative-collect (nth 1 b) neg)
- (math-commutative-collect (nth 2 b) neg))
- (if (eq (car-safe b) '-)
- (progn
- (math-commutative-collect (nth 1 b) neg)
- (math-commutative-collect (nth 2 b) (not neg)))
- (setq bterms (cons (if neg (math-neg b) b) bterms)))))
-
-;;; calc-arith.el ends here
+++ /dev/null
-;;; calc-bin.el --- binary functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-bin () nil)
-
-
-;;; b-prefix binary commands.
-
-(defun calc-and (n)
- (interactive "P")
- (calc-slow-wrapper
- (calc-enter-result 2 "and"
- (append '(calcFunc-and)
- (calc-top-list-n 2)
- (and n (list (prefix-numeric-value n)))))))
-
-(defun calc-or (n)
- (interactive "P")
- (calc-slow-wrapper
- (calc-enter-result 2 "or"
- (append '(calcFunc-or)
- (calc-top-list-n 2)
- (and n (list (prefix-numeric-value n)))))))
-
-(defun calc-xor (n)
- (interactive "P")
- (calc-slow-wrapper
- (calc-enter-result 2 "xor"
- (append '(calcFunc-xor)
- (calc-top-list-n 2)
- (and n (list (prefix-numeric-value n)))))))
-
-(defun calc-diff (n)
- (interactive "P")
- (calc-slow-wrapper
- (calc-enter-result 2 "diff"
- (append '(calcFunc-diff)
- (calc-top-list-n 2)
- (and n (list (prefix-numeric-value n)))))))
-
-(defun calc-not (n)
- (interactive "P")
- (calc-slow-wrapper
- (calc-enter-result 1 "not"
- (append '(calcFunc-not)
- (calc-top-list-n 1)
- (and n (list (prefix-numeric-value n)))))))
-
-(defun calc-lshift-binary (n)
- (interactive "P")
- (calc-slow-wrapper
- (let ((hyp (if (calc-is-hyperbolic) 2 1)))
- (calc-enter-result hyp "lsh"
- (append '(calcFunc-lsh)
- (calc-top-list-n hyp)
- (and n (list (prefix-numeric-value n))))))))
-
-(defun calc-rshift-binary (n)
- (interactive "P")
- (calc-slow-wrapper
- (let ((hyp (if (calc-is-hyperbolic) 2 1)))
- (calc-enter-result hyp "rsh"
- (append '(calcFunc-rsh)
- (calc-top-list-n hyp)
- (and n (list (prefix-numeric-value n))))))))
-
-(defun calc-lshift-arith (n)
- (interactive "P")
- (calc-slow-wrapper
- (let ((hyp (if (calc-is-hyperbolic) 2 1)))
- (calc-enter-result hyp "ash"
- (append '(calcFunc-ash)
- (calc-top-list-n hyp)
- (and n (list (prefix-numeric-value n))))))))
-
-(defun calc-rshift-arith (n)
- (interactive "P")
- (calc-slow-wrapper
- (let ((hyp (if (calc-is-hyperbolic) 2 1)))
- (calc-enter-result hyp "rash"
- (append '(calcFunc-rash)
- (calc-top-list-n hyp)
- (and n (list (prefix-numeric-value n))))))))
-
-(defun calc-rotate-binary (n)
- (interactive "P")
- (calc-slow-wrapper
- (let ((hyp (if (calc-is-hyperbolic) 2 1)))
- (calc-enter-result hyp "rot"
- (append '(calcFunc-rot)
- (calc-top-list-n hyp)
- (and n (list (prefix-numeric-value n))))))))
-
-(defun calc-clip (n)
- (interactive "P")
- (calc-slow-wrapper
- (calc-enter-result 1 "clip"
- (append '(calcFunc-clip)
- (calc-top-list-n 1)
- (and n (list (prefix-numeric-value n)))))))
-
-(defun calc-word-size (n)
- (interactive "P")
- (calc-wrapper
- (or n (setq n (read-string (format "Binary word size: (default %d) "
- calc-word-size))))
- (setq n (if (stringp n)
- (if (equal n "")
- calc-word-size
- (if (string-match "\\`[-+]?[0-9]+\\'" n)
- (string-to-int n)
- (error "Expected an integer")))
- (prefix-numeric-value n)))
- (or (= n calc-word-size)
- (if (> (math-abs n) 100)
- (calc-change-mode 'calc-word-size n calc-leading-zeros)
- (calc-change-mode '(calc-word-size calc-previous-modulo)
- (list n (math-power-of-2 (math-abs n)))
- calc-leading-zeros)))
- (if (< n 0)
- (message "Binary word size is %d bits (2's complement)" (- n))
- (message "Binary word size is %d bits" n))))
-
-
-
-
-
-;;; d-prefix mode commands.
-
-(defun calc-radix (n)
- (interactive "NDisplay radix (2-36): ")
- (calc-wrapper
- (if (and (>= n 2) (<= n 36))
- (progn
- (calc-change-mode 'calc-number-radix n t)
- ;; also change global value so minibuffer sees it
- (setq-default calc-number-radix calc-number-radix))
- (setq n calc-number-radix))
- (message "Number radix is %d" n)))
-
-(defun calc-decimal-radix ()
- (interactive)
- (calc-radix 10))
-
-(defun calc-binary-radix ()
- (interactive)
- (calc-radix 2))
-
-(defun calc-octal-radix ()
- (interactive)
- (calc-radix 8))
-
-(defun calc-hex-radix ()
- (interactive)
- (calc-radix 16))
-
-(defun calc-leading-zeros (n)
- (interactive "P")
- (calc-wrapper
- (if (calc-change-mode 'calc-leading-zeros n t t)
- (message "Zero-padding integers to %d digits (assuming radix %d)"
- (let* ((calc-internal-prec 6))
- (math-compute-max-digits (math-abs calc-word-size)
- calc-number-radix))
- calc-number-radix)
- (message "Omitting leading zeros on integers"))))
-
-
-(defvar math-power-of-2-cache (list 1 2 4 8 16 32 64 128 256 512 1024))
-(defvar math-big-power-of-2-cache nil)
-(defun math-power-of-2 (n) ; [I I] [Public]
- (if (and (natnump n) (<= n 100))
- (or (nth n math-power-of-2-cache)
- (let* ((i (length math-power-of-2-cache))
- (val (nth (1- i) math-power-of-2-cache)))
- (while (<= i n)
- (setq val (math-mul val 2)
- math-power-of-2-cache (nconc math-power-of-2-cache
- (list val))
- i (1+ i)))
- val))
- (let ((found (assq n math-big-power-of-2-cache)))
- (if found
- (cdr found)
- (let ((po2 (math-ipow 2 n)))
- (setq math-big-power-of-2-cache
- (cons (cons n po2) math-big-power-of-2-cache))
- po2)))))
-
-(defun math-integer-log2 (n) ; [I I] [Public]
- (let ((i 0)
- (p math-power-of-2-cache)
- val)
- (while (and p (Math-natnum-lessp (setq val (car p)) n))
- (setq p (cdr p)
- i (1+ i)))
- (if p
- (and (equal val n)
- i)
- (while (Math-natnum-lessp
- (prog1
- (setq val (math-mul val 2))
- (setq math-power-of-2-cache (nconc math-power-of-2-cache
- (list val))))
- n)
- (setq i (1+ i)))
- (and (equal val n)
- i))))
-
-
-
-
-;;; Bitwise operations.
-
-(defun calcFunc-and (a b &optional w) ; [I I I] [Public]
- (cond ((Math-messy-integerp w)
- (calcFunc-and a b (math-trunc w)))
- ((and w (not (integerp w)))
- (math-reject-arg w 'fixnump))
- ((and (integerp a) (integerp b))
- (math-clip (logand a b) w))
- ((or (eq (car-safe a) 'mod) (eq (car-safe b) 'mod))
- (math-binary-modulo-args 'calcFunc-and a b w))
- ((not (Math-num-integerp a))
- (math-reject-arg a 'integerp))
- ((not (Math-num-integerp b))
- (math-reject-arg b 'integerp))
- (t (math-clip (cons 'bigpos
- (math-and-bignum (math-binary-arg a w)
- (math-binary-arg b w)))
- w))))
-
-(defun math-binary-arg (a w)
- (if (not (Math-integerp a))
- (setq a (math-trunc a)))
- (if (Math-integer-negp a)
- (math-not-bignum (cdr (math-bignum-test (math-sub -1 a)))
- (math-abs (if w (math-trunc w) calc-word-size)))
- (cdr (Math-bignum-test a))))
-
-(defun math-binary-modulo-args (f a b w)
- (let (mod)
- (if (eq (car-safe a) 'mod)
- (progn
- (setq mod (nth 2 a)
- a (nth 1 a))
- (if (eq (car-safe b) 'mod)
- (if (equal mod (nth 2 b))
- (setq b (nth 1 b))
- (math-reject-arg b "*Inconsistent modulos"))))
- (setq mod (nth 2 b)
- b (nth 1 b)))
- (if (Math-messy-integerp mod)
- (setq mod (math-trunc mod))
- (or (Math-integerp mod)
- (math-reject-arg mod 'integerp)))
- (let ((bits (math-integer-log2 mod)))
- (if bits
- (if w
- (if (/= w bits)
- (calc-record-why
- "*Warning: Modulo inconsistent with word size"))
- (setq w bits))
- (calc-record-why "*Warning: Modulo is not a power of 2"))
- (math-make-mod (if b
- (funcall f a b w)
- (funcall f a w))
- mod))))
-
-(defun math-and-bignum (a b) ; [l l l]
- (and a b
- (let ((qa (math-div-bignum-digit a 512))
- (qb (math-div-bignum-digit b 512)))
- (math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- 512
- (logand (cdr qa) (cdr qb))))))
-
-(defun calcFunc-or (a b &optional w) ; [I I I] [Public]
- (cond ((Math-messy-integerp w)
- (calcFunc-or a b (math-trunc w)))
- ((and w (not (integerp w)))
- (math-reject-arg w 'fixnump))
- ((and (integerp a) (integerp b))
- (math-clip (logior a b) w))
- ((or (eq (car-safe a) 'mod) (eq (car-safe b) 'mod))
- (math-binary-modulo-args 'calcFunc-or a b w))
- ((not (Math-num-integerp a))
- (math-reject-arg a 'integerp))
- ((not (Math-num-integerp b))
- (math-reject-arg b 'integerp))
- (t (math-clip (cons 'bigpos
- (math-or-bignum (math-binary-arg a w)
- (math-binary-arg b w)))
- w))))
-
-(defun math-or-bignum (a b) ; [l l l]
- (and (or a b)
- (let ((qa (math-div-bignum-digit a 512))
- (qb (math-div-bignum-digit b 512)))
- (math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- 512
- (logior (cdr qa) (cdr qb))))))
-
-(defun calcFunc-xor (a b &optional w) ; [I I I] [Public]
- (cond ((Math-messy-integerp w)
- (calcFunc-xor a b (math-trunc w)))
- ((and w (not (integerp w)))
- (math-reject-arg w 'fixnump))
- ((and (integerp a) (integerp b))
- (math-clip (logxor a b) w))
- ((or (eq (car-safe a) 'mod) (eq (car-safe b) 'mod))
- (math-binary-modulo-args 'calcFunc-xor a b w))
- ((not (Math-num-integerp a))
- (math-reject-arg a 'integerp))
- ((not (Math-num-integerp b))
- (math-reject-arg b 'integerp))
- (t (math-clip (cons 'bigpos
- (math-xor-bignum (math-binary-arg a w)
- (math-binary-arg b w)))
- w))))
-
-(defun math-xor-bignum (a b) ; [l l l]
- (and (or a b)
- (let ((qa (math-div-bignum-digit a 512))
- (qb (math-div-bignum-digit b 512)))
- (math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- 512
- (logxor (cdr qa) (cdr qb))))))
-
-(defun calcFunc-diff (a b &optional w) ; [I I I] [Public]
- (cond ((Math-messy-integerp w)
- (calcFunc-diff a b (math-trunc w)))
- ((and w (not (integerp w)))
- (math-reject-arg w 'fixnump))
- ((and (integerp a) (integerp b))
- (math-clip (logand a (lognot b)) w))
- ((or (eq (car-safe a) 'mod) (eq (car-safe b) 'mod))
- (math-binary-modulo-args 'calcFunc-diff a b w))
- ((not (Math-num-integerp a))
- (math-reject-arg a 'integerp))
- ((not (Math-num-integerp b))
- (math-reject-arg b 'integerp))
- (t (math-clip (cons 'bigpos
- (math-diff-bignum (math-binary-arg a w)
- (math-binary-arg b w)))
- w))))
-
-(defun math-diff-bignum (a b) ; [l l l]
- (and a
- (let ((qa (math-div-bignum-digit a 512))
- (qb (math-div-bignum-digit b 512)))
- (math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa))
- (math-norm-bignum (car qb)))
- 512
- (logand (cdr qa) (lognot (cdr qb)))))))
-
-(defun calcFunc-not (a &optional w) ; [I I] [Public]
- (cond ((Math-messy-integerp w)
- (calcFunc-not a (math-trunc w)))
- ((eq (car-safe a) 'mod)
- (math-binary-modulo-args 'calcFunc-not a nil w))
- ((and w (not (integerp w)))
- (math-reject-arg w 'fixnump))
- ((not (Math-num-integerp a))
- (math-reject-arg a 'integerp))
- ((< (or w (setq w calc-word-size)) 0)
- (math-clip (calcFunc-not a (- w)) w))
- (t (math-normalize
- (cons 'bigpos
- (math-not-bignum (math-binary-arg a w)
- w))))))
-
-(defun math-not-bignum (a w) ; [l l]
- (let ((q (math-div-bignum-digit a 512)))
- (if (<= w 9)
- (list (logand (lognot (cdr q))
- (1- (lsh 1 w))))
- (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
- (- w 9))
- 512
- (logxor (cdr q) 511)))))
-
-(defun calcFunc-lsh (a &optional n w) ; [I I] [Public]
- (setq a (math-trunc a)
- n (if n (math-trunc n) 1))
- (if (eq (car-safe a) 'mod)
- (math-binary-modulo-args 'calcFunc-lsh a n w)
- (setq w (if w (math-trunc w) calc-word-size))
- (or (integerp w)
- (math-reject-arg w 'fixnump))
- (or (Math-integerp a)
- (math-reject-arg a 'integerp))
- (or (Math-integerp n)
- (math-reject-arg n 'integerp))
- (if (< w 0)
- (math-clip (calcFunc-lsh a n (- w)) w)
- (if (Math-integer-negp a)
- (setq a (math-clip a w)))
- (cond ((or (Math-lessp n (- w))
- (Math-lessp w n))
- 0)
- ((< n 0)
- (math-quotient (math-clip a w) (math-power-of-2 (- n))))
- (t
- (math-clip (math-mul a (math-power-of-2 n)) w))))))
-
-(defun calcFunc-rsh (a &optional n w) ; [I I] [Public]
- (calcFunc-lsh a (math-neg (or n 1)) w))
-
-(defun calcFunc-ash (a &optional n w) ; [I I] [Public]
- (if (or (null n)
- (not (Math-negp n)))
- (calcFunc-lsh a n w)
- (setq a (math-trunc a)
- n (if n (math-trunc n) 1))
- (if (eq (car-safe a) 'mod)
- (math-binary-modulo-args 'calcFunc-ash a n w)
- (setq w (if w (math-trunc w) calc-word-size))
- (or (integerp w)
- (math-reject-arg w 'fixnump))
- (or (Math-integerp a)
- (math-reject-arg a 'integerp))
- (or (Math-integerp n)
- (math-reject-arg n 'integerp))
- (if (< w 0)
- (math-clip (calcFunc-ash a n (- w)) w)
- (if (Math-integer-negp a)
- (setq a (math-clip a w)))
- (let ((two-to-sizem1 (math-power-of-2 (1- w)))
- (sh (calcFunc-lsh a n w)))
- (cond ((Math-natnum-lessp a two-to-sizem1)
- sh)
- ((Math-lessp n (- 1 w))
- (math-add (math-mul two-to-sizem1 2) -1))
- (t (let ((two-to-n (math-power-of-2 (- n))))
- (math-add (calcFunc-lsh (math-add two-to-n -1)
- (+ w n) w)
- sh)))))))))
-
-(defun calcFunc-rash (a &optional n w) ; [I I] [Public]
- (calcFunc-ash a (math-neg (or n 1)) w))
-
-(defun calcFunc-rot (a &optional n w) ; [I I] [Public]
- (setq a (math-trunc a)
- n (if n (math-trunc n) 1))
- (if (eq (car-safe a) 'mod)
- (math-binary-modulo-args 'calcFunc-rot a n w)
- (setq w (if w (math-trunc w) calc-word-size))
- (or (integerp w)
- (math-reject-arg w 'fixnump))
- (or (Math-integerp a)
- (math-reject-arg a 'integerp))
- (or (Math-integerp n)
- (math-reject-arg n 'integerp))
- (if (< w 0)
- (math-clip (calcFunc-rot a n (- w)) w)
- (if (Math-integer-negp a)
- (setq a (math-clip a w)))
- (cond ((or (Math-integer-negp n)
- (not (Math-natnum-lessp n w)))
- (calcFunc-rot a (math-mod n w) w))
- (t
- (math-add (calcFunc-lsh a (- n w) w)
- (calcFunc-lsh a n w)))))))
-
-(defun math-clip (a &optional w) ; [I I] [Public]
- (cond ((Math-messy-integerp w)
- (math-clip a (math-trunc w)))
- ((eq (car-safe a) 'mod)
- (math-binary-modulo-args 'math-clip a nil w))
- ((and w (not (integerp w)))
- (math-reject-arg w 'fixnump))
- ((not (Math-num-integerp a))
- (math-reject-arg a 'integerp))
- ((< (or w (setq w calc-word-size)) 0)
- (setq a (math-clip a (- w)))
- (if (Math-natnum-lessp a (math-power-of-2 (- -1 w)))
- a
- (math-sub a (math-power-of-2 (- w)))))
- ((Math-negp a)
- (math-normalize (cons 'bigpos (math-binary-arg a w))))
- ((and (integerp a) (< a 1000000))
- (if (>= w 20)
- a
- (logand a (1- (lsh 1 w)))))
- (t
- (math-normalize
- (cons 'bigpos
- (math-clip-bignum (cdr (math-bignum-test (math-trunc a)))
- w))))))
-
-(defalias 'calcFunc-clip 'math-clip)
-
-(defun math-clip-bignum (a w) ; [l l]
- (let ((q (math-div-bignum-digit a 512)))
- (if (<= w 9)
- (list (logand (cdr q)
- (1- (lsh 1 w))))
- (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q))
- (- w 9))
- 512
- (cdr q)))))
-
-(defvar math-max-digits-cache nil)
-(defun math-compute-max-digits (w r)
- (let* ((pair (+ (* r 100000) w))
- (res (assq pair math-max-digits-cache)))
- (if res
- (cdr res)
- (let* ((calc-command-flags nil)
- (digs (math-ceiling (math-div w (math-real-log2 r)))))
- (setq math-max-digits-cache (cons (cons pair digs)
- math-max-digits-cache))
- digs))))
-
-(defvar math-log2-cache (list '(2 . 1)
- '(4 . 2)
- '(8 . 3)
- '(10 . (float 332193 -5))
- '(16 . 4)
- '(32 . 5)))
-(defun math-real-log2 (x) ;;; calc-internal-prec must be 6
- (let ((res (assq x math-log2-cache)))
- (if res
- (cdr res)
- (let* ((calc-symbolic-mode nil)
- (calc-display-working-message nil)
- (log (calcFunc-log x 2)))
- (setq math-log2-cache (cons (cons x log) math-log2-cache))
- log))))
-
-(defconst math-radix-digits ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
- "A" "B" "C" "D" "E" "F" "G" "H" "I" "J"
- "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
- "U" "V" "W" "X" "Y" "Z"])
-
-(defsubst math-format-radix-digit (a) ; [X D]
- (aref math-radix-digits a))
-
-(defun math-format-radix (a) ; [X S]
- (if (< a calc-number-radix)
- (if (< a 0)
- (concat "-" (math-format-radix (- a)))
- (math-format-radix-digit a))
- (let ((s ""))
- (while (> a 0)
- (setq s (concat (math-format-radix-digit (% a calc-number-radix)) s)
- a (/ a calc-number-radix)))
- s)))
-
-(defconst math-binary-digits ["000" "001" "010" "011"
- "100" "101" "110" "111"])
-(defun math-format-binary (a) ; [X S]
- (if (< a 8)
- (if (< a 0)
- (concat "-" (math-format-binary (- a)))
- (math-format-radix a))
- (let ((s ""))
- (while (> a 7)
- (setq s (concat (aref math-binary-digits (% a 8)) s)
- a (/ a 8)))
- (concat (math-format-radix a) s))))
-
-(defun math-format-bignum-radix (a) ; [X L]
- (cond ((null a) "0")
- ((and (null (cdr a))
- (< (car a) calc-number-radix))
- (math-format-radix-digit (car a)))
- (t
- (let ((q (math-div-bignum-digit a calc-number-radix)))
- (concat (math-format-bignum-radix (math-norm-bignum (car q)))
- (math-format-radix-digit (cdr q)))))))
-
-(defun math-format-bignum-binary (a) ; [X L]
- (cond ((null a) "0")
- ((null (cdr a))
- (math-format-binary (car a)))
- (t
- (let ((q (math-div-bignum-digit a 512)))
- (concat (math-format-bignum-binary (math-norm-bignum (car q)))
- (aref math-binary-digits (/ (cdr q) 64))
- (aref math-binary-digits (% (/ (cdr q) 8) 8))
- (aref math-binary-digits (% (cdr q) 8)))))))
-
-(defun math-format-bignum-octal (a) ; [X L]
- (cond ((null a) "0")
- ((null (cdr a))
- (math-format-radix (car a)))
- (t
- (let ((q (math-div-bignum-digit a 512)))
- (concat (math-format-bignum-octal (math-norm-bignum (car q)))
- (math-format-radix-digit (/ (cdr q) 64))
- (math-format-radix-digit (% (/ (cdr q) 8) 8))
- (math-format-radix-digit (% (cdr q) 8)))))))
-
-(defun math-format-bignum-hex (a) ; [X L]
- (cond ((null a) "0")
- ((null (cdr a))
- (math-format-radix (car a)))
- (t
- (let ((q (math-div-bignum-digit a 256)))
- (concat (math-format-bignum-hex (math-norm-bignum (car q)))
- (math-format-radix-digit (/ (cdr q) 16))
- (math-format-radix-digit (% (cdr q) 16)))))))
-
-;;; Decompose into integer and fractional parts, without depending
-;;; on calc-internal-prec.
-(defun math-float-parts (a need-frac) ; returns ( int frac fracdigs )
- (if (>= (nth 2 a) 0)
- (list (math-scale-rounding (nth 1 a) (nth 2 a)) '(float 0 0) 0)
- (let* ((d (math-numdigs (nth 1 a)))
- (n (- (nth 2 a))))
- (if need-frac
- (if (>= n d)
- (list 0 a n)
- (let ((qr (math-idivmod (nth 1 a) (math-scale-int 1 n))))
- (list (car qr) (math-make-float (cdr qr) (- n)) n)))
- (list (math-scale-rounding (nth 1 a) (nth 2 a))
- '(float 0 0) 0)))))
-
-(defun math-format-radix-float (a prec)
- (let ((fmt (car calc-float-format))
- (figs (nth 1 calc-float-format))
- (point calc-point-char)
- (str nil))
- (if (eq fmt 'fix)
- (let* ((afigs (math-abs figs))
- (fp (math-float-parts a (> afigs 0)))
- (calc-internal-prec (+ 3 (max (nth 2 fp)
- (math-convert-radix-digits
- afigs t))))
- (int (car fp))
- (frac (math-round (math-mul (math-normalize (nth 1 fp))
- (math-radix-float-power afigs)))))
- (if (not (and (math-zerop frac) (math-zerop int) (< figs 0)))
- (let ((math-radix-explicit-format nil))
- (let ((calc-group-digits nil))
- (setq str (if (> afigs 0) (math-format-number frac) ""))
- (if (< (length str) afigs)
- (setq str (concat (make-string (- afigs (length str)) ?0)
- str))
- (if (> (length str) afigs)
- (setq str (substring str 1)
- int (math-add int 1))))
- (setq str (concat (math-format-number int) point str)))
- (when calc-group-digits
- (setq str (math-group-float str))))
- (setq figs 0))))
- (or str
- (let* ((prec calc-internal-prec)
- (afigs (if (> figs 0)
- figs
- (max 1 (+ figs
- (1- (math-convert-radix-digits
- (max prec
- (math-numdigs (nth 1 a)))))))))
- (calc-internal-prec (+ 3 (math-convert-radix-digits afigs t)))
- (explo -1) (vlo (math-radix-float-power explo))
- (exphi 1) (vhi (math-radix-float-power exphi))
- expmid vmid eadj)
- (setq a (math-normalize a))
- (if (Math-zerop a)
- (setq explo 0)
- (if (math-lessp-float '(float 1 0) a)
- (while (not (math-lessp-float a vhi))
- (setq explo exphi vlo vhi
- exphi (math-mul exphi 2)
- vhi (math-radix-float-power exphi)))
- (while (math-lessp-float a vlo)
- (setq exphi explo vhi vlo
- explo (math-mul explo 2)
- vlo (math-radix-float-power explo))))
- (while (not (eq (math-sub exphi explo) 1))
- (setq expmid (math-div2 (math-add explo exphi))
- vmid (math-radix-float-power expmid))
- (if (math-lessp-float a vmid)
- (setq exphi expmid vhi vmid)
- (setq explo expmid vlo vmid)))
- (setq a (math-div-float a vlo)))
- (let* ((sc (math-round (math-mul a (math-radix-float-power
- (1- afigs)))))
- (math-radix-explicit-format nil))
- (let ((calc-group-digits nil))
- (setq str (math-format-number sc))))
- (if (> (length str) afigs)
- (setq str (substring str 0 -1)
- explo (1+ explo)))
- (if (and (eq fmt 'float)
- (math-lessp explo (+ (if (= figs 0)
- (1- (math-convert-radix-digits
- prec))
- afigs)
- calc-display-sci-high 1))
- (math-lessp calc-display-sci-low explo))
- (let ((dpos (1+ explo)))
- (cond ((<= dpos 0)
- (setq str (concat "0" point (make-string (- dpos) ?0)
- str)))
- ((> dpos (length str))
- (setq str (concat str (make-string (- dpos (length str))
- ?0) point)))
- (t
- (setq str (concat (substring str 0 dpos) point
- (substring str dpos)))))
- (setq explo nil))
- (setq eadj (if (eq fmt 'eng)
- (min (math-mod explo 3) (length str))
- 0)
- str (concat (substring str 0 (1+ eadj)) point
- (substring str (1+ eadj)))))
- (setq pos (length str))
- (while (eq (aref str (1- pos)) ?0) (setq pos (1- pos)))
- (and explo (eq (aref str (1- pos)) ?.) (setq pos (1- pos)))
- (setq str (substring str 0 pos))
- (when calc-group-digits
- (setq str (math-group-float str)))
- (if explo
- (let ((estr (let ((calc-number-radix 10)
- (calc-group-digits nil))
- (setq estr (math-format-number
- (math-sub explo eadj))))))
- (setq str (if (or (memq calc-language '(math maple))
- (> calc-number-radix 14))
- (format "%s*%d.^%s" str calc-number-radix estr)
- (format "%se%s" str estr)))))))
- str))
-
-(defvar math-radix-digits-cache nil)
-
-(defun math-convert-radix-digits (n &optional to-dec)
- (let ((key (cons n (cons to-dec calc-number-radix))))
- (or (cdr (assoc key math-radix-digits-cache))
- (let* ((calc-internal-prec 6)
- (log (math-div (math-real-log2 calc-number-radix)
- '(float 332193 -5))))
- (cdr (car (setq math-radix-digits-cache
- (cons (cons key (math-ceiling (if to-dec
- (math-mul n log)
- (math-div n log))))
- math-radix-digits-cache))))))))
-
-(defvar math-radix-float-cache-tag nil)
-
-(defun math-radix-float-power (n)
- (if (eq n 0)
- '(float 1 0)
- (or (and (eq calc-number-radix (car math-radix-float-cache-tag))
- (<= calc-internal-prec (cdr math-radix-float-cache-tag)))
- (setq math-radix-float-cache-tag (cons calc-number-radix
- calc-internal-prec)
- math-radix-float-cache nil))
- (math-normalize
- (or (cdr (assoc n math-radix-float-cache))
- (cdr (car (setq math-radix-float-cache
- (cons (cons
- n
- (let ((calc-internal-prec
- (cdr math-radix-float-cache-tag)))
- (if (math-negp n)
- (math-div-float '(float 1 0)
- (math-radix-float-power
- (math-neg n)))
- (math-mul-float (math-sqr-float
- (math-radix-float-power
- (math-div2 n)))
- (if (math-evenp n)
- '(float 1 0)
- (math-float
- calc-number-radix))))))
- math-radix-float-cache))))))))
-
-
-;;; calc-bin.el ends here
+++ /dev/null
-;;; calc-comb.el --- combinatoric functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-comb () nil)
-
-(defconst math-primes-table
- [2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89
- 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181
- 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277
- 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383
- 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487
- 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601
- 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709
- 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827
- 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947
- 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049
- 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151
- 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249
- 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361
- 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459
- 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559
- 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657
- 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759
- 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
- 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997
- 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089
- 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213
- 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311
- 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411
- 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543
- 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663
- 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741
- 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851
- 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969
- 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089
- 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221
- 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331
- 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461
- 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557
- 3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671
- 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779
- 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907
- 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013
- 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129
- 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243
- 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363
- 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493
- 4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621
- 4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729
- 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871
- 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
- 4987 4993 4999 5003])
-
-;;; Combinatorics
-
-(defun calc-gcd (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "gcd" 'calcFunc-gcd arg)))
-
-(defun calc-lcm (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "lcm" 'calcFunc-lcm arg)))
-
-(defun calc-extended-gcd ()
- (interactive)
- (calc-slow-wrapper
- (calc-enter-result 2 "egcd" (cons 'calcFunc-egcd (calc-top-list-n 2)))))
-
-(defun calc-factorial (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "fact" 'calcFunc-fact arg)))
-
-(defun calc-gamma (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "gmma" 'calcFunc-gamma arg)))
-
-(defun calc-double-factorial (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "dfac" 'calcFunc-dfact arg)))
-
-(defun calc-choose (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-binary-op "perm" 'calcFunc-perm arg)
- (calc-binary-op "chos" 'calcFunc-choose arg))))
-
-(defun calc-perm (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-choose arg))
-
-(defvar calc-last-random-limit '(float 1 0))
-(defun calc-random (n)
- (interactive "P")
- (calc-slow-wrapper
- (if n
- (calc-enter-result 0 "rand" (list 'calcFunc-random
- (calc-get-random-limit
- (prefix-numeric-value n))))
- (calc-enter-result 1 "rand" (list 'calcFunc-random
- (calc-get-random-limit
- (calc-top-n 1)))))))
-
-(defun calc-get-random-limit (val)
- (if (eq val 0)
- calc-last-random-limit
- (setq calc-last-random-limit val)))
-
-(defun calc-rrandom ()
- (interactive)
- (calc-slow-wrapper
- (setq calc-last-random-limit '(float 1 0))
- (calc-enter-result 0 "rand" (list 'calcFunc-random '(float 1 0)))))
-
-(defun calc-random-again (arg)
- (interactive "p")
- (calc-slow-wrapper
- (while (>= (setq arg (1- arg)) 0)
- (calc-enter-result 0 "rand" (list 'calcFunc-random
- calc-last-random-limit)))))
-
-(defun calc-shuffle (n)
- (interactive "P")
- (calc-slow-wrapper
- (if n
- (calc-enter-result 1 "shuf" (list 'calcFunc-shuffle
- (prefix-numeric-value n)
- (calc-get-random-limit
- (calc-top-n 1))))
- (calc-enter-result 2 "shuf" (list 'calcFunc-shuffle
- (calc-top-n 1)
- (calc-get-random-limit
- (calc-top-n 2)))))))
-
-(defun calc-report-prime-test (res)
- (cond ((eq (car res) t)
- (calc-record-message "prim" "Prime (guaranteed)"))
- ((eq (car res) nil)
- (if (cdr res)
- (if (eq (nth 1 res) 'unknown)
- (calc-record-message
- "prim" "Non-prime (factors unknown)")
- (calc-record-message
- "prim" "Non-prime (%s is a factor)"
- (math-format-number (nth 1 res))))
- (calc-record-message "prim" "Non-prime")))
- (t
- (calc-record-message
- "prim" "Probably prime (%d iters; %s%% chance of error)"
- (nth 1 res)
- (let ((calc-float-format '(fix 2)))
- (math-format-number (nth 2 res)))))))
-
-(defun calc-prime-test (iters)
- (interactive "p")
- (calc-slow-wrapper
- (let* ((n (calc-top-n 1))
- (res (math-prime-test n iters)))
- (calc-report-prime-test res))))
-
-(defun calc-next-prime (iters)
- (interactive "p")
- (calc-slow-wrapper
- (let ((calc-verbose-nextprime t))
- (if (calc-is-inverse)
- (calc-enter-result 1 "prvp" (list 'calcFunc-prevprime
- (calc-top-n 1) (math-abs iters)))
- (calc-enter-result 1 "nxtp" (list 'calcFunc-nextprime
- (calc-top-n 1) (math-abs iters)))))))
-
-(defun calc-prev-prime (iters)
- (interactive "p")
- (calc-invert-func)
- (calc-next-prime iters))
-
-(defun calc-prime-factors (iters)
- (interactive "p")
- (calc-slow-wrapper
- (let ((res (calcFunc-prfac (calc-top-n 1))))
- (if (not math-prime-factors-finished)
- (calc-record-message "pfac" "Warning: May not be fully factored"))
- (calc-enter-result 1 "pfac" res))))
-
-(defun calc-totient (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "phi" 'calcFunc-totient arg)))
-
-(defun calc-moebius (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "mu" 'calcFunc-moebius arg)))
-
-
-(defun calcFunc-gcd (a b)
- (if (Math-messy-integerp a)
- (setq a (math-trunc a)))
- (if (Math-messy-integerp b)
- (setq b (math-trunc b)))
- (cond ((and (Math-integerp a) (Math-integerp b))
- (math-gcd a b))
- ((Math-looks-negp a)
- (calcFunc-gcd (math-neg a) b))
- ((Math-looks-negp b)
- (calcFunc-gcd a (math-neg b)))
- ((Math-zerop a) b)
- ((Math-zerop b) a)
- ((and (Math-ratp a)
- (Math-ratp b))
- (math-make-frac (math-gcd (if (eq (car-safe a) 'frac) (nth 1 a) a)
- (if (eq (car-safe b) 'frac) (nth 1 b) b))
- (calcFunc-lcm
- (if (eq (car-safe a) 'frac) (nth 2 a) 1)
- (if (eq (car-safe b) 'frac) (nth 2 b) 1))))
- ((not (Math-integerp a))
- (calc-record-why 'integerp a)
- (list 'calcFunc-gcd a b))
- (t
- (calc-record-why 'integerp b)
- (list 'calcFunc-gcd a b))))
-
-(defun calcFunc-lcm (a b)
- (let ((g (calcFunc-gcd a b)))
- (if (Math-numberp g)
- (math-div (math-mul a b) g)
- (list 'calcFunc-lcm a b))))
-
-(defun calcFunc-egcd (a b) ; Knuth section 4.5.2
- (cond
- ((not (Math-integerp a))
- (if (Math-messy-integerp a)
- (calcFunc-egcd (math-trunc a) b)
- (calc-record-why 'integerp a)
- (list 'calcFunc-egcd a b)))
- ((not (Math-integerp b))
- (if (Math-messy-integerp b)
- (calcFunc-egcd a (math-trunc b))
- (calc-record-why 'integerp b)
- (list 'calcFunc-egcd a b)))
- (t
- (let ((u1 1) (u2 0) (u3 a)
- (v1 0) (v2 1) (v3 b)
- t1 t2 q)
- (while (not (eq v3 0))
- (setq q (math-idivmod u3 v3)
- t1 (math-sub u1 (math-mul v1 (car q)))
- t2 (math-sub u2 (math-mul v2 (car q)))
- u1 v1 u2 v2 u3 v3
- v1 t1 v2 t2 v3 (cdr q)))
- (list 'vec u3 u1 u2)))))
-
-
-;;; Factorial and related functions.
-
-(defun calcFunc-fact (n) ; [I I] [F F] [Public]
- (let (temp)
- (cond ((Math-integer-negp n)
- (if calc-infinite-mode
- '(var uinf var-uinf)
- (math-reject-arg n 'range)))
- ((integerp n)
- (if (<= n 20)
- (aref '[1 1 2 6 24 120 720 5040 40320 362880
- (bigpos 800 628 3) (bigpos 800 916 39)
- (bigpos 600 1 479) (bigpos 800 20 227 6)
- (bigpos 200 291 178 87) (bigpos 0 368 674 307 1)
- (bigpos 0 888 789 922 20) (bigpos 0 96 428 687 355)
- (bigpos 0 728 705 373 402 6)
- (bigpos 0 832 408 100 645 121)
- (bigpos 0 640 176 8 902 432 2)] n)
- (math-factorial-iter (1- n) 2 1)))
- ((and (math-messy-integerp n)
- (Math-lessp n 100))
- (math-inexact-result)
- (setq temp (math-trunc n))
- (if (>= temp 0)
- (if (<= temp 20)
- (math-float (calcFunc-fact temp))
- (math-with-extra-prec 1
- (math-factorial-iter (1- temp) 2 '(float 1 0))))
- (math-reject-arg n 'range)))
- ((math-numberp n)
- (let* ((q (math-quarter-integer n))
- (tn (and q (Math-lessp n 1000) (Math-lessp -1000 n)
- (1+ (math-floor n)))))
- (cond ((and tn (= q 2)
- (or calc-symbolic-mode (< (math-abs tn) 20)))
- (let ((q (if (< tn 0)
- (math-div
- (math-pow -2 (- tn))
- (math-double-factorial-iter (* -2 tn) 3 1 2))
- (math-div
- (math-double-factorial-iter (* 2 tn) 3 1 2)
- (math-pow 2 tn)))))
- (math-mul q (if calc-symbolic-mode
- (list 'calcFunc-sqrt '(var pi var-pi))
- (math-sqrt-pi)))))
- ((and tn (>= tn 0) (< tn 20)
- (memq q '(1 3)))
- (math-inexact-result)
- (math-div
- (math-mul (math-double-factorial-iter (* 4 tn) q 1 4)
- (if (= q 1) (math-gamma-1q) (math-gamma-3q)))
- (math-pow 4 tn)))
- (t
- (math-inexact-result)
- (math-with-extra-prec 3
- (math-gammap1-raw (math-float n)))))))
- ((equal n '(var inf var-inf)) n)
- (t (calc-record-why 'numberp n)
- (list 'calcFunc-fact n)))))
-
-(math-defcache math-gamma-1q nil
- (math-with-extra-prec 3
- (math-gammap1-raw '(float -75 -2))))
-
-(math-defcache math-gamma-3q nil
- (math-with-extra-prec 3
- (math-gammap1-raw '(float -25 -2))))
-
-(defun math-factorial-iter (count n f)
- (if (= (% n 5) 1)
- (math-working (format "factorial(%d)" (1- n)) f))
- (if (> count 0)
- (math-factorial-iter (1- count) (1+ n) (math-mul n f))
- f))
-
-(defun calcFunc-dfact (n) ; [I I] [F F] [Public]
- (cond ((Math-integer-negp n)
- (if (math-oddp n)
- (if (eq n -1)
- 1
- (math-div (if (eq (math-mod n 4) 3) 1 -1)
- (calcFunc-dfact (math-sub -2 n))))
- (list 'calcFunc-dfact n)))
- ((Math-zerop n) 1)
- ((integerp n) (math-double-factorial-iter n (+ 2 (% n 2)) 1 2))
- ((math-messy-integerp n)
- (let ((temp (math-trunc n)))
- (math-inexact-result)
- (if (natnump temp)
- (if (Math-lessp temp 200)
- (math-with-extra-prec 1
- (math-double-factorial-iter temp (+ 2 (% temp 2))
- '(float 1 0) 2))
- (let* ((half (math-div2 temp))
- (even (math-mul (math-pow 2 half)
- (calcFunc-fact (math-float half)))))
- (if (math-evenp temp)
- even
- (math-div (calcFunc-fact n) even))))
- (list 'calcFunc-dfact max))))
- ((equal n '(var inf var-inf)) n)
- (t (calc-record-why 'natnump n)
- (list 'calcFunc-dfact n))))
-
-(defun math-double-factorial-iter (max n f step)
- (if (< (% n 12) step)
- (math-working (format "dfact(%d)" (- n step)) f))
- (if (<= n max)
- (math-double-factorial-iter max (+ n step) (math-mul n f) step)
- f))
-
-(defun calcFunc-perm (n m) ; [I I I] [F F F] [Public]
- (cond ((and (integerp n) (integerp m) (<= m n) (>= m 0))
- (math-factorial-iter m (1+ (- n m)) 1))
- ((or (not (math-num-integerp n))
- (and (math-messy-integerp n) (Math-lessp 100 n))
- (not (math-num-integerp m))
- (and (math-messy-integerp m) (Math-lessp 100 m)))
- (or (math-realp n) (equal n '(var inf var-inf))
- (math-reject-arg n 'realp))
- (or (math-realp m) (equal m '(var inf var-inf))
- (math-reject-arg m 'realp))
- (and (math-num-integerp n) (math-negp n) (math-reject-arg n 'range))
- (and (math-num-integerp m) (math-negp m) (math-reject-arg m 'range))
- (math-div (calcFunc-fact n) (calcFunc-fact (math-sub n m))))
- (t
- (let ((tn (math-trunc n))
- (tm (math-trunc m)))
- (math-inexact-result)
- (or (integerp tn) (math-reject-arg tn 'fixnump))
- (or (integerp tm) (math-reject-arg tm 'fixnump))
- (or (and (<= tm tn) (>= tm 0)) (math-reject-arg tm 'range))
- (math-with-extra-prec 1
- (math-factorial-iter tm (1+ (- tn tm)) '(float 1 0)))))))
-
-(defun calcFunc-choose (n m) ; [I I I] [F F F] [Public]
- (cond ((and (integerp n) (integerp m) (<= m n) (>= m 0))
- (if (> m (/ n 2))
- (math-choose-iter (- n m) n 1 1)
- (math-choose-iter m n 1 1)))
- ((not (math-realp n))
- (math-reject-arg n 'realp))
- ((not (math-realp m))
- (math-reject-arg m 'realp))
- ((not (math-num-integerp m))
- (if (and (math-num-integerp n) (math-negp n))
- (list 'calcFunc-choose n m)
- (math-div (calcFunc-fact (math-float n))
- (math-mul (calcFunc-fact m)
- (calcFunc-fact (math-sub n m))))))
- ((math-negp m) 0)
- ((math-negp n)
- (let ((val (calcFunc-choose (math-add (math-add n m) -1) m)))
- (if (math-evenp (math-trunc m))
- val
- (math-neg val))))
- ((and (math-num-integerp n)
- (Math-lessp n m))
- 0)
- (t
- (math-inexact-result)
- (let ((tm (math-trunc m)))
- (or (integerp tm) (math-reject-arg tm 'fixnump))
- (if (> tm 100)
- (math-div (calcFunc-fact (math-float n))
- (math-mul (calcFunc-fact (math-float m))
- (calcFunc-fact (math-float
- (math-sub n m)))))
- (math-with-extra-prec 1
- (math-choose-float-iter tm n 1 1)))))))
-
-(defun math-choose-iter (m n i c)
- (if (and (= (% i 5) 1) (> i 5))
- (math-working (format "choose(%d)" (1- i)) c))
- (if (<= i m)
- (math-choose-iter m (1- n) (1+ i)
- (math-quotient (math-mul c n) i))
- c))
-
-(defun math-choose-float-iter (count n i c)
- (if (= (% i 5) 1)
- (math-working (format "choose(%d)" (1- i)) c))
- (if (> count 0)
- (math-choose-float-iter (1- count) (math-sub n 1) (1+ i)
- (math-div (math-mul c n) i))
- c))
-
-
-;;; Stirling numbers.
-
-(defun calcFunc-stir1 (n m)
- (math-stirling-number n m 1))
-
-(defun calcFunc-stir2 (n m)
- (math-stirling-number n m 0))
-
-(defvar math-stirling-cache (vector [[1]] [[1]]))
-(defun math-stirling-number (n m k)
- (or (math-num-natnump n) (math-reject-arg n 'natnump))
- (or (math-num-natnump m) (math-reject-arg m 'natnump))
- (if (consp n) (setq n (math-trunc n)))
- (or (integerp n) (math-reject-arg n 'fixnump))
- (if (consp m) (setq m (math-trunc m)))
- (or (integerp m) (math-reject-arg m 'fixnump))
- (if (< n m)
- 0
- (let ((cache (aref math-stirling-cache k)))
- (while (<= (length cache) n)
- (let ((i (1- (length cache)))
- row)
- (setq cache (vconcat cache (make-vector (length cache) nil)))
- (aset math-stirling-cache k cache)
- (while (< (setq i (1+ i)) (length cache))
- (aset cache i (setq row (make-vector (1+ i) nil)))
- (aset row 0 0)
- (aset row i 1))))
- (if (= k 1)
- (math-stirling-1 n m)
- (math-stirling-2 n m)))))
-
-(defun math-stirling-1 (n m)
- (or (aref (aref cache n) m)
- (aset (aref cache n) m
- (math-add (math-stirling-1 (1- n) (1- m))
- (math-mul (- 1 n) (math-stirling-1 (1- n) m))))))
-
-(defun math-stirling-2 (n m)
- (or (aref (aref cache n) m)
- (aset (aref cache n) m
- (math-add (math-stirling-2 (1- n) (1- m))
- (math-mul m (math-stirling-2 (1- n) m))))))
-
-(defvar math-random-table nil)
-(defvar math-last-RandSeed nil)
-(defvar math-random-ptr1 nil)
-(defvar math-random-ptr2 nil)
-(defvar math-random-shift nil)
-
-;;; Produce a random 10-bit integer, with (random) if no seed provided,
-;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A.
-(defun math-init-random-base ()
- (if (and (boundp 'var-RandSeed) var-RandSeed)
- (if (eq (car-safe var-RandSeed) 'vec)
- nil
- (if (Math-integerp var-RandSeed)
- (let* ((seed (math-sub 161803 var-RandSeed))
- (mj (1+ (math-mod seed '(bigpos 0 0 1))))
- (mk (1+ (math-mod (math-quotient seed '(bigpos 0 0 1))
- '(bigpos 0 0 1))))
- (i 0))
- (setq math-random-table (cons 'vec (make-list 55 mj)))
- (while (<= (setq i (1+ i)) 54)
- (let* ((ii (% (* i 21) 55))
- (p (nthcdr ii math-random-table)))
- (setcar p mk)
- (setq mk (- mj mk)
- mj (car p)))))
- (math-reject-arg var-RandSeed "*RandSeed must be an integer"))
- (setq var-RandSeed (list 'vec var-RandSeed)
- math-random-ptr1 math-random-table
- math-random-cache nil
- math-random-ptr2 (nthcdr 31 math-random-table))
- (let ((i 200))
- (while (> (setq i (1- i)) 0)
- (math-random-base))))
- (random t)
- (setq var-RandSeed nil
- math-random-cache nil
- i 0
- math-random-shift -4) ; assume RAND_MAX >= 16383
- ;; This exercises the random number generator and also helps
- ;; deduce a better value for RAND_MAX.
- (while (< (setq i (1+ i)) 30)
- (if (> (lsh (math-abs (random)) math-random-shift) 4095)
- (setq math-random-shift (1- math-random-shift)))))
- (setq math-last-RandSeed var-RandSeed
- math-gaussian-cache nil))
-
-(defun math-random-base ()
- (if var-RandSeed
- (progn
- (setq math-random-ptr1 (or (cdr math-random-ptr1)
- (cdr math-random-table))
- math-random-ptr2 (or (cdr math-random-ptr2)
- (cdr math-random-table)))
- (logand (lsh (setcar math-random-ptr1
- (logand (- (car math-random-ptr1)
- (car math-random-ptr2)) 524287))
- -6) 1023))
- (logand (lsh (random) math-random-shift) 1023)))
-
-
-;;; Produce a random digit in the range 0..999.
-;;; Avoid various pitfalls that may lurk in the built-in (random) function!
-;;; Shuffling algorithm from Numerical Recipes, section 7.1.
-(defun math-random-digit ()
- (let (i)
- (or (and (boundp 'var-RandSeed) (eq var-RandSeed math-last-RandSeed))
- (math-init-random-base))
- (or math-random-cache
- (progn
- (setq math-random-last (math-random-base)
- math-random-cache (make-vector 13 nil)
- i -1)
- (while (< (setq i (1+ i)) 13)
- (aset math-random-cache i (math-random-base)))))
- (while (progn
- (setq i (/ math-random-last 79) ; 0 <= i < 13
- math-random-last (aref math-random-cache i))
- (aset math-random-cache i (math-random-base))
- (>= math-random-last 1000)))
- math-random-last))
-(setq math-random-cache nil)
-
-;;; Produce an N-digit random integer.
-(defun math-random-digits (n)
- (cond ((<= n 6)
- (math-scale-right (+ (* (math-random-digit) 1000) (math-random-digit))
- (- 6 n)))
- (t (let* ((slop (% (- 900003 n) 3))
- (i (/ (+ n slop) 3))
- (digs nil))
- (while (> i 0)
- (setq digs (cons (math-random-digit) digs)
- i (1- i)))
- (math-normalize (math-scale-right (cons 'bigpos digs)
- slop))))))
-
-;;; Produce a uniformly-distributed random float 0 <= N < 1.
-(defun math-random-float ()
- (math-make-float (math-random-digits calc-internal-prec)
- (- calc-internal-prec)))
-
-;;; Produce a Gaussian-distributed random float with mean=0, sigma=1.
-(defun math-gaussian-float ()
- (math-with-extra-prec 2
- (if (and math-gaussian-cache
- (= (car math-gaussian-cache) calc-internal-prec))
- (prog1
- (cdr math-gaussian-cache)
- (setq math-gaussian-cache nil))
- (let* ((v1 (math-add (math-mul (math-random-float) 2) -1))
- (v2 (math-add (math-mul (math-random-float) 2) -1))
- (r (math-add (math-sqr v1) (math-sqr v2))))
- (while (or (not (Math-lessp r 1)) (math-zerop r))
- (setq v1 (math-add (math-mul (math-random-float) 2) -1)
- v2 (math-add (math-mul (math-random-float) 2) -1)
- r (math-add (math-sqr v1) (math-sqr v2))))
- (let ((fac (math-sqrt (math-mul (math-div (calcFunc-ln r) r) -2))))
- (setq math-gaussian-cache (cons calc-internal-prec
- (math-mul v1 fac)))
- (math-mul v2 fac))))))
-(setq math-gaussian-cache nil)
-
-;;; Produce a random integer or real 0 <= N < MAX.
-(defun calcFunc-random (max)
- (cond ((Math-zerop max)
- (math-gaussian-float))
- ((Math-integerp max)
- (let* ((digs (math-numdigs max))
- (r (math-random-digits (+ digs 3))))
- (math-mod r max)))
- ((Math-realp max)
- (math-mul (math-random-float) max))
- ((and (eq (car max) 'intv) (math-constp max)
- (Math-lessp (nth 2 max) (nth 3 max)))
- (if (math-floatp max)
- (let ((val (math-add (math-mul (math-random-float)
- (math-sub (nth 3 max) (nth 2 max)))
- (nth 2 max))))
- (if (or (and (memq (nth 1 max) '(0 1)) ; almost not worth
- (Math-equal val (nth 2 max))) ; checking!
- (and (memq (nth 1 max) '(0 2))
- (Math-equal val (nth 3 max))))
- (calcFunc-random max)
- val))
- (let ((lo (if (memq (nth 1 max) '(0 1))
- (math-add (nth 2 max) 1) (nth 2 max)))
- (hi (if (memq (nth 1 max) '(1 3))
- (math-add (nth 3 max) 1) (nth 3 max))))
- (if (Math-lessp lo hi)
- (math-add (calcFunc-random (math-sub hi lo)) lo)
- (math-reject-arg max "*Empty interval")))))
- ((eq (car max) 'vec)
- (if (cdr max)
- (nth (1+ (calcFunc-random (1- (length max)))) max)
- (math-reject-arg max "*Empty list")))
- ((and (eq (car max) 'sdev) (math-constp max) (Math-realp (nth 1 max)))
- (math-add (math-mul (math-gaussian-float) (nth 2 max)) (nth 1 max)))
- (t (math-reject-arg max 'realp))))
-
-;;; Choose N objects at random from the set MAX without duplicates.
-(defun calcFunc-shuffle (n &optional max)
- (or max (setq max n n -1))
- (or (and (Math-num-integerp n)
- (or (natnump (setq n (math-trunc n))) (eq n -1)))
- (math-reject-arg n 'integerp))
- (cond ((or (math-zerop max)
- (math-floatp max)
- (eq (car-safe max) 'sdev))
- (if (< n 0)
- (math-reject-arg n 'natnump)
- (math-simple-shuffle n max)))
- ((and (<= n 1) (>= n 0))
- (math-simple-shuffle n max))
- ((and (eq (car-safe max) 'intv) (math-constp max))
- (let ((num (math-add (math-sub (nth 3 max) (nth 2 max))
- (cdr (assq (nth 1 max)
- '((0 . -1) (1 . 0)
- (2 . 0) (3 . 1))))))
- (min (math-add (nth 2 max) (if (memq (nth 1 max) '(0 1))
- 1 0))))
- (if (< n 0) (setq n num))
- (or (math-posp num) (math-reject-arg max 'range))
- (and (Math-lessp num n) (math-reject-arg n 'range))
- (if (Math-lessp n (math-quotient num 3))
- (math-simple-shuffle n max)
- (if (> (* n 4) (* num 3))
- (math-add (math-sub min 1)
- (math-shuffle-list n num (calcFunc-index num)))
- (let ((tot 0)
- (m 0)
- (vec nil))
- (while (< m n)
- (if (< (calcFunc-random (- num tot)) (- n m))
- (setq vec (cons (math-add min tot) vec)
- m (1+ m)))
- (setq tot (1+ tot)))
- (math-shuffle-list n n (cons 'vec vec)))))))
- ((eq (car-safe max) 'vec)
- (let ((size (1- (length max))))
- (if (< n 0) (setq n size))
- (if (and (> n (/ size 2)) (<= n size))
- (math-shuffle-list n size (copy-sequence max))
- (let* ((vals (calcFunc-shuffle
- n (list 'intv 3 1 (1- (length max)))))
- (p vals))
- (while (setq p (cdr p))
- (setcar p (nth (car p) max)))
- vals))))
- ((math-integerp max)
- (if (math-posp max)
- (calcFunc-shuffle n (list 'intv 2 0 max))
- (calcFunc-shuffle n (list 'intv 1 max 0))))
- (t (math-reject-arg max 'realp))))
-
-(defun math-simple-shuffle (n max)
- (let ((vec nil)
- val)
- (while (>= (setq n (1- n)) 0)
- (while (math-member (setq val (calcFunc-random max)) vec))
- (setq vec (cons val vec)))
- (cons 'vec vec)))
-
-(defun math-shuffle-list (n size vec)
- (let ((j size)
- k temp
- (p vec))
- (while (cdr (setq p (cdr p)))
- (setq k (calcFunc-random j)
- j (1- j)
- temp (nth k p))
- (setcar (nthcdr k p) (car p))
- (setcar p temp))
- (cons 'vec (nthcdr (- size n -1) vec))))
-
-(defun math-member (x list)
- (while (and list (not (equal x (car list))))
- (setq list (cdr list)))
- list)
-
-
-;;; Check if the integer N is prime. [X I]
-;;; Return (nil) if non-prime,
-;;; (nil N) if non-prime with known factor N,
-;;; (nil unknown) if non-prime with no known factors,
-;;; (t) if prime,
-;;; (maybe N P) if probably prime (after N iters with probability P%)
-(defun math-prime-test (n iters)
- (if (and (Math-vectorp n) (cdr n))
- (setq n (nth (1- (length n)) n)))
- (if (Math-messy-integerp n)
- (setq n (math-trunc n)))
- (let ((res))
- (while (> iters 0)
- (setq res
- (cond ((and (integerp n) (<= n 5003))
- (list (= (math-next-small-prime n) n)))
- ((not (Math-integerp n))
- (error "Argument must be an integer"))
- ((Math-integer-negp n)
- '(nil))
- ((Math-natnum-lessp n '(bigpos 0 0 8))
- (setq n (math-fixnum n))
- (let ((i -1) v)
- (while (and (> (% n (setq v (aref math-primes-table
- (setq i (1+ i)))))
- 0)
- (< (* v v) n)))
- (if (= (% n v) 0)
- (list nil v)
- '(t))))
- ((not (equal n (car math-prime-test-cache)))
- (cond ((= (% (nth 1 n) 2) 0) '(nil 2))
- ((= (% (nth 1 n) 5) 0) '(nil 5))
- (t (let ((dig (cdr n)) (sum 0))
- (while dig
- (if (cdr dig)
- (setq sum (% (+ (+ sum (car dig))
- (* (nth 1 dig) 1000))
- 111111)
- dig (cdr (cdr dig)))
- (setq sum (% (+ sum (car dig)) 111111)
- dig nil)))
- (cond ((= (% sum 3) 0) '(nil 3))
- ((= (% sum 7) 0) '(nil 7))
- ((= (% sum 11) 0) '(nil 11))
- ((= (% sum 13) 0) '(nil 13))
- ((= (% sum 37) 0) '(nil 37))
- (t
- (setq math-prime-test-cache-k 1
- math-prime-test-cache-q
- (math-div2 n)
- math-prime-test-cache-nm1
- (math-add n -1))
- (while (math-evenp
- math-prime-test-cache-q)
- (setq math-prime-test-cache-k
- (1+ math-prime-test-cache-k)
- math-prime-test-cache-q
- (math-div2
- math-prime-test-cache-q)))
- (setq iters (1+ iters))
- (list 'maybe
- 0
- (math-sub
- 100
- (math-div
- '(float 232 0)
- (math-numdigs n))))))))))
- ((not (eq (car (nth 1 math-prime-test-cache)) 'maybe))
- (nth 1 math-prime-test-cache))
- (t ; Fermat step
- (let* ((x (math-add (calcFunc-random (math-add n -2)) 2))
- (y (math-pow-mod x math-prime-test-cache-q n))
- (j 0))
- (while (and (not (eq y 1))
- (not (equal y math-prime-test-cache-nm1))
- (< (setq j (1+ j)) math-prime-test-cache-k))
- (setq y (math-mod (math-mul y y) n)))
- (if (or (equal y math-prime-test-cache-nm1)
- (and (eq y 1) (eq j 0)))
- (list 'maybe
- (1+ (nth 1 (nth 1 math-prime-test-cache)))
- (math-mul (nth 2 (nth 1 math-prime-test-cache))
- '(float 25 -2)))
- '(nil unknown))))))
- (setq math-prime-test-cache (list n res)
- iters (if (eq (car res) 'maybe)
- (1- iters)
- 0)))
- res))
-(defvar math-prime-test-cache '(-1))
-
-(defun calcFunc-prime (n &optional iters)
- (or (math-num-integerp n) (math-reject-arg n 'integerp))
- (or (not iters) (math-num-integerp iters) (math-reject-arg iters 'integerp))
- (if (car (math-prime-test (math-trunc n) (math-trunc (or iters 1))))
- 1
- 0))
-
-;;; Theory: summing base-10^6 digits modulo 111111 is "casting out 999999s".
-;;; Initial probability that N is prime is 1/ln(N) = log10(e)/log10(N).
-;;; After culling [2,3,5,7,11,13,37], probability of primality is 5.36 x more.
-;;; Initial reported probability of non-primality is thus 100% - this.
-;;; Each Fermat step multiplies this probability by 25%.
-;;; The Fermat step is algorithm P from Knuth section 4.5.4.
-
-
-(defun calcFunc-prfac (n)
- (setq math-prime-factors-finished t)
- (if (Math-messy-integerp n)
- (setq n (math-trunc n)))
- (if (Math-natnump n)
- (if (Math-natnum-lessp 2 n)
- (let (factors res p (i 0))
- (while (and (not (eq n 1))
- (< i (length math-primes-table)))
- (setq p (aref math-primes-table i))
- (while (eq (cdr (setq res (cond ((eq n p) (cons 1 0))
- ((eq n 1) (cons 0 1))
- ((consp n) (math-idivmod n p))
- (t (cons (/ n p) (% n p))))))
- 0)
- (math-working "factor" p)
- (setq factors (nconc factors (list p))
- n (car res)))
- (or (eq n 1)
- (Math-natnum-lessp p (car res))
- (setq factors (nconc factors (list n))
- n 1))
- (setq i (1+ i)))
- (or (setq math-prime-factors-finished (eq n 1))
- (setq factors (nconc factors (list n))))
- (cons 'vec factors))
- (list 'vec n))
- (if (Math-integerp n)
- (if (eq n -1)
- (list 'vec n)
- (cons 'vec (cons -1 (cdr (calcFunc-prfac (math-neg n))))))
- (calc-record-why 'integerp n)
- (list 'calcFunc-prfac n))))
-
-(defun calcFunc-totient (n)
- (if (Math-messy-integerp n)
- (setq n (math-trunc n)))
- (if (Math-natnump n)
- (if (Math-natnum-lessp n 2)
- (if (Math-negp n)
- (calcFunc-totient (math-abs n))
- n)
- (let ((factors (cdr (calcFunc-prfac n)))
- p)
- (if math-prime-factors-finished
- (progn
- (while factors
- (setq p (car factors)
- n (math-mul (math-div n p) (math-add p -1)))
- (while (equal p (car factors))
- (setq factors (cdr factors))))
- n)
- (calc-record-why "*Number too big to factor" n)
- (list 'calcFunc-totient n))))
- (calc-record-why 'natnump n)
- (list 'calcFunc-totient n)))
-
-(defun calcFunc-moebius (n)
- (if (Math-messy-integerp n)
- (setq n (math-trunc n)))
- (if (and (Math-natnump n) (not (eq n 0)))
- (if (Math-natnum-lessp n 2)
- (if (Math-negp n)
- (calcFunc-moebius (math-abs n))
- 1)
- (let ((factors (cdr (calcFunc-prfac n)))
- (mu 1))
- (if math-prime-factors-finished
- (progn
- (while factors
- (setq mu (if (equal (car factors) (nth 1 factors))
- 0 (math-neg mu))
- factors (cdr factors)))
- mu)
- (calc-record-why "Number too big to factor" n)
- (list 'calcFunc-moebius n))))
- (calc-record-why 'posintp n)
- (list 'calcFunc-moebius n)))
-
-
-(defun calcFunc-nextprime (n &optional iters)
- (if (Math-integerp n)
- (if (Math-integer-negp n)
- 2
- (if (and (integerp n) (< n 5003))
- (math-next-small-prime (1+ n))
- (if (math-evenp n)
- (setq n (math-add n -1)))
- (let (res)
- (while (not (car (setq res (math-prime-test
- (setq n (math-add n 2))
- (or iters 1))))))
- (if (and calc-verbose-nextprime
- (eq (car res) 'maybe))
- (calc-report-prime-test res)))
- n))
- (if (Math-realp n)
- (calcFunc-nextprime (math-trunc n) iters)
- (math-reject-arg n 'integerp))))
-(setq calc-verbose-nextprime nil)
-
-(defun calcFunc-prevprime (n &optional iters)
- (if (Math-integerp n)
- (if (Math-lessp n 4)
- 2
- (if (math-evenp n)
- (setq n (math-add n 1)))
- (let (res)
- (while (not (car (setq res (math-prime-test
- (setq n (math-add n -2))
- (or iters 1))))))
- (if (and calc-verbose-nextprime
- (eq (car res) 'maybe))
- (calc-report-prime-test res)))
- n)
- (if (Math-realp n)
- (calcFunc-prevprime (math-ceiling n) iters)
- (math-reject-arg n 'integerp))))
-
-(defun math-next-small-prime (n)
- (if (and (integerp n) (> n 2))
- (let ((lo -1)
- (hi (length math-primes-table))
- mid)
- (while (> (- hi lo) 1)
- (if (> n (aref math-primes-table
- (setq mid (ash (+ lo hi) -1))))
- (setq lo mid)
- (setq hi mid)))
- (aref math-primes-table hi))
- 2))
-
-
-
-
-;;; calc-comb.el ends here
+++ /dev/null
-;;; calc-cplx.el --- Complex number functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-cplx () nil)
-
-
-(defun calc-argument (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "arg" 'calcFunc-arg arg)))
-
-(defun calc-re (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "re" 'calcFunc-re arg)))
-
-(defun calc-im (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "im" 'calcFunc-im arg)))
-
-
-(defun calc-polar ()
- (interactive)
- (calc-slow-wrapper
- (let ((arg (calc-top-n 1)))
- (if (or (calc-is-inverse)
- (eq (car-safe arg) 'polar))
- (calc-enter-result 1 "p-r" (list 'calcFunc-rect arg))
- (calc-enter-result 1 "r-p" (list 'calcFunc-polar arg))))))
-
-
-
-
-(defun calc-complex-notation ()
- (interactive)
- (calc-wrapper
- (calc-change-mode 'calc-complex-format nil t)
- (message "Displaying complex numbers in (X,Y) format")))
-
-(defun calc-i-notation ()
- (interactive)
- (calc-wrapper
- (calc-change-mode 'calc-complex-format 'i t)
- (message "Displaying complex numbers in X+Yi format")))
-
-(defun calc-j-notation ()
- (interactive)
- (calc-wrapper
- (calc-change-mode 'calc-complex-format 'j t)
- (message "Displaying complex numbers in X+Yj format")))
-
-
-(defun calc-polar-mode (n)
- (interactive "P")
- (calc-wrapper
- (if (if n
- (> (prefix-numeric-value n) 0)
- (eq calc-complex-mode 'cplx))
- (progn
- (calc-change-mode 'calc-complex-mode 'polar)
- (message "Preferred complex form is polar"))
- (calc-change-mode 'calc-complex-mode 'cplx)
- (message "Preferred complex form is rectangular"))))
-
-
-;;;; Complex numbers.
-
-(defun math-normalize-polar (a)
- (let ((r (math-normalize (nth 1 a)))
- (th (math-normalize (nth 2 a))))
- (cond ((math-zerop r)
- '(polar 0 0))
- ((or (math-zerop th))
- r)
- ((and (not (eq calc-angle-mode 'rad))
- (or (equal th '(float 18 1))
- (equal th 180)))
- (math-neg r))
- ((math-negp r)
- (math-neg (list 'polar (math-neg r) th)))
- (t
- (list 'polar r th)))))
-
-
-;;; Coerce A to be complex (rectangular form). [c N]
-(defun math-complex (a)
- (cond ((eq (car-safe a) 'cplx) a)
- ((eq (car-safe a) 'polar)
- (if (math-zerop (nth 1 a))
- (nth 1 a)
- (let ((sc (calcFunc-sincos (nth 2 a))))
- (list 'cplx
- (math-mul (nth 1 a) (nth 1 sc))
- (math-mul (nth 1 a) (nth 2 sc))))))
- (t (list 'cplx a 0))))
-
-;;; Coerce A to be complex (polar form). [c N]
-(defun math-polar (a)
- (cond ((eq (car-safe a) 'polar) a)
- ((math-zerop a) '(polar 0 0))
- (t
- (list 'polar
- (math-abs a)
- (calcFunc-arg a)))))
-
-;;; Multiply A by the imaginary constant i. [N N] [Public]
-(defun math-imaginary (a)
- (if (and (or (Math-objvecp a) (math-infinitep a))
- (not calc-symbolic-mode))
- (math-mul a
- (if (or (eq (car-safe a) 'polar)
- (and (not (eq (car-safe a) 'cplx))
- (eq calc-complex-mode 'polar)))
- (list 'polar 1 (math-quarter-circle nil))
- '(cplx 0 1)))
- (math-mul a '(var i var-i))))
-
-
-
-
-(defun math-want-polar (a b)
- (cond ((eq (car-safe a) 'polar)
- (if (eq (car-safe b) 'cplx)
- (eq calc-complex-mode 'polar)
- t))
- ((eq (car-safe a) 'cplx)
- (if (eq (car-safe b) 'polar)
- (eq calc-complex-mode 'polar)
- nil))
- ((eq (car-safe b) 'polar)
- t)
- ((eq (car-safe b) 'cplx)
- nil)
- (t (eq calc-complex-mode 'polar))))
-
-;;; Force A to be in the (-pi,pi] or (-180,180] range.
-(defun math-fix-circular (a &optional dir) ; [R R]
- (cond ((eq (car-safe a) 'hms)
- (cond ((and (Math-lessp 180 (nth 1 a)) (not (eq dir 1)))
- (math-fix-circular (math-add a '(float -36 1)) -1))
- ((or (Math-lessp -180 (nth 1 a)) (eq dir -1))
- a)
- (t
- (math-fix-circular (math-add a '(float 36 1)) 1))))
- ((eq calc-angle-mode 'rad)
- (cond ((and (Math-lessp (math-pi) a) (not (eq dir 1)))
- (math-fix-circular (math-sub a (math-two-pi)) -1))
- ((or (Math-lessp (math-neg (math-pi)) a) (eq dir -1))
- a)
- (t
- (math-fix-circular (math-add a (math-two-pi)) 1))))
- (t
- (cond ((and (Math-lessp '(float 18 1) a) (not (eq dir 1)))
- (math-fix-circular (math-add a '(float -36 1)) -1))
- ((or (Math-lessp '(float -18 1) a) (eq dir -1))
- a)
- (t
- (math-fix-circular (math-add a '(float 36 1)) 1))))))
-
-
-;;;; Complex numbers.
-
-(defun calcFunc-polar (a) ; [C N] [Public]
- (cond ((Math-vectorp a)
- (math-map-vec 'calcFunc-polar a))
- ((Math-realp a) a)
- ((Math-numberp a)
- (math-normalize (math-polar a)))
- (t (list 'calcFunc-polar a))))
-
-(defun calcFunc-rect (a) ; [N N] [Public]
- (cond ((Math-vectorp a)
- (math-map-vec 'calcFunc-rect a))
- ((Math-realp a) a)
- ((Math-numberp a)
- (math-normalize (math-complex a)))
- (t (list 'calcFunc-rect a))))
-
-;;; Compute the complex conjugate of A. [O O] [Public]
-(defun calcFunc-conj (a)
- (let (aa bb)
- (cond ((Math-realp a)
- a)
- ((eq (car a) 'cplx)
- (list 'cplx (nth 1 a) (math-neg (nth 2 a))))
- ((eq (car a) 'polar)
- (list 'polar (nth 1 a) (math-neg (nth 2 a))))
- ((eq (car a) 'vec)
- (math-map-vec 'calcFunc-conj a))
- ((eq (car a) 'calcFunc-conj)
- (nth 1 a))
- ((math-known-realp a)
- a)
- ((and (equal a '(var i var-i))
- (math-imaginary-i))
- (math-neg a))
- ((and (memq (car a) '(+ - * /))
- (progn
- (setq aa (calcFunc-conj (nth 1 a))
- bb (calcFunc-conj (nth 2 a)))
- (or (not (eq (car-safe aa) 'calcFunc-conj))
- (not (eq (car-safe bb) 'calcFunc-conj)))))
- (if (eq (car a) '+)
- (math-add aa bb)
- (if (eq (car a) '-)
- (math-sub aa bb)
- (if (eq (car a) '*)
- (math-mul aa bb)
- (math-div aa bb)))))
- ((eq (car a) 'neg)
- (math-neg (calcFunc-conj (nth 1 a))))
- ((let ((inf (math-infinitep a)))
- (and inf
- (math-mul (calcFunc-conj (math-infinite-dir a inf)) inf))))
- (t (calc-record-why 'numberp a)
- (list 'calcFunc-conj a)))))
-
-
-;;; Compute the complex argument of A. [F N] [Public]
-(defun calcFunc-arg (a)
- (cond ((Math-anglep a)
- (if (math-negp a) (math-half-circle nil) 0))
- ((eq (car-safe a) 'cplx)
- (calcFunc-arctan2 (nth 2 a) (nth 1 a)))
- ((eq (car-safe a) 'polar)
- (nth 2 a))
- ((eq (car a) 'vec)
- (math-map-vec 'calcFunc-arg a))
- ((and (equal a '(var i var-i))
- (math-imaginary-i))
- (math-quarter-circle t))
- ((and (equal a '(neg (var i var-i)))
- (math-imaginary-i))
- (math-neg (math-quarter-circle t)))
- ((let ((signs (math-possible-signs a)))
- (or (and (memq signs '(2 4 6)) 0)
- (and (eq signs 1) (math-half-circle nil)))))
- ((math-infinitep a)
- (if (or (equal a '(var uinf var-uinf))
- (equal a '(var nan var-nan)))
- '(var nan var-nan)
- (calcFunc-arg (math-infinite-dir a))))
- (t (calc-record-why 'numvecp a)
- (list 'calcFunc-arg a))))
-
-(defun math-imaginary-i ()
- (let ((val (calc-var-value 'var-i)))
- (or (eq (car-safe val) 'special-const)
- (equal val '(cplx 0 1))
- (and (eq (car-safe val) 'polar)
- (eq (nth 1 val) 0)
- (Math-equal (nth 1 val) (math-quarter-circle nil))))))
-
-;;; Extract the real or complex part of a complex number. [R N] [Public]
-;;; Also extracts the real part of a modulo form.
-(defun calcFunc-re (a)
- (let (aa bb)
- (cond ((Math-realp a) a)
- ((memq (car a) '(mod cplx))
- (nth 1 a))
- ((eq (car a) 'polar)
- (math-mul (nth 1 a) (calcFunc-cos (nth 2 a))))
- ((eq (car a) 'vec)
- (math-map-vec 'calcFunc-re a))
- ((math-known-realp a) a)
- ((eq (car a) 'calcFunc-conj)
- (calcFunc-re (nth 1 a)))
- ((and (equal a '(var i var-i))
- (math-imaginary-i))
- 0)
- ((and (memq (car a) '(+ - *))
- (progn
- (setq aa (calcFunc-re (nth 1 a))
- bb (calcFunc-re (nth 2 a)))
- (or (not (eq (car-safe aa) 'calcFunc-re))
- (not (eq (car-safe bb) 'calcFunc-re)))))
- (if (eq (car a) '+)
- (math-add aa bb)
- (if (eq (car a) '-)
- (math-sub aa bb)
- (math-sub (math-mul aa bb)
- (math-mul (calcFunc-im (nth 1 a))
- (calcFunc-im (nth 2 a)))))))
- ((and (eq (car a) '/)
- (math-known-realp (nth 2 a)))
- (math-div (calcFunc-re (nth 1 a)) (nth 2 a)))
- ((eq (car a) 'neg)
- (math-neg (calcFunc-re (nth 1 a))))
- (t (calc-record-why 'numberp a)
- (list 'calcFunc-re a)))))
-
-(defun calcFunc-im (a)
- (let (aa bb)
- (cond ((Math-realp a)
- (if (math-floatp a) '(float 0 0) 0))
- ((eq (car a) 'cplx)
- (nth 2 a))
- ((eq (car a) 'polar)
- (math-mul (nth 1 a) (calcFunc-sin (nth 2 a))))
- ((eq (car a) 'vec)
- (math-map-vec 'calcFunc-im a))
- ((math-known-realp a)
- 0)
- ((eq (car a) 'calcFunc-conj)
- (math-neg (calcFunc-im (nth 1 a))))
- ((and (equal a '(var i var-i))
- (math-imaginary-i))
- 1)
- ((and (memq (car a) '(+ - *))
- (progn
- (setq aa (calcFunc-im (nth 1 a))
- bb (calcFunc-im (nth 2 a)))
- (or (not (eq (car-safe aa) 'calcFunc-im))
- (not (eq (car-safe bb) 'calcFunc-im)))))
- (if (eq (car a) '+)
- (math-add aa bb)
- (if (eq (car a) '-)
- (math-sub aa bb)
- (math-add (math-mul (calcFunc-re (nth 1 a)) bb)
- (math-mul aa (calcFunc-re (nth 2 a)))))))
- ((and (eq (car a) '/)
- (math-known-realp (nth 2 a)))
- (math-div (calcFunc-im (nth 1 a)) (nth 2 a)))
- ((eq (car a) 'neg)
- (math-neg (calcFunc-im (nth 1 a))))
- (t (calc-record-why 'numberp a)
- (list 'calcFunc-im a)))))
-
-;;; calc-cplx.el ends here
+++ /dev/null
-;;; calc-embed.el --- embed Calc in a buffer
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-embed () nil)
-
-(defun calc-show-plain (n)
- (interactive "P")
- (calc-wrapper
- (calc-set-command-flag 'renum-stack)
- (message (if (calc-change-mode 'calc-show-plain n nil t)
- "Including \"plain\" formulas in Calc Embedded mode"
- "Omitting \"plain\" formulas in Calc Embedded mode"))))
-
-
-(defvar calc-embedded-modes nil)
-(defvar calc-embedded-globals nil)
-(defvar calc-embedded-active nil)
-(defvar calc-embedded-all-active nil)
-(make-variable-buffer-local 'calc-embedded-all-active)
-(defvar calc-embedded-some-active nil)
-(make-variable-buffer-local 'calc-embedded-some-active)
-
-(defvar calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
- "*A regular expression for the opening delimiter of a formula used by
-calc-embedded.")
-
-(defvar calc-embedded-close-formula "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
- "*A regular expression for the closing delimiter of a formula used by
-calc-embedded.")
-
-(defvar calc-embedded-open-word "^\\|[^-+0-9.eE]"
- "*A regular expression for the opening delimiter of a formula used by
-calc-embedded-word.")
-
-(defvar calc-embedded-close-word "$\\|[^-+0-9.eE]"
- "*A regular expression for the closing delimiter of a formula used by
-calc-embedded-word.")
-
-(defvar calc-embedded-open-plain "%%% "
- "*A string which is the opening delimiter for a \"plain\" formula.
-If calc-show-plain mode is enabled, this is inserted at the front of
-each formula.")
-
-(defvar calc-embedded-close-plain " %%%\n"
- "*A string which is the closing delimiter for a \"plain\" formula.
-See calc-embedded-open-plain.")
-
-(defvar calc-embedded-open-new-formula "\n\n"
- "*A string which is inserted at front of formula by calc-embedded-new-formula.")
-
-(defvar calc-embedded-close-new-formula "\n\n"
- "*A string which is inserted at end of formula by calc-embedded-new-formula.")
-
-(defvar calc-embedded-announce-formula "%Embed\n\\(% .*\n\\)*"
- "*A regular expression which is sure to be followed by a calc-embedded formula." )
-
-(defvar calc-embedded-open-mode "% "
- "*A string which should precede calc-embedded mode annotations.
-This is not required to be present for user-written mode annotations.")
-
-(defvar calc-embedded-close-mode "\n"
- "*A string which should follow calc-embedded mode annotations.
-This is not required to be present for user-written mode annotations.")
-
-
-(defconst calc-embedded-mode-vars '(("precision" . calc-internal-prec)
- ("word-size" . calc-word-size)
- ("angles" . calc-angle-mode)
- ("symbolic" . calc-symbolic-mode)
- ("matrix" . calc-matrix-mode)
- ("fractions" . calc-prefer-frac)
- ("complex" . calc-complex-mode)
- ("simplify" . calc-simplify-mode)
- ("language" . the-language)
- ("plain" . calc-show-plain)
- ("break" . calc-line-breaking)
- ("justify" . the-display-just)
- ("left-label" . calc-left-label)
- ("right-label" . calc-right-label)
- ("radix" . calc-number-radix)
- ("leading-zeros" . calc-leading-zeros)
- ("grouping" . calc-group-digits)
- ("group-char" . calc-group-char)
- ("point-char" . calc-point-char)
- ("frac-format" . calc-frac-format)
- ("float-format" . calc-float-format)
- ("complex-format" . calc-complex-format)
- ("hms-format" . calc-hms-format)
- ("date-format" . calc-date-format)
- ("matrix-justify" . calc-matrix-just)
- ("full-vectors" . calc-full-vectors)
- ("break-vectors" . calc-break-vectors)
- ("vector-commas" . calc-vector-commas)
- ("vector-brackets" . calc-vector-brackets)
- ("matrix-brackets" . calc-matrix-brackets)
- ("strings" . calc-display-strings)
-))
-
-
-;;; Format of calc-embedded-info vector:
-;;; 0 Editing buffer.
-;;; 1 Calculator buffer.
-;;; 2 Top of current formula (marker).
-;;; 3 Bottom of current formula (marker).
-;;; 4 Top of current formula's delimiters (marker).
-;;; 5 Bottom of current formula's delimiters (marker).
-;;; 6 String representation of current formula.
-;;; 7 Non-nil if formula is embedded within a single line.
-;;; 8 Internal representation of current formula.
-;;; 9 Variable assigned by this formula, or nil.
-;;; 10 List of variables upon which this formula depends.
-;;; 11 Evaluated value of the formula, or nil.
-;;; 12 Mode settings for current formula.
-;;; 13 Local mode settings for current formula.
-;;; 14 Permanent mode settings for current formula.
-;;; 15 Global mode settings for editing buffer.
-
-
-;;; calc-embedded-active is an a-list keyed on buffers; each cdr is a
-;;; sorted list of calc-embedded-infos in that buffer. We do this
-;;; rather than using buffer-local variables because the latter are
-;;; thrown away when a buffer changes major modes.
-
-
-(defvar calc-embedded-quiet nil)
-(defun calc-do-embedded (arg end obeg oend)
- (if calc-embedded-info
-
- ;; Turn embedded mode off or switch to a new buffer.
- (cond ((eq (current-buffer) (aref calc-embedded-info 1))
- (let ((calcbuf (current-buffer))
- (buf (aref calc-embedded-info 0)))
- (calc-embedded-original-buffer t)
- (calc-embedded nil)
- (switch-to-buffer calcbuf)))
-
- ((eq (current-buffer) (aref calc-embedded-info 0))
- (let* ((info calc-embedded-info)
- (mode calc-embedded-modes))
- (save-excursion
- (set-buffer (aref info 1))
- (if (and (> (calc-stack-size) 0)
- (equal (calc-top 1 'full) (aref info 8)))
- (let ((calc-no-refresh-evaltos t))
- (if (calc-top 1 'sel)
- (calc-unselect 1))
- (calc-embedded-set-modes
- (aref info 15) (aref info 12) (aref info 14))
- (let ((calc-embedded-info nil))
- (calc-wrapper (calc-pop-stack))))
- (calc-set-mode-line)))
- (setq calc-embedded-info nil
- mode-line-buffer-identification (car mode)
- truncate-lines (nth 2 mode)
- buffer-read-only nil)
- (use-local-map (nth 1 mode))
- (set-buffer-modified-p (buffer-modified-p))
- (or calc-embedded-quiet
- (message "Back to %s mode" mode-name))))
-
- (t
- (if (buffer-name (aref calc-embedded-info 0))
- (save-excursion
- (set-buffer (aref calc-embedded-info 0))
- (or (y-or-n-p (format "Cancel Calc Embedded mode in buffer %s? "
- (buffer-name)))
- (keyboard-quit))
- (calc-embedded nil)))
- (calc-embedded arg end obeg oend)))
-
- ;; Turn embedded mode on.
- (calc-plain-buffer-only)
- (let ((modes (list mode-line-buffer-identification
- (current-local-map)
- truncate-lines))
- top bot outer-top outer-bot
- info chg ident)
- (barf-if-buffer-read-only)
- (or calc-embedded-globals
- (calc-find-globals))
- (setq info (calc-embedded-make-info (point) nil t arg end obeg oend))
- (if (eq (car-safe (aref info 8)) 'error)
- (progn
- (goto-char (nth 1 (aref info 8)))
- (error (nth 2 (aref info 8)))))
- (let ((mode-line-buffer-identification mode-line-buffer-identification)
- (calc-embedded-info info)
- (calc-embedded-no-reselect t))
- (calc-wrapper
- (let* ((okay nil)
- (calc-no-refresh-evaltos t))
- (setq chg (calc-embedded-set-modes
- (aref info 15) (aref info 12) (aref info 13)))
- (if (aref info 8)
- (calc-push (calc-normalize (aref info 8)))
- (calc-alg-entry)))
- (setq calc-undo-list nil
- calc-redo-list nil
- ident mode-line-buffer-identification)))
- (setq calc-embedded-info info
- calc-embedded-modes modes
- mode-line-buffer-identification ident
- truncate-lines t
- buffer-read-only t)
- (set-buffer-modified-p (buffer-modified-p))
- (use-local-map calc-mode-map)
- (setq calc-no-refresh-evaltos nil)
- (and chg calc-any-evaltos (calc-wrapper (calc-refresh-evaltos)))
- (or (eq calc-embedded-quiet t)
- (message "Embedded Calc mode enabled; %s to return to normal"
- (if calc-embedded-quiet
- "Type `M-# x'"
- "Give this command again")))))
- (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed.
-
-
-(defun calc-embedded-select (arg)
- (interactive "P")
- (calc-embedded arg)
- (and calc-embedded-info
- (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto)
- (calc-select-part 1))
- (and calc-embedded-info
- (or (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-assign)
- (and (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto)
- (eq (car-safe (nth 1 (aref calc-embedded-info 8)))
- 'calcFunc-assign)))
- (calc-select-part 2)))
-
-
-(defun calc-embedded-update-formula (arg)
- (interactive "P")
- (if arg
- (let ((entry (assq (current-buffer) calc-embedded-active)))
- (while (setq entry (cdr entry))
- (and (eq (car-safe (aref (car entry) 8)) 'calcFunc-evalto)
- (or (not (consp arg))
- (and (<= (aref (car entry) 2) (region-beginning))
- (>= (aref (car entry) 3) (region-end))))
- (save-excursion
- (calc-embedded-update (car entry) 14 t t)))))
- (if (and calc-embedded-info
- (eq (current-buffer) (aref calc-embedded-info 0))
- (>= (point) (aref calc-embedded-info 4))
- (<= (point) (aref calc-embedded-info 5)))
- (calc-evaluate 1)
- (let* ((opt (point))
- (info (calc-embedded-make-info (point) nil t))
- (pt (- opt (aref info 4))))
- (or (eq (car-safe (aref info 8)) 'error)
- (progn
- (save-excursion
- (calc-embedded-update info 14 'eval t))
- (goto-char (+ (aref info 4) pt))))))))
-
-
-(defun calc-embedded-edit (arg)
- (interactive "P")
- (let ((info (calc-embedded-make-info (point) nil t arg))
- str)
- (if (eq (car-safe (aref info 8)) 'error)
- (progn
- (goto-char (nth 1 (aref info 8)))
- (error (nth 2 (aref info 8)))))
- (calc-wrapper
- (setq str (math-showing-full-precision
- (math-format-nice-expr (aref info 8) (frame-width))))
- (calc-edit-mode (list 'calc-embedded-finish-edit info))
- (insert str "\n")))
- (calc-show-edit-buffer))
-
-(defun calc-embedded-finish-edit (info)
- (let ((buf (current-buffer))
- (str (buffer-substring (point) (point-max)))
- (start (point))
- pos)
- (switch-to-buffer calc-original-buffer)
- (let ((val (save-excursion
- (set-buffer (aref info 1))
- (let ((calc-language nil)
- (math-expr-opers math-standard-opers))
- (math-read-expr str)))))
- (if (eq (car-safe val) 'error)
- (progn
- (switch-to-buffer buf)
- (goto-char (+ start (nth 1 val)))
- (error (nth 2 val))))
- (calc-embedded-original-buffer t info)
- (aset info 8 val)
- (calc-embedded-update info 14 t t))))
-
-(defun calc-do-embedded-activate (arg cbuf)
- (calc-plain-buffer-only)
- (if arg
- (calc-embedded-forget))
- (calc-find-globals)
- (if (< (prefix-numeric-value arg) 0)
- (message "Deactivating %s for Calc Embedded mode" (buffer-name))
- (message "Activating %s for Calc Embedded mode..." (buffer-name))
- (save-excursion
- (let* ((active (assq (current-buffer) calc-embedded-active))
- (info active)
- (pat " := \\| \\\\gets \\| => \\| \\\\evalto "))
- (if calc-embedded-announce-formula
- (setq pat (format "%s\\|\\(%s\\)"
- pat calc-embedded-announce-formula)))
- (while (setq info (cdr info))
- (or (equal (buffer-substring (aref (car info) 2) (aref (car info) 3))
- (aref (car info) 6))
- (setcdr active (delq (car info) (cdr active)))))
- (goto-char (point-min))
- (while (re-search-forward pat nil t)
- (if (looking-at calc-embedded-open-formula)
- (goto-char (match-end 1)))
- (setq info (calc-embedded-make-info (point) cbuf nil))
- (or (eq (car-safe (aref info 8)) 'error)
- (goto-char (aref info 5))))))
- (message "Activating %s for Calc Embedded mode...done" (buffer-name)))
- (calc-embedded-active-state t))
-
-(defun calc-plain-buffer-only ()
- (if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode))
- (error "This command should be used in a normal editing buffer")))
-
-(defun calc-embedded-active-state (state)
- (or (assq 'calc-embedded-all-active minor-mode-alist)
- (setq minor-mode-alist
- (cons '(calc-embedded-all-active " Active")
- (cons '(calc-embedded-some-active " ~Active")
- minor-mode-alist))))
- (let ((active (assq (current-buffer) calc-embedded-active)))
- (or (cdr active)
- (setq state nil)))
- (and (eq state 'more) calc-embedded-all-active (setq state t))
- (setq calc-embedded-all-active (eq state t)
- calc-embedded-some-active (not (memq state '(nil t))))
- (set-buffer-modified-p (buffer-modified-p)))
-
-
-(defun calc-embedded-original-buffer (switch &optional info)
- (or info (setq info calc-embedded-info))
- (or (buffer-name (aref info 0))
- (progn
- (error "Calc embedded mode: Original buffer has been killed")))
- (if switch
- (set-buffer (aref info 0))))
-
-(defun calc-embedded-word ()
- (interactive)
- (calc-embedded '(4)))
-
-(defun calc-embedded-mark-formula (&optional body-only)
- "Put point at the beginning of this Calc formula, mark at the end.
-This normally marks the whole formula, including surrounding delimiters.
-With any prefix argument, marks only the formula itself."
- (interactive "P")
- (and (eq major-mode 'calc-mode)
- (error "This command should be used in a normal editing buffer"))
- (let (top bot outer-top outer-bot)
- (save-excursion
- (calc-embedded-find-bounds body-only))
- (push-mark (if body-only bot outer-bot) t)
- (goto-char (if body-only top outer-top))))
-
-(defun calc-embedded-find-bounds (&optional plain)
- ;; (while (and (bolp) (eq (following-char) ?\n))
- ;; (forward-char 1))
- (and (eolp) (bolp) (not (eq (char-after (- (point) 2)) ?\n))
- (forward-char -1))
- (let ((home (point)))
- (or (and (looking-at calc-embedded-open-formula)
- (not (looking-at calc-embedded-close-formula)))
- (re-search-backward calc-embedded-open-formula nil t)
- (error "Can't find start of formula"))
- (and (eq (preceding-char) ?\$) ; backward search for \$\$? won't back
- (eq (following-char) ?\$) ; up over a second $, so do it by hand.
- (forward-char -1))
- (setq outer-top (point))
- (goto-char (match-end 0))
- (if (eq (following-char) ?\n)
- (forward-char 1))
- (or (bolp)
- (while (eq (following-char) ?\ )
- (forward-char 1)))
- (or (eq plain 'plain)
- (if (looking-at (regexp-quote calc-embedded-open-plain))
- (progn
- (goto-char (match-end 0))
- (search-forward calc-embedded-close-plain))))
- (setq top (point))
- (or (re-search-forward calc-embedded-close-formula nil t)
- (error "Can't find end of formula"))
- (if (< (point) home)
- (error "Not inside a formula"))
- (and (eq (following-char) ?\n) (not (bolp))
- (forward-char 1))
- (setq outer-bot (point))
- (goto-char (match-beginning 0))
- (if (eq (preceding-char) ?\n)
- (backward-char 1))
- (or (eolp)
- (while (eq (preceding-char) ?\ )
- (backward-char 1)))
- (setq bot (point))))
-
-(defun calc-embedded-kill-formula ()
- "Kill the formula surrounding point.
-If Calc Embedded mode was active, this deactivates it.
-The formula (including its surrounding delimiters) is saved in the kill ring.
-The command \\[yank] can retrieve it from there."
- (interactive)
- (and calc-embedded-info
- (calc-embedded nil))
- (calc-embedded-mark-formula)
- (kill-region (point) (mark))
- (pop-mark))
-
-(defun calc-embedded-copy-formula-as-kill ()
- "Save the formula surrounding point as if killed, but don't kill it."
- (interactive)
- (save-excursion
- (calc-embedded-mark-formula)
- (copy-region-as-kill (point) (mark))
- (pop-mark)))
-
-(defun calc-embedded-duplicate ()
- (interactive)
- (let ((already calc-embedded-info)
- top bot outer-top outer-bot new-top)
- (if calc-embedded-info
- (progn
- (setq top (+ (aref calc-embedded-info 2))
- bot (+ (aref calc-embedded-info 3))
- outer-top (+ (aref calc-embedded-info 4))
- outer-bot (+ (aref calc-embedded-info 5)))
- (calc-embedded nil))
- (calc-embedded-find-bounds))
- (goto-char outer-bot)
- (insert "\n")
- (setq new-top (point))
- (insert-buffer-substring (current-buffer) outer-top outer-bot)
- (goto-char (+ new-top (- top outer-top)))
- (let ((calc-embedded-quiet (if already t 'x)))
- (calc-embedded (+ new-top (- top outer-top))
- (+ new-top (- bot outer-top))
- new-top
- (+ new-top (- outer-bot outer-top))))))
-
-(defun calc-embedded-next (arg)
- (interactive "P")
- (setq arg (prefix-numeric-value arg))
- (let* ((active (cdr (assq (current-buffer) calc-embedded-active)))
- (p active)
- (num (length active)))
- (or active
- (error "No active formulas in buffer"))
- (cond ((= arg 0))
- ((= arg -1)
- (if (<= (point) (aref (car active) 3))
- (goto-char (aref (nth (1- num) active) 2))
- (while (and (cdr p)
- (> (point) (aref (nth 1 p) 3)))
- (setq p (cdr p)))
- (goto-char (aref (car p) 2))))
- ((< arg -1)
- (calc-embedded-next -1)
- (calc-embedded-next (+ (* num 1000) arg 1)))
- (t
- (setq arg (1+ (% (1- arg) num)))
- (while (and p (>= (point) (aref (car p) 2)))
- (setq p (cdr p)))
- (while (> (setq arg (1- arg)) 0)
- (setq p (if p (cdr p) (cdr active))))
- (goto-char (aref (car (or p active)) 2))))))
-
-(defun calc-embedded-previous (arg)
- (interactive "p")
- (calc-embedded-next (- (prefix-numeric-value arg))))
-
-(defun calc-embedded-new-formula ()
- (interactive)
- (and (eq major-mode 'calc-mode)
- (error "This command should be used in a normal editing buffer"))
- (if calc-embedded-info
- (calc-embedded nil))
- (let (top bot outer-top outer-bot)
- (if (and (eq (preceding-char) ?\n)
- (string-match "\\`\n" calc-embedded-open-new-formula))
- (progn
- (setq outer-top (1- (point)))
- (forward-char -1)
- (insert (substring calc-embedded-open-new-formula 1)))
- (setq outer-top (point))
- (insert calc-embedded-open-new-formula))
- (setq top (point))
- (insert " ")
- (setq bot (point))
- (insert calc-embedded-close-new-formula)
- (if (and (eq (following-char) ?\n)
- (string-match "\n\\'" calc-embedded-close-new-formula))
- (delete-char 1))
- (setq outer-bot (point))
- (goto-char top)
- (let ((calc-embedded-quiet 'x))
- (calc-embedded top bot outer-top outer-bot))))
-
-(defun calc-embedded-forget ()
- (interactive)
- (setq calc-embedded-active (delq (assq (current-buffer) calc-embedded-active)
- calc-embedded-active))
- (calc-embedded-active-state nil))
-
-
-(defun calc-embedded-set-modes (gmodes modes local-modes &optional temp)
- (let ((the-language (calc-embedded-language))
- (the-display-just (calc-embedded-justify))
- (v gmodes)
- (changed nil)
- found value)
- (while v
- (or (symbolp (car v))
- (and (setq found (assq (car (car v)) modes))
- (not (eq (cdr found) 'default)))
- (and (setq found (assq (car (car v)) local-modes))
- (not (eq (cdr found) 'default)))
- (progn
- (if (eq (setq value (cdr (car v))) 'default)
- (setq value (cdr (assq (car (car v)) calc-mode-var-list))))
- (equal (symbol-value (car (car v))) value))
- (progn
- (setq changed t)
- (if temp (setq prev-modes (cons (cons (car (car v))
- (symbol-value (car (car v))))
- prev-modes)))
- (set (car (car v)) value)))
- (setq v (cdr v)))
- (setq v modes)
- (while v
- (or (and (setq found (assq (car (car v)) local-modes))
- (not (eq (cdr found) 'default)))
- (eq (setq value (cdr (car v))) 'default)
- (equal (symbol-value (car (car v))) value)
- (progn
- (setq changed t)
- (if temp (setq prev-modes (cons (cons (car (car v))
- (symbol-value (car (car v))))
- prev-modes)))
- (set (car (car v)) value)))
- (setq v (cdr v)))
- (setq v local-modes)
- (while v
- (or (eq (setq value (cdr (car v))) 'default)
- (equal (symbol-value (car (car v))) value)
- (progn
- (setq changed t)
- (if temp (setq prev-modes (cons (cons (car (car v))
- (symbol-value (car (car v))))
- prev-modes)))
- (set (car (car v)) value)))
- (setq v (cdr v)))
- (and changed (not (eq temp t))
- (progn
- (calc-embedded-set-justify the-display-just)
- (calc-embedded-set-language the-language)))
- (and changed (not temp)
- (progn
- (setq calc-full-float-format (list (if (eq (car calc-float-format)
- 'fix)
- 'float
- (car calc-float-format))
- 0))
- (calc-refresh)))
- changed))
-
-(defun calc-embedded-language ()
- (if calc-language-option
- (list calc-language calc-language-option)
- calc-language))
-
-(defun calc-embedded-set-language (lang)
- (let ((option nil))
- (if (consp lang)
- (setq option (nth 1 lang)
- lang (car lang)))
- (or (and (eq lang calc-language)
- (equal option calc-language-option))
- (calc-set-language lang option t))))
-
-(defun calc-embedded-justify ()
- (if calc-display-origin
- (list calc-display-just calc-display-origin)
- calc-display-just))
-
-(defun calc-embedded-set-justify (just)
- (if (consp just)
- (setq calc-display-origin (nth 1 just)
- calc-display-just (car just))
- (setq calc-display-just just
- calc-display-origin nil)))
-
-
-(defun calc-find-globals ()
- (interactive)
- (and (eq major-mode 'calc-mode)
- (error "This command should be used in a normal editing buffer"))
- (make-local-variable 'calc-embedded-globals)
- (let ((case-fold-search nil)
- (modes nil)
- (save-pt (point))
- found value)
- (goto-char (point-min))
- (while (re-search-forward "\\[calc-global-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)\\]" nil t)
- (and (setq found (assoc (buffer-substring (match-beginning 1)
- (match-end 1))
- calc-embedded-mode-vars))
- (or (assq (cdr found) modes)
- (setq modes (cons (cons (cdr found)
- (car (read-from-string
- (buffer-substring
- (match-beginning 2)
- (match-end 2)))))
- modes)))))
- (setq calc-embedded-globals (cons t modes))
- (goto-char save-pt)))
-
-(defun calc-embedded-find-modes ()
- (let ((case-fold-search nil)
- (save-pt (point))
- (no-defaults t)
- (modes nil)
- (emodes nil)
- (pmodes nil)
- found value)
- (while (and no-defaults (search-backward "[calc-" nil t))
- (forward-char 6)
- (or (and (looking-at "mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
- (setq found (assoc (buffer-substring (match-beginning 1)
- (match-end 1))
- calc-embedded-mode-vars))
- (or (assq (cdr found) modes)
- (setq modes (cons (cons (cdr found)
- (car (read-from-string
- (buffer-substring
- (match-beginning 2)
- (match-end 2)))))
- modes))))
- (and (looking-at "perm-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
- (setq found (assoc (buffer-substring (match-beginning 1)
- (match-end 1))
- calc-embedded-mode-vars))
- (or (assq (cdr found) pmodes)
- (setq pmodes (cons (cons (cdr found)
- (car (read-from-string
- (buffer-substring
- (match-beginning 2)
- (match-end 2)))))
- pmodes))))
- (and (looking-at "edit-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
- (setq found (assoc (buffer-substring (match-beginning 1)
- (match-end 1))
- calc-embedded-mode-vars))
- (or (assq (cdr found) emodes)
- (setq emodes (cons (cons (cdr found)
- (car (read-from-string
- (buffer-substring
- (match-beginning 2)
- (match-end 2)))))
- emodes))))
- (and (looking-at "defaults]")
- (setq no-defaults nil)))
- (backward-char 6))
- (goto-char save-pt)
- (list modes emodes pmodes)))
-
-
-(defun calc-embedded-make-info (point cbuf fresh &optional
- top bot outer-top outer-bot)
- (let* ((bufentry (assq (current-buffer) calc-embedded-active))
- (found bufentry)
- (force (and fresh top))
- (fixed top)
- (new-info nil)
- info str)
- (or found
- (setq found (list (current-buffer))
- calc-embedded-active (cons found calc-embedded-active)))
- (while (and (cdr found)
- (> point (aref (car (cdr found)) 3)))
- (setq found (cdr found)))
- (if (and (cdr found)
- (>= point (aref (nth 1 found) 2)))
- (setq info (nth 1 found))
- (setq info (make-vector 16 nil)
- new-info t
- fresh t)
- (aset info 0 (current-buffer))
- (aset info 1 (or cbuf (save-excursion
- (calc-create-buffer)
- (current-buffer)))))
- (if (and (integerp top) (not bot)) ; started with a user-supplied argument
- (progn
- (if (= (setq arg (prefix-numeric-value arg)) 0)
- (progn
- (aset info 2 (copy-marker (region-beginning)))
- (aset info 3 (copy-marker (region-end))))
- (aset info (if (> arg 0) 2 3) (point-marker))
- (forward-line arg)
- (aset info (if (> arg 0) 3 2) (point-marker)))
- (aset info 4 (copy-marker (aref info 2)))
- (aset info 5 (copy-marker (aref info 3))))
- (if (aref info 4)
- (setq top (aref info 2)
- fixed top)
- (if (consp top)
- (let ((calc-embedded-open-formula calc-embedded-open-word)
- (calc-embedded-close-formula calc-embedded-close-word))
- (calc-embedded-find-bounds 'plain))
- (or top
- (calc-embedded-find-bounds 'plain)))
- (aset info 2 (copy-marker (min top bot)))
- (aset info 3 (copy-marker (max top bot)))
- (aset info 4 (copy-marker (or outer-top (aref info 2))))
- (aset info 5 (copy-marker (or outer-bot (aref info 3))))))
- (goto-char (aref info 2))
- (if new-info
- (progn
- (or (bolp) (aset info 7 t))
- (goto-char (aref info 3))
- (or (bolp) (eolp) (aset info 7 t))))
- (if fresh
- (let ((modes (calc-embedded-find-modes)))
- (aset info 12 (car modes))
- (aset info 13 (nth 1 modes))
- (aset info 14 (nth 2 modes))))
- (aset info 15 calc-embedded-globals)
- (setq str (buffer-substring (aref info 2) (aref info 3)))
- (if (or force
- (not (equal str (aref info 6))))
- (if (and fixed (aref info 6))
- (progn
- (aset info 4 nil)
- (calc-embedded-make-info point cbuf nil)
- (setq new-info nil))
- (let* ((open-plain calc-embedded-open-plain)
- (close-plain calc-embedded-close-plain)
- (pref-len (length open-plain))
- (vars-used nil)
- suff-pos val temp)
- (save-excursion
- (set-buffer (aref info 1))
- (calc-embedded-set-modes (aref info 15)
- (aref info 12) (aref info 14))
- (if (and (> (length str) pref-len)
- (equal (substring str 0 pref-len) open-plain)
- (setq suff-pos (string-match (regexp-quote close-plain)
- str pref-len)))
- (setq val (math-read-plain-expr
- (substring str pref-len suff-pos)))
- (if (string-match "[^ \t\n]" str)
- (setq pref-len 0
- val (math-read-big-expr str))
- (setq val nil))))
- (if (eq (car-safe val) 'error)
- (setq val (list 'error
- (+ (aref info 2) pref-len (nth 1 val))
- (nth 2 val))))
- (aset info 6 str)
- (aset info 8 val)
- (setq temp val)
- (if (eq (car-safe temp) 'calcFunc-evalto)
- (setq temp (nth 1 temp))
- (if (eq (car-safe temp) 'error)
- (if new-info
- (setq new-info nil)
- (setcdr found (delq info (cdr found)))
- (calc-embedded-active-state 'less))))
- (aset info 9 (and (eq (car-safe temp) 'calcFunc-assign)
- (nth 1 temp)))
- (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
- (calc-embedded-find-vars val))
- (aset info 10 vars-used)
- (aset info 11 nil))))
- (if new-info
- (progn
- (setcdr found (cons info (cdr found)))
- (calc-embedded-active-state 'more)))
- info))
-
-(defun calc-embedded-find-vars (x)
- (cond ((Math-primp x)
- (and (eq (car-safe x) 'var)
- (not (assoc x vars-used))
- (setq vars-used (cons (list x) vars-used))))
- ((eq (car x) 'calcFunc-evalto)
- (calc-embedded-find-vars (nth 1 x)))
- ((eq (car x) 'calcFunc-assign)
- (calc-embedded-find-vars (nth 2 x)))
- (t
- (and (eq (car x) 'calcFunc-subscr)
- (eq (car-safe (nth 1 x)) 'var)
- (Math-primp (nth 2 x))
- (not (assoc x vars-used))
- (setq vars-used (cons (list x) vars-used)))
- (while (setq x (cdr x))
- (calc-embedded-find-vars (car x))))))
-
-
-(defun calc-embedded-evaluate-expr (x)
- (let ((vars-used (aref calc-embedded-info 10)))
- (or vars-used (calc-embedded-find-vars x))
- (if vars-used
- (let ((active (assq (aref calc-embedded-info 0) calc-embedded-active))
- (args nil))
- (save-excursion
- (calc-embedded-original-buffer t)
- (or active
- (progn
- (calc-embedded-activate)
- (setq active (assq (aref calc-embedded-info 0)
- calc-embedded-active))))
- (while vars-used
- (calc-embedded-eval-get-var (car (car vars-used)) active)
- (setq vars-used (cdr vars-used))))
- (calc-embedded-subst x))
- (calc-normalize (math-evaluate-expr-rec x)))))
-
-(defun calc-embedded-subst (x)
- (if (and (eq (car-safe x) 'calcFunc-evalto) (cdr x))
- (let ((rhs (calc-embedded-subst (nth 1 x))))
- (list 'calcFunc-evalto
- (nth 1 x)
- (if (eq (car-safe rhs) 'calcFunc-assign) (nth 2 rhs) rhs)))
- (if (and (eq (car-safe x) 'calcFunc-assign) (= (length x) 3))
- (list 'calcFunc-assign
- (nth 1 x)
- (calc-embedded-subst (nth 2 x)))
- (calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x))))))
-
-(defun calc-embedded-eval-get-var (var base)
- (let ((entry base)
- (point (aref calc-embedded-info 2))
- (last nil)
- val)
- (while (and (setq entry (cdr entry))
- (or (not (equal var (aref (car entry) 9)))
- (and (> point (aref (car entry) 3))
- (setq last entry)))))
- (if last
- (setq entry last))
- (if entry
- (progn
- (setq entry (car entry))
- (if (equal (buffer-substring (aref entry 2) (aref entry 3))
- (aref entry 6))
- (progn
- (or (aref entry 11)
- (save-excursion
- (calc-embedded-update entry 14 t nil)))
- (setq val (aref entry 11))
- (if (eq (car-safe val) 'calcFunc-evalto)
- (setq val (nth 2 val)))
- (if (eq (car-safe val) 'calcFunc-assign)
- (setq val (nth 2 val)))
- (setq args (cons (cons var val) args)))
- (calc-embedded-activate)
- (calc-embedded-eval-get-var var base))))))
-
-
-(defun calc-embedded-update (info which need-eval need-display
- &optional str entry old-val)
- (let* ((prev-modes nil)
- (open-plain calc-embedded-open-plain)
- (close-plain calc-embedded-close-plain)
- (vars-used nil)
- (evalled nil)
- (val (aref info 8))
- (old-eval (aref info 11)))
- (or old-val (setq old-val val))
- (if (eq (car-safe val) 'calcFunc-evalto)
- (setq need-display t))
- (unwind-protect
- (progn
- (set-buffer (aref info 1))
- (and which
- (calc-embedded-set-modes (aref info 15) (aref info 12)
- (aref info which)
- (if need-display 'full t)))
- (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
- (calc-embedded-find-vars val))
- (if need-eval
- (let ((calc-embedded-info info))
- (setq val (math-evaluate-expr val)
- evalled val)))
- (if (or (eq need-eval 'eval) (eq (car-safe val) 'calcFunc-evalto))
- (aset info 8 val))
- (aset info 9 nil)
- (aset info 10 vars-used)
- (aset info 11 nil)
- (if (or need-display (eq (car-safe val) 'calcFunc-evalto))
- (let ((extra (if (eq calc-language 'big) 1 0)))
- (or entry (setq entry (list val 1 nil)))
- (or str (progn
- (setq str (let ((calc-line-numbering nil))
- (math-format-stack-value entry)))
- (if (eq calc-language 'big)
- (setq str (substring str 0 -1)))))
- (and calc-show-plain
- (setq str (concat open-plain
- (math-showing-full-precision
- (math-format-flat-expr val 0))
- close-plain
- str)))
- (save-excursion
- (calc-embedded-original-buffer t info)
- (or (equal str (aref info 6))
- (let ((delta (- (aref info 5) (aref info 3)))
- (buffer-read-only nil))
- (goto-char (aref info 2))
- (delete-region (point) (aref info 3))
- (and (> (nth 1 entry) (1+ extra))
- (aref info 7)
- (progn
- (aset info 7 nil)
- (delete-horizontal-space)
- (insert "\n\n")
- (delete-horizontal-space)
- (backward-char 1)))
- (insert str)
- (set-marker (aref info 3) (point))
- (set-marker (aref info 5) (+ (point) delta))
- (aset info 6 str))))))
- (if (eq (car-safe val) 'calcFunc-evalto)
- (progn
- (setq evalled (nth 2 val)
- val (nth 1 val))))
- (if (eq (car-safe val) 'calcFunc-assign)
- (progn
- (aset info 9 (nth 1 val))
- (aset info 11 (or evalled
- (let ((calc-embedded-info info))
- (math-evaluate-expr (nth 2 val)))))
- (or (equal old-eval (aref info 11))
- (calc-embedded-var-change (nth 1 val) (aref info 0))))
- (if (eq (car-safe old-val) 'calcFunc-evalto)
- (setq old-val (nth 1 old-val)))
- (if (eq (car-safe old-val) 'calcFunc-assign)
- (calc-embedded-var-change (nth 1 old-val) (aref info 0)))))
- (set-buffer (aref info 1))
- (while prev-modes
- (cond ((eq (car (car prev-modes)) 'the-language)
- (if need-display
- (calc-embedded-set-language (cdr (car prev-modes)))))
- ((eq (car (car prev-modes)) 'the-display-just)
- (if need-display
- (calc-embedded-set-justify (cdr (car prev-modes)))))
- (t
- (set (car (car prev-modes)) (cdr (car prev-modes)))))
- (setq prev-modes (cdr prev-modes))))))
-
-
-
-
-;;; These are hooks called by the main part of Calc.
-
-(defvar calc-embedded-no-reselect nil)
-(defun calc-embedded-select-buffer ()
- (if (eq (current-buffer) (aref calc-embedded-info 0))
- (let ((info calc-embedded-info)
- horiz vert)
- (if (and (or (< (point) (aref info 4))
- (> (point) (aref info 5)))
- (not calc-embedded-no-reselect))
- (let ((calc-embedded-quiet t))
- (message "(Switching Calc Embedded mode to new formula.)")
- (calc-embedded nil)
- (calc-embedded nil)))
- (setq horiz (max (min (current-column) (- (point) (aref info 2))) 0)
- vert (if (<= (aref info 2) (point))
- (- (count-lines (aref info 2) (point))
- (if (bolp) 0 1))
- 0))
- (set-buffer (aref info 1))
- (if calc-show-plain
- (if (= vert 0)
- (setq horiz 0)
- (setq vert (1- vert))))
- (calc-cursor-stack-index 1)
- (if calc-line-numbering
- (setq horiz (+ horiz 4)))
- (if (> vert 0)
- (forward-line vert))
- (forward-char (min horiz
- (- (point-max) (point)))))
- (calc-select-buffer)))
-
-(defun calc-embedded-finish-command ()
- (let ((buf (current-buffer))
- horiz vert)
- (save-excursion
- (set-buffer (aref calc-embedded-info 1))
- (if (> (calc-stack-size) 0)
- (let ((pt (point))
- (col (current-column))
- (bol (bolp)))
- (calc-cursor-stack-index 0)
- (if (< pt (point))
- (progn
- (calc-cursor-stack-index 1)
- (if (>= pt (point))
- (progn
- (setq horiz (- col (if calc-line-numbering 4 0))
- vert (- (count-lines (point) pt)
- (if bol 0 1)))
- (if calc-show-plain
- (setq vert (max 1 (1+ vert))))))))
- (goto-char pt))))
- (if horiz
- (progn
- (set-buffer (aref calc-embedded-info 0))
- (goto-char (aref calc-embedded-info 2))
- (if (> vert 0)
- (forward-line vert))
- (forward-char (max horiz 0))
- (set-buffer buf)))))
-
-(defun calc-embedded-stack-change ()
- (or calc-executing-macro
- (save-excursion
- (set-buffer (aref calc-embedded-info 1))
- (let* ((info calc-embedded-info)
- (extra-line (if (eq calc-language 'big) 1 0))
- (the-point (point))
- (empty (= (calc-stack-size) 0))
- (entry (if empty
- (list '(var empty var-empty) 1 nil)
- (calc-top 1 'entry)))
- (old-val (aref info 8))
- top bot str)
- (if empty
- (setq str "empty")
- (save-excursion
- (calc-cursor-stack-index 1)
- (setq top (point))
- (calc-cursor-stack-index 0)
- (setq bot (- (point) extra-line))
- (setq str (buffer-substring top (- bot 1))))
- (if calc-line-numbering
- (let ((pos 0))
- (setq str (substring str 4))
- (while (setq pos (string-match "\n...." str pos))
- (setq str (concat (substring str 0 (1+ pos))
- (substring str (+ pos 5)))
- pos (1+ pos))))))
- (calc-embedded-original-buffer t)
- (aset info 8 (car entry))
- (calc-embedded-update info 13 nil t str entry old-val)))))
-
-(defun calc-embedded-mode-line-change ()
- (let ((str mode-line-buffer-identification))
- (save-excursion
- (calc-embedded-original-buffer t)
- (setq mode-line-buffer-identification str)
- (set-buffer-modified-p (buffer-modified-p)))))
-
-(defun calc-embedded-modes-change (vars)
- (if (eq (car vars) 'calc-language) (setq vars '(the-language)))
- (if (eq (car vars) 'calc-display-just) (setq vars '(the-display-just)))
- (while (and vars
- (not (rassq (car vars) calc-embedded-mode-vars)))
- (setq vars (cdr vars)))
- (if (and vars calc-mode-save-mode (not (eq calc-mode-save-mode 'save)))
- (save-excursion
- (let* ((save-mode calc-mode-save-mode)
- (header (if (eq save-mode 'local)
- "calc-mode:"
- (format "calc-%s-mode:" save-mode)))
- (the-language (calc-embedded-language))
- (the-display-just (calc-embedded-justify))
- (values (mapcar 'symbol-value vars))
- (num (cond ((eq save-mode 'local) 12)
- ((eq save-mode 'edit) 13)
- ((eq save-mode 'perm) 14)
- (t nil)))
- base limit mname mlist)
- (calc-embedded-original-buffer t)
- (save-excursion
- (if (eq save-mode 'global)
- (setq base (point-max)
- limit (point-min)
- mlist calc-embedded-globals)
- (goto-char (aref calc-embedded-info 4))
- (beginning-of-line)
- (setq base (point)
- limit (max (- (point) 1000) (point-min))
- mlist (and num (aref calc-embedded-info num)))
- (and (re-search-backward
- (format "\\(%s\\)[^\001]*\\(%s\\)\\|\\[calc-defaults]"
- calc-embedded-open-formula
- calc-embedded-close-formula) limit t)
- (setq limit (point))))
- (while vars
- (goto-char base)
- (if (setq mname (car (rassq (car vars)
- calc-embedded-mode-vars)))
- (let ((buffer-read-only nil)
- (found (assq (car vars) mlist)))
- (if found
- (setcdr found (car values))
- (setq mlist (cons (cons (car vars) (car values)) mlist))
- (if num
- (aset calc-embedded-info num mlist)
- (if (eq save-mode 'global)
- (setq calc-embedded-globals mlist))))
- (if (re-search-backward
- (format "\\[%s *%s: *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]"
- header mname)
- limit t)
- (progn
- (goto-char (match-beginning 1))
- (delete-region (point) (match-end 1))
- (insert (prin1-to-string (car values))))
- (goto-char base)
- (insert-before-markers
- calc-embedded-open-mode
- "[" header " " mname ": "
- (prin1-to-string (car values)) "]"
- calc-embedded-close-mode))))
- (setq vars (cdr vars)
- values (cdr values))))))))
-
-(defun calc-embedded-var-change (var &optional buf)
- (if (symbolp var)
- (setq var (list 'var
- (if (string-match "\\`var-.+\\'"
- (symbol-name var))
- (intern (substring (symbol-name var) 4))
- var)
- var)))
- (save-excursion
- (let ((manual (not calc-auto-recompute))
- (bp calc-embedded-active)
- (first t))
- (if buf (setq bp (memq (assq buf bp) bp)))
- (while bp
- (let ((calc-embedded-no-reselect t)
- (p (and (buffer-name (car (car bp)))
- (cdr (car bp)))))
- (while p
- (if (assoc var (aref (car p) 10))
- (if manual
- (if (aref (car p) 11)
- (progn
- (aset (car p) 11 nil)
- (if (aref (car p) 9)
- (calc-embedded-var-change (aref (car p) 9)))))
- (set-buffer (aref (car p) 0))
- (if (equal (buffer-substring (aref (car p) 2)
- (aref (car p) 3))
- (aref (car p) 6))
- (let ((calc-embedded-info nil))
- (or calc-embedded-quiet
- (message "Recomputing..."))
- (setq first nil)
- (calc-wrapper
- (set-buffer (aref (car p) 0))
- (calc-embedded-update (car p) 14 t nil)))
- (setcdr (car bp) (delq (car p) (cdr (car bp))))
- (message
- "(Tried to recompute but formula was changed or missing)"))))
- (setq p (cdr p))))
- (setq bp (if buf nil (cdr bp))))
- (or first calc-embedded-quiet (message "")))))
-
-;;; calc-embed.el ends here
+++ /dev/null
-;;; calc-ext.el --- various extension functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-(provide 'calc-ext)
-(require 'calc)
-
-(setq calc-extensions-loaded t)
-
-;;; This function is the autoload "hook" to cause this file to be loaded.
-;;;###autoload
-(defun calc-extensions ()
- "This function is part of the autoload linkage for parts of Calc."
- t)
-
-;;; Auto-load calc.el part, in case this part was loaded first.
-(if (fboundp 'calc-dispatch)
- (and (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
- (load (nth 1 (symbol-function 'calc-dispatch))))
- (if (fboundp 'calc)
- (and (eq (car-safe (symbol-function 'calc)) 'autoload)
- (load (nth 1 (symbol-function 'calc))))
- (error "Main part of Calc must be present in order to load this file")))
-
-(require 'calc-macs)
-
-(defvar math-simplifying nil)
-(defvar math-living-dangerously nil) ; true if unsafe simplifications are okay.
-(defvar math-integrating nil)
-
-(defvar math-rewrite-selections nil)
-
-(defvar math-compose-level 0)
-(defvar math-comp-selected nil)
-(defvar math-comp-tagged nil)
-(defvar math-comp-sel-hpos nil)
-(defvar math-comp-sel-vpos nil)
-(defvar math-comp-sel-cpos nil)
-(defvar math-compose-hash-args nil)
-
-;;; The following was made a function so that it could be byte-compiled.
-(defun calc-init-extensions ()
-
- (define-key calc-mode-map ":" 'calc-fdiv)
- (define-key calc-mode-map "\\" 'calc-idiv)
- (define-key calc-mode-map "|" 'calc-concat)
- (define-key calc-mode-map "!" 'calc-factorial)
- (define-key calc-mode-map "C" 'calc-cos)
- (define-key calc-mode-map "E" 'calc-exp)
- (define-key calc-mode-map "H" 'calc-hyperbolic)
- (define-key calc-mode-map "I" 'calc-inverse)
- (define-key calc-mode-map "J" 'calc-conj)
- (define-key calc-mode-map "L" 'calc-ln)
- (define-key calc-mode-map "N" 'calc-eval-num)
- (define-key calc-mode-map "P" 'calc-pi)
- (define-key calc-mode-map "Q" 'calc-sqrt)
- (define-key calc-mode-map "R" 'calc-round)
- (define-key calc-mode-map "S" 'calc-sin)
- (define-key calc-mode-map "T" 'calc-tan)
- (define-key calc-mode-map "U" 'calc-undo)
- (define-key calc-mode-map "X" 'calc-call-last-kbd-macro)
- (define-key calc-mode-map "o" 'calc-realign)
- (define-key calc-mode-map "p" 'calc-precision)
- (define-key calc-mode-map "w" 'calc-why)
- (define-key calc-mode-map "x" 'calc-execute-extended-command)
- (define-key calc-mode-map "y" 'calc-copy-to-buffer)
-
- (define-key calc-mode-map "(" 'calc-begin-complex)
- (define-key calc-mode-map ")" 'calc-end-complex)
- (define-key calc-mode-map "[" 'calc-begin-vector)
- (define-key calc-mode-map "]" 'calc-end-vector)
- (define-key calc-mode-map "," 'calc-comma)
- (define-key calc-mode-map ";" 'calc-semi)
- (define-key calc-mode-map "`" 'calc-edit)
- (define-key calc-mode-map "=" 'calc-evaluate)
- (define-key calc-mode-map "~" 'calc-num-prefix)
- (define-key calc-mode-map "<" 'calc-scroll-left)
- (define-key calc-mode-map ">" 'calc-scroll-right)
- (define-key calc-mode-map "{" 'calc-scroll-down)
- (define-key calc-mode-map "}" 'calc-scroll-up)
- (define-key calc-mode-map "\C-k" 'calc-kill)
- (define-key calc-mode-map "\M-k" 'calc-copy-as-kill)
- (define-key calc-mode-map "\C-w" 'calc-kill-region)
- (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill)
- (define-key calc-mode-map "\C-y" 'calc-yank)
- (define-key calc-mode-map "\C-_" 'calc-undo)
- (define-key calc-mode-map "\C-xu" 'calc-undo)
- (define-key calc-mode-map "\M-\C-m" 'calc-last-args)
-
- (define-key calc-mode-map "a" nil)
- (define-key calc-mode-map "a?" 'calc-a-prefix-help)
- (define-key calc-mode-map "aa" 'calc-apart)
- (define-key calc-mode-map "ab" 'calc-substitute)
- (define-key calc-mode-map "ac" 'calc-collect)
- (define-key calc-mode-map "ad" 'calc-derivative)
- (define-key calc-mode-map "ae" 'calc-simplify-extended)
- (define-key calc-mode-map "af" 'calc-factor)
- (define-key calc-mode-map "ag" 'calc-poly-gcd)
- (define-key calc-mode-map "ai" 'calc-integral)
- (define-key calc-mode-map "am" 'calc-match)
- (define-key calc-mode-map "an" 'calc-normalize-rat)
- (define-key calc-mode-map "ap" 'calc-poly-interp)
- (define-key calc-mode-map "ar" 'calc-rewrite)
- (define-key calc-mode-map "as" 'calc-simplify)
- (define-key calc-mode-map "at" 'calc-taylor)
- (define-key calc-mode-map "av" 'calc-alg-evaluate)
- (define-key calc-mode-map "ax" 'calc-expand)
- (define-key calc-mode-map "aA" 'calc-abs)
- (define-key calc-mode-map "aF" 'calc-curve-fit)
- (define-key calc-mode-map "aI" 'calc-num-integral)
- (define-key calc-mode-map "aM" 'calc-map-equation)
- (define-key calc-mode-map "aN" 'calc-find-minimum)
- (define-key calc-mode-map "aP" 'calc-poly-roots)
- (define-key calc-mode-map "aS" 'calc-solve-for)
- (define-key calc-mode-map "aR" 'calc-find-root)
- (define-key calc-mode-map "aT" 'calc-tabulate)
- (define-key calc-mode-map "aX" 'calc-find-maximum)
- (define-key calc-mode-map "a+" 'calc-summation)
- (define-key calc-mode-map "a-" 'calc-alt-summation)
- (define-key calc-mode-map "a*" 'calc-product)
- (define-key calc-mode-map "a\\" 'calc-poly-div)
- (define-key calc-mode-map "a%" 'calc-poly-rem)
- (define-key calc-mode-map "a/" 'calc-poly-div-rem)
- (define-key calc-mode-map "a=" 'calc-equal-to)
- (define-key calc-mode-map "a#" 'calc-not-equal-to)
- (define-key calc-mode-map "a<" 'calc-less-than)
- (define-key calc-mode-map "a>" 'calc-greater-than)
- (define-key calc-mode-map "a[" 'calc-less-equal)
- (define-key calc-mode-map "a]" 'calc-greater-equal)
- (define-key calc-mode-map "a." 'calc-remove-equal)
- (define-key calc-mode-map "a{" 'calc-in-set)
- (define-key calc-mode-map "a&" 'calc-logical-and)
- (define-key calc-mode-map "a|" 'calc-logical-or)
- (define-key calc-mode-map "a!" 'calc-logical-not)
- (define-key calc-mode-map "a:" 'calc-logical-if)
- (define-key calc-mode-map "a_" 'calc-subscript)
- (define-key calc-mode-map "a\"" 'calc-expand-formula)
-
- (define-key calc-mode-map "b" nil)
- (define-key calc-mode-map "b?" 'calc-b-prefix-help)
- (define-key calc-mode-map "ba" 'calc-and)
- (define-key calc-mode-map "bc" 'calc-clip)
- (define-key calc-mode-map "bd" 'calc-diff)
- (define-key calc-mode-map "bl" 'calc-lshift-binary)
- (define-key calc-mode-map "bn" 'calc-not)
- (define-key calc-mode-map "bo" 'calc-or)
- (define-key calc-mode-map "bp" 'calc-pack-bits)
- (define-key calc-mode-map "br" 'calc-rshift-binary)
- (define-key calc-mode-map "bt" 'calc-rotate-binary)
- (define-key calc-mode-map "bu" 'calc-unpack-bits)
- (define-key calc-mode-map "bw" 'calc-word-size)
- (define-key calc-mode-map "bx" 'calc-xor)
- (define-key calc-mode-map "bB" 'calc-log)
- (define-key calc-mode-map "bD" 'calc-fin-ddb)
- (define-key calc-mode-map "bF" 'calc-fin-fv)
- (define-key calc-mode-map "bI" 'calc-fin-irr)
- (define-key calc-mode-map "bL" 'calc-lshift-arith)
- (define-key calc-mode-map "bM" 'calc-fin-pmt)
- (define-key calc-mode-map "bN" 'calc-fin-npv)
- (define-key calc-mode-map "bP" 'calc-fin-pv)
- (define-key calc-mode-map "bR" 'calc-rshift-arith)
- (define-key calc-mode-map "bS" 'calc-fin-sln)
- (define-key calc-mode-map "bT" 'calc-fin-rate)
- (define-key calc-mode-map "bY" 'calc-fin-syd)
- (define-key calc-mode-map "b#" 'calc-fin-nper)
- (define-key calc-mode-map "b%" 'calc-percent-change)
-
- (define-key calc-mode-map "c" nil)
- (define-key calc-mode-map "c?" 'calc-c-prefix-help)
- (define-key calc-mode-map "cc" 'calc-clean)
- (define-key calc-mode-map "cd" 'calc-to-degrees)
- (define-key calc-mode-map "cf" 'calc-float)
- (define-key calc-mode-map "ch" 'calc-to-hms)
- (define-key calc-mode-map "cp" 'calc-polar)
- (define-key calc-mode-map "cr" 'calc-to-radians)
- (define-key calc-mode-map "cC" 'calc-cos)
- (define-key calc-mode-map "cF" 'calc-fraction)
- (define-key calc-mode-map "c%" 'calc-convert-percent)
-
- (define-key calc-mode-map "d" nil)
- (define-key calc-mode-map "d?" 'calc-d-prefix-help)
- (define-key calc-mode-map "d0" 'calc-decimal-radix)
- (define-key calc-mode-map "d2" 'calc-binary-radix)
- (define-key calc-mode-map "d6" 'calc-hex-radix)
- (define-key calc-mode-map "d8" 'calc-octal-radix)
- (define-key calc-mode-map "db" 'calc-line-breaking)
- (define-key calc-mode-map "dc" 'calc-complex-notation)
- (define-key calc-mode-map "dd" 'calc-date-notation)
- (define-key calc-mode-map "de" 'calc-eng-notation)
- (define-key calc-mode-map "df" 'calc-fix-notation)
- (define-key calc-mode-map "dg" 'calc-group-digits)
- (define-key calc-mode-map "dh" 'calc-hms-notation)
- (define-key calc-mode-map "di" 'calc-i-notation)
- (define-key calc-mode-map "dj" 'calc-j-notation)
- (define-key calc-mode-map "dl" 'calc-line-numbering)
- (define-key calc-mode-map "dn" 'calc-normal-notation)
- (define-key calc-mode-map "do" 'calc-over-notation)
- (define-key calc-mode-map "dp" 'calc-show-plain)
- (define-key calc-mode-map "dr" 'calc-radix)
- (define-key calc-mode-map "ds" 'calc-sci-notation)
- (define-key calc-mode-map "dt" 'calc-truncate-stack)
- (define-key calc-mode-map "dw" 'calc-auto-why)
- (define-key calc-mode-map "dz" 'calc-leading-zeros)
- (define-key calc-mode-map "dB" 'calc-big-language)
- (define-key calc-mode-map "dD" 'calc-redo)
- (define-key calc-mode-map "dC" 'calc-c-language)
- (define-key calc-mode-map "dE" 'calc-eqn-language)
- (define-key calc-mode-map "dF" 'calc-fortran-language)
- (define-key calc-mode-map "dM" 'calc-mathematica-language)
- (define-key calc-mode-map "dN" 'calc-normal-language)
- (define-key calc-mode-map "dO" 'calc-flat-language)
- (define-key calc-mode-map "dP" 'calc-pascal-language)
- (define-key calc-mode-map "dT" 'calc-tex-language)
- (define-key calc-mode-map "dU" 'calc-unformatted-language)
- (define-key calc-mode-map "dW" 'calc-maple-language)
- (define-key calc-mode-map "d[" 'calc-truncate-up)
- (define-key calc-mode-map "d]" 'calc-truncate-down)
- (define-key calc-mode-map "d." 'calc-point-char)
- (define-key calc-mode-map "d," 'calc-group-char)
- (define-key calc-mode-map "d\"" 'calc-display-strings)
- (define-key calc-mode-map "d<" 'calc-left-justify)
- (define-key calc-mode-map "d=" 'calc-center-justify)
- (define-key calc-mode-map "d>" 'calc-right-justify)
- (define-key calc-mode-map "d{" 'calc-left-label)
- (define-key calc-mode-map "d}" 'calc-right-label)
- (define-key calc-mode-map "d'" 'calc-display-raw)
- (define-key calc-mode-map "d " 'calc-refresh)
- (define-key calc-mode-map "d\r" 'calc-refresh-top)
- (define-key calc-mode-map "d@" 'calc-toggle-banner)
-
- (define-key calc-mode-map "f" nil)
- (define-key calc-mode-map "f?" 'calc-f-prefix-help)
- (define-key calc-mode-map "fb" 'calc-beta)
- (define-key calc-mode-map "fe" 'calc-erf)
- (define-key calc-mode-map "fg" 'calc-gamma)
- (define-key calc-mode-map "fh" 'calc-hypot)
- (define-key calc-mode-map "fi" 'calc-im)
- (define-key calc-mode-map "fj" 'calc-bessel-J)
- (define-key calc-mode-map "fn" 'calc-min)
- (define-key calc-mode-map "fr" 'calc-re)
- (define-key calc-mode-map "fs" 'calc-sign)
- (define-key calc-mode-map "fx" 'calc-max)
- (define-key calc-mode-map "fy" 'calc-bessel-Y)
- (define-key calc-mode-map "fA" 'calc-abssqr)
- (define-key calc-mode-map "fB" 'calc-inc-beta)
- (define-key calc-mode-map "fE" 'calc-expm1)
- (define-key calc-mode-map "fF" 'calc-floor)
- (define-key calc-mode-map "fG" 'calc-inc-gamma)
- (define-key calc-mode-map "fI" 'calc-ilog)
- (define-key calc-mode-map "fL" 'calc-lnp1)
- (define-key calc-mode-map "fM" 'calc-mant-part)
- (define-key calc-mode-map "fQ" 'calc-isqrt)
- (define-key calc-mode-map "fS" 'calc-scale-float)
- (define-key calc-mode-map "fT" 'calc-arctan2)
- (define-key calc-mode-map "fX" 'calc-xpon-part)
- (define-key calc-mode-map "f[" 'calc-decrement)
- (define-key calc-mode-map "f]" 'calc-increment)
-
- (define-key calc-mode-map "g" nil)
- (define-key calc-mode-map "g?" 'calc-g-prefix-help)
- (define-key calc-mode-map "ga" 'calc-graph-add)
- (define-key calc-mode-map "gb" 'calc-graph-border)
- (define-key calc-mode-map "gc" 'calc-graph-clear)
- (define-key calc-mode-map "gd" 'calc-graph-delete)
- (define-key calc-mode-map "gf" 'calc-graph-fast)
- (define-key calc-mode-map "gg" 'calc-graph-grid)
- (define-key calc-mode-map "gh" 'calc-graph-header)
- (define-key calc-mode-map "gk" 'calc-graph-key)
- (define-key calc-mode-map "gj" 'calc-graph-juggle)
- (define-key calc-mode-map "gl" 'calc-graph-log-x)
- (define-key calc-mode-map "gn" 'calc-graph-name)
- (define-key calc-mode-map "gp" 'calc-graph-plot)
- (define-key calc-mode-map "gq" 'calc-graph-quit)
- (define-key calc-mode-map "gr" 'calc-graph-range-x)
- (define-key calc-mode-map "gs" 'calc-graph-line-style)
- (define-key calc-mode-map "gt" 'calc-graph-title-x)
- (define-key calc-mode-map "gv" 'calc-graph-view-commands)
- (define-key calc-mode-map "gx" 'calc-graph-display)
- (define-key calc-mode-map "gz" 'calc-graph-zero-x)
- (define-key calc-mode-map "gA" 'calc-graph-add-3d)
- (define-key calc-mode-map "gC" 'calc-graph-command)
- (define-key calc-mode-map "gD" 'calc-graph-device)
- (define-key calc-mode-map "gF" 'calc-graph-fast-3d)
- (define-key calc-mode-map "gG" 'calc-argument)
- (define-key calc-mode-map "gH" 'calc-graph-hide)
- (define-key calc-mode-map "gK" 'calc-graph-kill)
- (define-key calc-mode-map "gL" 'calc-graph-log-y)
- (define-key calc-mode-map "gN" 'calc-graph-num-points)
- (define-key calc-mode-map "gO" 'calc-graph-output)
- (define-key calc-mode-map "gP" 'calc-graph-print)
- (define-key calc-mode-map "gR" 'calc-graph-range-y)
- (define-key calc-mode-map "gS" 'calc-graph-point-style)
- (define-key calc-mode-map "gT" 'calc-graph-title-y)
- (define-key calc-mode-map "gV" 'calc-graph-view-trail)
- (define-key calc-mode-map "gX" 'calc-graph-geometry)
- (define-key calc-mode-map "gZ" 'calc-graph-zero-y)
- (define-key calc-mode-map "g\C-l" 'calc-graph-log-z)
- (define-key calc-mode-map "g\C-r" 'calc-graph-range-z)
- (define-key calc-mode-map "g\C-t" 'calc-graph-title-z)
-
- (define-key calc-mode-map "h" 'calc-help-prefix)
-
- (define-key calc-mode-map "j" nil)
- (define-key calc-mode-map "j?" 'calc-j-prefix-help)
- (define-key calc-mode-map "ja" 'calc-select-additional)
- (define-key calc-mode-map "jb" 'calc-break-selections)
- (define-key calc-mode-map "jc" 'calc-clear-selections)
- (define-key calc-mode-map "jd" 'calc-show-selections)
- (define-key calc-mode-map "je" 'calc-enable-selections)
- (define-key calc-mode-map "jl" 'calc-select-less)
- (define-key calc-mode-map "jm" 'calc-select-more)
- (define-key calc-mode-map "jn" 'calc-select-next)
- (define-key calc-mode-map "jo" 'calc-select-once)
- (define-key calc-mode-map "jp" 'calc-select-previous)
- (define-key calc-mode-map "jr" 'calc-rewrite-selection)
- (define-key calc-mode-map "js" 'calc-select-here)
- (define-key calc-mode-map "jv" 'calc-sel-evaluate)
- (define-key calc-mode-map "ju" 'calc-unselect)
- (define-key calc-mode-map "jC" 'calc-sel-commute)
- (define-key calc-mode-map "jD" 'calc-sel-distribute)
- (define-key calc-mode-map "jE" 'calc-sel-jump-equals)
- (define-key calc-mode-map "jI" 'calc-sel-isolate)
- (define-key calc-mode-map "jJ" 'calc-conj)
- (define-key calc-mode-map "jL" 'calc-commute-left)
- (define-key calc-mode-map "jM" 'calc-sel-merge)
- (define-key calc-mode-map "jN" 'calc-sel-negate)
- (define-key calc-mode-map "jO" 'calc-select-once-maybe)
- (define-key calc-mode-map "jR" 'calc-commute-right)
- (define-key calc-mode-map "jS" 'calc-select-here-maybe)
- (define-key calc-mode-map "jU" 'calc-sel-unpack)
- (define-key calc-mode-map "j&" 'calc-sel-invert)
- (define-key calc-mode-map "j\r" 'calc-copy-selection)
- (define-key calc-mode-map "j\n" 'calc-copy-selection)
- (define-key calc-mode-map "j\010" 'calc-del-selection)
- (define-key calc-mode-map "j\177" 'calc-del-selection)
- (define-key calc-mode-map "j'" 'calc-enter-selection)
- (define-key calc-mode-map "j`" 'calc-edit-selection)
- (define-key calc-mode-map "j+" 'calc-sel-add-both-sides)
- (define-key calc-mode-map "j-" 'calc-sel-sub-both-sides)
- (define-key calc-mode-map "j*" 'calc-sel-mult-both-sides)
- (define-key calc-mode-map "j/" 'calc-sel-div-both-sides)
- (define-key calc-mode-map "j\"" 'calc-sel-expand-formula)
-
- (define-key calc-mode-map "k" nil)
- (define-key calc-mode-map "k?" 'calc-k-prefix-help)
- (define-key calc-mode-map "ka" 'calc-random-again)
- (define-key calc-mode-map "kb" 'calc-bernoulli-number)
- (define-key calc-mode-map "kc" 'calc-choose)
- (define-key calc-mode-map "kd" 'calc-double-factorial)
- (define-key calc-mode-map "ke" 'calc-euler-number)
- (define-key calc-mode-map "kf" 'calc-prime-factors)
- (define-key calc-mode-map "kg" 'calc-gcd)
- (define-key calc-mode-map "kh" 'calc-shuffle)
- (define-key calc-mode-map "kl" 'calc-lcm)
- (define-key calc-mode-map "km" 'calc-moebius)
- (define-key calc-mode-map "kn" 'calc-next-prime)
- (define-key calc-mode-map "kp" 'calc-prime-test)
- (define-key calc-mode-map "kr" 'calc-random)
- (define-key calc-mode-map "ks" 'calc-stirling-number)
- (define-key calc-mode-map "kt" 'calc-totient)
- (define-key calc-mode-map "kB" 'calc-utpb)
- (define-key calc-mode-map "kC" 'calc-utpc)
- (define-key calc-mode-map "kE" 'calc-extended-gcd)
- (define-key calc-mode-map "kF" 'calc-utpf)
- (define-key calc-mode-map "kK" 'calc-keep-args)
- (define-key calc-mode-map "kN" 'calc-utpn)
- (define-key calc-mode-map "kP" 'calc-utpp)
- (define-key calc-mode-map "kT" 'calc-utpt)
-
- (define-key calc-mode-map "m" nil)
- (define-key calc-mode-map "m?" 'calc-m-prefix-help)
- (define-key calc-mode-map "ma" 'calc-algebraic-mode)
- (define-key calc-mode-map "md" 'calc-degrees-mode)
- (define-key calc-mode-map "mf" 'calc-frac-mode)
- (define-key calc-mode-map "mg" 'calc-get-modes)
- (define-key calc-mode-map "mh" 'calc-hms-mode)
- (define-key calc-mode-map "mi" 'calc-infinite-mode)
- (define-key calc-mode-map "mm" 'calc-save-modes)
- (define-key calc-mode-map "mp" 'calc-polar-mode)
- (define-key calc-mode-map "mr" 'calc-radians-mode)
- (define-key calc-mode-map "ms" 'calc-symbolic-mode)
- (define-key calc-mode-map "mt" 'calc-total-algebraic-mode)
- (define-key calc-mode-map "\emt" 'calc-total-algebraic-mode)
- (define-key calc-mode-map "\em\et" 'calc-total-algebraic-mode)
- (define-key calc-mode-map "mv" 'calc-matrix-mode)
- (define-key calc-mode-map "mw" 'calc-working)
- (define-key calc-mode-map "mx" 'calc-always-load-extensions)
- (define-key calc-mode-map "mA" 'calc-alg-simplify-mode)
- (define-key calc-mode-map "mB" 'calc-bin-simplify-mode)
- (define-key calc-mode-map "mC" 'calc-auto-recompute)
- (define-key calc-mode-map "mD" 'calc-default-simplify-mode)
- (define-key calc-mode-map "mE" 'calc-ext-simplify-mode)
- (define-key calc-mode-map "mF" 'calc-settings-file-name)
- (define-key calc-mode-map "mM" 'calc-more-recursion-depth)
- (define-key calc-mode-map "mN" 'calc-num-simplify-mode)
- (define-key calc-mode-map "mO" 'calc-no-simplify-mode)
- (define-key calc-mode-map "mR" 'calc-mode-record-mode)
- (define-key calc-mode-map "mS" 'calc-shift-prefix)
- (define-key calc-mode-map "mU" 'calc-units-simplify-mode)
- (define-key calc-mode-map "mX" 'calc-load-everything)
-
- (define-key calc-mode-map "r" nil)
- (define-key calc-mode-map "r?" 'calc-r-prefix-help)
-
- (define-key calc-mode-map "s" nil)
- (define-key calc-mode-map "s?" 'calc-s-prefix-help)
- (define-key calc-mode-map "sc" 'calc-copy-variable)
- (define-key calc-mode-map "sd" 'calc-declare-variable)
- (define-key calc-mode-map "se" 'calc-edit-variable)
- (define-key calc-mode-map "si" 'calc-insert-variables)
- (define-key calc-mode-map "sl" 'calc-let)
- (define-key calc-mode-map "sm" 'calc-store-map)
- (define-key calc-mode-map "sn" 'calc-store-neg)
- (define-key calc-mode-map "sp" 'calc-permanent-variable)
- (define-key calc-mode-map "sr" 'calc-recall)
- (define-key calc-mode-map "ss" 'calc-store)
- (define-key calc-mode-map "st" 'calc-store-into)
- (define-key calc-mode-map "su" 'calc-unstore)
- (define-key calc-mode-map "sx" 'calc-store-exchange)
- (define-key calc-mode-map "sA" 'calc-edit-AlgSimpRules)
- (define-key calc-mode-map "sD" 'calc-edit-Decls)
- (define-key calc-mode-map "sE" 'calc-edit-EvalRules)
- (define-key calc-mode-map "sF" 'calc-edit-FitRules)
- (define-key calc-mode-map "sG" 'calc-edit-GenCount)
- (define-key calc-mode-map "sH" 'calc-edit-Holidays)
- (define-key calc-mode-map "sI" 'calc-edit-IntegLimit)
- (define-key calc-mode-map "sL" 'calc-edit-LineStyles)
- (define-key calc-mode-map "sP" 'calc-edit-PointStyles)
- (define-key calc-mode-map "sR" 'calc-edit-PlotRejects)
- (define-key calc-mode-map "sS" 'calc-sin)
- (define-key calc-mode-map "sT" 'calc-edit-TimeZone)
- (define-key calc-mode-map "sU" 'calc-edit-Units)
- (define-key calc-mode-map "sX" 'calc-edit-ExtSimpRules)
- (define-key calc-mode-map "s+" 'calc-store-plus)
- (define-key calc-mode-map "s-" 'calc-store-minus)
- (define-key calc-mode-map "s*" 'calc-store-times)
- (define-key calc-mode-map "s/" 'calc-store-div)
- (define-key calc-mode-map "s^" 'calc-store-power)
- (define-key calc-mode-map "s|" 'calc-store-concat)
- (define-key calc-mode-map "s&" 'calc-store-inv)
- (define-key calc-mode-map "s[" 'calc-store-decr)
- (define-key calc-mode-map "s]" 'calc-store-incr)
- (define-key calc-mode-map "s:" 'calc-assign)
- (define-key calc-mode-map "s=" 'calc-evalto)
-
- (define-key calc-mode-map "t" nil)
- (define-key calc-mode-map "t?" 'calc-t-prefix-help)
- (define-key calc-mode-map "tb" 'calc-trail-backward)
- (define-key calc-mode-map "td" 'calc-trail-display)
- (define-key calc-mode-map "tf" 'calc-trail-forward)
- (define-key calc-mode-map "th" 'calc-trail-here)
- (define-key calc-mode-map "ti" 'calc-trail-in)
- (define-key calc-mode-map "tk" 'calc-trail-kill)
- (define-key calc-mode-map "tm" 'calc-trail-marker)
- (define-key calc-mode-map "tn" 'calc-trail-next)
- (define-key calc-mode-map "to" 'calc-trail-out)
- (define-key calc-mode-map "tp" 'calc-trail-previous)
- (define-key calc-mode-map "tr" 'calc-trail-isearch-backward)
- (define-key calc-mode-map "ts" 'calc-trail-isearch-forward)
- (define-key calc-mode-map "ty" 'calc-trail-yank)
- (define-key calc-mode-map "t[" 'calc-trail-first)
- (define-key calc-mode-map "t]" 'calc-trail-last)
- (define-key calc-mode-map "t<" 'calc-trail-scroll-left)
- (define-key calc-mode-map "t>" 'calc-trail-scroll-right)
- (define-key calc-mode-map "t{" 'calc-trail-backward)
- (define-key calc-mode-map "t}" 'calc-trail-forward)
- (define-key calc-mode-map "t." 'calc-full-trail-vectors)
- (define-key calc-mode-map "tC" 'calc-convert-time-zones)
- (define-key calc-mode-map "tD" 'calc-date)
- (define-key calc-mode-map "tI" 'calc-inc-month)
- (define-key calc-mode-map "tJ" 'calc-julian)
- (define-key calc-mode-map "tM" 'calc-new-month)
- (define-key calc-mode-map "tN" 'calc-now)
- (define-key calc-mode-map "tP" 'calc-date-part)
- (define-key calc-mode-map "tT" 'calc-tan)
- (define-key calc-mode-map "tU" 'calc-unix-time)
- (define-key calc-mode-map "tW" 'calc-new-week)
- (define-key calc-mode-map "tY" 'calc-new-year)
- (define-key calc-mode-map "tZ" 'calc-time-zone)
- (define-key calc-mode-map "t+" 'calc-business-days-plus)
- (define-key calc-mode-map "t-" 'calc-business-days-minus)
-
- (define-key calc-mode-map "u" 'nil)
- (define-key calc-mode-map "u?" 'calc-u-prefix-help)
- (define-key calc-mode-map "ua" 'calc-autorange-units)
- (define-key calc-mode-map "ub" 'calc-base-units)
- (define-key calc-mode-map "uc" 'calc-convert-units)
- (define-key calc-mode-map "ud" 'calc-define-unit)
- (define-key calc-mode-map "ue" 'calc-explain-units)
- (define-key calc-mode-map "ug" 'calc-get-unit-definition)
- (define-key calc-mode-map "up" 'calc-permanent-units)
- (define-key calc-mode-map "ur" 'calc-remove-units)
- (define-key calc-mode-map "us" 'calc-simplify-units)
- (define-key calc-mode-map "ut" 'calc-convert-temperature)
- (define-key calc-mode-map "uu" 'calc-undefine-unit)
- (define-key calc-mode-map "uv" 'calc-enter-units-table)
- (define-key calc-mode-map "ux" 'calc-extract-units)
- (define-key calc-mode-map "uV" 'calc-view-units-table)
- (define-key calc-mode-map "uC" 'calc-vector-covariance)
- (define-key calc-mode-map "uG" 'calc-vector-geometric-mean)
- (define-key calc-mode-map "uM" 'calc-vector-mean)
- (define-key calc-mode-map "uN" 'calc-vector-min)
- (define-key calc-mode-map "uS" 'calc-vector-sdev)
- (define-key calc-mode-map "uU" 'calc-undo)
- (define-key calc-mode-map "uX" 'calc-vector-max)
- (define-key calc-mode-map "u#" 'calc-vector-count)
- (define-key calc-mode-map "u+" 'calc-vector-sum)
- (define-key calc-mode-map "u*" 'calc-vector-product)
-
- (define-key calc-mode-map "v" 'nil)
- (define-key calc-mode-map "v?" 'calc-v-prefix-help)
- (define-key calc-mode-map "va" 'calc-arrange-vector)
- (define-key calc-mode-map "vb" 'calc-build-vector)
- (define-key calc-mode-map "vc" 'calc-mcol)
- (define-key calc-mode-map "vd" 'calc-diag)
- (define-key calc-mode-map "ve" 'calc-expand-vector)
- (define-key calc-mode-map "vf" 'calc-vector-find)
- (define-key calc-mode-map "vh" 'calc-head)
- (define-key calc-mode-map "vi" 'calc-ident)
- (define-key calc-mode-map "vk" 'calc-cons)
- (define-key calc-mode-map "vl" 'calc-vlength)
- (define-key calc-mode-map "vm" 'calc-mask-vector)
- (define-key calc-mode-map "vn" 'calc-rnorm)
- (define-key calc-mode-map "vp" 'calc-pack)
- (define-key calc-mode-map "vr" 'calc-mrow)
- (define-key calc-mode-map "vs" 'calc-subvector)
- (define-key calc-mode-map "vt" 'calc-transpose)
- (define-key calc-mode-map "vu" 'calc-unpack)
- (define-key calc-mode-map "vv" 'calc-reverse-vector)
- (define-key calc-mode-map "vx" 'calc-index)
- (define-key calc-mode-map "vA" 'calc-apply)
- (define-key calc-mode-map "vC" 'calc-cross)
- (define-key calc-mode-map "vD" 'calc-mdet)
- (define-key calc-mode-map "vE" 'calc-set-enumerate)
- (define-key calc-mode-map "vF" 'calc-set-floor)
- (define-key calc-mode-map "vG" 'calc-grade)
- (define-key calc-mode-map "vH" 'calc-histogram)
- (define-key calc-mode-map "vI" 'calc-inner-product)
- (define-key calc-mode-map "vJ" 'calc-conj-transpose)
- (define-key calc-mode-map "vL" 'calc-mlud)
- (define-key calc-mode-map "vM" 'calc-map)
- (define-key calc-mode-map "vN" 'calc-cnorm)
- (define-key calc-mode-map "vO" 'calc-outer-product)
- (define-key calc-mode-map "vR" 'calc-reduce)
- (define-key calc-mode-map "vS" 'calc-sort)
- (define-key calc-mode-map "vT" 'calc-mtrace)
- (define-key calc-mode-map "vU" 'calc-accumulate)
- (define-key calc-mode-map "vV" 'calc-set-union)
- (define-key calc-mode-map "vX" 'calc-set-xor)
- (define-key calc-mode-map "v^" 'calc-set-intersect)
- (define-key calc-mode-map "v-" 'calc-set-difference)
- (define-key calc-mode-map "v~" 'calc-set-complement)
- (define-key calc-mode-map "v:" 'calc-set-span)
- (define-key calc-mode-map "v#" 'calc-set-cardinality)
- (define-key calc-mode-map "v+" 'calc-remove-duplicates)
- (define-key calc-mode-map "v&" 'calc-inv)
- (define-key calc-mode-map "v<" 'calc-matrix-left-justify)
- (define-key calc-mode-map "v=" 'calc-matrix-center-justify)
- (define-key calc-mode-map "v>" 'calc-matrix-right-justify)
- (define-key calc-mode-map "v." 'calc-full-vectors)
- (define-key calc-mode-map "v/" 'calc-break-vectors)
- (define-key calc-mode-map "v," 'calc-vector-commas)
- (define-key calc-mode-map "v[" 'calc-vector-brackets)
- (define-key calc-mode-map "v]" 'calc-matrix-brackets)
- (define-key calc-mode-map "v{" 'calc-vector-braces)
- (define-key calc-mode-map "v}" 'calc-matrix-brackets)
- (define-key calc-mode-map "v(" 'calc-vector-parens)
- (define-key calc-mode-map "v)" 'calc-matrix-brackets)
- (define-key calc-mode-map "V" (lookup-key calc-mode-map "v"))
-
- (define-key calc-mode-map "z" 'nil)
- (define-key calc-mode-map "z?" 'calc-z-prefix-help)
-
- (define-key calc-mode-map "Z" 'nil)
- (define-key calc-mode-map "Z?" 'calc-shift-Z-prefix-help)
- (define-key calc-mode-map "ZC" 'calc-user-define-composition)
- (define-key calc-mode-map "ZD" 'calc-user-define)
- (define-key calc-mode-map "ZE" 'calc-user-define-edit)
- (define-key calc-mode-map "ZF" 'calc-user-define-formula)
- (define-key calc-mode-map "ZG" 'calc-get-user-defn)
- (define-key calc-mode-map "ZI" 'calc-user-define-invocation)
- (define-key calc-mode-map "ZK" 'calc-user-define-kbd-macro)
- (define-key calc-mode-map "ZP" 'calc-user-define-permanent)
- (define-key calc-mode-map "ZS" 'calc-edit-user-syntax)
- (define-key calc-mode-map "ZT" 'calc-timing)
- (define-key calc-mode-map "ZU" 'calc-user-undefine)
- (define-key calc-mode-map "Z[" 'calc-kbd-if)
- (define-key calc-mode-map "Z:" 'calc-kbd-else)
- (define-key calc-mode-map "Z|" 'calc-kbd-else-if)
- (define-key calc-mode-map "Z]" 'calc-kbd-end-if)
- (define-key calc-mode-map "Z<" 'calc-kbd-repeat)
- (define-key calc-mode-map "Z>" 'calc-kbd-end-repeat)
- (define-key calc-mode-map "Z(" 'calc-kbd-for)
- (define-key calc-mode-map "Z)" 'calc-kbd-end-for)
- (define-key calc-mode-map "Z{" 'calc-kbd-loop)
- (define-key calc-mode-map "Z}" 'calc-kbd-end-loop)
- (define-key calc-mode-map "Z/" 'calc-kbd-break)
- (define-key calc-mode-map "Z`" 'calc-kbd-push)
- (define-key calc-mode-map "Z'" 'calc-kbd-pop)
- (define-key calc-mode-map "Z=" 'calc-kbd-report)
- (define-key calc-mode-map "Z#" 'calc-kbd-query)
-
- (calc-init-prefixes)
-
- (mapcar (function
- (lambda (x)
- (define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
- (define-key calc-mode-map (format "j%c" x) 'calc-select-part)
- (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick)
- (define-key calc-mode-map (format "s%c" x) 'calc-store-quick)
- (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick)
- (define-key calc-mode-map (format "u%c" x) 'calc-quick-units)))
- "0123456789")
-
- (or calc-emacs-type-19 (progn
- (let ((i ?A))
- (while (and (<= i ?z) (vectorp calc-mode-map))
- (if (eq (car-safe (aref calc-mode-map i)) 'keymap)
- (aset calc-mode-map i
- (cons 'keymap (cons (cons ?\e (aref calc-mode-map i))
- (cdr (aref calc-mode-map i))))))
- (setq i (1+ i))))
-
- (setq calc-alg-map (copy-sequence calc-mode-map)
- calc-alg-esc-map (copy-sequence esc-map))
- (let ((i 32))
- (while (< i 127)
- (or (memq i '(?' ?` ?= ??))
- (aset calc-alg-map i 'calc-auto-algebraic-entry))
- (or (memq i '(?# ?x ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (aset calc-alg-esc-map i (aref calc-mode-map i)))
- (setq i (1+ i))))
- (define-key calc-alg-map "\e" calc-alg-esc-map)
- (define-key calc-alg-map "\e\t" 'calc-roll-up)
- (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub)
- (define-key calc-alg-map "\e\177" 'calc-pop-above)
- ))
-
- ;; The following is a relic for backward compatability only.
- ;; The calc-define property list is now the recommended method.
- (if (and (boundp 'calc-ext-defs)
- calc-ext-defs)
- (progn
- (calc-need-macros)
- (message "Evaluating calc-ext-defs...")
- (eval (cons 'progn calc-ext-defs))
- (setq calc-ext-defs nil)))
-
-;;;; (Autoloads here)
- (mapcar (function (lambda (x)
- (mapcar (function (lambda (func)
- (autoload func (car x)))) (cdr x))))
- '(
-
- ("calc-alg" calc-Need-calc-alg calc-has-rules
-calc-modify-simplify-mode calcFunc-collect calcFunc-esimplify
-calcFunc-islin calcFunc-islinnt calcFunc-lin calcFunc-linnt
-calcFunc-simplify calcFunc-subst math-beforep
-math-build-polynomial-expr math-expand-formula math-expr-contains
-math-expr-contains-count math-expr-depends math-expr-height
-math-expr-subst math-expr-weight math-integer-plus math-is-linear
-math-is-multiple math-is-polynomial math-linear-in math-multiple-of
-math-need-std-simps math-poly-depends math-poly-mix math-poly-mul
-math-poly-simplify math-poly-zerop math-polynomial-base
-math-polynomial-p math-recompile-eval-rules math-simplify
-math-simplify-exp math-simplify-extended math-simplify-sqrt
-math-to-simple-fraction)
-
- ("calcalg2" calc-Need-calc-alg-2 calcFunc-asum calcFunc-deriv
-calcFunc-ffinv calcFunc-finv calcFunc-fsolve calcFunc-gpoly
-calcFunc-integ calcFunc-poly calcFunc-prod calcFunc-roots
-calcFunc-solve calcFunc-sum calcFunc-table calcFunc-taylor
-calcFunc-tderiv math-expr-calls math-integral-q02 math-integral-q12
-math-integral-rational-funcs math-lcm-denoms math-looks-evenp
-math-poly-all-roots math-prod-rec math-reject-solution math-solve-eqn
-math-solve-for math-sum-rec math-try-integral)
-
- ("calcalg3" calc-Need-calc-alg-3 calcFunc-efit calcFunc-fit
-calcFunc-fitdummy calcFunc-fitparam calcFunc-fitvar
-calcFunc-hasfitparams calcFunc-hasfitvars calcFunc-maximize
-calcFunc-minimize calcFunc-ninteg calcFunc-polint calcFunc-ratint
-calcFunc-root calcFunc-wmaximize calcFunc-wminimize calcFunc-wroot
-calcFunc-xfit math-find-minimum math-find-root math-ninteg-evaluate
-math-ninteg-midpoint math-ninteg-romberg math-poly-interp)
-
- ("calc-arith" calc-Need-calc-arith calcFunc-abs calcFunc-abssqr
-calcFunc-add calcFunc-ceil calcFunc-decr calcFunc-deven calcFunc-dimag
-calcFunc-dint calcFunc-div calcFunc-dnatnum calcFunc-dneg
-calcFunc-dnonneg calcFunc-dnonzero calcFunc-dnumint calcFunc-dodd
-calcFunc-dpos calcFunc-drange calcFunc-drat calcFunc-dreal
-calcFunc-dscalar calcFunc-fceil calcFunc-ffloor calcFunc-float
-calcFunc-fround calcFunc-frounde calcFunc-froundu calcFunc-ftrunc
-calcFunc-idiv calcFunc-incr calcFunc-mant calcFunc-max calcFunc-min
-calcFunc-mod calcFunc-mul calcFunc-neg calcFunc-percent calcFunc-pow
-calcFunc-relch calcFunc-round calcFunc-rounde calcFunc-roundu
-calcFunc-scf calcFunc-sub calcFunc-xpon math-abs math-abs-approx
-math-add-objects-fancy math-add-or-sub math-add-symb-fancy
-math-ceiling math-combine-prod math-combine-sum math-div-by-zero
-math-div-objects-fancy math-div-symb-fancy math-div-zero
-math-float-fancy math-floor-fancy math-floor-special math-guess-if-neg
-math-intv-constp math-known-evenp math-known-imagp math-known-integerp
-math-known-matrixp math-known-negp math-known-nonnegp
-math-known-nonposp math-known-nonzerop math-known-num-integerp
-math-known-oddp math-known-posp math-known-realp math-known-scalarp
-math-max math-min math-mod-fancy math-mul-float math-mul-objects-fancy
-math-mul-or-div math-mul-symb-fancy math-mul-zero math-neg-fancy
-math-neg-float math-okay-neg math-possible-signs math-possible-types
-math-pow-fancy math-pow-mod math-pow-of-zero math-pow-zero
-math-quarter-integer math-round math-setup-declarations math-sqr
-math-sqr-float math-trunc-fancy math-trunc-special)
-
- ("calc-bin" calc-Need-calc-bin calcFunc-and calcFunc-ash
-calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or
-calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip
-math-compute-max-digits math-convert-radix-digits math-float-parts
-math-format-bignum-binary math-format-bignum-hex
-math-format-bignum-octal math-format-bignum-radix math-format-binary
-math-format-radix math-format-radix-float math-integer-log2
-math-power-of-2 math-radix-float-power)
-
- ("calc-comb" calc-Need-calc-comb calc-report-prime-test
-calcFunc-choose calcFunc-dfact calcFunc-egcd calcFunc-fact
-calcFunc-gcd calcFunc-lcm calcFunc-moebius calcFunc-nextprime
-calcFunc-perm calcFunc-prevprime calcFunc-prfac calcFunc-prime
-calcFunc-random calcFunc-shuffle calcFunc-stir1 calcFunc-stir2
-calcFunc-totient math-init-random-base math-member math-prime-test
-math-random-base)
-
- ("calccomp" calc-Need-calc-comp calcFunc-cascent calcFunc-cdescent
-calcFunc-cheight calcFunc-cwidth math-comp-ascent math-comp-descent
-math-comp-height math-comp-width math-compose-expr
-math-composition-to-string math-stack-value-offset-fancy
-math-vector-is-string math-vector-to-string)
-
- ("calc-cplx" calc-Need-calc-cplx calcFunc-arg calcFunc-conj
-calcFunc-im calcFunc-polar calcFunc-re calcFunc-rect math-complex
-math-fix-circular math-imaginary math-imaginary-i math-normalize-polar
-math-polar math-want-polar)
-
- ("calc-embed" calc-Need-calc-embed calc-do-embedded
-calc-do-embedded-activate calc-embedded-evaluate-expr
-calc-embedded-modes-change calc-embedded-var-change)
-
- ("calc-fin" calc-Need-calc-fin calc-to-percentage calcFunc-ddb
-calcFunc-fv calcFunc-fvb calcFunc-fvl calcFunc-irr calcFunc-irrb
-calcFunc-nper calcFunc-nperb calcFunc-nperl calcFunc-npv calcFunc-npvb
-calcFunc-pmt calcFunc-pmtb calcFunc-pv calcFunc-pvb calcFunc-pvl
-calcFunc-rate calcFunc-rateb calcFunc-ratel calcFunc-sln calcFunc-syd)
-
- ("calc-forms" calc-Need-calc-forms calcFunc-badd calcFunc-bsub
-calcFunc-date calcFunc-day calcFunc-dsadj calcFunc-hms
-calcFunc-holiday calcFunc-hour calcFunc-incmonth calcFunc-incyear
-calcFunc-intv calcFunc-julian calcFunc-makemod calcFunc-minute
-calcFunc-month calcFunc-newmonth calcFunc-newweek calcFunc-newyear
-calcFunc-now calcFunc-pwday calcFunc-sdev calcFunc-second
-calcFunc-time calcFunc-tzconv calcFunc-tzone calcFunc-unixtime
-calcFunc-weekday calcFunc-year calcFunc-yearday math-combine-intervals
-math-date-parts math-date-to-dt math-div-mod math-dt-to-date
-math-format-date math-from-business-day math-from-hms math-make-intv
-math-make-mod math-make-sdev math-mod-intv math-normalize-hms
-math-normalize-mod math-parse-date math-read-angle-brackets
-math-setup-add-holidays math-setup-holidays math-setup-year-holidays
-math-sort-intv math-to-business-day math-to-hms)
-
- ("calc-frac" calc-Need-calc-frac calc-add-fractions
-calc-div-fractions calc-mul-fractions calcFunc-fdiv calcFunc-frac
-math-make-frac)
-
- ("calc-funcs" calc-Need-calc-funcs calc-prob-dist calcFunc-bern
-calcFunc-besJ calcFunc-besY calcFunc-beta calcFunc-betaB
-calcFunc-betaI calcFunc-erf calcFunc-erfc calcFunc-euler
-calcFunc-gamma calcFunc-gammaG calcFunc-gammaP calcFunc-gammaQ
-calcFunc-gammag calcFunc-ltpb calcFunc-ltpc calcFunc-ltpf
-calcFunc-ltpn calcFunc-ltpp calcFunc-ltpt calcFunc-utpb calcFunc-utpc
-calcFunc-utpf calcFunc-utpn calcFunc-utpp calcFunc-utpt
-math-bernoulli-number math-gammap1-raw)
-
- ("calc-graph" calc-Need-calc-graph calc-graph-show-tty)
-
- ("calc-help" calc-Need-calc-help)
-
- ("calc-incom" calc-Need-calc-incom calc-digit-dots)
-
- ("calc-keypd" calc-Need-calc-keypd calc-do-keypad
-calc-keypad-x-left-click calc-keypad-x-middle-click
-calc-keypad-x-right-click)
-
- ("calc-lang" calc-Need-calc-lang calc-set-language
-math-read-big-balance math-read-big-rec)
-
- ("calc-map" calc-Need-calc-map calc-get-operator calcFunc-accum
-calcFunc-afixp calcFunc-anest calcFunc-apply calcFunc-call
-calcFunc-fixp calcFunc-inner calcFunc-map calcFunc-mapa calcFunc-mapc
-calcFunc-mapd calcFunc-mapeq calcFunc-mapeqp calcFunc-mapeqr
-calcFunc-mapr calcFunc-nest calcFunc-outer calcFunc-raccum
-calcFunc-reduce calcFunc-reducea calcFunc-reducec calcFunc-reduced
-calcFunc-reducer calcFunc-rreduce calcFunc-rreducea calcFunc-rreducec
-calcFunc-rreduced calcFunc-rreducer math-build-call
-math-calcFunc-to-var math-multi-subst math-multi-subst-rec
-math-var-to-calcFunc)
-
- ("calc-mtx" calc-Need-calc-mat calcFunc-det calcFunc-lud calcFunc-tr
-math-col-matrix math-lud-solve math-matrix-inv-raw math-matrix-lud
-math-mul-mat-vec math-mul-mats math-row-matrix)
-
- ("calc-math" calc-Need-calc-math calcFunc-alog calcFunc-arccos
-calcFunc-arccosh calcFunc-arcsin calcFunc-arcsincos calcFunc-arcsinh
-calcFunc-arctan calcFunc-arctan2 calcFunc-arctanh calcFunc-cos
-calcFunc-cosh calcFunc-deg calcFunc-exp calcFunc-exp10 calcFunc-expm1
-calcFunc-hypot calcFunc-ilog calcFunc-isqrt calcFunc-ln calcFunc-lnp1
-calcFunc-log calcFunc-log10 calcFunc-nroot calcFunc-rad calcFunc-sin
-calcFunc-sincos calcFunc-sinh calcFunc-sqr calcFunc-sqrt calcFunc-tan
-calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw
-math-arctan2-raw math-cos-raw math-exp-minus-1-raw math-exp-raw
-math-from-radians math-from-radians-2 math-hypot math-infinite-dir
-math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float
-math-nearly-zerop math-nearly-zerop-float math-nth-root
-math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw
-math-tan-raw math-to-radians math-to-radians-2)
-
- ("calc-mode" calc-Need-calc-mode math-get-modes-vec)
-
- ("calc-poly" calc-Need-calc-poly calcFunc-apart calcFunc-expand
-calcFunc-expandpow calcFunc-factor calcFunc-factors calcFunc-nrat
-calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide
-calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim
-calcFunc-prem math-accum-factors math-atomic-factorp
-math-div-poly-const math-div-thru math-expand-power math-expand-term
-math-factor-contains math-factor-expr math-factor-expr-part
-math-factor-expr-try math-factor-finish math-factor-poly-coefs
-math-factor-protect math-mul-thru math-padded-polynomial
-math-partial-fractions math-poly-degree math-poly-deriv-coefs
-math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p
-math-to-ratpoly math-to-ratpoly-rec)
-
- ("calc-prog" calc-Need-calc-prog calc-default-formula-arglist
-calc-execute-kbd-macro calc-finish-user-syntax-edit
-calc-fix-token-name calc-fix-user-formula calc-read-parse-table
-calc-read-parse-table-part calc-subsetp calc-write-parse-table
-calc-write-parse-table-part calcFunc-constant calcFunc-eq calcFunc-geq
-calcFunc-gt calcFunc-if calcFunc-in calcFunc-integer calcFunc-istrue
-calcFunc-land calcFunc-leq calcFunc-lnot calcFunc-lor calcFunc-lt
-calcFunc-negative calcFunc-neq calcFunc-nonvar calcFunc-real
-calcFunc-refers calcFunc-rmeq calcFunc-typeof calcFunc-variable
-math-body-refers-to math-break math-composite-inequalities
-math-do-defmath math-handle-for math-handle-foreach
-math-normalize-logical-op math-return)
-
- ("calc-rewr" calc-Need-calc-rewr calcFunc-match calcFunc-matches
-calcFunc-matchnot calcFunc-rewrite calcFunc-vmatches
-math-apply-rewrites math-compile-patterns math-compile-rewrites
-math-flatten-lands math-match-patterns math-rewrite
-math-rewrite-heads)
-
- ("calc-rules" calc-CommuteRules calc-DistribRules calc-FactorRules
-calc-FitRules calc-IntegAfterRules calc-InvertRules calc-JumpRules
-calc-MergeRules calc-Need-calc-rules calc-NegateRules
-calc-compile-rule-set)
-
- ("calc-sel" calc-Need-calc-sel calc-auto-selection
-calc-delete-selection calc-encase-atoms calc-find-assoc-parent-formula
-calc-find-parent-formula calc-find-sub-formula calc-prepare-selection
-calc-preserve-point calc-replace-selections calc-replace-sub-formula
-calc-roll-down-with-selections calc-roll-up-with-selections
-calc-sel-error)
-
- ("calcsel2" calc-Need-calc-sel-2)
-
- ("calc-stat" calc-Need-calc-stat calc-vector-op calcFunc-agmean
-calcFunc-vcorr calcFunc-vcount calcFunc-vcov calcFunc-vflat
-calcFunc-vgmean calcFunc-vhmean calcFunc-vmax calcFunc-vmean
-calcFunc-vmeane calcFunc-vmedian calcFunc-vmin calcFunc-vpcov
-calcFunc-vprod calcFunc-vpsdev calcFunc-vpvar calcFunc-vsdev
-calcFunc-vsum calcFunc-vvar math-flatten-many-vecs)
-
- ("calc-store" calc-Need-calc-store calc-read-var-name
-calc-store-value calc-var-name)
-
- ("calc-stuff" calc-Need-calc-stuff calc-explain-why calcFunc-clean
-calcFunc-pclean calcFunc-pfloat calcFunc-pfrac)
-
- ("calc-trail" calc-Need-calc-trail)
-
- ("calc-undo" calc-Need-calc-undo)
-
- ("calc-units" calc-Need-calc-units calcFunc-usimplify
-math-build-units-table math-build-units-table-buffer
-math-check-unit-name math-convert-temperature math-convert-units
-math-extract-units math-remove-units math-simplify-units
-math-single-units-in-expr-p math-to-standard-units
-math-units-in-expr-p)
-
- ("calc-vec" calc-Need-calc-vec calcFunc-append calcFunc-appendrev
-calcFunc-arrange calcFunc-cnorm calcFunc-cons calcFunc-cross
-calcFunc-ctrn calcFunc-cvec calcFunc-diag calcFunc-find
-calcFunc-getdiag calcFunc-grade calcFunc-head calcFunc-histogram
-calcFunc-idn calcFunc-index calcFunc-mcol calcFunc-mdims
-calcFunc-mrcol calcFunc-mrow calcFunc-mrrow calcFunc-pack
-calcFunc-rcons calcFunc-rdup calcFunc-rev calcFunc-rgrade
-calcFunc-rhead calcFunc-rnorm calcFunc-rsort calcFunc-rsubvec
-calcFunc-rtail calcFunc-sort calcFunc-subscr calcFunc-subvec
-calcFunc-tail calcFunc-trn calcFunc-unpack calcFunc-unpackt
-calcFunc-vcard calcFunc-vcompl calcFunc-vconcat calcFunc-vconcatrev
-calcFunc-vdiff calcFunc-vec calcFunc-venum calcFunc-vexp
-calcFunc-vfloor calcFunc-vint calcFunc-vlen calcFunc-vmask
-calcFunc-vpack calcFunc-vspan calcFunc-vunion calcFunc-vunpack
-calcFunc-vxor math-check-for-commas math-clean-set math-copy-matrix
-math-dimension-error math-dot-product math-flatten-vector math-map-vec
-math-map-vec-2 math-mat-col math-mimic-ident math-prepare-set
-math-read-brackets math-reduce-cols math-reduce-vec math-transpose)
-
- ("calc-yank" calc-Need-calc-yank calc-alg-edit calc-clean-newlines
-calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit
-calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer)
-
-))
-
- (mapcar (function (lambda (x)
- (mapcar (function (lambda (cmd)
- (autoload cmd (car x) nil t))) (cdr x))))
- '(
-
- ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
-calc-expand-formula calc-factor calc-normalize-rat calc-poly-div
-calc-poly-div-rem calc-poly-gcd calc-poly-rem calc-simplify
-calc-simplify-extended calc-substitute)
-
- ("calcalg2" calc-alt-summation calc-derivative
-calc-dump-integral-cache calc-integral calc-num-integral
-calc-poly-roots calc-product calc-solve-for calc-summation
-calc-tabulate calc-taylor)
-
- ("calcalg3" calc-curve-fit calc-find-maximum calc-find-minimum
-calc-find-root calc-poly-interp)
-
- ("calc-arith" calc-abs calc-abssqr calc-ceiling calc-decrement
-calc-floor calc-idiv calc-increment calc-mant-part calc-max calc-min
-calc-round calc-scale-float calc-sign calc-trunc calc-xpon-part)
-
- ("calc-bin" calc-and calc-binary-radix calc-clip calc-decimal-radix
-calc-diff calc-hex-radix calc-leading-zeros calc-lshift-arith
-calc-lshift-binary calc-not calc-octal-radix calc-or calc-radix
-calc-rotate-binary calc-rshift-arith calc-rshift-binary calc-word-size
-calc-xor)
-
- ("calc-comb" calc-choose calc-double-factorial calc-extended-gcd
-calc-factorial calc-gamma calc-gcd calc-lcm calc-moebius
-calc-next-prime calc-perm calc-prev-prime calc-prime-factors
-calc-prime-test calc-random calc-random-again calc-rrandom
-calc-shuffle calc-totient)
-
- ("calc-cplx" calc-argument calc-complex-notation calc-i-notation
-calc-im calc-j-notation calc-polar calc-polar-mode calc-re)
-
- ("calc-embed" calc-embedded-copy-formula-as-kill
-calc-embedded-duplicate calc-embedded-edit calc-embedded-forget
-calc-embedded-kill-formula calc-embedded-mark-formula
-calc-embedded-new-formula calc-embedded-next calc-embedded-previous
-calc-embedded-select calc-embedded-update-formula calc-embedded-word
-calc-find-globals calc-show-plain)
-
- ("calc-fin" calc-convert-percent calc-fin-ddb calc-fin-fv
-calc-fin-irr calc-fin-nper calc-fin-npv calc-fin-pmt calc-fin-pv
-calc-fin-rate calc-fin-sln calc-fin-syd calc-percent-change)
-
- ("calc-forms" calc-business-days-minus calc-business-days-plus
-calc-convert-time-zones calc-date calc-date-notation calc-date-part
-calc-from-hms calc-hms-mode calc-hms-notation calc-inc-month
-calc-julian calc-new-month calc-new-week calc-new-year calc-now
-calc-time calc-time-zone calc-to-hms calc-unix-time)
-
- ("calc-frac" calc-fdiv calc-frac-mode calc-fraction
-calc-over-notation calc-slash-notation)
-
- ("calc-funcs" calc-bernoulli-number calc-bessel-J calc-bessel-Y
-calc-beta calc-erf calc-erfc calc-euler-number calc-inc-beta
-calc-inc-gamma calc-stirling-number calc-utpb calc-utpc calc-utpf
-calc-utpn calc-utpp calc-utpt)
-
- ("calc-graph" calc-graph-add calc-graph-add-3d calc-graph-border
-calc-graph-clear calc-graph-command calc-graph-delete
-calc-graph-device calc-graph-display calc-graph-fast
-calc-graph-fast-3d calc-graph-geometry calc-graph-grid
-calc-graph-header calc-graph-hide calc-graph-juggle calc-graph-key
-calc-graph-kill calc-graph-line-style calc-graph-log-x
-calc-graph-log-y calc-graph-log-z calc-graph-name
-calc-graph-num-points calc-graph-output calc-graph-plot
-calc-graph-point-style calc-graph-print calc-graph-quit
-calc-graph-range-x calc-graph-range-y calc-graph-range-z
-calc-graph-show-dumb calc-graph-title-x calc-graph-title-y
-calc-graph-title-z calc-graph-view-commands calc-graph-view-trail
-calc-graph-zero-x calc-graph-zero-y)
-
- ("calc-help" calc-a-prefix-help calc-b-prefix-help calc-c-prefix-help
-calc-d-prefix-help calc-describe-function calc-describe-key
-calc-describe-key-briefly calc-describe-variable calc-f-prefix-help
-calc-full-help calc-g-prefix-help calc-help-prefix
-calc-hyperbolic-prefix-help calc-inv-hyp-prefix-help
-calc-inverse-prefix-help calc-j-prefix-help calc-k-prefix-help
-calc-m-prefix-help calc-r-prefix-help calc-s-prefix-help
-calc-t-prefix-help calc-u-prefix-help calc-v-prefix-help)
-
- ("calc-incom" calc-begin-complex calc-begin-vector calc-comma
-calc-dots calc-end-complex calc-end-vector calc-semi)
-
- ("calc-keypd" calc-keypad-menu calc-keypad-menu-back
-calc-keypad-press)
-
- ("calc-lang" calc-big-language calc-c-language calc-eqn-language
-calc-flat-language calc-fortran-language calc-maple-language
-calc-mathematica-language calc-normal-language calc-pascal-language
-calc-tex-language calc-unformatted-language)
-
- ("calc-map" calc-accumulate calc-apply calc-inner-product calc-map
-calc-map-equation calc-map-stack calc-outer-product calc-reduce)
-
- ("calc-mtx" calc-mdet calc-mlud calc-mtrace)
-
- ("calc-math" calc-arccos calc-arccosh calc-arcsin calc-arcsinh
-calc-arctan calc-arctan2 calc-arctanh calc-conj calc-cos calc-cosh
-calc-degrees-mode calc-exp calc-expm1 calc-hypot calc-ilog
-calc-imaginary calc-isqrt calc-ln calc-lnp1 calc-log calc-log10
-calc-pi calc-radians-mode calc-sin calc-sincos calc-sinh calc-sqrt
-calc-tan calc-tanh calc-to-degrees calc-to-radians)
-
- ("calc-mode" calc-alg-simplify-mode calc-algebraic-mode
-calc-always-load-extensions calc-auto-recompute calc-auto-why
-calc-bin-simplify-mode calc-break-vectors calc-center-justify
-calc-default-simplify-mode calc-display-raw calc-eng-notation
-calc-ext-simplify-mode calc-fix-notation calc-full-trail-vectors
-calc-full-vectors calc-get-modes calc-group-char calc-group-digits
-calc-infinite-mode calc-left-justify calc-left-label
-calc-line-breaking calc-line-numbering calc-matrix-brackets
-calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode
-calc-matrix-right-justify calc-mode-record-mode calc-no-simplify-mode
-calc-normal-notation calc-num-simplify-mode calc-point-char
-calc-right-justify calc-right-label calc-save-modes calc-sci-notation
-calc-settings-file-name calc-shift-prefix calc-symbolic-mode
-calc-total-algebraic-mode calc-truncate-down calc-truncate-stack
-calc-truncate-up calc-units-simplify-mode calc-vector-braces
-calc-vector-brackets calc-vector-commas calc-vector-parens
-calc-working)
-
- ("calc-prog" calc-call-last-kbd-macro calc-edit-user-syntax
-calc-equal-to calc-get-user-defn calc-greater-equal calc-greater-than
-calc-in-set calc-kbd-break calc-kbd-else calc-kbd-else-if
-calc-kbd-end-for calc-kbd-end-if calc-kbd-end-loop calc-kbd-end-repeat
-calc-kbd-for calc-kbd-if calc-kbd-loop calc-kbd-pop calc-kbd-push
-calc-kbd-query calc-kbd-repeat calc-kbd-report calc-less-equal
-calc-less-than calc-logical-and calc-logical-if calc-logical-not
-calc-logical-or calc-not-equal-to calc-pass-errors calc-remove-equal
-calc-timing calc-user-define calc-user-define-composition
-calc-user-define-edit calc-user-define-formula
-calc-user-define-invocation calc-user-define-kbd-macro
-calc-user-define-permanent calc-user-undefine)
-
- ("calc-rewr" calc-match calc-rewrite calc-rewrite-selection)
-
- ("calc-sel" calc-break-selections calc-clear-selections
-calc-copy-selection calc-del-selection calc-edit-selection
-calc-enable-selections calc-enter-selection calc-sel-add-both-sides
-calc-sel-div-both-sides calc-sel-evaluate calc-sel-expand-formula
-calc-sel-mult-both-sides calc-sel-sub-both-sides
-calc-select-additional calc-select-here calc-select-here-maybe
-calc-select-less calc-select-more calc-select-next calc-select-once
-calc-select-once-maybe calc-select-part calc-select-previous
-calc-show-selections calc-unselect)
-
- ("calcsel2" calc-commute-left calc-commute-right calc-sel-commute
-calc-sel-distribute calc-sel-invert calc-sel-isolate
-calc-sel-jump-equals calc-sel-merge calc-sel-negate calc-sel-unpack)
-
- ("calc-stat" calc-vector-correlation calc-vector-count
-calc-vector-covariance calc-vector-geometric-mean
-calc-vector-harmonic-mean calc-vector-max calc-vector-mean
-calc-vector-mean-error calc-vector-median calc-vector-min
-calc-vector-pop-covariance calc-vector-pop-sdev
-calc-vector-pop-variance calc-vector-product calc-vector-sdev
-calc-vector-sum calc-vector-variance)
-
- ("calc-store" calc-assign calc-copy-variable calc-declare-variable
-calc-edit-AlgSimpRules calc-edit-Decls calc-edit-EvalRules
-calc-edit-ExtSimpRules calc-edit-FitRules calc-edit-GenCount
-calc-edit-Holidays calc-edit-IntegLimit calc-edit-LineStyles
-calc-edit-PlotRejects calc-edit-PointStyles calc-edit-TimeZone
-calc-edit-Units calc-edit-variable calc-evalto calc-insert-variables
-calc-let calc-permanent-variable calc-recall calc-recall-quick
-calc-store calc-store-concat calc-store-decr calc-store-div
-calc-store-exchange calc-store-incr calc-store-into
-calc-store-into-quick calc-store-inv calc-store-map calc-store-minus
-calc-store-neg calc-store-plus calc-store-power calc-store-quick
-calc-store-times calc-subscript calc-unstore)
-
- ("calc-stuff" calc-clean calc-clean-num calc-flush-caches
-calc-less-recursion-depth calc-more-recursion-depth calc-num-prefix
-calc-version calc-why)
-
- ("calc-trail" calc-trail-backward calc-trail-first calc-trail-forward
-calc-trail-in calc-trail-isearch-backward calc-trail-isearch-forward
-calc-trail-kill calc-trail-last calc-trail-marker calc-trail-next
-calc-trail-out calc-trail-previous calc-trail-scroll-left
-calc-trail-scroll-right calc-trail-yank)
-
- ("calc-undo" calc-last-args calc-redo calc-undo)
-
- ("calc-units" calc-autorange-units calc-base-units
-calc-convert-temperature calc-convert-units calc-define-unit
-calc-enter-units-table calc-explain-units calc-extract-units
-calc-get-unit-definition calc-permanent-units calc-quick-units
-calc-remove-units calc-simplify-units calc-undefine-unit
-calc-view-units-table)
-
- ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm
-calc-conj-transpose calc-cons calc-cross calc-diag
-calc-display-strings calc-expand-vector calc-grade calc-head
-calc-histogram calc-ident calc-index calc-mask-vector calc-mcol
-calc-mrow calc-pack calc-pack-bits calc-remove-duplicates
-calc-reverse-vector calc-rnorm calc-set-cardinality
-calc-set-complement calc-set-difference calc-set-enumerate
-calc-set-floor calc-set-intersect calc-set-span calc-set-union
-calc-set-xor calc-sort calc-subvector calc-tail calc-transpose
-calc-unpack calc-unpack-bits calc-vector-find calc-vlength)
-
- ("calc-yank" calc-copy-as-kill calc-copy-region-as-kill
-calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode
-calc-kill calc-kill-region calc-yank))))
-
-(defun calc-init-prefixes ()
- (if calc-shift-prefix
- (progn
- (define-key calc-mode-map "A" (lookup-key calc-mode-map "a"))
- (define-key calc-mode-map "B" (lookup-key calc-mode-map "b"))
- (define-key calc-mode-map "C" (lookup-key calc-mode-map "c"))
- (define-key calc-mode-map "D" (lookup-key calc-mode-map "d"))
- (define-key calc-mode-map "F" (lookup-key calc-mode-map "f"))
- (define-key calc-mode-map "G" (lookup-key calc-mode-map "g"))
- (define-key calc-mode-map "J" (lookup-key calc-mode-map "j"))
- (define-key calc-mode-map "K" (lookup-key calc-mode-map "k"))
- (define-key calc-mode-map "M" (lookup-key calc-mode-map "m"))
- (define-key calc-mode-map "S" (lookup-key calc-mode-map "s"))
- (define-key calc-mode-map "T" (lookup-key calc-mode-map "t"))
- (define-key calc-mode-map "U" (lookup-key calc-mode-map "u")))
- (define-key calc-mode-map "A" 'calc-abs)
- (define-key calc-mode-map "B" 'calc-log)
- (define-key calc-mode-map "C" 'calc-cos)
- (define-key calc-mode-map "D" 'calc-redo)
- (define-key calc-mode-map "F" 'calc-floor)
- (define-key calc-mode-map "G" 'calc-argument)
- (define-key calc-mode-map "J" 'calc-conj)
- (define-key calc-mode-map "K" 'calc-keep-args)
- (define-key calc-mode-map "M" 'calc-more-recursion-depth)
- (define-key calc-mode-map "S" 'calc-sin)
- (define-key calc-mode-map "T" 'calc-tan)
- (define-key calc-mode-map "U" 'calc-undo)))
-
-(calc-init-extensions)
-
-
-
-
-;;;; Miscellaneous.
-
-(defun calc-clear-command-flag (f)
- (setq calc-command-flags (delq f calc-command-flags)))
-
-
-(defun calc-record-message (tag &rest args)
- (let ((msg (apply 'format args)))
- (message "%s" msg)
- (calc-record msg tag))
- (calc-clear-command-flag 'clear-message))
-
-
-(defun calc-normalize-fancy (val)
- (let ((simp (if (consp calc-simplify-mode)
- (car calc-simplify-mode)
- calc-simplify-mode)))
- (cond ((eq simp 'binary)
- (let ((s (math-normalize val)))
- (if (math-realp s)
- (math-clip (math-round s))
- s)))
- ((eq simp 'alg)
- (math-simplify val))
- ((eq simp 'ext)
- (math-simplify-extended val))
- ((eq simp 'units)
- (math-simplify-units val))
- (t ; nil, none, num
- (math-normalize val)))))
-
-
-
-(if (boundp 'calc-help-map)
- nil
- (setq calc-help-map (make-keymap))
- (define-key calc-help-map "b" 'calc-describe-bindings)
- (define-key calc-help-map "c" 'calc-describe-key-briefly)
- (define-key calc-help-map "f" 'calc-describe-function)
- (define-key calc-help-map "h" 'calc-full-help)
- (define-key calc-help-map "i" 'calc-info)
- (define-key calc-help-map "k" 'calc-describe-key)
- (define-key calc-help-map "n" 'calc-view-news)
- (define-key calc-help-map "s" 'calc-info-summary)
- (define-key calc-help-map "t" 'calc-tutorial)
- (define-key calc-help-map "v" 'calc-describe-variable)
- (define-key calc-help-map "\C-c" 'calc-describe-copying)
- (define-key calc-help-map "\C-d" 'calc-describe-distribution)
- (define-key calc-help-map "\C-n" 'calc-view-news)
- (define-key calc-help-map "\C-w" 'calc-describe-no-warranty)
- (define-key calc-help-map "?" 'calc-help-for-help)
- (define-key calc-help-map "\C-h" 'calc-help-for-help))
-
-(defvar calc-prefix-help-phase 0)
-(defun calc-do-prefix-help (msgs group key)
- (if calc-full-help-flag
- (list msgs group key)
- (if (cdr msgs)
- (progn
- (setq calc-prefix-help-phase
- (if (eq this-command last-command)
- (% (1+ calc-prefix-help-phase) (1+ (length msgs)))
- 0))
- (let ((msg (nth calc-prefix-help-phase msgs)))
- (message "%s" (if msg
- (concat group ": " msg ":"
- (make-string
- (- (apply 'max (mapcar 'length msgs))
- (length msg)) 32)
- " [MORE]"
- (if key
- (concat " " (char-to-string key)
- "-")
- ""))
- (if key (format "%c-" key) "")))))
- (setq calc-prefix-help-phase 0)
- (if key
- (if msgs
- (message "%s: %s: %c-" group (car msgs) key)
- (message "%s: (none) %c-" group (car msgs) key))
- (message "%s: %s" group (car msgs))))
- (and key (calc-unread-command key))))
-
-;;;; Commands.
-
-
-;;; General.
-
-(defun calc-reset (arg)
- (interactive "P")
- (save-excursion
- (or (eq major-mode 'calc-mode)
- (calc-create-buffer))
- (if calc-embedded-info
- (calc-embedded nil))
- (or arg
- (setq calc-stack nil))
- (setq calc-undo-list nil
- calc-redo-list nil)
- (let (calc-stack calc-user-parse-tables calc-standard-date-formats
- calc-invocation-macro)
- (mapcar (function (lambda (v) (set v nil))) calc-local-var-list)
- (mapcar (function (lambda (v) (set (car v) (nth 1 v))))
- calc-mode-var-list))
- (calc-set-language nil nil t)
- (calc-mode)
- (calc-flush-caches t)
- (run-hooks 'calc-reset-hook))
- (calc-wrapper
- (let ((win (get-buffer-window (current-buffer))))
- (calc-realign 0)
- (if win
- (let ((height (- (window-height win) 2)))
- (set-window-point win (point))
- (or (= height calc-window-height)
- (let ((swin (selected-window)))
- (select-window win)
- (enlarge-window (- calc-window-height height))
- (select-window swin)))))))
- (message "(Calculator reset)"))
-
-;; What a pain; scroll-left behaves differently when called non-interactively.
-(defun calc-scroll-left (n)
- (interactive "P")
- (setq prefix-arg (or n (/ (window-width) 2)))
- (call-interactively #'scroll-left))
-
-(defun calc-scroll-right (n)
- (interactive "P")
- (setq prefix-arg (or n (/ (window-width) 2)))
- (call-interactively #'scroll-right))
-
-(defun calc-scroll-up (n)
- (interactive "P")
- (condition-case err
- (scroll-up (or n (/ (window-height) 2)))
- (error nil))
- (if (pos-visible-in-window-p (max 1 (- (point-max) 2)))
- (if (eq major-mode 'calc-mode)
- (calc-realign)
- (goto-char (point-max))
- (set-window-start (selected-window)
- (save-excursion
- (forward-line (- (1- (window-height))))
- (point)))
- (forward-line -1))))
-
-(defun calc-scroll-down (n)
- (interactive "P")
- (or (pos-visible-in-window-p 1)
- (scroll-down (or n (/ (window-height) 2)))))
-
-
-(defun calc-precision (n)
- (interactive "NPrecision: ")
- (calc-wrapper
- (if (< (prefix-numeric-value n) 3)
- (error "Precision must be at least 3 digits")
- (calc-change-mode 'calc-internal-prec (prefix-numeric-value n)
- (and (memq (car calc-float-format) '(float sci eng))
- (< (nth 1 calc-float-format)
- (if (= calc-number-radix 10) 0 1))))
- (calc-record calc-internal-prec "prec"))
- (message "Floating-point precision is %d digits" calc-internal-prec)))
-
-
-(defun calc-inverse (&optional n)
- (interactive "P")
- (calc-fancy-prefix 'calc-inverse-flag "Inverse..." n))
-
-(defconst calc-fancy-prefix-map
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'calc-fancy-prefix-other-key)
- (define-key map (vector meta-prefix-char t) 'calc-fancy-prefix-other-key)
- (define-key map [switch-frame] nil)
- (define-key map [?\C-u] 'universal-argument)
- (define-key map [?0] 'digit-argument)
- (define-key map [?1] 'digit-argument)
- (define-key map [?2] 'digit-argument)
- (define-key map [?3] 'digit-argument)
- (define-key map [?4] 'digit-argument)
- (define-key map [?5] 'digit-argument)
- (define-key map [?6] 'digit-argument)
- (define-key map [?7] 'digit-argument)
- (define-key map [?8] 'digit-argument)
- (define-key map [?9] 'digit-argument)
- map)
- "Keymap used while processing calc-fancy-prefix.")
-
-(defvar calc-is-keypad-press nil)
-(defun calc-fancy-prefix (flag msg n)
- (let (prefix)
- (calc-wrapper
- (calc-set-command-flag 'keep-flags)
- (calc-set-command-flag 'no-align)
- (setq prefix (set flag (not (symbol-value flag)))
- prefix-arg n)
- (message (if prefix msg "")))
- (and prefix
- (not calc-is-keypad-press)
- (if (boundp 'overriding-terminal-local-map)
- (setq overriding-terminal-local-map calc-fancy-prefix-map)
- (let ((event (calc-read-key t)))
- (if (eq (setq last-command-char (car event)) ?\C-u)
- (universal-argument)
- (if (or (not (integerp last-command-char))
- (and (>= last-command-char 0) (< last-command-char ? )
- (not (memq last-command-char '(?\e)))))
- (calc-wrapper)) ; clear flags if not a Calc command.
- (if calc-emacs-type-19
- (setq last-command-event (cdr event)))
- (if (or (not (integerp last-command-char))
- (eq last-command-char ?-))
- (calc-unread-command)
- (digit-argument n))))))))
-
-(defun calc-fancy-prefix-other-key (arg)
- (interactive "P")
- (if (or (not (integerp last-command-char))
- (and (>= last-command-char 0) (< last-command-char ? )
- (not (eq last-command-char meta-prefix-char))))
- (calc-wrapper)) ; clear flags if not a Calc command.
- (calc-unread-command)
- (setq overriding-terminal-local-map nil))
-
-(defun calc-invert-func ()
- (save-excursion
- (calc-select-buffer)
- (setq calc-inverse-flag (not (calc-is-inverse))
- calc-hyperbolic-flag (calc-is-hyperbolic)
- current-prefix-arg nil)))
-
-(defun calc-is-inverse ()
- calc-inverse-flag)
-
-(defun calc-hyperbolic (&optional n)
- (interactive "P")
- (calc-fancy-prefix 'calc-hyperbolic-flag "Hyperbolic..." n))
-
-(defun calc-hyperbolic-func ()
- (save-excursion
- (calc-select-buffer)
- (setq calc-inverse-flag (calc-is-inverse)
- calc-hyperbolic-flag (not (calc-is-hyperbolic))
- current-prefix-arg nil)))
-
-(defun calc-is-hyperbolic ()
- calc-hyperbolic-flag)
-
-(defun calc-keep-args (&optional n)
- (interactive "P")
- (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n))
-
-
-(defun calc-change-mode (var value &optional refresh option)
- (if option
- (setq value (if value
- (> (prefix-numeric-value value) 0)
- (not (symbol-value var)))))
- (or (consp var) (setq var (list var) value (list value)))
- (if calc-inverse-flag
- (let ((old nil))
- (or refresh (error "Not a display-mode command"))
- (calc-check-stack 1)
- (unwind-protect
- (let ((v var))
- (while v
- (setq old (cons (symbol-value (car v)) old))
- (set (car v) (car value))
- (setq v (cdr v)
- value (cdr value)))
- (calc-refresh-top 1)
- (calc-refresh-evaltos)
- (symbol-value (car var)))
- (let ((v var))
- (setq old (nreverse old))
- (while v
- (set (car v) (car old))
- (setq v (cdr v)
- old (cdr old)))
- (if (eq (car var) 'calc-language)
- (calc-set-language calc-language calc-language-option t)))))
- (let ((chg nil)
- (v var))
- (while v
- (or (equal (symbol-value (car v)) (car value))
- (progn
- (set (car v) (car value))
- (if (eq (car v) 'calc-float-format)
- (setq calc-full-float-format
- (list (if (eq (car (car value)) 'fix)
- 'float
- (car (car value)))
- 0)))
- (setq chg t)))
- (setq v (cdr v)
- value (cdr value)))
- (if chg
- (progn
- (or (and refresh (calc-do-refresh))
- (calc-refresh-evaltos))
- (and (eq calc-mode-save-mode 'save)
- (not (equal var '(calc-mode-save-mode)))
- (calc-save-modes))))
- (if calc-embedded-info (calc-embedded-modes-change var))
- (symbol-value (car var)))))
-
-(defun calc-toggle-banner ()
- "Toggle display of the friendly greeting calc normally shows above the stack."
- (interactive)
- (setq calc-show-banner (not calc-show-banner))
- (calc-refresh))
-
-(defun calc-refresh-top (n)
- (interactive "p")
- (calc-wrapper
- (cond ((< n 0)
- (setq n (- n))
- (let ((entry (calc-top n 'entry))
- (calc-undo-list nil) (calc-redo-list nil))
- (calc-pop-stack 1 n t)
- (calc-push-list (list (car entry)) n (list (nth 2 entry)))))
- ((= n 0)
- (calc-refresh))
- (t
- (let ((entries (calc-top-list n 1 'entry))
- (calc-undo-list nil) (calc-redo-list nil))
- (calc-pop-stack n 1 t)
- (calc-push-list (mapcar 'car entries)
- 1
- (mapcar (function (lambda (x) (nth 2 x)))
- entries)))))))
-
-(defvar calc-refreshing-evaltos nil)
-(defvar calc-no-refresh-evaltos nil)
-(defun calc-refresh-evaltos (&optional which-var)
- (and calc-any-evaltos calc-auto-recompute (not calc-no-refresh-evaltos)
- (let ((calc-refreshing-evaltos t)
- (num (calc-stack-size))
- (calc-undo-list nil) (calc-redo-list nil)
- value new-val)
- (while (> num 0)
- (setq value (calc-top num 'entry))
- (if (and (not (nth 2 value))
- (setq value (car value))
- (or (eq (car-safe value) 'calcFunc-evalto)
- (and (eq (car-safe value) 'vec)
- (eq (car-safe (nth 1 value)) 'calcFunc-evalto))))
- (progn
- (setq new-val (math-normalize value))
- (or (equal new-val value)
- (progn
- (calc-push-list (list new-val) num)
- (calc-pop-stack 1 (1+ num) t)))))
- (setq num (1- num)))))
- (and calc-embedded-active which-var
- (calc-embedded-var-change which-var)))
-
-(defun calc-push (&rest vals)
- (calc-push-list vals))
-
-(defun calc-pop-push (n &rest vals)
- (calc-pop-push-list n vals))
-
-(defun calc-pop-push-record (n prefix &rest vals)
- (calc-pop-push-record-list n prefix vals))
-
-
-(defun calc-evaluate (n)
- (interactive "p")
- (calc-slow-wrapper
- (if (= n 0)
- (setq n (calc-stack-size)))
- (calc-with-default-simplification
- (if (< n 0)
- (calc-pop-push-record-list 1 "eval"
- (math-evaluate-expr (calc-top (- n)))
- (- n))
- (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr
- (calc-top-list n)))))
- (calc-handle-whys)))
-
-
-(defun calc-eval-num (n)
- (interactive "P")
- (calc-slow-wrapper
- (let* ((nn (prefix-numeric-value n))
- (calc-internal-prec (cond ((>= nn 3) nn)
- ((< nn 0) (max (+ calc-internal-prec nn)
- 3))
- (t calc-internal-prec)))
- (calc-symbolic-mode nil))
- (calc-with-default-simplification
- (calc-pop-push-record 1 "num" (math-evaluate-expr (calc-top 1)))))
- (calc-handle-whys)))
-
-
-(defun calc-execute-extended-command (n)
- (interactive "P")
- (let* ((prompt (concat (calc-num-prefix-name n) "M-x "))
- (cmd (intern (completing-read prompt obarray 'commandp t "calc-"))))
- (setq prefix-arg n)
- (command-execute cmd)))
-
-
-(defun calc-realign (&optional num)
- (interactive "P")
- (if (and num (eq major-mode 'calc-mode))
- (progn
- (calc-check-stack num)
- (calc-cursor-stack-index num)
- (and calc-line-numbering
- (forward-char 4)))
- (if (and calc-embedded-info
- (eq (current-buffer) (aref calc-embedded-info 0)))
- (progn
- (goto-char (aref calc-embedded-info 2))
- (if (save-excursion (set-buffer (aref calc-embedded-info 1))
- calc-show-plain)
- (forward-line 1)))
- (calc-wrapper
- (if (get-buffer-window (current-buffer))
- (set-window-hscroll (get-buffer-window (current-buffer)) 0))))))
-
-(defvar math-cache-list nil)
-
-(defun calc-var-value (v)
- (and (symbolp v)
- (boundp v)
- (symbol-value v)
- (if (symbolp (symbol-value v))
- (set v (funcall (symbol-value v)))
- (if (stringp (symbol-value v))
- (let ((val (math-read-expr (symbol-value v))))
- (if (eq (car-safe val) 'error)
- (error "Bad format in variable contents: %s" (nth 2 val))
- (set v val)))
- (symbol-value v)))))
-
-;;; In the following table, ( OP LOPS ROPS ) means that if an OP
-;;; term appears as the first argument to any LOPS term, or as the
-;;; second argument to any ROPS term, then they should be treated
-;;; as one large term for purposes of associative selection.
-(defconst calc-assoc-ops '( ( + ( + - ) ( + ) )
- ( - ( + - ) ( + ) )
- ( * ( * ) ( * ) )
- ( / ( / ) ( ) )
- ( | ( | ) ( | ) )
- ( calcFunc-land ( calcFunc-land )
- ( calcFunc-land ) )
- ( calcFunc-lor ( calcFunc-lor )
- ( calcFunc-lor ) ) ))
-
-
-(defvar var-CommuteRules 'calc-CommuteRules)
-(defvar var-JumpRules 'calc-JumpRules)
-(defvar var-DistribRules 'calc-DistribRules)
-(defvar var-MergeRules 'calc-MergeRules)
-(defvar var-NegateRules 'calc-NegateRules)
-(defvar var-InvertRules 'calc-InvertRules)
-
-
-(defconst calc-tweak-eqn-table '( ( calcFunc-eq calcFunc-eq calcFunc-neq )
- ( calcFunc-neq calcFunc-neq calcFunc-eq )
- ( calcFunc-lt calcFunc-gt calcFunc-geq )
- ( calcFunc-gt calcFunc-lt calcFunc-leq )
- ( calcFunc-leq calcFunc-geq calcFunc-gt )
- ( calcFunc-geq calcFunc-leq calcFunc-lt ) ))
-
-
-
-
-(defun calc-float (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "flt"
- (if (calc-is-hyperbolic) 'calcFunc-float 'calcFunc-pfloat)
- arg)))
-
-
-(defvar calc-gnuplot-process nil)
-
-
-(defun calc-gnuplot-alive ()
- (and calc-gnuplot-process
- calc-gnuplot-buffer
- (buffer-name calc-gnuplot-buffer)
- calc-gnuplot-input
- (buffer-name calc-gnuplot-input)
- (memq (process-status calc-gnuplot-process) '(run stop))))
-
-
-
-
-
-(defun calc-load-everything ()
- (interactive)
- (calc-need-macros) ; calc-macs.el
- (calc-record-list nil) ; calc-misc.el
- (math-read-exprs "0") ; calc-aent.el
-
-;;;; (Loads here)
- (calc-Need-calc-alg-2)
- (calc-Need-calc-alg-3)
- (calc-Need-calc-alg)
- (calc-Need-calc-arith)
- (calc-Need-calc-bin)
- (calc-Need-calc-comb)
- (calc-Need-calc-comp)
- (calc-Need-calc-cplx)
- (calc-Need-calc-embed)
- (calc-Need-calc-fin)
- (calc-Need-calc-forms)
- (calc-Need-calc-frac)
- (calc-Need-calc-funcs)
- (calc-Need-calc-graph)
- (calc-Need-calc-help)
- (calc-Need-calc-incom)
- (calc-Need-calc-keypd)
- (calc-Need-calc-lang)
- (calc-Need-calc-map)
- (calc-Need-calc-mat)
- (calc-Need-calc-math)
- (calc-Need-calc-mode)
- (calc-Need-calc-poly)
- (calc-Need-calc-prog)
- (calc-Need-calc-rewr)
- (calc-Need-calc-rules)
- (calc-Need-calc-sel-2)
- (calc-Need-calc-sel)
- (calc-Need-calc-stat)
- (calc-Need-calc-store)
- (calc-Need-calc-stuff)
- (calc-Need-calc-trail)
- (calc-Need-calc-undo)
- (calc-Need-calc-units)
- (calc-Need-calc-vec)
- (calc-Need-calc-yank)
-
- (message "All parts of Calc are now loaded"))
-
-
-;;; Vector commands.
-
-(defun calc-concat (arg)
- (interactive "P")
- (calc-wrapper
- (if (calc-is-inverse)
- (if (calc-is-hyperbolic)
- (calc-enter-result 2 "apnd" (list 'calcFunc-append
- (calc-top 1) (calc-top 2)))
- (calc-enter-result 2 "|" (list 'calcFunc-vconcat
- (calc-top 1) (calc-top 2))))
- (if (calc-is-hyperbolic)
- (calc-binary-op "apnd" 'calcFunc-append arg '(vec))
- (calc-binary-op "|" 'calcFunc-vconcat arg '(vec) nil '|)))))
-
-(defun calc-append (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-concat arg))
-
-
-(defconst calc-arg-values '( ( var ArgA var-ArgA ) ( var ArgB var-ArgB )
- ( var ArgC var-ArgC ) ( var ArgD var-ArgD )
- ( var ArgE var-ArgE ) ( var ArgF var-ArgF )
- ( var ArgG var-ArgG ) ( var ArgH var-ArgH )
- ( var ArgI var-ArgI ) ( var ArgJ var-ArgJ )
-))
-
-(defun calc-invent-args (n)
- (nreverse (nthcdr (- (length calc-arg-values) n) (reverse calc-arg-values))))
-
-
-
-
-;;; User menu.
-
-(defun calc-user-key-map ()
- (if calc-emacs-type-lucid
- (error "User-defined keys are not supported in Lucid Emacs"))
- (let ((res (cdr (lookup-key calc-mode-map "z"))))
- (if (eq (car (car res)) 27)
- (cdr res)
- res)))
-
-(defun calc-z-prefix-help ()
- (interactive)
- (let* ((msgs nil)
- (buf "")
- (kmap (sort (copy-sequence (calc-user-key-map))
- (function (lambda (x y) (< (car x) (car y))))))
- (flags (apply 'logior
- (mapcar (function
- (lambda (k)
- (calc-user-function-classify (car k))))
- kmap))))
- (if (= (logand flags 8) 0)
- (calc-user-function-list kmap 7)
- (calc-user-function-list kmap 1)
- (setq msgs (cons buf msgs)
- buf "")
- (calc-user-function-list kmap 6))
- (if (/= flags 0)
- (setq msgs (cons buf msgs)))
- (calc-do-prefix-help (nreverse msgs) "user" ?z)))
-
-(defun calc-user-function-classify (key)
- (cond ((/= key (downcase key)) ; upper-case
- (if (assq (downcase key) (calc-user-key-map)) 9 1))
- ((/= key (upcase key)) 2) ; lower-case
- ((= key ??) 0)
- (t 4))) ; other
-
-(defun calc-user-function-list (map flags)
- (and map
- (let* ((key (car (car map)))
- (kind (calc-user-function-classify key))
- (func (cdr (car map))))
- (if (or (= (logand kind flags) 0)
- (not (symbolp func)))
- ()
- (let* ((name (symbol-name func))
- (name (if (string-match "\\`calc-" name)
- (substring name 5) name))
- (pos (string-match (char-to-string key) name))
- (desc
- (if (symbolp func)
- (if (= (logand kind 3) 0)
- (format "`%c' = %s" key name)
- (if pos
- (format "%s%c%s"
- (downcase (substring name 0 pos))
- (upcase key)
- (downcase (substring name (1+ pos))))
- (format "%c = %s"
- (upcase key)
- (downcase name))))
- (char-to-string (upcase key)))))
- (if (= (length buf) 0)
- (setq buf (concat (if (= flags 1) "SHIFT + " "")
- desc))
- (if (> (+ (length buf) (length desc)) 58)
- (setq msgs (cons buf msgs)
- buf (concat (if (= flags 1) "SHIFT + " "")
- desc))
- (setq buf (concat buf ", " desc))))))
- (calc-user-function-list (cdr map) flags))))
-
-
-
-(defun calc-shift-Z-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Define, Undefine, Formula, Kbd-macro, Edit, Get-defn"
- "Composition, Syntax; Invocation; Permanent; Timing"
- "kbd-macros: [ (if), : (else), | (else-if), ] (end-if)"
- "kbd-macros: < > (repeat), ( ) (for), { } (loop)"
- "kbd-macros: / (break)"
- "kbd-macros: ` (save), ' (restore)")
- "user" ?Z))
-
-
-;;;; Caches.
-
-(defmacro math-defcache (name init form)
- (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec")))
- (cache-val (intern (concat (symbol-name name) "-cache")))
- (last-prec (intern (concat (symbol-name name) "-last-prec")))
- (last-val (intern (concat (symbol-name name) "-last"))))
- (list 'progn
- (list 'setq cache-prec (if init (math-numdigs (nth 1 init)) -100))
- (list 'setq cache-val (list 'quote init))
- (list 'setq last-prec -100)
- (list 'setq last-val nil)
- (list 'setq 'math-cache-list
- (list 'cons
- (list 'quote cache-prec)
- (list 'cons
- (list 'quote last-prec)
- 'math-cache-list)))
- (list 'defun
- name ()
- (list 'or
- (list '= last-prec 'calc-internal-prec)
- (list 'setq
- last-val
- (list 'math-normalize
- (list 'progn
- (list 'or
- (list '>= cache-prec
- 'calc-internal-prec)
- (list 'setq
- cache-val
- (list 'let
- '((calc-internal-prec
- (+ calc-internal-prec
- 4)))
- form)
- cache-prec
- '(+ calc-internal-prec 2)))
- cache-val))
- last-prec 'calc-internal-prec))
- last-val))))
-(put 'math-defcache 'lisp-indent-hook 2)
-
-;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public]
-(math-defcache math-pi (float (bigpos 463 238 793 589 653 592 141 3) -21)
- (math-add-float (math-mul-float '(float 16 0)
- (math-arctan-raw '(float 2 -1)))
- (math-mul-float '(float -4 0)
- (math-arctan-raw
- (math-float '(frac 1 239))))))
-
-(math-defcache math-two-pi nil
- (math-mul-float (math-pi) '(float 2 0)))
-
-(math-defcache math-pi-over-2 nil
- (math-mul-float (math-pi) '(float 5 -1)))
-
-(math-defcache math-pi-over-4 nil
- (math-mul-float (math-pi) '(float 25 -2)))
-
-(math-defcache math-pi-over-180 nil
- (math-div-float (math-pi) '(float 18 1)))
-
-(math-defcache math-sqrt-pi nil
- (math-sqrt-float (math-pi)))
-
-(math-defcache math-sqrt-2 nil
- (math-sqrt-float '(float 2 0)))
-
-(math-defcache math-sqrt-12 nil
- (math-sqrt-float '(float 12 0)))
-
-(math-defcache math-sqrt-two-pi nil
- (math-sqrt-float (math-two-pi)))
-
-(math-defcache math-sqrt-e (float (bigpos 849 146 128 700 270 721 648 1) -21)
- (math-add-float '(float 1 0) (math-exp-minus-1-raw '(float 5 -1))))
-
-(math-defcache math-e nil
- (math-pow (math-sqrt-e) 2))
-
-(math-defcache math-phi nil
- (math-mul-float (math-add-float (math-sqrt-raw '(float 5 0)) '(float 1 0))
- '(float 5 -1)))
-
-(math-defcache math-gamma-const nil
- '(float (bigpos 495 467 917 632 470 369 709 646 776 267 677 848 348 672
- 057 988 235 399 359 593 421 310 024 824 900 120 065 606
- 328 015 649 156 772 5) -100))
-
-(defun math-half-circle (symb)
- (if (eq calc-angle-mode 'rad)
- (if symb
- '(var pi var-pi)
- (math-pi))
- 180))
-
-(defun math-full-circle (symb)
- (math-mul 2 (math-half-circle symb)))
-
-(defun math-quarter-circle (symb)
- (math-div (math-half-circle symb) 2))
-
-(defvar math-expand-formulas nil)
-
-;;;; Miscellaneous math routines.
-
-;;; True if A is an odd integer. [P R R] [Public]
-(defun math-oddp (a)
- (if (consp a)
- (and (memq (car a) '(bigpos bigneg))
- (= (% (nth 1 a) 2) 1))
- (/= (% a 2) 0)))
-
-;;; True if A is a small or big integer. [P x] [Public]
-(defun math-integerp (a)
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg))))
-
-;;; True if A is (numerically) a non-negative integer. [P N] [Public]
-(defun math-natnump (a)
- (or (natnump a)
- (eq (car-safe a) 'bigpos)))
-
-;;; True if A is a rational (or integer). [P x] [Public]
-(defun math-ratp (a)
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac))))
-
-;;; True if A is a real (or rational). [P x] [Public]
-(defun math-realp (a)
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float))))
-
-;;; True if A is a real or HMS form. [P x] [Public]
-(defun math-anglep (a)
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float hms))))
-
-;;; True if A is a number of any kind. [P x] [Public]
-(defun math-numberp (a)
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
-
-;;; True if A is a complex number or angle. [P x] [Public]
-(defun math-scalarp (a)
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
-
-;;; True if A is a vector. [P x] [Public]
-(defun math-vectorp (a)
- (eq (car-safe a) 'vec))
-
-;;; True if A is any vector or scalar data object. [P x]
-(defun math-objvecp (a) ; [Public]
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar
- hms date sdev intv mod vec incomplete))))
-
-;;; True if A is an object not composed of sub-formulas . [P x] [Public]
-(defun math-primp (a)
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar
- hms date mod var))))
-
-;;; True if A is numerically (but not literally) an integer. [P x] [Public]
-(defun math-messy-integerp (a)
- (cond
- ((eq (car-safe a) 'float) (>= (nth 2 a) 0))
- ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))))
-
-;;; True if A is numerically an integer. [P x] [Public]
-(defun math-num-integerp (a)
- (or (Math-integerp a)
- (Math-messy-integerp a)))
-
-;;; True if A is (numerically) a non-negative integer. [P N] [Public]
-(defun math-num-natnump (a)
- (or (natnump a)
- (eq (car-safe a) 'bigpos)
- (and (eq (car-safe a) 'float)
- (Math-natnump (nth 1 a))
- (>= (nth 2 a) 0))))
-
-;;; True if A is an integer or will evaluate to an integer. [P x] [Public]
-(defun math-provably-integerp (a)
- (or (Math-integerp a)
- (and (memq (car-safe a) '(calcFunc-trunc
- calcFunc-round
- calcFunc-rounde
- calcFunc-roundu
- calcFunc-floor
- calcFunc-ceil))
- (= (length a) 2))))
-
-;;; True if A is a real or will evaluate to a real. [P x] [Public]
-(defun math-provably-realp (a)
- (or (Math-realp a)
- (math-provably-integer a)
- (memq (car-safe a) '(abs arg))))
-
-;;; True if A is a non-real, complex number. [P x] [Public]
-(defun math-complexp (a)
- (memq (car-safe a) '(cplx polar)))
-
-;;; True if A is a non-real, rectangular complex number. [P x] [Public]
-(defun math-rect-complexp (a)
- (eq (car-safe a) 'cplx))
-
-;;; True if A is a non-real, polar complex number. [P x] [Public]
-(defun math-polar-complexp (a)
- (eq (car-safe a) 'polar))
-
-;;; True if A is a matrix. [P x] [Public]
-(defun math-matrixp (a)
- (and (Math-vectorp a)
- (Math-vectorp (nth 1 a))
- (cdr (nth 1 a))
- (let ((len (length (nth 1 a))))
- (setq a (cdr a))
- (while (and (setq a (cdr a))
- (Math-vectorp (car a))
- (= (length (car a)) len)))
- (null a))))
-
-(defun math-matrixp-step (a len) ; [P L]
- (or (null a)
- (and (Math-vectorp (car a))
- (= (length (car a)) len)
- (math-matrixp-step (cdr a) len))))
-
-;;; True if A is a square matrix. [P V] [Public]
-(defun math-square-matrixp (a)
- (let ((dims (math-mat-dimens a)))
- (and (cdr dims)
- (= (car dims) (nth 1 dims)))))
-
-;;; True if A is any scalar data object. [P x]
-(defun math-objectp (a) ; [Public]
- (or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx
- polar hms date sdev intv mod))))
-
-;;; Verify that A is an integer and return A in integer form. [I N; - x]
-(defun math-check-integer (a) ; [Public]
- (cond ((integerp a) a) ; for speed
- ((math-integerp a) a)
- ((math-messy-integerp a)
- (math-trunc a))
- (t (math-reject-arg a 'integerp))))
-
-;;; Verify that A is a small integer and return A in integer form. [S N; - x]
-(defun math-check-fixnum (a &optional allow-inf) ; [Public]
- (cond ((integerp a) a) ; for speed
- ((Math-num-integerp a)
- (let ((a (math-trunc a)))
- (if (integerp a)
- a
- (if (or (Math-lessp (lsh -1 -1) a)
- (Math-lessp a (- (lsh -1 -1))))
- (math-reject-arg a 'fixnump)
- (math-fixnum a)))))
- ((and allow-inf (equal a '(var inf var-inf)))
- (lsh -1 -1))
- ((and allow-inf (equal a '(neg (var inf var-inf))))
- (- (lsh -1 -1)))
- (t (math-reject-arg a 'fixnump))))
-
-;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x]
-(defun math-check-natnum (a) ; [Public]
- (cond ((natnump a) a)
- ((and (not (math-negp a))
- (Math-num-integerp a))
- (math-trunc a))
- (t (math-reject-arg a 'natnump))))
-
-;;; Verify that A is in floating-point form, or force it to be a float. [F N]
-(defun math-check-float (a) ; [Public]
- (cond ((eq (car-safe a) 'float) a)
- ((Math-vectorp a) (math-map-vec 'math-check-float a))
- ((Math-objectp a) (math-float a))
- (t a)))
-
-;;; Verify that A is a constant.
-(defun math-check-const (a &optional exp-ok)
- (if (or (math-constp a)
- (and exp-ok math-expand-formulas))
- a
- (math-reject-arg a 'constp)))
-
-
-;;; Coerce integer A to be a small integer. [S I]
-(defun math-fixnum (a)
- (if (consp a)
- (if (cdr a)
- (if (eq (car a) 'bigneg)
- (- (math-fixnum-big (cdr a)))
- (math-fixnum-big (cdr a)))
- 0)
- a))
-
-(defun math-fixnum-big (a)
- (if (cdr a)
- (+ (car a) (* (math-fixnum-big (cdr a)) 1000))
- (car a)))
-
-(defvar math-simplify-only nil)
-
-(defun math-normalize-fancy (a)
- (cond ((eq (car a) 'frac)
- (math-make-frac (math-normalize (nth 1 a))
- (math-normalize (nth 2 a))))
- ((eq (car a) 'cplx)
- (let ((real (math-normalize (nth 1 a)))
- (imag (math-normalize (nth 2 a))))
- (if (and (math-zerop imag)
- (not math-simplify-only)) ; oh, what a kludge!
- real
- (list 'cplx real imag))))
- ((eq (car a) 'polar)
- (math-normalize-polar a))
- ((eq (car a) 'hms)
- (math-normalize-hms a))
- ((eq (car a) 'date)
- (list 'date (math-normalize (nth 1 a))))
- ((eq (car a) 'mod)
- (math-normalize-mod a))
- ((eq (car a) 'sdev)
- (let ((x (math-normalize (nth 1 a)))
- (s (math-normalize (nth 2 a))))
- (if (or (and (Math-objectp x) (not (Math-scalarp x)))
- (and (Math-objectp s) (not (Math-scalarp s))))
- (list 'calcFunc-sdev x s)
- (math-make-sdev x s))))
- ((eq (car a) 'intv)
- (let ((mask (math-normalize (nth 1 a)))
- (lo (math-normalize (nth 2 a)))
- (hi (math-normalize (nth 3 a))))
- (if (if (eq (car-safe lo) 'date)
- (not (eq (car-safe hi) 'date))
- (or (and (Math-objectp lo) (not (Math-anglep lo)))
- (and (Math-objectp hi) (not (Math-anglep hi)))))
- (list 'calcFunc-intv mask lo hi)
- (math-make-intv mask lo hi))))
- ((eq (car a) 'vec)
- (cons 'vec (mapcar 'math-normalize (cdr a))))
- ((eq (car a) 'quote)
- (math-normalize (nth 1 a)))
- ((eq (car a) 'special-const)
- (calc-with-default-simplification
- (math-normalize (nth 1 a))))
- ((eq (car a) 'var)
- (cons 'var (cdr a))) ; need to re-cons for selection routines
- ((eq (car a) 'calcFunc-if)
- (math-normalize-logical-op a))
- ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition))
- (let ((calc-simplify-mode 'none))
- (cons (car a) (mapcar 'math-normalize (cdr a)))))
- ((eq (car a) 'calcFunc-evalto)
- (setq a (or (nth 1 a) 0))
- (or calc-refreshing-evaltos
- (setq a (let ((calc-simplify-mode 'none)) (math-normalize a))))
- (let ((b (if (and (eq (car-safe a) 'calcFunc-assign)
- (= (length a) 3))
- (nth 2 a)
- a)))
- (list 'calcFunc-evalto
- a
- (if (eq calc-simplify-mode 'none)
- (math-normalize b)
- (calc-with-default-simplification
- (math-evaluate-expr b))))))
- ((or (integerp (car a)) (consp (car a)))
- (if (null (cdr a))
- (math-normalize (car a))
- (error "Can't use multi-valued function in an expression")))))
-
-(defun math-normalize-nonstandard () ; uses "a"
- (if (consp calc-simplify-mode)
- (progn
- (setq calc-simplify-mode 'none
- math-simplify-only (car-safe (cdr-safe a)))
- nil)
- (and (symbolp (car a))
- (or (eq calc-simplify-mode 'none)
- (and (eq calc-simplify-mode 'num)
- (let ((aptr (setq a (cons
- (car a)
- (mapcar 'math-normalize (cdr a))))))
- (while (and aptr (math-constp (car aptr)))
- (setq aptr (cdr aptr)))
- aptr)))
- (cons (car a) (mapcar 'math-normalize (cdr a))))))
-
-
-
-
-
-;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
-(defun math-norm-bignum (a)
- (let ((digs a) (last nil))
- (while digs
- (or (eq (car digs) 0) (setq last digs))
- (setq digs (cdr digs)))
- (and last
- (progn
- (setcdr last nil)
- a))))
-
-(defun math-bignum-test (a) ; [B N; B s; b b]
- (if (consp a)
- a
- (math-bignum a)))
-
-
-;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
-(defun calcFunc-sign (a &optional x)
- (let ((signs (math-possible-signs a)))
- (cond ((eq signs 4) (or x 1))
- ((eq signs 2) 0)
- ((eq signs 1) (if x (math-neg x) -1))
- ((math-looks-negp a) (math-neg (calcFunc-sign (math-neg a))))
- (t (calc-record-why 'realp a)
- (if x
- (list 'calcFunc-sign a x)
- (list 'calcFunc-sign a))))))
-
-;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more.
-;;; Arguments must be normalized! [S N N]
-(defun math-compare (a b)
- (cond ((equal a b)
- (if (and (consp a)
- (memq (car a) '(var neg * /))
- (math-infinitep a))
- 2
- 0))
- ((and (integerp a) (Math-integerp b))
- (if (consp b)
- (if (eq (car b) 'bigpos) -1 1)
- (if (< a b) -1 1)))
- ((and (eq (car-safe a) 'bigpos) (Math-integerp b))
- (if (eq (car-safe b) 'bigpos)
- (math-compare-bignum (cdr a) (cdr b))
- 1))
- ((and (eq (car-safe a) 'bigneg) (Math-integerp b))
- (if (eq (car-safe b) 'bigneg)
- (math-compare-bignum (cdr b) (cdr a))
- -1))
- ((eq (car-safe a) 'frac)
- (if (eq (car-safe b) 'frac)
- (math-compare (math-mul (nth 1 a) (nth 2 b))
- (math-mul (nth 1 b) (nth 2 a)))
- (math-compare (nth 1 a) (math-mul b (nth 2 a)))))
- ((eq (car-safe b) 'frac)
- (math-compare (math-mul a (nth 2 b)) (nth 1 b)))
- ((and (eq (car-safe a) 'float) (eq (car-safe b) 'float))
- (if (math-lessp-float a b) -1 1))
- ((and (eq (car-safe a) 'date) (eq (car-safe b) 'date))
- (math-compare (nth 1 a) (nth 1 b)))
- ((and (or (Math-anglep a)
- (and (eq (car a) 'cplx) (eq (nth 2 a) 0)))
- (or (Math-anglep b)
- (and (eq (car b) 'cplx) (eq (nth 2 b) 0))))
- (calcFunc-sign (math-add a (math-neg b))))
- ((and (eq (car-safe a) 'intv)
- (or (Math-anglep b) (eq (car-safe b) 'date)))
- (let ((res (math-compare (nth 2 a) b)))
- (cond ((eq res 1) 1)
- ((and (eq res 0) (memq (nth 1 a) '(0 1))) 1)
- ((eq (setq res (math-compare (nth 3 a) b)) -1) -1)
- ((and (eq res 0) (memq (nth 1 a) '(0 2))) -1)
- (t 2))))
- ((and (eq (car-safe b) 'intv)
- (or (Math-anglep a) (eq (car-safe a) 'date)))
- (let ((res (math-compare a (nth 2 b))))
- (cond ((eq res -1) -1)
- ((and (eq res 0) (memq (nth 1 b) '(0 1))) -1)
- ((eq (setq res (math-compare a (nth 3 b))) 1) 1)
- ((and (eq res 0) (memq (nth 1 b) '(0 2))) 1)
- (t 2))))
- ((and (eq (car-safe a) 'intv) (eq (car-safe b) 'intv))
- (let ((res (math-compare (nth 3 a) (nth 2 b))))
- (cond ((eq res -1) -1)
- ((and (eq res 0) (or (memq (nth 1 a) '(0 2))
- (memq (nth 1 b) '(0 1)))) -1)
- ((eq (setq res (math-compare (nth 2 a) (nth 3 b))) 1) 1)
- ((and (eq res 0) (or (memq (nth 1 a) '(0 1))
- (memq (nth 1 b) '(0 2)))) 1)
- (t 2))))
- ((math-infinitep a)
- (if (or (equal a '(var uinf var-uinf))
- (equal a '(var nan var-nan)))
- 2
- (let ((dira (math-infinite-dir a)))
- (if (math-infinitep b)
- (if (or (equal b '(var uinf var-uinf))
- (equal b '(var nan var-nan)))
- 2
- (let ((dirb (math-infinite-dir b)))
- (cond ((and (eq dira 1) (eq dirb -1)) 1)
- ((and (eq dira -1) (eq dirb 1)) -1)
- (t 2))))
- (cond ((eq dira 1) 1)
- ((eq dira -1) -1)
- (t 2))))))
- ((math-infinitep b)
- (if (or (equal b '(var uinf var-uinf))
- (equal b '(var nan var-nan)))
- 2
- (let ((dirb (math-infinite-dir b)))
- (cond ((eq dirb 1) -1)
- ((eq dirb -1) 1)
- (t 2)))))
- ((and (eq (car-safe a) 'calcFunc-exp)
- (eq (car-safe b) '^)
- (equal (nth 1 b) '(var e var-e)))
- (math-compare (nth 1 a) (nth 2 b)))
- ((and (eq (car-safe b) 'calcFunc-exp)
- (eq (car-safe a) '^)
- (equal (nth 1 a) '(var e var-e)))
- (math-compare (nth 2 a) (nth 1 b)))
- ((or (and (eq (car-safe a) 'calcFunc-sqrt)
- (eq (car-safe b) '^)
- (or (equal (nth 2 b) '(frac 1 2))
- (equal (nth 2 b) '(float 5 -1))))
- (and (eq (car-safe b) 'calcFunc-sqrt)
- (eq (car-safe a) '^)
- (or (equal (nth 2 a) '(frac 1 2))
- (equal (nth 2 a) '(float 5 -1)))))
- (math-compare (nth 1 a) (nth 1 b)))
- ((eq (car-safe a) 'var)
- 2)
- (t
- (if (and (consp a) (consp b)
- (eq (car a) (car b))
- (math-compare-lists (cdr a) (cdr b)))
- 0
- 2))))
-
-;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B.
-(defun math-compare-bignum (a b) ; [S l l]
- (let ((res 0))
- (while (and a b)
- (if (< (car a) (car b))
- (setq res -1)
- (if (> (car a) (car b))
- (setq res 1)))
- (setq a (cdr a)
- b (cdr b)))
- (if a
- (progn
- (while (eq (car a) 0) (setq a (cdr a)))
- (if a 1 res))
- (while (eq (car b) 0) (setq b (cdr b)))
- (if b -1 res))))
-
-(defun math-compare-lists (a b)
- (cond ((null a) (null b))
- ((null b) nil)
- (t (and (Math-equal (car a) (car b))
- (math-compare-lists (cdr a) (cdr b))))))
-
-(defun math-lessp-float (a b) ; [P F F]
- (let ((ediff (- (nth 2 a) (nth 2 b))))
- (if (>= ediff 0)
- (if (>= ediff (+ calc-internal-prec calc-internal-prec))
- (if (eq (nth 1 a) 0)
- (Math-integer-posp (nth 1 b))
- (Math-integer-negp (nth 1 a)))
- (Math-lessp (math-scale-int (nth 1 a) ediff)
- (nth 1 b)))
- (if (>= (setq ediff (- ediff))
- (+ calc-internal-prec calc-internal-prec))
- (if (eq (nth 1 b) 0)
- (Math-integer-negp (nth 1 a))
- (Math-integer-posp (nth 1 b)))
- (Math-lessp (nth 1 a)
- (math-scale-int (nth 1 b) ediff))))))
-
-;;; True if A is numerically equal to B. [P N N] [Public]
-(defun math-equal (a b)
- (= (math-compare a b) 0))
-
-;;; True if A is numerically less than B. [P R R] [Public]
-(defun math-lessp (a b)
- (= (math-compare a b) -1))
-
-;;; True if A is numerically equal to the integer B. [P N S] [Public]
-;;; B must not be a multiple of 10.
-(defun math-equal-int (a b)
- (or (eq a b)
- (and (eq (car-safe a) 'float)
- (eq (nth 1 a) b)
- (= (nth 2 a) 0))))
-
-
-
-
-;;; Return the dimensions of a matrix as a list. [l x] [Public]
-(defun math-mat-dimens (m)
- (if (math-vectorp m)
- (if (math-matrixp m)
- (cons (1- (length m))
- (math-mat-dimens (nth 1 m)))
- (list (1- (length m))))
- nil))
-
-
-
-(defun calc-binary-op-fancy (name func arg ident unary)
- (let ((n (prefix-numeric-value arg)))
- (cond ((> n 1)
- (calc-enter-result n
- name
- (list 'calcFunc-reduce
- (math-calcFunc-to-var func)
- (cons 'vec (calc-top-list-n n)))))
- ((= n 1)
- (if unary
- (calc-enter-result 1 name (list unary (calc-top-n 1)))))
- ((= n 0)
- (if ident
- (calc-enter-result 0 name ident)
- (error "Argument must be nonzero")))
- (t
- (let ((rhs (calc-top-n 1)))
- (calc-enter-result (- 1 n)
- name
- (mapcar (function
- (lambda (x)
- (list func x rhs)))
- (calc-top-list-n (- n) 2))))))))
-
-(defun calc-unary-op-fancy (name func arg)
- (let ((n (prefix-numeric-value arg)))
- (if (= n 0) (setq n (calc-stack-size)))
- (cond ((> n 0)
- (calc-enter-result n
- name
- (mapcar (function
- (lambda (x)
- (list func x)))
- (calc-top-list-n n))))
- ((< n 0)
- (calc-enter-result 1
- name
- (list func (calc-top-n (- n)))
- (- n))))))
-
-(defvar var-Holidays '(vec (var sat var-sat) (var sun var-sun)))
-(defvar var-Decls (list 'vec))
-
-
-(defun math-inexact-result ()
- (and calc-symbolic-mode
- (signal 'inexact-result nil)))
-
-(defun math-overflow (&optional exp)
- (if (and exp (math-negp exp))
- (math-underflow)
- (signal 'math-overflow nil)))
-
-(defun math-underflow ()
- (signal 'math-underflow nil))
-
-;;; Compute the greatest common divisor of A and B. [I I I] [Public]
-(defun math-gcd (a b)
- (cond ((not (or (consp a) (consp b)))
- (if (< a 0) (setq a (- a)))
- (if (< b 0) (setq b (- b)))
- (let (c)
- (if (< a b)
- (setq c b b a a c))
- (while (> b 0)
- (setq c b
- b (% a b)
- a c))
- a))
- ((eq a 0) b)
- ((eq b 0) a)
- (t
- (if (Math-integer-negp a) (setq a (math-neg a)))
- (if (Math-integer-negp b) (setq b (math-neg b)))
- (let (c)
- (if (Math-natnum-lessp a b)
- (setq c b b a a c))
- (while (and (consp a) (not (eq b 0)))
- (setq c b
- b (math-imod a b)
- a c))
- (while (> b 0)
- (setq c b
- b (% a b)
- a c))
- a))))
-
-
-;;;; Algebra.
-
-;;; Evaluate variables in an expression.
-(defun math-evaluate-expr (x) ; [Public]
- (if calc-embedded-info
- (calc-embedded-evaluate-expr x)
- (calc-normalize (math-evaluate-expr-rec x))))
-
-(defalias 'calcFunc-evalv 'math-evaluate-expr)
-
-(defun calcFunc-evalvn (x &optional prec)
- (if prec
- (progn
- (or (math-num-integerp prec)
- (if (and (math-vectorp prec)
- (= (length prec) 2)
- (math-num-integerp (nth 1 prec)))
- (setq prec (math-add (nth 1 prec) calc-internal-prec))
- (math-reject-arg prec 'integerp)))
- (setq prec (math-trunc prec))
- (if (< prec 3) (setq prec 3))
- (if (> prec calc-internal-prec)
- (math-normalize
- (let ((calc-internal-prec prec))
- (calcFunc-evalvn x)))
- (let ((calc-internal-prec prec))
- (calcFunc-evalvn x))))
- (let ((calc-symbolic-mode nil))
- (math-evaluate-expr x))))
-
-(defun math-evaluate-expr-rec (x)
- (if (consp x)
- (if (memq (car x) '(calcFunc-quote calcFunc-condition
- calcFunc-evalto calcFunc-assign))
- (if (and (eq (car x) 'calcFunc-assign)
- (= (length x) 3))
- (list (car x) (nth 1 x) (math-evaluate-expr-rec (nth 2 x)))
- x)
- (if (eq (car x) 'var)
- (if (and (calc-var-value (nth 2 x))
- (not (eq (car-safe (symbol-value (nth 2 x)))
- 'incomplete)))
- (let ((val (symbol-value (nth 2 x))))
- (if (eq (car-safe val) 'special-const)
- (if calc-symbolic-mode
- x
- val)
- val))
- x)
- (if (Math-primp x)
- x
- (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))
- x))
-
-(defmacro math-defsimplify (funcs &rest code)
- (append '(progn (math-need-std-simps))
- (mapcar (function
- (lambda (func)
- (list 'put (list 'quote func) ''math-simplify
- (list 'nconc
- (list 'get (list 'quote func) ''math-simplify)
- (list 'list
- (list 'function
- (append '(lambda (expr))
- code)))))))
- (if (symbolp funcs) (list funcs) funcs))))
-(put 'math-defsimplify 'lisp-indent-hook 1)
-
-(defun math-any-floats (expr)
- (if (Math-primp expr)
- (math-floatp expr)
- (while (and (setq expr (cdr expr)) (not (math-any-floats (car expr)))))
- expr))
-
-(defvar var-FactorRules 'calc-FactorRules)
-
-(defun math-map-tree (mmt-func mmt-expr &optional mmt-many)
- (or mmt-many (setq mmt-many 1000000))
- (math-map-tree-rec mmt-expr))
-
-(defun math-map-tree-rec (mmt-expr)
- (or (= mmt-many 0)
- (let ((mmt-done nil)
- mmt-nextval)
- (while (not mmt-done)
- (while (and (/= mmt-many 0)
- (setq mmt-nextval (funcall mmt-func mmt-expr))
- (not (equal mmt-expr mmt-nextval)))
- (setq mmt-expr mmt-nextval
- mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many))))
- (if (or (Math-primp mmt-expr)
- (<= mmt-many 0))
- (setq mmt-done t)
- (setq mmt-nextval (cons (car mmt-expr)
- (mapcar 'math-map-tree-rec
- (cdr mmt-expr))))
- (if (equal mmt-nextval mmt-expr)
- (setq mmt-done t)
- (setq mmt-expr mmt-nextval))))))
- mmt-expr)
-
-(defun math-is-true (expr)
- (if (Math-numberp expr)
- (not (Math-zerop expr))
- (math-known-nonzerop expr)))
-
-(defun math-const-var (expr)
- (and (consp expr)
- (eq (car expr) 'var)
- (or (and (symbolp (nth 2 expr))
- (boundp (nth 2 expr))
- (eq (car-safe (symbol-value (nth 2 expr))) 'special-const))
- (memq (nth 2 expr) '(var-inf var-uinf var-nan)))))
-
-(defmacro math-defintegral (funcs &rest code)
- (setq math-integral-cache nil)
- (append '(progn)
- (mapcar (function
- (lambda (func)
- (list 'put (list 'quote func) ''math-integral
- (list 'nconc
- (list 'get (list 'quote func) ''math-integral)
- (list 'list
- (list 'function
- (append '(lambda (u))
- code)))))))
- (if (symbolp funcs) (list funcs) funcs))))
-(put 'math-defintegral 'lisp-indent-hook 1)
-
-(defmacro math-defintegral-2 (funcs &rest code)
- (setq math-integral-cache nil)
- (append '(progn)
- (mapcar (function
- (lambda (func)
- (list 'put (list 'quote func) ''math-integral-2
- (list 'nconc
- (list 'get (list 'quote func)
- ''math-integral-2)
- (list 'list
- (list 'function
- (append '(lambda (u v))
- code)))))))
- (if (symbolp funcs) (list funcs) funcs))))
-(put 'math-defintegral-2 'lisp-indent-hook 1)
-
-(defvar var-IntegAfterRules 'calc-IntegAfterRules)
-
-(defvar var-FitRules 'calc-FitRules)
-
-(defvar math-poly-base-variable nil)
-(defvar math-poly-neg-powers nil)
-(defvar math-poly-mult-powers 1)
-(defvar math-poly-frac-powers nil)
-(defvar math-poly-exp-base nil)
-
-(defun math-build-var-name (name)
- (if (stringp name)
- (setq name (intern name)))
- (if (string-match "\\`var-." (symbol-name name))
- (list 'var (intern (substring (symbol-name name) 4)) name)
- (list 'var name (intern (concat "var-" (symbol-name name))))))
-
-(defvar math-simplifying-units nil)
-(defvar math-combining-units t)
-
-;;; Nontrivial number parsing.
-
-(defun math-read-number-fancy (s)
- (cond
-
- ;; Integer+fractions
- ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
- (let ((int (math-match-substring s 1))
- (num (math-match-substring s 2))
- (den (math-match-substring s 3)))
- (let ((int (if (> (length int) 0) (math-read-number int) 0))
- (num (if (> (length num) 0) (math-read-number num) 1))
- (den (if (> (length num) 0) (math-read-number den) 1)))
- (and int num den
- (math-integerp int) (math-integerp num) (math-integerp den)
- (not (math-zerop den))
- (list 'frac (math-add num (math-mul int den)) den)))))
-
- ;; Fractions
- ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
- (let ((num (math-match-substring s 1))
- (den (math-match-substring s 2)))
- (let ((num (if (> (length num) 0) (math-read-number num) 1))
- (den (if (> (length num) 0) (math-read-number den) 1)))
- (and num den (math-integerp num) (math-integerp den)
- (not (math-zerop den))
- (list 'frac num den)))))
-
- ;; Modulo forms
- ((string-match "^\\(.*\\) *mod *\\(.*\\)$" s)
- (let* ((n (math-match-substring s 1))
- (m (math-match-substring s 2))
- (n (math-read-number n))
- (m (math-read-number m)))
- (and n m (math-anglep n) (math-anglep m)
- (list 'mod n m))))
-
- ;; Error forms
- ((string-match "^\\(.*\\) *\\+/- *\\(.*\\)$" s)
- (let* ((x (math-match-substring s 1))
- (sigma (math-match-substring s 2))
- (x (math-read-number x))
- (sigma (math-read-number sigma)))
- (and x sigma (math-scalarp x) (math-anglep sigma)
- (list 'sdev x sigma))))
-
- ;; Hours (or degrees)
- ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s)
- (string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s))
- (let* ((hours (math-match-substring s 1))
- (minsec (math-match-substring s 2))
- (hours (math-read-number hours))
- (minsec (if (> (length minsec) 0) (math-read-number minsec) 0)))
- (and hours minsec
- (math-num-integerp hours)
- (not (math-negp hours)) (not (math-negp minsec))
- (cond ((math-num-integerp minsec)
- (and (Math-lessp minsec 60)
- (list 'hms hours minsec 0)))
- ((and (eq (car-safe minsec) 'hms)
- (math-zerop (nth 1 minsec)))
- (math-add (list 'hms hours 0 0) minsec))
- (t nil)))))
-
- ;; Minutes
- ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s)
- (let* ((minutes (math-match-substring s 1))
- (seconds (math-match-substring s 2))
- (minutes (math-read-number minutes))
- (seconds (if (> (length seconds) 0) (math-read-number seconds) 0)))
- (and minutes seconds
- (math-num-integerp minutes)
- (not (math-negp minutes)) (not (math-negp seconds))
- (cond ((math-realp seconds)
- (and (Math-lessp minutes 60)
- (list 'hms 0 minutes seconds)))
- ((and (eq (car-safe seconds) 'hms)
- (math-zerop (nth 1 seconds))
- (math-zerop (nth 2 seconds)))
- (math-add (list 'hms 0 minutes 0) seconds))
- (t nil)))))
-
- ;; Seconds
- ((string-match "^\\([^\"#^]+\\)[sS\"]$" s)
- (let ((seconds (math-read-number (math-match-substring s 1))))
- (and seconds (math-realp seconds)
- (not (math-negp seconds))
- (Math-lessp seconds 60)
- (list 'hms 0 0 seconds))))
-
- ;; Integer+fraction with explicit radix
- ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s)
- (let ((radix (string-to-int (math-match-substring s 1)))
- (int (math-match-substring s 3))
- (num (math-match-substring s 4))
- (den (math-match-substring s 5)))
- (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
- (num (if (> (length num) 0) (math-read-radix num radix) 1))
- (den (if (> (length den) 0) (math-read-radix den radix) 1)))
- (and int num den (not (math-zerop den))
- (list 'frac
- (math-add num (math-mul int den))
- den)))))
-
- ;; Fraction with explicit radix
- ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s)
- (let ((radix (string-to-int (math-match-substring s 1)))
- (num (math-match-substring s 3))
- (den (math-match-substring s 4)))
- (let ((num (if (> (length num) 0) (math-read-radix num radix) 1))
- (den (if (> (length den) 0) (math-read-radix den radix) 1)))
- (and num den (not (math-zerop den)) (list 'frac num den)))))
-
- ;; Float with explicit radix and exponent
- ((or (string-match "^0*\\(\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+\\)[eE]\\([-+]?[0-9]+\\)$" s)
- (string-match "^\\(\\([0-9]+\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z.]+\\) *\\* *\\2\\.? *\\^ *\\([-+]?[0-9]+\\)$" s))
- (let ((radix (string-to-int (math-match-substring s 2)))
- (mant (math-match-substring s 1))
- (exp (math-match-substring s 4)))
- (let ((mant (math-read-number mant))
- (exp (math-read-number exp)))
- (and mant exp
- (math-mul mant (math-pow (math-float radix) exp))))))
-
- ;; Float with explicit radix, no exponent
- ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)\\.\\([0-9a-zA-Z]*\\)$" s)
- (let ((radix (string-to-int (math-match-substring s 1)))
- (int (math-match-substring s 3))
- (fracs (math-match-substring s 4)))
- (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
- (frac (if (> (length fracs) 0) (math-read-radix fracs radix) 0))
- (calc-prefer-frac nil))
- (and int frac
- (math-add int (math-div frac (math-pow radix (length fracs))))))))
-
- ;; Integer with explicit radix
- ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]+\\)$" s)
- (math-read-radix (math-match-substring s 3)
- (string-to-int (math-match-substring s 1))))
-
- ;; C language hexadecimal notation
- ((and (eq calc-language 'c)
- (string-match "^0[xX]\\([0-9a-fA-F]+\\)$" s))
- (let ((digs (math-match-substring s 1)))
- (math-read-radix digs 16)))
-
- ;; Pascal language hexadecimal notation
- ((and (eq calc-language 'pascal)
- (string-match "^\\$\\([0-9a-fA-F]+\\)$" s))
- (let ((digs (math-match-substring s 1)))
- (math-read-radix digs 16)))
-
- ;; Fraction using "/" instead of ":"
- ((string-match "^\\([0-9]+\\)/\\([0-9/]+\\)$" s)
- (math-read-number (concat (math-match-substring s 1) ":"
- (math-match-substring s 2))))
-
- ;; Syntax error!
- (t nil)))
-
-(defun math-read-radix (s r) ; [I X D]
- (setq s (upcase s))
- (let ((i 0)
- (res 0)
- dig)
- (while (and (< i (length s))
- (setq dig (math-read-radix-digit (elt s i)))
- (< dig r))
- (setq res (math-add (math-mul res r) dig)
- i (1+ i)))
- (and (= i (length s))
- res)))
-
-
-
-;;; Expression parsing.
-
-(defun math-read-expr (exp-str)
- (let ((exp-pos 0)
- (exp-old-pos 0)
- (exp-keep-spaces nil)
- exp-token exp-data)
- (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str))
- (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots"
- (substring exp-str (+ exp-token 2)))))
- (math-build-parse-table)
- (math-read-token)
- (let ((val (catch 'syntax (math-read-expr-level 0))))
- (if (stringp val)
- (list 'error exp-old-pos val)
- (if (equal exp-token 'end)
- val
- (list 'error exp-old-pos "Syntax error"))))))
-
-(defun math-read-plain-expr (exp-str &optional error-check)
- (let* ((calc-language nil)
- (math-expr-opers math-standard-opers)
- (val (math-read-expr exp-str)))
- (and error-check
- (eq (car-safe val) 'error)
- (error "%s: %s" (nth 2 val) exp-str))
- val))
-
-
-(defun math-read-string ()
- (let ((str (read-from-string (concat exp-data "\""))))
- (or (and (= (cdr str) (1+ (length exp-data)))
- (stringp (car str)))
- (throw 'syntax "Error in string constant"))
- (math-read-token)
- (append '(vec) (car str) nil)))
-
-
-
-;;; They said it couldn't be done...
-
-(defun math-read-big-expr (str)
- (and (> (length calc-left-label) 0)
- (string-match (concat "^" (regexp-quote calc-left-label)) str)
- (setq str (concat (substring str 0 (match-beginning 0))
- (substring str (match-end 0)))))
- (and (> (length calc-right-label) 0)
- (string-match (concat (regexp-quote calc-right-label) " *$") str)
- (setq str (concat (substring str 0 (match-beginning 0))
- (substring str (match-end 0)))))
- (if (string-match "\\\\[^ \n|]" str)
- (if (eq calc-language 'tex)
- (math-read-expr str)
- (let ((calc-language 'tex)
- (calc-language-option nil)
- (math-expr-opers (get 'tex 'math-oper-table))
- (math-expr-function-mapping (get 'tex 'math-function-table))
- (math-expr-variable-mapping (get 'tex 'math-variable-table)))
- (math-read-expr str)))
- (let ((lines nil)
- (pos 0)
- (width 0)
- (err-msg nil)
- the-baseline the-h2
- new-pos p)
- (while (setq new-pos (string-match "\n" str pos))
- (setq lines (cons (substring str pos new-pos) lines)
- pos (1+ new-pos)))
- (setq lines (nreverse (cons (substring str pos) lines))
- p lines)
- (while p
- (setq width (max width (length (car p)))
- p (cdr p)))
- (if (math-read-big-bigp lines)
- (or (catch 'syntax
- (math-read-big-rec 0 0 width (length lines)))
- err-msg
- '(error 0 "Syntax error"))
- (math-read-expr str)))))
-
-(defun math-read-big-bigp (lines)
- (and (cdr lines)
- (let ((matrix nil)
- (v 0)
- (height (if (> (length (car lines)) 0) 1 0)))
- (while (and (cdr lines)
- (let* ((i 0)
- j
- (l1 (car lines))
- (l2 (nth 1 lines))
- (len (min (length l1) (length l2))))
- (if (> (length l2) 0)
- (setq height (1+ height)))
- (while (and (< i len)
- (or (memq (aref l1 i) '(?\ ?\- ?\_))
- (memq (aref l2 i) '(?\ ?\-))
- (and (memq (aref l1 i) '(?\| ?\,))
- (= (aref l2 i) (aref l1 i)))
- (and (eq (aref l1 i) ?\[)
- (eq (aref l2 i) ?\[)
- (let ((h2 (length l1)))
- (setq j (math-read-big-balance
- (1+ i) v "[")))
- (setq i (1- j)))))
- (setq i (1+ i)))
- (or (= i len)
- (and (eq (aref l1 i) ?\[)
- (eq (aref l2 i) ?\[)
- (setq matrix t)
- nil))))
- (setq lines (cdr lines)
- v (1+ v)))
- (or (and (> height 1)
- (not (cdr lines)))
- matrix))))
-
-;;; Nontrivial "flat" formatting.
-
-(defvar math-format-hash-args nil)
-(defvar calc-can-abbrev-vectors nil)
-
-(defun math-format-flat-expr-fancy (a prec)
- (cond
- ((eq (car a) 'incomplete)
- (format "<incomplete %s>" (nth 1 a)))
- ((eq (car a) 'vec)
- (if (or calc-full-trail-vectors (not calc-can-abbrev-vectors)
- (< (length a) 7))
- (concat "[" (math-format-flat-vector (cdr a) ", "
- (if (cdr (cdr a)) 0 1000)) "]")
- (concat "["
- (math-format-flat-expr (nth 1 a) 0) ", "
- (math-format-flat-expr (nth 2 a) 0) ", "
- (math-format-flat-expr (nth 3 a) 0) ", ..., "
- (math-format-flat-expr (nth (1- (length a)) a) 0) "]")))
- ((eq (car a) 'intv)
- (concat (if (memq (nth 1 a) '(0 1)) "(" "[")
- (math-format-flat-expr (nth 2 a) 1000)
- " .. "
- (math-format-flat-expr (nth 3 a) 1000)
- (if (memq (nth 1 a) '(0 2)) ")" "]")))
- ((eq (car a) 'date)
- (concat "<" (math-format-date a) ">"))
- ((and (eq (car a) 'calcFunc-lambda) (> (length a) 2))
- (let ((p (cdr a))
- (ap calc-arg-values)
- (math-format-hash-args (if (= (length a) 3) 1 t)))
- (while (and (cdr p) (equal (car p) (car ap)))
- (setq p (cdr p) ap (cdr ap)))
- (concat "<"
- (if (cdr p)
- (concat (math-format-flat-vector
- (nreverse (cdr (reverse (cdr a)))) ", " 0)
- " : ")
- "")
- (math-format-flat-expr (nth (1- (length a)) a) 0)
- ">")))
- ((eq (car a) 'var)
- (or (and math-format-hash-args
- (let ((p calc-arg-values) (v 1))
- (while (and p (not (equal (car p) a)))
- (setq p (and (eq math-format-hash-args t) (cdr p))
- v (1+ v)))
- (and p
- (if (eq math-format-hash-args 1)
- "#"
- (format "#%d" v)))))
- (symbol-name (nth 1 a))))
- ((and (memq (car a) '(calcFunc-string calcFunc-bstring))
- (= (length a) 2)
- (math-vectorp (nth 1 a))
- (math-vector-is-string (nth 1 a)))
- (concat (substring (symbol-name (car a)) 9)
- "(" (math-vector-to-string (nth 1 a) t) ")"))
- (t
- (let ((op (math-assq2 (car a) math-standard-opers)))
- (cond ((and op (= (length a) 3))
- (if (> prec (min (nth 2 op) (nth 3 op)))
- (concat "(" (math-format-flat-expr a 0) ")")
- (let ((lhs (math-format-flat-expr (nth 1 a) (nth 2 op)))
- (rhs (math-format-flat-expr (nth 2 a) (nth 3 op))))
- (setq op (car op))
- (if (or (equal op "^") (equal op "_"))
- (if (= (aref lhs 0) ?-)
- (setq lhs (concat "(" lhs ")")))
- (setq op (concat " " op " ")))
- (concat lhs op rhs))))
- ((eq (car a) 'neg)
- (concat "-" (math-format-flat-expr (nth 1 a) 1000)))
- (t
- (concat (math-remove-dashes
- (if (string-match "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
- (symbol-name (car a)))
- (math-match-substring (symbol-name (car a)) 1)
- (symbol-name (car a))))
- "("
- (math-format-flat-vector (cdr a) ", " 0)
- ")")))))))
-
-(defun math-format-flat-vector (vec sep prec)
- (if vec
- (let ((buf (math-format-flat-expr (car vec) prec)))
- (while (setq vec (cdr vec))
- (setq buf (concat buf sep (math-format-flat-expr (car vec) prec))))
- buf)
- ""))
-
-(defun math-format-nice-expr (x w)
- (cond ((and (eq (car-safe x) 'vec)
- (cdr (cdr x))
- (let ((ops '(vec calcFunc-assign calcFunc-condition
- calcFunc-schedule calcFunc-iterations
- calcFunc-phase)))
- (or (memq (car-safe (nth 1 x)) ops)
- (memq (car-safe (nth 2 x)) ops)
- (memq (car-safe (nth 3 x)) ops)
- calc-break-vectors)))
- (concat "[ " (math-format-flat-vector (cdr x) ",\n " 0) " ]"))
- (t
- (let ((str (math-format-flat-expr x 0))
- (pos 0) p)
- (or (string-match "\"" str)
- (while (<= (setq p (+ pos w)) (length str))
- (while (and (> (setq p (1- p)) pos)
- (not (= (aref str p) ? ))))
- (if (> p (+ pos 5))
- (setq str (concat (substring str 0 p)
- "\n "
- (substring str p))
- pos (1+ p))
- (setq pos (+ pos w)))))
- str))))
-
-(defun math-assq2 (v a)
- (while (and a (not (eq v (nth 1 (car a)))))
- (setq a (cdr a)))
- (car a))
-
-(defun math-format-number-fancy (a prec)
- (cond
- ((eq (car a) 'float) ; non-decimal radix
- (if (Math-integer-negp (nth 1 a))
- (concat "-" (math-format-number (math-neg a)))
- (let ((str (if (and calc-radix-formatter
- (not (memq calc-language '(c pascal))))
- (funcall calc-radix-formatter
- calc-number-radix
- (math-format-radix-float a prec))
- (format "%d#%s" calc-number-radix
- (math-format-radix-float a prec)))))
- (if (and prec (> prec 191) (string-match "\\*" str))
- (concat "(" str ")")
- str))))
- ((eq (car a) 'frac)
- (setq a (math-adjust-fraction a))
- (if (> (length (car calc-frac-format)) 1)
- (if (Math-integer-negp (nth 1 a))
- (concat "-" (math-format-number (math-neg a)))
- (let ((q (math-idivmod (nth 1 a) (nth 2 a))))
- (concat (let ((calc-frac-format nil))
- (math-format-number (car q)))
- (substring (car calc-frac-format) 0 1)
- (let ((math-radix-explicit-format nil)
- (calc-frac-format nil))
- (math-format-number (cdr q)))
- (substring (car calc-frac-format) 1 2)
- (let ((math-radix-explicit-format nil)
- (calc-frac-format nil))
- (math-format-number (nth 2 a))))))
- (concat (let ((calc-frac-format nil))
- (math-format-number (nth 1 a)))
- (car calc-frac-format)
- (let ((math-radix-explicit-format nil)
- (calc-frac-format nil))
- (math-format-number (nth 2 a))))))
- ((eq (car a) 'cplx)
- (if (math-zerop (nth 2 a))
- (math-format-number (nth 1 a))
- (if (null calc-complex-format)
- (concat "(" (math-format-number (nth 1 a))
- ", " (math-format-number (nth 2 a)) ")")
- (if (math-zerop (nth 1 a))
- (if (math-equal-int (nth 2 a) 1)
- (symbol-name calc-complex-format)
- (if (math-equal-int (nth 2 a) -1)
- (concat "-" (symbol-name calc-complex-format))
- (if prec
- (math-compose-expr (list '* (nth 2 a) '(cplx 0 1)) prec)
- (concat (math-format-number (nth 2 a)) " "
- (symbol-name calc-complex-format)))))
- (if prec
- (math-compose-expr (list (if (math-negp (nth 2 a)) '- '+)
- (nth 1 a)
- (list 'cplx 0 (math-abs (nth 2 a))))
- prec)
- (concat (math-format-number (nth 1 a))
- (if (math-negp (nth 2 a)) " - " " + ")
- (math-format-number
- (list 'cplx 0 (math-abs (nth 2 a))))))))))
- ((eq (car a) 'polar)
- (concat "(" (math-format-number (nth 1 a))
- "; " (math-format-number (nth 2 a)) ")"))
- ((eq (car a) 'hms)
- (if (math-negp a)
- (concat "-" (math-format-number (math-neg a)))
- (let ((calc-number-radix 10)
- (calc-leading-zeros nil)
- (calc-group-digits nil))
- (format calc-hms-format
- (let ((calc-frac-format '(":" nil)))
- (math-format-number (nth 1 a)))
- (let ((calc-frac-format '(":" nil)))
- (math-format-number (nth 2 a)))
- (math-format-number (nth 3 a))))))
- ((eq (car a) 'intv)
- (concat (if (memq (nth 1 a) '(0 1)) "(" "[")
- (math-format-number (nth 2 a))
- " .. "
- (math-format-number (nth 3 a))
- (if (memq (nth 1 a) '(0 2)) ")" "]")))
- ((eq (car a) 'sdev)
- (concat (math-format-number (nth 1 a))
- " +/- "
- (math-format-number (nth 2 a))))
- ((eq (car a) 'vec)
- (math-format-flat-expr a 0))
- (t (format "%s" a))))
-
-(defun math-adjust-fraction (a)
- (if (nth 1 calc-frac-format)
- (progn
- (if (Math-integerp a) (setq a (list 'frac a 1)))
- (let ((g (math-quotient (nth 1 calc-frac-format)
- (math-gcd (nth 2 a)
- (nth 1 calc-frac-format)))))
- (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))
- a))
-
-(defun math-format-bignum-fancy (a) ; [X L]
- (let ((str (cond ((= calc-number-radix 10)
- (math-format-bignum-decimal a))
- ((= calc-number-radix 2)
- (math-format-bignum-binary a))
- ((= calc-number-radix 8)
- (math-format-bignum-octal a))
- ((= calc-number-radix 16)
- (math-format-bignum-hex a))
- (t (math-format-bignum-radix a)))))
- (if calc-leading-zeros
- (let* ((calc-internal-prec 6)
- (digs (math-compute-max-digits (math-abs calc-word-size)
- calc-number-radix))
- (len (length str)))
- (if (< len digs)
- (setq str (concat (make-string (- digs len) ?0) str)))))
- (if calc-group-digits
- (let ((i (length str))
- (g (if (integerp calc-group-digits)
- (math-abs calc-group-digits)
- (if (memq calc-number-radix '(2 16)) 4 3))))
- (while (> i g)
- (setq i (- i g)
- str (concat (substring str 0 i)
- calc-group-char
- (substring str i))))
- str))
- (if (and (/= calc-number-radix 10)
- math-radix-explicit-format)
- (if calc-radix-formatter
- (funcall calc-radix-formatter calc-number-radix str)
- (format "%d#%s" calc-number-radix str))
- str)))
-
-
-(defun math-group-float (str) ; [X X]
- (let* ((pt (or (string-match "[^0-9a-zA-Z]" str) (length str)))
- (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3))
- (i pt))
- (if (and (integerp calc-group-digits) (< calc-group-digits 0))
- (while (< (setq i (+ (1+ i) g)) (length str))
- (setq str (concat (substring str 0 i)
- calc-group-char
- (substring str i))
- i (+ i (1- (length calc-group-char))))))
- (setq i pt)
- (while (> i g)
- (setq i (- i g)
- str (concat (substring str 0 i)
- calc-group-char
- (substring str i))))
- str))
-
-;;; Users can redefine this in their .emacs files.
-(defvar calc-keypad-user-menu nil
- "If non-nil, this describes an additional menu for calc-keypad.
-It should contain a list of three rows.
-Each row should be a list of six keys.
-Each key should be a list of a label string, plus a Calc command name spec.
-A command spec is a command name symbol, a keyboard macro string, a
-list containing a numeric entry string, or nil.
-A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.")
-
-(run-hooks 'calc-ext-load-hook)
-
-;;; calc-ext.el ends here
+++ /dev/null
-;;; calc-fin.el --- financial functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-fin () nil)
-
-
-;;; Financial functions.
-
-(defun calc-fin-pv ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3)))
- (if (calc-is-inverse)
- (calc-enter-result 3 "pvb" (cons 'calcFunc-pvb (calc-top-list-n 3)))
- (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3)))))))
-
-(defun calc-fin-npv (arg)
- (interactive "p")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-vector-op "npvb" 'calcFunc-npvb (1+ arg))
- (calc-vector-op "npv" 'calcFunc-npv (1+ arg)))))
-
-(defun calc-fin-fv ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))
- (if (calc-is-inverse)
- (calc-enter-result 3 "fvb" (cons 'calcFunc-fvb (calc-top-list-n 3)))
- (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3)))))))
-
-(defun calc-fin-pmt ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))
- (if (calc-is-inverse)
- (calc-enter-result 3 "pmtb" (cons 'calcFunc-pmtb (calc-top-list-n 3)))
- (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3)))))))
-
-(defun calc-fin-nper ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-enter-result 3 "nprl" (cons 'calcFunc-nperl (calc-top-list-n 3)))
- (if (calc-is-inverse)
- (calc-enter-result 3 "nprb" (cons 'calcFunc-nperb
- (calc-top-list-n 3)))
- (calc-enter-result 3 "nper" (cons 'calcFunc-nper
- (calc-top-list-n 3)))))))
-
-(defun calc-fin-rate ()
- (interactive)
- (calc-slow-wrapper
- (calc-pop-push-record 3
- (if (calc-is-hyperbolic) "ratl"
- (if (calc-is-inverse) "ratb" "rate"))
- (calc-to-percentage
- (calc-normalize
- (cons (if (calc-is-hyperbolic) 'calcFunc-ratel
- (if (calc-is-hyperbolic) 'calcFunc-rateb
- 'calcFunc-rate))
- (calc-top-list-n 3)))))))
-
-(defun calc-fin-irr (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-vector-op "irrb" 'calcFunc-irrb arg)
- (calc-vector-op "irr" 'calcFunc-irr arg))))
-
-(defun calc-fin-sln ()
- (interactive)
- (calc-slow-wrapper
- (calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3)))))
-
-(defun calc-fin-syd ()
- (interactive)
- (calc-slow-wrapper
- (calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4)))))
-
-(defun calc-fin-ddb ()
- (interactive)
- (calc-slow-wrapper
- (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4)))))
-
-
-(defun calc-to-percentage (x)
- (cond ((Math-objectp x)
- (setq x (math-mul x 100))
- (if (Math-num-integerp x)
- (setq x (math-trunc x)))
- (list 'calcFunc-percent x))
- ((Math-vectorp x)
- (cons 'vec (mapcar 'calc-to-percentage (cdr x))))
- (t x)))
-
-(defun calc-convert-percent ()
- (interactive)
- (calc-slow-wrapper
- (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1)))))
-
-(defun calc-percent-change ()
- (interactive)
- (calc-slow-wrapper
- (let ((res (calc-normalize (cons 'calcFunc-relch (calc-top-list 2)))))
- (calc-pop-push-record 2 "%ch" (calc-to-percentage res)))))
-
-
-;;; Financial functions.
-
-(defun calcFunc-pv (rate num amount &optional lump)
- (math-check-financial rate num)
- (math-with-extra-prec 2
- (let ((p (math-pow (math-add 1 rate) num)))
- (math-add (math-mul amount
- (math-div (math-sub 1 (math-div 1 p))
- rate))
- (math-div (or lump 0) p)))))
-(put 'calcFunc-pv 'math-expandable t)
-
-(defun calcFunc-pvl (rate num amount)
- (calcFunc-pv rate num 0 amount))
-(put 'calcFunc-pvl 'math-expandable t)
-
-(defun calcFunc-pvb (rate num amount &optional lump)
- (math-check-financial rate num)
- (math-with-extra-prec 2
- (let* ((p (math-pow (math-add 1 rate) num)))
- (math-add (math-mul amount
- (math-div (math-mul (math-sub 1 (math-div 1 p))
- (math-add 1 rate))
- rate))
- (math-div (or lump 0) p)))))
-(put 'calcFunc-pvb 'math-expandable t)
-
-(defun calcFunc-npv (rate &rest flows)
- (math-check-financial rate 1)
- (math-with-extra-prec 2
- (let* ((flat (math-flatten-many-vecs flows))
- (pp (math-add 1 rate))
- (p pp)
- (accum 0))
- (while (setq flat (cdr flat))
- (setq accum (math-add accum (math-div (car flat) p))
- p (math-mul p pp)))
- accum)))
-(put 'calcFunc-npv 'math-expandable t)
-
-(defun calcFunc-npvb (rate &rest flows)
- (math-check-financial rate 1)
- (math-with-extra-prec 2
- (let* ((flat (math-flatten-many-vecs flows))
- (pp (math-add 1 rate))
- (p 1)
- (accum 0))
- (while (setq flat (cdr flat))
- (setq accum (math-add accum (math-div (car flat) p))
- p (math-mul p pp)))
- accum)))
-(put 'calcFunc-npvb 'math-expandable t)
-
-(defun calcFunc-fv (rate num amount &optional initial)
- (math-check-financial rate num)
- (math-with-extra-prec 2
- (let ((p (math-pow (math-add 1 rate) num)))
- (math-add (math-mul amount
- (math-div (math-sub p 1)
- rate))
- (math-mul (or initial 0) p)))))
-(put 'calcFunc-fv 'math-expandable t)
-
-(defun calcFunc-fvl (rate num amount)
- (calcFunc-fv rate num 0 amount))
-(put 'calcFunc-fvl 'math-expandable t)
-
-(defun calcFunc-fvb (rate num amount &optional initial)
- (math-check-financial rate num)
- (math-with-extra-prec 2
- (let ((p (math-pow (math-add 1 rate) num)))
- (math-add (math-mul amount
- (math-div (math-mul (math-sub p 1)
- (math-add 1 rate))
- rate))
- (math-mul (or initial 0) p)))))
-(put 'calcFunc-fvb 'math-expandable t)
-
-(defun calcFunc-pmt (rate num amount &optional lump)
- (math-check-financial rate num)
- (math-with-extra-prec 2
- (let ((p (math-pow (math-add 1 rate) num)))
- (math-div (math-mul (math-sub amount
- (math-div (or lump 0) p))
- rate)
- (math-sub 1 (math-div 1 p))))))
-(put 'calcFunc-pmt 'math-expandable t)
-
-(defun calcFunc-pmtb (rate num amount &optional lump)
- (math-check-financial rate num)
- (math-with-extra-prec 2
- (let ((p (math-pow (math-add 1 rate) num)))
- (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate)
- (math-mul (math-sub 1 (math-div 1 p))
- (math-add 1 rate))))))
-(put 'calcFunc-pmtb 'math-expandable t)
-
-(defun calcFunc-nper (rate pmt amount &optional lump)
- (math-compute-nper rate pmt amount lump nil))
-(put 'calcFunc-nper 'math-expandable t)
-
-(defun calcFunc-nperb (rate pmt amount &optional lump)
- (math-compute-nper rate pmt amount lump 'b))
-(put 'calcFunc-nperb 'math-expandable t)
-
-(defun calcFunc-nperl (rate pmt amount)
- (math-compute-nper rate pmt amount nil 'l))
-(put 'calcFunc-nperl 'math-expandable t)
-
-(defun math-compute-nper (rate pmt amount lump bflag)
- (and lump (math-zerop lump)
- (setq lump nil))
- (and lump (math-zerop pmt)
- (setq amount lump
- lump nil
- bflag 'l))
- (or (math-objectp rate) (and math-expand-formulas (null lump))
- (math-reject-arg rate 'numberp))
- (and (math-zerop rate)
- (math-reject-arg rate 'nonzerop))
- (or (math-objectp pmt) (and math-expand-formulas (null lump))
- (math-reject-arg pmt 'numberp))
- (or (math-objectp amount) (and math-expand-formulas (null lump))
- (math-reject-arg amount 'numberp))
- (if lump
- (progn
- (or (math-objectp lump)
- (math-reject-arg lump 'numberp))
- (let ((root (math-find-root (list 'calcFunc-eq
- (list (if bflag
- 'calcFunc-pvb
- 'calcFunc-pv)
- rate
- '(var DUMMY var-DUMMY)
- pmt
- lump)
- amount)
- '(var DUMMY var-DUMMY)
- '(intv 3 0 100)
- t)))
- (if (math-vectorp root)
- (nth 1 root)
- root)))
- (math-with-extra-prec 2
- (let ((temp (if (eq bflag 'l)
- (math-div amount pmt)
- (math-sub 1 (math-div (math-mul amount rate)
- (if bflag
- (math-mul pmt (math-add 1 rate))
- pmt))))))
- (if (or (math-posp temp) math-expand-formulas)
- (math-neg (calcFunc-log temp (math-add 1 rate)))
- (math-reject-arg pmt "*Payment too small to cover interest rate"))))))
-
-(defun calcFunc-rate (num pmt amount &optional lump)
- (math-compute-rate num pmt amount lump 'calcFunc-pv))
-
-(defun calcFunc-rateb (num pmt amount &optional lump)
- (math-compute-rate num pmt amount lump 'calcFunc-pvb))
-
-(defun math-compute-rate (num pmt amount lump func)
- (or (math-objectp num)
- (math-reject-arg num 'numberp))
- (or (math-objectp pmt)
- (math-reject-arg pmt 'numberp))
- (or (math-objectp amount)
- (math-reject-arg amount 'numberp))
- (or (null lump)
- (math-objectp lump)
- (math-reject-arg lump 'numberp))
- (let ((root (math-find-root (list 'calcFunc-eq
- (list func
- '(var DUMMY var-DUMMY)
- num
- pmt
- (or lump 0))
- amount)
- '(var DUMMY var-DUMMY)
- '(intv 3 (float 1 -4) 1)
- t)))
- (if (math-vectorp root)
- (nth 1 root)
- root)))
-
-(defun calcFunc-ratel (num pmt amount)
- (or (math-objectp num) math-expand-formulas
- (math-reject-arg num 'numberp))
- (or (math-objectp pmt) math-expand-formulas
- (math-reject-arg pmt 'numberp))
- (or (math-objectp amount) math-expand-formulas
- (math-reject-arg amount 'numberp))
- (math-with-extra-prec 2
- (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1)))
-
-(defun calcFunc-irr (&rest vecs)
- (math-compute-irr vecs 'calcFunc-npv))
-
-(defun calcFunc-irrb (&rest vecs)
- (math-compute-irr vecs 'calcFunc-npvb))
-
-(defun math-compute-irr (vecs func)
- (let* ((flat (math-flatten-many-vecs vecs))
- (root (math-find-root (list func
- '(var DUMMY var-DUMMY)
- flat)
- '(var DUMMY var-DUMMY)
- '(intv 3 (float 1 -4) 1)
- t)))
- (if (math-vectorp root)
- (nth 1 root)
- root)))
-
-(defun math-check-financial (rate num)
- (or (math-objectp rate) math-expand-formulas
- (math-reject-arg rate 'numberp))
- (and (math-zerop rate)
- (math-reject-arg rate 'nonzerop))
- (or (math-objectp num) math-expand-formulas
- (math-reject-arg num 'numberp)))
-
-
-(defun calcFunc-sln (cost salvage life &optional period)
- (or (math-realp cost) math-expand-formulas
- (math-reject-arg cost 'realp))
- (or (math-realp salvage) math-expand-formulas
- (math-reject-arg salvage 'realp))
- (or (math-realp life) math-expand-formulas
- (math-reject-arg life 'realp))
- (if (math-zerop life) (math-reject-arg life 'nonzerop))
- (if (and period
- (if (math-num-integerp period)
- (or (Math-lessp life period) (not (math-posp period)))
- (math-reject-arg period 'integerp)))
- 0
- (math-div (math-sub cost salvage) life)))
-(put 'calcFunc-sln 'math-expandable t)
-
-(defun calcFunc-syd (cost salvage life period)
- (or (math-realp cost) math-expand-formulas
- (math-reject-arg cost 'realp))
- (or (math-realp salvage) math-expand-formulas
- (math-reject-arg salvage 'realp))
- (or (math-realp life) math-expand-formulas
- (math-reject-arg life 'realp))
- (if (math-zerop life) (math-reject-arg life 'nonzerop))
- (or (math-realp period) math-expand-formulas
- (math-reject-arg period 'realp))
- (if (or (Math-lessp life period) (not (math-posp period)))
- 0
- (math-div (math-mul (math-sub cost salvage)
- (math-add (math-sub life period) 1))
- (math-div (math-mul life (math-add life 1)) 2))))
-(put 'calcFunc-syd 'math-expandable t)
-
-(defun calcFunc-ddb (cost salvage life period)
- (if (math-messy-integerp period) (setq period (math-trunc period)))
- (or (integerp period) (math-reject-arg period 'fixnump))
- (or (math-realp cost) (math-reject-arg cost 'realp))
- (or (math-realp salvage) (math-reject-arg salvage 'realp))
- (or (math-realp life) (math-reject-arg life 'realp))
- (if (math-zerop life) (math-reject-arg life 'nonzerop))
- (if (or (Math-lessp life period) (<= period 0))
- 0
- (let ((book cost)
- (res 0))
- (while (>= (setq period (1- period)) 0)
- (setq res (math-div (math-mul book 2) life)
- book (math-sub book res))
- (if (Math-lessp book salvage)
- (setq res (math-add res (math-sub book salvage))
- book salvage)))
- res)))
-
-;;; calc-fin.el ends here
+++ /dev/null
-;;; calc-forms.el --- data format conversion functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-forms () nil)
-
-
-(defun calc-time ()
- (interactive)
- (calc-wrapper
- (let ((time (current-time-string)))
- (calc-enter-result 0 "time"
- (list 'mod
- (list 'hms
- (string-to-int (substring time 11 13))
- (string-to-int (substring time 14 16))
- (string-to-int (substring time 17 19)))
- (list 'hms 24 0 0))))))
-
-(defun calc-to-hms (arg)
- (interactive "P")
- (calc-wrapper
- (if (calc-is-inverse)
- (if (eq calc-angle-mode 'rad)
- (calc-unary-op ">rad" 'calcFunc-rad arg)
- (calc-unary-op ">deg" 'calcFunc-deg arg))
- (calc-unary-op ">hms" 'calcFunc-hms arg))))
-
-(defun calc-from-hms (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-to-hms arg))
-
-
-(defun calc-hms-notation (fmt)
- (interactive "sHours-minutes-seconds format (hms, @ ' \", etc.): ")
- (calc-wrapper
- (if (string-match "\\`\\([^,; ]+\\)\\([,; ]*\\)\\([^,; ]\\)\\([,; ]*\\)\\([^,; ]\\)\\'" fmt)
- (progn
- (calc-change-mode 'calc-hms-format
- (concat "%s" (math-match-substring fmt 1)
- (math-match-substring fmt 2)
- "%s" (math-match-substring fmt 3)
- (math-match-substring fmt 4)
- "%s" (math-match-substring fmt 5))
- t)
- (setq-default calc-hms-format calc-hms-format)) ; for minibuffer
- (error "Bad hours-minutes-seconds format"))))
-
-(defun calc-date-notation (fmt arg)
- (interactive "sDate format (e.g., M/D/YY h:mm:ss): \nP")
- (calc-wrapper
- (if (equal fmt "")
- (setq fmt "1"))
- (if (string-match "\\` *[0-9] *\\'" fmt)
- (setq fmt (nth (string-to-int fmt) calc-standard-date-formats)))
- (or (string-match "[a-zA-Z]" fmt)
- (error "Bad date format specifier"))
- (and arg
- (>= (setq arg (prefix-numeric-value arg)) 0)
- (<= arg 9)
- (setq calc-standard-date-formats
- (copy-sequence calc-standard-date-formats))
- (setcar (nthcdr arg calc-standard-date-formats) fmt))
- (let ((case-fold-search nil))
- (and (not (string-match "<.*>" fmt))
- (string-match "\\`[^hHspP]*\\([^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*[bBhHmpPsS]+[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*\\)[^hHspP]*\\'" fmt)
- (string-match (concat "[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*"
- (regexp-quote (math-match-substring fmt 1))
- "[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*") fmt)
- (setq fmt (concat (substring fmt 0 (match-beginning 0))
- "<"
- (substring fmt (match-beginning 0) (match-end 0))
- ">"
- (substring fmt (match-end 0))))))
- (let ((lfmt nil)
- (fullfmt nil)
- (time nil)
- pos pos2 sym temp)
- (let ((case-fold-search nil))
- (and (setq temp (string-match ":[BS]S" fmt))
- (aset fmt temp ?C)))
- (while (setq pos (string-match "[<>a-zA-Z]" fmt))
- (if (> pos 0)
- (setq lfmt (cons (substring fmt 0 pos) lfmt)))
- (setq pos2 (1+ pos))
- (cond ((= (aref fmt pos) ?\<)
- (and time (error "Nested <'s not allowed"))
- (and lfmt (setq fullfmt (nconc lfmt fullfmt)
- lfmt nil))
- (setq time t))
- ((= (aref fmt pos) ?\>)
- (or time (error "Misplaced > in format"))
- (and lfmt (setq fullfmt (cons (nreverse lfmt) fullfmt)
- lfmt nil))
- (setq time nil))
- (t
- (if (string-match "\\`[^a-zA-Z]*[bB][a-zA-Z]" fmt)
- (setq pos2 (1+ pos2)))
- (while (and (< pos2 (length fmt))
- (= (upcase (aref fmt pos2))
- (upcase (aref fmt (1- pos2)))))
- (setq pos2 (1+ pos2)))
- (setq sym (intern (substring fmt pos pos2)))
- (or (memq sym '(Y YY BY YYY YYYY
- aa AA aaa AAA aaaa AAAA
- bb BB bbb BBB bbbb BBBB
- M MM BM mmm Mmm Mmmm MMM MMMM
- D DD BD d ddd bdd
- W www Www Wwww WWW WWWW
- h hh bh H HH BH
- p P pp PP pppp PPPP
- m mm bm s ss bss SS BS C
- N n J j U b))
- (and (eq sym 'X) (not lfmt) (not fullfmt))
- (error "Bad format code: %s" sym))
- (and (memq sym '(bb BB bbb BBB bbbb BBBB))
- (setq lfmt (cons 'b lfmt)))
- (setq lfmt (cons sym lfmt))))
- (setq fmt (substring fmt pos2)))
- (or (equal fmt "")
- (setq lfmt (cons fmt lfmt)))
- (and lfmt (if time
- (setq fullfmt (cons (nreverse lfmt) fullfmt))
- (setq fullfmt (nconc lfmt fullfmt))))
- (calc-change-mode 'calc-date-format (nreverse fullfmt) t))))
-
-
-(defun calc-hms-mode ()
- (interactive)
- (calc-wrapper
- (calc-change-mode 'calc-angle-mode 'hms)
- (message "Angles measured in degrees-minutes-seconds")))
-
-
-(defun calc-now (arg)
- (interactive "P")
- (calc-date-zero-args "now" 'calcFunc-now arg))
-
-(defun calc-date-part (arg)
- (interactive "NPart code (1-9 = Y,M,D,H,M,S,Wd,Yd,Hms): ")
- (if (or (< arg 1) (> arg 9))
- (error "Part code out of range"))
- (calc-wrapper
- (calc-enter-result 1
- (nth arg '(nil "year" "mnth" "day" "hour" "minu"
- "sec" "wday" "yday" "hmst"))
- (list (nth arg '(nil calcFunc-year calcFunc-month
- calcFunc-day calcFunc-hour
- calcFunc-minute calcFunc-second
- calcFunc-weekday calcFunc-yearday
- calcFunc-time))
- (calc-top-n 1)))))
-
-(defun calc-date (arg)
- (interactive "p")
- (if (or (< arg 1) (> arg 6))
- (error "Between one and six arguments are allowed"))
- (calc-wrapper
- (calc-enter-result arg "date" (cons 'calcFunc-date (calc-top-list-n arg)))))
-
-(defun calc-julian (arg)
- (interactive "P")
- (calc-date-one-arg "juln" 'calcFunc-julian arg))
-
-(defun calc-unix-time (arg)
- (interactive "P")
- (calc-date-one-arg "unix" 'calcFunc-unixtime arg))
-
-(defun calc-time-zone (arg)
- (interactive "P")
- (calc-date-zero-args "zone" 'calcFunc-tzone arg))
-
-(defun calc-convert-time-zones (old &optional new)
- (interactive "sFrom time zone: ")
- (calc-wrapper
- (if (equal old "$")
- (calc-enter-result 3 "tzcv" (cons 'calcFunc-tzconv (calc-top-list-n 3)))
- (if (equal old "") (setq old "local"))
- (or new
- (setq new (read-string (concat "From time zone: " old
- ", to zone: "))))
- (if (stringp old) (setq old (math-read-expr old)))
- (if (eq (car-safe old) 'error)
- (error "Error in expression: " (nth 1 old)))
- (if (equal new "") (setq new "local"))
- (if (stringp new) (setq new (math-read-expr new)))
- (if (eq (car-safe new) 'error)
- (error "Error in expression: " (nth 1 new)))
- (calc-enter-result 1 "tzcv" (list 'calcFunc-tzconv
- (calc-top-n 1) old new)))))
-
-(defun calc-new-week (arg)
- (interactive "P")
- (calc-date-one-arg "nwwk" 'calcFunc-newweek arg))
-
-(defun calc-new-month (arg)
- (interactive "P")
- (calc-date-one-arg "nwmn" 'calcFunc-newmonth arg))
-
-(defun calc-new-year (arg)
- (interactive "P")
- (calc-date-one-arg "nwyr" 'calcFunc-newyear arg))
-
-(defun calc-inc-month (arg)
- (interactive "p")
- (calc-date-one-arg "incm" 'calcFunc-incmonth arg))
-
-(defun calc-business-days-plus (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "bus+" 'calcFunc-badd arg)))
-
-(defun calc-business-days-minus (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "bus-" 'calcFunc-bsub arg)))
-
-(defun calc-date-zero-args (prefix func arg)
- (calc-wrapper
- (if (consp arg)
- (calc-enter-result 1 prefix (list func (calc-top-n 1)))
- (calc-enter-result 0 prefix (if arg
- (list func (prefix-numeric-value arg))
- (list func))))))
-
-(defun calc-date-one-arg (prefix func arg)
- (calc-wrapper
- (if (consp arg)
- (calc-enter-result 2 prefix (cons func (calc-top-list-n 2)))
- (calc-enter-result 1 prefix (if arg
- (list func (calc-top-n 1)
- (prefix-numeric-value arg))
- (list func (calc-top-n 1)))))))
-
-
-;;;; Hours-minutes-seconds forms.
-
-(defun math-normalize-hms (a)
- (let ((h (math-normalize (nth 1 a)))
- (m (math-normalize (nth 2 a)))
- (s (let ((calc-internal-prec (max (- calc-internal-prec 4) 3)))
- (math-normalize (nth 3 a)))))
- (if (math-negp h)
- (progn
- (if (math-posp s)
- (setq s (math-add s -60)
- m (math-add m 1)))
- (if (math-posp m)
- (setq m (math-add m -60)
- h (math-add h 1)))
- (if (not (Math-lessp -60 s))
- (setq s (math-add s 60)
- m (math-add m -1)))
- (if (not (Math-lessp -60 m))
- (setq m (math-add m 60)
- h (math-add h -1))))
- (if (math-negp s)
- (setq s (math-add s 60)
- m (math-add m -1)))
- (if (math-negp m)
- (setq m (math-add m 60)
- h (math-add h -1)))
- (if (not (Math-lessp s 60))
- (setq s (math-add s -60)
- m (math-add m 1)))
- (if (not (Math-lessp m 60))
- (setq m (math-add m -60)
- h (math-add h 1))))
- (if (and (eq (car-safe s) 'float)
- (<= (+ (math-numdigs (nth 1 s)) (nth 2 s))
- (- 2 calc-internal-prec)))
- (setq s 0))
- (list 'hms h m s)))
-
-;;; Convert A from ANG or current angular mode to HMS format.
-(defun math-to-hms (a &optional ang) ; [X R] [Public]
- (cond ((eq (car-safe a) 'hms) a)
- ((eq (car-safe a) 'sdev)
- (math-make-sdev (math-to-hms (nth 1 a))
- (math-to-hms (nth 2 a))))
- ((not (Math-numberp a))
- (list 'calcFunc-hms a))
- ((math-negp a)
- (math-neg (math-to-hms (math-neg a) ang)))
- ((eq (or ang calc-angle-mode) 'rad)
- (math-to-hms (math-div a (math-pi-over-180)) 'deg))
- ((memq (car-safe a) '(cplx polar)) a)
- (t
- ;(setq a (let ((calc-internal-prec (max (1- calc-internal-prec) 3)))
- ; (math-normalize a)))
- (math-normalize
- (let* ((b (math-mul a 3600))
- (hm (math-trunc (math-div b 60)))
- (hmd (math-idivmod hm 60)))
- (list 'hms
- (car hmd)
- (cdr hmd)
- (math-sub b (math-mul hm 60))))))))
-(defun calcFunc-hms (h &optional m s)
- (or (Math-realp h) (math-reject-arg h 'realp))
- (or m (setq m 0))
- (or (Math-realp m) (math-reject-arg m 'realp))
- (or s (setq s 0))
- (or (Math-realp s) (math-reject-arg s 'realp))
- (if (and (not (Math-lessp m 0)) (Math-lessp m 60)
- (not (Math-lessp s 0)) (Math-lessp s 60))
- (math-add (math-to-hms h)
- (list 'hms 0 m s))
- (math-to-hms (math-add h
- (math-add (math-div (or m 0) 60)
- (math-div (or s 0) 3600)))
- 'deg)))
-
-;;; Convert A from HMS format to ANG or current angular mode.
-(defun math-from-hms (a &optional ang) ; [R X] [Public]
- (cond ((not (eq (car-safe a) 'hms))
- (if (Math-numberp a)
- a
- (if (eq (car-safe a) 'sdev)
- (math-make-sdev (math-from-hms (nth 1 a) ang)
- (math-from-hms (nth 2 a) ang))
- (if (eq (or ang calc-angle-mode) 'rad)
- (list 'calcFunc-rad a)
- (list 'calcFunc-deg a)))))
- ((math-negp a)
- (math-neg (math-from-hms (math-neg a) ang)))
- ((eq (or ang calc-angle-mode) 'rad)
- (math-mul (math-from-hms a 'deg) (math-pi-over-180)))
- (t
- (math-add (math-div (math-add (math-div (nth 3 a)
- '(float 6 1))
- (nth 2 a))
- 60)
- (nth 1 a)))))
-
-;;;; Date forms.
-
-
-;;; Some of these functions are adapted from Edward Reingold's "calendar.el".
-;;; These versions are rewritten to use arbitrary-size integers.
-;;; The Julian calendar is used up to 9/2/1752, after which the Gregorian
-;;; calendar is used; the first day after 9/2/1752 is 9/14/1752.
-
-;;; A numerical date is the number of days since midnight on
-;;; the morning of January 1, 1 A.D. If the date is a non-integer,
-;;; it represents a specific date and time.
-;;; A "dt" is a list of the form, (year month day), corresponding to
-;;; an integer code, or (year month day hour minute second), corresponding
-;;; to a non-integer code.
-
-(defun math-date-to-dt (value)
- (if (eq (car-safe value) 'date)
- (setq value (nth 1 value)))
- (or (math-realp value)
- (math-reject-arg value 'datep))
- (let* ((parts (math-date-parts value))
- (date (car parts))
- (time (nth 1 parts))
- (month 1)
- day
- (year (math-quotient (math-add date (if (Math-lessp date 711859)
- 365 ; for speed, we take
- -108)) ; >1950 as a special case
- (if (math-negp value) 366 365)))
- ; this result may be an overestimate
- temp)
- (while (Math-lessp date (setq temp (math-absolute-from-date year 1 1)))
- (setq year (math-add year -1)))
- (if (eq year 0) (setq year -1))
- (setq date (1+ (math-sub date temp)))
- (and (eq year 1752) (>= date 247)
- (setq date (+ date 11)))
- (setq temp (if (math-leap-year-p year)
- [1 32 61 92 122 153 183 214 245 275 306 336 999]
- [1 32 60 91 121 152 182 213 244 274 305 335 999]))
- (while (>= date (aref temp month))
- (setq month (1+ month)))
- (setq day (1+ (- date (aref temp (1- month)))))
- (if (math-integerp value)
- (list year month day)
- (list year month day
- (/ time 3600)
- (% (/ time 60) 60)
- (math-add (% time 60) (nth 2 parts))))))
-
-(defun math-dt-to-date (dt)
- (or (integerp (nth 1 dt))
- (math-reject-arg (nth 1 dt) 'fixnump))
- (if (or (< (nth 1 dt) 1) (> (nth 1 dt) 12))
- (math-reject-arg (nth 1 dt) "Month value is out of range"))
- (or (integerp (nth 2 dt))
- (math-reject-arg (nth 2 dt) 'fixnump))
- (if (or (< (nth 2 dt) 1) (> (nth 2 dt) 31))
- (math-reject-arg (nth 2 dt) "Day value is out of range"))
- (let ((date (math-absolute-from-date (car dt) (nth 1 dt) (nth 2 dt))))
- (if (nth 3 dt)
- (math-add (math-float date)
- (math-div (math-add (+ (* (nth 3 dt) 3600)
- (* (nth 4 dt) 60))
- (nth 5 dt))
- '(float 864 2)))
- date)))
-
-(defun math-date-parts (value &optional offset)
- (let* ((date (math-floor value))
- (time (math-round (math-mul (math-sub value (or offset date)) 86400)
- (and (> calc-internal-prec 12)
- (- calc-internal-prec 12))))
- (ftime (math-floor time)))
- (list date
- ftime
- (math-sub time ftime))))
-
-
-(defun math-this-year ()
- (string-to-int (substring (current-time-string) -4)))
-
-(defun math-leap-year-p (year)
- (if (Math-lessp year 1752)
- (if (math-negp year)
- (= (math-imod (math-neg year) 4) 1)
- (= (math-imod year 4) 0))
- (setq year (math-imod year 400))
- (or (and (= (% year 4) 0) (/= (% year 100) 0))
- (= year 0))))
-
-(defun math-days-in-month (year month)
- (if (and (= month 2) (math-leap-year-p year))
- 29
- (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
-
-(defun math-day-number (year month day)
- (let ((day-of-year (+ day (* 31 (1- month)))))
- (if (> month 2)
- (progn
- (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
- (if (math-leap-year-p year)
- (setq day-of-year (1+ day-of-year)))))
- (and (eq year 1752)
- (or (> month 9)
- (and (= month 9) (>= day 14)))
- (setq day-of-year (- day-of-year 11)))
- day-of-year))
-
-(defun math-absolute-from-date (year month day)
- (if (eq year 0) (setq year -1))
- (let ((yearm1 (math-sub year 1)))
- (math-sub (math-add (math-day-number year month day)
- (math-add (math-mul 365 yearm1)
- (if (math-posp year)
- (math-quotient yearm1 4)
- (math-sub 365
- (math-quotient (math-sub 3 year)
- 4)))))
- (if (or (Math-lessp year 1753)
- (and (eq year 1752) (<= month 9)))
- 1
- (let ((correction (math-mul (math-quotient yearm1 100) 3)))
- (let ((res (math-idivmod correction 4)))
- (math-add (if (= (cdr res) 0)
- -1
- 0)
- (car res))))))))
-
-
-;;; It is safe to redefine these in your .emacs file to use a different
-;;; language.
-
-(defvar math-long-weekday-names '( "Sunday" "Monday" "Tuesday" "Wednesday"
- "Thursday" "Friday" "Saturday" ))
-(defvar math-short-weekday-names '( "Sun" "Mon" "Tue" "Wed"
- "Thu" "Fri" "Sat" ))
-
-(defvar math-long-month-names '( "January" "February" "March" "April"
- "May" "June" "July" "August"
- "September" "October" "November" "December" ))
-(defvar math-short-month-names '( "Jan" "Feb" "Mar" "Apr" "May" "Jun"
- "Jul" "Aug" "Sep" "Oct" "Nov" "Dec" ))
-
-
-(defvar math-format-date-cache nil)
-(defun math-format-date (date)
- (if (eq (car-safe date) 'date)
- (setq date (nth 1 date)))
- (let ((entry (list date calc-internal-prec calc-date-format)))
- (or (cdr (assoc entry math-format-date-cache))
- (let* ((dt nil)
- (calc-group-digits nil)
- (calc-leading-zeros nil)
- (calc-number-radix 10)
- year month day weekday hour minute second
- (bc-flag nil)
- (fmt (apply 'concat (mapcar 'math-format-date-part
- calc-date-format))))
- (setq math-format-date-cache (cons (cons entry fmt)
- math-format-date-cache))
- (and (setq dt (nthcdr 10 math-format-date-cache))
- (setcdr dt nil))
- fmt))))
-
-(defun math-format-date-part (x)
- (cond ((stringp x)
- x)
- ((listp x)
- (if (math-integerp date)
- ""
- (apply 'concat (mapcar 'math-format-date-part x))))
- ((eq x 'X)
- "")
- ((eq x 'N)
- (math-format-number date))
- ((eq x 'n)
- (math-format-number (math-floor date)))
- ((eq x 'J)
- (math-format-number (math-add date '(float (bigpos 235 214 17) -1))))
- ((eq x 'j)
- (math-format-number (math-add (math-floor date) '(bigpos 424 721 1))))
- ((eq x 'U)
- (math-format-number (nth 1 (math-date-parts date 719164))))
- ((progn
- (or dt
- (progn
- (setq dt (math-date-to-dt date)
- year (car dt)
- month (nth 1 dt)
- day (nth 2 dt)
- weekday (math-mod (math-add (math-floor date) 6) 7)
- hour (nth 3 dt)
- minute (nth 4 dt)
- second (nth 5 dt))
- (and (memq 'b calc-date-format)
- (math-negp year)
- (setq year (math-neg year)
- bc-flag t))))
- (memq x '(Y YY BY)))
- (if (and (integerp year) (> year 1940) (< year 2040))
- (format (cond ((eq x 'YY) "%02d")
- ((eq x 'BYY) "%2d")
- (t "%d"))
- (% year 100))
- (if (and (natnump year) (< year 100))
- (format "+%d" year)
- (math-format-number year))))
- ((eq x 'YYY)
- (math-format-number year))
- ((eq x 'YYYY)
- (if (and (natnump year) (< year 100))
- (format "+%d" year)
- (math-format-number year)))
- ((eq x 'b) "")
- ((eq x 'aa)
- (and (not bc-flag) "ad"))
- ((eq x 'AA)
- (and (not bc-flag) "AD"))
- ((eq x 'aaa)
- (and (not bc-flag) "ad "))
- ((eq x 'AAA)
- (and (not bc-flag) "AD "))
- ((eq x 'aaaa)
- (and (not bc-flag) "a.d."))
- ((eq x 'AAAA)
- (and (not bc-flag) "A.D."))
- ((eq x 'bb)
- (and bc-flag "bc"))
- ((eq x 'BB)
- (and bc-flag "BC"))
- ((eq x 'bbb)
- (and bc-flag " bc"))
- ((eq x 'BBB)
- (and bc-flag " BC"))
- ((eq x 'bbbb)
- (and bc-flag "b.c."))
- ((eq x 'BBBB)
- (and bc-flag "B.C."))
- ((eq x 'M)
- (format "%d" month))
- ((eq x 'MM)
- (format "%02d" month))
- ((eq x 'BM)
- (format "%2d" month))
- ((eq x 'mmm)
- (downcase (nth (1- month) math-short-month-names)))
- ((eq x 'Mmm)
- (nth (1- month) math-short-month-names))
- ((eq x 'MMM)
- (upcase (nth (1- month) math-short-month-names)))
- ((eq x 'Mmmm)
- (nth (1- month) math-long-month-names))
- ((eq x 'MMMM)
- (upcase (nth (1- month) math-long-month-names)))
- ((eq x 'D)
- (format "%d" day))
- ((eq x 'DD)
- (format "%02d" day))
- ((eq x 'BD)
- (format "%2d" day))
- ((eq x 'W)
- (format "%d" weekday))
- ((eq x 'www)
- (downcase (nth weekday math-short-weekday-names)))
- ((eq x 'Www)
- (nth weekday math-short-weekday-names))
- ((eq x 'WWW)
- (upcase (nth weekday math-short-weekday-names)))
- ((eq x 'Wwww)
- (nth weekday math-long-weekday-names))
- ((eq x 'WWWW)
- (upcase (nth weekday math-long-weekday-names)))
- ((eq x 'd)
- (format "%d" (math-day-number year month day)))
- ((eq x 'ddd)
- (format "%03d" (math-day-number year month day)))
- ((eq x 'bdd)
- (format "%3d" (math-day-number year month day)))
- ((eq x 'h)
- (and hour (format "%d" hour)))
- ((eq x 'hh)
- (and hour (format "%02d" hour)))
- ((eq x 'bh)
- (and hour (format "%2d" hour)))
- ((eq x 'H)
- (and hour (format "%d" (1+ (% (+ hour 11) 12)))))
- ((eq x 'HH)
- (and hour (format "%02d" (1+ (% (+ hour 11) 12)))))
- ((eq x 'BH)
- (and hour (format "%2d" (1+ (% (+ hour 11) 12)))))
- ((eq x 'p)
- (and hour (if (< hour 12) "a" "p")))
- ((eq x 'P)
- (and hour (if (< hour 12) "A" "P")))
- ((eq x 'pp)
- (and hour (if (< hour 12) "am" "pm")))
- ((eq x 'PP)
- (and hour (if (< hour 12) "AM" "PM")))
- ((eq x 'pppp)
- (and hour (if (< hour 12) "a.m." "p.m.")))
- ((eq x 'PPPP)
- (and hour (if (< hour 12) "A.M." "P.M.")))
- ((eq x 'm)
- (and minute (format "%d" minute)))
- ((eq x 'mm)
- (and minute (format "%02d" minute)))
- ((eq x 'bm)
- (and minute (format "%2d" minute)))
- ((eq x 'C)
- (and second (not (math-zerop second))
- ":"))
- ((memq x '(s ss bs SS BS))
- (and second
- (not (and (memq x '(SS BS)) (math-zerop second)))
- (if (integerp second)
- (format (cond ((memq x '(ss SS)) "%02d")
- ((memq x '(bs BS)) "%2d")
- (t "%d"))
- second)
- (concat (if (Math-lessp second 10)
- (cond ((memq x '(ss SS)) "0")
- ((memq x '(bs BS)) " ")
- (t ""))
- "")
- (let ((calc-float-format
- (list 'fix (min (- 12 calc-internal-prec)
- 0))))
- (math-format-number second))))))))
-
-
-(defun math-parse-date (str)
- (catch 'syntax
- (or (math-parse-standard-date str t)
- (math-parse-standard-date str nil)
- (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" str)
- (list 'date (math-read-number (math-match-substring str 1))))
- (let ((case-fold-search t)
- (year nil) (month nil) (day nil) (weekday nil)
- (hour nil) (minute nil) (second nil) (bc-flag nil)
- (a nil) (b nil) (c nil) (bigyear nil) temp)
-
- ;; Extract the time, if any.
- (if (or (string-match "\\([0-9][0-9]?\\):\\([0-9][0-9]?\\)\\(:\\([0-9][0-9]?\\(\\.[0-9]+\\)?\\)\\)? *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)?" str)
- (string-match "\\([0-9][0-9]?\\)\\(\\)\\(\\(\\(\\)\\)\\) *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)" str))
- (let ((ampm (math-match-substring str 6)))
- (setq hour (string-to-int (math-match-substring str 1))
- minute (math-match-substring str 2)
- second (math-match-substring str 4)
- str (concat (substring str 0 (match-beginning 0))
- (substring str (match-end 0))))
- (if (equal minute "")
- (setq minute 0)
- (setq minute (string-to-int minute)))
- (if (equal second "")
- (setq second 0)
- (setq second (math-read-number second)))
- (if (equal ampm "")
- (if (> hour 23)
- (throw 'syntax "Hour value out of range"))
- (setq ampm (upcase (aref ampm 0)))
- (if (memq ampm '(?N ?M))
- (if (and (= hour 12) (= minute 0) (eq second 0))
- (if (eq ampm ?M) (setq hour 0))
- (throw 'syntax
- "Time must be 12:00:00 in this context"))
- (if (or (= hour 0) (> hour 12))
- (throw 'syntax "Hour value out of range"))
- (if (eq (= ampm ?A) (= hour 12))
- (setq hour (% (+ hour 12) 24)))))))
-
- ;; Rewrite xx-yy-zz to xx/yy/zz to avoid seeing "-" as a minus sign.
- (while (string-match "[0-9a-zA-Z]\\(-\\)[0-9a-zA-Z]" str)
- (progn
- (setq str (copy-sequence str))
- (aset str (match-beginning 1) ?\/)))
-
- ;; Extract obvious month or weekday names.
- (if (string-match "[a-zA-Z]" str)
- (progn
- (setq month (math-parse-date-word math-long-month-names))
- (setq weekday (math-parse-date-word math-long-weekday-names))
- (or month (setq month
- (math-parse-date-word math-short-month-names)))
- (or weekday (math-parse-date-word math-short-weekday-names))
- (or hour
- (if (setq temp (math-parse-date-word
- '( "noon" "midnight" "mid" )))
- (setq hour (if (= temp 1) 12 0) minute 0 second 0)))
- (or (math-parse-date-word '( "ad" "a.d." ))
- (if (math-parse-date-word '( "bc" "b.c." ))
- (setq bc-flag t)))
- (if (string-match "[a-zA-Z]+" str)
- (throw 'syntax (format "Bad word in date: \"%s\""
- (math-match-substring str 0))))))
-
- ;; If there is a huge number other than the year, ignore it.
- (while (and (string-match "[-+]?0*[1-9][0-9][0-9][0-9][0-9]+" str)
- (setq temp (concat (substring str 0 (match-beginning 0))
- (substring str (match-end 0))))
- (string-match "[4-9][0-9]\\|[0-9][0-9][0-9]\\|[-+][0-9]+[^-]*\\'" temp))
- (setq str temp))
-
- ;; If there is a number with a sign or a large number, it is a year.
- (if (or (string-match "\\([-+][0-9]+\\)[^-]*\\'" str)
- (string-match "\\(0*[1-9][0-9][0-9]+\\)" str))
- (setq year (math-match-substring str 1)
- str (concat (substring str 0 (match-beginning 1))
- (substring str (match-end 1)))
- year (math-read-number year)
- bigyear t))
-
- ;; Collect remaining numbers.
- (setq temp 0)
- (while (string-match "[0-9]+" str temp)
- (and c (throw 'syntax "Too many numbers in date"))
- (setq c (string-to-int (math-match-substring str 0)))
- (or b (setq b c c nil))
- (or a (setq a b b nil))
- (setq temp (match-end 0)))
-
- ;; Check that we have the right amount of information.
- (setq temp (+ (if year 1 0) (if month 1 0) (if day 1 0)
- (if a 1 0) (if b 1 0) (if c 1 0)))
- (if (> temp 3)
- (throw 'syntax "Too many numbers in date")
- (if (or (< temp 2) (and year (= temp 2)))
- (throw 'syntax "Not enough numbers in date")
- (if (= temp 2) ; if year omitted, assume current year
- (setq year (math-this-year)))))
-
- ;; A large number must be a year.
- (or year
- (if (and a (or (> a 31) (< a 1)))
- (setq year a a b b c c nil)
- (if (and b (or (> b 31) (< b 1)))
- (setq year b b c c nil)
- (if (and c (or (> c 31) (< c 1)))
- (setq year c c nil)))))
-
- ;; A medium-large number must be a day.
- (if year
- (if (and a (> a 12))
- (setq day a a b b c c nil)
- (if (and b (> b 12))
- (setq day b b c c nil)
- (if (and c (> c 12))
- (setq day c c nil)))))
-
- ;; We may know enough to sort it out now.
- (if (and year day)
- (or month (setq month a))
- (if (and year month)
- (setq day a)
-
- ;; Interpret order of numbers as same as for display format.
- (setq temp calc-date-format)
- (while temp
- (cond ((not (symbolp (car temp))))
- ((memq (car temp) '(Y YY BY YYY YYYY))
- (or year (setq year a a b b c)))
- ((memq (car temp) '(M MM BM mmm Mmm Mmmm MMM MMMM))
- (or month (setq month a a b b c)))
- ((memq (car temp) '(D DD BD))
- (or day (setq day a a b b c))))
- (setq temp (cdr temp)))
-
- ;; If display format was not complete, assume American style.
- (or month (setq month a a b b c))
- (or day (setq day a a b b c))
- (or year (setq year a a b b c))))
-
- (if bc-flag
- (setq year (math-neg (math-abs year))))
-
- (math-parse-date-validate year bigyear month day
- hour minute second)))))
-
-(defun math-parse-date-validate (year bigyear month day hour minute second)
- (and (not bigyear) (natnump year) (< year 100)
- (setq year (+ year (if (< year 40) 2000 1900))))
- (if (eq year 0)
- (throw 'syntax "Year value is out of range"))
- (if (or (< month 1) (> month 12))
- (throw 'syntax "Month value is out of range"))
- (if (or (< day 1) (> day (math-days-in-month year month)))
- (throw 'syntax "Day value is out of range"))
- (and hour
- (progn
- (if (or (< hour 0) (> hour 23))
- (throw 'syntax "Hour value is out of range"))
- (if (or (< minute 0) (> minute 59))
- (throw 'syntax "Minute value is out of range"))
- (if (or (math-negp second) (not (Math-lessp second 60)))
- (throw 'syntax "Seconds value is out of range"))))
- (list 'date (math-dt-to-date (append (list year month day)
- (and hour (list hour minute second))))))
-
-(defun math-parse-date-word (names &optional front)
- (let ((n 1))
- (while (and names (not (string-match (if (equal (car names) "Sep")
- "Sept?"
- (regexp-quote (car names)))
- str)))
- (setq names (cdr names)
- n (1+ n)))
- (and names
- (or (not front) (= (match-beginning 0) 0))
- (progn
- (setq str (concat (substring str 0 (match-beginning 0))
- (if front "" " ")
- (substring str (match-end 0))))
- n))))
-
-(defun math-parse-standard-date (str with-time)
- (let ((case-fold-search t)
- (okay t) num
- (fmt calc-date-format) this next (gnext nil)
- (year nil) (month nil) (day nil) (bigyear nil) (yearday nil)
- (hour nil) (minute nil) (second nil) (bc-flag nil))
- (while (and fmt okay)
- (setq this (car fmt)
- fmt (setq fmt (or (cdr fmt)
- (prog1
- gnext
- (setq gnext nil))))
- next (car fmt))
- (if (consp next) (setq next (car next)))
- (or (cond ((listp this)
- (or (not with-time)
- (not this)
- (setq gnext fmt
- fmt this)))
- ((stringp this)
- (if (and (<= (length this) (length str))
- (equal this
- (substring str 0 (length this))))
- (setq str (substring str (length this)))))
- ((eq this 'X)
- t)
- ((memq this '(n N j J))
- (and (string-match "\\`[-+]?[0-9.]+\\([eE][-+]?[0-9]+\\)?" str)
- (setq num (math-match-substring str 0)
- str (substring str (match-end 0))
- num (math-date-to-dt (math-read-number num))
- num (math-sub num
- (if (memq this '(n N))
- 0
- (if (or (eq this 'j)
- (math-integerp num))
- '(bigpos 424 721 1)
- '(float (bigpos 235 214 17)
- -1))))
- hour (or (nth 3 num) hour)
- minute (or (nth 4 num) minute)
- second (or (nth 5 num) second)
- year (car num)
- month (nth 1 num)
- day (nth 2 num))))
- ((eq this 'U)
- (and (string-match "\\`[-+]?[0-9]+" str)
- (setq num (math-match-substring str 0)
- str (substring str (match-end 0))
- num (math-date-to-dt
- (math-add 719164
- (math-div (math-read-number num)
- '(float 864 2))))
- hour (nth 3 num)
- minute (nth 4 num)
- second (nth 5 num)
- year (car num)
- month (nth 1 num)
- day (nth 2 num))))
- ((memq this '(mmm Mmm MMM))
- (setq month (math-parse-date-word math-short-month-names t)))
- ((memq this '(Mmmm MMMM))
- (setq month (math-parse-date-word math-long-month-names t)))
- ((memq this '(www Www WWW))
- (math-parse-date-word math-short-weekday-names t))
- ((memq this '(Wwww WWWW))
- (math-parse-date-word math-long-weekday-names t))
- ((memq this '(p P))
- (if (string-match "\\`a" str)
- (setq hour (if (= hour 12) 0 hour)
- str (substring str 1))
- (if (string-match "\\`p" str)
- (setq hour (if (= hour 12) 12 (% (+ hour 12) 24))
- str (substring str 1)))))
- ((memq this '(pp PP pppp PPPP))
- (if (string-match "\\`am\\|a\\.m\\." str)
- (setq hour (if (= hour 12) 0 hour)
- str (substring str (match-end 0)))
- (if (string-match "\\`pm\\|p\\.m\\." str)
- (setq hour (if (= hour 12) 12 (% (+ hour 12) 24))
- str (substring str (match-end 0))))))
- ((memq this '(Y YY BY YYY YYYY))
- (and (if (memq next '(MM DD ddd hh HH mm ss SS))
- (if (memq this '(Y YY BYY))
- (string-match "\\` *[0-9][0-9]" str)
- (string-match "\\`[0-9][0-9][0-9][0-9]" str))
- (string-match "\\`[-+]?[0-9]+" str))
- (setq year (math-match-substring str 0)
- bigyear (or (eq this 'YYY)
- (memq (aref str 0) '(?\+ ?\-)))
- str (substring str (match-end 0))
- year (math-read-number year))))
- ((eq this 'b)
- t)
- ((memq this '(aa AA aaaa AAAA))
- (if (string-match "\\` *\\(ad\\|a\\.d\\.\\)" str)
- (setq str (substring str (match-end 0)))))
- ((memq this '(aaa AAA))
- (if (string-match "\\` *ad *" str)
- (setq str (substring str (match-end 0)))))
- ((memq this '(bb BB bbb BBB bbbb BBBB))
- (if (string-match "\\` *\\(bc\\|b\\.c\\.\\)" str)
- (setq str (substring str (match-end 0))
- bc-flag t)))
- ((memq this '(s ss bs SS BS))
- (and (if (memq next '(YY YYYY MM DD hh HH mm))
- (string-match "\\` *[0-9][0-9]\\(\\.[0-9]+\\)?" str)
- (string-match "\\` *[0-9][0-9]?\\(\\.[0-9]+\\)?" str))
- (setq second (math-match-substring str 0)
- str (substring str (match-end 0))
- second (math-read-number second))))
- ((eq this 'C)
- (if (string-match "\\`:[0-9][0-9]" str)
- (setq str (substring str 1))
- t))
- ((or (not (if (and (memq this '(ddd MM DD hh HH mm))
- (memq next '(YY YYYY MM DD ddd
- hh HH mm ss SS)))
- (if (eq this 'ddd)
- (string-match "\\` *[0-9][0-9][0-9]" str)
- (string-match "\\` *[0-9][0-9]" str))
- (string-match "\\` *[0-9]+" str)))
- (and (setq num (string-to-int
- (math-match-substring str 0))
- str (substring str (match-end 0)))
- nil))
- nil)
- ((eq this 'W)
- (and (>= num 0) (< num 7)))
- ((memq this '(d ddd bdd))
- (setq yearday num))
- ((memq this '(M MM BM))
- (setq month num))
- ((memq this '(D DD BD))
- (setq day num))
- ((memq this '(h hh bh H HH BH))
- (setq hour num))
- ((memq this '(m mm bm))
- (setq minute num)))
- (setq okay nil)))
- (if yearday
- (if (and month day)
- (setq yearday nil)
- (setq month 1 day 1)))
- (if (and okay (equal str ""))
- (and month day (or (not (or hour minute second))
- (and hour minute))
- (progn
- (or year (setq year (math-this-year)))
- (or second (setq second 0))
- (if bc-flag
- (setq year (math-neg (math-abs year))))
- (setq day (math-parse-date-validate year bigyear month day
- hour minute second))
- (if yearday
- (setq day (math-add day (1- yearday))))
- day)))))
-
-
-(defun calcFunc-now (&optional zone)
- (let ((date (let ((calc-date-format nil))
- (math-parse-date (current-time-string)))))
- (if (consp date)
- (if zone
- (math-add date (math-div (math-sub (calcFunc-tzone nil date)
- (calcFunc-tzone zone date))
- '(float 864 2)))
- date)
- (calc-record-why "*Unable to interpret current date from system")
- (append (list 'calcFunc-now) (and zone (list zone))))))
-
-(defun calcFunc-year (date)
- (car (math-date-to-dt date)))
-
-(defun calcFunc-month (date)
- (nth 1 (math-date-to-dt date)))
-
-(defun calcFunc-day (date)
- (nth 2 (math-date-to-dt date)))
-
-(defun calcFunc-weekday (date)
- (if (eq (car-safe date) 'date)
- (setq date (nth 1 date)))
- (or (math-realp date)
- (math-reject-arg date 'datep))
- (math-mod (math-add (math-floor date) 6) 7))
-
-(defun calcFunc-yearday (date)
- (let ((dt (math-date-to-dt date)))
- (math-day-number (car dt) (nth 1 dt) (nth 2 dt))))
-
-(defun calcFunc-hour (date)
- (if (eq (car-safe date) 'hms)
- (nth 1 date)
- (or (nth 3 (math-date-to-dt date)) 0)))
-
-(defun calcFunc-minute (date)
- (if (eq (car-safe date) 'hms)
- (nth 2 date)
- (or (nth 4 (math-date-to-dt date)) 0)))
-
-(defun calcFunc-second (date)
- (if (eq (car-safe date) 'hms)
- (nth 3 date)
- (or (nth 5 (math-date-to-dt date)) 0)))
-
-(defun calcFunc-time (date)
- (let ((dt (math-date-to-dt date)))
- (if (nth 3 dt)
- (cons 'hms (nthcdr 3 dt))
- (list 'hms 0 0 0))))
-
-(defun calcFunc-date (date &optional month day hour minute second)
- (and (math-messy-integerp month) (setq month (math-trunc month)))
- (and month (not (integerp month)) (math-reject-arg month 'fixnump))
- (and (math-messy-integerp day) (setq day (math-trunc day)))
- (and day (not (integerp day)) (math-reject-arg day 'fixnump))
- (if (and (eq (car-safe hour) 'hms) (not minute))
- (setq second (nth 3 hour)
- minute (nth 2 hour)
- hour (nth 1 hour)))
- (and (math-messy-integerp hour) (setq hour (math-trunc hour)))
- (and hour (not (integerp hour)) (math-reject-arg hour 'fixnump))
- (and (math-messy-integerp minute) (setq minute (math-trunc minute)))
- (and minute (not (integerp minute)) (math-reject-arg minute 'fixnump))
- (and (math-messy-integerp second) (setq second (math-trunc second)))
- (and second (not (math-realp second)) (math-reject-arg second 'realp))
- (if month
- (progn
- (and (math-messy-integerp date) (setq date (math-trunc date)))
- (and date (not (math-integerp date)) (math-reject-arg date 'integerp))
- (if day
- (if hour
- (list 'date (math-dt-to-date (list date month day hour
- (or minute 0)
- (or second 0))))
- (list 'date (math-dt-to-date (list date month day))))
- (list 'date (math-dt-to-date (list (math-this-year) date month)))))
- (if (math-realp date)
- (list 'date date)
- (if (eq (car date) 'date)
- (nth 1 date)
- (math-reject-arg date 'datep)))))
-
-(defun calcFunc-julian (date &optional zone)
- (if (math-realp date)
- (list 'date (if (math-integerp date)
- (math-sub date '(bigpos 424 721 1))
- (setq date (math-sub date '(float (bigpos 235 214 17) -1)))
- (math-sub date (math-div (calcFunc-tzone zone date)
- '(float 864 2)))))
- (if (eq (car date) 'date)
- (math-add (nth 1 date) (if (math-integerp (nth 1 date))
- '(bigpos 424 721 1)
- (math-add '(float (bigpos 235 214 17) -1)
- (math-div (calcFunc-tzone zone date)
- '(float 864 2)))))
- (math-reject-arg date 'datep))))
-
-(defun calcFunc-unixtime (date &optional zone)
- (if (math-realp date)
- (progn
- (setq date (math-add 719164 (math-div date '(float 864 2))))
- (list 'date (math-sub date (math-div (calcFunc-tzone zone date)
- '(float 864 2)))))
- (if (eq (car date) 'date)
- (math-add (nth 1 (math-date-parts (nth 1 date) 719164))
- (calcFunc-tzone zone date))
- (math-reject-arg date 'datep))))
-
-(defun calcFunc-tzone (&optional zone date)
- (if zone
- (cond ((math-realp zone)
- (math-round (math-mul zone 3600)))
- ((eq (car zone) 'hms)
- (math-round (math-mul (math-from-hms zone 'deg) 3600)))
- ((eq (car zone) '+)
- (math-add (calcFunc-tzone (nth 1 zone) date)
- (calcFunc-tzone (nth 2 zone) date)))
- ((eq (car zone) '-)
- (math-sub (calcFunc-tzone (nth 1 zone) date)
- (calcFunc-tzone (nth 2 zone) date)))
- ((eq (car zone) 'var)
- (let ((name (upcase (symbol-name (nth 1 zone))))
- found)
- (if (setq found (assoc name math-tzone-names))
- (calcFunc-tzone (math-add (nth 1 found)
- (if (integerp (nth 2 found))
- (nth 2 found)
- (or
- (math-daylight-savings-adjust
- date (car found))
- 0)))
- date)
- (if (equal name "LOCAL")
- (calcFunc-tzone nil date)
- (math-reject-arg zone "*Unrecognized time zone name")))))
- (t (math-reject-arg zone "*Expected a time zone")))
- (if (calc-var-value 'var-TimeZone)
- (calcFunc-tzone (calc-var-value 'var-TimeZone) date)
- (let ((p math-tzone-names)
- (offset 0)
- (tz '(var error var-error)))
- (save-excursion
- (set-buffer (get-buffer-create " *Calc Temporary*"))
- (erase-buffer)
- (call-process "date" nil t)
- (goto-char 1)
- (let ((case-fold-search t))
- (while (and p (not (search-forward (car (car p)) nil t)))
- (setq p (cdr p))))
- (if (looking-at "\\([-+][0-9]?[0-9]\\)\\([0-9][0-9]\\)?\\(\\'\\|[^0-9]\\)")
- (setq offset (math-add
- (string-to-int (buffer-substring
- (match-beginning 1)
- (match-end 1)))
- (if (match-beginning 2)
- (math-div (string-to-int (buffer-substring
- (match-beginning 2)
- (match-end 2)))
- 60)
- 0)))))
- (if p
- (progn
- (setq p (car p))
- ;; Try to convert to a generalized time zone.
- (if (integerp (nth 2 p))
- (let ((gen math-tzone-names))
- (while (and gen
- (not (equal (nth 2 (car gen)) (car p)))
- (not (equal (nth 3 (car gen)) (car p)))
- (not (equal (nth 4 (car gen)) (car p)))
- (not (equal (nth 5 (car gen)) (car p))))
- (setq gen (cdr gen)))
- (and gen
- (setq gen (car gen))
- (equal (math-daylight-savings-adjust nil (car gen))
- (nth 2 p))
- (setq p gen))))
- (setq tz (math-add (list 'var
- (intern (car p))
- (intern (concat "var-" (car p))))
- offset))))
- (kill-buffer " *Calc Temporary*")
- (setq var-TimeZone tz)
- (calc-refresh-evaltos 'var-TimeZone)
- (calcFunc-tzone tz date)))))
-
-;;; Note: Longer names must appear before shorter names which are
-;;; substrings of them.
-(defvar math-tzone-names
- '(( "UTC" 0 0)
- ( "MEGT" -1 "MET" "METDST" ) ; Middle Europe
- ( "METDST" -1 -1 ) ( "MET" -1 0 )
- ( "MEGZ" -1 "MEZ" "MESZ" ) ( "MEZ" -1 0 ) ( "MESZ" -1 -1 )
- ( "WEGT" 0 "WET" "WETDST" ) ; Western Europe
- ( "WETDST" 0 -1 ) ( "WET" 0 0 )
- ( "BGT" 0 "GMT" "BST" ) ( "GMT" 0 0 ) ( "BST" 0 -1 ) ; Britain
- ( "NGT" (float 35 -1) "NST" "NDT" ) ; Newfoundland
- ( "NST" (float 35 -1) 0 ) ( "NDT" (float 35 -1) -1 )
- ( "AGT" 4 "AST" "ADT" ) ( "AST" 4 0 ) ( "ADT" 4 -1 ) ; Atlantic
- ( "EGT" 5 "EST" "EDT" ) ( "EST" 5 0 ) ( "EDT" 5 -1 ) ; Eastern
- ( "CGT" 6 "CST" "CDT" ) ( "CST" 6 0 ) ( "CDT" 6 -1 ) ; Central
- ( "MGT" 7 "MST" "MDT" ) ( "MST" 7 0 ) ( "MDT" 7 -1 ) ; Mountain
- ( "PGT" 8 "PST" "PDT" ) ( "PST" 8 0 ) ( "PDT" 8 -1 ) ; Pacific
- ( "YGT" 9 "YST" "YDT" ) ( "YST" 9 0 ) ( "YDT" 9 -1 ) ; Yukon
- )
- "No doc yet. See calc manual for now. ")
-
-
-(defun math-daylight-savings-adjust (date zone &optional dt)
- (or date (setq date (nth 1 (calcFunc-now))))
- (let (bump)
- (if (eq (car-safe date) 'date)
- (setq bump 0
- date (nth 1 date))
- (if (and date (math-realp date))
- (let ((zadj (assoc zone math-tzone-names)))
- (if zadj (setq bump -1
- date (math-sub date (math-div (nth 1 zadj)
- '(float 24 0))))))
- (math-reject-arg date 'datep)))
- (setq date (math-float date))
- (or dt (setq dt (math-date-to-dt date)))
- (and math-daylight-savings-hook
- (funcall math-daylight-savings-hook date dt zone bump))))
-
-(defun calcFunc-dsadj (date &optional zone)
- (if zone
- (or (eq (car-safe zone) 'var)
- (math-reject-arg zone "*Time zone variable expected"))
- (setq zone (or (calc-var-value 'var-TimeZone)
- (progn
- (calcFunc-tzone)
- (calc-var-value 'var-TimeZone)))))
- (setq zone (and (eq (car-safe zone) 'var)
- (upcase (symbol-name (nth 1 zone)))))
- (let ((zadj (assoc zone math-tzone-names)))
- (or zadj (math-reject-arg zone "*Unrecognized time zone name"))
- (if (integerp (nth 2 zadj))
- (nth 2 zadj)
- (math-daylight-savings-adjust date zone))))
-
-(defun calcFunc-tzconv (date z1 z2)
- (if (math-realp date)
- (nth 1 (calcFunc-tzconv (list 'date date) z1 z2))
- (calcFunc-unixtime (calcFunc-unixtime date z1) z2)))
-
-(defvar math-daylight-savings-hook 'math-std-daylight-savings)
-
-(defun math-std-daylight-savings (date dt zone bump)
- "Standard North American daylight savings algorithm.
-This implements the rules for the U.S. and Canada as of 1987.
-Daylight savings begins on the first Sunday of April at 2 a.m.,
-and ends on the last Sunday of October at 2 a.m."
- (cond ((< (nth 1 dt) 4) 0)
- ((= (nth 1 dt) 4)
- (let ((sunday (math-prev-weekday-in-month date dt 7 0)))
- (cond ((< (nth 2 dt) sunday) 0)
- ((= (nth 2 dt) sunday)
- (if (>= (nth 3 dt) (+ 3 bump)) -1 0))
- (t -1))))
- ((< (nth 1 dt) 10) -1)
- ((= (nth 1 dt) 10)
- (let ((sunday (math-prev-weekday-in-month date dt 31 0)))
- (cond ((< (nth 2 dt) sunday) -1)
- ((= (nth 2 dt) sunday)
- (if (>= (nth 3 dt) (+ 2 bump)) 0 -1))
- (t 0))))
- (t 0)))
-
-;;; Compute the day (1-31) of the WDAY (0-6) on or preceding the given
-;;; day of the given month.
-(defun math-prev-weekday-in-month (date dt day wday)
- (or day (setq day (nth 2 dt)))
- (if (> day (math-days-in-month (car dt) (nth 1 dt)))
- (setq day (math-days-in-month (car dt) (nth 1 dt))))
- (let ((zeroth (math-sub (math-floor date) (nth 2 dt))))
- (math-sub (nth 1 (calcFunc-newweek (math-add zeroth day))) zeroth)))
-
-(defun calcFunc-pwday (date &optional day weekday)
- (if (eq (car-safe date) 'date)
- (setq date (nth 1 date)))
- (or (math-realp date)
- (math-reject-arg date 'datep))
- (if (math-messy-integerp day) (setq day (math-trunc day)))
- (or (integerp day) (math-reject-arg day 'fixnump))
- (if (= day 0) (setq day 31))
- (and (or (< day 7) (> day 31)) (math-reject-arg day 'range))
- (math-prev-weekday-in-month date (math-date-to-dt date) day (or weekday 0)))
-
-
-(defun calcFunc-newweek (date &optional weekday)
- (if (eq (car-safe date) 'date)
- (setq date (nth 1 date)))
- (or (math-realp date)
- (math-reject-arg date 'datep))
- (or weekday (setq weekday 0))
- (and (math-messy-integerp weekday) (setq weekday (math-trunc weekday)))
- (or (integerp weekday) (math-reject-arg weekday 'fixnump))
- (and (or (< weekday 0) (> weekday 6)) (math-reject-arg weekday 'range))
- (setq date (math-floor date))
- (list 'date (math-sub date (calcFunc-weekday (math-sub date weekday)))))
-
-(defun calcFunc-newmonth (date &optional day)
- (or day (setq day 1))
- (and (math-messy-integerp day) (setq day (math-trunc day)))
- (or (integerp day) (math-reject-arg day 'fixnump))
- (and (or (< day 0) (> day 31)) (math-reject-arg day 'range))
- (let ((dt (math-date-to-dt date)))
- (if (or (= day 0) (> day (math-days-in-month (car dt) (nth 1 dt))))
- (setq day (math-days-in-month (car dt) (nth 1 dt))))
- (and (eq (car dt) 1752) (= (nth 1 dt) 9)
- (if (>= day 14) (setq day (- day 11))))
- (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1))
- (1- day)))))
-
-(defun calcFunc-newyear (date &optional day)
- (or day (setq day 1))
- (and (math-messy-integerp day) (setq day (math-trunc day)))
- (or (integerp day) (math-reject-arg day 'fixnump))
- (let ((dt (math-date-to-dt date)))
- (if (and (>= day 0) (<= day 366))
- (let ((max (if (eq (car dt) 1752) 355
- (if (math-leap-year-p (car dt)) 366 365))))
- (if (or (= day 0) (> day max)) (setq day max))
- (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
- (1- day))))
- (if (and (>= day -12) (<= day -1))
- (list 'date (math-dt-to-date (list (car dt) (- day) 1)))
- (math-reject-arg day 'range)))))
-
-(defun calcFunc-incmonth (date &optional step)
- (or step (setq step 1))
- (and (math-messy-integerp step) (setq step (math-trunc step)))
- (or (math-integerp step) (math-reject-arg step 'integerp))
- (let* ((dt (math-date-to-dt date))
- (year (car dt))
- (month (math-add (1- (nth 1 dt)) step))
- (extra (calcFunc-idiv month 12))
- (day (nth 2 dt)))
- (setq month (1+ (math-sub month (math-mul extra 12)))
- year (math-add year extra)
- day (min day (math-days-in-month year month)))
- (and (math-posp (car dt)) (not (math-posp year))
- (setq year (math-sub year 1))) ; did we go past the year zero?
- (and (math-negp (car dt)) (not (math-negp year))
- (setq year (math-add year 1)))
- (list 'date (math-dt-to-date
- (cons year (cons month (cons day (cdr (cdr (cdr dt))))))))))
-
-(defun calcFunc-incyear (date &optional step)
- (calcFunc-incmonth date (math-mul (or step 1) 12)))
-
-
-
-(defun calcFunc-bsub (a b)
- (or (eq (car-safe a) 'date)
- (math-reject-arg a 'datep))
- (if (eq (car-safe b) 'date)
- (if (math-lessp (nth 1 a) (nth 1 b))
- (math-neg (calcFunc-bsub b a))
- (math-setup-holidays b)
- (let* ((da (math-to-business-day a))
- (db (math-to-business-day b)))
- (math-add (math-sub (car da) (car db))
- (if (and (cdr db) (not (cdr da))) 1 0))))
- (calcFunc-badd a (math-neg b))))
-
-(defvar math-holidays-cache nil)
-(defvar math-holidays-cache-tag t)
-(defun calcFunc-badd (a b)
- (if (eq (car-safe b) 'date)
- (if (eq (car-safe a) 'date)
- (math-reject-arg nil "*Illegal combination in date arithmetic")
- (calcFunc-badd b a))
- (if (eq (car-safe a) 'date)
- (if (Math-realp b)
- (if (Math-zerop b)
- a
- (let* ((d (math-to-business-day a))
- (bb (math-add (car d)
- (if (and (cdr d) (Math-posp b))
- (math-sub b 1) b))))
- (or (math-from-business-day bb)
- (calcFunc-badd a b))))
- (if (eq (car-safe b) 'hms)
- (let ((hours (nth 7 math-holidays-cache)))
- (setq b (math-div (math-from-hms b 'deg) 24))
- (if hours
- (setq b (math-div b (cdr hours))))
- (calcFunc-badd a b))
- (math-reject-arg nil "*Illegal combination in date arithmetic")))
- (math-reject-arg a 'datep))))
-
-(defun calcFunc-holiday (a)
- (if (cdr (math-to-business-day a)) 1 0))
-
-;;; Compute the number of business days since Jan 1, 1 AD.
-
-(defun math-to-business-day (date &optional need-year)
- (if (eq (car-safe date) 'date)
- (setq date (nth 1 date)))
- (or (Math-realp date)
- (math-reject-arg date 'datep))
- (let* ((day (math-floor date))
- (time (math-sub date day))
- (dt (math-date-to-dt day))
- (delta 0)
- (holiday nil))
- (or (not need-year) (eq (car dt) need-year)
- (math-reject-arg (list 'date day) "*Generated holiday has wrong year"))
- (math-setup-holidays date)
- (let ((days (car math-holidays-cache)))
- (while (and (setq days (cdr days)) (< (car days) day))
- (setq delta (1+ delta)))
- (and days (= day (car days))
- (setq holiday t)))
- (let* ((weekdays (nth 3 math-holidays-cache))
- (weeks (1- (/ (+ day 6) 7)))
- (wkday (- day 1 (* weeks 7))))
- (setq delta (+ delta (* weeks (length weekdays))))
- (while (and weekdays (< (car weekdays) wkday))
- (setq weekdays (cdr weekdays)
- delta (1+ delta)))
- (and weekdays (eq wkday (car weekdays))
- (setq holiday t)))
- (let ((hours (nth 7 math-holidays-cache)))
- (if hours
- (progn
- (setq time (math-div (math-sub time (car hours)) (cdr hours)))
- (if (Math-lessp time 0) (setq time 0))
- (or (Math-lessp time 1)
- (setq time
- (math-sub 1
- (math-div 1 (math-mul 86400 (cdr hours)))))))))
- (cons (math-add (math-sub day delta) time) holiday)))
-
-
-;;; Compute the date a certain number of business days since Jan 1, 1 AD.
-;;; If this returns nil, holiday table was adjusted; redo calculation.
-
-(defun math-from-business-day (num)
- (let* ((day (math-floor num))
- (time (math-sub num day)))
- (or (integerp day)
- (math-reject-arg nil "*Date is outside valid range"))
- (math-setup-holidays)
- (let ((days (nth 1 math-holidays-cache))
- (delta 0))
- (while (and (setq days (cdr days)) (< (car days) day))
- (setq delta (1+ delta)))
- (setq day (+ day delta)))
- (let* ((weekdays (nth 3 math-holidays-cache))
- (bweek (- 7 (length weekdays)))
- (weeks (1- (/ (+ day (1- bweek)) bweek)))
- (wkday (- day 1 (* weeks bweek)))
- (w 0))
- (setq day (+ day (* weeks (length weekdays))))
- (while (if (memq w weekdays)
- (setq day (1+ day))
- (> (setq wkday (1- wkday)) 0))
- (setq w (1+ w)))
- (let ((hours (nth 7 math-holidays-cache)))
- (if hours
- (setq time (math-add (math-mul time (cdr hours)) (car hours)))))
- (and (not (math-setup-holidays day))
- (list 'date (math-add day time))))))
-
-
-(defun math-setup-holidays (&optional date)
- (or (eq (calc-var-value 'var-Holidays) math-holidays-cache-tag)
- (let ((h (calc-var-value 'var-Holidays))
- (wdnames '( (sun . 0) (mon . 1) (tue . 2) (wed . 3)
- (thu . 4) (fri . 5) (sat . 6) ))
- (days nil) (weekdays nil) (exprs nil) (limit nil) (hours nil))
- (or (math-vectorp h)
- (math-reject-arg h "*Holidays variable must be a vector"))
- (while (setq h (cdr h))
- (cond ((or (and (eq (car-safe (car h)) 'date)
- (integerp (nth 1 (car h))))
- (and (eq (car-safe (car h)) 'intv)
- (eq (car-safe (nth 2 (car h))) 'date))
- (eq (car-safe (car h)) 'vec))
- (setq days (cons (car h) days)))
- ((and (eq (car-safe (car h)) 'var)
- (assq (nth 1 (car h)) wdnames))
- (setq weekdays (cons (cdr (assq (nth 1 (car h)) wdnames))
- weekdays)))
- ((and (eq (car-safe (car h)) 'intv)
- (eq (car-safe (nth 2 (car h))) 'hms)
- (eq (car-safe (nth 3 (car h))) 'hms))
- (if hours
- (math-reject-arg
- (car h) "*Only one hours interval allowed in Holidays"))
- (setq hours (math-div (car h) '(hms 24 0 0)))
- (if (or (Math-lessp (nth 2 hours) 0)
- (Math-lessp 1 (nth 3 hours)))
- (math-reject-arg
- (car h) "*Hours interval out of range"))
- (setq hours (cons (nth 2 hours)
- (math-sub (nth 3 hours) (nth 2 hours))))
- (if (Math-zerop (cdr hours))
- (math-reject-arg
- (car h) "*Degenerate hours interval")))
- ((or (and (eq (car-safe (car h)) 'intv)
- (Math-integerp (nth 2 (car h)))
- (Math-integerp (nth 3 (car h))))
- (and (integerp (car h))
- (> (car h) 1900) (< (car h) 2100)))
- (if limit
- (math-reject-arg
- (car h) "*Only one limit allowed in Holidays"))
- (setq limit (calcFunc-vint (car h) '(intv 3 1 2737)))
- (if (equal limit '(vec))
- (math-reject-arg (car h) "*Limit is out of range")))
- ((or (math-expr-contains (car h) '(var y var-y))
- (math-expr-contains (car h) '(var m var-m)))
- (setq exprs (cons (car h) exprs)))
- (t (math-reject-arg
- (car h) "*Holidays must contain a vector of holidays"))))
- (if (= (length weekdays) 7)
- (math-reject-arg nil "*Too many weekend days"))
- (setq math-holidays-cache (list (list -1) ; 0: days list
- (list -1) ; 1: inverse-days list
- nil ; 2: exprs
- (sort weekdays '<)
- (or limit '(intv 3 1 2737))
- nil ; 5: (lo.hi) expanded years
- (cons exprs days)
- hours) ; 7: business hours
- math-holidays-cache-tag (calc-var-value 'var-Holidays))))
- (if date
- (let ((year (calcFunc-year date))
- (limits (nth 5 math-holidays-cache))
- (done nil))
- (or (eq (calcFunc-in year (nth 4 math-holidays-cache)) 1)
- (progn
- (or (eq (car-safe date) 'date) (setq date (list 'date date)))
- (math-reject-arg date "*Date is outside valid range")))
- (unwind-protect
- (let ((days (nth 6 math-holidays-cache)))
- (if days
- (let ((year nil)) ; see below
- (setcar (nthcdr 6 math-holidays-cache) nil)
- (math-setup-add-holidays (cons 'vec (cdr days)))
- (setcar (nthcdr 2 math-holidays-cache) (car days))))
- (cond ((not (nth 2 math-holidays-cache))
- (setq done t)
- nil)
- ((not limits)
- (setcar (nthcdr 5 math-holidays-cache) (cons year year))
- (math-setup-year-holidays year)
- (setq done t))
- ((< year (car limits))
- (message "Computing holidays, %d .. %d"
- year (1- (car limits)))
- (calc-set-command-flag 'clear-message)
- (while (< year (car limits))
- (setcar limits (1- (car limits)))
- (math-setup-year-holidays (car limits)))
- (setq done t))
- ((> year (cdr limits))
- (message "Computing holidays, %d .. %d"
- (1+ (cdr limits)) year)
- (calc-set-command-flag 'clear-message)
- (while (> year (cdr limits))
- (setcdr limits (1+ (cdr limits)))
- (math-setup-year-holidays (cdr limits)))
- (setq done t))
- (t
- (setq done t)
- nil)))
- (or done (setq math-holidays-cache-tag t))))))
-
-(defun math-setup-year-holidays (year)
- (let ((exprs (nth 2 math-holidays-cache)))
- (while exprs
- (let* ((var-y year)
- (var-m nil)
- (expr (math-evaluate-expr (car exprs))))
- (if (math-expr-contains expr '(var m var-m))
- (let ((var-m 0))
- (while (<= (setq var-m (1+ var-m)) 12)
- (math-setup-add-holidays (math-evaluate-expr expr))))
- (math-setup-add-holidays expr)))
- (setq exprs (cdr exprs)))))
-
-(defun math-setup-add-holidays (days) ; uses "year"
- (cond ((eq (car-safe days) 'vec)
- (while (setq days (cdr days))
- (math-setup-add-holidays (car days))))
- ((eq (car-safe days) 'intv)
- (let ((day (math-ceiling (nth 2 days))))
- (or (eq (calcFunc-in day days) 1)
- (setq day (math-add day 1)))
- (while (eq (calcFunc-in day days) 1)
- (math-setup-add-holidays day)
- (setq day (math-add day 1)))))
- ((eq (car-safe days) 'date)
- (math-setup-add-holidays (nth 1 days)))
- ((eq days 0))
- ((integerp days)
- (let ((b (math-to-business-day days year)))
- (or (cdr b) ; don't register holidays twice!
- (let ((prev (car math-holidays-cache))
- (iprev (nth 1 math-holidays-cache)))
- (while (and (cdr prev) (< (nth 1 prev) days))
- (setq prev (cdr prev) iprev (cdr iprev)))
- (setcdr prev (cons days (cdr prev)))
- (setcdr iprev (cons (car b) (cdr iprev)))
- (while (setq iprev (cdr iprev))
- (setcar iprev (1- (car iprev))))))))
- ((Math-realp days)
- (math-reject-arg (list 'date days) "*Invalid holiday value"))
- (t
- (math-reject-arg days "*Holiday formula failed to evaluate"))))
-
-
-
-
-;;;; Error forms.
-
-;;; Build a standard deviation form. [X X X]
-(defun math-make-sdev (x sigma)
- (if (memq (car-safe x) '(date mod sdev intv vec))
- (math-reject-arg x 'realp))
- (if (memq (car-safe sigma) '(date mod sdev intv vec))
- (math-reject-arg sigma 'realp))
- (if (or (Math-negp sigma) (memq (car-safe sigma) '(cplx polar)))
- (setq sigma (math-abs sigma)))
- (if (and (Math-zerop sigma) (Math-scalarp x))
- x
- (list 'sdev x sigma)))
-(defun calcFunc-sdev (x sigma)
- (math-make-sdev x sigma))
-
-
-
-;;;; Modulo forms.
-
-(defun math-normalize-mod (a)
- (let ((n (math-normalize (nth 1 a)))
- (m (math-normalize (nth 2 a))))
- (if (and (math-anglep n) (math-anglep m) (math-posp m))
- (math-make-mod n m)
- (math-normalize (list 'calcFunc-makemod n m)))))
-
-;;; Build a modulo form. [N R R]
-(defun math-make-mod (n m)
- (setq calc-previous-modulo m)
- (and n
- (cond ((not (Math-anglep m))
- (math-reject-arg m 'anglep))
- ((not (math-posp m))
- (math-reject-arg m 'posp))
- ((Math-anglep n)
- (if (or (Math-negp n)
- (not (Math-lessp n m)))
- (list 'mod (math-mod n m) m)
- (list 'mod n m)))
- ((memq (car n) '(+ - / vec neg))
- (math-normalize
- (cons (car n)
- (mapcar (function (lambda (x) (math-make-mod x m)))
- (cdr n)))))
- ((and (eq (car n) '*) (Math-anglep (nth 1 n)))
- (math-mul (math-make-mod (nth 1 n) m) (nth 2 n)))
- ((memq (car n) '(* ^ var calcFunc-subscr))
- (math-mul (math-make-mod 1 m) n))
- (t (math-reject-arg n 'anglep)))))
-(defun calcFunc-makemod (n m)
- (math-make-mod n m))
-
-
-
-;;;; Interval forms.
-
-;;; Build an interval form. [X S X X]
-(defun math-make-intv (mask lo hi)
- (if (memq (car-safe lo) '(cplx polar mod sdev intv vec))
- (math-reject-arg lo 'realp))
- (if (memq (car-safe hi) '(cplx polar mod sdev intv vec))
- (math-reject-arg hi 'realp))
- (or (eq (eq (car-safe lo) 'date) (eq (car-safe hi) 'date))
- (math-reject-arg (if (eq (car-safe lo) 'date) hi lo) 'datep))
- (if (and (or (Math-realp lo) (eq (car lo) 'date))
- (or (Math-realp hi) (eq (car hi) 'date)))
- (let ((cmp (math-compare lo hi)))
- (if (= cmp 0)
- (if (= mask 3)
- lo
- (list 'intv mask lo hi))
- (if (> cmp 0)
- (if (= mask 3)
- (list 'intv 2 lo lo)
- (list 'intv mask lo lo))
- (list 'intv mask lo hi))))
- (list 'intv mask lo hi)))
-(defun calcFunc-intv (mask lo hi)
- (if (math-messy-integerp mask) (setq mask (math-trunc mask)))
- (or (natnump mask) (math-reject-arg mask 'fixnatnump))
- (or (<= mask 3) (math-reject-arg mask 'range))
- (math-make-intv mask lo hi))
-
-(defun math-sort-intv (mask lo hi)
- (if (Math-lessp hi lo)
- (math-make-intv (aref [0 2 1 3] mask) hi lo)
- (math-make-intv mask lo hi)))
-
-
-
-
-(defun math-combine-intervals (a am b bm c cm d dm)
- (let (res)
- (if (= (setq res (math-compare a c)) 1)
- (setq a c am cm)
- (if (= res 0)
- (setq am (or am cm))))
- (if (= (setq res (math-compare b d)) -1)
- (setq b d bm dm)
- (if (= res 0)
- (setq bm (or bm dm))))
- (math-make-intv (+ (if am 2 0) (if bm 1 0)) a b)))
-
-
-(defun math-div-mod (a b m) ; [R R R R] (Returns nil if no solution)
- (and (Math-integerp a) (Math-integerp b) (Math-integerp m)
- (let ((u1 1) (u3 b) (v1 0) (v3 m))
- (while (not (eq v3 0)) ; See Knuth sec 4.5.2, exercise 15
- (let* ((q (math-idivmod u3 v3))
- (t1 (math-sub u1 (math-mul v1 (car q)))))
- (setq u1 v1 u3 v3 v1 t1 v3 (cdr q))))
- (let ((q (math-idivmod a u3)))
- (and (eq (cdr q) 0)
- (math-mod (math-mul (car q) u1) m))))))
-
-(defun math-mod-intv (a b)
- (let* ((q1 (math-floor (math-div (nth 2 a) b)))
- (q2 (math-floor (math-div (nth 3 a) b)))
- (m1 (math-sub (nth 2 a) (math-mul q1 b)))
- (m2 (math-sub (nth 3 a) (math-mul q2 b))))
- (cond ((equal q1 q2)
- (math-sort-intv (nth 1 a) m1 m2))
- ((and (math-equal-int (math-sub q2 q1) 1)
- (math-zerop m2)
- (memq (nth 1 a) '(0 2)))
- (math-make-intv (nth 1 a) m1 b))
- (t
- (math-make-intv 2 0 b)))))
-
-
-(defun math-read-angle-brackets ()
- (let* ((last (or (math-check-for-commas t) (length exp-str)))
- (str (substring exp-str exp-pos last))
- (res
- (if (string-match "\\` *\\([a-zA-Z#][a-zA-Z0-9#]* *,? *\\)*:" str)
- (let ((str1 (substring str 0 (1- (match-end 0))))
- (str2 (substring str (match-end 0)))
- (calc-hashes-used 0))
- (setq str1 (math-read-expr (concat "[" str1 "]")))
- (if (eq (car-safe str1) 'error)
- str1
- (setq str2 (math-read-expr str2))
- (if (eq (car-safe str2) 'error)
- str2
- (append '(calcFunc-lambda) (cdr str1) (list str2)))))
- (if (string-match "#" str)
- (let ((calc-hashes-used 0))
- (and (setq str (math-read-expr str))
- (if (eq (car-safe str) 'error)
- str
- (append '(calcFunc-lambda)
- (calc-invent-args calc-hashes-used)
- (list str)))))
- (math-parse-date str)))))
- (if (stringp res)
- (throw 'syntax res))
- (if (eq (car-safe res) 'error)
- (throw 'syntax (nth 2 res)))
- (setq exp-pos (1+ last))
- (math-read-token)
- res))
-
-;;; calc-forms.el ends here
+++ /dev/null
-;;; calc-frac.el --- fraction functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-frac () nil)
-
-(defun calc-fdiv (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op ":" 'calcFunc-fdiv arg 1)))
-
-
-(defun calc-fraction (arg)
- (interactive "P")
- (calc-slow-wrapper
- (let ((func (if (calc-is-hyperbolic) 'calcFunc-frac 'calcFunc-pfrac)))
- (if (eq arg 0)
- (calc-enter-result 2 "frac" (list func
- (calc-top-n 2)
- (calc-top-n 1)))
- (calc-enter-result 1 "frac" (list func
- (calc-top-n 1)
- (prefix-numeric-value (or arg 0))))))))
-
-
-(defun calc-over-notation (fmt)
- (interactive
- (list
- (completing-read "Fraction separator: " (mapcar (lambda (s)
- (cons s 0))
- '(":" "::" "/" "//" ":/"))
- nil t)))
- (calc-wrapper
- (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt)
- (let ((n nil))
- (if (/= (match-end 0) (match-end 1))
- (setq n (string-to-int (substring fmt (match-end 1)))
- fmt (math-match-substring fmt 1)))
- (if (eq n 0) (error "Bad denominator"))
- (calc-change-mode 'calc-frac-format (list fmt n) t))
- (error "Bad fraction separator format"))))
-
-(defun calc-slash-notation (n)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-frac-format (if n '("//" nil) '("/" nil)) t)))
-
-
-(defun calc-frac-mode (n)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-prefer-frac n nil t)
- (message (if calc-prefer-frac
- "Integer division will now generate fractions"
- "Integer division will now generate floating-point results"))))
-
-
-;;;; Fractions.
-
-;;; Build a normalized fraction. [R I I]
-;;; (This could probably be implemented more efficiently than using
-;;; the plain gcd algorithm.)
-(defun math-make-frac (num den)
- (if (Math-integer-negp den)
- (setq num (math-neg num)
- den (math-neg den)))
- (let ((gcd (math-gcd num den)))
- (if (eq gcd 1)
- (if (eq den 1)
- num
- (list 'frac num den))
- (if (equal gcd den)
- (math-quotient num gcd)
- (list 'frac (math-quotient num gcd) (math-quotient den gcd))))))
-
-(defun calc-add-fractions (a b)
- (if (eq (car-safe a) 'frac)
- (if (eq (car-safe b) 'frac)
- (math-make-frac (math-add (math-mul (nth 1 a) (nth 2 b))
- (math-mul (nth 2 a) (nth 1 b)))
- (math-mul (nth 2 a) (nth 2 b)))
- (math-make-frac (math-add (nth 1 a)
- (math-mul (nth 2 a) b))
- (nth 2 a)))
- (math-make-frac (math-add (math-mul a (nth 2 b))
- (nth 1 b))
- (nth 2 b))))
-
-(defun calc-mul-fractions (a b)
- (if (eq (car-safe a) 'frac)
- (if (eq (car-safe b) 'frac)
- (math-make-frac (math-mul (nth 1 a) (nth 1 b))
- (math-mul (nth 2 a) (nth 2 b)))
- (math-make-frac (math-mul (nth 1 a) b)
- (nth 2 a)))
- (math-make-frac (math-mul a (nth 1 b))
- (nth 2 b))))
-
-(defun calc-div-fractions (a b)
- (if (eq (car-safe a) 'frac)
- (if (eq (car-safe b) 'frac)
- (math-make-frac (math-mul (nth 1 a) (nth 2 b))
- (math-mul (nth 2 a) (nth 1 b)))
- (math-make-frac (nth 1 a)
- (math-mul (nth 2 a) b)))
- (math-make-frac (math-mul a (nth 2 b))
- (nth 1 b))))
-
-
-;;; Convert a real value to fractional form. [T R I; T R F] [Public]
-(defun calcFunc-frac (a &optional tol)
- (or tol (setq tol 0))
- (cond ((Math-ratp a)
- a)
- ((memq (car a) '(cplx polar vec hms date sdev intv mod))
- (cons (car a) (mapcar (function
- (lambda (x)
- (calcFunc-frac x tol)))
- (cdr a))))
- ((Math-messy-integerp a)
- (math-trunc a))
- ((Math-negp a)
- (math-neg (calcFunc-frac (math-neg a) tol)))
- ((not (eq (car a) 'float))
- (if (math-infinitep a)
- a
- (if (math-provably-integerp a)
- a
- (math-reject-arg a 'numberp))))
- ((integerp tol)
- (if (<= tol 0)
- (setq tol (+ tol calc-internal-prec)))
- (calcFunc-frac a (list 'float 5
- (- (+ (math-numdigs (nth 1 a))
- (nth 2 a))
- (1+ tol)))))
- ((not (eq (car tol) 'float))
- (if (Math-realp tol)
- (calcFunc-frac a (math-float tol))
- (math-reject-arg tol 'realp)))
- ((Math-negp tol)
- (calcFunc-frac a (math-neg tol)))
- ((Math-zerop tol)
- (calcFunc-frac a 0))
- ((not (math-lessp-float tol '(float 1 0)))
- (math-trunc a))
- ((Math-zerop a)
- 0)
- (t
- (let ((cfrac (math-continued-fraction a tol))
- (calc-prefer-frac t))
- (math-eval-continued-fraction cfrac)))))
-
-(defun math-continued-fraction (a tol)
- (let ((calc-internal-prec (+ calc-internal-prec 2)))
- (let ((cfrac nil)
- (aa a)
- (calc-prefer-frac nil)
- int)
- (while (or (null cfrac)
- (and (not (Math-zerop aa))
- (not (math-lessp-float
- (math-abs
- (math-sub a
- (let ((f (math-eval-continued-fraction
- cfrac)))
- (math-working "Fractionalize" f)
- f)))
- tol))))
- (setq int (math-trunc aa)
- aa (math-sub aa int)
- cfrac (cons int cfrac))
- (or (Math-zerop aa)
- (setq aa (math-div 1 aa))))
- cfrac)))
-
-(defun math-eval-continued-fraction (cf)
- (let ((n (car cf))
- (d 1)
- temp)
- (while (setq cf (cdr cf))
- (setq temp (math-add (math-mul (car cf) n) d)
- d n
- n temp))
- (math-div n d)))
-
-
-
-(defun calcFunc-fdiv (a b) ; [R I I] [Public]
- (if (Math-num-integerp a)
- (if (Math-num-integerp b)
- (if (Math-zerop b)
- (math-reject-arg a "*Division by zero")
- (math-make-frac (math-trunc a) (math-trunc b)))
- (math-reject-arg b 'integerp))
- (math-reject-arg a 'integerp)))
-
-;;; calc-frac.el ends here
+++ /dev/null
-;;; calc-funcs.el --- well-known functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-funcs () nil)
-
-
-(defun calc-inc-gamma (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (if (calc-is-hyperbolic)
- (calc-binary-op "gamG" 'calcFunc-gammaG arg)
- (calc-binary-op "gamQ" 'calcFunc-gammaQ arg))
- (if (calc-is-hyperbolic)
- (calc-binary-op "gamg" 'calcFunc-gammag arg)
- (calc-binary-op "gamP" 'calcFunc-gammaP arg)))))
-
-(defun calc-erf (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-unary-op "erfc" 'calcFunc-erfc arg)
- (calc-unary-op "erf" 'calcFunc-erf arg))))
-
-(defun calc-erfc (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-erf arg))
-
-(defun calc-beta (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "beta" 'calcFunc-beta arg)))
-
-(defun calc-inc-beta ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-enter-result 3 "betB" (cons 'calcFunc-betaB (calc-top-list-n 3)))
- (calc-enter-result 3 "betI" (cons 'calcFunc-betaI (calc-top-list-n 3))))))
-
-(defun calc-bessel-J (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "besJ" 'calcFunc-besJ arg)))
-
-(defun calc-bessel-Y (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "besY" 'calcFunc-besY arg)))
-
-(defun calc-bernoulli-number (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-binary-op "bern" 'calcFunc-bern arg)
- (calc-unary-op "bern" 'calcFunc-bern arg))))
-
-(defun calc-euler-number (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-binary-op "eulr" 'calcFunc-euler arg)
- (calc-unary-op "eulr" 'calcFunc-euler arg))))
-
-(defun calc-stirling-number (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-binary-op "str2" 'calcFunc-stir2 arg)
- (calc-binary-op "str1" 'calcFunc-stir1 arg))))
-
-(defun calc-utpb ()
- (interactive)
- (calc-prob-dist "b" 3))
-
-(defun calc-utpc ()
- (interactive)
- (calc-prob-dist "c" 2))
-
-(defun calc-utpf ()
- (interactive)
- (calc-prob-dist "f" 3))
-
-(defun calc-utpn ()
- (interactive)
- (calc-prob-dist "n" 3))
-
-(defun calc-utpp ()
- (interactive)
- (calc-prob-dist "p" 2))
-
-(defun calc-utpt ()
- (interactive)
- (calc-prob-dist "t" 2))
-
-(defun calc-prob-dist (letter nargs)
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-enter-result nargs (concat "ltp" letter)
- (append (list (intern (concat "calcFunc-ltp" letter))
- (calc-top-n 1))
- (calc-top-list-n (1- nargs) 2)))
- (calc-enter-result nargs (concat "utp" letter)
- (append (list (intern (concat "calcFunc-utp" letter))
- (calc-top-n 1))
- (calc-top-list-n (1- nargs) 2))))))
-
-
-
-
-;;; Sources: Numerical Recipes, Press et al;
-;;; Handbook of Mathematical Functions, Abramowitz & Stegun.
-
-
-;;; Gamma function.
-
-(defun calcFunc-gamma (x)
- (or (math-numberp x) (math-reject-arg x 'numberp))
- (calcFunc-fact (math-add x -1)))
-
-(defun math-gammap1-raw (x &optional fprec nfprec) ; compute gamma(1 + x)
- (or fprec
- (setq fprec (math-float calc-internal-prec)
- nfprec (math-float (- calc-internal-prec))))
- (cond ((math-lessp-float (calcFunc-re x) fprec)
- (if (math-lessp-float (calcFunc-re x) nfprec)
- (math-neg (math-div
- (math-pi)
- (math-mul (math-gammap1-raw
- (math-add (math-neg x)
- '(float -1 0))
- fprec nfprec)
- (math-sin-raw
- (math-mul (math-pi) x)))))
- (let ((xplus1 (math-add x '(float 1 0))))
- (math-div (math-gammap1-raw xplus1 fprec nfprec) xplus1))))
- ((and (math-realp x)
- (math-lessp-float '(float 736276 0) x))
- (math-overflow))
- (t ; re(x) now >= 10.0
- (let ((xinv (math-div 1 x))
- (lnx (math-ln-raw x)))
- (math-mul (math-sqrt-two-pi)
- (math-exp-raw
- (math-gamma-series
- (math-sub (math-mul (math-add x '(float 5 -1))
- lnx)
- x)
- xinv
- (math-sqr xinv)
- '(float 0 0)
- 2)))))))
-
-(defun math-gamma-series (sum x xinvsqr oterm n)
- (math-working "gamma" sum)
- (let* ((bn (math-bernoulli-number n))
- (term (math-mul (math-div-float (math-float (nth 1 bn))
- (math-float (* (nth 2 bn)
- (* n (1- n)))))
- x))
- (next (math-add sum term)))
- (if (math-nearly-equal sum next)
- next
- (if (> n (* 2 calc-internal-prec))
- (progn
- ;; Need this because series eventually diverges for large enough n.
- (calc-record-why
- "*Gamma computation stopped early, not all digits may be valid")
- next)
- (math-gamma-series next (math-mul x xinvsqr) xinvsqr term (+ n 2))))))
-
-
-;;; Incomplete gamma function.
-
-(defvar math-current-gamma-value nil)
-(defun calcFunc-gammaP (a x)
- (if (equal x '(var inf var-inf))
- '(float 1 0)
- (math-inexact-result)
- (or (Math-numberp a) (math-reject-arg a 'numberp))
- (or (math-numberp x) (math-reject-arg x 'numberp))
- (if (and (math-num-integerp a)
- (integerp (setq a (math-trunc a)))
- (> a 0) (< a 20))
- (math-sub 1 (calcFunc-gammaQ a x))
- (let ((math-current-gamma-value (calcFunc-gamma a)))
- (math-div (calcFunc-gammag a x) math-current-gamma-value)))))
-
-(defun calcFunc-gammaQ (a x)
- (if (equal x '(var inf var-inf))
- '(float 0 0)
- (math-inexact-result)
- (or (Math-numberp a) (math-reject-arg a 'numberp))
- (or (math-numberp x) (math-reject-arg x 'numberp))
- (if (and (math-num-integerp a)
- (integerp (setq a (math-trunc a)))
- (> a 0) (< a 20))
- (let ((n 0)
- (sum '(float 1 0))
- (term '(float 1 0)))
- (math-with-extra-prec 1
- (while (< (setq n (1+ n)) a)
- (setq term (math-div (math-mul term x) n)
- sum (math-add sum term))
- (math-working "gamma" sum))
- (math-mul sum (calcFunc-exp (math-neg x)))))
- (let ((math-current-gamma-value (calcFunc-gamma a)))
- (math-div (calcFunc-gammaG a x) math-current-gamma-value)))))
-
-(defun calcFunc-gammag (a x)
- (if (equal x '(var inf var-inf))
- (calcFunc-gamma a)
- (math-inexact-result)
- (or (Math-numberp a) (math-reject-arg a 'numberp))
- (or (Math-numberp x) (math-reject-arg x 'numberp))
- (math-with-extra-prec 2
- (setq a (math-float a))
- (setq x (math-float x))
- (if (or (math-negp (calcFunc-re a))
- (math-lessp-float (calcFunc-re x)
- (math-add-float (calcFunc-re a)
- '(float 1 0))))
- (math-inc-gamma-series a x)
- (math-sub (or math-current-gamma-value (calcFunc-gamma a))
- (math-inc-gamma-cfrac a x))))))
-
-(defun calcFunc-gammaG (a x)
- (if (equal x '(var inf var-inf))
- '(float 0 0)
- (math-inexact-result)
- (or (Math-numberp a) (math-reject-arg a 'numberp))
- (or (Math-numberp x) (math-reject-arg x 'numberp))
- (math-with-extra-prec 2
- (setq a (math-float a))
- (setq x (math-float x))
- (if (or (math-negp (calcFunc-re a))
- (math-lessp-float (calcFunc-re x)
- (math-add-float (math-abs-approx a)
- '(float 1 0))))
- (math-sub (or math-current-gamma-value (calcFunc-gamma a))
- (math-inc-gamma-series a x))
- (math-inc-gamma-cfrac a x)))))
-
-(defun math-inc-gamma-series (a x)
- (if (Math-zerop x)
- '(float 0 0)
- (math-mul (math-exp-raw (math-sub (math-mul a (math-ln-raw x)) x))
- (math-with-extra-prec 2
- (let ((start (math-div '(float 1 0) a)))
- (math-inc-gamma-series-step start start a x))))))
-
-(defun math-inc-gamma-series-step (sum term a x)
- (math-working "gamma" sum)
- (setq a (math-add a '(float 1 0))
- term (math-div (math-mul term x) a))
- (let ((next (math-add sum term)))
- (if (math-nearly-equal sum next)
- next
- (math-inc-gamma-series-step next term a x))))
-
-(defun math-inc-gamma-cfrac (a x)
- (if (Math-zerop x)
- (or math-current-gamma-value (calcFunc-gamma a))
- (math-mul (math-exp-raw (math-sub (math-mul a (math-ln-raw x)) x))
- (math-inc-gamma-cfrac-step '(float 1 0) x
- '(float 0 0) '(float 1 0)
- '(float 1 0) '(float 1 0) '(float 0 0)
- a x))))
-
-(defun math-inc-gamma-cfrac-step (a0 a1 b0 b1 n fac g a x)
- (let ((ana (math-sub n a))
- (anf (math-mul n fac)))
- (setq n (math-add n '(float 1 0))
- a0 (math-mul (math-add a1 (math-mul a0 ana)) fac)
- b0 (math-mul (math-add b1 (math-mul b0 ana)) fac)
- a1 (math-add (math-mul x a0) (math-mul anf a1))
- b1 (math-add (math-mul x b0) (math-mul anf b1)))
- (if (math-zerop a1)
- (math-inc-gamma-cfrac-step a0 a1 b0 b1 n fac g a x)
- (setq fac (math-div '(float 1 0) a1))
- (let ((next (math-mul b1 fac)))
- (math-working "gamma" next)
- (if (math-nearly-equal next g)
- next
- (math-inc-gamma-cfrac-step a0 a1 b0 b1 n fac next a x))))))
-
-
-;;; Error function.
-
-(defun calcFunc-erf (x)
- (if (equal x '(var inf var-inf))
- '(float 1 0)
- (if (equal x '(neg (var inf var-inf)))
- '(float -1 0)
- (if (Math-zerop x)
- x
- (let ((math-current-gamma-value (math-sqrt-pi)))
- (math-to-same-complex-quad
- (math-div (calcFunc-gammag '(float 5 -1)
- (math-sqr (math-to-complex-quad-one x)))
- math-current-gamma-value)
- x))))))
-
-(defun calcFunc-erfc (x)
- (if (equal x '(var inf var-inf))
- '(float 0 0)
- (if (math-posp x)
- (let ((math-current-gamma-value (math-sqrt-pi)))
- (math-div (calcFunc-gammaG '(float 5 -1) (math-sqr x))
- math-current-gamma-value))
- (math-sub 1 (calcFunc-erf x)))))
-
-(defun math-to-complex-quad-one (x)
- (if (eq (car-safe x) 'polar) (setq x (math-complex x)))
- (if (eq (car-safe x) 'cplx)
- (list 'cplx (math-abs (nth 1 x)) (math-abs (nth 2 x)))
- x))
-
-(defun math-to-same-complex-quad (x y)
- (if (eq (car-safe y) 'cplx)
- (if (eq (car-safe x) 'cplx)
- (list 'cplx
- (if (math-negp (nth 1 y)) (math-neg (nth 1 x)) (nth 1 x))
- (if (math-negp (nth 2 y)) (math-neg (nth 2 x)) (nth 2 x)))
- (if (math-negp (nth 1 y)) (math-neg x) x))
- (if (math-negp y)
- (if (eq (car-safe x) 'cplx)
- (list 'cplx (math-neg (nth 1 x)) (nth 2 x))
- (math-neg x))
- x)))
-
-
-;;; Beta function.
-
-(defun calcFunc-beta (a b)
- (if (math-num-integerp a)
- (let ((am (math-add a -1)))
- (or (math-numberp b) (math-reject-arg b 'numberp))
- (math-div 1 (math-mul b (calcFunc-choose (math-add b am) am))))
- (if (math-num-integerp b)
- (calcFunc-beta b a)
- (math-div (math-mul (calcFunc-gamma a) (calcFunc-gamma b))
- (calcFunc-gamma (math-add a b))))))
-
-
-;;; Incomplete beta function.
-
-(defvar math-current-beta-value nil)
-(defun calcFunc-betaI (x a b)
- (cond ((math-zerop x)
- '(float 0 0))
- ((math-equal-int x 1)
- '(float 1 0))
- ((or (math-zerop a)
- (and (math-num-integerp a)
- (math-negp a)))
- (if (or (math-zerop b)
- (and (math-num-integerp b)
- (math-negp b)))
- (math-reject-arg b 'range)
- '(float 1 0)))
- ((or (math-zerop b)
- (and (math-num-integerp b)
- (math-negp b)))
- '(float 0 0))
- ((not (math-numberp a)) (math-reject-arg a 'numberp))
- ((not (math-numberp b)) (math-reject-arg b 'numberp))
- ((math-inexact-result))
- (t (let ((math-current-beta-value (calcFunc-beta a b)))
- (math-div (calcFunc-betaB x a b) math-current-beta-value)))))
-
-(defun calcFunc-betaB (x a b)
- (cond
- ((math-zerop x)
- '(float 0 0))
- ((math-equal-int x 1)
- (calcFunc-beta a b))
- ((not (math-numberp x)) (math-reject-arg x 'numberp))
- ((not (math-numberp a)) (math-reject-arg a 'numberp))
- ((not (math-numberp b)) (math-reject-arg b 'numberp))
- ((math-zerop a) (math-reject-arg a 'nonzerop))
- ((math-zerop b) (math-reject-arg b 'nonzerop))
- ((and (math-num-integerp b)
- (if (math-negp b)
- (math-reject-arg b 'range)
- (Math-natnum-lessp (setq b (math-trunc b)) 20)))
- (and calc-symbolic-mode (or (math-floatp a) (math-floatp b))
- (math-inexact-result))
- (math-mul
- (math-with-extra-prec 2
- (let* ((i 0)
- (term 1)
- (sum (math-div term a)))
- (while (< (setq i (1+ i)) b)
- (setq term (math-mul (math-div (math-mul term (- i b)) i) x)
- sum (math-add sum (math-div term (math-add a i))))
- (math-working "beta" sum))
- sum))
- (math-pow x a)))
- ((and (math-num-integerp a)
- (if (math-negp a)
- (math-reject-arg a 'range)
- (Math-natnum-lessp (setq a (math-trunc a)) 20)))
- (math-sub (or math-current-beta-value (calcFunc-beta a b))
- (calcFunc-betaB (math-sub 1 x) b a)))
- (t
- (math-inexact-result)
- (math-with-extra-prec 2
- (setq x (math-float x))
- (setq a (math-float a))
- (setq b (math-float b))
- (let ((bt (math-exp-raw (math-add (math-mul a (math-ln-raw x))
- (math-mul b (math-ln-raw
- (math-sub '(float 1 0)
- x)))))))
- (if (Math-lessp x (math-div (math-add a '(float 1 0))
- (math-add (math-add a b) '(float 2 0))))
- (math-div (math-mul bt (math-beta-cfrac a b x)) a)
- (math-sub (or math-current-beta-value (calcFunc-beta a b))
- (math-div (math-mul bt
- (math-beta-cfrac b a (math-sub 1 x)))
- b))))))))
-
-(defun math-beta-cfrac (a b x)
- (let ((qab (math-add a b))
- (qap (math-add a '(float 1 0)))
- (qam (math-add a '(float -1 0))))
- (math-beta-cfrac-step '(float 1 0)
- (math-sub '(float 1 0)
- (math-div (math-mul qab x) qap))
- '(float 1 0) '(float 1 0)
- '(float 1 0)
- qab qap qam a b x)))
-
-(defun math-beta-cfrac-step (az bz am bm m qab qap qam a b x)
- (let* ((two-m (math-mul m '(float 2 0)))
- (d (math-div (math-mul (math-mul (math-sub b m) m) x)
- (math-mul (math-add qam two-m) (math-add a two-m))))
- (ap (math-add az (math-mul d am)))
- (bp (math-add bz (math-mul d bm)))
- (d2 (math-neg
- (math-div (math-mul (math-mul (math-add a m) (math-add qab m)) x)
- (math-mul (math-add qap two-m) (math-add a two-m)))))
- (app (math-add ap (math-mul d2 az)))
- (bpp (math-add bp (math-mul d2 bz)))
- (next (math-div app bpp)))
- (math-working "beta" next)
- (if (math-nearly-equal next az)
- next
- (math-beta-cfrac-step next '(float 1 0)
- (math-div ap bpp) (math-div bp bpp)
- (math-add m '(float 1 0))
- qab qap qam a b x))))
-
-
-;;; Bessel functions.
-
-;;; Should generalize this to handle arbitrary precision!
-
-(defun calcFunc-besJ (v x)
- (or (math-numberp v) (math-reject-arg v 'numberp))
- (or (math-numberp x) (math-reject-arg x 'numberp))
- (let ((calc-internal-prec (min 8 calc-internal-prec)))
- (math-with-extra-prec 3
- (setq x (math-float (math-normalize x)))
- (setq v (math-float (math-normalize v)))
- (cond ((math-zerop x)
- (if (math-zerop v)
- '(float 1 0)
- '(float 0 0)))
- ((math-inexact-result))
- ((not (math-num-integerp v))
- (let ((start (math-div 1 (calcFunc-fact v))))
- (math-mul (math-besJ-series start start
- 0
- (math-mul '(float -25 -2)
- (math-sqr x))
- v)
- (math-pow (math-div x 2) v))))
- ((math-negp (setq v (math-trunc v)))
- (if (math-oddp v)
- (math-neg (calcFunc-besJ (math-neg v) x))
- (calcFunc-besJ (math-neg v) x)))
- ((eq v 0)
- (math-besJ0 x))
- ((eq v 1)
- (math-besJ1 x))
- ((Math-lessp v (math-abs-approx x))
- (let ((j 0)
- (bjm (math-besJ0 x))
- (bj (math-besJ1 x))
- (two-over-x (math-div 2 x))
- bjp)
- (while (< (setq j (1+ j)) v)
- (setq bjp (math-sub (math-mul (math-mul j two-over-x) bj)
- bjm)
- bjm bj
- bj bjp))
- bj))
- (t
- (if (Math-lessp 100 v) (math-reject-arg v 'range))
- (let* ((j (logior (+ v (math-isqrt-small (* 40 v))) 1))
- (two-over-x (math-div 2 x))
- (jsum nil)
- (bjp '(float 0 0))
- (sum '(float 0 0))
- (bj '(float 1 0))
- bjm ans)
- (while (> (setq j (1- j)) 0)
- (setq bjm (math-sub (math-mul (math-mul j two-over-x) bj)
- bjp)
- bjp bj
- bj bjm)
- (if (> (nth 2 (math-abs-approx bj)) 10)
- (setq bj (math-mul bj '(float 1 -10))
- bjp (math-mul bjp '(float 1 -10))
- ans (and ans (math-mul ans '(float 1 -10)))
- sum (math-mul sum '(float 1 -10))))
- (or (setq jsum (not jsum))
- (setq sum (math-add sum bj)))
- (if (= j v)
- (setq ans bjp)))
- (math-div ans (math-sub (math-mul 2 sum) bj))))))))
-
-(defun math-besJ-series (sum term k zz vk)
- (math-working "besJ" sum)
- (setq k (1+ k)
- vk (math-add 1 vk)
- term (math-div (math-mul term zz) (math-mul k vk)))
- (let ((next (math-add sum term)))
- (if (math-nearly-equal next sum)
- next
- (math-besJ-series next term k zz vk))))
-
-(defun math-besJ0 (x &optional yflag)
- (cond ((and (not yflag) (math-negp (calcFunc-re x)))
- (math-besJ0 (math-neg x)))
- ((Math-lessp '(float 8 0) (math-abs-approx x))
- (let* ((z (math-div '(float 8 0) x))
- (y (math-sqr z))
- (xx (math-add x '(float (bigneg 164 398 785) -9)))
- (a1 (math-poly-eval y
- '((float (bigpos 211 887 093 2) -16)
- (float (bigneg 639 370 073 2) -15)
- (float (bigpos 407 510 734 2) -14)
- (float (bigneg 627 628 098 1) -12)
- (float 1 0))))
- (a2 (math-poly-eval y
- '((float (bigneg 152 935 934) -16)
- (float (bigpos 161 095 621 7) -16)
- (float (bigneg 651 147 911 6) -15)
- (float (bigpos 765 488 430 1) -13)
- (float (bigneg 995 499 562 1) -11))))
- (sc (math-sin-cos-raw xx)))
- (if yflag
- (setq sc (cons (math-neg (cdr sc)) (car sc))))
- (math-mul (math-sqrt
- (math-div '(float (bigpos 722 619 636) -9) x))
- (math-sub (math-mul (cdr sc) a1)
- (math-mul (car sc) (math-mul z a2))))))
- (t
- (let ((y (math-sqr x)))
- (math-div (math-poly-eval y
- '((float (bigneg 456 052 849 1) -7)
- (float (bigpos 017 233 739 7) -5)
- (float (bigneg 418 442 121 1) -2)
- (float (bigpos 407 196 516 6) -1)
- (float (bigneg 354 590 362 13) 0)
- (float (bigpos 574 490 568 57) 0)))
- (math-poly-eval y
- '((float 1 0)
- (float (bigpos 712 532 678 2) -7)
- (float (bigpos 853 264 927 5) -5)
- (float (bigpos 718 680 494 9) -3)
- (float (bigpos 985 532 029 1) 0)
- (float (bigpos 411 490 568 57) 0))))))))
-
-(defun math-besJ1 (x &optional yflag)
- (cond ((and (math-negp (calcFunc-re x)) (not yflag))
- (math-neg (math-besJ1 (math-neg x))))
- ((Math-lessp '(float 8 0) (math-abs-approx x))
- (let* ((z (math-div '(float 8 0) x))
- (y (math-sqr z))
- (xx (math-add x '(float (bigneg 491 194 356 2) -9)))
- (a1 (math-poly-eval y
- '((float (bigneg 019 337 240) -15)
- (float (bigpos 174 520 457 2) -15)
- (float (bigneg 496 396 516 3) -14)
- (float 183105 -8)
- (float 1 0))))
- (a2 (math-poly-eval y
- '((float (bigpos 412 787 105) -15)
- (float (bigneg 987 228 88) -14)
- (float (bigpos 096 199 449 8) -15)
- (float (bigneg 873 690 002 2) -13)
- (float (bigpos 995 499 687 4) -11))))
- (sc (math-sin-cos-raw xx)))
- (if yflag
- (setq sc (cons (math-neg (cdr sc)) (car sc)))
- (if (math-negp x)
- (setq sc (cons (math-neg (car sc)) (math-neg (cdr sc))))))
- (math-mul (math-sqrt (math-div '(float (bigpos 722 619 636) -9) x))
- (math-sub (math-mul (cdr sc) a1)
- (math-mul (car sc) (math-mul z a2))))))
- (t
- (let ((y (math-sqr x)))
- (math-mul
- x
- (math-div (math-poly-eval y
- '((float (bigneg 606 036 016 3) -8)
- (float (bigpos 826 044 157) -4)
- (float (bigneg 439 611 972 2) -3)
- (float (bigpos 531 968 423 2) -1)
- (float (bigneg 235 059 895 7) 0)
- (float (bigpos 232 614 362 72) 0)))
- (math-poly-eval y
- '((float 1 0)
- (float (bigpos 397 991 769 3) -7)
- (float (bigpos 394 743 944 9) -5)
- (float (bigpos 474 330 858 1) -2)
- (float (bigpos 178 535 300 2) 0)
- (float (bigpos 442 228 725 144)
- 0)))))))))
-
-(defun calcFunc-besY (v x)
- (math-inexact-result)
- (or (math-numberp v) (math-reject-arg v 'numberp))
- (or (math-numberp x) (math-reject-arg x 'numberp))
- (let ((calc-internal-prec (min 8 calc-internal-prec)))
- (math-with-extra-prec 3
- (setq x (math-float (math-normalize x)))
- (setq v (math-float (math-normalize v)))
- (cond ((not (math-num-integerp v))
- (let ((sc (math-sin-cos-raw (math-mul v (math-pi)))))
- (math-div (math-sub (math-mul (calcFunc-besJ v x) (cdr sc))
- (calcFunc-besJ (math-neg v) x))
- (car sc))))
- ((math-negp (setq v (math-trunc v)))
- (if (math-oddp v)
- (math-neg (calcFunc-besY (math-neg v) x))
- (calcFunc-besY (math-neg v) x)))
- ((eq v 0)
- (math-besY0 x))
- ((eq v 1)
- (math-besY1 x))
- (t
- (let ((j 0)
- (bym (math-besY0 x))
- (by (math-besY1 x))
- (two-over-x (math-div 2 x))
- byp)
- (while (< (setq j (1+ j)) v)
- (setq byp (math-sub (math-mul (math-mul j two-over-x) by)
- bym)
- bym by
- by byp))
- by))))))
-
-(defun math-besY0 (x)
- (cond ((Math-lessp (math-abs-approx x) '(float 8 0))
- (let ((y (math-sqr x)))
- (math-add
- (math-div (math-poly-eval y
- '((float (bigpos 733 622 284 2) -7)
- (float (bigneg 757 792 632 8) -5)
- (float (bigpos 129 988 087 1) -2)
- (float (bigneg 036 598 123 5) -1)
- (float (bigpos 065 834 062 7) 0)
- (float (bigneg 389 821 957 2) 0)))
- (math-poly-eval y
- '((float 1 0)
- (float (bigpos 244 030 261 2) -7)
- (float (bigpos 647 472 474) -4)
- (float (bigpos 438 466 189 7) -3)
- (float (bigpos 648 499 452 7) -1)
- (float (bigpos 269 544 076 40) 0))))
- (math-mul '(float (bigpos 772 619 636) -9)
- (math-mul (math-besJ0 x) (math-ln-raw x))))))
- ((math-negp (calcFunc-re x))
- (math-add (math-besJ0 (math-neg x) t)
- (math-mul '(cplx 0 2)
- (math-besJ0 (math-neg x)))))
- (t
- (math-besJ0 x t))))
-
-(defun math-besY1 (x)
- (cond ((Math-lessp (math-abs-approx x) '(float 8 0))
- (let ((y (math-sqr x)))
- (math-add
- (math-mul
- x
- (math-div (math-poly-eval y
- '((float (bigpos 935 937 511 8) -6)
- (float (bigneg 726 922 237 4) -3)
- (float (bigpos 551 264 349 7) -1)
- (float (bigneg 139 438 153 5) 1)
- (float (bigpos 439 527 127) 4)
- (float (bigneg 943 604 900 4) 3)))
- (math-poly-eval y
- '((float 1 0)
- (float (bigpos 885 632 549 3) -7)
- (float (bigpos 605 042 102) -3)
- (float (bigpos 002 904 245 2) -2)
- (float (bigpos 367 650 733 3) 0)
- (float (bigpos 664 419 244 4) 2)
- (float (bigpos 057 958 249) 5)))))
- (math-mul '(float (bigpos 772 619 636) -9)
- (math-sub (math-mul (math-besJ1 x) (math-ln-raw x))
- (math-div 1 x))))))
- ((math-negp (calcFunc-re x))
- (math-neg
- (math-add (math-besJ1 (math-neg x) t)
- (math-mul '(cplx 0 2)
- (math-besJ1 (math-neg x))))))
- (t
- (math-besJ1 x t))))
-
-(defun math-poly-eval (x coefs)
- (let ((accum (car coefs)))
- (while (setq coefs (cdr coefs))
- (setq accum (math-add (car coefs) (math-mul accum x))))
- accum))
-
-
-;;;; Bernoulli and Euler polynomials and numbers.
-
-(defun calcFunc-bern (n &optional x)
- (if (and x (not (math-zerop x)))
- (if (and calc-symbolic-mode (math-floatp x))
- (math-inexact-result)
- (math-build-polynomial-expr (math-bernoulli-coefs n) x))
- (or (math-num-natnump n) (math-reject-arg n 'natnump))
- (if (consp n)
- (progn
- (math-inexact-result)
- (math-float (math-bernoulli-number (math-trunc n))))
- (math-bernoulli-number n))))
-
-(defun calcFunc-euler (n &optional x)
- (or (math-num-natnump n) (math-reject-arg n 'natnump))
- (if x
- (let* ((n1 (math-add n 1))
- (coefs (math-bernoulli-coefs n1))
- (fac (math-div (math-pow 2 n1) n1))
- (k -1)
- (x1 (math-div (math-add x 1) 2))
- (x2 (math-div x 2)))
- (if (math-numberp x)
- (if (and calc-symbolic-mode (math-floatp x))
- (math-inexact-result)
- (math-mul fac
- (math-sub (math-build-polynomial-expr coefs x1)
- (math-build-polynomial-expr coefs x2))))
- (calcFunc-collect
- (math-reduce-vec
- 'math-add
- (cons 'vec
- (mapcar (function
- (lambda (c)
- (setq k (1+ k))
- (math-mul (math-mul fac c)
- (math-sub (math-pow x1 k)
- (math-pow x2 k)))))
- coefs)))
- x)))
- (math-mul (math-pow 2 n)
- (if (consp n)
- (progn
- (math-inexact-result)
- (calcFunc-euler n '(float 5 -1)))
- (calcFunc-euler n '(frac 1 2))))))
-
-(defvar math-bernoulli-b-cache '((frac -174611
- (bigpos 0 200 291 698 662 857 802))
- (frac 43867 (bigpos 0 944 170 217 94 109 5))
- (frac -3617 (bigpos 0 880 842 622 670 10))
- (frac 1 (bigpos 600 249 724 74))
- (frac -691 (bigpos 0 368 674 307 1))
- (frac 1 (bigpos 160 900 47))
- (frac -1 (bigpos 600 209 1))
- (frac 1 30240) (frac -1 720)
- (frac 1 12) 1 ))
-
-(defvar math-bernoulli-B-cache '((frac -174611 330) (frac 43867 798)
- (frac -3617 510) (frac 7 6) (frac -691 2730)
- (frac 5 66) (frac -1 30) (frac 1 42)
- (frac -1 30) (frac 1 6) 1 ))
-
-(defvar math-bernoulli-cache-size 11)
-(defun math-bernoulli-coefs (n)
- (let* ((coefs (list (calcFunc-bern n)))
- (nn (math-trunc n))
- (k nn)
- (term nn)
- coef
- (calc-prefer-frac (or (integerp n) calc-prefer-frac)))
- (while (>= (setq k (1- k)) 0)
- (setq term (math-div term (- nn k))
- coef (math-mul term (math-bernoulli-number k))
- coefs (cons (if (consp n) (math-float coef) coef) coefs)
- term (math-mul term k)))
- (nreverse coefs)))
-
-(defun math-bernoulli-number (n)
- (if (= (% n 2) 1)
- (if (= n 1)
- '(frac -1 2)
- 0)
- (setq n (/ n 2))
- (while (>= n math-bernoulli-cache-size)
- (let* ((sum 0)
- (nk 1) ; nk = n-k+1
- (fact 1) ; fact = (n-k+1)!
- ofact
- (p math-bernoulli-b-cache)
- (calc-prefer-frac t))
- (math-working "bernoulli B" (* 2 math-bernoulli-cache-size))
- (while p
- (setq nk (+ nk 2)
- ofact fact
- fact (math-mul fact (* nk (1- nk)))
- sum (math-add sum (math-div (car p) fact))
- p (cdr p)))
- (setq ofact (math-mul ofact (1- nk))
- sum (math-sub (math-div '(frac 1 2) ofact) sum)
- math-bernoulli-b-cache (cons sum math-bernoulli-b-cache)
- math-bernoulli-B-cache (cons (math-mul sum ofact)
- math-bernoulli-B-cache)
- math-bernoulli-cache-size (1+ math-bernoulli-cache-size))))
- (nth (- math-bernoulli-cache-size n 1) math-bernoulli-B-cache)))
-
-;;; Bn = n! bn
-;;; bn = - sum_k=0^n-1 bk / (n-k+1)!
-
-;;; A faster method would be to use "tangent numbers", c.f., Concrete
-;;; Mathematics pg. 273.
-
-
-;;; Probability distributions.
-
-;;; Binomial.
-(defun calcFunc-utpb (x n p)
- (if math-expand-formulas
- (math-normalize (list 'calcFunc-betaI p x (list '+ (list '- n x) 1)))
- (calcFunc-betaI p x (math-add (math-sub n x) 1))))
-(put 'calcFunc-utpb 'math-expandable t)
-
-(defun calcFunc-ltpb (x n p)
- (math-sub 1 (calcFunc-utpb x n p)))
-(put 'calcFunc-ltpb 'math-expandable t)
-
-;;; Chi-square.
-(defun calcFunc-utpc (chisq v)
- (if math-expand-formulas
- (math-normalize (list 'calcFunc-gammaQ (list '/ v 2) (list '/ chisq 2)))
- (calcFunc-gammaQ (math-div v 2) (math-div chisq 2))))
-(put 'calcFunc-utpc 'math-expandable t)
-
-(defun calcFunc-ltpc (chisq v)
- (if math-expand-formulas
- (math-normalize (list 'calcFunc-gammaP (list '/ v 2) (list '/ chisq 2)))
- (calcFunc-gammaP (math-div v 2) (math-div chisq 2))))
-(put 'calcFunc-ltpc 'math-expandable t)
-
-;;; F-distribution.
-(defun calcFunc-utpf (f v1 v2)
- (if math-expand-formulas
- (math-normalize (list 'calcFunc-betaI
- (list '/ v2 (list '+ v2 (list '* v1 f)))
- (list '/ v2 2)
- (list '/ v1 2)))
- (calcFunc-betaI (math-div v2 (math-add v2 (math-mul v1 f)))
- (math-div v2 2)
- (math-div v1 2))))
-(put 'calcFunc-utpf 'math-expandable t)
-
-(defun calcFunc-ltpf (f v1 v2)
- (math-sub 1 (calcFunc-utpf f v1 v2)))
-(put 'calcFunc-ltpf 'math-expandable t)
-
-;;; Normal.
-(defun calcFunc-utpn (x mean sdev)
- (if math-expand-formulas
- (math-normalize
- (list '/
- (list '+ 1
- (list 'calcFunc-erf
- (list '/ (list '- mean x)
- (list '* sdev (list 'calcFunc-sqrt 2)))))
- 2))
- (math-mul (math-add '(float 1 0)
- (calcFunc-erf
- (math-div (math-sub mean x)
- (math-mul sdev (math-sqrt-2)))))
- '(float 5 -1))))
-(put 'calcFunc-utpn 'math-expandable t)
-
-(defun calcFunc-ltpn (x mean sdev)
- (if math-expand-formulas
- (math-normalize
- (list '/
- (list '+ 1
- (list 'calcFunc-erf
- (list '/ (list '- x mean)
- (list '* sdev (list 'calcFunc-sqrt 2)))))
- 2))
- (math-mul (math-add '(float 1 0)
- (calcFunc-erf
- (math-div (math-sub x mean)
- (math-mul sdev (math-sqrt-2)))))
- '(float 5 -1))))
-(put 'calcFunc-ltpn 'math-expandable t)
-
-;;; Poisson.
-(defun calcFunc-utpp (n x)
- (if math-expand-formulas
- (math-normalize (list 'calcFunc-gammaP x n))
- (calcFunc-gammaP x n)))
-(put 'calcFunc-utpp 'math-expandable t)
-
-(defun calcFunc-ltpp (n x)
- (if math-expand-formulas
- (math-normalize (list 'calcFunc-gammaQ x n))
- (calcFunc-gammaQ x n)))
-(put 'calcFunc-ltpp 'math-expandable t)
-
-;;; Student's t. (As defined in Abramowitz & Stegun and Numerical Recipes.)
-(defun calcFunc-utpt (tt v)
- (if math-expand-formulas
- (math-normalize (list 'calcFunc-betaI
- (list '/ v (list '+ v (list '^ tt 2)))
- (list '/ v 2)
- '(float 5 -1)))
- (calcFunc-betaI (math-div v (math-add v (math-sqr tt)))
- (math-div v 2)
- '(float 5 -1))))
-(put 'calcFunc-utpt 'math-expandable t)
-
-(defun calcFunc-ltpt (tt v)
- (math-sub 1 (calcFunc-utpt tt v)))
-(put 'calcFunc-ltpt 'math-expandable t)
-
-
-;;; calc-funcs.el ends here
+++ /dev/null
-;;; calc-graph.el --- graph output functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-graph () nil)
-
-
-;;; Graphics
-
-;;; Note that some of the following initial values also occur in calc.el.
-(defvar calc-gnuplot-tempfile "calc")
-
-(defvar calc-gnuplot-default-device "default")
-(defvar calc-gnuplot-default-output "STDOUT")
-(defvar calc-gnuplot-print-device "postscript")
-(defvar calc-gnuplot-print-output "auto")
-(defvar calc-gnuplot-keep-outfile nil)
-(defvar calc-gnuplot-version nil)
-
-(defvar calc-gnuplot-display (getenv "DISPLAY"))
-(defvar calc-gnuplot-geometry nil)
-
-(defvar calc-graph-default-resolution 15)
-(defvar calc-graph-default-resolution-3d 5)
-(defvar calc-graph-default-precision 5)
-
-(defvar calc-gnuplot-buffer nil)
-(defvar calc-gnuplot-input nil)
-
-(defvar calc-gnuplot-last-error-pos 1)
-(defvar calc-graph-last-device nil)
-(defvar calc-graph-last-output nil)
-(defvar calc-graph-file-cache nil)
-(defvar calc-graph-var-cache nil)
-(defvar calc-graph-data-cache nil)
-(defvar calc-graph-data-cache-limit 10)
-(defvar calc-graph-no-auto-view nil)
-(defvar calc-graph-no-wait nil)
-
-(defun calc-graph-fast (many)
- (interactive "P")
- (let ((calc-graph-no-auto-view t))
- (calc-graph-delete t)
- (calc-graph-add many)
- (calc-graph-plot nil)))
-
-(defun calc-graph-fast-3d (many)
- (interactive "P")
- (let ((calc-graph-no-auto-view t))
- (calc-graph-delete t)
- (calc-graph-add-3d many)
- (calc-graph-plot nil)))
-
-(defun calc-graph-delete (all)
- (interactive "P")
- (calc-wrapper
- (calc-graph-init)
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (and (calc-graph-find-plot t all)
- (progn
- (if (looking-at "s?plot")
- (progn
- (setq calc-graph-var-cache nil)
- (delete-region (point) (point-max)))
- (delete-region (point) (1- (point-max)))))))
- (calc-graph-view-commands)))
-
-(defun calc-graph-find-plot (&optional before all)
- (goto-char (point-min))
- (and (re-search-forward "^s?plot[ \t]+" nil t)
- (let ((beg (point)))
- (goto-char (point-max))
- (if (or all
- (not (search-backward "," nil t))
- (< (point) beg))
- (progn
- (goto-char beg)
- (if before
- (beginning-of-line)))
- (or before
- (re-search-forward ",[ \t]+")))
- t)))
-
-(defun calc-graph-add (many)
- (interactive "P")
- (calc-wrapper
- (calc-graph-init)
- (cond ((null many)
- (calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
- (calc-graph-lookup (calc-top-n 1))))
- ((or (consp many) (eq many 0))
- (let ((xdata (calc-graph-lookup (calc-top-n 2)))
- (ylist (calc-top-n 1)))
- (or (eq (car-safe ylist) 'vec)
- (error "Y argument must be a vector"))
- (while (setq ylist (cdr ylist))
- (calc-graph-add-curve xdata (calc-graph-lookup (car ylist))))))
- ((> (setq many (prefix-numeric-value many)) 0)
- (let ((xdata (calc-graph-lookup (calc-top-n (1+ many)))))
- (while (> many 0)
- (calc-graph-add-curve xdata
- (calc-graph-lookup (calc-top-n many)))
- (setq many (1- many)))))
- (t
- (let (pair)
- (setq many (- many))
- (while (> many 0)
- (setq pair (calc-top-n many))
- (or (and (eq (car-safe pair) 'vec)
- (= (length pair) 3))
- (error "Argument must be an [x,y] vector"))
- (calc-graph-add-curve (calc-graph-lookup (nth 1 pair))
- (calc-graph-lookup (nth 2 pair)))
- (setq many (1- many))))))
- (calc-graph-view-commands)))
-
-(defun calc-graph-add-3d (many)
- (interactive "P")
- (calc-wrapper
- (calc-graph-init)
- (cond ((null many)
- (calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
- (calc-graph-lookup (calc-top-n 2))
- (calc-graph-lookup (calc-top-n 1))))
- ((or (consp many) (eq many 0))
- (let ((xdata (calc-graph-lookup (calc-top-n 3)))
- (ydata (calc-graph-lookup (calc-top-n 2)))
- (zlist (calc-top-n 1)))
- (or (eq (car-safe zlist) 'vec)
- (error "Z argument must be a vector"))
- (while (setq zlist (cdr zlist))
- (calc-graph-add-curve xdata ydata
- (calc-graph-lookup (car zlist))))))
- ((> (setq many (prefix-numeric-value many)) 0)
- (let ((xdata (calc-graph-lookup (calc-top-n (+ many 2))))
- (ydata (calc-graph-lookup (calc-top-n (+ many 1)))))
- (while (> many 0)
- (calc-graph-add-curve xdata ydata
- (calc-graph-lookup (calc-top-n many)))
- (setq many (1- many)))))
- (t
- (let (curve)
- (setq many (- many))
- (while (> many 0)
- (setq curve (calc-top-n many))
- (or (and (eq (car-safe curve) 'vec)
- (= (length curve) 4))
- (error "Argument must be an [x,y,z] vector"))
- (calc-graph-add-curve (calc-graph-lookup (nth 1 curve))
- (calc-graph-lookup (nth 2 curve))
- (calc-graph-lookup (nth 3 curve)))
- (setq many (1- many))))))
- (calc-graph-view-commands)))
-
-(defun calc-graph-add-curve (xdata ydata &optional zdata)
- (let ((num (calc-graph-count-curves))
- (pstyle (calc-var-value 'var-PointStyles))
- (lstyle (calc-var-value 'var-LineStyles)))
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (goto-char (point-min))
- (if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
- nil t)
- (error "Can't mix 2d and 3d curves on one graph"))
- (if (re-search-forward "^s?plot[ \t]" nil t)
- (progn
- (end-of-line)
- (insert ", "))
- (goto-char (point-max))
- (or (eq (preceding-char) ?\n)
- (insert "\n"))
- (insert (if zdata "splot" "plot") " \n")
- (forward-char -1))
- (insert "{" (symbol-name (nth 1 xdata))
- ":" (symbol-name (nth 1 ydata)))
- (if zdata
- (insert ":" (symbol-name (nth 1 zdata))))
- (insert "} "
- "title \"" (symbol-name (nth 1 ydata)) "\" "
- "with dots")
- (setq pstyle (and (eq (car-safe pstyle) 'vec) (nth (1+ num) pstyle)))
- (setq lstyle (and (eq (car-safe lstyle) 'vec) (nth (1+ num) lstyle)))
- (calc-graph-set-styles
- (or (and (Math-num-integerp lstyle) (math-trunc lstyle))
- 0)
- (or (and (Math-num-integerp pstyle) (math-trunc pstyle))
- (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
- 0 -1))))))
-
-(defun calc-graph-lookup (thing)
- (if (and (eq (car-safe thing) 'var)
- (calc-var-value (nth 2 thing)))
- thing
- (let ((found (assoc thing calc-graph-var-cache)))
- (or found
- (progn
- (setq varname (concat "PlotData"
- (int-to-string
- (1+ (length calc-graph-var-cache))))
- var (list 'var (intern varname)
- (intern (concat "var-" varname)))
- found (cons thing var)
- calc-graph-var-cache (cons found calc-graph-var-cache))
- (set (nth 2 var) thing)))
- (cdr found))))
-
-(defun calc-graph-juggle (arg)
- (interactive "p")
- (calc-graph-init)
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (if (< arg 0)
- (let ((num (calc-graph-count-curves)))
- (if (> num 0)
- (while (< arg 0)
- (setq arg (+ arg num))))))
- (while (>= (setq arg (1- arg)) 0)
- (calc-graph-do-juggle))))
-
-(defun calc-graph-count-curves ()
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (if (re-search-forward "^s?plot[ \t]" nil t)
- (let ((num 1))
- (goto-char (point-min))
- (while (search-forward "," nil t)
- (setq num (1+ num)))
- num)
- 0)))
-
-(defun calc-graph-do-juggle ()
- (let (base)
- (and (calc-graph-find-plot t t)
- (progn
- (setq base (point))
- (calc-graph-find-plot t nil)
- (or (eq base (point))
- (let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
- (delete-region (point) (1- (point-max)))
- (goto-char (+ base 5))
- (insert str ", ")))))))
-
-(defun calc-graph-print (flag)
- (interactive "P")
- (calc-graph-plot flag t))
-
-(defun calc-graph-plot (flag &optional printing)
- (interactive "P")
- (calc-slow-wrapper
- (let ((calcbuf (current-buffer))
- (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
- (tempbuftop 1)
- (tempoutfile nil)
- (curve-num 0)
- (refine (and flag (> (prefix-numeric-value flag) 0)))
- (recompute (and flag (< (prefix-numeric-value flag) 0)))
- (surprise-splot nil)
- (tty-output nil)
- cache-env is-splot device output resolution precision samples-pos)
- (or (boundp 'calc-graph-prev-kill-hook)
- (if calc-emacs-type-19
- (progn
- (setq calc-graph-prev-kill-hook nil)
- (add-hook 'kill-emacs-hook 'calc-graph-kill-hook))
- (setq calc-graph-prev-kill-hook kill-emacs-hook)
- (setq kill-emacs-hook 'calc-graph-kill-hook)))
- (save-excursion
- (calc-graph-init)
- (set-buffer tempbuf)
- (erase-buffer)
- (set-buffer calc-gnuplot-input)
- (goto-char (point-min))
- (setq is-splot (re-search-forward "^splot[ \t]" nil t))
- (let ((str (buffer-string))
- (ver calc-gnuplot-version))
- (set-buffer (get-buffer-create "*Gnuplot Temp*"))
- (erase-buffer)
- (insert "# (Note: This is a temporary copy---do not edit!)\n")
- (if (>= ver 2)
- (insert "set noarrow\nset nolabel\n"
- "set autoscale xy\nset nologscale xy\n"
- "set xlabel\nset ylabel\nset title\n"
- "set noclip points\nset clip one\nset clip two\n"
- "set format \"%g\"\nset tics\nset xtics\nset ytics\n"
- "set data style linespoints\n"
- "set nogrid\nset nokey\nset nopolar\n"))
- (if (>= ver 3)
- (insert "set surface\nset nocontour\n"
- "set " (if is-splot "" "no") "parametric\n"
- "set notime\nset border\nset ztics\nset zeroaxis\n"
- "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
- (setq samples-pos (point))
- (insert "\n\n" str))
- (goto-char (point-min))
- (if is-splot
- (if refine
- (error "This option works only for 2d plots")
- (setq recompute t)))
- (let ((calc-gnuplot-input (current-buffer))
- (calc-graph-no-auto-view t))
- (if printing
- (setq device calc-gnuplot-print-device
- output calc-gnuplot-print-output)
- (setq device (calc-graph-find-command "terminal")
- output (calc-graph-find-command "output"))
- (or device
- (setq device calc-gnuplot-default-device))
- (if output
- (setq output (car (read-from-string output)))
- (setq output calc-gnuplot-default-output)))
- (if (or (equal device "") (equal device "default"))
- (setq device (if printing
- "postscript"
- (if (or (eq window-system 'x) (getenv "DISPLAY"))
- "x11"
- (if (>= calc-gnuplot-version 3)
- "dumb" "postscript")))))
- (if (equal device "dumb")
- (setq device (format "dumb %d %d"
- (1- (frame-width)) (1- (frame-height)))))
- (if (equal device "big")
- (setq device (format "dumb %d %d"
- (* 4 (- (frame-width) 3))
- (* 4 (- (frame-height) 3)))))
- (if (stringp output)
- (if (or (equal output "auto")
- (and (equal output "tty") (setq tty-output t)))
- (setq tempoutfile (calc-temp-file-name -1)
- output tempoutfile))
- (setq output (eval output)))
- (or (equal device calc-graph-last-device)
- (progn
- (setq calc-graph-last-device device)
- (calc-gnuplot-command "set terminal" device)))
- (or (equal output calc-graph-last-output)
- (progn
- (setq calc-graph-last-output output)
- (calc-gnuplot-command "set output"
- (if (equal output "STDOUT")
- ""
- (prin1-to-string output)))))
- (setq resolution (calc-graph-find-command "samples"))
- (if resolution
- (setq resolution (string-to-int resolution))
- (setq resolution (if is-splot
- calc-graph-default-resolution-3d
- calc-graph-default-resolution)))
- (setq precision (calc-graph-find-command "precision"))
- (if precision
- (setq precision (string-to-int precision))
- (setq precision calc-graph-default-precision))
- (calc-graph-set-command "terminal")
- (calc-graph-set-command "output")
- (calc-graph-set-command "samples")
- (calc-graph-set-command "precision"))
- (goto-char samples-pos)
- (insert "set samples " (int-to-string (max (if is-splot 20 200)
- (+ 5 resolution))) "\n")
- (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t)
- (delete-region (match-beginning 0) (match-end 0))
- (if (looking-at ",")
- (delete-char 1)
- (while (memq (preceding-char) '(?\s ?\t))
- (forward-char -1))
- (if (eq (preceding-char) ?\,)
- (delete-backward-char 1))))
- (save-excursion
- (set-buffer calcbuf)
- (setq cache-env (list calc-angle-mode
- calc-complex-mode
- calc-simplify-mode
- calc-infinite-mode
- calc-word-size
- precision is-splot))
- (if (and (not recompute)
- (equal (cdr (car calc-graph-data-cache)) cache-env))
- (while (> (length calc-graph-data-cache)
- calc-graph-data-cache-limit)
- (setcdr calc-graph-data-cache
- (cdr (cdr calc-graph-data-cache))))
- (setq calc-graph-data-cache (list (cons nil cache-env)))))
- (calc-graph-find-plot t t)
- (while (re-search-forward
- (if is-splot
- "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
- "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
- nil t)
- (setq curve-num (1+ curve-num))
- (let* ((xname (buffer-substring (match-beginning 1) (match-end 1)))
- (xvar (intern (concat "var-" xname)))
- (xvalue (math-evaluate-expr (calc-var-value xvar)))
- (y3name (and is-splot
- (buffer-substring (match-beginning 2)
- (match-end 2))))
- (y3var (and is-splot (intern (concat "var-" y3name))))
- (y3value (and is-splot (calc-var-value y3var)))
- (yname (buffer-substring (match-beginning 3) (match-end 3)))
- (yvar (intern (concat "var-" yname)))
- (yvalue (calc-var-value yvar))
- filename)
- (delete-region (match-beginning 0) (match-end 0))
- (setq filename (calc-temp-file-name curve-num))
- (save-excursion
- (set-buffer calcbuf)
- (let (tempbuftop
- (xp xvalue)
- (yp yvalue)
- (zp nil)
- (xlow nil) (xhigh nil) (y3low nil) (y3high nil)
- xvec xval xstep var-DUMMY
- y3vec y3val y3step var-DUMMY2 (zval nil)
- yvec yval ycache ycacheptr yvector
- numsteps numsteps3
- (keep-file (and (not is-splot) (file-exists-p filename)))
- (stepcount 0)
- (calc-symbolic-mode nil)
- (calc-prefer-frac nil)
- (calc-internal-prec (max 3 precision))
- (calc-simplify-mode (and (not (memq calc-simplify-mode
- '(none num)))
- calc-simplify-mode))
- (blank t)
- (non-blank nil)
- (math-working-step 0)
- (math-working-step-2 nil))
- (save-excursion
- (if is-splot
- (calc-graph-compute-3d)
- (calc-graph-compute-2d))
- (set-buffer tempbuf)
- (goto-char (point-max))
- (insert "\n" xname)
- (if is-splot
- (insert ":" y3name))
- (insert ":" yname "\n\n")
- (setq tempbuftop (point))
- (let ((calc-group-digits nil)
- (calc-leading-zeros nil)
- (calc-number-radix 10)
- (entry (and (not is-splot)
- (list xp yp xhigh numsteps))))
- (or (equal entry
- (nth 1 (nth (1+ curve-num)
- calc-graph-file-cache)))
- (setq keep-file nil))
- (setcar (cdr (nth (1+ curve-num) calc-graph-file-cache))
- entry)
- (or keep-file
- (calc-graph-format-data)))
- (or keep-file
- (progn
- (or non-blank
- (error "No valid data points for %s:%s"
- xname yname))
- (write-region tempbuftop (point-max) filename
- nil 'quiet))))))
- (insert (prin1-to-string filename))))
- (if surprise-splot
- (setcdr cache-env nil))
- (if (= curve-num 0)
- (progn
- (calc-gnuplot-command "clear")
- (calc-clear-command-flag 'clear-message)
- (message "No data to plot!"))
- (setq calc-graph-data-cache-limit (max curve-num
- calc-graph-data-cache-limit)
- filename (calc-temp-file-name 0))
- (write-region (point-min) (point-max) filename nil 'quiet)
- (calc-gnuplot-command "load" (prin1-to-string filename))
- (or (equal output "STDOUT")
- calc-gnuplot-keep-outfile
- (progn ; need to close the output file before printing/plotting
- (setq calc-graph-last-output "STDOUT")
- (calc-gnuplot-command "set output")))
- (let ((command (if printing
- calc-gnuplot-print-command
- (or calc-gnuplot-plot-command
- (and (string-match "^dumb" device)
- 'calc-graph-show-dumb)
- (and tty-output
- 'calc-graph-show-tty)))))
- (if command
- (if (stringp command)
- (calc-gnuplot-command
- "!" (format command
- (or tempoutfile
- calc-gnuplot-print-output)))
- (if (symbolp command)
- (funcall command output)
- (eval command))))))))))
-
-(defun calc-graph-compute-2d ()
- (if (setq yvec (eq (car-safe yvalue) 'vec))
- (if (= (setq numsteps (1- (length yvalue))) 0)
- (error "Can't plot an empty vector")
- (if (setq xvec (eq (car-safe xvalue) 'vec))
- (or (= (1- (length xvalue)) numsteps)
- (error "%s and %s have different lengths" xname yname))
- (if (and (eq (car-safe xvalue) 'intv)
- (math-constp xvalue))
- (setq xstep (math-div (math-sub (nth 3 xvalue)
- (nth 2 xvalue))
- (1- numsteps))
- xvalue (nth 2 xvalue))
- (if (math-realp xvalue)
- (setq xstep 1)
- (error "%s is not a suitable basis for %s" xname yname)))))
- (or (math-realp yvalue)
- (let ((arglist nil))
- (setq yvalue (math-evaluate-expr yvalue))
- (calc-default-formula-arglist yvalue)
- (or arglist
- (error "%s does not contain any unassigned variables" yname))
- (and (cdr arglist)
- (error "%s contains more than one variable: %s"
- yname arglist))
- (setq yvalue (math-expr-subst yvalue
- (math-build-var-name (car arglist))
- '(var DUMMY var-DUMMY)))))
- (setq ycache (assoc yvalue calc-graph-data-cache))
- (delq ycache calc-graph-data-cache)
- (nconc calc-graph-data-cache
- (list (or ycache (setq ycache (list yvalue)))))
- (if (and (not (setq xvec (eq (car-safe xvalue) 'vec)))
- refine (cdr (cdr ycache)))
- (calc-graph-refine-2d)
- (calc-graph-recompute-2d))))
-
-(defun calc-graph-refine-2d ()
- (setq keep-file nil
- ycacheptr (cdr ycache))
- (if (and (setq xval (calc-graph-find-command "xrange"))
- (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
- xval))
- (let ((b2 (match-beginning 2))
- (e2 (match-end 2)))
- (setq xlow (math-read-number (substring xval
- (match-beginning 1)
- (match-end 1)))
- xhigh (math-read-number (substring xval b2 e2))))
- (if xlow
- (while (and (cdr ycacheptr)
- (Math-lessp (car (nth 1 ycacheptr)) xlow))
- (setq ycacheptr (cdr ycacheptr)))))
- (setq math-working-step-2 (1- (length ycacheptr)))
- (while (and (cdr ycacheptr)
- (or (not xhigh)
- (Math-lessp (car (car ycacheptr)) xhigh)))
- (setq var-DUMMY (math-div (math-add (car (car ycacheptr))
- (car (nth 1 ycacheptr)))
- 2)
- math-working-step (1+ math-working-step)
- yval (math-evaluate-expr yvalue))
- (setcdr ycacheptr (cons (cons var-DUMMY yval)
- (cdr ycacheptr)))
- (setq ycacheptr (cdr (cdr ycacheptr))))
- (setq yp ycache
- numsteps 1000000))
-
-(defun calc-graph-recompute-2d ()
- (setq ycacheptr ycache)
- (if xvec
- (setq numsteps (1- (length xvalue))
- yvector nil)
- (if (and (eq (car-safe xvalue) 'intv)
- (math-constp xvalue))
- (setq numsteps resolution
- yp nil
- xlow (nth 2 xvalue)
- xhigh (nth 3 xvalue)
- xstep (math-div (math-sub xhigh xlow)
- (1- numsteps))
- xvalue (nth 2 xvalue))
- (error "%s is not a suitable basis for %s"
- xname yname)))
- (setq math-working-step-2 numsteps)
- (while (>= (setq numsteps (1- numsteps)) 0)
- (setq math-working-step (1+ math-working-step))
- (if xvec
- (progn
- (setq xp (cdr xp)
- xval (car xp))
- (and (not (eq ycacheptr ycache))
- (consp (car ycacheptr))
- (not (Math-lessp (car (car ycacheptr)) xval))
- (setq ycacheptr ycache)))
- (if (= numsteps 0)
- (setq xval xhigh) ; avoid cumulative roundoff
- (setq xval xvalue
- xvalue (math-add xvalue xstep))))
- (while (and (cdr ycacheptr)
- (Math-lessp (car (nth 1 ycacheptr)) xval))
- (setq ycacheptr (cdr ycacheptr)))
- (or (and (cdr ycacheptr)
- (Math-equal (car (nth 1 ycacheptr)) xval))
- (progn
- (setq keep-file nil
- var-DUMMY xval)
- (setcdr ycacheptr (cons (cons xval (math-evaluate-expr yvalue))
- (cdr ycacheptr)))))
- (setq ycacheptr (cdr ycacheptr))
- (if xvec
- (setq yvector (cons (cdr (car ycacheptr)) yvector))
- (or yp (setq yp ycacheptr))))
- (if xvec
- (setq xp xvalue
- yvec t
- yp (cons 'vec (nreverse yvector))
- numsteps (1- (length xp)))
- (setq numsteps 1000000)))
-
-(defun calc-graph-compute-3d ()
- (if (setq yvec (eq (car-safe yvalue) 'vec))
- (if (math-matrixp yvalue)
- (progn
- (setq numsteps (1- (length yvalue))
- numsteps3 (1- (length (nth 1 yvalue))))
- (if (eq (car-safe xvalue) 'vec)
- (or (= (1- (length xvalue)) numsteps)
- (error "%s has wrong length" xname))
- (if (and (eq (car-safe xvalue) 'intv)
- (math-constp xvalue))
- (setq xvalue (calcFunc-index numsteps
- (nth 2 xvalue)
- (math-div
- (math-sub (nth 3 xvalue)
- (nth 2 xvalue))
- (1- numsteps))))
- (if (math-realp xvalue)
- (setq xvalue (calcFunc-index numsteps xvalue 1))
- (error "%s is not a suitable basis for %s" xname yname))))
- (if (eq (car-safe y3value) 'vec)
- (or (= (1- (length y3value)) numsteps3)
- (error "%s has wrong length" y3name))
- (if (and (eq (car-safe y3value) 'intv)
- (math-constp y3value))
- (setq y3value (calcFunc-index numsteps3
- (nth 2 y3value)
- (math-div
- (math-sub (nth 3 y3value)
- (nth 2 y3value))
- (1- numsteps3))))
- (if (math-realp y3value)
- (setq y3value (calcFunc-index numsteps3 y3value 1))
- (error "%s is not a suitable basis for %s" y3name yname))))
- (setq xp nil
- yp nil
- zp nil
- xvec t)
- (while (setq xvalue (cdr xvalue) yvalue (cdr yvalue))
- (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue)))
- yp (nconc yp (cons 0 (copy-sequence (cdr y3value))))
- zp (nconc zp (cons '(skip)
- (copy-sequence (cdr (car yvalue)))))))
- (setq numsteps (1- (* numsteps (1+ numsteps3)))))
- (if (= (setq numsteps (1- (length yvalue))) 0)
- (error "Can't plot an empty vector"))
- (or (and (eq (car-safe xvalue) 'vec)
- (= (1- (length xvalue)) numsteps))
- (error "%s is not a suitable basis for %s" xname yname))
- (or (and (eq (car-safe y3value) 'vec)
- (= (1- (length y3value)) numsteps))
- (error "%s is not a suitable basis for %s" y3name yname))
- (setq xp xvalue
- yp y3value
- zp yvalue
- xvec t))
- (or (math-realp yvalue)
- (let ((arglist nil))
- (setq yvalue (math-evaluate-expr yvalue))
- (calc-default-formula-arglist yvalue)
- (setq arglist (sort arglist 'string-lessp))
- (or (cdr arglist)
- (error "%s does not contain enough unassigned variables" yname))
- (and (cdr (cdr arglist))
- (error "%s contains too many variables: %s" yname arglist))
- (setq yvalue (math-multi-subst yvalue
- (mapcar 'math-build-var-name
- arglist)
- '((var DUMMY var-DUMMY)
- (var DUMMY2 var-DUMMY2))))))
- (if (setq xvec (eq (car-safe xvalue) 'vec))
- (setq numsteps (1- (length xvalue)))
- (if (and (eq (car-safe xvalue) 'intv)
- (math-constp xvalue))
- (setq numsteps resolution
- xvalue (calcFunc-index numsteps
- (nth 2 xvalue)
- (math-div (math-sub (nth 3 xvalue)
- (nth 2 xvalue))
- (1- numsteps))))
- (error "%s is not a suitable basis for %s"
- xname yname)))
- (if (setq y3vec (eq (car-safe y3value) 'vec))
- (setq numsteps3 (1- (length y3value)))
- (if (and (eq (car-safe y3value) 'intv)
- (math-constp y3value))
- (setq numsteps3 resolution
- y3value (calcFunc-index numsteps3
- (nth 2 y3value)
- (math-div (math-sub (nth 3 y3value)
- (nth 2 y3value))
- (1- numsteps3))))
- (error "%s is not a suitable basis for %s"
- y3name yname)))
- (setq xp nil
- yp nil
- zp nil
- xvec t)
- (setq math-working-step 0)
- (while (setq xvalue (cdr xvalue))
- (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue)))
- yp (nconc yp (cons 0 (copy-sequence (cdr y3value))))
- zp (cons '(skip) zp)
- y3step y3value
- var-DUMMY (car xvalue)
- math-working-step-2 0
- math-working-step (1+ math-working-step))
- (while (setq y3step (cdr y3step))
- (setq math-working-step-2 (1+ math-working-step-2)
- var-DUMMY2 (car y3step)
- zp (cons (math-evaluate-expr yvalue) zp))))
- (setq zp (nreverse zp)
- numsteps (1- (* numsteps (1+ numsteps3))))))
-
-(defun calc-graph-format-data ()
- (while (<= (setq stepcount (1+ stepcount)) numsteps)
- (if xvec
- (setq xp (cdr xp)
- xval (car xp)
- yp (cdr yp)
- yval (car yp)
- zp (cdr zp)
- zval (car zp))
- (if yvec
- (setq xval xvalue
- xvalue (math-add xvalue xstep)
- yp (cdr yp)
- yval (car yp))
- (setq xval (car (car yp))
- yval (cdr (car yp))
- yp (cdr yp))
- (if (or (not yp)
- (and xhigh (equal xval xhigh)))
- (setq numsteps 0))))
- (if is-splot
- (if (and (eq (car-safe zval) 'calcFunc-xyz)
- (= (length zval) 4))
- (setq xval (nth 1 zval)
- yval (nth 2 zval)
- zval (nth 3 zval)))
- (if (and (eq (car-safe yval) 'calcFunc-xyz)
- (= (length yval) 4))
- (progn
- (or surprise-splot
- (save-excursion
- (set-buffer (get-buffer-create "*Gnuplot Temp*"))
- (save-excursion
- (goto-char (point-max))
- (re-search-backward "^plot[ \t]")
- (insert "set parametric\ns")
- (setq surprise-splot t))))
- (setq xval (nth 1 yval)
- zval (nth 3 yval)
- yval (nth 2 yval)))
- (if (and (eq (car-safe yval) 'calcFunc-xy)
- (= (length yval) 3))
- (setq xval (nth 1 yval)
- yval (nth 2 yval)))))
- (if (and (Math-realp xval)
- (Math-realp yval)
- (or (not zval) (Math-realp zval)))
- (progn
- (setq blank nil
- non-blank t)
- (if (Math-integerp xval)
- (insert (math-format-number xval))
- (if (eq (car xval) 'frac)
- (setq xval (math-float xval)))
- (insert (math-format-number (nth 1 xval))
- "e" (int-to-string (nth 2 xval))))
- (insert " ")
- (if (Math-integerp yval)
- (insert (math-format-number yval))
- (if (eq (car yval) 'frac)
- (setq yval (math-float yval)))
- (insert (math-format-number (nth 1 yval))
- "e" (int-to-string (nth 2 yval))))
- (if zval
- (progn
- (insert " ")
- (if (Math-integerp zval)
- (insert (math-format-number zval))
- (if (eq (car zval) 'frac)
- (setq zval (math-float zval)))
- (insert (math-format-number (nth 1 zval))
- "e" (int-to-string (nth 2 zval))))))
- (insert "\n"))
- (and (not (equal zval '(skip)))
- (boundp 'var-PlotRejects)
- (eq (car-safe var-PlotRejects) 'vec)
- (nconc var-PlotRejects
- (list (list 'vec
- curve-num
- stepcount
- xval yval)))
- (calc-refresh-evaltos 'var-PlotRejects))
- (or blank
- (progn
- (insert "\n")
- (setq blank t))))))
-
-(defun calc-temp-file-name (num)
- (while (<= (length calc-graph-file-cache) (1+ num))
- (setq calc-graph-file-cache (nconc calc-graph-file-cache (list nil))))
- (car (or (nth (1+ num) calc-graph-file-cache)
- (setcar (nthcdr (1+ num) calc-graph-file-cache)
- (list (make-temp-file
- (concat calc-gnuplot-tempfile
- (if (<= num 0)
- (char-to-string (- ?A num))
- (int-to-string num))))
- nil)))))
-
-(defun calc-graph-delete-temps ()
- (while calc-graph-file-cache
- (and (car calc-graph-file-cache)
- (file-exists-p (car (car calc-graph-file-cache)))
- (condition-case err
- (delete-file (car (car calc-graph-file-cache)))
- (error nil)))
- (setq calc-graph-file-cache (cdr calc-graph-file-cache))))
-
-(defun calc-graph-kill-hook ()
- (calc-graph-delete-temps)
- (if calc-graph-prev-kill-hook
- (funcall calc-graph-prev-kill-hook)))
-
-(defun calc-graph-show-tty (output)
- "Default calc-gnuplot-plot-command for \"tty\" output mode.
-This is useful for tek40xx and other graphics-terminal types."
- (call-process-region 1 1 shell-file-name
- nil calc-gnuplot-buffer nil
- "-c" (format "cat %s >/dev/tty; rm %s" output output)))
-
-(defun calc-graph-show-dumb (&optional output)
- "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
-This \"dumb\" driver will be present in Gnuplot 3.0."
- (interactive)
- (save-window-excursion
- (switch-to-buffer calc-gnuplot-buffer)
- (delete-other-windows)
- (goto-char calc-gnuplot-trail-mark)
- (or (search-forward "\f" nil t)
- (sleep-for 1))
- (goto-char (point-max))
- (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
- (setq found-pt (point))
- (if (looking-at "\f")
- (progn
- (forward-char 1)
- (if (eolp) (forward-line 1))
- (or (calc-graph-find-command "time")
- (calc-graph-find-command "title")
- (calc-graph-find-command "ylabel")
- (let ((pt (point)))
- (insert-before-markers (format "(%s)" (current-time-string)))
- (goto-char pt)))
- (set-window-start (selected-window) (point))
- (goto-char (point-max)))
- (end-of-line)
- (backward-char 1)
- (recenter '(4)))
- (or (boundp 'calc-dumb-map)
- (progn
- (setq calc-dumb-map (make-sparse-keymap))
- (define-key calc-dumb-map "\n" 'scroll-up)
- (define-key calc-dumb-map " " 'scroll-up)
- (define-key calc-dumb-map "\177" 'scroll-down)
- (define-key calc-dumb-map "<" 'scroll-left)
- (define-key calc-dumb-map ">" 'scroll-right)
- (define-key calc-dumb-map "{" 'scroll-down)
- (define-key calc-dumb-map "}" 'scroll-up)
- (define-key calc-dumb-map "q" 'exit-recursive-edit)
- (define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
- (use-local-map calc-dumb-map)
- (setq truncate-lines t)
- (message "Type `q'%s to return to Calc"
- (if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch)
- " or `M-# M-#'" ""))
- (recursive-edit)
- (bury-buffer "*Gnuplot Trail*")))
-
-(defun calc-graph-clear ()
- (interactive)
- (if calc-graph-last-device
- (if (or (equal calc-graph-last-device "x11")
- (equal calc-graph-last-device "X11"))
- (calc-gnuplot-command "set output"
- (if (equal calc-graph-last-output "STDOUT")
- ""
- (prin1-to-string calc-graph-last-output)))
- (calc-gnuplot-command "clear"))))
-
-(defun calc-graph-title-x (title)
- (interactive "sX axis title: ")
- (calc-graph-set-command "xlabel" (if (not (equal title ""))
- (prin1-to-string title))))
-
-(defun calc-graph-title-y (title)
- (interactive "sY axis title: ")
- (calc-graph-set-command "ylabel" (if (not (equal title ""))
- (prin1-to-string title))))
-
-(defun calc-graph-title-z (title)
- (interactive "sZ axis title: ")
- (calc-graph-set-command "zlabel" (if (not (equal title ""))
- (prin1-to-string title))))
-
-(defun calc-graph-range-x (range)
- (interactive "sX axis range: ")
- (calc-graph-set-range "xrange" range))
-
-(defun calc-graph-range-y (range)
- (interactive "sY axis range: ")
- (calc-graph-set-range "yrange" range))
-
-(defun calc-graph-range-z (range)
- (interactive "sZ axis range: ")
- (calc-graph-set-range "zrange" range))
-
-(defun calc-graph-set-range (cmd range)
- (if (equal range "$")
- (calc-wrapper
- (let ((val (calc-top-n 1)))
- (if (and (eq (car-safe val) 'intv) (math-constp val))
- (setq range (concat
- (math-format-number (math-float (nth 2 val))) ":"
- (math-format-number (math-float (nth 3 val)))))
- (if (and (eq (car-safe val) 'vec)
- (= (length val) 3))
- (setq range (concat
- (math-format-number (math-float (nth 1 val))) ":"
- (math-format-number (math-float (nth 2 val)))))
- (error "Range specification must be an interval or 2-vector")))
- (calc-pop-stack 1))))
- (if (string-match "\\[.+\\]" range)
- (setq range (substring range 1 -1)))
- (if (and (not (string-match ":" range))
- (or (string-match "," range)
- (string-match " " range)))
- (aset range (match-beginning 0) ?\:))
- (calc-graph-set-command cmd (if (not (equal range ""))
- (concat "[" range "]"))))
-
-(defun calc-graph-log-x (flag)
- (interactive "P")
- (calc-graph-set-log flag 0 0))
-
-(defun calc-graph-log-y (flag)
- (interactive "P")
- (calc-graph-set-log 0 flag 0))
-
-(defun calc-graph-log-z (flag)
- (interactive "P")
- (calc-graph-set-log 0 0 flag))
-
-(defun calc-graph-set-log (xflag yflag zflag)
- (let* ((old (or (calc-graph-find-command "logscale") ""))
- (xold (string-match "x" old))
- (yold (string-match "y" old))
- (zold (string-match "z" old))
- str)
- (setq str (concat (if (if xflag
- (if (eq xflag 0) xold
- (> (prefix-numeric-value xflag) 0))
- (not xold)) "x" "")
- (if (if yflag
- (if (eq yflag 0) yold
- (> (prefix-numeric-value yflag) 0))
- (not yold)) "y" "")
- (if (if zflag
- (if (eq zflag 0) zold
- (> (prefix-numeric-value zflag) 0))
- (not zold)) "z" "")))
- (calc-graph-set-command "logscale" (if (not (equal str "")) str))))
-
-(defun calc-graph-line-style (style)
- (interactive "P")
- (calc-graph-set-styles (and style (prefix-numeric-value style)) t))
-
-(defun calc-graph-point-style (style)
- (interactive "P")
- (calc-graph-set-styles t (and style (prefix-numeric-value style))))
-
-(defun calc-graph-set-styles (lines points)
- (calc-graph-init)
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (or (calc-graph-find-plot nil nil)
- (error "No data points have been set!"))
- (let ((base (point))
- (mode nil) (lstyle nil) (pstyle nil)
- start end lenbl penbl)
- (re-search-forward "[,\n]")
- (forward-char -1)
- (setq end (point) start end)
- (goto-char base)
- (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
- (progn
- (setq start (match-beginning 1))
- (goto-char (match-end 0))
- (if (looking-at "[ \t]+\\([a-z]+\\)")
- (setq mode (buffer-substring (match-beginning 1)
- (match-end 1))))
- (if (looking-at "[ \ta-z]+\\([0-9]+\\)")
- (setq lstyle (string-to-int
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
- (if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
- (setq pstyle (string-to-int
- (buffer-substring (match-beginning 1)
- (match-end 1)))))))
- (setq lenbl (or (equal mode "lines") (equal mode "linespoints"))
- penbl (or (equal mode "points") (equal mode "linespoints")))
- (if lines
- (or (eq lines t)
- (setq lstyle lines
- lenbl (>= lines 0)))
- (setq lenbl (not lenbl)))
- (if points
- (or (eq points t)
- (setq pstyle points
- penbl (>= points 0)))
- (setq penbl (not penbl)))
- (delete-region start end)
- (goto-char start)
- (insert " with "
- (if lenbl
- (if penbl "linespoints" "lines")
- (if penbl "points" "dots")))
- (if (and pstyle (> pstyle 0))
- (insert " " (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
- " " (int-to-string pstyle))
- (if (and lstyle (> lstyle 0))
- (insert " " (int-to-string lstyle))))))
- (calc-graph-view-commands))
-
-(defun calc-graph-zero-x (flag)
- (interactive "P")
- (calc-graph-set-command "noxzeroaxis"
- (and (if flag
- (<= (prefix-numeric-value flag) 0)
- (not (calc-graph-find-command "noxzeroaxis")))
- " ")))
-
-(defun calc-graph-zero-y (flag)
- (interactive "P")
- (calc-graph-set-command "noyzeroaxis"
- (and (if flag
- (<= (prefix-numeric-value flag) 0)
- (not (calc-graph-find-command "noyzeroaxis")))
- " ")))
-
-(defun calc-graph-name (name)
- (interactive "sTitle for current curve: ")
- (calc-graph-init)
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (or (calc-graph-find-plot nil nil)
- (error "No data points have been set!"))
- (let ((base (point))
- start)
- (re-search-forward "[,\n]\\|[ \t]+with")
- (setq end (match-beginning 0))
- (goto-char base)
- (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
- (progn
- (goto-char (match-beginning 1))
- (delete-region (point) end))
- (goto-char end))
- (insert " title " (prin1-to-string name))))
- (calc-graph-view-commands))
-
-(defun calc-graph-hide (flag)
- (interactive "P")
- (calc-graph-init)
- (and (calc-graph-find-plot nil nil)
- (progn
- (or (looking-at "{")
- (error "Can't hide this curve (wrong format)"))
- (forward-char 1)
- (if (looking-at "*")
- (if (or (null flag) (<= (prefix-numeric-value flag) 0))
- (delete-char 1))
- (if (or (null flag) (> (prefix-numeric-value flag) 0))
- (insert "*"))))))
-
-(defun calc-graph-header (title)
- (interactive "sTitle for entire graph: ")
- (calc-graph-set-command "title" (if (not (equal title ""))
- (prin1-to-string title))))
-
-(defun calc-graph-border (flag)
- (interactive "P")
- (calc-graph-set-command "noborder"
- (and (if flag
- (<= (prefix-numeric-value flag) 0)
- (not (calc-graph-find-command "noborder")))
- " ")))
-
-(defun calc-graph-grid (flag)
- (interactive "P")
- (calc-graph-set-command "grid" (and (if flag
- (> (prefix-numeric-value flag) 0)
- (not (calc-graph-find-command "grid")))
- " ")))
-
-(defun calc-graph-key (flag)
- (interactive "P")
- (calc-graph-set-command "key" (and (if flag
- (> (prefix-numeric-value flag) 0)
- (not (calc-graph-find-command "key")))
- " ")))
-
-(defun calc-graph-num-points (res flag)
- (interactive "sNumber of data points: \nP")
- (if flag
- (if (> (prefix-numeric-value flag) 0)
- (if (equal res "")
- (message "Default resolution is %d"
- calc-graph-default-resolution)
- (setq calc-graph-default-resolution (string-to-int res)))
- (if (equal res "")
- (message "Default 3D resolution is %d"
- calc-graph-default-resolution-3d)
- (setq calc-graph-default-resolution-3d (string-to-int res))))
- (calc-graph-set-command "samples" (if (not (equal res "")) res))))
-
-(defun calc-graph-device (name flag)
- (interactive "sDevice name: \nP")
- (if (equal name "?")
- (progn
- (calc-gnuplot-command "set terminal")
- (calc-graph-view-trail))
- (if flag
- (if (> (prefix-numeric-value flag) 0)
- (if (equal name "")
- (message "Default GNUPLOT device is \"%s\""
- calc-gnuplot-default-device)
- (setq calc-gnuplot-default-device name))
- (if (equal name "")
- (message "GNUPLOT device for Print command is \"%s\""
- calc-gnuplot-print-device)
- (setq calc-gnuplot-print-device name)))
- (calc-graph-set-command "terminal" (if (not (equal name ""))
- name)))))
-
-(defun calc-graph-output (name flag)
- (interactive "FOutput file name: \np")
- (cond ((string-match "\\<[aA][uU][tT][oO]$" name)
- (setq name "auto"))
- ((string-match "\\<[tT][tT][yY]$" name)
- (setq name "tty"))
- ((string-match "\\<[sS][tT][dD][oO][uU][tT]$" name)
- (setq name "STDOUT"))
- ((equal (file-name-nondirectory name) "")
- (setq name ""))
- (t (setq name (expand-file-name name))))
- (if flag
- (if (> (prefix-numeric-value flag) 0)
- (if (equal name "")
- (message "Default GNUPLOT output file is \"%s\""
- calc-gnuplot-default-output)
- (setq calc-gnuplot-default-output name))
- (if (equal name "")
- (message "GNUPLOT output file for Print command is \"%s\""
- calc-gnuplot-print-output)
- (setq calc-gnuplot-print-output name)))
- (calc-graph-set-command "output" (if (not (equal name ""))
- (prin1-to-string name)))))
-
-(defun calc-graph-display (name)
- (interactive "sX display name: ")
- (if (equal name "")
- (message "Current X display is \"%s\""
- (or calc-gnuplot-display "<none>"))
- (setq calc-gnuplot-display name)
- (if (calc-gnuplot-alive)
- (calc-gnuplot-command "exit"))))
-
-(defun calc-graph-geometry (name)
- (interactive "sX geometry spec (or \"default\"): ")
- (if (equal name "")
- (message "Current X geometry is \"%s\""
- (or calc-gnuplot-geometry "default"))
- (setq calc-gnuplot-geometry (and (not (equal name "default")) name))
- (if (calc-gnuplot-alive)
- (calc-gnuplot-command "exit"))))
-
-(defun calc-graph-find-command (cmd)
- (calc-graph-init)
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (goto-char (point-min))
- (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
- (buffer-substring (match-beginning 1) (match-end 1)))))
-
-(defun calc-graph-set-command (cmd &rest args)
- (calc-graph-init)
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (goto-char (point-min))
- (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
- (progn
- (forward-char -1)
- (end-of-line)
- (let ((end (point)))
- (beginning-of-line)
- (delete-region (point) (1+ end))))
- (if (calc-graph-find-plot t t)
- (if (eq (preceding-char) ?\n)
- (forward-char -1))
- (goto-char (1- (point-max)))))
- (if (and args (car args))
- (progn
- (or (bolp)
- (insert "\n"))
- (insert "set " (mapconcat 'identity (cons cmd args) " ") "\n"))))
- (calc-graph-view-commands))
-
-(defun calc-graph-command (cmd)
- (interactive "sGNUPLOT command: ")
- (calc-wrapper
- (calc-graph-init)
- (calc-graph-view-trail)
- (calc-gnuplot-command cmd)
- (accept-process-output)
- (calc-graph-view-trail)))
-
-(defun calc-graph-kill (&optional no-view)
- (interactive)
- (calc-graph-delete-temps)
- (if (calc-gnuplot-alive)
- (calc-wrapper
- (or no-view (calc-graph-view-trail))
- (let ((calc-graph-no-wait t))
- (calc-gnuplot-command "exit"))
- (sit-for 1)
- (if (process-status calc-gnuplot-process)
- (delete-process calc-gnuplot-process))
- (setq calc-gnuplot-process nil))))
-
-(defun calc-graph-quit ()
- (interactive)
- (if (get-buffer-window calc-gnuplot-input)
- (calc-graph-view-commands t))
- (if (get-buffer-window calc-gnuplot-buffer)
- (calc-graph-view-trail t))
- (calc-graph-kill t))
-
-(defun calc-graph-view-commands (&optional no-need)
- (interactive "p")
- (or calc-graph-no-auto-view (calc-graph-init-buffers))
- (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need)))
-
-(defun calc-graph-view-trail (&optional no-need)
- (interactive "p")
- (or calc-graph-no-auto-view (calc-graph-init-buffers))
- (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need)))
-
-(defun calc-graph-view (buf other-buf need)
- (let (win)
- (or calc-graph-no-auto-view
- (if (setq win (get-buffer-window buf))
- (or need
- (and (eq buf calc-gnuplot-buffer)
- (save-excursion
- (set-buffer buf)
- (not (pos-visible-in-window-p (point-max) win))))
- (progn
- (bury-buffer buf)
- (bury-buffer other-buf)
- (let ((curwin (selected-window)))
- (select-window win)
- (switch-to-buffer nil)
- (select-window curwin))))
- (if (setq win (get-buffer-window other-buf))
- (set-window-buffer win buf)
- (if (eq major-mode 'calc-mode)
- (if (or need
- (< (window-height) (1- (frame-height))))
- (display-buffer buf))
- (switch-to-buffer buf)))))
- (save-excursion
- (set-buffer buf)
- (if (and (eq buf calc-gnuplot-buffer)
- (setq win (get-buffer-window buf))
- (not (pos-visible-in-window-p (point-max) win)))
- (progn
- (goto-char (point-max))
- (vertical-motion (- 6 (window-height win)))
- (set-window-start win (point))
- (goto-char (point-max)))))
- (or calc-graph-no-auto-view (sit-for 0))))
-
-(defun calc-gnuplot-check-for-errors ()
- (if (save-excursion
- (prog2
- (progn
- (set-buffer calc-gnuplot-buffer)
- (goto-char calc-gnuplot-last-error-pos))
- (re-search-forward "^[ \t]+\\^$" nil t)
- (goto-char (point-max))
- (setq calc-gnuplot-last-error-pos (point-max))))
- (calc-graph-view-trail)))
-
-(defun calc-gnuplot-command (&rest args)
- (calc-graph-init)
- (let ((cmd (concat (mapconcat 'identity args " ") "\n")))
- (accept-process-output)
- (save-excursion
- (set-buffer calc-gnuplot-buffer)
- (calc-gnuplot-check-for-errors)
- (goto-char (point-max))
- (setq calc-gnuplot-trail-mark (point))
- (or (>= calc-gnuplot-version 3)
- (insert cmd))
- (set-marker (process-mark calc-gnuplot-process) (point))
- (process-send-string calc-gnuplot-process cmd)
- (if (get-buffer-window calc-gnuplot-buffer)
- (calc-graph-view-trail))
- (accept-process-output (and (not calc-graph-no-wait)
- calc-gnuplot-process))
- (calc-gnuplot-check-for-errors)
- (if (get-buffer-window calc-gnuplot-buffer)
- (calc-graph-view-trail)))))
-
-(defun calc-graph-init-buffers ()
- (or (and calc-gnuplot-buffer
- (buffer-name calc-gnuplot-buffer))
- (setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*")))
- (or (and calc-gnuplot-input
- (buffer-name calc-gnuplot-input))
- (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*"))))
-
-(defun calc-graph-init ()
- (or (calc-gnuplot-alive)
- (let ((process-connection-type t)
- origin)
- (if calc-gnuplot-process
- (progn
- (delete-process calc-gnuplot-process)
- (setq calc-gnuplot-process nil)))
- (calc-graph-init-buffers)
- (save-excursion
- (set-buffer calc-gnuplot-buffer)
- (insert "\nStarting gnuplot...\n")
- (setq origin (point)))
- (setq calc-graph-last-device nil)
- (setq calc-graph-last-output nil)
- (condition-case err
- (let ((args (append (and calc-gnuplot-display
- (not (equal calc-gnuplot-display
- (getenv "DISPLAY")))
- (list "-display"
- calc-gnuplot-display))
- (and calc-gnuplot-geometry
- (list "-geometry"
- calc-gnuplot-geometry)))))
- (setq calc-gnuplot-process
- (apply 'start-process
- "gnuplot"
- calc-gnuplot-buffer
- calc-gnuplot-name
- args))
- (process-kill-without-query calc-gnuplot-process))
- (file-error
- (error "Sorry, can't find \"%s\" on your system"
- calc-gnuplot-name)))
- (save-excursion
- (set-buffer calc-gnuplot-buffer)
- (while (and (not (save-excursion
- (goto-char origin)
- (search-forward "gnuplot> " nil t)))
- (memq (process-status calc-gnuplot-process) '(run stop)))
- (accept-process-output calc-gnuplot-process))
- (or (memq (process-status calc-gnuplot-process) '(run stop))
- (error "Unable to start GNUPLOT process"))
- (if (save-excursion
- (goto-char origin)
- (re-search-forward
- "G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t))
- (setq calc-gnuplot-version (string-to-int (buffer-substring
- (match-beginning 1)
- (match-end 1))))
- (setq calc-gnuplot-version 1))
- (goto-char (point-max)))))
- (save-excursion
- (set-buffer calc-gnuplot-input)
- (if (= (buffer-size) 0)
- (insert "# Commands for running gnuplot\n\n\n")
- (or calc-graph-no-auto-view
- (eq (char-after (1- (point-max))) ?\n)
- (progn
- (goto-char (point-max))
- (insert "\n"))))))
-
-;;; calc-graph.el ends here
+++ /dev/null
-;;; calc-help.el --- help display functions for Calc,
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-help () nil)
-
-
-(defun calc-help-prefix (arg)
- "This key is the prefix for Calc help functions. See calc-help-for-help."
- (interactive "P")
- (or calc-dispatch-help (sit-for echo-keystrokes))
- (let ((key (calc-read-key-sequence
- (if calc-dispatch-help
- "Calc Help options: Help, Info, Tutorial, Summary; Key, Function; ?=more"
- (format "%s (Type ? for a list of Calc Help options)"
- (key-description (this-command-keys))))
- calc-help-map)))
- (setq key (lookup-key calc-help-map key))
- (message "")
- (if key
- (call-interactively key)
- (beep))))
-
-(defun calc-help-for-help (arg)
- "You have typed `h', the Calc help character. Type a Help option:
-
-B calc-describe-bindings. Display a table of all key bindings.
-H calc-full-help. Display all `?' key messages at once.
-
-I calc-info. Read the Calc manual using the Info system.
-T calc-tutorial. Read the Calc tutorial using the Info system.
-S calc-info-summary. Read the Calc summary using the Info system.
-
-C calc-describe-key-briefly. Look up the command name for a given key.
-K calc-describe-key. Look up a key's documentation in the manual.
-F calc-describe-function. Look up a function's documentation in the manual.
-V calc-describe-variable. Look up a variable's documentation in the manual.
-
-N calc-view-news. Display Calc history of changes.
-
-C-c Describe conditions for copying Calc.
-C-d Describe how you can get a new copy of Calc or report a bug.
-C-w Describe how there is no warranty for Calc."
- (interactive "P")
- (if calc-dispatch-help
- (let (key)
- (save-window-excursion
- (describe-function 'calc-help-for-help)
- (select-window (get-buffer-window "*Help*"))
- (while (progn
- (message "Calc Help options: Help, Info, ... press SPC, DEL to scroll, C-g to cancel")
- (memq (car (setq key (calc-read-key t)))
- '(? ?\C-h ?\C-? ?\C-v ?\M-v)))
- (condition-case err
- (if (memq (car key) '(? ?\C-v))
- (scroll-up)
- (scroll-down))
- (error (beep)))))
- (calc-unread-command (cdr key))
- (calc-help-prefix nil))
- (let ((calc-dispatch-help t))
- (calc-help-prefix arg))))
-
-(defun calc-describe-copying ()
- (interactive)
- (calc-info)
- (Info-goto-node "Copying"))
-
-(defun calc-describe-distribution ()
- (interactive)
- (calc-info)
- (Info-goto-node "Reporting Bugs"))
-
-(defun calc-describe-no-warranty ()
- (interactive)
- (calc-info)
- (Info-goto-node "Copying")
- (let ((case-fold-search nil))
- (search-forward " NO WARRANTY"))
- (beginning-of-line)
- (recenter 0))
-
-(defun calc-describe-bindings ()
- (interactive)
- (describe-bindings)
- (save-excursion
- (set-buffer "*Help*")
- (goto-char (point-min))
- (if (search-forward "Global bindings:" nil t)
- (delete-region (match-beginning 0) (point-max)))
- (goto-char (point-min))
- (while (re-search-forward "\n[a-z] ESC" nil t)
- (end-of-line)
- (delete-region (match-beginning 0) (point)))
- (goto-char (point-min))
- (while (re-search-forward "\nESC m" nil t)
- (end-of-line)
- (delete-region (match-beginning 0) (point)))
- (goto-char (point-min))
- (while (search-forward "\n\n\n" nil t)
- (backward-delete-char 1)
- (backward-char 2))
- (goto-char (point-min))
- (while
- (re-search-forward
- "\n[a-z] [0-9]\\(\t\t.*\n\\)\\([a-z] [0-9]\\1\\)*[a-z] \\([0-9]\\)\\1"
- nil t)
- (let ((dig1 (char-after (1- (match-beginning 1))))
- (dig2 (char-after (match-beginning 3))))
- (delete-region (match-end 1) (match-end 0))
- (goto-char (match-beginning 1))
- (delete-backward-char 1)
- (delete-char 1)
- (insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2)))))
- (goto-char (point-min))))
-
-(defun calc-describe-key-briefly (key)
- (interactive "kDescribe key briefly: ")
- (calc-describe-key key t))
-
-(defun calc-describe-key (key &optional briefly)
- (interactive "kDescribe key: ")
- (let ((defn (if (eq (key-binding key) 'calc-dispatch)
- (let ((key2 (calc-read-key-sequence
- (format "Describe key briefly: %s-"
- (key-description key))
- calc-dispatch-map)))
- (setq key (concat key key2))
- (lookup-key calc-dispatch-map key2))
- (if (eq (key-binding key) 'calc-help-prefix)
- (let ((key2 (calc-read-key-sequence
- (format "Describe key briefly: %s-"
- (key-description key))
- calc-help-map)))
- (setq key (concat key key2))
- (lookup-key calc-help-map key2))
- (key-binding key))))
- (inv nil)
- (hyp nil))
- (while (or (equal key "I") (equal key "H"))
- (if (equal key "I")
- (setq inv (not inv))
- (setq hyp (not hyp)))
- (setq key (read-key-sequence (format "Describe key%s:%s%s "
- (if briefly " briefly" "")
- (if inv " I" "")
- (if hyp " H" "")))
- defn (key-binding key)))
- (let ((desc (key-description key))
- target)
- (if (string-match "^ESC " desc)
- (setq desc (concat "M-" (substring desc 4))))
- (while (string-match "^M-# \\(ESC \\|C-\\)" desc)
- (setq desc (concat "M-# " (substring desc (match-end 0)))))
- (if briefly
- (let ((msg (save-excursion
- (set-buffer (get-buffer-create "*Calc Summary*"))
- (if (= (buffer-size) 0)
- (progn
- (message "Reading Calc summary from manual...")
- (save-window-excursion
- (save-excursion
- (calc-info)
- (Info-goto-node "Summary")
- (goto-char (point-min))
- (forward-line 1)
- (copy-to-buffer "*Calc Summary*"
- (point) (point-max))
- (Info-last)))
- (setq case-fold-search nil)
- (re-search-forward "^\\(.*\\)\\[\\.\\. a b")
- (setq calc-summary-indentation
- (- (match-end 1) (match-beginning 1)))))
- (goto-char (point-min))
- (setq target (if (and (string-match "[0-9]\\'" desc)
- (not (string-match "[d#]" desc)))
- (concat (substring desc 0 -1) "0-9")
- desc))
- (if (re-search-forward
- (format "\n%s%s%s%s[ a-zA-Z]"
- (make-string (+ calc-summary-indentation 9)
- ?\.)
- (if (string-match "M-#" desc) " "
- (if inv
- (if hyp "I H " " I ")
- (if hyp " H " " ")))
- (regexp-quote target)
- (make-string (max (- 6 (length target)) 0)
- ?\ ))
- nil t)
- (let (pt)
- (beginning-of-line)
- (forward-char calc-summary-indentation)
- (setq pt (point))
- (end-of-line)
- (buffer-substring pt (point)))))))
- (if msg
- (let ((args (substring msg 0 9))
- (keys (substring msg 9 19))
- (prompts (substring msg 19 38))
- (notes "")
- (cmd (substring msg 40))
- msg)
- (if (string-match "\\` +" args)
- (setq args (substring args (match-end 0))))
- (if (string-match " +\\'" args)
- (setq args (substring args 0 (match-beginning 0))))
- (if (string-match "\\` +" keys)
- (setq keys (substring keys (match-end 0))))
- (if (string-match " +\\'" keys)
- (setq keys (substring keys 0 (match-beginning 0))))
- (if (string-match " [0-9,]+\\'" prompts)
- (setq notes (substring prompts (1+ (match-beginning 0)))
- prompts (substring prompts 0 (match-beginning 0))))
- (if (string-match " +\\'" prompts)
- (setq prompts (substring prompts 0 (match-beginning 0))))
- (if (string-match "\\` +" prompts)
- (setq prompts (substring prompts (match-end 0))))
- (setq msg (format
- "%s: %s%s`%s'%s%s %s%s"
- (if (string-match
- "\\`\\(calc-[-a-zA-Z0-9]+\\) *\\(.*\\)\\'"
- cmd)
- (prog1 (math-match-substring cmd 1)
- (setq cmd (math-match-substring cmd 2)))
- defn)
- args (if (equal args "") "" " ")
- keys
- (if (equal prompts "") "" " ") prompts
- (if (equal cmd "") "" " => ") cmd))
- (message "%s%s%s runs %s%s"
- (if inv "I " "") (if hyp "H " "") desc
- msg
- (if (equal notes "") ""
- (format " (?=notes %s)" notes)))
- (let ((key (calc-read-key t)))
- (if (eq (car key) ??)
- (if (equal notes "")
- (message "No notes for this command")
- (while (string-match "," notes)
- (aset notes (match-beginning 0) ? ))
- (setq notes (sort (car (read-from-string
- (format "(%s)" notes)))
- '<))
- (with-output-to-temp-buffer "*Help*"
- (princ (format "%s\n\n" msg))
- (set-buffer "*Calc Summary*")
- (re-search-forward "^ *NOTES")
- (while notes
- (re-search-forward
- (format "^ *%d\\. " (car notes)))
- (beginning-of-line)
- (let ((pt (point)))
- (forward-line 1)
- (or (re-search-forward "^ ? ?[0-9]+\\. " nil t)
- (goto-char (point-max)))
- (beginning-of-line)
- (princ (buffer-substring pt (point))))
- (setq notes (cdr notes)))
- (print-help-return-message)))
- (calc-unread-command (cdr key)))))
- (if (or (null defn) (integerp defn))
- (message "%s is undefined" desc)
- (message "%s runs the command %s"
- desc
- (if (symbolp defn) defn (prin1-to-string defn))))))
- (if inv (setq desc (concat "I " desc)))
- (if hyp (setq desc (concat "H " desc)))
- (calc-describe-thing desc "Key Index" nil
- (string-match "[A-Z][A-Z][A-Z]" desc))))))
-
-(defun calc-describe-function (&optional func)
- (interactive)
- (or func
- (setq func (intern (completing-read "Describe function: "
- obarray nil t "calcFunc-"))))
- (setq func (symbol-name func))
- (if (string-match "\\`calc-." func)
- (calc-describe-thing func "Command Index")
- (calc-describe-thing (if (string-match "\\`calcFunc-." func)
- (substring func 9)
- func)
- "Function Index")))
-
-(defun calc-describe-variable (&optional var)
- (interactive)
- (or var
- (setq var (intern (completing-read "Describe variable: "
- obarray nil t "var-"))))
- (setq var (symbol-name var))
- (calc-describe-thing var "Variable Index"
- (if (string-match "\\`var-." var)
- (substring var 4)
- var)))
-
-(defun calc-describe-thing (thing where &optional target not-quoted)
- (message "Looking for `%s' in %s..." thing where)
- (let ((savewin (current-window-configuration)))
- (calc-info)
- (Info-goto-node where)
- (or (let ((case-fold-search nil))
- (re-search-forward (format "\n\\* +%s: \\(.*\\)\\."
- (regexp-quote thing))
- nil t))
- (and (string-match "\\`\\([a-z ]*\\)[0-9]\\'" thing)
- (re-search-forward (format "\n\\* +%s[01]-9: \\(.*\\)\\."
- (substring thing 0 -1))
- nil t)
- (setq thing (format "%s9" (substring thing 0 -1))))
- (progn
- (Info-last)
- (set-window-configuration savewin)
- (error "Can't find `%s' in %s" thing where)))
- (let (Info-history)
- (Info-goto-node (buffer-substring (match-beginning 1) (match-end 1))))
- (or (let ((case-fold-search nil))
- (or (search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'"
- (or target thing)
- (or target thing)
- (or target thing)) nil t)
- (and not-quoted
- (let ((case-fold-search t))
- (search-forward (or target thing) nil t)))
- (search-forward (format "`%s'" (or target thing)) nil t)
- (search-forward (or target thing) nil t)))
- (let ((case-fold-search t))
- (or (search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'"
- (or target thing)
- (or target thing)
- (or target thing)) nil t)
- (search-forward (format "`%s'" (or target thing)) nil t)
- (search-forward (or target thing) nil t))))
- (beginning-of-line)
- (message "Found `%s' in %s" thing where)))
-
-(defun calc-view-news ()
- (interactive)
- (let ((path load-path))
- (while (and path
- (not (file-exists-p (expand-file-name "calc.el" (car path)))))
- (setq path (cdr path)))
- (or (and path
- (file-exists-p (expand-file-name "README" (car path))))
- (error "Can't locate Calc sources"))
- (calc-quit)
- (switch-to-buffer "*Help*")
- (erase-buffer)
- (insert-file-contents (expand-file-name "README" (car path)))
- (search-forward "Summary of changes")
- (forward-line -1)
- (delete-region (point-min) (point))
- (goto-char (point-min))))
-
-(defun calc-full-help ()
- (interactive)
- (with-output-to-temp-buffer "*Help*"
- (princ (format "GNU Emacs Calculator version %s of %s.\n"
- calc-version calc-version-date))
- (princ " By Dave Gillespie, daveg@synaptics.com.\n")
- (princ " Copyright (C) 1990, 1993 Free Software Foundation, Inc.\n\n")
- (princ "Type `h s' for a more detailed summary.\n")
- (princ "Or type `h i' to read the full Calc manual on-line.\n\n")
- (princ "Basic keys:\n")
- (let* ((calc-full-help-flag t))
- (mapcar (function (lambda (x) (princ (format " %s\n" x))))
- (nreverse (cdr (reverse (cdr (calc-help))))))
- (mapcar (function (lambda (prefix)
- (let ((msgs (condition-case err
- (funcall prefix)
- (error nil))))
- (if (car msgs)
- (princ
- (if (eq (nth 2 msgs) ?v)
- "\n`v' or `V' prefix (vector/matrix) keys: \n"
- (if (nth 2 msgs)
- (format
- "\n`%c' prefix (%s) keys:\n"
- (nth 2 msgs)
- (or (cdr (assq (nth 2 msgs)
- calc-help-long-names))
- (nth 1 msgs)))
- (format "\n%s-modified keys:\n"
- (capitalize (nth 1 msgs)))))))
- (mapcar (function (lambda (x)
- (princ (format " %s\n" x))))
- (car msgs)))))
- '(calc-inverse-prefix-help
- calc-hyperbolic-prefix-help
- calc-inv-hyp-prefix-help
- calc-a-prefix-help
- calc-b-prefix-help
- calc-c-prefix-help
- calc-d-prefix-help
- calc-f-prefix-help
- calc-g-prefix-help
- calc-h-prefix-help
- calc-j-prefix-help
- calc-k-prefix-help
- calc-m-prefix-help
- calc-r-prefix-help
- calc-s-prefix-help
- calc-t-prefix-help
- calc-u-prefix-help
- calc-v-prefix-help
- calc-shift-Y-prefix-help
- calc-shift-Z-prefix-help
- calc-z-prefix-help)))
- (print-help-return-message)))
-
-(defvar calc-help-long-names '((?b . "binary/business")
- (?g . "graphics")
- (?j . "selection")
- (?k . "combinatorics/statistics")
- (?u . "units/statistics")))
-
-(defun calc-h-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Help; Bindings; Info, Tutorial, Summary; News"
- "describe: Key, C (briefly), Function, Variable")
- "help" ?h))
-
-(defun calc-inverse-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("I + S (arcsin), C (arccos), T (arctan); Q (square)"
- "I + E (ln), L (exp), B (alog: B^X); f E (lnp1), f L (expm1)"
- "I + F (ceiling), R (truncate); a S (invert func)"
- "I + a m (match-not); c h (from-hms); k n (prev prime)"
- "I + f G (gamma-Q); f e (erfc); k B (etc., lower-tail dists)"
- "I + V S (reverse sort); V G (reverse grade)"
- "I + v s (remove subvec); v h (tail)"
- "I + t + (alt sum), t M (mean with error)"
- "I + t S (pop std dev), t C (pop covar)")
- "inverse" nil))
-
-(defun calc-hyperbolic-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("H + S (sinh), C (cosh), T (tanh); E (exp10), L (log10)"
- "H + F (float floor), R (float round); P (constant \"e\")"
- "H + a d (total derivative); k c (permutations)"
- "H + k b (bern-poly), k e (euler-poly); k s (stirling-2)"
- "H + f G (gamma-g), f B (beta-B); v h (rhead), v k (rcons)"
- "H + v e (expand w/filler); V H (weighted histogram)"
- "H + a S (general solve eqn), j I (general isolate)"
- "H + a R (widen/root), a N (widen/min), a X (widen/max)"
- "H + t M (median), t S (variance), t C (correlation coef)"
- "H + c f/F/c (pervasive float/frac/clean)")
- "hyperbolic" nil))
-
-(defun calc-inv-hyp-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("I H + S (arcsinh), C (arccosh), T (arctanh)"
- "I H + E (log10), L (exp10); f G (gamma-G)"
- "I H + F (float ceiling), R (float truncate)"
- "I H + t S (pop variance)"
- "I H + a S (general invert func); v h (rtail)")
- "inverse-hyperbolic" nil))
-
-
-(defun calc-f-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("miN, maX; Hypot; Im, Re; Sign; [, ] (incr/decr)"
- "Gamma, Beta, Erf, besselJ, besselY"
- "SHIFT + int-sQrt; Int-log, Exp(x)-1, Ln(x+1); arcTan2"
- "SHIFT + Abssqr; Mantissa, eXponent, Scale"
- "SHIFT + incomplete: Gamma-P, Beta-I")
- "functions" ?f))
-
-
-(defun calc-s-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Store, inTo, Xchg, Unstore; Recall, 0-9; : (:=); = (=>)"
- "Let; Copy; Declare; Insert, Perm; Edit"
- "Negate, +, -, *, /, ^, &, |, [, ]; Map"
- "SHIFT + Decls, GenCount, TimeZone, Holidays; IntegLimit"
- "SHIFT + LineStyles, PointStyles, plotRejects; Units"
- "SHIFT + Eval-, AlgSimp-, ExtSimp-, FitRules")
- "store" ?s))
-
-(defun calc-r-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("digits 0-9: recall, same as `s r 0-9'")
- "recall" ?r))
-
-
-(defun calc-j-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Select, Additional, Once; eVal, Formula; Rewrite"
- "More, Less, 1-9, Next, Previous"
- "Unselect, Clear; Display; Enable; Breakable"
- "' (replace), ` (edit), +, -, *, /, RET (grab), DEL"
- "SHIFT + swap: Left, Right; maybe: Select, Once"
- "SHIFT + Commute, Merge, Distrib, jump-Eqn, Isolate"
- "SHIFT + Negate, & (invert); Unpack")
- "select" ?j))
-
-
-(defun calc-a-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Simplify, Extended-simplify, eVal; \" (exp-formula)"
- "eXpand, Collect, Factor, Apart, Norm-rat"
- "GCD, /, \\, % (polys); Polint"
- "Derivative, Integral, Taylor; _ (subscr)"
- "suBstitute; Rewrite, Match"
- "SHIFT + Solve; Root, miN, maX; Poly-roots; Fit"
- "SHIFT + Map; Tabulate, + (sum), * (prod); num-Integ"
- "relations: =, # (not =), <, >, [ (< or =), ] (> or =)"
- "logical: & (and), | (or), ! (not); : (if)"
- "misc: { (in-set); . (rmeq)")
- "algebra" ?a))
-
-
-(defun calc-b-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("And, Or, Xor, Diff, Not; Wordsize, Clip"
- "Lshift, Rshift, roTate; SHIFT + signed Lshift, Rshift"
- "SHIFT + business: Pv, Npv, Fv, pMt, #pmts, raTe, Irr"
- "SHIFT + business: Sln, sYd, Ddb; %ch")
- "binary/bus" ?b))
-
-
-(defun calc-c-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Deg, Rad, HMS; Float; Polar/rect; Clean, 0-9; %"
- "SHIFT + Fraction")
- "convert" ?c))
-
-
-(defun calc-d-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Group, \",\"; Normal, Fix, Sci, Eng, \".\"; Over"
- "Radix, Zeros, 2, 8, 0, 6; Hms; Date; Complex, I, J"
- "Why; Line-nums, line-Breaks; <, =, > (justify); Plain"
- "\" (strings); Truncate, [, ]; SPC (refresh), RET, @"
- "SHIFT + language: Normal, One-line, Big, Unformatted"
- "SHIFT + language: C, Pascal, Fortran; TeX, Eqn"
- "SHIFT + language: Mathematica, W=Maple")
- "display" ?d))
-
-
-(defun calc-g-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Fast; Add, Delete, Juggle; Plot, Clear; Quit"
- "Header, Name, Grid, Border, Key; View-commands, X-display"
- "x-axis: Range, Title, Log, Zero; lineStyle"
- "SHIFT + y-axis: Range, Title, Log, Zero; pointStyle"
- "SHIFT + Print; Device, Output-file; X-geometry"
- "SHIFT + Num-pts; Command, Kill, View-trail"
- "SHIFT + 3d: Fast, Add; CTRL + z-axis: Range, Title, Log")
- "graph" ?g))
-
-
-(defun calc-k-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("GCD, LCM; Choose (binomial), Double-factorial"
- "Random, random-Again, sHuffle"
- "Factors, Prime-test, Next-prime, Totient, Moebius"
- "Bernoulli, Euler, Stirling"
- "SHIFT + Extended-gcd"
- "SHIFT + dists: Binomial, Chi-square, F, Normal"
- "SHIFT + dists: Poisson, student's-T")
- "combinatorics" ?k))
-
-
-(defun calc-m-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Deg, Rad, HMS; Frac; Polar; Inf; Alg, Total; Symb; Vec/mat"
- "Working; Xtensions; Mode-save"
- "SHIFT + Shifted-prefixes, mode-Filename; Record; reCompute"
- "SHIFT + simplify: Off, Num, Default, Bin, Alg, Ext, Units")
- "mode" ?m))
-
-
-(defun calc-t-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Display; Fwd, Back; Next, Prev, Here, [, ]; Yank"
- "Search, Rev; In, Out; <, >; Kill; Marker; . (abbrev)"
- "SHIFT + time: Now; Part; Date, Julian, Unix, Czone"
- "SHIFT + time: newWeek, newMonth, newYear; Incmonth"
- "SHIFT + time: +, - (business days)"
- "digits 0-9: store-to, same as `s t 0-9'")
- "trail/time" ?t))
-
-
-(defun calc-u-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Simplify, Convert, Temperature-convert, Base-units"
- "Autorange; Remove, eXtract; Explain; View-table; 0-9"
- "Define, Undefine, Get-defn, Permanent"
- "SHIFT + View-table-other-window"
- "SHIFT + stat: Mean, G-mean, Std-dev, Covar, maX, miN"
- "SHIFT + stat: + (sum), - (asum), * (prod), # (count)")
- "units/stat" ?u))
-
-
-(defun calc-v-prefix-help ()
- (interactive)
- (calc-do-prefix-help
- '("Pack, Unpack, Identity, Diagonal, indeX, Build"
- "Row, Column, Subvector; Length; Find; Mask, Expand"
- "Tranpose, Arrange, reVerse; Head, Kons; rNorm"
- "SHIFT + Det, & (inverse), LUD, Trace, conJtrn, Cross"
- "SHIFT + Sort, Grade, Histogram; cNorm"
- "SHIFT + Apply, Map, Reduce, accUm, Inner-, Outer-prod"
- "SHIFT + sets: V (union), ^ (intersection), - (diff)"
- "SHIFT + sets: Xor, ~ (complement), Floor, Enum"
- "SHIFT + sets: : (span), # (card), + (rdup)"
- "<, =, > (justification); , (commas); [, {, ( (brackets)"
- "} (matrix brackets); . (abbreviate); / (multi-lines)")
- "vec/mat" ?v))
-
-;;; calc-help.el ends here
+++ /dev/null
-;;; calc-incom.el --- complex data type input functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-incom () nil)
-
-
-;;; Incomplete forms.
-
-(defun calc-begin-complex ()
- (interactive)
- (calc-wrapper
- (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
- (calc-alg-entry "(")
- (calc-push (list 'incomplete calc-complex-mode)))))
-
-(defun calc-end-complex ()
- (interactive)
- (calc-comma t)
- (calc-wrapper
- (let ((top (calc-top 1)))
- (if (and (eq (car-safe top) 'incomplete)
- (eq (nth 1 top) 'intv))
- (progn
- (if (< (length top) 4)
- (setq top (append top '((neg (var inf var-inf))))))
- (if (< (length top) 5)
- (setq top (append top '((var inf var-inf)))))
- (calc-enter-result 1 "..)" (cdr top)))
- (if (not (and (eq (car-safe top) 'incomplete)
- (memq (nth 1 top) '(cplx polar))))
- (error "Not entering a complex number"))
- (while (< (length top) 4)
- (setq top (append top '(0))))
- (if (not (and (math-realp (nth 2 top))
- (math-anglep (nth 3 top))))
- (error "Components must be real"))
- (calc-enter-result 1 "()" (cdr top))))))
-
-(defun calc-begin-vector ()
- (interactive)
- (calc-wrapper
- (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
- (calc-alg-entry "[")
- (calc-push '(incomplete vec)))))
-
-(defun calc-end-vector ()
- (interactive)
- (calc-comma t)
- (calc-wrapper
- (let ((top (calc-top 1)))
- (if (and (eq (car-safe top) 'incomplete)
- (eq (nth 1 top) 'intv))
- (progn
- (if (< (length top) 4)
- (setq top (append top '((neg (var inf var-inf))))))
- (if (< (length top) 5)
- (setq top (append top '((var inf var-inf)))))
- (setcar (cdr (cdr top)) (1+ (nth 2 top)))
- (calc-enter-result 1 "..]" (cdr top)))
- (if (not (and (eq (car-safe top) 'incomplete)
- (eq (nth 1 top) 'vec)))
- (error "Not entering a vector"))
- (calc-pop-push-record 1 "[]" (cdr top))))))
-
-(defun calc-comma (&optional allow-polar)
- (interactive)
- (calc-wrapper
- (let ((num (calc-find-first-incomplete
- (nthcdr calc-stack-top calc-stack) 1)))
- (if (= num 0)
- (error "Not entering a vector or complex number"))
- (let* ((inc (calc-top num))
- (stuff (calc-top-list (1- num)))
- (new (append inc stuff)))
- (if (and (null stuff)
- (not allow-polar)
- (or (eq (nth 1 inc) 'vec)
- (< (length new) 4)))
- (setq new (append new
- (if (= (length new) 2)
- '(0)
- (nthcdr (1- (length new)) new)))))
- (or allow-polar
- (if (eq (nth 1 new) 'polar)
- (setq new (append '(incomplete cplx) (cdr (cdr new))))
- (if (eq (nth 1 new) 'intv)
- (setq new (append '(incomplete cplx)
- (cdr (cdr (cdr new))))))))
- (if (and (memq (nth 1 new) '(cplx polar))
- (> (length new) 4))
- (error "Too many components in complex number"))
- (if (and (eq (nth 1 new) 'intv)
- (> (length new) 5))
- (error "Too many components in interval form"))
- (calc-pop-push num new)))))
-
-(defun calc-semi ()
- (interactive)
- (calc-wrapper
- (let ((num (calc-find-first-incomplete
- (nthcdr calc-stack-top calc-stack) 1)))
- (if (= num 0)
- (error "Not entering a vector or complex number"))
- (let ((inc (calc-top num))
- (stuff (calc-top-list (1- num))))
- (if (eq (nth 1 inc) 'cplx)
- (setq inc (append '(incomplete polar) (cdr (cdr inc))))
- (if (eq (nth 1 inc) 'intv)
- (setq inc (append '(incomplete polar) (cdr (cdr (cdr inc)))))))
- (cond ((eq (nth 1 inc) 'polar)
- (let ((new (append inc stuff)))
- (if (> (length new) 4)
- (error "Too many components in complex number")
- (if (= (length new) 2)
- (setq new (append new '(1)))))
- (calc-pop-push num new)))
- ((null stuff)
- (if (> (length inc) 2)
- (if (math-vectorp (nth 2 inc))
- (calc-comma)
- (calc-pop-push 1
- (list 'incomplete 'vec (cdr (cdr inc)))
- (list 'incomplete 'vec)))))
- ((math-vectorp (car stuff))
- (calc-comma))
- ((eq (car-safe (car-safe (nth (+ num calc-stack-top)
- calc-stack))) 'incomplete)
- (calc-end-vector)
- (calc-comma)
- (let ((calc-algebraic-mode nil)
- (calc-incomplete-algebraic-mode nil))
- (calc-begin-vector)))
- ((or (= (length inc) 2)
- (math-vectorp (nth 2 inc)))
- (calc-pop-push num
- (append inc (list (cons 'vec stuff)))
- (list 'incomplete 'vec)))
- (t
- (calc-pop-push num
- (list 'incomplete 'vec
- (cons 'vec (append (cdr (cdr inc)) stuff)))
- (list 'incomplete 'vec))))))))
-
-(defun calc-digit-dots ()
- (if (eq calc-prev-char ?.)
- (progn
- (delete-backward-char 1)
- (if (calc-minibuffer-contains ".*\\.\\'")
- (delete-backward-char 1))
- (setq calc-prev-char 'dots
- last-command-char 32)
- (if calc-prev-prev-char
- (calcDigit-nondigit)
- (setq calc-digit-value nil)
- (erase-buffer)
- (exit-minibuffer)))
- ;; just ignore extra decimal point, anticipating ".."
- (delete-backward-char 1)))
-
-(defun calc-dots ()
- (interactive)
- (calc-wrapper
- (let ((num (calc-find-first-incomplete
- (nthcdr calc-stack-top calc-stack) 1)))
- (if (= num 0)
- (error "Not entering an interval form"))
- (let* ((inc (calc-top num))
- (stuff (calc-top-list (1- num)))
- (new (append inc stuff)))
- (if (not (eq (nth 1 new) 'intv))
- (setq new (append '(incomplete intv)
- (if (eq (nth 1 new) 'vec) '(2) '(0))
- (cdr (cdr new)))))
- (if (and (null stuff)
- (= (length new) 3))
- (setq new (append new '((neg (var inf var-inf))))))
- (if (> (length new) 5)
- (error "Too many components in interval form"))
- (calc-pop-push num new)))))
-
-(defun calc-find-first-incomplete (stack n)
- (cond ((null stack)
- 0)
- ((eq (car-safe (car-safe (car stack))) 'incomplete)
- n)
- (t
- (calc-find-first-incomplete (cdr stack) (1+ n)))))
-
-(defun calc-incomplete-error (a)
- (cond ((memq (nth 1 a) '(cplx polar))
- (error "Complex number is incomplete"))
- ((eq (nth 1 a) 'vec)
- (error "Vector is incomplete"))
- ((eq (nth 1 a) 'intv)
- (error "Interval form is incomplete"))
- (t (error "Object is incomplete"))))
-
-;;; calc-incom.el ends here
+++ /dev/null
-;;; calc-keypd.el --- mouse-capable keypad input for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-keypd () nil)
-
-
-(defvar calc-keypad-buffer nil)
-(defvar calc-keypad-menu 0)
-(defvar calc-keypad-full-layout nil)
-(defvar calc-keypad-input nil)
-(defvar calc-keypad-prev-input nil)
-(defvar calc-keypad-said-hello nil)
-
-;;; |----+----+----+----+----+----|
-;;; | ENTER |+/- |EEX |UNDO| <- |
-;;; |-----+---+-+--+--+-+---++----|
-;;; | INV | 7 | 8 | 9 | / |
-;;; |-----+-----+-----+-----+-----|
-;;; | HYP | 4 | 5 | 6 | * |
-;;; |-----+-----+-----+-----+-----|
-;;; |EXEC | 1 | 2 | 3 | - |
-;;; |-----+-----+-----+-----+-----|
-;;; | OFF | 0 | . | PI | + |
-;;; |-----+-----+-----+-----+-----|
-(defvar calc-keypad-layout
- '( ( ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
- ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
- ( "+/-" calc-change-sign calc-inv (progn -4 calc-pack) )
- ( "EEX" ("e") (progn calc-num-prefix calc-pack-interval)
- (progn -5 calc-pack) )
- ( "UNDO" calc-undo calc-redo calc-last-args )
- ( "<-" calc-pop (progn 0 calc-pop)
- (progn calc-num-prefix calc-pop) ) )
- ( ( "INV" calc-inverse )
- ( "7" ("7") calc-round )
- ( "8" ("8") (progn 2 calc-clean-num) )
- ( "9" ("9") calc-float )
- ( "/" calc-divide (progn calc-inverse calc-power) ) )
- ( ( "HYP" calc-hyperbolic )
- ( "4" ("4") calc-ln calc-log10 )
- ( "5" ("5") calc-exp calc-exp10 )
- ( "6" ("6") calc-abs )
- ( "*" calc-times calc-power ) )
- ( ( "EXEC" calc-keypad-execute )
- ( "1" ("1") calc-arcsin calc-sin )
- ( "2" ("2") calc-arccos calc-cos )
- ( "3" ("3") calc-arctan calc-tan )
- ( "-" calc-minus calc-conj ) )
- ( ( "OFF" calc-keypad-off )
- ( "0" ("0") calc-imaginary )
- ( "." (".") calc-precision )
- ( "PI" calc-pi )
- ( "+" calc-plus calc-sqrt ) ) ))
-
-(defvar calc-keypad-menus '( calc-keypad-math-menu
- calc-keypad-funcs-menu
- calc-keypad-binary-menu
- calc-keypad-vector-menu
- calc-keypad-modes-menu
- calc-keypad-user-menu ) )
-
-;;; |----+----+----+----+----+----|
-;;; |FLR |CEIL|RND |TRNC|CLN2|FLT |
-;;; |----+----+----+----+----+----|
-;;; | LN |EXP | |ABS |IDIV|MOD |
-;;; |----+----+----+----+----+----|
-;;; |SIN |COS |TAN |SQRT|y^x |1/x |
-
-(defvar calc-keypad-math-menu
- '( ( ( "FLR" calc-floor )
- ( "CEIL" calc-ceiling )
- ( "RND" calc-round )
- ( "TRNC" calc-trunc )
- ( "CLN2" (progn 2 calc-clean-num) )
- ( "FLT" calc-float ) )
- ( ( "LN" calc-ln )
- ( "EXP" calc-exp )
- ( "" nil )
- ( "ABS" calc-abs )
- ( "IDIV" calc-idiv )
- ( "MOD" calc-mod ) )
- ( ( "SIN" calc-sin )
- ( "COS" calc-cos )
- ( "TAN" calc-tan )
- ( "SQRT" calc-sqrt )
- ( "y^x" calc-power )
- ( "1/x" calc-inv ) ) ))
-
-;;; |----+----+----+----+----+----|
-;;; |IGAM|BETA|IBET|ERF |BESJ|BESY|
-;;; |----+----+----+----+----+----|
-;;; |IMAG|CONJ| RE |ATN2|RAND|RAGN|
-;;; |----+----+----+----+----+----|
-;;; |GCD |FACT|DFCT|BNOM|PERM|NXTP|
-
-(defvar calc-keypad-funcs-menu
- '( ( ( "IGAM" calc-inc-gamma )
- ( "BETA" calc-beta )
- ( "IBET" calc-inc-beta )
- ( "ERF" calc-erf )
- ( "BESJ" calc-bessel-J )
- ( "BESY" calc-bessel-Y ) )
- ( ( "IMAG" calc-imaginary )
- ( "CONJ" calc-conj )
- ( "RE" calc-re calc-im )
- ( "ATN2" calc-arctan2 )
- ( "RAND" calc-random )
- ( "RAGN" calc-random-again ) )
- ( ( "GCD" calc-gcd calc-lcm )
- ( "FACT" calc-factorial calc-gamma )
- ( "DFCT" calc-double-factorial )
- ( "BNOM" calc-choose )
- ( "PERM" calc-perm )
- ( "NXTP" calc-next-prime calc-prev-prime ) ) ))
-
-;;; |----+----+----+----+----+----|
-;;; |AND | OR |XOR |NOT |LSH |RSH |
-;;; |----+----+----+----+----+----|
-;;; |DEC |HEX |OCT |BIN |WSIZ|ARSH|
-;;; |----+----+----+----+----+----|
-;;; | A | B | C | D | E | F |
-
-(defvar calc-keypad-binary-menu
- '( ( ( "AND" calc-and calc-diff )
- ( "OR" calc-or )
- ( "XOR" calc-xor )
- ( "NOT" calc-not calc-clip )
- ( "LSH" calc-lshift-binary calc-rotate-binary )
- ( "RSH" calc-rshift-binary ) )
- ( ( "DEC" calc-decimal-radix )
- ( "HEX" calc-hex-radix )
- ( "OCT" calc-octal-radix )
- ( "BIN" calc-binary-radix )
- ( "WSIZ" calc-word-size )
- ( "ARSH" calc-rshift-arith ) )
- ( ( "A" ("A") )
- ( "B" ("B") )
- ( "C" ("C") )
- ( "D" ("D") )
- ( "E" ("E") )
- ( "F" ("F") ) ) ))
-
-;;; |----+----+----+----+----+----|
-;;; |SUM |PROD|MAX |MAP*|MAP^|MAP$|
-;;; |----+----+----+----+----+----|
-;;; |INV |DET |TRN |IDNT|CRSS|"x" |
-;;; |----+----+----+----+----+----|
-;;; |PACK|UNPK|INDX|BLD |LEN |... |
-
-(defvar calc-keypad-vector-menu
- '( ( ( "SUM" calc-vector-sum calc-vector-alt-sum calc-vector-mean )
- ( "PROD" calc-vector-product nil calc-vector-sdev )
- ( "MAX" calc-vector-max calc-vector-min calc-vector-median )
- ( "MAP*" (lambda () (interactive)
- (calc-map '(2 calcFunc-mul "*"))) )
- ( "MAP^" (lambda () (interactive)
- (calc-map '(2 calcFunc-pow "^"))) )
- ( "MAP$" calc-map-stack ) )
- ( ( "MINV" calc-inv )
- ( "MDET" calc-mdet )
- ( "MTRN" calc-transpose calc-conj-transpose )
- ( "IDNT" (progn calc-num-prefix calc-ident) )
- ( "CRSS" calc-cross )
- ( "\"x\"" "\excalc-algebraic-entry\rx\r"
- "\excalc-algebraic-entry\ry\r"
- "\excalc-algebraic-entry\rz\r"
- "\excalc-algebraic-entry\rt\r") )
- ( ( "PACK" calc-pack )
- ( "UNPK" calc-unpack )
- ( "INDX" (progn calc-num-prefix calc-index) "\C-u\excalc-index\r" )
- ( "BLD" (progn calc-num-prefix calc-build-vector) )
- ( "LEN" calc-vlength )
- ( "..." calc-full-vectors ) ) ))
-
-;;; |----+----+----+----+----+----|
-;;; |FLT |FIX |SCI |ENG |GRP | |
-;;; |----+----+----+----+----+----|
-;;; |RAD |DEG |FRAC|POLR|SYMB|PREC|
-;;; |----+----+----+----+----+----|
-;;; |SWAP|RLL3|RLL4|OVER|STO |RCL |
-
-(defvar calc-keypad-modes-menu
- '( ( ( "FLT" calc-normal-notation
- (progn calc-num-prefix calc-normal-notation) )
- ( "FIX" (progn 2 calc-fix-notation)
- (progn calc-num-prefix calc-fix-notation) )
- ( "SCI" calc-sci-notation
- (progn calc-num-prefix calc-sci-notation) )
- ( "ENG" calc-eng-notation
- (progn calc-num-prefix calc-eng-notation) )
- ( "GRP" calc-group-digits "\C-u-3\excalc-group-digits\r" )
- ( "" nil ) )
- ( ( "RAD" calc-radians-mode )
- ( "DEG" calc-degrees-mode )
- ( "FRAC" calc-frac-mode )
- ( "POLR" calc-polar-mode )
- ( "SYMB" calc-symbolic-mode )
- ( "PREC" calc-precision ) )
- ( ( "SWAP" calc-roll-down )
- ( "RLL3" (progn 3 calc-roll-up) (progn 3 calc-roll-down) )
- ( "RLL4" (progn 4 calc-roll-up) (progn 4 calc-roll-down) )
- ( "OVER" calc-over )
- ( "STO" calc-keypad-store )
- ( "RCL" calc-keypad-recall ) ) ))
-
-(define-derived-mode calc-keypad-mode fundamental-mode "Calculator"
- "Major mode for Calc keypad input."
- (define-key calc-keypad-mode-map " " 'calc-keypad-press)
- (define-key calc-keypad-mode-map (kbd "RET") 'calc-keypad-press)
- (define-key calc-keypad-mode-map (kbd "TAB") 'calc-keypad-menu)
- (define-key calc-keypad-mode-map "q" 'calc-keypad-off)
- (define-key calc-keypad-mode-map [(mouse-3)] 'calc-keypad-right-click)
- (define-key calc-keypad-mode-map [(mouse-2)] 'calc-keypad-middle-click)
- (define-key calc-keypad-mode-map [(mouse-1)] 'calc-keypad-left-click)
- (put 'calc-keypad-mode 'mode-class 'special)
- (make-local-variable 'calc-main-buffer))
-
-(defun calc-do-keypad (&optional full-display interactive)
- (calc-create-buffer)
- (let ((calcbuf (current-buffer)))
- (unless (bufferp calc-keypad-buffer)
- (set-buffer (setq calc-keypad-buffer (get-buffer-create "*Calc Keypad*")))
- (calc-keypad-mode)
- (setq calc-main-buffer calcbuf)
- (calc-keypad-redraw)
- (calc-trail-buffer))
- (let ((width 29)
- (height 17)
- win old-win)
- (if (setq win (get-buffer-window "*Calculator*"))
- (delete-window win))
- (if (setq win (get-buffer-window "*Calc Trail*"))
- (if (one-window-p)
- (switch-to-buffer (other-buffer))
- (delete-window win)))
- (if (setq win (get-buffer-window calc-keypad-buffer))
- (progn
- (bury-buffer "*Calculator*")
- (bury-buffer "*Calc Trail*")
- (bury-buffer calc-keypad-buffer)
- (if (one-window-p)
- (switch-to-buffer (other-buffer))
- (delete-window win)))
- (setq calc-was-keypad-mode t
- old-win (get-largest-window))
- (if (or (< (window-height old-win) (+ height 6))
- (< (window-width old-win) (+ width 15))
- full-display)
- (delete-other-windows old-win))
- (if (< (window-height old-win) (+ height 4))
- (error "Screen is not tall enough for this mode"))
- (if full-display
- (progn
- (setq win (split-window old-win (- (window-height old-win)
- height 1)))
- (set-window-buffer old-win (calc-trail-buffer))
- (set-window-buffer win calc-keypad-buffer)
- (set-window-start win 1)
- (setq win (split-window win (+ width 3) t))
- (set-window-buffer win calcbuf))
- (if (or t ; left-side keypad not yet fully implemented
- (< (save-excursion
- (set-buffer (window-buffer old-win))
- (current-column))
- (/ (window-width) 2)))
- (setq win (split-window old-win (- (window-width old-win)
- width 2)
- t))
- (setq old-win (split-window old-win (+ width 2) t)))
- (set-window-buffer win calc-keypad-buffer)
- (set-window-start win 1)
- (split-window win (- (window-height win) height 1))
- (set-window-buffer win calcbuf))
- (select-window old-win)
- (message "Welcome to GNU Emacs Calc! Use the left and right mouse buttons")
- (run-hooks 'calc-keypad-start-hook)
- (and calc-keypad-said-hello interactive
- (progn
- (sit-for 2)
- (message "")))
- (setq calc-keypad-said-hello t)))
- (setq calc-keypad-input nil)))
-
-(defun calc-keypad-off ()
- (interactive)
- (if calc-standalone-flag
- (save-buffers-kill-emacs nil)
- (calc-keypad)))
-
-(defun calc-keypad-redraw ()
- (set-buffer calc-keypad-buffer)
- (setq buffer-read-only t)
- (setq calc-keypad-full-layout (append (symbol-value (nth calc-keypad-menu
- calc-keypad-menus))
- calc-keypad-layout))
- (let ((buffer-read-only nil)
- (row calc-keypad-full-layout)
- (y 0))
- (erase-buffer)
- (insert "\n")
- (while row
- (let ((col (car row)))
- (while col
- (let* ((key (car col))
- (cwid (if (>= y 4)
- 5
- (if (and (= y 3) (eq col (car row)))
- (progn (setq col (cdr col)) 9)
- 4)))
- (name (if (and calc-standalone-flag
- (eq (nth 1 key) 'calc-keypad-off))
- "EXIT"
- (if (> (length (car key)) cwid)
- (substring (car key) 0 cwid)
- (car key))))
- (wid (length name))
- (pad (- cwid (/ wid 2))))
- (insert (make-string (/ (- cwid wid) 2) 32)
- name
- (make-string (/ (- cwid wid -1) 2) 32)
- (if (equal name "MENU")
- (int-to-string (1+ calc-keypad-menu))
- "|")))
- (or (setq col (cdr col))
- (insert "\n")))
- (insert (if (>= y 4)
- "-----+-----+-----+-----+-----"
- (if (= y 3)
- "-----+---+-+--+--+-+---++----"
- "----+----+----+----+----+----"))
- (if (= y 7) "+\n" "|\n"))
- (setq y (1+ y)
- row (cdr row)))))
- (setq calc-keypad-prev-input t)
- (calc-keypad-show-input)
- (goto-char (point-min)))
-
-(defun calc-keypad-show-input ()
- (or (equal calc-keypad-input calc-keypad-prev-input)
- (let ((buffer-read-only nil))
- (save-excursion
- (goto-char (point-min))
- (forward-line 1)
- (delete-region (point-min) (point))
- (if calc-keypad-input
- (insert "Calc: " calc-keypad-input "\n")
- (insert "----+-----Calc " calc-version "-----+----"
- (int-to-string (1+ calc-keypad-menu))
- "\n")))))
- (setq calc-keypad-prev-input calc-keypad-input))
-
-(defun calc-keypad-press ()
- (interactive)
- (unless (eq major-mode 'calc-keypad-mode)
- (error "Must be in *Calc Keypad* buffer for this command"))
- (let* ((row (save-excursion
- (beginning-of-line)
- (count-lines (point-min) (point))))
- (y (/ row 2))
- (x (/ (current-column) (if (>= y 4) 6 5)))
- radix frac inv
- (hyp (with-current-buffer calc-main-buffer
- (setq radix calc-number-radix
- frac calc-prefer-frac
- inv calc-inverse-flag)
- calc-hyperbolic-flag))
- (invhyp t)
- (menu (symbol-value (nth calc-keypad-menu calc-keypad-menus)))
- (input calc-keypad-input)
- (iexpon (and input
- (or (string-match "\\*[0-9]+\\.\\^" input)
- (and (<= radix 14) (string-match "e" input)))
- (match-end 0)))
- (key (nth x (nth y calc-keypad-full-layout)))
- (cmd (or (nth (if inv (if hyp 4 2) (if hyp 3 99)) key)
- (setq invhyp nil)
- (nth 1 key)))
- (isstring (and (consp cmd) (stringp (car cmd))))
- (calc-is-keypad-press t))
- (if invhyp (calc-wrapper)) ; clear Inv and Hyp flags
- (unwind-protect
- (cond ((or (null cmd)
- (= (% row 2) 0))
- (beep))
- ((and (> (minibuffer-depth) 0))
- (cond (isstring
- (push (aref (car cmd) 0) unread-command-events))
- ((eq cmd 'calc-pop)
- (push ?\177 unread-command-events))
- ((eq cmd 'calc-enter)
- (push 13 unread-command-events))
- ((eq cmd 'calc-undo)
- (push 7 unread-command-events))
- (t
- (beep))))
- ((and input (string-match "STO\\|RCL" input))
- (cond ((and isstring (string-match "[0-9]" (car cmd)))
- (setq calc-keypad-input nil)
- (let ((var (intern (concat "var-q" (car cmd)))))
- (cond ((equal input "STO+") (calc-store-plus var))
- ((equal input "STO-") (calc-store-minus var))
- ((equal input "STO*") (calc-store-times var))
- ((equal input "STO/") (calc-store-div var))
- ((equal input "STO^") (calc-store-power var))
- ((equal input "STOn") (calc-store-neg 1 var))
- ((equal input "STO&") (calc-store-inv 1 var))
- ((equal input "STO") (calc-store-into var))
- (t (calc-recall var)))))
- ((memq cmd '(calc-pop calc-undo))
- (setq calc-keypad-input nil))
- ((and (equal input "STO")
- (setq frac (assq cmd '( ( calc-plus . "+" )
- ( calc-minus . "-" )
- ( calc-times . "*" )
- ( calc-divide . "/" )
- ( calc-power . "^")
- ( calc-change-sign . "n")
- ( calc-inv . "&") ))))
- (setq calc-keypad-input (concat input (cdr frac))))
- (t
- (beep))))
- (isstring
- (setq cmd (car cmd))
- (if (or (and (equal cmd ".")
- input
- (string-match "[.:e^]" input))
- (and (equal cmd "e")
- input
- (or (and (<= radix 14) (string-match "e" input))
- (string-match "\\^\\|[-.:]\\'" input)))
- (and (not (equal cmd "."))
- (let ((case-fold-search nil))
- (string-match cmd "0123456789ABCDEF"
- (if (string-match
- "[e^]" (or input ""))
- 10 radix)))))
- (beep)
- (setq calc-keypad-input (concat
- (and (/= radix 10)
- (or (not input)
- (equal input "-"))
- (format "%d#" radix))
- (and (or (not input)
- (equal input "-"))
- (or (and (equal cmd "e") "1")
- (and (equal cmd ".")
- (if frac "1" "0"))))
- input
- (if (and (equal cmd ".") frac)
- ":"
- (if (and (equal cmd "e")
- (or (not input)
- (string-match
- "#" input))
- (> radix 14))
- (format "*%d.^" radix)
- cmd))))))
- ((and (eq cmd 'calc-change-sign)
- input)
- (let* ((epos (or iexpon 0))
- (suffix (substring input epos)))
- (setq calc-keypad-input (concat
- (substring input 0 epos)
- (if (string-match "\\`-" suffix)
- (substring suffix 1)
- (concat "-" suffix))))))
- ((and (eq cmd 'calc-pop)
- input)
- (if (equal input "")
- (beep)
- (setq calc-keypad-input (substring input 0
- (or (string-match
- "\\*[0-9]+\\.\\^\\'"
- input)
- -1)))))
- ((and (eq cmd 'calc-undo)
- input)
- (setq calc-keypad-input nil))
- (t
- (if input
- (let ((val (math-read-number input)))
- (setq calc-keypad-input nil)
- (if val
- (calc-wrapper
- (calc-push-list (list (calc-record
- (calc-normalize val)))))
- (or (equal input "")
- (beep))
- (setq cmd nil))
- (if (eq cmd 'calc-enter) (setq cmd nil))))
- (setq prefix-arg current-prefix-arg)
- (if cmd
- (if (and (consp cmd) (eq (car cmd) 'progn))
- (while (setq cmd (cdr cmd))
- (if (integerp (car cmd))
- (setq prefix-arg (car cmd))
- (command-execute (car cmd))))
- (command-execute cmd)))))
- (set-buffer calc-keypad-buffer)
- (calc-keypad-show-input))))
-
-(defun calc-keypad-left-click (event)
- "Handle a left-button mouse click in Calc Keypad window."
- (interactive "e")
- (goto-char (posn-point (event-start event)))
- (calc-keypad-press))
-
-(defun calc-keypad-right-click (event)
- "Handle a right-button mouse click in Calc Keypad window."
- (interactive "e")
- (save-excursion
- (set-buffer calc-keypad-buffer)
- (calc-keypad-menu)))
-
-(defun calc-keypad-middle-click (event)
- "Handle a middle-button mouse click in Calc Keypad window."
- (interactive "e")
- (with-current-buffer calc-keypad-buffer
- (calc-keypad-menu-back)))
-
-(defun calc-keypad-menu ()
- (interactive)
- (unless (eq major-mode 'calc-keypad-mode)
- (error "Must be in *Calc Keypad* buffer for this command"))
- (while (progn (setq calc-keypad-menu (% (1+ calc-keypad-menu)
- (length calc-keypad-menus)))
- (not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))
- (calc-keypad-redraw))
-
-(defun calc-keypad-menu-back ()
- (interactive)
- (or (eq major-mode 'calc-keypad-mode)
- (error "Must be in *Calc Keypad* buffer for this command"))
- (while (progn (setq calc-keypad-menu (% (1- (+ calc-keypad-menu
- (length calc-keypad-menus)))
- (length calc-keypad-menus)))
- (not (symbol-value (nth calc-keypad-menu calc-keypad-menus)))))
- (calc-keypad-redraw))
-
-(defun calc-keypad-store ()
- (interactive)
- (setq calc-keypad-input "STO"))
-
-(defun calc-keypad-recall ()
- (interactive)
- (setq calc-keypad-input "RCL"))
-
-(defun calc-pack-interval (mode)
- (interactive "p")
- (if (or (< mode 0) (> mode 3))
- (error "Open/close code should be in the range from 0 to 3"))
- (calc-pack (- -6 mode)))
-
-(defun calc-keypad-execute ()
- (interactive)
- (let* ((prompt "Calc keystrokes: ")
- (flush 'x-flush-mouse-queue)
- (prefix nil)
- keys cmd)
- (save-excursion
- (calc-select-buffer)
- (while (progn
- (setq keys (read-key-sequence prompt))
- (setq cmd (key-binding keys))
- (if (or (memq cmd '(calc-inverse
- calc-hyperbolic
- universal-argument
- digit-argument
- negative-argument))
- (and prefix (string-match "\\`\e?[-0-9]\\'" keys)))
- (progn
- (setq last-command-char (aref keys (1- (length keys))))
- (command-execute cmd)
- (setq flush 'not-any-more
- prefix t
- prompt (concat prompt (key-description keys) " ")))
- (eq cmd flush))))) ; skip mouse-up event
- (message "")
- (if (commandp cmd)
- (command-execute cmd)
- (error "Not a Calc command: %s" (key-description keys)))))
-
-
-;;; calc-keypd.el ends here
+++ /dev/null
-;;; calc-lang.el --- calc language functions
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-lang () nil)
-
-
-;;; Alternate entry/display languages.
-
-(defun calc-set-language (lang &optional option no-refresh)
- (setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers)
- math-expr-function-mapping (get lang 'math-function-table)
- math-expr-variable-mapping (get lang 'math-variable-table)
- calc-language-input-filter (get lang 'math-input-filter)
- calc-language-output-filter (get lang 'math-output-filter)
- calc-vector-brackets (or (get lang 'math-vector-brackets) "[]")
- calc-complex-format (get lang 'math-complex-format)
- calc-radix-formatter (get lang 'math-radix-formatter)
- calc-function-open (or (get lang 'math-function-open) "(")
- calc-function-close (or (get lang 'math-function-close) ")"))
- (if no-refresh
- (setq calc-language lang
- calc-language-option option)
- (calc-change-mode '(calc-language calc-language-option)
- (list lang option) t)))
-
-(defun calc-normal-language ()
- (interactive)
- (calc-wrapper
- (calc-set-language nil)
- (message "Normal language mode")))
-
-(defun calc-flat-language ()
- (interactive)
- (calc-wrapper
- (calc-set-language 'flat)
- (message "Flat language mode (all stack entries shown on one line)")))
-
-(defun calc-big-language ()
- (interactive)
- (calc-wrapper
- (calc-set-language 'big)
- (message "\"Big\" language mode")))
-
-(defun calc-unformatted-language ()
- (interactive)
- (calc-wrapper
- (calc-set-language 'unform)
- (message "Unformatted language mode")))
-
-
-(defun calc-c-language ()
- (interactive)
- (calc-wrapper
- (calc-set-language 'c)
- (message "`C' language mode")))
-
-(put 'c 'math-oper-table
- '( ( "u+" ident -1 1000 )
- ( "u-" neg -1 1000 )
- ( "u!" calcFunc-lnot -1 1000 )
- ( "~" calcFunc-not -1 1000 )
- ( "*" * 190 191 )
- ( "/" / 190 191 )
- ( "%" % 190 191 )
- ( "+" + 180 181 )
- ( "-" - 180 181 )
- ( "<<" calcFunc-lsh 170 171 )
- ( ">>" calcFunc-rsh 170 171 )
- ( "<" calcFunc-lt 160 161 )
- ( ">" calcFunc-gt 160 161 )
- ( "<=" calcFunc-leq 160 161 )
- ( ">=" calcFunc-geq 160 161 )
- ( "==" calcFunc-eq 150 151 )
- ( "!=" calcFunc-neq 150 151 )
- ( "&" calcFunc-and 140 141 )
- ( "^" calcFunc-xor 131 130 )
- ( "|" calcFunc-or 120 121 )
- ( "&&" calcFunc-land 110 111 )
- ( "||" calcFunc-lor 100 101 )
- ( "?" (math-read-if) 91 90 )
- ( "!!!" calcFunc-pnot -1 88 )
- ( "&&&" calcFunc-pand 85 86 )
- ( "|||" calcFunc-por 75 76 )
- ( "=" calcFunc-assign 51 50 )
- ( ":=" calcFunc-assign 51 50 )
- ( "::" calcFunc-condition 45 46 ))) ; should support full assignments
-
-(put 'c 'math-function-table
- '( ( acos . calcFunc-arccos )
- ( acosh . calcFunc-arccosh )
- ( asin . calcFunc-arcsin )
- ( asinh . calcFunc-arcsinh )
- ( atan . calcFunc-arctan )
- ( atan2 . calcFunc-arctan2 )
- ( atanh . calcFunc-arctanh )))
-
-(put 'c 'math-variable-table
- '( ( M_PI . var-pi )
- ( M_E . var-e )))
-
-(put 'c 'math-vector-brackets "{}")
-
-(put 'c 'math-radix-formatter
- (function (lambda (r s)
- (if (= r 16) (format "0x%s" s)
- (if (= r 8) (format "0%s" s)
- (format "%d#%s" r s))))))
-
-
-(defun calc-pascal-language (n)
- (interactive "P")
- (calc-wrapper
- (and n (setq n (prefix-numeric-value n)))
- (calc-set-language 'pascal n)
- (message (if (and n (/= n 0))
- (if (> n 0)
- "Pascal language mode (all uppercase)"
- "Pascal language mode (all lowercase)")
- "Pascal language mode"))))
-
-(put 'pascal 'math-oper-table
- '( ( "not" calcFunc-lnot -1 1000 )
- ( "*" * 190 191 )
- ( "/" / 190 191 )
- ( "and" calcFunc-and 190 191 )
- ( "div" calcFunc-idiv 190 191 )
- ( "mod" % 190 191 )
- ( "u+" ident -1 185 )
- ( "u-" neg -1 185 )
- ( "+" + 180 181 )
- ( "-" - 180 181 )
- ( "or" calcFunc-or 180 181 )
- ( "xor" calcFunc-xor 180 181 )
- ( "shl" calcFunc-lsh 180 181 )
- ( "shr" calcFunc-rsh 180 181 )
- ( "in" calcFunc-in 160 161 )
- ( "<" calcFunc-lt 160 161 )
- ( ">" calcFunc-gt 160 161 )
- ( "<=" calcFunc-leq 160 161 )
- ( ">=" calcFunc-geq 160 161 )
- ( "=" calcFunc-eq 160 161 )
- ( "<>" calcFunc-neq 160 161 )
- ( "!!!" calcFunc-pnot -1 85 )
- ( "&&&" calcFunc-pand 80 81 )
- ( "|||" calcFunc-por 75 76 )
- ( ":=" calcFunc-assign 51 50 )
- ( "::" calcFunc-condition 45 46 )))
-
-(put 'pascal 'math-input-filter 'calc-input-case-filter)
-(put 'pascal 'math-output-filter 'calc-output-case-filter)
-
-(put 'pascal 'math-radix-formatter
- (function (lambda (r s)
- (if (= r 16) (format "$%s" s)
- (format "%d#%s" r s)))))
-
-(defun calc-input-case-filter (str)
- (cond ((or (null calc-language-option) (= calc-language-option 0))
- str)
- (t
- (downcase str))))
-
-(defun calc-output-case-filter (str)
- (cond ((or (null calc-language-option) (= calc-language-option 0))
- str)
- ((> calc-language-option 0)
- (upcase str))
- (t
- (downcase str))))
-
-
-(defun calc-fortran-language (n)
- (interactive "P")
- (calc-wrapper
- (and n (setq n (prefix-numeric-value n)))
- (calc-set-language 'fortran n)
- (message (if (and n (/= n 0))
- (if (> n 0)
- "FORTRAN language mode (all uppercase)"
- "FORTRAN language mode (all lowercase)")
- "FORTRAN language mode"))))
-
-(put 'fortran 'math-oper-table
- '( ( "u/" (math-parse-fortran-vector) -1 1 )
- ( "/" (math-parse-fortran-vector-end) 1 -1 )
- ( "**" ^ 201 200 )
- ( "u+" ident -1 191 )
- ( "u-" neg -1 191 )
- ( "*" * 190 191 )
- ( "/" / 190 191 )
- ( "+" + 180 181 )
- ( "-" - 180 181 )
- ( ".LT." calcFunc-lt 160 161 )
- ( ".GT." calcFunc-gt 160 161 )
- ( ".LE." calcFunc-leq 160 161 )
- ( ".GE." calcFunc-geq 160 161 )
- ( ".EQ." calcFunc-eq 160 161 )
- ( ".NE." calcFunc-neq 160 161 )
- ( ".NOT." calcFunc-lnot -1 121 )
- ( ".AND." calcFunc-land 110 111 )
- ( ".OR." calcFunc-lor 100 101 )
- ( "!!!" calcFunc-pnot -1 85 )
- ( "&&&" calcFunc-pand 80 81 )
- ( "|||" calcFunc-por 75 76 )
- ( "=" calcFunc-assign 51 50 )
- ( ":=" calcFunc-assign 51 50 )
- ( "::" calcFunc-condition 45 46 )))
-
-(put 'fortran 'math-vector-brackets "//")
-
-(put 'fortran 'math-function-table
- '( ( acos . calcFunc-arccos )
- ( acosh . calcFunc-arccosh )
- ( aimag . calcFunc-im )
- ( aint . calcFunc-ftrunc )
- ( asin . calcFunc-arcsin )
- ( asinh . calcFunc-arcsinh )
- ( atan . calcFunc-arctan )
- ( atan2 . calcFunc-arctan2 )
- ( atanh . calcFunc-arctanh )
- ( conjg . calcFunc-conj )
- ( log . calcFunc-ln )
- ( nint . calcFunc-round )
- ( real . calcFunc-re )))
-
-(put 'fortran 'math-input-filter 'calc-input-case-filter)
-(put 'fortran 'math-output-filter 'calc-output-case-filter)
-
-(defvar math-parsing-fortran-vector nil)
-(defun math-parse-fortran-vector (op)
- (let ((math-parsing-fortran-vector '(end . "\000")))
- (prog1
- (math-read-brackets t "]")
- (setq exp-token (car math-parsing-fortran-vector)
- exp-data (cdr math-parsing-fortran-vector)))))
-
-(defun math-parse-fortran-vector-end (x op)
- (if math-parsing-fortran-vector
- (progn
- (setq math-parsing-fortran-vector (cons exp-token exp-data)
- exp-token 'end
- exp-data "\000")
- x)
- (throw 'syntax "Unmatched closing `/'")))
-
-(defun math-parse-fortran-subscr (sym args)
- (setq sym (math-build-var-name sym))
- (while args
- (setq sym (list 'calcFunc-subscr sym (car args))
- args (cdr args)))
- sym)
-
-
-(defun calc-tex-language (n)
- (interactive "P")
- (calc-wrapper
- (and n (setq n (prefix-numeric-value n)))
- (calc-set-language 'tex n)
- (message (if (and n (/= n 0))
- (if (> n 0)
- "TeX language mode with \\hbox{func}(\\hbox{var})"
- "TeX language mode with \\func{\\hbox{var}}")
- "TeX language mode"))))
-
-(put 'tex 'math-oper-table
- '( ( "u+" ident -1 1000 )
- ( "u-" neg -1 1000 )
- ( "\\hat" calcFunc-hat -1 950 )
- ( "\\check" calcFunc-check -1 950 )
- ( "\\tilde" calcFunc-tilde -1 950 )
- ( "\\acute" calcFunc-acute -1 950 )
- ( "\\grave" calcFunc-grave -1 950 )
- ( "\\dot" calcFunc-dot -1 950 )
- ( "\\ddot" calcFunc-dotdot -1 950 )
- ( "\\breve" calcFunc-breve -1 950 )
- ( "\\bar" calcFunc-bar -1 950 )
- ( "\\vec" calcFunc-Vec -1 950 )
- ( "\\underline" calcFunc-under -1 950 )
- ( "u|" calcFunc-abs -1 0 )
- ( "|" closing 0 -1 )
- ( "\\lfloor" calcFunc-floor -1 0 )
- ( "\\rfloor" closing 0 -1 )
- ( "\\lceil" calcFunc-ceil -1 0 )
- ( "\\rceil" closing 0 -1 )
- ( "\\pm" sdev 300 300 )
- ( "!" calcFunc-fact 210 -1 )
- ( "^" ^ 201 200 )
- ( "_" calcFunc-subscr 201 200 )
- ( "\\times" * 191 190 )
- ( "*" * 191 190 )
- ( "2x" * 191 190 )
- ( "+" + 180 181 )
- ( "-" - 180 181 )
- ( "\\over" / 170 171 )
- ( "/" / 170 171 )
- ( "\\choose" calcFunc-choose 170 171 )
- ( "\\mod" % 170 171 )
- ( "<" calcFunc-lt 160 161 )
- ( ">" calcFunc-gt 160 161 )
- ( "\\leq" calcFunc-leq 160 161 )
- ( "\\geq" calcFunc-geq 160 161 )
- ( "=" calcFunc-eq 160 161 )
- ( "\\neq" calcFunc-neq 160 161 )
- ( "\\ne" calcFunc-neq 160 161 )
- ( "\\lnot" calcFunc-lnot -1 121 )
- ( "\\land" calcFunc-land 110 111 )
- ( "\\lor" calcFunc-lor 100 101 )
- ( "?" (math-read-if) 91 90 )
- ( "!!!" calcFunc-pnot -1 85 )
- ( "&&&" calcFunc-pand 80 81 )
- ( "|||" calcFunc-por 75 76 )
- ( "\\gets" calcFunc-assign 51 50 )
- ( ":=" calcFunc-assign 51 50 )
- ( "::" calcFunc-condition 45 46 )
- ( "\\to" calcFunc-evalto 40 41 )
- ( "\\to" calcFunc-evalto 40 -1 )
- ( "=>" calcFunc-evalto 40 41 )
- ( "=>" calcFunc-evalto 40 -1 )))
-
-(put 'tex 'math-function-table
- '( ( \\arccos . calcFunc-arccos )
- ( \\arcsin . calcFunc-arcsin )
- ( \\arctan . calcFunc-arctan )
- ( \\arg . calcFunc-arg )
- ( \\cos . calcFunc-cos )
- ( \\cosh . calcFunc-cosh )
- ( \\det . calcFunc-det )
- ( \\exp . calcFunc-exp )
- ( \\gcd . calcFunc-gcd )
- ( \\ln . calcFunc-ln )
- ( \\log . calcFunc-log10 )
- ( \\max . calcFunc-max )
- ( \\min . calcFunc-min )
- ( \\tan . calcFunc-tan )
- ( \\sin . calcFunc-sin )
- ( \\sinh . calcFunc-sinh )
- ( \\sqrt . calcFunc-sqrt )
- ( \\tanh . calcFunc-tanh )
- ( \\phi . calcFunc-totient )
- ( \\mu . calcFunc-moebius )))
-
-(put 'tex 'math-variable-table
- '( ( \\pi . var-pi )
- ( \\infty . var-inf )
- ( \\infty . var-uinf )
- ( \\phi . var-phi )
- ( \\gamma . var-gamma )
- ( \\sum . (math-parse-tex-sum calcFunc-sum) )
- ( \\prod . (math-parse-tex-sum calcFunc-prod) )))
-
-(put 'tex 'math-complex-format 'i)
-
-(defun math-parse-tex-sum (f val)
- (let (low high save)
- (or (equal exp-data "_") (throw 'syntax "Expected `_'"))
- (math-read-token)
- (setq save exp-old-pos)
- (setq low (math-read-factor))
- (or (eq (car-safe low) 'calcFunc-eq)
- (progn
- (setq exp-old-pos (1+ save))
- (throw 'syntax "Expected equation")))
- (or (equal exp-data "^") (throw 'syntax "Expected `^'"))
- (math-read-token)
- (setq high (math-read-factor))
- (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high)))
-
-(defun math-tex-input-filter (str) ; allow parsing of 123\,456\,789.
- (while (string-match "[0-9]\\\\,[0-9]" str)
- (setq str (concat (substring str 0 (1+ (match-beginning 0)))
- (substring str (1- (match-end 0))))))
- str)
-(put 'tex 'math-input-filter 'math-tex-input-filter)
-
-
-(defun calc-eqn-language (n)
- (interactive "P")
- (calc-wrapper
- (calc-set-language 'eqn)
- (message "Eqn language mode")))
-
-(put 'eqn 'math-oper-table
- '( ( "u+" ident -1 1000 )
- ( "u-" neg -1 1000 )
- ( "prime" (math-parse-eqn-prime) 950 -1 )
- ( "prime" calcFunc-Prime 950 -1 )
- ( "dot" calcFunc-dot 950 -1 )
- ( "dotdot" calcFunc-dotdot 950 -1 )
- ( "hat" calcFunc-hat 950 -1 )
- ( "tilde" calcFunc-tilde 950 -1 )
- ( "vec" calcFunc-Vec 950 -1 )
- ( "dyad" calcFunc-dyad 950 -1 )
- ( "bar" calcFunc-bar 950 -1 )
- ( "under" calcFunc-under 950 -1 )
- ( "sub" calcFunc-subscr 931 930 )
- ( "sup" ^ 921 920 )
- ( "sqrt" calcFunc-sqrt -1 910 )
- ( "over" / 900 901 )
- ( "u|" calcFunc-abs -1 0 )
- ( "|" closing 0 -1 )
- ( "left floor" calcFunc-floor -1 0 )
- ( "right floor" closing 0 -1 )
- ( "left ceil" calcFunc-ceil -1 0 )
- ( "right ceil" closing 0 -1 )
- ( "+-" sdev 300 300 )
- ( "!" calcFunc-fact 210 -1 )
- ( "times" * 191 190 )
- ( "*" * 191 190 )
- ( "2x" * 191 190 )
- ( "/" / 180 181 )
- ( "%" % 180 181 )
- ( "+" + 170 171 )
- ( "-" - 170 171 )
- ( "<" calcFunc-lt 160 161 )
- ( ">" calcFunc-gt 160 161 )
- ( "<=" calcFunc-leq 160 161 )
- ( ">=" calcFunc-geq 160 161 )
- ( "=" calcFunc-eq 160 161 )
- ( "==" calcFunc-eq 160 161 )
- ( "!=" calcFunc-neq 160 161 )
- ( "u!" calcFunc-lnot -1 121 )
- ( "&&" calcFunc-land 110 111 )
- ( "||" calcFunc-lor 100 101 )
- ( "?" (math-read-if) 91 90 )
- ( "!!!" calcFunc-pnot -1 85 )
- ( "&&&" calcFunc-pand 80 81 )
- ( "|||" calcFunc-por 75 76 )
- ( "<-" calcFunc-assign 51 50 )
- ( ":=" calcFunc-assign 51 50 )
- ( "::" calcFunc-condition 45 46 )
- ( "->" calcFunc-evalto 40 41 )
- ( "->" calcFunc-evalto 40 -1 )
- ( "=>" calcFunc-evalto 40 41 )
- ( "=>" calcFunc-evalto 40 -1 )))
-
-(put 'eqn 'math-function-table
- '( ( arc\ cos . calcFunc-arccos )
- ( arc\ cosh . calcFunc-arccosh )
- ( arc\ sin . calcFunc-arcsin )
- ( arc\ sinh . calcFunc-arcsinh )
- ( arc\ tan . calcFunc-arctan )
- ( arc\ tanh . calcFunc-arctanh )
- ( GAMMA . calcFunc-gamma )
- ( phi . calcFunc-totient )
- ( mu . calcFunc-moebius )
- ( matrix . (math-parse-eqn-matrix) )))
-
-(put 'eqn 'math-variable-table
- '( ( inf . var-uinf )))
-
-(put 'eqn 'math-complex-format 'i)
-
-(defun math-parse-eqn-matrix (f sym)
- (let ((vec nil))
- (while (assoc exp-data '(("ccol") ("lcol") ("rcol")))
- (math-read-token)
- (or (equal exp-data calc-function-open)
- (throw 'syntax "Expected `{'"))
- (math-read-token)
- (setq vec (cons (cons 'vec (math-read-expr-list)) vec))
- (or (equal exp-data calc-function-close)
- (throw 'syntax "Expected `}'"))
- (math-read-token))
- (or (equal exp-data calc-function-close)
- (throw 'syntax "Expected `}'"))
- (math-read-token)
- (math-transpose (cons 'vec (nreverse vec)))))
-
-(defun math-parse-eqn-prime (x sym)
- (if (eq (car-safe x) 'var)
- (if (equal exp-data calc-function-open)
- (progn
- (math-read-token)
- (let ((args (if (or (equal exp-data calc-function-close)
- (eq exp-token 'end))
- nil
- (math-read-expr-list))))
- (if (not (or (equal exp-data calc-function-close)
- (eq exp-token 'end)))
- (throw 'syntax "Expected `)'"))
- (math-read-token)
- (cons (intern (format "calcFunc-%s'" (nth 1 x))) args)))
- (list 'var
- (intern (concat (symbol-name (nth 1 x)) "'"))
- (intern (concat (symbol-name (nth 2 x)) "'"))))
- (list 'calcFunc-Prime x)))
-
-
-(defun calc-mathematica-language ()
- (interactive)
- (calc-wrapper
- (calc-set-language 'math)
- (message "Mathematica language mode")))
-
-(put 'math 'math-oper-table
- '( ( "[[" (math-read-math-subscr) 250 -1 )
- ( "!" calcFunc-fact 210 -1 )
- ( "!!" calcFunc-dfact 210 -1 )
- ( "^" ^ 201 200 )
- ( "u+" ident -1 197 )
- ( "u-" neg -1 197 )
- ( "/" / 195 196 )
- ( "*" * 190 191 )
- ( "2x" * 190 191 )
- ( "+" + 180 181 )
- ( "-" - 180 181 )
- ( "<" calcFunc-lt 160 161 )
- ( ">" calcFunc-gt 160 161 )
- ( "<=" calcFunc-leq 160 161 )
- ( ">=" calcFunc-geq 160 161 )
- ( "==" calcFunc-eq 150 151 )
- ( "!=" calcFunc-neq 150 151 )
- ( "u!" calcFunc-lnot -1 121 )
- ( "&&" calcFunc-land 110 111 )
- ( "||" calcFunc-lor 100 101 )
- ( "!!!" calcFunc-pnot -1 85 )
- ( "&&&" calcFunc-pand 80 81 )
- ( "|||" calcFunc-por 75 76 )
- ( ":=" calcFunc-assign 51 50 )
- ( "=" calcFunc-assign 51 50 )
- ( "->" calcFunc-assign 51 50 )
- ( ":>" calcFunc-assign 51 50 )
- ( "::" calcFunc-condition 45 46 )
-))
-
-(put 'math 'math-function-table
- '( ( Abs . calcFunc-abs )
- ( ArcCos . calcFunc-arccos )
- ( ArcCosh . calcFunc-arccosh )
- ( ArcSin . calcFunc-arcsin )
- ( ArcSinh . calcFunc-arcsinh )
- ( ArcTan . calcFunc-arctan )
- ( ArcTanh . calcFunc-arctanh )
- ( Arg . calcFunc-arg )
- ( Binomial . calcFunc-choose )
- ( Ceiling . calcFunc-ceil )
- ( Conjugate . calcFunc-conj )
- ( Cos . calcFunc-cos )
- ( Cosh . calcFunc-cosh )
- ( D . calcFunc-deriv )
- ( Dt . calcFunc-tderiv )
- ( Det . calcFunc-det )
- ( Exp . calcFunc-exp )
- ( EulerPhi . calcFunc-totient )
- ( Floor . calcFunc-floor )
- ( Gamma . calcFunc-gamma )
- ( GCD . calcFunc-gcd )
- ( If . calcFunc-if )
- ( Im . calcFunc-im )
- ( Inverse . calcFunc-inv )
- ( Integrate . calcFunc-integ )
- ( Join . calcFunc-vconcat )
- ( LCM . calcFunc-lcm )
- ( Log . calcFunc-ln )
- ( Max . calcFunc-max )
- ( Min . calcFunc-min )
- ( Mod . calcFunc-mod )
- ( MoebiusMu . calcFunc-moebius )
- ( Random . calcFunc-random )
- ( Round . calcFunc-round )
- ( Re . calcFunc-re )
- ( Sign . calcFunc-sign )
- ( Sin . calcFunc-sin )
- ( Sinh . calcFunc-sinh )
- ( Sqrt . calcFunc-sqrt )
- ( Tan . calcFunc-tan )
- ( Tanh . calcFunc-tanh )
- ( Transpose . calcFunc-trn )
- ( Length . calcFunc-vlen )
-))
-
-(put 'math 'math-variable-table
- '( ( I . var-i )
- ( Pi . var-pi )
- ( E . var-e )
- ( GoldenRatio . var-phi )
- ( EulerGamma . var-gamma )
- ( Infinity . var-inf )
- ( ComplexInfinity . var-uinf )
- ( Indeterminate . var-nan )
-))
-
-(put 'math 'math-vector-brackets "{}")
-(put 'math 'math-complex-format 'I)
-(put 'math 'math-function-open "[")
-(put 'math 'math-function-close "]")
-
-(put 'math 'math-radix-formatter
- (function (lambda (r s) (format "%d^^%s" r s))))
-
-(defun math-read-math-subscr (x op)
- (let ((idx (math-read-expr-level 0)))
- (or (and (equal exp-data "]")
- (progn
- (math-read-token)
- (equal exp-data "]")))
- (throw 'syntax "Expected ']]'"))
- (math-read-token)
- (list 'calcFunc-subscr x idx)))
-
-
-(defun calc-maple-language ()
- (interactive)
- (calc-wrapper
- (calc-set-language 'maple)
- (message "Maple language mode")))
-
-(put 'maple 'math-oper-table
- '( ( "matrix" ident -1 300 )
- ( "MATRIX" ident -1 300 )
- ( "!" calcFunc-fact 210 -1 )
- ( "^" ^ 201 200 )
- ( "**" ^ 201 200 )
- ( "u+" ident -1 197 )
- ( "u-" neg -1 197 )
- ( "/" / 191 192 )
- ( "*" * 191 192 )
- ( "intersect" calcFunc-vint 191 192 )
- ( "+" + 180 181 )
- ( "-" - 180 181 )
- ( "union" calcFunc-vunion 180 181 )
- ( "minus" calcFunc-vdiff 180 181 )
- ( "mod" % 170 170 )
- ( ".." (math-read-maple-dots) 165 165 )
- ( "\\dots" (math-read-maple-dots) 165 165 )
- ( "<" calcFunc-lt 160 160 )
- ( ">" calcFunc-gt 160 160 )
- ( "<=" calcFunc-leq 160 160 )
- ( ">=" calcFunc-geq 160 160 )
- ( "=" calcFunc-eq 160 160 )
- ( "<>" calcFunc-neq 160 160 )
- ( "not" calcFunc-lnot -1 121 )
- ( "and" calcFunc-land 110 111 )
- ( "or" calcFunc-lor 100 101 )
- ( "!!!" calcFunc-pnot -1 85 )
- ( "&&&" calcFunc-pand 80 81 )
- ( "|||" calcFunc-por 75 76 )
- ( ":=" calcFunc-assign 51 50 )
- ( "::" calcFunc-condition 45 46 )
-))
-
-(put 'maple 'math-function-table
- '( ( bernoulli . calcFunc-bern )
- ( binomial . calcFunc-choose )
- ( diff . calcFunc-deriv )
- ( GAMMA . calcFunc-gamma )
- ( ifactor . calcFunc-prfac )
- ( igcd . calcFunc-gcd )
- ( ilcm . calcFunc-lcm )
- ( int . calcFunc-integ )
- ( modp . % )
- ( irem . % )
- ( iquo . calcFunc-idiv )
- ( isprime . calcFunc-prime )
- ( length . calcFunc-vlen )
- ( member . calcFunc-in )
- ( crossprod . calcFunc-cross )
- ( inverse . calcFunc-inv )
- ( trace . calcFunc-tr )
- ( transpose . calcFunc-trn )
- ( vectdim . calcFunc-vlen )
-))
-
-(put 'maple 'math-variable-table
- '( ( I . var-i )
- ( Pi . var-pi )
- ( E . var-e )
- ( infinity . var-inf )
- ( infinity . var-uinf )
- ( infinity . var-nan )
-))
-
-(put 'maple 'math-complex-format 'I)
-
-(defun math-read-maple-dots (x op)
- (list 'intv 3 x (math-read-expr-level (nth 3 op))))
-
-
-
-
-
-(defun math-read-big-rec (h1 v1 h2 v2 &optional baseline prec short)
- (or prec (setq prec 0))
-
- ;; Clip whitespace above or below.
- (while (and (< v1 v2) (math-read-big-emptyp h1 v1 h2 (1+ v1)))
- (setq v1 (1+ v1)))
- (while (and (< v1 v2) (math-read-big-emptyp h1 (1- v2) h2 v2))
- (setq v2 (1- v2)))
-
- ;; If formula is a single line high, normal parser can handle it.
- (if (<= v2 (1+ v1))
- (if (or (<= v2 v1)
- (> h1 (length (setq v2 (nth v1 lines)))))
- (math-read-big-error h1 v1)
- (setq the-baseline v1
- the-h2 h2
- v2 (nth v1 lines)
- h2 (math-read-expr (substring v2 h1 (min h2 (length v2)))))
- (if (eq (car-safe h2) 'error)
- (math-read-big-error (+ h1 (nth 1 h2)) v1 (nth 2 h2))
- h2))
-
- ;; Clip whitespace at left or right.
- (while (and (< h1 h2) (math-read-big-emptyp h1 v1 (1+ h1) v2))
- (setq h1 (1+ h1)))
- (while (and (< h1 h2) (math-read-big-emptyp (1- h2) v1 h2 v2))
- (setq h2 (1- h2)))
-
- ;; Scan to find widest left-justified "----" in the region.
- (let* ((widest nil)
- (widest-h2 0)
- (lines-v1 (nthcdr v1 lines))
- (p lines-v1)
- (v v1)
- (other-v nil)
- other-char line len h)
- (while (< v v2)
- (setq line (car p)
- len (min h2 (length line)))
- (and (< h1 len)
- (/= (aref line h1) ?\ )
- (if (and (= (aref line h1) ?\-)
- ;; Make sure it's not a minus sign.
- (or (and (< (1+ h1) len) (= (aref line (1+ h1)) ?\-))
- (/= (math-read-big-char h1 (1- v)) ?\ )
- (/= (math-read-big-char h1 (1+ v)) ?\ )))
- (progn
- (setq h h1)
- (while (and (< (setq h (1+ h)) len)
- (= (aref line h) ?\-)))
- (if (> h widest-h2)
- (setq widest v
- widest-h2 h)))
- (or other-v (setq other-v v other-char (aref line h1)))))
- (setq v (1+ v)
- p (cdr p)))
-
- (cond ((not (setq v other-v))
- (math-read-big-error h1 v1)) ; Should never happen!
-
- ;; Quotient.
- (widest
- (setq h widest-h2
- v widest)
- (let ((num (math-read-big-rec h1 v1 h v))
- (den (math-read-big-rec h1 (1+ v) h v2)))
- (setq p (if (and (math-integerp num) (math-integerp den))
- (math-make-frac num den)
- (list '/ num den)))))
-
- ;; Big radical sign.
- ((= other-char ?\\)
- (or (= (math-read-big-char (1+ h1) v) ?\|)
- (math-read-big-error (1+ h1) v "Malformed root sign"))
- (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
- (while (= (math-read-big-char (1+ h1) (setq v (1- v))) ?\|))
- (or (= (math-read-big-char (setq h (+ h1 2)) v) ?\_)
- (math-read-big-error h v "Malformed root sign"))
- (while (= (math-read-big-char (setq h (1+ h)) v) ?\_))
- (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
- (math-read-big-emptyp h1 (1+ other-v) h v2 nil t)
- (setq p (list 'calcFunc-sqrt (math-read-big-rec
- (+ h1 2) (1+ v)
- h (1+ other-v) baseline))
- v the-baseline))
-
- ;; Small radical sign.
- ((and (= other-char ?V)
- (= (math-read-big-char (1+ h1) (1- v)) ?\_))
- (setq h (1+ h1))
- (math-read-big-emptyp h1 v1 h (1- v) nil t)
- (math-read-big-emptyp h1 (1+ v) h v2 nil t)
- (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
- (while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_))
- (setq p (list 'calcFunc-sqrt (math-read-big-rec
- (1+ h1) v h (1+ v) t))
- v the-baseline))
-
- ;; Binomial coefficient.
- ((and (= other-char ?\()
- (= (math-read-big-char (1+ h1) v) ?\ )
- (= (string-match "( *)" (nth v lines) h1) h1))
- (setq h (match-end 0))
- (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
- (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
- (math-read-big-emptyp (1- h) v1 h v nil t)
- (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
- (setq p (list 'calcFunc-choose
- (math-read-big-rec (1+ h1) v1 (1- h) v)
- (math-read-big-rec (1+ h1) (1+ v)
- (1- h) v2))))
-
- ;; Minus sign.
- ((= other-char ?\-)
- (setq p (list 'neg (math-read-big-rec (1+ h1) v1 h2 v2 v 250 t))
- v the-baseline
- h the-h2))
-
- ;; Parentheses.
- ((= other-char ?\()
- (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
- (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
- (setq h (math-read-big-balance (1+ h1) v "(" t))
- (math-read-big-emptyp (1- h) v1 h v nil t)
- (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
- (let ((sep (math-read-big-char (1- h) v))
- hmid)
- (if (= sep ?\.)
- (setq h (1+ h)))
- (if (= sep ?\])
- (math-read-big-error (1- h) v "Expected `)'"))
- (if (= sep ?\))
- (setq p (math-read-big-rec (1+ h1) v1 (1- h) v2 v))
- (setq hmid (math-read-big-balance h v "(")
- p (list p (math-read-big-rec h v1 (1- hmid) v2 v))
- h hmid)
- (cond ((= sep ?\.)
- (setq p (cons 'intv (cons (if (= (math-read-big-char
- (1- h) v)
- ?\))
- 0 1)
- p))))
- ((= (math-read-big-char (1- h) v) ?\])
- (math-read-big-error (1- h) v "Expected `)'"))
- ((= sep ?\,)
- (or (and (math-realp (car p)) (math-realp (nth 1 p)))
- (math-read-big-error
- h1 v "Complex components must be real"))
- (setq p (cons 'cplx p)))
- ((= sep ?\;)
- (or (and (math-realp (car p)) (math-anglep (nth 1 p)))
- (math-read-big-error
- h1 v "Complex components must be real"))
- (setq p (cons 'polar p)))))))
-
- ;; Matrix.
- ((and (= other-char ?\[)
- (or (= (math-read-big-char (setq h h1) (1+ v)) ?\[)
- (= (math-read-big-char (setq h (1+ h)) v) ?\[)
- (and (= (math-read-big-char h v) ?\ )
- (= (math-read-big-char (setq h (1+ h)) v) ?\[)))
- (= (math-read-big-char h (1+ v)) ?\[))
- (math-read-big-emptyp h1 v1 h v nil t)
- (let ((vtop v)
- (hleft h)
- (hright nil))
- (setq p nil)
- (while (progn
- (setq h (math-read-big-balance (1+ hleft) v "["))
- (if hright
- (or (= h hright)
- (math-read-big-error hright v "Expected `]'"))
- (setq hright h))
- (setq p (cons (math-read-big-rec
- hleft v h (1+ v)) p))
- (and (memq (math-read-big-char h v) '(?\ ?\,))
- (= (math-read-big-char hleft (1+ v)) ?\[)))
- (setq v (1+ v)))
- (or (= hleft h1)
- (progn
- (if (= (math-read-big-char h v) ?\ )
- (setq h (1+ h)))
- (and (= (math-read-big-char h v) ?\])
- (setq h (1+ h))))
- (math-read-big-error (1- h) v "Expected `]'"))
- (if (= (math-read-big-char h vtop) ?\,)
- (setq h (1+ h)))
- (math-read-big-emptyp h1 (1+ v) (1- h) v2 nil t)
- (setq v (+ vtop (/ (- v vtop) 2))
- p (cons 'vec (nreverse p)))))
-
- ;; Square brackets.
- ((= other-char ?\[)
- (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
- (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
- (setq p nil
- h (1+ h1))
- (while (progn
- (setq widest (math-read-big-balance h v "[" t))
- (math-read-big-emptyp (1- h) v1 h v nil t)
- (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
- (setq p (cons (math-read-big-rec
- h v1 (1- widest) v2 v) p)
- h widest)
- (= (math-read-big-char (1- h) v) ?\,)))
- (setq widest (math-read-big-char (1- h) v))
- (if (or (memq widest '(?\; ?\)))
- (and (eq widest ?\.) (cdr p)))
- (math-read-big-error (1- h) v "Expected `]'"))
- (if (= widest ?\.)
- (setq h (1+ h)
- widest (math-read-big-balance h v "[")
- p (nconc p (list (math-read-big-big-rec
- h v1 (1- widest) v2 v)))
- h widest
- p (cons 'intv (cons (if (= (math-read-big-char (1- h) v)
- ?\])
- 3 2)
- p)))
- (setq p (cons 'vec (nreverse p)))))
-
- ;; Date form.
- ((= other-char ?\<)
- (setq line (nth v lines))
- (string-match ">" line h1)
- (setq h (match-end 0))
- (math-read-big-emptyp h1 v1 h v nil t)
- (math-read-big-emptyp h1 (1+ v) h v2 nil t)
- (setq p (math-read-big-rec h1 v h (1+ v) v)))
-
- ;; Variable name or function call.
- ((or (and (>= other-char ?a) (<= other-char ?z))
- (and (>= other-char ?A) (<= other-char ?Z)))
- (setq line (nth v lines))
- (string-match "\\([a-zA-Z'_]+\\) *" line h1)
- (setq h (match-end 1)
- widest (match-end 0)
- p (math-match-substring line 1))
- (math-read-big-emptyp h1 v1 h v nil t)
- (math-read-big-emptyp h1 (1+ v) h v2 nil t)
- (if (= (math-read-big-char widest v) ?\()
- (progn
- (setq line (if (string-match "-" p)
- (intern p)
- (intern (concat "calcFunc-" p)))
- h (1+ widest)
- p nil)
- (math-read-big-emptyp widest v1 h v nil t)
- (math-read-big-emptyp widest (1+ v) h v2 nil t)
- (while (progn
- (setq widest (math-read-big-balance h v "(" t))
- (math-read-big-emptyp (1- h) v1 h v nil t)
- (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
- (setq p (cons (math-read-big-rec
- h v1 (1- widest) v2 v) p)
- h widest)
- (= (math-read-big-char (1- h) v) ?\,)))
- (or (= (math-read-big-char (1- h) v) ?\))
- (math-read-big-error (1- h) v "Expected `)'"))
- (setq p (cons line (nreverse p))))
- (setq p (list 'var
- (intern (math-remove-dashes p))
- (if (string-match "-" p)
- (intern p)
- (intern (concat "var-" p)))))))
-
- ;; Number.
- (t
- (setq line (nth v lines))
- (or (= (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\([0-9]+\\(#\\|\\^\\^\\)[0-9a-zA-Z:]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" line h1) h1)
- (math-read-big-error h v "Expected a number"))
- (setq h (match-end 0)
- p (math-read-number (math-match-substring line 0)))
- (math-read-big-emptyp h1 v1 h v nil t)
- (math-read-big-emptyp h1 (1+ v) h v2 nil t)))
-
- ;; Now left term is bounded by h1, v1, h, v2; baseline = v.
- (if baseline
- (or (= v baseline)
- (math-read-big-error h1 v "Inconsistent baseline in formula"))
- (setq baseline v))
-
- ;; Look for superscripts or subscripts.
- (setq line (nth baseline lines)
- len (min h2 (length line))
- widest h)
- (while (and (< widest len)
- (= (aref line widest) ?\ ))
- (setq widest (1+ widest)))
- (and (>= widest len) (setq widest h2))
- (if (math-read-big-emptyp h v widest v2)
- (if (math-read-big-emptyp h v1 widest v)
- (setq h widest)
- (setq p (list '^ p (math-read-big-rec h v1 widest v))
- h widest))
- (if (math-read-big-emptyp h v1 widest v)
- (setq p (list 'calcFunc-subscr p
- (math-read-big-rec h v widest v2))
- h widest)))
-
- ;; Look for an operator name and grab additional terms.
- (while (and (< h len)
- (if (setq widest (and (math-read-big-emptyp
- h v1 (1+ h) v)
- (math-read-big-emptyp
- h (1+ v) (1+ h) v2)
- (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h)
- (assoc (math-match-substring line 0)
- math-standard-opers)))
- (and (>= (nth 2 widest) prec)
- (setq h (match-end 0)))
- (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h)
- h))
- (setq widest '("2x" * 196 195)))))
- (cond ((eq (nth 3 widest) -1)
- (setq p (list (nth 1 widest) p)))
- ((equal (car widest) "?")
- (let ((y (math-read-big-rec h v1 h2 v2 baseline nil t)))
- (or (= (math-read-big-char the-h2 baseline) ?\:)
- (math-read-big-error the-h2 baseline "Expected `:'"))
- (setq p (list (nth 1 widest) p y
- (math-read-big-rec (1+ the-h2) v1 h2 v2
- baseline (nth 3 widest) t))
- h the-h2)))
- (t
- (setq p (list (nth 1 widest) p
- (math-read-big-rec h v1 h2 v2
- baseline (nth 3 widest) t))
- h the-h2))))
-
- ;; Return all relevant information to caller.
- (setq the-baseline baseline
- the-h2 h)
- (or short (= the-h2 h2)
- (math-read-big-error h baseline))
- p)))
-
-(defun math-read-big-char (h v)
- (or (and (>= h h1)
- (< h h2)
- (>= v v1)
- (< v v2)
- (let ((line (nth v lines)))
- (and line
- (< h (length line))
- (aref line h))))
- ?\ ))
-
-(defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error)
- (and (< ev1 v1) (setq ev1 v1))
- (and (< eh1 h1) (setq eh1 h1))
- (and (> ev2 v2) (setq ev2 v2))
- (and (> eh2 h2) (setq eh2 h2))
- (or what (setq what ?\ ))
- (let ((p (nthcdr ev1 lines))
- h)
- (while (and (< ev1 ev2)
- (progn
- (setq h (min eh2 (length (car p))))
- (while (and (>= (setq h (1- h)) eh1)
- (= (aref (car p) h) what)))
- (and error (>= h eh1)
- (math-read-big-error h ev1 (if (stringp error)
- error
- "Whitespace expected")))
- (< h eh1)))
- (setq ev1 (1+ ev1)
- p (cdr p)))
- (>= ev1 ev2)))
-
-(defun math-read-big-error (h v &optional msg)
- (let ((pos 0)
- (p lines))
- (while (> v 0)
- (setq pos (+ pos 1 (length (car p)))
- p (cdr p)
- v (1- v)))
- (setq h (+ pos (min h (length (car p))))
- err-msg (list 'error h (or msg "Syntax error")))
- (throw 'syntax nil)))
-
-(defun math-read-big-balance (h v what &optional commas)
- (let* ((line (nth v lines))
- (len (min h2 (length line)))
- (count 1))
- (while (> count 0)
- (if (>= h len)
- (if what
- (math-read-big-error h1 v (format "Unmatched `%s'" what))
- (setq count 0))
- (if (memq (aref line h) '(?\( ?\[))
- (setq count (1+ count))
- (if (if (and commas (= count 1))
- (or (memq (aref line h) '(?\) ?\] ?\, ?\;))
- (and (eq (aref line h) ?\.)
- (< (1+ h) len)
- (eq (aref line (1+ h)) ?\.)))
- (memq (aref line h) '(?\) ?\])))
- (setq count (1- count))))
- (setq h (1+ h))))
- h))
-
-;;; calc-lang.el ends here
+++ /dev/null
-;;; calc-macs.el --- important macros for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-(provide 'calc-macs)
-
-(defun calc-need-macros () nil)
-
-(defmacro calc-wrapper (&rest body)
- `(calc-do (function (lambda ()
- ,@body))))
-
-(defmacro calc-slow-wrapper (&rest body)
- `(calc-do
- (function (lambda () ,@body)) (point)))
-
-(defmacro math-showing-full-precision (form)
- `(let ((calc-float-format calc-full-float-format))
- ,form))
-
-(defmacro math-with-extra-prec (delta &rest body)
- `(math-normalize
- (let ((calc-internal-prec (+ calc-internal-prec ,delta)))
- ,@body)))
-
-(defmacro math-working (msg arg) ; [Public]
- `(if (eq calc-display-working-message 'lots)
- (math-do-working ,msg ,arg)))
-
-(defmacro calc-with-default-simplification (&rest body)
- `(let ((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num)))
- calc-simplify-mode)))
- ,@body))
-
-(defmacro calc-with-trail-buffer (&rest body)
- `(let ((save-buf (current-buffer))
- (calc-command-flags nil))
- (with-current-buffer (calc-trail-display t)
- (progn
- (goto-char calc-trail-pointer)
- ,@body))))
-
-;;; Faster in-line version zerop, normalized values only.
-(defsubst Math-zerop (a) ; [P N]
- (if (consp a)
- (and (not (memq (car a) '(bigpos bigneg)))
- (if (eq (car a) 'float)
- (eq (nth 1 a) 0)
- (math-zerop a)))
- (eq a 0)))
-
-(defsubst Math-integer-negp (a)
- (if (consp a)
- (eq (car a) 'bigneg)
- (< a 0)))
-
-(defsubst Math-integer-posp (a)
- (if (consp a)
- (eq (car a) 'bigpos)
- (> a 0)))
-
-(defsubst Math-negp (a)
- (if (consp a)
- (or (eq (car a) 'bigneg)
- (and (not (eq (car a) 'bigpos))
- (if (memq (car a) '(frac float))
- (Math-integer-negp (nth 1 a))
- (math-negp a))))
- (< a 0)))
-
-(defsubst Math-looks-negp (a) ; [P x] [Public]
- (or (Math-negp a)
- (and (consp a) (or (eq (car a) 'neg)
- (and (memq (car a) '(* /))
- (or (math-looks-negp (nth 1 a))
- (math-looks-negp (nth 2 a))))))))
-
-(defsubst Math-posp (a)
- (if (consp a)
- (or (eq (car a) 'bigpos)
- (and (not (eq (car a) 'bigneg))
- (if (memq (car a) '(frac float))
- (Math-integer-posp (nth 1 a))
- (math-posp a))))
- (> a 0)))
-
-(defsubst Math-integerp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg))))
-
-(defsubst Math-natnump (a)
- (if (consp a)
- (eq (car a) 'bigpos)
- (>= a 0)))
-
-(defsubst Math-ratp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg frac))))
-
-(defsubst Math-realp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float))))
-
-(defsubst Math-anglep (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float hms))))
-
-(defsubst Math-numberp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar))))
-
-(defsubst Math-scalarp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar hms))))
-
-(defsubst Math-vectorp (a)
- (and (consp a) (eq (car a) 'vec)))
-
-(defsubst Math-messy-integerp (a)
- (and (consp a)
- (eq (car a) 'float)
- (>= (nth 2 a) 0)))
-
-(defsubst Math-objectp (a) ; [Public]
- (or (not (consp a))
- (memq (car a)
- '(bigpos bigneg frac float cplx polar hms date sdev intv mod))))
-
-(defsubst Math-objvecp (a) ; [Public]
- (or (not (consp a))
- (memq (car a)
- '(bigpos bigneg frac float cplx polar hms date
- sdev intv mod vec))))
-
-;;; Compute the negative of A. [O O; o o] [Public]
-(defsubst Math-integer-neg (a)
- (if (consp a)
- (if (eq (car a) 'bigpos)
- (cons 'bigneg (cdr a))
- (cons 'bigpos (cdr a)))
- (- a)))
-
-(defsubst Math-equal (a b)
- (= (math-compare a b) 0))
-
-(defsubst Math-lessp (a b)
- (= (math-compare a b) -1))
-
-(defsubst Math-primp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg frac float cplx polar
- hms date mod var))))
-
-(defsubst Math-num-integerp (a)
- (or (not (consp a))
- (memq (car a) '(bigpos bigneg))
- (and (eq (car a) 'float)
- (>= (nth 2 a) 0))))
-
-(defsubst Math-bignum-test (a) ; [B N; B s; b b]
- (if (consp a)
- a
- (math-bignum a)))
-
-(defsubst Math-equal-int (a b)
- (or (eq a b)
- (and (consp a)
- (eq (car a) 'float)
- (eq (nth 1 a) b)
- (= (nth 2 a) 0))))
-
-(defsubst Math-natnum-lessp (a b)
- (if (consp a)
- (and (consp b)
- (= (math-compare-bignum (cdr a) (cdr b)) -1))
- (or (consp b)
- (< a b))))
-
-;;; calc-macs.el ends here
+++ /dev/null
-;;; calc-maint.el --- maintenance routines for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-(defun calc-compile ()
- "Compile all parts of Calc.
-Unix usage:
- emacs -batch -l calc-maint -f calc-compile"
- (interactive)
- (if (equal (user-full-name) "David Gillespie")
- (load "~/lisp/newbytecomp"))
- (setq byte-compile-verbose t)
- (if noninteractive
- (let ((old-message (symbol-function 'message))
- (old-write-region (symbol-function 'write-region))
- (comp-was-func nil)
- (comp-len 0))
- (unwind-protect
- (progn
- (fset 'message (symbol-function 'calc-compile-message))
- (fset 'write-region (symbol-function 'calc-compile-write-region))
- (calc-do-compile))
- (fset 'message old-message)
- (fset 'write-region old-write-region)))
- (calc-do-compile)))
-
-(defun calc-do-compile ()
- (let ((make-backup-files nil)
- (changed-rules nil)
- (changed-units nil)
- (message-bug (string-match "^18.\\([0-4][0-9]\\|5[0-6]\\)"
- emacs-version)))
- (setq max-lisp-eval-depth (max 400 max-lisp-eval-depth))
- ;; Enable some irrelevant warnings to avoid compiler bug in 19.29:
- (setq byte-compile-warnings (and (string-match "^19.29" emacs-version)
- '(obsolete)))
-
- ;; Make sure we're in the right directory.
- (find-file "calc.el")
- (if (= (buffer-size) 0)
- (error "This command must be used in the Calc source directory"))
-
- ;; Make sure current directory is in load-path.
- (setq load-path (cons default-directory load-path))
- (load "calc-macs.el" nil t t)
- (provide 'calc)
- (provide 'calc-ext)
-
- ;; Compile all the source files.
- (let ((files (append
- '("calc.el" "calc-ext.el")
- (sort (directory-files
- default-directory nil
- "\\`calc-.[^x].*\\.el\\'")
- 'string<))))
- (while files
- (if (file-newer-than-file-p (car files) (concat (car files) "c"))
- (progn
- (if (string-match "calc-rules" (car files))
- (setq changed-rules t))
- (if (string-match "calc-units" (car files))
- (setq changed-units t))
- (or message-bug (message ""))
- (byte-compile-file (car files)))
- (message "File %s is up to date" (car files)))
- (if (string-match "calc\\(-ext\\)?.el" (car files))
- (load (concat (car files) "c") nil t t))
- (setq files (cdr files))))
-
- (if (or changed-units changed-rules)
- (condition-case err
- (progn
-
- ;; Pre-build the units table.
- (if (and changed-units
- (not (string-match "Lucid" emacs-version)))
- (progn
- (or message-bug (message ""))
- (save-excursion
- (calc-create-buffer)
- (math-build-units-table))
- (find-file "calc-units.elc")
- (goto-char (point-max))
- (insert "\n(setq math-units-table '"
- (prin1-to-string math-units-table)
- ")\n")
- (save-buffer)))
-
- ;; Pre-build rewrite rules for j D, j M, etc.
- (if (and changed-rules (not (string-match "^19" emacs-version)))
- (let ((rules nil))
- (or message-bug (message ""))
- (find-file "calc-rules.elc")
- (goto-char (point-min))
- (while (re-search-forward "defun calc-\\([A-Za-z]*Rules\\)"
- nil t)
- (setq rules (cons (buffer-substring (match-beginning 1)
- (match-end 1))
- rules)))
- (goto-char (point-min))
- (re-search-forward "\n(defun calc-[A-Za-z]*Rules")
- (beginning-of-line)
- (delete-region (point) (point-max))
- (mapcar (function
- (lambda (v)
- (let* ((vv (intern (concat "var-" v)))
- (val (save-excursion
- (calc-create-buffer)
- (calc-var-value vv))))
- (insert "\n(defun calc-" v " () '"
- (prin1-to-string val) ")\n"))))
- (sort rules 'string<))
- (save-buffer))))
- (error (message "Unable to pre-build tables %s" err))))
- (message "Done. Don't forget to install with \"make public\" or \"make private\"")))
-
-(defun calc-compile-message (fmt &rest args)
- (cond ((and (= (length args) 2)
- (stringp (car args))
- (string-match ".elc?\\'" (car args))
- (symbolp (nth 1 args)))
- (let ((name (symbol-name (nth 1 args))))
- (princ (if comp-was-func ", " " "))
- (if (and comp-was-func (eq (string-match comp-was-func name) 0))
- (setq name (substring name (1- (length comp-was-func))))
- (setq comp-was-func (if (string-match "\\`[a-zA-Z]+-" name)
- (substring name 0 (match-end 0))
- " ")))
- (if (> (+ comp-len (length name)) 75)
- (progn
- (princ "\n ")
- (setq comp-len 0)))
- (princ name)
- (send-string-to-terminal "") ; cause an fflush(stdout)
- (setq comp-len (+ comp-len 2 (length name)))))
- ((and (setq comp-was-func nil
- comp-len 0)
- (= (length args) 1)
- (stringp (car args))
- (string-match ".elc?\\'" (car args)))
- (unless (string-match "Saving file %s..." fmt)
- (funcall old-message fmt (file-name-nondirectory (car args)))))
- ((string-match "\\(Preparing\\|Building\\).*\\.\\.\\.$" fmt)
- (send-string-to-terminal (apply 'format fmt args)))
- ((string-match "\\(Preparing\\|Building\\).*\\.\\.\\. *done$" fmt)
- (send-string-to-terminal "done\n"))
- (t (apply old-message fmt args))))
-
-(defun calc-compile-write-region (start end filename &optional append visit &rest rest)
- (if (eq visit t)
- (set-buffer-auto-saved))
- (if (and (string-match "\\.elc" filename)
- (= start (point-min))
- (= end (point-max)))
- (save-excursion
- (goto-char (point-min))
- (if (search-forward "\n(require (quote calc-macs))\n" nil t)
- (replace-match ""))
- (setq end (point-max))))
- (apply old-write-region start end filename append 'quietly rest)
- (message "Wrote %s" filename)
- nil)
-
-(defun calc-split-tutorial (&optional force)
- (interactive "P")
- (calc-split-manual force 1))
-
-(defun calc-split-reference (&optional force)
- (interactive "P")
- (calc-split-manual force 2))
-
-(defun calc-split-manual (&optional force part)
- "Split the Calc manual into separate Tutorial and Reference manuals.
-Use this if your TeX installation is too small-minded to handle
-calc.texinfo all at once.
-Usage: C-x C-f calc.texinfo RET
- M-x calc-split-manual RET"
- (interactive "P")
- (or (let ((case-fold-search t))
- (string-match "calc\\.texi" (buffer-name)))
- force
- (error "This command should be used in the calc.texi buffer"))
- (let ((srcbuf (current-buffer))
- tutpos refpos endpos (maxpos (point-max)))
- (goto-char 1)
- (search-forward "@c [tutorial]")
- (beginning-of-line)
- (setq tutpos (point))
- (search-forward "@c [reference]")
- (beginning-of-line)
- (setq refpos (point))
- (search-forward "@c [end]")
- (beginning-of-line)
- (setq endpos (point))
- (or (eq part 2)
- (progn
- (find-file "calctut.tex")
- (erase-buffer)
- (insert-buffer-substring srcbuf 1 refpos)
- (insert-buffer-substring srcbuf endpos maxpos)
- (calc-split-volume "I" "ref" "Tutorial" "Reference")
- (save-buffer)))
- (or (eq part 1)
- (progn
- (find-file "calcref.tex")
- (erase-buffer)
- (insert-buffer-substring srcbuf 1 tutpos)
- (insert "\n@tex\n\\global\\advance\\chapno by 1\n@end tex\n")
- (insert-buffer-substring srcbuf refpos maxpos)
- (calc-split-volume "II" "tut" "Reference" "Tutorial")
- (save-buffer)))
- (switch-to-buffer srcbuf)
- (goto-char 1))
- (message (cond ((eq part 1) "Wrote file calctut.tex")
- ((eq part 2) "Wrote file calcref.tex")
- (t "Wrote files calctut.tex and calcref.tex"))))
-
-(defun calc-split-volume (number fix name other-name)
- (goto-char 1)
- (search-forward "@c [title]\n")
- (search-forward "Manual")
- (delete-backward-char 6)
- (insert name)
- (search-forward "@c [volume]\n")
- (insert "@sp 1\n@center Volume " number ": " name "\n")
- (let ((pat (format "@c \\[fix-%s \\(.*\\)\\]\n" fix)))
- (while (re-search-forward pat nil t)
- (let ((topic (buffer-substring (match-beginning 1) (match-end 1))))
- (re-search-forward "@\\(p?xref\\){[^}]*}")
- (let ((cmd (buffer-substring (match-beginning 1) (match-end 1))))
- (delete-region (match-beginning 0) (match-end 0))
- (insert (if (equal cmd "pxref") "see" "See")
- " ``" topic "'' in @emph{the Calc "
- other-name "}")))))
- (goto-char 1)
- (while (search-forward "@c [when-split]\n" nil t)
- (while (looking-at "@c ")
- (delete-char 3)
- (forward-line 1)))
- (goto-char 1)
- (while (search-forward "@c [not-split]\n" nil t)
- (while (not (looking-at "@c"))
- (insert "@c ")
- (forward-line 1))))
-
-
-(defun calc-inline-summary ()
- "Make a special \"calcsum.tex\" file to be used with main manual."
- (calc-split-summary nil t))
-
-(defun calc-split-summary (&optional force in-line)
- "Make a special \"calcsum.tex\" file with just the Calc summary."
- (interactive "P")
- (or (let ((case-fold-search t))
- (string-match "calc\\.texinfo" (buffer-name)))
- force
- (error "This command should be used in the calc.texinfo buffer"))
- (let ((srcbuf (current-buffer))
- begpos sumpos endpos midpos)
- (goto-char 1)
- (search-forward "{Calc Manual}")
- (backward-char 1)
- (delete-backward-char 6)
- (insert "Summary")
- (search-forward "@c [begin]")
- (beginning-of-line)
- (setq begpos (point))
- (search-forward "@c [summary]")
- (beginning-of-line)
- (setq sumpos (point))
- (search-forward "@c [end-summary]")
- (beginning-of-line)
- (setq endpos (point))
- (find-file "calcsum.tex")
- (erase-buffer)
- (insert-buffer-substring srcbuf 1 begpos)
- (insert "@tex\n"
- "\\global\\advance\\appendixno2\n"
- "\\gdef\\xref#1.{See ``#1.''}\n")
- (setq midpos (point))
- (insert "@end tex\n")
- (insert-buffer-substring srcbuf sumpos endpos)
- (insert "@bye\n")
- (goto-char 1)
- (if (search-forward "{. a b c" nil t)
- (replace-match "{... a b c"))
- (goto-char 1)
- (if in-line
- (let ((buf (current-buffer))
- (page nil))
- (find-file "calc.aux")
- (if (> (buffer-size) 0)
- (progn
- (goto-char 1)
- (re-search-forward "{Summary-pg}{\\([0-9]+\\)}")
- (setq page (string-to-int (buffer-substring (match-beginning 1)
- (match-end 1))))))
- (switch-to-buffer buf)
- (if page
- (progn
- (message "Adjusting starting page number to %d" page)
- (goto-char midpos)
- (insert (format "\\global\\pageno=%d\n" page)))
- (message "Unable to find page number from calc.aux")))
- (if (search-forward "@c smallbook" nil t)
- (progn ; activate "smallbook" format for compactness
- (beginning-of-line)
- (forward-char 1)
- (delete-char 2))))
- (let ((buf (current-buffer)))
- (find-file "calc.ky")
- (if (> (buffer-size) 0)
- (let ((ibuf (current-buffer)))
- (message "Mixing in page numbers from Key Index (calc.ky)")
- (switch-to-buffer buf)
- (goto-char 1)
- (search-forward "notes at the end")
- (insert "; the number in italics is\n"
- "the page number where the command is described")
- (while (re-search-forward
- "@r{.*@: *\\([^ ]\\(.*[^ ]\\)?\\) *@:.*@:.*@:\\(.*\\)@:.*}"
- nil t)
- (let ((key (buffer-substring (match-beginning 1) (match-end 1)))
- (pos (match-beginning 3))
- num)
- (set-buffer ibuf)
- (goto-char 1)
- (let ((p '( ( "I H " . "H I " ) ; oops!
- ( "@@ ' \"" . "@@" ) ( "h m s" . "@@" )
- ( "\\\\" . "{\\tt\\indexbackslash }" )
- ( "_" . "{\\_}" )
- ( "\\^" . "{\\tt\\hat}" )
- ( "<" . "{\\tt\\less}" )
- ( ">" . "{\\tt\\gtr}" )
- ( "\"" ) ( "@{" ) ( "@}" )
- ( "~" ) ( "|" ) ( "@@" )
- ( "\\+" . "{\\tt\\char43}" )
- ( "# l" . "# L" )
- ( "I f I" . "f I" ) ( "I f Q" . "f Q" )
- ( "V &" . "&" ) ( "C-u " . "" ) ))
- (case-fold-search nil))
- (while p
- (if (string-match (car (car p)) key)
- (setq key (concat (substring key 0 (match-beginning 0))
- (or (cdr (car p))
- (format "{\\tt\\char'%03o}"
- (aref key (1- (match-end
- 0)))))
- (substring key (match-end 0)))))
- (setq p (cdr p)))
- (setq num (and (search-forward (format "\\entry {%s}{" key)
- nil t)
- (looking-at "[0-9]+")
- (buffer-substring (point) (match-end 0)))))
- (set-buffer buf)
- (goto-char pos)
- (insert "@pgref{" (or num "") "}")))
- (goto-char midpos)
- (insert "\\gdef\\pgref#1{\\hbox to 2em{\\indsl\\hss#1}\\ \\ }\n"))
- (message
- "Unable to find Key Index (calc.ky); no page numbers inserted"))
- (switch-to-buffer buf))
- (save-buffer))
- (message "Wrote file calcsum.tex"))
-
-;;; calc-maint.el ends here
+++ /dev/null
-;;; calc-map.el --- higher-order functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-map () nil)
-
-
-(defun calc-apply (&optional oper)
- (interactive)
- (calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
- (nthcdr calc-stack-top calc-stack)))
- (calc-dollar-used 0)
- (oper (or oper (calc-get-operator "Apply"
- (if (math-vectorp (calc-top 1))
- (1- (length (calc-top 1)))
- -1))))
- (expr (calc-top-n (1+ calc-dollar-used))))
- (message "Working...")
- (calc-set-command-flag 'clear-message)
- (calc-enter-result (1+ calc-dollar-used)
- (concat (substring "apl" 0 (- 4 (length (nth 2 oper))))
- (nth 2 oper))
- (list 'calcFunc-apply
- (math-calcFunc-to-var (nth 1 oper))
- expr)))))
-
-(defun calc-reduce (&optional oper accum)
- (interactive)
- (calc-wrapper
- (let* ((sel-mode nil)
- (nest (calc-is-hyperbolic))
- (rev (calc-is-inverse))
- (nargs (if (and nest (not rev)) 2 1))
- (calc-dollar-values (mapcar 'calc-get-stack-element
- (nthcdr calc-stack-top calc-stack)))
- (calc-dollar-used 0)
- (calc-mapping-dir (and (not accum) (not nest) ""))
- (oper (or oper (calc-get-operator
- (if nest
- (concat (if accum "Accumulate " "")
- (if rev "Fixed Point" "Nest"))
- (concat (if rev "Inv " "")
- (if accum "Accumulate" "Reduce")))
- (if nest 1 2)))))
- (message "Working...")
- (calc-set-command-flag 'clear-message)
- (calc-enter-result (+ calc-dollar-used nargs)
- (concat (substring (if nest
- (if rev "fxp" "nst")
- (if accum "acc" "red"))
- 0 (- 4 (length (nth 2 oper))))
- (nth 2 oper))
- (if nest
- (cons (if rev
- (if accum 'calcFunc-afixp 'calcFunc-fixp)
- (if accum 'calcFunc-anest 'calcFunc-nest))
- (cons (math-calcFunc-to-var (nth 1 oper))
- (calc-top-list-n
- nargs (1+ calc-dollar-used))))
- (list (if accum
- (if rev 'calcFunc-raccum 'calcFunc-accum)
- (intern (concat "calcFunc-"
- (if rev "r" "")
- "reduce"
- calc-mapping-dir)))
- (math-calcFunc-to-var (nth 1 oper))
- (calc-top-n (1+ calc-dollar-used))))))))
-
-(defun calc-accumulate (&optional oper)
- (interactive)
- (calc-reduce oper t))
-
-(defun calc-map (&optional oper)
- (interactive)
- (calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
- (nthcdr calc-stack-top calc-stack)))
- (calc-dollar-used 0)
- (calc-mapping-dir "")
- (oper (or oper (calc-get-operator "Map")))
- (nargs (car oper)))
- (message "Working...")
- (calc-set-command-flag 'clear-message)
- (calc-enter-result (+ nargs calc-dollar-used)
- (concat (substring "map" 0 (- 4 (length (nth 2 oper))))
- (nth 2 oper))
- (cons (intern (concat "calcFunc-map" calc-mapping-dir))
- (cons (math-calcFunc-to-var (nth 1 oper))
- (calc-top-list-n
- nargs
- (1+ calc-dollar-used))))))))
-
-(defun calc-map-equation (&optional oper)
- (interactive)
- (calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
- (nthcdr calc-stack-top calc-stack)))
- (calc-dollar-used 0)
- (oper (or oper (calc-get-operator "Map-equation")))
- (nargs (car oper)))
- (message "Working...")
- (calc-set-command-flag 'clear-message)
- (calc-enter-result (+ nargs calc-dollar-used)
- (concat (substring "map" 0 (- 4 (length (nth 2 oper))))
- (nth 2 oper))
- (cons (if (calc-is-inverse)
- 'calcFunc-mapeqr
- (if (calc-is-hyperbolic)
- 'calcFunc-mapeqp 'calcFunc-mapeq))
- (cons (math-calcFunc-to-var (nth 1 oper))
- (calc-top-list-n
- nargs
- (1+ calc-dollar-used))))))))
-
-(defvar calc-verify-arglist t)
-(defvar calc-mapping-dir nil)
-(defun calc-map-stack ()
- "This is meant to be called by calc-keypad mode."
- (interactive)
- (let ((calc-verify-arglist nil))
- (calc-unread-command ?\$)
- (calc-map)))
-
-(defun calc-outer-product (&optional oper)
- (interactive)
- (calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
- (nthcdr calc-stack-top calc-stack)))
- (calc-dollar-used 0)
- (oper (or oper (calc-get-operator "Outer" 2))))
- (message "Working...")
- (calc-set-command-flag 'clear-message)
- (calc-enter-result (+ 2 calc-dollar-used)
- (concat (substring "out" 0 (- 4 (length (nth 2 oper))))
- (nth 2 oper))
- (cons 'calcFunc-outer
- (cons (math-calcFunc-to-var (nth 1 oper))
- (calc-top-list-n
- 2 (1+ calc-dollar-used))))))))
-
-(defun calc-inner-product (&optional mul-oper add-oper)
- (interactive)
- (calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
- (nthcdr calc-stack-top calc-stack)))
- (calc-dollar-used 0)
- (mul-oper (or mul-oper (calc-get-operator "Inner (Mult)" 2)))
- (mul-used calc-dollar-used)
- (calc-dollar-values (if (> mul-used 0)
- (cdr calc-dollar-values)
- calc-dollar-values))
- (calc-dollar-used 0)
- (add-oper (or add-oper (calc-get-operator "Inner (Add)" 2))))
- (message "Working...")
- (calc-set-command-flag 'clear-message)
- (calc-enter-result (+ 2 mul-used calc-dollar-used)
- (concat "in"
- (substring (nth 2 mul-oper) 0 1)
- (substring (nth 2 add-oper) 0 1))
- (nconc (list 'calcFunc-inner
- (math-calcFunc-to-var (nth 1 mul-oper))
- (math-calcFunc-to-var (nth 1 add-oper)))
- (calc-top-list-n
- 2 (+ 1 mul-used calc-dollar-used)))))))
-
-(defconst calc-oper-keys '( ( ( ?+ 2 calcFunc-add )
- ( ?- 2 calcFunc-sub )
- ( ?* 2 calcFunc-mul )
- ( ?/ 2 calcFunc-div )
- ( ?^ 2 calcFunc-pow )
- ( ?| 2 calcFunc-vconcat )
- ( ?% 2 calcFunc-mod )
- ( ?\\ 2 calcFunc-idiv )
- ( ?! 1 calcFunc-fact )
- ( ?& 1 calcFunc-inv )
- ( ?n 1 calcFunc-neg )
- ( ?x user )
- ( ?z user )
- ( ?A 1 calcFunc-abs )
- ( ?J 1 calcFunc-conj )
- ( ?G 1 calcFunc-arg )
- ( ?Q 1 calcFunc-sqrt )
- ( ?N 2 calcFunc-min )
- ( ?X 2 calcFunc-max )
- ( ?F 1 calcFunc-floor )
- ( ?R 1 calcFunc-round )
- ( ?S 1 calcFunc-sin )
- ( ?C 1 calcFunc-cos )
- ( ?T 1 calcFunc-tan )
- ( ?L 1 calcFunc-ln )
- ( ?E 1 calcFunc-exp )
- ( ?B 2 calcFunc-log ) )
- ( ( ?F 1 calcFunc-ceil ) ; inverse
- ( ?R 1 calcFunc-trunc )
- ( ?Q 1 calcFunc-sqr )
- ( ?S 1 calcFunc-arcsin )
- ( ?C 1 calcFunc-arccos )
- ( ?T 1 calcFunc-arctan )
- ( ?L 1 calcFunc-exp )
- ( ?E 1 calcFunc-ln )
- ( ?B 2 calcFunc-alog )
- ( ?^ 2 calcFunc-nroot )
- ( ?| 2 calcFunc-vconcatrev ) )
- ( ( ?F 1 calcFunc-ffloor ) ; hyperbolic
- ( ?R 1 calcFunc-fround )
- ( ?S 1 calcFunc-sinh )
- ( ?C 1 calcFunc-cosh )
- ( ?T 1 calcFunc-tanh )
- ( ?L 1 calcFunc-log10 )
- ( ?E 1 calcFunc-exp10 )
- ( ?| 2 calcFunc-append ) )
- ( ( ?F 1 calcFunc-fceil ) ; inverse-hyperbolic
- ( ?R 1 calcFunc-ftrunc )
- ( ?S 1 calcFunc-arcsinh )
- ( ?C 1 calcFunc-arccosh )
- ( ?T 1 calcFunc-arctanh )
- ( ?L 1 calcFunc-exp10 )
- ( ?E 1 calcFunc-log10 )
- ( ?| 2 calcFunc-appendrev ) )))
-
-(defconst calc-a-oper-keys '( ( ( ?a 3 calcFunc-apart )
- ( ?b 3 calcFunc-subst )
- ( ?c 2 calcFunc-collect )
- ( ?d 2 calcFunc-deriv )
- ( ?e 1 calcFunc-esimplify )
- ( ?f 2 calcFunc-factor )
- ( ?g 2 calcFunc-pgcd )
- ( ?i 2 calcFunc-integ )
- ( ?m 2 calcFunc-match )
- ( ?n 1 calcFunc-nrat )
- ( ?r 2 calcFunc-rewrite )
- ( ?s 1 calcFunc-simplify )
- ( ?t 3 calcFunc-taylor )
- ( ?x 1 calcFunc-expand )
- ( ?M 2 calcFunc-mapeq )
- ( ?N 3 calcFunc-minimize )
- ( ?P 2 calcFunc-roots )
- ( ?R 3 calcFunc-root )
- ( ?S 2 calcFunc-solve )
- ( ?T 4 calcFunc-table )
- ( ?X 3 calcFunc-maximize )
- ( ?= 2 calcFunc-eq )
- ( ?\# 2 calcFunc-neq )
- ( ?< 2 calcFunc-lt )
- ( ?> 2 calcFunc-gt )
- ( ?\[ 2 calcFunc-leq )
- ( ?\] 2 calcFunc-geq )
- ( ?{ 2 calcFunc-in )
- ( ?! 1 calcFunc-lnot )
- ( ?& 2 calcFunc-land )
- ( ?\| 2 calcFunc-lor )
- ( ?: 3 calcFunc-if )
- ( ?. 2 calcFunc-rmeq )
- ( ?+ 4 calcFunc-sum )
- ( ?- 4 calcFunc-asum )
- ( ?* 4 calcFunc-prod )
- ( ?_ 2 calcFunc-subscr )
- ( ?\\ 2 calcFunc-pdiv )
- ( ?% 2 calcFunc-prem )
- ( ?/ 2 calcFunc-pdivrem ) )
- ( ( ?m 2 calcFunc-matchnot )
- ( ?M 2 calcFunc-mapeqr )
- ( ?S 2 calcFunc-finv ) )
- ( ( ?d 2 calcFunc-tderiv )
- ( ?f 2 calcFunc-factors )
- ( ?M 2 calcFunc-mapeqp )
- ( ?N 3 calcFunc-wminimize )
- ( ?R 3 calcFunc-wroot )
- ( ?S 2 calcFunc-fsolve )
- ( ?X 3 calcFunc-wmaximize )
- ( ?/ 2 calcFunc-pdivide ) )
- ( ( ?S 2 calcFunc-ffinv ) )))
-
-(defconst calc-b-oper-keys '( ( ( ?a 2 calcFunc-and )
- ( ?o 2 calcFunc-or )
- ( ?x 2 calcFunc-xor )
- ( ?d 2 calcFunc-diff )
- ( ?n 1 calcFunc-not )
- ( ?c 1 calcFunc-clip )
- ( ?l 2 calcFunc-lsh )
- ( ?r 2 calcFunc-rsh )
- ( ?L 2 calcFunc-ash )
- ( ?R 2 calcFunc-rash )
- ( ?t 2 calcFunc-rot )
- ( ?p 1 calcFunc-vpack )
- ( ?u 1 calcFunc-vunpack )
- ( ?D 4 calcFunc-ddb )
- ( ?F 3 calcFunc-fv )
- ( ?I 1 calcFunc-irr )
- ( ?M 3 calcFunc-pmt )
- ( ?N 2 calcFunc-npv )
- ( ?P 3 calcFunc-pv )
- ( ?S 3 calcFunc-sln )
- ( ?T 3 calcFunc-rate )
- ( ?Y 4 calcFunc-syd )
- ( ?\# 3 calcFunc-nper )
- ( ?\% 2 calcFunc-relch ) )
- ( ( ?F 3 calcFunc-fvb )
- ( ?I 1 calcFunc-irrb )
- ( ?M 3 calcFunc-pmtb )
- ( ?N 2 calcFunc-npvb )
- ( ?P 3 calcFunc-pvb )
- ( ?T 3 calcFunc-rateb )
- ( ?\# 3 calcFunc-nperb ) )
- ( ( ?F 3 calcFunc-fvl )
- ( ?M 3 calcFunc-pmtl )
- ( ?P 3 calcFunc-pvl )
- ( ?T 3 calcFunc-ratel )
- ( ?\# 3 calcFunc-nperl ) )))
-
-(defconst calc-c-oper-keys '( ( ( ?d 1 calcFunc-deg )
- ( ?r 1 calcFunc-rad )
- ( ?h 1 calcFunc-hms )
- ( ?f 1 calcFunc-float )
- ( ?F 1 calcFunc-frac ) )))
-
-(defconst calc-f-oper-keys '( ( ( ?b 2 calcFunc-beta )
- ( ?e 1 calcFunc-erf )
- ( ?g 1 calcFunc-gamma )
- ( ?h 2 calcFunc-hypot )
- ( ?i 1 calcFunc-im )
- ( ?j 2 calcFunc-besJ )
- ( ?n 2 calcFunc-min )
- ( ?r 1 calcFunc-re )
- ( ?s 1 calcFunc-sign )
- ( ?x 2 calcFunc-max )
- ( ?y 2 calcFunc-besY )
- ( ?A 1 calcFunc-abssqr )
- ( ?B 3 calcFunc-betaI )
- ( ?E 1 calcFunc-expm1 )
- ( ?G 2 calcFunc-gammaP )
- ( ?I 2 calcFunc-ilog )
- ( ?L 1 calcFunc-lnp1 )
- ( ?M 1 calcFunc-mant )
- ( ?Q 1 calcFunc-isqrt )
- ( ?S 1 calcFunc-scf )
- ( ?T 2 calcFunc-arctan2 )
- ( ?X 1 calcFunc-xpon )
- ( ?\[ 2 calcFunc-decr )
- ( ?\] 2 calcFunc-incr ) )
- ( ( ?e 1 calcFunc-erfc )
- ( ?E 1 calcFunc-lnp1 )
- ( ?G 2 calcFunc-gammaQ )
- ( ?L 1 calcFunc-expm1 ) )
- ( ( ?B 3 calcFunc-betaB )
- ( ?G 2 calcFunc-gammag) )
- ( ( ?G 2 calcFunc-gammaG ) )))
-
-(defconst calc-k-oper-keys '( ( ( ?b 1 calcFunc-bern )
- ( ?c 2 calcFunc-choose )
- ( ?d 1 calcFunc-dfact )
- ( ?e 1 calcFunc-euler )
- ( ?f 1 calcFunc-prfac )
- ( ?g 2 calcFunc-gcd )
- ( ?h 2 calcFunc-shuffle )
- ( ?l 2 calcFunc-lcm )
- ( ?m 1 calcFunc-moebius )
- ( ?n 1 calcFunc-nextprime )
- ( ?r 1 calcFunc-random )
- ( ?s 2 calcFunc-stir1 )
- ( ?t 1 calcFunc-totient )
- ( ?B 3 calcFunc-utpb )
- ( ?C 2 calcFunc-utpc )
- ( ?F 3 calcFunc-utpf )
- ( ?N 3 calcFunc-utpn )
- ( ?P 2 calcFunc-utpp )
- ( ?T 2 calcFunc-utpt ) )
- ( ( ?n 1 calcFunc-prevprime )
- ( ?B 3 calcFunc-ltpb )
- ( ?C 2 calcFunc-ltpc )
- ( ?F 3 calcFunc-ltpf )
- ( ?N 3 calcFunc-ltpn )
- ( ?P 2 calcFunc-ltpp )
- ( ?T 2 calcFunc-ltpt ) )
- ( ( ?b 2 calcFunc-bern )
- ( ?c 2 calcFunc-perm )
- ( ?e 2 calcFunc-euler )
- ( ?s 2 calcFunc-stir2 ) )))
-
-(defconst calc-s-oper-keys '( ( ( ?: 2 calcFunc-assign )
- ( ?= 1 calcFunc-evalto ) )))
-
-(defconst calc-t-oper-keys '( ( ( ?C 3 calcFunc-tzconv )
- ( ?D 1 calcFunc-date )
- ( ?I 2 calcFunc-incmonth )
- ( ?J 1 calcFunc-julian )
- ( ?M 1 calcFunc-newmonth )
- ( ?W 1 calcFunc-newweek )
- ( ?U 1 calcFunc-unixtime )
- ( ?Y 1 calcFunc-newyear ) )))
-
-(defconst calc-u-oper-keys '( ( ( ?C 2 calcFunc-vcov )
- ( ?G 1 calcFunc-vgmean )
- ( ?M 1 calcFunc-vmean )
- ( ?N 1 calcFunc-vmin )
- ( ?S 1 calcFunc-vsdev )
- ( ?X 1 calcFunc-vmax ) )
- ( ( ?C 2 calcFunc-vpcov )
- ( ?M 1 calcFunc-vmeane )
- ( ?S 1 calcFunc-vpsdev ) )
- ( ( ?C 2 calcFunc-vcorr )
- ( ?G 1 calcFunc-agmean )
- ( ?M 1 calcFunc-vmedian )
- ( ?S 1 calcFunc-vvar ) )
- ( ( ?M 1 calcFunc-vhmean )
- ( ?S 1 calcFunc-vpvar ) )))
-
-(defconst calc-v-oper-keys '( ( ( ?a 2 calcFunc-arrange )
- ( ?b 2 calcFunc-cvec )
- ( ?c 2 calcFunc-mcol )
- ( ?d 2 calcFunc-diag )
- ( ?e 2 calcFunc-vexp )
- ( ?f 2 calcFunc-find )
- ( ?h 1 calcFunc-head )
- ( ?k 2 calcFunc-cons )
- ( ?l 1 calcFunc-vlen )
- ( ?m 2 calcFunc-vmask )
- ( ?n 1 calcFunc-rnorm )
- ( ?p 2 calcFunc-pack )
- ( ?r 2 calcFunc-mrow )
- ( ?s 3 calcFunc-subvec )
- ( ?t 1 calcFunc-trn )
- ( ?u 1 calcFunc-unpack )
- ( ?v 1 calcFunc-rev )
- ( ?x 1 calcFunc-index )
- ( ?A 1 calcFunc-apply )
- ( ?C 1 calcFunc-cross )
- ( ?D 1 calcFunc-det )
- ( ?E 1 calcFunc-venum )
- ( ?F 1 calcFunc-vfloor )
- ( ?G 1 calcFunc-grade )
- ( ?H 2 calcFunc-histogram )
- ( ?I 2 calcFunc-inner )
- ( ?L 1 calcFunc-lud )
- ( ?M 0 calcFunc-map )
- ( ?N 1 calcFunc-cnorm )
- ( ?O 2 calcFunc-outer )
- ( ?R 1 calcFunc-reduce )
- ( ?S 1 calcFunc-sort )
- ( ?T 1 calcFunc-tr )
- ( ?U 1 calcFunc-accum )
- ( ?V 2 calcFunc-vunion )
- ( ?X 2 calcFunc-vxor )
- ( ?- 2 calcFunc-vdiff )
- ( ?^ 2 calcFunc-vint )
- ( ?~ 1 calcFunc-vcompl )
- ( ?# 1 calcFunc-vcard )
- ( ?: 1 calcFunc-vspan )
- ( ?+ 1 calcFunc-rdup ) )
- ( ( ?h 1 calcFunc-tail )
- ( ?s 3 calcFunc-rsubvec )
- ( ?G 1 calcFunc-rgrade )
- ( ?R 1 calcFunc-rreduce )
- ( ?S 1 calcFunc-rsort )
- ( ?U 1 calcFunc-raccum ) )
- ( ( ?e 3 calcFunc-vexp )
- ( ?h 1 calcFunc-rhead )
- ( ?k 2 calcFunc-rcons )
- ( ?H 3 calcFunc-histogram )
- ( ?R 2 calcFunc-nest )
- ( ?U 2 calcFunc-anest ) )
- ( ( ?h 1 calcFunc-rtail )
- ( ?R 1 calcFunc-fixp )
- ( ?U 1 calcFunc-afixp ) )))
-
-
-;;; Return a list of the form (nargs func name)
-(defun calc-get-operator (msg &optional nargs)
- (setq calc-aborted-prefix nil)
- (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil)
- done key oper (which 0)
- (msgs '( "(Press ? for help)"
- "+, -, *, /, ^, %, \\, :, &, !, |, Neg"
- "SHIFT + Abs, conJ, arG; maX, miN; Floor, Round; sQrt"
- "SHIFT + Inv, Hyp; Sin, Cos, Tan; Exp, Ln, logB"
- "Algebra + Simp, Esimp, Deriv, Integ, !, =, etc."
- "Binary + And, Or, Xor, Diff; l/r/t/L/R shifts; Not, Clip"
- "Conversions + Deg, Rad, HMS; Float; SHIFT + Fraction"
- "Functions + Re, Im; Hypot; Mant, Expon, Scale; etc."
- "Kombinatorics + Dfact, Lcm, Gcd, Choose; Random; etc."
- "Time/date + newYear, Incmonth, etc."
- "Vectors + Length, Row, Col, Diag, Mask, etc."
- "_ = mapr/reducea, : = mapc/reduced, = = reducer"
- "X or Z = any function by name; ' = alg entry; $ = stack")))
- (while (not done)
- (message "%s%s: %s: %s%s%s"
- msg
- (cond ((equal calc-mapping-dir "r") " rows")
- ((equal calc-mapping-dir "c") " columns")
- ((equal calc-mapping-dir "a") " across")
- ((equal calc-mapping-dir "d") " down")
- (t ""))
- (if forcenargs
- (format "(%d arg%s)"
- forcenargs (if (= forcenargs 1) "" "s"))
- (nth which msgs))
- (if inv "Inv " "") (if hyp "Hyp " "")
- (if prefix (concat (char-to-string prefix) "-") ""))
- (setq key (read-char))
- (if (>= key 128) (setq key (- key 128)))
- (cond ((memq key '(?\C-g ?q))
- (keyboard-quit))
- ((memq key '(?\C-u ?\e)))
- ((= key ??)
- (setq which (% (1+ which) (length msgs))))
- ((and (= key ?I) (null prefix))
- (setq inv (not inv)))
- ((and (= key ?H) (null prefix))
- (setq hyp (not hyp)))
- ((and (eq key prefix) (not (eq key ?v)))
- (setq prefix nil))
- ((and (memq key '(?a ?b ?c ?f ?k ?s ?t ?u ?v ?V))
- (null prefix))
- (setq prefix (downcase key)))
- ((and (eq key ?\=) (null prefix))
- (if calc-mapping-dir
- (setq calc-mapping-dir (if (equal calc-mapping-dir "r")
- "" "r"))
- (beep)))
- ((and (eq key ?\_) (null prefix))
- (if calc-mapping-dir
- (if (string-match "map$" msg)
- (setq calc-mapping-dir (if (equal calc-mapping-dir "r")
- "" "r"))
- (setq calc-mapping-dir (if (equal calc-mapping-dir "a")
- "" "a")))
- (beep)))
- ((and (eq key ?\:) (null prefix))
- (if calc-mapping-dir
- (if (string-match "map$" msg)
- (setq calc-mapping-dir (if (equal calc-mapping-dir "c")
- "" "c"))
- (setq calc-mapping-dir (if (equal calc-mapping-dir "d")
- "" "d")))
- (beep)))
- ((and (>= key ?0) (<= key ?9) (null prefix))
- (setq forcenargs (if (eq forcenargs (- key ?0)) nil (- key ?0)))
- (and nargs forcenargs (/= nargs forcenargs) (>= nargs 0)
- (error "Must be a %d-argument operator" nargs)))
- ((memq key '(?\$ ?\'))
- (let* ((arglist nil)
- (has-args nil)
- (record-entry nil)
- (expr (if (eq key ?\$)
- (progn
- (setq calc-dollar-used 1)
- (if calc-dollar-values
- (car calc-dollar-values)
- (error "Stack underflow")))
- (let* ((calc-dollar-values calc-arg-values)
- (calc-dollar-used 0)
- (calc-hashes-used 0)
- (func (calc-do-alg-entry "" "Function: ")))
- (setq record-entry t)
- (or (= (length func) 1)
- (error "Bad format"))
- (if (> calc-dollar-used 0)
- (progn
- (setq has-args calc-dollar-used
- arglist (calc-invent-args has-args))
- (math-multi-subst (car func)
- (reverse arglist)
- arglist))
- (if (> calc-hashes-used 0)
- (setq has-args calc-hashes-used
- arglist (calc-invent-args has-args)))
- (car func))))))
- (if (eq (car-safe expr) 'calcFunc-lambda)
- (setq oper (list "$" (- (length expr) 2) expr)
- done t)
- (or has-args
- (progn
- (calc-default-formula-arglist expr)
- (setq record-entry t
- arglist (sort arglist 'string-lessp))
- (if calc-verify-arglist
- (setq arglist (read-from-minibuffer
- "Function argument list: "
- (if arglist
- (prin1-to-string arglist)
- "()")
- minibuffer-local-map
- t)))
- (setq arglist (mapcar (function
- (lambda (x)
- (list 'var
- x
- (intern
- (concat
- "var-"
- (symbol-name x))))))
- arglist))))
- (setq oper (list "$"
- (length arglist)
- (append '(calcFunc-lambda) arglist
- (list expr)))
- done t))
- (if record-entry
- (calc-record (nth 2 oper) "oper"))))
- ((setq oper (assq key (nth (if inv (if hyp 3 1) (if hyp 2 0))
- (if prefix
- (symbol-value
- (intern (format "calc-%c-oper-keys"
- prefix)))
- calc-oper-keys))))
- (if (eq (nth 1 oper) 'user)
- (let ((func (intern
- (completing-read "Function name: "
- obarray 'fboundp
- nil "calcFunc-"))))
- (if (or forcenargs nargs)
- (setq oper (list "z" (or forcenargs nargs) func)
- done t)
- (if (fboundp func)
- (let* ((defn (symbol-function func)))
- (and (symbolp defn)
- (setq defn (symbol-function defn)))
- (if (eq (car-safe defn) 'lambda)
- (let ((args (nth 1 defn))
- (nargs 0))
- (while (not (memq (car args) '(&optional
- &rest nil)))
- (setq nargs (1+ nargs)
- args (cdr args)))
- (setq oper (list "z" nargs func)
- done t))
- (error
- "Function is not suitable for this operation")))
- (message "Number of arguments: ")
- (let ((nargs (read-char)))
- (if (and (>= nargs ?0) (<= nargs ?9))
- (setq oper (list "z" (- nargs ?0) func)
- done t)
- (beep))))))
- (if (or (and (eq prefix ?v) (memq key '(?A ?I ?M ?O ?R ?U)))
- (and (eq prefix ?a) (eq key ?M)))
- (let* ((dir (cond ((and (equal calc-mapping-dir "")
- (string-match "map$" msg))
- (setq calc-mapping-dir "r")
- " rows")
- ((equal calc-mapping-dir "r") " rows")
- ((equal calc-mapping-dir "c") " columns")
- ((equal calc-mapping-dir "a") " across")
- ((equal calc-mapping-dir "d") " down")
- (t "")))
- (calc-mapping-dir (and (memq (nth 2 oper)
- '(calcFunc-map
- calcFunc-reduce
- calcFunc-rreduce))
- ""))
- (oper2 (calc-get-operator
- (format "%s%s, %s%s" msg dir
- (substring (symbol-name (nth 2 oper))
- 9)
- (if (eq key ?I) " (mult)" ""))
- (cdr (assq (nth 2 oper)
- '((calcFunc-reduce . 2)
- (calcFunc-rreduce . 2)
- (calcFunc-accum . 2)
- (calcFunc-raccum . 2)
- (calcFunc-nest . 2)
- (calcFunc-anest . 2)
- (calcFunc-fixp . 2)
- (calcFunc-afixp . 2))))))
- (oper3 (if (eq (nth 2 oper) 'calcFunc-inner)
- (calc-get-operator
- (format "%s%s, inner (add)" msg dir
- (substring
- (symbol-name (nth 2 oper))
- 9)))
- '(0 0 0)))
- (args nil)
- (nargs (if (> (nth 1 oper) 0)
- (nth 1 oper)
- (car oper2)))
- (n nargs)
- (p calc-arg-values))
- (while (and p (> n 0))
- (or (math-expr-contains (nth 1 oper2) (car p))
- (math-expr-contains (nth 1 oper3) (car p))
- (setq args (nconc args (list (car p)))
- n (1- n)))
- (setq p (cdr p)))
- (setq oper (list "" nargs
- (append
- '(calcFunc-lambda)
- args
- (list (math-build-call
- (intern
- (concat
- (symbol-name (nth 2 oper))
- calc-mapping-dir))
- (cons (math-calcFunc-to-var
- (nth 1 oper2))
- (if (eq key ?I)
- (cons
- (math-calcFunc-to-var
- (nth 1 oper3))
- args)
- args))))))
- done t))
- (setq done t))))
- (t (beep))))
- (and nargs (>= nargs 0)
- (/= nargs (nth 1 oper))
- (error "Must be a %d-argument operator" nargs))
- (append (if forcenargs
- (cons forcenargs (cdr (cdr oper)))
- (cdr oper))
- (list
- (let ((name (concat (if inv "I" "") (if hyp "H" "")
- (if prefix (char-to-string prefix) "")
- (char-to-string key))))
- (if (> (length name) 3)
- (substring name 0 3)
- name))))))
-
-
-;;; Convert a variable name (as a formula) into a like-looking function name.
-(defun math-var-to-calcFunc (f)
- (if (eq (car-safe f) 'var)
- (if (fboundp (nth 2 f))
- (nth 2 f)
- (intern (concat "calcFunc-" (symbol-name (nth 1 f)))))
- (if (memq (car-safe f) '(lambda calcFunc-lambda))
- f
- (math-reject-arg f "*Expected a function name"))))
-
-;;; Convert a function name into a like-looking variable name formula.
-(defun math-calcFunc-to-var (f)
- (if (symbolp f)
- (let* ((func (or (cdr (assq f '( ( + . calcFunc-add )
- ( - . calcFunc-sub )
- ( * . calcFunc-mul )
- ( / . calcFunc-div )
- ( ^ . calcFunc-pow )
- ( % . calcFunc-mod )
- ( neg . calcFunc-neg )
- ( | . calcFunc-vconcat ) )))
- f))
- (base (if (string-match "\\`calcFunc-\\(.+\\)\\'"
- (symbol-name func))
- (math-match-substring (symbol-name func) 1)
- (symbol-name func))))
- (list 'var
- (intern base)
- (intern (concat "var-" base))))
- f))
-
-;;; Expand a function call using "lambda" notation.
-(defun math-build-call (f args)
- (if (eq (car-safe f) 'calcFunc-lambda)
- (if (= (length args) (- (length f) 2))
- (math-multi-subst (nth (1- (length f)) f) (cdr f) args)
- (calc-record-why "*Wrong number of arguments" f)
- (cons 'calcFunc-call (cons (math-calcFunc-to-var f) args)))
- (if (and (eq f 'calcFunc-neg)
- (= (length args) 1))
- (list 'neg (car args))
- (let ((func (assq f '( ( calcFunc-add . + )
- ( calcFunc-sub . - )
- ( calcFunc-mul . * )
- ( calcFunc-div . / )
- ( calcFunc-pow . ^ )
- ( calcFunc-mod . % )
- ( calcFunc-vconcat . | ) ))))
- (if (and func (= (length args) 2))
- (cons (cdr func) args)
- (cons f args))))))
-
-;;; Do substitutions in parallel to avoid crosstalk.
-(defun math-multi-subst (expr olds news)
- (let ((args nil)
- temp)
- (while (and olds news)
- (setq args (cons (cons (car olds) (car news)) args)
- olds (cdr olds)
- news (cdr news)))
- (math-multi-subst-rec expr)))
-
-(defun math-multi-subst-rec (expr)
- (cond ((setq temp (assoc expr args)) (cdr temp))
- ((Math-primp expr) expr)
- ((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2))
- (let ((new (list (car expr)))
- (args args))
- (while (cdr (setq expr (cdr expr)))
- (setq new (cons (car expr) new))
- (if (assoc (car expr) args)
- (setq args (cons (cons (car expr) (car expr)) args))))
- (nreverse (cons (math-multi-subst-rec (car expr)) new))))
- (t
- (cons (car expr)
- (mapcar 'math-multi-subst-rec (cdr expr))))))
-
-(defun calcFunc-call (f &rest args)
- (setq args (math-build-call (math-var-to-calcFunc f) args))
- (if (eq (car-safe args) 'calcFunc-call)
- args
- (math-normalize args)))
-
-(defun calcFunc-apply (f args)
- (or (Math-vectorp args)
- (math-reject-arg args 'vectorp))
- (apply 'calcFunc-call (cons f (cdr args))))
-
-
-
-
-;;; Map a function over a vector symbolically. [Public]
-(defun math-symb-map (f mode args)
- (let* ((func (math-var-to-calcFunc f))
- (nargs (length args))
- (ptrs (vconcat args))
- (vflags (make-vector nargs nil))
- (heads '(vec))
- (head nil)
- (vec nil)
- (i -1)
- (math-working-step 0)
- (math-working-step-2 nil)
- len cols obj expr)
- (if (eq mode 'eqn)
- (setq mode 'elems
- heads '(calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt
- calcFunc-leq calcFunc-geq))
- (while (and (< (setq i (1+ i)) nargs)
- (not (math-matrixp (aref ptrs i)))))
- (if (< i nargs)
- (if (eq mode 'elems)
- (setq func (list 'lambda '(&rest x)
- (list 'math-symb-map
- (list 'quote f) '(quote elems) 'x))
- mode 'rows)
- (if (eq mode 'cols)
- (while (< i nargs)
- (if (math-matrixp (aref ptrs i))
- (aset ptrs i (math-transpose (aref ptrs i))))
- (setq i (1+ i)))))
- (setq mode 'elems))
- (setq i -1))
- (while (< (setq i (1+ i)) nargs)
- (setq obj (aref ptrs i))
- (if (and (memq (car-safe obj) heads)
- (or (eq mode 'elems)
- (math-matrixp obj)))
- (progn
- (aset vflags i t)
- (if head
- (if (cdr heads)
- (setq head (nth
- (aref (aref [ [0 1 2 3 4 5]
- [1 1 2 3 2 3]
- [2 2 2 1 2 1]
- [3 3 1 3 1 3]
- [4 2 2 1 4 1]
- [5 3 1 3 1 5] ]
- (- 6 (length (memq head heads))))
- (- 6 (length (memq (car obj) heads))))
- heads)))
- (setq head (car obj)))
- (if len
- (or (= (length obj) len)
- (math-dimension-error))
- (setq len (length obj))))))
- (or len
- (if (= nargs 1)
- (math-reject-arg (aref ptrs 0) 'vectorp)
- (math-reject-arg nil "At least one argument must be a vector")))
- (setq math-working-step-2 (1- len))
- (while (> (setq len (1- len)) 0)
- (setq expr nil
- i -1)
- (while (< (setq i (1+ i)) nargs)
- (if (aref vflags i)
- (progn
- (aset ptrs i (cdr (aref ptrs i)))
- (setq expr (nconc expr (list (car (aref ptrs i))))))
- (setq expr (nconc expr (list (aref ptrs i))))))
- (setq math-working-step (1+ math-working-step)
- vec (cons (math-normalize (math-build-call func expr)) vec)))
- (setq vec (cons head (nreverse vec)))
- (if (and (eq mode 'cols) (math-matrixp vec))
- (math-transpose vec)
- vec)))
-
-(defun calcFunc-map (func &rest args)
- (math-symb-map func 'elems args))
-
-(defun calcFunc-mapr (func &rest args)
- (math-symb-map func 'rows args))
-
-(defun calcFunc-mapc (func &rest args)
- (math-symb-map func 'cols args))
-
-(defun calcFunc-mapa (func arg)
- (if (math-matrixp arg)
- (math-symb-map func 'elems (cdr (math-transpose arg)))
- (math-symb-map func 'elems arg)))
-
-(defun calcFunc-mapd (func arg)
- (if (math-matrixp arg)
- (math-symb-map func 'elems (cdr arg))
- (math-symb-map func 'elems arg)))
-
-(defun calcFunc-mapeq (func &rest args)
- (if (and (or (equal func '(var mul var-mul))
- (equal func '(var div var-div)))
- (= (length args) 2))
- (if (math-negp (car args))
- (let ((func (nth 1 (assq (car-safe (nth 1 args))
- calc-tweak-eqn-table))))
- (and func (setq args (list (car args)
- (cons func (cdr (nth 1 args)))))))
- (if (math-negp (nth 1 args))
- (let ((func (nth 1 (assq (car-safe (car args))
- calc-tweak-eqn-table))))
- (and func (setq args (list (cons func (cdr (car args)))
- (nth 1 args))))))))
- (if (or (and (equal func '(var div var-div))
- (assq (car-safe (nth 1 args)) calc-tweak-eqn-table))
- (equal func '(var neg var-neg))
- (equal func '(var inv var-inv)))
- (apply 'calcFunc-mapeqr func args)
- (apply 'calcFunc-mapeqp func args)))
-
-(defun calcFunc-mapeqr (func &rest args)
- (setq args (mapcar (function (lambda (x)
- (let ((func (assq (car-safe x)
- calc-tweak-eqn-table)))
- (if func
- (cons (nth 1 func) (cdr x))
- x))))
- args))
- (apply 'calcFunc-mapeqp func args))
-
-(defun calcFunc-mapeqp (func &rest args)
- (if (or (and (memq (car-safe (car args)) '(calcFunc-lt calcFunc-leq))
- (memq (car-safe (nth 1 args)) '(calcFunc-gt calcFunc-geq)))
- (and (memq (car-safe (car args)) '(calcFunc-gt calcFunc-geq))
- (memq (car-safe (nth 1 args)) '(calcFunc-lt calcFunc-leq))))
- (setq args (cons (car args)
- (cons (list (nth 1 (assq (car (nth 1 args))
- calc-tweak-eqn-table))
- (nth 2 (nth 1 args))
- (nth 1 (nth 1 args)))
- (cdr (cdr args))))))
- (math-symb-map func 'eqn args))
-
-
-
-;;; Reduce a function over a vector symbolically. [Public]
-(defun calcFunc-reduce (func vec)
- (if (math-matrixp vec)
- (let (expr row)
- (setq func (math-var-to-calcFunc func))
- (while (setq vec (cdr vec))
- (setq row (car vec))
- (while (setq row (cdr row))
- (setq expr (if expr
- (if (Math-numberp expr)
- (math-normalize
- (math-build-call func (list expr (car row))))
- (math-build-call func (list expr (car row))))
- (car row)))))
- (math-normalize expr))
- (calcFunc-reducer func vec)))
-
-(defun calcFunc-rreduce (func vec)
- (if (math-matrixp vec)
- (let (expr row)
- (setq func (math-var-to-calcFunc func)
- vec (reverse (cdr vec)))
- (while vec
- (setq row (reverse (cdr (car vec))))
- (while row
- (setq expr (if expr
- (math-build-call func (list (car row) expr))
- (car row))
- row (cdr row)))
- (setq vec (cdr vec)))
- (math-normalize expr))
- (calcFunc-rreducer func vec)))
-
-(defun calcFunc-reducer (func vec)
- (setq func (math-var-to-calcFunc func))
- (or (math-vectorp vec)
- (math-reject-arg vec 'vectorp))
- (let ((expr (car (setq vec (cdr vec)))))
- (if expr
- (progn
- (condition-case err
- (and (symbolp func)
- (let ((lfunc (or (cdr (assq func
- '( (calcFunc-add . math-add)
- (calcFunc-sub . math-sub)
- (calcFunc-mul . math-mul)
- (calcFunc-div . math-div)
- (calcFunc-pow . math-pow)
- (calcFunc-mod . math-mod)
- (calcFunc-vconcat .
- math-concat) )))
- lfunc)))
- (while (cdr vec)
- (setq expr (funcall lfunc expr (nth 1 vec))
- vec (cdr vec)))))
- (error nil))
- (while (setq vec (cdr vec))
- (setq expr (math-build-call func (list expr (car vec)))))
- (math-normalize expr))
- (or (math-identity-value func)
- (math-reject-arg vec "*Vector is empty")))))
-
-(defun math-identity-value (func)
- (cdr (assq func '( (calcFunc-add . 0) (calcFunc-sub . 0)
- (calcFunc-mul . 1) (calcFunc-div . 1)
- (calcFunc-idiv . 1) (calcFunc-fdiv . 1)
- (calcFunc-min . (var inf var-inf))
- (calcFunc-max . (neg (var inf var-inf)))
- (calcFunc-vconcat . (vec))
- (calcFunc-append . (vec)) ))))
-
-(defun calcFunc-rreducer (func vec)
- (setq func (math-var-to-calcFunc func))
- (or (math-vectorp vec)
- (math-reject-arg vec 'vectorp))
- (if (eq func 'calcFunc-sub) ; do this in a way that looks nicer
- (let ((expr (car (setq vec (cdr vec)))))
- (if expr
- (progn
- (while (setq vec (cdr vec))
- (setq expr (math-build-call func (list expr (car vec)))
- func (if (eq func 'calcFunc-sub)
- 'calcFunc-add 'calcFunc-sub)))
- (math-normalize expr))
- 0))
- (let ((expr (car (setq vec (reverse (cdr vec))))))
- (if expr
- (progn
- (while (setq vec (cdr vec))
- (setq expr (math-build-call func (list (car vec) expr))))
- (math-normalize expr))
- (or (math-identity-value func)
- (math-reject-arg vec "*Vector is empty"))))))
-
-(defun calcFunc-reducec (func vec)
- (if (math-matrixp vec)
- (calcFunc-reducer func (math-transpose vec))
- (calcFunc-reducer func vec)))
-
-(defun calcFunc-rreducec (func vec)
- (if (math-matrixp vec)
- (calcFunc-rreducer func (math-transpose vec))
- (calcFunc-rreducer func vec)))
-
-(defun calcFunc-reducea (func vec)
- (if (math-matrixp vec)
- (cons 'vec
- (mapcar (function (lambda (x) (calcFunc-reducer func x)))
- (cdr vec)))
- (calcFunc-reducer func vec)))
-
-(defun calcFunc-rreducea (func vec)
- (if (math-matrixp vec)
- (cons 'vec
- (mapcar (function (lambda (x) (calcFunc-rreducer func x)))
- (cdr vec)))
- (calcFunc-rreducer func vec)))
-
-(defun calcFunc-reduced (func vec)
- (if (math-matrixp vec)
- (cons 'vec
- (mapcar (function (lambda (x) (calcFunc-reducer func x)))
- (cdr (math-transpose vec))))
- (calcFunc-reducer func vec)))
-
-(defun calcFunc-rreduced (func vec)
- (if (math-matrixp vec)
- (cons 'vec
- (mapcar (function (lambda (x) (calcFunc-rreducer func x)))
- (cdr (math-transpose vec))))
- (calcFunc-rreducer func vec)))
-
-(defun calcFunc-accum (func vec)
- (setq func (math-var-to-calcFunc func))
- (or (math-vectorp vec)
- (math-reject-arg vec 'vectorp))
- (let* ((expr (car (setq vec (cdr vec))))
- (res (list 'vec expr)))
- (or expr
- (math-reject-arg vec "*Vector is empty"))
- (while (setq vec (cdr vec))
- (setq expr (math-build-call func (list expr (car vec)))
- res (nconc res (list expr))))
- (math-normalize res)))
-
-(defun calcFunc-raccum (func vec)
- (setq func (math-var-to-calcFunc func))
- (or (math-vectorp vec)
- (math-reject-arg vec 'vectorp))
- (let* ((expr (car (setq vec (reverse (cdr vec)))))
- (res (list expr)))
- (or expr
- (math-reject-arg vec "*Vector is empty"))
- (while (setq vec (cdr vec))
- (setq expr (math-build-call func (list (car vec) expr))
- res (cons (list expr) res)))
- (math-normalize (cons 'vec res))))
-
-
-(defun math-nest-calls (func base iters accum tol)
- (or (symbolp tol)
- (if (math-realp tol)
- (or (math-numberp base) (math-reject-arg base 'numberp))
- (math-reject-arg tol 'realp)))
- (setq func (math-var-to-calcFunc func))
- (or (null iters)
- (if (equal iters '(var inf var-inf))
- (setq iters nil)
- (progn
- (if (math-messy-integerp iters)
- (setq iters (math-trunc iters)))
- (or (integerp iters) (math-reject-arg iters 'fixnump))
- (or (not tol) (natnump iters) (math-reject-arg iters 'fixnatnump))
- (if (< iters 0)
- (let* ((dummy '(var DummyArg var-DummyArg))
- (dummy2 '(var DummyArg2 var-DummyArg2))
- (finv (math-solve-for (math-build-call func (list dummy2))
- dummy dummy2 nil)))
- (or finv (math-reject-arg nil "*Unable to find an inverse"))
- (if (and (= (length finv) 2)
- (equal (nth 1 finv) dummy))
- (setq func (car finv))
- (setq func (list 'calcFunc-lambda dummy finv)))
- (setq iters (- iters)))))))
- (math-with-extra-prec 1
- (let ((value base)
- (ovalue nil)
- (avalues (list base))
- (math-working-step 0)
- (math-working-step-2 iters))
- (while (and (or (null iters)
- (>= (setq iters (1- iters)) 0))
- (or (null tol)
- (null ovalue)
- (if (eq tol t)
- (not (if (and (Math-numberp value)
- (Math-numberp ovalue))
- (math-nearly-equal value ovalue)
- (Math-equal value ovalue)))
- (if (math-numberp value)
- (Math-lessp tol (math-abs (math-sub value ovalue)))
- (math-reject-arg value 'numberp)))))
- (setq ovalue value
- math-working-step (1+ math-working-step)
- value (math-normalize (math-build-call func (list value))))
- (if accum
- (setq avalues (cons value avalues))))
- (if accum
- (cons 'vec (nreverse avalues))
- value))))
-
-(defun calcFunc-nest (func base iters)
- (math-nest-calls func base iters nil nil))
-
-(defun calcFunc-anest (func base iters)
- (math-nest-calls func base iters t nil))
-
-(defun calcFunc-fixp (func base &optional iters tol)
- (math-nest-calls func base iters nil (or tol t)))
-
-(defun calcFunc-afixp (func base &optional iters tol)
- (math-nest-calls func base iters t (or tol t)))
-
-
-(defun calcFunc-outer (func a b)
- (or (math-vectorp a) (math-reject-arg a 'vectorp))
- (or (math-vectorp b) (math-reject-arg b 'vectorp))
- (setq func (math-var-to-calcFunc func))
- (let ((mat nil))
- (while (setq a (cdr a))
- (setq mat (cons (cons 'vec
- (mapcar (function (lambda (x)
- (math-build-call func
- (list (car a)
- x))))
- (cdr b)))
- mat)))
- (math-normalize (cons 'vec (nreverse mat)))))
-
-
-(defun calcFunc-inner (mul-func add-func a b)
- (or (math-vectorp a) (math-reject-arg a 'vectorp))
- (or (math-vectorp b) (math-reject-arg b 'vectorp))
- (if (math-matrixp a)
- (if (math-matrixp b)
- (if (= (length (nth 1 a)) (length b))
- (math-inner-mats a b)
- (math-dimension-error))
- (if (= (length (nth 1 a)) 2)
- (if (= (length a) (length b))
- (math-inner-mats a (list 'vec b))
- (math-dimension-error))
- (if (= (length (nth 1 a)) (length b))
- (math-mat-col (math-inner-mats a (math-col-matrix b))
- 1)
- (math-dimension-error))))
- (if (math-matrixp b)
- (nth 1 (math-inner-mats (list 'vec a) b))
- (calcFunc-reduce add-func (calcFunc-map mul-func a b)))))
-
-(defun math-inner-mats (a b)
- (let ((mat nil)
- (cols (length (nth 1 b)))
- row col ap bp accum)
- (while (setq a (cdr a))
- (setq col cols
- row nil)
- (while (> (setq col (1- col)) 0)
- (setq row (cons (calcFunc-reduce add-func
- (calcFunc-map mul-func
- (car a)
- (math-mat-col b col)))
- row)))
- (setq mat (cons (cons 'vec row) mat)))
- (cons 'vec (nreverse mat))))
-
-;;; calc-map.el ends here
+++ /dev/null
-;;; calc-math.el --- mathematical functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-math () nil)
-
-
-(defun calc-sqrt (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-unary-op "^2" 'calcFunc-sqr arg)
- (calc-unary-op "sqrt" 'calcFunc-sqrt arg))))
-
-(defun calc-isqrt (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-unary-op "^2" 'calcFunc-sqr arg)
- (calc-unary-op "isqt" 'calcFunc-isqrt arg))))
-
-
-(defun calc-hypot (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "hypt" 'calcFunc-hypot arg)))
-
-(defun calc-ln (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-exp arg))
-
-(defun calc-log10 (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-ln arg))
-
-(defun calc-log (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-binary-op "alog" 'calcFunc-alog arg)
- (calc-binary-op "log" 'calcFunc-log arg))))
-
-(defun calc-ilog (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-binary-op "alog" 'calcFunc-alog arg)
- (calc-binary-op "ilog" 'calcFunc-ilog arg))))
-
-(defun calc-lnp1 (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-expm1 arg))
-
-(defun calc-exp (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (if (calc-is-inverse)
- (calc-unary-op "lg10" 'calcFunc-log10 arg)
- (calc-unary-op "10^" 'calcFunc-exp10 arg))
- (if (calc-is-inverse)
- (calc-unary-op "ln" 'calcFunc-ln arg)
- (calc-unary-op "exp" 'calcFunc-exp arg)))))
-
-(defun calc-expm1 (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-unary-op "ln+1" 'calcFunc-lnp1 arg)
- (calc-unary-op "ex-1" 'calcFunc-expm1 arg))))
-
-(defun calc-pi ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (if (calc-is-hyperbolic)
- (if calc-symbolic-mode
- (calc-pop-push-record 0 "phi" '(var phi var-phi))
- (calc-pop-push-record 0 "phi" (math-phi)))
- (if calc-symbolic-mode
- (calc-pop-push-record 0 "gmma" '(var gamma var-gamma))
- (calc-pop-push-record 0 "gmma" (math-gamma-const))))
- (if (calc-is-hyperbolic)
- (if calc-symbolic-mode
- (calc-pop-push-record 0 "e" '(var e var-e))
- (calc-pop-push-record 0 "e" (math-e)))
- (if calc-symbolic-mode
- (calc-pop-push-record 0 "pi" '(var pi var-pi))
- (calc-pop-push-record 0 "pi" (math-pi)))))))
-
-(defun calc-sin (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (if (calc-is-inverse)
- (calc-unary-op "asnh" 'calcFunc-arcsinh arg)
- (calc-unary-op "sinh" 'calcFunc-sinh arg))
- (if (calc-is-inverse)
- (calc-unary-op "asin" 'calcFunc-arcsin arg)
- (calc-unary-op "sin" 'calcFunc-sin arg)))))
-
-(defun calc-arcsin (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-sin arg))
-
-(defun calc-sinh (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-sin arg))
-
-(defun calc-arcsinh (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-hyperbolic-func)
- (calc-sin arg))
-
-(defun calc-cos (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (if (calc-is-inverse)
- (calc-unary-op "acsh" 'calcFunc-arccosh arg)
- (calc-unary-op "cosh" 'calcFunc-cosh arg))
- (if (calc-is-inverse)
- (calc-unary-op "acos" 'calcFunc-arccos arg)
- (calc-unary-op "cos" 'calcFunc-cos arg)))))
-
-(defun calc-arccos (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-cos arg))
-
-(defun calc-cosh (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-cos arg))
-
-(defun calc-arccosh (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-hyperbolic-func)
- (calc-cos arg))
-
-(defun calc-sincos ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-enter-result 1 "asnc" (list 'calcFunc-arcsincos (calc-top-n 1)))
- (calc-enter-result 1 "sncs" (list 'calcFunc-sincos (calc-top-n 1))))))
-
-(defun calc-tan (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (if (calc-is-inverse)
- (calc-unary-op "atnh" 'calcFunc-arctanh arg)
- (calc-unary-op "tanh" 'calcFunc-tanh arg))
- (if (calc-is-inverse)
- (calc-unary-op "atan" 'calcFunc-arctan arg)
- (calc-unary-op "tan" 'calcFunc-tan arg)))))
-
-(defun calc-arctan (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-tan arg))
-
-(defun calc-tanh (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-tan arg))
-
-(defun calc-arctanh (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-hyperbolic-func)
- (calc-tan arg))
-
-(defun calc-arctan2 ()
- (interactive)
- (calc-slow-wrapper
- (calc-enter-result 2 "atn2" (cons 'calcFunc-arctan2 (calc-top-list-n 2)))))
-
-(defun calc-conj (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "conj" 'calcFunc-conj arg)))
-
-(defun calc-imaginary ()
- (interactive)
- (calc-slow-wrapper
- (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1)))))
-
-
-
-(defun calc-to-degrees (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op ">deg" 'calcFunc-deg arg)))
-
-(defun calc-to-radians (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op ">rad" 'calcFunc-rad arg)))
-
-
-(defun calc-degrees-mode (arg)
- (interactive "p")
- (cond ((= arg 1)
- (calc-wrapper
- (calc-change-mode 'calc-angle-mode 'deg)
- (message "Angles measured in degrees")))
- ((= arg 2) (calc-radians-mode))
- ((= arg 3) (calc-hms-mode))
- (t (error "Prefix argument out of range"))))
-
-(defun calc-radians-mode ()
- (interactive)
- (calc-wrapper
- (calc-change-mode 'calc-angle-mode 'rad)
- (message "Angles measured in radians")))
-
-
-;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
-;;; This method takes advantage of the fact that Newton's method starting
-;;; with an overestimate always works, even using truncating integer division!
-(defun math-isqrt (a)
- (cond ((Math-zerop a) a)
- ((not (math-natnump a))
- (math-reject-arg a 'natnump))
- ((integerp a)
- (math-isqrt-small a))
- (t
- (math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a))))))))
-
-(defun calcFunc-isqrt (a)
- (if (math-realp a)
- (math-isqrt (math-floor a))
- (math-floor (math-sqrt a))))
-
-
-;;; This returns (flag . result) where the flag is t if A is a perfect square.
-(defun math-isqrt-bignum (a) ; [P.l L]
- (let ((len (length a)))
- (if (= (% len 2) 0)
- (let* ((top (nthcdr (- len 2) a)))
- (math-isqrt-bignum-iter
- a
- (math-scale-bignum-3
- (math-bignum-big
- (1+ (math-isqrt-small
- (+ (* (nth 1 top) 1000) (car top)))))
- (1- (/ len 2)))))
- (let* ((top (nth (1- len) a)))
- (math-isqrt-bignum-iter
- a
- (math-scale-bignum-3
- (list (1+ (math-isqrt-small top)))
- (/ len 2)))))))
-
-(defun math-isqrt-bignum-iter (a guess) ; [l L l]
- (math-working "isqrt" (cons 'bigpos guess))
- (let* ((q (math-div-bignum a guess))
- (s (math-add-bignum (car q) guess))
- (g2 (math-div2-bignum s))
- (comp (math-compare-bignum g2 guess)))
- (if (< comp 0)
- (math-isqrt-bignum-iter a g2)
- (cons (and (= comp 0)
- (math-zerop-bignum (cdr q))
- (= (% (car s) 2) 0))
- guess))))
-
-(defun math-zerop-bignum (a)
- (and (eq (car a) 0)
- (progn
- (while (eq (car (setq a (cdr a))) 0))
- (null a))))
-
-(defun math-scale-bignum-3 (a n) ; [L L S]
- (while (> n 0)
- (setq a (cons 0 a)
- n (1- n)))
- a)
-
-(defun math-isqrt-small (a) ; A > 0. [S S]
- (let ((g (cond ((>= a 10000) 1000)
- ((>= a 100) 100)
- (t 10)))
- g2)
- (while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
- (setq g g2))
- g))
-
-
-
-
-;;; Compute the square root of a number.
-;;; [T N] if possible, else [F N] if possible, else [C N]. [Public]
-(defun math-sqrt (a)
- (or
- (and (Math-zerop a) a)
- (and (math-known-nonposp a)
- (math-imaginary (math-sqrt (math-neg a))))
- (and (integerp a)
- (let ((sqrt (math-isqrt-small a)))
- (if (= (* sqrt sqrt) a)
- sqrt
- (if calc-symbolic-mode
- (list 'calcFunc-sqrt a)
- (math-sqrt-float (math-float a) (math-float sqrt))))))
- (and (eq (car-safe a) 'bigpos)
- (let* ((res (math-isqrt-bignum (cdr a)))
- (sqrt (math-normalize (cons 'bigpos (cdr res)))))
- (if (car res)
- sqrt
- (if calc-symbolic-mode
- (list 'calcFunc-sqrt a)
- (math-sqrt-float (math-float a) (math-float sqrt))))))
- (and (eq (car-safe a) 'frac)
- (let* ((num-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 1 a)))))
- (num-sqrt (math-normalize (cons 'bigpos (cdr num-res))))
- (den-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 2 a)))))
- (den-sqrt (math-normalize (cons 'bigpos (cdr den-res)))))
- (if (and (car num-res) (car den-res))
- (list 'frac num-sqrt den-sqrt)
- (if calc-symbolic-mode
- (if (or (car num-res) (car den-res))
- (math-div (if (car num-res)
- num-sqrt (list 'calcFunc-sqrt (nth 1 a)))
- (if (car den-res)
- den-sqrt (list 'calcFunc-sqrt (nth 2 a))))
- (list 'calcFunc-sqrt a))
- (math-sqrt-float (math-float a)
- (math-div (math-float num-sqrt) den-sqrt))))))
- (and (eq (car-safe a) 'float)
- (if calc-symbolic-mode
- (if (= (% (nth 2 a) 2) 0)
- (let ((res (math-isqrt-bignum
- (cdr (Math-bignum-test (nth 1 a))))))
- (if (car res)
- (math-make-float (math-normalize
- (cons 'bigpos (cdr res)))
- (/ (nth 2 a) 2))
- (signal 'inexact-result nil)))
- (signal 'inexact-result nil))
- (math-sqrt-float a)))
- (and (eq (car-safe a) 'cplx)
- (math-with-extra-prec 2
- (let* ((d (math-abs a))
- (imag (math-sqrt (math-mul (math-sub d (nth 1 a))
- '(float 5 -1)))))
- (list 'cplx
- (math-sqrt (math-mul (math-add d (nth 1 a)) '(float 5 -1)))
- (if (math-negp (nth 2 a)) (math-neg imag) imag)))))
- (and (eq (car-safe a) 'polar)
- (list 'polar
- (math-sqrt (nth 1 a))
- (math-mul (nth 2 a) '(float 5 -1))))
- (and (eq (car-safe a) 'sdev)
- (let ((sqrt (math-sqrt (nth 1 a))))
- (math-make-sdev sqrt
- (math-div (nth 2 a) (math-mul sqrt 2)))))
- (and (eq (car-safe a) 'intv)
- (not (math-negp (nth 2 a)))
- (math-make-intv (nth 1 a) (math-sqrt (nth 2 a)) (math-sqrt (nth 3 a))))
- (and (eq (car-safe a) '*)
- (or (math-known-nonnegp (nth 1 a))
- (math-known-nonnegp (nth 2 a)))
- (math-mul (math-sqrt (nth 1 a)) (math-sqrt (nth 2 a))))
- (and (eq (car-safe a) '/)
- (or (and (math-known-nonnegp (nth 2 a))
- (math-div (math-sqrt (nth 1 a)) (math-sqrt (nth 2 a))))
- (and (math-known-nonnegp (nth 1 a))
- (not (math-equal-int (nth 1 a) 1))
- (math-mul (math-sqrt (nth 1 a))
- (math-sqrt (math-div 1 (nth 2 a)))))))
- (and (eq (car-safe a) '^)
- (math-known-evenp (nth 2 a))
- (math-known-realp (nth 1 a))
- (math-abs (math-pow (nth 1 a) (math-div (nth 2 a) 2))))
- (let ((inf (math-infinitep a)))
- (and inf
- (math-mul (math-sqrt (math-infinite-dir a inf)) inf)))
- (progn
- (calc-record-why 'numberp a)
- (list 'calcFunc-sqrt a))))
-(defalias 'calcFunc-sqrt 'math-sqrt)
-
-(defun math-infinite-dir (a &optional inf)
- (or inf (setq inf (math-infinitep a)))
- (math-normalize (math-expr-subst a inf 1)))
-
-(defun math-sqrt-float (a &optional guess) ; [F F F]
- (if calc-symbolic-mode
- (signal 'inexact-result nil)
- (math-with-extra-prec 1 (math-sqrt-raw a guess))))
-
-(defun math-sqrt-raw (a &optional guess) ; [F F F]
- (if (not (Math-posp a))
- (math-sqrt a)
- (if (null guess)
- (let ((ldiff (- (math-numdigs (nth 1 a)) 6)))
- (or (= (% (+ (nth 2 a) ldiff) 2) 0) (setq ldiff (1+ ldiff)))
- (setq guess (math-make-float (math-isqrt-small
- (math-scale-int (nth 1 a) (- ldiff)))
- (/ (+ (nth 2 a) ldiff) 2)))))
- (math-sqrt-float-iter a guess)))
-
-(defun math-sqrt-float-iter (a guess) ; [F F F]
- (math-working "sqrt" guess)
- (let ((g2 (math-mul-float (math-add-float guess (math-div-float a guess))
- '(float 5 -1))))
- (if (math-nearly-equal-float g2 guess)
- g2
- (math-sqrt-float-iter a g2))))
-
-;;; True if A and B differ only in the last digit of precision. [P F F]
-(defun math-nearly-equal-float (a b)
- (let ((ediff (- (nth 2 a) (nth 2 b))))
- (cond ((= ediff 0) ;; Expanded out for speed
- (setq ediff (math-add (Math-integer-neg (nth 1 a)) (nth 1 b)))
- (or (eq ediff 0)
- (and (not (consp ediff))
- (< ediff 10)
- (> ediff -10)
- (= (math-numdigs (nth 1 a)) calc-internal-prec))))
- ((= ediff 1)
- (setq ediff (math-add (Math-integer-neg (nth 1 b))
- (math-scale-int (nth 1 a) 1)))
- (and (not (consp ediff))
- (< ediff 10)
- (> ediff -10)
- (= (math-numdigs (nth 1 b)) calc-internal-prec)))
- ((= ediff -1)
- (setq ediff (math-add (Math-integer-neg (nth 1 a))
- (math-scale-int (nth 1 b) 1)))
- (and (not (consp ediff))
- (< ediff 10)
- (> ediff -10)
- (= (math-numdigs (nth 1 a)) calc-internal-prec))))))
-
-(defun math-nearly-equal (a b) ; [P N N] [Public]
- (setq a (math-float a))
- (setq b (math-float b))
- (if (eq (car a) 'polar) (setq a (math-complex a)))
- (if (eq (car b) 'polar) (setq b (math-complex b)))
- (if (eq (car a) 'cplx)
- (if (eq (car b) 'cplx)
- (and (or (math-nearly-equal-float (nth 1 a) (nth 1 b))
- (and (math-nearly-zerop-float (nth 1 a) (nth 2 a))
- (math-nearly-zerop-float (nth 1 b) (nth 2 b))))
- (or (math-nearly-equal-float (nth 2 a) (nth 2 b))
- (and (math-nearly-zerop-float (nth 2 a) (nth 1 a))
- (math-nearly-zerop-float (nth 2 b) (nth 1 b)))))
- (and (math-nearly-equal-float (nth 1 a) b)
- (math-nearly-zerop-float (nth 2 a) b)))
- (if (eq (car b) 'cplx)
- (and (math-nearly-equal-float a (nth 1 b))
- (math-nearly-zerop-float a (nth 2 b)))
- (math-nearly-equal-float a b))))
-
-;;; True if A is nearly zero compared to B. [P F F]
-(defun math-nearly-zerop-float (a b)
- (or (eq (nth 1 a) 0)
- (<= (+ (math-numdigs (nth 1 a)) (nth 2 a))
- (1+ (- (+ (math-numdigs (nth 1 b)) (nth 2 b)) calc-internal-prec)))))
-
-(defun math-nearly-zerop (a b) ; [P N R] [Public]
- (setq a (math-float a))
- (setq b (math-float b))
- (if (eq (car a) 'cplx)
- (and (math-nearly-zerop-float (nth 1 a) b)
- (math-nearly-zerop-float (nth 2 a) b))
- (if (eq (car a) 'polar)
- (math-nearly-zerop-float (nth 1 a) b)
- (math-nearly-zerop-float a b))))
-
-;;; This implementation could be improved, accuracy-wise.
-(defun math-hypot (a b)
- (cond ((Math-zerop a) (math-abs b))
- ((Math-zerop b) (math-abs a))
- ((not (Math-scalarp a))
- (if (math-infinitep a)
- (if (math-infinitep b)
- (if (equal a b)
- a
- '(var nan var-nan))
- a)
- (calc-record-why 'scalarp a)
- (list 'calcFunc-hypot a b)))
- ((not (Math-scalarp b))
- (if (math-infinitep b)
- b
- (calc-record-why 'scalarp b)
- (list 'calcFunc-hypot a b)))
- ((and (Math-numberp a) (Math-numberp b))
- (math-with-extra-prec 1
- (math-sqrt (math-add (calcFunc-abssqr a) (calcFunc-abssqr b)))))
- ((eq (car-safe a) 'hms)
- (if (eq (car-safe b) 'hms) ; this helps sdev's of hms forms
- (math-to-hms (math-hypot (math-from-hms a 'deg)
- (math-from-hms b 'deg)))
- (math-to-hms (math-hypot (math-from-hms a 'deg) b))))
- ((eq (car-safe b) 'hms)
- (math-to-hms (math-hypot a (math-from-hms b 'deg))))
- (t nil)))
-(defalias 'calcFunc-hypot 'math-hypot)
-
-(defun calcFunc-sqr (x)
- (math-pow x 2))
-
-
-
-(defun math-nth-root (a n)
- (cond ((= n 2) (math-sqrt a))
- ((Math-zerop a) a)
- ((Math-negp a) nil)
- ((Math-integerp a)
- (let ((root (math-nth-root-integer a n)))
- (if (car root)
- (cdr root)
- (and (not calc-symbolic-mode)
- (math-nth-root-float (math-float a) n
- (math-float (cdr root)))))))
- ((eq (car-safe a) 'frac)
- (let* ((num-root (math-nth-root-integer (nth 1 a) n))
- (den-root (math-nth-root-integer (nth 2 a) n)))
- (if (and (car num-root) (car den-root))
- (list 'frac (cdr num-root) (cdr den-root))
- (and (not calc-symbolic-mode)
- (math-nth-root-float
- (math-float a) n
- (math-div-float (math-float (cdr num-root))
- (math-float (cdr den-root))))))))
- ((eq (car-safe a) 'float)
- (and (not calc-symbolic-mode)
- (math-nth-root-float a n)))
- ((eq (car-safe a) 'polar)
- (let ((root (math-nth-root (nth 1 a) n)))
- (and root (list 'polar root (math-div (nth 2 a) n)))))
- (t nil)))
-
-(defun math-nth-root-float (a n &optional guess)
- (math-inexact-result)
- (math-with-extra-prec 1
- (let ((nf (math-float n))
- (nfm1 (math-float (1- n))))
- (math-nth-root-float-iter a (or guess
- (math-make-float
- 1 (/ (+ (math-numdigs (nth 1 a))
- (nth 2 a)
- (/ n 2))
- n)))))))
-
-(defun math-nth-root-float-iter (a guess) ; uses "n", "nf", "nfm1"
- (math-working "root" guess)
- (let ((g2 (math-div-float (math-add-float (math-mul nfm1 guess)
- (math-div-float
- a (math-ipow guess (1- n))))
- nf)))
- (if (math-nearly-equal-float g2 guess)
- g2
- (math-nth-root-float-iter a g2))))
-
-(defun math-nth-root-integer (a n &optional guess) ; [I I S]
- (math-nth-root-int-iter a (or guess
- (math-scale-int 1 (/ (+ (math-numdigs a)
- (1- n))
- n)))))
-
-(defun math-nth-root-int-iter (a guess) ; uses "n"
- (math-working "root" guess)
- (let* ((q (math-idivmod a (math-ipow guess (1- n))))
- (s (math-add (car q) (math-mul (1- n) guess)))
- (g2 (math-idivmod s n)))
- (if (Math-natnum-lessp (car g2) guess)
- (math-nth-root-int-iter a (car g2))
- (cons (and (equal (car g2) guess)
- (eq (cdr q) 0)
- (eq (cdr g2) 0))
- guess))))
-
-(defun calcFunc-nroot (x n)
- (calcFunc-pow x (if (integerp n)
- (math-make-frac 1 n)
- (math-div 1 n))))
-
-
-
-
-;;;; Transcendental functions.
-
-;;; All of these functions are defined on the complex plane.
-;;; (Branch cuts, etc. follow Steele's Common Lisp book.)
-
-;;; Most functions increase calc-internal-prec by 2 digits, then round
-;;; down afterward. "-raw" functions use the current precision, require
-;;; their arguments to be in float (or complex float) format, and always
-;;; work in radians (where applicable).
-
-(defun math-to-radians (a) ; [N N]
- (cond ((eq (car-safe a) 'hms)
- (math-from-hms a 'rad))
- ((memq calc-angle-mode '(deg hms))
- (math-mul a (math-pi-over-180)))
- (t a)))
-
-(defun math-from-radians (a) ; [N N]
- (cond ((eq calc-angle-mode 'deg)
- (if (math-constp a)
- (math-div a (math-pi-over-180))
- (list 'calcFunc-deg a)))
- ((eq calc-angle-mode 'hms)
- (math-to-hms a 'rad))
- (t a)))
-
-(defun math-to-radians-2 (a) ; [N N]
- (cond ((eq (car-safe a) 'hms)
- (math-from-hms a 'rad))
- ((memq calc-angle-mode '(deg hms))
- (if calc-symbolic-mode
- (math-div (math-mul a '(var pi var-pi)) 180)
- (math-mul a (math-pi-over-180))))
- (t a)))
-
-(defun math-from-radians-2 (a) ; [N N]
- (cond ((memq calc-angle-mode '(deg hms))
- (if calc-symbolic-mode
- (math-div (math-mul 180 a) '(var pi var-pi))
- (math-div a (math-pi-over-180))))
- (t a)))
-
-
-
-;;; Sine, cosine, and tangent.
-
-(defun calcFunc-sin (x) ; [N N] [Public]
- (cond ((and (integerp x)
- (if (eq calc-angle-mode 'deg)
- (= (% x 90) 0)
- (= x 0)))
- (aref [0 1 0 -1] (math-mod (/ x 90) 4)))
- ((Math-scalarp x)
- (math-with-extra-prec 2
- (math-sin-raw (math-to-radians (math-float x)))))
- ((eq (car x) 'sdev)
- (if (math-constp x)
- (math-with-extra-prec 2
- (let* ((xx (math-to-radians (math-float (nth 1 x))))
- (xs (math-to-radians (math-float (nth 2 x))))
- (sc (math-sin-cos-raw xx)))
- (math-make-sdev (car sc) (math-mul xs (cdr sc)))))
- (math-make-sdev (calcFunc-sin (nth 1 x))
- (math-mul (nth 2 x) (calcFunc-cos (nth 1 x))))))
- ((and (eq (car x) 'intv) (math-intv-constp x))
- (calcFunc-cos (math-sub x (math-quarter-circle nil))))
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'scalarp x)
- (list 'calcFunc-sin x))))
-
-(defun calcFunc-cos (x) ; [N N] [Public]
- (cond ((and (integerp x)
- (if (eq calc-angle-mode 'deg)
- (= (% x 90) 0)
- (= x 0)))
- (aref [1 0 -1 0] (math-mod (/ x 90) 4)))
- ((Math-scalarp x)
- (math-with-extra-prec 2
- (math-cos-raw (math-to-radians (math-float x)))))
- ((eq (car x) 'sdev)
- (if (math-constp x)
- (math-with-extra-prec 2
- (let* ((xx (math-to-radians (math-float (nth 1 x))))
- (xs (math-to-radians (math-float (nth 2 x))))
- (sc (math-sin-cos-raw xx)))
- (math-make-sdev (cdr sc) (math-mul xs (car sc)))))
- (math-make-sdev (calcFunc-cos (nth 1 x))
- (math-mul (nth 2 x) (calcFunc-sin (nth 1 x))))))
- ((and (eq (car x) 'intv) (math-intv-constp x))
- (math-with-extra-prec 2
- (let* ((xx (math-to-radians (math-float x)))
- (na (math-floor (math-div (nth 2 xx) (math-pi))))
- (nb (math-floor (math-div (nth 3 xx) (math-pi))))
- (span (math-sub nb na)))
- (if (memq span '(0 1))
- (let ((int (math-sort-intv (nth 1 x)
- (math-cos-raw (nth 2 xx))
- (math-cos-raw (nth 3 xx)))))
- (if (eq span 1)
- (if (math-evenp na)
- (math-make-intv (logior (nth 1 x) 2)
- -1
- (nth 3 int))
- (math-make-intv (logior (nth 1 x) 1)
- (nth 2 int)
- 1))
- int))
- (list 'intv 3 -1 1)))))
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'scalarp x)
- (list 'calcFunc-cos x))))
-
-(defun calcFunc-sincos (x) ; [V N] [Public]
- (if (Math-scalarp x)
- (math-with-extra-prec 2
- (let ((sc (math-sin-cos-raw (math-to-radians (math-float x)))))
- (list 'vec (cdr sc) (car sc)))) ; the vector [cos, sin]
- (list 'vec (calcFunc-sin x) (calcFunc-cos x))))
-
-(defun calcFunc-tan (x) ; [N N] [Public]
- (cond ((and (integerp x)
- (if (eq calc-angle-mode 'deg)
- (= (% x 180) 0)
- (= x 0)))
- 0)
- ((Math-scalarp x)
- (math-with-extra-prec 2
- (math-tan-raw (math-to-radians (math-float x)))))
- ((eq (car x) 'sdev)
- (if (math-constp x)
- (math-with-extra-prec 2
- (let* ((xx (math-to-radians (math-float (nth 1 x))))
- (xs (math-to-radians (math-float (nth 2 x))))
- (sc (math-sin-cos-raw xx)))
- (if (and (math-zerop (cdr sc)) (not calc-infinite-mode))
- (progn
- (calc-record-why "*Division by zero")
- (list 'calcFunc-tan x))
- (math-make-sdev (math-div-float (car sc) (cdr sc))
- (math-div-float xs (math-sqr (cdr sc)))))))
- (math-make-sdev (calcFunc-tan (nth 1 x))
- (math-div (nth 2 x)
- (math-sqr (calcFunc-cos (nth 1 x)))))))
- ((and (eq (car x) 'intv) (math-intv-constp x))
- (or (math-with-extra-prec 2
- (let* ((xx (math-to-radians (math-float x)))
- (na (math-floor (math-div (math-sub (nth 2 xx)
- (math-pi-over-2))
- (math-pi))))
- (nb (math-floor (math-div (math-sub (nth 3 xx)
- (math-pi-over-2))
- (math-pi)))))
- (and (equal na nb)
- (math-sort-intv (nth 1 x)
- (math-tan-raw (nth 2 xx))
- (math-tan-raw (nth 3 xx))))))
- '(intv 3 (neg (var inf var-inf)) (var inf var-inf))))
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'scalarp x)
- (list 'calcFunc-tan x))))
-
-(defun math-sin-raw (x) ; [N N]
- (cond ((eq (car x) 'cplx)
- (let* ((expx (math-exp-raw (nth 2 x)))
- (expmx (math-div-float '(float 1 0) expx))
- (sc (math-sin-cos-raw (nth 1 x))))
- (list 'cplx
- (math-mul-float (car sc)
- (math-mul-float (math-add-float expx expmx)
- '(float 5 -1)))
- (math-mul-float (cdr sc)
- (math-mul-float (math-sub-float expx expmx)
- '(float 5 -1))))))
- ((eq (car x) 'polar)
- (math-polar (math-sin-raw (math-complex x))))
- ((Math-integer-negp (nth 1 x))
- (math-neg-float (math-sin-raw (math-neg-float x))))
- ((math-lessp-float '(float 7 0) x) ; avoid inf loops due to roundoff
- (math-sin-raw (math-mod x (math-two-pi))))
- (t (math-sin-raw-2 x x))))
-
-(defun math-cos-raw (x) ; [N N]
- (if (eq (car-safe x) 'polar)
- (math-polar (math-cos-raw (math-complex x)))
- (math-sin-raw (math-sub (math-pi-over-2) x))))
-
-;;; This could use a smarter method: Reduce x as in math-sin-raw, then
-;;; compute either sin(x) or cos(x), whichever is smaller, and compute
-;;; the other using the identity sin(x)^2 + cos(x)^2 = 1.
-(defun math-sin-cos-raw (x) ; [F.F F] (result is (sin x . cos x))
- (cons (math-sin-raw x) (math-cos-raw x)))
-
-(defun math-tan-raw (x) ; [N N]
- (cond ((eq (car x) 'cplx)
- (let* ((x (math-mul x '(float 2 0)))
- (expx (math-exp-raw (nth 2 x)))
- (expmx (math-div-float '(float 1 0) expx))
- (sc (math-sin-cos-raw (nth 1 x)))
- (d (math-add-float (cdr sc)
- (math-mul-float (math-add-float expx expmx)
- '(float 5 -1)))))
- (and (not (eq (nth 1 d) 0))
- (list 'cplx
- (math-div-float (car sc) d)
- (math-div-float (math-mul-float (math-sub-float expx
- expmx)
- '(float 5 -1)) d)))))
- ((eq (car x) 'polar)
- (math-polar (math-tan-raw (math-complex x))))
- (t
- (let ((sc (math-sin-cos-raw x)))
- (if (eq (nth 1 (cdr sc)) 0)
- (math-div (car sc) 0)
- (math-div-float (car sc) (cdr sc)))))))
-
-(defun math-sin-raw-2 (x orgx) ; This avoids poss of inf recursion. [F F]
- (let ((xmpo2 (math-sub-float (math-pi-over-2) x)))
- (cond ((Math-integer-negp (nth 1 xmpo2))
- (math-neg-float (math-sin-raw-2 (math-sub-float x (math-pi))
- orgx)))
- ((math-lessp-float (math-pi-over-4) x)
- (math-cos-raw-2 xmpo2 orgx))
- ((math-lessp-float x (math-neg (math-pi-over-4)))
- (math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx)))
- ((math-nearly-zerop-float x orgx) '(float 0 0))
- (calc-symbolic-mode (signal 'inexact-result nil))
- (t (math-sin-series x 6 4 x (math-neg-float (math-sqr-float x)))))))
-
-(defun math-cos-raw-2 (x orgx) ; [F F]
- (cond ((math-nearly-zerop-float x orgx) '(float 1 0))
- (calc-symbolic-mode (signal 'inexact-result nil))
- (t (let ((xnegsqr (math-neg-float (math-sqr-float x))))
- (math-sin-series
- (math-add-float '(float 1 0)
- (math-mul-float xnegsqr '(float 5 -1)))
- 24 5 xnegsqr xnegsqr)))))
-
-(defun math-sin-series (sum nfac n x xnegsqr)
- (math-working "sin" sum)
- (let* ((nextx (math-mul-float x xnegsqr))
- (nextsum (math-add-float sum (math-div-float nextx
- (math-float nfac)))))
- (if (math-nearly-equal-float sum nextsum)
- sum
- (math-sin-series nextsum (math-mul nfac (* n (1+ n)))
- (+ n 2) nextx xnegsqr))))
-
-
-;;; Inverse sine, cosine, tangent.
-
-(defun calcFunc-arcsin (x) ; [N N] [Public]
- (cond ((eq x 0) 0)
- ((and (eq x 1) (eq calc-angle-mode 'deg)) 90)
- ((and (eq x -1) (eq calc-angle-mode 'deg)) -90)
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((Math-numberp x)
- (math-with-extra-prec 2
- (math-from-radians (math-arcsin-raw (math-float x)))))
- ((eq (car x) 'sdev)
- (math-make-sdev (calcFunc-arcsin (nth 1 x))
- (math-from-radians
- (math-div (nth 2 x)
- (math-sqrt
- (math-sub 1 (math-sqr (nth 1 x))))))))
- ((eq (car x) 'intv)
- (math-sort-intv (nth 1 x)
- (calcFunc-arcsin (nth 2 x))
- (calcFunc-arcsin (nth 3 x))))
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-arcsin x))))
-
-(defun calcFunc-arccos (x) ; [N N] [Public]
- (cond ((eq x 1) 0)
- ((and (eq x 0) (eq calc-angle-mode 'deg)) 90)
- ((and (eq x -1) (eq calc-angle-mode 'deg)) 180)
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((Math-numberp x)
- (math-with-extra-prec 2
- (math-from-radians (math-arccos-raw (math-float x)))))
- ((eq (car x) 'sdev)
- (math-make-sdev (calcFunc-arccos (nth 1 x))
- (math-from-radians
- (math-div (nth 2 x)
- (math-sqrt
- (math-sub 1 (math-sqr (nth 1 x))))))))
- ((eq (car x) 'intv)
- (math-sort-intv (nth 1 x)
- (calcFunc-arccos (nth 2 x))
- (calcFunc-arccos (nth 3 x))))
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-arccos x))))
-
-(defun calcFunc-arctan (x) ; [N N] [Public]
- (cond ((eq x 0) 0)
- ((and (eq x 1) (eq calc-angle-mode 'deg)) 45)
- ((and (eq x -1) (eq calc-angle-mode 'deg)) -45)
- ((Math-numberp x)
- (math-with-extra-prec 2
- (math-from-radians (math-arctan-raw (math-float x)))))
- ((eq (car x) 'sdev)
- (math-make-sdev (calcFunc-arctan (nth 1 x))
- (math-from-radians
- (math-div (nth 2 x)
- (math-add 1 (math-sqr (nth 1 x)))))))
- ((eq (car x) 'intv)
- (math-sort-intv (nth 1 x)
- (calcFunc-arctan (nth 2 x))
- (calcFunc-arctan (nth 3 x))))
- ((equal x '(var inf var-inf))
- (math-quarter-circle t))
- ((equal x '(neg (var inf var-inf)))
- (math-neg (math-quarter-circle t)))
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-arctan x))))
-
-(defun math-arcsin-raw (x) ; [N N]
- (let ((a (math-sqrt-raw (math-sub '(float 1 0) (math-sqr x)))))
- (if (or (memq (car x) '(cplx polar))
- (memq (car a) '(cplx polar)))
- (math-with-extra-prec 2 ; use extra precision for difficult case
- (math-mul '(cplx 0 -1)
- (math-ln-raw (math-add (math-mul '(cplx 0 1) x) a))))
- (math-arctan2-raw x a))))
-
-(defun math-arccos-raw (x) ; [N N]
- (math-sub (math-pi-over-2) (math-arcsin-raw x)))
-
-(defun math-arctan-raw (x) ; [N N]
- (cond ((memq (car x) '(cplx polar))
- (math-with-extra-prec 2 ; extra-extra
- (math-div (math-sub
- (math-ln-raw (math-add 1 (math-mul '(cplx 0 1) x)))
- (math-ln-raw (math-add 1 (math-mul '(cplx 0 -1) x))))
- '(cplx 0 2))))
- ((Math-integer-negp (nth 1 x))
- (math-neg-float (math-arctan-raw (math-neg-float x))))
- ((math-zerop x) x)
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((math-equal-int x 1) (math-pi-over-4))
- ((math-equal-int x -1) (math-neg (math-pi-over-4)))
- ((math-lessp-float '(float 414214 -6) x) ; if x > sqrt(2) - 1, reduce
- (if (math-lessp-float '(float 1 0) x)
- (math-sub-float (math-mul-float (math-pi) '(float 5 -1))
- (math-arctan-raw (math-div-float '(float 1 0) x)))
- (math-sub-float (math-mul-float (math-pi) '(float 25 -2))
- (math-arctan-raw (math-div-float
- (math-sub-float '(float 1 0) x)
- (math-add-float '(float 1 0)
- x))))))
- (t (math-arctan-series x 3 x (math-neg-float (math-sqr-float x))))))
-
-(defun math-arctan-series (sum n x xnegsqr)
- (math-working "arctan" sum)
- (let* ((nextx (math-mul-float x xnegsqr))
- (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
- (if (math-nearly-equal-float sum nextsum)
- sum
- (math-arctan-series nextsum (+ n 2) nextx xnegsqr))))
-
-(defun calcFunc-arctan2 (y x) ; [F R R] [Public]
- (if (Math-anglep y)
- (if (Math-anglep x)
- (math-with-extra-prec 2
- (math-from-radians (math-arctan2-raw (math-float y)
- (math-float x))))
- (calc-record-why 'anglep x)
- (list 'calcFunc-arctan2 y x))
- (if (and (or (math-infinitep x) (math-anglep x))
- (or (math-infinitep y) (math-anglep y)))
- (progn
- (if (math-posp x)
- (setq x 1)
- (if (math-negp x)
- (setq x -1)
- (or (math-zerop x)
- (setq x nil))))
- (if (math-posp y)
- (setq y 1)
- (if (math-negp y)
- (setq y -1)
- (or (math-zerop y)
- (setq y nil))))
- (if (and y x)
- (calcFunc-arctan2 y x)
- '(var nan var-nan)))
- (calc-record-why 'anglep y)
- (list 'calcFunc-arctan2 y x))))
-
-(defun math-arctan2-raw (y x) ; [F R R]
- (cond ((math-zerop y)
- (if (math-negp x) (math-pi)
- (if (or (math-floatp x) (math-floatp y)) '(float 0 0) 0)))
- ((math-zerop x)
- (if (math-posp y)
- (math-pi-over-2)
- (math-neg (math-pi-over-2))))
- ((math-posp x)
- (math-arctan-raw (math-div-float y x)))
- ((math-posp y)
- (math-add-float (math-arctan-raw (math-div-float y x))
- (math-pi)))
- (t
- (math-sub-float (math-arctan-raw (math-div-float y x))
- (math-pi)))))
-
-(defun calcFunc-arcsincos (x) ; [V N] [Public]
- (if (and (Math-vectorp x)
- (= (length x) 3))
- (calcFunc-arctan2 (nth 2 x) (nth 1 x))
- (math-reject-arg x "*Two-element vector expected")))
-
-
-
-;;; Exponential function.
-
-(defun calcFunc-exp (x) ; [N N] [Public]
- (cond ((eq x 0) 1)
- ((and (memq x '(1 -1)) calc-symbolic-mode)
- (if (eq x 1) '(var e var-e) (math-div 1 '(var e var-e))))
- ((Math-numberp x)
- (math-with-extra-prec 2 (math-exp-raw (math-float x))))
- ((eq (car-safe x) 'sdev)
- (let ((ex (calcFunc-exp (nth 1 x))))
- (math-make-sdev ex (math-mul (nth 2 x) ex))))
- ((eq (car-safe x) 'intv)
- (math-make-intv (nth 1 x) (calcFunc-exp (nth 2 x))
- (calcFunc-exp (nth 3 x))))
- ((equal x '(var inf var-inf))
- x)
- ((equal x '(neg (var inf var-inf)))
- 0)
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-exp x))))
-
-(defun calcFunc-expm1 (x) ; [N N] [Public]
- (cond ((eq x 0) 0)
- ((math-zerop x) '(float 0 0))
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((Math-numberp x)
- (math-with-extra-prec 2
- (let ((x (math-float x)))
- (if (and (eq (car x) 'float)
- (math-lessp-float x '(float 1 0))
- (math-lessp-float '(float -1 0) x))
- (math-exp-minus-1-raw x)
- (math-add (math-exp-raw x) -1)))))
- ((eq (car-safe x) 'sdev)
- (if (math-constp x)
- (let ((ex (calcFunc-expm1 (nth 1 x))))
- (math-make-sdev ex (math-mul (nth 2 x) (math-add ex 1))))
- (math-make-sdev (calcFunc-expm1 (nth 1 x))
- (math-mul (nth 2 x) (calcFunc-exp (nth 1 x))))))
- ((eq (car-safe x) 'intv)
- (math-make-intv (nth 1 x)
- (calcFunc-expm1 (nth 2 x))
- (calcFunc-expm1 (nth 3 x))))
- ((equal x '(var inf var-inf))
- x)
- ((equal x '(neg (var inf var-inf)))
- -1)
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-expm1 x))))
-
-(defun calcFunc-exp10 (x) ; [N N] [Public]
- (if (eq x 0)
- 1
- (math-pow '(float 1 1) x)))
-
-(defun math-exp-raw (x) ; [N N]
- (cond ((math-zerop x) '(float 1 0))
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((eq (car x) 'cplx)
- (let ((expx (math-exp-raw (nth 1 x)))
- (sc (math-sin-cos-raw (nth 2 x))))
- (list 'cplx
- (math-mul-float expx (cdr sc))
- (math-mul-float expx (car sc)))))
- ((eq (car x) 'polar)
- (let ((xc (math-complex x)))
- (list 'polar
- (math-exp-raw (nth 1 xc))
- (math-from-radians (nth 2 xc)))))
- ((or (math-lessp-float '(float 5 -1) x)
- (math-lessp-float x '(float -5 -1)))
- (if (math-lessp-float '(float 921035 1) x)
- (math-overflow)
- (if (math-lessp-float x '(float -921035 1))
- (math-underflow)))
- (let* ((two-x (math-mul-float x '(float 2 0)))
- (hint (math-scale-int (nth 1 two-x) (nth 2 two-x)))
- (hfrac (math-sub-float x (math-mul-float (math-float hint)
- '(float 5 -1)))))
- (math-mul-float (math-ipow (math-sqrt-e) hint)
- (math-add-float '(float 1 0)
- (math-exp-minus-1-raw hfrac)))))
- (t (math-add-float '(float 1 0) (math-exp-minus-1-raw x)))))
-
-(defun math-exp-minus-1-raw (x) ; [F F]
- (math-exp-series x 2 3 x x))
-
-(defun math-exp-series (sum nfac n xpow x)
- (math-working "exp" sum)
- (let* ((nextx (math-mul-float xpow x))
- (nextsum (math-add-float sum (math-div-float nextx
- (math-float nfac)))))
- (if (math-nearly-equal-float sum nextsum)
- sum
- (math-exp-series nextsum (math-mul nfac n) (1+ n) nextx x))))
-
-
-
-;;; Logarithms.
-
-(defun calcFunc-ln (x) ; [N N] [Public]
- (cond ((math-zerop x)
- (if calc-infinite-mode
- '(neg (var inf var-inf))
- (math-reject-arg x "*Logarithm of zero")))
- ((eq x 1) 0)
- ((Math-numberp x)
- (math-with-extra-prec 2 (math-ln-raw (math-float x))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-ln (nth 1 x))
- (math-div (nth 2 x) (nth 1 x))))
- ((and (eq (car-safe x) 'intv) (or (Math-posp (nth 2 x))
- (Math-zerop (nth 2 x))
- (not (math-intv-constp x))))
- (let ((calc-infinite-mode t))
- (math-make-intv (nth 1 x) (calcFunc-ln (nth 2 x))
- (calcFunc-ln (nth 3 x)))))
- ((equal x '(var e var-e))
- 1)
- ((and (eq (car-safe x) '^)
- (equal (nth 1 x) '(var e var-e))
- (math-known-realp (nth 2 x)))
- (nth 2 x))
- ((math-infinitep x)
- (if (equal x '(var nan var-nan))
- x
- '(var inf var-inf)))
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-ln x))))
-
-(defun calcFunc-log10 (x) ; [N N] [Public]
- (cond ((math-equal-int x 1)
- (if (math-floatp x) '(float 0 0) 0))
- ((and (Math-integerp x)
- (math-posp x)
- (let ((res (math-integer-log x 10)))
- (and (car res)
- (setq x (cdr res)))))
- x)
- ((and (eq (car-safe x) 'frac)
- (eq (nth 1 x) 1)
- (let ((res (math-integer-log (nth 2 x) 10)))
- (and (car res)
- (setq x (- (cdr res))))))
- x)
- ((math-zerop x)
- (if calc-infinite-mode
- '(neg (var inf var-inf))
- (math-reject-arg x "*Logarithm of zero")))
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((Math-numberp x)
- (math-with-extra-prec 2
- (let ((xf (math-float x)))
- (if (eq (nth 1 xf) 0)
- (math-reject-arg x "*Logarithm of zero"))
- (if (Math-integer-posp (nth 1 xf))
- (if (eq (nth 1 xf) 1) ; log10(1*10^n) = n
- (math-float (nth 2 xf))
- (let ((xdigs (1- (math-numdigs (nth 1 xf)))))
- (math-add-float
- (math-div-float (math-ln-raw-2
- (list 'float (nth 1 xf) (- xdigs)))
- (math-ln-10))
- (math-float (+ (nth 2 xf) xdigs)))))
- (math-div (calcFunc-ln xf) (math-ln-10))))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-log10 (nth 1 x))
- (math-div (nth 2 x)
- (math-mul (nth 1 x) (math-ln-10)))))
- ((and (eq (car-safe x) 'intv) (or (Math-posp (nth 2 x))
- (not (math-intv-constp x))))
- (math-make-intv (nth 1 x)
- (calcFunc-log10 (nth 2 x))
- (calcFunc-log10 (nth 3 x))))
- ((math-infinitep x)
- (if (equal x '(var nan var-nan))
- x
- '(var inf var-inf)))
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-log10 x))))
-
-(defun calcFunc-log (x &optional b) ; [N N N] [Public]
- (cond ((or (null b) (equal b '(var e var-e)))
- (math-normalize (list 'calcFunc-ln x)))
- ((or (eq b 10) (equal b '(float 1 1)))
- (math-normalize (list 'calcFunc-log10 x)))
- ((math-zerop x)
- (if calc-infinite-mode
- (math-div (calcFunc-ln x) (calcFunc-ln b))
- (math-reject-arg x "*Logarithm of zero")))
- ((math-zerop b)
- (if calc-infinite-mode
- (math-div (calcFunc-ln x) (calcFunc-ln b))
- (math-reject-arg b "*Logarithm of zero")))
- ((math-equal-int b 1)
- (if calc-infinite-mode
- (math-div (calcFunc-ln x) 0)
- (math-reject-arg b "*Logarithm base one")))
- ((math-equal-int x 1)
- (if (or (math-floatp a) (math-floatp b)) '(float 0 0) 0))
- ((and (Math-ratp x) (Math-ratp b)
- (math-posp x) (math-posp b)
- (let* ((sign 1) (inv nil)
- (xx (if (Math-lessp 1 x)
- x
- (setq sign -1)
- (math-div 1 x)))
- (bb (if (Math-lessp 1 b)
- b
- (setq sign (- sign))
- (math-div 1 b)))
- (res (if (Math-lessp xx bb)
- (setq inv (math-integer-log bb xx))
- (math-integer-log xx bb))))
- (and (car res)
- (setq x (if inv
- (math-div 1 (* sign (cdr res)))
- (* sign (cdr res)))))))
- x)
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((and (Math-numberp x) (Math-numberp b))
- (math-with-extra-prec 2
- (math-div (math-ln-raw (math-float x))
- (math-log-base-raw b))))
- ((and (eq (car-safe x) 'sdev)
- (Math-numberp b))
- (math-make-sdev (calcFunc-log (nth 1 x) b)
- (math-div (nth 2 x)
- (math-mul (nth 1 x)
- (math-log-base-raw b)))))
- ((and (eq (car-safe x) 'intv) (or (Math-posp (nth 2 x))
- (not (math-intv-constp x)))
- (math-realp b))
- (math-make-intv (nth 1 x)
- (calcFunc-log (nth 2 x) b)
- (calcFunc-log (nth 3 x) b)))
- ((or (eq (car-safe x) 'intv) (eq (car-safe b) 'intv))
- (math-div (calcFunc-ln x) (calcFunc-ln b)))
- ((or (math-infinitep x)
- (math-infinitep b))
- (math-div (calcFunc-ln x) (calcFunc-ln b)))
- (t (if (Math-numberp b)
- (calc-record-why 'numberp x)
- (calc-record-why 'numberp b))
- (list 'calcFunc-log x b))))
-
-(defun calcFunc-alog (x &optional b)
- (cond ((or (null b) (equal b '(var e var-e)))
- (math-normalize (list 'calcFunc-exp x)))
- (t (math-pow b x))))
-
-(defun calcFunc-ilog (x b)
- (if (and (math-natnump x) (not (eq x 0))
- (math-natnump b) (not (eq b 0)))
- (if (eq b 1)
- (math-reject-arg x "*Logarithm base one")
- (if (Math-natnum-lessp x b)
- 0
- (cdr (math-integer-log x b))))
- (math-floor (calcFunc-log x b))))
-
-(defun math-integer-log (x b)
- (let ((pows (list b))
- (pow (math-sqr b))
- next
- sum n)
- (while (not (Math-lessp x pow))
- (setq pows (cons pow pows)
- pow (math-sqr pow)))
- (setq n (lsh 1 (1- (length pows)))
- sum n
- pow (car pows))
- (while (and (setq pows (cdr pows))
- (Math-lessp pow x))
- (setq n (/ n 2)
- next (math-mul pow (car pows)))
- (or (Math-lessp x next)
- (setq pow next
- sum (+ sum n))))
- (cons (equal pow x) sum)))
-
-
-(defvar math-log-base-cache nil)
-(defun math-log-base-raw (b) ; [N N]
- (if (not (and (equal (car math-log-base-cache) b)
- (eq (nth 1 math-log-base-cache) calc-internal-prec)))
- (setq math-log-base-cache (list b calc-internal-prec
- (math-ln-raw (math-float b)))))
- (nth 2 math-log-base-cache))
-
-(defun calcFunc-lnp1 (x) ; [N N] [Public]
- (cond ((Math-equal-int x -1)
- (if calc-infinite-mode
- '(neg (var inf var-inf))
- (math-reject-arg x "*Logarithm of zero")))
- ((eq x 0) 0)
- ((math-zerop x) '(float 0 0))
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((Math-numberp x)
- (math-with-extra-prec 2
- (let ((x (math-float x)))
- (if (and (eq (car x) 'float)
- (math-lessp-float x '(float 5 -1))
- (math-lessp-float '(float -5 -1) x))
- (math-ln-plus-1-raw x)
- (math-ln-raw (math-add-float x '(float 1 0)))))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-lnp1 (nth 1 x))
- (math-div (nth 2 x) (math-add (nth 1 x) 1))))
- ((and (eq (car-safe x) 'intv) (or (Math-posp (nth 2 x))
- (not (math-intv-constp x))))
- (math-make-intv (nth 1 x)
- (calcFunc-lnp1 (nth 2 x))
- (calcFunc-lnp1 (nth 3 x))))
- ((math-infinitep x)
- (if (equal x '(var nan var-nan))
- x
- '(var inf var-inf)))
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-lnp1 x))))
-
-(defun math-ln-raw (x) ; [N N] --- must be float format!
- (cond ((eq (car-safe x) 'cplx)
- (list 'cplx
- (math-mul-float (math-ln-raw
- (math-add-float (math-sqr-float (nth 1 x))
- (math-sqr-float (nth 2 x))))
- '(float 5 -1))
- (math-arctan2-raw (nth 2 x) (nth 1 x))))
- ((eq (car x) 'polar)
- (math-polar (list 'cplx
- (math-ln-raw (nth 1 x))
- (math-to-radians (nth 2 x)))))
- ((Math-equal-int x 1)
- '(float 0 0))
- (calc-symbolic-mode (signal 'inexact-result nil))
- ((math-posp (nth 1 x)) ; positive and real
- (let ((xdigs (1- (math-numdigs (nth 1 x)))))
- (math-add-float (math-ln-raw-2 (list 'float (nth 1 x) (- xdigs)))
- (math-mul-float (math-float (+ (nth 2 x) xdigs))
- (math-ln-10)))))
- ((math-zerop x)
- (math-reject-arg x "*Logarithm of zero"))
- ((eq calc-complex-mode 'polar) ; negative and real
- (math-polar
- (list 'cplx ; negative and real
- (math-ln-raw (math-neg-float x))
- (math-pi))))
- (t (list 'cplx ; negative and real
- (math-ln-raw (math-neg-float x))
- (math-pi)))))
-
-(defun math-ln-raw-2 (x) ; [F F]
- (cond ((math-lessp-float '(float 14 -1) x)
- (math-add-float (math-ln-raw-2 (math-mul-float x '(float 5 -1)))
- (math-ln-2)))
- (t ; now .7 < x <= 1.4
- (math-ln-raw-3 (math-div-float (math-sub-float x '(float 1 0))
- (math-add-float x '(float 1 0)))))))
-
-(defun math-ln-raw-3 (x) ; [F F]
- (math-mul-float (math-ln-raw-series x 3 x (math-sqr-float x))
- '(float 2 0)))
-
-;;; Compute ln((1+x)/(1-x))
-(defun math-ln-raw-series (sum n x xsqr)
- (math-working "log" sum)
- (let* ((nextx (math-mul-float x xsqr))
- (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
- (if (math-nearly-equal-float sum nextsum)
- sum
- (math-ln-raw-series nextsum (+ n 2) nextx xsqr))))
-
-(defun math-ln-plus-1-raw (x)
- (math-lnp1-series x 2 x (math-neg x)))
-
-(defun math-lnp1-series (sum n xpow x)
- (math-working "lnp1" sum)
- (let* ((nextx (math-mul-float xpow x))
- (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
- (if (math-nearly-equal-float sum nextsum)
- sum
- (math-lnp1-series nextsum (1+ n) nextx x))))
-
-(math-defcache math-ln-10 (float (bigpos 018 684 045 994 092 585 302 2) -21)
- (math-ln-raw-2 '(float 1 1)))
-
-(math-defcache math-ln-2 (float (bigpos 417 309 945 559 180 147 693) -21)
- (math-ln-raw-3 (math-float '(frac 1 3))))
-
-
-
-;;; Hyperbolic functions.
-
-(defun calcFunc-sinh (x) ; [N N] [Public]
- (cond ((eq x 0) 0)
- (math-expand-formulas
- (math-normalize
- (list '/ (list '- (list 'calcFunc-exp x)
- (list 'calcFunc-exp (list 'neg x))) 2)))
- ((Math-numberp x)
- (if calc-symbolic-mode (signal 'inexact-result nil))
- (math-with-extra-prec 2
- (let ((expx (math-exp-raw (math-float x))))
- (math-mul (math-add expx (math-div -1 expx)) '(float 5 -1)))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-sinh (nth 1 x))
- (math-mul (nth 2 x) (calcFunc-cosh (nth 1 x)))))
- ((eq (car x) 'intv)
- (math-sort-intv (nth 1 x)
- (calcFunc-sinh (nth 2 x))
- (calcFunc-sinh (nth 3 x))))
- ((or (equal x '(var inf var-inf))
- (equal x '(neg (var inf var-inf)))
- (equal x '(var nan var-nan)))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-sinh x))))
-(put 'calcFunc-sinh 'math-expandable t)
-
-(defun calcFunc-cosh (x) ; [N N] [Public]
- (cond ((eq x 0) 1)
- (math-expand-formulas
- (math-normalize
- (list '/ (list '+ (list 'calcFunc-exp x)
- (list 'calcFunc-exp (list 'neg x))) 2)))
- ((Math-numberp x)
- (if calc-symbolic-mode (signal 'inexact-result nil))
- (math-with-extra-prec 2
- (let ((expx (math-exp-raw (math-float x))))
- (math-mul (math-add expx (math-div 1 expx)) '(float 5 -1)))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-cosh (nth 1 x))
- (math-mul (nth 2 x)
- (calcFunc-sinh (nth 1 x)))))
- ((and (eq (car x) 'intv) (math-intv-constp x))
- (setq x (math-abs x))
- (math-sort-intv (nth 1 x)
- (calcFunc-cosh (nth 2 x))
- (calcFunc-cosh (nth 3 x))))
- ((or (equal x '(var inf var-inf))
- (equal x '(neg (var inf var-inf)))
- (equal x '(var nan var-nan)))
- (math-abs x))
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-cosh x))))
-(put 'calcFunc-cosh 'math-expandable t)
-
-(defun calcFunc-tanh (x) ; [N N] [Public]
- (cond ((eq x 0) 0)
- (math-expand-formulas
- (math-normalize
- (let ((expx (list 'calcFunc-exp x))
- (expmx (list 'calcFunc-exp (list 'neg x))))
- (math-normalize
- (list '/ (list '- expx expmx) (list '+ expx expmx))))))
- ((Math-numberp x)
- (if calc-symbolic-mode (signal 'inexact-result nil))
- (math-with-extra-prec 2
- (let* ((expx (calcFunc-exp (math-float x)))
- (expmx (math-div 1 expx)))
- (math-div (math-sub expx expmx)
- (math-add expx expmx)))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-tanh (nth 1 x))
- (math-div (nth 2 x)
- (math-sqr (calcFunc-cosh (nth 1 x))))))
- ((eq (car x) 'intv)
- (math-sort-intv (nth 1 x)
- (calcFunc-tanh (nth 2 x))
- (calcFunc-tanh (nth 3 x))))
- ((equal x '(var inf var-inf))
- 1)
- ((equal x '(neg (var inf var-inf)))
- -1)
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-tanh x))))
-(put 'calcFunc-tanh 'math-expandable t)
-
-(defun calcFunc-arcsinh (x) ; [N N] [Public]
- (cond ((eq x 0) 0)
- (math-expand-formulas
- (math-normalize
- (list 'calcFunc-ln (list '+ x (list 'calcFunc-sqrt
- (list '+ (list '^ x 2) 1))))))
- ((Math-numberp x)
- (if calc-symbolic-mode (signal 'inexact-result nil))
- (math-with-extra-prec 2
- (math-ln-raw (math-add x (math-sqrt-raw (math-add (math-sqr x)
- '(float 1 0)))))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-arcsinh (nth 1 x))
- (math-div (nth 2 x)
- (math-sqrt
- (math-add (math-sqr (nth 1 x)) 1)))))
- ((eq (car x) 'intv)
- (math-sort-intv (nth 1 x)
- (calcFunc-arcsinh (nth 2 x))
- (calcFunc-arcsinh (nth 3 x))))
- ((or (equal x '(var inf var-inf))
- (equal x '(neg (var inf var-inf)))
- (equal x '(var nan var-nan)))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-arcsinh x))))
-(put 'calcFunc-arcsinh 'math-expandable t)
-
-(defun calcFunc-arccosh (x) ; [N N] [Public]
- (cond ((eq x 1) 0)
- ((and (eq x -1) calc-symbolic-mode)
- '(var pi var-pi))
- ((and (eq x 0) calc-symbolic-mode)
- (math-div (math-mul '(var pi var-pi) '(var i var-i)) 2))
- (math-expand-formulas
- (math-normalize
- (list 'calcFunc-ln (list '+ x (list 'calcFunc-sqrt
- (list '- (list '^ x 2) 1))))))
- ((Math-numberp x)
- (if calc-symbolic-mode (signal 'inexact-result nil))
- (if (Math-equal-int x -1)
- (math-imaginary (math-pi))
- (math-with-extra-prec 2
- (if (or t ; need to do this even in the real case!
- (memq (car-safe x) '(cplx polar)))
- (let ((xp1 (math-add 1 x))) ; this gets the branch cuts right
- (math-ln-raw
- (math-add x (math-mul xp1
- (math-sqrt-raw
- (math-div (math-sub
- x
- '(float 1 0))
- xp1))))))
- (math-ln-raw
- (math-add x (math-sqrt-raw (math-add (math-sqr x)
- '(float -1 0)))))))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-arccosh (nth 1 x))
- (math-div (nth 2 x)
- (math-sqrt
- (math-add (math-sqr (nth 1 x)) -1)))))
- ((eq (car x) 'intv)
- (math-sort-intv (nth 1 x)
- (calcFunc-arccosh (nth 2 x))
- (calcFunc-arccosh (nth 3 x))))
- ((or (equal x '(var inf var-inf))
- (equal x '(neg (var inf var-inf)))
- (equal x '(var nan var-nan)))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-arccosh x))))
-(put 'calcFunc-arccosh 'math-expandable t)
-
-(defun calcFunc-arctanh (x) ; [N N] [Public]
- (cond ((eq x 0) 0)
- ((and (Math-equal-int x 1) calc-infinite-mode)
- '(var inf var-inf))
- ((and (Math-equal-int x -1) calc-infinite-mode)
- '(neg (var inf var-inf)))
- (math-expand-formulas
- (list '/ (list '-
- (list 'calcFunc-ln (list '+ 1 x))
- (list 'calcFunc-ln (list '- 1 x))) 2))
- ((Math-numberp x)
- (if calc-symbolic-mode (signal 'inexact-result nil))
- (math-with-extra-prec 2
- (if (or (memq (car-safe x) '(cplx polar))
- (Math-lessp 1 x))
- (math-mul (math-sub (math-ln-raw (math-add '(float 1 0) x))
- (math-ln-raw (math-sub '(float 1 0) x)))
- '(float 5 -1))
- (if (and (math-equal-int x 1) calc-infinite-mode)
- '(var inf var-inf)
- (if (and (math-equal-int x -1) calc-infinite-mode)
- '(neg (var inf var-inf))
- (math-mul (math-ln-raw (math-div (math-add '(float 1 0) x)
- (math-sub 1 x)))
- '(float 5 -1)))))))
- ((eq (car-safe x) 'sdev)
- (math-make-sdev (calcFunc-arctanh (nth 1 x))
- (math-div (nth 2 x)
- (math-sub 1 (math-sqr (nth 1 x))))))
- ((eq (car x) 'intv)
- (math-sort-intv (nth 1 x)
- (calcFunc-arctanh (nth 2 x))
- (calcFunc-arctanh (nth 3 x))))
- ((equal x '(var nan var-nan))
- x)
- (t (calc-record-why 'numberp x)
- (list 'calcFunc-arctanh x))))
-(put 'calcFunc-arctanh 'math-expandable t)
-
-
-;;; Convert A from HMS or degrees to radians.
-(defun calcFunc-rad (a) ; [R R] [Public]
- (cond ((or (Math-numberp a)
- (eq (car a) 'intv))
- (math-with-extra-prec 2
- (math-mul a (math-pi-over-180))))
- ((eq (car a) 'hms)
- (math-from-hms a 'rad))
- ((eq (car a) 'sdev)
- (math-make-sdev (calcFunc-rad (nth 1 a))
- (calcFunc-rad (nth 2 a))))
- (math-expand-formulas
- (math-div (math-mul a '(var pi var-pi)) 180))
- ((math-infinitep a) a)
- (t (list 'calcFunc-rad a))))
-(put 'calcFunc-rad 'math-expandable t)
-
-;;; Convert A from HMS or radians to degrees.
-(defun calcFunc-deg (a) ; [R R] [Public]
- (cond ((or (Math-numberp a)
- (eq (car a) 'intv))
- (math-with-extra-prec 2
- (math-div a (math-pi-over-180))))
- ((eq (car a) 'hms)
- (math-from-hms a 'deg))
- ((eq (car a) 'sdev)
- (math-make-sdev (calcFunc-deg (nth 1 a))
- (calcFunc-deg (nth 2 a))))
- (math-expand-formulas
- (math-div (math-mul 180 a) '(var pi var-pi)))
- ((math-infinitep a) a)
- (t (list 'calcFunc-deg a))))
-(put 'calcFunc-deg 'math-expandable t)
-
-;;; calc-math.el ends here
+++ /dev/null
-;;; calc-misc.el --- miscellaenous functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc.el.
-(require 'calc)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-misc () nil)
-
-
-(defun calc-dispatch-help (arg)
- "M-# is a prefix key; follow it with one of these letters:
-
-For turning Calc on and off:
- C calc. Start the Calculator in a window at the bottom of the screen.
- O calc-other-window. Start the Calculator but don't select its window.
- B calc-big-or-small. Control whether to use the full Emacs screen for Calc.
- Q quick-calc. Use the Calculator in the minibuffer.
- K calc-keypad. Start the Calculator in keypad mode (X window system only).
- E calc-embedded. Use the Calculator on a formula in this editing buffer.
- J calc-embedded-select. Like E, but select appropriate half of => or :=.
- W calc-embedded-word. Like E, but activate a single word, i.e., a number.
- Z calc-user-invocation. Invoke Calc in the way you defined with `Z I' cmd.
- X calc-quit. Turn Calc off.
-
-For moving data into and out of Calc:
- G calc-grab-region. Grab the region defined by mark and point into Calc.
- R calc-grab-rectangle. Grab the rectangle defined by mark, point into Calc.
- : calc-grab-sum-down. Grab a rectangle and sum the columns.
- _ calc-grab-sum-across. Grab a rectangle and sum the rows.
- Y calc-copy-to-buffer. Copy a value from the stack into the editing buffer.
-
-For use with Embedded mode:
- A calc-embedded-activate. Find and activate all :='s and =>'s in buffer.
- D calc-embedded-duplicate. Make a copy of this formula and select it.
- F calc-embedded-new-formula. Insert a new formula at current point.
- N calc-embedded-next. Advance cursor to next known formula in buffer.
- P calc-embedded-previous. Advance cursor to previous known formula.
- U calc-embedded-update-formula. Re-evaluate formula at point.
- ` calc-embedded-edit. Use calc-edit to edit formula at point.
-
-Documentation:
- I calc-info. Read the Calculator manual in the Emacs Info system.
- T calc-tutorial. Run the Calculator Tutorial using the Emacs Info system.
- S calc-summary. Read the Summary from the Calculator manual in Info.
-
-Miscellaneous:
- L calc-load-everything. Load all parts of the Calculator into memory.
- M read-kbd-macro. Read a region of keystroke names as a keyboard macro.
- 0 (zero) calc-reset. Reset Calc stack and modes to default state.
-
-Press twice (`M-# M-#' or `M-# #') to turn Calc on or off using the same
-Calc user interface as before (either M-# C or M-# K; initially M-# C)."
- (interactive "P")
- (calc-check-defines)
- (if calc-dispatch-help
- (progn
- (save-window-excursion
- (describe-function 'calc-dispatch-help)
- (let ((win (get-buffer-window "*Help*")))
- (if win
- (let (key)
- (select-window win)
- (while (progn
- (message "Calc options: Calc, Keypad, ... %s"
- "press SPC, DEL to scroll, C-g to cancel")
- (memq (car (setq key (calc-read-key t)))
- '(? ?\C-h ?\C-? ?\C-v ?\M-v)))
- (condition-case err
- (if (memq (car key) '(? ?\C-v))
- (scroll-up)
- (scroll-down))
- (error (beep))))
- (calc-unread-command (cdr key))))))
- (calc-do-dispatch nil))
- (let ((calc-dispatch-help t))
- (calc-do-dispatch arg))))
-
-
-(defun calc-big-or-small (arg)
- "Toggle Calc between full-screen and regular mode."
- (interactive "P")
- (let ((cwin (get-buffer-window "*Calculator*"))
- (twin (get-buffer-window "*Calc Trail*"))
- (kwin (get-buffer-window "*Calc Keypad*")))
- (if cwin
- (setq calc-full-mode
- (if kwin
- (and twin (eq (window-width twin) (frame-width)))
- (eq (window-height cwin) (1- (frame-height))))))
- (setq calc-full-mode (if arg
- (> (prefix-numeric-value arg) 0)
- (not calc-full-mode)))
- (if kwin
- (progn
- (calc-quit)
- (calc-do-keypad calc-full-mode nil))
- (if cwin
- (progn
- (calc-quit)
- (calc nil calc-full-mode nil))))
- (message (if calc-full-mode
- "Now using full screen for Calc"
- "Now using partial screen for Calc"))))
-
-(defun calc-other-window ()
- "Invoke the Calculator in another window."
- (interactive)
- (if (memq major-mode '(calc-mode calc-trail-mode))
- (progn
- (other-window 1)
- (if (memq major-mode '(calc-mode calc-trail-mode))
- (other-window 1)))
- (if (get-buffer-window "*Calculator*")
- (calc-quit)
- (let ((win (selected-window)))
- (calc nil win (interactive-p))))))
-
-(defun another-calc ()
- "Create another, independent Calculator buffer."
- (interactive)
- (if (eq major-mode 'calc-mode)
- (mapcar (function
- (lambda (v)
- (set-default v (symbol-value v)))) calc-local-var-list))
- (set-buffer (generate-new-buffer "*Calculator*"))
- (pop-to-buffer (current-buffer))
- (calc-mode))
-
-(defun calc-info ()
- "Run the Emacs Info system on the Calculator documentation."
- (interactive)
- (select-window (get-largest-window))
- (info "Calc"))
-
-(defun calc-tutorial ()
- "Run the Emacs Info system on the Calculator Tutorial."
- (interactive)
- (if (get-buffer-window "*Calculator*")
- (calc-quit))
- (calc-info)
- (Info-goto-node "Interactive Tutorial")
- (calc-other-window)
- (message "Welcome to the Calc Tutorial!"))
-
-(defun calc-info-summary ()
- "Run the Emacs Info system on the Calculator Summary."
- (interactive)
- (calc-info)
- (Info-goto-node "Summary"))
-
-(defun calc-help ()
- (interactive)
- (let ((msgs (append
- '("Press `h' for complete help; press `?' repeatedly for a summary"
- "Letter keys: Negate; Precision; Yank; Why; Xtended cmd; Quit"
- "Letter keys: SHIFT + Undo, reDo; Keep-args; Inverse, Hyperbolic"
- "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB"
- "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi"
- "Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro"
- "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
- "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
- "Other keys: ' (alg-entry), = (eval), ` (edit); M-RET (last-args)"
- "Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)"
- "Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)"
- "Other keys: TAB (swap/roll-dn), M-TAB (roll-up)"
- "Other keys: [ , ; ] (vector), ( , ) (complex), ( ; ) (polar)"
- "Prefix keys: Algebra, Binary/business, Convert, Display"
- "Prefix keys: Functions, Graphics, Help, J (select)"
- "Prefix keys: Kombinatorics/statistics, Modes, Store/recall"
- "Prefix keys: Trail/time, Units/statistics, Vector/matrix"
- "Prefix keys: Z (user), SHIFT + Z (define)"
- "Prefix keys: prefix + ? gives further help for that prefix")
- (list (format
- " Calc %s by Dave Gillespie, daveg@synaptics.com"
- calc-version)))))
- (if calc-full-help-flag
- msgs
- (if (or calc-inverse-flag calc-hyperbolic-flag)
- (if calc-inverse-flag
- (if calc-hyperbolic-flag
- (calc-inv-hyp-prefix-help)
- (calc-inverse-prefix-help))
- (calc-hyperbolic-prefix-help))
- (setq calc-help-phase
- (if (eq this-command last-command)
- (% (1+ calc-help-phase) (1+ (length msgs)))
- 0))
- (let ((msg (nth calc-help-phase msgs)))
- (message "%s" (if msg
- (concat msg ":"
- (make-string (- (apply 'max
- (mapcar 'length
- msgs))
- (length msg)) 32)
- " [?=MORE]")
- "")))))))
-
-
-
-
-;;;; Stack and buffer management.
-
-
-(defun calc-do-handle-whys ()
- (setq calc-why (sort calc-next-why
- (function
- (lambda (x y)
- (and (eq (car x) '*) (not (eq (car y) '*))))))
- calc-next-why nil)
- (if (and calc-why (or (eq calc-auto-why t)
- (and (eq (car (car calc-why)) '*)
- calc-auto-why)))
- (progn
- (calc-extensions)
- (calc-explain-why (car calc-why)
- (if (eq calc-auto-why t)
- (cdr calc-why)
- (if calc-auto-why
- (eq (car (nth 1 calc-why)) '*))))
- (setq calc-last-why-command this-command)
- (calc-clear-command-flag 'clear-message))))
-
-(defun calc-record-why (&rest stuff)
- (if (eq (car stuff) 'quiet)
- (setq stuff (cdr stuff))
- (if (and (symbolp (car stuff))
- (cdr stuff)
- (or (Math-objectp (nth 1 stuff))
- (and (Math-vectorp (nth 1 stuff))
- (math-constp (nth 1 stuff)))
- (math-infinitep (nth 1 stuff))))
- (setq stuff (cons '* stuff))
- (if (and (stringp (car stuff))
- (string-match "\\`\\*" (car stuff)))
- (setq stuff (cons '* (cons (substring (car stuff) 1)
- (cdr stuff)))))))
- (setq calc-next-why (cons stuff calc-next-why))
- nil)
-
-;;; True if A is a constant or vector of constants. [P x] [Public]
-(defun math-constp (a)
- (or (Math-scalarp a)
- (and (memq (car a) '(sdev intv mod vec))
- (progn
- (while (and (setq a (cdr a))
- (or (Math-scalarp (car a)) ; optimization
- (math-constp (car a)))))
- (null a)))))
-
-
-(defun calc-roll-down-stack (n &optional m)
- (if (< n 0)
- (calc-roll-up-stack (- n) m)
- (if (or (= n 0) (> n (calc-stack-size))) (setq n (calc-stack-size)))
- (or m (setq m 1))
- (and (> n 1)
- (< m n)
- (if (and calc-any-selections
- (not calc-use-selections))
- (calc-roll-down-with-selections n m)
- (calc-pop-push-list n
- (append (calc-top-list m 1)
- (calc-top-list (- n m) (1+ m))))))))
-
-(defun calc-roll-up-stack (n &optional m)
- (if (< n 0)
- (calc-roll-down-stack (- n) m)
- (if (or (= n 0) (> n (calc-stack-size))) (setq n (calc-stack-size)))
- (or m (setq m 1))
- (and (> n 1)
- (< m n)
- (if (and calc-any-selections
- (not calc-use-selections))
- (calc-roll-up-with-selections n m)
- (calc-pop-push-list n
- (append (calc-top-list (- n m) 1)
- (calc-top-list m (- n m -1))))))))
-
-
-(defun calc-do-refresh ()
- (if calc-hyperbolic-flag
- (progn
- (setq calc-display-dirty t)
- nil)
- (calc-refresh)
- t))
-
-
-(defun calc-record-list (vals &optional prefix)
- (while vals
- (or (eq (car vals) 'top-of-stack)
- (progn
- (calc-record (car vals) prefix)
- (setq prefix "...")))
- (setq vals (cdr vals))))
-
-
-(defun calc-last-args-stub (arg)
- (interactive "p")
- (calc-extensions)
- (calc-last-args arg))
-
-
-(defun calc-power (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (and calc-extensions-loaded
- (calc-is-inverse))
- (calc-binary-op "root" 'calcFunc-nroot arg nil nil)
- (calc-binary-op "^" 'calcFunc-pow arg nil nil '^))))
-
-(defun calc-mod (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "%" 'calcFunc-mod arg nil nil '%)))
-
-(defun calc-inv (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "inv" 'calcFunc-inv arg)))
-
-(defun calc-percent ()
- (interactive)
- (calc-slow-wrapper
- (calc-pop-push-record-list
- 1 "%" (list (list 'calcFunc-percent (calc-top-n 1))))))
-
-
-(defun calc-over (n)
- (interactive "P")
- (if n
- (calc-enter (- (prefix-numeric-value n)))
- (calc-enter -2)))
-
-
-(defun calc-pop-above (n)
- (interactive "P")
- (if n
- (calc-pop (- (prefix-numeric-value n)))
- (calc-pop -2)))
-
-(defun calc-roll-down (n)
- (interactive "P")
- (calc-wrapper
- (let ((nn (prefix-numeric-value n)))
- (cond ((null n)
- (calc-roll-down-stack 2))
- ((> nn 0)
- (calc-roll-down-stack nn))
- ((= nn 0)
- (calc-pop-push-list (calc-stack-size)
- (reverse
- (calc-top-list (calc-stack-size)))))
- (t
- (calc-roll-down-stack (calc-stack-size) (- nn)))))))
-
-(defun calc-roll-up (n)
- (interactive "P")
- (calc-wrapper
- (let ((nn (prefix-numeric-value n)))
- (cond ((null n)
- (calc-roll-up-stack 3))
- ((> nn 0)
- (calc-roll-up-stack nn))
- ((= nn 0)
- (calc-pop-push-list (calc-stack-size)
- (reverse
- (calc-top-list (calc-stack-size)))))
- (t
- (calc-roll-up-stack (calc-stack-size) (- nn)))))))
-
-
-
-
-;;; Other commands.
-
-(defun calc-num-prefix-name (n)
- (cond ((eq n '-) "- ")
- ((equal n '(4)) "C-u ")
- ((consp n) (format "%d " (car n)))
- ((integerp n) (format "%d " n))
- (t "")))
-
-(defun calc-missing-key (n)
- "This is a placeholder for a command which needs to be loaded from calc-ext.
-When this key is used, calc-ext (the Calculator extensions module) will be
-loaded and the keystroke automatically re-typed."
- (interactive "P")
- (calc-extensions)
- (if (keymapp (key-binding (char-to-string last-command-char)))
- (message "%s%c-" (calc-num-prefix-name n) last-command-char))
- (calc-unread-command)
- (setq prefix-arg n))
-
-(defun calc-shift-Y-prefix-help ()
- (interactive)
- (calc-extensions)
- (calc-do-prefix-help calc-Y-help-msgs "other" ?Y))
-
-
-
-
-(defun calcDigit-letter ()
- (interactive)
- (if (calc-minibuffer-contains "[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#.*")
- (progn
- (setq last-command-char (upcase last-command-char))
- (calcDigit-key))
- (calcDigit-nondigit)))
-
-
-;; A Lisp version of temp_minibuffer_message from minibuf.c.
-(defun calc-temp-minibuffer-message (m)
- (let ((savemax (point-max)))
- (save-excursion
- (goto-char (point-max))
- (insert m))
- (let ((okay nil))
- (unwind-protect
- (progn
- (sit-for 2)
- (identity 1) ; this forces a call to QUIT; in bytecode.c.
- (setq okay t))
- (progn
- (delete-region savemax (point-max))
- (or okay (abort-recursive-edit)))))))
-
-
-(put 'math-with-extra-prec 'lisp-indent-hook 1)
-
-
-;;; Concatenate two vectors, or a vector and an object. [V O O] [Public]
-(defun math-concat (v1 v2)
- (if (stringp v1)
- (concat v1 v2)
- (calc-extensions)
- (if (and (or (math-objvecp v1) (math-known-scalarp v1))
- (or (math-objvecp v2) (math-known-scalarp v2)))
- (append (if (and (math-vectorp v1)
- (or (math-matrixp v1)
- (not (math-matrixp v2))))
- v1
- (list 'vec v1))
- (if (and (math-vectorp v2)
- (or (math-matrixp v2)
- (not (math-matrixp v1))))
- (cdr v2)
- (list v2)))
- (list '| v1 v2))))
-
-
-;;; True if A is zero. Works for un-normalized values. [P n] [Public]
-(defun math-zerop (a)
- (if (consp a)
- (cond ((memq (car a) '(bigpos bigneg))
- (while (eq (car (setq a (cdr a))) 0))
- (null a))
- ((memq (car a) '(frac float polar mod))
- (math-zerop (nth 1 a)))
- ((eq (car a) 'cplx)
- (and (math-zerop (nth 1 a)) (math-zerop (nth 2 a))))
- ((eq (car a) 'hms)
- (and (math-zerop (nth 1 a))
- (math-zerop (nth 2 a))
- (math-zerop (nth 3 a)))))
- (eq a 0)))
-
-
-;;; True if A is real and negative. [P n] [Public]
-
-(defun math-negp (a)
- (if (consp a)
- (cond ((eq (car a) 'bigpos) nil)
- ((eq (car a) 'bigneg) (cdr a))
- ((memq (car a) '(float frac))
- (Math-integer-negp (nth 1 a)))
- ((eq (car a) 'hms)
- (if (math-zerop (nth 1 a))
- (if (math-zerop (nth 2 a))
- (math-negp (nth 3 a))
- (math-negp (nth 2 a)))
- (math-negp (nth 1 a))))
- ((eq (car a) 'date)
- (math-negp (nth 1 a)))
- ((eq (car a) 'intv)
- (or (math-negp (nth 3 a))
- (and (math-zerop (nth 3 a))
- (memq (nth 1 a) '(0 2)))))
- ((equal a '(neg (var inf var-inf))) t))
- (< a 0)))
-
-;;; True if A is a negative number or an expression the starts with '-'.
-(defun math-looks-negp (a) ; [P x] [Public]
- (or (Math-negp a)
- (eq (car-safe a) 'neg)
- (and (memq (car-safe a) '(* /))
- (or (math-looks-negp (nth 1 a))
- (math-looks-negp (nth 2 a))))
- (and (eq (car-safe a) '-)
- (math-looks-negp (nth 1 a)))))
-
-
-;;; True if A is real and positive. [P n] [Public]
-(defun math-posp (a)
- (if (consp a)
- (cond ((eq (car a) 'bigpos) (cdr a))
- ((eq (car a) 'bigneg) nil)
- ((memq (car a) '(float frac))
- (Math-integer-posp (nth 1 a)))
- ((eq (car a) 'hms)
- (if (math-zerop (nth 1 a))
- (if (math-zerop (nth 2 a))
- (math-posp (nth 3 a))
- (math-posp (nth 2 a)))
- (math-posp (nth 1 a))))
- ((eq (car a) 'date)
- (math-posp (nth 1 a)))
- ((eq (car a) 'mod)
- (not (math-zerop (nth 1 a))))
- ((eq (car a) 'intv)
- (or (math-posp (nth 2 a))
- (and (math-zerop (nth 2 a))
- (memq (nth 1 a) '(0 1)))))
- ((equal a '(var inf var-inf)) t))
- (> a 0)))
-
-(defalias 'math-fixnump 'integerp)
-(defalias 'math-fixnatnump 'natnump)
-
-
-;;; True if A is an even integer. [P R R] [Public]
-(defun math-evenp (a)
- (if (consp a)
- (and (memq (car a) '(bigpos bigneg))
- (= (% (nth 1 a) 2) 0))
- (= (% a 2) 0)))
-
-;;; Compute A / 2, for small or big integer A. [I i]
-;;; If A is negative, type of truncation is undefined.
-(defun math-div2 (a)
- (if (consp a)
- (if (cdr a)
- (math-normalize (cons (car a) (math-div2-bignum (cdr a))))
- 0)
- (/ a 2)))
-
-(defun math-div2-bignum (a) ; [l l]
- (if (cdr a)
- (cons (+ (/ (car a) 2) (* (% (nth 1 a) 2) 500))
- (math-div2-bignum (cdr a)))
- (list (/ (car a) 2))))
-
-
-;;; Reject an argument to a calculator function. [Public]
-(defun math-reject-arg (&optional a p option)
- (if option
- (calc-record-why option p a)
- (if p
- (calc-record-why p a)))
- (signal 'wrong-type-argument (and a (if p (list p a) (list a)))))
-
-
-;;; Coerce A to be an integer (by truncation toward zero). [I N] [Public]
-(defun math-trunc (a &optional prec)
- (cond (prec
- (calc-extensions)
- (math-trunc-special a prec))
- ((Math-integerp a) a)
- ((Math-looks-negp a)
- (math-neg (math-trunc (math-neg a))))
- ((eq (car a) 'float)
- (math-scale-int (nth 1 a) (nth 2 a)))
- (t (calc-extensions)
- (math-trunc-fancy a))))
-(defalias 'calcFunc-trunc 'math-trunc)
-
-;;; Coerce A to be an integer (by truncation toward minus infinity). [I N]
-(defun math-floor (a &optional prec) ; [Public]
- (cond (prec
- (calc-extensions)
- (math-floor-special a prec))
- ((Math-integerp a) a)
- ((Math-messy-integerp a) (math-trunc a))
- ((Math-realp a)
- (if (Math-negp a)
- (math-add (math-trunc a) -1)
- (math-trunc a)))
- (t (calc-extensions)
- (math-floor-fancy a))))
-(defalias 'calcFunc-floor 'math-floor)
-
-
-(defun math-imod (a b) ; [I I I] [Public]
- (if (and (not (consp a)) (not (consp b)))
- (if (= b 0)
- (math-reject-arg a "*Division by zero")
- (% a b))
- (cdr (math-idivmod a b))))
-
-
-(defun calcFunc-inv (m)
- (if (Math-vectorp m)
- (progn
- (calc-extensions)
- (if (math-square-matrixp m)
- (or (math-with-extra-prec 2 (math-matrix-inv-raw m))
- (math-reject-arg m "*Singular matrix"))
- (math-reject-arg m 'square-matrixp)))
- (math-div 1 m)))
-
-
-(defun math-do-working (msg arg)
- (or executing-kbd-macro
- (progn
- (calc-set-command-flag 'clear-message)
- (if math-working-step
- (if math-working-step-2
- (setq msg (format "[%d/%d] %s"
- math-working-step math-working-step-2 msg))
- (setq msg (format "[%d] %s" math-working-step msg))))
- (message "Working... %s = %s" msg
- (math-showing-full-precision (math-format-number arg))))))
-
-
-;;; Compute A modulo B, defined in terms of truncation toward minus infinity.
-(defun math-mod (a b) ; [R R R] [Public]
- (cond ((and (Math-zerop a) (not (eq (car-safe a) 'mod))) a)
- ((Math-zerop b)
- (math-reject-arg a "*Division by zero"))
- ((and (Math-natnump a) (Math-natnump b))
- (math-imod a b))
- ((and (Math-anglep a) (Math-anglep b))
- (math-sub a (math-mul (math-floor (math-div a b)) b)))
- (t (calc-extensions)
- (math-mod-fancy a b))))
-
-
-
-;;; General exponentiation.
-
-(defun math-pow (a b) ; [O O N] [Public]
- (cond ((equal b '(var nan var-nan))
- b)
- ((Math-zerop a)
- (if (and (Math-scalarp b) (Math-posp b))
- (if (math-floatp b) (math-float a) a)
- (calc-extensions)
- (math-pow-of-zero a b)))
- ((or (eq a 1) (eq b 1)) a)
- ((or (equal a '(float 1 0)) (equal b '(float 1 0))) a)
- ((Math-zerop b)
- (if (Math-scalarp a)
- (if (or (math-floatp a) (math-floatp b))
- '(float 1 0) 1)
- (calc-extensions)
- (math-pow-zero a b)))
- ((and (Math-integerp b) (or (Math-numberp a) (Math-vectorp a)))
- (if (and (equal a '(float 1 1)) (integerp b))
- (math-make-float 1 b)
- (math-with-extra-prec 2
- (math-ipow a b))))
- (t
- (calc-extensions)
- (math-pow-fancy a b))))
-
-(defun math-ipow (a n) ; [O O I] [Public]
- (cond ((Math-integer-negp n)
- (math-ipow (math-div 1 a) (Math-integer-neg n)))
- ((not (consp n))
- (if (and (Math-ratp a) (> n 20))
- (math-iipow-show a n)
- (math-iipow a n)))
- ((math-evenp n)
- (math-ipow (math-mul a a) (math-div2 n)))
- (t
- (math-mul a (math-ipow (math-mul a a)
- (math-div2 (math-add n -1)))))))
-
-(defun math-iipow (a n) ; [O O S]
- (cond ((= n 0) 1)
- ((= n 1) a)
- ((= (% n 2) 0) (math-iipow (math-mul a a) (/ n 2)))
- (t (math-mul a (math-iipow (math-mul a a) (/ n 2))))))
-
-(defun math-iipow-show (a n) ; [O O S]
- (math-working "pow" a)
- (let ((val (cond
- ((= n 0) 1)
- ((= n 1) a)
- ((= (% n 2) 0) (math-iipow-show (math-mul a a) (/ n 2)))
- (t (math-mul a (math-iipow-show (math-mul a a) (/ n 2)))))))
- (math-working "pow" val)
- val))
-
-
-(defun math-read-radix-digit (dig) ; [D S; Z S]
- (if (> dig ?9)
- (if (< dig ?A)
- nil
- (- dig 55))
- (if (>= dig ?0)
- (- dig ?0)
- nil)))
-
-
-;;; Bug reporting
-
-(defun report-calc-bug ()
- "Report a bug in Calc, the GNU Emacs calculator.
-Prompts for bug subject. Leaves you in a mail buffer."
- (interactive)
- (let ((reporter-prompt-for-summary-p t))
- (reporter-submit-bug-report calc-bug-address "Calc" '(calc-version)
- nil nil
- "Please describe exactly what actions triggered the bug and the
-precise symptoms of the bug. If possible, include a backtrace by
-doing 'M-x toggle-debug-on-error', then reproducing the bug.
-" )))
-(defalias 'calc-report-bug 'report-calc-bug)
-
-;;; calc-misc.el ends here
+++ /dev/null
-;;; calc-mode.el --- calculator modes for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-mode () nil)
-
-
-(defun calc-line-numbering (n)
- (interactive "P")
- (calc-wrapper
- (message (if (calc-change-mode 'calc-line-numbering n t t)
- "Displaying stack level numbers"
- "Hiding stack level numbers"))))
-
-(defun calc-line-breaking (n)
- (interactive "P")
- (calc-wrapper
- (setq n (if n
- (and (> (setq n (prefix-numeric-value n)) 0)
- (or (< n 5)
- n))
- (not calc-line-breaking)))
- (if (calc-change-mode 'calc-line-breaking n t)
- (if (integerp calc-line-breaking)
- (message "Breaking lines longer than %d characters" n)
- (message "Breaking long lines in Stack display"))
- (message "Not breaking long lines in Stack display"))))
-
-
-(defun calc-left-justify (n)
- (interactive "P")
- (calc-wrapper
- (and n (setq n (prefix-numeric-value n)))
- (calc-change-mode '(calc-display-just calc-display-origin)
- (list nil n) t)
- (if n
- (message "Displaying stack entries indented by %d" n)
- (message "Displaying stack entries left-justified"))))
-
-(defun calc-center-justify (n)
- (interactive "P")
- (calc-wrapper
- (and n (setq n (prefix-numeric-value n)))
- (calc-change-mode '(calc-display-just calc-display-origin)
- (list 'center n) t)
- (if n
- (message "Displaying stack entries centered on column %d" n)
- (message "Displaying stack entries centered in window"))))
-
-(defun calc-right-justify (n)
- (interactive "P")
- (calc-wrapper
- (and n (setq n (prefix-numeric-value n)))
- (calc-change-mode '(calc-display-just calc-display-origin)
- (list 'right n) t)
- (if n
- (message "Displaying stack entries right-justified to column %d" n)
- (message "Displaying stack entries right-justified in window"))))
-
-(defun calc-left-label (s)
- (interactive "sLefthand label: ")
- (calc-wrapper
- (or (equal s "")
- (setq s (concat s " ")))
- (calc-change-mode 'calc-left-label s t)))
-
-(defun calc-right-label (s)
- (interactive "sRighthand label: ")
- (calc-wrapper
- (or (equal s "")
- (setq s (concat " " s)))
- (calc-change-mode 'calc-right-label s t)))
-
-(defun calc-auto-why (n)
- (interactive "P")
- (calc-wrapper
- (if n
- (progn
- (setq n (prefix-numeric-value n))
- (if (<= n 0) (setq n nil)
- (if (> n 1) (setq n t))))
- (setq n (and (not (eq calc-auto-why t)) (if calc-auto-why t 1))))
- (calc-change-mode 'calc-auto-why n nil)
- (cond ((null n)
- (message "User must press `w' to explain unsimplified results"))
- ((eq n t)
- (message "Automatically doing `w' to explain unsimplified results"))
- (t
- (message "Automatically doing `w' only for unusual messages")))))
-
-(defun calc-group-digits (n)
- (interactive "P")
- (calc-wrapper
- (if n
- (progn
- (setq n (prefix-numeric-value n))
- (cond ((or (> n 0) (< n -1)))
- ((= n -1)
- (setq n nil))
- (t
- (setq n calc-group-digits))))
- (setq n (not calc-group-digits)))
- (calc-change-mode 'calc-group-digits n t)
- (cond ((null n)
- (message "Grouping is off"))
- ((integerp n)
- (message "Grouping every %d digits" (math-abs n)))
- (t
- (message "Grouping is on")))))
-
-(defun calc-group-char (ch)
- (interactive "cGrouping character: ")
- (calc-wrapper
- (or (>= ch 32)
- (error "Control characters not allowed for grouping"))
- (if (= ch ?\\)
- (setq ch "\\,")
- (setq ch (char-to-string ch)))
- (calc-change-mode 'calc-group-char ch calc-group-digits)
- (message "Digit grouping character is \"%s\"" ch)))
-
-(defun calc-point-char (ch)
- (interactive "cCharacter to use as decimal point: ")
- (calc-wrapper
- (or (>= ch 32)
- (error "Control characters not allowed as decimal point"))
- (calc-change-mode 'calc-point-char (char-to-string ch) t)
- (message "Decimal point character is \"%c\"" ch)))
-
-(defun calc-normal-notation (n)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-float-format
- (let* ((val (if n (prefix-numeric-value n) 0))
- (mode (/ (+ val 5000) 10000)))
- (if (or (< val -5000) (> mode 3))
- (error "Prefix out of range"))
- (setq n (list (aref [float sci eng fix] mode)
- (- (% (+ val 5000) 10000) 5000))))
- t)
- (if (eq (nth 1 n) 0)
- (message "Displaying floating-point numbers normally")
- (if (> (nth 1 n) 0)
- (message
- "Displaying floating-point numbers with %d significant digits"
- (nth 1 n))
- (message "Displaying floating-point numbers with (precision%d)"
- (nth 1 n))))))
-
-(defun calc-fix-notation (n)
- (interactive "NDigits after decimal point: ")
- (calc-wrapper
- (calc-change-mode 'calc-float-format
- (setq n (list 'fix (if n (prefix-numeric-value n) 0)))
- t)
- (message "Displaying floats with %d digits after decimal"
- (math-abs (nth 1 n)))))
-
-(defun calc-sci-notation (n)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-float-format
- (setq n (list 'sci (if n (prefix-numeric-value n) 0)))
- t)
- (if (eq (nth 1 n) 0)
- (message "Displaying floats in scientific notation")
- (if (> (nth 1 n) 0)
- (message "Displaying scientific notation with %d significant digits"
- (nth 1 n))
- (message "Displaying scientific notation with (precision%d)"
- (nth 1 n))))))
-
-(defun calc-eng-notation (n)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-float-format
- (setq n (list 'eng (if n (prefix-numeric-value n) 0)))
- t)
- (if (eq (nth 1 n) 0)
- (message "Displaying floats in engineering notation")
- (if (> (nth 1 n) 0)
- (message "Displaying engineering notation with %d significant digits"
- (nth 1 n))
- (message "Displaying engineering notation with (precision%d)"
- (nth 1 n))))))
-
-
-(defun calc-truncate-stack (n &optional rel)
- (interactive "P")
- (calc-wrapper
- (let ((oldtop calc-stack-top)
- (newtop calc-stack-top))
- (calc-record-undo (list 'set 'saved-stack-top calc-stack-top))
- (let ((calc-stack-top 0)
- (nn (prefix-numeric-value n)))
- (setq newtop
- (if n
- (progn
- (if rel
- (setq nn (+ oldtop nn))
- (if (< nn 0)
- (setq nn (+ nn (calc-stack-size)))
- (setq nn (1+ nn))))
- (if (< nn 1)
- 1
- (if (> nn (calc-stack-size))
- (calc-stack-size)
- nn)))
- (max 1 (calc-locate-cursor-element (point)))))
- (if (= newtop oldtop)
- ()
- (calc-pop-stack 1 oldtop t)
- (calc-push-list '(top-of-stack) newtop)
- (if calc-line-numbering
- (calc-refresh))))
- (calc-record-undo (list 'set 'saved-stack-top 0))
- (setq calc-stack-top newtop))))
-
-(defun calc-truncate-up (n)
- (interactive "p")
- (calc-truncate-stack n t))
-
-(defun calc-truncate-down (n)
- (interactive "p")
- (calc-truncate-stack (- n) t))
-
-(defun calc-display-raw (arg)
- (interactive "P")
- (calc-wrapper
- (setq calc-display-raw (if calc-display-raw nil (if arg 0 t)))
- (calc-do-refresh)
- (if calc-display-raw
- (message "Press d ' again to cancel \"raw\" display mode"))))
-
-
-
-
-;;; Mode commands.
-
-(defun calc-save-modes ()
- (interactive)
- (calc-wrapper
- (let (pos
- (vals (mapcar (function (lambda (v) (symbol-value (car v))))
- calc-mode-var-list)))
- (unless calc-settings-file
- (error "No `calc-settings-file' specified"))
- (set-buffer (find-file-noselect (substitute-in-file-name
- calc-settings-file)))
- (goto-char (point-min))
- (if (and (search-forward ";;; Mode settings stored by Calc" nil t)
- (progn
- (beginning-of-line)
- (setq pos (point))
- (search-forward "\n;;; End of mode settings" nil t)))
- (progn
- (beginning-of-line)
- (forward-line 1)
- (delete-region pos (point)))
- (goto-char (point-max))
- (insert "\n\n")
- (forward-char -1))
- (insert ";;; Mode settings stored by Calc on " (current-time-string) "\n")
- (let ((list calc-mode-var-list))
- (while list
- (let* ((v (car (car list)))
- (def (nth 1 (car list)))
- (val (car vals)))
- (or (equal val def)
- (progn
- (insert "(setq " (symbol-name v) " ")
- (if (and (or (listp val)
- (symbolp val))
- (not (memq val '(nil t))))
- (insert "'"))
- (insert (prin1-to-string val) ")\n"))))
- (setq list (cdr list)
- vals (cdr vals))))
- (run-hooks 'calc-mode-save-hook)
- (insert ";;; End of mode settings\n")
- (save-buffer))))
-
-(defun calc-settings-file-name (name &optional arg)
- (interactive
- (list (read-file-name (format "Settings file name (normally %s): "
- (abbreviate-file-name (or user-init-file
- "~/.emacs"))))
- current-prefix-arg))
- (calc-wrapper
- (setq arg (if arg (prefix-numeric-value arg) 0))
- (if (equal name "")
- (message "Calc settings file is \"%s\"" calc-settings-file)
- (if (< (math-abs arg) 2)
- (let ((list calc-mode-var-list))
- (while list
- (set (car (car list)) (nth 1 (car list)))
- (setq list (cdr list)))))
- ;; FIXME: we should use ~/.calc or so in order to avoid
- ;; reexecuting ~/.emacs (it's not always idempotent) -cgw 2001.11.12
- (setq calc-settings-file name)
- (or (and
- calc-settings-file
- (string-match "\\.emacs" calc-settings-file)
- (> arg 0))
- (< arg 0)
- (load name t)
- (message "New file")))))
-
-(defun math-get-modes-vec ()
- (list 'vec
- calc-internal-prec
- calc-word-size
- (calc-stack-size)
- calc-number-radix
- (+ (if (<= (nth 1 calc-float-format) 0)
- (+ calc-internal-prec (nth 1 calc-float-format))
- (nth 1 calc-float-format))
- (cdr (assq (car calc-float-format)
- '((float . 0) (sci . 10000)
- (eng . 20000) (fix . 30000)))))
- (cond ((eq calc-angle-mode 'rad) 2)
- ((eq calc-angle-mode 'hms) 3)
- (t 1))
- (if calc-symbolic-mode 1 0)
- (if calc-prefer-frac 1 0)
- (if (eq calc-complex-mode 'polar) 1 0)
- (cond ((eq calc-matrix-mode 'scalar) 0)
- ((eq calc-matrix-mode 'matrix) -2)
- (calc-matrix-mode)
- (t -1))
- (cond ((eq calc-simplify-mode 'none) -1)
- ((eq calc-simplify-mode 'num) 0)
- ((eq calc-simplify-mode 'binary) 2)
- ((eq calc-simplify-mode 'alg) 3)
- ((eq calc-simplify-mode 'ext) 4)
- ((eq calc-simplify-mode 'units) 5)
- (t 1))
- (cond ((eq calc-infinite-mode 1) 0)
- (calc-infinite-mode 1)
- (t -1))))
-
-(defun calc-get-modes (n)
- (interactive "P")
- (calc-wrapper
- (let ((modes (math-get-modes-vec)))
- (calc-enter-result 0 "mode"
- (if n
- (if (and (>= (setq n (prefix-numeric-value n)) 1)
- (< n (length modes)))
- (nth n modes)
- (error "Prefix out of range"))
- modes)))))
-
-(defun calc-shift-prefix (arg)
- (interactive "P")
- (calc-wrapper
- (setq calc-shift-prefix (if arg
- (> (prefix-numeric-value arg) 0)
- (not calc-shift-prefix)))
- (calc-init-prefixes)
- (message (if calc-shift-prefix
- "Prefix keys are now case-insensitive"
- "Prefix keys must be unshifted (except V, Z)"))))
-
-(defun calc-mode-record-mode (n)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-mode-save-mode
- (cond ((null n)
- (cond ((not calc-embedded-info)
- (if (eq calc-mode-save-mode 'save)
- 'local 'save))
- ((eq calc-mode-save-mode 'local) 'edit)
- ((eq calc-mode-save-mode 'edit) 'perm)
- ((eq calc-mode-save-mode 'perm) 'global)
- ((eq calc-mode-save-mode 'global) 'save)
- ((eq calc-mode-save-mode 'save) nil)
- ((eq calc-mode-save-mode nil) 'local)))
- ((= (setq n (prefix-numeric-value n)) 0) nil)
- ((= n 2) 'edit)
- ((= n 3) 'perm)
- ((= n 4) 'global)
- ((= n 5) 'save)
- (t 'local)))
- (message (cond ((and (eq calc-mode-save-mode 'local) calc-embedded-info)
- "Recording mode changes with [calc-mode: ...]")
- ((eq calc-mode-save-mode 'edit)
- "Recording mode changes with [calc-edit-mode: ...]")
- ((eq calc-mode-save-mode 'perm)
- "Recording mode changes with [calc-perm-mode: ...]")
- ((eq calc-mode-save-mode 'global)
- "Recording mode changes with [calc-global-mode: ...]")
- ((eq calc-mode-save-mode 'save)
- (format "Recording mode changes in \"%s\""
- calc-settings-file))
- (t
- "Not recording mode changes permanently")))))
-
-(defun calc-total-algebraic-mode (flag)
- (interactive "P")
- (if calc-emacs-type-19
- (error "Total algebraic mode not yet supported for Emacs 19"))
- (calc-wrapper
- (if (eq calc-algebraic-mode 'total)
- (calc-algebraic-mode nil)
- (calc-change-mode '(calc-algebraic-mode calc-incomplete-algebraic-mode)
- '(total nil))
- (use-local-map calc-alg-map)
- (message
- "All keys begin algebraic entry; use Meta (ESC) for Calc keys"))))
-
-(defun calc-algebraic-mode (flag)
- (interactive "P")
- (calc-wrapper
- (if flag
- (calc-change-mode '(calc-algebraic-mode
- calc-incomplete-algebraic-mode)
- (list nil (not calc-incomplete-algebraic-mode)))
- (calc-change-mode '(calc-algebraic-mode calc-incomplete-algebraic-mode)
- (list (not calc-algebraic-mode) nil)))
- (use-local-map calc-mode-map)
- (message (if calc-algebraic-mode
- "Numeric keys and ( and [ begin algebraic entry"
- (if calc-incomplete-algebraic-mode
- "Only ( and [ begin algebraic entry"
- "No keys except ' and $ begin algebraic entry")))))
-
-(defun calc-symbolic-mode (n)
- (interactive "P")
- (calc-wrapper
-
- (message (if (calc-change-mode 'calc-symbolic-mode n nil t)
- "Inexact computations like sqrt(2) are deferred"
- "Numerical computations are always done immediately"))))
-
-(defun calc-infinite-mode (n)
- (interactive "P")
- (calc-wrapper
- (if (eq n 0)
- (progn
- (calc-change-mode 'calc-infinite-mode 1)
- (message "Computations like 1 / 0 produce \"inf\""))
- (message (if (calc-change-mode 'calc-infinite-mode n nil t)
- "Computations like 1 / 0 produce \"uinf\""
- "Computations like 1 / 0 are left unsimplified")))))
-
-(defun calc-matrix-mode (arg)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-matrix-mode
- (cond ((eq arg 0) 'scalar)
- ((< (prefix-numeric-value arg) 1)
- (and (< (prefix-numeric-value arg) -1) 'matrix))
- (arg (prefix-numeric-value arg))
- ((eq calc-matrix-mode 'matrix) 'scalar)
- ((eq calc-matrix-mode 'scalar) nil)
- (t 'matrix)))
- (if (integerp calc-matrix-mode)
- (message "Variables are assumed to be %dx%d matrices"
- calc-matrix-mode calc-matrix-mode)
- (message (if (eq calc-matrix-mode 'matrix)
- "Variables are assumed to be matrices"
- (if calc-matrix-mode
- "Variables are assumed to be scalars (non-matrices)"
- "Variables are not assumed to be matrix or scalar"))))))
-
-(defun calc-set-simplify-mode (mode arg msg)
- (calc-change-mode 'calc-simplify-mode
- (if arg
- (and (> (prefix-numeric-value arg) 0)
- mode)
- (and (not (eq calc-simplify-mode mode))
- mode)))
- (message (if (eq calc-simplify-mode mode)
- msg
- "Default simplifications enabled")))
-
-(defun calc-no-simplify-mode (arg)
- (interactive "P")
- (calc-wrapper
- (calc-set-simplify-mode 'none arg
- "All default simplifications are disabled")))
-
-(defun calc-num-simplify-mode (arg)
- (interactive "P")
- (calc-wrapper
- (calc-set-simplify-mode 'num arg
- "Default simplifications apply only if arguments are numeric")))
-
-(defun calc-default-simplify-mode (arg)
- (interactive "p")
- (cond ((= arg 1)
- (calc-wrapper
- (calc-set-simplify-mode
- nil nil "Usual default simplifications are enabled")))
- ((= arg 0) (calc-num-simplify-mode 1))
- ((< arg 0) (calc-no-simplify-mode 1))
- ((= arg 2) (calc-bin-simplify-mode 1))
- ((= arg 3) (calc-alg-simplify-mode 1))
- ((= arg 4) (calc-ext-simplify-mode 1))
- ((= arg 5) (calc-units-simplify-mode 1))
- (t (error "Prefix argument out of range"))))
-
-(defun calc-bin-simplify-mode (arg)
- (interactive "P")
- (calc-wrapper
- (calc-set-simplify-mode 'binary arg
- (format "Binary simplification occurs by default (word size=%d)"
- calc-word-size))))
-
-(defun calc-alg-simplify-mode (arg)
- (interactive "P")
- (calc-wrapper
- (calc-set-simplify-mode 'alg arg
- "Algebraic simplification occurs by default")))
-
-(defun calc-ext-simplify-mode (arg)
- (interactive "P")
- (calc-wrapper
- (calc-set-simplify-mode 'ext arg
- "Extended algebraic simplification occurs by default")))
-
-(defun calc-units-simplify-mode (arg)
- (interactive "P")
- (calc-wrapper
- (calc-set-simplify-mode 'units arg
- "Units simplification occurs by default")))
-
-(defun calc-auto-recompute (arg)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-auto-recompute arg nil t)
- (calc-refresh-evaltos)
- (message (if calc-auto-recompute
- "Automatically recomputing `=>' forms when necessary"
- "Not recomputing `=>' forms automatically"))))
-
-(defun calc-working (n)
- (interactive "P")
- (calc-wrapper
- (cond ((consp n)
- (calc-pop-push-record 0 "work"
- (cond ((eq calc-display-working-message t) 1)
- (calc-display-working-message 2)
- (t 0))))
- ((eq n 2) (calc-change-mode 'calc-display-working-message 'lots))
- ((eq n 0) (calc-change-mode 'calc-display-working-message nil))
- ((eq n 1) (calc-change-mode 'calc-display-working-message t)))
- (cond ((eq calc-display-working-message t)
- (message "\"Working...\" messages enabled"))
- (calc-display-working-message
- (message "Detailed \"Working...\" messages enabled"))
- (t
- (message "\"Working...\" messages disabled")))))
-
-(defun calc-always-load-extensions ()
- (interactive)
- (calc-wrapper
- (if (setq calc-always-load-extensions (not calc-always-load-extensions))
- (message "Always loading extensions package")
- (message "Loading extensions package on demand only"))))
-
-
-(defun calc-matrix-left-justify ()
- (interactive)
- (calc-wrapper
- (calc-change-mode 'calc-matrix-just nil t)
- (message "Matrix elements will be left-justified in columns")))
-
-(defun calc-matrix-center-justify ()
- (interactive)
- (calc-wrapper
- (calc-change-mode 'calc-matrix-just 'center t)
- (message "Matrix elements will be centered in columns")))
-
-(defun calc-matrix-right-justify ()
- (interactive)
- (calc-wrapper
- (calc-change-mode 'calc-matrix-just 'right t)
- (message "Matrix elements will be right-justified in columns")))
-
-(defun calc-full-vectors (n)
- (interactive "P")
- (calc-wrapper
- (message (if (calc-change-mode 'calc-full-vectors n t t)
- "Displaying long vectors in full"
- "Displaying long vectors in [a, b, c, ..., z] notation"))))
-
-(defun calc-full-trail-vectors (n)
- (interactive "P")
- (calc-wrapper
- (message (if (calc-change-mode 'calc-full-trail-vectors n nil t)
- "Recording long vectors in full"
- "Recording long vectors in [a, b, c, ..., z] notation"))))
-
-(defun calc-break-vectors (n)
- (interactive "P")
- (calc-wrapper
- (message (if (calc-change-mode 'calc-break-vectors n t t)
- "Displaying vector elements one-per-line"
- "Displaying vector elements all on one line"))))
-
-(defun calc-vector-commas ()
- (interactive)
- (calc-wrapper
- (if (calc-change-mode 'calc-vector-commas (if calc-vector-commas nil ",") t)
- (message "Separating vector elements with \",\"")
- (message "Separating vector elements with spaces"))))
-
-(defun calc-vector-brackets ()
- (interactive)
- (calc-wrapper
- (if (calc-change-mode 'calc-vector-brackets
- (if (equal calc-vector-brackets "[]") nil "[]") t)
- (message "Surrounding vectors with \"[]\"")
- (message "Not surrounding vectors with brackets"))))
-
-(defun calc-vector-braces ()
- (interactive)
- (calc-wrapper
- (if (calc-change-mode 'calc-vector-brackets
- (if (equal calc-vector-brackets "{}") nil "{}") t)
- (message "Surrounding vectors with \"{}\"")
- (message "Not surrounding vectors with brackets"))))
-
-(defun calc-vector-parens ()
- (interactive)
- (calc-wrapper
- (if (calc-change-mode 'calc-vector-brackets
- (if (equal calc-vector-brackets "()") nil "()") t)
- (message "Surrounding vectors with \"()\"")
- (message "Not surrounding vectors with brackets"))))
-
-(defun calc-matrix-brackets (arg)
- (interactive "sCode letters (R, O, C, P): ")
- (calc-wrapper
- (let ((code (append (and (string-match "[rR]" arg) '(R))
- (and (string-match "[oO]" arg) '(O))
- (and (string-match "[cC]" arg) '(C))
- (and (string-match "[pP]" arg) '(P))))
- (bad (string-match "[^rRoOcCpP ]" arg)))
- (if bad
- (error "Unrecognized character: %c" (aref arg bad)))
- (calc-change-mode 'calc-matrix-brackets code t))))
-
-;;; calc-mode.el ends here
+++ /dev/null
-;;; calc-mtx.el --- matrix functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-mat () nil)
-
-
-(defun calc-mdet (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "mdet" 'calcFunc-det arg)))
-
-(defun calc-mtrace (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "mtr" 'calcFunc-tr arg)))
-
-(defun calc-mlud (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "mlud" 'calcFunc-lud arg)))
-
-
-;;; Coerce row vector A to be a matrix. [V V]
-(defun math-row-matrix (a)
- (if (and (Math-vectorp a)
- (not (math-matrixp a)))
- (list 'vec a)
- a))
-
-;;; Coerce column vector A to be a matrix. [V V]
-(defun math-col-matrix (a)
- (if (and (Math-vectorp a)
- (not (math-matrixp a)))
- (cons 'vec (mapcar (function (lambda (x) (list 'vec x))) (cdr a)))
- a))
-
-
-
-;;; Multiply matrices A and B. [V V V]
-(defun math-mul-mats (a b)
- (let ((mat nil)
- (cols (length (nth 1 b)))
- row col ap bp accum)
- (while (setq a (cdr a))
- (setq col cols
- row nil)
- (while (> (setq col (1- col)) 0)
- (setq ap (cdr (car a))
- bp (cdr b)
- accum (math-mul (car ap) (nth col (car bp))))
- (while (setq ap (cdr ap) bp (cdr bp))
- (setq accum (math-add accum (math-mul (car ap) (nth col (car bp))))))
- (setq row (cons accum row)))
- (setq mat (cons (cons 'vec row) mat)))
- (cons 'vec (nreverse mat))))
-
-(defun math-mul-mat-vec (a b)
- (cons 'vec (mapcar (function (lambda (row)
- (math-dot-product row b)))
- (cdr a))))
-
-
-
-(defun calcFunc-tr (mat) ; [Public]
- (if (math-square-matrixp mat)
- (math-matrix-trace-step 2 (1- (length mat)) mat (nth 1 (nth 1 mat)))
- (math-reject-arg mat 'square-matrixp)))
-
-(defun math-matrix-trace-step (n size mat sum)
- (if (<= n size)
- (math-matrix-trace-step (1+ n) size mat
- (math-add sum (nth n (nth n mat))))
- sum))
-
-
-;;; Matrix inverse and determinant.
-(defun math-matrix-inv-raw (m)
- (let ((n (1- (length m))))
- (if (<= n 3)
- (let ((det (math-det-raw m)))
- (and (not (math-zerop det))
- (math-div
- (cond ((= n 1) 1)
- ((= n 2)
- (list 'vec
- (list 'vec
- (nth 2 (nth 2 m))
- (math-neg (nth 2 (nth 1 m))))
- (list 'vec
- (math-neg (nth 1 (nth 2 m)))
- (nth 1 (nth 1 m)))))
- ((= n 3)
- (list 'vec
- (list 'vec
- (math-sub (math-mul (nth 3 (nth 3 m))
- (nth 2 (nth 2 m)))
- (math-mul (nth 3 (nth 2 m))
- (nth 2 (nth 3 m))))
- (math-sub (math-mul (nth 3 (nth 1 m))
- (nth 2 (nth 3 m)))
- (math-mul (nth 3 (nth 3 m))
- (nth 2 (nth 1 m))))
- (math-sub (math-mul (nth 3 (nth 2 m))
- (nth 2 (nth 1 m)))
- (math-mul (nth 3 (nth 1 m))
- (nth 2 (nth 2 m)))))
- (list 'vec
- (math-sub (math-mul (nth 3 (nth 2 m))
- (nth 1 (nth 3 m)))
- (math-mul (nth 3 (nth 3 m))
- (nth 1 (nth 2 m))))
- (math-sub (math-mul (nth 3 (nth 3 m))
- (nth 1 (nth 1 m)))
- (math-mul (nth 3 (nth 1 m))
- (nth 1 (nth 3 m))))
- (math-sub (math-mul (nth 3 (nth 1 m))
- (nth 1 (nth 2 m)))
- (math-mul (nth 3 (nth 2 m))
- (nth 1 (nth 1 m)))))
- (list 'vec
- (math-sub (math-mul (nth 2 (nth 3 m))
- (nth 1 (nth 2 m)))
- (math-mul (nth 2 (nth 2 m))
- (nth 1 (nth 3 m))))
- (math-sub (math-mul (nth 2 (nth 1 m))
- (nth 1 (nth 3 m)))
- (math-mul (nth 2 (nth 3 m))
- (nth 1 (nth 1 m))))
- (math-sub (math-mul (nth 2 (nth 2 m))
- (nth 1 (nth 1 m)))
- (math-mul (nth 2 (nth 1 m))
- (nth 1 (nth 2 m))))))))
- det)))
- (let ((lud (math-matrix-lud m)))
- (and lud
- (math-lud-solve lud (calcFunc-idn 1 n)))))))
-
-(defun calcFunc-det (m)
- (if (math-square-matrixp m)
- (math-with-extra-prec 2 (math-det-raw m))
- (if (and (eq (car-safe m) 'calcFunc-idn)
- (or (math-zerop (nth 1 m))
- (math-equal-int (nth 1 m) 1)))
- (nth 1 m)
- (math-reject-arg m 'square-matrixp))))
-
-(defun math-det-raw (m)
- (let ((n (1- (length m))))
- (cond ((= n 1)
- (nth 1 (nth 1 m)))
- ((= n 2)
- (math-sub (math-mul (nth 1 (nth 1 m))
- (nth 2 (nth 2 m)))
- (math-mul (nth 2 (nth 1 m))
- (nth 1 (nth 2 m)))))
- ((= n 3)
- (math-sub
- (math-sub
- (math-sub
- (math-add
- (math-add
- (math-mul (nth 1 (nth 1 m))
- (math-mul (nth 2 (nth 2 m))
- (nth 3 (nth 3 m))))
- (math-mul (nth 2 (nth 1 m))
- (math-mul (nth 3 (nth 2 m))
- (nth 1 (nth 3 m)))))
- (math-mul (nth 3 (nth 1 m))
- (math-mul (nth 1 (nth 2 m))
- (nth 2 (nth 3 m)))))
- (math-mul (nth 3 (nth 1 m))
- (math-mul (nth 2 (nth 2 m))
- (nth 1 (nth 3 m)))))
- (math-mul (nth 1 (nth 1 m))
- (math-mul (nth 3 (nth 2 m))
- (nth 2 (nth 3 m)))))
- (math-mul (nth 2 (nth 1 m))
- (math-mul (nth 1 (nth 2 m))
- (nth 3 (nth 3 m))))))
- (t (let ((lud (math-matrix-lud m)))
- (if lud
- (let ((lu (car lud)))
- (math-det-step n (nth 2 lud)))
- 0))))))
-
-(defun math-det-step (n prod)
- (if (> n 0)
- (math-det-step (1- n) (math-mul prod (nth n (nth n lu))))
- prod))
-
-;;; This returns a list (LU index d), or nil if not possible.
-;;; Argument M must be a square matrix.
-(defvar math-lud-cache nil)
-(defun math-matrix-lud (m)
- (let ((old (assoc m math-lud-cache))
- (context (list calc-internal-prec calc-prefer-frac)))
- (if (and old (equal (nth 1 old) context))
- (cdr (cdr old))
- (let* ((lud (catch 'singular (math-do-matrix-lud m)))
- (entry (cons context lud)))
- (if old
- (setcdr old entry)
- (setq math-lud-cache (cons (cons m entry) math-lud-cache)))
- lud))))
-
-;;; Numerical Recipes section 2.3; implicit pivoting omitted.
-(defun math-do-matrix-lud (m)
- (let* ((lu (math-copy-matrix m))
- (n (1- (length lu)))
- i (j 1) k imax sum big
- (d 1) (index nil))
- (while (<= j n)
- (setq i 1
- big 0
- imax j)
- (while (< i j)
- (math-working "LUD step" (format "%d/%d" j i))
- (setq sum (nth j (nth i lu))
- k 1)
- (while (< k i)
- (setq sum (math-sub sum (math-mul (nth k (nth i lu))
- (nth j (nth k lu))))
- k (1+ k)))
- (setcar (nthcdr j (nth i lu)) sum)
- (setq i (1+ i)))
- (while (<= i n)
- (math-working "LUD step" (format "%d/%d" j i))
- (setq sum (nth j (nth i lu))
- k 1)
- (while (< k j)
- (setq sum (math-sub sum (math-mul (nth k (nth i lu))
- (nth j (nth k lu))))
- k (1+ k)))
- (setcar (nthcdr j (nth i lu)) sum)
- (let ((dum (math-abs-approx sum)))
- (if (Math-lessp big dum)
- (setq big dum
- imax i)))
- (setq i (1+ i)))
- (if (> imax j)
- (setq lu (math-swap-rows lu j imax)
- d (- d)))
- (setq index (cons imax index))
- (let ((pivot (nth j (nth j lu))))
- (if (math-zerop pivot)
- (throw 'singular nil)
- (setq i j)
- (while (<= (setq i (1+ i)) n)
- (setcar (nthcdr j (nth i lu))
- (math-div (nth j (nth i lu)) pivot)))))
- (setq j (1+ j)))
- (list lu (nreverse index) d)))
-
-(defun math-swap-rows (m r1 r2)
- (or (= r1 r2)
- (let* ((r1prev (nthcdr (1- r1) m))
- (row1 (cdr r1prev))
- (r2prev (nthcdr (1- r2) m))
- (row2 (cdr r2prev))
- (r2next (cdr row2)))
- (setcdr r2prev row1)
- (setcdr r1prev row2)
- (setcdr row2 (cdr row1))
- (setcdr row1 r2next)))
- m)
-
-
-(defun math-lud-solve (lud b &optional need)
- (if lud
- (let* ((x (math-copy-matrix b))
- (n (1- (length x)))
- (m (1- (length (nth 1 x))))
- (lu (car lud))
- (col 1)
- i j ip ii index sum)
- (while (<= col m)
- (math-working "LUD solver step" col)
- (setq i 1
- ii nil
- index (nth 1 lud))
- (while (<= i n)
- (setq ip (car index)
- index (cdr index)
- sum (nth col (nth ip x)))
- (setcar (nthcdr col (nth ip x)) (nth col (nth i x)))
- (if (null ii)
- (or (math-zerop sum)
- (setq ii i))
- (setq j ii)
- (while (< j i)
- (setq sum (math-sub sum (math-mul (nth j (nth i lu))
- (nth col (nth j x))))
- j (1+ j))))
- (setcar (nthcdr col (nth i x)) sum)
- (setq i (1+ i)))
- (while (>= (setq i (1- i)) 1)
- (setq sum (nth col (nth i x))
- j i)
- (while (<= (setq j (1+ j)) n)
- (setq sum (math-sub sum (math-mul (nth j (nth i lu))
- (nth col (nth j x))))))
- (setcar (nthcdr col (nth i x))
- (math-div sum (nth i (nth i lu)))))
- (setq col (1+ col)))
- x)
- (and need
- (math-reject-arg need "*Singular matrix"))))
-
-(defun calcFunc-lud (m)
- (if (math-square-matrixp m)
- (or (math-with-extra-prec 2
- (let ((lud (math-matrix-lud m)))
- (and lud
- (let* ((lmat (math-copy-matrix (car lud)))
- (umat (math-copy-matrix (car lud)))
- (n (1- (length (car lud))))
- (perm (calcFunc-idn 1 n))
- i (j 1))
- (while (<= j n)
- (setq i 1)
- (while (< i j)
- (setcar (nthcdr j (nth i lmat)) 0)
- (setq i (1+ i)))
- (setcar (nthcdr j (nth j lmat)) 1)
- (while (<= (setq i (1+ i)) n)
- (setcar (nthcdr j (nth i umat)) 0))
- (setq j (1+ j)))
- (while (>= (setq j (1- j)) 1)
- (let ((pos (nth (1- j) (nth 1 lud))))
- (or (= pos j)
- (setq perm (math-swap-rows perm j pos)))))
- (list 'vec perm lmat umat)))))
- (math-reject-arg m "*Singular matrix"))
- (math-reject-arg m 'square-matrixp)))
-
-;;; calc-mtx.el ends here
+++ /dev/null
-;;; calc-poly.el --- polynomial functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-poly () nil)
-
-
-(defun calcFunc-pcont (expr &optional var)
- (cond ((Math-primp expr)
- (cond ((Math-zerop expr) 1)
- ((Math-messy-integerp expr) (math-trunc expr))
- ((Math-objectp expr) expr)
- ((or (equal expr var) (not var)) 1)
- (t expr)))
- ((eq (car expr) '*)
- (math-mul (calcFunc-pcont (nth 1 expr) var)
- (calcFunc-pcont (nth 2 expr) var)))
- ((eq (car expr) '/)
- (math-div (calcFunc-pcont (nth 1 expr) var)
- (calcFunc-pcont (nth 2 expr) var)))
- ((and (eq (car expr) '^) (Math-natnump (nth 2 expr)))
- (math-pow (calcFunc-pcont (nth 1 expr) var) (nth 2 expr)))
- ((memq (car expr) '(neg polar))
- (calcFunc-pcont (nth 1 expr) var))
- ((consp var)
- (let ((p (math-is-polynomial expr var)))
- (if p
- (let ((lead (nth (1- (length p)) p))
- (cont (math-poly-gcd-list p)))
- (if (math-guess-if-neg lead)
- (math-neg cont)
- cont))
- 1)))
- ((memq (car expr) '(+ - cplx sdev))
- (let ((cont (calcFunc-pcont (nth 1 expr) var)))
- (if (eq cont 1)
- 1
- (let ((c2 (calcFunc-pcont (nth 2 expr) var)))
- (if (and (math-negp cont)
- (if (eq (car expr) '-) (math-posp c2) (math-negp c2)))
- (math-neg (math-poly-gcd cont c2))
- (math-poly-gcd cont c2))))))
- (var expr)
- (t 1)))
-
-(defun calcFunc-pprim (expr &optional var)
- (let ((cont (calcFunc-pcont expr var)))
- (if (math-equal-int cont 1)
- expr
- (math-poly-div-exact expr cont var))))
-
-(defun math-div-poly-const (expr c)
- (cond ((memq (car-safe expr) '(+ -))
- (list (car expr)
- (math-div-poly-const (nth 1 expr) c)
- (math-div-poly-const (nth 2 expr) c)))
- (t (math-div expr c))))
-
-(defun calcFunc-pdeg (expr &optional var)
- (if (Math-zerop expr)
- '(neg (var inf var-inf))
- (if var
- (or (math-polynomial-p expr var)
- (math-reject-arg expr "Expected a polynomial"))
- (math-poly-degree expr))))
-
-(defun math-poly-degree (expr)
- (cond ((Math-primp expr)
- (if (eq (car-safe expr) 'var) 1 0))
- ((eq (car expr) 'neg)
- (math-poly-degree (nth 1 expr)))
- ((eq (car expr) '*)
- (+ (math-poly-degree (nth 1 expr))
- (math-poly-degree (nth 2 expr))))
- ((eq (car expr) '/)
- (- (math-poly-degree (nth 1 expr))
- (math-poly-degree (nth 2 expr))))
- ((and (eq (car expr) '^) (natnump (nth 2 expr)))
- (* (math-poly-degree (nth 1 expr)) (nth 2 expr)))
- ((memq (car expr) '(+ -))
- (max (math-poly-degree (nth 1 expr))
- (math-poly-degree (nth 2 expr))))
- (t 1)))
-
-(defun calcFunc-plead (expr var)
- (cond ((eq (car-safe expr) '*)
- (math-mul (calcFunc-plead (nth 1 expr) var)
- (calcFunc-plead (nth 2 expr) var)))
- ((eq (car-safe expr) '/)
- (math-div (calcFunc-plead (nth 1 expr) var)
- (calcFunc-plead (nth 2 expr) var)))
- ((and (eq (car-safe expr) '^) (math-natnump (nth 2 expr)))
- (math-pow (calcFunc-plead (nth 1 expr) var) (nth 2 expr)))
- ((Math-primp expr)
- (if (equal expr var)
- 1
- expr))
- (t
- (let ((p (math-is-polynomial expr var)))
- (if (cdr p)
- (nth (1- (length p)) p)
- 1)))))
-
-
-
-
-
-;;; Polynomial quotient, remainder, and GCD.
-;;; Originally by Ove Ewerlid (ewerlid@mizar.DoCS.UU.SE).
-;;; Modifications and simplifications by daveg.
-
-(defvar math-poly-modulus 1)
-
-;;; Return gcd of two polynomials
-(defun calcFunc-pgcd (pn pd)
- (if (math-any-floats pn)
- (math-reject-arg pn "Coefficients must be rational"))
- (if (math-any-floats pd)
- (math-reject-arg pd "Coefficients must be rational"))
- (let ((calc-prefer-frac t)
- (math-poly-modulus (math-poly-modulus pn pd)))
- (math-poly-gcd pn pd)))
-
-;;; Return only quotient to top of stack (nil if zero)
-(defun calcFunc-pdiv (pn pd &optional base)
- (let* ((calc-prefer-frac t)
- (math-poly-modulus (math-poly-modulus pn pd))
- (res (math-poly-div pn pd base)))
- (setq calc-poly-div-remainder (cdr res))
- (car res)))
-
-;;; Return only remainder to top of stack
-(defun calcFunc-prem (pn pd &optional base)
- (let ((calc-prefer-frac t)
- (math-poly-modulus (math-poly-modulus pn pd)))
- (cdr (math-poly-div pn pd base))))
-
-(defun calcFunc-pdivrem (pn pd &optional base)
- (let* ((calc-prefer-frac t)
- (math-poly-modulus (math-poly-modulus pn pd))
- (res (math-poly-div pn pd base)))
- (list 'vec (car res) (cdr res))))
-
-(defun calcFunc-pdivide (pn pd &optional base)
- (let* ((calc-prefer-frac t)
- (math-poly-modulus (math-poly-modulus pn pd))
- (res (math-poly-div pn pd base)))
- (math-add (car res) (math-div (cdr res) pd))))
-
-
-;;; Multiply two terms, expanding out products of sums.
-(defun math-mul-thru (lhs rhs)
- (if (memq (car-safe lhs) '(+ -))
- (list (car lhs)
- (math-mul-thru (nth 1 lhs) rhs)
- (math-mul-thru (nth 2 lhs) rhs))
- (if (memq (car-safe rhs) '(+ -))
- (list (car rhs)
- (math-mul-thru lhs (nth 1 rhs))
- (math-mul-thru lhs (nth 2 rhs)))
- (math-mul lhs rhs))))
-
-(defun math-div-thru (num den)
- (if (memq (car-safe num) '(+ -))
- (list (car num)
- (math-div-thru (nth 1 num) den)
- (math-div-thru (nth 2 num) den))
- (math-div num den)))
-
-
-;;; Sort the terms of a sum into canonical order.
-(defun math-sort-terms (expr)
- (if (memq (car-safe expr) '(+ -))
- (math-list-to-sum
- (sort (math-sum-to-list expr)
- (function (lambda (a b) (math-beforep (car a) (car b))))))
- expr))
-
-(defun math-list-to-sum (lst)
- (if (cdr lst)
- (list (if (cdr (car lst)) '- '+)
- (math-list-to-sum (cdr lst))
- (car (car lst)))
- (if (cdr (car lst))
- (math-neg (car (car lst)))
- (car (car lst)))))
-
-(defun math-sum-to-list (tree &optional neg)
- (cond ((eq (car-safe tree) '+)
- (nconc (math-sum-to-list (nth 1 tree) neg)
- (math-sum-to-list (nth 2 tree) neg)))
- ((eq (car-safe tree) '-)
- (nconc (math-sum-to-list (nth 1 tree) neg)
- (math-sum-to-list (nth 2 tree) (not neg))))
- (t (list (cons tree neg)))))
-
-;;; Check if the polynomial coefficients are modulo forms.
-(defun math-poly-modulus (expr &optional expr2)
- (or (math-poly-modulus-rec expr)
- (and expr2 (math-poly-modulus-rec expr2))
- 1))
-
-(defun math-poly-modulus-rec (expr)
- (if (and (eq (car-safe expr) 'mod) (Math-natnump (nth 2 expr)))
- (list 'mod 1 (nth 2 expr))
- (and (memq (car-safe expr) '(+ - * /))
- (or (math-poly-modulus-rec (nth 1 expr))
- (math-poly-modulus-rec (nth 2 expr))))))
-
-
-;;; Divide two polynomials. Return (quotient . remainder).
-(defvar math-poly-div-base nil)
-(defun math-poly-div (u v &optional math-poly-div-base)
- (if math-poly-div-base
- (math-do-poly-div u v)
- (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v))))
-
-(defun math-poly-div-exact (u v &optional base)
- (let ((res (math-poly-div u v base)))
- (if (eq (cdr res) 0)
- (car res)
- (math-reject-arg (list 'vec u v) "Argument is not a polynomial"))))
-
-(defun math-do-poly-div (u v)
- (cond ((math-constp u)
- (if (math-constp v)
- (cons (math-div u v) 0)
- (cons 0 u)))
- ((math-constp v)
- (cons (if (eq v 1)
- u
- (if (memq (car-safe u) '(+ -))
- (math-add-or-sub (math-poly-div-exact (nth 1 u) v)
- (math-poly-div-exact (nth 2 u) v)
- nil (eq (car u) '-))
- (math-div u v)))
- 0))
- ((Math-equal u v)
- (cons math-poly-modulus 0))
- ((and (math-atomic-factorp u) (math-atomic-factorp v))
- (cons (math-simplify (math-div u v)) 0))
- (t
- (let ((base (or math-poly-div-base
- (math-poly-div-base u v)))
- vp up res)
- (if (or (null base)
- (null (setq vp (math-is-polynomial v base nil 'gen))))
- (cons 0 u)
- (setq up (math-is-polynomial u base nil 'gen)
- res (math-poly-div-coefs up vp))
- (cons (math-build-polynomial-expr (car res) base)
- (math-build-polynomial-expr (cdr res) base)))))))
-
-(defun math-poly-div-rec (u v)
- (cond ((math-constp u)
- (math-div u v))
- ((math-constp v)
- (if (eq v 1)
- u
- (if (memq (car-safe u) '(+ -))
- (math-add-or-sub (math-poly-div-rec (nth 1 u) v)
- (math-poly-div-rec (nth 2 u) v)
- nil (eq (car u) '-))
- (math-div u v))))
- ((Math-equal u v) math-poly-modulus)
- ((and (math-atomic-factorp u) (math-atomic-factorp v))
- (math-simplify (math-div u v)))
- (math-poly-div-base
- (math-div u v))
- (t
- (let ((base (math-poly-div-base u v))
- vp up res)
- (if (or (null base)
- (null (setq vp (math-is-polynomial v base nil 'gen))))
- (math-div u v)
- (setq up (math-is-polynomial u base nil 'gen)
- res (math-poly-div-coefs up vp))
- (math-add (math-build-polynomial-expr (car res) base)
- (math-div (math-build-polynomial-expr (cdr res) base)
- v)))))))
-
-;;; Divide two polynomials in coefficient-list form. Return (quot . rem).
-(defun math-poly-div-coefs (u v)
- (cond ((null v) (math-reject-arg nil "Division by zero"))
- ((< (length u) (length v)) (cons nil u))
- ((cdr u)
- (let ((q nil)
- (urev (reverse u))
- (vrev (reverse v)))
- (while
- (let ((qk (math-poly-div-rec (math-simplify (car urev))
- (car vrev)))
- (up urev)
- (vp vrev))
- (if (or q (not (math-zerop qk)))
- (setq q (cons qk q)))
- (while (setq up (cdr up) vp (cdr vp))
- (setcar up (math-sub (car up) (math-mul-thru qk (car vp)))))
- (setq urev (cdr urev))
- up))
- (while (and urev (Math-zerop (car urev)))
- (setq urev (cdr urev)))
- (cons q (nreverse (mapcar 'math-simplify urev)))))
- (t
- (cons (list (math-poly-div-rec (car u) (car v)))
- nil))))
-
-;;; Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.)
-;;; This returns only the remainder from the pseudo-division.
-(defun math-poly-pseudo-div (u v)
- (cond ((null v) nil)
- ((< (length u) (length v)) u)
- ((or (cdr u) (cdr v))
- (let ((urev (reverse u))
- (vrev (reverse v))
- up)
- (while
- (let ((vp vrev))
- (setq up urev)
- (while (setq up (cdr up) vp (cdr vp))
- (setcar up (math-sub (math-mul-thru (car vrev) (car up))
- (math-mul-thru (car urev) (car vp)))))
- (setq urev (cdr urev))
- up)
- (while up
- (setcar up (math-mul-thru (car vrev) (car up)))
- (setq up (cdr up))))
- (while (and urev (Math-zerop (car urev)))
- (setq urev (cdr urev)))
- (nreverse (mapcar 'math-simplify urev))))
- (t nil)))
-
-;;; Compute the GCD of two multivariate polynomials.
-(defun math-poly-gcd (u v)
- (cond ((Math-equal u v) u)
- ((math-constp u)
- (if (Math-zerop u)
- v
- (calcFunc-gcd u (calcFunc-pcont v))))
- ((math-constp v)
- (if (Math-zerop v)
- v
- (calcFunc-gcd v (calcFunc-pcont u))))
- (t
- (let ((base (math-poly-gcd-base u v)))
- (if base
- (math-simplify
- (calcFunc-expand
- (math-build-polynomial-expr
- (math-poly-gcd-coefs (math-is-polynomial u base nil 'gen)
- (math-is-polynomial v base nil 'gen))
- base)))
- (calcFunc-gcd (calcFunc-pcont u) (calcFunc-pcont u)))))))
-
-(defun math-poly-div-list (lst a)
- (if (eq a 1)
- lst
- (if (eq a -1)
- (math-mul-list lst a)
- (mapcar (function (lambda (x) (math-poly-div-exact x a))) lst))))
-
-(defun math-mul-list (lst a)
- (if (eq a 1)
- lst
- (if (eq a -1)
- (mapcar 'math-neg lst)
- (and (not (eq a 0))
- (mapcar (function (lambda (x) (math-mul x a))) lst)))))
-
-;;; Run GCD on all elements in a list.
-(defun math-poly-gcd-list (lst)
- (if (or (memq 1 lst) (memq -1 lst))
- (math-poly-gcd-frac-list lst)
- (let ((gcd (car lst)))
- (while (and (setq lst (cdr lst)) (not (eq gcd 1)))
- (or (eq (car lst) 0)
- (setq gcd (math-poly-gcd gcd (car lst)))))
- (if lst (setq lst (math-poly-gcd-frac-list lst)))
- gcd)))
-
-(defun math-poly-gcd-frac-list (lst)
- (while (and lst (not (eq (car-safe (car lst)) 'frac)))
- (setq lst (cdr lst)))
- (if lst
- (let ((denom (nth 2 (car lst))))
- (while (setq lst (cdr lst))
- (if (eq (car-safe (car lst)) 'frac)
- (setq denom (calcFunc-lcm denom (nth 2 (car lst))))))
- (list 'frac 1 denom))
- 1))
-
-;;; Compute the GCD of two monovariate polynomial lists.
-;;; Knuth section 4.6.1, algorithm C.
-(defun math-poly-gcd-coefs (u v)
- (let ((d (math-poly-gcd (math-poly-gcd-list u)
- (math-poly-gcd-list v)))
- (g 1) (h 1) (z 0) hh r delta ghd)
- (while (and u v (Math-zerop (car u)) (Math-zerop (car v)))
- (setq u (cdr u) v (cdr v) z (1+ z)))
- (or (eq d 1)
- (setq u (math-poly-div-list u d)
- v (math-poly-div-list v d)))
- (while (progn
- (setq delta (- (length u) (length v)))
- (if (< delta 0)
- (setq r u u v v r delta (- delta)))
- (setq r (math-poly-pseudo-div u v))
- (cdr r))
- (setq u v
- v (math-poly-div-list r (math-mul g (math-pow h delta)))
- g (nth (1- (length u)) u)
- h (if (<= delta 1)
- (math-mul (math-pow g delta) (math-pow h (- 1 delta)))
- (math-poly-div-exact (math-pow g delta)
- (math-pow h (1- delta))))))
- (setq v (if r
- (list d)
- (math-mul-list (math-poly-div-list v (math-poly-gcd-list v)) d)))
- (if (math-guess-if-neg (nth (1- (length v)) v))
- (setq v (math-mul-list v -1)))
- (while (>= (setq z (1- z)) 0)
- (setq v (cons 0 v)))
- v))
-
-
-;;; Return true if is a factor containing no sums or quotients.
-(defun math-atomic-factorp (expr)
- (cond ((eq (car-safe expr) '*)
- (and (math-atomic-factorp (nth 1 expr))
- (math-atomic-factorp (nth 2 expr))))
- ((memq (car-safe expr) '(+ - /))
- nil)
- ((memq (car-safe expr) '(^ neg))
- (math-atomic-factorp (nth 1 expr)))
- (t t)))
-
-;;; Find a suitable base for dividing a by b.
-;;; The base must exist in both expressions.
-;;; The degree in the numerator must be higher or equal than the
-;;; degree in the denominator.
-;;; If the above conditions are not met the quotient is just a remainder.
-;;; Return nil if this is the case.
-
-(defun math-poly-div-base (a b)
- (let (a-base b-base)
- (and (setq a-base (math-total-polynomial-base a))
- (setq b-base (math-total-polynomial-base b))
- (catch 'return
- (while a-base
- (let ((maybe (assoc (car (car a-base)) b-base)))
- (if maybe
- (if (>= (nth 1 (car a-base)) (nth 1 maybe))
- (throw 'return (car (car a-base))))))
- (setq a-base (cdr a-base)))))))
-
-;;; Same as above but for gcd algorithm.
-;;; Here there is no requirement that degree(a) > degree(b).
-;;; Take the base that has the highest degree considering both a and b.
-;;; ("a^20+b^21+x^3+a+b", "a+b^2+x^5+a^22+b^10") --> (a 22)
-
-(defun math-poly-gcd-base (a b)
- (let (a-base b-base)
- (and (setq a-base (math-total-polynomial-base a))
- (setq b-base (math-total-polynomial-base b))
- (catch 'return
- (while (and a-base b-base)
- (if (> (nth 1 (car a-base)) (nth 1 (car b-base)))
- (if (assoc (car (car a-base)) b-base)
- (throw 'return (car (car a-base)))
- (setq a-base (cdr a-base)))
- (if (assoc (car (car b-base)) a-base)
- (throw 'return (car (car b-base)))
- (setq b-base (cdr b-base)))))))))
-
-;;; Sort a list of polynomial bases.
-(defun math-sort-poly-base-list (lst)
- (sort lst (function (lambda (a b)
- (or (> (nth 1 a) (nth 1 b))
- (and (= (nth 1 a) (nth 1 b))
- (math-beforep (car a) (car b))))))))
-
-;;; Given an expression find all variables that are polynomial bases.
-;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
-;;; Note dynamic scope of mpb-total-base.
-(defun math-total-polynomial-base (expr)
- (let ((mpb-total-base nil))
- (math-polynomial-base expr 'math-polynomial-p1)
- (math-sort-poly-base-list mpb-total-base)))
-
-(defun math-polynomial-p1 (subexpr)
- (or (assoc subexpr mpb-total-base)
- (memq (car subexpr) '(+ - * / neg))
- (and (eq (car subexpr) '^) (natnump (nth 2 subexpr)))
- (let* ((math-poly-base-variable subexpr)
- (exponent (math-polynomial-p mpb-top-expr subexpr)))
- (if exponent
- (setq mpb-total-base (cons (list subexpr exponent)
- mpb-total-base)))))
- nil)
-
-
-
-
-(defun calcFunc-factors (expr &optional var)
- (let ((math-factored-vars (if var t nil))
- (math-to-list t)
- (calc-prefer-frac t))
- (or var
- (setq var (math-polynomial-base expr)))
- (let ((res (math-factor-finish
- (or (catch 'factor (math-factor-expr-try var))
- expr))))
- (math-simplify (if (math-vectorp res)
- res
- (list 'vec (list 'vec res 1)))))))
-
-(defun calcFunc-factor (expr &optional var)
- (let ((math-factored-vars nil)
- (math-to-list nil)
- (calc-prefer-frac t))
- (math-simplify (math-factor-finish
- (if var
- (let ((math-factored-vars t))
- (or (catch 'factor (math-factor-expr-try var)) expr))
- (math-factor-expr expr))))))
-
-(defun math-factor-finish (x)
- (if (Math-primp x)
- x
- (if (eq (car x) 'calcFunc-Fac-Prot)
- (math-factor-finish (nth 1 x))
- (cons (car x) (mapcar 'math-factor-finish (cdr x))))))
-
-(defun math-factor-protect (x)
- (if (memq (car-safe x) '(+ -))
- (list 'calcFunc-Fac-Prot x)
- x))
-
-(defun math-factor-expr (expr)
- (cond ((eq math-factored-vars t) expr)
- ((or (memq (car-safe expr) '(* / ^ neg))
- (assq (car-safe expr) calc-tweak-eqn-table))
- (cons (car expr) (mapcar 'math-factor-expr (cdr expr))))
- ((memq (car-safe expr) '(+ -))
- (let* ((math-factored-vars math-factored-vars)
- (y (catch 'factor (math-factor-expr-part expr))))
- (if y
- (math-factor-expr y)
- expr)))
- (t expr)))
-
-(defun math-factor-expr-part (x) ; uses "expr"
- (if (memq (car-safe x) '(+ - * / ^ neg))
- (while (setq x (cdr x))
- (math-factor-expr-part (car x)))
- (and (not (Math-objvecp x))
- (not (assoc x math-factored-vars))
- (> (math-factor-contains expr x) 1)
- (setq math-factored-vars (cons (list x) math-factored-vars))
- (math-factor-expr-try x))))
-
-(defun math-factor-expr-try (x)
- (if (eq (car-safe expr) '*)
- (let ((res1 (catch 'factor (let ((expr (nth 1 expr)))
- (math-factor-expr-try x))))
- (res2 (catch 'factor (let ((expr (nth 2 expr)))
- (math-factor-expr-try x)))))
- (and (or res1 res2)
- (throw 'factor (math-accum-factors (or res1 (nth 1 expr)) 1
- (or res2 (nth 2 expr))))))
- (let* ((p (math-is-polynomial expr x 30 'gen))
- (math-poly-modulus (math-poly-modulus expr))
- res)
- (and (cdr p)
- (setq res (math-factor-poly-coefs p))
- (throw 'factor res)))))
-
-(defun math-accum-factors (fac pow facs)
- (if math-to-list
- (if (math-vectorp fac)
- (progn
- (while (setq fac (cdr fac))
- (setq facs (math-accum-factors (nth 1 (car fac))
- (* pow (nth 2 (car fac)))
- facs)))
- facs)
- (if (and (eq (car-safe fac) '^) (natnump (nth 2 fac)))
- (setq pow (* pow (nth 2 fac))
- fac (nth 1 fac)))
- (if (eq fac 1)
- facs
- (or (math-vectorp facs)
- (setq facs (if (eq facs 1) '(vec)
- (list 'vec (list 'vec facs 1)))))
- (let ((found facs))
- (while (and (setq found (cdr found))
- (not (equal fac (nth 1 (car found))))))
- (if found
- (progn
- (setcar (cdr (cdr (car found))) (+ pow (nth 2 (car found))))
- facs)
- ;; Put constant term first.
- (if (and (cdr facs) (Math-ratp (nth 1 (nth 1 facs))))
- (cons 'vec (cons (nth 1 facs) (cons (list 'vec fac pow)
- (cdr (cdr facs)))))
- (cons 'vec (cons (list 'vec fac pow) (cdr facs))))))))
- (math-mul (math-pow fac pow) facs)))
-
-(defun math-factor-poly-coefs (p &optional square-free) ; uses "x"
- (let (t1 t2)
- (cond ((not (cdr p))
- (or (car p) 0))
-
- ;; Strip off multiples of x.
- ((Math-zerop (car p))
- (let ((z 0))
- (while (and p (Math-zerop (car p)))
- (setq z (1+ z) p (cdr p)))
- (if (cdr p)
- (setq p (math-factor-poly-coefs p square-free))
- (setq p (math-sort-terms (math-factor-expr (car p)))))
- (math-accum-factors x z (math-factor-protect p))))
-
- ;; Factor out content.
- ((and (not square-free)
- (not (eq 1 (setq t1 (math-mul (math-poly-gcd-list p)
- (if (math-guess-if-neg
- (nth (1- (length p)) p))
- -1 1))))))
- (math-accum-factors t1 1 (math-factor-poly-coefs
- (math-poly-div-list p t1) 'cont)))
-
- ;; Check if linear in x.
- ((not (cdr (cdr p)))
- (math-add (math-factor-protect
- (math-sort-terms
- (math-factor-expr (car p))))
- (math-mul x (math-factor-protect
- (math-sort-terms
- (math-factor-expr (nth 1 p)))))))
-
- ;; If symbolic coefficients, use FactorRules.
- ((let ((pp p))
- (while (and pp (or (Math-ratp (car pp))
- (and (eq (car (car pp)) 'mod)
- (Math-integerp (nth 1 (car pp)))
- (Math-integerp (nth 2 (car pp))))))
- (setq pp (cdr pp)))
- pp)
- (let ((res (math-rewrite
- (list 'calcFunc-thecoefs x (cons 'vec p))
- '(var FactorRules var-FactorRules))))
- (or (and (eq (car-safe res) 'calcFunc-thefactors)
- (= (length res) 3)
- (math-vectorp (nth 2 res))
- (let ((facs 1)
- (vec (nth 2 res)))
- (while (setq vec (cdr vec))
- (setq facs (math-accum-factors (car vec) 1 facs)))
- facs))
- (math-build-polynomial-expr p x))))
-
- ;; Check if rational coefficients (i.e., not modulo a prime).
- ((eq math-poly-modulus 1)
-
- ;; Check if there are any squared terms, or a content not = 1.
- (if (or (eq square-free t)
- (equal (setq t1 (math-poly-gcd-coefs
- p (setq t2 (math-poly-deriv-coefs p))))
- '(1)))
-
- ;; We now have a square-free polynomial with integer coefs.
- ;; For now, we use a kludgey method that finds linear and
- ;; quadratic terms using floating-point root-finding.
- (if (setq t1 (let ((calc-symbolic-mode nil))
- (math-poly-all-roots nil p t)))
- (let ((roots (car t1))
- (csign (if (math-negp (nth (1- (length p)) p)) -1 1))
- (expr 1)
- (unfac (nth 1 t1))
- (scale (nth 2 t1)))
- (while roots
- (let ((coef0 (car (car roots)))
- (coef1 (cdr (car roots))))
- (setq expr (math-accum-factors
- (if coef1
- (let ((den (math-lcm-denoms
- coef0 coef1)))
- (setq scale (math-div scale den))
- (math-add
- (math-add
- (math-mul den (math-pow x 2))
- (math-mul (math-mul coef1 den) x))
- (math-mul coef0 den)))
- (let ((den (math-lcm-denoms coef0)))
- (setq scale (math-div scale den))
- (math-add (math-mul den x)
- (math-mul coef0 den))))
- 1 expr)
- roots (cdr roots))))
- (setq expr (math-accum-factors
- expr 1
- (math-mul csign
- (math-build-polynomial-expr
- (math-mul-list (nth 1 t1) scale)
- x)))))
- (math-build-polynomial-expr p x)) ; can't factor it.
-
- ;; Separate out the squared terms (Knuth exercise 4.6.2-34).
- ;; This step also divides out the content of the polynomial.
- (let* ((cabs (math-poly-gcd-list p))
- (csign (if (math-negp (nth (1- (length p)) p)) -1 1))
- (t1s (math-mul-list t1 csign))
- (uu nil)
- (v (car (math-poly-div-coefs p t1s)))
- (w (car (math-poly-div-coefs t2 t1s))))
- (while
- (not (math-poly-zerop
- (setq t2 (math-poly-simplify
- (math-poly-mix
- w 1 (math-poly-deriv-coefs v) -1)))))
- (setq t1 (math-poly-gcd-coefs v t2)
- uu (cons t1 uu)
- v (car (math-poly-div-coefs v t1))
- w (car (math-poly-div-coefs t2 t1))))
- (setq t1 (length uu)
- t2 (math-accum-factors (math-factor-poly-coefs v t)
- (1+ t1) 1))
- (while uu
- (setq t2 (math-accum-factors (math-factor-poly-coefs
- (car uu) t)
- t1 t2)
- t1 (1- t1)
- uu (cdr uu)))
- (math-accum-factors (math-mul cabs csign) 1 t2))))
-
- ;; Factoring modulo a prime.
- ((and (= (length (setq temp (math-poly-gcd-coefs
- p (math-poly-deriv-coefs p))))
- (length p)))
- (setq p (car temp))
- (while (cdr temp)
- (setq temp (nthcdr (nth 2 math-poly-modulus) temp)
- p (cons (car temp) p)))
- (and (setq temp (math-factor-poly-coefs p))
- (math-pow temp (nth 2 math-poly-modulus))))
- (t
- (math-reject-arg nil "*Modulo factorization not yet implemented")))))
-
-(defun math-poly-deriv-coefs (p)
- (let ((n 1)
- (dp nil))
- (while (setq p (cdr p))
- (setq dp (cons (math-mul (car p) n) dp)
- n (1+ n)))
- (nreverse dp)))
-
-(defun math-factor-contains (x a)
- (if (equal x a)
- 1
- (if (memq (car-safe x) '(+ - * / neg))
- (let ((sum 0))
- (while (setq x (cdr x))
- (setq sum (+ sum (math-factor-contains (car x) a))))
- sum)
- (if (and (eq (car-safe x) '^)
- (natnump (nth 2 x)))
- (* (math-factor-contains (nth 1 x) a) (nth 2 x))
- 0))))
-
-
-
-
-
-;;; Merge all quotients and expand/simplify the numerator
-(defun calcFunc-nrat (expr)
- (if (math-any-floats expr)
- (setq expr (calcFunc-pfrac expr)))
- (if (or (math-vectorp expr)
- (assq (car-safe expr) calc-tweak-eqn-table))
- (cons (car expr) (mapcar 'calcFunc-nrat (cdr expr)))
- (let* ((calc-prefer-frac t)
- (res (math-to-ratpoly expr))
- (num (math-simplify (math-sort-terms (calcFunc-expand (car res)))))
- (den (math-simplify (math-sort-terms (calcFunc-expand (cdr res)))))
- (g (math-poly-gcd num den)))
- (or (eq g 1)
- (let ((num2 (math-poly-div num g))
- (den2 (math-poly-div den g)))
- (and (eq (cdr num2) 0) (eq (cdr den2) 0)
- (setq num (car num2) den (car den2)))))
- (math-simplify (math-div num den)))))
-
-;;; Returns expressions (num . denom).
-(defun math-to-ratpoly (expr)
- (let ((res (math-to-ratpoly-rec expr)))
- (cons (math-simplify (car res)) (math-simplify (cdr res)))))
-
-(defun math-to-ratpoly-rec (expr)
- (cond ((Math-primp expr)
- (cons expr 1))
- ((memq (car expr) '(+ -))
- (let ((r1 (math-to-ratpoly-rec (nth 1 expr)))
- (r2 (math-to-ratpoly-rec (nth 2 expr))))
- (if (equal (cdr r1) (cdr r2))
- (cons (list (car expr) (car r1) (car r2)) (cdr r1))
- (if (eq (cdr r1) 1)
- (cons (list (car expr)
- (math-mul (car r1) (cdr r2))
- (car r2))
- (cdr r2))
- (if (eq (cdr r2) 1)
- (cons (list (car expr)
- (car r1)
- (math-mul (car r2) (cdr r1)))
- (cdr r1))
- (let ((g (math-poly-gcd (cdr r1) (cdr r2))))
- (let ((d1 (and (not (eq g 1)) (math-poly-div (cdr r1) g)))
- (d2 (and (not (eq g 1)) (math-poly-div
- (math-mul (car r1) (cdr r2))
- g))))
- (if (and (eq (cdr d1) 0) (eq (cdr d2) 0))
- (cons (list (car expr) (car d2)
- (math-mul (car r2) (car d1)))
- (math-mul (car d1) (cdr r2)))
- (cons (list (car expr)
- (math-mul (car r1) (cdr r2))
- (math-mul (car r2) (cdr r1)))
- (math-mul (cdr r1) (cdr r2)))))))))))
- ((eq (car expr) '*)
- (let* ((r1 (math-to-ratpoly-rec (nth 1 expr)))
- (r2 (math-to-ratpoly-rec (nth 2 expr)))
- (g (math-mul (math-poly-gcd (car r1) (cdr r2))
- (math-poly-gcd (cdr r1) (car r2)))))
- (if (eq g 1)
- (cons (math-mul (car r1) (car r2))
- (math-mul (cdr r1) (cdr r2)))
- (cons (math-poly-div-exact (math-mul (car r1) (car r2)) g)
- (math-poly-div-exact (math-mul (cdr r1) (cdr r2)) g)))))
- ((eq (car expr) '/)
- (let* ((r1 (math-to-ratpoly-rec (nth 1 expr)))
- (r2 (math-to-ratpoly-rec (nth 2 expr))))
- (if (and (eq (cdr r1) 1) (eq (cdr r2) 1))
- (cons (car r1) (car r2))
- (let ((g (math-mul (math-poly-gcd (car r1) (car r2))
- (math-poly-gcd (cdr r1) (cdr r2)))))
- (if (eq g 1)
- (cons (math-mul (car r1) (cdr r2))
- (math-mul (cdr r1) (car r2)))
- (cons (math-poly-div-exact (math-mul (car r1) (cdr r2)) g)
- (math-poly-div-exact (math-mul (cdr r1) (car r2))
- g)))))))
- ((and (eq (car expr) '^) (integerp (nth 2 expr)))
- (let ((r1 (math-to-ratpoly-rec (nth 1 expr))))
- (if (> (nth 2 expr) 0)
- (cons (math-pow (car r1) (nth 2 expr))
- (math-pow (cdr r1) (nth 2 expr)))
- (cons (math-pow (cdr r1) (- (nth 2 expr)))
- (math-pow (car r1) (- (nth 2 expr)))))))
- ((eq (car expr) 'neg)
- (let ((r1 (math-to-ratpoly-rec (nth 1 expr))))
- (cons (math-neg (car r1)) (cdr r1))))
- (t (cons expr 1))))
-
-
-(defun math-ratpoly-p (expr &optional var)
- (cond ((equal expr var) 1)
- ((Math-primp expr) 0)
- ((memq (car expr) '(+ -))
- (let ((p1 (math-ratpoly-p (nth 1 expr) var))
- p2)
- (and p1 (setq p2 (math-ratpoly-p (nth 2 expr) var))
- (max p1 p2))))
- ((eq (car expr) '*)
- (let ((p1 (math-ratpoly-p (nth 1 expr) var))
- p2)
- (and p1 (setq p2 (math-ratpoly-p (nth 2 expr) var))
- (+ p1 p2))))
- ((eq (car expr) 'neg)
- (math-ratpoly-p (nth 1 expr) var))
- ((eq (car expr) '/)
- (let ((p1 (math-ratpoly-p (nth 1 expr) var))
- p2)
- (and p1 (setq p2 (math-ratpoly-p (nth 2 expr) var))
- (- p1 p2))))
- ((and (eq (car expr) '^)
- (integerp (nth 2 expr)))
- (let ((p1 (math-ratpoly-p (nth 1 expr) var)))
- (and p1 (* p1 (nth 2 expr)))))
- ((not var) 1)
- ((math-poly-depends expr var) nil)
- (t 0)))
-
-
-(defun calcFunc-apart (expr &optional var)
- (cond ((Math-primp expr) expr)
- ((eq (car expr) '+)
- (math-add (calcFunc-apart (nth 1 expr) var)
- (calcFunc-apart (nth 2 expr) var)))
- ((eq (car expr) '-)
- (math-sub (calcFunc-apart (nth 1 expr) var)
- (calcFunc-apart (nth 2 expr) var)))
- ((not (math-ratpoly-p expr var))
- (math-reject-arg expr "Expected a rational function"))
- (t
- (let* ((calc-prefer-frac t)
- (rat (math-to-ratpoly expr))
- (num (car rat))
- (den (cdr rat))
- (qr (math-poly-div num den))
- (q (car qr))
- (r (cdr qr)))
- (or var
- (setq var (math-polynomial-base den)))
- (math-add q (or (and var
- (math-expr-contains den var)
- (math-partial-fractions r den var))
- (math-div r den)))))))
-
-
-(defun math-padded-polynomial (expr var deg)
- (let ((p (math-is-polynomial expr var deg)))
- (append p (make-list (- deg (length p)) 0))))
-
-(defun math-partial-fractions (r den var)
- (let* ((fden (calcFunc-factors den var))
- (tdeg (math-polynomial-p den var))
- (fp fden)
- (dlist nil)
- (eqns 0)
- (lz nil)
- (tz (make-list (1- tdeg) 0))
- (calc-matrix-mode 'scalar))
- (and (not (and (= (length fden) 2) (eq (nth 2 (nth 1 fden)) 1)))
- (progn
- (while (setq fp (cdr fp))
- (let ((rpt (nth 2 (car fp)))
- (deg (math-polynomial-p (nth 1 (car fp)) var))
- dnum dvar deg2)
- (while (> rpt 0)
- (setq deg2 deg
- dnum 0)
- (while (> deg2 0)
- (setq dvar (append '(vec) lz '(1) tz)
- lz (cons 0 lz)
- tz (cdr tz)
- deg2 (1- deg2)
- dnum (math-add dnum (math-mul dvar
- (math-pow var deg2)))
- dlist (cons (and (= deg2 (1- deg))
- (math-pow (nth 1 (car fp)) rpt))
- dlist)))
- (let ((fpp fden)
- (mult 1))
- (while (setq fpp (cdr fpp))
- (or (eq fpp fp)
- (setq mult (math-mul mult
- (math-pow (nth 1 (car fpp))
- (nth 2 (car fpp)))))))
- (setq dnum (math-mul dnum mult)))
- (setq eqns (math-add eqns (math-mul dnum
- (math-pow
- (nth 1 (car fp))
- (- (nth 2 (car fp))
- rpt))))
- rpt (1- rpt)))))
- (setq eqns (math-div (cons 'vec (math-padded-polynomial r var tdeg))
- (math-transpose
- (cons 'vec
- (mapcar
- (function
- (lambda (x)
- (cons 'vec (math-padded-polynomial
- x var tdeg))))
- (cdr eqns))))))
- (and (math-vectorp eqns)
- (let ((res 0)
- (num nil))
- (setq eqns (nreverse eqns))
- (while eqns
- (setq num (cons (car eqns) num)
- eqns (cdr eqns))
- (if (car dlist)
- (setq num (math-build-polynomial-expr
- (nreverse num) var)
- res (math-add res (math-div num (car dlist)))
- num nil))
- (setq dlist (cdr dlist)))
- (math-normalize res)))))))
-
-
-
-(defun math-expand-term (expr)
- (cond ((and (eq (car-safe expr) '*)
- (memq (car-safe (nth 1 expr)) '(+ -)))
- (math-add-or-sub (list '* (nth 1 (nth 1 expr)) (nth 2 expr))
- (list '* (nth 2 (nth 1 expr)) (nth 2 expr))
- nil (eq (car (nth 1 expr)) '-)))
- ((and (eq (car-safe expr) '*)
- (memq (car-safe (nth 2 expr)) '(+ -)))
- (math-add-or-sub (list '* (nth 1 expr) (nth 1 (nth 2 expr)))
- (list '* (nth 1 expr) (nth 2 (nth 2 expr)))
- nil (eq (car (nth 2 expr)) '-)))
- ((and (eq (car-safe expr) '/)
- (memq (car-safe (nth 1 expr)) '(+ -)))
- (math-add-or-sub (list '/ (nth 1 (nth 1 expr)) (nth 2 expr))
- (list '/ (nth 2 (nth 1 expr)) (nth 2 expr))
- nil (eq (car (nth 1 expr)) '-)))
- ((and (eq (car-safe expr) '^)
- (memq (car-safe (nth 1 expr)) '(+ -))
- (integerp (nth 2 expr))
- (if (> (nth 2 expr) 0)
- (or (and (or (> mmt-many 500000) (< mmt-many -500000))
- (math-expand-power (nth 1 expr) (nth 2 expr)
- nil t))
- (list '*
- (nth 1 expr)
- (list '^ (nth 1 expr) (1- (nth 2 expr)))))
- (if (< (nth 2 expr) 0)
- (list '/ 1 (list '^ (nth 1 expr) (- (nth 2 expr))))))))
- (t expr)))
-
-(defun calcFunc-expand (expr &optional many)
- (math-normalize (math-map-tree 'math-expand-term expr many)))
-
-(defun math-expand-power (x n &optional var else-nil)
- (or (and (natnump n)
- (memq (car-safe x) '(+ -))
- (let ((terms nil)
- (cterms nil))
- (while (memq (car-safe x) '(+ -))
- (setq terms (cons (if (eq (car x) '-)
- (math-neg (nth 2 x))
- (nth 2 x))
- terms)
- x (nth 1 x)))
- (setq terms (cons x terms))
- (if var
- (let ((p terms))
- (while p
- (or (math-expr-contains (car p) var)
- (setq terms (delq (car p) terms)
- cterms (cons (car p) cterms)))
- (setq p (cdr p)))
- (if cterms
- (setq terms (cons (apply 'calcFunc-add cterms)
- terms)))))
- (if (= (length terms) 2)
- (let ((i 0)
- (accum 0))
- (while (<= i n)
- (setq accum (list '+ accum
- (list '* (calcFunc-choose n i)
- (list '*
- (list '^ (nth 1 terms) i)
- (list '^ (car terms)
- (- n i)))))
- i (1+ i)))
- accum)
- (if (= n 2)
- (let ((accum 0)
- (p1 terms)
- p2)
- (while p1
- (setq accum (list '+ accum
- (list '^ (car p1) 2))
- p2 p1)
- (while (setq p2 (cdr p2))
- (setq accum (list '+ accum
- (list '* 2 (list '*
- (car p1)
- (car p2))))))
- (setq p1 (cdr p1)))
- accum)
- (if (= n 3)
- (let ((accum 0)
- (p1 terms)
- p2 p3)
- (while p1
- (setq accum (list '+ accum (list '^ (car p1) 3))
- p2 p1)
- (while (setq p2 (cdr p2))
- (setq accum (list '+
- (list '+
- accum
- (list '* 3
- (list
- '*
- (list '^ (car p1) 2)
- (car p2))))
- (list '* 3
- (list
- '* (car p1)
- (list '^ (car p2) 2))))
- p3 p2)
- (while (setq p3 (cdr p3))
- (setq accum (list '+ accum
- (list '* 6
- (list '*
- (car p1)
- (list
- '* (car p2)
- (car p3))))))))
- (setq p1 (cdr p1)))
- accum))))))
- (and (not else-nil)
- (list '^ x n))))
-
-(defun calcFunc-expandpow (x n)
- (math-normalize (math-expand-power x n)))
-
-;;; calc-poly.el ends here
+++ /dev/null
-;;; calc-prog.el --- user programmability functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-prog () nil)
-
-
-(defun calc-equal-to (arg)
- (interactive "P")
- (calc-wrapper
- (if (and (integerp arg) (> arg 2))
- (calc-enter-result arg "eq" (cons 'calcFunc-eq (calc-top-list-n arg)))
- (calc-binary-op "eq" 'calcFunc-eq arg))))
-
-(defun calc-remove-equal (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "rmeq" 'calcFunc-rmeq arg)))
-
-(defun calc-not-equal-to (arg)
- (interactive "P")
- (calc-wrapper
- (if (and (integerp arg) (> arg 2))
- (calc-enter-result arg "neq" (cons 'calcFunc-neq (calc-top-list-n arg)))
- (calc-binary-op "neq" 'calcFunc-neq arg))))
-
-(defun calc-less-than (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "lt" 'calcFunc-lt arg)))
-
-(defun calc-greater-than (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "gt" 'calcFunc-gt arg)))
-
-(defun calc-less-equal (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "leq" 'calcFunc-leq arg)))
-
-(defun calc-greater-equal (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "geq" 'calcFunc-geq arg)))
-
-(defun calc-in-set (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "in" 'calcFunc-in arg)))
-
-(defun calc-logical-and (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "land" 'calcFunc-land arg 1)))
-
-(defun calc-logical-or (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "lor" 'calcFunc-lor arg 0)))
-
-(defun calc-logical-not (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "lnot" 'calcFunc-lnot arg)))
-
-(defun calc-logical-if ()
- (interactive)
- (calc-wrapper
- (calc-enter-result 3 "if" (cons 'calcFunc-if (calc-top-list-n 3)))))
-
-
-
-
-
-(defun calc-timing (n)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-timing n nil t)
- (message (if calc-timing
- "Reporting timing of slow commands in Trail"
- "Not reporting timing of commands"))))
-
-(defun calc-pass-errors ()
- (interactive)
- ;; The following two cases are for the new, optimizing byte compiler
- ;; or the standard 18.57 byte compiler, respectively.
- (condition-case err
- (let ((place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 15)))
- (or (memq (car-safe (car-safe place)) '(error xxxerror))
- (setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27)))
- (or (memq (car (car place)) '(error xxxerror))
- (error "foo"))
- (setcar (car place) 'xxxerror))
- (error (error "The calc-do function has been modified; unable to patch"))))
-
-(defun calc-user-define ()
- (interactive)
- (message "Define user key: z-")
- (let ((key (read-char)))
- (if (= (calc-user-function-classify key) 0)
- (error "Can't redefine \"?\" key"))
- (let ((func (intern (completing-read (concat "Set key z "
- (char-to-string key)
- " to command: ")
- obarray
- 'commandp
- t
- "calc-"))))
- (let* ((kmap (calc-user-key-map))
- (old (assq key kmap)))
- (if old
- (setcdr old func)
- (setcdr kmap (cons (cons key func) (cdr kmap))))))))
-
-(defun calc-user-undefine ()
- (interactive)
- (message "Undefine user key: z-")
- (let ((key (read-char)))
- (if (= (calc-user-function-classify key) 0)
- (error "Can't undefine \"?\" key"))
- (let* ((kmap (calc-user-key-map)))
- (delq (or (assq key kmap)
- (assq (upcase key) kmap)
- (assq (downcase key) kmap)
- (error "No such user key is defined"))
- kmap))))
-
-(defun calc-user-define-formula ()
- (interactive)
- (calc-wrapper
- (let* ((form (calc-top 1))
- (arglist nil)
- (is-lambda (and (eq (car-safe form) 'calcFunc-lambda)
- (>= (length form) 2)))
- odef key keyname cmd cmd-base func alist is-symb)
- (if is-lambda
- (setq arglist (mapcar (function (lambda (x) (nth 1 x)))
- (nreverse (cdr (reverse (cdr form)))))
- form (nth (1- (length form)) form))
- (calc-default-formula-arglist form)
- (setq arglist (sort arglist 'string-lessp)))
- (message "Define user key: z-")
- (setq key (read-char))
- (if (= (calc-user-function-classify key) 0)
- (error "Can't redefine \"?\" key"))
- (setq key (and (not (memq key '(13 32))) key)
- keyname (and key
- (if (or (and (<= ?0 key) (<= key ?9))
- (and (<= ?a key) (<= key ?z))
- (and (<= ?A key) (<= key ?Z)))
- (char-to-string key)
- (format "%03d" key)))
- odef (assq key (calc-user-key-map)))
- (while
- (progn
- (setq cmd (completing-read "Define M-x command name: "
- obarray 'commandp nil
- (if (and odef (symbolp (cdr odef)))
- (symbol-name (cdr odef))
- "calc-"))
- cmd-base (and (string-match "\\`calc-\\(.+\\)\\'" cmd)
- (math-match-substring cmd 1))
- cmd (and (not (or (string-equal cmd "")
- (string-equal cmd "calc-")))
- (intern cmd)))
- (and cmd
- (fboundp cmd)
- odef
- (not
- (y-or-n-p
- (if (get cmd 'calc-user-defn)
- (concat "Replace previous definition for "
- (symbol-name cmd) "? ")
- "That name conflicts with a built-in Emacs function. Replace this function? "))))))
- (if (and key (not cmd))
- (setq cmd (intern (concat "calc-User-" keyname))))
- (while
- (progn
- (setq func (completing-read "Define algebraic function name: "
- obarray 'fboundp nil
- (concat "calcFunc-"
- (if cmd-base
- (if (string-match
- "\\`User-.+" cmd-base)
- (concat
- "User"
- (substring cmd-base 5))
- cmd-base)
- "")))
- func (and (not (or (string-equal func "")
- (string-equal func "calcFunc-")))
- (intern func)))
- (and func
- (fboundp func)
- (not (fboundp cmd))
- odef
- (not
- (y-or-n-p
- (if (get func 'calc-user-defn)
- (concat "Replace previous definition for "
- (symbol-name func) "? ")
- "That name conflicts with a built-in Emacs function. Replace this function? "))))))
- (if (not func)
- (setq func (intern (concat "calcFunc-User"
- (or keyname
- (and cmd (symbol-name cmd))
- (format "%05d" (% (random) 10000)))))))
- (if is-lambda
- (setq alist arglist)
- (while
- (progn
- (setq alist (read-from-minibuffer "Function argument list: "
- (if arglist
- (prin1-to-string arglist)
- "()")
- minibuffer-local-map
- t))
- (and (not (calc-subsetp alist arglist))
- (not (y-or-n-p
- "Okay for arguments that don't appear in formula to be ignored? "))))))
- (setq is-symb (and alist
- func
- (y-or-n-p
- "Leave it symbolic for non-constant arguments? ")))
- (setq alist (mapcar (function (lambda (x)
- (or (cdr (assq x '((nil . arg-nil)
- (t . arg-t))))
- x))) alist))
- (if cmd
- (progn
- (calc-need-macros)
- (fset cmd
- (list 'lambda
- '()
- '(interactive)
- (list 'calc-wrapper
- (list 'calc-enter-result
- (length alist)
- (let ((name (symbol-name (or func cmd))))
- (and (string-match
- "\\([^-][^-]?[^-]?[^-]?\\)[^-]*\\'"
- name)
- (math-match-substring name 1)))
- (list 'cons
- (list 'quote func)
- (list 'calc-top-list-n
- (length alist)))))))
- (put cmd 'calc-user-defn t)))
- (let ((body (list 'math-normalize (calc-fix-user-formula form))))
- (fset func
- (append
- (list 'lambda alist)
- (and is-symb
- (mapcar (function (lambda (v)
- (list 'math-check-const v t)))
- alist))
- (list body))))
- (put func 'calc-user-defn form)
- (setq math-integral-cache-state nil)
- (if key
- (let* ((kmap (calc-user-key-map))
- (old (assq key kmap)))
- (if old
- (setcdr old cmd)
- (setcdr kmap (cons (cons key cmd) (cdr kmap)))))))
- (message "")))
-
-(defun calc-default-formula-arglist (form)
- (if (consp form)
- (if (eq (car form) 'var)
- (if (or (memq (nth 1 form) arglist)
- (math-const-var form))
- ()
- (setq arglist (cons (nth 1 form) arglist)))
- (calc-default-formula-arglist-step (cdr form)))))
-
-(defun calc-default-formula-arglist-step (l)
- (and l
- (progn
- (calc-default-formula-arglist (car l))
- (calc-default-formula-arglist-step (cdr l)))))
-
-(defun calc-subsetp (a b)
- (or (null a)
- (and (memq (car a) b)
- (calc-subsetp (cdr a) b))))
-
-(defun calc-fix-user-formula (f)
- (if (consp f)
- (let (temp)
- (cond ((and (eq (car f) 'var)
- (memq (setq temp (or (cdr (assq (nth 1 f) '((nil . arg-nil)
- (t . arg-t))))
- (nth 1 f)))
- alist))
- temp)
- ((or (math-constp f) (eq (car f) 'var))
- (list 'quote f))
- ((and (eq (car f) 'calcFunc-eval)
- (= (length f) 2))
- (list 'let '((calc-simplify-mode nil))
- (list 'math-normalize (calc-fix-user-formula (nth 1 f)))))
- ((and (eq (car f) 'calcFunc-evalsimp)
- (= (length f) 2))
- (list 'math-simplify (calc-fix-user-formula (nth 1 f))))
- ((and (eq (car f) 'calcFunc-evalextsimp)
- (= (length f) 2))
- (list 'math-simplify-extended
- (calc-fix-user-formula (nth 1 f))))
- (t
- (cons 'list
- (cons (list 'quote (car f))
- (mapcar 'calc-fix-user-formula (cdr f)))))))
- f))
-
-(defun calc-user-define-composition ()
- (interactive)
- (calc-wrapper
- (if (eq calc-language 'unform)
- (error "Can't define formats for unformatted mode"))
- (let* ((comp (calc-top 1))
- (func (intern (completing-read "Define format for which function: "
- obarray 'fboundp nil "calcFunc-")))
- (comps (get func 'math-compose-forms))
- entry entry2
- (arglist nil)
- (alist nil))
- (if (math-zerop comp)
- (if (setq entry (assq calc-language comps))
- (put func 'math-compose-forms (delq entry comps)))
- (calc-default-formula-arglist comp)
- (setq arglist (sort arglist 'string-lessp))
- (while
- (progn
- (setq alist (read-from-minibuffer "Composition argument list: "
- (if arglist
- (prin1-to-string arglist)
- "()")
- minibuffer-local-map
- t))
- (and (not (calc-subsetp alist arglist))
- (y-or-n-p
- "Okay for arguments that don't appear in formula to be invisible? "))))
- (or (setq entry (assq calc-language comps))
- (put func 'math-compose-forms
- (cons (setq entry (list calc-language)) comps)))
- (or (setq entry2 (assq (length alist) (cdr entry)))
- (setcdr entry
- (cons (setq entry2 (list (length alist))) (cdr entry))))
- (setcdr entry2 (list 'lambda alist (calc-fix-user-formula comp))))
- (calc-pop-stack 1)
- (calc-do-refresh))))
-
-
-(defun calc-user-define-kbd-macro (arg)
- (interactive "P")
- (or last-kbd-macro
- (error "No keyboard macro defined"))
- (message "Define last kbd macro on user key: z-")
- (let ((key (read-char)))
- (if (= (calc-user-function-classify key) 0)
- (error "Can't redefine \"?\" key"))
- (let ((cmd (intern (completing-read "Full name for new command: "
- obarray
- 'commandp
- nil
- (concat "calc-User-"
- (if (or (and (>= key ?a)
- (<= key ?z))
- (and (>= key ?A)
- (<= key ?Z))
- (and (>= key ?0)
- (<= key ?9)))
- (char-to-string key)
- (format "%03d" key)))))))
- (and (fboundp cmd)
- (not (let ((f (symbol-function cmd)))
- (or (stringp f)
- (and (consp f)
- (eq (car-safe (nth 3 f))
- 'calc-execute-kbd-macro)))))
- (error "Function %s is already defined and not a keyboard macro"
- cmd))
- (put cmd 'calc-user-defn t)
- (fset cmd (if (< (prefix-numeric-value arg) 0)
- last-kbd-macro
- (list 'lambda
- '(arg)
- '(interactive "P")
- (list 'calc-execute-kbd-macro
- (vector (key-description last-kbd-macro)
- last-kbd-macro)
- 'arg
- (format "z%c" key)))))
- (let* ((kmap (calc-user-key-map))
- (old (assq key kmap)))
- (if old
- (setcdr old cmd)
- (setcdr kmap (cons (cons key cmd) (cdr kmap))))))))
-
-
-(defun calc-edit-user-syntax ()
- (interactive)
- (calc-wrapper
- (let ((lang calc-language))
- (calc-edit-mode (list 'calc-finish-user-syntax-edit (list 'quote lang))
- t
- (format "Editing %s-Mode Syntax Table"
- (cond ((null lang) "Normal")
- ((eq lang 'tex) "TeX")
- (t (capitalize (symbol-name lang))))))
- (calc-write-parse-table (cdr (assq lang calc-user-parse-tables))
- lang)))
- (calc-show-edit-buffer))
-
-(defun calc-finish-user-syntax-edit (lang)
- (let ((tab (calc-read-parse-table calc-original-buffer lang))
- (entry (assq lang calc-user-parse-tables)))
- (if tab
- (setcdr (or entry
- (car (setq calc-user-parse-tables
- (cons (list lang) calc-user-parse-tables))))
- tab)
- (if entry
- (setq calc-user-parse-tables
- (delq entry calc-user-parse-tables)))))
- (switch-to-buffer calc-original-buffer))
-
-(defun calc-write-parse-table (tab calc-lang)
- (let ((p tab))
- (while p
- (calc-write-parse-table-part (car (car p)))
- (insert ":= "
- (let ((math-format-hash-args t))
- (math-format-flat-expr (cdr (car p)) 0))
- "\n")
- (setq p (cdr p)))))
-
-(defun calc-write-parse-table-part (p)
- (while p
- (cond ((stringp (car p))
- (let ((s (car p)))
- (if (and (string-match "\\`\\\\dots\\>" s)
- (not (eq calc-lang 'tex)))
- (setq s (concat ".." (substring s 5))))
- (if (or (and (string-match
- "[a-zA-Z0-9\"{}]\\|\\`:=\\'\\|\\`#\\|\\`%%" s)
- (string-match "[^a-zA-Z0-9\\]" s))
- (and (assoc s '((")") ("]") (">")))
- (not (cdr p))))
- (insert (prin1-to-string s) " ")
- (insert s " "))))
- ((integerp (car p))
- (insert "#")
- (or (= (car p) 0)
- (insert "/" (int-to-string (car p))))
- (insert " "))
- ((and (eq (car (car p)) '\?) (equal (car (nth 2 (car p))) "$$"))
- (insert (car (nth 1 (car p))) " "))
- (t
- (insert "{ ")
- (calc-write-parse-table-part (nth 1 (car p)))
- (insert "}" (symbol-name (car (car p))))
- (if (nth 2 (car p))
- (calc-write-parse-table-part (list (car (nth 2 (car p)))))
- (insert " "))))
- (setq p (cdr p))))
-
-(defun calc-read-parse-table (calc-buf calc-lang)
- (let ((tab nil))
- (while (progn
- (skip-chars-forward "\n\t ")
- (not (eobp)))
- (if (looking-at "%%")
- (end-of-line)
- (let ((pt (point))
- (p (calc-read-parse-table-part ":=[\n\t ]+" ":=")))
- (or (stringp (car p))
- (and (integerp (car p))
- (stringp (nth 1 p)))
- (progn
- (goto-char pt)
- (error "Malformed syntax rule")))
- (let ((pos (point)))
- (end-of-line)
- (let* ((str (buffer-substring pos (point)))
- (exp (save-excursion
- (set-buffer calc-buf)
- (let ((calc-user-parse-tables nil)
- (calc-language nil)
- (math-expr-opers math-standard-opers)
- (calc-hashes-used 0))
- (math-read-expr
- (if (string-match ",[ \t]*\\'" str)
- (substring str 0 (match-beginning 0))
- str))))))
- (if (eq (car-safe exp) 'error)
- (progn
- (goto-char (+ pos (nth 1 exp)))
- (error (nth 2 exp))))
- (setq tab (nconc tab (list (cons p exp)))))))))
- tab))
-
-(defun calc-fix-token-name (name &optional unquoted)
- (cond ((string-match "\\`\\.\\." name)
- (concat "\\dots" (substring name 2)))
- ((and (equal name "{") (memq calc-lang '(tex eqn)))
- "(")
- ((and (equal name "}") (memq calc-lang '(tex eqn)))
- ")")
- ((and (equal name "&") (eq calc-lang 'tex))
- ",")
- ((equal name "#")
- (search-backward "#")
- (error "Token '#' is reserved"))
- ((and unquoted (string-match "#" name))
- (error "Tokens containing '#' must be quoted"))
- ((not (string-match "[^ ]" name))
- (search-backward "\"" nil t)
- (error "Blank tokens are not allowed"))
- (t name)))
-
-(defun calc-read-parse-table-part (term eterm)
- (let ((part nil)
- (quoted nil))
- (while (progn
- (skip-chars-forward "\n\t ")
- (if (eobp) (error "Expected '%s'" eterm))
- (not (looking-at term)))
- (cond ((looking-at "%%")
- (end-of-line))
- ((looking-at "{[\n\t ]")
- (forward-char 2)
- (let ((p (calc-read-parse-table-part "}" "}")))
- (or (looking-at "[+*?]")
- (error "Expected '+', '*', or '?'"))
- (let ((sym (intern (buffer-substring (point) (1+ (point))))))
- (forward-char 1)
- (looking-at "[^\n\t ]*")
- (let ((sep (buffer-substring (point) (match-end 0))))
- (goto-char (match-end 0))
- (and (eq sym '\?) (> (length sep) 0)
- (not (equal sep "$")) (not (equal sep "."))
- (error "Separator not allowed with { ... }?"))
- (if (string-match "\\`\"" sep)
- (setq sep (read-from-string sep)))
- (setq sep (calc-fix-token-name sep))
- (setq part (nconc part
- (list (list sym p
- (and (> (length sep) 0)
- (cons sep p))))))))))
- ((looking-at "}")
- (error "Too many }'s"))
- ((looking-at "\"")
- (setq quoted (calc-fix-token-name (read (current-buffer)))
- part (nconc part (list quoted))))
- ((looking-at "#\\(\\(/[0-9]+\\)?\\)[\n\t ]")
- (setq part (nconc part (list (if (= (match-beginning 1)
- (match-end 1))
- 0
- (string-to-int
- (buffer-substring
- (1+ (match-beginning 1))
- (match-end 1)))))))
- (goto-char (match-end 0)))
- ((looking-at ":=[\n\t ]")
- (error "Misplaced ':='"))
- (t
- (looking-at "[^\n\t ]*")
- (let ((end (match-end 0)))
- (setq part (nconc part (list (calc-fix-token-name
- (buffer-substring
- (point) end) t))))
- (goto-char end)))))
- (goto-char (match-end 0))
- (let ((len (length part)))
- (while (and (> len 1)
- (let ((last (nthcdr (setq len (1- len)) part)))
- (and (assoc (car last) '((")") ("]") (">")))
- (not (eq (car last) quoted))
- (setcar last
- (list '\? (list (car last)) '("$$"))))))))
- part))
-
-
-(defun calc-user-define-invocation ()
- (interactive)
- (or last-kbd-macro
- (error "No keyboard macro defined"))
- (setq calc-invocation-macro last-kbd-macro)
- (message "Use `M-# Z' to invoke this macro"))
-
-
-(defun calc-user-define-edit (prefix)
- (interactive "P") ; but no calc-wrapper!
- (message "Edit definition of command: z-")
- (let* ((key (read-char))
- (def (or (assq key (calc-user-key-map))
- (assq (upcase key) (calc-user-key-map))
- (assq (downcase key) (calc-user-key-map))
- (error "No command defined for that key")))
- (cmd (cdr def)))
- (if (symbolp cmd)
- (setq cmd (symbol-function cmd)))
- (cond ((or (stringp cmd)
- (and (consp cmd)
- (eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))
- (if (and (>= (prefix-numeric-value prefix) 0)
- (fboundp 'edit-kbd-macro)
- (symbolp (cdr def))
- (eq major-mode 'calc-mode))
- (progn
- (if (and (< (window-width) (frame-width))
- calc-display-trail)
- (let ((win (get-buffer-window (calc-trail-buffer))))
- (if win
- (delete-window win))))
- (edit-kbd-macro (cdr def) prefix nil
- (function
- (lambda (x)
- (and calc-display-trail
- (calc-wrapper
- (calc-trail-display 1 t)))))
- (function
- (lambda (cmd)
- (if (stringp (symbol-function cmd))
- (symbol-function cmd)
- (let ((mac (nth 1 (nth 3 (symbol-function
- cmd)))))
- (if (vectorp mac)
- (aref mac 1)
- mac)))))
- (function
- (lambda (new cmd)
- (if (stringp (symbol-function cmd))
- (fset cmd new)
- (let ((mac (cdr (nth 3 (symbol-function
- cmd)))))
- (if (vectorp (car mac))
- (progn
- (aset (car mac) 0
- (key-description new))
- (aset (car mac) 1 new))
- (setcar mac new))))))))
- (let ((keys (progn (and (fboundp 'edit-kbd-macro)
- (edit-kbd-macro nil))
- (fboundp 'MacEdit-parse-keys))))
- (calc-wrapper
- (calc-edit-mode (list 'calc-finish-macro-edit
- (list 'quote def)
- keys)
- t)
- (if keys
- (let (top
- (fill-column 70)
- (fill-prefix nil))
- (insert "Notations: RET, SPC, TAB, DEL, LFD, NUL"
- ", C-xxx, M-xxx.\n\n")
- (setq top (point))
- (insert (if (stringp cmd)
- (key-description cmd)
- (if (vectorp (nth 1 (nth 3 cmd)))
- (aref (nth 1 (nth 3 cmd)) 0)
- (key-description (nth 1 (nth 3 cmd)))))
- "\n")
- (if (>= (prog2 (forward-char -1)
- (current-column)
- (forward-char 1))
- (frame-width))
- (fill-region top (point))))
- (insert "Press C-q to quote control characters like RET"
- " and TAB.\n"
- (if (stringp cmd)
- cmd
- (if (vectorp (nth 1 (nth 3 cmd)))
- (aref (nth 1 (nth 3 cmd)) 1)
- (nth 1 (nth 3 cmd)))))))
- (calc-show-edit-buffer)
- (forward-line (if keys 2 1)))))
- (t (let* ((func (calc-stack-command-p cmd))
- (defn (and func
- (symbolp func)
- (get func 'calc-user-defn))))
- (if (and defn (calc-valid-formula-func func))
- (progn
- (calc-wrapper
- (calc-edit-mode (list 'calc-finish-formula-edit
- (list 'quote func)))
- (insert (math-showing-full-precision
- (math-format-nice-expr defn (frame-width)))
- "\n"))
- (calc-show-edit-buffer))
- (error "That command's definition cannot be edited")))))))
-
-(defun calc-finish-macro-edit (def keys)
- (forward-line 1)
- (if (and keys (looking-at "\n")) (forward-line 1))
- (let* ((true-str (buffer-substring (point) (point-max)))
- (str true-str))
- (if keys (setq str (MacEdit-parse-keys str)))
- (if (symbolp (cdr def))
- (if (stringp (symbol-function (cdr def)))
- (fset (cdr def) str)
- (let ((mac (cdr (nth 3 (symbol-function (cdr def))))))
- (if (vectorp (car mac))
- (progn
- (aset (car mac) 0 (if keys true-str (key-description str)))
- (aset (car mac) 1 str))
- (setcar mac str))))
- (setcdr def str))))
-
-;;; The following are hooks into the MacEdit package from macedit.el.
-(put 'calc-execute-extended-command 'MacEdit-print
- (function (lambda ()
- (setq macro-str (concat "\excalc-" macro-str)))))
-
-(put 'calcDigit-start 'MacEdit-print
- (function (lambda ()
- (if calc-algebraic-mode
- (calc-macro-edit-algebraic)
- (MacEdit-unread-chars key-last)
- (let ((str "")
- (min-bsp 0)
- ch last)
- (while (and (setq ch (MacEdit-read-char))
- (or (and (>= ch ?0) (<= ch ?9))
- (memq ch '(?\. ?e ?\_ ?n ?\: ?\# ?M
- ?o ?h ?\@ ?\"))
- (and (memq ch '(?\' ?m ?s))
- (string-match "[@oh]" str))
- (and (or (and (>= ch ?a) (<= ch ?z))
- (and (>= ch ?A) (<= ch ?Z)))
- (string-match
- "^[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#"
- str))
- (and (memq ch '(?\177 ?\C-h))
- (> (length str) 0))
- (and (memq ch '(?+ ?-))
- (> (length str) 0)
- (eq (aref str (1- (length str)))
- ?e))))
- (if (or (and (>= ch ?0) (<= ch ?9))
- (and (or (not (memq ch '(?\177 ?\C-h)))
- (<= (length str) min-bsp))
- (setq min-bsp (1+ (length str)))))
- (setq str (concat str (char-to-string ch)))
- (setq str (substring str 0 -1))))
- (if (memq ch '(32 10 13))
- (setq str (concat str (char-to-string ch)))
- (MacEdit-unread-chars ch))
- (insert "type \"")
- (MacEdit-insert-string str)
- (insert "\"\n"))))))
-
-(defun calc-macro-edit-algebraic ()
- (MacEdit-unread-chars key-last)
- (let ((str "")
- (min-bsp 0))
- (while (progn
- (MacEdit-lookup-key calc-alg-ent-map)
- (or (and (memq key-symbol '(self-insert-command
- calcAlg-previous))
- (< (length str) 60))
- (memq key-symbol
- '(backward-delete-char
- delete-backward-char
- backward-delete-char-untabify))
- (eq key-last 9)))
- (setq macro-str (substring macro-str (length key-str)))
- (if (or (eq key-symbol 'self-insert-command)
- (and (or (not (memq key-symbol '(backward-delete-char
- delete-backward-char
- backward-delete-char-untabify)))
- (<= (length str) min-bsp))
- (setq min-bsp (+ (length str) (length key-str)))))
- (setq str (concat str key-str))
- (setq str (substring str 0 -1))))
- (if (memq key-last '(10 13))
- (setq str (concat str key-str)
- macro-str (substring macro-str (length key-str))))
- (if (> (length str) 0)
- (progn
- (insert "type \"")
- (MacEdit-insert-string str)
- (insert "\"\n")))))
-(put 'calc-algebraic-entry 'MacEdit-print 'calc-macro-edit-algebraic)
-(put 'calc-auto-algebraic-entry 'MacEdit-print 'calc-macro-edit-algebraic)
-
-(defun calc-macro-edit-variable (&optional no-cmd)
- (let ((str "") ch)
- (or no-cmd (insert (symbol-name key-symbol) "\n"))
- (if (memq (MacEdit-peek-char) '(?\+ ?\- ?\* ?\/ ?^ ?\|))
- (setq str (char-to-string (MacEdit-read-char))))
- (if (and (setq ch (MacEdit-peek-char))
- (>= ch ?0) (<= ch ?9))
- (insert "type \"" str
- (char-to-string (MacEdit-read-char)) "\"\n")
- (if (> (length str) 0)
- (insert "type \"" str "\"\n"))
- (MacEdit-read-argument))))
-(put 'calc-store 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-into 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-neg 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-plus 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-minus 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-times 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-div 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-power 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-concat 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-inv 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-decr 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-incr 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-store-exchange 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-unstore 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-recall 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-let 'MacEdit-print 'calc-macro-edit-variable)
-(put 'calc-permanent-variable 'MacEdit-print 'calc-macro-edit-variable)
-
-(defun calc-macro-edit-variable-2 ()
- (calc-macro-edit-variable)
- (calc-macro-edit-variable t))
-(put 'calc-copy-variable 'MacEdit-print 'calc-macro-edit-variable-2)
-(put 'calc-declare-variable 'MacEdit-print 'calc-macro-edit-variable-2)
-
-(defun calc-macro-edit-quick-digit ()
- (insert "type \"" key-str "\" # " (symbol-name key-symbol) "\n"))
-(put 'calc-store-quick 'MacEdit-print 'calc-macro-edit-quick-digit)
-(put 'calc-store-into-quick 'MacEdit-print 'calc-macro-edit-quick-digit)
-(put 'calc-recall-quick 'MacEdit-print 'calc-macro-edit-quick-digit)
-(put 'calc-select-part 'MacEdit-print 'calc-macro-edit-quick-digit)
-(put 'calc-clean-num 'MacEdit-print 'calc-macro-edit-quick-digit)
-
-
-(defun calc-finish-formula-edit (func)
- (let ((buf (current-buffer))
- (str (buffer-substring (point) (point-max)))
- (start (point))
- (body (calc-valid-formula-func func)))
- (set-buffer calc-original-buffer)
- (let ((val (math-read-expr str)))
- (if (eq (car-safe val) 'error)
- (progn
- (set-buffer buf)
- (goto-char (+ start (nth 1 val)))
- (error (nth 2 val))))
- (setcar (cdr body)
- (let ((alist (nth 1 (symbol-function func))))
- (calc-fix-user-formula val)))
- (put func 'calc-user-defn val))))
-
-(defun calc-valid-formula-func (func)
- (let ((def (symbol-function func)))
- (and (consp def)
- (eq (car def) 'lambda)
- (progn
- (setq def (cdr (cdr def)))
- (while (and def
- (not (eq (car (car def)) 'math-normalize)))
- (setq def (cdr def)))
- (car def)))))
-
-
-(defun calc-get-user-defn ()
- (interactive)
- (calc-wrapper
- (message "Get definition of command: z-")
- (let* ((key (read-char))
- (def (or (assq key (calc-user-key-map))
- (assq (upcase key) (calc-user-key-map))
- (assq (downcase key) (calc-user-key-map))
- (error "No command defined for that key")))
- (cmd (cdr def)))
- (if (symbolp cmd)
- (setq cmd (symbol-function cmd)))
- (cond ((stringp cmd)
- (message "Keyboard macro: %s" cmd))
- (t (let* ((func (calc-stack-command-p cmd))
- (defn (and func
- (symbolp func)
- (get func 'calc-user-defn))))
- (if defn
- (progn
- (and (calc-valid-formula-func func)
- (setq defn (append '(calcFunc-lambda)
- (mapcar 'math-build-var-name
- (nth 1 (symbol-function
- func)))
- (list defn))))
- (calc-enter-result 0 "gdef" defn))
- (error "That command is not defined by a formula"))))))))
-
-
-(defun calc-user-define-permanent ()
- (interactive)
- (calc-wrapper
- (message "Record in %s the command: z-" calc-settings-file)
- (let* ((key (read-char))
- (def (or (assq key (calc-user-key-map))
- (assq (upcase key) (calc-user-key-map))
- (assq (downcase key) (calc-user-key-map))
- (and (eq key ?\')
- (cons nil
- (intern (completing-read
- (format "Record in %s the function: "
- calc-settings-file)
- obarray 'fboundp nil "calcFunc-"))))
- (error "No command defined for that key"))))
- (set-buffer (find-file-noselect (substitute-in-file-name
- calc-settings-file)))
- (goto-char (point-max))
- (let* ((cmd (cdr def))
- (fcmd (and cmd (symbolp cmd) (symbol-function cmd)))
- (func nil)
- (pt (point))
- (fill-column 70)
- (fill-prefix nil)
- str q-ok)
- (insert "\n;;; Definition stored by Calc on " (current-time-string)
- "\n(put 'calc-define '"
- (if (symbolp cmd) (symbol-name cmd) (format "key%d" key))
- " '(progn\n")
- (if (and fcmd
- (eq (car-safe fcmd) 'lambda)
- (get cmd 'calc-user-defn))
- (let ((pt (point)))
- (and (eq (car-safe (nth 3 fcmd)) 'calc-execute-kbd-macro)
- (vectorp (nth 1 (nth 3 fcmd)))
- (progn (and (fboundp 'edit-kbd-macro)
- (edit-kbd-macro nil))
- (fboundp 'MacEdit-parse-keys))
- (setq q-ok t)
- (aset (nth 1 (nth 3 fcmd)) 1 nil))
- (insert (setq str (prin1-to-string
- (cons 'defun (cons cmd (cdr fcmd)))))
- "\n")
- (or (and (string-match "\"" str) (not q-ok))
- (fill-region pt (point)))
- (indent-rigidly pt (point) 2)
- (delete-region pt (1+ pt))
- (insert " (put '" (symbol-name cmd)
- " 'calc-user-defn '"
- (prin1-to-string (get cmd 'calc-user-defn))
- ")\n")
- (setq func (calc-stack-command-p cmd))
- (let ((ffunc (and func (symbolp func) (symbol-function func)))
- (pt (point)))
- (and ffunc
- (eq (car-safe ffunc) 'lambda)
- (get func 'calc-user-defn)
- (progn
- (insert (setq str (prin1-to-string
- (cons 'defun (cons func
- (cdr ffunc)))))
- "\n")
- (or (and (string-match "\"" str) (not q-ok))
- (fill-region pt (point)))
- (indent-rigidly pt (point) 2)
- (delete-region pt (1+ pt))
- (setq pt (point))
- (insert "(put '" (symbol-name func)
- " 'calc-user-defn '"
- (prin1-to-string (get func 'calc-user-defn))
- ")\n")
- (fill-region pt (point))
- (indent-rigidly pt (point) 2)
- (delete-region pt (1+ pt))))))
- (and (stringp fcmd)
- (insert " (fset '" (prin1-to-string cmd)
- " " (prin1-to-string fcmd) ")\n")))
- (or func (setq func (and cmd (symbolp cmd) (fboundp cmd) cmd)))
- (if (get func 'math-compose-forms)
- (let ((pt (point)))
- (insert "(put '" (symbol-name cmd)
- " 'math-compose-forms '"
- (prin1-to-string (get func 'math-compose-forms))
- ")\n")
- (fill-region pt (point))
- (indent-rigidly pt (point) 2)
- (delete-region pt (1+ pt))))
- (if (car def)
- (insert " (define-key calc-mode-map "
- (prin1-to-string (concat "z" (char-to-string key)))
- " '"
- (prin1-to-string cmd)
- ")\n")))
- (insert "))\n")
- (save-buffer))))
-
-(defun calc-stack-command-p (cmd)
- (if (and cmd (symbolp cmd))
- (and (fboundp cmd)
- (calc-stack-command-p (symbol-function cmd)))
- (and (consp cmd)
- (eq (car cmd) 'lambda)
- (setq cmd (or (assq 'calc-wrapper cmd)
- (assq 'calc-slow-wrapper cmd)))
- (setq cmd (assq 'calc-enter-result cmd))
- (memq (car (nth 3 cmd)) '(cons list))
- (eq (car (nth 1 (nth 3 cmd))) 'quote)
- (nth 1 (nth 1 (nth 3 cmd))))))
-
-
-(defun calc-call-last-kbd-macro (arg)
- (interactive "P")
- (and defining-kbd-macro
- (error "Can't execute anonymous macro while defining one"))
- (or last-kbd-macro
- (error "No kbd macro has been defined"))
- (calc-execute-kbd-macro last-kbd-macro arg))
-
-(defun calc-execute-kbd-macro (mac arg &rest prefix)
- (if (and (vectorp mac) (> (length mac) 0) (stringp (aref mac 0)))
- (setq mac (or (aref mac 1)
- (aset mac 1 (progn (and (fboundp 'edit-kbd-macro)
- (edit-kbd-macro nil))
- (MacEdit-parse-keys (aref mac 0)))))))
- (if (< (prefix-numeric-value arg) 0)
- (execute-kbd-macro mac (- (prefix-numeric-value arg)))
- (if calc-executing-macro
- (execute-kbd-macro mac arg)
- (calc-slow-wrapper
- (let ((old-stack-whole (copy-sequence calc-stack))
- (old-stack-top calc-stack-top)
- (old-buffer-size (buffer-size))
- (old-refresh-count calc-refresh-count))
- (unwind-protect
- (let ((calc-executing-macro mac))
- (execute-kbd-macro mac arg))
- (calc-select-buffer)
- (let ((new-stack (reverse calc-stack))
- (old-stack (reverse old-stack-whole)))
- (while (and new-stack old-stack
- (equal (car new-stack) (car old-stack)))
- (setq new-stack (cdr new-stack)
- old-stack (cdr old-stack)))
- (or (equal prefix '(nil))
- (calc-record-list (if (> (length new-stack) 1)
- (mapcar 'car new-stack)
- '(""))
- (or (car prefix) "kmac")))
- (calc-record-undo (list 'set 'saved-stack-top old-stack-top))
- (and old-stack
- (calc-record-undo (list 'pop 1 (mapcar 'car old-stack))))
- (let ((calc-stack old-stack-whole)
- (calc-stack-top 0))
- (calc-cursor-stack-index (length old-stack)))
- (if (and (= old-buffer-size (buffer-size))
- (= old-refresh-count calc-refresh-count))
- (let ((buffer-read-only nil))
- (delete-region (point) (point-max))
- (while new-stack
- (calc-record-undo (list 'push 1))
- (insert (math-format-stack-value (car new-stack)) "\n")
- (setq new-stack (cdr new-stack)))
- (calc-renumber-stack))
- (while new-stack
- (calc-record-undo (list 'push 1))
- (setq new-stack (cdr new-stack)))
- (calc-refresh))
- (calc-record-undo (list 'set 'saved-stack-top 0)))))))))
-
-(defun calc-push-list-in-macro (vals m sels)
- (let ((entry (list (car vals) 1 (car sels)))
- (mm (+ (or m 1) calc-stack-top)))
- (if (> mm 1)
- (setcdr (nthcdr (- mm 2) calc-stack)
- (cons entry (nthcdr (1- mm) calc-stack)))
- (setq calc-stack (cons entry calc-stack)))))
-
-(defun calc-pop-stack-in-macro (n mm)
- (if (> mm 1)
- (setcdr (nthcdr (- mm 2) calc-stack)
- (nthcdr (+ n mm -1) calc-stack))
- (setq calc-stack (nthcdr n calc-stack))))
-
-
-(defun calc-kbd-if ()
- (interactive)
- (calc-wrapper
- (let ((cond (calc-top-n 1)))
- (calc-pop-stack 1)
- (if (math-is-true cond)
- (if defining-kbd-macro
- (message "If true.."))
- (if defining-kbd-macro
- (message "Condition is false; skipping to Z: or Z] ..."))
- (calc-kbd-skip-to-else-if t)))))
-
-(defun calc-kbd-else-if ()
- (interactive)
- (calc-kbd-if))
-
-(defun calc-kbd-skip-to-else-if (else-okay)
- (let ((count 0)
- ch)
- (while (>= count 0)
- (setq ch (read-char))
- (if (= ch -1)
- (error "Unterminated Z[ in keyboard macro"))
- (if (= ch ?Z)
- (progn
- (setq ch (read-char))
- (cond ((= ch ?\[)
- (setq count (1+ count)))
- ((= ch ?\])
- (setq count (1- count)))
- ((= ch ?\:)
- (and (= count 0)
- else-okay
- (setq count -1)))
- ((eq ch 7)
- (keyboard-quit))))))
- (and defining-kbd-macro
- (if (= ch ?\:)
- (message "Else...")
- (message "End-if...")))))
-
-(defun calc-kbd-end-if ()
- (interactive)
- (if defining-kbd-macro
- (message "End-if...")))
-
-(defun calc-kbd-else ()
- (interactive)
- (if defining-kbd-macro
- (message "Else; skipping to Z] ..."))
- (calc-kbd-skip-to-else-if nil))
-
-
-(defun calc-kbd-repeat ()
- (interactive)
- (let (count)
- (calc-wrapper
- (setq count (math-trunc (calc-top-n 1)))
- (or (Math-integerp count)
- (error "Count must be an integer"))
- (if (Math-integer-negp count)
- (setq count 0))
- (or (integerp count)
- (setq count 1000000))
- (calc-pop-stack 1))
- (calc-kbd-loop count)))
-
-(defun calc-kbd-for (dir)
- (interactive "P")
- (let (init final)
- (calc-wrapper
- (setq init (calc-top-n 2)
- final (calc-top-n 1))
- (or (and (math-anglep init) (math-anglep final))
- (error "Initial and final values must be real numbers"))
- (calc-pop-stack 2))
- (calc-kbd-loop nil init final (and dir (prefix-numeric-value dir)))))
-
-(defun calc-kbd-loop (rpt-count &optional initial final dir)
- (interactive "P")
- (setq rpt-count (if rpt-count (prefix-numeric-value rpt-count) 1000000))
- (let* ((count 0)
- (parts nil)
- (body "")
- (open last-command-char)
- (counter initial)
- ch)
- (or executing-kbd-macro
- (message "Reading loop body..."))
- (while (>= count 0)
- (setq ch (read-char))
- (if (= ch -1)
- (error "Unterminated Z%c in keyboard macro" open))
- (if (= ch ?Z)
- (progn
- (setq ch (read-char)
- body (concat body "Z" (char-to-string ch)))
- (cond ((memq ch '(?\< ?\( ?\{))
- (setq count (1+ count)))
- ((memq ch '(?\> ?\) ?\}))
- (setq count (1- count)))
- ((and (= ch ?/)
- (= count 0))
- (setq parts (nconc parts (list (concat (substring body 0 -2)
- "Z]")))
- body ""))
- ((eq ch 7)
- (keyboard-quit))))
- (setq body (concat body (char-to-string ch)))))
- (if (/= ch (cdr (assq open '( (?\< . ?\>) (?\( . ?\)) (?\{ . ?\}) ))))
- (error "Mismatched Z%c and Z%c in keyboard macro" open ch))
- (or executing-kbd-macro
- (message "Looping..."))
- (setq body (concat (substring body 0 -2) "Z]"))
- (and (not executing-kbd-macro)
- (= rpt-count 1000000)
- (null parts)
- (null counter)
- (progn
- (message "Warning: Infinite loop! Not executing")
- (setq rpt-count 0)))
- (or (not initial) dir
- (setq dir (math-compare final initial)))
- (calc-wrapper
- (while (> rpt-count 0)
- (let ((part parts))
- (if counter
- (if (cond ((eq dir 0) (Math-equal final counter))
- ((eq dir 1) (Math-lessp final counter))
- ((eq dir -1) (Math-lessp counter final)))
- (setq rpt-count 0)
- (calc-push counter)))
- (while (and part (> rpt-count 0))
- (execute-kbd-macro (car part))
- (if (math-is-true (calc-top-n 1))
- (setq rpt-count 0)
- (setq part (cdr part)))
- (calc-pop-stack 1))
- (if (> rpt-count 0)
- (progn
- (execute-kbd-macro body)
- (if counter
- (let ((step (calc-top-n 1)))
- (calc-pop-stack 1)
- (setq counter (calcFunc-add counter step)))
- (setq rpt-count (1- rpt-count))))))))
- (or executing-kbd-macro
- (message "Looping...done"))))
-
-(defun calc-kbd-end-repeat ()
- (interactive)
- (error "Unbalanced Z> in keyboard macro"))
-
-(defun calc-kbd-end-for ()
- (interactive)
- (error "Unbalanced Z) in keyboard macro"))
-
-(defun calc-kbd-end-loop ()
- (interactive)
- (error "Unbalanced Z} in keyboard macro"))
-
-(defun calc-kbd-break ()
- (interactive)
- (calc-wrapper
- (let ((cond (calc-top-n 1)))
- (calc-pop-stack 1)
- (if (math-is-true cond)
- (error "Keyboard macro aborted")))))
-
-
-(defvar calc-kbd-push-level 0)
-(defun calc-kbd-push (arg)
- (interactive "P")
- (calc-wrapper
- (let* ((defs (and arg (> (prefix-numeric-value arg) 0)))
- (var-q0 (and (boundp 'var-q0) var-q0))
- (var-q1 (and (boundp 'var-q1) var-q1))
- (var-q2 (and (boundp 'var-q2) var-q2))
- (var-q3 (and (boundp 'var-q3) var-q3))
- (var-q4 (and (boundp 'var-q4) var-q4))
- (var-q5 (and (boundp 'var-q5) var-q5))
- (var-q6 (and (boundp 'var-q6) var-q6))
- (var-q7 (and (boundp 'var-q7) var-q7))
- (var-q8 (and (boundp 'var-q8) var-q8))
- (var-q9 (and (boundp 'var-q9) var-q9))
- (calc-internal-prec (if defs 12 calc-internal-prec))
- (calc-word-size (if defs 32 calc-word-size))
- (calc-angle-mode (if defs 'deg calc-angle-mode))
- (calc-simplify-mode (if defs nil calc-simplify-mode))
- (calc-algebraic-mode (if arg nil calc-algebraic-mode))
- (calc-incomplete-algebraic-mode (if arg nil
- calc-incomplete-algebraic-mode))
- (calc-symbolic-mode (if defs nil calc-symbolic-mode))
- (calc-matrix-mode (if defs nil calc-matrix-mode))
- (calc-prefer-frac (if defs nil calc-prefer-frac))
- (calc-complex-mode (if defs nil calc-complex-mode))
- (calc-infinite-mode (if defs nil calc-infinite-mode))
- (count 0)
- (body "")
- ch)
- (if (or executing-kbd-macro defining-kbd-macro)
- (progn
- (if defining-kbd-macro
- (message "Reading body..."))
- (while (>= count 0)
- (setq ch (read-char))
- (if (= ch -1)
- (error "Unterminated Z` in keyboard macro"))
- (if (= ch ?Z)
- (progn
- (setq ch (read-char)
- body (concat body "Z" (char-to-string ch)))
- (cond ((eq ch ?\`)
- (setq count (1+ count)))
- ((eq ch ?\')
- (setq count (1- count)))
- ((eq ch 7)
- (keyboard-quit))))
- (setq body (concat body (char-to-string ch)))))
- (if defining-kbd-macro
- (message "Reading body...done"))
- (let ((calc-kbd-push-level 0))
- (execute-kbd-macro (substring body 0 -2))))
- (let ((calc-kbd-push-level (1+ calc-kbd-push-level)))
- (message "Saving modes; type Z' to restore")
- (recursive-edit))))))
-
-(defun calc-kbd-pop ()
- (interactive)
- (if (> calc-kbd-push-level 0)
- (progn
- (message "Mode settings restored")
- (exit-recursive-edit))
- (error "Unbalanced Z' in keyboard macro")))
-
-
-(defun calc-kbd-report (msg)
- (interactive "sMessage: ")
- (calc-wrapper
- (math-working msg (calc-top-n 1))))
-
-(defun calc-kbd-query (msg)
- (interactive "sPrompt: ")
- (calc-wrapper
- (calc-alg-entry nil (and (not (equal msg "")) msg))))
-
-;;;; Logical operations.
-
-(defun calcFunc-eq (a b &rest more)
- (if more
- (let* ((args (cons a (cons b (copy-sequence more))))
- (res 1)
- (p args)
- p2)
- (while (and (cdr p) (not (eq res 0)))
- (setq p2 p)
- (while (and (setq p2 (cdr p2)) (not (eq res 0)))
- (setq res (math-two-eq (car p) (car p2)))
- (if (eq res 1)
- (setcdr p (delq (car p2) (cdr p)))))
- (setq p (cdr p)))
- (if (eq res 0)
- 0
- (if (cdr args)
- (cons 'calcFunc-eq args)
- 1)))
- (or (math-two-eq a b)
- (if (and (or (math-looks-negp a) (math-zerop a))
- (or (math-looks-negp b) (math-zerop b)))
- (list 'calcFunc-eq (math-neg a) (math-neg b))
- (list 'calcFunc-eq a b)))))
-
-(defun calcFunc-neq (a b &rest more)
- (if more
- (let* ((args (cons a (cons b more)))
- (res 0)
- (all t)
- (p args)
- p2)
- (while (and (cdr p) (not (eq res 1)))
- (setq p2 p)
- (while (and (setq p2 (cdr p2)) (not (eq res 1)))
- (setq res (math-two-eq (car p) (car p2)))
- (or res (setq all nil)))
- (setq p (cdr p)))
- (if (eq res 1)
- 0
- (if all
- 1
- (cons 'calcFunc-neq args))))
- (or (cdr (assq (math-two-eq a b) '((0 . 1) (1 . 0))))
- (if (and (or (math-looks-negp a) (math-zerop a))
- (or (math-looks-negp b) (math-zerop b)))
- (list 'calcFunc-neq (math-neg a) (math-neg b))
- (list 'calcFunc-neq a b)))))
-
-(defun math-two-eq (a b)
- (if (eq (car-safe a) 'vec)
- (if (eq (car-safe b) 'vec)
- (if (= (length a) (length b))
- (let ((res 1))
- (while (and (setq a (cdr a) b (cdr b)) (not (eq res 0)))
- (if res
- (setq res (math-two-eq (car a) (car b)))
- (if (eq (math-two-eq (car a) (car b)) 0)
- (setq res 0))))
- res)
- 0)
- (if (Math-objectp b)
- 0
- nil))
- (if (eq (car-safe b) 'vec)
- (if (Math-objectp a)
- 0
- nil)
- (let ((res (math-compare a b)))
- (if (= res 0)
- 1
- (if (and (= res 2) (not (and (Math-scalarp a) (Math-scalarp b))))
- nil
- 0))))))
-
-(defun calcFunc-lt (a b)
- (let ((res (math-compare a b)))
- (if (= res -1)
- 1
- (if (= res 2)
- (if (and (or (math-looks-negp a) (math-zerop a))
- (or (math-looks-negp b) (math-zerop b)))
- (list 'calcFunc-gt (math-neg a) (math-neg b))
- (list 'calcFunc-lt a b))
- 0))))
-
-(defun calcFunc-gt (a b)
- (let ((res (math-compare a b)))
- (if (= res 1)
- 1
- (if (= res 2)
- (if (and (or (math-looks-negp a) (math-zerop a))
- (or (math-looks-negp b) (math-zerop b)))
- (list 'calcFunc-lt (math-neg a) (math-neg b))
- (list 'calcFunc-gt a b))
- 0))))
-
-(defun calcFunc-leq (a b)
- (let ((res (math-compare a b)))
- (if (= res 1)
- 0
- (if (= res 2)
- (if (and (or (math-looks-negp a) (math-zerop a))
- (or (math-looks-negp b) (math-zerop b)))
- (list 'calcFunc-geq (math-neg a) (math-neg b))
- (list 'calcFunc-leq a b))
- 1))))
-
-(defun calcFunc-geq (a b)
- (let ((res (math-compare a b)))
- (if (= res -1)
- 0
- (if (= res 2)
- (if (and (or (math-looks-negp a) (math-zerop a))
- (or (math-looks-negp b) (math-zerop b)))
- (list 'calcFunc-leq (math-neg a) (math-neg b))
- (list 'calcFunc-geq a b))
- 1))))
-
-(defun calcFunc-rmeq (a)
- (if (math-vectorp a)
- (math-map-vec 'calcFunc-rmeq a)
- (if (assq (car-safe a) calc-tweak-eqn-table)
- (if (and (eq (car-safe (nth 2 a)) 'var)
- (math-objectp (nth 1 a)))
- (nth 1 a)
- (nth 2 a))
- (if (eq (car-safe a) 'calcFunc-assign)
- (nth 2 a)
- (if (eq (car-safe a) 'calcFunc-evalto)
- (nth 1 a)
- (list 'calcFunc-rmeq a))))))
-
-(defun calcFunc-land (a b)
- (cond ((Math-zerop a)
- a)
- ((Math-zerop b)
- b)
- ((math-is-true a)
- b)
- ((math-is-true b)
- a)
- (t (list 'calcFunc-land a b))))
-
-(defun calcFunc-lor (a b)
- (cond ((Math-zerop a)
- b)
- ((Math-zerop b)
- a)
- ((math-is-true a)
- a)
- ((math-is-true b)
- b)
- (t (list 'calcFunc-lor a b))))
-
-(defun calcFunc-lnot (a)
- (if (Math-zerop a)
- 1
- (if (math-is-true a)
- 0
- (let ((op (and (= (length a) 3)
- (assq (car a) calc-tweak-eqn-table))))
- (if op
- (cons (nth 2 op) (cdr a))
- (list 'calcFunc-lnot a))))))
-
-(defun calcFunc-if (c e1 e2)
- (if (Math-zerop c)
- e2
- (if (and (math-is-true c) (not (Math-vectorp c)))
- e1
- (or (and (Math-vectorp c)
- (math-constp c)
- (let ((ee1 (if (Math-vectorp e1)
- (if (= (length c) (length e1))
- (cdr e1)
- (calc-record-why "*Dimension error" e1))
- (list e1)))
- (ee2 (if (Math-vectorp e2)
- (if (= (length c) (length e2))
- (cdr e2)
- (calc-record-why "*Dimension error" e2))
- (list e2))))
- (and ee1 ee2
- (cons 'vec (math-if-vector (cdr c) ee1 ee2)))))
- (list 'calcFunc-if c e1 e2)))))
-
-(defun math-if-vector (c e1 e2)
- (and c
- (cons (if (Math-zerop (car c)) (car e2) (car e1))
- (math-if-vector (cdr c)
- (or (cdr e1) e1)
- (or (cdr e2) e2)))))
-
-(defun math-normalize-logical-op (a)
- (or (and (eq (car a) 'calcFunc-if)
- (= (length a) 4)
- (let ((a1 (math-normalize (nth 1 a))))
- (if (Math-zerop a1)
- (math-normalize (nth 3 a))
- (if (Math-numberp a1)
- (math-normalize (nth 2 a))
- (if (and (Math-vectorp (nth 1 a))
- (math-constp (nth 1 a)))
- (calcFunc-if (nth 1 a)
- (math-normalize (nth 2 a))
- (math-normalize (nth 3 a)))
- (let ((calc-simplify-mode 'none))
- (list 'calcFunc-if a1
- (math-normalize (nth 2 a))
- (math-normalize (nth 3 a)))))))))
- a))
-
-(defun calcFunc-in (a b)
- (or (and (eq (car-safe b) 'vec)
- (let ((bb b))
- (while (and (setq bb (cdr bb))
- (not (if (memq (car-safe (car bb)) '(vec intv))
- (eq (calcFunc-in a (car bb)) 1)
- (Math-equal a (car bb))))))
- (if bb 1 (and (math-constp a) (math-constp bb) 0))))
- (and (eq (car-safe b) 'intv)
- (let ((res (math-compare a (nth 2 b))) res2)
- (cond ((= res -1)
- 0)
- ((and (= res 0)
- (or (/= (nth 1 b) 2)
- (Math-lessp (nth 2 b) (nth 3 b))))
- (if (memq (nth 1 b) '(2 3)) 1 0))
- ((= (setq res2 (math-compare a (nth 3 b))) 1)
- 0)
- ((and (= res2 0)
- (or (/= (nth 1 b) 1)
- (Math-lessp (nth 2 b) (nth 3 b))))
- (if (memq (nth 1 b) '(1 3)) 1 0))
- ((/= res 1)
- nil)
- ((/= res2 -1)
- nil)
- (t 1))))
- (and (Math-equal a b)
- 1)
- (and (math-constp a) (math-constp b)
- 0)
- (list 'calcFunc-in a b)))
-
-(defun calcFunc-typeof (a)
- (cond ((Math-integerp a) 1)
- ((eq (car a) 'frac) 2)
- ((eq (car a) 'float) 3)
- ((eq (car a) 'hms) 4)
- ((eq (car a) 'cplx) 5)
- ((eq (car a) 'polar) 6)
- ((eq (car a) 'sdev) 7)
- ((eq (car a) 'intv) 8)
- ((eq (car a) 'mod) 9)
- ((eq (car a) 'date) (if (Math-integerp (nth 1 a)) 10 11))
- ((eq (car a) 'var)
- (if (memq (nth 2 a) '(var-inf var-uinf var-nan)) 12 100))
- ((eq (car a) 'vec) (if (math-matrixp a) 102 101))
- (t (math-calcFunc-to-var func))))
-
-(defun calcFunc-integer (a)
- (if (Math-integerp a)
- 1
- (if (Math-objvecp a)
- 0
- (list 'calcFunc-integer a))))
-
-(defun calcFunc-real (a)
- (if (Math-realp a)
- 1
- (if (Math-objvecp a)
- 0
- (list 'calcFunc-real a))))
-
-(defun calcFunc-constant (a)
- (if (math-constp a)
- 1
- (if (Math-objvecp a)
- 0
- (list 'calcFunc-constant a))))
-
-(defun calcFunc-refers (a b)
- (if (math-expr-contains a b)
- 1
- (if (eq (car-safe a) 'var)
- (list 'calcFunc-refers a b)
- 0)))
-
-(defun calcFunc-negative (a)
- (if (math-looks-negp a)
- 1
- (if (or (math-zerop a)
- (math-posp a))
- 0
- (list 'calcFunc-negative a))))
-
-(defun calcFunc-variable (a)
- (if (eq (car-safe a) 'var)
- 1
- (if (Math-objvecp a)
- 0
- (list 'calcFunc-variable a))))
-
-(defun calcFunc-nonvar (a)
- (if (eq (car-safe a) 'var)
- (list 'calcFunc-nonvar a)
- 1))
-
-(defun calcFunc-istrue (a)
- (if (math-is-true a)
- 1
- 0))
-
-
-
-;;;; User-programmability.
-
-;;; Compiling Lisp-like forms to use the math library.
-
-(defun math-do-defmath (func args body)
- (calc-need-macros)
- (let* ((fname (intern (concat "calcFunc-" (symbol-name func))))
- (doc (if (stringp (car body)) (list (car body))))
- (clargs (mapcar 'math-clean-arg args))
- (body (math-define-function-body
- (if (stringp (car body)) (cdr body) body)
- clargs)))
- (list 'progn
- (if (and (consp (car body))
- (eq (car (car body)) 'interactive))
- (let ((inter (car body)))
- (setq body (cdr body))
- (if (or (> (length inter) 2)
- (integerp (nth 1 inter)))
- (let ((hasprefix nil) (hasmulti nil))
- (if (stringp (nth 1 inter))
- (progn
- (cond ((equal (nth 1 inter) "p")
- (setq hasprefix t))
- ((equal (nth 1 inter) "m")
- (setq hasmulti t))
- (t (error
- "Can't handle interactive code string \"%s\""
- (nth 1 inter))))
- (setq inter (cdr inter))))
- (if (not (integerp (nth 1 inter)))
- (error
- "Expected an integer in interactive specification"))
- (append (list 'defun
- (intern (concat "calc-"
- (symbol-name func)))
- (if (or hasprefix hasmulti)
- '(&optional n)
- ()))
- doc
- (if (or hasprefix hasmulti)
- '((interactive "P"))
- '((interactive)))
- (list
- (append
- '(calc-slow-wrapper)
- (and hasmulti
- (list
- (list 'setq
- 'n
- (list 'if
- 'n
- (list 'prefix-numeric-value
- 'n)
- (nth 1 inter)))))
- (list
- (list 'calc-enter-result
- (if hasmulti 'n (nth 1 inter))
- (nth 2 inter)
- (if hasprefix
- (list 'append
- (list 'quote (list fname))
- (list 'calc-top-list-n
- (nth 1 inter))
- (list 'and
- 'n
- (list
- 'list
- (list
- 'math-normalize
- (list
- 'prefix-numeric-value
- 'n)))))
- (list 'cons
- (list 'quote fname)
- (list 'calc-top-list-n
- (if hasmulti
- 'n
- (nth 1 inter)))))))))))
- (append (list 'defun
- (intern (concat "calc-" (symbol-name func)))
- args)
- doc
- (list
- inter
- (cons 'calc-wrapper body))))))
- (append (list 'defun fname clargs)
- doc
- (math-do-arg-list-check args nil nil)
- body))))
-
-(defun math-clean-arg (arg)
- (if (consp arg)
- (math-clean-arg (nth 1 arg))
- arg))
-
-(defun math-do-arg-check (arg var is-opt is-rest)
- (if is-opt
- (let ((chk (math-do-arg-check arg var nil nil)))
- (list (cons 'and
- (cons var
- (if (cdr chk)
- (setq chk (list (cons 'progn chk)))
- chk)))))
- (and (consp arg)
- (let* ((rest (math-do-arg-check (nth 1 arg) var is-opt is-rest))
- (qual (car arg))
- (qqual (list 'quote qual))
- (qual-name (symbol-name qual))
- (chk (intern (concat "math-check-" qual-name))))
- (if (fboundp chk)
- (append rest
- (list
- (if is-rest
- (list 'setq var
- (list 'mapcar (list 'quote chk) var))
- (list 'setq var (list chk var)))))
- (if (fboundp (setq chk (intern (concat "math-" qual-name))))
- (append rest
- (list
- (if is-rest
- (list 'mapcar
- (list 'function
- (list 'lambda '(x)
- (list 'or
- (list chk 'x)
- (list 'math-reject-arg
- 'x qqual))))
- var)
- (list 'or
- (list chk var)
- (list 'math-reject-arg var qqual)))))
- (if (and (string-match "\\`not-\\(.*\\)\\'" qual-name)
- (fboundp (setq chk (intern
- (concat "math-"
- (math-match-substring
- qual-name 1))))))
- (append rest
- (list
- (if is-rest
- (list 'mapcar
- (list 'function
- (list 'lambda '(x)
- (list 'and
- (list chk 'x)
- (list 'math-reject-arg
- 'x qqual))))
- var)
- (list 'and
- (list chk var)
- (list 'math-reject-arg var qqual)))))
- (error "Unknown qualifier `%s'" qual-name))))))))
-
-(defun math-do-arg-list-check (args is-opt is-rest)
- (cond ((null args) nil)
- ((consp (car args))
- (append (math-do-arg-check (car args)
- (math-clean-arg (car args))
- is-opt is-rest)
- (math-do-arg-list-check (cdr args) is-opt is-rest)))
- ((eq (car args) '&optional)
- (math-do-arg-list-check (cdr args) t nil))
- ((eq (car args) '&rest)
- (math-do-arg-list-check (cdr args) nil t))
- (t (math-do-arg-list-check (cdr args) is-opt is-rest))))
-
-(defconst math-prim-funcs
- '( (~= . math-nearly-equal)
- (% . math-mod)
- (lsh . calcFunc-lsh)
- (ash . calcFunc-ash)
- (logand . calcFunc-and)
- (logandc2 . calcFunc-diff)
- (logior . calcFunc-or)
- (logxor . calcFunc-xor)
- (lognot . calcFunc-not)
- (equal . equal) ; need to leave these ones alone!
- (eq . eq)
- (and . and)
- (or . or)
- (if . if)
- (^ . math-pow)
- (expt . math-pow)
- ))
-
-(defconst math-prim-vars
- '( (nil . nil)
- (t . t)
- (&optional . &optional)
- (&rest . &rest)
- ))
-
-(defun math-define-function-body (body env)
- (let ((body (math-define-body body env)))
- (if (math-body-refers-to body 'math-return)
- (list (cons 'catch (cons '(quote math-return) body)))
- body)))
-
-(defun math-define-body (body exp-env)
- (math-define-list body))
-
-(defun math-define-list (body &optional quote)
- (cond ((null body)
- nil)
- ((and (eq (car body) ':)
- (stringp (nth 1 body)))
- (cons (let* ((math-read-expr-quotes t)
- (exp (math-read-plain-expr (nth 1 body) t)))
- (math-define-exp exp))
- (math-define-list (cdr (cdr body)))))
- (quote
- (cons (cond ((consp (car body))
- (math-define-list (cdr body) t))
- (t
- (car body)))
- (math-define-list (cdr body))))
- (t
- (cons (math-define-exp (car body))
- (math-define-list (cdr body))))))
-
-(defun math-define-exp (exp)
- (cond ((consp exp)
- (let ((func (car exp)))
- (cond ((memq func '(quote function))
- (if (and (consp (nth 1 exp))
- (eq (car (nth 1 exp)) 'lambda))
- (cons 'quote
- (math-define-lambda (nth 1 exp) exp-env))
- exp))
- ((memq func '(let let* for foreach))
- (let ((head (nth 1 exp))
- (body (cdr (cdr exp))))
- (if (memq func '(let let*))
- ()
- (setq func (cdr (assq func '((for . math-for)
- (foreach . math-foreach)))))
- (if (not (listp (car head)))
- (setq head (list head))))
- (macroexpand
- (cons func
- (cons (math-define-let head)
- (math-define-body body
- (nconc
- (math-define-let-env head)
- exp-env)))))))
- ((and (memq func '(setq setf))
- (math-complicated-lhs (cdr exp)))
- (if (> (length exp) 3)
- (cons 'progn (math-define-setf-list (cdr exp)))
- (math-define-setf (nth 1 exp) (nth 2 exp))))
- ((eq func 'condition-case)
- (cons func
- (cons (nth 1 exp)
- (math-define-body (cdr (cdr exp))
- (cons (nth 1 exp)
- exp-env)))))
- ((eq func 'cond)
- (cons func
- (math-define-cond (cdr exp))))
- ((and (consp func) ; ('spam a b) == force use of plain spam
- (eq (car func) 'quote))
- (cons func (math-define-list (cdr exp))))
- ((symbolp func)
- (let ((args (math-define-list (cdr exp)))
- (prim (assq func math-prim-funcs)))
- (cond (prim
- (cons (cdr prim) args))
- ((eq func 'floatp)
- (list 'eq (car args) '(quote float)))
- ((eq func '+)
- (math-define-binop 'math-add 0
- (car args) (cdr args)))
- ((eq func '-)
- (if (= (length args) 1)
- (cons 'math-neg args)
- (math-define-binop 'math-sub 0
- (car args) (cdr args))))
- ((eq func '*)
- (math-define-binop 'math-mul 1
- (car args) (cdr args)))
- ((eq func '/)
- (math-define-binop 'math-div 1
- (car args) (cdr args)))
- ((eq func 'min)
- (math-define-binop 'math-min 0
- (car args) (cdr args)))
- ((eq func 'max)
- (math-define-binop 'math-max 0
- (car args) (cdr args)))
- ((eq func '<)
- (if (and (math-numberp (nth 1 args))
- (math-zerop (nth 1 args)))
- (list 'math-negp (car args))
- (cons 'math-lessp args)))
- ((eq func '>)
- (if (and (math-numberp (nth 1 args))
- (math-zerop (nth 1 args)))
- (list 'math-posp (car args))
- (list 'math-lessp (nth 1 args) (nth 0 args))))
- ((eq func '<=)
- (list 'not
- (if (and (math-numberp (nth 1 args))
- (math-zerop (nth 1 args)))
- (list 'math-posp (car args))
- (list 'math-lessp
- (nth 1 args) (nth 0 args)))))
- ((eq func '>=)
- (list 'not
- (if (and (math-numberp (nth 1 args))
- (math-zerop (nth 1 args)))
- (list 'math-negp (car args))
- (cons 'math-lessp args))))
- ((eq func '=)
- (if (and (math-numberp (nth 1 args))
- (math-zerop (nth 1 args)))
- (list 'math-zerop (nth 0 args))
- (if (and (integerp (nth 1 args))
- (/= (% (nth 1 args) 10) 0))
- (cons 'math-equal-int args)
- (cons 'math-equal args))))
- ((eq func '/=)
- (list 'not
- (if (and (math-numberp (nth 1 args))
- (math-zerop (nth 1 args)))
- (list 'math-zerop (nth 0 args))
- (if (and (integerp (nth 1 args))
- (/= (% (nth 1 args) 10) 0))
- (cons 'math-equal-int args)
- (cons 'math-equal args)))))
- ((eq func '1+)
- (list 'math-add (car args) 1))
- ((eq func '1-)
- (list 'math-add (car args) -1))
- ((eq func 'not) ; optimize (not (not x)) => x
- (if (eq (car-safe args) func)
- (car (nth 1 args))
- (cons func args)))
- ((and (eq func 'elt) (cdr (cdr args)))
- (math-define-elt (car args) (cdr args)))
- (t
- (macroexpand
- (let* ((name (symbol-name func))
- (cfunc (intern (concat "calcFunc-" name)))
- (mfunc (intern (concat "math-" name))))
- (cond ((fboundp cfunc)
- (cons cfunc args))
- ((fboundp mfunc)
- (cons mfunc args))
- ((or (fboundp func)
- (string-match "\\`calcFunc-.*" name))
- (cons func args))
- (t
- (cons cfunc args)))))))))
- (t (cons func args)))))
- ((symbolp exp)
- (let ((prim (assq exp math-prim-vars))
- (name (symbol-name exp)))
- (cond (prim
- (cdr prim))
- ((memq exp exp-env)
- exp)
- ((string-match "-" name)
- exp)
- (t
- (intern (concat "var-" name))))))
- ((integerp exp)
- (if (or (<= exp -1000000) (>= exp 1000000))
- (list 'quote (math-normalize exp))
- exp))
- (t exp)))
-
-(defun math-define-cond (forms)
- (and forms
- (cons (math-define-list (car forms))
- (math-define-cond (cdr forms)))))
-
-(defun math-complicated-lhs (body)
- (and body
- (or (not (symbolp (car body)))
- (math-complicated-lhs (cdr (cdr body))))))
-
-(defun math-define-setf-list (body)
- (and body
- (cons (math-define-setf (nth 0 body) (nth 1 body))
- (math-define-setf-list (cdr (cdr body))))))
-
-(defun math-define-setf (place value)
- (setq place (math-define-exp place)
- value (math-define-exp value))
- (cond ((symbolp place)
- (list 'setq place value))
- ((eq (car-safe place) 'nth)
- (list 'setcar (list 'nthcdr (nth 1 place) (nth 2 place)) value))
- ((eq (car-safe place) 'elt)
- (list 'setcar (list 'nthcdr (nth 2 place) (nth 1 place)) value))
- ((eq (car-safe place) 'car)
- (list 'setcar (nth 1 place) value))
- ((eq (car-safe place) 'cdr)
- (list 'setcdr (nth 1 place) value))
- (t
- (error "Bad place form for setf: %s" place))))
-
-(defun math-define-binop (op ident arg1 rest)
- (if rest
- (math-define-binop op ident
- (list op arg1 (car rest))
- (cdr rest))
- (or arg1 ident)))
-
-(defun math-define-let (vlist)
- (and vlist
- (cons (if (consp (car vlist))
- (cons (car (car vlist))
- (math-define-list (cdr (car vlist))))
- (car vlist))
- (math-define-let (cdr vlist)))))
-
-(defun math-define-let-env (vlist)
- (and vlist
- (cons (if (consp (car vlist))
- (car (car vlist))
- (car vlist))
- (math-define-let-env (cdr vlist)))))
-
-(defun math-define-lambda (exp exp-env)
- (nconc (list (nth 0 exp) ; 'lambda
- (nth 1 exp)) ; arg list
- (math-define-function-body (cdr (cdr exp))
- (append (nth 1 exp) exp-env))))
-
-(defun math-define-elt (seq idx)
- (if idx
- (math-define-elt (list 'elt seq (car idx)) (cdr idx))
- seq))
-
-
-
-;;; Useful programming macros.
-
-(defmacro math-while (head &rest body)
- (let ((body (cons 'while (cons head body))))
- (if (math-body-refers-to body 'math-break)
- (cons 'catch (cons '(quote math-break) (list body)))
- body)))
-;; (put 'math-while 'lisp-indent-hook 1)
-
-(defmacro math-for (head &rest body)
- (let ((body (if head
- (math-handle-for head body)
- (cons 'while (cons t body)))))
- (if (math-body-refers-to body 'math-break)
- (cons 'catch (cons '(quote math-break) (list body)))
- body)))
-;; (put 'math-for 'lisp-indent-hook 1)
-
-(defun math-handle-for (head body)
- (let* ((var (nth 0 (car head)))
- (init (nth 1 (car head)))
- (limit (nth 2 (car head)))
- (step (or (nth 3 (car head)) 1))
- (body (if (cdr head)
- (list (math-handle-for (cdr head) body))
- body))
- (all-ints (and (integerp init) (integerp limit) (integerp step)))
- (const-limit (or (integerp limit)
- (and (eq (car-safe limit) 'quote)
- (math-realp (nth 1 limit)))))
- (const-step (or (integerp step)
- (and (eq (car-safe step) 'quote)
- (math-realp (nth 1 step)))))
- (save-limit (if const-limit limit (make-symbol "<limit>")))
- (save-step (if const-step step (make-symbol "<step>"))))
- (cons 'let
- (cons (append (if const-limit nil (list (list save-limit limit)))
- (if const-step nil (list (list save-step step)))
- (list (list var init)))
- (list
- (cons 'while
- (cons (if all-ints
- (if (> step 0)
- (list '<= var save-limit)
- (list '>= var save-limit))
- (list 'not
- (if const-step
- (if (or (math-posp step)
- (math-posp
- (cdr-safe step)))
- (list 'math-lessp
- save-limit
- var)
- (list 'math-lessp
- var
- save-limit))
- (list 'if
- (list 'math-posp
- save-step)
- (list 'math-lessp
- save-limit
- var)
- (list 'math-lessp
- var
- save-limit)))))
- (append body
- (list (list 'setq
- var
- (list (if all-ints
- '+
- 'math-add)
- var
- save-step)))))))))))
-
-(defmacro math-foreach (head &rest body)
- (let ((body (math-handle-foreach head body)))
- (if (math-body-refers-to body 'math-break)
- (cons 'catch (cons '(quote math-break) (list body)))
- body)))
-;; (put 'math-foreach 'lisp-indent-hook 1)
-
-(defun math-handle-foreach (head body)
- (let ((var (nth 0 (car head)))
- (data (nth 1 (car head)))
- (body (if (cdr head)
- (list (math-handle-foreach (cdr head) body))
- body)))
- (cons 'let
- (cons (list (list var data))
- (list
- (cons 'while
- (cons var
- (append body
- (list (list 'setq
- var
- (list 'cdr var)))))))))))
-
-
-(defun math-body-refers-to (body thing)
- (or (equal body thing)
- (and (consp body)
- (or (math-body-refers-to (car body) thing)
- (math-body-refers-to (cdr body) thing)))))
-
-(defun math-break (&optional value)
- (throw 'math-break value))
-
-(defun math-return (&optional value)
- (throw 'math-return value))
-
-
-
-
-
-(defun math-composite-inequalities (x op)
- (if (memq (nth 1 op) '(calcFunc-eq calcFunc-neq))
- (if (eq (car x) (nth 1 op))
- (append x (list (math-read-expr-level (nth 3 op))))
- (throw 'syntax "Syntax error"))
- (list 'calcFunc-in
- (nth 2 x)
- (if (memq (nth 1 op) '(calcFunc-lt calcFunc-leq))
- (if (memq (car x) '(calcFunc-lt calcFunc-leq))
- (math-make-intv
- (+ (if (eq (car x) 'calcFunc-leq) 2 0)
- (if (eq (nth 1 op) 'calcFunc-leq) 1 0))
- (nth 1 x) (math-read-expr-level (nth 3 op)))
- (throw 'syntax "Syntax error"))
- (if (memq (car x) '(calcFunc-gt calcFunc-geq))
- (math-make-intv
- (+ (if (eq (nth 1 op) 'calcFunc-geq) 2 0)
- (if (eq (car x) 'calcFunc-geq) 1 0))
- (math-read-expr-level (nth 3 op)) (nth 1 x))
- (throw 'syntax "Syntax error"))))))
-
-;;; calc-prog.el ends here
+++ /dev/null
-;;; calc-rewr.el --- rewriting functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-rewr () nil)
-
-
-(defvar math-rewrite-default-iters 100)
-(defun calc-rewrite-selection (rules-str &optional many prefix)
- (interactive "sRewrite rule(s): \np")
- (calc-slow-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect t)
- (pop-rules nil)
- (entry (calc-top num 'entry))
- (expr (car entry))
- (sel (calc-auto-selection entry))
- (math-rewrite-selections t)
- (math-rewrite-default-iters 1))
- (if (or (null rules-str) (equal rules-str "") (equal rules-str "$"))
- (if (= num 1)
- (error "Can't use same stack entry for formula and rules")
- (setq rules (calc-top-n 1 t)
- pop-rules t))
- (setq rules (if (stringp rules-str)
- (math-read-exprs rules-str) rules-str))
- (if (eq (car-safe rules) 'error)
- (error "Bad format in expression: %s" (nth 1 rules)))
- (if (= (length rules) 1)
- (setq rules (car rules))
- (setq rules (cons 'vec rules)))
- (or (memq (car-safe rules) '(vec var calcFunc-assign
- calcFunc-condition))
- (let ((rhs (math-read-expr
- (read-string (concat "Rewrite from: " rules-str
- " to: ")))))
- (if (eq (car-safe rhs) 'error)
- (error "Bad format in expression: %s" (nth 1 rhs)))
- (setq rules (list 'calcFunc-assign rules rhs))))
- (or (eq (car-safe rules) 'var)
- (calc-record rules "rule")))
- (if (eq many 0)
- (setq many '(var inf var-inf))
- (if many (setq many (prefix-numeric-value many))))
- (if sel
- (setq expr (calc-replace-sub-formula (car entry)
- sel
- (list 'calcFunc-select sel)))
- (setq expr (car entry)
- reselect nil
- math-rewrite-selections nil))
- (setq expr (calc-encase-atoms
- (calc-normalize
- (math-rewrite
- (calc-normalize expr)
- rules many)))
- sel nil
- expr (calc-locate-select-marker expr))
- (or (consp sel) (setq sel nil))
- (if pop-rules (calc-pop-stack 1))
- (calc-pop-push-record-list 1 (or prefix "rwrt") (list expr)
- (- num (if pop-rules 1 0))
- (list (and reselect sel))))
- (calc-handle-whys)))
-
-(defun calc-locate-select-marker (expr) ; changes "sel"
- (if (Math-primp expr)
- expr
- (if (and (eq (car expr) 'calcFunc-select)
- (= (length expr) 2))
- (progn
- (setq sel (if sel t (nth 1 expr)))
- (nth 1 expr))
- (cons (car expr)
- (mapcar 'calc-locate-select-marker (cdr expr))))))
-
-
-
-(defun calc-rewrite (rules-str many)
- (interactive "sRewrite rule(s): \nP")
- (calc-slow-wrapper
- (let (n rules expr)
- (if (or (null rules-str) (equal rules-str "") (equal rules-str "$"))
- (setq expr (calc-top-n 2)
- rules (calc-top-n 1 t)
- n 2)
- (setq rules (if (stringp rules-str)
- (math-read-exprs rules-str) rules-str))
- (if (eq (car-safe rules) 'error)
- (error "Bad format in expression: %s" (nth 1 rules)))
- (if (= (length rules) 1)
- (setq rules (car rules))
- (setq rules (cons 'vec rules)))
- (or (memq (car-safe rules) '(vec var calcFunc-assign
- calcFunc-condition))
- (let ((rhs (math-read-expr
- (read-string (concat "Rewrite from: " rules-str
- " to: ")))))
- (if (eq (car-safe rhs) 'error)
- (error "Bad format in expression: %s" (nth 1 rhs)))
- (setq rules (list 'calcFunc-assign rules rhs))))
- (or (eq (car-safe rules) 'var)
- (calc-record rules "rule"))
- (setq expr (calc-top-n 1)
- n 1))
- (if (eq many 0)
- (setq many '(var inf var-inf))
- (if many (setq many (prefix-numeric-value many))))
- (setq expr (calc-normalize (math-rewrite expr rules many)))
- (let (sel)
- (setq expr (calc-locate-select-marker expr)))
- (calc-pop-push-record-list n "rwrt" (list expr)))
- (calc-handle-whys)))
-
-(defun calc-match (pat)
- (interactive "sPattern: \n")
- (calc-slow-wrapper
- (let (n expr)
- (if (or (null pat) (equal pat "") (equal pat "$"))
- (setq expr (calc-top-n 2)
- pat (calc-top-n 1)
- n 2)
- (if (interactive-p) (setq calc-previous-alg-entry pat))
- (setq pat (if (stringp pat) (math-read-expr pat) pat))
- (if (eq (car-safe pat) 'error)
- (error "Bad format in expression: %s" (nth 1 pat)))
- (if (not (eq (car-safe pat) 'var))
- (calc-record pat "pat"))
- (setq expr (calc-top-n 1)
- n 1))
- (or (math-vectorp expr) (error "Argument must be a vector"))
- (if (calc-is-inverse)
- (calc-enter-result n "mtcn" (math-match-patterns pat expr t))
- (calc-enter-result n "mtch" (math-match-patterns pat expr nil))))))
-
-
-
-(defun math-rewrite (whole-expr rules &optional mmt-many)
- (let ((crules (math-compile-rewrites rules))
- (heads (math-rewrite-heads whole-expr))
- (trace-buffer (get-buffer "*Trace*"))
- (calc-display-just 'center)
- (calc-display-origin 39)
- (calc-line-breaking 78)
- (calc-line-numbering nil)
- (calc-show-selections t)
- (calc-why nil)
- (mmt-func (function
- (lambda (x)
- (let ((result (math-apply-rewrites x (cdr crules)
- heads crules)))
- (if result
- (progn
- (if trace-buffer
- (let ((fmt (math-format-stack-value
- (list result nil nil))))
- (save-excursion
- (set-buffer trace-buffer)
- (insert "\nrewrite to\n" fmt "\n"))))
- (setq heads (math-rewrite-heads result heads t))))
- result)))))
- (if trace-buffer
- (let ((fmt (math-format-stack-value (list whole-expr nil nil))))
- (save-excursion
- (set-buffer trace-buffer)
- (setq truncate-lines t)
- (goto-char (point-max))
- (insert "\n\nBegin rewriting\n" fmt "\n"))))
- (or mmt-many (setq mmt-many (or (nth 1 (car crules))
- math-rewrite-default-iters)))
- (if (equal mmt-many '(var inf var-inf)) (setq mmt-many 1000000))
- (if (equal mmt-many '(neg (var inf var-inf))) (setq mmt-many -1000000))
- (math-rewrite-phase (nth 3 (car crules)))
- (if trace-buffer
- (let ((fmt (math-format-stack-value (list whole-expr nil nil))))
- (save-excursion
- (set-buffer trace-buffer)
- (insert "\nDone rewriting"
- (if (= mmt-many 0) " (reached iteration limit)" "")
- ":\n" fmt "\n"))))
- whole-expr))
-
-(defun math-rewrite-phase (sched)
- (while (and sched (/= mmt-many 0))
- (if (listp (car sched))
- (while (let ((save-expr whole-expr))
- (math-rewrite-phase (car sched))
- (not (equal whole-expr save-expr))))
- (if (symbolp (car sched))
- (progn
- (setq whole-expr (math-normalize (list (car sched) whole-expr)))
- (if trace-buffer
- (let ((fmt (math-format-stack-value
- (list whole-expr nil nil))))
- (save-excursion
- (set-buffer trace-buffer)
- (insert "\ncall "
- (substring (symbol-name (car sched)) 9)
- ":\n" fmt "\n")))))
- (let ((math-rewrite-phase (car sched)))
- (if trace-buffer
- (save-excursion
- (set-buffer trace-buffer)
- (insert (format "\n(Phase %d)\n" math-rewrite-phase))))
- (while (let ((save-expr whole-expr))
- (setq whole-expr (math-normalize
- (math-map-tree-rec whole-expr)))
- (not (equal whole-expr save-expr)))))))
- (setq sched (cdr sched))))
-
-(defun calcFunc-rewrite (expr rules &optional many)
- (or (null many) (integerp many)
- (equal many '(var inf var-inf)) (equal many '(neg (var inf var-inf)))
- (math-reject-arg many 'fixnump))
- (condition-case err
- (math-rewrite expr rules (or many 1))
- (error (math-reject-arg rules (nth 1 err)))))
-
-(defun calcFunc-match (pat vec)
- (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
- (condition-case err
- (math-match-patterns pat vec nil)
- (error (math-reject-arg pat (nth 1 err)))))
-
-(defun calcFunc-matchnot (pat vec)
- (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
- (condition-case err
- (math-match-patterns pat vec t)
- (error (math-reject-arg pat (nth 1 err)))))
-
-(defun math-match-patterns (pat vec &optional not-flag)
- (let ((newvec nil)
- (crules (math-compile-patterns pat)))
- (while (setq vec (cdr vec))
- (if (eq (not (math-apply-rewrites (car vec) crules))
- not-flag)
- (setq newvec (cons (car vec) newvec))))
- (cons 'vec (nreverse newvec))))
-
-(defun calcFunc-matches (expr pat)
- (condition-case err
- (if (math-apply-rewrites expr (math-compile-patterns pat))
- 1
- 0)
- (error (math-reject-arg pat (nth 1 err)))))
-
-(defun calcFunc-vmatches (expr pat)
- (condition-case err
- (or (math-apply-rewrites expr (math-compile-patterns pat))
- 0)
- (error (math-reject-arg pat (nth 1 err)))))
-
-
-
-;;; A compiled rule set is an a-list of entries whose cars are functors,
-;;; and whose cdrs are lists of rules. If there are rules with no
-;;; well-defined head functor, they are included on all lists and also
-;;; on an extra list whose car is nil.
-;;;
-;;; The first entry in the a-list is of the form (schedule A B C ...).
-;;;
-;;; Rule list entries take the form (regs prog head phases), where:
-;;;
-;;; regs is a vector of match registers.
-;;;
-;;; prog is a match program (see below).
-;;;
-;;; head is a rare function name appearing in the rule body (but not the
-;;; head of the whole rule), or nil if none.
-;;;
-;;; phases is a list of phase numbers for which the rule is enabled.
-;;;
-;;; A match program is a list of match instructions.
-;;;
-;;; In the following, "part" is a register number that contains the
-;;; subexpression to be operated on.
-;;;
-;;; Register 0 is the whole expression being matched. The others are
-;;; meta-variables in the pattern, temporaries used for matching and
-;;; backtracking, and constant expressions.
-;;;
-;;; (same part reg)
-;;; The selected part must be math-equal to the contents of "reg".
-;;;
-;;; (same-neg part reg)
-;;; The selected part must be math-equal to the negative of "reg".
-;;;
-;;; (copy part reg)
-;;; The selected part is copied into "reg". (Rarely used.)
-;;;
-;;; (copy-neg part reg)
-;;; The negative of the selected part is copied into "reg".
-;;;
-;;; (integer part)
-;;; The selected part must be an integer.
-;;;
-;;; (real part)
-;;; The selected part must be a real.
-;;;
-;;; (constant part)
-;;; The selected part must be a constant.
-;;;
-;;; (negative part)
-;;; The selected part must "look" negative.
-;;;
-;;; (rel part op reg)
-;;; The selected part must satisfy "part op reg", where "op"
-;;; is one of the 6 relational ops, and "reg" is a register.
-;;;
-;;; (mod part modulo value)
-;;; The selected part must satisfy "part % modulo = value", where
-;;; "modulo" and "value" are constants.
-;;;
-;;; (func part head reg1 reg2 ... regn)
-;;; The selected part must be an n-ary call to function "head".
-;;; The arguments are stored in "reg1" through "regn".
-;;;
-;;; (func-def part head defs reg1 reg2 ... regn)
-;;; The selected part must be an n-ary call to function "head".
-;;; "Defs" is a list of value/register number pairs for default args.
-;;; If a match, assign default values to registers and then skip
-;;; immediately over any following "func-def" instructions and
-;;; the following "func" instruction. If wrong number of arguments,
-;;; proceed to the following "func-def" or "func" instruction.
-;;;
-;;; (func-opt part head defs reg1)
-;;; Like func-def with "n=1", except that if the selected part is
-;;; not a call to "head", then the part itself successfully matches
-;;; "reg1" (and the defaults are assigned).
-;;;
-;;; (try part heads mark reg1 [def])
-;;; The selected part must be a function of the correct type which is
-;;; associative and/or commutative. "Heads" is a list of acceptable
-;;; types. An initial assignment of arguments to "reg1" is tried.
-;;; If the program later fails, it backtracks to this instruction
-;;; and tries other assignments of arguments to "reg1".
-;;; If "def" exists and normal matching fails, backtrack and assign
-;;; "part" to "reg1", and "def" to "reg2" in the following "try2".
-;;; The "mark" is a vector of size 5; only "mark[3-4]" are initialized.
-;;; "mark[0]" points to the argument list; "mark[1]" points to the
-;;; current argument; "mark[2]" is 0 if there are two arguments,
-;;; 1 if reg1 is matching single arguments, 2 if reg2 is matching
-;;; single arguments (a+b+c+d is never split as (a+b)+(c+d)), or
-;;; 3 if reg2 is matching "def"; "mark[3]" is 0 if the function must
-;;; have two arguments, 1 if phase-2 can be skipped, 2 if full
-;;; backtracking is necessary; "mark[4]" is t if the arguments have
-;;; been switched from the order given in the original pattern.
-;;;
-;;; (try2 try reg2)
-;;; Every "try" will be followed by a "try2" whose "try" field is
-;;; a pointer to the corresponding "try". The arguments which were
-;;; not stored in "reg1" by that "try" are now stored in "reg2".
-;;;
-;;; (alt instr nil mark)
-;;; Basic backtracking. Execute the instruction sequence "instr".
-;;; If this fails, back up and execute following the "alt" instruction.
-;;; The "mark" must be the vector "[nil nil 4]". The "instr" sequence
-;;; should execute "end-alt" at the end.
-;;;
-;;; (end-alt ptr)
-;;; Register success of the first alternative of a previous "alt".
-;;; "Ptr" is a pointer to the next instruction following that "alt".
-;;;
-;;; (apply part reg1 reg2)
-;;; The selected part must be a function call. The functor
-;;; (as a variable name) is stored in "reg1"; the arguments
-;;; (as a vector) are stored in "reg2".
-;;;
-;;; (cons part reg1 reg2)
-;;; The selected part must be a nonempty vector. The first element
-;;; of the vector is stored in "reg1"; the rest of the vector
-;;; (as another vector) is stored in "reg2".
-;;;
-;;; (rcons part reg1 reg2)
-;;; The selected part must be a nonempty vector. The last element
-;;; of the vector is stored in "reg2"; the rest of the vector
-;;; (as another vector) is stored in "reg1".
-;;;
-;;; (select part reg)
-;;; If the selected part is a unary call to function "select", its
-;;; argument is stored in "reg"; otherwise (provided this is an `a r'
-;;; and not a `g r' command) the selected part is stored in "reg".
-;;;
-;;; (cond expr)
-;;; The "expr", with registers substituted, must simplify to
-;;; a non-zero value.
-;;;
-;;; (let reg expr)
-;;; Evaluate "expr" and store the result in "reg". Always succeeds.
-;;;
-;;; (done rhs remember)
-;;; Rewrite the expression to "rhs", with register substituted.
-;;; Normalize; if the result is different from the original
-;;; expression, the match has succeeded. This is the last
-;;; instruction of every program. If "remember" is non-nil,
-;;; record the result of the match as a new literal rule.
-
-
-;;; Pseudo-functions related to rewrites:
-;;;
-;;; In patterns: quote, plain, condition, opt, apply, cons, select
-;;;
-;;; In righthand sides: quote, plain, eval, evalsimp, evalextsimp,
-;;; apply, cons, select
-;;;
-;;; In conditions: let + same as for righthand sides
-
-;;; Some optimizations that would be nice to have:
-;;;
-;;; * Merge registers with disjoint lifetimes.
-;;; * Merge constant registers with equivalent values.
-;;;
-;;; * If an argument of a commutative op math-depends neither on the
-;;; rest of the pattern nor on any of the conditions, then no backtracking
-;;; should be done for that argument. (This won't apply to very many
-;;; cases.)
-;;;
-;;; * If top functor is "select", and its argument is a unique function,
-;;; add the rule to the lists for both "select" and that function.
-;;; (Currently rules like this go on the "nil" list.)
-;;; Same for "func-opt" functions. (Though not urgent for these.)
-;;;
-;;; * Shouldn't evaluate a "let" condition until the end, or until it
-;;; would enable another condition to be evaluated.
-;;;
-
-;;; Some additional features to add / things to think about:
-;;;
-;;; * Figure out what happens to "a +/- b" and "a +/- opt(b)".
-;;;
-;;; * Same for interval forms.
-;;;
-;;; * Have a name(v,pat) pattern which matches pat, and gives the
-;;; whole match the name v. Beware of circular structures!
-;;;
-
-(defun math-compile-patterns (pats)
- (if (and (eq (car-safe pats) 'var)
- (calc-var-value (nth 2 pats)))
- (let ((prop (get (nth 2 pats) 'math-pattern-cache)))
- (or prop
- (put (nth 2 pats) 'math-pattern-cache (setq prop (list nil))))
- (or (eq (car prop) (symbol-value (nth 2 pats)))
- (progn
- (setcdr prop (math-compile-patterns
- (symbol-value (nth 2 pats))))
- (setcar prop (symbol-value (nth 2 pats)))))
- (cdr prop))
- (let ((math-rewrite-whole t))
- (cdr (math-compile-rewrites (cons
- 'vec
- (mapcar (function (lambda (x)
- (list 'vec x t)))
- (if (eq (car-safe pats) 'vec)
- (cdr pats)
- (list pats)))))))))
-
-(defvar math-rewrite-whole nil)
-(defvar math-make-import-list nil)
-(defun math-compile-rewrites (rules &optional name)
- (if (eq (car-safe rules) 'var)
- (let ((prop (get (nth 2 rules) 'math-rewrite-cache))
- (math-import-list nil)
- (math-make-import-list t)
- p)
- (or (calc-var-value (nth 2 rules))
- (error "Rules variable %s has no stored value" (nth 1 rules)))
- (or prop
- (put (nth 2 rules) 'math-rewrite-cache
- (setq prop (list (list (cons (nth 2 rules) nil))))))
- (setq p (car prop))
- (while (and p (eq (symbol-value (car (car p))) (cdr (car p))))
- (setq p (cdr p)))
- (or (null p)
- (progn
- (message "Compiling rule set %s..." (nth 1 rules))
- (setcdr prop (math-compile-rewrites
- (symbol-value (nth 2 rules))
- (nth 2 rules)))
- (message "Compiling rule set %s...done" (nth 1 rules))
- (setcar prop (cons (cons (nth 2 rules)
- (symbol-value (nth 2 rules)))
- math-import-list))))
- (cdr prop))
- (if (or (not (eq (car-safe rules) 'vec))
- (and (memq (length rules) '(3 4))
- (let ((p rules))
- (while (and (setq p (cdr p))
- (memq (car-safe (car p))
- '(vec
- calcFunc-assign
- calcFunc-condition
- calcFunc-import
- calcFunc-phase
- calcFunc-schedule
- calcFunc-iterations))))
- p)))
- (setq rules (list rules))
- (setq rules (cdr rules)))
- (if (assq 'calcFunc-import rules)
- (let ((pp (setq rules (copy-sequence rules)))
- p part)
- (while (setq p (car (cdr pp)))
- (if (eq (car-safe p) 'calcFunc-import)
- (progn
- (setcdr pp (cdr (cdr pp)))
- (or (and (eq (car-safe (nth 1 p)) 'var)
- (setq part (calc-var-value (nth 2 (nth 1 p))))
- (memq (car-safe part) '(vec
- calcFunc-assign
- calcFunc-condition)))
- (error "Argument of import() must be a rules variable"))
- (if math-make-import-list
- (setq math-import-list
- (cons (cons (nth 2 (nth 1 p))
- (symbol-value (nth 2 (nth 1 p))))
- math-import-list)))
- (while (setq p (cdr (cdr p)))
- (or (cdr p)
- (error "import() must have odd number of arguments"))
- (setq part (math-rwcomp-substitute part
- (car p) (nth 1 p))))
- (if (eq (car-safe part) 'vec)
- (setq part (cdr part))
- (setq part (list part)))
- (setcdr pp (append part (cdr pp))))
- (setq pp (cdr pp))))))
- (let ((rule-set nil)
- (all-heads nil)
- (nil-rules nil)
- (rule-count 0)
- (math-schedule nil)
- (math-iterations nil)
- (math-phases nil)
- (math-all-phases nil)
- (math-remembering nil)
- math-pattern math-rhs math-conds)
- (while rules
- (cond
- ((and (eq (car-safe (car rules)) 'calcFunc-iterations)
- (= (length (car rules)) 2))
- (or (integerp (nth 1 (car rules)))
- (equal (nth 1 (car rules)) '(var inf var-inf))
- (equal (nth 1 (car rules)) '(neg (var inf var-inf)))
- (error "Invalid argument for iterations(n)"))
- (or math-iterations
- (setq math-iterations (nth 1 (car rules)))))
- ((eq (car-safe (car rules)) 'calcFunc-schedule)
- (or math-schedule
- (setq math-schedule (math-parse-schedule (cdr (car rules))))))
- ((eq (car-safe (car rules)) 'calcFunc-phase)
- (setq math-phases (cdr (car rules)))
- (if (equal math-phases '((var all var-all)))
- (setq math-phases nil))
- (let ((p math-phases))
- (while p
- (or (integerp (car p))
- (error "Phase numbers must be small integers"))
- (or (memq (car p) math-all-phases)
- (setq math-all-phases (cons (car p) math-all-phases)))
- (setq p (cdr p)))))
- ((or (and (eq (car-safe (car rules)) 'vec)
- (cdr (cdr (car rules)))
- (not (nthcdr 4 (car rules)))
- (setq math-conds (nth 3 (car rules))
- math-rhs (nth 2 (car rules))
- math-pattern (nth 1 (car rules))))
- (progn
- (setq math-conds nil
- math-pattern (car rules))
- (while (and (eq (car-safe math-pattern) 'calcFunc-condition)
- (= (length math-pattern) 3))
- (let ((cond (nth 2 math-pattern)))
- (setq math-conds (if math-conds
- (list 'calcFunc-land math-conds cond)
- cond)
- math-pattern (nth 1 math-pattern))))
- (and (eq (car-safe math-pattern) 'calcFunc-assign)
- (= (length math-pattern) 3)
- (setq math-rhs (nth 2 math-pattern)
- math-pattern (nth 1 math-pattern)))))
- (let* ((math-prog (list nil))
- (math-prog-last math-prog)
- (math-num-regs 1)
- (math-regs (list (list nil 0 nil nil)))
- (math-bound-vars nil)
- (math-aliased-vars nil)
- (math-copy-neg nil))
- (setq math-conds (and math-conds (math-flatten-lands math-conds)))
- (math-rwcomp-pattern math-pattern 0)
- (while math-conds
- (let ((expr (car math-conds)))
- (setq math-conds (cdr math-conds))
- (math-rwcomp-cond-instr expr)))
- (math-rwcomp-instr 'done
- (if (eq math-rhs t)
- (cons 'vec
- (delq
- nil
- (nreverse
- (mapcar
- (function
- (lambda (v)
- (and (car v)
- (list
- 'calcFunc-assign
- (math-build-var-name
- (car v))
- (math-rwcomp-register-expr
- (nth 1 v))))))
- math-regs))))
- (math-rwcomp-match-vars math-rhs))
- math-remembering)
- (setq math-prog (cdr math-prog))
- (let* ((heads (math-rewrite-heads math-pattern))
- (rule (list (vconcat
- (nreverse
- (mapcar (function (lambda (x) (nth 3 x)))
- math-regs)))
- math-prog
- heads
- math-phases))
- (head (and (not (Math-primp math-pattern))
- (not (and (eq (car (car math-prog)) 'try)
- (nth 5 (car math-prog))))
- (not (memq (car (car math-prog)) '(func-opt
- apply
- select
- alt)))
- (if (memq (car (car math-prog)) '(func
- func-def))
- (nth 2 (car math-prog))
- (if (eq (car math-pattern) 'calcFunc-quote)
- (car-safe (nth 1 math-pattern))
- (car math-pattern))))))
- (let (found)
- (while heads
- (if (setq found (assq (car heads) all-heads))
- (setcdr found (1+ (cdr found)))
- (setq all-heads (cons (cons (car heads) 1) all-heads)))
- (setq heads (cdr heads))))
- (if (eq head '-) (setq head '+))
- (if (memq head '(calcFunc-cons calcFunc-rcons)) (setq head 'vec))
- (if head
- (progn
- (nconc (or (assq head rule-set)
- (car (setq rule-set (cons (cons head
- (copy-sequence
- nil-rules))
- rule-set))))
- (list rule))
- (if (eq head '*)
- (nconc (or (assq '/ rule-set)
- (car (setq rule-set (cons (cons
- '/
- (copy-sequence
- nil-rules))
- rule-set))))
- (list rule))))
- (setq nil-rules (nconc nil-rules (list rule)))
- (let ((ptr rule-set))
- (while ptr
- (nconc (car ptr) (list rule))
- (setq ptr (cdr ptr))))))))
- (t
- (error "Rewrite rule set must be a vector of A := B rules")))
- (setq rules (cdr rules)))
- (if nil-rules
- (setq rule-set (cons (cons nil nil-rules) rule-set)))
- (setq all-heads (mapcar 'car
- (sort all-heads (function
- (lambda (x y)
- (< (cdr x) (cdr y)))))))
- (let ((set rule-set)
- rule heads ptr)
- (while set
- (setq rule (cdr (car set)))
- (while rule
- (if (consp (setq heads (nth 2 (car rule))))
- (progn
- (setq heads (delq (car (car set)) heads)
- ptr all-heads)
- (while (and ptr (not (memq (car ptr) heads)))
- (setq ptr (cdr ptr)))
- (setcar (nthcdr 2 (car rule)) (car ptr))))
- (setq rule (cdr rule)))
- (setq set (cdr set))))
- (let ((plus (assq '+ rule-set)))
- (if plus
- (setq rule-set (cons (cons '- (cdr plus)) rule-set))))
- (cons (list 'schedule math-iterations name
- (or math-schedule
- (sort math-all-phases '<)
- (list 1)))
- rule-set))))
-
-(defun math-flatten-lands (expr)
- (if (eq (car-safe expr) 'calcFunc-land)
- (append (math-flatten-lands (nth 1 expr))
- (math-flatten-lands (nth 2 expr)))
- (list expr)))
-
-(defun math-rewrite-heads (expr &optional more all)
- (let ((heads more)
- (skips (and (not all)
- '(calcFunc-apply calcFunc-condition calcFunc-opt
- calcFunc-por calcFunc-pnot)))
- (blanks (and (not all)
- '(calcFunc-quote calcFunc-plain calcFunc-select
- calcFunc-cons calcFunc-rcons
- calcFunc-pand))))
- (or (Math-primp expr)
- (math-rewrite-heads-rec expr))
- heads))
-
-(defun math-rewrite-heads-rec (expr)
- (or (memq (car expr) skips)
- (progn
- (or (memq (car expr) heads)
- (memq (car expr) blanks)
- (memq 'algebraic (get (car expr) 'math-rewrite-props))
- (setq heads (cons (car expr) heads)))
- (while (setq expr (cdr expr))
- (or (Math-primp (car expr))
- (math-rewrite-heads-rec (car expr)))))))
-
-(defun math-parse-schedule (sched)
- (mapcar (function
- (lambda (s)
- (if (integerp s)
- s
- (if (math-vectorp s)
- (math-parse-schedule (cdr s))
- (if (eq (car-safe s) 'var)
- (math-var-to-calcFunc s)
- (error "Improper component in rewrite schedule"))))))
- sched))
-
-(defun math-rwcomp-match-vars (expr)
- (if (Math-primp expr)
- (if (eq (car-safe expr) 'var)
- (let ((entry (assq (nth 2 expr) math-regs)))
- (if entry
- (math-rwcomp-register-expr (nth 1 entry))
- expr))
- expr)
- (if (and (eq (car expr) 'calcFunc-quote)
- (= (length expr) 2))
- (math-rwcomp-match-vars (nth 1 expr))
- (if (and (eq (car expr) 'calcFunc-plain)
- (= (length expr) 2)
- (not (Math-primp (nth 1 expr))))
- (list (car expr)
- (cons (car (nth 1 expr))
- (mapcar 'math-rwcomp-match-vars (cdr (nth 1 expr)))))
- (cons (car expr)
- (mapcar 'math-rwcomp-match-vars (cdr expr)))))))
-
-(defun math-rwcomp-register-expr (num)
- (let ((entry (nth (1- (- math-num-regs num)) math-regs)))
- (if (nth 2 entry)
- (list 'neg (list 'calcFunc-register (nth 1 entry)))
- (list 'calcFunc-register (nth 1 entry)))))
-
-(defun math-rwcomp-substitute (expr old new)
- (if (and (eq (car-safe old) 'var)
- (memq (car-safe new) '(var calcFunc-lambda)))
- (let ((old-func (math-var-to-calcFunc old))
- (new-func (math-var-to-calcFunc new)))
- (math-rwcomp-subst-rec expr))
- (let ((old-func nil))
- (math-rwcomp-subst-rec expr))))
-
-(defun math-rwcomp-subst-rec (expr)
- (cond ((equal expr old) new)
- ((Math-primp expr) expr)
- (t (if (eq (car expr) old-func)
- (math-build-call new-func (mapcar 'math-rwcomp-subst-rec
- (cdr expr)))
- (cons (car expr)
- (mapcar 'math-rwcomp-subst-rec (cdr expr)))))))
-
-(defvar math-rwcomp-tracing nil)
-
-(defun math-rwcomp-trace (instr)
- (when math-rwcomp-tracing
- (terpri) (princ instr))
- instr)
-
-(defun math-rwcomp-instr (&rest instr)
- (setcdr math-prog-last
- (setq math-prog-last (list (math-rwcomp-trace instr)))))
-
-(defun math-rwcomp-multi-instr (tail &rest instr)
- (setcdr math-prog-last
- (setq math-prog-last (list (math-rwcomp-trace (append instr tail))))))
-
-(defun math-rwcomp-bind-var (reg var)
- (setcar (math-rwcomp-reg-entry reg) (nth 2 var))
- (setq math-bound-vars (cons (nth 2 var) math-bound-vars))
- (math-rwcomp-do-conditions))
-
-(defun math-rwcomp-unbind-vars (mark)
- (while (not (eq math-bound-vars mark))
- (setcar (assq (car math-bound-vars) math-regs) nil)
- (setq math-bound-vars (cdr math-bound-vars))))
-
-(defun math-rwcomp-do-conditions ()
- (let ((cond math-conds))
- (while cond
- (if (math-rwcomp-all-regs-done (car cond))
- (let ((expr (car cond)))
- (setq math-conds (delq (car cond) math-conds))
- (setcar cond 1)
- (math-rwcomp-cond-instr expr)))
- (setq cond (cdr cond)))))
-
-(defun math-rwcomp-cond-instr (expr)
- (let (op arg)
- (cond ((and (eq (car-safe expr) 'calcFunc-matches)
- (= (length expr) 3)
- (eq (car-safe (setq arg (math-rwcomp-match-vars (nth 1 expr))))
- 'calcFunc-register))
- (math-rwcomp-pattern (nth 2 expr) (nth 1 arg)))
- ((math-numberp (setq expr (math-rwcomp-match-vars expr)))
- (if (Math-zerop expr)
- (math-rwcomp-instr 'backtrack)))
- ((and (eq (car expr) 'calcFunc-let)
- (= (length expr) 3))
- (let ((reg (math-rwcomp-reg)))
- (math-rwcomp-instr 'let reg (nth 2 expr))
- (math-rwcomp-pattern (nth 1 expr) reg)))
- ((and (eq (car expr) 'calcFunc-let)
- (= (length expr) 2)
- (eq (car-safe (nth 1 expr)) 'calcFunc-assign)
- (= (length (nth 1 expr)) 3))
- (let ((reg (math-rwcomp-reg)))
- (math-rwcomp-instr 'let reg (nth 2 (nth 1 expr)))
- (math-rwcomp-pattern (nth 1 (nth 1 expr)) reg)))
- ((and (setq op (cdr (assq (car-safe expr)
- '( (calcFunc-integer . integer)
- (calcFunc-real . real)
- (calcFunc-constant . constant)
- (calcFunc-negative . negative) ))))
- (= (length expr) 2)
- (or (and (eq (car-safe (nth 1 expr)) 'neg)
- (memq op '(integer real constant))
- (setq arg (nth 1 (nth 1 expr))))
- (setq arg (nth 1 expr)))
- (eq (car-safe (setq arg (nth 1 expr))) 'calcFunc-register))
- (math-rwcomp-instr op (nth 1 arg)))
- ((and (assq (car-safe expr) calc-tweak-eqn-table)
- (= (length expr) 3)
- (eq (car-safe (nth 1 expr)) 'calcFunc-register))
- (if (math-constp (nth 2 expr))
- (let ((reg (math-rwcomp-reg)))
- (setcar (nthcdr 3 (car math-regs)) (nth 2 expr))
- (math-rwcomp-instr 'rel (nth 1 (nth 1 expr))
- (car expr) reg))
- (if (eq (car (nth 2 expr)) 'calcFunc-register)
- (math-rwcomp-instr 'rel (nth 1 (nth 1 expr))
- (car expr) (nth 1 (nth 2 expr)))
- (math-rwcomp-instr 'cond expr))))
- ((and (eq (car-safe expr) 'calcFunc-eq)
- (= (length expr) 3)
- (eq (car-safe (nth 1 expr)) '%)
- (eq (car-safe (nth 1 (nth 1 expr))) 'calcFunc-register)
- (math-constp (nth 2 (nth 1 expr)))
- (math-constp (nth 2 expr)))
- (math-rwcomp-instr 'mod (nth 1 (nth 1 (nth 1 expr)))
- (nth 2 (nth 1 expr)) (nth 2 expr)))
- ((equal expr '(var remember var-remember))
- (setq math-remembering 1))
- ((and (eq (car-safe expr) 'calcFunc-remember)
- (= (length expr) 2))
- (setq math-remembering (if math-remembering
- (list 'calcFunc-lor
- math-remembering (nth 1 expr))
- (nth 1 expr))))
- (t (math-rwcomp-instr 'cond expr)))))
-
-(defun math-rwcomp-same-instr (reg1 reg2 neg)
- (math-rwcomp-instr (if (eq (eq (nth 2 (math-rwcomp-reg-entry reg1))
- (nth 2 (math-rwcomp-reg-entry reg2)))
- neg)
- 'same-neg
- 'same)
- reg1 reg2))
-
-(defun math-rwcomp-copy-instr (reg1 reg2 neg)
- (if (eq (eq (nth 2 (math-rwcomp-reg-entry reg1))
- (nth 2 (math-rwcomp-reg-entry reg2)))
- neg)
- (math-rwcomp-instr 'copy-neg reg1 reg2)
- (or (eq reg1 reg2)
- (math-rwcomp-instr 'copy reg1 reg2))))
-
-(defun math-rwcomp-reg ()
- (prog1
- math-num-regs
- (setq math-regs (cons (list nil math-num-regs nil 0) math-regs)
- math-num-regs (1+ math-num-regs))))
-
-(defun math-rwcomp-reg-entry (num)
- (nth (1- (- math-num-regs num)) math-regs))
-
-
-(defun math-rwcomp-pattern (expr part &optional not-direct)
- (cond ((or (math-rwcomp-no-vars expr)
- (and (eq (car expr) 'calcFunc-quote)
- (= (length expr) 2)
- (setq expr (nth 1 expr))))
- (if (eq (car-safe expr) 'calcFunc-register)
- (math-rwcomp-same-instr part (nth 1 expr) nil)
- (let ((reg (math-rwcomp-reg)))
- (setcar (nthcdr 3 (car math-regs)) expr)
- (math-rwcomp-same-instr part reg nil))))
- ((eq (car expr) 'var)
- (let ((entry (assq (nth 2 expr) math-regs)))
- (if entry
- (math-rwcomp-same-instr part (nth 1 entry) nil)
- (if not-direct
- (let ((reg (math-rwcomp-reg)))
- (math-rwcomp-pattern expr reg)
- (math-rwcomp-copy-instr part reg nil))
- (if (setq entry (assq (nth 2 expr) math-aliased-vars))
- (progn
- (setcar (math-rwcomp-reg-entry (nth 1 entry))
- (nth 2 expr))
- (setcar entry nil)
- (math-rwcomp-copy-instr part (nth 1 entry) nil))
- (math-rwcomp-bind-var part expr))))))
- ((and (eq (car expr) 'calcFunc-select)
- (= (length expr) 2))
- (let ((reg (math-rwcomp-reg)))
- (math-rwcomp-instr 'select part reg)
- (math-rwcomp-pattern (nth 1 expr) reg)))
- ((and (eq (car expr) 'calcFunc-opt)
- (memq (length expr) '(2 3)))
- (error "opt( ) occurs in context where it is not allowed"))
- ((eq (car expr) 'neg)
- (if (eq (car (nth 1 expr)) 'var)
- (let ((entry (assq (nth 2 (nth 1 expr)) math-regs)))
- (if entry
- (math-rwcomp-same-instr part (nth 1 entry) t)
- (if math-copy-neg
- (let ((reg (math-rwcomp-best-reg (nth 1 expr))))
- (math-rwcomp-copy-instr part reg t)
- (math-rwcomp-pattern (nth 1 expr) reg))
- (setcar (cdr (cdr (math-rwcomp-reg-entry part))) t)
- (math-rwcomp-pattern (nth 1 expr) part))))
- (if (math-rwcomp-is-algebraic (nth 1 expr))
- (math-rwcomp-cond-instr (list 'calcFunc-eq
- (math-rwcomp-register-expr part)
- expr))
- (let ((reg (math-rwcomp-reg)))
- (math-rwcomp-instr 'func part 'neg reg)
- (math-rwcomp-pattern (nth 1 expr) reg)))))
- ((and (eq (car expr) 'calcFunc-apply)
- (= (length expr) 3))
- (let ((reg1 (math-rwcomp-reg))
- (reg2 (math-rwcomp-reg)))
- (math-rwcomp-instr 'apply part reg1 reg2)
- (math-rwcomp-pattern (nth 1 expr) reg1)
- (math-rwcomp-pattern (nth 2 expr) reg2)))
- ((and (eq (car expr) 'calcFunc-cons)
- (= (length expr) 3))
- (let ((reg1 (math-rwcomp-reg))
- (reg2 (math-rwcomp-reg)))
- (math-rwcomp-instr 'cons part reg1 reg2)
- (math-rwcomp-pattern (nth 1 expr) reg1)
- (math-rwcomp-pattern (nth 2 expr) reg2)))
- ((and (eq (car expr) 'calcFunc-rcons)
- (= (length expr) 3))
- (let ((reg1 (math-rwcomp-reg))
- (reg2 (math-rwcomp-reg)))
- (math-rwcomp-instr 'rcons part reg1 reg2)
- (math-rwcomp-pattern (nth 1 expr) reg1)
- (math-rwcomp-pattern (nth 2 expr) reg2)))
- ((and (eq (car expr) 'calcFunc-condition)
- (>= (length expr) 3))
- (math-rwcomp-pattern (nth 1 expr) part)
- (setq expr (cdr expr))
- (while (setq expr (cdr expr))
- (let ((cond (math-flatten-lands (car expr))))
- (while cond
- (if (math-rwcomp-all-regs-done (car cond))
- (math-rwcomp-cond-instr (car cond))
- (setq math-conds (cons (car cond) math-conds)))
- (setq cond (cdr cond))))))
- ((and (eq (car expr) 'calcFunc-pand)
- (= (length expr) 3))
- (math-rwcomp-pattern (nth 1 expr) part)
- (math-rwcomp-pattern (nth 2 expr) part))
- ((and (eq (car expr) 'calcFunc-por)
- (= (length expr) 3))
- (math-rwcomp-instr 'alt nil nil [nil nil 4])
- (let ((math-conds nil)
- (head math-prog-last)
- (mark math-bound-vars)
- (math-copy-neg t))
- (math-rwcomp-pattern (nth 1 expr) part t)
- (let ((amark math-aliased-vars)
- (math-aliased-vars math-aliased-vars)
- (tail math-prog-last)
- (p math-bound-vars)
- entry)
- (while (not (eq p mark))
- (setq entry (assq (car p) math-regs)
- math-aliased-vars (cons (list (car p) (nth 1 entry) nil)
- math-aliased-vars)
- p (cdr p))
- (setcar (math-rwcomp-reg-entry (nth 1 entry)) nil))
- (setcar (cdr (car head)) (cdr head))
- (setcdr head nil)
- (setq math-prog-last head)
- (math-rwcomp-pattern (nth 2 expr) part)
- (math-rwcomp-instr 'same 0 0)
- (setcdr tail math-prog-last)
- (setq p math-aliased-vars)
- (while (not (eq p amark))
- (if (car (car p))
- (setcar (math-rwcomp-reg-entry (nth 1 (car p)))
- (car (car p))))
- (setq p (cdr p)))))
- (math-rwcomp-do-conditions))
- ((and (eq (car expr) 'calcFunc-pnot)
- (= (length expr) 2))
- (math-rwcomp-instr 'alt nil nil [nil nil 4])
- (let ((head math-prog-last)
- (mark math-bound-vars))
- (math-rwcomp-pattern (nth 1 expr) part)
- (math-rwcomp-unbind-vars mark)
- (math-rwcomp-instr 'end-alt head)
- (math-rwcomp-instr 'backtrack)
- (setcar (cdr (car head)) (cdr head))
- (setcdr head nil)
- (setq math-prog-last head)))
- (t (let ((props (get (car expr) 'math-rewrite-props)))
- (if (and (eq (car expr) 'calcFunc-plain)
- (= (length expr) 2)
- (not (math-primp (nth 1 expr))))
- (setq expr (nth 1 expr))) ; but "props" is still nil
- (if (and (memq 'algebraic props)
- (math-rwcomp-is-algebraic expr))
- (math-rwcomp-cond-instr (list 'calcFunc-eq
- (math-rwcomp-register-expr part)
- expr))
- (if (and (memq 'commut props)
- (= (length expr) 3))
- (let ((arg1 (nth 1 expr))
- (arg2 (nth 2 expr))
- try1 def code head (flip nil))
- (if (eq (car expr) '-)
- (setq arg2 (math-rwcomp-neg arg2)))
- (setq arg1 (cons arg1 (math-rwcomp-best-reg arg1))
- arg2 (cons arg2 (math-rwcomp-best-reg arg2)))
- (or (math-rwcomp-order arg1 arg2)
- (setq def arg1 arg1 arg2 arg2 def flip t))
- (if (math-rwcomp-optional-arg (car expr) arg1)
- (error "Too many opt( ) arguments in this context"))
- (setq def (math-rwcomp-optional-arg (car expr) arg2)
- head (if (memq (car expr) '(+ -))
- '(+ -)
- (if (eq (car expr) '*)
- '(* /)
- (list (car expr))))
- code (if (math-rwcomp-is-constrained
- (car arg1) head)
- (if (math-rwcomp-is-constrained
- (car arg2) head)
- 0 1)
- 2))
- (math-rwcomp-multi-instr (and def (list def))
- 'try part head
- (vector nil nil nil code flip)
- (cdr arg1))
- (setq try1 (car math-prog-last))
- (math-rwcomp-pattern (car arg1) (cdr arg1))
- (math-rwcomp-instr 'try2 try1 (cdr arg2))
- (if (and (= part 0) (not def) (not math-rewrite-whole)
- (not (eq math-rhs t))
- (setq def (get (car expr)
- 'math-rewrite-default)))
- (let ((reg1 (math-rwcomp-reg))
- (reg2 (math-rwcomp-reg)))
- (if (= (aref (nth 3 try1) 3) 0)
- (aset (nth 3 try1) 3 1))
- (math-rwcomp-instr 'try (cdr arg2)
- (if (equal head '(* /))
- '(*) head)
- (vector nil nil nil
- (if (= code 0)
- 1 2)
- nil)
- reg1 def)
- (setq try1 (car math-prog-last))
- (math-rwcomp-pattern (car arg2) reg1)
- (math-rwcomp-instr 'try2 try1 reg2)
- (setq math-rhs (list (if (eq (car expr) '-)
- '+ (car expr))
- math-rhs
- (list 'calcFunc-register
- reg2))))
- (math-rwcomp-pattern (car arg2) (cdr arg2))))
- (let* ((args (mapcar (function
- (lambda (x)
- (cons x (math-rwcomp-best-reg x))))
- (cdr expr)))
- (args2 (copy-sequence args))
- (argp (reverse args2))
- (defs nil)
- (num 1))
- (while argp
- (let ((def (math-rwcomp-optional-arg (car expr)
- (car argp))))
- (if def
- (progn
- (setq args2 (delq (car argp) args2)
- defs (cons (cons def (cdr (car argp)))
- defs))
- (math-rwcomp-multi-instr
- (mapcar 'cdr args2)
- (if (or (and (memq 'unary1 props)
- (= (length args2) 1)
- (eq (car args2) (car args)))
- (and (memq 'unary2 props)
- (= (length args) 2)
- (eq (car args2) (nth 1 args))))
- 'func-opt
- 'func-def)
- part (car expr)
- defs))))
- (setq argp (cdr argp)))
- (math-rwcomp-multi-instr (mapcar 'cdr args)
- 'func part (car expr))
- (setq args (sort args 'math-rwcomp-order))
- (while args
- (math-rwcomp-pattern (car (car args)) (cdr (car args)))
- (setq num (1+ num)
- args (cdr args))))))))))
-
-(defun math-rwcomp-best-reg (x)
- (or (and (eq (car-safe x) 'var)
- (let ((entry (assq (nth 2 x) math-aliased-vars)))
- (and entry
- (not (nth 2 entry))
- (not (nth 2 (math-rwcomp-reg-entry (nth 1 entry))))
- (progn
- (setcar (cdr (cdr entry)) t)
- (nth 1 entry)))))
- (math-rwcomp-reg)))
-
-(defun math-rwcomp-all-regs-done (expr)
- (if (Math-primp expr)
- (or (not (eq (car-safe expr) 'var))
- (assq (nth 2 expr) math-regs)
- (eq (nth 2 expr) 'var-remember)
- (math-const-var expr))
- (if (and (eq (car expr) 'calcFunc-let)
- (= (length expr) 3))
- (math-rwcomp-all-regs-done (nth 2 expr))
- (if (and (eq (car expr) 'calcFunc-let)
- (= (length expr) 2)
- (eq (car-safe (nth 1 expr)) 'calcFunc-assign)
- (= (length (nth 1 expr)) 3))
- (math-rwcomp-all-regs-done (nth 2 (nth 1 expr)))
- (while (and (setq expr (cdr expr))
- (math-rwcomp-all-regs-done (car expr))))
- (null expr)))))
-
-(defun math-rwcomp-no-vars (expr)
- (if (Math-primp expr)
- (or (not (eq (car-safe expr) 'var))
- (math-const-var expr))
- (and (not (memq (car expr) '(calcFunc-condition
- calcFunc-select calcFunc-quote
- calcFunc-plain calcFunc-opt
- calcFunc-por calcFunc-pand
- calcFunc-pnot calcFunc-apply
- calcFunc-cons calcFunc-rcons)))
- (progn
- (while (and (setq expr (cdr expr))
- (math-rwcomp-no-vars (car expr))))
- (null expr)))))
-
-(defun math-rwcomp-is-algebraic (expr)
- (if (Math-primp expr)
- (or (not (eq (car-safe expr) 'var))
- (math-const-var expr)
- (assq (nth 2 expr) math-regs))
- (and (memq 'algebraic (get (car expr) 'math-rewrite-props))
- (progn
- (while (and (setq expr (cdr expr))
- (math-rwcomp-is-algebraic (car expr))))
- (null expr)))))
-
-(defun math-rwcomp-is-constrained (expr not-these)
- (if (Math-primp expr)
- (not (eq (car-safe expr) 'var))
- (if (eq (car expr) 'calcFunc-plain)
- (math-rwcomp-is-constrained (nth 1 expr) not-these)
- (not (or (memq (car expr) '(neg calcFunc-select))
- (memq (car expr) not-these)
- (and (memq 'commut (get (car expr) 'math-rewrite-props))
- (or (eq (car-safe (nth 1 expr)) 'calcFunc-opt)
- (eq (car-safe (nth 2 expr)) 'calcFunc-opt))))))))
-
-(defun math-rwcomp-optional-arg (head argp)
- (let ((arg (car argp)))
- (if (eq (car-safe arg) 'calcFunc-opt)
- (and (memq (length arg) '(2 3))
- (progn
- (or (eq (car-safe (nth 1 arg)) 'var)
- (error "First argument of opt( ) must be a variable"))
- (setcar argp (nth 1 arg))
- (if (= (length arg) 2)
- (or (get head 'math-rewrite-default)
- (error "opt( ) must include a default in this context"))
- (nth 2 arg))))
- (and (eq (car-safe arg) 'neg)
- (let* ((part (list (nth 1 arg)))
- (partp (math-rwcomp-optional-arg head part)))
- (and partp
- (setcar argp (math-rwcomp-neg (car part)))
- (math-neg partp)))))))
-
-(defun math-rwcomp-neg (expr)
- (if (memq (car-safe expr) '(* /))
- (if (eq (car-safe (nth 1 expr)) 'var)
- (list (car expr) (list 'neg (nth 1 expr)) (nth 2 expr))
- (if (eq (car-safe (nth 2 expr)) 'var)
- (list (car expr) (nth 1 expr) (list 'neg (nth 2 expr)))
- (math-neg expr)))
- (math-neg expr)))
-
-(defun math-rwcomp-assoc-args (expr)
- (if (and (eq (car-safe (nth 1 expr)) (car expr))
- (= (length (nth 1 expr)) 3))
- (math-rwcomp-assoc-args (nth 1 expr))
- (setq math-args (cons (nth 1 expr) math-args)))
- (if (and (eq (car-safe (nth 2 expr)) (car expr))
- (= (length (nth 2 expr)) 3))
- (math-rwcomp-assoc-args (nth 2 expr))
- (setq math-args (cons (nth 2 expr) math-args))))
-
-(defun math-rwcomp-addsub-args (expr)
- (if (memq (car-safe (nth 1 expr)) '(+ -))
- (math-rwcomp-addsub-args (nth 1 expr))
- (setq math-args (cons (nth 1 expr) math-args)))
- (if (eq (car expr) '-)
- (setq math-args (cons (math-rwcomp-neg (nth 2 expr)) math-args))
- (if (eq (car-safe (nth 2 expr)) '+)
- (math-rwcomp-addsub-args (nth 2 expr))
- (setq math-args (cons (nth 2 expr) math-args)))))
-
-(defun math-rwcomp-order (a b)
- (< (math-rwcomp-priority (car a))
- (math-rwcomp-priority (car b))))
-
-;;; Order of priority: 0 Constants and other exact matches (first)
-;;; 10 Functions (except below)
-;;; 20 Meta-variables which occur more than once
-;;; 30 Algebraic functions
-;;; 40 Commutative/associative functions
-;;; 50 Meta-variables which occur only once
-;;; +100 for every "!!!" (pnot) in the pattern
-;;; 10000 Optional arguments (last)
-
-(defun math-rwcomp-priority (expr)
- (+ (math-rwcomp-count-pnots expr)
- (cond ((eq (car-safe expr) 'calcFunc-opt)
- 10000)
- ((math-rwcomp-no-vars expr)
- 0)
- ((eq (car expr) 'calcFunc-quote)
- 0)
- ((eq (car expr) 'var)
- (if (assq (nth 2 expr) math-regs)
- 0
- (if (= (math-rwcomp-count-refs expr) 1)
- 50
- 20)))
- (t (let ((props (get (car expr) 'math-rewrite-props)))
- (if (or (memq 'commut props)
- (memq 'assoc props))
- 40
- (if (memq 'algebraic props)
- 30
- 10)))))))
-
-(defun math-rwcomp-count-refs (var)
- (let ((count (or (math-expr-contains-count math-pattern var) 0))
- (p math-conds))
- (while p
- (if (eq (car-safe (car p)) 'calcFunc-let)
- (if (= (length (car p)) 3)
- (setq count (+ count
- (or (math-expr-contains-count (nth 2 (car p)) var)
- 0)))
- (if (and (= (length (car p)) 2)
- (eq (car-safe (nth 1 (car p))) 'calcFunc-assign)
- (= (length (nth 1 (car p))) 3))
- (setq count (+ count
- (or (math-expr-contains-count
- (nth 2 (nth 1 (car p))) var) 0))))))
- (setq p (cdr p)))
- count))
-
-(defun math-rwcomp-count-pnots (expr)
- (if (Math-primp expr)
- 0
- (if (eq (car expr) 'calcFunc-pnot)
- 100
- (let ((count 0))
- (while (setq expr (cdr expr))
- (setq count (+ count (math-rwcomp-count-pnots (car expr)))))
- count))))
-
-;;; In the current implementation, all associative functions must
-;;; also be commutative.
-
-(put '+ 'math-rewrite-props '(algebraic assoc commut))
-(put '- 'math-rewrite-props '(algebraic assoc commut)) ; see below
-(put '* 'math-rewrite-props '(algebraic assoc commut)) ; see below
-(put '/ 'math-rewrite-props '(algebraic unary1))
-(put '^ 'math-rewrite-props '(algebraic unary1))
-(put '% 'math-rewrite-props '(algebraic))
-(put 'neg 'math-rewrite-props '(algebraic))
-(put 'calcFunc-idiv 'math-rewrite-props '(algebraic))
-(put 'calcFunc-abs 'math-rewrite-props '(algebraic))
-(put 'calcFunc-sign 'math-rewrite-props '(algebraic))
-(put 'calcFunc-round 'math-rewrite-props '(algebraic))
-(put 'calcFunc-rounde 'math-rewrite-props '(algebraic))
-(put 'calcFunc-roundu 'math-rewrite-props '(algebraic))
-(put 'calcFunc-trunc 'math-rewrite-props '(algebraic))
-(put 'calcFunc-floor 'math-rewrite-props '(algebraic))
-(put 'calcFunc-ceil 'math-rewrite-props '(algebraic))
-(put 'calcFunc-re 'math-rewrite-props '(algebraic))
-(put 'calcFunc-im 'math-rewrite-props '(algebraic))
-(put 'calcFunc-conj 'math-rewrite-props '(algebraic))
-(put 'calcFunc-arg 'math-rewrite-props '(algebraic))
-(put 'calcFunc-and 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-or 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-xor 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-eq 'math-rewrite-props '(commut))
-(put 'calcFunc-neq 'math-rewrite-props '(commut))
-(put 'calcFunc-land 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-lor 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-beta 'math-rewrite-props '(commut))
-(put 'calcFunc-gcd 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-lcm 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-max 'math-rewrite-props '(algebraic assoc commut))
-(put 'calcFunc-min 'math-rewrite-props '(algebraic assoc commut))
-(put 'calcFunc-vunion 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-vint 'math-rewrite-props '(assoc commut))
-(put 'calcFunc-vxor 'math-rewrite-props '(assoc commut))
-
-;;; Note: "*" is not commutative for matrix args, but we pretend it is.
-;;; Also, "-" is not commutative but the code tweaks things so that it is.
-
-(put '+ 'math-rewrite-default 0)
-(put '- 'math-rewrite-default 0)
-(put '* 'math-rewrite-default 1)
-(put '/ 'math-rewrite-default 1)
-(put '^ 'math-rewrite-default 1)
-(put 'calcFunc-land 'math-rewrite-default 1)
-(put 'calcFunc-lor 'math-rewrite-default 0)
-(put 'calcFunc-vunion 'math-rewrite-default '(vec))
-(put 'calcFunc-vint 'math-rewrite-default '(vec))
-(put 'calcFunc-vdiff 'math-rewrite-default '(vec))
-(put 'calcFunc-vxor 'math-rewrite-default '(vec))
-
-(defmacro math-rwfail (&optional back)
- (list 'setq 'pc
- (list 'and
- (if back
- '(setq btrack (cdr btrack))
- 'btrack)
- ''((backtrack)))))
-
-;;; This monstrosity is necessary because the use of static vectors of
-;;; registers makes rewrite rules non-reentrant. Yucko!
-(defmacro math-rweval (form)
- (list 'let '((orig (car rules)))
- '(setcar rules (quote (nil nil nil no-phase)))
- (list 'unwind-protect
- form
- '(setcar rules orig))))
-
-(setq math-rewrite-phase 1)
-
-(defun math-apply-rewrites (expr rules &optional heads ruleset)
- (and
- (setq rules (cdr (or (assq (car-safe expr) rules)
- (assq nil rules))))
- (let ((result nil)
- op regs inst part pc mark btrack
- (tracing math-rwcomp-tracing)
- (phase math-rewrite-phase))
- (while rules
- (or
- (and (setq part (nth 2 (car rules)))
- heads
- (not (memq part heads)))
- (and (setq part (nth 3 (car rules)))
- (not (memq phase part)))
- (progn
- (setq regs (car (car rules))
- pc (nth 1 (car rules))
- btrack nil)
- (aset regs 0 expr)
- (while pc
-
- (and tracing
- (progn (terpri) (princ (car pc))
- (if (and (natnump (nth 1 (car pc)))
- (< (nth 1 (car pc)) (length regs)))
- (princ (format "\n part = %s"
- (aref regs (nth 1 (car pc))))))))
-
- (cond ((eq (setq op (car (setq inst (car pc)))) 'func)
- (if (and (consp (setq part (aref regs (car (cdr inst)))))
- (eq (car part)
- (car (setq inst (cdr (cdr inst)))))
- (progn
- (while (and (setq inst (cdr inst)
- part (cdr part))
- inst)
- (aset regs (car inst) (car part)))
- (not (or inst part))))
- (setq pc (cdr pc))
- (math-rwfail)))
-
- ((eq op 'same)
- (if (or (equal (setq part (aref regs (nth 1 inst)))
- (setq mark (aref regs (nth 2 inst))))
- (Math-equal part mark))
- (setq pc (cdr pc))
- (math-rwfail)))
-
- ((and (eq op 'try)
- calc-matrix-mode
- (not (eq calc-matrix-mode 'scalar))
- (eq (car (nth 2 inst)) '*)
- (consp (setq part (aref regs (car (cdr inst)))))
- (eq (car part) '*)
- (not (math-known-scalarp part)))
- (setq mark (nth 3 inst)
- pc (cdr pc))
- (if (aref mark 4)
- (progn
- (aset regs (nth 4 inst) (nth 2 part))
- (aset mark 1 (cdr (cdr part))))
- (aset regs (nth 4 inst) (nth 1 part))
- (aset mark 1 (cdr part)))
- (aset mark 0 (cdr part))
- (aset mark 2 0))
-
- ((eq op 'try)
- (if (and (consp (setq part (aref regs (car (cdr inst)))))
- (memq (car part) (nth 2 inst))
- (= (length part) 3)
- (or (not (eq (car part) '/))
- (Math-objectp (nth 2 part))))
- (progn
- (setq op nil
- mark (car (cdr (setq inst (cdr (cdr inst))))))
- (and
- (memq 'assoc (get (car part) 'math-rewrite-props))
- (not (= (aref mark 3) 0))
- (while (if (and (consp (nth 1 part))
- (memq (car (nth 1 part)) (car inst)))
- (setq op (cons (if (eq (car part) '-)
- (math-rwapply-neg
- (nth 2 part))
- (nth 2 part))
- op)
- part (nth 1 part))
- (if (and (consp (nth 2 part))
- (memq (car (nth 2 part))
- (car inst))
- (not (eq (car (nth 2 part)) '-)))
- (setq op (cons (nth 1 part) op)
- part (nth 2 part))))))
- (setq op (cons (nth 1 part)
- (cons (if (eq (car part) '-)
- (math-rwapply-neg
- (nth 2 part))
- (if (eq (car part) '/)
- (math-rwapply-inv
- (nth 2 part))
- (nth 2 part)))
- op))
- btrack (cons pc btrack)
- pc (cdr pc))
- (aset regs (nth 2 inst) (car op))
- (aset mark 0 op)
- (aset mark 1 op)
- (aset mark 2 (if (cdr (cdr op)) 1 0)))
- (if (nth 5 inst)
- (if (and (consp part)
- (eq (car part) 'neg)
- (eq (car (nth 2 inst)) '*)
- (eq (nth 5 inst) 1))
- (progn
- (setq mark (nth 3 inst)
- pc (cdr pc))
- (aset regs (nth 4 inst) (nth 1 part))
- (aset mark 1 -1)
- (aset mark 2 4))
- (setq mark (nth 3 inst)
- pc (cdr pc))
- (aset regs (nth 4 inst) part)
- (aset mark 2 3))
- (math-rwfail))))
-
- ((eq op 'try2)
- (setq part (nth 1 inst) ; try instr
- mark (nth 3 part)
- op (aref mark 2)
- pc (cdr pc))
- (aset regs (nth 2 inst)
- (cond
- ((eq op 0)
- (if (eq (aref mark 0) (aref mark 1))
- (nth 1 (aref mark 0))
- (car (aref mark 0))))
- ((eq op 1)
- (setq mark (delq (car (aref mark 1))
- (copy-sequence (aref mark 0)))
- op (car (nth 2 part)))
- (if (eq op '*)
- (progn
- (setq mark (nreverse mark)
- part (list '* (nth 1 mark) (car mark))
- mark (cdr mark))
- (while (setq mark (cdr mark))
- (setq part (list '* (car mark) part))))
- (setq part (car mark)
- mark (cdr mark)
- part (if (and (eq op '+)
- (consp (car mark))
- (eq (car (car mark)) 'neg))
- (list '- part
- (nth 1 (car mark)))
- (list op part (car mark))))
- (while (setq mark (cdr mark))
- (setq part (if (and (eq op '+)
- (consp (car mark))
- (eq (car (car mark)) 'neg))
- (list '- part
- (nth 1 (car mark)))
- (list op part (car mark))))))
- part)
- ((eq op 2)
- (car (aref mark 1)))
- ((eq op 3) (nth 5 part))
- (t (aref mark 1)))))
-
- ((eq op 'select)
- (setq pc (cdr pc))
- (if (and (consp (setq part (aref regs (nth 1 inst))))
- (eq (car part) 'calcFunc-select))
- (aset regs (nth 2 inst) (nth 1 part))
- (if math-rewrite-selections
- (math-rwfail)
- (aset regs (nth 2 inst) part))))
-
- ((eq op 'same-neg)
- (if (or (equal (setq part (aref regs (nth 1 inst)))
- (setq mark (math-neg
- (aref regs (nth 2 inst)))))
- (Math-equal part mark))
- (setq pc (cdr pc))
- (math-rwfail)))
-
- ((eq op 'backtrack)
- (setq inst (car (car btrack)) ; "try" or "alt" instr
- pc (cdr (car btrack))
- mark (or (nth 3 inst) [nil nil 4])
- op (aref mark 2))
- (cond ((eq op 0)
- (if (setq op (cdr (aref mark 1)))
- (aset regs (nth 4 inst) (car (aset mark 1 op)))
- (if (nth 5 inst)
- (progn
- (aset mark 2 3)
- (aset regs (nth 4 inst)
- (aref regs (nth 1 inst))))
- (math-rwfail t))))
- ((eq op 1)
- (if (setq op (cdr (aref mark 1)))
- (aset regs (nth 4 inst) (car (aset mark 1 op)))
- (if (= (aref mark 3) 1)
- (if (nth 5 inst)
- (progn
- (aset mark 2 3)
- (aset regs (nth 4 inst)
- (aref regs (nth 1 inst))))
- (math-rwfail t))
- (aset mark 2 2)
- (aset mark 1 (cons nil (aref mark 0)))
- (math-rwfail))))
- ((eq op 2)
- (if (setq op (cdr (aref mark 1)))
- (progn
- (setq mark (delq (car (aset mark 1 op))
- (copy-sequence
- (aref mark 0)))
- op (car (nth 2 inst)))
- (if (eq op '*)
- (progn
- (setq mark (nreverse mark)
- part (list '* (nth 1 mark)
- (car mark))
- mark (cdr mark))
- (while (setq mark (cdr mark))
- (setq part (list '* (car mark)
- part))))
- (setq part (car mark)
- mark (cdr mark)
- part (if (and (eq op '+)
- (consp (car mark))
- (eq (car (car mark))
- 'neg))
- (list '- part
- (nth 1 (car mark)))
- (list op part (car mark))))
- (while (setq mark (cdr mark))
- (setq part (if (and (eq op '+)
- (consp (car mark))
- (eq (car (car mark))
- 'neg))
- (list '- part
- (nth 1 (car mark)))
- (list op part (car mark))))))
- (aset regs (nth 4 inst) part))
- (if (nth 5 inst)
- (progn
- (aset mark 2 3)
- (aset regs (nth 4 inst)
- (aref regs (nth 1 inst))))
- (math-rwfail t))))
- ((eq op 4)
- (setq btrack (cdr btrack)))
- (t (math-rwfail t))))
-
- ((eq op 'integer)
- (if (Math-integerp (setq part (aref regs (nth 1 inst))))
- (setq pc (cdr pc))
- (if (Math-primp part)
- (math-rwfail)
- (setq part (math-rweval (math-simplify part)))
- (if (Math-integerp part)
- (setq pc (cdr pc))
- (math-rwfail)))))
-
- ((eq op 'real)
- (if (Math-realp (setq part (aref regs (nth 1 inst))))
- (setq pc (cdr pc))
- (if (Math-primp part)
- (math-rwfail)
- (setq part (math-rweval (math-simplify part)))
- (if (Math-realp part)
- (setq pc (cdr pc))
- (math-rwfail)))))
-
- ((eq op 'constant)
- (if (math-constp (setq part (aref regs (nth 1 inst))))
- (setq pc (cdr pc))
- (if (Math-primp part)
- (math-rwfail)
- (setq part (math-rweval (math-simplify part)))
- (if (math-constp part)
- (setq pc (cdr pc))
- (math-rwfail)))))
-
- ((eq op 'negative)
- (if (math-looks-negp (setq part (aref regs (nth 1 inst))))
- (setq pc (cdr pc))
- (if (Math-primp part)
- (math-rwfail)
- (setq part (math-rweval (math-simplify part)))
- (if (math-looks-negp part)
- (setq pc (cdr pc))
- (math-rwfail)))))
-
- ((eq op 'rel)
- (setq part (math-compare (aref regs (nth 1 inst))
- (aref regs (nth 3 inst)))
- op (nth 2 inst))
- (if (= part 2)
- (setq part (math-rweval
- (math-simplify
- (calcFunc-sign
- (math-sub (aref regs (nth 1 inst))
- (aref regs (nth 3 inst))))))))
- (if (cond ((eq op 'calcFunc-eq)
- (eq part 0))
- ((eq op 'calcFunc-neq)
- (memq part '(-1 1)))
- ((eq op 'calcFunc-lt)
- (eq part -1))
- ((eq op 'calcFunc-leq)
- (memq part '(-1 0)))
- ((eq op 'calcFunc-gt)
- (eq part 1))
- ((eq op 'calcFunc-geq)
- (memq part '(0 1))))
- (setq pc (cdr pc))
- (math-rwfail)))
-
- ((eq op 'func-def)
- (if (and (consp (setq part (aref regs (car (cdr inst)))))
- (eq (car part)
- (car (setq inst (cdr (cdr inst))))))
- (progn
- (setq inst (cdr inst)
- mark (car inst))
- (while (and (setq inst (cdr inst)
- part (cdr part))
- inst)
- (aset regs (car inst) (car part)))
- (if (or inst part)
- (setq pc (cdr pc))
- (while (eq (car (car (setq pc (cdr pc))))
- 'func-def))
- (setq pc (cdr pc)) ; skip over "func"
- (while mark
- (aset regs (cdr (car mark)) (car (car mark)))
- (setq mark (cdr mark)))))
- (math-rwfail)))
-
- ((eq op 'func-opt)
- (if (or (not (and (consp
- (setq part (aref regs (car (cdr inst)))))
- (eq (car part) (nth 2 inst))))
- (and (= (length part) 2)
- (setq part (nth 1 part))))
- (progn
- (setq mark (nth 3 inst))
- (aset regs (nth 4 inst) part)
- (while (eq (car (car (setq pc (cdr pc)))) 'func-def))
- (setq pc (cdr pc)) ; skip over "func"
- (while mark
- (aset regs (cdr (car mark)) (car (car mark)))
- (setq mark (cdr mark))))
- (setq pc (cdr pc))))
-
- ((eq op 'mod)
- (if (if (Math-zerop (setq part (aref regs (nth 1 inst))))
- (Math-zerop (nth 3 inst))
- (and (not (Math-zerop (nth 2 inst)))
- (progn
- (setq part (math-mod part (nth 2 inst)))
- (or (Math-numberp part)
- (setq part (math-rweval
- (math-simplify part))))
- (Math-equal part (nth 3 inst)))))
- (setq pc (cdr pc))
- (math-rwfail)))
-
- ((eq op 'apply)
- (if (and (consp (setq part (aref regs (car (cdr inst)))))
- (not (Math-objvecp part))
- (not (eq (car part) 'var)))
- (progn
- (aset regs (nth 2 inst)
- (math-calcFunc-to-var (car part)))
- (aset regs (nth 3 inst)
- (cons 'vec (cdr part)))
- (setq pc (cdr pc)))
- (math-rwfail)))
-
- ((eq op 'cons)
- (if (and (consp (setq part (aref regs (car (cdr inst)))))
- (eq (car part) 'vec)
- (cdr part))
- (progn
- (aset regs (nth 2 inst) (nth 1 part))
- (aset regs (nth 3 inst) (cons 'vec (cdr (cdr part))))
- (setq pc (cdr pc)))
- (math-rwfail)))
-
- ((eq op 'rcons)
- (if (and (consp (setq part (aref regs (car (cdr inst)))))
- (eq (car part) 'vec)
- (cdr part))
- (progn
- (aset regs (nth 2 inst) (calcFunc-rhead part))
- (aset regs (nth 3 inst) (calcFunc-rtail part))
- (setq pc (cdr pc)))
- (math-rwfail)))
-
- ((eq op 'cond)
- (if (math-is-true
- (math-rweval
- (math-simplify
- (math-rwapply-replace-regs (nth 1 inst)))))
- (setq pc (cdr pc))
- (math-rwfail)))
-
- ((eq op 'let)
- (aset regs (nth 1 inst)
- (math-rweval
- (math-normalize
- (math-rwapply-replace-regs (nth 2 inst)))))
- (setq pc (cdr pc)))
-
- ((eq op 'copy)
- (aset regs (nth 2 inst) (aref regs (nth 1 inst)))
- (setq pc (cdr pc)))
-
- ((eq op 'copy-neg)
- (aset regs (nth 2 inst)
- (math-rwapply-neg (aref regs (nth 1 inst))))
- (setq pc (cdr pc)))
-
- ((eq op 'alt)
- (setq btrack (cons pc btrack)
- pc (nth 1 inst)))
-
- ((eq op 'end-alt)
- (while (and btrack (not (eq (car btrack) (nth 1 inst))))
- (setq btrack (cdr btrack)))
- (setq btrack (cdr btrack)
- pc (cdr pc)))
-
- ((eq op 'done)
- (setq result (math-rwapply-replace-regs (nth 1 inst)))
- (if (or (and (eq (car-safe result) '+)
- (eq (nth 2 result) 0))
- (and (eq (car-safe result) '*)
- (eq (nth 2 result) 1)))
- (setq result (nth 1 result)))
- (setq part (and (nth 2 inst)
- (math-is-true
- (math-rweval
- (math-simplify
- (math-rwapply-replace-regs
- (nth 2 inst)))))))
- (if (or (equal result expr)
- (equal (setq result (math-normalize result)) expr))
- (setq result nil)
- (if part (math-rwapply-remember expr result))
- (setq rules nil))
- (setq pc nil))
-
- (t (error "%s is not a valid rewrite opcode" op))))))
- (setq rules (cdr rules)))
- result)))
-
-(defun math-rwapply-neg (expr)
- (if (and (consp expr)
- (memq (car expr) '(* /)))
- (if (Math-objectp (nth 2 expr))
- (list (car expr) (nth 1 expr) (math-neg (nth 2 expr)))
- (list (car expr)
- (if (Math-objectp (nth 1 expr))
- (math-neg (nth 1 expr))
- (list '* -1 (nth 1 expr)))
- (nth 2 expr)))
- (math-neg expr)))
-
-(defun math-rwapply-inv (expr)
- (if (and (Math-integerp expr)
- calc-prefer-frac)
- (math-make-frac 1 expr)
- (list '/ 1 expr)))
-
-(defun math-rwapply-replace-regs (expr)
- (cond ((Math-primp expr)
- expr)
- ((eq (car expr) 'calcFunc-register)
- (setq expr (aref regs (nth 1 expr)))
- (if (eq (car-safe expr) '*)
- (if (eq (nth 1 expr) -1)
- (math-neg (nth 2 expr))
- (if (eq (nth 1 expr) 1)
- (nth 2 expr)
- expr))
- expr))
- ((and (eq (car expr) 'calcFunc-eval)
- (= (length expr) 2))
- (calc-with-default-simplification
- (math-normalize (math-rwapply-replace-regs (nth 1 expr)))))
- ((and (eq (car expr) 'calcFunc-evalsimp)
- (= (length expr) 2))
- (math-simplify (math-rwapply-replace-regs (nth 1 expr))))
- ((and (eq (car expr) 'calcFunc-evalextsimp)
- (= (length expr) 2))
- (math-simplify-extended (math-rwapply-replace-regs (nth 1 expr))))
- ((and (eq (car expr) 'calcFunc-apply)
- (= (length expr) 3))
- (let ((func (math-rwapply-replace-regs (nth 1 expr)))
- (args (math-rwapply-replace-regs (nth 2 expr)))
- call)
- (if (and (math-vectorp args)
- (not (eq (car-safe (setq call (math-build-call
- (math-var-to-calcFunc func)
- (cdr args))))
- 'calcFunc-call)))
- call
- (list 'calcFunc-apply func args))))
- ((and (eq (car expr) 'calcFunc-cons)
- (= (length expr) 3))
- (let ((head (math-rwapply-replace-regs (nth 1 expr)))
- (tail (math-rwapply-replace-regs (nth 2 expr))))
- (if (math-vectorp tail)
- (cons 'vec (cons head (cdr tail)))
- (list 'calcFunc-cons head tail))))
- ((and (eq (car expr) 'calcFunc-rcons)
- (= (length expr) 3))
- (let ((head (math-rwapply-replace-regs (nth 1 expr)))
- (tail (math-rwapply-replace-regs (nth 2 expr))))
- (if (math-vectorp head)
- (append head (list tail))
- (list 'calcFunc-rcons head tail))))
- ((and (eq (car expr) 'neg)
- (math-rwapply-reg-looks-negp (nth 1 expr)))
- (math-rwapply-reg-neg (nth 1 expr)))
- ((and (eq (car expr) 'neg)
- (eq (car-safe (nth 1 expr)) 'calcFunc-register)
- (math-scalarp (aref regs (nth 1 (nth 1 expr)))))
- (math-neg (math-rwapply-replace-regs (nth 1 expr))))
- ((and (eq (car expr) '+)
- (math-rwapply-reg-looks-negp (nth 1 expr)))
- (list '- (math-rwapply-replace-regs (nth 2 expr))
- (math-rwapply-reg-neg (nth 1 expr))))
- ((and (eq (car expr) '+)
- (math-rwapply-reg-looks-negp (nth 2 expr)))
- (list '- (math-rwapply-replace-regs (nth 1 expr))
- (math-rwapply-reg-neg (nth 2 expr))))
- ((and (eq (car expr) '-)
- (math-rwapply-reg-looks-negp (nth 2 expr)))
- (list '+ (math-rwapply-replace-regs (nth 1 expr))
- (math-rwapply-reg-neg (nth 2 expr))))
- ((eq (car expr) '*)
- (cond ((eq (nth 1 expr) -1)
- (if (math-rwapply-reg-looks-negp (nth 2 expr))
- (math-rwapply-reg-neg (nth 2 expr))
- (math-neg (math-rwapply-replace-regs (nth 2 expr)))))
- ((eq (nth 1 expr) 1)
- (math-rwapply-replace-regs (nth 2 expr)))
- ((eq (nth 2 expr) -1)
- (if (math-rwapply-reg-looks-negp (nth 1 expr))
- (math-rwapply-reg-neg (nth 1 expr))
- (math-neg (math-rwapply-replace-regs (nth 1 expr)))))
- ((eq (nth 2 expr) 1)
- (math-rwapply-replace-regs (nth 1 expr)))
- (t
- (let ((arg1 (math-rwapply-replace-regs (nth 1 expr)))
- (arg2 (math-rwapply-replace-regs (nth 2 expr))))
- (cond ((and (eq (car-safe arg1) '/)
- (eq (nth 1 arg1) 1))
- (list '/ arg2 (nth 2 arg1)))
- ((and (eq (car-safe arg2) '/)
- (eq (nth 1 arg2) 1))
- (list '/ arg1 (nth 2 arg2)))
- (t (list '* arg1 arg2)))))))
- ((eq (car expr) '/)
- (let ((arg1 (math-rwapply-replace-regs (nth 1 expr)))
- (arg2 (math-rwapply-replace-regs (nth 2 expr))))
- (if (eq (car-safe arg2) '/)
- (list '/ (list '* arg1 (nth 2 arg2)) (nth 1 arg2))
- (list '/ arg1 arg2))))
- ((and (eq (car expr) 'calcFunc-plain)
- (= (length expr) 2))
- (if (Math-primp (nth 1 expr))
- (nth 1 expr)
- (if (eq (car (nth 1 expr)) 'calcFunc-register)
- (aref regs (nth 1 (nth 1 expr)))
- (cons (car (nth 1 expr)) (mapcar 'math-rwapply-replace-regs
- (cdr (nth 1 expr)))))))
- (t (cons (car expr) (mapcar 'math-rwapply-replace-regs (cdr expr))))))
-
-(defun math-rwapply-reg-looks-negp (expr)
- (if (eq (car-safe expr) 'calcFunc-register)
- (math-looks-negp (aref regs (nth 1 expr)))
- (if (memq (car-safe expr) '(* /))
- (or (math-rwapply-reg-looks-negp (nth 1 expr))
- (math-rwapply-reg-looks-negp (nth 2 expr))))))
-
-(defun math-rwapply-reg-neg (expr) ; expr must satisfy rwapply-reg-looks-negp
- (if (eq (car expr) 'calcFunc-register)
- (math-neg (math-rwapply-replace-regs expr))
- (if (math-rwapply-reg-looks-negp (nth 1 expr))
- (math-rwapply-replace-regs (list (car expr)
- (math-rwapply-reg-neg (nth 1 expr))
- (nth 2 expr)))
- (math-rwapply-replace-regs (list (car expr)
- (nth 1 expr)
- (math-rwapply-reg-neg (nth 2 expr)))))))
-
-(defun math-rwapply-remember (old new)
- (let ((varval (symbol-value (nth 2 (car ruleset))))
- (rules (assq (car-safe old) ruleset)))
- (if (and (eq (car-safe varval) 'vec)
- (not (memq (car-safe old) '(nil schedule + -)))
- rules)
- (progn
- (setcdr varval (cons (list 'calcFunc-assign
- (if (math-rwcomp-no-vars old)
- old
- (list 'calcFunc-quote old))
- new)
- (cdr varval)))
- (setcdr rules (cons (list (vector nil old)
- (list (list 'same 0 1)
- (list 'done new nil))
- nil nil)
- (cdr rules)))))))
-
-;;; calc-rewr.el ends here
+++ /dev/null
-;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-rules () nil)
-
-
-(defun calc-compile-rule-set (name rules)
- (prog2
- (message "Preparing rule set %s..." name)
- (math-read-plain-expr rules t)
- (message "Preparing rule set %s...done" name)))
-
-(defun calc-CommuteRules ()
- "CommuteRules"
- (calc-compile-rule-set
- "CommuteRules" "[
-iterations(1),
-select(plain(a + b)) := select(plain(b + a)),
-select(plain(a - b)) := select(plain((-b) + a)),
-select(plain((1/a) * b)) := select(b / a),
-select(plain(a * b)) := select(b * a),
-select((1/a) / b) := select((1/b) / a),
-select(a / b) := select((1/b) * a),
-select((a^b) ^ c) := select((a^c) ^ b),
-select(log(a, b)) := select(1 / log(b, a)),
-select(plain(a && b)) := select(b && a),
-select(plain(a || b)) := select(b || a),
-select(plain(a = b)) := select(b = a),
-select(plain(a != b)) := select(b != a),
-select(a < b) := select(b > a),
-select(a > b) := select(b < a),
-select(a <= b) := select(b >= a),
-select(a >= b) := select(b <= a) ]"))
-
-(defun calc-JumpRules ()
- "JumpRules"
- (calc-compile-rule-set
- "JumpRules" "[
-iterations(1),
-plain(select(x) = y) := 0 = select(-x) + y,
-plain(a + select(x) = y) := a = select(-x) + y,
-plain(a - select(x) = y) := a = select(x) + y,
-plain(select(x) + a = y) := a = select(-x) + y,
-plain(a * select(x) = y) := a = y / select(x),
-plain(a / select(x) = y) := a = select(x) * y,
-plain(select(x) / a = y) := 1/a = y / select(x),
-plain(a ^ select(2) = y) := a = select(sqrt(y)),
-plain(a ^ select(x) = y) := a = y ^ select(1/x),
-plain(select(x) ^ a = y) := a = log(y, select(x)),
-plain(log(a, select(x)) = y) := a = select(x) ^ y,
-plain(log(select(x), a) = y) := a = select(x) ^ (1/y),
-plain(y = select(x)) := y - select(x) = 0,
-plain(y = a + select(x)) := y - select(x) = a,
-plain(y = a - select(x)) := y + select(x) = a,
-plain(y = select(x) + a) := y - select(x) = a,
-plain(y = a * select(x)) := y / select(x) = a,
-plain(y = a / select(x)) := y * select(x) = a,
-plain(y = select(x) / a) := y / select(x) = 1/a,
-plain(y = a ^ select(2)) := select(sqrt(y)) = a,
-plain(y = a ^ select(x)) := y ^ select(1/x) = a,
-plain(y = select(x) ^ a) := log(y, select(x)) = a,
-plain(y = log(a, select(x))) := select(x) ^ y = a,
-plain(y = log(select(x), a)) := select(x) ^ (1/y) = a ]"))
-
-(defun calc-DistribRules ()
- "DistribRules"
- (calc-compile-rule-set
- "DistribRules" "[
-iterations(1),
-x * select(a + b) := x*select(a) + x*b,
-x * select(sum(a,b,c,d)) := sum(x*select(a),b,c,d),
-x / select(a + b) := 1 / (select(a)/x + b/x),
-select(a + b) / x := select(a)/x + b/x,
-sum(select(a),b,c,d) / x := sum(select(a)/x,b,c,d),
-x ^ select(a + b) := x^select(a) * x^b,
-x ^ select(sum(a,b,c,d)) := prod(x^select(a),b,c,d),
-x ^ select(a * b) := (x^a)^select(b),
-x ^ select(a / b) := (x^a)^select(1/b),
-select(a + b) ^ n := select(x)
- :: integer(n) :: n >= 2
- :: let(x, expandpow(a+b,n))
- :: quote(matches(x,y+z)),
-select(a + b) ^ x := a*select(a+b)^(x-1) + b*select(a+b)^(x-1),
-select(a * b) ^ x := a^x * select(b)^x,
-select(prod(a,b,c,d)) ^ x := prod(select(a)^x,b,c,d),
-select(a / b) ^ x := select(a)^x / b^x,
-select(- a) ^ x := (-1)^x * select(a)^x,
-plain(-select(a + b)) := select(-a) - b,
-plain(-select(sum(a,b,c,d))) := sum(select(-a),b,c,d),
-plain(-select(a * b)) := select(-a) * b,
-plain(-select(a / b)) := select(-a) / b,
-sqrt(select(a * b)) := sqrt(select(a)) * sqrt(b),
-sqrt(select(prod(a,b,c,d))) := prod(sqrt(select(a)),b,c,d),
-sqrt(select(a / b)) := sqrt(select(a)) / sqrt(b),
-sqrt(select(- a)) := sqrt(-1) sqrt(select(a)),
-exp(select(a + b)) := exp(select(a)) / exp(-b) :: negative(b),
-exp(select(a + b)) := exp(select(a)) * exp(b),
-exp(select(sum(a,b,c,d))) := prod(exp(select(a)),b,c,d),
-exp(select(a * b)) := exp(select(a)) ^ b :: constant(b),
-exp(select(a * b)) := exp(select(a)) ^ b,
-exp(select(a / b)) := exp(select(a)) ^ (1/b),
-ln(select(a * b)) := ln(select(a)) + ln(b),
-ln(select(prod(a,b,c,d))) := sum(ln(select(a)),b,c,d),
-ln(select(a / b)) := ln(select(a)) - ln(b),
-ln(select(a ^ b)) := ln(select(a)) * b,
-log10(select(a * b)) := log10(select(a)) + log10(b),
-log10(select(prod(a,b,c,d))) := sum(log10(select(a)),b,c,d),
-log10(select(a / b)) := log10(select(a)) - log10(b),
-log10(select(a ^ b)) := log10(select(a)) * b,
-log(select(a * b), x) := log(select(a), x) + log(b,x),
-log(select(prod(a,b,c,d)),x) := sum(log(select(a),x),b,c,d),
-log(select(a / b), x) := log(select(a), x) - log(b,x),
-log(select(a ^ b), x) := log(select(a), x) * b,
-log(a, select(b)) := ln(a) / select(ln(b)),
-sin(select(a + b)) := sin(select(a)) cos(b) + cos(a) sin(b),
-sin(select(2 a)) := 2 sin(select(a)) cos(a),
-sin(select(n a)) := 2sin((n-1) select(a)) cos(a) - sin((n-2) a)
- :: integer(n) :: n > 2,
-cos(select(a + b)) := cos(select(a)) cos(b) - sin(a) sin(b),
-cos(select(2 a)) := 2 cos(select(a))^2 - 1,
-cos(select(n a)) := 2cos((n-1) select(a)) cos(a) - cos((n-2) a)
- :: integer(n) :: n > 2,
-tan(select(a + b)) := (tan(select(a)) + tan(b)) /
- (1 - tan(a) tan(b)),
-tan(select(2 a)) := 2 tan(select(a)) / (1 - tan(a)^2),
-tan(select(n a)) := (tan((n-1) select(a)) + tan(a)) /
- (1 - tan((n-1) a) tan(a))
- :: integer(n) :: n > 2,
-sinh(select(a + b)) := sinh(select(a)) cosh(b) + cosh(a) sinh(b),
-cosh(select(a + b)) := cosh(select(a)) cosh(b) + sinh(a) sinh(b),
-tanh(select(a + b)) := (tanh(select(a)) + tanh(b)) /
- (1 + tanh(a) tanh(b)),
-x && select(a || b) := (x && select(a)) || (x && b),
-select(a || b) && x := (select(a) && x) || (b && x),
-! select(a && b) := (!a) || (!b),
-! select(a || b) := (!a) && (!b) ]"))
-
-(defun calc-MergeRules ()
- "MergeRules"
- (calc-compile-rule-set
- "MergeRules" "[
-iterations(1),
- (x*opt(a)) + select(x*b) := x * (a + select(b)),
- (x*opt(a)) - select(x*b) := x * (a - select(b)),
-sum(select(x)*a,b,c,d) := x * sum(select(a),b,c,d),
- (a/x) + select(b/x) := (a + select(b)) / x,
- (a/x) - select(b/x) := (a - select(b)) / x,
-sum(a/select(x),b,c,d) := sum(select(a),b,c,d) / x,
- (a/opt(b)) + select(c/d) := ((select(a)*d) + (b*c)) / (b*d),
- (a/opt(b)) - select(c/d) := ((select(a)*d) - (b*c)) / (b*d),
- (x^opt(a)) * select(x^b) := x ^ (a + select(b)),
- (x^opt(a)) / select(x^b) := x ^ (a - select(b)),
-select(x^a) / (x^opt(b)) := x ^ (select(a) - b),
-prod(select(x)^a,b,c,d) := x ^ sum(select(a),b,c,d),
-select(x^a) / (x^opt(b)) := x ^ (select(a) - b),
- (a^x) * select(b^x) := select((a * b) ^x),
- (a^x) / select(b^x) := select((b / b) ^ x),
-select(a^x) / (b^x) := select((a / b) ^ x),
-prod(a^select(x),b,c,d) := select(prod(a,b,c,d) ^ x),
- (a^x) * select(b^y) := select((a * b^(y-x)) ^x),
- (a^x) / select(b^y) := select((b / b^(y-x)) ^ x),
-select(a^x) / (b^y) := select((a / b^(y-x)) ^ x),
-select(x^a) ^ b := x ^ select(a * b),
- (x^a) ^ select(b) := x ^ select(a * b),
-select(sqrt(a)) ^ b := select(a ^ (b / 2)),
-sqrt(a) ^ select(b) := select(a ^ (b / 2)),
-sqrt(select(a) ^ b) := select(a ^ (b / 2)),
-sqrt(a ^ select(b)) := select(a ^ (b / 2)),
-sqrt(a) * select(sqrt(b)) := select(sqrt(a * b)),
-sqrt(a) / select(sqrt(b)) := select(sqrt(a / b)),
-select(sqrt(a)) / sqrt(b) := select(sqrt(a / b)),
-prod(select(sqrt(a)),b,c,d) := select(sqrt(prod(a,b,c,d))),
-exp(a) * select(exp(b)) := select(exp(a + b)),
-exp(a) / select(exp(b)) := select(exp(a - b)),
-select(exp(a)) / exp(b) := select(exp(a - b)),
-prod(select(exp(a)),b,c,d) := select(exp(sum(a,b,c,d))),
-select(exp(a)) ^ b := select(exp(a * b)),
-exp(a) ^ select(b) := select(exp(a * b)),
-ln(a) + select(ln(b)) := select(ln(a * b)),
-ln(a) - select(ln(b)) := select(ln(a / b)),
-select(ln(a)) - ln(b) := select(ln(a / b)),
-sum(select(ln(a)),b,c,d) := select(ln(prod(a,b,c,d))),
-b * select(ln(a)) := select(ln(a ^ b)),
-select(b) * ln(a) := select(ln(a ^ b)),
-select(ln(a)) / ln(b) := select(log(a, b)),
-ln(a) / select(ln(b)) := select(log(a, b)),
-select(ln(a)) / b := select(ln(a ^ (1/b))),
-ln(a) / select(b) := select(ln(a ^ (1/b))),
-log10(a) + select(log10(b)) := select(log10(a * b)),
-log10(a) - select(log10(b)) := select(log10(a / b)),
-select(log10(a)) - log10(b) := select(log10(a / b)),
-sum(select(log10(a)),b,c,d) := select(log10(prod(a,b,c,d))),
-b * select(log10(a)) := select(log10(a ^ b)),
-select(b) * log10(a) := select(log10(a ^ b)),
-select(log10(a)) / log10(b) := select(log(a, b)),
-log10(a) / select(log10(b)) := select(log(a, b)),
-select(log10(a)) / b := select(log10(a ^ (1/b))),
-log10(a) / select(b) := select(log10(a ^ (1/b))),
-log(a,x) + select(log(b,x)) := select(log(a * b,x)),
-log(a,x) - select(log(b,x)) := select(log(a / b,x)),
-select(log(a,x)) - log(b,x) := select(log(a / b,x)),
-sum(select(log(a,x)),b,c,d) := select(log(prod(a,b,c,d),x)),
-b * select(log(a,x)) := select(log(a ^ b,x)),
-select(b) * log(a,x) := select(log(a ^ b,x)),
-select(log(a,x)) / log(b,x) := select(log(a, b)),
-log(a,x) / select(log(b,x)) := select(log(a, b)),
-select(log(a,x)) / b := select(log(a ^ (1/b),x)),
-log(a,x) / select(b) := select(log(a ^ (1/b),x)),
-select(x && a) || (x && opt(b)) := x && (select(a) || b) ]"))
-
-(defun calc-NegateRules ()
- "NegateRules"
- (calc-compile-rule-set
- "NegateRules" "[
-iterations(1),
-a + select(x) := a - select(-x),
-a - select(x) := a + select(-x),
-sum(select(x),b,c,d) := -sum(select(-x),b,c,d),
-a * select(x) := -a * select(-x),
-a / select(x) := -a / select(-x),
-select(x) / a := -select(-x) / a,
-prod(select(x),b,c,d) := (-1)^(d-c+1) * prod(select(-x),b,c,d),
-select(x) ^ n := select(-x) ^ a :: integer(n) :: n%2 = 0,
-select(x) ^ n := -(select(-x) ^ a) :: integer(n) :: n%2 = 1,
-select(x) ^ a := (-select(-x)) ^ a,
-a ^ select(x) := (1 / a)^select(-x),
-abs(select(x)) := abs(select(-x)),
-i sqrt(select(x)) := -sqrt(select(-x)),
-sqrt(select(x)) := i sqrt(select(-x)),
-re(select(x)) := -re(select(-x)),
-im(select(x)) := -im(select(-x)),
-conj(select(x)) := -conj(select(-x)),
-trunc(select(x)) := -trunc(select(-x)),
-round(select(x)) := -round(select(-x)),
-floor(select(x)) := -ceil(select(-x)),
-ceil(select(x)) := -floor(select(-x)),
-ftrunc(select(x)) := -ftrunc(select(-x)),
-fround(select(x)) := -fround(select(-x)),
-ffloor(select(x)) := -fceil(select(-x)),
-fceil(select(x)) := -ffloor(select(-x)),
-exp(select(x)) := 1 / exp(select(-x)),
-sin(select(x)) := -sin(select(-x)),
-cos(select(x)) := cos(select(-x)),
-tan(select(x)) := -tan(select(-x)),
-arcsin(select(x)) := -arcsin(select(-x)),
-arccos(select(x)) := 4 arctan(1) - arccos(select(-x)),
-arctan(select(x)) := -arctan(select(-x)),
-sinh(select(x)) := -sinh(select(-x)),
-cosh(select(x)) := cosh(select(-x)),
-tanh(select(x)) := -tanh(select(-x)),
-arcsinh(select(x)) := -arcsinh(select(-x)),
-arctanh(select(x)) := -arctanh(select(-x)),
-select(x) = a := select(-x) = -a,
-select(x) != a := select(-x) != -a,
-select(x) < a := select(-x) > -a,
-select(x) > a := select(-x) < -a,
-select(x) <= a := select(-x) >= -a,
-select(x) >= a := select(-x) <= -a,
-a < select(x) := -a > select(-x),
-a > select(x) := -a < select(-x),
-a <= select(x) := -a >= select(-x),
-a >= select(x) := -a <= select(-x),
-select(x) := -select(-x) ]"))
-
-(defun calc-InvertRules ()
- "InvertRules"
- (calc-compile-rule-set
- "InvertRules" "[
-iterations(1),
-a * select(x) := a / select(1/x),
-a / select(x) := a * select(1/x),
-select(x) / a := 1 / (select(1/x) a),
-prod(select(x),b,c,d) := 1 / prod(select(1/x),b,c,d),
-abs(select(x)) := 1 / abs(select(1/x)),
-sqrt(select(x)) := 1 / sqrt(select(1/x)),
-ln(select(x)) := -ln(select(1/x)),
-log10(select(x)) := -log10(select(1/x)),
-log(select(x), a) := -log(select(1/x), a),
-log(a, select(x)) := -log(a, select(1/x)),
-arctan(select(x)) := simplify(2 arctan(1))-arctan(select(1/x)),
-select(x) = a := select(1/x) = 1/a,
-select(x) != a := select(1/x) != 1/a,
-select(x) < a := select(1/x) > 1/a,
-select(x) > a := select(1/x) < 1/a,
-select(x) <= a := select(1/x) >= 1/a,
-select(x) >= a := select(1/x) <= 1/a,
-a < select(x) := 1/a > select(1/x),
-a > select(x) := 1/a < select(1/x),
-a <= select(x) := 1/a >= select(1/x),
-a >= select(x) := 1/a <= select(1/x),
-select(x) := 1 / select(1/x) ]"))
-
-
-(defun calc-FactorRules ()
- "FactorRules"
- (calc-compile-rule-set
- "FactorRules" "[
-thecoefs(x, [z, a+b, c]) := thefactors(x, [d x + d a/c, (c/d) x + (b/d)])
- :: z = a b/c :: let(d := pgcd(pcont(c), pcont(b))),
-thecoefs(x, [z, a, c]) := thefactors(x, [(r x + a/(2 r))^2])
- :: z = (a/2)^2/c :: let(r := esimplify(sqrt(c)))
- :: !matches(r, sqrt(rr)),
-thecoefs(x, [z, 0, c]) := thefactors(x, [rc x + rz, rc x - rz])
- :: negative(z)
- :: let(rz := esimplify(sqrt(-z))) :: !matches(rz, sqrt(rzz))
- :: let(rc := esimplify(sqrt(c))) :: !matches(rc, sqrt(rcc)),
-thecoefs(x, [z, 0, c]) := thefactors(x, [rz + rc x, rz - rc x])
- :: negative(c)
- :: let(rz := esimplify(sqrt(z))) :: !matches(rz, sqrt(rzz))
- :: let(rc := esimplify(sqrt(-c))) :: !matches(rc, sqrt(rcc))
- ]"))
-;;(setq var-FactorRules 'calc-FactorRules)
-
-
-(defun calc-IntegAfterRules ()
- "IntegAfterRules"
- (calc-compile-rule-set
- "IntegAfterRules" "[
- opt(a) ln(x) + opt(b) ln(y) := 2 a esimplify(arctanh(x-1))
- :: a + b = 0 :: nrat(x + y) = 2 || nrat(x - y) = 2,
- a * (b + c) := a b + a c :: constant(a)
- ]"))
-
-;;(setq var-IntegAfterRules 'calc-IntegAfterRules)
-
-
-(defun calc-FitRules ()
- "FitRules"
- (calc-compile-rule-set
- "FitRules" "[
-
-schedule(1,2,3,4),
-iterations(inf),
-
-phase(1),
-e^x := exp(x),
-x^y := exp(y ln(x)) :: !istrue(constant(y)),
-x/y := x fitinv(y),
-fitinv(x y) := fitinv(x) fitinv(y),
-exp(a) exp(b) := exp(a + b),
-a exp(b) := exp(ln(a) + b) :: !hasfitvars(a),
-fitinv(exp(a)) := exp(-a),
-ln(a b) := ln(a) + ln(b),
-ln(fitinv(a)) := -ln(a),
-log10(a b) := log10(a) + log10(b),
-log10(fitinv(a)) := -log10(a),
-log(a,b) := ln(a)/ln(b),
-ln(exp(a)) := a,
-a*(b+c) := a*b + a*c,
-(a+b)^n := x :: integer(n) :: n >= 2
- :: let(x, expandpow(a+b,n))
- :: quote(matches(x,y+z)),
-
-phase(1,2),
-fitmodel(y = x) := fitmodel(0, y - x),
-fitmodel(y, x+c) := fitmodel(y-c, x) :: !hasfitparams(c),
-fitmodel(y, x c) := fitmodel(y/c, x) :: !hasfitparams(c),
-fitmodel(y, x/(c opt(d))) := fitmodel(y c, x/d) :: !hasfitparams(c),
-fitmodel(y, apply(f,[x])) := fitmodel(yy, x)
- :: hasfitparams(x)
- :: let(FTemp() = yy,
- solve(apply(f,[FTemp()]) = y,
- FTemp())),
-fitmodel(y, apply(f,[x,c])) := fitmodel(yy, x)
- :: !hasfitparams(c)
- :: let(FTemp() = yy,
- solve(apply(f,[FTemp(),c]) = y,
- FTemp())),
-fitmodel(y, apply(f,[c,x])) := fitmodel(yy, x)
- :: !hasfitparams(c)
- :: let(FTemp() = yy,
- solve(apply(f,[c,FTemp()]) = y,
- FTemp())),
-
-phase(2,3),
-fitmodel(y, x) := fitsystem(y, [], [], fitpart(1,1,x)),
-fitpart(a,b,plain(x + y)) := fitpart(a,b,x) + fitpart(a,b,y),
-fitpart(a,b,plain(x - y)) := fitpart(a,b,x) + fitpart(-a,b,y),
-fitpart(a,b,plain(-x)) := fitpart(-a,b,x),
-fitpart(a,b,x opt(c)) := fitpart(a,x b,c) :: !hasfitvars(x),
-fitpart(a,x opt(b),c) := fitpart(x a,b,c) :: !hasfitparams(x),
-fitpart(a,x y + x opt(z),c) := fitpart(a,x*(y+z),c),
-fitpart(a,b,c) := fitpart2(a,b,c),
-
-phase(3),
-fitpart2(a1,b1,x) + fitpart2(a2,b2,x) := fitpart(1, a1 b1 + a2 b2, x),
-fitpart2(a1,x,c1) + fitpart2(a2,x,c2) := fitpart2(1, x, a1 c1 + a2 c2),
-
-phase(4),
-fitinv(x) := 1 / x,
-exp(x + ln(y)) := y exp(x),
-exp(x ln(y)) := y^x,
-ln(x) + ln(y) := ln(x y),
-ln(x) - ln(y) := ln(x/y),
-x*y + x*z := x*(y+z),
-fitsystem(y, xv, pv, fitpart2(a,fitparam(b),c) + opt(d))
- := fitsystem(y, rcons(xv, a c),
- rcons(pv, fitdummy(b) = fitparam(b)), d)
- :: b = vlen(pv)+1,
-fitsystem(y, xv, pv, fitpart2(a,b,c) + opt(d))
- := fitsystem(y, rcons(xv, a c),
- rcons(pv, fitdummy(vlen(pv)+1) = b), d),
-fitsystem(y, xv, pv, 0) := fitsystem(y, xv, cons(fvh,fvt))
- :: !hasfitparams(xv)
- :: let(cons(fvh,fvt),
- solve(pv, table(fitparam(j), j, 1,
- hasfitparams(pv)))),
-fitparam(n) = x := x ]"))
-
-;;; calc-rules.el ends here
+++ /dev/null
-;;; calc-sel.el --- data selection functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-sel () nil)
-
-
-;;; Selection commands.
-
-(defvar calc-keep-selection t)
-
-(defun calc-select-here (num &optional once keep)
- (interactive "P")
- (calc-wrapper
- (calc-prepare-selection)
- (let ((found (calc-find-selected-part))
- (entry calc-selection-cache-entry))
- (or (and keep (nth 2 entry))
- (progn
- (if once (progn
- (setq calc-keep-selection nil)
- (message "(Selection will apply to next command only)")))
- (calc-change-current-selection
- (if found
- (if (and num (> (setq num (prefix-numeric-value num)) 0))
- (progn
- (while (and (>= (setq num (1- num)) 0)
- (not (eq found (car entry))))
- (setq found (calc-find-assoc-parent-formula
- (car entry) found)))
- found)
- (calc-grow-assoc-formula (car entry) found))
- (car entry))))))))
-
-(defun calc-select-once (num)
- (interactive "P")
- (calc-select-here num t))
-
-(defun calc-select-here-maybe (num)
- (interactive "P")
- (calc-select-here num nil t))
-
-(defun calc-select-once-maybe (num)
- (interactive "P")
- (calc-select-here num t t))
-
-(defun calc-select-additional ()
- (interactive)
- (calc-wrapper
- (let (calc-keep-selection)
- (calc-prepare-selection))
- (let ((found (calc-find-selected-part))
- (entry calc-selection-cache-entry))
- (calc-change-current-selection
- (if found
- (let ((sel (nth 2 entry)))
- (if sel
- (progn
- (while (not (or (eq sel (car entry))
- (calc-find-sub-formula sel found)))
- (setq sel (calc-find-assoc-parent-formula
- (car entry) sel)))
- sel)
- (calc-grow-assoc-formula (car entry) found)))
- (car entry))))))
-
-(defun calc-select-more (num)
- (interactive "P")
- (calc-wrapper
- (calc-prepare-selection)
- (let ((entry calc-selection-cache-entry))
- (if (nth 2 entry)
- (let ((sel (nth 2 entry)))
- (while (and (not (eq sel (car entry)))
- (>= (setq num (1- (prefix-numeric-value num))) 0))
- (setq sel (calc-find-assoc-parent-formula (car entry) sel)))
- (calc-change-current-selection sel))
- (calc-select-here num)))))
-
-(defun calc-select-less (num)
- (interactive "p")
- (calc-wrapper
- (calc-prepare-selection)
- (let ((found (calc-find-selected-part))
- (entry calc-selection-cache-entry))
- (calc-change-current-selection
- (and found
- (let ((sel (nth 2 entry))
- old index op)
- (while (and sel
- (not (eq sel found))
- (>= (setq num (1- num)) 0))
- (setq old sel
- index (calc-find-sub-formula sel found))
- (and (setq sel (and index (nth index old)))
- calc-assoc-selections
- (setq op (assq (car-safe sel) calc-assoc-ops))
- (memq (car old) (nth index op))
- (setq num (1+ num))))
- sel))))))
-
-(defun calc-select-part (num)
- (interactive "P")
- (or num (setq num (- last-command-char ?0)))
- (calc-wrapper
- (calc-prepare-selection)
- (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry)
- (car calc-selection-cache-entry))
- num)))
- (if sel
- (calc-change-current-selection sel)
- (error "%d is not a valid sub-formula index" num)))))
-
-(defun calc-find-nth-part (expr num)
- (if (and calc-assoc-selections
- (assq (car-safe expr) calc-assoc-ops))
- (let (op)
- (calc-find-nth-part-rec expr))
- (if (eq (car-safe expr) 'intv)
- (and (>= num 1) (<= num 2) (nth (1+ num) expr))
- (and (not (Math-primp expr)) (>= num 1) (< num (length expr))
- (nth num expr)))))
-
-(defun calc-find-nth-part-rec (expr) ; uses num, op
- (or (if (and (setq op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
- (memq (car expr) (nth 1 op)))
- (calc-find-nth-part-rec (nth 1 expr))
- (and (= (setq num (1- num)) 0)
- (nth 1 expr)))
- (if (and (setq op (assq (car-safe (nth 2 expr)) calc-assoc-ops))
- (memq (car expr) (nth 2 op)))
- (calc-find-nth-part-rec (nth 2 expr))
- (and (= (setq num (1- num)) 0)
- (nth 2 expr)))))
-
-(defun calc-select-next (num)
- (interactive "p")
- (if (< num 0)
- (calc-select-previous (- num))
- (calc-wrapper
- (calc-prepare-selection)
- (let* ((entry calc-selection-cache-entry)
- (sel (nth 2 entry)))
- (if sel
- (progn
- (while (>= (setq num (1- num)) 0)
- (let* ((parent (calc-find-parent-formula (car entry) sel))
- (p parent)
- op)
- (and (eq p t) (setq p nil))
- (while (and (setq p (cdr p))
- (not (eq (car p) sel))))
- (if (cdr p)
- (setq sel (or (and calc-assoc-selections
- (setq op (assq (car-safe (nth 1 p))
- calc-assoc-ops))
- (memq (car parent) (nth 2 op))
- (nth 1 (nth 1 p)))
- (nth 1 p)))
- (if (and calc-assoc-selections
- (setq op (assq (car-safe parent) calc-assoc-ops))
- (consp (setq p (calc-find-parent-formula
- (car entry) parent)))
- (eq (nth 1 p) parent)
- (memq (car p) (nth 1 op)))
- (setq sel (nth 2 p))
- (error "No \"next\" sub-formula")))))
- (calc-change-current-selection sel))
- (if (Math-primp (car entry))
- (calc-change-current-selection (car entry))
- (calc-select-part num)))))))
-
-(defun calc-select-previous (num)
- (interactive "p")
- (if (< num 0)
- (calc-select-next (- num))
- (calc-wrapper
- (calc-prepare-selection)
- (let* ((entry calc-selection-cache-entry)
- (sel (nth 2 entry)))
- (if sel
- (progn
- (while (>= (setq num (1- num)) 0)
- (let* ((parent (calc-find-parent-formula (car entry) sel))
- (p (cdr-safe parent))
- (prev nil)
- op)
- (if (eq (car-safe parent) 'intv) (setq p (cdr p)))
- (while (and (not (eq (car p) sel))
- (setq prev (car p)
- p (cdr p))))
- (if prev
- (setq sel (or (and calc-assoc-selections
- (setq op (assq (car-safe prev)
- calc-assoc-ops))
- (memq (car parent) (nth 1 op))
- (nth 2 prev))
- prev))
- (if (and calc-assoc-selections
- (setq op (assq (car-safe parent) calc-assoc-ops))
- (consp (setq p (calc-find-parent-formula
- (car entry) parent)))
- (eq (nth 2 p) parent)
- (memq (car p) (nth 2 op)))
- (setq sel (nth 1 p))
- (error "No \"previous\" sub-formula")))))
- (calc-change-current-selection sel))
- (if (Math-primp (car entry))
- (calc-change-current-selection (car entry))
- (let ((len (if (and calc-assoc-selections
- (assq (car (car entry)) calc-assoc-ops))
- (let (op (num 0))
- (calc-find-nth-part-rec (car entry))
- (- 1 num))
- (length (car entry)))))
- (calc-select-part (- len num)))))))))
-
-(defun calc-find-parent-formula (expr part)
- (cond ((eq expr part) t)
- ((Math-primp expr) nil)
- (t
- (let ((p expr) res)
- (while (and (setq p (cdr p))
- (not (setq res (calc-find-parent-formula
- (car p) part)))))
- (and p
- (if (eq res t) expr res))))))
-
-
-(defun calc-find-assoc-parent-formula (expr part)
- (calc-grow-assoc-formula expr (calc-find-parent-formula expr part)))
-
-(defun calc-grow-assoc-formula (expr part)
- (if calc-assoc-selections
- (let ((op (assq (car-safe part) calc-assoc-ops)))
- (if op
- (let (new)
- (while (and (consp (setq new (calc-find-parent-formula
- expr part)))
- (memq (car new)
- (nth (calc-find-sub-formula new part) op)))
- (setq part new))))
- part)
- part))
-
-(defun calc-find-sub-formula (expr part)
- (cond ((eq expr part) t)
- ((Math-primp expr) nil)
- (t
- (let ((num 1))
- (while (and (setq expr (cdr expr))
- (not (calc-find-sub-formula (car expr) part)))
- (setq num (1+ num)))
- (and expr num)))))
-
-(defun calc-unselect (num)
- (interactive "P")
- (calc-wrapper
- (calc-prepare-selection num)
- (calc-change-current-selection nil)))
-
-(defun calc-clear-selections ()
- (interactive)
- (calc-wrapper
- (let ((limit (calc-stack-size))
- (n 1))
- (while (<= n limit)
- (if (calc-top n 'sel)
- (progn
- (calc-prepare-selection n)
- (calc-change-current-selection nil)))
- (setq n (1+ n))))
- (calc-clear-command-flag 'position-point)))
-
-(defun calc-show-selections (arg)
- (interactive "P")
- (calc-wrapper
- (calc-preserve-point)
- (setq calc-show-selections (if arg
- (> (prefix-numeric-value arg) 0)
- (not calc-show-selections)))
- (let ((p calc-stack))
- (while (and p
- (or (null (nth 2 (car p)))
- (equal (car p) calc-selection-cache-entry)))
- (setq p (cdr p)))
- (or (and p
- (let ((calc-selection-cache-default-entry
- calc-selection-cache-entry))
- (calc-do-refresh)))
- (and calc-selection-cache-entry
- (let ((sel (nth 2 calc-selection-cache-entry)))
- (setcar (nthcdr 2 calc-selection-cache-entry) nil)
- (calc-change-current-selection sel)))))
- (message (if calc-show-selections
- "Displaying only selected part of formulas"
- "Displaying all but selected part of formulas"))))
-
-(defun calc-preserve-point ()
- (or (looking-at "\\.\n+\\'")
- (progn
- (setq calc-final-point-line (+ (count-lines (point-min) (point))
- (if (bolp) 1 0))
- calc-final-point-column (current-column))
- (calc-set-command-flag 'position-point))))
-
-(defun calc-enable-selections (arg)
- (interactive "P")
- (calc-wrapper
- (calc-preserve-point)
- (setq calc-use-selections (if arg
- (> (prefix-numeric-value arg) 0)
- (not calc-use-selections)))
- (calc-set-command-flag 'renum-stack)
- (message (if calc-use-selections
- "Commands operate only on selected sub-formulas"
- "Selections of sub-formulas have no effect"))))
-
-(defun calc-break-selections (arg)
- (interactive "P")
- (calc-wrapper
- (calc-preserve-point)
- (setq calc-assoc-selections (if arg
- (<= (prefix-numeric-value arg) 0)
- (not calc-assoc-selections)))
- (message (if calc-assoc-selections
- "Selection treats a+b+c as a sum of three terms"
- "Selection treats a+b+c as (a+b)+c"))))
-
-(defvar calc-selection-cache-entry nil)
-(defun calc-prepare-selection (&optional num)
- (or num (setq num (calc-locate-cursor-element (point))))
- (setq calc-selection-true-num num
- calc-keep-selection t)
- (or (> num 0) (setq num 1))
- ;; (if (or (< num 1) (> num (calc-stack-size)))
- ;; (error "Cursor must be positioned on a stack element"))
- (let* ((entry (calc-top num 'entry))
- ww w)
- (or (equal entry calc-selection-cache-entry)
- (progn
- (setcar entry (calc-encase-atoms (car entry)))
- (setq calc-selection-cache-entry entry
- calc-selection-cache-num num
- calc-selection-cache-comp
- (let ((math-comp-tagged t))
- (math-compose-expr (car entry) 0))
- calc-selection-cache-offset
- (+ (car (math-stack-value-offset calc-selection-cache-comp))
- (length calc-left-label)
- (if calc-line-numbering 4 0))))))
- (calc-preserve-point))
-
-;;; The following ensures that no two subformulas will be "eq" to each other!
-(defun calc-encase-atoms (x)
- (if (or (not (consp x))
- (equal x '(float 0 0)))
- (list 'cplx x 0)
- (calc-encase-atoms-rec x)
- x))
-
-(defun calc-encase-atoms-rec (x)
- (or (Math-primp x)
- (progn
- (if (eq (car x) 'intv)
- (setq x (cdr x)))
- (while (setq x (cdr x))
- (if (or (not (consp (car x)))
- (equal (car x) '(float 0 0)))
- (setcar x (list 'cplx (car x) 0))
- (calc-encase-atoms-rec (car x)))))))
-
-(defun calc-find-selected-part ()
- (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset))
- toppt
- (lcount 0)
- (spaces 0)
- (math-comp-sel-vpos (save-excursion
- (beginning-of-line)
- (let ((line (point)))
- (calc-cursor-stack-index
- calc-selection-cache-num)
- (setq toppt (point))
- (while (< (point) line)
- (forward-line 1)
- (setq spaces (+ spaces
- (current-indentation))
- lcount (1+ lcount)))
- (- lcount (math-comp-ascent
- calc-selection-cache-comp) -1))))
- (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset
- spaces lcount))
- (math-comp-sel-tag nil))
- (and (>= math-comp-sel-hpos 0)
- (> calc-selection-true-num 0)
- (math-composition-to-string calc-selection-cache-comp 1000000))
- (nth 1 math-comp-sel-tag)))
-
-(defun calc-change-current-selection (sub-expr)
- (or (eq sub-expr (nth 2 calc-selection-cache-entry))
- (let ((calc-prepared-composition calc-selection-cache-comp)
- (buffer-read-only nil)
- top)
- (calc-set-command-flag 'renum-stack)
- (setcar (nthcdr 2 calc-selection-cache-entry) sub-expr)
- (calc-cursor-stack-index calc-selection-cache-num)
- (setq top (point))
- (calc-cursor-stack-index (1- calc-selection-cache-num))
- (delete-region top (point))
- (let ((calc-selection-cache-default-entry calc-selection-cache-entry))
- (insert (math-format-stack-value calc-selection-cache-entry)
- "\n")))))
-
-(defun calc-top-selected (&optional n m)
- (and calc-any-selections
- calc-use-selections
- (progn
- (or n (setq n 1))
- (or m (setq m 1))
- (calc-check-stack (+ n m -1))
- (let ((top (nthcdr (+ m calc-stack-top -1) calc-stack))
- (sel nil))
- (while (>= (setq n (1- n)) 0)
- (if (nth 2 (car top))
- (setq sel (if sel t (nth 2 (car top)))))
- (setq top (cdr top)))
- sel))))
-
-(defun calc-replace-sub-formula (expr old new)
- (setq new (calc-encase-atoms new))
- (calc-replace-sub-formula-rec expr))
-
-(defun calc-replace-sub-formula-rec (expr)
- (cond ((eq expr old) new)
- ((Math-primp expr) expr)
- (t
- (cons (car expr)
- (mapcar 'calc-replace-sub-formula-rec (cdr expr))))))
-
-(defun calc-sel-error ()
- (error "Illegal operation on sub-formulas"))
-
-(defun calc-replace-selections (n vals m)
- (if (calc-top-selected n m)
- (let ((num (length vals)))
- (calc-preserve-point)
- (cond
- ((= n num)
- (let* ((old (calc-top-list n m 'entry))
- (new nil)
- (sel nil)
- val)
- (while old
- (if (nth 2 (car old))
- (setq val (calc-encase-atoms (car vals))
- new (cons (calc-replace-sub-formula (car (car old))
- (nth 2 (car old))
- val)
- new)
- sel (cons val sel))
- (setq new (cons (car vals) new)
- sel (cons nil sel)))
- (setq vals (cdr vals)
- old (cdr old)))
- (calc-pop-stack n m t)
- (calc-push-list (nreverse new)
- m (and calc-keep-selection (nreverse sel)))))
- ((= num 1)
- (let* ((old (calc-top-list n m 'entry))
- more)
- (while (and old (not (nth 2 (car old))))
- (setq old (cdr old)))
- (setq more old)
- (while (and (setq more (cdr more)) (not (nth 2 (car more)))))
- (and more
- (calc-sel-error))
- (calc-pop-stack n m t)
- (if old
- (let ((val (calc-encase-atoms (car vals))))
- (calc-push-list (list (calc-replace-sub-formula
- (car (car old))
- (nth 2 (car old))
- val))
- m (and calc-keep-selection (list val))))
- (calc-push-list vals))))
- (t (calc-sel-error))))
- (calc-pop-stack n m t)
- (calc-push-list vals m)))
-
-(defun calc-delete-selection (n)
- (let ((entry (calc-top n 'entry)))
- (if (nth 2 entry)
- (if (eq (nth 2 entry) (car entry))
- (progn
- (calc-pop-stack 1 n t)
- (calc-push-list '(0) n))
- (let ((parent (calc-find-parent-formula (car entry) (nth 2 entry)))
- (repl nil))
- (calc-preserve-point)
- (calc-pop-stack 1 n t)
- (cond ((or (memq (car parent) '(* / %))
- (and (eq (car parent) '^)
- (eq (nth 2 parent) (nth 2 entry))))
- (setq repl 1))
- ((memq (car parent) '(vec calcFunc-min calcFunc-max)))
- ((and (assq (car parent) calc-tweak-eqn-table)
- (= (length parent) 3))
- (setq repl 'del))
- (t
- (setq repl 0)))
- (cond
- ((eq repl 'del)
- (calc-push-list (list
- (calc-normalize
- (calc-replace-sub-formula
- (car entry)
- parent
- (if (eq (nth 2 entry) (nth 1 parent))
- (nth 2 parent)
- (nth 1 parent)))))
- n))
- (repl
- (calc-push-list (list
- (calc-normalize
- (calc-replace-sub-formula (car entry)
- (nth 2 entry)
- repl)))
- n))
- (t
- (calc-push-list (list
- (calc-normalize
- (calc-replace-sub-formula (car entry)
- parent
- (delq (nth 2 entry)
- (copy-sequence
- parent)))))
- n)))))
- (calc-pop-stack 1 n t))))
-
-(defun calc-roll-down-with-selections (n m)
- (let ((vals (append (calc-top-list m 1)
- (calc-top-list (- n m) (1+ m))))
- (sels (append (calc-top-list m 1 'sel)
- (calc-top-list (- n m) (1+ m) 'sel))))
- (calc-pop-push-list n vals 1 sels)))
-
-(defun calc-roll-up-with-selections (n m)
- (let ((vals (append (calc-top-list (- n m) 1)
- (calc-top-list m (- n m -1))))
- (sels (append (calc-top-list (- n m) 1 'sel)
- (calc-top-list m (- n m -1) 'sel))))
- (calc-pop-push-list n vals 1 sels)))
-
-(defun calc-auto-selection (entry)
- (or (nth 2 entry)
- (progn
- (and (boundp 'reselect) (setq reselect nil))
- (calc-prepare-selection)
- (calc-grow-assoc-formula (car entry) (calc-find-selected-part)))))
-
-(defun calc-copy-selection ()
- (interactive)
- (calc-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (entry (calc-top num 'entry)))
- (calc-push (or (calc-auto-selection entry) (car entry))))))
-
-(defun calc-del-selection ()
- (interactive)
- (calc-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (entry (calc-top num 'entry))
- (sel (calc-auto-selection entry)))
- (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel))
- (calc-delete-selection num))))
-
-(defun calc-enter-selection ()
- (interactive)
- (calc-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection)
- (entry (calc-top num 'entry))
- (expr (car entry))
- (sel (or (calc-auto-selection entry) expr))
- alg)
- (let ((calc-dollar-values (list sel))
- (calc-dollar-used 0))
- (setq alg (calc-do-alg-entry "" "Replace selection with: "))
- (and alg
- (progn
- (setq alg (calc-encase-atoms (car alg)))
- (calc-pop-push-record-list 1 "repl"
- (list (calc-replace-sub-formula
- expr sel alg))
- num
- (list (and reselect alg))))))
- (calc-handle-whys))))
-
-(defun calc-edit-selection ()
- (interactive)
- (calc-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection)
- (entry (calc-top num 'entry))
- (expr (car entry))
- (sel (or (calc-auto-selection entry) expr))
- alg)
- (let ((str (math-showing-full-precision
- (math-format-nice-expr sel (frame-width)))))
- (calc-edit-mode (list 'calc-finish-selection-edit
- num (list 'quote sel) reselect))
- (insert str "\n"))))
- (calc-show-edit-buffer))
-
-(defun calc-finish-selection-edit (num sel reselect)
- (let ((buf (current-buffer))
- (str (buffer-substring (point) (point-max)))
- (start (point)))
- (switch-to-buffer calc-original-buffer)
- (let ((val (math-read-expr str)))
- (if (eq (car-safe val) 'error)
- (progn
- (switch-to-buffer buf)
- (goto-char (+ start (nth 1 val)))
- (error (nth 2 val))))
- (calc-wrapper
- (calc-preserve-point)
- (if disp-trail
- (calc-trail-display 1 t))
- (setq val (calc-encase-atoms (calc-normalize val)))
- (let ((expr (calc-top num 'full)))
- (if (calc-find-sub-formula expr sel)
- (calc-pop-push-record-list 1 "edit"
- (list (calc-replace-sub-formula
- expr sel val))
- num
- (list (and reselect val)))
- (calc-push val)
- (error "Original selection has been lost")))))))
-
-(defun calc-sel-evaluate (arg)
- (interactive "p")
- (calc-slow-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection)
- (entry (calc-top num 'entry))
- (sel (or (calc-auto-selection entry) (car entry))))
- (calc-with-default-simplification
- (let ((math-simplify-only nil))
- (calc-modify-simplify-mode arg)
- (let ((val (calc-encase-atoms (calc-normalize sel))))
- (calc-pop-push-record-list 1 "jsmp"
- (list (calc-replace-sub-formula
- (car entry) sel val))
- num
- (list (and reselect val))))))
- (calc-handle-whys))))
-
-(defun calc-sel-expand-formula (arg)
- (interactive "p")
- (calc-slow-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection)
- (entry (calc-top num 'entry))
- (sel (or (calc-auto-selection entry) (car entry))))
- (calc-with-default-simplification
- (let ((math-simplify-only nil))
- (calc-modify-simplify-mode arg)
- (let* ((math-expand-formulas (> arg 0))
- (val (calc-normalize sel))
- top)
- (and (<= arg 0)
- (setq top (math-expand-formula val))
- (setq val (calc-normalize top)))
- (setq val (calc-encase-atoms val))
- (calc-pop-push-record-list 1 "jexf"
- (list (calc-replace-sub-formula
- (car entry) sel val))
- num
- (list (and reselect val))))))
- (calc-handle-whys))))
-
-(defun calc-sel-mult-both-sides (no-simp &optional divide)
- (interactive "P")
- (calc-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection)
- (entry (calc-top num 'entry))
- (expr (car entry))
- (sel (or (calc-auto-selection entry) expr))
- (func (car-safe sel))
- alg lhs rhs)
- (setq alg (calc-with-default-simplification
- (car (calc-do-alg-entry ""
- (if divide
- "Divide both sides by: "
- "Multiply both sides by: ")))))
- (and alg
- (progn
- (if (and (or (eq func '/)
- (assq func calc-tweak-eqn-table))
- (= (length sel) 3))
- (progn
- (or (memq func '(/ calcFunc-eq calcFunc-neq))
- (if (math-known-nonposp alg)
- (progn
- (setq func (nth 1 (assq func
- calc-tweak-eqn-table)))
- (or (math-known-negp alg)
- (message "Assuming this factor is nonzero")))
- (or (math-known-posp alg)
- (if (math-known-nonnegp alg)
- (message "Assuming this factor is nonzero")
- (message "Assuming this factor is positive")))))
- (setq lhs (list (if divide '/ '*) (nth 1 sel) alg)
- rhs (list (if divide '/ '*) (nth 2 sel) alg))
- (or no-simp
- (progn
- (setq lhs (math-simplify lhs)
- rhs (math-simplify rhs))
- (and (eq func '/)
- (or (Math-equal (nth 1 sel) 1)
- (Math-equal (nth 1 sel) -1)
- (and (memq (car-safe (nth 2 sel)) '(+ -))
- (memq (car-safe alg) '(+ -))))
- (setq rhs (math-expand-term rhs)))))
- (setq alg (calc-encase-atoms
- (calc-normalize (list func lhs rhs)))))
- (setq rhs (list (if divide '* '/) sel alg))
- (or no-simp
- (setq rhs (math-simplify rhs)))
- (setq alg (calc-encase-atoms
- (calc-normalize (if divide
- (list '/ rhs alg)
- (list '* alg rhs))))))
- (calc-pop-push-record-list 1 (if divide "div" "mult")
- (list (calc-replace-sub-formula
- expr sel alg))
- num
- (list (and reselect alg)))))
- (calc-handle-whys))))
-
-(defun calc-sel-div-both-sides (no-simp)
- (interactive "P")
- (calc-sel-mult-both-sides no-simp t))
-
-(defun calc-sel-add-both-sides (no-simp &optional subtract)
- (interactive "P")
- (calc-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection)
- (entry (calc-top num 'entry))
- (expr (car entry))
- (sel (or (calc-auto-selection entry) expr))
- (func (car-safe sel))
- alg lhs rhs)
- (setq alg (calc-with-default-simplification
- (car (calc-do-alg-entry ""
- (if subtract
- "Subtract from both sides: "
- "Add to both sides: ")))))
- (and alg
- (progn
- (if (and (assq func calc-tweak-eqn-table)
- (= (length sel) 3))
- (progn
- (setq lhs (list (if subtract '- '+) (nth 1 sel) alg)
- rhs (list (if subtract '- '+) (nth 2 sel) alg))
- (or no-simp
- (setq lhs (math-simplify lhs)
- rhs (math-simplify rhs)))
- (setq alg (calc-encase-atoms
- (calc-normalize (list func lhs rhs)))))
- (setq rhs (list (if subtract '+ '-) sel alg))
- (or no-simp
- (setq rhs (math-simplify rhs)))
- (setq alg (calc-encase-atoms
- (calc-normalize (list (if subtract '- '+) alg rhs)))))
- (calc-pop-push-record-list 1 (if subtract "sub" "add")
- (list (calc-replace-sub-formula
- expr sel alg))
- num
- (list (and reselect alg)))))
- (calc-handle-whys))))
-
-(defun calc-sel-sub-both-sides (no-simp)
- (interactive "P")
- (calc-sel-add-both-sides no-simp t))
-
-;;; calc-sel.el ends here
+++ /dev/null
-;;; calc-stat.el --- statistical functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-stat () nil)
-
-
-;;; Statistical operations on vectors.
-
-(defun calc-vector-count (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-vector-op "coun" 'calcFunc-vcount arg)))
-
-(defun calc-vector-sum (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-vector-op "vprd" 'calcFunc-vprod arg)
- (calc-vector-op "vsum" 'calcFunc-vsum arg))))
-
-(defun calc-vector-product (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-vector-sum arg))
-
-(defun calc-vector-max (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-vector-op "vmin" 'calcFunc-vmin arg)
- (calc-vector-op "vmax" 'calcFunc-vmax arg))))
-
-(defun calc-vector-min (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-vector-max arg))
-
-(defun calc-vector-mean (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (if (calc-is-inverse)
- (calc-vector-op "harm" 'calcFunc-vhmean arg)
- (calc-vector-op "medn" 'calcFunc-vmedian arg))
- (if (calc-is-inverse)
- (calc-vector-op "meae" 'calcFunc-vmeane arg)
- (calc-vector-op "mean" 'calcFunc-vmean arg)))))
-
-(defun calc-vector-mean-error (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-vector-mean arg))
-
-(defun calc-vector-median (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-vector-mean arg))
-
-(defun calc-vector-harmonic-mean (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-hyperbolic-func)
- (calc-vector-mean arg))
-
-(defun calc-vector-geometric-mean (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (calc-binary-op "geom" 'calcFunc-agmean arg)
- (calc-vector-op "geom" 'calcFunc-vgmean arg))))
-
-(defun calc-vector-sdev (arg)
- (interactive "P")
- (calc-slow-wrapper
- (if (calc-is-hyperbolic)
- (if (calc-is-inverse)
- (calc-vector-op "pvar" 'calcFunc-vpvar arg)
- (calc-vector-op "var" 'calcFunc-vvar arg))
- (if (calc-is-inverse)
- (calc-vector-op "psdv" 'calcFunc-vpsdev arg)
- (calc-vector-op "sdev" 'calcFunc-vsdev arg)))))
-
-(defun calc-vector-pop-sdev (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-vector-sdev arg))
-
-(defun calc-vector-variance (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-vector-sdev arg))
-
-(defun calc-vector-pop-variance (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-hyperbolic-func)
- (calc-vector-sdev arg))
-
-(defun calc-vector-covariance (arg)
- (interactive "P")
- (calc-slow-wrapper
- (let ((n (if (eq arg 1) 1 2)))
- (if (calc-is-hyperbolic)
- (calc-enter-result n "corr" (cons 'calcFunc-vcorr
- (calc-top-list-n n)))
- (if (calc-is-inverse)
- (calc-enter-result n "pcov" (cons 'calcFunc-vpcov
- (calc-top-list-n n)))
- (calc-enter-result n "cov" (cons 'calcFunc-vcov
- (calc-top-list-n n))))))))
-
-(defun calc-vector-pop-covariance (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-vector-covariance arg))
-
-(defun calc-vector-correlation (arg)
- (interactive "P")
- (calc-hyperbolic-func)
- (calc-vector-covariance arg))
-
-(defun calc-vector-op (name func arg)
- (setq calc-aborted-prefix name
- arg (prefix-numeric-value arg))
- (if (< arg 0)
- (error "Negative arguments not allowed"))
- (calc-enter-result arg name (cons func (calc-top-list-n arg))))
-
-
-
-
-;;; Useful statistical functions
-
-;;; Sum, product, etc., of one or more values or vectors.
-;;; Each argument must be either a number or a vector. Vectors
-;;; are flattened, but variables inside are assumed to represent
-;;; non-vectors.
-
-(defun calcFunc-vsum (&rest vecs)
- (math-reduce-many-vecs 'calcFunc-add 'calcFunc-vsum vecs 0))
-
-(defun calcFunc-vprod (&rest vecs)
- (math-reduce-many-vecs 'calcFunc-mul 'calcFunc-vprod vecs 1))
-
-(defun calcFunc-vmax (&rest vecs)
- (if (eq (car-safe (car vecs)) 'sdev)
- '(var inf var-inf)
- (if (eq (car-safe (car vecs)) 'intv)
- (nth 3 (math-fix-int-intv (car vecs)))
- (math-reduce-many-vecs 'calcFunc-max 'calcFunc-vmax vecs
- '(neg (var inf var-inf))))))
-
-(defun calcFunc-vmin (&rest vecs)
- (if (eq (car-safe (car vecs)) 'sdev)
- '(neg (var inf var-inf))
- (if (eq (car-safe (car vecs)) 'intv)
- (nth 2 (math-fix-int-intv (car vecs)))
- (math-reduce-many-vecs 'calcFunc-min 'calcFunc-vmin vecs
- '(var inf var-inf)))))
-
-(defun math-reduce-many-vecs (func whole-func vecs ident)
- (let ((const-part nil)
- (symb-part nil)
- val vec)
- (let ((calc-internal-prec (+ calc-internal-prec 2)))
- (while vecs
- (setq val (car vecs))
- (and (eq (car-safe val) 'var)
- (eq (car-safe (calc-var-value (nth 2 val))) 'vec)
- (setq val (symbol-value (nth 2 val))))
- (cond ((Math-vectorp val)
- (setq vec (append (and const-part (list const-part))
- (math-flatten-vector val)))
- (setq const-part (if vec
- (calcFunc-reducer
- (math-calcFunc-to-var func)
- (cons 'vec vec))
- ident)))
- ((or (Math-objectp val) (math-infinitep val))
- (setq const-part (if const-part
- (funcall func const-part val)
- val)))
- (t
- (setq symb-part (nconc symb-part (list val)))))
- (setq vecs (cdr vecs))))
- (if const-part
- (progn
- (setq const-part (math-normalize const-part))
- (if symb-part
- (funcall func const-part (cons whole-func symb-part))
- const-part))
- (if symb-part (cons whole-func symb-part) ident))))
-
-
-;;; Return the number of data elements among the arguments.
-(defun calcFunc-vcount (&rest vecs)
- (let ((count 0))
- (while vecs
- (setq count (if (Math-vectorp (car vecs))
- (+ count (math-count-elements (car vecs)))
- (if (Math-objectp (car vecs))
- (1+ count)
- (if (and (eq (car-safe (car vecs)) 'var)
- (eq (car-safe (calc-var-value
- (nth 2 (car vecs))))
- 'vec))
- (+ count (math-count-elements
- (symbol-value (nth 2 (car vecs)))))
- (math-reject-arg (car vecs) 'numvecp))))
- vecs (cdr vecs)))
- count))
-
-(defun math-count-elements (vec)
- (let ((count 0))
- (while (setq vec (cdr vec))
- (setq count (if (Math-vectorp (car vec))
- (+ count (math-count-elements (car vec)))
- (1+ count))))
- count))
-
-
-(defun math-flatten-many-vecs (vecs)
- (let ((p vecs)
- (vec (list 'vec)))
- (while p
- (setq vec (nconc vec
- (if (Math-vectorp (car p))
- (math-flatten-vector (car p))
- (if (Math-objectp (car p))
- (list (car p))
- (if (and (eq (car-safe (car p)) 'var)
- (eq (car-safe (calc-var-value
- (nth 2 (car p)))) 'vec))
- (math-flatten-vector (symbol-value
- (nth 2 (car p))))
- (math-reject-arg (car p) 'numvecp)))))
- p (cdr p)))
- vec))
-
-(defun calcFunc-vflat (&rest vecs)
- (math-flatten-many-vecs vecs))
-
-(defun math-split-sdev-vec (vec zero-ok)
- (let ((means (list 'vec))
- (wts (list 'vec))
- (exact nil)
- (p vec))
- (while (and (setq p (cdr p))
- (not (and (consp (car p))
- (eq (car (car p)) 'sdev)))))
- (if (null p)
- (list vec nil)
- (while (setq vec (cdr vec))
- (if (and (consp (setq p (car vec)))
- (eq (car p) 'sdev))
- (or exact
- (setq means (cons (nth 1 p) means)
- wts (cons (nth 2 p) wts)))
- (if zero-ok
- (setq means (cons (nth 1 p) means)
- wts (cons 0 wts))
- (or exact
- (setq means (list 'vec)
- wts nil
- exact t))
- (setq means (cons p means)))))
- (list (nreverse means)
- (and wts (nreverse wts))))))
-
-
-;;; Return the arithmetic mean of the argument numbers or vectors.
-;;; (If numbers are error forms, computes the weighted mean.)
-(defun calcFunc-vmean (&rest vecs)
- (let* ((split (math-split-sdev-vec (math-flatten-many-vecs vecs) nil))
- (means (car split))
- (wts (nth 1 split))
- (len (1- (length means))))
- (if (= len 0)
- (math-reject-arg nil "*Must be at least 1 argument")
- (if (and (= len 1) (eq (car-safe (nth 1 means)) 'intv))
- (let ((x (math-fix-int-intv (nth 1 means))))
- (calcFunc-vmean (nth 2 x) (nth 3 x)))
- (math-with-extra-prec 2
- (if (and wts (> len 1))
- (let* ((sqrwts (calcFunc-map '(var mul var-mul) wts wts))
- (suminvsqrwts (calcFunc-reduce
- '(var add var-add)
- (calcFunc-map '(var div var-div)
- 1 sqrwts))))
- (math-div (calcFunc-reduce '(var add var-add)
- (calcFunc-map '(var div var-div)
- means sqrwts))
- suminvsqrwts))
- (math-div (calcFunc-reduce '(var add var-add) means) len)))))))
-
-(defun math-fix-int-intv (x)
- (if (math-floatp x)
- x
- (list 'intv 3
- (if (memq (nth 1 x) '(2 3)) (nth 2 x) (math-add (nth 2 x) 1))
- (if (memq (nth 1 x) '(1 3)) (nth 3 x) (math-sub (nth 3 x) 1)))))
-
-;;; Compute the mean with an error estimate.
-(defun calcFunc-vmeane (&rest vecs)
- (let* ((split (math-split-sdev-vec (math-flatten-many-vecs vecs) nil))
- (means (car split))
- (wts (nth 1 split))
- (len (1- (length means))))
- (if (= len 0)
- (math-reject-arg nil "*Must be at least 1 argument")
- (math-with-extra-prec 2
- (if wts
- (let* ((sqrwts (calcFunc-map '(var mul var-mul) wts wts))
- (suminvsqrwts (calcFunc-reduce
- '(var add var-add)
- (calcFunc-map '(var div var-div)
- 1 sqrwts))))
- (math-make-sdev
- (math-div (calcFunc-reduce '(var add var-add)
- (calcFunc-map '(var div var-div)
- means sqrwts))
- suminvsqrwts)
- (list 'calcFunc-sqrt (math-div 1 suminvsqrwts))))
- (let ((mean (math-div (calcFunc-reduce '(var add var-add) means)
- len)))
- (math-make-sdev
- mean
- (list 'calcFunc-sqrt
- (math-div (calcFunc-reducer
- '(var add var-add)
- (calcFunc-map '(var pow var-pow)
- (calcFunc-map '(var abs var-abs)
- (calcFunc-map
- '(var add var-add)
- means
- (math-neg mean)))
- 2))
- (math-mul len (1- len)))))))))))
-
-
-;;; Compute the median of a list of values.
-(defun calcFunc-vmedian (&rest vecs)
- (let* ((flat (copy-sequence (cdr (math-flatten-many-vecs vecs))))
- (p flat)
- (len (length flat))
- (hlen (/ len 2)))
- (if (= len 0)
- (math-reject-arg nil "*Must be at least 1 argument")
- (if (and (= len 1) (memq (car-safe (car flat)) '(sdev intv)))
- (calcFunc-vmean (car flat))
- (while p
- (if (eq (car-safe (car p)) 'sdev)
- (setcar p (nth 1 (car p))))
- (or (Math-anglep (car p))
- (math-reject-arg (car p) 'anglep))
- (setq p (cdr p)))
- (setq flat (sort flat 'math-lessp))
- (if (= (% len 2) 0)
- (math-div (math-add (nth (1- hlen) flat) (nth hlen flat)) 2)
- (nth hlen flat))))))
-
-
-(defun calcFunc-vgmean (&rest vecs)
- (let* ((flat (math-flatten-many-vecs vecs))
- (len (1- (length flat))))
- (if (= len 0)
- (math-reject-arg nil "*Must be at least 1 argument")
- (math-with-extra-prec 2
- (let ((x (calcFunc-reduce '(var mul math-mul) flat)))
- (if (= len 2)
- (math-sqrt x)
- (math-pow x (list 'frac 1 len))))))))
-
-
-(defun calcFunc-agmean (a b)
- (cond ((Math-equal a b) a)
- ((math-zerop a) a)
- ((math-zerop b) b)
- (calc-symbolic-mode (math-inexact-result))
- ((not (Math-realp a)) (math-reject-arg a 'realp))
- ((not (Math-realp b)) (math-reject-arg b 'realp))
- (t
- (math-with-extra-prec 2
- (setq a (math-float (math-abs a))
- b (math-float (math-abs b)))
- (let (mean)
- (while (not (math-nearly-equal-float a b))
- (setq mean (math-mul-float (math-add-float a b) '(float 5 -1))
- b (math-sqrt-float (math-mul-float a b))
- a mean))
- a)))))
-
-
-(defun calcFunc-vhmean (&rest vecs)
- (let* ((flat (math-flatten-many-vecs vecs))
- (len (1- (length flat))))
- (if (= len 0)
- (math-reject-arg nil "*Must be at least 1 argument")
- (math-with-extra-prec 2
- (math-div len
- (calcFunc-reduce '(var add math-add)
- (calcFunc-map '(var inv var-inv) flat)))))))
-
-
-
-;;; Compute the sample variance or standard deviation of numbers or vectors.
-;;; (If the numbers are error forms, only the mean part of them is used.)
-(defun calcFunc-vvar (&rest vecs)
- (if (and (= (length vecs) 1)
- (memq (car-safe (car vecs)) '(sdev intv)))
- (if (eq (car-safe (car vecs)) 'intv)
- (math-intv-variance (car vecs) nil)
- (math-sqr (nth 2 (car vecs))))
- (math-covariance vecs nil nil 0)))
-
-(defun calcFunc-vsdev (&rest vecs)
- (if (and (= (length vecs) 1)
- (memq (car-safe (car vecs)) '(sdev intv)))
- (if (eq (car-safe (car vecs)) 'intv)
- (if (math-floatp (car vecs))
- (math-div (math-sub (nth 3 (car vecs)) (nth 2 (car vecs)))
- (math-sqrt-12))
- (math-sqrt (calcFunc-vvar (car vecs))))
- (nth 2 (car vecs)))
- (math-sqrt (math-covariance vecs nil nil 0))))
-
-;;; Compute the population variance or std deviation of numbers or vectors.
-(defun calcFunc-vpvar (&rest vecs)
- (if (and (= (length vecs) 1)
- (memq (car-safe (car vecs)) '(sdev intv)))
- (if (eq (car-safe (car vecs)) 'intv)
- (math-intv-variance (car vecs) t)
- (math-sqr (nth 2 (car vecs))))
- (math-covariance vecs nil t 0)))
-
-(defun calcFunc-vpsdev (&rest vecs)
- (if (and (= (length vecs) 1)
- (memq (car-safe (car vecs)) '(sdev intv)))
- (if (eq (car-safe (car vecs)) 'intv)
- (if (math-floatp (car vecs))
- (math-div (math-sub (nth 3 (car vecs)) (nth 2 (car vecs)))
- (math-sqrt-12))
- (math-sqrt (calcFunc-vpvar (car vecs))))
- (nth 2 (car vecs)))
- (math-sqrt (math-covariance vecs nil t 0))))
-
-(defun math-intv-variance (x pop)
- (or (math-constp x) (math-reject-arg x 'constp))
- (if (math-floatp x)
- (math-div (math-sqr (math-sub (nth 3 x) (nth 2 x))) 12)
- (let* ((x (math-fix-int-intv x))
- (len (math-sub (nth 3 x) (nth 2 x)))
- (hlen (math-quotient len 2)))
- (math-div (if (math-evenp len)
- (calcFunc-sum '(^ (var X var-X) 2) '(var X var-X)
- (math-neg hlen) hlen)
- (calcFunc-sum '(^ (- (var X var-X) (/ 1 2)) 2)
- '(var X var-X)
- (math-neg hlen) (math-add hlen 1)))
- (if pop (math-add len 1) len)))))
-
-;;; Compute the covariance and linear correlation coefficient.
-(defun calcFunc-vcov (vec1 &optional vec2)
- (math-covariance (list vec1) (list vec2) nil 1))
-
-(defun calcFunc-vpcov (vec1 &optional vec2)
- (math-covariance (list vec1) (list vec2) t 1))
-
-(defun calcFunc-vcorr (vec1 &optional vec2)
- (math-covariance (list vec1) (list vec2) nil 2))
-
-
-(defun math-covariance (vec1 vec2 pop mode)
- (or (car vec2) (= mode 0)
- (progn
- (if (and (eq (car-safe (car vec1)) 'var)
- (eq (car-safe (calc-var-value (nth 2 (car vec1)))) 'vec))
- (setq vec1 (symbol-value (nth 2 (car vec1))))
- (setq vec1 (car vec1)))
- (or (math-matrixp vec1) (math-dimension-error))
- (or (= (length (nth 1 vec1)) 3) (math-dimension-error))
- (setq vec2 (list (math-mat-col vec1 2))
- vec1 (list (math-mat-col vec1 1)))))
- (math-with-extra-prec 2
- (let* ((split1 (math-split-sdev-vec (math-flatten-many-vecs vec1) nil))
- (means1 (car split1))
- (wts1 (nth 1 split1))
- split2 means2 (wts2 nil)
- (sqrwts nil)
- suminvsqrwts
- (len (1- (length means1))))
- (if (< len (if pop 1 2))
- (math-reject-arg nil (if pop
- "*Must be at least 1 argument"
- "*Must be at least 2 arguments")))
- (if (or wts1 wts2)
- (setq sqrwts (math-add
- (if wts1
- (calcFunc-map '(var mul var-mul) wts1 wts1)
- 0)
- (if wts2
- (calcFunc-map '(var mul var-mul) wts2 wts2)
- 0))
- suminvsqrwts (calcFunc-reduce
- '(var add var-add)
- (calcFunc-map '(var div var-div) 1 sqrwts))))
- (or (= mode 0)
- (progn
- (setq split2 (math-split-sdev-vec (math-flatten-many-vecs vec2)
- nil)
- means2 (car split2)
- wts2 (nth 2 split1))
- (or (= len (1- (length means2))) (math-dimension-error))))
- (let* ((diff1 (calcFunc-map
- '(var add var-add)
- means1
- (if sqrwts
- (math-div (calcFunc-reduce
- '(var add var-add)
- (calcFunc-map '(var div var-div)
- means1 sqrwts))
- (math-neg suminvsqrwts))
- (math-div (calcFunc-reducer '(var add var-add) means1)
- (- len)))))
- (diff2 (if (= mode 0)
- diff1
- (calcFunc-map
- '(var add var-add)
- means2
- (if sqrwts
- (math-div (calcFunc-reduce
- '(var add var-add)
- (calcFunc-map '(var div var-div)
- means2 sqrwts))
- (math-neg suminvsqrwts))
- (math-div (calcFunc-reducer '(var add var-add) means2)
- (- len))))))
- (covar (calcFunc-map '(var mul var-mul) diff1 diff2)))
- (if sqrwts
- (setq covar (calcFunc-map '(var div var-div) covar sqrwts)))
- (math-div
- (calcFunc-reducer '(var add var-add) covar)
- (if (= mode 2)
- (let ((var1 (calcFunc-map '(var mul var-mul) diff1 diff1))
- (var2 (calcFunc-map '(var mul var-mul) diff2 diff2)))
- (if sqrwts
- (setq var1 (calcFunc-map '(var div var-div) var1 sqrwts)
- var2 (calcFunc-map '(var div var-div) var2 sqrwts)))
- (math-sqrt
- (math-mul (calcFunc-reducer '(var add var-add) var1)
- (calcFunc-reducer '(var add var-add) var2))))
- (if sqrwts
- (if pop
- suminvsqrwts
- (math-div (math-mul suminvsqrwts (1- len)) len))
- (if pop len (1- len)))))))))
-
-;;; calc-stat.el ends here
+++ /dev/null
-;;; calc-store.el --- value storage functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-store () nil)
-
-
-;;; Memory commands.
-
-(defvar calc-store-keep nil)
-(defun calc-store (&optional var)
- (interactive)
- (let ((calc-store-keep t))
- (calc-store-into var)))
-
-(defvar calc-given-value-flag nil)
-(defun calc-store-into (&optional var)
- (interactive)
- (calc-wrapper
- (let ((calc-given-value nil)
- (calc-given-value-flag 1))
- (or var (setq var (calc-read-var-name "Store: " t)))
- (if var
- (let ((found (assq var '( ( + . calc-store-plus )
- ( - . calc-store-minus )
- ( * . calc-store-times )
- ( / . calc-store-div )
- ( ^ . calc-store-power )
- ( | . calc-store-concat ) ))))
- (if found
- (funcall (cdr found))
- (calc-store-value var (or calc-given-value (calc-top 1))
- "" calc-given-value-flag)
- (message "Stored to variable \"%s\"" (calc-var-name var))))
- (setq var (calc-is-assignments (calc-top 1)))
- (if var
- (while var
- (calc-store-value (car (car var)) (cdr (car var))
- (if (not (cdr var)) "")
- (if (not (cdr var)) 1))
- (setq var (cdr var))))))))
-
-(defun calc-store-plus (&optional var)
- (interactive)
- (calc-store-binary var "+" '+))
-
-(defun calc-store-minus (&optional var)
- (interactive)
- (calc-store-binary var "-" '-))
-
-(defun calc-store-times (&optional var)
- (interactive)
- (calc-store-binary var "*" '*))
-
-(defun calc-store-div (&optional var)
- (interactive)
- (calc-store-binary var "/" '/))
-
-(defun calc-store-power (&optional var)
- (interactive)
- (calc-store-binary var "^" '^))
-
-(defun calc-store-concat (&optional var)
- (interactive)
- (calc-store-binary var "|" '|))
-
-(defun calc-store-neg (n &optional var)
- (interactive "p")
- (calc-store-binary var "n" '/ (- n)))
-
-(defun calc-store-inv (n &optional var)
- (interactive "p")
- (calc-store-binary var "&" '^ (- n)))
-
-(defun calc-store-incr (n &optional var)
- (interactive "p")
- (calc-store-binary var "n" '- (- n)))
-
-(defun calc-store-decr (n &optional var)
- (interactive "p")
- (calc-store-binary var "n" '- n))
-
-(defun calc-store-value (var value tag &optional pop)
- (if var
- (let ((old (calc-var-value var)))
- (set var value)
- (if pop (or calc-store-keep (calc-pop-stack pop)))
- (calc-record-undo (list 'store (symbol-name var) old))
- (if tag
- (let ((calc-full-trail-vectors nil))
- (calc-record value (format ">%s%s" tag (calc-var-name var)))))
- (and (memq var '(var-e var-i var-pi var-phi var-gamma))
- (eq (car-safe old) 'special-const)
- (message "(Note: Built-in definition of %s has been lost)" var))
- (and (memq var '(var-inf var-uinf var-nan))
- (null old)
- (message "(Note: %s has built-in meanings which may interfere)"
- var))
- (calc-refresh-evaltos var))))
-
-(defun calc-var-name (var)
- (if (symbolp var) (setq var (symbol-name var)))
- (if (string-match "\\`var-." var)
- (substring var 4)
- var))
-
-(defun calc-store-binary (var tag func &optional val)
- (calc-wrapper
- (let ((calc-simplify-mode (if (eq calc-simplify-mode 'none)
- 'num calc-simplify-mode))
- (value (or val (calc-top 1))))
- (or var (setq var (calc-read-var-name (format "Store %s: " tag))))
- (if var
- (let ((old (calc-var-value var)))
- (or old
- (error "No such variable: \"%s\"" (calc-var-name var)))
- (if (stringp old)
- (setq old (math-read-expr old)))
- (if (eq (car-safe old) 'error)
- (error "Bad format in variable contents: %s" (nth 2 old)))
- (calc-store-value var
- (calc-normalize (if (calc-is-inverse)
- (list func value old)
- (list func old value)))
- tag (and (not val) 1))
- (message "Stored to variable \"%s\"" (calc-var-name var)))))))
-
-(defun calc-read-var-name (prompt &optional calc-store-opers)
- (setq calc-given-value nil
- calc-aborted-prefix nil)
- (let ((var (let ((minibuffer-completion-table obarray)
- (minibuffer-completion-predicate 'boundp)
- (minibuffer-completion-confirm t))
- (read-from-minibuffer prompt "var-" calc-var-name-map nil))))
- (setq calc-aborted-prefix "")
- (and (not (equal var ""))
- (not (equal var "var-"))
- (if (string-match "\\`\\([-a-zA-Z0-9]+\\) *:?=" var)
- (if (null calc-given-value-flag)
- (error "Assignment is not allowed in this command")
- (let ((svar (intern (substring var 0 (match-end 1)))))
- (setq calc-given-value-flag 0
- calc-given-value (math-read-expr
- (substring var (match-end 0))))
- (if (eq (car-safe calc-given-value) 'error)
- (error "Bad format: %s" (nth 2 calc-given-value)))
- (setq calc-given-value (math-evaluate-expr calc-given-value))
- svar))
- (intern var)))))
-
-(defvar calc-var-name-map nil "Keymap for reading Calc variable names.")
-(if calc-var-name-map
- ()
- (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
- (define-key calc-var-name-map " " 'self-insert-command)
- (mapcar (function
- (lambda (x)
- (define-key calc-var-name-map (char-to-string x)
- 'calcVar-digit)))
- "0123456789")
- (mapcar (function
- (lambda (x)
- (define-key calc-var-name-map (char-to-string x)
- 'calcVar-oper)))
- "+-*/^|"))
-
-(defun calcVar-digit ()
- (interactive)
- (if (calc-minibuffer-contains "var-\\'")
- (if (eq calc-store-opers 0)
- (beep)
- (insert "q")
- (self-insert-and-exit))
- (self-insert-command 1)))
-
-(defun calcVar-oper ()
- (interactive)
- (if (and (eq calc-store-opers t)
- (calc-minibuffer-contains "var-\\'"))
- (progn
- (erase-buffer)
- (self-insert-and-exit))
- (self-insert-command 1)))
-
-(defun calc-store-map (&optional oper var)
- (interactive)
- (calc-wrapper
- (let* ((sel-mode nil)
- (calc-dollar-values (mapcar 'calc-get-stack-element
- (nthcdr calc-stack-top calc-stack)))
- (calc-dollar-used 0)
- (oper (or oper (calc-get-operator "Store Mapping")))
- (nargs (car oper)))
- (or var (setq var (calc-read-var-name (format "Store Mapping %s: "
- (nth 2 oper)))))
- (if var
- (let ((old (or (calc-var-value var)
- (error "No such variable: \"%s\""
- (calc-var-name var))))
- (calc-simplify-mode (if (eq calc-simplify-mode 'none)
- 'num calc-simplify-mode))
- (values (and (> nargs 1)
- (calc-top-list (1- nargs) (1+ calc-dollar-used)))))
- (message "Working...")
- (calc-set-command-flag 'clear-message)
- (if (stringp old)
- (setq old (math-read-expr old)))
- (if (eq (car-safe old) 'error)
- (error "Bad format in variable contents: %s" (nth 2 old)))
- (setq values (if (calc-is-inverse)
- (append values (list old))
- (append (list old) values)))
- (calc-store-value var
- (calc-normalize (cons (nth 1 oper) values))
- (nth 2 oper)
- (+ calc-dollar-used (1- nargs))))))))
-
-(defun calc-store-exchange (&optional var)
- (interactive)
- (calc-wrapper
- (let ((calc-given-value nil)
- (calc-given-value-flag 1)
- top)
- (or var (setq var (calc-read-var-name "Exchange with: ")))
- (if var
- (let ((value (calc-var-value var)))
- (or value
- (error "No such variable: \"%s\"" (calc-var-name var)))
- (if (eq (car-safe value) 'special-const)
- (error "%s is a special constant" var))
- (setq top (or calc-given-value (calc-top 1)))
- (calc-store-value var top nil)
- (calc-pop-push-record calc-given-value-flag
- (concat "<>" (calc-var-name var)) value))))))
-
-(defun calc-unstore (&optional var)
- (interactive)
- (calc-wrapper
- (or var (setq var (calc-read-var-name "Unstore: ")))
- (if var
- (progn
- (and (memq var '(var-e var-i var-pi var-phi var-gamma))
- (eq (car-safe (calc-var-value var)) 'special-const)
- (message "(Note: Built-in definition of %s has been lost)" var))
- (if (and (boundp var) (symbol-value var))
- (message "Unstored variable \"%s\"" (calc-var-name var))
- (message "Variable \"%s\" remains unstored" (calc-var-name var)))
- (makunbound var)
- (calc-refresh-evaltos var)))))
-
-(defun calc-let (&optional var)
- (interactive)
- (calc-wrapper
- (let* ((calc-given-value nil)
- (calc-given-value-flag 1)
- thing value)
- (or var (setq var (calc-read-var-name "Let variable: ")))
- (if calc-given-value
- (setq value calc-given-value
- thing (calc-top 1))
- (setq value (calc-top 1)
- thing (calc-top 2)))
- (setq var (if var
- (list (cons var value))
- (calc-is-assignments value)))
- (if var
- (calc-pop-push-record
- (1+ calc-given-value-flag)
- (concat "=" (calc-var-name (car (car var))))
- (let ((saved-val (mapcar (function
- (lambda (v)
- (and (boundp (car v))
- (symbol-value (car v)))))
- var)))
- (unwind-protect
- (let ((vv var))
- (while vv
- (set (car (car vv)) (calc-normalize (cdr (car vv))))
- (calc-refresh-evaltos (car (car vv)))
- (setq vv (cdr vv)))
- (math-evaluate-expr thing))
- (while saved-val
- (if (car saved-val)
- (set (car (car var)) (car saved-val))
- (makunbound (car (car var))))
- (setq saved-val (cdr saved-val)
- var (cdr var)))
- (calc-handle-whys))))))))
-
-(defun calc-is-assignments (value)
- (if (memq (car-safe value) '(calcFunc-eq calcFunc-assign))
- (and (eq (car-safe (nth 1 value)) 'var)
- (list (cons (nth 2 (nth 1 value)) (nth 2 value))))
- (if (eq (car-safe value) 'vec)
- (let ((vv nil))
- (while (and (setq value (cdr value))
- (memq (car-safe (car value))
- '(calcFunc-eq calcFunc-assign))
- (eq (car-safe (nth 1 (car value))) 'var))
- (setq vv (cons (cons (nth 2 (nth 1 (car value)))
- (nth 2 (car value)))
- vv)))
- (and (not value)
- vv)))))
-
-(defun calc-recall (&optional var)
- (interactive)
- (calc-wrapper
- (or var (setq var (calc-read-var-name "Recall: ")))
- (if var
- (let ((value (calc-var-value var)))
- (or value
- (error "No such variable: \"%s\"" (calc-var-name var)))
- (if (stringp value)
- (setq value (math-read-expr value)))
- (if (eq (car-safe value) 'error)
- (error "Bad format in variable contents: %s" (nth 2 value)))
- (setq value (calc-normalize value))
- (let ((calc-full-trail-vectors nil))
- (calc-record value (concat "<" (calc-var-name var))))
- (calc-push value)))))
-
-(defun calc-store-quick ()
- (interactive)
- (calc-store (intern (format "var-q%c" last-command-char))))
-
-(defun calc-store-into-quick ()
- (interactive)
- (calc-store-into (intern (format "var-q%c" last-command-char))))
-
-(defun calc-recall-quick ()
- (interactive)
- (calc-recall (intern (format "var-q%c" last-command-char))))
-
-(defun calc-copy-variable (&optional var1 var2)
- (interactive)
- (calc-wrapper
- (or var1 (setq var1 (calc-read-var-name "Copy variable: ")))
- (if var1
- (let ((value (calc-var-value var1)))
- (or value
- (error "No such variable: \"%s\"" (calc-var-name var)))
- (or var2 (setq var2 (calc-read-var-name
- (format "Copy variable: %s, to: " var1))))
- (if var2
- (calc-store-value var2 value ""))))))
-
-(defvar calc-last-edited-variable nil)
-(defun calc-edit-variable (&optional var)
- (interactive)
- (calc-wrapper
- (or var (setq var (calc-read-var-name
- (if calc-last-edited-variable
- (format "Edit: (default %s) "
- (calc-var-name calc-last-edited-variable))
- "Edit: "))))
- (or var (setq var calc-last-edited-variable))
- (if var
- (let* ((value (calc-var-value var)))
- (if (eq (car-safe value) 'special-const)
- (error "%s is a special constant" var))
- (setq calc-last-edited-variable var)
- (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var))
- t
- (concat "Editing " (calc-var-name var)))
- (and value
- (insert (math-format-nice-expr value (frame-width)) "\n")))))
- (calc-show-edit-buffer))
-
-(defun calc-edit-Decls ()
- (interactive)
- (calc-edit-variable 'var-Decls))
-
-(defun calc-edit-EvalRules ()
- (interactive)
- (calc-edit-variable 'var-EvalRules))
-
-(defun calc-edit-FitRules ()
- (interactive)
- (calc-edit-variable 'var-FitRules))
-
-(defun calc-edit-GenCount ()
- (interactive)
- (calc-edit-variable 'var-GenCount))
-
-(defun calc-edit-Holidays ()
- (interactive)
- (calc-edit-variable 'var-Holidays))
-
-(defun calc-edit-IntegLimit ()
- (interactive)
- (calc-edit-variable 'var-IntegLimit))
-
-(defun calc-edit-LineStyles ()
- (interactive)
- (calc-edit-variable 'var-LineStyles))
-
-(defun calc-edit-PointStyles ()
- (interactive)
- (calc-edit-variable 'var-PointStyles))
-
-(defun calc-edit-PlotRejects ()
- (interactive)
- (calc-edit-variable 'var-PlotRejects))
-
-(defun calc-edit-AlgSimpRules ()
- (interactive)
- (calc-edit-variable 'var-AlgSimpRules))
-
-(defun calc-edit-TimeZone ()
- (interactive)
- (calc-edit-variable 'var-TimeZone))
-
-(defun calc-edit-Units ()
- (interactive)
- (calc-edit-variable 'var-Units))
-
-(defun calc-edit-ExtSimpRules ()
- (interactive)
- (calc-edit-variable 'var-ExtSimpRules))
-
-(defun calc-declare-variable (&optional var)
- (interactive)
- (calc-wrapper
- (or var (setq var (calc-read-var-name "Declare: " 0)))
- (or var (setq var 'var-All))
- (let* (dp decl def row rp)
- (or (and (calc-var-value 'var-Decls)
- (eq (car-safe var-Decls) 'vec))
- (setq var-Decls (list 'vec)))
- (setq dp var-Decls)
- (while (and (setq dp (cdr dp))
- (or (not (eq (car-safe (car dp)) 'vec))
- (/= (length (car dp)) 3)
- (progn
- (setq row (nth 1 (car dp))
- rp row)
- (if (eq (car-safe row) 'vec)
- (progn
- (while
- (and (setq rp (cdr rp))
- (or (not (eq (car-safe (car rp)) 'var))
- (not (eq (nth 2 (car rp)) var)))))
- (setq rp (car rp)))
- (if (or (not (eq (car-safe row) 'var))
- (not (eq (nth 2 row) var)))
- (setq rp nil)))
- (not rp)))))
- (calc-unread-command ?\C-a)
- (setq decl (read-string (format "Declare: %s to be: " var)
- (and rp
- (math-format-flat-expr (nth 2 (car dp)) 0))))
- (setq decl (and (string-match "[^ \t]" decl)
- (math-read-exprs decl)))
- (if (eq (car-safe decl) 'error)
- (error "Bad format in declaration: %s" (nth 2 decl)))
- (if (cdr decl)
- (setq decl (cons 'vec decl))
- (setq decl (car decl)))
- (and (eq (car-safe decl) 'vec)
- (= (length decl) 2)
- (setq decl (nth 1 decl)))
- (calc-record (append '(vec) (list (math-build-var-name var))
- (and decl (list decl)))
- "decl")
- (setq var-Decls (copy-sequence var-Decls))
- (if (eq (car-safe row) 'vec)
- (progn
- (setcdr row (delq rp (cdr row)))
- (or (cdr row)
- (setq var-Decls (delq (car dp) var-Decls))))
- (setq var-Decls (delq (car dp) var-Decls)))
- (if decl
- (progn
- (setq dp (and (not (eq var 'var-All)) var-Decls))
- (while (and (setq dp (cdr dp))
- (or (not (eq (car-safe (car dp)) 'vec))
- (/= (length (car dp)) 3)
- (not (equal (nth 2 (car dp)) decl)))))
- (if dp
- (setcar (cdr (car dp))
- (append (if (eq (car-safe (nth 1 (car dp))) 'vec)
- (nth 1 (car dp))
- (list 'vec (nth 1 (car dp))))
- (list (math-build-var-name var))))
- (setq var-Decls (append var-Decls
- (list (list 'vec
- (math-build-var-name var)
- decl)))))))
- (calc-refresh-evaltos 'var-Decls))))
-
-(defvar calc-dont-insert-variables '(var-FitRules var-FactorRules
- var-CommuteRules var-JumpRules
- var-DistribRules var-MergeRules
- var-NegateRules var-InvertRules
- var-IntegAfterRules
- var-TimeZone var-PlotRejects
- var-PlotData1 var-PlotData2
- var-PlotData3 var-PlotData4
- var-PlotData5 var-PlotData6
- var-DUMMY))
-
-(defun calc-permanent-variable (&optional var)
- (interactive)
- (calc-wrapper
- (or var (setq var (calc-read-var-name "Save variable (default=all): ")))
- (let (pos)
- (and var (or (and (boundp var) (symbol-value var))
- (error "No such variable")))
- (set-buffer (find-file-noselect (substitute-in-file-name
- calc-settings-file)))
- (if var
- (calc-insert-permanent-variable var)
- (mapatoms (function
- (lambda (x)
- (and (string-match "\\`var-" (symbol-name x))
- (not (memq x calc-dont-insert-variables))
- (calc-var-value x)
- (not (eq (car-safe (symbol-value x)) 'special-const))
- (calc-insert-permanent-variable x))))))
- (save-buffer))))
-
-
-
-(defun calc-insert-permanent-variable (var)
- (goto-char (point-min))
- (if (search-forward (concat "(setq " (symbol-name var) " '") nil t)
- (progn
- (setq pos (point-marker))
- (forward-line -1)
- (if (looking-at ";;; Variable .* stored by Calc on ")
- (progn
- (delete-region (match-end 0) (progn (end-of-line) (point)))
- (insert (current-time-string))))
- (goto-char (- pos 8 (length (symbol-name var))))
- (forward-sexp 1)
- (backward-char 1)
- (delete-region pos (point)))
- (goto-char (point-max))
- (insert "\n;;; Variable \""
- (symbol-name var)
- "\" stored by Calc on "
- (current-time-string)
- "\n(setq "
- (symbol-name var)
- " ')\n")
- (backward-char 2))
- (insert (prin1-to-string (calc-var-value var)))
- (forward-line 1))
-
-(defun calc-insert-variables (buf)
- (interactive "bBuffer in which to save variable values: ")
- (save-excursion
- (set-buffer buf)
- (mapatoms (function
- (lambda (x)
- (and (string-match "\\`var-" (symbol-name x))
- (not (memq x calc-dont-insert-variables))
- (calc-var-value x)
- (not (eq (car-safe (symbol-value x)) 'special-const))
- (or (not (eq x 'var-Decls))
- (not (equal var-Decls '(vec))))
- (or (not (eq x 'var-Holidays))
- (not (equal var-Holidays '(vec (var sat var-sat)
- (var sun var-sun)))))
- (insert "(setq "
- (symbol-name x)
- " "
- (prin1-to-string
- (let ((calc-language
- (if (memq calc-language '(nil big))
- 'flat
- calc-language)))
- (math-format-value (symbol-value x) 100000)))
- ")\n")))))))
-
-(defun calc-assign (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op ":=" 'calcFunc-assign arg)))
-
-(defun calc-evalto (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-unary-op "=>" 'calcFunc-evalto arg)))
-
-(defun calc-subscript (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "sub" 'calcFunc-subscr arg)))
-
-;;; calc-store.el ends here
+++ /dev/null
-;;; calc-stuff.el --- miscellaneous functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-stuff () nil)
-
-
-(defun calc-num-prefix (n)
- "Use the number at the top of stack as the numeric prefix for the next command.
-With a prefix, push that prefix as a number onto the stack."
- (interactive "P")
- (calc-wrapper
- (if n
- (calc-enter-result 0 "" (prefix-numeric-value n))
- (let ((num (calc-top 1)))
- (if (math-messy-integerp num)
- (setq num (math-trunc num)))
- (or (integerp num)
- (error "Argument must be a small integer"))
- (calc-pop-stack 1)
- (setq prefix-arg num)
- (message "%d-" num))))) ; a (lame) simulation of the real thing...
-
-
-(defun calc-more-recursion-depth (n)
- (interactive "P")
- (calc-wrapper
- (if (calc-is-inverse)
- (calc-less-recursion-depth n)
- (let ((n (if n (prefix-numeric-value n) 2)))
- (if (> n 1)
- (setq max-specpdl-size (* max-specpdl-size n)
- max-lisp-eval-depth (* max-lisp-eval-depth n))))
- (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))))
-
-(defun calc-less-recursion-depth (n)
- (interactive "P")
- (let ((n (if n (prefix-numeric-value n) 2)))
- (if (> n 1)
- (setq max-specpdl-size
- (max (/ max-specpdl-size n) 600)
- max-lisp-eval-depth
- (max (/ max-lisp-eval-depth n) 200))))
- (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))
-
-
-(defvar calc-which-why nil)
-(defvar calc-last-why-command nil)
-(defun calc-explain-why (why &optional more)
- (if (eq (car why) '*)
- (setq why (cdr why)))
- (let* ((pred (car why))
- (arg (nth 1 why))
- (msg (cond ((not pred) "Wrong type of argument")
- ((stringp pred) pred)
- ((eq pred 'integerp) "Integer expected")
- ((eq pred 'natnump)
- (if (and arg (Math-objvecp arg) (not (Math-integerp arg)))
- "Integer expected"
- "Nonnegative integer expected"))
- ((eq pred 'posintp)
- (if (and arg (Math-objvecp arg) (not (Math-integerp arg)))
- "Integer expected"
- "Positive integer expected"))
- ((eq pred 'fixnump)
- (if (and arg (Math-integerp arg))
- "Small integer expected"
- "Integer expected"))
- ((eq pred 'fixnatnump)
- (if (and arg (Math-natnump arg))
- "Small integer expected"
- (if (and arg (Math-objvecp arg)
- (not (Math-integerp arg)))
- "Integer expected"
- "Nonnegative integer expected")))
- ((eq pred 'fixposintp)
- (if (and arg (Math-integerp arg) (Math-posp arg))
- "Small integer expected"
- (if (and arg (Math-objvecp arg)
- (not (Math-integerp arg)))
- "Integer expected"
- "Positive integer expected")))
- ((eq pred 'posp) "Positive number expected")
- ((eq pred 'negp) "Negative number expected")
- ((eq pred 'nonzerop) "Nonzero number expected")
- ((eq pred 'realp) "Real number expected")
- ((eq pred 'anglep) "Real number expected")
- ((eq pred 'hmsp) "HMS form expected")
- ((eq pred 'datep)
- (if (and arg (Math-objectp arg)
- (not (Math-realp arg)))
- "Real number or date form expected"
- "Date form expected"))
- ((eq pred 'numberp) "Number expected")
- ((eq pred 'scalarp) "Number expected")
- ((eq pred 'vectorp) "Vector or matrix expected")
- ((eq pred 'numvecp) "Number or vector expected")
- ((eq pred 'matrixp) "Matrix expected")
- ((eq pred 'square-matrixp)
- (if (and arg (math-matrixp arg))
- "Square matrix expected"
- "Matrix expected"))
- ((eq pred 'objectp) "Number expected")
- ((eq pred 'constp) "Constant expected")
- ((eq pred 'range) "Argument out of range")
- (t (format "%s expected" pred))))
- (punc ": ")
- (calc-can-abbrev-vectors t))
- (while (setq why (cdr why))
- (and (car why)
- (setq msg (concat msg punc (if (stringp (car why))
- (car why)
- (math-format-flat-expr (car why) 0)))
- punc ", ")))
- (message "%s%s" msg (if more " [w=more]" ""))))
-
-(defun calc-why ()
- (interactive)
- (if (not (eq this-command last-command))
- (if (eq last-command calc-last-why-command)
- (setq calc-which-why (cdr calc-why))
- (setq calc-which-why calc-why)))
- (if calc-which-why
- (progn
- (calc-explain-why (car calc-which-why) (cdr calc-which-why))
- (setq calc-which-why (cdr calc-which-why)))
- (if calc-why
- (progn
- (message "(No further explanations available)")
- (setq calc-which-why calc-why))
- (message "No explanations available"))))
-
-
-(defun calc-version ()
- (interactive)
- (message "Calc %s" calc-version))
-
-
-(defun calc-flush-caches (&optional inhibit-msg)
- (interactive "P")
- (calc-wrapper
- (setq math-lud-cache nil
- math-log2-cache nil
- math-radix-digits-cache nil
- math-radix-float-cache-tag nil
- math-random-cache nil
- math-max-digits-cache nil
- math-checked-rewrites nil
- math-integral-cache nil
- math-units-table nil
- math-decls-cache-tag nil
- math-eval-rules-cache-tag t
- math-graph-var-cache nil
- math-graph-data-cache nil
- math-format-date-cache nil
- math-holidays-cache-tag t)
- (mapcar (function (lambda (x) (set x -100))) math-cache-list)
- (unless inhibit-msg
- (message "All internal calculator caches have been reset"))))
-
-
-;;; Conversions.
-
-(defun calc-clean (n)
- (interactive "P")
- (calc-slow-wrapper
- (calc-with-default-simplification
- (let ((func (if (calc-is-hyperbolic) 'calcFunc-clean 'calcFunc-pclean)))
- (calc-enter-result 1 "cln"
- (if n
- (let ((n (prefix-numeric-value n)))
- (list func
- (calc-top-n 1)
- (if (<= n 0)
- (+ n calc-internal-prec)
- n)))
- (list func (calc-top-n 1))))))))
-
-(defun calc-clean-num (num)
- (interactive "P")
- (calc-clean (- (if num
- (prefix-numeric-value num)
- (if (and (>= last-command-char ?0)
- (<= last-command-char ?9))
- (- last-command-char ?0)
- (error "Number required"))))))
-
-
-(defvar math-chopping-small nil)
-(defun calcFunc-clean (a &optional prec) ; [X X S] [Public]
- (if prec
- (cond ((Math-messy-integerp prec)
- (calcFunc-clean a (math-trunc prec)))
- ((or (not (integerp prec))
- (< prec 3))
- (calc-record-why "*Precision must be an integer 3 or above")
- (list 'calcFunc-clean a prec))
- ((not (Math-objvecp a))
- (list 'calcFunc-clean a prec))
- (t (let ((calc-internal-prec prec)
- (math-chopping-small t))
- (calcFunc-clean (math-normalize a)))))
- (cond ((eq (car-safe a) 'polar)
- (let ((theta (math-mod (nth 2 a)
- (if (eq calc-angle-mode 'rad)
- (math-two-pi)
- 360))))
- (math-neg
- (math-neg
- (math-normalize
- (list 'polar
- (calcFunc-clean (nth 1 a))
- (calcFunc-clean theta)))))))
- ((memq (car-safe a) '(vec date hms))
- (cons (car a) (mapcar 'calcFunc-clean (cdr a))))
- ((memq (car-safe a) '(cplx mod sdev intv))
- (math-normalize (cons (car a) (mapcar 'calcFunc-clean (cdr a)))))
- ((eq (car-safe a) 'float)
- (if math-chopping-small
- (if (or (> (nth 2 a) (- calc-internal-prec))
- (Math-lessp (- calc-internal-prec) (calcFunc-xpon a)))
- (if (and (math-num-integerp a)
- (math-lessp (calcFunc-xpon a) calc-internal-prec))
- (math-trunc a)
- a)
- 0)
- a))
- ((Math-objectp a) a)
- ((math-infinitep a) a)
- (t (list 'calcFunc-clean a)))))
-
-(defun calcFunc-pclean (a &optional prec)
- (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))
- a))
-
-(defun calcFunc-pfloat (a)
- (math-map-over-constants 'math-float a))
-
-(defun calcFunc-pfrac (a &optional tol)
- (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol)))
- a))
-
-(defun math-map-over-constants (func expr)
- (math-map-over-constants-rec expr))
-
-(defun math-map-over-constants-rec (expr)
- (cond ((or (Math-primp expr)
- (memq (car expr) '(intv sdev)))
- (or (and (Math-objectp expr)
- (funcall func expr))
- expr))
- ((and (memq (car expr) '(^ calcFunc-subscr))
- (eq func 'math-float)
- (= (length expr) 3)
- (Math-integerp (nth 2 expr)))
- (list (car expr)
- (math-map-over-constants-rec (nth 1 expr))
- (nth 2 expr)))
- (t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr))))))
-
-;;; calc-stuff.el ends here
+++ /dev/null
-;;; calc-trail.el --- functions for manipulating the Calc "trail"
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-trail () nil)
-
-
-;;; Trail commands.
-
-(defun calc-trail-in ()
- (interactive)
- (let ((win (get-buffer-window (calc-trail-display t))))
- (and win (select-window win))))
-
-(defun calc-trail-out ()
- (interactive)
- (calc-select-buffer)
- (let ((win (get-buffer-window (current-buffer))))
- (if win
- (progn
- (select-window win)
- (calc-align-stack-window))
- (calc))))
-
-(defun calc-trail-next (n)
- (interactive "p")
- (calc-with-trail-buffer
- (forward-line n)
- (calc-trail-here)))
-
-(defun calc-trail-previous (n)
- (interactive "p")
- (calc-with-trail-buffer
- (forward-line (- n))
- (calc-trail-here)))
-
-(defun calc-trail-first (n)
- (interactive "p")
- (calc-with-trail-buffer
- (goto-char (point-min))
- (forward-line n)
- (calc-trail-here)))
-
-(defun calc-trail-last (n)
- (interactive "p")
- (calc-with-trail-buffer
- (goto-char (point-max))
- (forward-line (- n))
- (calc-trail-here)))
-
-(defun calc-trail-scroll-left (n)
- (interactive "P")
- (let ((curwin (selected-window)))
- (calc-with-trail-buffer
- (unwind-protect
- (progn
- (select-window (get-buffer-window (current-buffer)))
- (calc-scroll-left n))
- (select-window curwin)))))
-
-(defun calc-trail-scroll-right (n)
- (interactive "P")
- (let ((curwin (selected-window)))
- (calc-with-trail-buffer
- (unwind-protect
- (progn
- (select-window (get-buffer-window (current-buffer)))
- (calc-scroll-right n))
- (select-window curwin)))))
-
-(defun calc-trail-forward (n)
- (interactive "p")
- (calc-with-trail-buffer
- (forward-line (* n (1- (window-height))))
- (calc-trail-here)))
-
-(defun calc-trail-backward (n)
- (interactive "p")
- (calc-with-trail-buffer
- (forward-line (- (* n (1- (window-height)))))
- (calc-trail-here)))
-
-(defun calc-trail-isearch-forward ()
- (interactive)
- (calc-with-trail-buffer
- (save-window-excursion
- (select-window (get-buffer-window (current-buffer)))
- (let ((search-exit-char ?\r))
- (isearch-forward)))
- (calc-trail-here)))
-
-(defun calc-trail-isearch-backward ()
- (interactive)
- (calc-with-trail-buffer
- (save-window-excursion
- (select-window (get-buffer-window (current-buffer)))
- (let ((search-exit-char ?\r))
- (isearch-backward)))
- (calc-trail-here)))
-
-(defun calc-trail-yank (arg)
- (interactive "P")
- (calc-wrapper
- (or arg (calc-set-command-flag 'hold-trail))
- (calc-enter-result 0 "yank"
- (calc-with-trail-buffer
- (if arg
- (forward-line (- (prefix-numeric-value arg))))
- (if (or (looking-at "Emacs Calc")
- (looking-at "----")
- (looking-at " ? ? ?[^ \n]* *$")
- (looking-at "..?.?$"))
- (error "Can't yank that line"))
- (if (looking-at ".*, \\.\\.\\., ")
- (error "Can't yank (vector was abbreviated)"))
- (forward-char 4)
- (search-forward " ")
- (let* ((next (save-excursion (forward-line 1) (point)))
- (str (buffer-substring (point) (1- next)))
- (val (save-excursion
- (set-buffer save-buf)
- (math-read-plain-expr str))))
- (if (eq (car-safe val) 'error)
- (error "Can't yank that line: %s" (nth 2 val))
- val))))))
-
-(defun calc-trail-marker (str)
- (interactive "sText to insert in trail: ")
- (calc-with-trail-buffer
- (forward-line 1)
- (let ((buffer-read-only nil))
- (insert "---- " str "\n"))
- (forward-line -1)
- (calc-trail-here)))
-
-(defun calc-trail-kill (n)
- (interactive "p")
- (calc-with-trail-buffer
- (let ((buffer-read-only nil))
- (save-restriction
- (narrow-to-region ; don't delete "Emacs Trail" header
- (save-excursion
- (goto-char (point-min))
- (forward-line 1)
- (point))
- (point-max))
- (kill-line n)))
- (calc-trail-here)))
-
-;;; calc-trail.el ends here
+++ /dev/null
-;;; calc-undo.el --- undo functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-undo () nil)
-
-
-;;; Undo.
-
-(defun calc-undo (n)
- (interactive "p")
- (when calc-executing-macro
- (error "Use C-x e, not X, to run a keyboard macro that uses Undo"))
- (if (<= n 0)
- (if (< n 0)
- (calc-redo (- n))
- (calc-last-args 1))
- (calc-wrapper
- (when (null (nthcdr (1- n) calc-undo-list))
- (error "No further undo information available"))
- (setq calc-undo-list
- (prog1
- (nthcdr n calc-undo-list)
- (let ((saved-stack-top calc-stack-top))
- (let ((calc-stack-top 0))
- (calc-handle-undos calc-undo-list n))
- (setq calc-stack-top saved-stack-top))))
- (message "Undo!"))))
-
-(defun calc-handle-undos (cl n)
- (when (> n 0)
- (let ((old-redo calc-redo-list))
- (setq calc-undo-list nil)
- (calc-handle-undo (car cl))
- (setq calc-redo-list (append calc-undo-list old-redo)))
- (calc-handle-undos (cdr cl) (1- n))))
-
-(defun calc-handle-undo (list)
- (when list
- (let ((action (car list)))
- (cond
- ((eq (car action) 'push)
- (calc-pop-stack 1 (nth 1 action) t))
- ((eq (car action) 'pop)
- (calc-push-list (nth 2 action) (nth 1 action)))
- ((eq (car action) 'set)
- (calc-record-undo (list 'set (nth 1 action)
- (symbol-value (nth 1 action))))
- (set (nth 1 action) (nth 2 action)))
- ((eq (car action) 'store)
- (let ((v (intern (nth 1 action))))
- (calc-record-undo (list 'store (nth 1 action)
- (and (boundp v) (symbol-value v))))
- (if (y-or-n-p (format "Un-store variable %s? " (nth 1 action)))
- (progn
- (if (nth 2 action)
- (set v (nth 2 action))
- (makunbound v))
- (calc-refresh-evaltos v)))))
- ((eq (car action) 'eval)
- (calc-record-undo (append (list 'eval (nth 2 action) (nth 1 action))
- (cdr (cdr (cdr action)))))
- (apply (nth 1 action) (cdr (cdr (cdr action))))))
- (calc-handle-undo (cdr list)))))
-
-(defun calc-redo (n)
- (interactive "p")
- (when calc-executing-macro
- (error "Use C-x e, not X, to run a keyboard macro that uses Redo"))
- (if (<= n 0)
- (calc-undo (- n))
- (calc-wrapper
- (when (null (nthcdr (1- n) calc-redo-list))
- (error "Unable to redo"))
- (setq calc-redo-list
- (prog1
- (nthcdr n calc-redo-list)
- (let ((saved-stack-top calc-stack-top))
- (let ((calc-stack-top 0))
- (calc-handle-redos calc-redo-list n))
- (setq calc-stack-top saved-stack-top))))
- (message "Redo!"))))
-
-(defun calc-handle-redos (cl n)
- (when (> n 0)
- (let ((old-undo calc-undo-list))
- (setq calc-undo-list nil)
- (calc-handle-undo (car cl))
- (setq calc-undo-list (append calc-undo-list old-undo)))
- (calc-handle-redos (cdr cl) (1- n))))
-
-(defun calc-last-args (n)
- (interactive "p")
- (when calc-executing-macro
- (error "Use C-x e, not X, to run a keyboard macro that uses last-args"))
- (calc-wrapper
- (let ((urec (calc-find-last-x calc-undo-list n)))
- (if urec
- (calc-handle-last-x urec)
- (error "Not enough undo information available")))))
-
-(defun calc-handle-last-x (list)
- (when list
- (let ((action (car list)))
- (if (eq (car action) 'pop)
- (calc-pop-push-record-list 0 "larg"
- (delq 'top-of-stack (nth 2 action))))
- (calc-handle-last-x (cdr list)))))
-
-(defun calc-find-last-x (ul n)
- (when ul
- (if (calc-undo-does-pushes (car ul))
- (if (<= n 1)
- (car ul)
- (calc-find-last-x (cdr ul) (1- n)))
- (calc-find-last-x (cdr ul) n))))
-
-(defun calc-undo-does-pushes (list)
- (and list
- (or (eq (car (car list)) 'pop)
- (calc-undo-does-pushes (cdr list)))))
-
-;;; calc-undo.el ends here
+++ /dev/null
-;;; calc-units.el --- unit conversion functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-units () nil)
-
-;;; Units operations.
-
-;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch)
-;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov)
-;;; Updated April 2002 by Jochen Küpper
-
-;;; for CODATA 1998 see one of
-;;; - Journal of Physical and Chemical Reference Data, 28(6), 1713-1852, 1999.
-;;; - Reviews of Modern Physics, 72(2), 351-495, 2000.
-;;; - http://physics.nist.gov/cuu/Constants/index.html
-
-(defvar math-standard-units
- '( ;; Length
- ( m nil "*Meter" )
- ( in "2.54 cm" "Inch" )
- ( ft "12 in" "Foot" )
- ( yd "3 ft" "Yard" )
- ( mi "5280 ft" "Mile" )
- ( au "149597870691 m" "Astronomical Unit" ) ;; NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html)
- ( lyr "9460536207068016 m" "Light Year" )
- ( pc "206264.80625 au" "Parsec" )
- ( nmi "1852 m" "Nautical Mile" )
- ( fath "6 ft" "Fathom" )
- ( u "1 um" "Micron" )
- ( mil "in/1000" "Mil" )
- ( point "in/72" "Point (1/72 inch)" )
- ( tpt "in/72.27" "Point (TeX conventions)" )
- ( Ang "1e-10 m" "Angstrom" )
- ( mfi "mi+ft+in" "Miles + feet + inches" )
-
- ;; Area
- ( hect "10000 m^2" "*Hectare" )
- ( acre "mi^2 / 640" "Acre" )
- ( b "1e-28 m^2" "Barn" )
-
- ;; Volume
- ( l "1e-3 m^3" "*Liter" )
- ( L "1e-3 m^3" "Liter" )
- ( gal "4 qt" "US Gallon" )
- ( qt "2 pt" "Quart" )
- ( pt "2 cup" "Pint" )
- ( cup "8 ozfl" "Cup" )
- ( ozfl "2 tbsp" "Fluid Ounce" )
- ( floz "2 tbsp" "Fluid Ounce" )
- ( tbsp "3 tsp" "Tablespoon" )
- ( tsp "4.92892159375 ml" "Teaspoon" )
- ( vol "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" )
- ( galC "4.54609 l" "Canadian Gallon" )
- ( galUK "4.546092 l" "UK Gallon" )
-
- ;; Time
- ( s nil "*Second" )
- ( sec "s" "Second" )
- ( min "60 s" "Minute" )
- ( hr "60 min" "Hour" )
- ( day "24 hr" "Day" )
- ( wk "7 day" "Week" )
- ( hms "wk+day+hr+min+s" "Hours, minutes, seconds" )
- ( yr "365.25 day" "Year" )
- ( Hz "1/s" "Hertz" )
-
- ;; Speed
- ( mph "mi/hr" "*Miles per hour" )
- ( kph "km/hr" "Kilometers per hour" )
- ( knot "nmi/hr" "Knot" )
- ( c "2.99792458e8 m/s" "Speed of light" )
-
- ;; Acceleration
- ( ga "9.80665 m/s^2" "*\"g\" acceleration" )
-
- ;; Mass
- ( g nil "*Gram" )
- ( lb "16 oz" "Pound (mass)" )
- ( oz "28.349523125 g" "Ounce (mass)" )
- ( ton "2000 lb" "Ton" )
- ( tpo "ton+lb+oz" "Tons + pounds + ounces (mass)" )
- ( t "1000 kg" "Metric ton" )
- ( tonUK "1016.0469088 kg" "UK ton" )
- ( lbt "12 ozt" "Troy pound" )
- ( ozt "31.103475 g" "Troy ounce" )
- ( ct ".2 g" "Carat" )
- ( amu "1.66053873e-27 kg" "Unified atomic mass" ) ;; CODATA 1998
-
- ;; Force
- ( N "m kg/s^2" "*Newton" )
- ( dyn "1e-5 N" "Dyne" )
- ( gf "ga g" "Gram (force)" )
- ( lbf "4.44822161526 N" "Pound (force)" )
- ( kip "1000 lbf" "Kilopound (force)" )
- ( pdl "0.138255 N" "Poundal" )
-
- ;; Energy
- ( J "N m" "*Joule" )
- ( erg "1e-7 J" "Erg" )
- ( cal "4.1868 J" "International Table Calorie" )
- ( Btu "1055.05585262 J" "International Table Btu" )
- ( eV "ech V" "Electron volt" )
- ( ev "eV" "Electron volt" )
- ( therm "105506000 J" "EEC therm" )
- ( invcm "h c/cm" "Energy in inverse centimeters" )
- ( Kayser "invcm" "Kayser (inverse centimeter energy)" )
- ( men "100/invcm" "Inverse energy in meters" )
- ( Hzen "h Hz" "Energy in Hertz")
- ( Ken "k K" "Energy in Kelvins")
- ( Wh "W h" "Watt hour")
- ( Ws "W s" "Watt second")
-
- ;; Power
- ( W "J/s" "*Watt" )
- ( hp "745.7 W" "Horsepower" )
-
- ;; Temperature
- ( K nil "*Degree Kelvin" K )
- ( dK "K" "Degree Kelvin" K )
- ( degK "K" "Degree Kelvin" K )
- ( dC "K" "Degree Celsius" C )
- ( degC "K" "Degree Celsius" C )
- ( dF "(5/9) K" "Degree Fahrenheit" F )
- ( degF "(5/9) K" "Degree Fahrenheit" F )
-
- ;; Pressure
- ( Pa "N/m^2" "*Pascal" )
- ( bar "1e5 Pa" "Bar" )
- ( atm "101325 Pa" "Standard atmosphere" )
- ( torr " 1.333224e2 Pa" "Torr" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
- ( mHg "1000 torr" "Meter of mercury" )
- ( inHg "25.4 mmHg" "Inch of mercury" )
- ( inH2O "2.490889e2 Pa" "Inch of water" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
- ( psi "6894.75729317 Pa" "Pound per square inch" )
-
- ;; Viscosity
- ( P "0.1 Pa s" "*Poise" )
- ( St "1e-4 m^2/s" "Stokes" )
-
- ;; Electromagnetism
- ( A nil "*Ampere" )
- ( C "A s" "Coulomb" )
- ( Fdy "ech Nav" "Faraday" )
- ( e "1.602176462e-19 C" "Elementary charge" ) ;; CODATA 1998
- ( ech "1.602176462e-19 C" "Elementary charge" ) ;; CODATA 1998
- ( V "W/A" "Volt" )
- ( ohm "V/A" "Ohm" )
- ( mho "A/V" "Mho" )
- ( S "A/V" "Siemens" )
- ( F "C/V" "Farad" )
- ( H "Wb/A" "Henry" )
- ( T "Wb/m^2" "Tesla" )
- ( G "1e-4 T" "Gauss" )
- ( Wb "V s" "Weber" )
-
- ;; Luminous intensity
- ( cd nil "*Candela" )
- ( sb "1e4 cd/m^2" "Stilb" )
- ( lm "cd sr" "Lumen" )
- ( lx "lm/m^2" "Lux" )
- ( ph "1e4 lx" "Phot" )
- ( fc "10.76391 lx" "Footcandle" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
- ( lam "1e4 lm/m^2" "Lambert" )
- ( flam "3.426259 cd/m^2" "Footlambert" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
-
- ;; Radioactivity
- ( Bq "1/s" "*Becquerel" )
- ( Ci "3.7e10 Bq" "Curie" )
- ( Gy "J/kg" "Gray" )
- ( Sv "Gy" "Sievert" )
- ( R "2.58e-4 C/kg" "Roentgen" )
- ( rd ".01 Gy" "Rad" )
- ( rem "rd" "Rem" )
-
- ;; Amount of substance
- ( mol nil "*Mole" )
-
- ;; Plane angle
- ( rad nil "*Radian" )
- ( circ "2 pi rad" "Full circle" )
- ( rev "circ" "Full revolution" )
- ( deg "circ/360" "Degree" )
- ( arcmin "deg/60" "Arc minute" )
- ( arcsec "arcmin/60" "Arc second" )
- ( grad "circ/400" "Grade" )
- ( rpm "rev/min" "Revolutions per minute" )
-
- ;; Solid angle
- ( sr nil "*Steradian" )
-
- ;; Other physical quantities (CODATA 1998)
- ( h "6.62606876e-34 J s" "*Planck's constant" )
- ( hbar "h / 2 pi" "Planck's constant" )
- ( mu0 "4 pi 1e-7 H/m" "Permeability of vacuum" )
- ( Grav "6.673e-11 m^3/kg^1/s^2" "Gravitational constant" )
- ( Nav "6.02214199e23 / mol" "Avagadro's constant" )
- ( me "9.10938188e-31 kg" "Electron rest mass" )
- ( mp "1.67262158e-27 kg" "Proton rest mass" )
- ( mn "1.67492716e-27 kg" "Neutron rest mass" )
- ( mu "1.88353109e-28 kg" "Muon rest mass" )
- ( Ryd "10973731.568549 /m" "Rydberg's constant" )
- ( k "1.3806503e-23 J/K" "Boltzmann's constant" )
- ( fsc "7.297352533e-3" "Fine structure constant" )
- ( muB "927.400899e-26 J/T" "Bohr magneton" )
- ( muN "5.05078317e-27 J/T" "Nuclear magneton" )
- ( mue "-928.476362e-26 J/T" "Electron magnetic moment" )
- ( mup "1.410606633e-26 J/T" "Proton magnetic moment" )
- ( R0 "8.314472 J/mol/K" "Molar gas constant" )
- ( V0 "22.710981e-3 m^3/mol" "Standard volume of ideal gas" )))
-
-
-(defvar math-additional-units nil
- "*Additional units table for user-defined units.
-Must be formatted like math-standard-units.
-If this is changed, be sure to set math-units-table to nil to ensure
-that the combined units table will be rebuilt.")
-
-(defvar math-unit-prefixes
- '( ( ?E (float 1 18) "Exa" )
- ( ?P (float 1 15) "Peta" )
- ( ?T (float 1 12) "Tera" )
- ( ?G (float 1 9) "Giga" )
- ( ?M (float 1 6) "Mega" )
- ( ?k (float 1 3) "Kilo" )
- ( ?K (float 1 3) "Kilo" )
- ( ?h (float 1 2) "Hecto" )
- ( ?H (float 1 2) "Hecto" )
- ( ?D (float 1 1) "Deka" )
- ( 0 (float 1 0) nil )
- ( ?d (float 1 -1) "Deci" )
- ( ?c (float 1 -2) "Centi" )
- ( ?m (float 1 -3) "Milli" )
- ( ?u (float 1 -6) "Micro" )
- ( ?n (float 1 -9) "Nano" )
- ( ?p (float 1 -12) "Pico" )
- ( ?f (float 1 -15) "Femto" )
- ( ?a (float 1 -18) "Atto" )))
-
-(defvar math-standard-units-systems
- '( ( base nil )
- ( si ( ( g '(* (var kg var-kg) (float 1 -3)) ) ) )
- ( mks ( ( g '(* (var kg var-kg) (float 1 -3)) ) ) )
- ( cgs ( ( m '(* (var cm var-cm) 100 ) ) ) )))
-
-(defvar math-units-table nil
- "Internal units table derived from math-defined-units.
-Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
-
-(defvar math-units-table-buffer-valid nil)
-
-;;; Units commands.
-
-(defun calc-base-units ()
- (interactive)
- (calc-slow-wrapper
- (let ((calc-autorange-units nil))
- (calc-enter-result 1 "bsun" (math-simplify-units
- (math-to-standard-units (calc-top-n 1)
- nil))))))
-
-(defun calc-quick-units ()
- (interactive)
- (calc-slow-wrapper
- (let* ((num (- last-command-char ?0))
- (pos (if (= num 0) 10 num))
- (units (calc-var-value 'var-Units))
- (expr (calc-top-n 1)))
- (unless (and (>= num 0) (<= num 9))
- (errunless "Bad unit number"))
- (unless (math-vectorp units)
- (errunless "No \"quick units\" are defined"))
- (unless (< pos (length units))
- (errunless "Unit number %d not defined" pos))
- (if (math-units-in-expr-p expr nil)
- (calc-enter-result 1 (format "cun%d" num)
- (math-convert-units expr (nth pos units)))
- (calc-enter-result 1 (format "*un%d" num)
- (math-simplify-units
- (math-mul expr (nth pos units))))))))
-
-(defun calc-convert-units (&optional old-units new-units)
- (interactive)
- (calc-slow-wrapper
- (let ((expr (calc-top-n 1))
- (uoldname nil)
- unew)
- (unless (math-units-in-expr-p expr t)
- (let ((uold (or old-units
- (progn
- (setq uoldname (read-string "Old units: "))
- (if (equal uoldname "")
- (progn
- (setq uoldname "1")
- 1)
- (if (string-match "\\` */" uoldname)
- (setq uoldname (concat "1" uoldname)))
- (math-read-expr uoldname))))))
- (when (eq (car-safe uold) 'error)
- (error "Bad format in units expression: %s" (nth 1 uold)))
- (setq expr (math-mul expr uold))))
- (unless new-units
- (setq new-units (read-string (if uoldname
- (concat "Old units: "
- uoldname
- ", new units: ")
- "New units: "))))
- (when (string-match "\\` */" new-units)
- (setq new-units (concat "1" new-units)))
- (setq units (math-read-expr new-units))
- (when (eq (car-safe units) 'error)
- (error "Bad format in units expression: %s" (nth 2 units)))
- (let ((unew (math-units-in-expr-p units t))
- (std (and (eq (car-safe units) 'var)
- (assq (nth 1 units) math-standard-units-systems))))
- (if std
- (calc-enter-result 1 "cvun" (math-simplify-units
- (math-to-standard-units expr
- (nth 1 std))))
- (unless unew
- (error "No units specified"))
- (calc-enter-result 1 "cvun"
- (math-convert-units
- expr units
- (and uoldname (not (equal uoldname "1"))))))))))
-
-(defun calc-autorange-units (arg)
- (interactive "P")
- (calc-wrapper
- (calc-change-mode 'calc-autorange-units arg nil t)
- (message (if calc-autorange-units
- "Adjusting target unit prefix automatically"
- "Using target units exactly"))))
-
-(defun calc-convert-temperature (&optional old-units new-units)
- (interactive)
- (calc-slow-wrapper
- (let ((expr (calc-top-n 1))
- (uold nil)
- (uoldname nil)
- unew)
- (setq uold (or old-units
- (let ((units (math-single-units-in-expr-p expr)))
- (if units
- (if (consp units)
- (list 'var (car units)
- (intern (concat "var-"
- (symbol-name
- (car units)))))
- (error "Not a pure temperature expression"))
- (math-read-expr
- (setq uoldname (read-string
- "Old temperature units: ")))))))
- (when (eq (car-safe uold) 'error)
- (error "Bad format in units expression: %s" (nth 2 uold)))
- (or (math-units-in-expr-p expr nil)
- (setq expr (math-mul expr uold)))
- (setq unew (or new-units
- (math-read-expr
- (read-string (if uoldname
- (concat "Old temperature units: "
- uoldname
- ", new units: ")
- "New temperature units: ")))))
- (when (eq (car-safe unew) 'error)
- (error "Bad format in units expression: %s" (nth 2 unew)))
- (calc-enter-result 1 "cvtm" (math-simplify-units
- (math-convert-temperature expr uold unew
- uoldname))))))
-
-(defun calc-remove-units ()
- (interactive)
- (calc-slow-wrapper
- (calc-enter-result 1 "rmun" (math-simplify-units
- (math-remove-units (calc-top-n 1))))))
-
-(defun calc-extract-units ()
- (interactive)
- (calc-slow-wrapper
- (calc-enter-result 1 "rmun" (math-simplify-units
- (math-extract-units (calc-top-n 1))))))
-
-(defun calc-explain-units ()
- (interactive)
- (calc-wrapper
- (let ((num-units nil)
- (den-units nil))
- (calc-explain-units-rec (calc-top-n 1) 1)
- (and den-units (string-match "^[^(].* .*[^)]$" den-units)
- (setq den-units (concat "(" den-units ")")))
- (if num-units
- (if den-units
- (message "%s per %s" num-units den-units)
- (message "%s" num-units))
- (if den-units
- (message "1 per %s" den-units)
- (message "No units in expression"))))))
-
-(defun calc-explain-units-rec (expr pow)
- (let ((u (math-check-unit-name expr))
- pos)
- (if (and u (not (math-zerop pow)))
- (let ((name (or (nth 2 u) (symbol-name (car u)))))
- (if (eq (aref name 0) ?\*)
- (setq name (substring name 1)))
- (if (string-match "[^a-zA-Z0-9']" name)
- (if (string-match "^[a-zA-Z0-9' ()]*$" name)
- (while (setq pos (string-match "[ ()]" name))
- (setq name (concat (substring name 0 pos)
- (if (eq (aref name pos) 32) "-" "")
- (substring name (1+ pos)))))
- (setq name (concat "(" name ")"))))
- (or (eq (nth 1 expr) (car u))
- (setq name (concat (nth 2 (assq (aref (symbol-name
- (nth 1 expr)) 0)
- math-unit-prefixes))
- (if (and (string-match "[^a-zA-Z0-9']" name)
- (not (memq (car u) '(mHg gf))))
- (concat "-" name)
- (downcase name)))))
- (cond ((or (math-equal-int pow 1)
- (math-equal-int pow -1)))
- ((or (math-equal-int pow 2)
- (math-equal-int pow -2))
- (if (equal (nth 4 u) '((m . 1)))
- (setq name (concat "Square-" name))
- (setq name (concat name "-squared"))))
- ((or (math-equal-int pow 3)
- (math-equal-int pow -3))
- (if (equal (nth 4 u) '((m . 1)))
- (setq name (concat "Cubic-" name))
- (setq name (concat name "-cubed"))))
- (t
- (setq name (concat name "^"
- (math-format-number (math-abs pow))))))
- (if (math-posp pow)
- (setq num-units (if num-units
- (concat num-units " " name)
- name))
- (setq den-units (if den-units
- (concat den-units " " name)
- name))))
- (cond ((eq (car-safe expr) '*)
- (calc-explain-units-rec (nth 1 expr) pow)
- (calc-explain-units-rec (nth 2 expr) pow))
- ((eq (car-safe expr) '/)
- (calc-explain-units-rec (nth 1 expr) pow)
- (calc-explain-units-rec (nth 2 expr) (- pow)))
- ((memq (car-safe expr) '(neg + -))
- (calc-explain-units-rec (nth 1 expr) pow))
- ((and (eq (car-safe expr) '^)
- (math-realp (nth 2 expr)))
- (calc-explain-units-rec (nth 1 expr)
- (math-mul pow (nth 2 expr))))))))
-
-(defun calc-simplify-units ()
- (interactive)
- (calc-slow-wrapper
- (calc-with-default-simplification
- (calc-enter-result 1 "smun" (math-simplify-units (calc-top-n 1))))))
-
-(defun calc-view-units-table (n)
- (interactive "P")
- (and n (setq math-units-table-buffer-valid nil))
- (let ((win (get-buffer-window "*Units Table*")))
- (if (and win
- math-units-table
- math-units-table-buffer-valid)
- (progn
- (bury-buffer (window-buffer win))
- (let ((curwin (selected-window)))
- (select-window win)
- (switch-to-buffer nil)
- (select-window curwin)))
- (math-build-units-table-buffer nil))))
-
-(defun calc-enter-units-table (n)
- (interactive "P")
- (and n (setq math-units-table-buffer-valid nil))
- (math-build-units-table-buffer t)
- (message (substitute-command-keys "Type \\[calc] to return to the Calculator")))
-
-(defun calc-define-unit (uname desc)
- (interactive "SDefine unit name: \nsDescription: ")
- (calc-wrapper
- (let ((form (calc-top-n 1))
- (unit (assq uname math-additional-units)))
- (or unit
- (setq math-additional-units
- (cons (setq unit (list uname nil nil))
- math-additional-units)
- math-units-table nil))
- (setcar (cdr unit) (and (not (and (eq (car-safe form) 'var)
- (eq (nth 1 form) uname)))
- (not (math-equal-int form 1))
- (math-format-flat-expr form 0)))
- (setcar (cdr (cdr unit)) (and (not (equal desc ""))
- desc))))
- (calc-invalidate-units-table))
-
-(defun calc-undefine-unit (uname)
- (interactive "SUndefine unit name: ")
- (calc-wrapper
- (let ((unit (assq uname math-additional-units)))
- (or unit
- (if (assq uname math-standard-units)
- (error "\"%s\" is a predefined unit name" uname)
- (error "Unit name \"%s\" not found" uname)))
- (setq math-additional-units (delq unit math-additional-units)
- math-units-table nil)))
- (calc-invalidate-units-table))
-
-(defun calc-invalidate-units-table ()
- (setq math-units-table nil)
- (let ((buf (get-buffer "*Units Table*")))
- (and buf
- (save-excursion
- (set-buffer buf)
- (save-excursion
- (goto-char (point-min))
- (if (looking-at "Calculator Units Table")
- (let ((buffer-read-only nil))
- (insert "(Obsolete) "))))))))
-
-(defun calc-get-unit-definition (uname)
- (interactive "SGet definition for unit: ")
- (calc-wrapper
- (math-build-units-table)
- (let ((unit (assq uname math-units-table)))
- (or unit
- (error "Unit name \"%s\" not found" uname))
- (let ((msg (nth 2 unit)))
- (if (stringp msg)
- (if (string-match "^\\*" msg)
- (setq msg (substring msg 1)))
- (setq msg (symbol-name uname)))
- (if (nth 1 unit)
- (progn
- (calc-enter-result 0 "ugdf" (nth 1 unit))
- (message "Derived unit: %s" msg))
- (calc-enter-result 0 "ugdf" (list 'var uname
- (intern
- (concat "var-"
- (symbol-name uname)))))
- (message "Base unit: %s" msg))))))
-
-(defun calc-permanent-units ()
- (interactive)
- (calc-wrapper
- (let (pos)
- (set-buffer (find-file-noselect (substitute-in-file-name
- calc-settings-file)))
- (goto-char (point-min))
- (if (and (search-forward ";;; Custom units stored by Calc" nil t)
- (progn
- (beginning-of-line)
- (setq pos (point))
- (search-forward "\n;;; End of custom units" nil t)))
- (progn
- (beginning-of-line)
- (forward-line 1)
- (delete-region pos (point)))
- (goto-char (point-max))
- (insert "\n\n")
- (forward-char -1))
- (insert ";;; Custom units stored by Calc on " (current-time-string) "\n")
- (if math-additional-units
- (progn
- (insert "(setq math-additional-units '(\n")
- (let ((list math-additional-units))
- (while list
- (insert " (" (symbol-name (car (car list))) " "
- (if (nth 1 (car list))
- (if (stringp (nth 1 (car list)))
- (prin1-to-string (nth 1 (car list)))
- (prin1-to-string (math-format-flat-expr
- (nth 1 (car list)) 0)))
- "nil")
- " "
- (prin1-to-string (nth 2 (car list)))
- ")\n")
- (setq list (cdr list))))
- (insert "))\n"))
- (insert ";;; (no custom units defined)\n"))
- (insert ";;; End of custom units\n")
- (save-buffer))))
-
-
-
-(defun math-build-units-table ()
- (or math-units-table
- (let* ((combined-units (append math-additional-units
- math-standard-units))
- (unit-list (mapcar 'car combined-units))
- tab)
- (message "Building units table...")
- (setq math-units-table-buffer-valid nil)
- (setq tab (mapcar (function
- (lambda (x)
- (list (car x)
- (and (nth 1 x)
- (if (stringp (nth 1 x))
- (let ((exp (math-read-plain-expr
- (nth 1 x))))
- (if (eq (car-safe exp) 'error)
- (error "Format error in definition of %s in units table: %s"
- (car x) (nth 2 exp))
- exp))
- (nth 1 x)))
- (nth 2 x)
- (nth 3 x)
- (and (not (nth 1 x))
- (list (cons (car x) 1))))))
- combined-units))
- (let ((math-units-table tab))
- (mapcar 'math-find-base-units tab))
- (message "Building units table...done")
- (setq math-units-table tab))))
-
-(defun math-find-base-units (entry)
- (if (eq (nth 4 entry) 'boom)
- (error "Circular definition involving unit %s" (car entry)))
- (or (nth 4 entry)
- (let (base)
- (setcar (nthcdr 4 entry) 'boom)
- (math-find-base-units-rec (nth 1 entry) 1)
- '(or base
- (error "Dimensionless definition for unit %s" (car entry)))
- (while (eq (cdr (car base)) 0)
- (setq base (cdr base)))
- (let ((b base))
- (while (cdr b)
- (if (eq (cdr (car (cdr b))) 0)
- (setcdr b (cdr (cdr b)))
- (setq b (cdr b)))))
- (setq base (sort base 'math-compare-unit-names))
- (setcar (nthcdr 4 entry) base)
- base)))
-
-(defun math-compare-unit-names (a b)
- (memq (car b) (cdr (memq (car a) unit-list))))
-
-(defun math-find-base-units-rec (expr pow)
- (let ((u (math-check-unit-name expr)))
- (cond (u
- (let ((ulist (math-find-base-units u)))
- (while ulist
- (let ((p (* (cdr (car ulist)) pow))
- (old (assq (car (car ulist)) base)))
- (if old
- (setcdr old (+ (cdr old) p))
- (setq base (cons (cons (car (car ulist)) p) base))))
- (setq ulist (cdr ulist)))))
- ((math-scalarp expr))
- ((and (eq (car expr) '^)
- (integerp (nth 2 expr)))
- (math-find-base-units-rec (nth 1 expr) (* pow (nth 2 expr))))
- ((eq (car expr) '*)
- (math-find-base-units-rec (nth 1 expr) pow)
- (math-find-base-units-rec (nth 2 expr) pow))
- ((eq (car expr) '/)
- (math-find-base-units-rec (nth 1 expr) pow)
- (math-find-base-units-rec (nth 2 expr) (- pow)))
- ((eq (car expr) 'neg)
- (math-find-base-units-rec (nth 1 expr) pow))
- ((eq (car expr) '+)
- (math-find-base-units-rec (nth 1 expr) pow))
- ((eq (car expr) 'var)
- (or (eq (nth 1 expr) 'pi)
- (error "Unknown name %s in defining expression for unit %s"
- (nth 1 expr) (car entry))))
- (t (error "Malformed defining expression for unit %s" (car entry))))))
-
-
-(defun math-units-in-expr-p (expr sub-exprs)
- (and (consp expr)
- (if (eq (car expr) 'var)
- (math-check-unit-name expr)
- (and (or sub-exprs
- (memq (car expr) '(* / ^)))
- (or (math-units-in-expr-p (nth 1 expr) sub-exprs)
- (math-units-in-expr-p (nth 2 expr) sub-exprs))))))
-
-(defun math-only-units-in-expr-p (expr)
- (and (consp expr)
- (if (eq (car expr) 'var)
- (math-check-unit-name expr)
- (if (memq (car expr) '(* /))
- (and (math-only-units-in-expr-p (nth 1 expr))
- (math-only-units-in-expr-p (nth 2 expr)))
- (and (eq (car expr) '^)
- (and (math-only-units-in-expr-p (nth 1 expr))
- (math-realp (nth 2 expr))))))))
-
-(defun math-single-units-in-expr-p (expr)
- (cond ((math-scalarp expr) nil)
- ((eq (car expr) 'var)
- (math-check-unit-name expr))
- ((eq (car expr) '*)
- (let ((u1 (math-single-units-in-expr-p (nth 1 expr)))
- (u2 (math-single-units-in-expr-p (nth 2 expr))))
- (or (and u1 u2 'wrong)
- u1
- u2)))
- ((eq (car expr) '/)
- (if (math-units-in-expr-p (nth 2 expr) nil)
- 'wrong
- (math-single-units-in-expr-p (nth 1 expr))))
- (t 'wrong)))
-
-(defun math-check-unit-name (v)
- (and (eq (car-safe v) 'var)
- (or (assq (nth 1 v) (or math-units-table (math-build-units-table)))
- (let ((name (symbol-name (nth 1 v))))
- (and (> (length name) 1)
- (assq (aref name 0) math-unit-prefixes)
- (or (assq (intern (substring name 1)) math-units-table)
- (and (eq (aref name 0) ?M)
- (> (length name) 3)
- (eq (aref name 1) ?e)
- (eq (aref name 2) ?g)
- (assq (intern (substring name 3))
- math-units-table))))))))
-
-
-(defun math-to-standard-units (expr which-standard)
- (math-to-standard-rec expr))
-
-(defun math-to-standard-rec (expr)
- (if (eq (car-safe expr) 'var)
- (let ((u (math-check-unit-name expr))
- (base (nth 1 expr)))
- (if u
- (progn
- (if (nth 1 u)
- (setq expr (math-to-standard-rec (nth 1 u)))
- (let ((st (assq (car u) which-standard)))
- (if st
- (setq expr (nth 1 st))
- (setq expr (list 'var (car u)
- (intern (concat "var-"
- (symbol-name
- (car u)))))))))
- (or (null u)
- (eq base (car u))
- (setq expr (list '*
- (nth 1 (assq (aref (symbol-name base) 0)
- math-unit-prefixes))
- expr)))
- expr)
- (if (eq base 'pi)
- (math-pi)
- expr)))
- (if (Math-primp expr)
- expr
- (cons (car expr)
- (mapcar 'math-to-standard-rec (cdr expr))))))
-
-(defun math-apply-units (expr units ulist &optional pure)
- (if ulist
- (let ((new 0)
- value)
- (setq expr (math-simplify-units expr))
- (or (math-numberp expr)
- (error "Incompatible units"))
- (while (cdr ulist)
- (setq value (math-div expr (nth 1 (car ulist)))
- value (math-floor (let ((calc-internal-prec
- (1- calc-internal-prec)))
- (math-normalize value)))
- new (math-add new (math-mul value (car (car ulist))))
- expr (math-sub expr (math-mul value (nth 1 (car ulist))))
- ulist (cdr ulist)))
- (math-add new (math-mul (math-div expr (nth 1 (car ulist)))
- (car (car ulist)))))
- (math-simplify-units (if pure
- expr
- (list '* expr units)))))
-
-(defvar math-decompose-units-cache nil)
-(defun math-decompose-units (units)
- (let ((u (math-check-unit-name units)))
- (and u (eq (car-safe (nth 1 u)) '+)
- (setq units (nth 1 u))))
- (setq units (calcFunc-expand units))
- (and (eq (car-safe units) '+)
- (let ((entry (list units calc-internal-prec calc-prefer-frac)))
- (or (equal entry (car math-decompose-units-cache))
- (let ((ulist nil)
- (utemp units)
- qty unit)
- (while (eq (car-safe utemp) '+)
- (setq ulist (cons (math-decompose-unit-part (nth 2 utemp))
- ulist)
- utemp (nth 1 utemp)))
- (setq ulist (cons (math-decompose-unit-part utemp) ulist)
- utemp ulist)
- (while (setq utemp (cdr utemp))
- (unless (equal (nth 2 (car utemp)) (nth 2 (car ulist)))
- (error "Inconsistent units in sum")))
- (setq math-decompose-units-cache
- (cons entry
- (sort ulist
- (function
- (lambda (x y)
- (not (Math-lessp (nth 1 x)
- (nth 1 y))))))))))
- (cdr math-decompose-units-cache))))
-
-(defun math-decompose-unit-part (unit)
- (cons unit
- (math-is-multiple (math-simplify-units (math-to-standard-units
- unit nil))
- t)))
-
-(defun math-find-compatible-unit (expr unit)
- (let ((u (math-check-unit-name unit)))
- (if u
- (math-find-compatible-unit-rec expr 1))))
-
-(defun math-find-compatible-unit-rec (expr pow)
- (cond ((eq (car-safe expr) '*)
- (or (math-find-compatible-unit-rec (nth 1 expr) pow)
- (math-find-compatible-unit-rec (nth 2 expr) pow)))
- ((eq (car-safe expr) '/)
- (or (math-find-compatible-unit-rec (nth 1 expr) pow)
- (math-find-compatible-unit-rec (nth 2 expr) (- pow))))
- ((and (eq (car-safe expr) '^)
- (integerp (nth 2 expr)))
- (math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr))))
- (t
- (let ((u2 (math-check-unit-name expr)))
- (if (equal (nth 4 u) (nth 4 u2))
- (cons expr pow))))))
-
-(defun math-convert-units (expr new-units &optional pure)
- (math-with-extra-prec 2
- (let ((compat (and (not pure) (math-find-compatible-unit expr new-units)))
- (unit-list nil)
- (math-combining-units nil))
- (if compat
- (math-simplify-units
- (math-mul (math-mul (math-simplify-units
- (math-div expr (math-pow (car compat)
- (cdr compat))))
- (math-pow new-units (cdr compat)))
- (math-simplify-units
- (math-to-standard-units
- (math-pow (math-div (car compat) new-units)
- (cdr compat))
- nil))))
- (when (setq unit-list (math-decompose-units new-units))
- (setq new-units (nth 2 (car unit-list))))
- (when (eq (car-safe expr) '+)
- (setq expr (math-simplify-units expr)))
- (if (math-units-in-expr-p expr t)
- (math-convert-units-rec expr)
- (math-apply-units (math-to-standard-units
- (list '/ expr new-units) nil)
- new-units unit-list pure))))))
-
-(defun math-convert-units-rec (expr)
- (if (math-units-in-expr-p expr nil)
- (math-apply-units (math-to-standard-units (list '/ expr new-units) nil)
- new-units unit-list pure)
- (if (Math-primp expr)
- expr
- (cons (car expr)
- (mapcar 'math-convert-units-rec (cdr expr))))))
-
-(defun math-convert-temperature (expr old new &optional pure)
- (let* ((units (math-single-units-in-expr-p expr))
- (uold (if old
- (if (or (null units)
- (equal (nth 1 old) (car units)))
- (math-check-unit-name old)
- (error "Inconsistent temperature units"))
- units))
- (unew (math-check-unit-name new)))
- (unless (and (consp unew) (nth 3 unew))
- (error "Not a valid temperature unit"))
- (unless (and (consp uold) (nth 3 uold))
- (error "Not a pure temperature expression"))
- (let ((v (car uold)))
- (setq expr (list '/ expr (list 'var v
- (intern (concat "var-"
- (symbol-name v)))))))
- (or (eq (nth 3 uold) (nth 3 unew))
- (cond ((eq (nth 3 uold) 'K)
- (setq expr (list '- expr '(float 27315 -2)))
- (if (eq (nth 3 unew) 'F)
- (setq expr (list '+ (list '* expr '(frac 9 5)) 32))))
- ((eq (nth 3 uold) 'C)
- (if (eq (nth 3 unew) 'F)
- (setq expr (list '+ (list '* expr '(frac 9 5)) 32))
- (setq expr (list '+ expr '(float 27315 -2)))))
- (t
- (setq expr (list '* (list '- expr 32) '(frac 5 9)))
- (if (eq (nth 3 unew) 'K)
- (setq expr (list '+ expr '(float 27315 -2)))))))
- (if pure
- expr
- (list '* expr new))))
-
-
-
-(defun math-simplify-units (a)
- (let ((math-simplifying-units t)
- (calc-matrix-mode 'scalar))
- (math-simplify a)))
-(defalias 'calcFunc-usimplify 'math-simplify-units)
-
-(math-defsimplify (+ -)
- (and math-simplifying-units
- (math-units-in-expr-p (nth 1 expr) nil)
- (let* ((units (math-extract-units (nth 1 expr)))
- (ratio (math-simplify (math-to-standard-units
- (list '/ (nth 2 expr) units) nil))))
- (if (math-units-in-expr-p ratio nil)
- (progn
- (calc-record-why "*Inconsistent units" expr)
- expr)
- (list '* (math-add (math-remove-units (nth 1 expr))
- (if (eq (car expr) '-) (math-neg ratio) ratio))
- units)))))
-
-(math-defsimplify *
- (math-simplify-units-prod))
-
-(defun math-simplify-units-prod ()
- (and math-simplifying-units
- calc-autorange-units
- (Math-realp (nth 1 expr))
- (let* ((num (math-float (nth 1 expr)))
- (xpon (calcFunc-xpon num))
- (unitp (cdr (cdr expr)))
- (unit (car unitp))
- (pow (if (eq (car expr) '*) 1 -1))
- u)
- (and (eq (car-safe unit) '*)
- (setq unitp (cdr unit)
- unit (car unitp)))
- (and (eq (car-safe unit) '^)
- (integerp (nth 2 unit))
- (setq pow (* pow (nth 2 unit))
- unitp (cdr unit)
- unit (car unitp)))
- (and (setq u (math-check-unit-name unit))
- (integerp xpon)
- (or (< xpon 0)
- (>= xpon (if (eq (car u) 'm) 1 3)))
- (let* ((uxpon 0)
- (pref (if (< pow 0)
- (reverse math-unit-prefixes)
- math-unit-prefixes))
- (p pref)
- pxpon pname)
- (or (eq (car u) (nth 1 unit))
- (setq uxpon (* pow
- (nth 2 (nth 1 (assq
- (aref (symbol-name
- (nth 1 unit)) 0)
- math-unit-prefixes))))))
- (setq xpon (+ xpon uxpon))
- (while (and p
- (or (memq (car (car p)) '(?d ?D ?h ?H))
- (and (eq (car (car p)) ?c)
- (not (eq (car u) 'm)))
- (< xpon (setq pxpon (* (nth 2 (nth 1 (car p)))
- pow)))
- (progn
- (setq pname (math-build-var-name
- (if (eq (car (car p)) 0)
- (car u)
- (concat (char-to-string
- (car (car p)))
- (symbol-name
- (car u))))))
- (and (/= (car (car p)) 0)
- (assq (nth 1 pname)
- math-units-table)))))
- (setq p (cdr p)))
- (and p
- (/= pxpon uxpon)
- (or (not (eq p pref))
- (< xpon (+ pxpon (* (math-abs pow) 3))))
- (progn
- (setcar (cdr expr)
- (let ((calc-prefer-frac nil))
- (calcFunc-scf (nth 1 expr)
- (- uxpon pxpon))))
- (setcar unitp pname)
- expr)))))))
-
-(math-defsimplify /
- (and math-simplifying-units
- (let ((np (cdr expr))
- (try-cancel-units 0)
- n nn)
- (setq n (if (eq (car-safe (nth 2 expr)) '*)
- (cdr (nth 2 expr))
- (nthcdr 2 expr)))
- (if (math-realp (car n))
- (progn
- (setcar (cdr expr) (math-mul (nth 1 expr)
- (let ((calc-prefer-frac nil))
- (math-div 1 (car n)))))
- (setcar n 1)))
- (while (eq (car-safe (setq n (car np))) '*)
- (math-simplify-units-divisor (cdr n) (cdr (cdr expr)))
- (setq np (cdr (cdr n))))
- (math-simplify-units-divisor np (cdr (cdr expr)))
- (if (eq try-cancel-units 0)
- (let* ((math-simplifying-units nil)
- (base (math-simplify (math-to-standard-units expr nil))))
- (if (Math-numberp base)
- (setq expr base))))
- (if (eq (car-safe expr) '/)
- (math-simplify-units-prod))
- expr)))
-
-(defun math-simplify-units-divisor (np dp)
- (let ((n (car np))
- d dd temp)
- (while (eq (car-safe (setq d (car dp))) '*)
- (when (setq temp (math-simplify-units-quotient n (nth 1 d)))
- (setcar np (setq n temp))
- (setcar (cdr d) 1))
- (setq dp (cdr (cdr d))))
- (when (setq temp (math-simplify-units-quotient n d))
- (setcar np (setq n temp))
- (setcar dp 1))))
-
-;; Simplify, e.g., "in / cm" to "2.54" in a units expression.
-(defun math-simplify-units-quotient (n d)
- (let ((pow1 1)
- (pow2 1))
- (when (and (eq (car-safe n) '^)
- (integerp (nth 2 n)))
- (setq pow1 (nth 2 n) n (nth 1 n)))
- (when (and (eq (car-safe d) '^)
- (integerp (nth 2 d)))
- (setq pow2 (nth 2 d) d (nth 1 d)))
- (let ((un (math-check-unit-name n))
- (ud (math-check-unit-name d)))
- (and un ud
- (if (and (equal (nth 4 un) (nth 4 ud))
- (eq pow1 pow2))
- (math-to-standard-units (list '/ n d) nil)
- (let (ud1)
- (setq un (nth 4 un)
- ud (nth 4 ud))
- (while un
- (setq ud1 ud)
- (while ud1
- (and (eq (car (car un)) (car (car ud1)))
- (setq try-cancel-units
- (+ try-cancel-units
- (- (* (cdr (car un)) pow1)
- (* (cdr (car ud)) pow2)))))
- (setq ud1 (cdr ud1)))
- (setq un (cdr un)))
- nil))))))
-
-(math-defsimplify ^
- (and math-simplifying-units
- (math-realp (nth 2 expr))
- (if (memq (car-safe (nth 1 expr)) '(* /))
- (list (car (nth 1 expr))
- (list '^ (nth 1 (nth 1 expr)) (nth 2 expr))
- (list '^ (nth 2 (nth 1 expr)) (nth 2 expr)))
- (math-simplify-units-pow (nth 1 expr) (nth 2 expr)))))
-
-(math-defsimplify calcFunc-sqrt
- (and math-simplifying-units
- (if (memq (car-safe (nth 1 expr)) '(* /))
- (list (car (nth 1 expr))
- (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))
- (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))
- (math-simplify-units-pow (nth 1 expr) '(frac 1 2)))))
-
-(math-defsimplify (calcFunc-floor
- calcFunc-ceil
- calcFunc-round
- calcFunc-rounde
- calcFunc-roundu
- calcFunc-trunc
- calcFunc-float
- calcFunc-frac
- calcFunc-abs
- calcFunc-clean)
- (and math-simplifying-units
- (= (length expr) 2)
- (if (math-only-units-in-expr-p (nth 1 expr))
- (nth 1 expr)
- (if (and (memq (car-safe (nth 1 expr)) '(* /))
- (or (math-only-units-in-expr-p
- (nth 1 (nth 1 expr)))
- (math-only-units-in-expr-p
- (nth 2 (nth 1 expr)))))
- (list (car (nth 1 expr))
- (cons (car expr)
- (cons (nth 1 (nth 1 expr))
- (cdr (cdr expr))))
- (cons (car expr)
- (cons (nth 2 (nth 1 expr))
- (cdr (cdr expr)))))))))
-
-(defun math-simplify-units-pow (a pow)
- (if (and (eq (car-safe a) '^)
- (math-check-unit-name (nth 1 a))
- (math-realp (nth 2 a)))
- (list '^ (nth 1 a) (math-mul pow (nth 2 a)))
- (let* ((u (math-check-unit-name a))
- (pf (math-to-simple-fraction pow))
- (d (and (eq (car-safe pf) 'frac) (nth 2 pf))))
- (and u d
- (math-units-are-multiple u d)
- (list '^ (math-to-standard-units a nil) pow)))))
-
-
-(defun math-units-are-multiple (u n)
- (setq u (nth 4 u))
- (while (and u (= (% (cdr (car u)) n) 0))
- (setq u (cdr u)))
- (null u))
-
-(math-defsimplify calcFunc-sin
- (and math-simplifying-units
- (math-units-in-expr-p (nth 1 expr) nil)
- (let ((rad (math-simplify-units
- (math-evaluate-expr
- (math-to-standard-units (nth 1 expr) nil))))
- (calc-angle-mode 'rad))
- (and (eq (car-safe rad) '*)
- (math-realp (nth 1 rad))
- (eq (car-safe (nth 2 rad)) 'var)
- (eq (nth 1 (nth 2 rad)) 'rad)
- (list 'calcFunc-sin (nth 1 rad))))))
-
-(math-defsimplify calcFunc-cos
- (and math-simplifying-units
- (math-units-in-expr-p (nth 1 expr) nil)
- (let ((rad (math-simplify-units
- (math-evaluate-expr
- (math-to-standard-units (nth 1 expr) nil))))
- (calc-angle-mode 'rad))
- (and (eq (car-safe rad) '*)
- (math-realp (nth 1 rad))
- (eq (car-safe (nth 2 rad)) 'var)
- (eq (nth 1 (nth 2 rad)) 'rad)
- (list 'calcFunc-cos (nth 1 rad))))))
-
-(math-defsimplify calcFunc-tan
- (and math-simplifying-units
- (math-units-in-expr-p (nth 1 expr) nil)
- (let ((rad (math-simplify-units
- (math-evaluate-expr
- (math-to-standard-units (nth 1 expr) nil))))
- (calc-angle-mode 'rad))
- (and (eq (car-safe rad) '*)
- (math-realp (nth 1 rad))
- (eq (car-safe (nth 2 rad)) 'var)
- (eq (nth 1 (nth 2 rad)) 'rad)
- (list 'calcFunc-tan (nth 1 rad))))))
-
-
-(defun math-remove-units (expr)
- (if (math-check-unit-name expr)
- 1
- (if (Math-primp expr)
- expr
- (cons (car expr)
- (mapcar 'math-remove-units (cdr expr))))))
-
-(defun math-extract-units (expr)
- (if (memq (car-safe expr) '(* /))
- (cons (car expr)
- (mapcar 'math-extract-units (cdr expr)))
- (if (math-check-unit-name expr) expr 1)))
-
-(defun math-build-units-table-buffer (enter-buffer)
- (if (not (and math-units-table math-units-table-buffer-valid
- (get-buffer "*Units Table*")))
- (let ((buf (get-buffer-create "*Units Table*"))
- (uptr (math-build-units-table))
- (calc-language (if (eq calc-language 'big) nil calc-language))
- (calc-float-format '(float 0))
- (calc-group-digits nil)
- (calc-number-radix 10)
- (calc-point-char ".")
- (std nil)
- u name shadowed)
- (save-excursion
- (message "Formatting units table...")
- (set-buffer buf)
- (setq buffer-read-only nil)
- (erase-buffer)
- (insert "Calculator Units Table:\n\n")
- (insert "Unit Type Definition Description\n\n")
- (while uptr
- (setq u (car uptr)
- name (nth 2 u))
- (when (eq (car u) 'm)
- (setq std t))
- (setq shadowed (and std (assq (car u) math-additional-units)))
- (when (and name
- (> (length name) 1)
- (eq (aref name 0) ?\*))
- (unless (eq uptr math-units-table)
- (insert "\n"))
- (setq name (substring name 1)))
- (insert " ")
- (and shadowed (insert "("))
- (insert (symbol-name (car u)))
- (and shadowed (insert ")"))
- (if (nth 3 u)
- (progn
- (indent-to 10)
- (insert (symbol-name (nth 3 u))))
- (or std
- (progn
- (indent-to 10)
- (insert "U"))))
- (indent-to 14)
- (and shadowed (insert "("))
- (if (nth 1 u)
- (insert (math-format-value (nth 1 u) 80))
- (insert (symbol-name (car u))))
- (and shadowed (insert ")"))
- (indent-to 41)
- (insert " ")
- (when name
- (insert name))
- (if shadowed
- (insert " (redefined above)")
- (unless (nth 1 u)
- (insert " (base unit)")))
- (insert "\n")
- (setq uptr (cdr uptr)))
- (insert "\n\nUnit Prefix Table:\n\n")
- (setq uptr math-unit-prefixes)
- (while uptr
- (setq u (car uptr))
- (insert " " (char-to-string (car u)))
- (if (equal (nth 1 u) (nth 1 (nth 1 uptr)))
- (insert " " (char-to-string (car (car (setq uptr (cdr uptr)))))
- " ")
- (insert " "))
- (insert "10^" (int-to-string (nth 2 (nth 1 u))))
- (indent-to 15)
- (insert " " (nth 2 u) "\n")
- (while (eq (car (car (setq uptr (cdr uptr)))) 0)))
- (insert "\n")
- (setq buffer-read-only t)
- (message "Formatting units table...done"))
- (setq math-units-table-buffer-valid t)
- (let ((oldbuf (current-buffer)))
- (set-buffer buf)
- (goto-char (point-min))
- (set-buffer oldbuf))
- (if enter-buffer
- (pop-to-buffer buf)
- (display-buffer buf)))
- (if enter-buffer
- (pop-to-buffer (get-buffer "*Units Table*"))
- (display-buffer (get-buffer "*Units Table*")))))
-
-;; Local Variables:
-;; coding: iso-latin-1
-;; End:
-
-;;; calc-units.el ends here
+++ /dev/null
-;;; calc-vec.el --- vector functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-vec () nil)
-
-
-(defun calc-display-strings (n)
- (interactive "P")
- (calc-wrapper
- (message (if (calc-change-mode 'calc-display-strings n t t)
- "Displaying vectors of integers as quoted strings"
- "Displaying vectors of integers normally"))))
-
-
-(defun calc-pack (n)
- (interactive "P")
- (calc-wrapper
- (let* ((nn (if n 1 2))
- (mode (if n (prefix-numeric-value n) (calc-top-n 1)))
- (mode (if (and (Math-vectorp mode) (cdr mode)) (cdr mode)
- (if (integerp mode) mode
- (error "Packing mode must be an integer or vector of integers"))))
- (num (calc-pack-size mode))
- (items (calc-top-list num nn)))
- (calc-enter-result (+ nn num -1) "pack" (calc-pack-items mode items)))))
-
-(defun calc-pack-size (mode)
- (cond ((consp mode)
- (let ((size 1))
- (while mode
- (or (integerp (car mode)) (error "Vector of integers expected"))
- (setq size (* size (calc-pack-size (car mode)))
- mode (cdr mode)))
- (if (= size 0)
- (error "Zero dimensions not allowed")
- size)))
- ((>= mode 0) mode)
- (t (or (cdr (assq mode '((-3 . 3) (-13 . 1) (-14 . 3) (-15 . 6))))
- 2))))
-
-(defun calc-pack-items (mode items)
- (cond ((consp mode)
- (if (cdr mode)
- (let* ((size (calc-pack-size (cdr mode)))
- (len (length items))
- (new nil)
- p row)
- (while (> len 0)
- (setq p (nthcdr (1- size) items)
- row items
- items (cdr p)
- len (- len size))
- (setcdr p nil)
- (setq new (cons (calc-pack-items (cdr mode) row) new)))
- (calc-pack-items (car mode) (nreverse new)))
- (calc-pack-items (car mode) items)))
- ((>= mode 0)
- (cons 'vec items))
- ((= mode -3)
- (if (and (math-objvecp (car items))
- (math-objvecp (nth 1 items))
- (math-objvecp (nth 2 items)))
- (if (and (math-num-integerp (car items))
- (math-num-integerp (nth 1 items)))
- (if (math-realp (nth 2 items))
- (cons 'hms items)
- (error "Seconds must be real"))
- (error "Hours and minutes must be integers"))
- (math-normalize (list '+
- (list '+
- (if (eq calc-angle-mode 'rad)
- (list '* (car items)
- '(hms 1 0 0))
- (car items))
- (list '* (nth 1 items) '(hms 0 1 0)))
- (list '* (nth 2 items) '(hms 0 0 1))))))
- ((= mode -13)
- (if (math-realp (car items))
- (cons 'date items)
- (if (eq (car-safe (car items)) 'date)
- (car items)
- (if (math-objvecp (car items))
- (error "Date value must be real")
- (cons 'calcFunc-date items)))))
- ((memq mode '(-14 -15))
- (let ((p items))
- (while (and p (math-objvecp (car p)))
- (or (math-integerp (car p))
- (error "Components must be integers"))
- (setq p (cdr p)))
- (if p
- (cons 'calcFunc-date items)
- (list 'date (math-dt-to-date items)))))
- ((or (eq (car-safe (car items)) 'vec)
- (eq (car-safe (nth 1 items)) 'vec))
- (let* ((x (car items))
- (vx (eq (car-safe x) 'vec))
- (y (nth 1 items))
- (vy (eq (car-safe y) 'vec))
- (z nil)
- (n (1- (length (if vx x y)))))
- (and vx vy
- (/= n (1- (length y)))
- (error "Vectors must be the same length"))
- (while (>= (setq n (1- n)) 0)
- (setq z (cons (calc-pack-items
- mode
- (list (if vx (car (setq x (cdr x))) x)
- (if vy (car (setq y (cdr y))) y)))
- z)))
- (cons 'vec (nreverse z))))
- ((= mode -1)
- (if (and (math-realp (car items)) (math-realp (nth 1 items)))
- (cons 'cplx items)
- (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
- (error "Components must be real"))
- (math-normalize (list '+ (car items)
- (list '* (nth 1 items) '(cplx 0 1))))))
- ((= mode -2)
- (if (and (math-realp (car items)) (math-anglep (nth 1 items)))
- (cons 'polar items)
- (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
- (error "Components must be real"))
- (math-normalize (list '* (car items)
- (if (math-anglep (nth 1 items))
- (list 'polar 1 (nth 1 items))
- (list 'calcFunc-exp
- (list '*
- (math-to-radians-2
- (nth 1 items))
- (list 'polar
- 1
- (math-quarter-circle
- nil)))))))))
- ((= mode -4)
- (let ((x (car items))
- (sigma (nth 1 items)))
- (if (or (math-scalarp x) (not (math-objvecp x)))
- (if (or (math-anglep sigma) (not (math-objvecp sigma)))
- (math-make-sdev x sigma)
- (error "Error component must be real"))
- (error "Mean component must be real or complex"))))
- ((= mode -5)
- (let ((a (car items))
- (m (nth 1 items)))
- (if (and (math-anglep a) (math-anglep m))
- (if (math-posp m)
- (math-make-mod a m)
- (error "Modulus must be positive"))
- (if (and (math-objectp a) (math-objectp m))
- (error "Components must be real"))
- (list 'calcFunc-makemod a m))))
- ((memq mode '(-6 -7 -8 -9))
- (let ((lo (car items))
- (hi (nth 1 items)))
- (if (and (or (math-anglep lo) (eq (car lo) 'date)
- (not (math-objvecp lo)))
- (or (math-anglep hi) (eq (car hi) 'date)
- (not (math-objvecp hi))))
- (math-make-intv (+ mode 9) lo hi)
- (error "Components must be real"))))
- ((eq mode -10)
- (if (math-zerop (nth 1 items))
- (error "Denominator must not be zero")
- (if (and (math-integerp (car items)) (math-integerp (nth 1 items)))
- (math-normalize (cons 'frac items))
- (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
- (error "Components must be integers"))
- (cons 'calcFunc-fdiv items))))
- ((memq mode '(-11 -12))
- (if (and (math-realp (car items)) (math-integerp (nth 1 items)))
- (calcFunc-scf (math-float (car items)) (nth 1 items))
- (if (and (math-objectp (car items)) (math-objectp (nth 1 items)))
- (error "Components must be integers"))
- (math-normalize
- (list 'calcFunc-scf
- (list 'calcFunc-float (car items))
- (nth 1 items)))))
- (t
- (error "Invalid packing mode: %d" mode))))
-
-(defvar calc-unpack-with-type nil)
-(defun calc-unpack (mode)
- (interactive "P")
- (calc-wrapper
- (let ((calc-unpack-with-type t))
- (calc-pop-push-record-list 1 "unpk" (calc-unpack-item
- (and mode
- (prefix-numeric-value mode))
- (calc-top))))))
-
-(defun calc-unpack-type (item)
- (cond ((eq (car-safe item) 'vec)
- (1- (length item)))
- ((eq (car-safe item) 'intv)
- (- (nth 1 item) 9))
- (t
- (or (cdr (assq (car-safe item) '( (cplx . -1) (polar . -2)
- (hms . -3) (sdev . -4) (mod . -5)
- (frac . -10) (float . -11)
- (date . -13) )))
- (error "Argument must be a composite object")))))
-
-(defun calc-unpack-item (mode item)
- (cond ((not mode)
- (if (or (and (not (memq (car-safe item) '(frac float cplx polar vec
- hms date sdev mod
- intv)))
- (math-objvecp item))
- (eq (car-safe item) 'var))
- (error "Argument must be a composite object or function call"))
- (if (eq (car item) 'intv)
- (cdr (cdr item))
- (cdr item)))
- ((> mode 0)
- (let ((dims nil)
- type new row)
- (setq item (list item))
- (while (> mode 0)
- (setq type (calc-unpack-type (car item))
- dims (cons type dims)
- new (calc-unpack-item nil (car item)))
- (while (setq item (cdr item))
- (or (= (calc-unpack-type (car item)) type)
- (error "Inconsistent types or dimensions in vector elements"))
- (setq new (append new (calc-unpack-item nil (car item)))))
- (setq item new
- mode (1- mode)))
- (if (cdr dims) (setq dims (list (cons 'vec (nreverse dims)))))
- (cond ((eq calc-unpack-with-type 'pair)
- (list (car dims) (cons 'vec item)))
- (calc-unpack-with-type
- (append item dims))
- (t item))))
- ((eq calc-unpack-with-type 'pair)
- (let ((calc-unpack-with-type nil))
- (list mode (cons 'vec (calc-unpack-item mode item)))))
- ((= mode -3)
- (if (eq (car-safe item) 'hms)
- (cdr item)
- (error "Argument must be an HMS form")))
- ((= mode -13)
- (if (eq (car-safe item) 'date)
- (cdr item)
- (error "Argument must be a date form")))
- ((= mode -14)
- (if (eq (car-safe item) 'date)
- (math-date-to-dt (math-floor (nth 1 item)))
- (error "Argument must be a date form")))
- ((= mode -15)
- (if (eq (car-safe item) 'date)
- (append (math-date-to-dt (nth 1 item))
- (and (not (math-integerp (nth 1 item)))
- (list 0 0 0)))
- (error "Argument must be a date form")))
- ((eq (car-safe item) 'vec)
- (let ((x nil)
- (y nil)
- res)
- (while (setq item (cdr item))
- (setq res (calc-unpack-item mode (car item))
- x (cons (car res) x)
- y (cons (nth 1 res) y)))
- (list (cons 'vec (nreverse x))
- (cons 'vec (nreverse y)))))
- ((= mode -1)
- (if (eq (car-safe item) 'cplx)
- (cdr item)
- (if (eq (car-safe item) 'polar)
- (cdr (math-complex item))
- (if (Math-realp item)
- (list item 0)
- (error "Argument must be a complex number")))))
- ((= mode -2)
- (if (or (memq (car-safe item) '(cplx polar))
- (Math-realp item))
- (cdr (math-polar item))
- (error "Argument must be a complex number")))
- ((= mode -4)
- (if (eq (car-safe item) 'sdev)
- (cdr item)
- (list item 0)))
- ((= mode -5)
- (if (eq (car-safe item) 'mod)
- (cdr item)
- (error "Argument must be a modulo form")))
- ((memq mode '(-6 -7 -8 -9))
- (if (eq (car-safe item) 'intv)
- (cdr (cdr item))
- (list item item)))
- ((= mode -10)
- (if (eq (car-safe item) 'frac)
- (cdr item)
- (if (Math-integerp item)
- (list item 1)
- (error "Argument must be a rational number"))))
- ((= mode -11)
- (if (eq (car-safe item) 'float)
- (list (nth 1 item) (math-normalize (nth 2 item)))
- (error "Expected a floating-point number")))
- ((= mode -12)
- (if (eq (car-safe item) 'float)
- (list (calcFunc-mant item) (calcFunc-xpon item))
- (error "Expected a floating-point number")))
- (t
- (error "Invalid unpacking mode: %d" mode))))
-
-(defun calc-diag (n)
- (interactive "P")
- (calc-wrapper
- (calc-enter-result 1 "diag" (if n
- (list 'calcFunc-diag (calc-top-n 1)
- (prefix-numeric-value n))
- (list 'calcFunc-diag (calc-top-n 1))))))
-
-(defun calc-ident (n)
- (interactive "NDimension of identity matrix = ")
- (calc-wrapper
- (calc-enter-result 0 "idn" (if (eq n 0)
- '(calcFunc-idn 1)
- (list 'calcFunc-idn 1
- (prefix-numeric-value n))))))
-
-(defun calc-index (n &optional stack)
- (interactive "NSize of vector = \nP")
- (calc-wrapper
- (if (consp stack)
- (calc-enter-result 3 "indx" (cons 'calcFunc-index (calc-top-list-n 3)))
- (calc-enter-result 0 "indx" (list 'calcFunc-index
- (prefix-numeric-value n))))))
-
-(defun calc-build-vector (n)
- (interactive "NSize of vector = ")
- (calc-wrapper
- (calc-enter-result 1 "bldv" (list 'calcFunc-cvec
- (calc-top-n 1)
- (prefix-numeric-value n)))))
-
-(defun calc-cons (arg)
- (interactive "P")
- (calc-wrapper
- (if (calc-is-hyperbolic)
- (calc-binary-op "rcns" 'calcFunc-rcons arg)
- (calc-binary-op "cons" 'calcFunc-cons arg))))
-
-
-(defun calc-head (arg)
- (interactive "P")
- (calc-wrapper
- (if (calc-is-inverse)
- (if (calc-is-hyperbolic)
- (calc-unary-op "rtai" 'calcFunc-rtail arg)
- (calc-unary-op "tail" 'calcFunc-tail arg))
- (if (calc-is-hyperbolic)
- (calc-unary-op "rhed" 'calcFunc-rhead arg)
- (calc-unary-op "head" 'calcFunc-head arg)))))
-
-(defun calc-tail (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-head arg))
-
-(defun calc-vlength (arg)
- (interactive "P")
- (calc-wrapper
- (if (calc-is-hyperbolic)
- (calc-unary-op "dims" 'calcFunc-mdims arg)
- (calc-unary-op "len" 'calcFunc-vlen arg))))
-
-(defun calc-arrange-vector (n)
- (interactive "NNumber of columns = ")
- (calc-wrapper
- (calc-enter-result 1 "arng" (list 'calcFunc-arrange (calc-top-n 1)
- (prefix-numeric-value n)))))
-
-(defun calc-vector-find (arg)
- (interactive "P")
- (calc-wrapper
- (let ((func (cons 'calcFunc-find (calc-top-list-n 2))))
- (calc-enter-result
- 2 "find"
- (if arg (append func (list (prefix-numeric-value arg))) func)))))
-
-(defun calc-subvector ()
- (interactive)
- (calc-wrapper
- (if (calc-is-inverse)
- (calc-enter-result 3 "rsvc" (cons 'calcFunc-rsubvec
- (calc-top-list-n 3)))
- (calc-enter-result 3 "svec" (cons 'calcFunc-subvec (calc-top-list-n 3))))))
-
-(defun calc-reverse-vector (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "rev" 'calcFunc-rev arg)))
-
-(defun calc-mask-vector (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "vmsk" 'calcFunc-vmask arg)))
-
-(defun calc-expand-vector (arg)
- (interactive "P")
- (calc-wrapper
- (if (calc-is-hyperbolic)
- (calc-enter-result 3 "vexp" (cons 'calcFunc-vexp (calc-top-list-n 3)))
- (calc-binary-op "vexp" 'calcFunc-vexp arg))))
-
-(defun calc-sort ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-enter-result 1 "rsrt" (list 'calcFunc-rsort (calc-top-n 1)))
- (calc-enter-result 1 "sort" (list 'calcFunc-sort (calc-top-n 1))))))
-
-(defun calc-grade ()
- (interactive)
- (calc-slow-wrapper
- (if (calc-is-inverse)
- (calc-enter-result 1 "rgrd" (list 'calcFunc-rgrade (calc-top-n 1)))
- (calc-enter-result 1 "grad" (list 'calcFunc-grade (calc-top-n 1))))))
-
-(defun calc-histogram (n)
- (interactive "NNumber of bins: ")
- (calc-slow-wrapper
- (if calc-hyperbolic-flag
- (calc-enter-result 2 "hist" (list 'calcFunc-histogram
- (calc-top-n 2)
- (calc-top-n 1)
- (prefix-numeric-value n)))
- (calc-enter-result 1 "hist" (list 'calcFunc-histogram
- (calc-top-n 1)
- (prefix-numeric-value n))))))
-
-(defun calc-transpose (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "trn" 'calcFunc-trn arg)))
-
-(defun calc-conj-transpose (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "ctrn" 'calcFunc-ctrn arg)))
-
-(defun calc-cross (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "cros" 'calcFunc-cross arg)))
-
-(defun calc-remove-duplicates (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "rdup" 'calcFunc-rdup arg)))
-
-(defun calc-set-union (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "unio" 'calcFunc-vunion arg '(vec) 'calcFunc-rdup)))
-
-(defun calc-set-intersect (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "intr" 'calcFunc-vint arg '(vec) 'calcFunc-rdup)))
-
-(defun calc-set-difference (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "diff" 'calcFunc-vdiff arg '(vec) 'calcFunc-rdup)))
-
-(defun calc-set-xor (arg)
- (interactive "P")
- (calc-wrapper
- (calc-binary-op "xor" 'calcFunc-vxor arg '(vec) 'calcFunc-rdup)))
-
-(defun calc-set-complement (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "cmpl" 'calcFunc-vcompl arg)))
-
-(defun calc-set-floor (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "vflr" 'calcFunc-vfloor arg)))
-
-(defun calc-set-enumerate (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "enum" 'calcFunc-venum arg)))
-
-(defun calc-set-span (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "span" 'calcFunc-vspan arg)))
-
-(defun calc-set-cardinality (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "card" 'calcFunc-vcard arg)))
-
-(defun calc-unpack-bits (arg)
- (interactive "P")
- (calc-wrapper
- (if (calc-is-inverse)
- (calc-unary-op "bpck" 'calcFunc-vpack arg)
- (calc-unary-op "bupk" 'calcFunc-vunpack arg))))
-
-(defun calc-pack-bits (arg)
- (interactive "P")
- (calc-invert-func)
- (calc-unpack-bits arg))
-
-
-(defun calc-rnorm (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "rnrm" 'calcFunc-rnorm arg)))
-
-(defun calc-cnorm (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "cnrm" 'calcFunc-cnorm arg)))
-
-(defun calc-mrow (n &optional nn)
- (interactive "NRow number: \nP")
- (calc-wrapper
- (if (consp nn)
- (calc-enter-result 2 "mrow" (cons 'calcFunc-mrow (calc-top-list-n 2)))
- (setq n (prefix-numeric-value n))
- (if (= n 0)
- (calc-enter-result 1 "getd" (list 'calcFunc-getdiag (calc-top-n 1)))
- (if (< n 0)
- (calc-enter-result 1 "rrow" (list 'calcFunc-mrrow
- (calc-top-n 1) (- n)))
- (calc-enter-result 1 "mrow" (list 'calcFunc-mrow
- (calc-top-n 1) n)))))))
-
-(defun calc-mcol (n &optional nn)
- (interactive "NColumn number: \nP")
- (calc-wrapper
- (if (consp nn)
- (calc-enter-result 2 "mcol" (cons 'calcFunc-mcol (calc-top-list-n 2)))
- (setq n (prefix-numeric-value n))
- (if (= n 0)
- (calc-enter-result 1 "getd" (list 'calcFunc-getdiag (calc-top-n 1)))
- (if (< n 0)
- (calc-enter-result 1 "rcol" (list 'calcFunc-mrcol
- (calc-top-n 1) (- n)))
- (calc-enter-result 1 "mcol" (list 'calcFunc-mcol
- (calc-top-n 1) n)))))))
-
-
-;;;; Vectors.
-
-(defun calcFunc-mdims (m)
- (or (math-vectorp m)
- (math-reject-arg m 'vectorp))
- (cons 'vec (math-mat-dimens m)))
-
-
-;;; Apply a function elementwise to vector A. [V X V; N X N] [Public]
-(defun math-map-vec (f a)
- (if (math-vectorp a)
- (cons 'vec (mapcar f (cdr a)))
- (funcall f a)))
-
-(defun math-dimension-error ()
- (calc-record-why "*Dimension error")
- (signal 'wrong-type-argument nil))
-
-
-;;; Build a vector out of a list of objects. [Public]
-(defun calcFunc-vec (&rest objs)
- (cons 'vec objs))
-
-
-;;; Build a constant vector or matrix. [Public]
-(defun calcFunc-cvec (obj &rest dims)
- (math-make-vec-dimen obj dims))
-
-(defun math-make-vec-dimen (obj dims)
- (if dims
- (if (natnump (car dims))
- (if (or (cdr dims)
- (not (math-numberp obj)))
- (cons 'vec (copy-sequence
- (make-list (car dims)
- (math-make-vec-dimen obj (cdr dims)))))
- (cons 'vec (make-list (car dims) obj)))
- (math-reject-arg (car dims) 'fixnatnump))
- obj))
-
-(defun calcFunc-head (vec)
- (if (and (Math-vectorp vec)
- (cdr vec))
- (nth 1 vec)
- (calc-record-why 'vectorp vec)
- (list 'calcFunc-head vec)))
-
-(defun calcFunc-tail (vec)
- (if (and (Math-vectorp vec)
- (cdr vec))
- (cons 'vec (cdr (cdr vec)))
- (calc-record-why 'vectorp vec)
- (list 'calcFunc-tail vec)))
-
-(defun calcFunc-cons (head tail)
- (if (Math-vectorp tail)
- (cons 'vec (cons head (cdr tail)))
- (calc-record-why 'vectorp tail)
- (list 'calcFunc-cons head tail)))
-
-(defun calcFunc-rhead (vec)
- (if (and (Math-vectorp vec)
- (cdr vec))
- (let ((vec (copy-sequence vec)))
- (setcdr (nthcdr (- (length vec) 2) vec) nil)
- vec)
- (calc-record-why 'vectorp vec)
- (list 'calcFunc-rhead vec)))
-
-(defun calcFunc-rtail (vec)
- (if (and (Math-vectorp vec)
- (cdr vec))
- (nth (1- (length vec)) vec)
- (calc-record-why 'vectorp vec)
- (list 'calcFunc-rtail vec)))
-
-(defun calcFunc-rcons (head tail)
- (if (Math-vectorp head)
- (append head (list tail))
- (calc-record-why 'vectorp head)
- (list 'calcFunc-rcons head tail)))
-
-
-
-;;; Apply a function elementwise to vectors A and B. [O X O O] [Public]
-(defun math-map-vec-2 (f a b)
- (if (math-vectorp a)
- (if (math-vectorp b)
- (let ((v nil))
- (while (setq a (cdr a))
- (or (setq b (cdr b))
- (math-dimension-error))
- (setq v (cons (funcall f (car a) (car b)) v)))
- (if a (math-dimension-error))
- (cons 'vec (nreverse v)))
- (let ((v nil))
- (while (setq a (cdr a))
- (setq v (cons (funcall f (car a) b) v)))
- (cons 'vec (nreverse v))))
- (if (math-vectorp b)
- (let ((v nil))
- (while (setq b (cdr b))
- (setq v (cons (funcall f a (car b)) v)))
- (cons 'vec (nreverse v)))
- (funcall f a b))))
-
-
-
-;;; "Reduce" a function over a vector (left-associatively). [O X V] [Public]
-(defun math-reduce-vec (f a)
- (if (math-vectorp a)
- (if (cdr a)
- (let ((accum (car (setq a (cdr a)))))
- (while (setq a (cdr a))
- (setq accum (funcall f accum (car a))))
- accum)
- 0)
- a))
-
-;;; Reduce a function over the columns of matrix A. [V X V] [Public]
-(defun math-reduce-cols (f a)
- (if (math-matrixp a)
- (cons 'vec (math-reduce-cols-col-step f (cdr a) 1 (length (nth 1 a))))
- a))
-
-(defun math-reduce-cols-col-step (f a col cols)
- (and (< col cols)
- (cons (math-reduce-cols-row-step f (nth col (car a)) col (cdr a))
- (math-reduce-cols-col-step f a (1+ col) cols))))
-
-(defun math-reduce-cols-row-step (f tot col a)
- (if a
- (math-reduce-cols-row-step f
- (funcall f tot (nth col (car a)))
- col
- (cdr a))
- tot))
-
-
-
-(defun math-dot-product (a b)
- (if (setq a (cdr a) b (cdr b))
- (let ((accum (math-mul (car a) (car b))))
- (while (setq a (cdr a) b (cdr b))
- (setq accum (math-add accum (math-mul (car a) (car b)))))
- accum)
- 0))
-
-
-;;; Return the number of elements in vector V. [Public]
-(defun calcFunc-vlen (v)
- (if (math-vectorp v)
- (1- (length v))
- (if (math-objectp v)
- 0
- (list 'calcFunc-vlen v))))
-
-;;; Get the Nth row of a matrix.
-(defun calcFunc-mrow (mat n) ; [Public]
- (if (Math-vectorp n)
- (math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n)
- (if (and (eq (car-safe n) 'intv) (math-constp n))
- (calcFunc-subvec mat
- (math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
- (math-add (nth 3 n) (if (memq (nth 1 n) '(1 3)) 1 0)))
- (or (and (integerp (setq n (math-check-integer n)))
- (> n 0))
- (math-reject-arg n 'fixposintp))
- (or (Math-vectorp mat)
- (math-reject-arg mat 'vectorp))
- (or (nth n mat)
- (math-reject-arg n "*Index out of range")))))
-
-(defun calcFunc-subscr (mat n &optional m)
- (setq mat (calcFunc-mrow mat n))
- (if m
- (if (math-num-integerp n)
- (calcFunc-mrow mat m)
- (calcFunc-mcol mat m))
- mat))
-
-;;; Get the Nth column of a matrix.
-(defun math-mat-col (mat n)
- (cons 'vec (mapcar (function (lambda (x) (elt x n))) (cdr mat))))
-
-(defun calcFunc-mcol (mat n) ; [Public]
- (if (Math-vectorp n)
- (calcFunc-trn
- (math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n))
- (if (and (eq (car-safe n) 'intv) (math-constp n))
- (if (math-matrixp mat)
- (math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat)
- (calcFunc-mrow mat n))
- (or (and (integerp (setq n (math-check-integer n)))
- (> n 0))
- (math-reject-arg n 'fixposintp))
- (or (Math-vectorp mat)
- (math-reject-arg mat 'vectorp))
- (or (if (math-matrixp mat)
- (and (< n (length (nth 1 mat)))
- (math-mat-col mat n))
- (nth n mat))
- (math-reject-arg n "*Index out of range")))))
-
-;;; Remove the Nth row from a matrix.
-(defun math-mat-less-row (mat n)
- (if (<= n 0)
- (cdr mat)
- (cons (car mat)
- (math-mat-less-row (cdr mat) (1- n)))))
-
-(defun calcFunc-mrrow (mat n) ; [Public]
- (and (integerp (setq n (math-check-integer n)))
- (> n 0)
- (< n (length mat))
- (math-mat-less-row mat n)))
-
-;;; Remove the Nth column from a matrix.
-(defun math-mat-less-col (mat n)
- (cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n)))
- (cdr mat))))
-
-(defun calcFunc-mrcol (mat n) ; [Public]
- (and (integerp (setq n (math-check-integer n)))
- (> n 0)
- (if (math-matrixp mat)
- (and (< n (length (nth 1 mat)))
- (math-mat-less-col mat n))
- (math-mat-less-row mat n))))
-
-(defun calcFunc-getdiag (mat) ; [Public]
- (if (math-square-matrixp mat)
- (cons 'vec (math-get-diag-step (cdr mat) 1))
- (calc-record-why 'square-matrixp mat)
- (list 'calcFunc-getdiag mat)))
-
-(defun math-get-diag-step (row n)
- (and row
- (cons (nth n (car row))
- (math-get-diag-step (cdr row) (1+ n)))))
-
-(defun math-transpose (mat) ; [Public]
- (let ((m nil)
- (col (length (nth 1 mat))))
- (while (> (setq col (1- col)) 0)
- (setq m (cons (math-mat-col mat col) m)))
- (cons 'vec m)))
-
-(defun calcFunc-trn (mat)
- (if (math-vectorp mat)
- (if (math-matrixp mat)
- (math-transpose mat)
- (math-col-matrix mat))
- (if (math-numberp mat)
- mat
- (math-reject-arg mat 'matrixp))))
-
-(defun calcFunc-ctrn (mat)
- (calcFunc-conj (calcFunc-trn mat)))
-
-(defun calcFunc-pack (mode els)
- (or (Math-vectorp els) (math-reject-arg els 'vectorp))
- (if (and (Math-vectorp mode) (cdr mode))
- (setq mode (cdr mode))
- (or (integerp mode) (math-reject-arg mode 'fixnump)))
- (condition-case err
- (if (= (calc-pack-size mode) (1- (length els)))
- (calc-pack-items mode (cdr els))
- (math-reject-arg els "*Wrong number of elements"))
- (error (math-reject-arg els (nth 1 err)))))
-
-(defun calcFunc-unpack (mode thing)
- (or (integerp mode) (math-reject-arg mode 'fixnump))
- (condition-case err
- (cons 'vec (calc-unpack-item mode thing))
- (error (math-reject-arg thing (nth 1 err)))))
-
-(defun calcFunc-unpackt (mode thing)
- (let ((calc-unpack-with-type 'pair))
- (calcFunc-unpack mode thing)))
-
-(defun calcFunc-arrange (vec cols) ; [Public]
- (setq cols (math-check-fixnum cols t))
- (if (math-vectorp vec)
- (let* ((flat (math-flatten-vector vec))
- (mat (list 'vec))
- next)
- (if (<= cols 0)
- (nconc mat flat)
- (while (>= (length flat) cols)
- (setq next (nthcdr cols flat))
- (setcdr (nthcdr (1- cols) flat) nil)
- (setq mat (nconc mat (list (cons 'vec flat)))
- flat next))
- (if flat
- (setq mat (nconc mat (list (cons 'vec flat)))))
- mat))))
-
-(defun math-flatten-vector (vec) ; [L V]
- (if (math-vectorp vec)
- (apply 'append (mapcar 'math-flatten-vector (cdr vec)))
- (list vec)))
-
-(defun calcFunc-vconcat (a b)
- (math-normalize (list '| a b)))
-
-(defun calcFunc-vconcatrev (a b)
- (math-normalize (list '| b a)))
-
-(defun calcFunc-append (v1 v2)
- (if (and (math-vectorp v1) (math-vectorp v2))
- (append v1 (cdr v2))
- (list 'calcFunc-append v1 v2)))
-
-(defun calcFunc-appendrev (v1 v2)
- (calcFunc-append v2 v1))
-
-
-;;; Copy a matrix. [Public]
-(defun math-copy-matrix (m)
- (if (math-vectorp (nth 1 m))
- (cons 'vec (mapcar 'copy-sequence (cdr m)))
- (copy-sequence m)))
-
-;;; Convert a scalar or vector into an NxN diagonal matrix. [Public]
-(defun calcFunc-diag (a &optional n)
- (and n (not (integerp n))
- (setq n (math-check-fixnum n)))
- (if (math-vectorp a)
- (if (and n (/= (length a) (1+ n)))
- (list 'calcFunc-diag a n)
- (if (math-matrixp a)
- (if (and n (/= (length (elt a 1)) (1+ n)))
- (list 'calcFunc-diag a n)
- a)
- (cons 'vec (math-diag-step (cdr a) 0 (1- (length a))))))
- (if n
- (cons 'vec (math-diag-step (make-list n a) 0 n))
- (list 'calcFunc-diag a))))
-
-(defun calcFunc-idn (a &optional n)
- (if n
- (if (math-vectorp a)
- (math-reject-arg a 'numberp)
- (calcFunc-diag a n))
- (if (integerp calc-matrix-mode)
- (calcFunc-idn a calc-matrix-mode)
- (list 'calcFunc-idn a))))
-
-(defun math-mimic-ident (a m)
- (if (math-square-matrixp m)
- (calcFunc-idn a (1- (length m)))
- (if (math-vectorp m)
- (if (math-zerop a)
- (cons 'vec (mapcar (function (lambda (x)
- (if (math-vectorp x)
- (math-mimic-ident a x)
- a)))
- (cdr m)))
- (math-dimension-error))
- (calcFunc-idn a))))
-
-(defun math-diag-step (a n m)
- (if (< n m)
- (cons (cons 'vec
- (nconc (make-list n 0)
- (cons (car a)
- (make-list (1- (- m n)) 0))))
- (math-diag-step (cdr a) (1+ n) m))
- nil))
-
-;;; Create a vector of consecutive integers. [Public]
-(defun calcFunc-index (n &optional start incr)
- (if (math-messy-integerp n)
- (math-float (calcFunc-index (math-trunc n) start incr))
- (and (not (integerp n))
- (setq n (math-check-fixnum n)))
- (let ((vec nil))
- (if start
- (progn
- (if (>= n 0)
- (while (>= (setq n (1- n)) 0)
- (setq vec (cons start vec)
- start (math-add start (or incr 1))))
- (while (<= (setq n (1+ n)) 0)
- (setq vec (cons start vec)
- start (math-mul start (or incr 2)))))
- (setq vec (nreverse vec)))
- (if (>= n 0)
- (while (> n 0)
- (setq vec (cons n vec)
- n (1- n)))
- (let ((i -1))
- (while (>= i n)
- (setq vec (cons i vec)
- i (1- i))))))
- (cons 'vec vec))))
-
-;;; Find an element in a vector.
-(defun calcFunc-find (vec x &optional start)
- (setq start (if start (math-check-fixnum start t) 1))
- (if (< start 1) (math-reject-arg start 'posp))
- (setq vec (nthcdr start vec))
- (let ((n start))
- (while (and vec (not (Math-equal x (car vec))))
- (setq n (1+ n)
- vec (cdr vec)))
- (if vec n 0)))
-
-;;; Return a subvector of a vector.
-(defun calcFunc-subvec (vec start &optional end)
- (setq start (math-check-fixnum start t)
- end (math-check-fixnum (or end 0) t))
- (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
- (let ((len (1- (length vec))))
- (if (<= start 0)
- (setq start (+ len start 1)))
- (if (<= end 0)
- (setq end (+ len end 1)))
- (if (or (> start len)
- (<= end start))
- '(vec)
- (setq vec (nthcdr start vec))
- (if (<= end len)
- (let ((chop (nthcdr (- end start 1) (setq vec (copy-sequence vec)))))
- (setcdr chop nil)))
- (cons 'vec vec))))
-
-;;; Remove a subvector from a vector.
-(defun calcFunc-rsubvec (vec start &optional end)
- (setq start (math-check-fixnum start t)
- end (math-check-fixnum (or end 0) t))
- (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
- (let ((len (1- (length vec))))
- (if (<= start 0)
- (setq start (+ len start 1)))
- (if (<= end 0)
- (setq end (+ len end 1)))
- (if (or (> start len)
- (<= end start))
- vec
- (let ((tail (nthcdr end vec))
- (chop (nthcdr (1- start) (setq vec (copy-sequence vec)))))
- (setcdr chop nil)
- (append vec tail)))))
-
-;;; Reverse the order of the elements of a vector.
-(defun calcFunc-rev (vec)
- (if (math-vectorp vec)
- (cons 'vec (reverse (cdr vec)))
- (math-reject-arg vec 'vectorp)))
-
-;;; Compress a vector according to a mask vector.
-(defun calcFunc-vmask (mask vec)
- (if (math-numberp mask)
- (if (math-zerop mask)
- '(vec)
- vec)
- (or (math-vectorp mask) (math-reject-arg mask 'vectorp))
- (or (math-constp mask) (math-reject-arg mask 'constp))
- (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
- (or (= (length mask) (length vec)) (math-dimension-error))
- (let ((new nil))
- (while (setq mask (cdr mask) vec (cdr vec))
- (or (math-zerop (car mask))
- (setq new (cons (car vec) new))))
- (cons 'vec (nreverse new)))))
-
-;;; Expand a vector according to a mask vector.
-(defun calcFunc-vexp (mask vec &optional filler)
- (or (math-vectorp mask) (math-reject-arg mask 'vectorp))
- (or (math-constp mask) (math-reject-arg mask 'constp))
- (or (math-vectorp vec) (math-reject-arg vec 'vectorp))
- (let ((new nil)
- (fvec (and filler (math-vectorp filler))))
- (while (setq mask (cdr mask))
- (if (math-zerop (car mask))
- (setq new (cons (or (if fvec
- (car (setq filler (cdr filler)))
- filler)
- (car mask)) new))
- (setq vec (cdr vec)
- new (cons (or (car vec) (car mask)) new))))
- (cons 'vec (nreverse new))))
-
-
-;;; Compute the row and column norms of a vector or matrix. [Public]
-(defun calcFunc-rnorm (a)
- (if (and (Math-vectorp a)
- (math-constp a))
- (if (math-matrixp a)
- (math-reduce-vec 'math-max (math-map-vec 'calcFunc-cnorm a))
- (math-reduce-vec 'math-max (math-map-vec 'math-abs a)))
- (calc-record-why 'vectorp a)
- (list 'calcFunc-rnorm a)))
-
-(defun calcFunc-cnorm (a)
- (if (and (Math-vectorp a)
- (math-constp a))
- (if (math-matrixp a)
- (math-reduce-vec 'math-max
- (math-reduce-cols 'math-add-abs a))
- (math-reduce-vec 'math-add-abs a))
- (calc-record-why 'vectorp a)
- (list 'calcFunc-cnorm a)))
-
-(defun math-add-abs (a b)
- (math-add (math-abs a) (math-abs b)))
-
-
-;;; Sort the elements of a vector into increasing order.
-(defun calcFunc-sort (vec) ; [Public]
- (if (math-vectorp vec)
- (cons 'vec (sort (copy-sequence (cdr vec)) 'math-beforep))
- (math-reject-arg vec 'vectorp)))
-
-(defun calcFunc-rsort (vec) ; [Public]
- (if (math-vectorp vec)
- (cons 'vec (nreverse (sort (copy-sequence (cdr vec)) 'math-beforep)))
- (math-reject-arg vec 'vectorp)))
-
-(defun calcFunc-grade (grade-vec)
- (if (math-vectorp grade-vec)
- (let* ((len (1- (length grade-vec))))
- (cons 'vec (sort (cdr (calcFunc-index len)) 'math-grade-beforep)))
- (math-reject-arg grade-vec 'vectorp)))
-
-(defun calcFunc-rgrade (grade-vec)
- (if (math-vectorp grade-vec)
- (let* ((len (1- (length grade-vec))))
- (cons 'vec (nreverse (sort (cdr (calcFunc-index len))
- 'math-grade-beforep))))
- (math-reject-arg grade-vec 'vectorp)))
-
-(defun math-grade-beforep (i j)
- (math-beforep (nth i grade-vec) (nth j grade-vec)))
-
-
-;;; Compile a histogram of data from a vector.
-(defun calcFunc-histogram (vec wts &optional n)
- (or n (setq n wts wts 1))
- (or (Math-vectorp vec)
- (math-reject-arg vec 'vectorp))
- (if (Math-vectorp wts)
- (or (= (length vec) (length wts))
- (math-dimension-error)))
- (or (natnump n)
- (math-reject-arg n 'fixnatnump))
- (let ((res (make-vector n 0))
- (vp vec)
- (wvec (Math-vectorp wts))
- (wp wts)
- bin)
- (while (setq vp (cdr vp))
- (setq bin (car vp))
- (or (natnump bin)
- (setq bin (math-floor bin)))
- (and (natnump bin)
- (< bin n)
- (aset res bin (math-add (aref res bin)
- (if wvec (car (setq wp (cdr wp))) wts)))))
- (cons 'vec (append res nil))))
-
-
-;;; Set operations.
-
-(defun calcFunc-vunion (a b)
- (if (Math-objectp a)
- (setq a (list 'vec a))
- (or (math-vectorp a) (math-reject-arg a 'vectorp)))
- (if (Math-objectp b)
- (setq b (list b))
- (or (math-vectorp b) (math-reject-arg b 'vectorp))
- (setq b (cdr b)))
- (calcFunc-rdup (append a b)))
-
-(defun calcFunc-vint (a b)
- (if (and (math-simple-set a) (math-simple-set b))
- (progn
- (setq a (cdr (calcFunc-rdup a)))
- (setq b (cdr (calcFunc-rdup b)))
- (let ((vec (list 'vec)))
- (while (and a b)
- (if (math-beforep (car a) (car b))
- (setq a (cdr a))
- (if (Math-equal (car a) (car b))
- (setq vec (cons (car a) vec)
- a (cdr a)))
- (setq b (cdr b))))
- (nreverse vec)))
- (calcFunc-vcompl (calcFunc-vunion (calcFunc-vcompl a)
- (calcFunc-vcompl b)))))
-
-(defun calcFunc-vdiff (a b)
- (if (and (math-simple-set a) (math-simple-set b))
- (progn
- (setq a (cdr (calcFunc-rdup a)))
- (setq b (cdr (calcFunc-rdup b)))
- (let ((vec (list 'vec)))
- (while a
- (while (and b (math-beforep (car b) (car a)))
- (setq b (cdr b)))
- (if (and b (Math-equal (car a) (car b)))
- (setq a (cdr a)
- b (cdr b))
- (setq vec (cons (car a) vec)
- a (cdr a))))
- (nreverse vec)))
- (calcFunc-vcompl (calcFunc-vunion (calcFunc-vcompl a) b))))
-
-(defun calcFunc-vxor (a b)
- (if (and (math-simple-set a) (math-simple-set b))
- (progn
- (setq a (cdr (calcFunc-rdup a)))
- (setq b (cdr (calcFunc-rdup b)))
- (let ((vec (list 'vec)))
- (while (or a b)
- (if (and a
- (or (not b)
- (math-beforep (car a) (car b))))
- (setq vec (cons (car a) vec)
- a (cdr a))
- (if (and a (Math-equal (car a) (car b)))
- (setq a (cdr a))
- (setq vec (cons (car b) vec)))
- (setq b (cdr b))))
- (nreverse vec)))
- (let ((ca (calcFunc-vcompl a))
- (cb (calcFunc-vcompl b)))
- (calcFunc-vunion (calcFunc-vcompl (calcFunc-vunion ca b))
- (calcFunc-vcompl (calcFunc-vunion a cb))))))
-
-(defun calcFunc-vcompl (a)
- (setq a (math-prepare-set a))
- (let ((vec (list 'vec))
- (prev '(neg (var inf var-inf)))
- (closed 2))
- (while (setq a (cdr a))
- (or (and (equal (nth 2 (car a)) '(neg (var inf var-inf)))
- (memq (nth 1 (car a)) '(2 3)))
- (setq vec (cons (list 'intv
- (+ closed
- (if (memq (nth 1 (car a)) '(0 1)) 1 0))
- prev
- (nth 2 (car a)))
- vec)))
- (setq prev (nth 3 (car a))
- closed (if (memq (nth 1 (car a)) '(0 2)) 2 0)))
- (or (and (equal prev '(var inf var-inf))
- (= closed 0))
- (setq vec (cons (list 'intv (+ closed 1)
- prev '(var inf var-inf))
- vec)))
- (math-clean-set (nreverse vec))))
-
-(defun calcFunc-vspan (a)
- (setq a (math-prepare-set a))
- (if (cdr a)
- (let ((last (nth (1- (length a)) a)))
- (math-make-intv (+ (logand (nth 1 (nth 1 a)) 2)
- (logand (nth 1 last) 1))
- (nth 2 (nth 1 a))
- (nth 3 last)))
- '(intv 2 0 0)))
-
-(defun calcFunc-vfloor (a &optional always-vec)
- (setq a (math-prepare-set a))
- (let ((vec (list 'vec)) (p a) (prev nil) b mask)
- (while (setq p (cdr p))
- (setq mask (nth 1 (car p))
- a (nth 2 (car p))
- b (nth 3 (car p)))
- (and (memq mask '(0 1))
- (not (math-infinitep a))
- (setq mask (logior mask 2))
- (math-num-integerp a)
- (setq a (math-add a 1)))
- (setq a (math-ceiling a))
- (and (memq mask '(0 2))
- (not (math-infinitep b))
- (setq mask (logior mask 1))
- (math-num-integerp b)
- (setq b (math-sub b 1)))
- (setq b (math-floor b))
- (if (and prev (Math-equal (math-sub a 1) (nth 3 prev)))
- (setcar (nthcdr 3 prev) b)
- (or (Math-lessp b a)
- (setq vec (cons (setq prev (list 'intv mask a b)) vec)))))
- (setq vec (nreverse vec))
- (math-clean-set vec always-vec)))
-
-(defun calcFunc-vcard (a)
- (setq a (calcFunc-vfloor a t))
- (or (math-constp a) (math-reject-arg a "*Set must be finite"))
- (let ((count 0))
- (while (setq a (cdr a))
- (if (eq (car-safe (car a)) 'intv)
- (setq count (math-add count (math-sub (nth 3 (car a))
- (nth 2 (car a))))))
- (setq count (math-add count 1)))
- count))
-
-(defun calcFunc-venum (a)
- (setq a (calcFunc-vfloor a t))
- (or (math-constp a) (math-reject-arg a "*Set must be finite"))
- (let ((p a) next)
- (while (cdr p)
- (setq next (cdr p))
- (if (eq (car-safe (nth 1 p)) 'intv)
- (setcdr p (nconc (cdr (calcFunc-index (math-add
- (math-sub (nth 3 (nth 1 p))
- (nth 2 (nth 1 p)))
- 1)
- (nth 2 (nth 1 p))))
- (cdr (cdr p)))))
- (setq p next))
- a))
-
-(defun calcFunc-vpack (a)
- (setq a (calcFunc-vfloor a t))
- (if (and (cdr a)
- (math-negp (if (eq (car-safe (nth 1 a)) 'intv)
- (nth 2 (nth 1 a))
- (nth 1 a))))
- (math-reject-arg (nth 1 a) 'posp))
- (let ((accum 0))
- (while (setq a (cdr a))
- (if (eq (car-safe (car a)) 'intv)
- (if (equal (nth 3 (car a)) '(var inf var-inf))
- (setq accum (math-sub accum
- (math-power-of-2 (nth 2 (car a)))))
- (setq accum (math-add accum
- (math-sub
- (math-power-of-2 (1+ (nth 3 (car a))))
- (math-power-of-2 (nth 2 (car a)))))))
- (setq accum (math-add accum (math-power-of-2 (car a))))))
- accum))
-
-(defun calcFunc-vunpack (a &optional w)
- (or (math-num-integerp a) (math-reject-arg a 'integerp))
- (if w (setq a (math-clip a w)))
- (if (math-messy-integerp a) (setq a (math-trunc a)))
- (let* ((calc-number-radix 2)
- (neg (math-negp a))
- (aa (if neg (math-sub -1 a) a))
- (str (if (eq aa 0)
- ""
- (if (consp aa)
- (math-format-bignum-binary (cdr aa))
- (math-format-binary aa))))
- (zero (if neg ?1 ?0))
- (one (if neg ?0 ?1))
- (len (length str))
- (vec (list 'vec))
- (pos (1- len)) pos2)
- (while (>= pos 0)
- (if (eq (aref str pos) zero)
- (setq pos (1- pos))
- (setq pos2 pos)
- (while (and (>= pos 0) (eq (aref str pos) one))
- (setq pos (1- pos)))
- (setq vec (cons (if (= pos (1- pos2))
- (- len pos2 1)
- (list 'intv 3 (- len pos2 1) (- len pos 2)))
- vec))))
- (if neg
- (setq vec (cons (list 'intv 2 len '(var inf var-inf)) vec)))
- (math-clean-set (nreverse vec))))
-
-(defun calcFunc-rdup (a)
- (if (math-simple-set a)
- (progn
- (and (Math-objectp a) (setq a (list 'vec a)))
- (or (math-vectorp a) (math-reject-arg a 'vectorp))
- (setq a (sort (copy-sequence (cdr a)) 'math-beforep))
- (let ((p a))
- (while (cdr p)
- (if (Math-equal (car p) (nth 1 p))
- (setcdr p (cdr (cdr p)))
- (setq p (cdr p)))))
- (cons 'vec a))
- (math-clean-set (math-prepare-set a))))
-
-(defun math-prepare-set (a)
- (if (Math-objectp a)
- (setq a (list 'vec a))
- (or (math-vectorp a) (math-reject-arg a 'vectorp))
- (setq a (cons 'vec (sort (copy-sequence (cdr a)) 'math-beforep))))
- (let ((p a) res)
-
- ;; Convert all elements to non-empty intervals.
- (while (cdr p)
- (if (eq (car-safe (nth 1 p)) 'intv)
- (if (math-intv-constp (nth 1 p))
- (if (and (memq (nth 1 (nth 1 p)) '(0 1 2))
- (Math-equal (nth 2 (nth 1 p)) (nth 3 (nth 1 p))))
- (setcdr p (cdr (cdr p)))
- (setq p (cdr p)))
- (math-reject-arg (nth 1 p) 'constp))
- (or (Math-anglep (nth 1 p))
- (eq (car (nth 1 p)) 'date)
- (equal (nth 1 p) '(var inf var-inf))
- (equal (nth 1 p) '(neg (var inf var-inf)))
- (math-reject-arg (nth 1 p) 'realp))
- (setcar (cdr p) (list 'intv 3 (nth 1 p) (nth 1 p)))
- (setq p (cdr p))))
-
- ;; Combine redundant intervals.
- (setq p a)
- (while (cdr (cdr p))
- (if (or (memq (setq res (math-compare (nth 3 (nth 1 p))
- (nth 2 (nth 2 p))))
- '(-1 2))
- (and (eq res 0)
- (memq (nth 1 (nth 1 p)) '(0 2))
- (memq (nth 1 (nth 2 p)) '(0 1))))
- (setq p (cdr p))
- (setq res (math-compare (nth 3 (nth 1 p)) (nth 3 (nth 2 p))))
- (setcdr p (cons (list 'intv
- (+ (logand (logior (nth 1 (nth 1 p))
- (if (Math-equal
- (nth 2 (nth 1 p))
- (nth 2 (nth 2 p)))
- (nth 1 (nth 2 p))
- 0))
- 2)
- (logand (logior (if (memq res '(1 0 2))
- (nth 1 (nth 1 p)) 0)
- (if (memq res '(-1 0 2))
- (nth 1 (nth 2 p)) 0))
- 1))
- (nth 2 (nth 1 p))
- (if (eq res 1)
- (nth 3 (nth 1 p))
- (nth 3 (nth 2 p))))
- (cdr (cdr (cdr p))))))))
- a)
-
-(defun math-clean-set (a &optional always-vec)
- (let ((p a) res)
- (while (cdr p)
- (if (and (eq (car-safe (nth 1 p)) 'intv)
- (Math-equal (nth 2 (nth 1 p)) (nth 3 (nth 1 p))))
- (setcar (cdr p) (nth 2 (nth 1 p))))
- (setq p (cdr p)))
- (if (and (not (cdr (cdr a)))
- (eq (car-safe (nth 1 a)) 'intv)
- (not always-vec))
- (nth 1 a)
- a)))
-
-(defun math-simple-set (a)
- (or (and (Math-objectp a)
- (not (eq (car-safe a) 'intv)))
- (and (Math-vectorp a)
- (progn
- (while (and (setq a (cdr a))
- (not (eq (car-safe (car a)) 'intv))))
- (null a)))))
-
-
-
-
-;;; Compute a right-handed vector cross product. [O O O] [Public]
-(defun calcFunc-cross (a b)
- (if (and (eq (car-safe a) 'vec)
- (= (length a) 4))
- (if (and (eq (car-safe b) 'vec)
- (= (length b) 4))
- (list 'vec
- (math-sub (math-mul (nth 2 a) (nth 3 b))
- (math-mul (nth 3 a) (nth 2 b)))
- (math-sub (math-mul (nth 3 a) (nth 1 b))
- (math-mul (nth 1 a) (nth 3 b)))
- (math-sub (math-mul (nth 1 a) (nth 2 b))
- (math-mul (nth 2 a) (nth 1 b))))
- (math-reject-arg b "*Three-vector expected"))
- (math-reject-arg a "*Three-vector expected")))
-
-
-
-
-
-(defun math-read-brackets (space-sep close)
- (and space-sep (setq space-sep (not (math-check-for-commas))))
- (math-read-token)
- (while (eq exp-token 'space)
- (math-read-token))
- (if (or (equal exp-data close)
- (eq exp-token 'end))
- (progn
- (math-read-token)
- '(vec))
- (let ((save-exp-pos exp-pos)
- (save-exp-old-pos exp-old-pos)
- (save-exp-token exp-token)
- (save-exp-data exp-data)
- (vals (let ((exp-keep-spaces space-sep))
- (if (or (equal exp-data "\\dots")
- (equal exp-data "\\ldots"))
- '(vec (neg (var inf var-inf)))
- (catch 'syntax (math-read-vector))))))
- (if (stringp vals)
- (if space-sep
- (let ((error-exp-pos exp-pos)
- (error-exp-old-pos exp-old-pos)
- vals2)
- (setq exp-pos save-exp-pos
- exp-old-pos save-exp-old-pos
- exp-token save-exp-token
- exp-data save-exp-data)
- (let ((exp-keep-spaces nil))
- (setq vals2 (catch 'syntax (math-read-vector))))
- (if (and (not (stringp vals2))
- (or (assoc exp-data '(("\\ldots") ("\\dots") (";")))
- (equal exp-data close)
- (eq exp-token 'end)))
- (setq space-sep nil
- vals vals2)
- (setq exp-pos error-exp-pos
- exp-old-pos error-exp-old-pos)
- (throw 'syntax vals)))
- (throw 'syntax vals)))
- (if (or (equal exp-data "\\dots")
- (equal exp-data "\\ldots"))
- (progn
- (math-read-token)
- (setq vals (if (> (length vals) 2)
- (cons 'calcFunc-mul (cdr vals)) (nth 1 vals)))
- (let ((exp2 (if (or (equal exp-data close)
- (equal exp-data ")")
- (eq exp-token 'end))
- '(var inf var-inf)
- (math-read-expr-level 0))))
- (setq vals
- (list 'intv
- (if (equal exp-data ")") 2 3)
- vals
- exp2)))
- (if (not (or (equal exp-data close)
- (equal exp-data ")")
- (eq exp-token 'end)))
- (throw 'syntax "Expected `]'")))
- (if (equal exp-data ";")
- (let ((exp-keep-spaces space-sep))
- (setq vals (cons 'vec (math-read-matrix (list vals))))))
- (if (not (or (equal exp-data close)
- (eq exp-token 'end)))
- (throw 'syntax "Expected `]'")))
- (or (eq exp-token 'end)
- (math-read-token))
- vals)))
-
-(defun math-check-for-commas (&optional balancing)
- (let ((count 0)
- (pos (1- exp-pos)))
- (while (and (>= count 0)
- (setq pos (string-match
- (if balancing "[],[{}()<>]" "[],[{}()]")
- exp-str (1+ pos)))
- (or (/= (aref exp-str pos) ?,) (> count 0) balancing))
- (cond ((memq (aref exp-str pos) '(?\[ ?\{ ?\( ?\<))
- (setq count (1+ count)))
- ((memq (aref exp-str pos) '(?\] ?\} ?\) ?\>))
- (setq count (1- count)))))
- (if balancing
- pos
- (and pos (= (aref exp-str pos) ?,)))))
-
-(defun math-read-vector ()
- (let* ((val (list (math-read-expr-level 0)))
- (last val))
- (while (progn
- (while (eq exp-token 'space)
- (math-read-token))
- (and (not (eq exp-token 'end))
- (not (equal exp-data ";"))
- (not (equal exp-data close))
- (not (equal exp-data "\\dots"))
- (not (equal exp-data "\\ldots"))))
- (if (equal exp-data ",")
- (math-read-token))
- (while (eq exp-token 'space)
- (math-read-token))
- (let ((rest (list (math-read-expr-level 0))))
- (setcdr last rest)
- (setq last rest)))
- (cons 'vec val)))
-
-(defun math-read-matrix (mat)
- (while (equal exp-data ";")
- (math-read-token)
- (while (eq exp-token 'space)
- (math-read-token))
- (setq mat (nconc mat (list (math-read-vector)))))
- mat)
-
-;;; calc-vec.el ends here
+++ /dev/null
-;;; calc-yank.el --- kill-ring functionality for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-yank () nil)
-
-
-;;; Kill ring commands.
-
-(defun calc-kill (nn &optional no-delete)
- (interactive "P")
- (if (eq major-mode 'calc-mode)
- (calc-wrapper
- (calc-force-refresh)
- (calc-set-command-flag 'no-align)
- (let ((num (max (calc-locate-cursor-element (point)) 1))
- (n (prefix-numeric-value nn)))
- (if (< n 0)
- (progn
- (if (eobp)
- (setq num (1- num)))
- (setq num (- num n)
- n (- n))))
- (let ((stuff (calc-top-list n (- num n -1))))
- (calc-cursor-stack-index num)
- (let ((first (point)))
- (calc-cursor-stack-index (- num n))
- (if (null nn)
- (backward-char 1)) ; don't include newline for raw C-k
- (copy-region-as-kill first (point))
- (if (not no-delete)
- (calc-pop-stack n (- num n -1))))
- (setq calc-last-kill (cons (car kill-ring) stuff)))))
- (kill-line nn)))
-
-(defun calc-force-refresh ()
- (if (or calc-executing-macro calc-display-dirty)
- (let ((calc-executing-macro nil))
- (calc-refresh))))
-
-(defun calc-locate-cursor-element (pt)
- (save-excursion
- (goto-char (point-max))
- (calc-locate-cursor-scan (- calc-stack-top) calc-stack pt)))
-
-(defun calc-locate-cursor-scan (n stack pt)
- (if (or (<= (point) pt)
- (null stack))
- n
- (forward-line (- (nth 1 (car stack))))
- (calc-locate-cursor-scan (1+ n) (cdr stack) pt)))
-
-(defun calc-kill-region (top bot &optional no-delete)
- (interactive "r")
- (if (eq major-mode 'calc-mode)
- (calc-wrapper
- (calc-force-refresh)
- (calc-set-command-flag 'no-align)
- (let* ((top-num (calc-locate-cursor-element top))
- (bot-num (calc-locate-cursor-element (1- bot)))
- (num (- top-num bot-num -1)))
- (copy-region-as-kill top bot)
- (setq calc-last-kill (cons (car kill-ring)
- (calc-top-list num bot-num)))
- (if (not no-delete)
- (calc-pop-stack num bot-num))))
- (if no-delete
- (copy-region-as-kill top bot)
- (kill-region top bot))))
-
-(defun calc-copy-as-kill (n)
- (interactive "P")
- (calc-kill n t))
-
-(defun calc-copy-region-as-kill (top bot)
- (interactive "r")
- (calc-kill-region top bot t))
-
-;;; This function uses calc-last-kill if possible to get an exact result,
-;;; otherwise it just parses the yanked string.
-;;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96
-(defun calc-yank ()
- (interactive)
- (calc-wrapper
- (calc-pop-push-record-list
- 0 "yank"
- (let ((thing (if (fboundp 'current-kill)
- (current-kill 0 t)
- (car kill-ring-yank-pointer))))
- (if (eq (car-safe calc-last-kill) thing)
- (cdr calc-last-kill)
- (if (stringp thing)
- (let ((val (math-read-exprs (calc-clean-newlines thing))))
- (if (eq (car-safe val) 'error)
- (progn
- (setq val (math-read-exprs thing))
- (if (eq (car-safe val) 'error)
- (error "Bad format in yanked data")
- val))
- val))))))))
-
-(defun calc-clean-newlines (s)
- (cond
-
- ;; Omit leading/trailing whitespace
- ((or (string-match "\\`[ \n\r]+\\([^\001]*\\)\\'" s)
- (string-match "\\`\\([^\001]*\\)[ \n\r]+\\'" s))
- (calc-clean-newlines (math-match-substring s 1)))
-
- ;; Convert newlines to commas
- ((string-match "\\`\\(.*\\)[\n\r]+\\([^\001]*\\)\\'" s)
- (calc-clean-newlines (concat (math-match-substring s 1) ","
- (math-match-substring s 2))))
-
- (t s)))
-
-
-(defun calc-do-grab-region (top bot arg)
- (when (memq major-mode '(calc-mode calc-trail-mode))
- (error "This command works only in a regular text buffer"))
- (let* ((from-buffer (current-buffer))
- (calc-was-started (get-buffer-window "*Calculator*"))
- (single nil)
- data vals pos)
- (if arg
- (if (consp arg)
- (setq single t)
- (setq arg (prefix-numeric-value arg))
- (if (= arg 0)
- (save-excursion
- (beginning-of-line)
- (setq top (point))
- (end-of-line)
- (setq bot (point)))
- (save-excursion
- (setq top (point))
- (forward-line arg)
- (if (> arg 0)
- (setq bot (point))
- (setq bot top
- top (point)))))))
- (setq data (buffer-substring top bot))
- (calc)
- (if single
- (setq vals (math-read-expr data))
- (setq vals (math-read-expr (concat "[" data "]")))
- (and (eq (car-safe vals) 'vec)
- (= (length vals) 2)
- (eq (car-safe (nth 1 vals)) 'vec)
- (setq vals (nth 1 vals))))
- (if (eq (car-safe vals) 'error)
- (progn
- (if calc-was-started
- (pop-to-buffer from-buffer)
- (calc-quit t)
- (switch-to-buffer from-buffer))
- (goto-char top)
- (forward-char (+ (nth 1 vals) (if single 0 1)))
- (error (nth 2 vals))))
- (calc-slow-wrapper
- (calc-enter-result 0 "grab" vals))))
-
-
-(defun calc-do-grab-rectangle (top bot arg &optional reduce)
- (and (memq major-mode '(calc-mode calc-trail-mode))
- (error "This command works only in a regular text buffer"))
- (let* ((col1 (save-excursion (goto-char top) (current-column)))
- (col2 (save-excursion (goto-char bot) (current-column)))
- (from-buffer (current-buffer))
- (calc-was-started (get-buffer-window "*Calculator*"))
- data mat vals lnum pt pos)
- (if (= col1 col2)
- (save-excursion
- (unless (= col1 0)
- (error "Point and mark must be at beginning of line, or define a rectangle"))
- (goto-char top)
- (while (< (point) bot)
- (setq pt (point))
- (forward-line 1)
- (setq data (cons (buffer-substring pt (1- (point))) data)))
- (setq data (nreverse data)))
- (setq data (extract-rectangle top bot)))
- (calc)
- (setq mat (list 'vec)
- lnum 0)
- (when arg
- (setq arg (if (consp arg) 0 (prefix-numeric-value arg))))
- (while data
- (if (natnump arg)
- (progn
- (if (= arg 0)
- (setq arg 1000000))
- (setq pos 0
- vals (list 'vec))
- (let ((w (length (car data)))
- j v)
- (while (< pos w)
- (setq j (+ pos arg)
- v (if (>= j w)
- (math-read-expr (substring (car data) pos))
- (math-read-expr (substring (car data) pos j))))
- (if (eq (car-safe v) 'error)
- (setq vals v w 0)
- (setq vals (nconc vals (list v))
- pos j)))))
- (if (string-match "\\` *-?[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]? *\\'"
- (car data))
- (setq vals (list 'vec (string-to-int (car data))))
- (if (and (null arg)
- (string-match "[[{][^][{}]*[]}]" (car data)))
- (setq pos (match-beginning 0)
- vals (math-read-expr (math-match-substring (car data) 0)))
- (let ((s (if (string-match
- "\\`\\([0-9]+:[ \t]\\)?\\(.*[^, \t]\\)[, \t]*\\'"
- (car data))
- (math-match-substring (car data) 2)
- (car data))))
- (setq pos -1
- vals (math-read-expr (concat "[" s "]")))
- (if (eq (car-safe vals) 'error)
- (let ((v2 (math-read-expr s)))
- (unless (eq (car-safe v2) 'error)
- (setq vals (list 'vec v2)))))))))
- (if (eq (car-safe vals) 'error)
- (progn
- (if calc-was-started
- (pop-to-buffer from-buffer)
- (calc-quit t)
- (switch-to-buffer from-buffer))
- (goto-char top)
- (forward-line lnum)
- (forward-char (+ (nth 1 vals) (min col1 col2) pos))
- (error (nth 2 vals))))
- (unless (equal vals '(vec))
- (setq mat (cons vals mat)))
- (setq data (cdr data)
- lnum (1+ lnum)))
- (calc-slow-wrapper
- (if reduce
- (calc-enter-result 0 "grb+" (list reduce '(var add var-add)
- (nreverse mat)))
- (calc-enter-result 0 "grab" (nreverse mat))))))
-
-
-(defun calc-copy-to-buffer (nn)
- "Copy the top of stack into an editing buffer."
- (interactive "P")
- (let ((thebuf (and (not (memq major-mode '(calc-mode calc-trail-mode)))
- (current-buffer)))
- (movept nil)
- oldbuf newbuf)
- (calc-wrapper
- (save-excursion
- (calc-force-refresh)
- (let ((n (prefix-numeric-value nn))
- (eat-lnums calc-line-numbering)
- (big-offset (if (eq calc-language 'big) 1 0))
- top bot)
- (setq oldbuf (current-buffer)
- newbuf (or thebuf
- (calc-find-writable-buffer (buffer-list) 0)
- (calc-find-writable-buffer (buffer-list) 1)
- (error "No other buffer")))
- (cond ((and (or (null nn)
- (consp nn))
- (= (calc-substack-height 0)
- (- (1- (calc-substack-height 1)) big-offset)))
- (calc-cursor-stack-index 1)
- (if (looking-at
- (if calc-line-numbering "[0-9]+: *[^ \n]" " *[^ \n]"))
- (goto-char (1- (match-end 0))))
- (setq eat-lnums nil
- top (point))
- (calc-cursor-stack-index 0)
- (setq bot (- (1- (point)) big-offset)))
- ((> n 0)
- (calc-cursor-stack-index n)
- (setq top (point))
- (calc-cursor-stack-index 0)
- (setq bot (- (point) big-offset)))
- ((< n 0)
- (calc-cursor-stack-index (- n))
- (setq top (point))
- (calc-cursor-stack-index (1- (- n)))
- (setq bot (point)))
- (t
- (goto-char (point-min))
- (forward-line 1)
- (setq top (point))
- (calc-cursor-stack-index 0)
- (setq bot (point))))
- (save-excursion
- (set-buffer newbuf)
- (if (consp nn)
- (kill-region (region-beginning) (region-end)))
- (push-mark (point) t)
- (if (and overwrite-mode (not (consp nn)))
- (calc-overwrite-string (save-excursion
- (set-buffer oldbuf)
- (buffer-substring top bot))
- eat-lnums)
- (or (bolp) (setq eat-lnums nil))
- (insert-buffer-substring oldbuf top bot)
- (and eat-lnums
- (let ((n 1))
- (while (and (> (point) (mark))
- (progn
- (forward-line -1)
- (>= (point) (mark))))
- (delete-char 4)
- (setq n (1+ n)))
- (forward-line n))))
- (when thebuf
- (setq movept (point)))
- (when (get-buffer-window (current-buffer))
- (set-window-point (get-buffer-window (current-buffer))
- (point)))))))
- (when movept
- (goto-char movept))
- (when (and (consp nn)
- (not thebuf))
- (calc-quit t)
- (switch-to-buffer newbuf))))
-
-(defun calc-overwrite-string (str eat-lnums)
- (when (string-match "\n\\'" str)
- (setq str (substring str 0 -1)))
- (when eat-lnums
- (setq str (substring str 4)))
- (if (and (string-match "\\`[-+]?[0-9.]+\\(e-?[0-9]+\\)?\\'" str)
- (looking-at "[-+]?[0-9.]+\\(e-?[0-9]+\\)?"))
- (progn
- (delete-region (point) (match-end 0))
- (insert str))
- (let ((i 0))
- (while (< i (length str))
- (if (= (setq last-command-char (aref str i)) ?\n)
- (or (= i (1- (length str)))
- (let ((pt (point)))
- (end-of-line)
- (delete-region pt (point))
- (if (eobp)
- (insert "\n")
- (forward-char 1))
- (if eat-lnums (setq i (+ i 4)))))
- (self-insert-command 1))
- (setq i (1+ i))))))
-
-;;; First, require that buffer is visible and does not begin with "*"
-;;; Second, require only that it not begin with "*Calc"
-(defun calc-find-writable-buffer (buf mode)
- (and buf
- (if (or (string-match "\\`\\( .*\\|\\*Calc.*\\)"
- (buffer-name (car buf)))
- (and (= mode 0)
- (or (string-match "\\`\\*.*" (buffer-name (car buf)))
- (not (get-buffer-window (car buf))))))
- (calc-find-writable-buffer (cdr buf) mode)
- (car buf))))
-
-
-(defun calc-edit (n)
- (interactive "p")
- (calc-slow-wrapper
- (when (eq n 0)
- (setq n (calc-stack-size)))
- (let* ((flag nil)
- (allow-ret (> n 1))
- (list (math-showing-full-precision
- (mapcar (if (> n 1)
- (function (lambda (x)
- (math-format-flat-expr x 0)))
- (function
- (lambda (x)
- (if (math-vectorp x) (setq allow-ret t))
- (math-format-nice-expr x (frame-width)))))
- (if (> n 0)
- (calc-top-list n)
- (calc-top-list 1 (- n)))))))
- (calc-edit-mode (list 'calc-finish-stack-edit (or flag n)) allow-ret)
- (while list
- (insert (car list) "\n")
- (setq list (cdr list)))))
- (calc-show-edit-buffer))
-
-(defun calc-alg-edit (str)
- (calc-edit-mode '(calc-finish-stack-edit 0))
- (calc-show-edit-buffer)
- (insert str "\n")
- (backward-char 1)
- (calc-set-command-flag 'do-edit))
-
-(defvar calc-edit-mode-map nil "Keymap for use by the calc-edit command.")
-(if calc-edit-mode-map
- ()
- (setq calc-edit-mode-map (make-sparse-keymap))
- (define-key calc-edit-mode-map "\n" 'calc-edit-finish)
- (define-key calc-edit-mode-map "\r" 'calc-edit-return)
- (define-key calc-edit-mode-map "\C-c\C-c" 'calc-edit-finish))
-
-(defun calc-edit-mode (&optional handler allow-ret title)
- "Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
-To cancel the edit, simply kill the *Calc Edit* buffer."
- (interactive)
- (unless handler
- (error "This command can be used only indirectly through calc-edit"))
- (let ((oldbuf (current-buffer))
- (buf (get-buffer-create "*Calc Edit*")))
- (set-buffer buf)
- (kill-all-local-variables)
- (use-local-map calc-edit-mode-map)
- (setq buffer-read-only nil)
- (setq truncate-lines nil)
- (setq major-mode 'calc-edit-mode)
- (setq mode-name "Calc Edit")
- (run-hooks 'calc-edit-mode-hook)
- (make-local-variable 'calc-original-buffer)
- (setq calc-original-buffer oldbuf)
- (make-local-variable 'calc-return-buffer)
- (setq calc-return-buffer oldbuf)
- (make-local-variable 'calc-one-window)
- (setq calc-one-window (and (one-window-p t) pop-up-windows))
- (make-local-variable 'calc-edit-handler)
- (setq calc-edit-handler handler)
- (make-local-variable 'calc-restore-trail)
- (setq calc-restore-trail (get-buffer-window (calc-trail-buffer)))
- (make-local-variable 'calc-allow-ret)
- (setq calc-allow-ret allow-ret)
- (erase-buffer)
- (insert (or title title "Calc Edit Mode")
- ". Press "
- (if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch)
- "M-# M-# or C-c C-c"
- (if allow-ret "C-c C-c" "RET"))
- " to finish, "
- (if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch)
- "M-# x"
- "C-x k RET")
- " to cancel.\n")))
-(put 'calc-edit-mode 'mode-class 'special)
-
-(defun calc-show-edit-buffer ()
- (let ((buf (current-buffer)))
- (if (and (one-window-p t) pop-up-windows)
- (pop-to-buffer (get-buffer-create "*Calc Edit*"))
- (and calc-embedded-info (get-buffer-window (aref calc-embedded-info 1))
- (select-window (get-buffer-window (aref calc-embedded-info 1))))
- (switch-to-buffer (get-buffer-create "*Calc Edit*")))
- (setq calc-return-buffer buf)
- (if (and (< (window-width) (frame-width))
- calc-display-trail)
- (let ((win (get-buffer-window (calc-trail-buffer))))
- (if win
- (delete-window win))))
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (forward-line 1)))
-
-(defun calc-edit-return ()
- (interactive)
- (if (and (boundp 'calc-allow-ret) calc-allow-ret)
- (newline)
- (calc-edit-finish)))
-
-(defun calc-edit-finish (&optional keep)
- "Finish calc-edit mode. Parse buffer contents and push them on the stack."
- (interactive "P")
- (message "Working...")
- (or (and (boundp 'calc-original-buffer)
- (boundp 'calc-return-buffer)
- (boundp 'calc-one-window)
- (boundp 'calc-edit-handler)
- (boundp 'calc-restore-trail)
- (eq major-mode 'calc-edit-mode))
- (error "This command is valid only in buffers created by calc-edit"))
- (let ((buf (current-buffer))
- (original calc-original-buffer)
- (return calc-return-buffer)
- (one-window calc-one-window)
- (disp-trail calc-restore-trail))
- (save-excursion
- (when (or (null (buffer-name original))
- (progn
- (set-buffer original)
- (not (eq major-mode 'calc-mode))))
- (error "Original calculator buffer has been corrupted")))
- (goto-char (point-min))
- (when (looking-at "Calc Edit\\|Editing ")
- (forward-line 1))
- (if (buffer-modified-p)
- (eval calc-edit-handler))
- (if one-window
- (delete-window))
- (if (get-buffer-window return)
- (select-window (get-buffer-window return))
- (switch-to-buffer return))
- (if keep
- (bury-buffer buf)
- (kill-buffer buf))
- (if disp-trail
- (calc-wrapper
- (calc-trail-display 1 t)))
- (message "")))
-
-(defun calc-edit-cancel ()
- "Cancel calc-edit mode. Ignore the Calc Edit buffer and don't change stack."
- (interactive)
- (let ((calc-edit-handler nil))
- (calc-edit-finish))
- (message "(Cancelled)"))
-
-(defun calc-finish-stack-edit (num)
- (let ((buf (current-buffer))
- (str (buffer-substring (point) (point-max)))
- (start (point))
- pos)
- (if (and (integerp num) (> num 1))
- (while (setq pos (string-match "\n." str))
- (aset str pos ?\,)))
- (switch-to-buffer calc-original-buffer)
- (let ((vals (let ((calc-language nil)
- (math-expr-opers math-standard-opers))
- (and (string-match "[^\n\t ]" str)
- (math-read-exprs str)))))
- (when (eq (car-safe vals) 'error)
- (switch-to-buffer buf)
- (goto-char (+ start (nth 1 vals)))
- (error (nth 2 vals)))
- (calc-wrapper
- (if (symbolp num)
- (progn
- (set num (car vals))
- (calc-refresh-evaltos num))
- (if disp-trail
- (calc-trail-display 1 t))
- (and vals
- (let ((calc-simplify-mode (if (eq last-command-char ?\C-j)
- 'none
- calc-simplify-mode)))
- (if (>= num 0)
- (calc-enter-result num "edit" vals)
- (calc-enter-result 1 "edit" vals (- num))))))))))
-
-;;; calc-yank.el ends here
+++ /dev/null
-;;; calc.el --- the GNU Emacs calculator
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-;; Keywords: convenience, extensions
-;; Version: 2.02g
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;; Calc is split into many files. This file is the main entry point.
-;; This file includes autoload commands for various other basic Calc
-;; facilities. The more advanced features are based in calc-ext, which
-;; in turn contains autoloads for the rest of the Calc files. This
-;; odd set of interactions is designed to make Calc's loading time
-;; be as short as possible when only simple calculations are needed.
-
-;; Original author's address:
-;; Dave Gillespie, daveg@synaptics.com, uunet!synaptx!daveg.
-;; Synaptics, Inc., 2698 Orchard Parkway, San Jose, CA 95134.
-;;
-;; The old address daveg@csvax.cs.caltech.edu will continue to
-;; work for the foreseeable future.
-;;
-;; Bug reports and suggestions are always welcome! (Type M-x
-;; report-calc-bug to send them).
-
-;; All functions, macros, and Lisp variables defined here begin with one
-;; of the prefixes "math", "Math", or "calc", with the exceptions of
-;; "full-calc", "full-calc-keypad", "another-calc", "quick-calc",
-;; "report-calc-bug", and "defmath". User-accessible variables begin
-;; with "var-".
-
-;;; TODO:
-
-;; Fix rewrite mechanism to do less gratuitous rearrangement of terms.
-;; Implement a pattern-based "refers" predicate.
-;;
-;; Make it possible to Undo a selection command.
-;; Figure out how to allow selecting rows of matrices.
-;; If cursor was in selection before, move it after j n, j p, j L, etc.
-;; Consider reimplementing calc-delete-selection using rewrites.
-;;
-;; Implement line-breaking in non-flat compositions (is this desirable?).
-;; Implement matrix formatting with multi-line components.
-;;
-;; Have "Z R" define a user command based on a set of rewrite rules.
-;; Support "incf" and "decf" in defmath definitions.
-;; Have defmath generate calls to calc-binary-op or calc-unary-op.
-;; Make some way to define algebraic functions using keyboard macros.
-;;
-;; Allow calc-word-size=0 => Common Lisp-style signed bitwise arithmetic.
-;; Consider digamma function (and thus arb. prec. Euler's gamma constant).
-;; May as well make continued-fractions stuff available to the user.
-;;
-;; How about matrix eigenvalues, SVD, pseudo-inverse, etc.?
-;; Should cache matrix inverses as well as decompositions.
-;; If dividing by a non-square matrix, use least-squares automatically.
-;; Consider supporting matrix exponentials.
-;;
-;; Have ninteg detect and work around singularities at the endpoints.
-;; Use an adaptive subdivision algorithm for ninteg.
-;; Provide nsum and nprod to go along with ninteg.
-;;
-;; Handle TeX-mode parsing of \matrix{ ... } where ... contains braces.
-;; Support AmS-TeX's \{d,t,}frac, \{d,t,}binom notations.
-;; Format and parse sums and products in Eqn and Math modes.
-;;
-;; Get math-read-big-expr to read sums, products, etc.
-;; Change calc-grab-region to use math-read-big-expr.
-;; Have a way to define functions using := in Embedded Mode.
-;;
-;; Support polar plotting with GNUPLOT.
-;; Make a calc-graph-histogram function.
-;;
-;; Replace hokey formulas for complex functions with formulas designed
-;; to minimize roundoff while maintaining the proper branch cuts.
-;; Test accuracy of advanced math functions over whole complex plane.
-;; Extend Bessel functions to provide arbitrary precision.
-;; Extend advanced math functions to handle error forms and intervals.
-;; Provide a better implementation for math-sin-cos-raw.
-;; Provide a better implementation for math-hypot.
-;; Provide a better implementation for math-make-frac.
-;; Provide a better implementation for calcFunc-prfac.
-;; Provide a better implementation for calcFunc-factor.
-;;
-;; Provide more examples in the tutorial section of the manual.
-;; Cover in the tutorial: simplification modes, declarations,
-;; bitwise stuff, selections, matrix mapping, financial functions.
-;; Provide more Lisp programming examples in the manual.
-;; Finish the Internals section of the manual (and bring it up to date).
-;;
-;; Tim suggests adding spreadsheet-like features.
-;; Implement language modes for Gnuplot, Lisp, Ada, APL, ...?
-;;
-;; For atan series, if x > tan(pi/12) (about 0.268) reduce using the identity
-;; atan(x) = atan((x * sqrt(3) - 1) / (sqrt(3) + x)) + pi/6.
-;;
-;; A better integration algorithm:
-;; Use breadth-first instead of depth-first search, as follows:
-;; The integral cache allows unfinished integrals in symbolic notation
-;; on the righthand side. An entry with no unfinished integrals on the
-;; RHS is "complete"; references to it elsewhere are replaced by the
-;; integrated value. More than one cache entry for the same integral
-;; may exist, though if one becomes complete, the others may be deleted.
-;; The integrator works by using every applicable rule (such as
-;; substitution, parts, linearity, etc.) to generate possible righthand
-;; sides, all of which are entered into the cache. Now, as long as the
-;; target integral is not complete (and the time limit has not run out)
-;; choose an incomplete integral from the cache and, for every integral
-;; appearing in its RHS's, add those integrals to the cache using the
-;; same substitition, parts, etc. rules. The cache should be organized
-;; as a priority queue, choosing the "simplest" incomplete integral at
-;; each step, or choosing randomly among equally simple integrals.
-;; Simplicity equals small size, and few steps removed from the original
-;; target integral. Note that when the integrator finishes, incomplete
-;; integrals can be left in the cache, so the algorithm can start where
-;; it left off if another similar integral is later requested.
-;; Breadth-first search would avoid the nagging problem of, e.g., whether
-;; to use parts or substitution first, and which decomposition is best.
-;; All are tried, and any path that diverges will quickly be put on the
-;; back burner by the priority queue.
-;; Note: Probably a good idea to call math-simplify-extended before
-;; measuring a formula's simplicity.
-
-;; From: "Robert J. Chassell" <bob@rattlesnake.com>
-;; Subject: Re: fix for `Cannot open load file: calc-alg-3'
-;; To: walters@debian.org
-;; Date: Sat, 24 Nov 2001 21:44:21 +0000 (UTC)
-;;
-;; Could you add logistic curve fitting to the current list?
-;;
-;; (I guess the key binding for a logistic curve would have to be `s'
-;; since a logistic curve is an `s' curve; both `l' and `L' are already
-;; taken for logarithms.)
-;;
-;; Here is the current list for curve fitting;
-;;
-;; `1'
-;; Linear or multilinear. a + b x + c y + d z.
-;;
-;; `2-9'
-;; Polynomials. a + b x + c x^2 + d x^3.
-;;
-;; `e'
-;; Exponential. a exp(b x) exp(c y).
-;;
-;; `E'
-;; Base-10 exponential. a 10^(b x) 10^(c y).
-;;
-;; `x'
-;; Exponential (alternate notation). exp(a + b x + c y).
-;;
-;; `X'
-;; Base-10 exponential (alternate). 10^(a + b x + c y).
-;;
-;; `l'
-;; Logarithmic. a + b ln(x) + c ln(y).
-;;
-;; `L'
-;; Base-10 logarithmic. a + b log10(x) + c log10(y).
-;;
-;; `^'
-;; General exponential. a b^x c^y.
-;;
-;; `p'
-;; Power law. a x^b y^c.
-;;
-;; `q'
-;; Quadratic. a + b (x-c)^2 + d (x-e)^2.
-;;
-;; `g'
-;; Gaussian. (a / b sqrt(2 pi)) exp(-0.5*((x-c)/b)^2).
-;;
-;;
-;; Logistic curves are used a great deal in ecology, and in predicting
-;; human actions, such as use of different kinds of energy in a country
-;; (wood, coal, oil, natural gas, etc.) or the number of scientific
-;; papers a person publishes, or the number of movies made.
-;;
-;; (The less information on which to base the curve, the higher the error
-;; rate. Theodore Modis ran some Monte Carlo simulations and produced
-;; what may be useful set of confidence levels for different amounts of
-;; initial information.)
-
-;;; Code:
-
-(provide 'calc)
-(require 'calc-macs)
-
-;;; The "###autoload" comment will be used by Emacs version 19 for
-;;; maintaining the loaddefs.el file automatically.
-
-;;;###autoload
-(defvar calc-info-filename "calc.info"
- "*File name in which to look for the Calculator's Info documentation.")
-
-;;;###autoload
-(defvar calc-settings-file user-init-file
- "*File in which to record permanent settings; default is `user-init-file'.")
-
-;;;###autoload
-(defvar calc-autoload-directory nil
- "Name of directory from which additional \".elc\" files for Calc should be
-loaded. Should include a trailing \"/\".
-If nil, use original installation directory.
-This can safely be nil as long as the Calc files are on the load-path.")
-
-;;;###autoload
-(defvar calc-gnuplot-name "gnuplot"
- "*Name of GNUPLOT program, for calc-graph features.")
-
-;;;###autoload
-(defvar calc-gnuplot-plot-command nil
- "*Name of command for displaying GNUPLOT output; %s = file name to print.")
-
-;;;###autoload
-(defvar calc-gnuplot-print-command "lp %s"
- "*Name of command for printing GNUPLOT output; %s = file name to print.")
-
-(defvar calc-bug-address "deego@gnufans.org"
- "Address of the author of Calc, for use by `report-calc-bug'.")
-
-(defvar calc-scan-for-dels t
- "If t, scan keymaps to find all DEL-like keys.
-if nil, only DEL itself is mapped to calc-pop.")
-
-(defvar calc-extensions-loaded nil)
-
-(defvar calc-stack '((top-of-stack 1 nil))
- "Calculator stack.
-Entries are 3-lists: Formula, Height (in lines), Selection (or nil).")
-
-(defvar calc-show-banner t
- "*If non-nil, show a friendly greeting above the stack.")
-
-(defvar calc-stack-top 1
- "Index into `calc-stack' of \"top\" of stack.
-This is 1 unless `calc-truncate-stack' has been used.")
-
-(defvar calc-always-load-extensions nil
- "If non-nil, load the calc-ext module automatically when calc is loaded.")
-
-(defvar calc-line-numbering t
- "If non-nil, display line numbers in Calculator stack.")
-
-(defvar calc-line-breaking t
- "If non-nil, break long values across multiple lines in Calculator stack.")
-
-(defvar calc-display-just nil
- "If nil, stack display is left-justified.
-If `right', stack display is right-justified.
-If `center', stack display is centered.")
-
-(defvar calc-display-origin nil
- "Horizontal origin of displayed stack entries.
-In left-justified mode, this is effectively indentation. (Default 0).
-In right-justified mode, this is effectively window width.
-In centered mode, center of stack entry is placed here.")
-
-(defvar calc-number-radix 10
- "Radix for entry and display of numbers in calc-mode, 2-36.")
-
-(defvar calc-leading-zeros nil
- "If non-nil, leading zeros are provided to pad integers to calc-word-size.")
-
-(defvar calc-group-digits nil
- "If non-nil, group digits in large displayed integers by inserting spaces.
-If an integer, group that many digits at a time.
-If t, use 4 for binary and hex, 3 otherwise.")
-
-(defvar calc-group-char ","
- "The character (in the form of a string) to be used for grouping digits.
-This is used only when calc-group-digits mode is on.")
-
-(defvar calc-point-char "."
- "The character (in the form of a string) to be used as a decimal point.")
-
-(defvar calc-frac-format '(":" nil)
- "Format of displayed fractions; a string of one or two of \":\" or \"/\".")
-
-(defvar calc-prefer-frac nil
- "If non-nil, prefer fractional over floating-point results.")
-
-(defvar calc-hms-format "%s@ %s' %s\""
- "Format of displayed hours-minutes-seconds angles, a format string.
-String must contain three %s marks for hours, minutes, seconds respectively.")
-
-(defvar calc-date-format '((H ":" mm C SS pp " ")
- Www " " Mmm " " D ", " YYYY)
- "Format of displayed date forms.")
-
-(defvar calc-float-format '(float 0)
- "Format to use for display of floating-point numbers in calc-mode.
-Must be a list of one of the following forms:
- (float 0) Floating point format, display full precision.
- (float N) N > 0: Floating point format, at most N significant figures.
- (float -N) -N < 0: Floating point format, calc-internal-prec - N figs.
- (fix N) N >= 0: Fixed point format, N places after decimal point.
- (sci 0) Scientific notation, full precision.
- (sci N) N > 0: Scientific notation, N significant figures.
- (sci -N) -N < 0: Scientific notation, calc-internal-prec - N figs.
- (eng 0) Engineering notation, full precision.
- (eng N) N > 0: Engineering notation, N significant figures.
- (eng -N) -N < 0: Engineering notation, calc-internal-prec - N figs.")
-
-(defvar calc-full-float-format '(float 0)
- "Format to use when full precision must be displayed.")
-
-(defvar calc-complex-format nil
- "Format to use for display of complex numbers in calc-mode. Must be one of:
- nil Use (x, y) form.
- i Use x + yi form.
- j Use x + yj form.")
-
-(defvar calc-complex-mode 'cplx
- "Preferred form, either `cplx' or `polar', for complex numbers.")
-
-(defvar calc-infinite-mode nil
- "If nil, 1 / 0 is left unsimplified.
-If 0, 1 / 0 is changed to inf (zeros are considered positive).
-Otherwise, 1 / 0 is changed to uinf (undirected infinity).")
-
-(defvar calc-display-strings nil
- "If non-nil, display vectors of byte-sized integers as strings.")
-
-(defvar calc-matrix-just 'center
- "If nil, vector elements are left-justified.
-If `right', vector elements are right-justified.
-If `center', vector elements are centered.")
-
-(defvar calc-break-vectors nil
- "If non-nil, display vectors one element per line.")
-
-(defvar calc-full-vectors t
- "If non-nil, display long vectors in full. If nil, use abbreviated form.")
-
-(defvar calc-full-trail-vectors t
- "If non-nil, display long vectors in full in the trail.")
-
-(defvar calc-vector-commas ","
- "If non-nil, separate elements of displayed vectors with this string.")
-
-(defvar calc-vector-brackets "[]"
- "If non-nil, surround displayed vectors with these characters.")
-
-(defvar calc-matrix-brackets '(R O)
- "A list of code-letter symbols that control \"big\" matrix display.
-If `R' is present, display inner brackets for matrices.
-If `O' is present, display outer brackets for matrices (above/below).
-If `C' is present, display outer brackets for matrices (centered).")
-
-(defvar calc-language nil
- "Language or format for entry and display of stack values. Must be one of:
- nil Use standard Calc notation.
- flat Use standard Calc notation, one-line format.
- big Display formulas in 2-d notation (enter w/std notation).
- unform Use unformatted display: add(a, mul(b,c)).
- c Use C language notation.
- pascal Use Pascal language notation.
- fortran Use Fortran language notation.
- tex Use TeX notation.
- eqn Use eqn notation.
- math Use Mathematica(tm) notation.
- maple Use Maple notation.")
-
-(defvar calc-language-option nil
- "Numeric prefix argument for the command that set `calc-language'.")
-
-(defvar calc-function-open "("
- "Open-parenthesis string for function call notation.")
-
-(defvar calc-function-close ")"
- "Close-parenthesis string for function call notation.")
-
-(defvar calc-language-output-filter nil
- "Function through which to pass strings after formatting.")
-
-(defvar calc-language-input-filter nil
- "Function through which to pass strings before parsing.")
-
-(defvar calc-radix-formatter nil
- "Formatting function used for non-decimal numbers.")
-
-(defvar calc-left-label ""
- "Label to display at left of formula.")
-
-(defvar calc-right-label ""
- "Label to display at right of formula.")
-
-(defvar calc-word-size 32
- "Minimum number of bits per word, if any, for binary operations in calc-mode.")
-
-(defvar calc-previous-modulo nil
- "Most recently used value of M in a modulo form.")
-
-(defvar calc-simplify-mode nil
- "Type of simplification applied to results.
-If `none', results are not simplified when pushed on the stack.
-If `num', functions are simplified only when args are constant.
-If nil, only fast simplifications are applied.
-If `binary', `math-clip' is applied if appropriate.
-If `alg', `math-simplify' is applied.
-If `ext', `math-simplify-extended' is applied.
-If `units', `math-simplify-units' is applied.")
-
-(defvar calc-auto-recompute t
- "If non-nil, recompute evalto's automatically when necessary.")
-
-(defvar calc-display-raw nil
- "If non-nil, display shows unformatted Lisp exprs. (For debugging)")
-
-(defvar calc-internal-prec 12
- "Number of digits of internal precision for calc-mode calculations.")
-
-(defvar calc-inverse-flag nil
- "If non-nil, next operation is Inverse.")
-
-(defvar calc-hyperbolic-flag nil
- "If non-nil, next operation is Hyperbolic.")
-
-(defvar calc-keep-args-flag nil
- "If non-nil, next operation should not remove its arguments from stack.")
-
-(defvar calc-angle-mode 'deg
- "If deg, angles are in degrees; if rad, angles are in radians.
-If hms, angles are in degrees-minutes-seconds.")
-
-(defvar calc-algebraic-mode nil
- "If non-nil, numeric entry accepts whole algebraic expressions.
-If nil, algebraic expressions must be preceded by \"'\".")
-
-(defvar calc-incomplete-algebraic-mode nil
- "Like calc-algebraic-mode except only affects ( and [ keys.")
-
-(defvar calc-symbolic-mode nil
- "If non-nil, inexact numeric computations like sqrt(2) are postponed.
-If nil, computations on numbers always yield numbers where possible.")
-
-(defvar calc-matrix-mode nil
- "If `matrix', variables are assumed to be matrix-valued.
-If a number, variables are assumed to be NxN matrices.
-If `scalar', variables are assumed to be scalar-valued.
-If nil, symbolic math routines make no assumptions about variables.")
-
-(defvar calc-shift-prefix nil
- "If non-nil, shifted letter keys are prefix keys rather than normal meanings.")
-
-(defvar calc-window-height 7
- "Initial height of Calculator window.")
-
-(defvar calc-display-trail t
- "If non-nil, M-x calc creates a window to display Calculator trail.")
-
-(defvar calc-show-selections t
- "If non-nil, selected sub-formulas are shown by obscuring rest of formula.
-If nil, selected sub-formulas are highlighted by obscuring the sub-formulas.")
-
-(defvar calc-use-selections t
- "If non-nil, commands operate only on selected portions of formulas.
-If nil, selections displayed but ignored.")
-
-(defvar calc-assoc-selections t
- "If non-nil, selection hides deep structure of associative formulas.")
-
-(defvar calc-display-working-message 'lots
- "If non-nil, display \"Working...\" for potentially slow Calculator commands.")
-
-(defvar calc-auto-why 'maybe
- "If non-nil, automatically execute a \"why\" command to explain odd results.")
-
-(defvar calc-timing nil
- "If non-nil, display timing information on each slow command.")
-
-(defvar calc-display-sci-high 0
- "Floating-point numbers with this positive exponent or higher above the
-current precision are displayed in scientific notation in calc-mode.")
-
-(defvar calc-display-sci-low -3
- "Floating-point numbers with this negative exponent or lower are displayed
-scientific notation in calc-mode.")
-
-
-(defvar calc-other-modes nil
- "List of used-defined strings to append to Calculator mode line.")
-
-(defvar calc-Y-help-msgs nil
- "List of strings for Y prefix help.")
-
-(defvar calc-loaded-settings-file nil
- "t if `calc-settings-file' has been loaded yet.")
-
-
-
-(defvar calc-mode-save-mode 'local)
-(defvar calc-standard-date-formats
- '("N"
- "<H:mm:SSpp >Www Mmm D, YYYY"
- "D Mmm YYYY<, h:mm:SS>"
- "Www Mmm BD< hh:mm:ss> YYYY"
- "M/D/Y< H:mm:SSpp>"
- "D.M.Y< h:mm:SS>"
- "M-D-Y< H:mm:SSpp>"
- "D-M-Y< h:mm:SS>"
- "j<, h:mm:SS>"
- "YYddd< hh:mm:ss>"))
-(defvar calc-autorange-units nil)
-(defvar calc-was-keypad-mode nil)
-(defvar calc-full-mode nil)
-(defvar calc-user-parse-tables nil)
-(defvar calc-gnuplot-default-device "default")
-(defvar calc-gnuplot-default-output "STDOUT")
-(defvar calc-gnuplot-print-device "postscript")
-(defvar calc-gnuplot-print-output "auto")
-(defvar calc-gnuplot-geometry nil)
-(defvar calc-graph-default-resolution 15)
-(defvar calc-graph-default-resolution-3d 5)
-(defvar calc-invocation-macro nil)
-(defvar calc-show-banner t)
-
-(defconst calc-local-var-list '(calc-stack
- calc-stack-top
- calc-undo-list
- calc-redo-list
- calc-always-load-extensions
- calc-mode-save-mode
- calc-display-raw
- calc-line-numbering
- calc-line-breaking
- calc-display-just
- calc-display-origin
- calc-left-label
- calc-right-label
- calc-auto-why
- calc-algebraic-mode
- calc-incomplete-algebraic-mode
- calc-symbolic-mode
- calc-matrix-mode
- calc-inverse-flag
- calc-hyperbolic-flag
- calc-keep-args-flag
- calc-angle-mode
- calc-number-radix
- calc-leading-zeros
- calc-group-digits
- calc-group-char
- calc-point-char
- calc-frac-format
- calc-prefer-frac
- calc-hms-format
- calc-date-format
- calc-standard-date-formats
- calc-float-format
- calc-full-float-format
- calc-complex-format
- calc-matrix-just
- calc-full-vectors
- calc-full-trail-vectors
- calc-break-vectors
- calc-vector-commas
- calc-vector-brackets
- calc-matrix-brackets
- calc-complex-mode
- calc-infinite-mode
- calc-display-strings
- calc-simplify-mode
- calc-auto-recompute
- calc-autorange-units
- calc-show-plain
- calc-show-selections
- calc-use-selections
- calc-assoc-selections
- calc-word-size
- calc-internal-prec))
-
-
-;; Verify that Calc is running on the right kind of system.
-(defconst calc-emacs-type-epoch (and (fboundp 'epoch::version) epoch::version))
-(defvar calc-emacs-type-19 (not (or calc-emacs-type-epoch
- (string-lessp emacs-version "19"))))
-(defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version))))
-(defvar calc-emacs-type-gnu19 (and calc-emacs-type-19
- (not calc-emacs-type-lucid)))
-
-;; Set up the standard keystroke (M-#) to run the Calculator, if that key
-;; has not yet been bound to anything. For best results, the user should
-;; do this before Calc is even loaded, so that M-# can auto-load Calc.
-(or (global-key-binding "\e#") (global-set-key "\e#" 'calc-dispatch))
-
-;; Set up the autoloading linkage.
-(let ((name (and (fboundp 'calc-dispatch)
- (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
- (nth 1 (symbol-function 'calc-dispatch))))
- (p load-path))
-
- ;; If Calc files exist on the load-path, we're all set.
- (while (and p (not (file-exists-p
- (expand-file-name "calc-misc.elc" (car p)))))
- (setq p (cdr p)))
- (or p
-
- ;; If Calc is autoloaded using a path name, look there for Calc files.
- ;; This works for both relative ("calc/calc.elc") and absolute paths.
- (and name (file-name-directory name)
- (let ((p2 load-path)
- (name2 (concat (file-name-directory name)
- "calc-misc.elc")))
- (while (and p2 (not (file-exists-p
- (expand-file-name name2 (car p2)))))
- (setq p2 (cdr p2)))
- (when p2
- (setq load-path (nconc load-path
- (list
- (directory-file-name
- (file-name-directory
- (expand-file-name
- name (car p2))))))))))
-
- ;; If calc-autoload-directory is given, use that (and hope it works!).
- (and calc-autoload-directory
- (not (equal calc-autoload-directory ""))
- (setq load-path (nconc load-path
- (list (directory-file-name
- calc-autoload-directory)))))))
-
-;; The following modes use specially-formatted data.
-(put 'calc-mode 'mode-class 'special)
-(put 'calc-trail-mode 'mode-class 'special)
-
-;; Define "inexact-result" as an e-lisp error symbol.
-(put 'inexact-result 'error-conditions '(error inexact-result calc-error))
-(put 'inexact-result 'error-message "Calc internal error (inexact-result)")
-
-;; Define "math-overflow" and "math-underflow" as e-lisp error symbols.
-(put 'math-overflow 'error-conditions '(error math-overflow calc-error))
-(put 'math-overflow 'error-message "Floating-point overflow occurred")
-(put 'math-underflow 'error-conditions '(error math-underflow calc-error))
-(put 'math-underflow 'error-message "Floating-point underflow occurred")
-
-(defconst calc-version "2.02g")
-(defconst calc-version-date "Mon Nov 19 2001")
-(defvar calc-trail-pointer nil) ; "Current" entry in trail buffer.
-(defvar calc-trail-overlay nil) ; Value of overlay-arrow-string.
-(defvar calc-undo-list nil) ; List of previous operations for undo.
-(defvar calc-redo-list nil) ; List of recent undo operations.
-(defvar calc-main-buffer nil) ; Pointer to Calculator buffer.
-(defvar calc-trail-buffer nil) ; Pointer to Calc Trail buffer.
-(defvar calc-why nil) ; Explanations of most recent errors.
-(defvar calc-next-why nil)
-(defvar calc-inverse-flag nil)
-(defvar calc-hyperbolic-flag nil)
-(defvar calc-keep-args-flag nil)
-(defvar calc-last-kill nil) ; Last number killed in calc-mode.
-(defvar calc-previous-alg-entry nil) ; Previous algebraic entry.
-(defvar calc-dollar-values nil) ; Values to be used for '$'.
-(defvar calc-dollar-used nil) ; Highest order of '$' that occurred.
-(defvar calc-hashes-used nil) ; Highest order of '#' that occurred.
-(defvar calc-quick-prev-results nil) ; Previous results from Quick Calc.
-(defvar calc-said-hello nil) ; Has welcome message been said yet?
-(defvar calc-executing-macro nil) ; Kbd macro executing from "K" key.
-(defvar calc-any-selections nil) ; Nil means no selections present.
-(defvar calc-help-phase 0) ; Count of consecutive "?" keystrokes.
-(defvar calc-full-help-flag nil) ; Executing calc-full-help?
-(defvar calc-refresh-count 0) ; Count of calc-refresh calls.
-(defvar calc-display-dirty nil)
-(defvar calc-prepared-composition nil)
-(defvar calc-selection-cache-default-entry nil)
-(defvar calc-embedded-info nil)
-(defvar calc-embedded-active nil)
-(defvar calc-standalone-flag nil)
-(defvar var-EvalRules nil)
-(defvar math-eval-rules-cache-tag t)
-(defvar math-radix-explicit-format t)
-(defvar math-expr-function-mapping nil)
-(defvar math-expr-variable-mapping nil)
-(defvar math-read-expr-quotes nil)
-(defvar math-working-step nil)
-(defvar math-working-step-2 nil)
-(defvar var-i '(special-const (math-imaginary 1)))
-(defvar var-pi '(special-const (math-pi)))
-(defvar var-e '(special-const (math-e)))
-(defvar var-phi '(special-const (math-phi)))
-(defvar var-gamma '(special-const (math-gamma-const)))
-(defvar var-Modes '(special-const (math-get-modes-vec)))
-
-(mapcar (lambda (v) (or (boundp v) (set v nil)))
- calc-local-var-list)
-
-(defvar calc-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map t)
- (define-key map "+" 'calc-plus)
- (define-key map "-" 'calc-minus)
- (define-key map "*" 'calc-times)
- (define-key map "/" 'calc-divide)
- (define-key map "%" 'calc-mod)
- (define-key map "&" 'calc-inv)
- (define-key map "^" 'calc-power)
- (define-key map "\M-%" 'calc-percent)
- (define-key map "e" 'calcDigit-start)
- (define-key map "i" 'calc-info)
- (define-key map "n" 'calc-change-sign)
- (define-key map "q" 'calc-quit)
- (define-key map "Y" 'nil)
- (define-key map "Y?" 'calc-shift-Y-prefix-help)
- (define-key map "?" 'calc-help)
- (define-key map " " 'calc-enter)
- (define-key map "'" 'calc-algebraic-entry)
- (define-key map "$" 'calc-auto-algebraic-entry)
- (define-key map "\"" 'calc-auto-algebraic-entry)
- (define-key map "\t" 'calc-roll-down)
- (define-key map "\M-\t" 'calc-roll-up)
- (define-key map "\C-m" 'calc-enter)
- (define-key map "\M-\C-m" 'calc-last-args-stub)
- (define-key map "\C-j" 'calc-over)
-
- (mapcar (lambda (x) (define-key map (char-to-string x) 'undefined))
- "lOW")
- (mapcar (lambda (x) (define-key map (char-to-string x) 'calc-missing-key))
- (concat "ABCDEFGHIJKLMNPQRSTUVXZabcdfghjkmoprstuvwxyz"
- ":\\|!()[]<>{},;=~`\C-k\M-k\C-w\M-w\C-y\C-_"))
- (mapcar (lambda (x) (define-key map (char-to-string x) 'calcDigit-start))
- "_0123456789.#@")
- map))
-
-(defvar calc-digit-map
- (let ((map (make-keymap)))
- (if calc-emacs-type-lucid
- (map-keymap (function
- (lambda (keys bind)
- (define-key map keys
- (if (eq bind 'undefined)
- 'undefined 'calcDigit-nondigit))))
- calc-mode-map)
- (let ((cmap (if calc-emacs-type-19 (nth 1 calc-mode-map) calc-mode-map))
- (dmap (if calc-emacs-type-19 (nth 1 map) map))
- (i 0))
- (while (< i 128)
- (aset dmap i
- (if (eq (aref cmap i) 'undefined)
- 'undefined 'calcDigit-nondigit))
- (setq i (1+ i)))))
- (mapcar (lambda (x) (define-key map (char-to-string x) 'calcDigit-key))
- "_0123456789.e+-:n#@oh'\"mspM")
- (mapcar (lambda (x) (define-key map (char-to-string x) 'calcDigit-letter))
- "abcdfgijklqrtuvwxyzABCDEFGHIJKLNOPQRSTUVWXYZ")
- (define-key map "'" 'calcDigit-algebraic)
- (define-key map "`" 'calcDigit-edit)
- (define-key map "\C-g" 'abort-recursive-edit)
- map))
-
-(mapcar (lambda (x)
- (condition-case err
- (progn
- (define-key calc-digit-map x 'calcDigit-backspace)
- (define-key calc-mode-map x 'calc-pop)
- (define-key calc-mode-map
- (if (vectorp x)
- (if calc-emacs-type-lucid
- (if (= (length x) 1)
- (vector (if (consp (aref x 0))
- (cons 'meta (aref x 0))
- (list 'meta (aref x 0))))
- "\e\C-d")
- (vconcat "\e" x))
- (concat "\e" x))
- 'calc-pop-above))
- (error nil)))
- (if calc-scan-for-dels
- (append (where-is-internal 'delete-backward-char global-map)
- (where-is-internal 'backward-delete-char global-map)
- '("\C-d"))
- '("\177" "\C-d")))
-
-(defvar calc-dispatch-map
- (let ((map (make-keymap)))
- (mapcar (lambda (x)
- (define-key map (char-to-string (car x)) (cdr x))
- (when (string-match "abcdefhijklnopqrstuwxyz"
- (char-to-string (car x)))
- (define-key map (char-to-string (- (car x) ?a -1)) (cdr x)))
- (define-key map (format "\e%c" (car x)) (cdr x)))
- '( ( ?a . calc-embedded-activate )
- ( ?b . calc-big-or-small )
- ( ?c . calc )
- ( ?d . calc-embedded-duplicate )
- ( ?e . calc-embedded )
- ( ?f . calc-embedded-new-formula )
- ( ?g . calc-grab-region )
- ( ?h . calc-dispatch-help )
- ( ?i . calc-info )
- ( ?j . calc-embedded-select )
- ( ?k . calc-keypad )
- ( ?l . calc-load-everything )
- ( ?m . read-kbd-macro )
- ( ?n . calc-embedded-next )
- ( ?o . calc-other-window )
- ( ?p . calc-embedded-previous )
- ( ?q . quick-calc )
- ( ?r . calc-grab-rectangle )
- ( ?s . calc-info-summary )
- ( ?t . calc-tutorial )
- ( ?u . calc-embedded-update-formula )
- ( ?w . calc-embedded-word )
- ( ?x . calc-quit )
- ( ?y . calc-copy-to-buffer )
- ( ?z . calc-user-invocation )
- ( ?= . calc-embedded-update-formula )
- ( ?\' . calc-embedded-new-formula )
- ( ?\` . calc-embedded-edit )
- ( ?: . calc-grab-sum-down )
- ( ?_ . calc-grab-sum-across )
- ( ?0 . calc-reset )
- ( ?# . calc-same-interface )
- ( ?? . calc-dispatch-help ) ))
- map))
-
-(autoload 'calc-extensions "calc-ext")
-(autoload 'calc-need-macros "calc-macs")
-
-;;;; (Autoloads here)
-(mapcar
- (lambda (x) (dolist (func (cdr x)) (autoload func (car x))))
- '(
-
- ("calc-aent" calc-Need-calc-aent calc-alg-digit-entry calc-alg-entry
- calc-check-user-syntax calc-do-alg-entry calc-do-calc-eval
- calc-do-quick-calc calc-match-user-syntax math-build-parse-table
- math-find-user-tokens math-read-expr-list math-read-exprs math-read-if
- math-read-token math-remove-dashes)
-
- ("calc-misc" calc-Need-calc-misc
- calc-do-handle-whys calc-do-refresh calc-num-prefix-name
- calc-record-list calc-record-why calc-report-bug calc-roll-down-stack
- calc-roll-up-stack calc-temp-minibuffer-message calcFunc-floor
- calcFunc-inv calcFunc-trunc math-concat math-constp math-div2
- math-div2-bignum math-do-working math-evenp math-fixnatnump
- math-fixnump math-floor math-imod math-ipow math-looks-negp math-mod
- math-negp math-posp math-pow math-read-radix-digit math-reject-arg
- math-trunc math-zerop)))
-
-(mapcar
- (lambda (x) (dolist (cmd (cdr x)) (autoload cmd (car x) nil t)))
- '(
-
- ("calc-aent" calc-algebraic-entry calc-auto-algebraic-entry
- calcDigit-algebraic calcDigit-edit)
-
- ("calc-misc" another-calc calc-big-or-small calc-dispatch-help
- calc-help calc-info calc-info-summary calc-inv calc-last-args-stub
- calc-missing-key calc-mod calc-other-window calc-over calc-percent
- calc-pop-above calc-power calc-roll-down calc-roll-up
- calc-shift-Y-prefix-help calc-tutorial calcDigit-letter
- report-calc-bug)))
-
-
-;;;###autoload (global-set-key "\e#" 'calc-dispatch)
-
-;;;###autoload
-(defun calc-dispatch (&optional arg)
- "Invoke the GNU Emacs Calculator. See `calc-dispatch-help' for details."
- (interactive "P")
- (sit-for echo-keystrokes)
- (condition-case err ; look for other keys bound to calc-dispatch
- (let ((keys (this-command-keys)))
- (unless (or (not (stringp keys))
- (string-match "\\`\C-u\\|\\`\e[-0-9#]\\|`[\M--\M-0-\M-9]" keys)
- (eq (lookup-key calc-dispatch-map keys) 'calc-same-interface))
- (when (and (string-match "\\`[\C-@-\C-_]" keys)
- (symbolp
- (lookup-key calc-dispatch-map (substring keys 0 1))))
- (define-key calc-dispatch-map (substring keys 0 1) nil))
- (define-key calc-dispatch-map keys 'calc-same-interface)))
- (error nil))
- (calc-do-dispatch arg))
-
-(defvar calc-dispatch-help nil)
-(defun calc-do-dispatch (arg)
- (let ((key (calc-read-key-sequence
- (if calc-dispatch-help
- "Calc options: Calc, Keypad, Quick, Embed; eXit; Info, Tutorial; Grab; ?=more"
- (format "%s (Type ? for a list of Calc options)"
- (key-description (this-command-keys))))
- calc-dispatch-map)))
- (setq key (lookup-key calc-dispatch-map key))
- (message "")
- (if key
- (progn
- (or (commandp key) (calc-extensions))
- (call-interactively key))
- (beep))))
-
-(defun calc-read-key-sequence (prompt map)
- (let ((prompt2 (format "%s " (key-description (this-command-keys))))
- (glob (current-global-map))
- (loc (current-local-map)))
- (or (input-pending-p) (message prompt))
- (let ((key (calc-read-key t)))
- (calc-unread-command (cdr key))
- (unwind-protect
- (progn
- (use-global-map map)
- (use-local-map nil)
- (read-key-sequence
- (if (commandp (key-binding (if calc-emacs-type-19
- (vector (cdr key))
- (char-to-string (cdr key)))))
- "" prompt2)))
- (use-global-map glob)
- (use-local-map loc)))))
-
-
-
-(defun calc-mode ()
- "Calculator major mode.
-
-This is an RPN calculator featuring arbitrary-precision integer, rational,
-floating-point, complex, matrix, and symbolic arithmetic.
-
-RPN calculation: 2 RET 3 + produces 5.
-Algebraic style: ' 2+3 RET produces 5.
-
-Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign).
-
-Press ? repeatedly for more complete help. Press `h i' to read the
-Calc manual on-line, `h s' to read the summary, or `h t' for the tutorial.
-
-Notations: 3.14e6 3.14 * 10^6
- _23 negative number -23 (or type `23 n')
- 17:3 the fraction 17/3
- 5:2:3 the fraction 5 and 2/3
- 16#12C the integer 12C base 16 = 300 base 10
- 8#177:100 the fraction 177:100 base 8 = 127:64 base 10
- (2, 4) complex number 2 + 4i
- (2; 4) polar complex number (r; theta)
- [1, 2, 3] vector ([[1, 2], [3, 4]] is a matrix)
- [1 .. 4) semi-open interval, 1 <= x < 4
- 2 +/- 3 (p key) number with mean 2, standard deviation 3
- 2 mod 3 (M key) number 2 computed modulo 3
- <1 jan 91> Date form (enter using ' key)
-
-
-\\{calc-mode-map}
-"
- (interactive)
- (mapcar (function
- (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list)
- (kill-all-local-variables)
- (use-local-map (if (eq calc-algebraic-mode 'total)
- (progn (calc-extensions) calc-alg-map) calc-mode-map))
- (mapcar (function (lambda (v) (make-local-variable v))) calc-local-var-list)
- (make-local-variable 'overlay-arrow-position)
- (make-local-variable 'overlay-arrow-string)
- (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (setq major-mode 'calc-mode)
- (setq mode-name "Calculator")
- (setq calc-stack-top (length (or (memq (assq 'top-of-stack calc-stack)
- calc-stack)
- (setq calc-stack (list (list 'top-of-stack
- 1 nil))))))
- (setq calc-stack-top (- (length calc-stack) calc-stack-top -1))
- (or calc-loaded-settings-file
- (null calc-settings-file)
- (string-match "\\.emacs" calc-settings-file)
- (progn
- (setq calc-loaded-settings-file t)
- (load calc-settings-file t))) ; t = missing-ok
- (if (and (eq window-system 'x) (boundp 'mouse-map))
- (substitute-key-definition 'x-paste-text 'calc-x-paste-text
- mouse-map))
- (let ((p command-line-args))
- (while p
- (and (equal (car p) "-f")
- (string-match "calc" (nth 1 p))
- (string-match "full" (nth 1 p))
- (setq calc-standalone-flag t))
- (setq p (cdr p))))
- (run-hooks 'calc-mode-hook)
- (calc-refresh t)
- (calc-set-mode-line)
- ;; The calc-defs variable is a relic. Use calc-define properties instead.
- (when (and (boundp 'calc-defs)
- calc-defs)
- (message "Evaluating calc-defs...")
- (calc-need-macros)
- (eval (cons 'progn calc-defs))
- (setq calc-defs nil)
- (calc-set-mode-line))
- (calc-check-defines))
-
-(defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks
-(defun calc-check-defines ()
- (if (symbol-plist 'calc-define)
- (let ((plist (copy-sequence (symbol-plist 'calc-define))))
- (while (and plist (null (nth 1 plist)))
- (setq plist (cdr (cdr plist))))
- (if plist
- (save-excursion
- (calc-extensions)
- (calc-need-macros)
- (set-buffer "*Calculator*")
- (while plist
- (put 'calc-define (car plist) nil)
- (eval (nth 1 plist))
- (setq plist (cdr (cdr plist))))
- ;; See if this has added any more calc-define properties.
- (calc-check-defines))
- (setplist 'calc-define nil)))))
-
-(defun calc-trail-mode (&optional buf)
- "Calc Trail mode.
-This mode is used by the *Calc Trail* buffer, which records all results
-obtained by the GNU Emacs Calculator.
-
-Calculator commands beginning with the `t' key are used to manipulate
-the Trail.
-
-This buffer uses the same key map as the *Calculator* buffer; calculator
-commands given here will actually operate on the *Calculator* stack."
- (interactive)
- (fundamental-mode)
- (use-local-map calc-mode-map)
- (setq major-mode 'calc-trail-mode)
- (setq mode-name "Calc Trail")
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (make-local-variable 'overlay-arrow-position)
- (make-local-variable 'overlay-arrow-string)
- (set (make-local-variable 'font-lock-defaults)
- '(nil t nil nil nil (font-lock-core-only . t)))
- (when buf
- (set (make-local-variable 'calc-main-buffer) buf))
- (when (= (buffer-size) 0)
- (let ((buffer-read-only nil))
- (insert (propertize (concat "Emacs Calculator v" calc-version
- " by Dave Gillespie\n")
- 'font-lock-face 'italic))))
- (run-hooks 'calc-trail-mode-hook))
-
-(defun calc-create-buffer ()
- (set-buffer (get-buffer-create "*Calculator*"))
- (or (eq major-mode 'calc-mode)
- (calc-mode))
- (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000))
- (when calc-always-load-extensions
- (calc-extensions))
- (when calc-language
- (calc-extensions)
- (calc-set-language calc-language calc-language-option t)))
-
-;;;###autoload
-(defun calc (&optional arg full-display interactive)
- "The Emacs Calculator. Full documentation is listed under \"calc-mode\"."
- (interactive "P")
- (if arg
- (unless (eq arg 0)
- (calc-extensions)
- (if (= (prefix-numeric-value arg) -1)
- (calc-grab-region (region-beginning) (region-end) nil)
- (when (= (prefix-numeric-value arg) -2)
- (calc-keypad))))
- (when (get-buffer-window "*Calc Keypad*")
- (calc-keypad)
- (set-buffer (window-buffer (selected-window))))
- (if (eq major-mode 'calc-mode)
- (calc-quit)
- (let ((oldbuf (current-buffer)))
- (calc-create-buffer)
- (setq calc-was-keypad-mode nil)
- (if (or (eq full-display t)
- (and (null full-display) calc-full-mode))
- (switch-to-buffer (current-buffer) t)
- (if (get-buffer-window (current-buffer))
- (select-window (get-buffer-window (current-buffer)))
- (if (and (boundp 'calc-window-hook) calc-window-hook)
- (run-hooks 'calc-window-hook)
- (let ((w (get-largest-window)))
- (if (and pop-up-windows
- (> (window-height w)
- (+ window-min-height calc-window-height 2)))
- (progn
- (setq w (split-window w
- (- (window-height w)
- calc-window-height 2)
- nil))
- (set-window-buffer w (current-buffer))
- (select-window w))
- (pop-to-buffer (current-buffer)))))))
- (save-excursion
- (set-buffer (calc-trail-buffer))
- (and calc-display-trail
- (= (window-width) (frame-width))
- (calc-trail-display 1 t)))
- (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit")
- (run-hooks 'calc-start-hook)
- (and (windowp full-display)
- (window-point full-display)
- (select-window full-display))
- (calc-check-defines)
- (when (and calc-said-hello
- (or (interactive-p) interactive))
- (sit-for 2)
- (message ""))
- (setq calc-said-hello t)))))
-
-;;;###autoload
-(defun full-calc ()
- "Invoke the Calculator and give it a full-sized window."
- (interactive)
- (calc nil t (interactive-p)))
-
-(defun calc-same-interface (arg)
- "Invoke the Calculator using the most recent interface (calc or calc-keypad)."
- (interactive "P")
- (if (and (equal (buffer-name) "*Gnuplot Trail*")
- (> (recursion-depth) 0))
- (exit-recursive-edit)
- (if (eq major-mode 'calc-edit-mode)
- (calc-edit-finish arg)
- (if (eq major-mode 'MacEdit-mode)
- (MacEdit-finish-edit)
- (if calc-was-keypad-mode
- (calc-keypad)
- (calc arg calc-full-mode t))))))
-
-
-(defun calc-quit (&optional non-fatal)
- (interactive)
- (and calc-standalone-flag (not non-fatal)
- (save-buffers-kill-emacs nil))
- (if (and (equal (buffer-name) "*Gnuplot Trail*")
- (> (recursion-depth) 0))
- (exit-recursive-edit))
- (if (eq major-mode 'calc-edit-mode)
- (calc-edit-cancel)
- (if (eq major-mode 'MacEdit-mode)
- (MacEdit-cancel-edit)
- (if (and (interactive-p)
- calc-embedded-info
- (eq (current-buffer) (aref calc-embedded-info 0)))
- (calc-embedded nil)
- (unless (eq major-mode 'calc-mode)
- (calc-create-buffer))
- (run-hooks 'calc-end-hook)
- (setq calc-undo-list nil calc-redo-list nil)
- (mapcar (function (lambda (v) (set-default v (symbol-value v))))
- calc-local-var-list)
- (let ((buf (current-buffer))
- (win (get-buffer-window (current-buffer)))
- (kbuf (get-buffer "*Calc Keypad*")))
- (delete-windows-on (calc-trail-buffer))
- (if (and win
- (< (window-height win) (1- (frame-height)))
- (= (window-width win) (frame-width)) ; avoid calc-keypad
- (not (get-buffer-window "*Calc Keypad*")))
- (setq calc-window-height (- (window-height win) 2)))
- (progn
- (delete-windows-on buf)
- (delete-windows-on kbuf))
- (bury-buffer buf)
- (bury-buffer calc-trail-buffer)
- (and kbuf (bury-buffer kbuf)))))))
-
-;;;###autoload
-(defun quick-calc ()
- "Do a quick calculation in the minibuffer without invoking full Calculator."
- (interactive)
- (calc-do-quick-calc))
-
-;;;###autoload
-(defun calc-eval (str &optional separator &rest args)
- "Do a quick calculation and return the result as a string.
-Return value will either be the formatted result in string form,
-or a list containing a character position and an error message in string form."
- (calc-do-calc-eval str separator args))
-
-;;;###autoload
-(defun calc-keypad ()
- "Invoke the Calculator in \"visual keypad\" mode.
-This is most useful in the X window system.
-In this mode, click on the Calc \"buttons\" using the left mouse button.
-Or, position the cursor manually and do M-x calc-keypad-press."
- (interactive)
- (calc-extensions)
- (calc-do-keypad calc-full-mode (interactive-p)))
-
-;;;###autoload
-(defun full-calc-keypad ()
- "Invoke the Calculator in full-screen \"visual keypad\" mode.
-See calc-keypad for details."
- (interactive)
- (calc-extensions)
- (calc-do-keypad t (interactive-p)))
-
-
-(defvar calc-aborted-prefix nil)
-(defvar calc-start-time nil)
-(defvar calc-command-flags)
-(defvar calc-final-point-line)
-(defvar calc-final-point-column)
-;;; Note that modifications to this function may break calc-pass-errors.
-(defun calc-do (do-body &optional do-slow)
- (calc-check-defines)
- (let* ((calc-command-flags nil)
- (calc-start-time (and calc-timing (not calc-start-time)
- (calc-extensions)
- (current-time-string)))
- (gc-cons-threshold (max gc-cons-threshold
- (if calc-timing 2000000 100000)))
- calc-final-point-line calc-final-point-column)
- (setq calc-aborted-prefix "")
- (unwind-protect
- (condition-case err
- (save-excursion
- (if calc-embedded-info
- (calc-embedded-select-buffer)
- (calc-select-buffer))
- (and (eq calc-algebraic-mode 'total)
- (calc-extensions)
- (use-local-map calc-alg-map))
- (when (and do-slow calc-display-working-message)
- (message "Working...")
- (calc-set-command-flag 'clear-message))
- (funcall do-body)
- (setq calc-aborted-prefix nil)
- (when (memq 'renum-stack calc-command-flags)
- (calc-renumber-stack))
- (when (memq 'clear-message calc-command-flags)
- (message "")))
- (error
- (if (and (eq (car err) 'error)
- (stringp (nth 1 err))
- (string-match "max-specpdl-size\\|max-lisp-eval-depth"
- (nth 1 err)))
- (error "Computation got stuck or ran too long. Type `M' to increase the limit")
- (setq calc-aborted-prefix nil)
- (signal (car err) (cdr err)))))
- (when calc-aborted-prefix
- (calc-record "<Aborted>" calc-aborted-prefix))
- (and calc-start-time
- (let* ((calc-internal-prec 12)
- (calc-date-format nil)
- (end-time (current-time-string))
- (time (if (equal calc-start-time end-time)
- 0
- (math-sub
- (calcFunc-unixtime (math-parse-date end-time) 0)
- (calcFunc-unixtime (math-parse-date calc-start-time)
- 0)))))
- (if (math-lessp 1 time)
- (calc-record time "(t)"))))
- (or (memq 'no-align calc-command-flags)
- (eq major-mode 'calc-trail-mode)
- (calc-align-stack-window))
- (and (memq 'position-point calc-command-flags)
- (if (eq major-mode 'calc-mode)
- (progn
- (goto-line calc-final-point-line)
- (move-to-column calc-final-point-column))
- (save-current-buffer
- (calc-select-buffer)
- (goto-line calc-final-point-line)
- (move-to-column calc-final-point-column))))
- (unless (memq 'keep-flags calc-command-flags)
- (save-excursion
- (calc-select-buffer)
- (setq calc-inverse-flag nil
- calc-hyperbolic-flag nil
- calc-keep-args-flag nil)))
- (when (memq 'do-edit calc-command-flags)
- (switch-to-buffer (get-buffer-create "*Calc Edit*")))
- (calc-set-mode-line)
- (when calc-embedded-info
- (calc-embedded-finish-command))))
- (identity nil)) ; allow a GC after timing is done
-
-
-(defun calc-set-command-flag (f)
- (unless (memq f calc-command-flags)
- (setq calc-command-flags (cons f calc-command-flags))))
-
-(defun calc-select-buffer ()
- (or (eq major-mode 'calc-mode)
- (if calc-main-buffer
- (set-buffer calc-main-buffer)
- (let ((buf (get-buffer "*Calculator*")))
- (if buf
- (set-buffer buf)
- (error "Calculator buffer not available"))))))
-
-(defun calc-cursor-stack-index (&optional index)
- (goto-char (point-max))
- (forward-line (- (calc-substack-height (or index 1)))))
-
-(defun calc-stack-size ()
- (- (length calc-stack) calc-stack-top))
-
-(defun calc-substack-height (n)
- (let ((sum 0)
- (stack calc-stack))
- (setq n (+ n calc-stack-top))
- (while (and (> n 0) stack)
- (setq sum (+ sum (nth 1 (car stack)))
- n (1- n)
- stack (cdr stack)))
- sum))
-
-(defun calc-set-mode-line ()
- (save-excursion
- (calc-select-buffer)
- (let* ((fmt (car calc-float-format))
- (figs (nth 1 calc-float-format))
- (new-mode-string
- (format "Calc%s%s: %d %s %-14s"
- (if calc-embedded-info "Embed" "")
- (if (and (> (length (buffer-name)) 12)
- (equal (substring (buffer-name) 0 12)
- "*Calculator*"))
- (substring (buffer-name) 12)
- "")
- calc-internal-prec
- (capitalize (symbol-name calc-angle-mode))
- (concat
-
- ;; Input-related modes
- (if (eq calc-algebraic-mode 'total) "Alg* "
- (if calc-algebraic-mode "Alg "
- (if calc-incomplete-algebraic-mode "Alg[( " "")))
-
- ;; Computational modes
- (if calc-symbolic-mode "Symb " "")
- (cond ((eq calc-matrix-mode 'matrix) "Matrix ")
- ((integerp calc-matrix-mode)
- (format "Matrix%d " calc-matrix-mode))
- ((eq calc-matrix-mode 'scalar) "Scalar ")
- (t ""))
- (if (eq calc-complex-mode 'polar) "Polar " "")
- (if calc-prefer-frac "Frac " "")
- (cond ((null calc-infinite-mode) "")
- ((eq calc-infinite-mode 1) "+Inf ")
- (t "Inf "))
- (cond ((eq calc-simplify-mode 'none) "NoSimp ")
- ((eq calc-simplify-mode 'num) "NumSimp ")
- ((eq calc-simplify-mode 'binary)
- (format "BinSimp%d " calc-word-size))
- ((eq calc-simplify-mode 'alg) "AlgSimp ")
- ((eq calc-simplify-mode 'ext) "ExtSimp ")
- ((eq calc-simplify-mode 'units) "UnitSimp ")
- (t ""))
-
- ;; Display modes
- (cond ((= calc-number-radix 10) "")
- ((= calc-number-radix 2) "Bin ")
- ((= calc-number-radix 8) "Oct ")
- ((= calc-number-radix 16) "Hex ")
- (t (format "Radix%d " calc-number-radix)))
- (if calc-leading-zeros "Zero " "")
- (cond ((null calc-language) "")
- ((eq calc-language 'tex) "TeX ")
- (t (concat
- (capitalize (symbol-name calc-language))
- " ")))
- (cond ((eq fmt 'float)
- (if (zerop figs) "" (format "Norm%d " figs)))
- ((eq fmt 'fix) (format "Fix%d " figs))
- ((eq fmt 'sci)
- (if (zerop figs) "Sci " (format "Sci%d " figs)))
- ((eq fmt 'eng)
- (if (zerop figs) "Eng " (format "Eng%d " figs))))
- (cond ((not calc-display-just)
- (if calc-display-origin
- (format "Left%d " calc-display-origin) ""))
- ((eq calc-display-just 'right)
- (if calc-display-origin
- (format "Right%d " calc-display-origin)
- "Right "))
- (t
- (if calc-display-origin
- (format "Center%d " calc-display-origin)
- "Center ")))
- (cond ((integerp calc-line-breaking)
- (format "Wid%d " calc-line-breaking))
- (calc-line-breaking "")
- (t "Wide "))
-
- ;; Miscellaneous other modes/indicators
- (if calc-assoc-selections "" "Break ")
- (cond ((eq calc-mode-save-mode 'save) "Save ")
- ((not calc-embedded-info) "")
- ((eq calc-mode-save-mode 'local) "Local ")
- ((eq calc-mode-save-mode 'edit) "LocEdit ")
- ((eq calc-mode-save-mode 'perm) "LocPerm ")
- ((eq calc-mode-save-mode 'global) "Global ")
- (t ""))
- (if calc-auto-recompute "" "Manual ")
- (if (and (fboundp 'calc-gnuplot-alive)
- (calc-gnuplot-alive)) "Graph " "")
- (if (and calc-embedded-info
- (> (calc-stack-size) 0)
- (calc-top 1 'sel)) "Sel " "")
- (if calc-display-dirty "Dirty " "")
- (if calc-inverse-flag "Inv " "")
- (if calc-hyperbolic-flag "Hyp " "")
- (if calc-keep-args-flag "Keep " "")
- (if (/= calc-stack-top 1) "Narrow " "")
- (apply 'concat calc-other-modes)))))
- (if (equal new-mode-string mode-line-buffer-identification)
- nil
- (setq mode-line-buffer-identification new-mode-string)
- (set-buffer-modified-p (buffer-modified-p))
- (and calc-embedded-info (calc-embedded-mode-line-change))))))
-
-(defun calc-align-stack-window ()
- (if (eq major-mode 'calc-mode)
- (progn
- (let ((win (get-buffer-window (current-buffer))))
- (if win
- (progn
- (calc-cursor-stack-index 0)
- (vertical-motion (- 2 (window-height win)))
- (set-window-start win (point)))))
- (calc-cursor-stack-index 0)
- (if (looking-at " *\\.$")
- (goto-char (1- (match-end 0)))))
- (save-excursion
- (calc-select-buffer)
- (calc-align-stack-window))))
-
-(defun calc-check-stack (n)
- (if (> n (calc-stack-size))
- (error "Too few elements on stack"))
- (if (< n 0)
- (error "Invalid argument")))
-
-(defun calc-push-list (vals &optional m sels)
- (while vals
- (if calc-executing-macro
- (calc-push-list-in-macro vals m sels)
- (save-excursion
- (calc-select-buffer)
- (let* ((val (car vals))
- (entry (list val 1 (car sels)))
- (mm (+ (or m 1) calc-stack-top)))
- (calc-cursor-stack-index (1- (or m 1)))
- (if (> mm 1)
- (setcdr (nthcdr (- mm 2) calc-stack)
- (cons entry (nthcdr (1- mm) calc-stack)))
- (setq calc-stack (cons entry calc-stack)))
- (let ((buffer-read-only nil))
- (insert (math-format-stack-value entry) "\n"))
- (calc-record-undo (list 'push mm))
- (calc-set-command-flag 'renum-stack))))
- (setq vals (cdr vals)
- sels (cdr sels))))
-
-(defun calc-pop-push-list (n vals &optional m sels)
- (if (and calc-any-selections (null sels))
- (calc-replace-selections n vals m)
- (calc-pop-stack n m sels)
- (calc-push-list vals m sels)))
-
-(defun calc-pop-push-record-list (n prefix vals &optional m sels)
- (or (and (consp vals)
- (or (integerp (car vals))
- (consp (car vals))))
- (and vals (setq vals (list vals)
- sels (and sels (list sels)))))
- (calc-check-stack (+ n (or m 1) -1))
- (if prefix
- (if (cdr vals)
- (calc-record-list vals prefix)
- (calc-record (car vals) prefix)))
- (calc-pop-push-list n vals m sels))
-
-(defun calc-enter-result (n prefix vals &optional m)
- (setq calc-aborted-prefix prefix)
- (if (and (consp vals)
- (or (integerp (car vals))
- (consp (car vals))))
- (setq vals (mapcar 'calc-normalize vals))
- (setq vals (calc-normalize vals)))
- (or (and (consp vals)
- (or (integerp (car vals))
- (consp (car vals))))
- (setq vals (list vals)))
- (if (equal vals '((nil)))
- (setq vals nil))
- (calc-pop-push-record-list n prefix vals m)
- (calc-handle-whys))
-
-(defun calc-normalize (val)
- (if (memq calc-simplify-mode '(nil none num))
- (math-normalize val)
- (calc-extensions)
- (calc-normalize-fancy val)))
-
-(defun calc-handle-whys ()
- (if calc-next-why
- (calc-do-handle-whys)))
-
-
-(defun calc-pop-stack (&optional n m sel-ok) ; pop N objs at level M of stack.
- (or n (setq n 1))
- (or m (setq m 1))
- (or calc-keep-args-flag
- (let ((mm (+ m calc-stack-top)))
- (if (and calc-any-selections (not sel-ok)
- (calc-top-selected n m))
- (calc-sel-error))
- (if calc-executing-macro
- (calc-pop-stack-in-macro n mm)
- (calc-record-undo (list 'pop mm (calc-top-list n m 'full)))
- (save-excursion
- (calc-select-buffer)
- (let ((buffer-read-only nil))
- (if (> mm 1)
- (progn
- (calc-cursor-stack-index (1- m))
- (let ((bot (point)))
- (calc-cursor-stack-index (+ n m -1))
- (delete-region (point) bot))
- (setcdr (nthcdr (- mm 2) calc-stack)
- (nthcdr (+ n mm -1) calc-stack)))
- (calc-cursor-stack-index n)
- (setq calc-stack (nthcdr n calc-stack))
- (delete-region (point) (point-max))))
- (calc-set-command-flag 'renum-stack))))))
-
-(defvar sel-mode)
-(defun calc-get-stack-element (x)
- (cond ((eq sel-mode 'entry)
- x)
- ((eq sel-mode 'sel)
- (nth 2 x))
- ((or (null (nth 2 x))
- (eq sel-mode 'full)
- (not calc-use-selections))
- (car x))
- (sel-mode
- (calc-sel-error))
- (t (nth 2 x))))
-
-;; Get the Nth element of the stack (N=1 is the top element).
-(defun calc-top (&optional n sel-mode)
- (or n (setq n 1))
- (calc-check-stack n)
- (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack)))
-
-(defun calc-top-n (&optional n sel-mode) ; in case precision has changed
- (math-check-complete (calc-normalize (calc-top n sel-mode))))
-
-(defun calc-top-list (&optional n m sel-mode)
- (or n (setq n 1))
- (or m (setq m 1))
- (calc-check-stack (+ n m -1))
- (and (> n 0)
- (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1)
- calc-stack))))
- (setcdr (nthcdr (1- n) top) nil)
- (nreverse (mapcar 'calc-get-stack-element top)))))
-
-(defun calc-top-list-n (&optional n m sel-mode)
- (mapcar 'math-check-complete
- (mapcar 'calc-normalize (calc-top-list n m sel-mode))))
-
-
-(defun calc-renumber-stack ()
- (if calc-line-numbering
- (save-excursion
- (calc-cursor-stack-index 0)
- (let ((lnum 1)
- (buffer-read-only nil)
- (stack (nthcdr calc-stack-top calc-stack)))
- (if (re-search-forward "^[0-9]+[:*]" nil t)
- (progn
- (beginning-of-line)
- (while (re-search-forward "^[0-9]+[:*]" nil t)
- (let ((buffer-read-only nil))
- (beginning-of-line)
- (delete-char 4)
- (insert " ")))
- (calc-cursor-stack-index 0)))
- (while (re-search-backward "^[0-9]+[:*]" nil t)
- (delete-char 4)
- (if (> lnum 999)
- (insert (format "%03d%s" (% lnum 1000)
- (if (and (nth 2 (car stack))
- calc-use-selections) "*" ":")))
- (let ((prefix (int-to-string lnum)))
- (insert prefix (if (and (nth 2 (car stack))
- calc-use-selections) "*" ":")
- (make-string (- 3 (length prefix)) 32))))
- (beginning-of-line)
- (setq lnum (1+ lnum)
- stack (cdr stack))))))
- (and calc-embedded-info (calc-embedded-stack-change)))
-
-(defvar calc-any-evaltos nil)
-(defun calc-refresh (&optional align)
- (interactive)
- (and (eq major-mode 'calc-mode)
- (not calc-executing-macro)
- (let* ((buffer-read-only nil)
- (save-point (point))
- (save-mark (condition-case err (mark) (error nil)))
- (save-aligned (looking-at "\\.$"))
- (thing calc-stack)
- (calc-any-evaltos nil))
- (setq calc-any-selections nil)
- (erase-buffer)
- (when calc-show-banner
- (insert (propertize "--- Emacs Calculator Mode ---\n"
- 'font-lock-face 'italic)))
- (while thing
- (goto-char (point-min))
- (when calc-show-banner
- (forward-line 1))
- (insert (math-format-stack-value (car thing)) "\n")
- (setq thing (cdr thing)))
- (calc-renumber-stack)
- (if calc-display-dirty
- (calc-wrapper (setq calc-display-dirty nil)))
- (and calc-any-evaltos calc-auto-recompute
- (calc-wrapper (calc-refresh-evaltos)))
- (if (or align save-aligned)
- (calc-align-stack-window)
- (goto-char save-point))
- (if save-mark (set-mark save-mark))))
- (and calc-embedded-info (not (eq major-mode 'calc-mode))
- (save-excursion
- (set-buffer (aref calc-embedded-info 1))
- (calc-refresh align)))
- (setq calc-refresh-count (1+ calc-refresh-count)))
-
-
-(defun calc-x-paste-text (arg)
- "Move point to mouse position and insert window system cut buffer contents.
-If mouse is pressed in Calc window, push cut buffer contents onto the stack."
- (x-mouse-select arg)
- (if (memq major-mode '(calc-mode calc-trail-mode))
- (progn
- (calc-wrapper
- (calc-extensions)
- (let* ((buf (x-get-cut-buffer))
- (val (math-read-exprs (calc-clean-newlines buf))))
- (if (eq (car-safe val) 'error)
- (progn
- (setq val (math-read-exprs buf))
- (if (eq (car-safe val) 'error)
- (error "%s in yanked data" (nth 2 val)))))
- (calc-enter-result 0 "Xynk" val))))
- (x-paste-text arg)))
-
-
-
-;;;; The Calc Trail buffer.
-
-(defun calc-check-trail-aligned ()
- (save-excursion
- (let ((win (get-buffer-window (current-buffer))))
- (and win
- (pos-visible-in-window-p (1- (point-max)) win)))))
-
-(defun calc-trail-buffer ()
- (and (or (null calc-trail-buffer)
- (null (buffer-name calc-trail-buffer)))
- (save-excursion
- (setq calc-trail-buffer (get-buffer-create "*Calc Trail*"))
- (let ((buf (or (and (not (eq major-mode 'calc-mode))
- (get-buffer "*Calculator*"))
- (current-buffer))))
- (set-buffer calc-trail-buffer)
- (or (eq major-mode 'calc-trail-mode)
- (calc-trail-mode buf)))))
- (or (and calc-trail-pointer
- (eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
- (save-excursion
- (set-buffer calc-trail-buffer)
- (goto-line 2)
- (setq calc-trail-pointer (point-marker))))
- calc-trail-buffer)
-
-(defun calc-record (val &optional prefix)
- (setq calc-aborted-prefix nil)
- (or calc-executing-macro
- (let* ((mainbuf (current-buffer))
- (buf (calc-trail-buffer))
- (calc-display-raw nil)
- (calc-can-abbrev-vectors t)
- (fval (if val
- (if (stringp val)
- val
- (math-showing-full-precision
- (math-format-flat-expr val 0)))
- "")))
- (save-excursion
- (set-buffer buf)
- (let ((aligned (calc-check-trail-aligned))
- (buffer-read-only nil))
- (goto-char (point-max))
- (cond ((null prefix) (insert " "))
- ((and (> (length prefix) 4)
- (string-match " " prefix 4))
- (insert (substring prefix 0 4) " "))
- (t (insert (format "%4s " prefix))))
- (insert fval "\n")
- (let ((win (get-buffer-window buf)))
- (if (and aligned win (not (memq 'hold-trail calc-command-flags)))
- (calc-trail-here))
- (goto-char (1- (point-max))))))))
- val)
-
-
-(defun calc-trail-display (flag &optional no-refresh)
- (interactive "P")
- (let ((win (get-buffer-window (calc-trail-buffer))))
- (if (setq calc-display-trail
- (not (if flag (memq flag '(nil 0)) win)))
- (if (null win)
- (progn
- (if (and (boundp 'calc-trail-window-hook) calc-trail-window-hook)
- (run-hooks 'calc-trail-window-hook)
- (let ((w (split-window nil (/ (* (window-width) 2) 3) t)))
- (set-window-buffer w calc-trail-buffer)))
- (calc-wrapper
- (setq overlay-arrow-string calc-trail-overlay
- overlay-arrow-position calc-trail-pointer)
- (or no-refresh
- (if (interactive-p)
- (calc-do-refresh)
- (calc-refresh))))))
- (if win
- (progn
- (delete-window win)
- (calc-wrapper
- (or no-refresh
- (if (interactive-p)
- (calc-do-refresh)
- (calc-refresh))))))))
- calc-trail-buffer)
-
-(defun calc-trail-here ()
- (interactive)
- (if (eq major-mode 'calc-trail-mode)
- (progn
- (beginning-of-line)
- (if (bobp)
- (forward-line 1)
- (if (eobp)
- (forward-line -1)))
- (if (or (bobp) (eobp))
- (setq overlay-arrow-position nil) ; trail is empty
- (set-marker calc-trail-pointer (point) (current-buffer))
- (setq calc-trail-overlay (concat (buffer-substring (point)
- (+ (point) 4))
- ">")
- overlay-arrow-string calc-trail-overlay
- overlay-arrow-position calc-trail-pointer)
- (forward-char 4)
- (let ((win (get-buffer-window (current-buffer))))
- (if win
- (save-excursion
- (forward-line (/ (window-height win) 2))
- (forward-line (- 1 (window-height win)))
- (set-window-start win (point))
- (set-window-point win (+ calc-trail-pointer 4))
- (set-buffer calc-main-buffer)
- (setq overlay-arrow-string calc-trail-overlay
- overlay-arrow-position calc-trail-pointer))))))
- (error "Not in Calc Trail buffer")))
-
-
-
-
-;;;; The Undo list.
-
-(defun calc-record-undo (rec)
- (or calc-executing-macro
- (if (memq 'undo calc-command-flags)
- (setq calc-undo-list (cons (cons rec (car calc-undo-list))
- (cdr calc-undo-list)))
- (setq calc-undo-list (cons (list rec) calc-undo-list)
- calc-redo-list nil)
- (calc-set-command-flag 'undo))))
-
-
-
-
-;;; Arithmetic commands.
-
-(defun calc-binary-op (name func arg &optional ident unary func2)
- (setq calc-aborted-prefix name)
- (if (null arg)
- (calc-enter-result 2 name (cons (or func2 func)
- (mapcar 'math-check-complete
- (calc-top-list 2))))
- (calc-extensions)
- (calc-binary-op-fancy name func arg ident unary)))
-
-(defun calc-unary-op (name func arg &optional func2)
- (setq calc-aborted-prefix name)
- (if (null arg)
- (calc-enter-result 1 name (list (or func2 func)
- (math-check-complete (calc-top 1))))
- (calc-extensions)
- (calc-unary-op-fancy name func arg)))
-
-
-(defun calc-plus (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "+" 'calcFunc-add arg 0 nil '+)))
-
-(defun calc-minus (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-)))
-
-(defun calc-times (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*)))
-
-(defun calc-divide (arg)
- (interactive "P")
- (calc-slow-wrapper
- (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/)))
-
-
-(defun calc-change-sign (arg)
- (interactive "P")
- (calc-wrapper
- (calc-unary-op "chs" 'neg arg)))
-
-
-
-;;; Stack management commands.
-
-(defun calc-enter (n)
- (interactive "p")
- (calc-wrapper
- (cond ((< n 0)
- (calc-push-list (calc-top-list 1 (- n))))
- ((= n 0)
- (calc-push-list (calc-top-list (calc-stack-size))))
- (t
- (calc-push-list (calc-top-list n))))))
-
-
-(defun calc-pop (n)
- (interactive "P")
- (calc-wrapper
- (let* ((nn (prefix-numeric-value n))
- (top (and (null n) (calc-top 1))))
- (cond ((and (null n)
- (eq (car-safe top) 'incomplete)
- (> (length top) (if (eq (nth 1 top) 'intv) 3 2)))
- (calc-pop-push-list 1 (let ((tt (copy-sequence top)))
- (setcdr (nthcdr (- (length tt) 2) tt) nil)
- (list tt))))
- ((< nn 0)
- (if (and calc-any-selections
- (calc-top-selected 1 (- nn)))
- (calc-delete-selection (- nn))
- (calc-pop-stack 1 (- nn) t)))
- ((= nn 0)
- (calc-pop-stack (calc-stack-size) 1 t))
- (t
- (if (and calc-any-selections
- (= nn 1)
- (calc-top-selected 1 1))
- (calc-delete-selection 1)
- (calc-pop-stack nn)))))))
-
-
-
-
-;;;; Reading a number using the minibuffer.
-(defvar calc-buffer)
-(defvar calc-prev-char)
-(defvar calc-prev-prev-char)
-(defvar calc-digit-value)
-(defun calcDigit-start ()
- (interactive)
- (calc-wrapper
- (if (or calc-algebraic-mode
- (and (> calc-number-radix 14) (eq last-command-char ?e)))
- (calc-alg-digit-entry)
- (calc-unread-command)
- (setq calc-aborted-prefix nil)
- (let* ((calc-digit-value nil)
- (calc-prev-char nil)
- (calc-prev-prev-char nil)
- (calc-buffer (current-buffer))
- (buf (if calc-emacs-type-lucid
- (catch 'calc-foo
- (catch 'execute-kbd-macro
- (throw 'calc-foo
- (read-from-minibuffer
- "Calc: " "" calc-digit-map)))
- (error "Lucid Emacs requires RET after %s"
- "digit entry in kbd macro"))
- (let ((old-esc (lookup-key global-map "\e")))
- (unwind-protect
- (progn
- (define-key global-map "\e" nil)
- (read-from-minibuffer "Calc: " "" calc-digit-map))
- (define-key global-map "\e" old-esc))))))
- (or calc-digit-value (setq calc-digit-value (math-read-number buf)))
- (if (stringp calc-digit-value)
- (calc-alg-entry calc-digit-value)
- (if calc-digit-value
- (calc-push-list (list (calc-record (calc-normalize
- calc-digit-value))))))
- (if (eq calc-prev-char 'dots)
- (progn
- (calc-extensions)
- (calc-dots)))))))
-
-(defsubst calc-minibuffer-size ()
- (- (point-max) (minibuffer-prompt-end)))
-
-(defun calcDigit-nondigit ()
- (interactive)
- ;; Exercise for the reader: Figure out why this is a good precaution!
- (or (boundp 'calc-buffer)
- (use-local-map minibuffer-local-map))
- (let ((str (minibuffer-contents)))
- (setq calc-digit-value (save-excursion
- (set-buffer calc-buffer)
- (math-read-number str))))
- (if (and (null calc-digit-value) (> (calc-minibuffer-size) 0))
- (progn
- (beep)
- (calc-temp-minibuffer-message " [Bad format]"))
- (or (memq last-command-char '(32 13))
- (progn (setq prefix-arg current-prefix-arg)
- (calc-unread-command (if (and (eq last-command-char 27)
- (>= last-input-char 128))
- last-input-char
- nil))))
- (exit-minibuffer)))
-
-
-(defun calc-minibuffer-contains (rex)
- (save-excursion
- (goto-char (minibuffer-prompt-end))
- (looking-at rex)))
-
-(defun calcDigit-key ()
- (interactive)
- (goto-char (point-max))
- (if (or (and (memq last-command-char '(?+ ?-))
- (> (buffer-size) 0)
- (/= (preceding-char) ?e))
- (and (memq last-command-char '(?m ?s))
- (not (calc-minibuffer-contains "[-+]?[0-9]+\\.?0*[@oh].*"))
- (not (calc-minibuffer-contains "[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#.*"))))
- (calcDigit-nondigit)
- (if (calc-minibuffer-contains "\\([-+]?\\|.* \\)\\'")
- (cond ((memq last-command-char '(?. ?@)) (insert "0"))
- ((and (memq last-command-char '(?o ?h ?m))
- (not (calc-minibuffer-contains ".*#.*"))) (insert "0"))
- ((memq last-command-char '(?: ?e)) (insert "1"))
- ((eq last-command-char ?#)
- (insert (int-to-string calc-number-radix)))))
- (if (and (calc-minibuffer-contains "\\([-+]?[0-9]+#\\|[^:]*:\\)\\'")
- (eq last-command-char ?:))
- (insert "1"))
- (if (and (calc-minibuffer-contains "[-+]?[0-9]+#\\'")
- (eq last-command-char ?.))
- (insert "0"))
- (if (and (calc-minibuffer-contains "[-+]?0*\\([2-9]\\|1[0-4]\\)#\\'")
- (eq last-command-char ?e))
- (insert "1"))
- (if (or (and (memq last-command-char '(?h ?o ?m ?s ?p))
- (calc-minibuffer-contains ".*#.*"))
- (and (eq last-command-char ?e)
- (calc-minibuffer-contains "[-+]?\\(1[5-9]\\|[2-9][0-9]\\)#.*"))
- (and (eq last-command-char ?n)
- (calc-minibuffer-contains "[-+]?\\(2[4-9]\\|[3-9][0-9]\\)#.*")))
- (setq last-command-char (upcase last-command-char)))
- (cond
- ((memq last-command-char '(?_ ?n))
- (goto-char (minibuffer-prompt-end))
- (if (and (search-forward " +/- " nil t)
- (not (search-forward "e" nil t)))
- (beep)
- (and (not (calc-minibuffer-contains "[-+]?\\(1[5-9]\\|[2-9][0-9]\\)#.*"))
- (search-forward "e" nil t))
- (if (looking-at "+")
- (delete-char 1))
- (if (looking-at "-")
- (delete-char 1)
- (insert "-")))
- (goto-char (point-max)))
- ((eq last-command-char ?p)
- (if (or (calc-minibuffer-contains ".*\\+/-.*")
- (calc-minibuffer-contains ".*mod.*")
- (calc-minibuffer-contains ".*#.*")
- (calc-minibuffer-contains ".*[-+e:]\\'"))
- (beep)
- (if (not (calc-minibuffer-contains ".* \\'"))
- (insert " "))
- (insert "+/- ")))
- ((and (eq last-command-char ?M)
- (not (calc-minibuffer-contains
- "[-+]?\\(2[3-9]\\|[3-9][0-9]\\)#.*")))
- (if (or (calc-minibuffer-contains ".*\\+/-.*")
- (calc-minibuffer-contains ".*mod *[^ ]+")
- (calc-minibuffer-contains ".*[-+e:]\\'"))
- (beep)
- (if (calc-minibuffer-contains ".*mod \\'")
- (if calc-previous-modulo
- (insert (math-format-flat-expr calc-previous-modulo 0))
- (beep))
- (if (not (calc-minibuffer-contains ".* \\'"))
- (insert " "))
- (insert "mod "))))
- (t
- (insert (char-to-string last-command-char))
- (if (or (and (calc-minibuffer-contains "[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9][0-9]?\\)#[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\\)?\\|.[0-9a-zA-Z]*\\(e[-+]?[0-9]*\\)?\\)?\\'")
- (let ((radix (string-to-int
- (buffer-substring
- (match-beginning 2) (match-end 2)))))
- (and (>= radix 2)
- (<= radix 36)
- (or (memq last-command-char '(?# ?: ?. ?e ?+ ?-))
- (let ((dig (math-read-radix-digit
- (upcase last-command-char))))
- (and dig
- (< dig radix)))))))
- (calc-minibuffer-contains
- "[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9]+\\.?0*[@oh] *\\)?\\([0-9]+\\.?0*['m] *\\)?[0-9]*\\(\\.?[0-9]*\\(e[-+]?[0-3]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\\)?\\|[0-9]:\\([0-9]+:\\)?[0-9]*\\)?[\"s]?\\'"))
- (if (and (memq last-command-char '(?@ ?o ?h ?\' ?m))
- (string-match " " calc-hms-format))
- (insert " "))
- (if (and (eq this-command last-command)
- (eq last-command-char ?.))
- (progn
- (calc-extensions)
- (calc-digit-dots))
- (delete-backward-char 1)
- (beep)
- (calc-temp-minibuffer-message " [Bad format]"))))))
- (setq calc-prev-prev-char calc-prev-char
- calc-prev-char last-command-char))
-
-
-(defun calcDigit-backspace ()
- (interactive)
- (goto-char (point-max))
- (cond ((calc-minibuffer-contains ".* \\+/- \\'")
- (backward-delete-char 5))
- ((calc-minibuffer-contains ".* mod \\'")
- (backward-delete-char 5))
- ((calc-minibuffer-contains ".* \\'")
- (backward-delete-char 2))
- ((eq last-command 'calcDigit-start)
- (erase-buffer))
- (t (backward-delete-char 1)))
- (if (= (calc-minibuffer-size) 0)
- (progn
- (setq last-command-char 13)
- (calcDigit-nondigit))))
-
-
-
-
-
-
-
-;;;; Arithmetic routines.
-;;;
-;;; An object as manipulated by one of these routines may take any of the
-;;; following forms:
-;;;
-;;; integer An integer. For normalized numbers, this format
-;;; is used only for -999999 ... 999999.
-;;;
-;;; (bigpos N0 N1 N2 ...) A big positive integer, N0 + N1*1000 + N2*10^6 ...
-;;; (bigneg N0 N1 N2 ...) A big negative integer, - N0 - N1*1000 ...
-;;; Each digit N is in the range 0 ... 999.
-;;; Normalized, always at least three N present,
-;;; and the most significant N is nonzero.
-;;;
-;;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers.
-;;; Normalized, DEN > 1.
-;;;
-;;; (float NUM EXP) A floating-point number, NUM * 10^EXP;
-;;; NUM is a small or big integer, EXP is a small int.
-;;; Normalized, NUM is not a multiple of 10, and
-;;; abs(NUM) < 10^calc-internal-prec.
-;;; Normalized zero is stored as (float 0 0).
-;;;
-;;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above.
-;;; Normalized, IMAG is nonzero.
-;;;
-;;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA
-;;; is neither zero nor 180 degrees (pi radians).
-;;;
-;;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a
-;;; vector of vectors.
-;;;
-;;; (hms H M S) Angle in hours-minutes-seconds form. All three
-;;; components have the same sign; H and M must be
-;;; numerically integers; M and S are expected to
-;;; lie in the range [0,60).
-;;;
-;;; (date N) A date or date/time object. N is an integer to
-;;; store a date only, or a fraction or float to
-;;; store a date and time.
-;;;
-;;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized,
-;;; SIGMA > 0. X is any complex number and SIGMA
-;;; is real numbers; or these may be symbolic
-;;; expressions where SIGMA is assumed real.
-;;;
-;;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[].
-;;; LO and HI are any real numbers, or symbolic
-;;; expressions which are assumed real, and LO < HI.
-;;; For [LO..HI], if LO = HI normalization produces LO,
-;;; and if LO > HI normalization produces [LO..LO).
-;;; For other intervals, if LO > HI normalization
-;;; sets HI equal to LO.
-;;;
-;;; (mod N M) Number modulo M. When normalized, 0 <= N < M.
-;;; N and M are real numbers.
-;;;
-;;; (var V S) Symbolic variable. V is a Lisp symbol which
-;;; represents the variable's visible name. S is
-;;; the symbol which actually stores the variable's
-;;; value: (var pi var-pi).
-;;;
-;;; In general, combining rational numbers in a calculation always produces
-;;; a rational result, but if either argument is a float, result is a float.
-
-;;; In the following comments, [x y z] means result is x, args must be y, z,
-;;; respectively, where the code letters are:
-;;;
-;;; O Normalized object (vector or number)
-;;; V Normalized vector
-;;; N Normalized number of any type
-;;; N Normalized complex number
-;;; R Normalized real number (float or rational)
-;;; F Normalized floating-point number
-;;; T Normalized rational number
-;;; I Normalized integer
-;;; B Normalized big integer
-;;; S Normalized small integer
-;;; D Digit (small integer, 0..999)
-;;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol)
-;;; or normalized vector element list (without "vec")
-;;; P Predicate (truth value)
-;;; X Any Lisp object
-;;; Z "nil"
-;;;
-;;; Lower-case letters signify possibly un-normalized values.
-;;; "L.D" means a cons of an L and a D.
-;;; [N N; n n] means result will be normalized if argument is.
-;;; Also, [Public] marks routines intended to be called from outside.
-;;; [This notation has been neglected in many recent routines.]
-
-(defvar math-eval-rules-cache)
-(defvar math-eval-rules-cache-other)
-;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public]
-(defun math-normalize (a)
- (cond
- ((not (consp a))
- (if (integerp a)
- (if (or (>= a 1000000) (<= a -1000000))
- (math-bignum a)
- a)
- a))
- ((eq (car a) 'bigpos)
- (if (eq (nth (1- (length a)) a) 0)
- (let* ((last (setq a (copy-sequence a))) (digs a))
- (while (setq digs (cdr digs))
- (or (eq (car digs) 0) (setq last digs)))
- (setcdr last nil)))
- (if (cdr (cdr (cdr a)))
- a
- (cond
- ((cdr (cdr a)) (+ (nth 1 a) (* (nth 2 a) 1000)))
- ((cdr a) (nth 1 a))
- (t 0))))
- ((eq (car a) 'bigneg)
- (if (eq (nth (1- (length a)) a) 0)
- (let* ((last (setq a (copy-sequence a))) (digs a))
- (while (setq digs (cdr digs))
- (or (eq (car digs) 0) (setq last digs)))
- (setcdr last nil)))
- (if (cdr (cdr (cdr a)))
- a
- (cond
- ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000))))
- ((cdr a) (- (nth 1 a)))
- (t 0))))
- ((eq (car a) 'float)
- (math-make-float (math-normalize (nth 1 a)) (nth 2 a)))
- ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote
- special-const calcFunc-if calcFunc-lambda
- calcFunc-quote calcFunc-condition
- calcFunc-evalto))
- (integerp (car a))
- (and (consp (car a)) (not (eq (car (car a)) 'lambda))))
- (calc-extensions)
- (math-normalize-fancy a))
- (t
- (or (and calc-simplify-mode
- (calc-extensions)
- (math-normalize-nonstandard))
- (let ((args (mapcar 'math-normalize (cdr a))))
- (or (condition-case err
- (let ((func (assq (car a) '( ( + . math-add )
- ( - . math-sub )
- ( * . math-mul )
- ( / . math-div )
- ( % . math-mod )
- ( ^ . math-pow )
- ( neg . math-neg )
- ( | . math-concat ) ))))
- (or (and var-EvalRules
- (progn
- (or (eq var-EvalRules math-eval-rules-cache-tag)
- (progn
- (calc-extensions)
- (math-recompile-eval-rules)))
- (and (or math-eval-rules-cache-other
- (assq (car a) math-eval-rules-cache))
- (math-apply-rewrites
- (cons (car a) args)
- (cdr math-eval-rules-cache)
- nil math-eval-rules-cache))))
- (if func
- (apply (cdr func) args)
- (and (or (consp (car a))
- (fboundp (car a))
- (and (not calc-extensions-loaded)
- (calc-extensions)
- (fboundp (car a))))
- (apply (car a) args)))))
- (wrong-number-of-arguments
- (calc-record-why "*Wrong number of arguments"
- (cons (car a) args))
- nil)
- (wrong-type-argument
- (or calc-next-why (calc-record-why "Wrong type of argument"
- (cons (car a) args)))
- nil)
- (args-out-of-range
- (calc-record-why "*Argument out of range" (cons (car a) args))
- nil)
- (inexact-result
- (calc-record-why "No exact representation for result"
- (cons (car a) args))
- nil)
- (math-overflow
- (calc-record-why "*Floating-point overflow occurred"
- (cons (car a) args))
- nil)
- (math-underflow
- (calc-record-why "*Floating-point underflow occurred"
- (cons (car a) args))
- nil)
- (void-variable
- (if (eq (nth 1 err) 'var-EvalRules)
- (progn
- (setq var-EvalRules nil)
- (math-normalize (cons (car a) args)))
- (calc-record-why "*Variable is void" (nth 1 err)))))
- (if (consp (car a))
- (math-dimension-error)
- (cons (car a) args))))))))
-
-
-
-;;; True if A is a floating-point real or complex number. [P x] [Public]
-(defun math-floatp (a)
- (cond ((eq (car-safe a) 'float) t)
- ((memq (car-safe a) '(cplx polar mod sdev intv))
- (or (math-floatp (nth 1 a))
- (math-floatp (nth 2 a))
- (and (eq (car a) 'intv) (math-floatp (nth 3 a)))))
- ((eq (car-safe a) 'date)
- (math-floatp (nth 1 a)))))
-
-
-
-;;; Verify that A is a complete object and return A. [x x] [Public]
-(defun math-check-complete (a)
- (cond ((integerp a) a)
- ((eq (car-safe a) 'incomplete)
- (calc-incomplete-error a))
- ((consp a) a)
- (t (error "Invalid data object encountered"))))
-
-
-
-;;; Coerce integer A to be a bignum. [B S]
-(defun math-bignum (a)
- (if (>= a 0)
- (cons 'bigpos (math-bignum-big a))
- (cons 'bigneg (math-bignum-big (- a)))))
-
-(defun math-bignum-big (a) ; [L s]
- (if (= a 0)
- nil
- (cons (% a 1000) (math-bignum-big (/ a 1000)))))
-
-
-;;; Build a normalized floating-point number. [F I S]
-(defun math-make-float (mant exp)
- (if (eq mant 0)
- '(float 0 0)
- (let* ((ldiff (- calc-internal-prec (math-numdigs mant))))
- (if (< ldiff 0)
- (setq mant (math-scale-rounding mant ldiff)
- exp (- exp ldiff))))
- (if (consp mant)
- (let ((digs (cdr mant)))
- (if (= (% (car digs) 10) 0)
- (progn
- (while (= (car digs) 0)
- (setq digs (cdr digs)
- exp (+ exp 3)))
- (while (= (% (car digs) 10) 0)
- (setq digs (math-div10-bignum digs)
- exp (1+ exp)))
- (setq mant (math-normalize (cons (car mant) digs))))))
- (while (= (% mant 10) 0)
- (setq mant (/ mant 10)
- exp (1+ exp))))
- (if (and (<= exp -4000000)
- (<= (+ exp (math-numdigs mant) -1) -4000000))
- (signal 'math-underflow nil)
- (if (and (>= exp 3000000)
- (>= (+ exp (math-numdigs mant) -1) 4000000))
- (signal 'math-overflow nil)
- (list 'float mant exp)))))
-
-(defun math-div10-bignum (a) ; [l l]
- (if (cdr a)
- (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100))
- (math-div10-bignum (cdr a)))
- (list (/ (car a) 10))))
-
-;;; Coerce A to be a float. [F N; V V] [Public]
-(defun math-float (a)
- (cond ((Math-integerp a) (math-make-float a 0))
- ((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a)))
- ((eq (car a) 'float) a)
- ((memq (car a) '(cplx polar vec hms date sdev mod))
- (cons (car a) (mapcar 'math-float (cdr a))))
- (t (math-float-fancy a))))
-
-
-(defun math-neg (a)
- (cond ((not (consp a)) (- a))
- ((eq (car a) 'bigpos) (cons 'bigneg (cdr a)))
- ((eq (car a) 'bigneg) (cons 'bigpos (cdr a)))
- ((memq (car a) '(frac float))
- (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
- ((memq (car a) '(cplx vec hms date calcFunc-idn))
- (cons (car a) (mapcar 'math-neg (cdr a))))
- (t (math-neg-fancy a))))
-
-
-;;; Compute the number of decimal digits in integer A. [S I]
-(defun math-numdigs (a)
- (if (consp a)
- (if (cdr a)
- (let* ((len (1- (length a)))
- (top (nth len a)))
- (+ (* len 3) (cond ((>= top 100) 0) ((>= top 10) -1) (t -2))))
- 0)
- (cond ((>= a 100) (+ (math-numdigs (/ a 1000)) 3))
- ((>= a 10) 2)
- ((>= a 1) 1)
- ((= a 0) 0)
- ((> a -10) 1)
- ((> a -100) 2)
- (t (math-numdigs (- a))))))
-
-;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S]
-(defun math-scale-int (a n)
- (cond ((= n 0) a)
- ((> n 0) (math-scale-left a n))
- (t (math-normalize (math-scale-right a (- n))))))
-
-(defun math-scale-left (a n) ; [I I S]
- (if (= n 0)
- a
- (if (consp a)
- (cons (car a) (math-scale-left-bignum (cdr a) n))
- (if (>= n 3)
- (if (or (>= a 1000) (<= a -1000))
- (math-scale-left (math-bignum a) n)
- (math-scale-left (* a 1000) (- n 3)))
- (if (= n 2)
- (if (or (>= a 10000) (<= a -10000))
- (math-scale-left (math-bignum a) 2)
- (* a 100))
- (if (or (>= a 100000) (<= a -100000))
- (math-scale-left (math-bignum a) 1)
- (* a 10)))))))
-
-(defun math-scale-left-bignum (a n)
- (if (>= n 3)
- (while (>= (setq a (cons 0 a)
- n (- n 3)) 3)))
- (if (> n 0)
- (math-mul-bignum-digit a (if (= n 2) 100 10) 0)
- a))
-
-(defun math-scale-right (a n) ; [i i S]
- (if (= n 0)
- a
- (if (consp a)
- (cons (car a) (math-scale-right-bignum (cdr a) n))
- (if (<= a 0)
- (if (= a 0)
- 0
- (- (math-scale-right (- a) n)))
- (if (>= n 3)
- (while (and (> (setq a (/ a 1000)) 0)
- (>= (setq n (- n 3)) 3))))
- (if (= n 2)
- (/ a 100)
- (if (= n 1)
- (/ a 10)
- a))))))
-
-(defun math-scale-right-bignum (a n) ; [L L S; l l S]
- (if (>= n 3)
- (setq a (nthcdr (/ n 3) a)
- n (% n 3)))
- (if (> n 0)
- (cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0))
- a))
-
-;;; Multiply (with rounding) the integer A by 10^N. [I i S]
-(defun math-scale-rounding (a n)
- (cond ((>= n 0)
- (math-scale-left a n))
- ((consp a)
- (math-normalize
- (cons (car a)
- (let ((val (if (< n -3)
- (math-scale-right-bignum (cdr a) (- -3 n))
- (if (= n -2)
- (math-mul-bignum-digit (cdr a) 10 0)
- (if (= n -1)
- (math-mul-bignum-digit (cdr a) 100 0)
- (cdr a)))))) ; n = -3
- (if (and val (>= (car val) 500))
- (if (cdr val)
- (if (eq (car (cdr val)) 999)
- (math-add-bignum (cdr val) '(1))
- (cons (1+ (car (cdr val))) (cdr (cdr val))))
- '(1))
- (cdr val))))))
- (t
- (if (< a 0)
- (- (math-scale-rounding (- a) n))
- (if (= n -1)
- (/ (+ a 5) 10)
- (/ (+ (math-scale-right a (- -1 n)) 5) 10))))))
-
-
-;;; Compute the sum of A and B. [O O O] [Public]
-(defun math-add (a b)
- (or
- (and (not (or (consp a) (consp b)))
- (progn
- (setq a (+ a b))
- (if (or (<= a -1000000) (>= a 1000000))
- (math-bignum a)
- a)))
- (and (Math-zerop a) (not (eq (car-safe a) 'mod))
- (if (and (math-floatp a) (Math-ratp b)) (math-float b) b))
- (and (Math-zerop b) (not (eq (car-safe b) 'mod))
- (if (and (math-floatp b) (Math-ratp a)) (math-float a) a))
- (and (Math-objvecp a) (Math-objvecp b)
- (or
- (and (Math-integerp a) (Math-integerp b)
- (progn
- (or (consp a) (setq a (math-bignum a)))
- (or (consp b) (setq b (math-bignum b)))
- (if (eq (car a) 'bigneg)
- (if (eq (car b) 'bigneg)
- (cons 'bigneg (math-add-bignum (cdr a) (cdr b)))
- (math-normalize
- (let ((diff (math-sub-bignum (cdr b) (cdr a))))
- (if (eq diff 'neg)
- (cons 'bigneg (math-sub-bignum (cdr a) (cdr b)))
- (cons 'bigpos diff)))))
- (if (eq (car b) 'bigneg)
- (math-normalize
- (let ((diff (math-sub-bignum (cdr a) (cdr b))))
- (if (eq diff 'neg)
- (cons 'bigneg (math-sub-bignum (cdr b) (cdr a)))
- (cons 'bigpos diff))))
- (cons 'bigpos (math-add-bignum (cdr a) (cdr b)))))))
- (and (Math-ratp a) (Math-ratp b)
- (calc-extensions)
- (calc-add-fractions a b))
- (and (Math-realp a) (Math-realp b)
- (progn
- (or (and (consp a) (eq (car a) 'float))
- (setq a (math-float a)))
- (or (and (consp b) (eq (car b) 'float))
- (setq b (math-float b)))
- (math-add-float a b)))
- (and (calc-extensions)
- (math-add-objects-fancy a b))))
- (and (calc-extensions)
- (math-add-symb-fancy a b))))
-
-(defun math-add-bignum (a b) ; [L L L; l l l]
- (if a
- (if b
- (let* ((a (copy-sequence a)) (aa a) (carry nil) sum)
- (while (and aa b)
- (if carry
- (if (< (setq sum (+ (car aa) (car b))) 999)
- (progn
- (setcar aa (1+ sum))
- (setq carry nil))
- (setcar aa (+ sum -999)))
- (if (< (setq sum (+ (car aa) (car b))) 1000)
- (setcar aa sum)
- (setcar aa (+ sum -1000))
- (setq carry t)))
- (setq aa (cdr aa)
- b (cdr b)))
- (if carry
- (if b
- (nconc a (math-add-bignum b '(1)))
- (while (eq (car aa) 999)
- (setcar aa 0)
- (setq aa (cdr aa)))
- (if aa
- (progn
- (setcar aa (1+ (car aa)))
- a)
- (nconc a '(1))))
- (if b
- (nconc a b)
- a)))
- a)
- b))
-
-(defun math-sub-bignum (a b) ; [l l l]
- (if b
- (if a
- (let* ((a (copy-sequence a)) (aa a) (borrow nil) sum diff)
- (while (and aa b)
- (if borrow
- (if (>= (setq diff (- (car aa) (car b))) 1)
- (progn
- (setcar aa (1- diff))
- (setq borrow nil))
- (setcar aa (+ diff 999)))
- (if (>= (setq diff (- (car aa) (car b))) 0)
- (setcar aa diff)
- (setcar aa (+ diff 1000))
- (setq borrow t)))
- (setq aa (cdr aa)
- b (cdr b)))
- (if borrow
- (progn
- (while (eq (car aa) 0)
- (setcar aa 999)
- (setq aa (cdr aa)))
- (if aa
- (progn
- (setcar aa (1- (car aa)))
- a)
- 'neg))
- (while (eq (car b) 0)
- (setq b (cdr b)))
- (if b
- 'neg
- a)))
- (while (eq (car b) 0)
- (setq b (cdr b)))
- (and b
- 'neg))
- a))
-
-(defun math-add-float (a b) ; [F F F]
- (let ((ediff (- (nth 2 a) (nth 2 b))))
- (if (>= ediff 0)
- (if (>= ediff (+ calc-internal-prec calc-internal-prec))
- a
- (math-make-float (math-add (nth 1 b)
- (if (eq ediff 0)
- (nth 1 a)
- (math-scale-left (nth 1 a) ediff)))
- (nth 2 b)))
- (if (>= (setq ediff (- ediff))
- (+ calc-internal-prec calc-internal-prec))
- b
- (math-make-float (math-add (nth 1 a)
- (math-scale-left (nth 1 b) ediff))
- (nth 2 a))))))
-
-;;; Compute the difference of A and B. [O O O] [Public]
-(defun math-sub (a b)
- (if (or (consp a) (consp b))
- (math-add a (math-neg b))
- (setq a (- a b))
- (if (or (<= a -1000000) (>= a 1000000))
- (math-bignum a)
- a)))
-
-(defun math-sub-float (a b) ; [F F F]
- (let ((ediff (- (nth 2 a) (nth 2 b))))
- (if (>= ediff 0)
- (if (>= ediff (+ calc-internal-prec calc-internal-prec))
- a
- (math-make-float (math-add (Math-integer-neg (nth 1 b))
- (if (eq ediff 0)
- (nth 1 a)
- (math-scale-left (nth 1 a) ediff)))
- (nth 2 b)))
- (if (>= (setq ediff (- ediff))
- (+ calc-internal-prec calc-internal-prec))
- b
- (math-make-float (math-add (nth 1 a)
- (Math-integer-neg
- (math-scale-left (nth 1 b) ediff)))
- (nth 2 a))))))
-
-
-;;; Compute the product of A and B. [O O O] [Public]
-(defun math-mul (a b)
- (or
- (and (not (consp a)) (not (consp b))
- (< a 1000) (> a -1000) (< b 1000) (> b -1000)
- (* a b))
- (and (Math-zerop a) (not (eq (car-safe b) 'mod))
- (if (Math-scalarp b)
- (if (and (math-floatp b) (Math-ratp a)) (math-float a) a)
- (calc-extensions)
- (math-mul-zero a b)))
- (and (Math-zerop b) (not (eq (car-safe a) 'mod))
- (if (Math-scalarp a)
- (if (and (math-floatp a) (Math-ratp b)) (math-float b) b)
- (calc-extensions)
- (math-mul-zero b a)))
- (and (Math-objvecp a) (Math-objvecp b)
- (or
- (and (Math-integerp a) (Math-integerp b)
- (progn
- (or (consp a) (setq a (math-bignum a)))
- (or (consp b) (setq b (math-bignum b)))
- (math-normalize
- (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
- (if (cdr (cdr a))
- (if (cdr (cdr b))
- (math-mul-bignum (cdr a) (cdr b))
- (math-mul-bignum-digit (cdr a) (nth 1 b) 0))
- (math-mul-bignum-digit (cdr b) (nth 1 a) 0))))))
- (and (Math-ratp a) (Math-ratp b)
- (calc-extensions)
- (calc-mul-fractions a b))
- (and (Math-realp a) (Math-realp b)
- (progn
- (or (and (consp a) (eq (car a) 'float))
- (setq a (math-float a)))
- (or (and (consp b) (eq (car b) 'float))
- (setq b (math-float b)))
- (math-make-float (math-mul (nth 1 a) (nth 1 b))
- (+ (nth 2 a) (nth 2 b)))))
- (and (calc-extensions)
- (math-mul-objects-fancy a b))))
- (and (calc-extensions)
- (math-mul-symb-fancy a b))))
-
-(defun math-infinitep (a &optional undir)
- (while (and (consp a) (memq (car a) '(* / neg)))
- (if (or (not (eq (car a) '*)) (math-infinitep (nth 1 a)))
- (setq a (nth 1 a))
- (setq a (nth 2 a))))
- (and (consp a)
- (eq (car a) 'var)
- (memq (nth 2 a) '(var-inf var-uinf var-nan))
- (if (and undir (eq (nth 2 a) 'var-inf))
- '(var uinf var-uinf)
- a)))
-
-;;; Multiply digit lists A and B. [L L L; l l l]
-(defun math-mul-bignum (a b)
- (and a b
- (let* ((sum (if (<= (car b) 1)
- (if (= (car b) 0)
- (list 0)
- (copy-sequence a))
- (math-mul-bignum-digit a (car b) 0)))
- (sump sum) c d aa ss prod)
- (while (setq b (cdr b))
- (setq ss (setq sump (or (cdr sump) (setcdr sump (list 0))))
- d (car b)
- c 0
- aa a)
- (while (progn
- (setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d))
- c)) 1000))
- (setq aa (cdr aa)))
- (setq c (/ prod 1000)
- ss (or (cdr ss) (setcdr ss (list 0)))))
- (if (>= prod 1000)
- (if (cdr ss)
- (setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss))))
- (setcdr ss (list (/ prod 1000))))))
- sum)))
-
-;;; Multiply digit list A by digit D. [L L D D; l l D D]
-(defun math-mul-bignum-digit (a d c)
- (if a
- (if (<= d 1)
- (and (= d 1) a)
- (let* ((a (copy-sequence a)) (aa a) prod)
- (while (progn
- (setcar aa (% (setq prod (+ (* (car aa) d) c)) 1000))
- (cdr aa))
- (setq aa (cdr aa)
- c (/ prod 1000)))
- (if (>= prod 1000)
- (setcdr aa (list (/ prod 1000))))
- a))
- (and (> c 0)
- (list c))))
-
-
-;;; Compute the integer (quotient . remainder) of A and B, which may be
-;;; small or big integers. Type and consistency of truncation is undefined
-;;; if A or B is negative. B must be nonzero. [I.I I I] [Public]
-(defun math-idivmod (a b)
- (if (eq b 0)
- (math-reject-arg a "*Division by zero"))
- (if (or (consp a) (consp b))
- (if (and (natnump b) (< b 1000))
- (let ((res (math-div-bignum-digit (cdr a) b)))
- (cons
- (math-normalize (cons (car a) (car res)))
- (cdr res)))
- (or (consp a) (setq a (math-bignum a)))
- (or (consp b) (setq b (math-bignum b)))
- (let ((res (math-div-bignum (cdr a) (cdr b))))
- (cons
- (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
- (car res)))
- (math-normalize (cons (car a) (cdr res))))))
- (cons (/ a b) (% a b))))
-
-(defun math-quotient (a b) ; [I I I] [Public]
- (if (and (not (consp a)) (not (consp b)))
- (if (= b 0)
- (math-reject-arg a "*Division by zero")
- (/ a b))
- (if (and (natnump b) (< b 1000))
- (if (= b 0)
- (math-reject-arg a "*Division by zero")
- (math-normalize (cons (car a)
- (car (math-div-bignum-digit (cdr a) b)))))
- (or (consp a) (setq a (math-bignum a)))
- (or (consp b) (setq b (math-bignum b)))
- (let* ((alen (1- (length a)))
- (blen (1- (length b)))
- (d (/ 1000 (1+ (nth (1- blen) (cdr b)))))
- (res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0)
- (math-mul-bignum-digit (cdr b) d 0)
- alen blen)))
- (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
- (car res)))))))
-
-
-;;; Divide a bignum digit list by another. [l.l l L]
-;;; The following division algorithm is borrowed from Knuth vol. II, sec. 4.3.1
-(defun math-div-bignum (a b)
- (if (cdr b)
- (let* ((alen (length a))
- (blen (length b))
- (d (/ 1000 (1+ (nth (1- blen) b))))
- (res (math-div-bignum-big (math-mul-bignum-digit a d 0)
- (math-mul-bignum-digit b d 0)
- alen blen)))
- (if (= d 1)
- res
- (cons (car res)
- (car (math-div-bignum-digit (cdr res) d)))))
- (let ((res (math-div-bignum-digit a (car b))))
- (cons (car res) (list (cdr res))))))
-
-;;; Divide a bignum digit list by a digit. [l.D l D]
-(defun math-div-bignum-digit (a b)
- (if a
- (let* ((res (math-div-bignum-digit (cdr a) b))
- (num (+ (* (cdr res) 1000) (car a))))
- (cons
- (cons (/ num b) (car res))
- (% num b)))
- '(nil . 0)))
-
-(defun math-div-bignum-big (a b alen blen) ; [l.l l L]
- (if (< alen blen)
- (cons nil a)
- (let* ((res (math-div-bignum-big (cdr a) b (1- alen) blen))
- (num (cons (car a) (cdr res)))
- (res2 (math-div-bignum-part num b blen)))
- (cons
- (cons (car res2) (car res))
- (cdr res2)))))
-
-(defun math-div-bignum-part (a b blen) ; a < b*1000 [D.l l L]
- (let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0)))
- (den (nth (1- blen) b))
- (guess (min (/ num den) 999)))
- (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)))
-
-(defun math-div-bignum-try (a b c guess) ; [D.l l l D]
- (let ((rem (math-sub-bignum a c)))
- (if (eq rem 'neg)
- (math-div-bignum-try a b (math-sub-bignum c b) (1- guess))
- (cons guess rem))))
-
-
-;;; Compute the quotient of A and B. [O O N] [Public]
-(defun math-div (a b)
- (or
- (and (Math-zerop b)
- (calc-extensions)
- (math-div-by-zero a b))
- (and (Math-zerop a) (not (eq (car-safe b) 'mod))
- (if (Math-scalarp b)
- (if (and (math-floatp b) (Math-ratp a)) (math-float a) a)
- (calc-extensions)
- (math-div-zero a b)))
- (and (Math-objvecp a) (Math-objvecp b)
- (or
- (and (Math-integerp a) (Math-integerp b)
- (let ((q (math-idivmod a b)))
- (if (eq (cdr q) 0)
- (car q)
- (if calc-prefer-frac
- (progn
- (calc-extensions)
- (math-make-frac a b))
- (math-div-float (math-make-float a 0)
- (math-make-float b 0))))))
- (and (Math-ratp a) (Math-ratp b)
- (calc-extensions)
- (calc-div-fractions a b))
- (and (Math-realp a) (Math-realp b)
- (progn
- (or (and (consp a) (eq (car a) 'float))
- (setq a (math-float a)))
- (or (and (consp b) (eq (car b) 'float))
- (setq b (math-float b)))
- (math-div-float a b)))
- (and (calc-extensions)
- (math-div-objects-fancy a b))))
- (and (calc-extensions)
- (math-div-symb-fancy a b))))
-
-(defun math-div-float (a b) ; [F F F]
- (let ((ldiff (max (- (1+ calc-internal-prec)
- (- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b))))
- 0)))
- (math-make-float (math-quotient (math-scale-int (nth 1 a) ldiff) (nth 1 b))
- (- (- (nth 2 a) (nth 2 b)) ldiff))))
-
-
-
-
-(defvar calc-selection-cache-entry)
-;;; Format the number A as a string. [X N; X Z] [Public]
-(defun math-format-stack-value (entry)
- (setq calc-selection-cache-entry calc-selection-cache-default-entry)
- (let* ((a (car entry))
- (math-comp-selected (nth 2 entry))
- (c (cond ((null a) "<nil>")
- ((eq calc-display-raw t) (format "%s" a))
- ((stringp a) a)
- ((eq a 'top-of-stack) (propertize "." 'font-lock-face 'bold))
- (calc-prepared-composition
- calc-prepared-composition)
- ((and (Math-scalarp a)
- (memq calc-language '(nil flat unform))
- (null math-comp-selected))
- (math-format-number a))
- (t (calc-extensions)
- (math-compose-expr a 0))))
- (off (math-stack-value-offset c))
- s w)
- (and math-comp-selected (setq calc-any-selections t))
- (setq w (cdr off)
- off (car off))
- (when (> off 0)
- (setq c (math-comp-concat (make-string off ? ) c)))
- (or (equal calc-left-label "")
- (setq c (math-comp-concat (if (eq a 'top-of-stack)
- (make-string (length calc-left-label) ? )
- calc-left-label)
- c)))
- (when calc-line-numbering
- (setq c (math-comp-concat (if (eq calc-language 'big)
- (if math-comp-selected
- '(tag t "1: ")
- "1: ")
- " ")
- c)))
- (unless (or (equal calc-right-label "")
- (eq a 'top-of-stack))
- (calc-extensions)
- (setq c (list 'horiz c
- (make-string (max (- w (math-comp-width c)
- (length calc-right-label)) 0) ? )
- '(break -1)
- calc-right-label)))
- (setq s (if (stringp c)
- (if calc-display-raw
- (prin1-to-string c)
- c)
- (math-composition-to-string c w)))
- (when calc-language-output-filter
- (setq s (funcall calc-language-output-filter s)))
- (if (eq calc-language 'big)
- (setq s (concat s "\n"))
- (when calc-line-numbering
- (aset s 0 ?1)
- (aset s 1 ?:)))
- (setcar (cdr entry) (calc-count-lines s))
- s))
-
-(defun math-stack-value-offset (c)
- (let* ((num (if calc-line-numbering 4 0))
- (wid (calc-window-width))
- off)
- (if calc-display-just
- (progn
- (calc-extensions)
- (math-stack-value-offset-fancy))
- (setq off (or calc-display-origin 0))
- (when (integerp calc-line-breaking)
- (setq wid calc-line-breaking)))
- (cons (max (- off (length calc-left-label)) 0)
- (+ wid num))))
-
-(defun calc-count-lines (s)
- (let ((pos 0)
- (num 1))
- (while (setq pos (string-match "\n" s pos))
- (setq pos (1+ pos)
- num (1+ num)))
- num))
-
-(defun math-format-value (a &optional w)
- (if (and (Math-scalarp a)
- (memq calc-language '(nil flat unform)))
- (math-format-number a)
- (calc-extensions)
- (let ((calc-line-breaking nil))
- (math-composition-to-string (math-compose-expr a 0) w))))
-
-(defun calc-window-width ()
- (if calc-embedded-info
- (let ((win (get-buffer-window (aref calc-embedded-info 0))))
- (1- (if win (window-width win) (frame-width))))
- (- (window-width (get-buffer-window (current-buffer)))
- (if calc-line-numbering 5 1))))
-
-(defun math-comp-concat (c1 c2)
- (if (and (stringp c1) (stringp c2))
- (concat c1 c2)
- (list 'horiz c1 c2)))
-
-
-
-;;; Format an expression as a one-line string suitable for re-reading.
-
-(defun math-format-flat-expr (a prec)
- (cond
- ((or (not (or (consp a) (integerp a)))
- (eq calc-display-raw t))
- (let ((print-escape-newlines t))
- (concat "'" (prin1-to-string a))))
- ((Math-scalarp a)
- (let ((calc-group-digits nil)
- (calc-point-char ".")
- (calc-frac-format (if (> (length (car calc-frac-format)) 1)
- '("::" nil) '(":" nil)))
- (calc-complex-format nil)
- (calc-hms-format "%s@ %s' %s\"")
- (calc-language nil))
- (math-format-number a)))
- (t
- (calc-extensions)
- (math-format-flat-expr-fancy a prec))))
-
-
-
-;;; Format a number as a string.
-(defun math-format-number (a &optional prec) ; [X N] [Public]
- (cond
- ((eq calc-display-raw t) (format "%s" a))
- ((and (nth 1 calc-frac-format) (Math-integerp a))
- (calc-extensions)
- (math-format-number (math-adjust-fraction a)))
- ((integerp a)
- (if (not (or calc-group-digits calc-leading-zeros))
- (if (= calc-number-radix 10)
- (int-to-string a)
- (if (< a 0)
- (concat "-" (math-format-number (- a)))
- (calc-extensions)
- (if math-radix-explicit-format
- (if calc-radix-formatter
- (funcall calc-radix-formatter
- calc-number-radix
- (if (= calc-number-radix 2)
- (math-format-binary a)
- (math-format-radix a)))
- (format "%d#%s" calc-number-radix
- (if (= calc-number-radix 2)
- (math-format-binary a)
- (math-format-radix a))))
- (math-format-radix a))))
- (math-format-number (math-bignum a))))
- ((stringp a) a)
- ((not (consp a)) (prin1-to-string a))
- ((eq (car a) 'bigpos) (math-format-bignum (cdr a)))
- ((eq (car a) 'bigneg) (concat "-" (math-format-bignum (cdr a))))
- ((and (eq (car a) 'float) (= calc-number-radix 10))
- (if (Math-integer-negp (nth 1 a))
- (concat "-" (math-format-number (math-neg a)))
- (let ((mant (nth 1 a))
- (exp (nth 2 a))
- (fmt (car calc-float-format))
- (figs (nth 1 calc-float-format))
- (point calc-point-char)
- str)
- (if (and (eq fmt 'fix)
- (or (and (< figs 0) (setq figs (- figs)))
- (> (+ exp (math-numdigs mant)) (- figs))))
- (progn
- (setq mant (math-scale-rounding mant (+ exp figs))
- str (if (integerp mant)
- (int-to-string mant)
- (math-format-bignum-decimal (cdr mant))))
- (if (<= (length str) figs)
- (setq str (concat (make-string (1+ (- figs (length str))) ?0)
- str)))
- (if (> figs 0)
- (setq str (concat (substring str 0 (- figs)) point
- (substring str (- figs))))
- (setq str (concat str point)))
- (when calc-group-digits
- (require 'calc-ext)
- (setq str (math-group-float str))))
- (when (< figs 0)
- (setq figs (+ calc-internal-prec figs)))
- (when (> figs 0)
- (let ((adj (- figs (math-numdigs mant))))
- (when (< adj 0)
- (setq mant (math-scale-rounding mant adj)
- exp (- exp adj)))))
- (setq str (if (integerp mant)
- (int-to-string mant)
- (math-format-bignum-decimal (cdr mant))))
- (let* ((len (length str))
- (dpos (+ exp len)))
- (if (and (eq fmt 'float)
- (<= dpos (+ calc-internal-prec calc-display-sci-high))
- (>= dpos (+ calc-display-sci-low 2)))
- (progn
- (cond
- ((= dpos 0)
- (setq str (concat "0" point str)))
- ((and (<= exp 0) (> dpos 0))
- (setq str (concat (substring str 0 dpos) point
- (substring str dpos))))
- ((> exp 0)
- (setq str (concat str (make-string exp ?0) point)))
- (t ; (< dpos 0)
- (setq str (concat "0" point
- (make-string (- dpos) ?0) str))))
- (when calc-group-digits
- (require 'calc-ext)
- (setq str (math-group-float str))))
- (let* ((eadj (+ exp len))
- (scale (if (eq fmt 'eng)
- (1+ (math-mod (+ eadj 300002) 3))
- 1)))
- (if (> scale (length str))
- (setq str (concat str (make-string (- scale (length str))
- ?0))))
- (if (< scale (length str))
- (setq str (concat (substring str 0 scale) point
- (substring str scale))))
- (when calc-group-digits
- (require 'calc-ext)
- (setq str (math-group-float str)))
- (setq str (format (if (memq calc-language '(math maple))
- (if (and prec (> prec 191))
- "(%s*10.^%d)" "%s*10.^%d")
- "%se%d")
- str (- eadj scale)))))))
- str)))
- (t
- (calc-extensions)
- (math-format-number-fancy a prec))))
-
-(defun math-format-bignum (a) ; [X L]
- (if (and (= calc-number-radix 10)
- (not calc-leading-zeros)
- (not calc-group-digits))
- (math-format-bignum-decimal a)
- (calc-extensions)
- (math-format-bignum-fancy a)))
-
-(defun math-format-bignum-decimal (a) ; [X L]
- (if a
- (let ((s ""))
- (while (cdr (cdr a))
- (setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s)
- a (cdr (cdr a))))
- (concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s))
- "0"))
-
-
-
-;;; Parse a simple number in string form. [N X] [Public]
-(defun math-read-number (s)
- (math-normalize
- (cond
-
- ;; Integers (most common case)
- ((string-match "\\` *\\([0-9]+\\) *\\'" s)
- (let ((digs (math-match-substring s 1)))
- (if (and (eq calc-language 'c)
- (> (length digs) 1)
- (eq (aref digs 0) ?0))
- (math-read-number (concat "8#" digs))
- (if (<= (length digs) 6)
- (string-to-int digs)
- (cons 'bigpos (math-read-bignum digs))))))
-
- ;; Clean up the string if necessary
- ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s)
- (math-read-number (concat (math-match-substring s 1)
- (math-match-substring s 2))))
-
- ;; Plus and minus signs
- ((string-match "^[-_+]\\(.*\\)$" s)
- (let ((val (math-read-number (math-match-substring s 1))))
- (and val (if (eq (aref s 0) ?+) val (math-neg val)))))
-
- ;; Forms that require extensions module
- ((string-match "[^-+0-9eE.]" s)
- (calc-extensions)
- (math-read-number-fancy s))
-
- ;; Decimal point
- ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s)
- (let ((int (math-match-substring s 1))
- (frac (math-match-substring s 2)))
- (let ((ilen (length int))
- (flen (length frac)))
- (let ((int (if (> ilen 0) (math-read-number int) 0))
- (frac (if (> flen 0) (math-read-number frac) 0)))
- (and int frac (or (> ilen 0) (> flen 0))
- (list 'float
- (math-add (math-scale-int int flen) frac)
- (- flen)))))))
-
- ;; "e" notation
- ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s)
- (let ((mant (math-match-substring s 1))
- (exp (math-match-substring s 2)))
- (let ((mant (if (> (length mant) 0) (math-read-number mant) 1))
- (exp (if (<= (length exp) (if (memq (aref exp 0) '(?+ ?-)) 8 7))
- (string-to-int exp))))
- (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000)
- (let ((mant (math-float mant)))
- (list 'float (nth 1 mant) (+ (nth 2 mant) exp)))))))
-
- ;; Syntax error!
- (t nil))))
-
-(defun math-match-substring (s n)
- (if (match-beginning n)
- (substring s (match-beginning n) (match-end n))
- ""))
-
-(defun math-read-bignum (s) ; [l X]
- (if (> (length s) 3)
- (cons (string-to-int (substring s -3))
- (math-read-bignum (substring s 0 -3)))
- (list (string-to-int s))))
-
-
-(defconst math-tex-ignore-words
- '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right")
- ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ")
- ("\\quad") ("\\qquad") ("\\hfil") ("\\hfill")
- ("\\displaystyle") ("\\textstyle") ("\\dsize") ("\\tsize")
- ("\\scriptstyle") ("\\scriptscriptstyle") ("\\ssize") ("\\sssize")
- ("\\rm") ("\\bf") ("\\it") ("\\sl")
- ("\\roman") ("\\bold") ("\\italic") ("\\slanted")
- ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth")
- ("\\evalto")
- ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat)
- ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*")
- ("\\{" punc "[") ("\\}" punc "]")
-))
-
-(defconst math-eqn-ignore-words
- '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto")
- ("left" ("floor") ("ceil"))
- ("right" ("floor") ("ceil"))
- ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh"))
- ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n)
- ("above" punc ",")
-))
-
-(defconst math-standard-opers
- '( ( "_" calcFunc-subscr 1200 1201 )
- ( "%" calcFunc-percent 1100 -1 )
- ( "u+" ident -1 1000 )
- ( "u-" neg -1 1000 197 )
- ( "u!" calcFunc-lnot -1 1000 )
- ( "mod" mod 400 400 185 )
- ( "+/-" sdev 300 300 185 )
- ( "!!" calcFunc-dfact 210 -1 )
- ( "!" calcFunc-fact 210 -1 )
- ( "^" ^ 201 200 )
- ( "**" ^ 201 200 )
- ( "*" * 196 195 )
- ( "2x" * 196 195 )
- ( "/" / 190 191 )
- ( "%" % 190 191 )
- ( "\\" calcFunc-idiv 190 191 )
- ( "+" + 180 181 )
- ( "-" - 180 181 )
- ( "|" | 170 171 )
- ( "<" calcFunc-lt 160 161 )
- ( ">" calcFunc-gt 160 161 )
- ( "<=" calcFunc-leq 160 161 )
- ( ">=" calcFunc-geq 160 161 )
- ( "=" calcFunc-eq 160 161 )
- ( "==" calcFunc-eq 160 161 )
- ( "!=" calcFunc-neq 160 161 )
- ( "&&" calcFunc-land 110 111 )
- ( "||" calcFunc-lor 100 101 )
- ( "?" (math-read-if) 91 90 )
- ( "!!!" calcFunc-pnot -1 85 )
- ( "&&&" calcFunc-pand 80 81 )
- ( "|||" calcFunc-por 75 76 )
- ( ":=" calcFunc-assign 51 50 )
- ( "::" calcFunc-condition 45 46 )
- ( "=>" calcFunc-evalto 40 41 )
- ( "=>" calcFunc-evalto 40 -1 )))
-(defvar math-expr-opers math-standard-opers)
-
-;;;###autoload
-(defun calc-grab-region (top bot arg)
- "Parse the region as a vector of numbers and push it on the Calculator stack."
- (interactive "r\nP")
- (calc-extensions)
- (calc-do-grab-region top bot arg))
-
-;;;###autoload
-(defun calc-grab-rectangle (top bot arg)
- "Parse a rectangle as a matrix of numbers and push it on the Calculator stack."
- (interactive "r\nP")
- (calc-extensions)
- (calc-do-grab-rectangle top bot arg))
-
-(defun calc-grab-sum-down (top bot arg)
- "Parse a rectangle as a matrix of numbers and sum its columns."
- (interactive "r\nP")
- (calc-extensions)
- (calc-do-grab-rectangle top bot arg 'calcFunc-reduced))
-
-(defun calc-grab-sum-across (top bot arg)
- "Parse a rectangle as a matrix of numbers and sum its rows."
- (interactive "r\nP")
- (calc-extensions)
- (calc-do-grab-rectangle top bot arg 'calcFunc-reducea))
-
-
-;;;###autoload
-(defun calc-embedded (arg &optional end obeg oend)
- "Start Calc Embedded mode on the formula surrounding point."
- (interactive "P")
- (calc-extensions)
- (calc-do-embedded arg end obeg oend))
-
-;;;###autoload
-(defun calc-embedded-activate (&optional arg cbuf)
- "Scan the current editing buffer for all embedded := and => formulas.
-Also looks for the equivalent TeX words, \\gets and \\evalto."
- (interactive "P")
- (calc-do-embedded-activate arg cbuf))
-
-(defun calc-user-invocation ()
- (interactive)
- (unless (stringp calc-invocation-macro)
- (error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro"))
- (execute-kbd-macro calc-invocation-macro nil))
-
-;;; User-programmability.
-
-;;;###autoload
-(defmacro defmath (func args &rest body) ; [Public]
- (calc-extensions)
- (math-do-defmath func args body))
-
-;;; Functions needed for Lucid Emacs support.
-
-(defun calc-read-key (&optional optkey)
- (cond (calc-emacs-type-lucid
- (let ((event (next-command-event)))
- (let ((key (event-to-character event t t)))
- (or key optkey (error "Expected a plain keystroke"))
- (cons key event))))
- (calc-emacs-type-gnu19
- (let ((key (read-event)))
- (cons key key)))
- (t
- (let ((key (read-char)))
- (cons key key)))))
-
-(defun calc-unread-command (&optional input)
- (if (featurep 'xemacs)
- (setq unread-command-event
- (if (integerp input) (character-to-event input)
- (or input last-command-event)))
- (push (or input last-command-event) unread-command-events)))
-
-(defun calc-clear-unread-commands ()
- (if (featurep 'xemacs)
- (calc-emacs-type-lucid (setq unread-command-event nil))
- (setq unread-command-events nil)))
-
-(when calc-always-load-extensions
- (calc-extensions)
- (calc-load-everything))
-
-
-(run-hooks 'calc-load-hook)
-
-;;; calc.el ends here
+++ /dev/null
-;;; calcalg2.el --- more algebraic functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-alg-2 () nil)
-
-
-(defun calc-derivative (var num)
- (interactive "sDifferentiate with respect to: \np")
- (calc-slow-wrapper
- (when (< num 0)
- (error "Order of derivative must be positive"))
- (let ((func (if (calc-is-hyperbolic) 'calcFunc-tderiv 'calcFunc-deriv))
- n expr)
- (if (or (equal var "") (equal var "$"))
- (setq n 2
- expr (calc-top-n 2)
- var (calc-top-n 1))
- (setq var (math-read-expr var))
- (when (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (setq n 1
- expr (calc-top-n 1)))
- (while (>= (setq num (1- num)) 0)
- (setq expr (list func expr var)))
- (calc-enter-result n "derv" expr))))
-
-(defun calc-integral (var)
- (interactive "sIntegration variable: ")
- (calc-slow-wrapper
- (if (or (equal var "") (equal var "$"))
- (calc-enter-result 2 "intg" (list 'calcFunc-integ
- (calc-top-n 2)
- (calc-top-n 1)))
- (let ((var (math-read-expr var)))
- (if (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (calc-enter-result 1 "intg" (list 'calcFunc-integ
- (calc-top-n 1)
- var))))))
-
-(defun calc-num-integral (&optional varname lowname highname)
- (interactive "sIntegration variable: ")
- (calc-tabular-command 'calcFunc-ninteg "Integration" "nint"
- nil varname lowname highname))
-
-(defun calc-summation (arg &optional varname lowname highname)
- (interactive "P\nsSummation variable: ")
- (calc-tabular-command 'calcFunc-sum "Summation" "sum"
- arg varname lowname highname))
-
-(defun calc-alt-summation (arg &optional varname lowname highname)
- (interactive "P\nsSummation variable: ")
- (calc-tabular-command 'calcFunc-asum "Summation" "asum"
- arg varname lowname highname))
-
-(defun calc-product (arg &optional varname lowname highname)
- (interactive "P\nsIndex variable: ")
- (calc-tabular-command 'calcFunc-prod "Index" "prod"
- arg varname lowname highname))
-
-(defun calc-tabulate (arg &optional varname lowname highname)
- (interactive "P\nsIndex variable: ")
- (calc-tabular-command 'calcFunc-table "Index" "tabl"
- arg varname lowname highname))
-
-(defun calc-tabular-command (func prompt prefix arg varname lowname highname)
- (calc-slow-wrapper
- (let (var (low nil) (high nil) (step nil) stepname stepnum (num 1) expr)
- (if (consp arg)
- (setq stepnum 1)
- (setq stepnum 0))
- (if (or (equal varname "") (equal varname "$") (null varname))
- (setq high (calc-top-n (+ stepnum 1))
- low (calc-top-n (+ stepnum 2))
- var (calc-top-n (+ stepnum 3))
- num (+ stepnum 4))
- (setq var (if (stringp varname) (math-read-expr varname) varname))
- (if (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (or lowname
- (setq lowname (read-string (concat prompt " variable: " varname
- ", from: "))))
- (if (or (equal lowname "") (equal lowname "$"))
- (setq high (calc-top-n (+ stepnum 1))
- low (calc-top-n (+ stepnum 2))
- num (+ stepnum 3))
- (setq low (if (stringp lowname) (math-read-expr lowname) lowname))
- (if (eq (car-safe low) 'error)
- (error "Bad format in expression: %s" (nth 1 low)))
- (or highname
- (setq highname (read-string (concat prompt " variable: " varname
- ", from: " lowname
- ", to: "))))
- (if (or (equal highname "") (equal highname "$"))
- (setq high (calc-top-n (+ stepnum 1))
- num (+ stepnum 2))
- (setq high (if (stringp highname) (math-read-expr highname)
- highname))
- (if (eq (car-safe high) 'error)
- (error "Bad format in expression: %s" (nth 1 high)))
- (if (consp arg)
- (progn
- (setq stepname (read-string (concat prompt " variable: "
- varname
- ", from: " lowname
- ", to: " highname
- ", step: ")))
- (if (or (equal stepname "") (equal stepname "$"))
- (setq step (calc-top-n 1)
- num 2)
- (setq step (math-read-expr stepname))
- (if (eq (car-safe step) 'error)
- (error "Bad format in expression: %s"
- (nth 1 step)))))))))
- (or step
- (if (consp arg)
- (setq step (calc-top-n 1))
- (if arg
- (setq step (prefix-numeric-value arg)))))
- (setq expr (calc-top-n num))
- (calc-enter-result num prefix (append (list func expr var low high)
- (and step (list step)))))))
-
-(defun calc-solve-for (var)
- (interactive "sVariable to solve for: ")
- (calc-slow-wrapper
- (let ((func (if (calc-is-inverse)
- (if (calc-is-hyperbolic) 'calcFunc-ffinv 'calcFunc-finv)
- (if (calc-is-hyperbolic) 'calcFunc-fsolve 'calcFunc-solve))))
- (if (or (equal var "") (equal var "$"))
- (calc-enter-result 2 "solv" (list func
- (calc-top-n 2)
- (calc-top-n 1)))
- (let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
- (math-read-expr (concat "[" var "]"))
- (math-read-expr var))))
- (if (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (calc-enter-result 1 "solv" (list func
- (calc-top-n 1)
- var)))))))
-
-(defun calc-poly-roots (var)
- (interactive "sVariable to solve for: ")
- (calc-slow-wrapper
- (if (or (equal var "") (equal var "$"))
- (calc-enter-result 2 "prts" (list 'calcFunc-roots
- (calc-top-n 2)
- (calc-top-n 1)))
- (let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
- (math-read-expr (concat "[" var "]"))
- (math-read-expr var))))
- (if (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (calc-enter-result 1 "prts" (list 'calcFunc-roots
- (calc-top-n 1)
- var))))))
-
-(defun calc-taylor (var nterms)
- (interactive "sTaylor expansion variable: \nNNumber of terms: ")
- (calc-slow-wrapper
- (let ((var (math-read-expr var)))
- (if (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (calc-enter-result 1 "tylr" (list 'calcFunc-taylor
- (calc-top-n 1)
- var
- (prefix-numeric-value nterms))))))
-
-
-(defun math-derivative (expr) ; uses global values: deriv-var, deriv-total.
- (cond ((equal expr deriv-var)
- 1)
- ((or (Math-scalarp expr)
- (eq (car expr) 'sdev)
- (and (eq (car expr) 'var)
- (or (not deriv-total)
- (math-const-var expr)
- (progn
- (math-setup-declarations)
- (memq 'const (nth 1 (or (assq (nth 2 expr)
- math-decls-cache)
- math-decls-all)))))))
- 0)
- ((eq (car expr) '+)
- (math-add (math-derivative (nth 1 expr))
- (math-derivative (nth 2 expr))))
- ((eq (car expr) '-)
- (math-sub (math-derivative (nth 1 expr))
- (math-derivative (nth 2 expr))))
- ((memq (car expr) '(calcFunc-eq calcFunc-neq calcFunc-lt
- calcFunc-gt calcFunc-leq calcFunc-geq))
- (list (car expr)
- (math-derivative (nth 1 expr))
- (math-derivative (nth 2 expr))))
- ((eq (car expr) 'neg)
- (math-neg (math-derivative (nth 1 expr))))
- ((eq (car expr) '*)
- (math-add (math-mul (nth 2 expr)
- (math-derivative (nth 1 expr)))
- (math-mul (nth 1 expr)
- (math-derivative (nth 2 expr)))))
- ((eq (car expr) '/)
- (math-sub (math-div (math-derivative (nth 1 expr))
- (nth 2 expr))
- (math-div (math-mul (nth 1 expr)
- (math-derivative (nth 2 expr)))
- (math-sqr (nth 2 expr)))))
- ((eq (car expr) '^)
- (let ((du (math-derivative (nth 1 expr)))
- (dv (math-derivative (nth 2 expr))))
- (or (Math-zerop du)
- (setq du (math-mul (nth 2 expr)
- (math-mul (math-normalize
- (list '^
- (nth 1 expr)
- (math-add (nth 2 expr) -1)))
- du))))
- (or (Math-zerop dv)
- (setq dv (math-mul (math-normalize
- (list 'calcFunc-ln (nth 1 expr)))
- (math-mul expr dv))))
- (math-add du dv)))
- ((eq (car expr) '%)
- (math-derivative (nth 1 expr))) ; a reasonable definition
- ((eq (car expr) 'vec)
- (math-map-vec 'math-derivative expr))
- ((and (memq (car expr) '(calcFunc-conj calcFunc-re calcFunc-im))
- (= (length expr) 2))
- (list (car expr) (math-derivative (nth 1 expr))))
- ((and (memq (car expr) '(calcFunc-subscr calcFunc-mrow calcFunc-mcol))
- (= (length expr) 3))
- (let ((d (math-derivative (nth 1 expr))))
- (if (math-numberp d)
- 0 ; assume x and x_1 are independent vars
- (list (car expr) d (nth 2 expr)))))
- (t (or (and (symbolp (car expr))
- (if (= (length expr) 2)
- (let ((handler (get (car expr) 'math-derivative)))
- (and handler
- (let ((deriv (math-derivative (nth 1 expr))))
- (if (Math-zerop deriv)
- deriv
- (math-mul (funcall handler (nth 1 expr))
- deriv)))))
- (let ((handler (get (car expr) 'math-derivative-n)))
- (and handler
- (funcall handler expr)))))
- (and (not (eq deriv-symb 'pre-expand))
- (let ((exp (math-expand-formula expr)))
- (and exp
- (or (let ((deriv-symb 'pre-expand))
- (catch 'math-deriv (math-derivative expr)))
- (math-derivative exp)))))
- (if (or (Math-objvecp expr)
- (eq (car expr) 'var)
- (not (symbolp (car expr))))
- (if deriv-symb
- (throw 'math-deriv nil)
- (list (if deriv-total 'calcFunc-tderiv 'calcFunc-deriv)
- expr
- deriv-var))
- (let ((accum 0)
- (arg expr)
- (n 1)
- derv)
- (while (setq arg (cdr arg))
- (or (Math-zerop (setq derv (math-derivative (car arg))))
- (let ((func (intern (concat (symbol-name (car expr))
- "'"
- (if (> n 1)
- (int-to-string n)
- ""))))
- (prop (cond ((= (length expr) 2)
- 'math-derivative-1)
- ((= (length expr) 3)
- 'math-derivative-2)
- ((= (length expr) 4)
- 'math-derivative-3)
- ((= (length expr) 5)
- 'math-derivative-4)
- ((= (length expr) 6)
- 'math-derivative-5))))
- (setq accum
- (math-add
- accum
- (math-mul
- derv
- (let ((handler (get func prop)))
- (or (and prop handler
- (apply handler (cdr expr)))
- (if (and deriv-symb
- (not (get func
- 'calc-user-defn)))
- (throw 'math-deriv nil)
- (cons func (cdr expr))))))))))
- (setq n (1+ n)))
- accum))))))
-
-(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb)
- (let* ((deriv-total nil)
- (res (catch 'math-deriv (math-derivative expr))))
- (or (eq (car-safe res) 'calcFunc-deriv)
- (null res)
- (setq res (math-normalize res)))
- (and res
- (if deriv-value
- (math-expr-subst res deriv-var deriv-value)
- res))))
-
-(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb)
- (math-setup-declarations)
- (let* ((deriv-total t)
- (res (catch 'math-deriv (math-derivative expr))))
- (or (eq (car-safe res) 'calcFunc-tderiv)
- (null res)
- (setq res (math-normalize res)))
- (and res
- (if deriv-value
- (math-expr-subst res deriv-var deriv-value)
- res))))
-
-(put 'calcFunc-inv\' 'math-derivative-1
- (function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))
-
-(put 'calcFunc-sqrt\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
-
-(put 'calcFunc-deg\' 'math-derivative-1
- (function (lambda (u) (math-div-float '(float 18 1) (math-pi)))))
-
-(put 'calcFunc-rad\' 'math-derivative-1
- (function (lambda (u) (math-pi-over-180))))
-
-(put 'calcFunc-ln\' 'math-derivative-1
- (function (lambda (u) (math-div 1 u))))
-
-(put 'calcFunc-log10\' 'math-derivative-1
- (function (lambda (u)
- (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
- u))))
-
-(put 'calcFunc-lnp1\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-add u 1)))))
-
-(put 'calcFunc-log\' 'math-derivative-2
- (function (lambda (x b)
- (and (not (Math-zerop b))
- (let ((lnv (math-normalize
- (list 'calcFunc-ln b))))
- (math-div 1 (math-mul lnv x)))))))
-
-(put 'calcFunc-log\'2 'math-derivative-2
- (function (lambda (x b)
- (let ((lnv (list 'calcFunc-ln b)))
- (math-neg (math-div (list 'calcFunc-log x b)
- (math-mul lnv b)))))))
-
-(put 'calcFunc-exp\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))
-
-(put 'calcFunc-expm1\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))
-
-(put 'calcFunc-sin\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2 (math-normalize
- (list 'calcFunc-cos u))))))
-
-(put 'calcFunc-cos\' 'math-derivative-1
- (function (lambda (u) (math-neg (math-to-radians-2
- (math-normalize
- (list 'calcFunc-sin u)))))))
-
-(put 'calcFunc-tan\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
- (math-div 1 (math-sqr
- (math-normalize
- (list 'calcFunc-cos u))))))))
-
-(put 'calcFunc-arcsin\' 'math-derivative-1
- (function (lambda (u)
- (math-from-radians-2
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr u)))))))))
-
-(put 'calcFunc-arccos\' 'math-derivative-1
- (function (lambda (u)
- (math-from-radians-2
- (math-div -1 (math-normalize
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr u)))))))))
-
-(put 'calcFunc-arctan\' 'math-derivative-1
- (function (lambda (u) (math-from-radians-2
- (math-div 1 (math-add 1 (math-sqr u)))))))
-
-(put 'calcFunc-sinh\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))
-
-(put 'calcFunc-cosh\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))
-
-(put 'calcFunc-tanh\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-sqr
- (math-normalize
- (list 'calcFunc-cosh u)))))))
-
-(put 'calcFunc-arcsinh\' 'math-derivative-1
- (function (lambda (u)
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr u) 1)))))))
-
-(put 'calcFunc-arccosh\' 'math-derivative-1
- (function (lambda (u)
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr u) -1)))))))
-
-(put 'calcFunc-arctanh\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))
-
-(put 'calcFunc-bern\'2 'math-derivative-2
- (function (lambda (n x)
- (math-mul n (list 'calcFunc-bern (math-add n -1) x)))))
-
-(put 'calcFunc-euler\'2 'math-derivative-2
- (function (lambda (n x)
- (math-mul n (list 'calcFunc-euler (math-add n -1) x)))))
-
-(put 'calcFunc-gammag\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x 1))))
-
-(put 'calcFunc-gammaG\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x -1))))
-
-(put 'calcFunc-gammaP\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x
- (math-div
- 1 (math-normalize
- (list 'calcFunc-gamma
- a)))))))
-
-(put 'calcFunc-gammaQ\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x
- (math-div
- -1 (math-normalize
- (list 'calcFunc-gamma
- a)))))))
-
-(defun math-deriv-gamma (a x scale)
- (math-mul scale
- (math-mul (math-pow x (math-add a -1))
- (list 'calcFunc-exp (math-neg x)))))
-
-(put 'calcFunc-betaB\' 'math-derivative-3
- (function (lambda (x a b) (math-deriv-beta x a b 1))))
-
-(put 'calcFunc-betaI\' 'math-derivative-3
- (function (lambda (x a b) (math-deriv-beta x a b
- (math-div
- 1 (list 'calcFunc-beta
- a b))))))
-
-(defun math-deriv-beta (x a b scale)
- (math-mul (math-mul (math-pow x (math-add a -1))
- (math-pow (math-sub 1 x) (math-add b -1)))
- scale))
-
-(put 'calcFunc-erf\' 'math-derivative-1
- (function (lambda (x) (math-div 2
- (math-mul (list 'calcFunc-exp
- (math-sqr x))
- (if calc-symbolic-mode
- '(calcFunc-sqrt
- (var pi var-pi))
- (math-sqrt-pi)))))))
-
-(put 'calcFunc-erfc\' 'math-derivative-1
- (function (lambda (x) (math-div -2
- (math-mul (list 'calcFunc-exp
- (math-sqr x))
- (if calc-symbolic-mode
- '(calcFunc-sqrt
- (var pi var-pi))
- (math-sqrt-pi)))))))
-
-(put 'calcFunc-besJ\'2 'math-derivative-2
- (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
- (math-add v -1)
- z)
- (list 'calcFunc-besJ
- (math-add v 1)
- z))
- 2))))
-
-(put 'calcFunc-besY\'2 'math-derivative-2
- (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
- (math-add v -1)
- z)
- (list 'calcFunc-besY
- (math-add v 1)
- z))
- 2))))
-
-(put 'calcFunc-sum 'math-derivative-n
- (function
- (lambda (expr)
- (if (math-expr-contains (cons 'vec (cdr (cdr expr))) deriv-var)
- (throw 'math-deriv nil)
- (cons 'calcFunc-sum
- (cons (math-derivative (nth 1 expr))
- (cdr (cdr expr))))))))
-
-(put 'calcFunc-prod 'math-derivative-n
- (function
- (lambda (expr)
- (if (math-expr-contains (cons 'vec (cdr (cdr expr))) deriv-var)
- (throw 'math-deriv nil)
- (math-mul expr
- (cons 'calcFunc-sum
- (cons (math-div (math-derivative (nth 1 expr))
- (nth 1 expr))
- (cdr (cdr expr)))))))))
-
-(put 'calcFunc-integ 'math-derivative-n
- (function
- (lambda (expr)
- (if (= (length expr) 3)
- (if (equal (nth 2 expr) deriv-var)
- (nth 1 expr)
- (math-normalize
- (list 'calcFunc-integ
- (math-derivative (nth 1 expr))
- (nth 2 expr))))
- (if (= (length expr) 5)
- (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
- (nth 3 expr)))
- (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
- (nth 4 expr))))
- (math-add (math-sub (math-mul upper
- (math-derivative (nth 4 expr)))
- (math-mul lower
- (math-derivative (nth 3 expr))))
- (if (equal (nth 2 expr) deriv-var)
- 0
- (math-normalize
- (list 'calcFunc-integ
- (math-derivative (nth 1 expr)) (nth 2 expr)
- (nth 3 expr) (nth 4 expr)))))))))))
-
-(put 'calcFunc-if 'math-derivative-n
- (function
- (lambda (expr)
- (and (= (length expr) 4)
- (list 'calcFunc-if (nth 1 expr)
- (math-derivative (nth 2 expr))
- (math-derivative (nth 3 expr)))))))
-
-(put 'calcFunc-subscr 'math-derivative-n
- (function
- (lambda (expr)
- (and (= (length expr) 3)
- (list 'calcFunc-subscr (nth 1 expr)
- (math-derivative (nth 2 expr)))))))
-
-
-(defvar math-integ-var '(var X ---))
-(defvar math-integ-var-2 '(var Y ---))
-(defvar math-integ-vars (list 'f math-integ-var math-integ-var-2))
-(defvar math-integ-var-list (list math-integ-var))
-(defvar math-integ-var-list-list (list math-integ-var-list))
-
-(defmacro math-tracing-integral (&rest parts)
- (list 'and
- 'trace-buffer
- (list 'save-excursion
- '(set-buffer trace-buffer)
- '(goto-char (point-max))
- (list 'and
- '(bolp)
- '(insert (make-string (- math-integral-limit
- math-integ-level) 32)
- (format "%2d " math-integ-depth)
- (make-string math-integ-level 32)))
- ;;(list 'condition-case 'err
- (cons 'insert parts)
- ;; '(error (insert (prin1-to-string err))))
- '(sit-for 0))))
-
-;;; The following wrapper caches results and avoids infinite recursion.
-;;; Each cache entry is: ( A B ) Integral of A is B;
-;;; ( A N ) Integral of A failed at level N;
-;;; ( A busy ) Currently working on integral of A;
-;;; ( A parts ) Currently working, integ-by-parts;
-;;; ( A parts2 ) Currently working, integ-by-parts;
-;;; ( A cancelled ) Ignore this cache entry;
-;;; ( A [B] ) Same result as for cur-record = B.
-(defun math-integral (expr &optional simplify same-as-above)
- (let* ((simp cur-record)
- (cur-record (assoc expr math-integral-cache))
- (math-integ-depth (1+ math-integ-depth))
- (val 'cancelled))
- (math-tracing-integral "Integrating "
- (math-format-value expr 1000)
- "...\n")
- (and cur-record
- (progn
- (math-tracing-integral "Found "
- (math-format-value (nth 1 cur-record) 1000))
- (and (consp (nth 1 cur-record))
- (math-replace-integral-parts cur-record))
- (math-tracing-integral " => "
- (math-format-value (nth 1 cur-record) 1000)
- "\n")))
- (or (and cur-record
- (not (eq (nth 1 cur-record) 'cancelled))
- (or (not (integerp (nth 1 cur-record)))
- (>= (nth 1 cur-record) math-integ-level)))
- (and (math-integral-contains-parts expr)
- (progn
- (setq val nil)
- t))
- (unwind-protect
- (progn
- (let (math-integ-msg)
- (if (eq calc-display-working-message 'lots)
- (progn
- (calc-set-command-flag 'clear-message)
- (setq math-integ-msg (format
- "Working... Integrating %s"
- (math-format-flat-expr expr 0)))
- (message math-integ-msg)))
- (if cur-record
- (setcar (cdr cur-record)
- (if same-as-above (vector simp) 'busy))
- (setq cur-record
- (list expr (if same-as-above (vector simp) 'busy))
- math-integral-cache (cons cur-record
- math-integral-cache)))
- (if (eq simplify 'yes)
- (progn
- (math-tracing-integral "Simplifying...")
- (setq simp (math-simplify expr))
- (setq val (if (equal simp expr)
- (progn
- (math-tracing-integral " no change\n")
- (math-do-integral expr))
- (math-tracing-integral " simplified\n")
- (math-integral simp 'no t))))
- (or (setq val (math-do-integral expr))
- (eq simplify 'no)
- (let ((simp (math-simplify expr)))
- (or (equal simp expr)
- (progn
- (math-tracing-integral "Trying again after "
- "simplification...\n")
- (setq val (math-integral simp 'no t))))))))
- (if (eq calc-display-working-message 'lots)
- (message math-integ-msg)))
- (setcar (cdr cur-record) (or val
- (if (or math-enable-subst
- (not math-any-substs))
- math-integ-level
- 'cancelled)))))
- (setq val cur-record)
- (while (vectorp (nth 1 val))
- (setq val (aref (nth 1 val) 0)))
- (setq val (if (memq (nth 1 val) '(parts parts2))
- (progn
- (setcar (cdr val) 'parts2)
- (list 'var 'PARTS val))
- (and (consp (nth 1 val))
- (nth 1 val))))
- (math-tracing-integral "Integral of "
- (math-format-value expr 1000)
- " is "
- (math-format-value val 1000)
- "\n")
- val))
-(defvar math-integral-cache nil)
-(defvar math-integral-cache-state nil)
-
-(defun math-integral-contains-parts (expr)
- (if (Math-primp expr)
- (and (eq (car-safe expr) 'var)
- (eq (nth 1 expr) 'PARTS)
- (listp (nth 2 expr)))
- (while (and (setq expr (cdr expr))
- (not (math-integral-contains-parts (car expr)))))
- expr))
-
-(defun math-replace-integral-parts (expr)
- (or (Math-primp expr)
- (while (setq expr (cdr expr))
- (and (consp (car expr))
- (if (eq (car (car expr)) 'var)
- (and (eq (nth 1 (car expr)) 'PARTS)
- (consp (nth 2 (car expr)))
- (if (listp (nth 1 (nth 2 (car expr))))
- (progn
- (setcar expr (nth 1 (nth 2 (car expr))))
- (math-replace-integral-parts (cons 'foo expr)))
- (setcar (cdr cur-record) 'cancelled)))
- (math-replace-integral-parts (car expr)))))))
-
-(defun math-do-integral (expr)
- (let (t1 t2)
- (or (cond ((not (math-expr-contains expr math-integ-var))
- (math-mul expr math-integ-var))
- ((equal expr math-integ-var)
- (math-div (math-sqr expr) 2))
- ((eq (car expr) '+)
- (and (setq t1 (math-integral (nth 1 expr)))
- (setq t2 (math-integral (nth 2 expr)))
- (math-add t1 t2)))
- ((eq (car expr) '-)
- (and (setq t1 (math-integral (nth 1 expr)))
- (setq t2 (math-integral (nth 2 expr)))
- (math-sub t1 t2)))
- ((eq (car expr) 'neg)
- (and (setq t1 (math-integral (nth 1 expr)))
- (math-neg t1)))
- ((eq (car expr) '*)
- (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
- (and (setq t1 (math-integral (nth 2 expr)))
- (math-mul (nth 1 expr) t1)))
- ((not (math-expr-contains (nth 2 expr) math-integ-var))
- (and (setq t1 (math-integral (nth 1 expr)))
- (math-mul t1 (nth 2 expr))))
- ((memq (car-safe (nth 1 expr)) '(+ -))
- (math-integral (list (car (nth 1 expr))
- (math-mul (nth 1 (nth 1 expr))
- (nth 2 expr))
- (math-mul (nth 2 (nth 1 expr))
- (nth 2 expr)))
- 'yes t))
- ((memq (car-safe (nth 2 expr)) '(+ -))
- (math-integral (list (car (nth 2 expr))
- (math-mul (nth 1 (nth 2 expr))
- (nth 1 expr))
- (math-mul (nth 2 (nth 2 expr))
- (nth 1 expr)))
- 'yes t))))
- ((eq (car expr) '/)
- (cond ((and (not (math-expr-contains (nth 1 expr)
- math-integ-var))
- (not (math-equal-int (nth 1 expr) 1)))
- (and (setq t1 (math-integral (math-div 1 (nth 2 expr))))
- (math-mul (nth 1 expr) t1)))
- ((not (math-expr-contains (nth 2 expr) math-integ-var))
- (and (setq t1 (math-integral (nth 1 expr)))
- (math-div t1 (nth 2 expr))))
- ((and (eq (car-safe (nth 1 expr)) '*)
- (not (math-expr-contains (nth 1 (nth 1 expr))
- math-integ-var)))
- (and (setq t1 (math-integral
- (math-div (nth 2 (nth 1 expr))
- (nth 2 expr))))
- (math-mul t1 (nth 1 (nth 1 expr)))))
- ((and (eq (car-safe (nth 1 expr)) '*)
- (not (math-expr-contains (nth 2 (nth 1 expr))
- math-integ-var)))
- (and (setq t1 (math-integral
- (math-div (nth 1 (nth 1 expr))
- (nth 2 expr))))
- (math-mul t1 (nth 2 (nth 1 expr)))))
- ((and (eq (car-safe (nth 2 expr)) '*)
- (not (math-expr-contains (nth 1 (nth 2 expr))
- math-integ-var)))
- (and (setq t1 (math-integral
- (math-div (nth 1 expr)
- (nth 2 (nth 2 expr)))))
- (math-div t1 (nth 1 (nth 2 expr)))))
- ((and (eq (car-safe (nth 2 expr)) '*)
- (not (math-expr-contains (nth 2 (nth 2 expr))
- math-integ-var)))
- (and (setq t1 (math-integral
- (math-div (nth 1 expr)
- (nth 1 (nth 2 expr)))))
- (math-div t1 (nth 2 (nth 2 expr)))))
- ((eq (car-safe (nth 2 expr)) 'calcFunc-exp)
- (math-integral
- (math-mul (nth 1 expr)
- (list 'calcFunc-exp
- (math-neg (nth 1 (nth 2 expr)))))))))
- ((eq (car expr) '^)
- (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
- (or (and (setq t1 (math-is-polynomial (nth 2 expr)
- math-integ-var 1))
- (math-div expr
- (math-mul (nth 1 t1)
- (math-normalize
- (list 'calcFunc-ln
- (nth 1 expr))))))
- (math-integral
- (list 'calcFunc-exp
- (math-mul (nth 2 expr)
- (math-normalize
- (list 'calcFunc-ln
- (nth 1 expr)))))
- 'yes t)))
- ((not (math-expr-contains (nth 2 expr) math-integ-var))
- (if (and (integerp (nth 2 expr)) (< (nth 2 expr) 0))
- (math-integral
- (list '/ 1 (math-pow (nth 1 expr) (- (nth 2 expr))))
- nil t)
- (or (and (setq t1 (math-is-polynomial (nth 1 expr)
- math-integ-var
- 1))
- (setq t2 (math-add (nth 2 expr) 1))
- (math-div (math-pow (nth 1 expr) t2)
- (math-mul t2 (nth 1 t1))))
- (and (Math-negp (nth 2 expr))
- (math-integral
- (math-div 1
- (math-pow (nth 1 expr)
- (math-neg
- (nth 2 expr))))
- nil t))
- nil))))))
-
- ;; Integral of a polynomial.
- (and (setq t1 (math-is-polynomial expr math-integ-var 20))
- (let ((accum 0)
- (n 1))
- (while t1
- (if (setq accum (math-add accum
- (math-div (math-mul (car t1)
- (math-pow
- math-integ-var
- n))
- n))
- t1 (cdr t1))
- (setq n (1+ n))))
- accum))
-
- ;; Try looking it up!
- (cond ((= (length expr) 2)
- (and (symbolp (car expr))
- (setq t1 (get (car expr) 'math-integral))
- (progn
- (while (and t1
- (not (setq t2 (funcall (car t1)
- (nth 1 expr)))))
- (setq t1 (cdr t1)))
- (and t2 (math-normalize t2)))))
- ((= (length expr) 3)
- (and (symbolp (car expr))
- (setq t1 (get (car expr) 'math-integral-2))
- (progn
- (while (and t1
- (not (setq t2 (funcall (car t1)
- (nth 1 expr)
- (nth 2 expr)))))
- (setq t1 (cdr t1)))
- (and t2 (math-normalize t2))))))
-
- ;; Integral of a rational function.
- (and (math-ratpoly-p expr math-integ-var)
- (setq t1 (calcFunc-apart expr math-integ-var))
- (not (equal t1 expr))
- (math-integral t1))
-
- ;; Try user-defined integration rules.
- (and has-rules
- (let ((math-old-integ (symbol-function 'calcFunc-integ))
- (input (list 'calcFunc-integtry expr math-integ-var))
- res part)
- (unwind-protect
- (progn
- (fset 'calcFunc-integ 'math-sub-integration)
- (setq res (math-rewrite input
- '(var IntegRules var-IntegRules)
- 1))
- (fset 'calcFunc-integ math-old-integ)
- (and (not (equal res input))
- (if (setq part (math-expr-calls
- res '(calcFunc-integsubst)))
- (and (memq (length part) '(3 4 5))
- (let ((parts (mapcar
- (function
- (lambda (x)
- (math-expr-subst
- x (nth 2 part)
- math-integ-var)))
- (cdr part))))
- (math-integrate-by-substitution
- expr (car parts) t
- (or (nth 2 parts)
- (list 'calcFunc-integfailed
- math-integ-var))
- (nth 3 parts))))
- (if (not (math-expr-calls res
- '(calcFunc-integtry
- calcFunc-integfailed)))
- res))))
- (fset 'calcFunc-integ math-old-integ))))
-
- ;; See if the function is a symbolic derivative.
- (and (string-match "'" (symbol-name (car expr)))
- (let ((name (symbol-name (car expr)))
- (p expr) (n 0) (which nil) (bad nil))
- (while (setq n (1+ n) p (cdr p))
- (if (equal (car p) math-integ-var)
- (if which (setq bad t) (setq which n))
- (if (math-expr-contains (car p) math-integ-var)
- (setq bad t))))
- (and which (not bad)
- (let ((prime (if (= which 1) "'" (format "'%d" which))))
- (and (string-match (concat prime "\\('['0-9]*\\|$\\)")
- name)
- (cons (intern
- (concat
- (substring name 0 (match-beginning 0))
- (substring name (+ (match-beginning 0)
- (length prime)))))
- (cdr expr)))))))
-
- ;; Try transformation methods (parts, substitutions).
- (and (> math-integ-level 0)
- (math-do-integral-methods expr))
-
- ;; Try expanding the function's definition.
- (let ((res (math-expand-formula expr)))
- (and res
- (math-integral res))))))
-
-(defun math-sub-integration (expr &rest rest)
- (or (if (or (not rest)
- (and (< math-integ-level math-integral-limit)
- (eq (car rest) math-integ-var)))
- (math-integral expr)
- (let ((res (apply math-old-integ expr rest)))
- (and (or (= math-integ-level math-integral-limit)
- (not (math-expr-calls res 'calcFunc-integ)))
- res)))
- (list 'calcFunc-integfailed expr)))
-
-(defun math-do-integral-methods (expr)
- (let ((so-far math-integ-var-list-list)
- rat-in)
-
- ;; Integration by substitution, for various likely sub-expressions.
- ;; (In first pass, we look only for sub-exprs that are linear in X.)
- (or (if math-enable-subst
- (math-integ-try-substitutions expr)
- (math-integ-try-linear-substitutions expr))
-
- ;; If function has sines and cosines, try tan(x/2) substitution.
- (and (let ((p (setq rat-in (math-expr-rational-in expr))))
- (while (and p
- (memq (car (car p)) '(calcFunc-sin
- calcFunc-cos
- calcFunc-tan))
- (equal (nth 1 (car p)) math-integ-var))
- (setq p (cdr p)))
- (null p))
- (or (and (math-integ-parts-easy expr)
- (math-integ-try-parts expr t))
- (math-integrate-by-good-substitution
- expr (list 'calcFunc-tan (math-div math-integ-var 2)))))
-
- ;; If function has sinh and cosh, try tanh(x/2) substitution.
- (and (let ((p rat-in))
- (while (and p
- (memq (car (car p)) '(calcFunc-sinh
- calcFunc-cosh
- calcFunc-tanh
- calcFunc-exp))
- (equal (nth 1 (car p)) math-integ-var))
- (setq p (cdr p)))
- (null p))
- (or (and (math-integ-parts-easy expr)
- (math-integ-try-parts expr t))
- (math-integrate-by-good-substitution
- expr (list 'calcFunc-tanh (math-div math-integ-var 2)))))
-
- ;; If function has square roots, try sin, tan, or sec substitution.
- (and (let ((p rat-in))
- (setq t1 nil)
- (while (and p
- (or (equal (car p) math-integ-var)
- (and (eq (car (car p)) 'calcFunc-sqrt)
- (setq t1 (math-is-polynomial
- (nth 1 (setq t2 (car p)))
- math-integ-var 2)))))
- (setq p (cdr p)))
- (and (null p) t1))
- (if (cdr (cdr t1))
- (if (math-guess-if-neg (nth 2 t1))
- (let* ((c (math-sqrt (math-neg (nth 2 t1))))
- (d (math-div (nth 1 t1) (math-mul -2 c)))
- (a (math-sqrt (math-add (car t1) (math-sqr d)))))
- (math-integrate-by-good-substitution
- expr (list 'calcFunc-arcsin
- (math-div-thru
- (math-add (math-mul c math-integ-var) d)
- a))))
- (let* ((c (math-sqrt (nth 2 t1)))
- (d (math-div (nth 1 t1) (math-mul 2 c)))
- (aa (math-sub (car t1) (math-sqr d))))
- (if (and nil (not (and (eq d 0) (eq c 1))))
- (math-integrate-by-good-substitution
- expr (math-add (math-mul c math-integ-var) d))
- (if (math-guess-if-neg aa)
- (math-integrate-by-good-substitution
- expr (list 'calcFunc-arccosh
- (math-div-thru
- (math-add (math-mul c math-integ-var)
- d)
- (math-sqrt (math-neg aa)))))
- (math-integrate-by-good-substitution
- expr (list 'calcFunc-arcsinh
- (math-div-thru
- (math-add (math-mul c math-integ-var)
- d)
- (math-sqrt aa))))))))
- (math-integrate-by-good-substitution expr t2)) )
-
- ;; Try integration by parts.
- (math-integ-try-parts expr)
-
- ;; Give up.
- nil)))
-
-(defun math-integ-parts-easy (expr)
- (cond ((Math-primp expr) t)
- ((memq (car expr) '(+ - *))
- (and (math-integ-parts-easy (nth 1 expr))
- (math-integ-parts-easy (nth 2 expr))))
- ((eq (car expr) '/)
- (and (math-integ-parts-easy (nth 1 expr))
- (math-atomic-factorp (nth 2 expr))))
- ((eq (car expr) '^)
- (and (natnump (nth 2 expr))
- (math-integ-parts-easy (nth 1 expr))))
- ((eq (car expr) 'neg)
- (math-integ-parts-easy (nth 1 expr)))
- (t t)))
-
-(defun math-integ-try-parts (expr &optional math-good-parts)
- ;; Integration by parts:
- ;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x)
- ;; where h(x) = integ(g(x),x).
- (or (let ((exp (calcFunc-expand expr)))
- (and (not (equal exp expr))
- (math-integral exp)))
- (and (eq (car expr) '*)
- (let ((first-bad (or (math-polynomial-p (nth 1 expr)
- math-integ-var)
- (equal (nth 2 expr) math-prev-parts-v))))
- (or (and first-bad ; so try this one first
- (math-integrate-by-parts (nth 1 expr) (nth 2 expr)))
- (math-integrate-by-parts (nth 2 expr) (nth 1 expr))
- (and (not first-bad)
- (math-integrate-by-parts (nth 1 expr) (nth 2 expr))))))
- (and (eq (car expr) '/)
- (math-expr-contains (nth 1 expr) math-integ-var)
- (let ((recip (math-div 1 (nth 2 expr))))
- (or (math-integrate-by-parts (nth 1 expr) recip)
- (math-integrate-by-parts recip (nth 1 expr)))))
- (and (eq (car expr) '^)
- (math-integrate-by-parts (math-pow (nth 1 expr)
- (math-sub (nth 2 expr) 1))
- (nth 1 expr)))))
-
-(defun math-integrate-by-parts (u vprime)
- (let ((math-integ-level (if (or math-good-parts
- (math-polynomial-p u math-integ-var))
- math-integ-level
- (1- math-integ-level)))
- (math-doing-parts t)
- v temp)
- (and (>= math-integ-level 0)
- (unwind-protect
- (progn
- (setcar (cdr cur-record) 'parts)
- (math-tracing-integral "Integrating by parts, u = "
- (math-format-value u 1000)
- ", v' = "
- (math-format-value vprime 1000)
- "\n")
- (and (setq v (math-integral vprime))
- (setq temp (calcFunc-deriv u math-integ-var nil t))
- (setq temp (let ((math-prev-parts-v v))
- (math-integral (math-mul v temp) 'yes)))
- (setq temp (math-sub (math-mul u v) temp))
- (if (eq (nth 1 cur-record) 'parts)
- (calcFunc-expand temp)
- (setq v (list 'var 'PARTS cur-record)
- var-thing (list 'vec (math-sub v temp) v)
- temp (let (calc-next-why)
- (math-solve-for (math-sub v temp) 0 v nil)))
- (and temp (not (integerp temp))
- (math-simplify-extended temp)))))
- (setcar (cdr cur-record) 'busy)))))
-
-;;; This tries two different formulations, hoping the algebraic simplifier
-;;; will be strong enough to handle at least one.
-(defun math-integrate-by-substitution (expr u &optional user uinv uinvprime)
- (and (> math-integ-level 0)
- (let ((math-integ-level (max (- math-integ-level 2) 0)))
- (math-integrate-by-good-substitution expr u user uinv uinvprime))))
-
-(defun math-integrate-by-good-substitution (expr u &optional user
- uinv uinvprime)
- (let ((math-living-dangerously t)
- deriv temp)
- (and (setq uinv (if uinv
- (math-expr-subst uinv math-integ-var
- math-integ-var-2)
- (let (calc-next-why)
- (math-solve-for u
- math-integ-var-2
- math-integ-var nil))))
- (progn
- (math-tracing-integral "Integrating by substitution, u = "
- (math-format-value u 1000)
- "\n")
- (or (and (setq deriv (calcFunc-deriv u
- math-integ-var nil
- (not user)))
- (setq temp (math-integral (math-expr-subst
- (math-expr-subst
- (math-expr-subst
- (math-div expr deriv)
- u
- math-integ-var-2)
- math-integ-var
- uinv)
- math-integ-var-2
- math-integ-var)
- 'yes)))
- (and (setq deriv (or uinvprime
- (calcFunc-deriv uinv
- math-integ-var-2
- math-integ-var
- (not user))))
- (setq temp (math-integral (math-mul
- (math-expr-subst
- (math-expr-subst
- (math-expr-subst
- expr
- u
- math-integ-var-2)
- math-integ-var
- uinv)
- math-integ-var-2
- math-integ-var)
- deriv)
- 'yes)))))
- (math-simplify-extended
- (math-expr-subst temp math-integ-var u)))))
-
-;;; Look for substitutions of the form u = a x + b.
-(defun math-integ-try-linear-substitutions (sub-expr)
- (and (not (Math-primp sub-expr))
- (or (and (not (memq (car sub-expr) '(+ - * / neg)))
- (not (and (eq (car sub-expr) '^)
- (integerp (nth 2 sub-expr))))
- (math-expr-contains sub-expr math-integ-var)
- (let ((res nil))
- (while (and (setq sub-expr (cdr sub-expr))
- (or (not (math-linear-in (car sub-expr)
- math-integ-var))
- (assoc (car sub-expr) so-far)
- (progn
- (setq so-far (cons (list (car sub-expr))
- so-far))
- (not (setq res
- (math-integrate-by-substitution
- expr (car sub-expr))))))))
- res))
- (let ((res nil))
- (while (and (setq sub-expr (cdr sub-expr))
- (not (setq res (math-integ-try-linear-substitutions
- (car sub-expr))))))
- res))))
-
-;;; Recursively try different substitutions based on various sub-expressions.
-(defun math-integ-try-substitutions (sub-expr &optional allow-rat)
- (and (not (Math-primp sub-expr))
- (not (assoc sub-expr so-far))
- (math-expr-contains sub-expr math-integ-var)
- (or (and (if (and (not (memq (car sub-expr) '(+ - * / neg)))
- (not (and (eq (car sub-expr) '^)
- (integerp (nth 2 sub-expr)))))
- (setq allow-rat t)
- (prog1 allow-rat (setq allow-rat nil)))
- (not (eq sub-expr expr))
- (or (math-integrate-by-substitution expr sub-expr)
- (and (eq (car sub-expr) '^)
- (integerp (nth 2 sub-expr))
- (< (nth 2 sub-expr) 0)
- (math-integ-try-substitutions
- (math-pow (nth 1 sub-expr) (- (nth 2 sub-expr)))
- t))))
- (let ((res nil))
- (setq so-far (cons (list sub-expr) so-far))
- (while (and (setq sub-expr (cdr sub-expr))
- (not (setq res (math-integ-try-substitutions
- (car sub-expr) allow-rat)))))
- res))))
-
-(defun math-expr-rational-in (expr)
- (let ((parts nil))
- (math-expr-rational-in-rec expr)
- (mapcar 'car parts)))
-
-(defun math-expr-rational-in-rec (expr)
- (cond ((Math-primp expr)
- (and (equal expr math-integ-var)
- (not (assoc expr parts))
- (setq parts (cons (list expr) parts))))
- ((or (memq (car expr) '(+ - * / neg))
- (and (eq (car expr) '^) (integerp (nth 2 expr))))
- (math-expr-rational-in-rec (nth 1 expr))
- (and (nth 2 expr) (math-expr-rational-in-rec (nth 2 expr))))
- ((and (eq (car expr) '^)
- (eq (math-quarter-integer (nth 2 expr)) 2))
- (math-expr-rational-in-rec (list 'calcFunc-sqrt (nth 1 expr))))
- (t
- (and (not (assoc expr parts))
- (math-expr-contains expr math-integ-var)
- (setq parts (cons (list expr) parts))))))
-
-(defun math-expr-calls (expr funcs &optional arg-contains)
- (if (consp expr)
- (if (or (memq (car expr) funcs)
- (and (eq (car expr) '^) (eq (car funcs) 'calcFunc-sqrt)
- (eq (math-quarter-integer (nth 2 expr)) 2)))
- (and (or (not arg-contains)
- (math-expr-contains expr arg-contains))
- expr)
- (and (not (Math-primp expr))
- (let ((res nil))
- (while (and (setq expr (cdr expr))
- (not (setq res (math-expr-calls
- (car expr) funcs arg-contains)))))
- res)))))
-
-(defun math-fix-const-terms (expr except-vars)
- (cond ((not (math-expr-depends expr except-vars)) 0)
- ((Math-primp expr) expr)
- ((eq (car expr) '+)
- (math-add (math-fix-const-terms (nth 1 expr) except-vars)
- (math-fix-const-terms (nth 2 expr) except-vars)))
- ((eq (car expr) '-)
- (math-sub (math-fix-const-terms (nth 1 expr) except-vars)
- (math-fix-const-terms (nth 2 expr) except-vars)))
- (t expr)))
-
-;; Command for debugging the Calculator's symbolic integrator.
-(defun calc-dump-integral-cache (&optional arg)
- (interactive "P")
- (let ((buf (current-buffer)))
- (unwind-protect
- (let ((p math-integral-cache)
- cur-record)
- (display-buffer (get-buffer-create "*Integral Cache*"))
- (set-buffer (get-buffer "*Integral Cache*"))
- (erase-buffer)
- (while p
- (setq cur-record (car p))
- (or arg (math-replace-integral-parts cur-record))
- (insert (math-format-flat-expr (car cur-record) 0)
- " --> "
- (if (symbolp (nth 1 cur-record))
- (concat "(" (symbol-name (nth 1 cur-record)) ")")
- (math-format-flat-expr (nth 1 cur-record) 0))
- "\n")
- (setq p (cdr p)))
- (goto-char (point-min)))
- (set-buffer buf))))
-
-(defun math-try-integral (expr)
- (let ((math-integ-level math-integral-limit)
- (math-integ-depth 0)
- (math-integ-msg "Working...done")
- (cur-record nil) ; a technicality
- (math-integrating t)
- (calc-prefer-frac t)
- (calc-symbolic-mode t)
- (has-rules (calc-has-rules 'var-IntegRules)))
- (or (math-integral expr 'yes)
- (and math-any-substs
- (setq math-enable-subst t)
- (math-integral expr 'yes))
- (and (> math-max-integral-limit math-integral-limit)
- (setq math-integral-limit math-max-integral-limit
- math-integ-level math-integral-limit)
- (math-integral expr 'yes)))))
-
-(defun calcFunc-integ (expr var &optional low high)
- (cond
- ;; Do these even if the parts turn out not to be integrable.
- ((eq (car-safe expr) '+)
- (math-add (calcFunc-integ (nth 1 expr) var low high)
- (calcFunc-integ (nth 2 expr) var low high)))
- ((eq (car-safe expr) '-)
- (math-sub (calcFunc-integ (nth 1 expr) var low high)
- (calcFunc-integ (nth 2 expr) var low high)))
- ((eq (car-safe expr) 'neg)
- (math-neg (calcFunc-integ (nth 1 expr) var low high)))
- ((and (eq (car-safe expr) '*)
- (not (math-expr-contains (nth 1 expr) var)))
- (math-mul (nth 1 expr) (calcFunc-integ (nth 2 expr) var low high)))
- ((and (eq (car-safe expr) '*)
- (not (math-expr-contains (nth 2 expr) var)))
- (math-mul (calcFunc-integ (nth 1 expr) var low high) (nth 2 expr)))
- ((and (eq (car-safe expr) '/)
- (not (math-expr-contains (nth 1 expr) var))
- (not (math-equal-int (nth 1 expr) 1)))
- (math-mul (nth 1 expr)
- (calcFunc-integ (math-div 1 (nth 2 expr)) var low high)))
- ((and (eq (car-safe expr) '/)
- (not (math-expr-contains (nth 2 expr) var)))
- (math-div (calcFunc-integ (nth 1 expr) var low high) (nth 2 expr)))
- ((and (eq (car-safe expr) '/)
- (eq (car-safe (nth 1 expr)) '*)
- (not (math-expr-contains (nth 1 (nth 1 expr)) var)))
- (math-mul (nth 1 (nth 1 expr))
- (calcFunc-integ (math-div (nth 2 (nth 1 expr)) (nth 2 expr))
- var low high)))
- ((and (eq (car-safe expr) '/)
- (eq (car-safe (nth 1 expr)) '*)
- (not (math-expr-contains (nth 2 (nth 1 expr)) var)))
- (math-mul (nth 2 (nth 1 expr))
- (calcFunc-integ (math-div (nth 1 (nth 1 expr)) (nth 2 expr))
- var low high)))
- ((and (eq (car-safe expr) '/)
- (eq (car-safe (nth 2 expr)) '*)
- (not (math-expr-contains (nth 1 (nth 2 expr)) var)))
- (math-div (calcFunc-integ (math-div (nth 1 expr) (nth 2 (nth 2 expr)))
- var low high)
- (nth 1 (nth 2 expr))))
- ((and (eq (car-safe expr) '/)
- (eq (car-safe (nth 2 expr)) '*)
- (not (math-expr-contains (nth 2 (nth 2 expr)) var)))
- (math-div (calcFunc-integ (math-div (nth 1 expr) (nth 1 (nth 2 expr)))
- var low high)
- (nth 2 (nth 2 expr))))
- ((eq (car-safe expr) 'vec)
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high)))
- (cdr expr))))
- (t
- (let ((state (list calc-angle-mode
- ;;calc-symbolic-mode
- ;;calc-prefer-frac
- calc-internal-prec
- (calc-var-value 'var-IntegRules)
- (calc-var-value 'var-IntegSimpRules))))
- (or (equal state math-integral-cache-state)
- (setq math-integral-cache-state state
- math-integral-cache nil)))
- (let* ((math-max-integral-limit (or (and (boundp 'var-IntegLimit)
- (natnump var-IntegLimit)
- var-IntegLimit)
- 3))
- (math-integral-limit 1)
- (sexpr (math-expr-subst expr var math-integ-var))
- (trace-buffer (get-buffer "*Trace*"))
- (calc-language (if (eq calc-language 'big) nil calc-language))
- (math-any-substs t)
- (math-enable-subst nil)
- (math-prev-parts-v nil)
- (math-doing-parts nil)
- (math-good-parts nil)
- (res
- (if trace-buffer
- (let ((calcbuf (current-buffer))
- (calcwin (selected-window)))
- (unwind-protect
- (progn
- (if (get-buffer-window trace-buffer)
- (select-window (get-buffer-window trace-buffer)))
- (set-buffer trace-buffer)
- (goto-char (point-max))
- (or (assq 'scroll-stop (buffer-local-variables))
- (progn
- (make-local-variable 'scroll-step)
- (setq scroll-step 3)))
- (insert "\n\n\n")
- (set-buffer calcbuf)
- (math-try-integral sexpr))
- (select-window calcwin)
- (set-buffer calcbuf)))
- (math-try-integral sexpr))))
- (if res
- (progn
- (if (calc-has-rules 'var-IntegAfterRules)
- (setq res (math-rewrite res '(var IntegAfterRules
- var-IntegAfterRules))))
- (math-simplify
- (if (and low high)
- (math-sub (math-expr-subst res math-integ-var high)
- (math-expr-subst res math-integ-var low))
- (setq res (math-fix-const-terms res math-integ-vars))
- (if low
- (math-expr-subst res math-integ-var low)
- (math-expr-subst res math-integ-var var)))))
- (append (list 'calcFunc-integ expr var)
- (and low (list low))
- (and high (list high))))))))
-
-
-(math-defintegral calcFunc-inv
- (math-integral (math-div 1 u)))
-
-(math-defintegral calcFunc-conj
- (let ((int (math-integral u)))
- (and int
- (list 'calcFunc-conj int))))
-
-(math-defintegral calcFunc-deg
- (let ((int (math-integral u)))
- (and int
- (list 'calcFunc-deg int))))
-
-(math-defintegral calcFunc-rad
- (let ((int (math-integral u)))
- (and int
- (list 'calcFunc-rad int))))
-
-(math-defintegral calcFunc-re
- (let ((int (math-integral u)))
- (and int
- (list 'calcFunc-re int))))
-
-(math-defintegral calcFunc-im
- (let ((int (math-integral u)))
- (and int
- (list 'calcFunc-im int))))
-
-(math-defintegral calcFunc-sqrt
- (and (equal u math-integ-var)
- (math-mul '(frac 2 3)
- (list 'calcFunc-sqrt (math-pow u 3)))))
-
-(math-defintegral calcFunc-exp
- (or (and (equal u math-integ-var)
- (list 'calcFunc-exp u))
- (let ((p (math-is-polynomial u math-integ-var 2)))
- (and (nth 2 p)
- (let ((sqa (math-sqrt (math-neg (nth 2 p)))))
- (math-div
- (math-mul
- (math-mul (math-div (list 'calcFunc-sqrt '(var pi var-pi))
- sqa)
- (math-normalize
- (list 'calcFunc-exp
- (math-div (math-sub (math-mul (car p)
- (nth 2 p))
- (math-div
- (math-sqr (nth 1 p))
- 4))
- (nth 2 p)))))
- (list 'calcFunc-erf
- (math-sub (math-mul sqa math-integ-var)
- (math-div (nth 1 p) (math-mul 2 sqa)))))
- 2))))))
-
-(math-defintegral calcFunc-ln
- (or (and (equal u math-integ-var)
- (math-sub (math-mul u (list 'calcFunc-ln u)) u))
- (and (eq (car u) '*)
- (math-integral (math-add (list 'calcFunc-ln (nth 1 u))
- (list 'calcFunc-ln (nth 2 u)))))
- (and (eq (car u) '/)
- (math-integral (math-sub (list 'calcFunc-ln (nth 1 u))
- (list 'calcFunc-ln (nth 2 u)))))
- (and (eq (car u) '^)
- (math-integral (math-mul (nth 2 u)
- (list 'calcFunc-ln (nth 1 u)))))))
-
-(math-defintegral calcFunc-log10
- (and (equal u math-integ-var)
- (math-sub (math-mul u (list 'calcFunc-ln u))
- (math-div u (list 'calcFunc-ln 10)))))
-
-(math-defintegral-2 calcFunc-log
- (math-integral (math-div (list 'calcFunc-ln u)
- (list 'calcFunc-ln v))))
-
-(math-defintegral calcFunc-sin
- (or (and (equal u math-integ-var)
- (math-neg (math-from-radians-2 (list 'calcFunc-cos u))))
- (and (nth 2 (math-is-polynomial u math-integ-var 2))
- (math-integral (math-to-exponentials (list 'calcFunc-sin u))))))
-
-(math-defintegral calcFunc-cos
- (or (and (equal u math-integ-var)
- (math-from-radians-2 (list 'calcFunc-sin u)))
- (and (nth 2 (math-is-polynomial u math-integ-var 2))
- (math-integral (math-to-exponentials (list 'calcFunc-cos u))))))
-
-(math-defintegral calcFunc-tan
- (and (equal u math-integ-var)
- (math-neg (math-from-radians-2
- (list 'calcFunc-ln (list 'calcFunc-cos u))))))
-
-(math-defintegral calcFunc-arcsin
- (and (equal u math-integ-var)
- (math-add (math-mul u (list 'calcFunc-arcsin u))
- (math-from-radians-2
- (list 'calcFunc-sqrt (math-sub 1 (math-sqr u)))))))
-
-(math-defintegral calcFunc-arccos
- (and (equal u math-integ-var)
- (math-sub (math-mul u (list 'calcFunc-arccos u))
- (math-from-radians-2
- (list 'calcFunc-sqrt (math-sub 1 (math-sqr u)))))))
-
-(math-defintegral calcFunc-arctan
- (and (equal u math-integ-var)
- (math-sub (math-mul u (list 'calcFunc-arctan u))
- (math-from-radians-2
- (math-div (list 'calcFunc-ln (math-add 1 (math-sqr u)))
- 2)))))
-
-(math-defintegral calcFunc-sinh
- (and (equal u math-integ-var)
- (list 'calcFunc-cosh u)))
-
-(math-defintegral calcFunc-cosh
- (and (equal u math-integ-var)
- (list 'calcFunc-sinh u)))
-
-(math-defintegral calcFunc-tanh
- (and (equal u math-integ-var)
- (list 'calcFunc-ln (list 'calcFunc-cosh u))))
-
-(math-defintegral calcFunc-arcsinh
- (and (equal u math-integ-var)
- (math-sub (math-mul u (list 'calcFunc-arcsinh u))
- (list 'calcFunc-sqrt (math-add (math-sqr u) 1)))))
-
-(math-defintegral calcFunc-arccosh
- (and (equal u math-integ-var)
- (math-sub (math-mul u (list 'calcFunc-arccosh u))
- (list 'calcFunc-sqrt (math-sub 1 (math-sqr u))))))
-
-(math-defintegral calcFunc-arctanh
- (and (equal u math-integ-var)
- (math-sub (math-mul u (list 'calcFunc-arctan u))
- (math-div (list 'calcFunc-ln
- (math-add 1 (math-sqr u)))
- 2))))
-
-;;; (Ax + B) / (ax^2 + bx + c)^n forms.
-(math-defintegral-2 /
- (math-integral-rational-funcs u v))
-
-(defun math-integral-rational-funcs (u v)
- (let ((pu (math-is-polynomial u math-integ-var 1))
- (vpow 1) pv)
- (and pu
- (catch 'int-rat
- (if (and (eq (car-safe v) '^) (natnump (nth 2 v)))
- (setq vpow (nth 2 v)
- v (nth 1 v)))
- (and (setq pv (math-is-polynomial v math-integ-var 2))
- (let ((int (math-mul-thru
- (car pu)
- (math-integral-q02 (car pv) (nth 1 pv)
- (nth 2 pv) v vpow))))
- (if (cdr pu)
- (setq int (math-add int
- (math-mul-thru
- (nth 1 pu)
- (math-integral-q12
- (car pv) (nth 1 pv)
- (nth 2 pv) v vpow)))))
- int))))))
-
-(defun math-integral-q12 (a b c v vpow)
- (let (q)
- (cond ((not c)
- (cond ((= vpow 1)
- (math-sub (math-div math-integ-var b)
- (math-mul (math-div a (math-sqr b))
- (list 'calcFunc-ln v))))
- ((= vpow 2)
- (math-div (math-add (list 'calcFunc-ln v)
- (math-div a v))
- (math-sqr b)))
- (t
- (let ((nm1 (math-sub vpow 1))
- (nm2 (math-sub vpow 2)))
- (math-div (math-sub
- (math-div a (math-mul nm1 (math-pow v nm1)))
- (math-div 1 (math-mul nm2 (math-pow v nm2))))
- (math-sqr b))))))
- ((math-zerop
- (setq q (math-sub (math-mul 4 (math-mul a c)) (math-sqr b))))
- (let ((part (math-div b (math-mul 2 c))))
- (math-mul-thru (math-pow c vpow)
- (math-integral-q12 part 1 nil
- (math-add math-integ-var part)
- (* vpow 2)))))
- ((= vpow 1)
- (and (math-ratp q) (math-negp q)
- (let ((calc-symbolic-mode t))
- (math-ratp (math-sqrt (math-neg q))))
- (throw 'int-rat nil)) ; should have used calcFunc-apart first
- (math-sub (math-div (list 'calcFunc-ln v) (math-mul 2 c))
- (math-mul-thru (math-div b (math-mul 2 c))
- (math-integral-q02 a b c v 1))))
- (t
- (let ((n (1- vpow)))
- (math-sub (math-neg (math-div
- (math-add (math-mul b math-integ-var)
- (math-mul 2 a))
- (math-mul n (math-mul q (math-pow v n)))))
- (math-mul-thru (math-div (math-mul b (1- (* 2 n)))
- (math-mul n q))
- (math-integral-q02 a b c v n))))))))
-
-(defun math-integral-q02 (a b c v vpow)
- (let (q rq part)
- (cond ((not c)
- (cond ((= vpow 1)
- (math-div (list 'calcFunc-ln v) b))
- (t
- (math-div (math-pow v (- 1 vpow))
- (math-mul (- 1 vpow) b)))))
- ((math-zerop
- (setq q (math-sub (math-mul 4 (math-mul a c)) (math-sqr b))))
- (let ((part (math-div b (math-mul 2 c))))
- (math-mul-thru (math-pow c vpow)
- (math-integral-q02 part 1 nil
- (math-add math-integ-var part)
- (* vpow 2)))))
- ((progn
- (setq part (math-add (math-mul 2 (math-mul c math-integ-var)) b))
- (> vpow 1))
- (let ((n (1- vpow)))
- (math-add (math-div part (math-mul n (math-mul q (math-pow v n))))
- (math-mul-thru (math-div (math-mul (- (* 4 n) 2) c)
- (math-mul n q))
- (math-integral-q02 a b c v n)))))
- ((math-guess-if-neg q)
- (setq rq (list 'calcFunc-sqrt (math-neg q)))
- ;;(math-div-thru (list 'calcFunc-ln
- ;; (math-div (math-sub part rq)
- ;; (math-add part rq)))
- ;; rq)
- (math-div (math-mul -2 (list 'calcFunc-arctanh
- (math-div part rq)))
- rq))
- (t
- (setq rq (list 'calcFunc-sqrt q))
- (math-div (math-mul 2 (math-to-radians-2
- (list 'calcFunc-arctan
- (math-div part rq))))
- rq)))))
-
-
-(math-defintegral calcFunc-erf
- (and (equal u math-integ-var)
- (math-add (math-mul u (list 'calcFunc-erf u))
- (math-div 1 (math-mul (list 'calcFunc-exp (math-sqr u))
- (list 'calcFunc-sqrt
- '(var pi var-pi)))))))
-
-(math-defintegral calcFunc-erfc
- (and (equal u math-integ-var)
- (math-sub (math-mul u (list 'calcFunc-erfc u))
- (math-div 1 (math-mul (list 'calcFunc-exp (math-sqr u))
- (list 'calcFunc-sqrt
- '(var pi var-pi)))))))
-
-
-
-
-(defvar math-tabulate-initial nil)
-(defvar math-tabulate-function nil)
-(defun calcFunc-table (expr var &optional low high step)
- (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
- (or high (setq high low low 1))
- (and (or (math-infinitep low) (math-infinitep high))
- (not step)
- (math-scan-for-limits expr))
- (and step (math-zerop step) (math-reject-arg step 'nonzerop))
- (let ((known (+ (if (Math-objectp low) 1 0)
- (if (Math-objectp high) 1 0)
- (if (or (null step) (Math-objectp step)) 1 0)))
- (count '(var inf var-inf))
- vec)
- (or (= known 2) ; handy optimization
- (equal high '(var inf var-inf))
- (progn
- (setq count (math-div (math-sub high low) (or step 1)))
- (or (Math-objectp count)
- (setq count (math-simplify count)))
- (if (Math-messy-integerp count)
- (setq count (math-trunc count)))))
- (if (Math-negp count)
- (setq count -1))
- (if (integerp count)
- (let ((var-DUMMY nil)
- (vec math-tabulate-initial)
- (math-working-step-2 (1+ count))
- (math-working-step 0))
- (setq expr (math-evaluate-expr
- (math-expr-subst expr var '(var DUMMY var-DUMMY))))
- (while (>= count 0)
- (setq math-working-step (1+ math-working-step)
- var-DUMMY low
- vec (cond ((eq math-tabulate-function 'calcFunc-sum)
- (math-add vec (math-evaluate-expr expr)))
- ((eq math-tabulate-function 'calcFunc-prod)
- (math-mul vec (math-evaluate-expr expr)))
- (t
- (cons (math-evaluate-expr expr) vec)))
- low (math-add low (or step 1))
- count (1- count)))
- (if math-tabulate-function
- vec
- (cons 'vec (nreverse vec))))
- (if (Math-integerp count)
- (calc-record-why 'fixnump high)
- (if (Math-num-integerp low)
- (if (Math-num-integerp high)
- (calc-record-why 'integerp step)
- (calc-record-why 'integerp high))
- (calc-record-why 'integerp low)))
- (append (list (or math-tabulate-function 'calcFunc-table)
- expr var)
- (and (not (and (equal low '(neg (var inf var-inf)))
- (equal high '(var inf var-inf))))
- (list low high))
- (and step (list step))))))
-
-(defun math-scan-for-limits (x)
- (cond ((Math-primp x))
- ((and (eq (car x) 'calcFunc-subscr)
- (Math-vectorp (nth 1 x))
- (math-expr-contains (nth 2 x) var))
- (let* ((calc-next-why nil)
- (low-val (math-solve-for (nth 2 x) 1 var nil))
- (high-val (math-solve-for (nth 2 x) (1- (length (nth 1 x)))
- var nil))
- temp)
- (and low-val (math-realp low-val)
- high-val (math-realp high-val))
- (and (Math-lessp high-val low-val)
- (setq temp low-val low-val high-val high-val temp))
- (setq low (math-max low (math-ceiling low-val))
- high (math-min high (math-floor high-val)))))
- (t
- (while (setq x (cdr x))
- (math-scan-for-limits (car x))))))
-
-
-(defvar math-disable-sums nil)
-(defun calcFunc-sum (expr var &optional low high step)
- (if math-disable-sums (math-reject-arg))
- (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))
- (math-sum-rec expr var low high step)))
- (math-disable-sums t))
- (math-normalize res)))
-
-(defun math-sum-rec (expr var &optional low high step)
- (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
- (and low (not high) (setq high low low 1))
- (let (t1 t2 val)
- (setq val
- (cond
- ((not (math-expr-contains expr var))
- (math-mul expr (math-add (math-div (math-sub high low) (or step 1))
- 1)))
- ((and step (not (math-equal-int step 1)))
- (if (math-negp step)
- (math-sum-rec expr var high low (math-neg step))
- (let ((lo (math-simplify (math-div low step))))
- (if (math-known-num-integerp lo)
- (math-sum-rec (math-normalize
- (math-expr-subst expr var
- (math-mul step var)))
- var lo (math-simplify (math-div high step)))
- (math-sum-rec (math-normalize
- (math-expr-subst expr var
- (math-add (math-mul step var)
- low)))
- var 0
- (math-simplify (math-div (math-sub high low)
- step)))))))
- ((memq (setq t1 (math-compare low high)) '(0 1))
- (if (eq t1 0)
- (math-expr-subst expr var low)
- 0))
- ((setq t1 (math-is-polynomial expr var 20))
- (let ((poly nil)
- (n 0))
- (while t1
- (setq poly (math-poly-mix poly 1
- (math-sum-integer-power n) (car t1))
- n (1+ n)
- t1 (cdr t1)))
- (setq n (math-build-polynomial-expr poly high))
- (if (memq low '(0 1))
- n
- (math-sub n (math-build-polynomial-expr poly
- (math-sub low 1))))))
- ((and (memq (car expr) '(+ -))
- (setq t1 (math-sum-rec (nth 1 expr) var low high)
- t2 (math-sum-rec (nth 2 expr) var low high))
- (not (and (math-expr-calls t1 '(calcFunc-sum))
- (math-expr-calls t2 '(calcFunc-sum)))))
- (list (car expr) t1 t2))
- ((and (eq (car expr) '*)
- (setq t1 (math-sum-const-factors expr var)))
- (math-mul (car t1) (math-sum-rec (cdr t1) var low high)))
- ((and (eq (car expr) '*) (memq (car-safe (nth 1 expr)) '(+ -)))
- (math-sum-rec (math-add-or-sub (math-mul (nth 1 (nth 1 expr))
- (nth 2 expr))
- (math-mul (nth 2 (nth 1 expr))
- (nth 2 expr))
- nil (eq (car (nth 1 expr)) '-))
- var low high))
- ((and (eq (car expr) '*) (memq (car-safe (nth 2 expr)) '(+ -)))
- (math-sum-rec (math-add-or-sub (math-mul (nth 1 expr)
- (nth 1 (nth 2 expr)))
- (math-mul (nth 1 expr)
- (nth 2 (nth 2 expr)))
- nil (eq (car (nth 2 expr)) '-))
- var low high))
- ((and (eq (car expr) '/)
- (not (math-primp (nth 1 expr)))
- (setq t1 (math-sum-const-factors (nth 1 expr) var)))
- (math-mul (car t1)
- (math-sum-rec (math-div (cdr t1) (nth 2 expr))
- var low high)))
- ((and (eq (car expr) '/)
- (setq t1 (math-sum-const-factors (nth 2 expr) var)))
- (math-div (math-sum-rec (math-div (nth 1 expr) (cdr t1))
- var low high)
- (car t1)))
- ((eq (car expr) 'neg)
- (math-neg (math-sum-rec (nth 1 expr) var low high)))
- ((and (eq (car expr) '^)
- (not (math-expr-contains (nth 1 expr) var))
- (setq t1 (math-is-polynomial (nth 2 expr) var 1)))
- (let ((x (math-pow (nth 1 expr) (nth 1 t1))))
- (math-div (math-mul (math-sub (math-pow x (math-add 1 high))
- (math-pow x low))
- (math-pow (nth 1 expr) (car t1)))
- (math-sub x 1))))
- ((and (setq t1 (math-to-exponentials expr))
- (setq t1 (math-sum-rec t1 var low high))
- (not (math-expr-calls t1 '(calcFunc-sum))))
- (math-to-exps t1))
- ((memq (car expr) '(calcFunc-ln calcFunc-log10))
- (list (car expr) (calcFunc-prod (nth 1 expr) var low high)))
- ((and (eq (car expr) 'calcFunc-log)
- (= (length expr) 3)
- (not (math-expr-contains (nth 2 expr) var)))
- (list 'calcFunc-log
- (calcFunc-prod (nth 1 expr) var low high)
- (nth 2 expr)))))
- (if (equal val '(var nan var-nan)) (setq val nil))
- (or val
- (let* ((math-tabulate-initial 0)
- (math-tabulate-function 'calcFunc-sum))
- (calcFunc-table expr var low high)))))
-
-(defun calcFunc-asum (expr var low &optional high step no-mul-flag)
- (or high (setq high low low 1))
- (if (and step (not (math-equal-int step 1)))
- (if (math-negp step)
- (math-mul (math-pow -1 low)
- (calcFunc-asum expr var high low (math-neg step) t))
- (let ((lo (math-simplify (math-div low step))))
- (if (math-num-integerp lo)
- (calcFunc-asum (math-normalize
- (math-expr-subst expr var
- (math-mul step var)))
- var lo (math-simplify (math-div high step)))
- (calcFunc-asum (math-normalize
- (math-expr-subst expr var
- (math-add (math-mul step var)
- low)))
- var 0
- (math-simplify (math-div (math-sub high low)
- step))))))
- (math-mul (if no-mul-flag 1 (math-pow -1 low))
- (calcFunc-sum (math-mul (math-pow -1 var) expr) var low high))))
-
-(defun math-sum-const-factors (expr var)
- (let ((const nil)
- (not-const nil)
- (p expr))
- (while (eq (car-safe p) '*)
- (if (math-expr-contains (nth 1 p) var)
- (setq not-const (cons (nth 1 p) not-const))
- (setq const (cons (nth 1 p) const)))
- (setq p (nth 2 p)))
- (if (math-expr-contains p var)
- (setq not-const (cons p not-const))
- (setq const (cons p const)))
- (and const
- (cons (let ((temp (car const)))
- (while (setq const (cdr const))
- (setq temp (list '* (car const) temp)))
- temp)
- (let ((temp (or (car not-const) 1)))
- (while (setq not-const (cdr not-const))
- (setq temp (list '* (car not-const) temp)))
- temp)))))
-
-(defvar math-sum-int-pow-cache (list '(0 1)))
-;; Following is from CRC Math Tables, 27th ed, pp. 52-53.
-(defun math-sum-integer-power (pow)
- (let ((calc-prefer-frac t)
- (n (length math-sum-int-pow-cache)))
- (while (<= n pow)
- (let* ((new (list 0 0))
- (lin new)
- (pp (cdr (nth (1- n) math-sum-int-pow-cache)))
- (p 2)
- (sum 0)
- q)
- (while pp
- (setq q (math-div (car pp) p)
- new (cons (math-mul q n) new)
- sum (math-add sum q)
- p (1+ p)
- pp (cdr pp)))
- (setcar lin (math-sub 1 (math-mul n sum)))
- (setq math-sum-int-pow-cache
- (nconc math-sum-int-pow-cache (list (nreverse new)))
- n (1+ n))))
- (nth pow math-sum-int-pow-cache)))
-
-(defun math-to-exponentials (expr)
- (and (consp expr)
- (= (length expr) 2)
- (let ((x (nth 1 expr))
- (pi (if calc-symbolic-mode '(var pi var-pi) (math-pi)))
- (i (if calc-symbolic-mode '(var i var-i) '(cplx 0 1))))
- (cond ((eq (car expr) 'calcFunc-exp)
- (list '^ '(var e var-e) x))
- ((eq (car expr) 'calcFunc-sin)
- (or (eq calc-angle-mode 'rad)
- (setq x (list '/ (list '* x pi) 180)))
- (list '/ (list '-
- (list '^ '(var e var-e) (list '* x i))
- (list '^ '(var e var-e)
- (list 'neg (list '* x i))))
- (list '* 2 i)))
- ((eq (car expr) 'calcFunc-cos)
- (or (eq calc-angle-mode 'rad)
- (setq x (list '/ (list '* x pi) 180)))
- (list '/ (list '+
- (list '^ '(var e var-e)
- (list '* x i))
- (list '^ '(var e var-e)
- (list 'neg (list '* x i))))
- 2))
- ((eq (car expr) 'calcFunc-sinh)
- (list '/ (list '-
- (list '^ '(var e var-e) x)
- (list '^ '(var e var-e) (list 'neg x)))
- 2))
- ((eq (car expr) 'calcFunc-cosh)
- (list '/ (list '+
- (list '^ '(var e var-e) x)
- (list '^ '(var e var-e) (list 'neg x)))
- 2))
- (t nil)))))
-
-(defun math-to-exps (expr)
- (cond (calc-symbolic-mode expr)
- ((Math-primp expr)
- (if (equal expr '(var e var-e)) (math-e) expr))
- ((and (eq (car expr) '^)
- (equal (nth 1 expr) '(var e var-e)))
- (list 'calcFunc-exp (nth 2 expr)))
- (t
- (cons (car expr) (mapcar 'math-to-exps (cdr expr))))))
-
-
-(defvar math-disable-prods nil)
-(defun calcFunc-prod (expr var &optional low high step)
- (if math-disable-prods (math-reject-arg))
- (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))
- (math-prod-rec expr var low high step)))
- (math-disable-prods t))
- (math-normalize res)))
-
-(defun math-prod-rec (expr var &optional low high step)
- (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
- (and low (not high) (setq high '(var inf var-inf)))
- (let (t1 t2 t3 val)
- (setq val
- (cond
- ((not (math-expr-contains expr var))
- (math-pow expr (math-add (math-div (math-sub high low) (or step 1))
- 1)))
- ((and step (not (math-equal-int step 1)))
- (if (math-negp step)
- (math-prod-rec expr var high low (math-neg step))
- (let ((lo (math-simplify (math-div low step))))
- (if (math-known-num-integerp lo)
- (math-prod-rec (math-normalize
- (math-expr-subst expr var
- (math-mul step var)))
- var lo (math-simplify (math-div high step)))
- (math-prod-rec (math-normalize
- (math-expr-subst expr var
- (math-add (math-mul step
- var)
- low)))
- var 0
- (math-simplify (math-div (math-sub high low)
- step)))))))
- ((and (memq (car expr) '(* /))
- (setq t1 (math-prod-rec (nth 1 expr) var low high)
- t2 (math-prod-rec (nth 2 expr) var low high))
- (not (and (math-expr-calls t1 '(calcFunc-prod))
- (math-expr-calls t2 '(calcFunc-prod)))))
- (list (car expr) t1 t2))
- ((and (eq (car expr) '^)
- (not (math-expr-contains (nth 2 expr) var)))
- (math-pow (math-prod-rec (nth 1 expr) var low high)
- (nth 2 expr)))
- ((and (eq (car expr) '^)
- (not (math-expr-contains (nth 1 expr) var)))
- (math-pow (nth 1 expr)
- (calcFunc-sum (nth 2 expr) var low high)))
- ((eq (car expr) 'sqrt)
- (math-normalize (list 'calcFunc-sqrt
- (list 'calcFunc-prod (nth 1 expr)
- var low high))))
- ((eq (car expr) 'neg)
- (math-mul (math-pow -1 (math-add (math-sub high low) 1))
- (math-prod-rec (nth 1 expr) var low high)))
- ((eq (car expr) 'calcFunc-exp)
- (list 'calcFunc-exp (calcFunc-sum (nth 1 expr) var low high)))
- ((and (setq t1 (math-is-polynomial expr var 1))
- (setq t2
- (cond
- ((or (and (math-equal-int (nth 1 t1) 1)
- (setq low (math-simplify
- (math-add low (car t1)))
- high (math-simplify
- (math-add high (car t1)))))
- (and (math-equal-int (nth 1 t1) -1)
- (setq t2 low
- low (math-simplify
- (math-sub (car t1) high))
- high (math-simplify
- (math-sub (car t1) t2)))))
- (if (or (math-zerop low) (math-zerop high))
- 0
- (if (and (or (math-negp low) (math-negp high))
- (or (math-num-integerp low)
- (math-num-integerp high)))
- (if (math-posp high)
- 0
- (math-mul (math-pow -1
- (math-add
- (math-add low high) 1))
- (list '/
- (list 'calcFunc-fact
- (math-neg low))
- (list 'calcFunc-fact
- (math-sub -1 high)))))
- (list '/
- (list 'calcFunc-fact high)
- (list 'calcFunc-fact (math-sub low 1))))))
- ((and (or (and (math-equal-int (nth 1 t1) 2)
- (setq t2 (math-simplify
- (math-add (math-mul low 2)
- (car t1)))
- t3 (math-simplify
- (math-add (math-mul high 2)
- (car t1)))))
- (and (math-equal-int (nth 1 t1) -2)
- (setq t2 (math-simplify
- (math-sub (car t1)
- (math-mul high 2)))
- t3 (math-simplify
- (math-sub (car t1)
- (math-mul low
- 2))))))
- (or (math-integerp t2)
- (and (math-messy-integerp t2)
- (setq t2 (math-trunc t2)))
- (math-integerp t3)
- (and (math-messy-integerp t3)
- (setq t3 (math-trunc t3)))))
- (if (or (math-zerop t2) (math-zerop t3))
- 0
- (if (or (math-evenp t2) (math-evenp t3))
- (if (or (math-negp t2) (math-negp t3))
- (if (math-posp high)
- 0
- (list '/
- (list 'calcFunc-dfact
- (math-neg t2))
- (list 'calcFunc-dfact
- (math-sub -2 t3))))
- (list '/
- (list 'calcFunc-dfact t3)
- (list 'calcFunc-dfact
- (math-sub t2 2))))
- (if (math-negp t3)
- (list '*
- (list '^ -1
- (list '/ (list '- (list '- t2 t3)
- 2)
- 2))
- (list '/
- (list 'calcFunc-dfact
- (math-neg t2))
- (list 'calcFunc-dfact
- (math-sub -2 t3))))
- (if (math-posp t2)
- (list '/
- (list 'calcFunc-dfact t3)
- (list 'calcFunc-dfact
- (math-sub t2 2)))
- nil))))))))
- t2)))
- (if (equal val '(var nan var-nan)) (setq val nil))
- (or val
- (let* ((math-tabulate-initial 1)
- (math-tabulate-function 'calcFunc-prod))
- (calcFunc-table expr var low high)))))
-
-
-
-
-(defvar math-solve-ranges nil)
-;;; Attempt to reduce lhs = rhs to solve-var = rhs', where solve-var appears
-;;; in lhs but not in rhs or rhs'; return rhs'.
-;;; Uses global values: solve-*.
-(defun math-try-solve-for (lhs rhs &optional sign no-poly)
- (let (t1 t2 t3)
- (cond ((equal lhs solve-var)
- (setq math-solve-sign sign)
- (if (eq solve-full 'all)
- (let ((vec (list 'vec (math-evaluate-expr rhs)))
- newvec var p)
- (while math-solve-ranges
- (setq p (car math-solve-ranges)
- var (car p)
- newvec (list 'vec))
- (while (setq p (cdr p))
- (setq newvec (nconc newvec
- (cdr (math-expr-subst
- vec var (car p))))))
- (setq vec newvec
- math-solve-ranges (cdr math-solve-ranges)))
- (math-normalize vec))
- rhs))
- ((Math-primp lhs)
- nil)
- ((and (eq (car lhs) '-)
- (eq (car-safe (nth 1 lhs)) (car-safe (nth 2 lhs)))
- (Math-zerop rhs)
- (= (length (nth 1 lhs)) 2)
- (= (length (nth 2 lhs)) 2)
- (setq t1 (get (car (nth 1 lhs)) 'math-inverse))
- (setq t2 (funcall t1 '(var SOLVEDUM SOLVEDUM)))
- (eq (math-expr-contains-count t2 '(var SOLVEDUM SOLVEDUM)) 1)
- (setq t3 (math-solve-above-dummy t2))
- (setq t1 (math-try-solve-for (math-sub (nth 1 (nth 1 lhs))
- (math-expr-subst
- t2 t3
- (nth 1 (nth 2 lhs))))
- 0)))
- t1)
- ((eq (car lhs) 'neg)
- (math-try-solve-for (nth 1 lhs) (math-neg rhs)
- (and sign (- sign))))
- ((and (not (eq solve-full 't)) (math-try-solve-prod)))
- ((and (not no-poly)
- (setq t2 (math-decompose-poly lhs solve-var 15 rhs)))
- (setq t1 (cdr (nth 1 t2))
- t1 (let ((math-solve-ranges math-solve-ranges))
- (cond ((= (length t1) 5)
- (apply 'math-solve-quartic (car t2) t1))
- ((= (length t1) 4)
- (apply 'math-solve-cubic (car t2) t1))
- ((= (length t1) 3)
- (apply 'math-solve-quadratic (car t2) t1))
- ((= (length t1) 2)
- (apply 'math-solve-linear (car t2) sign t1))
- (solve-full
- (math-poly-all-roots (car t2) t1))
- (calc-symbolic-mode nil)
- (t
- (math-try-solve-for
- (car t2)
- (math-poly-any-root (reverse t1) 0 t)
- nil t)))))
- (if t1
- (if (eq (nth 2 t2) 1)
- t1
- (math-solve-prod t1 (math-try-solve-for (nth 2 t2) 0 nil t)))
- (calc-record-why "*Unable to find a symbolic solution")
- nil))
- ((and (math-solve-find-root-term lhs nil)
- (eq (math-expr-contains-count lhs t1) 1)) ; just in case
- (math-try-solve-for (math-simplify
- (math-sub (if (or t3 (math-evenp t2))
- (math-pow t1 t2)
- (math-neg (math-pow t1 t2)))
- (math-expand-power
- (math-sub (math-normalize
- (math-expr-subst
- lhs t1 0))
- rhs)
- t2 solve-var)))
- 0))
- ((eq (car lhs) '+)
- (cond ((not (math-expr-contains (nth 1 lhs) solve-var))
- (math-try-solve-for (nth 2 lhs)
- (math-sub rhs (nth 1 lhs))
- sign))
- ((not (math-expr-contains (nth 2 lhs) solve-var))
- (math-try-solve-for (nth 1 lhs)
- (math-sub rhs (nth 2 lhs))
- sign))))
- ((eq (car lhs) 'calcFunc-eq)
- (math-try-solve-for (math-sub (nth 1 lhs) (nth 2 lhs))
- rhs sign no-poly))
- ((eq (car lhs) '-)
- (cond ((or (and (eq (car-safe (nth 1 lhs)) 'calcFunc-sin)
- (eq (car-safe (nth 2 lhs)) 'calcFunc-cos))
- (and (eq (car-safe (nth 1 lhs)) 'calcFunc-cos)
- (eq (car-safe (nth 2 lhs)) 'calcFunc-sin)))
- (math-try-solve-for (math-sub (nth 1 lhs)
- (list (car (nth 1 lhs))
- (math-sub
- (math-quarter-circle t)
- (nth 1 (nth 2 lhs)))))
- rhs))
- ((not (math-expr-contains (nth 1 lhs) solve-var))
- (math-try-solve-for (nth 2 lhs)
- (math-sub (nth 1 lhs) rhs)
- (and sign (- sign))))
- ((not (math-expr-contains (nth 2 lhs) solve-var))
- (math-try-solve-for (nth 1 lhs)
- (math-add rhs (nth 2 lhs))
- sign))))
- ((and (eq solve-full 't) (math-try-solve-prod)))
- ((and (eq (car lhs) '%)
- (not (math-expr-contains (nth 2 lhs) solve-var)))
- (math-try-solve-for (nth 1 lhs) (math-add rhs
- (math-solve-get-int
- (nth 2 lhs)))))
- ((eq (car lhs) 'calcFunc-log)
- (cond ((not (math-expr-contains (nth 2 lhs) solve-var))
- (math-try-solve-for (nth 1 lhs) (math-pow (nth 2 lhs) rhs)))
- ((not (math-expr-contains (nth 1 lhs) solve-var))
- (math-try-solve-for (nth 2 lhs) (math-pow
- (nth 1 lhs)
- (math-div 1 rhs))))))
- ((and (= (length lhs) 2)
- (symbolp (car lhs))
- (setq t1 (get (car lhs) 'math-inverse))
- (setq t2 (funcall t1 rhs)))
- (setq t1 (get (car lhs) 'math-inverse-sign))
- (math-try-solve-for (nth 1 lhs) (math-normalize t2)
- (and sign t1
- (if (integerp t1)
- (* t1 sign)
- (funcall t1 lhs sign)))))
- ((and (symbolp (car lhs))
- (setq t1 (get (car lhs) 'math-inverse-n))
- (setq t2 (funcall t1 lhs rhs)))
- t2)
- ((setq t1 (math-expand-formula lhs))
- (math-try-solve-for t1 rhs sign))
- (t
- (calc-record-why "*No inverse known" lhs)
- nil))))
-
-
-(defun math-try-solve-prod ()
- (cond ((eq (car lhs) '*)
- (cond ((not (math-expr-contains (nth 1 lhs) solve-var))
- (math-try-solve-for (nth 2 lhs)
- (math-div rhs (nth 1 lhs))
- (math-solve-sign sign (nth 1 lhs))))
- ((not (math-expr-contains (nth 2 lhs) solve-var))
- (math-try-solve-for (nth 1 lhs)
- (math-div rhs (nth 2 lhs))
- (math-solve-sign sign (nth 2 lhs))))
- ((Math-zerop rhs)
- (math-solve-prod (let ((math-solve-ranges math-solve-ranges))
- (math-try-solve-for (nth 2 lhs) 0))
- (math-try-solve-for (nth 1 lhs) 0)))))
- ((eq (car lhs) '/)
- (cond ((not (math-expr-contains (nth 1 lhs) solve-var))
- (math-try-solve-for (nth 2 lhs)
- (math-div (nth 1 lhs) rhs)
- (math-solve-sign sign (nth 1 lhs))))
- ((not (math-expr-contains (nth 2 lhs) solve-var))
- (math-try-solve-for (nth 1 lhs)
- (math-mul rhs (nth 2 lhs))
- (math-solve-sign sign (nth 2 lhs))))
- ((setq t1 (math-try-solve-for (math-sub (nth 1 lhs)
- (math-mul (nth 2 lhs)
- rhs))
- 0))
- t1)))
- ((eq (car lhs) '^)
- (cond ((not (math-expr-contains (nth 1 lhs) solve-var))
- (math-try-solve-for
- (nth 2 lhs)
- (math-add (math-normalize
- (list 'calcFunc-log rhs (nth 1 lhs)))
- (math-div
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))
- (math-normalize
- (list 'calcFunc-ln (nth 1 lhs)))))))
- ((not (math-expr-contains (nth 2 lhs) solve-var))
- (cond ((and (integerp (nth 2 lhs))
- (>= (nth 2 lhs) 2)
- (setq t1 (math-integer-log2 (nth 2 lhs))))
- (setq t2 rhs)
- (if (and (eq solve-full t)
- (math-known-realp (nth 1 lhs)))
- (progn
- (while (>= (setq t1 (1- t1)) 0)
- (setq t2 (list 'calcFunc-sqrt t2)))
- (setq t2 (math-solve-get-sign t2)))
- (while (>= (setq t1 (1- t1)) 0)
- (setq t2 (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-sqrt t2))))))
- (math-try-solve-for
- (nth 1 lhs)
- (math-normalize t2)))
- ((math-looks-negp (nth 2 lhs))
- (math-try-solve-for
- (list '^ (nth 1 lhs) (math-neg (nth 2 lhs)))
- (math-div 1 rhs)))
- ((and (eq solve-full t)
- (Math-integerp (nth 2 lhs))
- (math-known-realp (nth 1 lhs)))
- (setq t1 (math-normalize
- (list 'calcFunc-nroot rhs (nth 2 lhs))))
- (if (math-evenp (nth 2 lhs))
- (setq t1 (math-solve-get-sign t1)))
- (math-try-solve-for
- (nth 1 lhs) t1
- (and sign
- (math-oddp (nth 2 lhs))
- (math-solve-sign sign (nth 2 lhs)))))
- (t (math-try-solve-for
- (nth 1 lhs)
- (math-mul
- (math-normalize
- (list 'calcFunc-exp
- (if (Math-realp (nth 2 lhs))
- (math-div (math-mul
- '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i)
- (and (integerp (nth 2 lhs))
- (math-abs
- (nth 2 lhs)))))
- (math-div (nth 2 lhs) 2))
- (math-div (math-mul
- 2
- (math-mul
- '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i)
- (and (integerp (nth 2 lhs))
- (math-abs
- (nth 2 lhs))))))
- (nth 2 lhs)))))
- (math-normalize
- (list 'calcFunc-nroot
- rhs
- (nth 2 lhs))))
- (and sign
- (math-oddp (nth 2 lhs))
- (math-solve-sign sign (nth 2 lhs)))))))))
- (t nil)))
-
-(defun math-solve-prod (lsoln rsoln)
- (cond ((null lsoln)
- rsoln)
- ((null rsoln)
- lsoln)
- ((eq solve-full 'all)
- (cons 'vec (append (cdr lsoln) (cdr rsoln))))
- (solve-full
- (list 'calcFunc-if
- (list 'calcFunc-gt (math-solve-get-sign 1) 0)
- lsoln
- rsoln))
- (t lsoln)))
-
-;;; This deals with negative, fractional, and symbolic powers of "x".
-(defun math-solve-poly-funny-powers (sub-rhs) ; uses "t1", "t2"
- (setq t1 lhs)
- (let ((pp math-poly-neg-powers)
- fac)
- (while pp
- (setq fac (math-pow (car pp) (or math-poly-mult-powers 1))
- t1 (math-mul t1 fac)
- rhs (math-mul rhs fac)
- pp (cdr pp))))
- (if sub-rhs (setq t1 (math-sub t1 rhs)))
- (let ((math-poly-neg-powers nil))
- (setq t2 (math-mul (or math-poly-mult-powers 1)
- (let ((calc-prefer-frac t))
- (math-div 1 math-poly-frac-powers)))
- t1 (math-is-polynomial (math-simplify (calcFunc-expand t1)) b 50))))
-
-;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2".
-(defun math-solve-crunch-poly (max-degree) ; uses "t1", "t3"
- (let ((count 0))
- (while (and t1 (Math-zerop (car t1)))
- (setq t1 (cdr t1)
- count (1+ count)))
- (and t1
- (let* ((degree (1- (length t1)))
- (scale degree))
- (while (and (> scale 1) (= (car t3) 1))
- (and (= (% degree scale) 0)
- (let ((p t1)
- (n 0)
- (new-t1 nil)
- (okay t))
- (while (and p okay)
- (if (= (% n scale) 0)
- (setq new-t1 (nconc new-t1 (list (car p))))
- (or (Math-zerop (car p))
- (setq okay nil)))
- (setq p (cdr p)
- n (1+ n)))
- (if okay
- (setq t3 (cons scale (cdr t3))
- t1 new-t1))))
- (setq scale (1- scale)))
- (setq t3 (list (math-mul (car t3) t2) (math-mul count t2)))
- (<= (1- (length t1)) max-degree)))))
-
-(defun calcFunc-poly (expr var &optional degree)
- (if degree
- (or (natnump degree) (math-reject-arg degree 'fixnatnump))
- (setq degree 50))
- (let ((p (math-is-polynomial expr var degree 'gen)))
- (if p
- (if (equal p '(0))
- (list 'vec)
- (cons 'vec p))
- (math-reject-arg expr "Expected a polynomial"))))
-
-(defun calcFunc-gpoly (expr var &optional degree)
- (if degree
- (or (natnump degree) (math-reject-arg degree 'fixnatnump))
- (setq degree 50))
- (let* ((math-poly-base-variable var)
- (d (math-decompose-poly expr var degree nil)))
- (if d
- (cons 'vec d)
- (math-reject-arg expr "Expected a polynomial"))))
-
-(defun math-decompose-poly (lhs solve-var degree sub-rhs)
- (let ((rhs (or sub-rhs 1))
- t1 t2 t3)
- (setq t2 (math-polynomial-base
- lhs
- (function
- (lambda (b)
- (let ((math-poly-neg-powers '(1))
- (math-poly-mult-powers nil)
- (math-poly-frac-powers 1)
- (math-poly-exp-base t))
- (and (not (equal b lhs))
- (or (not (memq (car-safe b) '(+ -))) sub-rhs)
- (setq t3 '(1 0) t2 1
- t1 (math-is-polynomial lhs b 50))
- (if (and (equal math-poly-neg-powers '(1))
- (memq math-poly-mult-powers '(nil 1))
- (eq math-poly-frac-powers 1)
- sub-rhs)
- (setq t1 (cons (math-sub (car t1) rhs)
- (cdr t1)))
- (math-solve-poly-funny-powers sub-rhs))
- (math-solve-crunch-poly degree)
- (or (math-expr-contains b solve-var)
- (math-expr-contains (car t3) solve-var))))))))
- (if t2
- (list (math-pow t2 (car t3))
- (cons 'vec t1)
- (if sub-rhs
- (math-pow t2 (nth 1 t3))
- (math-div (math-pow t2 (nth 1 t3)) rhs))))))
-
-(defun math-solve-linear (var sign b a)
- (math-try-solve-for var
- (math-div (math-neg b) a)
- (math-solve-sign sign a)
- t))
-
-(defun math-solve-quadratic (var c b a)
- (math-try-solve-for
- var
- (if (math-looks-evenp b)
- (let ((halfb (math-div b 2)))
- (math-div
- (math-add
- (math-neg halfb)
- (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr halfb)
- (math-mul (math-neg c) a))))))
- a))
- (math-div
- (math-add
- (math-neg b)
- (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr b)
- (math-mul 4 (math-mul (math-neg c) a)))))))
- (math-mul 2 a)))
- nil t))
-
-(defun math-solve-cubic (var d c b a)
- (let* ((p (math-div b a))
- (q (math-div c a))
- (r (math-div d a))
- (psqr (math-sqr p))
- (aa (math-sub q (math-div psqr 3)))
- (bb (math-add r
- (math-div (math-sub (math-mul 2 (math-mul psqr p))
- (math-mul 9 (math-mul p q)))
- 27)))
- m)
- (if (Math-zerop aa)
- (math-try-solve-for (math-pow (math-add var (math-div p 3)) 3)
- (math-neg bb) nil t)
- (if (Math-zerop bb)
- (math-try-solve-for
- (math-mul (math-add var (math-div p 3))
- (math-add (math-sqr (math-add var (math-div p 3)))
- aa))
- 0 nil t)
- (setq m (math-mul 2 (list 'calcFunc-sqrt (math-div aa -3))))
- (math-try-solve-for
- var
- (math-sub
- (math-normalize
- (math-mul
- m
- (list 'calcFunc-cos
- (math-div
- (math-sub (list 'calcFunc-arccos
- (math-div (math-mul 3 bb)
- (math-mul aa m)))
- (math-mul 2
- (math-mul
- (math-add 1 (math-solve-get-int
- 1 3))
- (math-half-circle
- calc-symbolic-mode))))
- 3))))
- (math-div p 3))
- nil t)))))
-
-(defun math-solve-quartic (var d c b a aa)
- (setq a (math-div a aa))
- (setq b (math-div b aa))
- (setq c (math-div c aa))
- (setq d (math-div d aa))
- (math-try-solve-for
- var
- (let* ((asqr (math-sqr a))
- (asqr4 (math-div asqr 4))
- (y (let ((solve-full nil)
- calc-next-why)
- (math-solve-cubic solve-var
- (math-sub (math-sub
- (math-mul 4 (math-mul b d))
- (math-mul asqr d))
- (math-sqr c))
- (math-sub (math-mul a c)
- (math-mul 4 d))
- (math-neg b)
- 1)))
- (rsqr (math-add (math-sub asqr4 b) y))
- (r (list 'calcFunc-sqrt rsqr))
- (sign1 (math-solve-get-sign 1))
- (de (list 'calcFunc-sqrt
- (math-add
- (math-sub (math-mul 3 asqr4)
- (math-mul 2 b))
- (if (Math-zerop rsqr)
- (math-mul
- 2
- (math-mul sign1
- (list 'calcFunc-sqrt
- (math-sub (math-sqr y)
- (math-mul 4 d)))))
- (math-sub
- (math-mul sign1
- (math-div
- (math-sub (math-sub
- (math-mul 4 (math-mul a b))
- (math-mul 8 c))
- (math-mul asqr a))
- (math-mul 4 r)))
- rsqr))))))
- (math-normalize
- (math-sub (math-add (math-mul sign1 (math-div r 2))
- (math-solve-get-sign (math-div de 2)))
- (math-div a 4))))
- nil t))
-
-(defvar math-symbolic-solve nil)
-(defvar math-int-coefs nil)
-(defun math-poly-all-roots (var p &optional math-factoring)
- (catch 'ouch
- (let* ((math-symbolic-solve calc-symbolic-mode)
- (roots nil)
- (deg (1- (length p)))
- (orig-p (reverse p))
- (math-int-coefs nil)
- (math-int-scale nil)
- (math-double-roots nil)
- (math-int-factors nil)
- (math-int-threshold nil)
- (pp p))
- ;; If rational coefficients, look for exact rational factors.
- (while (and pp (Math-ratp (car pp)))
- (setq pp (cdr pp)))
- (if pp
- (if (or math-factoring math-symbolic-solve)
- (throw 'ouch nil))
- (let ((lead (car orig-p))
- (calc-prefer-frac t)
- (scale (apply 'math-lcm-denoms p)))
- (setq math-int-scale (math-abs (math-mul scale lead))
- math-int-threshold (math-div '(float 5 -2) math-int-scale)
- math-int-coefs (cdr (math-div (cons 'vec orig-p) lead)))))
- (if (> deg 4)
- (let ((calc-prefer-frac nil)
- (calc-symbolic-mode nil)
- (pp p)
- (def-p (copy-sequence orig-p)))
- (while pp
- (if (Math-numberp (car pp))
- (setq pp (cdr pp))
- (throw 'ouch nil)))
- (while (> deg (if math-symbolic-solve 2 4))
- (let* ((x (math-poly-any-root def-p '(float 0 0) nil))
- b c pp)
- (if (and (eq (car-safe x) 'cplx)
- (math-nearly-zerop (nth 2 x) (nth 1 x)))
- (setq x (calcFunc-re x)))
- (or math-factoring
- (setq roots (cons x roots)))
- (or (math-numberp x)
- (setq x (math-evaluate-expr x)))
- (setq pp def-p
- b (car def-p))
- (while (setq pp (cdr pp))
- (setq c (car pp))
- (setcar pp b)
- (setq b (math-add (math-mul x b) c)))
- (setq def-p (cdr def-p)
- deg (1- deg))))
- (setq p (reverse def-p))))
- (if (> deg 1)
- (let ((solve-var '(var DUMMY var-DUMMY))
- (math-solve-sign nil)
- (math-solve-ranges nil)
- (solve-full 'all))
- (if (= (length p) (length math-int-coefs))
- (setq p (reverse math-int-coefs)))
- (setq roots (append (cdr (apply (cond ((= deg 2)
- 'math-solve-quadratic)
- ((= deg 3)
- 'math-solve-cubic)
- (t
- 'math-solve-quartic))
- solve-var p))
- roots)))
- (if (> deg 0)
- (setq roots (cons (math-div (math-neg (car p)) (nth 1 p))
- roots))))
- (if math-factoring
- (progn
- (while roots
- (math-poly-integer-root (car roots))
- (setq roots (cdr roots)))
- (list math-int-factors (nreverse math-int-coefs) math-int-scale))
- (let ((vec nil) res)
- (while roots
- (let ((root (car roots))
- (solve-full (and solve-full 'all)))
- (if (math-floatp root)
- (setq root (math-poly-any-root orig-p root t)))
- (setq vec (append vec
- (cdr (or (math-try-solve-for var root nil t)
- (throw 'ouch nil))))))
- (setq roots (cdr roots)))
- (setq vec (cons 'vec (nreverse vec)))
- (if math-symbolic-solve
- (setq vec (math-normalize vec)))
- (if (eq solve-full t)
- (list 'calcFunc-subscr
- vec
- (math-solve-get-int 1 (1- (length orig-p)) 1))
- vec))))))
-
-(defun math-lcm-denoms (&rest fracs)
- (let ((den 1))
- (while fracs
- (if (eq (car-safe (car fracs)) 'frac)
- (setq den (calcFunc-lcm den (nth 2 (car fracs)))))
- (setq fracs (cdr fracs)))
- den))
-
-(defun math-poly-any-root (p x polish) ; p is a reverse poly coeff list
- (let* ((newt (if (math-zerop x)
- (math-poly-newton-root
- p '(cplx (float 123 -6) (float 1 -4)) 4)
- (math-poly-newton-root p x 4)))
- (res (if (math-zerop (cdr newt))
- (car newt)
- (if (and (math-lessp (cdr newt) '(float 1 -3)) (not polish))
- (setq newt (math-poly-newton-root p (car newt) 30)))
- (if (math-zerop (cdr newt))
- (car newt)
- (math-poly-laguerre-root p x polish)))))
- (and math-symbolic-solve (math-floatp res)
- (throw 'ouch nil))
- res))
-
-(defun math-poly-newton-root (p x iters)
- (let* ((calc-prefer-frac nil)
- (calc-symbolic-mode nil)
- (try-integer math-int-coefs)
- (dx x) b d)
- (while (and (> (setq iters (1- iters)) 0)
- (let ((pp p))
- (math-working "newton" x)
- (setq b (car p)
- d 0)
- (while (setq pp (cdr pp))
- (setq d (math-add (math-mul x d) b)
- b (math-add (math-mul x b) (car pp))))
- (not (math-zerop d)))
- (progn
- (setq dx (math-div b d)
- x (math-sub x dx))
- (if try-integer
- (let ((adx (math-abs-approx dx)))
- (and (math-lessp adx math-int-threshold)
- (let ((iroot (math-poly-integer-root x)))
- (if iroot
- (setq x iroot dx 0)
- (setq try-integer nil))))))
- (or (not (or (eq dx 0)
- (math-nearly-zerop dx (math-abs-approx x))))
- (progn (setq dx 0) nil)))))
- (cons x (if (math-zerop x)
- 1 (math-div (math-abs-approx dx) (math-abs-approx x))))))
-
-(defun math-poly-integer-root (x)
- (and (math-lessp (calcFunc-xpon (math-abs-approx x)) calc-internal-prec)
- math-int-coefs
- (let* ((calc-prefer-frac t)
- (xre (calcFunc-re x))
- (xim (calcFunc-im x))
- (xresq (math-sqr xre))
- (ximsq (math-sqr xim)))
- (if (math-lessp ximsq (calcFunc-scf xresq -1))
- ;; Look for linear factor
- (let* ((rnd (math-div (math-round (math-mul xre math-int-scale))
- math-int-scale))
- (icp math-int-coefs)
- (rem (car icp))
- (newcoef nil))
- (while (setq icp (cdr icp))
- (setq newcoef (cons rem newcoef)
- rem (math-add (car icp)
- (math-mul rem rnd))))
- (and (math-zerop rem)
- (progn
- (setq math-int-coefs (nreverse newcoef)
- math-int-factors (cons (list (math-neg rnd))
- math-int-factors))
- rnd)))
- ;; Look for irreducible quadratic factor
- (let* ((rnd1 (math-div (math-round
- (math-mul xre (math-mul -2 math-int-scale)))
- math-int-scale))
- (sqscale (math-sqr math-int-scale))
- (rnd0 (math-div (math-round (math-mul (math-add xresq ximsq)
- sqscale))
- sqscale))
- (rem1 (car math-int-coefs))
- (icp (cdr math-int-coefs))
- (rem0 (car icp))
- (newcoef nil)
- (found (assoc (list rnd0 rnd1 (math-posp xim))
- math-double-roots))
- this)
- (if found
- (setq math-double-roots (delq found math-double-roots)
- rem0 0 rem1 0)
- (while (setq icp (cdr icp))
- (setq this rem1
- newcoef (cons rem1 newcoef)
- rem1 (math-sub rem0 (math-mul this rnd1))
- rem0 (math-sub (car icp) (math-mul this rnd0)))))
- (and (math-zerop rem0)
- (math-zerop rem1)
- (let ((aa (math-div rnd1 -2)))
- (or found (setq math-int-coefs (reverse newcoef)
- math-double-roots (cons (list
- (list
- rnd0 rnd1
- (math-negp xim)))
- math-double-roots)
- math-int-factors (cons (cons rnd0 rnd1)
- math-int-factors)))
- (math-add aa
- (let ((calc-symbolic-mode math-symbolic-solve))
- (math-mul (math-sqrt (math-sub (math-sqr aa)
- rnd0))
- (if (math-negp xim) -1 1)))))))))))
-
-;;; The following routine is from Numerical Recipes, section 9.5.
-(defun math-poly-laguerre-root (p x polish)
- (let* ((calc-prefer-frac nil)
- (calc-symbolic-mode nil)
- (iters 0)
- (m (1- (length p)))
- (try-newt (not polish))
- (tried-newt nil)
- b d f x1 dx dxold)
- (while
- (and (or (< (setq iters (1+ iters)) 50)
- (math-reject-arg x "*Laguerre's method failed to converge"))
- (let ((err (math-abs-approx (car p)))
- (abx (math-abs-approx x))
- (pp p))
- (setq b (car p)
- d 0 f 0)
- (while (setq pp (cdr pp))
- (setq f (math-add (math-mul x f) d)
- d (math-add (math-mul x d) b)
- b (math-add (math-mul x b) (car pp))
- err (math-add (math-abs-approx b) (math-mul abx err))))
- (math-lessp (calcFunc-scf err (- -2 calc-internal-prec))
- (math-abs-approx b)))
- (or (not (math-zerop d))
- (not (math-zerop f))
- (progn
- (setq x (math-pow (math-neg b) (list 'frac 1 m)))
- nil))
- (let* ((g (math-div d b))
- (g2 (math-sqr g))
- (h (math-sub g2 (math-mul 2 (math-div f b))))
- (sq (math-sqrt
- (math-mul (1- m) (math-sub (math-mul m h) g2))))
- (gp (math-add g sq))
- (gm (math-sub g sq)))
- (if (math-lessp (calcFunc-abssqr gp) (calcFunc-abssqr gm))
- (setq gp gm))
- (setq dx (math-div m gp)
- x1 (math-sub x dx))
- (if (and try-newt
- (math-lessp (math-abs-approx dx)
- (calcFunc-scf (math-abs-approx x) -3)))
- (let ((newt (math-poly-newton-root p x1 7)))
- (setq tried-newt t
- try-newt nil)
- (if (math-zerop (cdr newt))
- (setq x (car newt) x1 x)
- (if (math-lessp (cdr newt) '(float 1 -6))
- (let ((newt2 (math-poly-newton-root
- p (car newt) 20)))
- (if (math-zerop (cdr newt2))
- (setq x (car newt2) x1 x)
- (setq x (car newt))))))))
- (not (or (eq x x1)
- (math-nearly-equal x x1))))
- (let ((cdx (math-abs-approx dx)))
- (setq x x1
- tried-newt nil)
- (prog1
- (or (<= iters 6)
- (math-lessp cdx dxold)
- (progn
- (if polish
- (let ((digs (calcFunc-xpon
- (math-div (math-abs-approx x) cdx))))
- (calc-record-why
- "*Could not attain full precision")
- (if (natnump digs)
- (let ((calc-internal-prec (max 3 digs)))
- (setq x (math-normalize x))))))
- nil))
- (setq dxold cdx)))
- (or polish
- (math-lessp (calcFunc-scf (math-abs-approx x)
- (- calc-internal-prec))
- dxold))))
- (or (and (math-floatp x)
- (math-poly-integer-root x))
- x)))
-
-(defun math-solve-above-dummy (x)
- (and (not (Math-primp x))
- (if (and (equal (nth 1 x) '(var SOLVEDUM SOLVEDUM))
- (= (length x) 2))
- x
- (let ((res nil))
- (while (and (setq x (cdr x))
- (not (setq res (math-solve-above-dummy (car x))))))
- res))))
-
-(defun math-solve-find-root-term (x neg) ; sets "t2", "t3"
- (if (math-solve-find-root-in-prod x)
- (setq t3 neg
- t1 x)
- (and (memq (car-safe x) '(+ -))
- (or (math-solve-find-root-term (nth 1 x) neg)
- (math-solve-find-root-term (nth 2 x)
- (if (eq (car x) '-) (not neg) neg))))))
-
-(defun math-solve-find-root-in-prod (x)
- (and (consp x)
- (math-expr-contains x solve-var)
- (or (and (eq (car x) 'calcFunc-sqrt)
- (setq t2 2))
- (and (eq (car x) '^)
- (or (and (memq (math-quarter-integer (nth 2 x)) '(1 2 3))
- (setq t2 2))
- (and (eq (car-safe (nth 2 x)) 'frac)
- (eq (nth 2 (nth 2 x)) 3)
- (setq t2 3))))
- (and (memq (car x) '(* /))
- (or (and (not (math-expr-contains (nth 1 x) solve-var))
- (math-solve-find-root-in-prod (nth 2 x)))
- (and (not (math-expr-contains (nth 2 x) solve-var))
- (math-solve-find-root-in-prod (nth 1 x))))))))
-
-
-(defun math-solve-system (exprs solve-vars solve-full)
- (setq exprs (mapcar 'list (if (Math-vectorp exprs)
- (cdr exprs)
- (list exprs)))
- solve-vars (if (Math-vectorp solve-vars)
- (cdr solve-vars)
- (list solve-vars)))
- (or (let ((math-solve-simplifying nil))
- (math-solve-system-rec exprs solve-vars nil))
- (let ((math-solve-simplifying t))
- (math-solve-system-rec exprs solve-vars nil))))
-
-;;; The following backtracking solver works by choosing a variable
-;;; and equation, and trying to solve the equation for the variable.
-;;; If it succeeds it calls itself recursively with that variable and
-;;; equation removed from their respective lists, and with the solution
-;;; added to solns as well as being substituted into all existing
-;;; equations. The algorithm terminates when any solution path
-;;; manages to remove all the variables from var-list.
-
-;;; To support calcFunc-roots, entries in eqn-list and solns are
-;;; actually lists of equations.
-
-(defun math-solve-system-rec (eqn-list var-list solns)
- (if var-list
- (let ((v var-list)
- (res nil))
-
- ;; Try each variable in turn.
- (while
- (and
- v
- (let* ((vv (car v))
- (e eqn-list)
- (elim (eq (car-safe vv) 'calcFunc-elim)))
- (if elim
- (setq vv (nth 1 vv)))
-
- ;; Try each equation in turn.
- (while
- (and
- e
- (let ((e2 (car e))
- (eprev nil)
- res2)
- (setq res nil)
-
- ;; Try to solve for vv the list of equations e2.
- (while (and e2
- (setq res2 (or (and (eq (car e2) eprev)
- res2)
- (math-solve-for (car e2) 0 vv
- solve-full))))
- (setq eprev (car e2)
- res (cons (if (eq solve-full 'all)
- (cdr res2)
- (list res2))
- res)
- e2 (cdr e2)))
- (if e2
- (setq res nil)
-
- ;; Found a solution. Now try other variables.
- (setq res (nreverse res)
- res (math-solve-system-rec
- (mapcar
- 'math-solve-system-subst
- (delq (car e)
- (copy-sequence eqn-list)))
- (delq (car v) (copy-sequence var-list))
- (let ((math-solve-simplifying nil)
- (s (mapcar
- (function
- (lambda (x)
- (cons
- (car x)
- (math-solve-system-subst
- (cdr x)))))
- solns)))
- (if elim
- s
- (cons (cons vv (apply 'append res))
- s)))))
- (not res))))
- (setq e (cdr e)))
- (not res)))
- (setq v (cdr v)))
- res)
-
- ;; Eliminated all variables, so now put solution into the proper format.
- (setq solns (sort solns
- (function
- (lambda (x y)
- (not (memq (car x) (memq (car y) solve-vars)))))))
- (if (eq solve-full 'all)
- (math-transpose
- (math-normalize
- (cons 'vec
- (if solns
- (mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns)
- (mapcar (function (lambda (x) (cons 'vec x))) eqn-list)))))
- (math-normalize
- (cons 'vec
- (if solns
- (mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns)
- (mapcar 'car eqn-list)))))))
-
-(defun math-solve-system-subst (x) ; uses "res" and "v"
- (let ((accum nil)
- (res2 res))
- (while x
- (setq accum (nconc accum
- (mapcar (function
- (lambda (r)
- (if math-solve-simplifying
- (math-simplify
- (math-expr-subst (car x) vv r))
- (math-expr-subst (car x) vv r))))
- (car res2)))
- x (cdr x)
- res2 (cdr res2)))
- accum))
-
-
-(defun math-get-from-counter (name)
- (let ((ctr (assq name calc-command-flags)))
- (if ctr
- (setcdr ctr (1+ (cdr ctr)))
- (setq ctr (cons name 1)
- calc-command-flags (cons ctr calc-command-flags)))
- (cdr ctr)))
-
-(defun math-solve-get-sign (val)
- (setq val (math-simplify val))
- (if (and (eq (car-safe val) '*)
- (Math-numberp (nth 1 val)))
- (list '* (nth 1 val) (math-solve-get-sign (nth 2 val)))
- (and (eq (car-safe val) 'calcFunc-sqrt)
- (eq (car-safe (nth 1 val)) '^)
- (setq val (math-normalize (list '^
- (nth 1 (nth 1 val))
- (math-div (nth 2 (nth 1 val)) 2)))))
- (if solve-full
- (if (and (calc-var-value 'var-GenCount)
- (Math-natnump var-GenCount)
- (not (eq solve-full 'all)))
- (prog1
- (math-mul (list 'calcFunc-as var-GenCount) val)
- (setq var-GenCount (math-add var-GenCount 1))
- (calc-refresh-evaltos 'var-GenCount))
- (let* ((var (concat "s" (int-to-string (math-get-from-counter 'solve-sign))))
- (var2 (list 'var (intern var) (intern (concat "var-" var)))))
- (if (eq solve-full 'all)
- (setq math-solve-ranges (cons (list var2 1 -1)
- math-solve-ranges)))
- (math-mul var2 val)))
- (calc-record-why "*Choosing positive solution")
- val)))
-
-(defun math-solve-get-int (val &optional range first)
- (if solve-full
- (if (and (calc-var-value 'var-GenCount)
- (Math-natnump var-GenCount)
- (not (eq solve-full 'all)))
- (prog1
- (math-mul val (list 'calcFunc-an var-GenCount))
- (setq var-GenCount (math-add var-GenCount 1))
- (calc-refresh-evaltos 'var-GenCount))
- (let* ((var (concat "n" (int-to-string
- (math-get-from-counter 'solve-int))))
- (var2 (list 'var (intern var) (intern (concat "var-" var)))))
- (if (and range (eq solve-full 'all))
- (setq math-solve-ranges (cons (cons var2
- (cdr (calcFunc-index
- range (or first 0))))
- math-solve-ranges)))
- (math-mul val var2)))
- (calc-record-why "*Choosing 0 for arbitrary integer in solution")
- 0))
-
-(defun math-solve-sign (sign expr)
- (and sign
- (let ((s1 (math-possible-signs expr)))
- (cond ((memq s1 '(4 6))
- sign)
- ((memq s1 '(1 3))
- (- sign))))))
-
-(defun math-looks-evenp (expr)
- (if (Math-integerp expr)
- (math-evenp expr)
- (if (memq (car expr) '(* /))
- (math-looks-evenp (nth 1 expr)))))
-
-(defun math-solve-for (lhs rhs solve-var solve-full &optional sign)
- (if (math-expr-contains rhs solve-var)
- (math-solve-for (math-sub lhs rhs) 0 solve-var solve-full)
- (and (math-expr-contains lhs solve-var)
- (math-with-extra-prec 1
- (let* ((math-poly-base-variable solve-var)
- (res (math-try-solve-for lhs rhs sign)))
- (if (and (eq solve-full 'all)
- (math-known-realp solve-var))
- (let ((old-len (length res))
- new-len)
- (setq res (delq nil
- (mapcar (function
- (lambda (x)
- (and (not (memq (car-safe x)
- '(cplx polar)))
- x)))
- res))
- new-len (length res))
- (if (< new-len old-len)
- (calc-record-why (if (= new-len 1)
- "*All solutions were complex"
- (format
- "*Omitted %d complex solutions"
- (- old-len new-len)))))))
- res)))))
-
-(defun math-solve-eqn (expr var full)
- (if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt
- calcFunc-leq calcFunc-geq))
- (let ((res (math-solve-for (cons '- (cdr expr))
- 0 var full
- (if (eq (car expr) 'calcFunc-neq) nil 1))))
- (and res
- (if (eq math-solve-sign 1)
- (list (car expr) var res)
- (if (eq math-solve-sign -1)
- (list (car expr) res var)
- (or (eq (car expr) 'calcFunc-neq)
- (calc-record-why
- "*Can't determine direction of inequality"))
- (and (memq (car expr) '(calcFunc-neq calcFunc-lt calcFunc-gt))
- (list 'calcFunc-neq var res))))))
- (let ((res (math-solve-for expr 0 var full)))
- (and res
- (list 'calcFunc-eq var res)))))
-
-(defun math-reject-solution (expr var func)
- (if (math-expr-contains expr var)
- (or (equal (car calc-next-why) '(* "Unable to find a symbolic solution"))
- (calc-record-why "*Unable to find a solution")))
- (list func expr var))
-
-(defun calcFunc-solve (expr var)
- (or (if (or (Math-vectorp expr) (Math-vectorp var))
- (math-solve-system expr var nil)
- (math-solve-eqn expr var nil))
- (math-reject-solution expr var 'calcFunc-solve)))
-
-(defun calcFunc-fsolve (expr var)
- (or (if (or (Math-vectorp expr) (Math-vectorp var))
- (math-solve-system expr var t)
- (math-solve-eqn expr var t))
- (math-reject-solution expr var 'calcFunc-fsolve)))
-
-(defun calcFunc-roots (expr var)
- (let ((math-solve-ranges nil))
- (or (if (or (Math-vectorp expr) (Math-vectorp var))
- (math-solve-system expr var 'all)
- (math-solve-for expr 0 var 'all))
- (math-reject-solution expr var 'calcFunc-roots))))
-
-(defun calcFunc-finv (expr var)
- (let ((res (math-solve-for expr math-integ-var var nil)))
- (if res
- (math-normalize (math-expr-subst res math-integ-var var))
- (math-reject-solution expr var 'calcFunc-finv))))
-
-(defun calcFunc-ffinv (expr var)
- (let ((res (math-solve-for expr math-integ-var var t)))
- (if res
- (math-normalize (math-expr-subst res math-integ-var var))
- (math-reject-solution expr var 'calcFunc-finv))))
-
-
-(put 'calcFunc-inv 'math-inverse
- (function (lambda (x) (math-div 1 x))))
-(put 'calcFunc-inv 'math-inverse-sign -1)
-
-(put 'calcFunc-sqrt 'math-inverse
- (function (lambda (x) (math-sqr x))))
-
-(put 'calcFunc-conj 'math-inverse
- (function (lambda (x) (list 'calcFunc-conj x))))
-
-(put 'calcFunc-abs 'math-inverse
- (function (lambda (x) (math-solve-get-sign x))))
-
-(put 'calcFunc-deg 'math-inverse
- (function (lambda (x) (list 'calcFunc-rad x))))
-(put 'calcFunc-deg 'math-inverse-sign 1)
-
-(put 'calcFunc-rad 'math-inverse
- (function (lambda (x) (list 'calcFunc-deg x))))
-(put 'calcFunc-rad 'math-inverse-sign 1)
-
-(put 'calcFunc-ln 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp x))))
-(put 'calcFunc-ln 'math-inverse-sign 1)
-
-(put 'calcFunc-log10 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp10 x))))
-(put 'calcFunc-log10 'math-inverse-sign 1)
-
-(put 'calcFunc-lnp1 'math-inverse
- (function (lambda (x) (list 'calcFunc-expm1 x))))
-(put 'calcFunc-lnp1 'math-inverse-sign 1)
-
-(put 'calcFunc-exp 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))))))
-(put 'calcFunc-exp 'math-inverse-sign 1)
-
-(put 'calcFunc-expm1 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))))))
-(put 'calcFunc-expm1 'math-inverse-sign 1)
-
-(put 'calcFunc-sin 'math-inverse
- (function (lambda (x) (let ((n (math-solve-get-int 1)))
- (math-add (math-mul (math-normalize
- (list 'calcFunc-arcsin x))
- (math-pow -1 n))
- (math-mul (math-half-circle t)
- n))))))
-
-(put 'calcFunc-cos 'math-inverse
- (function (lambda (x) (math-add (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-arccos x)))
- (math-solve-get-int
- (math-full-circle t))))))
-
-(put 'calcFunc-tan 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
- (math-solve-get-int
- (math-half-circle t))))))
-
-(put 'calcFunc-arcsin 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-sin x)))))
-
-(put 'calcFunc-arccos 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-cos x)))))
-
-(put 'calcFunc-arctan 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-tan x)))))
-
-(put 'calcFunc-sinh 'math-inverse
- (function (lambda (x) (let ((n (math-solve-get-int 1)))
- (math-add (math-mul (math-normalize
- (list 'calcFunc-arcsinh x))
- (math-pow -1 n))
- (math-mul (math-half-circle t)
- (math-mul
- '(var i var-i)
- n)))))))
-(put 'calcFunc-sinh 'math-inverse-sign 1)
-
-(put 'calcFunc-cosh 'math-inverse
- (function (lambda (x) (math-add (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-arccosh x)))
- (math-mul (math-full-circle t)
- (math-solve-get-int
- '(var i var-i)))))))
-
-(put 'calcFunc-tanh 'math-inverse
- (function (lambda (x) (math-add (math-normalize
- (list 'calcFunc-arctanh x))
- (math-mul (math-half-circle t)
- (math-solve-get-int
- '(var i var-i)))))))
-(put 'calcFunc-tanh 'math-inverse-sign 1)
-
-(put 'calcFunc-arcsinh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-sinh x)))))
-(put 'calcFunc-arcsinh 'math-inverse-sign 1)
-
-(put 'calcFunc-arccosh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-cosh x)))))
-
-(put 'calcFunc-arctanh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-tanh x)))))
-(put 'calcFunc-arctanh 'math-inverse-sign 1)
-
-
-
-(defun calcFunc-taylor (expr var num)
- (let ((x0 0) (v var))
- (if (memq (car-safe var) '(+ - calcFunc-eq))
- (setq x0 (if (eq (car var) '+) (math-neg (nth 2 var)) (nth 2 var))
- v (nth 1 var)))
- (or (and (eq (car-safe v) 'var)
- (math-expr-contains expr v)
- (natnump num)
- (let ((accum (math-expr-subst expr v x0))
- (var2 (if (eq (car var) 'calcFunc-eq)
- (cons '- (cdr var))
- var))
- (n 0)
- (nfac 1)
- (fprime expr))
- (while (and (<= (setq n (1+ n)) num)
- (setq fprime (calcFunc-deriv fprime v nil t)))
- (setq fprime (math-simplify fprime)
- nfac (math-mul nfac n)
- accum (math-add accum
- (math-div (math-mul (math-pow var2 n)
- (math-expr-subst
- fprime v x0))
- nfac))))
- (and fprime
- (math-normalize accum))))
- (list 'calcFunc-taylor expr var num))))
-
-;;; calcalg2.el ends here
+++ /dev/null
-;;; calcalg3.el --- more algebraic functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-alg-3 () nil)
-
-
-(defun calc-find-root (var)
- (interactive "sVariable(s) to solve for: ")
- (calc-slow-wrapper
- (let ((func (if (calc-is-hyperbolic) 'calcFunc-wroot 'calcFunc-root)))
- (if (or (equal var "") (equal var "$"))
- (calc-enter-result 2 "root" (list func
- (calc-top-n 3)
- (calc-top-n 1)
- (calc-top-n 2)))
- (let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
- (math-read-expr (concat "[" var "]"))
- (math-read-expr var))))
- (if (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (calc-enter-result 1 "root" (list func
- (calc-top-n 2)
- var
- (calc-top-n 1))))))))
-
-(defun calc-find-minimum (var)
- (interactive "sVariable(s) to minimize over: ")
- (calc-slow-wrapper
- (let ((func (if (calc-is-inverse)
- (if (calc-is-hyperbolic)
- 'calcFunc-wmaximize 'calcFunc-maximize)
- (if (calc-is-hyperbolic)
- 'calcFunc-wminimize 'calcFunc-minimize)))
- (tag (if (calc-is-inverse) "max" "min")))
- (if (or (equal var "") (equal var "$"))
- (calc-enter-result 2 tag (list func
- (calc-top-n 3)
- (calc-top-n 1)
- (calc-top-n 2)))
- (let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
- (math-read-expr (concat "[" var "]"))
- (math-read-expr var))))
- (if (eq (car-safe var) 'error)
- (error "Bad format in expression: %s" (nth 1 var)))
- (calc-enter-result 1 tag (list func
- (calc-top-n 2)
- var
- (calc-top-n 1))))))))
-
-(defun calc-find-maximum (var)
- (interactive "sVariable to maximize over: ")
- (calc-invert-func)
- (calc-find-minimum var))
-
-
-(defun calc-poly-interp (arg)
- (interactive "P")
- (calc-slow-wrapper
- (let ((data (calc-top 2)))
- (if (or (consp arg) (eq arg 0) (eq arg 2))
- (setq data (cons 'vec (calc-top-list 2 2)))
- (or (null arg)
- (error "Bad prefix argument")))
- (if (calc-is-hyperbolic)
- (calc-enter-result 1 "rati" (list 'calcFunc-ratint data (calc-top 1)))
- (calc-enter-result 1 "poli" (list 'calcFunc-polint data
- (calc-top 1)))))))
-
-
-(defun calc-curve-fit (arg &optional model coefnames varnames)
- (interactive "P")
- (calc-slow-wrapper
- (setq calc-aborted-prefix nil)
- (let ((func (if (calc-is-inverse) 'calcFunc-xfit
- (if (calc-is-hyperbolic) 'calcFunc-efit
- 'calcFunc-fit)))
- key (which 0)
- n nvars temp data
- (homog nil)
- (msgs '( "(Press ? for help)"
- "1 = linear or multilinear"
- "2-9 = polynomial fits; i = interpolating polynomial"
- "p = a x^b, ^ = a b^x"
- "e = a exp(b x), x = exp(a + b x), l = a + b ln(x)"
- "E = a 10^(b x), X = 10^(a + b x), L = a + b log10(x)"
- "q = a + b (x-c)^2"
- "g = (a/b sqrt(2 pi)) exp(-0.5*((x-c)/b)^2)"
- "h prefix = homogeneous model (no constant term)"
- "' = alg entry, $ = stack, u = Model1, U = Model2")))
- (while (not model)
- (message "Fit to model: %s:%s"
- (nth which msgs)
- (if homog " h" ""))
- (setq key (read-char))
- (cond ((= key ?\C-g)
- (keyboard-quit))
- ((= key ??)
- (setq which (% (1+ which) (length msgs))))
- ((memq key '(?h ?H))
- (setq homog (not homog)))
- ((progn
- (if (eq key ?\$)
- (setq n 1)
- (setq n 0))
- (cond ((null arg)
- (setq n (1+ n)
- data (calc-top n)))
- ((or (consp arg) (eq arg 0))
- (setq n (+ n 2)
- data (calc-top n)
- data (if (math-matrixp data)
- (append data (list (calc-top (1- n))))
- (list 'vec data (calc-top (1- n))))))
- ((> (setq arg (prefix-numeric-value arg)) 0)
- (setq data (cons 'vec (calc-top-list arg (1+ n)))
- n (+ n arg)))
- (t (error "Bad prefix argument")))
- (or (math-matrixp data) (not (cdr (cdr data)))
- (error "Data matrix is not a matrix!"))
- (setq nvars (- (length data) 2)
- coefnames nil
- varnames nil)
- nil))
- ((= key ?1) ; linear or multilinear
- (calc-get-fit-variables nvars (1+ nvars) (and homog 0))
- (setq model (math-mul coefnames
- (cons 'vec (cons 1 (cdr varnames))))))
- ((and (>= key ?2) (<= key ?9)) ; polynomial
- (calc-get-fit-variables 1 (- key ?0 -1) (and homog 0))
- (setq model (math-build-polynomial-expr (cdr coefnames)
- (nth 1 varnames))))
- ((= key ?i) ; exact polynomial
- (calc-get-fit-variables 1 (1- (length (nth 1 data)))
- (and homog 0))
- (setq model (math-build-polynomial-expr (cdr coefnames)
- (nth 1 varnames))))
- ((= key ?p) ; power law
- (calc-get-fit-variables nvars (1+ nvars) (and homog 1))
- (setq model (math-mul (nth 1 coefnames)
- (calcFunc-reduce
- '(var mul var-mul)
- (calcFunc-map
- '(var pow var-pow)
- varnames
- (cons 'vec (cdr (cdr coefnames))))))))
- ((= key ?^) ; exponential law
- (calc-get-fit-variables nvars (1+ nvars) (and homog 1))
- (setq model (math-mul (nth 1 coefnames)
- (calcFunc-reduce
- '(var mul var-mul)
- (calcFunc-map
- '(var pow var-pow)
- (cons 'vec (cdr (cdr coefnames)))
- varnames)))))
- ((memq key '(?e ?E))
- (calc-get-fit-variables nvars (1+ nvars) (and homog 1))
- (setq model (math-mul (nth 1 coefnames)
- (calcFunc-reduce
- '(var mul var-mul)
- (calcFunc-map
- (if (eq key ?e)
- '(var exp var-exp)
- '(calcFunc-lambda
- (var a var-a)
- (^ 10 (var a var-a))))
- (calcFunc-map
- '(var mul var-mul)
- (cons 'vec (cdr (cdr coefnames)))
- varnames))))))
- ((memq key '(?x ?X))
- (calc-get-fit-variables nvars (1+ nvars) (and homog 0))
- (setq model (math-mul coefnames
- (cons 'vec (cons 1 (cdr varnames)))))
- (setq model (if (eq key ?x)
- (list 'calcFunc-exp model)
- (list '^ 10 model))))
- ((memq key '(?l ?L))
- (calc-get-fit-variables nvars (1+ nvars) (and homog 0))
- (setq model (math-mul coefnames
- (cons 'vec
- (cons 1 (cdr (calcFunc-map
- (if (eq key ?l)
- '(var ln var-ln)
- '(var log10
- var-log10))
- varnames)))))))
- ((= key ?q)
- (calc-get-fit-variables nvars (1+ (* 2 nvars)) (and homog 0))
- (let ((c coefnames)
- (v varnames))
- (setq model (nth 1 c))
- (while (setq v (cdr v) c (cdr (cdr c)))
- (setq model (math-add
- model
- (list '*
- (car c)
- (list '^
- (list '- (car v) (nth 1 c))
- 2)))))))
- ((= key ?g)
- (setq model (math-read-expr "(AFit / BFit sqrt(2 pi)) exp(-0.5 * ((XFit - CFit) / BFit)^2)")
- varnames '(vec (var XFit var-XFit))
- coefnames '(vec (var AFit var-AFit)
- (var BFit var-BFit)
- (var CFit var-CFit)))
- (calc-get-fit-variables 1 (1- (length coefnames)) (and homog 1)))
- ((memq key '(?\$ ?\' ?u ?U))
- (let* ((defvars nil)
- (record-entry nil))
- (if (eq key ?\')
- (let* ((calc-dollar-values calc-arg-values)
- (calc-dollar-used 0)
- (calc-hashes-used 0))
- (setq model (calc-do-alg-entry "" "Model formula: "))
- (if (/= (length model) 1)
- (error "Bad format"))
- (setq model (car model)
- record-entry t)
- (if (> calc-dollar-used 0)
- (setq coefnames
- (cons 'vec
- (nthcdr (- (length calc-arg-values)
- calc-dollar-used)
- (reverse calc-arg-values))))
- (if (> calc-hashes-used 0)
- (setq coefnames
- (cons 'vec (calc-invent-args
- calc-hashes-used))))))
- (progn
- (setq model (cond ((eq key ?u)
- (calc-var-value 'var-Model1))
- ((eq key ?U)
- (calc-var-value 'var-Model2))
- (t (calc-top 1))))
- (or model (error "User model not yet defined"))
- (if (math-vectorp model)
- (if (and (memq (length model) '(3 4))
- (not (math-objvecp (nth 1 model)))
- (math-vectorp (nth 2 model))
- (or (null (nth 3 model))
- (math-vectorp (nth 3 model))))
- (setq varnames (nth 2 model)
- coefnames (or (nth 3 model)
- (cons 'vec
- (math-all-vars-but
- model varnames)))
- model (nth 1 model))
- (error "Incorrect model specifier")))))
- (or varnames
- (let ((with-y (eq (car-safe model) 'calcFunc-eq)))
- (if coefnames
- (calc-get-fit-variables (if with-y (1+ nvars) nvars)
- (1- (length coefnames))
- (math-all-vars-but
- model coefnames)
- nil with-y)
- (let* ((coefs (math-all-vars-but model nil))
- (vars nil)
- (n (- (length coefs) nvars (if with-y 2 1)))
- p)
- (if (< n 0)
- (error "Not enough variables in model"))
- (setq p (nthcdr n coefs))
- (setq vars (cdr p))
- (setcdr p nil)
- (calc-get-fit-variables (if with-y (1+ nvars) nvars)
- (length coefs)
- vars coefs with-y)))))
- (if record-entry
- (calc-record (list 'vec model varnames coefnames)
- "modl"))))
- (t (beep))))
- (let ((calc-fit-to-trail t))
- (calc-enter-result n (substring (symbol-name func) 9)
- (list func model
- (if (= (length varnames) 2)
- (nth 1 varnames)
- varnames)
- (if (= (length coefnames) 2)
- (nth 1 coefnames)
- coefnames)
- data))
- (if (consp calc-fit-to-trail)
- (calc-record (calc-normalize calc-fit-to-trail) "parm"))))))
-
-(defun calc-invent-independent-variables (n &optional but)
- (calc-invent-variables n but '(x y z t) "x"))
-
-(defun calc-invent-parameter-variables (n &optional but)
- (calc-invent-variables n but '(a b c d) "a"))
-
-(defun calc-invent-variables (num but names base)
- (let ((vars nil)
- (n num) (nn 0)
- var)
- (while (and (> n 0) names)
- (setq var (math-build-var-name (if (consp names)
- (car names)
- (concat base (int-to-string
- (setq nn (1+ nn)))))))
- (or (math-expr-contains (cons 'vec but) var)
- (setq vars (cons var vars)
- n (1- n)))
- (or (symbolp names) (setq names (cdr names))))
- (if (= n 0)
- (nreverse vars)
- (calc-invent-variables num but t base))))
-
-(defun calc-get-fit-variables (nv nc &optional defv defc with-y homog)
- (or (= nv (if with-y (1+ nvars) nvars))
- (error "Wrong number of data vectors for this type of model"))
- (if (integerp defv)
- (setq homog defv
- defv nil))
- (if homog
- (setq nc (1- nc)))
- (or defv
- (setq defv (calc-invent-independent-variables nv)))
- (or defc
- (setq defc (calc-invent-parameter-variables nc defv)))
- (let ((vars (read-string (format "Fitting variables: (default %s; %s) "
- (mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
- defv)
- ",")
- (mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
- defc)
- ","))))
- (coefs nil))
- (setq vars (if (string-match "\\[" vars)
- (math-read-expr vars)
- (math-read-expr (concat "[" vars "]"))))
- (if (eq (car-safe vars) 'error)
- (error "Bad format in expression: %s" (nth 2 vars)))
- (or (math-vectorp vars)
- (error "Expected a variable or vector of variables"))
- (if (equal vars '(vec))
- (setq vars (cons 'vec defv)
- coefs (cons 'vec defc))
- (if (math-vectorp (nth 1 vars))
- (if (and (= (length vars) 3)
- (math-vectorp (nth 2 vars)))
- (setq coefs (nth 2 vars)
- vars (nth 1 vars))
- (error
- "Expected independent variables vector, then parameters vector"))
- (setq coefs (cons 'vec defc))))
- (or (= nv (1- (length vars)))
- (and (not with-y) (= (1+ nv) (1- (length vars))))
- (error "Expected %d independent variable%s" nv (if (= nv 1) "" "s")))
- (or (= nc (1- (length coefs)))
- (error "Expected %d parameter variable%s" nc (if (= nc 1) "" "s")))
- (if homog
- (setq coefs (cons 'vec (cons homog (cdr coefs)))))
- (if varnames
- (setq model (math-multi-subst model (cdr varnames) (cdr vars))))
- (if coefnames
- (setq model (math-multi-subst model (cdr coefnames) (cdr coefs))))
- (setq varnames vars
- coefnames coefs)))
-
-
-
-
-;;; The following algorithms are from Numerical Recipes chapter 9.
-
-;;; "rtnewt" with safety kludges
-(defun math-newton-root (expr deriv guess orig-guess limit)
- (math-working "newton" guess)
- (let* ((var-DUMMY guess)
- next dval)
- (setq next (math-evaluate-expr expr)
- dval (math-evaluate-expr deriv))
- (if (and (Math-numberp next)
- (Math-numberp dval)
- (not (Math-zerop dval)))
- (progn
- (setq next (math-sub guess (math-div next dval)))
- (if (math-nearly-equal guess (setq next (math-float next)))
- (progn
- (setq var-DUMMY next)
- (list 'vec next (math-evaluate-expr expr)))
- (if (Math-lessp (math-abs-approx (math-sub next orig-guess))
- limit)
- (math-newton-root expr deriv next orig-guess limit)
- (math-reject-arg next "*Newton's method failed to converge"))))
- (math-reject-arg next "*Newton's method encountered a singularity"))))
-
-;;; Inspired by "rtsafe"
-(defun math-newton-search-root (expr deriv guess vguess ostep oostep
- low vlow high vhigh)
- (let ((var-DUMMY guess)
- (better t)
- pos step next vnext)
- (if guess
- (math-working "newton" (list 'intv 0 low high))
- (math-working "bisect" (list 'intv 0 low high))
- (setq ostep (math-mul-float (math-sub-float high low)
- '(float 5 -1))
- guess (math-add-float low ostep)
- var-DUMMY guess
- vguess (math-evaluate-expr expr))
- (or (Math-realp vguess)
- (progn
- (setq ostep (math-mul-float ostep '(float 6 -1))
- guess (math-add-float low ostep)
- var-DUMMY guess
- vguess (math-evaluate-expr expr))
- (or (math-realp vguess)
- (progn
- (setq ostep (math-mul-float ostep '(float 123456 -5))
- guess (math-add-float low ostep)
- var-DUMMY guess
- vguess nil))))))
- (or vguess
- (setq vguess (math-evaluate-expr expr)))
- (or (Math-realp vguess)
- (math-reject-arg guess "*Newton's method encountered a singularity"))
- (setq vguess (math-float vguess))
- (if (eq (Math-negp vlow) (setq pos (Math-posp vguess)))
- (setq high guess
- vhigh vguess)
- (if (eq (Math-negp vhigh) pos)
- (setq low guess
- vlow vguess)
- (setq better nil)))
- (if (or (Math-zerop vguess)
- (math-nearly-equal low high))
- (list 'vec guess vguess)
- (setq step (math-evaluate-expr deriv))
- (if (and (Math-realp step)
- (not (Math-zerop step))
- (setq step (math-div-float vguess (math-float step))
- next (math-sub-float guess step))
- (not (math-lessp-float high next))
- (not (math-lessp-float next low)))
- (progn
- (setq var-DUMMY next
- vnext (math-evaluate-expr expr))
- (if (or (Math-zerop vnext)
- (math-nearly-equal next guess))
- (list 'vec next vnext)
- (if (and better
- (math-lessp-float (math-abs (or oostep
- (math-sub-float
- high low)))
- (math-abs
- (math-mul-float '(float 2 0)
- step))))
- (math-newton-search-root expr deriv nil nil nil ostep
- low vlow high vhigh)
- (math-newton-search-root expr deriv next vnext step ostep
- low vlow high vhigh))))
- (if (or (and (Math-posp vlow) (Math-posp vhigh))
- (and (Math-negp vlow) (Math-negp vhigh)))
- (math-search-root expr deriv low vlow high vhigh)
- (math-newton-search-root expr deriv nil nil nil ostep
- low vlow high vhigh))))))
-
-;;; Search for a root in an interval with no overt zero crossing.
-(defun math-search-root (expr deriv low vlow high vhigh)
- (let (found)
- (if root-widen
- (let ((iters 0)
- (iterlim (if (eq root-widen 'point)
- (+ calc-internal-prec 10)
- 20))
- (factor (if (eq root-widen 'point)
- '(float 9 0)
- '(float 16 -1)))
- (prev nil) vprev waslow
- diff)
- (while (or (and (math-posp vlow) (math-posp vhigh))
- (and (math-negp vlow) (math-negp vhigh)))
- (math-working "widen" (list 'intv 0 low high))
- (if (> (setq iters (1+ iters)) iterlim)
- (math-reject-arg (list 'intv 0 low high)
- "*Unable to bracket root"))
- (if (= iters calc-internal-prec)
- (setq factor '(float 16 -1)))
- (setq diff (math-mul-float (math-sub-float high low) factor))
- (if (Math-zerop diff)
- (setq high (calcFunc-incr high 10))
- (if (math-lessp-float (math-abs vlow) (math-abs vhigh))
- (setq waslow t
- prev low
- low (math-sub low diff)
- var-DUMMY low
- vprev vlow
- vlow (math-evaluate-expr expr))
- (setq waslow nil
- prev high
- high (math-add high diff)
- var-DUMMY high
- vprev vhigh
- vhigh (math-evaluate-expr expr)))))
- (if prev
- (if waslow
- (setq high prev vhigh vprev)
- (setq low prev vlow vprev)))
- (setq found t))
- (or (Math-realp vlow)
- (math-reject-arg vlow 'realp))
- (or (Math-realp vhigh)
- (math-reject-arg vhigh 'realp))
- (let ((xvals (list low high))
- (yvals (list vlow vhigh))
- (pos (Math-posp vlow))
- (levels 0)
- (step (math-sub-float high low))
- xp yp var-DUMMY)
- (while (and (<= (setq levels (1+ levels)) 5)
- (not found))
- (setq xp xvals
- yp yvals
- step (math-mul-float step '(float 497 -3)))
- (while (and (cdr xp) (not found))
- (if (Math-realp (car yp))
- (setq low (car xp)
- vlow (car yp)))
- (setq high (math-add-float (car xp) step)
- var-DUMMY high
- vhigh (math-evaluate-expr expr))
- (math-working "search" high)
- (if (and (Math-realp vhigh)
- (eq (math-negp vhigh) pos))
- (setq found t)
- (setcdr xp (cons high (cdr xp)))
- (setcdr yp (cons vhigh (cdr yp)))
- (setq xp (cdr (cdr xp))
- yp (cdr (cdr yp))))))))
- (if found
- (if (Math-zerop vhigh)
- (list 'vec high vhigh)
- (if (Math-zerop vlow)
- (list 'vec low vlow)
- (if deriv
- (math-newton-search-root expr deriv nil nil nil nil
- low vlow high vhigh)
- (math-bisect-root expr low vlow high vhigh))))
- (math-reject-arg (list 'intv 3 low high)
- "*Unable to find a sign change in this interval"))))
-
-;;; "rtbis" (but we should be using Brent's method)
-(defun math-bisect-root (expr low vlow high vhigh)
- (let ((step (math-sub-float high low))
- (pos (Math-posp vhigh))
- var-DUMMY
- mid vmid)
- (while (not (or (math-nearly-equal low
- (setq step (math-mul-float
- step '(float 5 -1))
- mid (math-add-float low step)))
- (progn
- (setq var-DUMMY mid
- vmid (math-evaluate-expr expr))
- (Math-zerop vmid))))
- (math-working "bisect" mid)
- (if (eq (Math-posp vmid) pos)
- (setq high mid
- vhigh vmid)
- (setq low mid
- vlow vmid)))
- (list 'vec mid vmid)))
-
-;;; "mnewt"
-(defun math-newton-multi (expr jacob n guess orig-guess limit)
- (let ((m -1)
- (p guess)
- p2 expr-val jacob-val next)
- (while (< (setq p (cdr p) m (1+ m)) n)
- (set (nth 2 (aref math-root-vars m)) (car p)))
- (setq expr-val (math-evaluate-expr expr)
- jacob-val (math-evaluate-expr jacob))
- (unless (and (math-constp expr-val)
- (math-constp jacob-val))
- (math-reject-arg guess "*Newton's method encountered a singularity"))
- (setq next (math-add guess (math-div (math-float (math-neg expr-val))
- (math-float jacob-val)))
- p guess p2 next)
- (math-working "newton" next)
- (while (and (setq p (cdr p) p2 (cdr p2))
- (math-nearly-equal (car p) (car p2))))
- (if p
- (if (Math-lessp (math-abs-approx (math-sub next orig-guess))
- limit)
- (math-newton-multi expr jacob n next orig-guess limit)
- (math-reject-arg nil "*Newton's method failed to converge"))
- (list 'vec next expr-val))))
-
-(defvar math-root-vars [(var DUMMY var-DUMMY)])
-
-(defun math-find-root (expr var guess root-widen)
- (if (eq (car-safe expr) 'vec)
- (let ((n (1- (length expr)))
- (calc-symbolic-mode nil)
- (var-DUMMY nil)
- (jacob (list 'vec))
- p p2 m row)
- (unless (eq (car-safe var) 'vec)
- (math-reject-arg var 'vectorp))
- (unless (= (length var) (1+ n))
- (math-dimension-error))
- (setq expr (copy-sequence expr))
- (while (>= n (length math-root-vars))
- (let ((symb (intern (concat "math-root-v"
- (int-to-string
- (length math-root-vars))))))
- (setq math-root-vars (vconcat math-root-vars
- (vector (list 'var symb symb))))))
- (setq m -1)
- (while (< (setq m (1+ m)) n)
- (set (nth 2 (aref math-root-vars m)) nil))
- (setq m -1 p var)
- (while (setq m (1+ m) p (cdr p))
- (or (eq (car-safe (car p)) 'var)
- (math-reject-arg var "*Expected a variable"))
- (setq p2 expr)
- (while (setq p2 (cdr p2))
- (setcar p2 (math-expr-subst (car p2) (car p)
- (aref math-root-vars m)))))
- (unless (eq (car-safe guess) 'vec)
- (math-reject-arg guess 'vectorp))
- (unless (= (length guess) (1+ n))
- (math-dimension-error))
- (setq guess (copy-sequence guess)
- p guess)
- (while (setq p (cdr p))
- (or (Math-numberp (car guess))
- (math-reject-arg guess 'numberp))
- (setcar p (math-float (car p))))
- (setq p expr)
- (while (setq p (cdr p))
- (if (assq (car-safe (car p)) calc-tweak-eqn-table)
- (setcar p (math-sub (nth 1 (car p)) (nth 2 (car p)))))
- (setcar p (math-evaluate-expr (car p)))
- (setq row (list 'vec)
- m -1)
- (while (< (setq m (1+ m)) n)
- (nconc row (list (math-evaluate-expr
- (or (calcFunc-deriv (car p)
- (aref math-root-vars m)
- nil t)
- (math-reject-arg
- expr
- "*Formulas must be differentiable"))))))
- (nconc jacob (list row)))
- (setq m (math-abs-approx guess))
- (math-newton-multi expr jacob n guess guess
- (if (math-zerop m) '(float 1 3) (math-mul m 10))))
- (unless (eq (car-safe var) 'var)
- (math-reject-arg var "*Expected a variable"))
- (unless (math-expr-contains expr var)
- (math-reject-arg expr "*Formula does not contain specified variable"))
- (if (assq (car expr) calc-tweak-eqn-table)
- (setq expr (math-sub (nth 1 expr) (nth 2 expr))))
- (math-with-extra-prec 2
- (setq expr (math-expr-subst expr var '(var DUMMY var-DUMMY)))
- (let* ((calc-symbolic-mode nil)
- (var-DUMMY nil)
- (expr (math-evaluate-expr expr))
- (deriv (calcFunc-deriv expr '(var DUMMY var-DUMMY) nil t))
- low high vlow vhigh)
- (and deriv (setq deriv (math-evaluate-expr deriv)))
- (setq guess (math-float guess))
- (if (and (math-numberp guess)
- deriv)
- (math-newton-root expr deriv guess guess
- (if (math-zerop guess) '(float 1 6)
- (math-mul (math-abs-approx guess) 100)))
- (if (Math-realp guess)
- (setq low guess
- high guess
- var-DUMMY guess
- vlow (math-evaluate-expr expr)
- vhigh vlow
- root-widen 'point)
- (if (eq (car guess) 'intv)
- (progn
- (or (math-constp guess) (math-reject-arg guess 'constp))
- (setq low (nth 2 guess)
- high (nth 3 guess))
- (if (memq (nth 1 guess) '(0 1))
- (setq low (calcFunc-incr low 1 high)))
- (if (memq (nth 1 guess) '(0 2))
- (setq high (calcFunc-incr high -1 low)))
- (setq var-DUMMY low
- vlow (math-evaluate-expr expr)
- var-DUMMY high
- vhigh (math-evaluate-expr expr)))
- (if (math-complexp guess)
- (math-reject-arg "*Complex root finder must have derivative")
- (math-reject-arg guess 'realp))))
- (if (Math-zerop vlow)
- (list 'vec low vlow)
- (if (Math-zerop vhigh)
- (list 'vec high vhigh)
- (if (and deriv (Math-numberp vlow) (Math-numberp vhigh))
- (math-newton-search-root expr deriv nil nil nil nil
- low vlow high vhigh)
- (if (or (and (Math-posp vlow) (Math-posp vhigh))
- (and (Math-negp vlow) (Math-negp vhigh))
- (not (Math-numberp vlow))
- (not (Math-numberp vhigh)))
- (math-search-root expr deriv low vlow high vhigh)
- (math-bisect-root expr low vlow high vhigh))))))))))
-
-(defun calcFunc-root (expr var guess)
- (math-find-root expr var guess nil))
-
-(defun calcFunc-wroot (expr var guess)
- (math-find-root expr var guess t))
-
-
-
-
-;;; The following algorithms come from Numerical Recipes, chapter 10.
-
-(defun math-min-eval (expr a)
- (if (Math-vectorp a)
- (let ((m -1))
- (while (setq m (1+ m) a (cdr a))
- (set (nth 2 (aref math-min-vars m)) (car a))))
- (setq var-DUMMY a))
- (setq a (math-evaluate-expr expr))
- (if (Math-ratp a)
- (math-float a)
- (if (eq (car a) 'float)
- a
- (math-reject-arg a 'realp))))
-
-(defvar math-min-or-max "minimum")
-
-;;; A bracket for a minimum is a < b < c where f(b) < f(a) and f(b) < f(c).
-
-;;; "mnbrak"
-(defun math-widen-min (expr a b)
- (let ((done nil)
- (iters 30)
- incr c va vb vc u vu r q ulim bc ba qr)
- (or b (setq b (math-mul a '(float 101 -2))))
- (setq va (math-min-eval expr a)
- vb (math-min-eval expr b))
- (if (math-lessp-float va vb)
- (setq u a a b b u
- vu va va vb vb vu))
- (setq c (math-add-float b (math-mul-float '(float 161803 -5)
- (math-sub-float b a)))
- vc (math-min-eval expr c))
- (while (and (not done) (math-lessp-float vc vb))
- (math-working "widen" (list 'intv 0 a c))
- (if (= (setq iters (1- iters)) 0)
- (math-reject-arg nil (format "*Unable to find a %s near the interval"
- math-min-or-max)))
- (setq bc (math-sub-float b c)
- ba (math-sub-float b a)
- r (math-mul-float ba (math-sub-float vb vc))
- q (math-mul-float bc (math-sub-float vb va))
- qr (math-sub-float q r))
- (if (math-lessp-float (math-abs qr) '(float 1 -20))
- (setq qr (if (math-negp qr) '(float -1 -20) '(float 1 -20))))
- (setq u (math-sub-float
- b
- (math-div-float (math-sub-float (math-mul-float bc q)
- (math-mul-float ba r))
- (math-mul-float '(float 2 0) qr)))
- ulim (math-add-float b (math-mul-float '(float -1 2) bc))
- incr (math-negp bc))
- (if (if incr (math-lessp-float b u) (math-lessp-float u b))
- (if (if incr (math-lessp-float u c) (math-lessp-float c u))
- (if (math-lessp-float (setq vu (math-min-eval expr u)) vc)
- (setq a b va vb
- b u vb vu
- done t)
- (if (math-lessp-float vb vu)
- (setq c u vc vu
- done t)
- (setq u (math-add-float c (math-mul-float '(float -161803 -5)
- bc))
- vu (math-min-eval expr u))))
- (if (if incr (math-lessp-float u ulim) (math-lessp-float ulim u))
- (if (math-lessp-float (setq vu (math-min-eval expr u)) vc)
- (setq b c vb vc
- c u vc vu
- u (math-add-float c (math-mul-float
- '(float -161803 -5)
- (math-sub-float b c)))
- vu (math-min-eval expr u)))
- (setq u ulim
- vu (math-min-eval expr u))))
- (setq u (math-add-float c (math-mul-float '(float -161803 -5)
- bc))
- vu (math-min-eval expr u)))
- (setq a b va vb
- b c vb vc
- c u vc vu))
- (if (math-lessp-float a c)
- (list a va b vb c vc)
- (list c vc b vb a va))))
-
-(defun math-narrow-min (expr a c intv)
- (let ((xvals (list a c))
- (yvals (list (math-min-eval expr a)
- (math-min-eval expr c)))
- (levels 0)
- (step (math-sub-float c a))
- (found nil)
- xp yp b)
- (while (and (<= (setq levels (1+ levels)) 5)
- (not found))
- (setq xp xvals
- yp yvals
- step (math-mul-float step '(float 497 -3)))
- (while (and (cdr xp) (not found))
- (setq b (math-add-float (car xp) step))
- (math-working "search" b)
- (setcdr xp (cons b (cdr xp)))
- (setcdr yp (cons (math-min-eval expr b) (cdr yp)))
- (if (and (math-lessp-float (nth 1 yp) (car yp))
- (math-lessp-float (nth 1 yp) (nth 2 yp)))
- (setq found t)
- (setq xp (cdr xp)
- yp (cdr yp))
- (if (and (cdr (cdr yp))
- (math-lessp-float (nth 1 yp) (car yp))
- (math-lessp-float (nth 1 yp) (nth 2 yp)))
- (setq found t)
- (setq xp (cdr xp)
- yp (cdr yp))))))
- (if found
- (list (car xp) (car yp)
- (nth 1 xp) (nth 1 yp)
- (nth 2 xp) (nth 2 yp))
- (or (if (math-lessp-float (car yvals) (nth 1 yvals))
- (and (memq (nth 1 intv) '(2 3))
- (let ((min (car yvals)))
- (while (and (setq yvals (cdr yvals))
- (math-lessp-float min (car yvals))))
- (and (not yvals)
- (list (nth 2 intv) min))))
- (and (memq (nth 1 intv) '(1 3))
- (setq yvals (nreverse yvals))
- (let ((min (car yvals)))
- (while (and (setq yvals (cdr yvals))
- (math-lessp-float min (car yvals))))
- (and (not yvals)
- (list (nth 3 intv) min)))))
- (math-reject-arg nil (format "*Unable to find a %s in the interval"
- math-min-or-max))))))
-
-;;; "brent"
-(defun math-brent-min (expr prec a va x vx b vb)
- (let ((iters (+ 20 (* 5 prec)))
- (w x)
- (vw vx)
- (v x)
- (vv vx)
- (tol (list 'float 1 (- -1 prec)))
- (zeps (list 'float 1 (- -5 prec)))
- (e '(float 0 0))
- u vu xm tol1 tol2 etemp p q r xv xw)
- (while (progn
- (setq xm (math-mul-float '(float 5 -1)
- (math-add-float a b))
- tol1 (math-add-float
- zeps
- (math-mul-float tol (math-abs x)))
- tol2 (math-mul-float tol1 '(float 2 0)))
- (math-lessp-float (math-sub-float tol2
- (math-mul-float
- '(float 5 -1)
- (math-sub-float b a)))
- (math-abs (math-sub-float x xm))))
- (if (= (setq iters (1- iters)) 0)
- (math-reject-arg nil (format "*Unable to converge on a %s"
- math-min-or-max)))
- (math-working "brent" x)
- (if (math-lessp-float (math-abs e) tol1)
- (setq e (if (math-lessp-float x xm)
- (math-sub-float b x)
- (math-sub-float a x))
- d (math-mul-float '(float 381966 -6) e))
- (setq xw (math-sub-float x w)
- r (math-mul-float xw (math-sub-float vx vv))
- xv (math-sub-float x v)
- q (math-mul-float xv (math-sub-float vx vw))
- p (math-sub-float (math-mul-float xv q)
- (math-mul-float xw r))
- q (math-mul-float '(float 2 0) (math-sub-float q r)))
- (if (math-posp q)
- (setq p (math-neg-float p))
- (setq q (math-neg-float q)))
- (setq etemp e
- e d)
- (if (and (math-lessp-float (math-abs p)
- (math-abs (math-mul-float
- '(float 5 -1)
- (math-mul-float q etemp))))
- (math-lessp-float (math-mul-float
- q (math-sub-float a x)) p)
- (math-lessp-float p (math-mul-float
- q (math-sub-float b x))))
- (progn
- (setq d (math-div-float p q)
- u (math-add-float x d))
- (if (or (math-lessp-float (math-sub-float u a) tol2)
- (math-lessp-float (math-sub-float b u) tol2))
- (setq d (if (math-lessp-float xm x)
- (math-neg-float tol1)
- tol1))))
- (setq e (if (math-lessp-float x xm)
- (math-sub-float b x)
- (math-sub-float a x))
- d (math-mul-float '(float 381966 -6) e))))
- (setq u (math-add-float x
- (if (math-lessp-float (math-abs d) tol1)
- (if (math-negp d)
- (math-neg-float tol1)
- tol1)
- d))
- vu (math-min-eval expr u))
- (if (math-lessp-float vx vu)
- (progn
- (if (math-lessp-float u x)
- (setq a u)
- (setq b u))
- (if (or (equal w x)
- (not (math-lessp-float vw vu)))
- (setq v w vv vw
- w u vw vu)
- (if (or (equal v x)
- (equal v w)
- (not (math-lessp-float vv vu)))
- (setq v u vv vu))))
- (if (math-lessp-float u x)
- (setq b x)
- (setq a x))
- (setq v w vv vw
- w x vw vx
- x u vx vu)))
- (list 'vec x vx)))
-
-;;; "powell"
-(defun math-powell-min (expr n guesses prec)
- (let* ((f1dim (math-line-min-func expr n))
- (xi (calcFunc-idn 1 n))
- (p (cons 'vec (mapcar 'car guesses)))
- (pt p)
- (ftol (list 'float 1 (- prec)))
- (fret (math-min-eval expr p))
- fp ptt fptt xit i ibig del diff res)
- (while (progn
- (setq fp fret
- ibig 0
- del '(float 0 0)
- i 0)
- (while (<= (setq i (1+ i)) n)
- (setq fptt fret
- res (math-line-min f1dim p
- (math-mat-col xi i)
- n prec)
- p (let ((calc-internal-prec prec))
- (math-normalize (car res)))
- fret (nth 2 res)
- diff (math-abs (math-sub-float fptt fret)))
- (if (math-lessp-float del diff)
- (setq del diff
- ibig i)))
- (math-lessp-float
- (math-mul-float ftol
- (math-add-float (math-abs fp)
- (math-abs fret)))
- (math-mul-float '(float 2 0)
- (math-abs (math-sub-float fp
- fret)))))
- (setq ptt (math-sub (math-mul '(float 2 0) p) pt)
- xit (math-sub p pt)
- pt p
- fptt (math-min-eval expr ptt))
- (if (and (math-lessp-float fptt fp)
- (math-lessp-float
- (math-mul-float
- (math-mul-float '(float 2 0)
- (math-add-float
- (math-sub-float fp
- (math-mul-float '(float 2 0)
- fret))
- fptt))
- (math-sqr-float (math-sub-float
- (math-sub-float fp fret) del)))
- (math-mul-float del
- (math-sqr-float (math-sub-float fp fptt)))))
- (progn
- (setq res (math-line-min f1dim p xit n prec)
- p (car res)
- fret (nth 2 res)
- i 0)
- (while (<= (setq i (1+ i)) n)
- (setcar (nthcdr ibig (nth i xi))
- (nth i (nth 1 res)))))))
- (list 'vec p fret)))
-
-(defun math-line-min-func (expr n)
- (let ((m -1))
- (while (< (setq m (1+ m)) n)
- (set (nth 2 (aref math-min-vars m))
- (list '+
- (list '*
- '(var DUMMY var-DUMMY)
- (list 'calcFunc-mrow '(var line-xi line-xi) (1+ m)))
- (list 'calcFunc-mrow '(var line-p line-p) (1+ m)))))
- (math-evaluate-expr expr)))
-
-(defun math-line-min (f1dim line-p line-xi n prec)
- (let* ((var-DUMMY nil)
- (expr (math-evaluate-expr f1dim))
- (params (math-widen-min expr '(float 0 0) '(float 1 0)))
- (res (apply 'math-brent-min expr prec params))
- (xi (math-mul (nth 1 res) line-xi)))
- (list (math-add line-p xi) xi (nth 2 res))))
-
-
-(defvar math-min-vars [(var DUMMY var-DUMMY)])
-
-(defun math-find-minimum (expr var guess min-widen)
- (let* ((calc-symbolic-mode nil)
- (n 0)
- (var-DUMMY nil)
- (isvec (math-vectorp var))
- g guesses)
- (or (math-vectorp var)
- (setq var (list 'vec var)))
- (or (math-vectorp guess)
- (setq guess (list 'vec guess)))
- (or (= (length var) (length guess))
- (math-dimension-error))
- (while (setq var (cdr var) guess (cdr guess))
- (or (eq (car-safe (car var)) 'var)
- (math-reject-arg (car vg) "*Expected a variable"))
- (or (math-expr-contains expr (car var))
- (math-reject-arg (car var)
- "*Formula does not contain specified variable"))
- (while (>= (1+ n) (length math-min-vars))
- (let ((symb (intern (concat "math-min-v"
- (int-to-string
- (length math-min-vars))))))
- (setq math-min-vars (vconcat math-min-vars
- (vector (list 'var symb symb))))))
- (set (nth 2 (aref math-min-vars n)) nil)
- (set (nth 2 (aref math-min-vars (1+ n))) nil)
- (if (math-complexp (car guess))
- (setq expr (math-expr-subst expr
- (car var)
- (list '+ (aref math-min-vars n)
- (list '*
- (aref math-min-vars (1+ n))
- '(cplx 0 1))))
- guesses (let ((g (math-float (math-complex (car guess)))))
- (cons (list (nth 2 g) nil nil)
- (cons (list (nth 1 g) nil nil t)
- guesses)))
- n (+ n 2))
- (setq expr (math-expr-subst expr
- (car var)
- (aref math-min-vars n))
- guesses (cons (if (math-realp (car guess))
- (list (math-float (car guess)) nil nil)
- (if (and (eq (car-safe (car guess)) 'intv)
- (math-constp (car guess)))
- (list (math-mul
- (math-add (nth 2 (car guess))
- (nth 3 (car guess)))
- '(float 5 -1))
- (math-float (nth 2 (car guess)))
- (math-float (nth 3 (car guess)))
- (car guess))
- (math-reject-arg (car guess) 'realp)))
- guesses)
- n (1+ n))))
- (setq guesses (nreverse guesses)
- expr (math-evaluate-expr expr))
- (if (= n 1)
- (let* ((params (if (nth 1 (car guesses))
- (if min-widen
- (math-widen-min expr
- (nth 1 (car guesses))
- (nth 2 (car guesses)))
- (math-narrow-min expr
- (nth 1 (car guesses))
- (nth 2 (car guesses))
- (nth 3 (car guesses))))
- (math-widen-min expr
- (car (car guesses))
- nil)))
- (prec calc-internal-prec)
- (res (if (cdr (cdr params))
- (math-with-extra-prec (+ calc-internal-prec 2)
- (apply 'math-brent-min expr prec params))
- (cons 'vec params))))
- (if isvec
- (list 'vec (list 'vec (nth 1 res)) (nth 2 res))
- res))
- (let* ((prec calc-internal-prec)
- (res (math-with-extra-prec (+ calc-internal-prec 2)
- (math-powell-min expr n guesses prec)))
- (p (nth 1 res))
- (vec (list 'vec)))
- (while (setq p (cdr p))
- (if (nth 3 (car guesses))
- (progn
- (nconc vec (list (math-normalize
- (list 'cplx (car p) (nth 1 p)))))
- (setq p (cdr p)
- guesses (cdr guesses)))
- (nconc vec (list (car p))))
- (setq guesses (cdr guesses)))
- (if isvec
- (list 'vec vec (nth 2 res))
- (list 'vec (nth 1 vec) (nth 2 res)))))))
-
-(defun calcFunc-minimize (expr var guess)
- (let ((calc-internal-prec (max (/ calc-internal-prec 2) 3))
- (math-min-or-max "minimum"))
- (math-find-minimum (math-normalize expr)
- (math-normalize var)
- (math-normalize guess) nil)))
-
-(defun calcFunc-wminimize (expr var guess)
- (let ((calc-internal-prec (max (/ calc-internal-prec 2) 3))
- (math-min-or-max "minimum"))
- (math-find-minimum (math-normalize expr)
- (math-normalize var)
- (math-normalize guess) t)))
-
-(defun calcFunc-maximize (expr var guess)
- (let* ((calc-internal-prec (max (/ calc-internal-prec 2) 3))
- (math-min-or-max "maximum")
- (res (math-find-minimum (math-normalize (math-neg expr))
- (math-normalize var)
- (math-normalize guess) nil)))
- (list 'vec (nth 1 res) (math-neg (nth 2 res)))))
-
-(defun calcFunc-wmaximize (expr var guess)
- (let* ((calc-internal-prec (max (/ calc-internal-prec 2) 3))
- (math-min-or-max "maximum")
- (res (math-find-minimum (math-normalize (math-neg expr))
- (math-normalize var)
- (math-normalize guess) t)))
- (list 'vec (nth 1 res) (math-neg (nth 2 res)))))
-
-
-
-
-;;; The following algorithms come from Numerical Recipes, chapter 3.
-
-(defun calcFunc-polint (data x)
- (or (math-matrixp data) (math-reject-arg data 'matrixp))
- (or (= (length data) 3)
- (math-reject-arg data "*Wrong number of data rows"))
- (or (> (length (nth 1 data)) 2)
- (math-reject-arg data "*Too few data points"))
- (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-polint data x)))
- (cdr x)))
- (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
- (math-with-extra-prec 2
- (cons 'vec (math-poly-interp (cdr (nth 1 data)) (cdr (nth 2 data)) x
- nil)))))
-(put 'calcFunc-polint 'math-expandable t)
-
-
-(defun calcFunc-ratint (data x)
- (or (math-matrixp data) (math-reject-arg data 'matrixp))
- (or (= (length data) 3)
- (math-reject-arg data "*Wrong number of data rows"))
- (or (> (length (nth 1 data)) 2)
- (math-reject-arg data "*Too few data points"))
- (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-ratint data x)))
- (cdr x)))
- (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
- (math-with-extra-prec 2
- (cons 'vec (math-poly-interp (cdr (nth 1 data)) (cdr (nth 2 data)) x
- (cdr (cdr (cdr (nth 1 data)))))))))
-(put 'calcFunc-ratint 'math-expandable t)
-
-
-(defun math-poly-interp (xa ya x ratp)
- (let ((n (length xa))
- (dif nil)
- (ns nil)
- (xax nil)
- (c (copy-sequence ya))
- (d (copy-sequence ya))
- (i 0)
- (m 0)
- y dy (xp xa) xpm cp dp temp)
- (while (<= (setq i (1+ i)) n)
- (setq xax (cons (math-sub (car xp) x) xax)
- xp (cdr xp)
- temp (math-abs (car xax)))
- (if (or (null dif) (math-lessp temp dif))
- (setq dif temp
- ns i)))
- (setq xax (nreverse xax)
- ns (1- ns)
- y (nth ns ya))
- (if (math-zerop dif)
- (list y 0)
- (while (< (setq m (1+ m)) n)
- (setq i 0
- xp xax
- xpm (nthcdr m xax)
- cp c
- dp d)
- (while (<= (setq i (1+ i)) (- n m))
- (if ratp
- (let ((t2 (math-div (math-mul (car xp) (car dp)) (car xpm))))
- (setq temp (math-div (math-sub (nth 1 cp) (car dp))
- (math-sub t2 (nth 1 cp))))
- (setcar dp (math-mul (nth 1 cp) temp))
- (setcar cp (math-mul t2 temp)))
- (if (math-equal (car xp) (car xpm))
- (math-reject-arg (cons 'vec xa) "*Duplicate X values"))
- (setq temp (math-div (math-sub (nth 1 cp) (car dp))
- (math-sub (car xp) (car xpm))))
- (setcar dp (math-mul (car xpm) temp))
- (setcar cp (math-mul (car xp) temp)))
- (setq cp (cdr cp)
- dp (cdr dp)
- xp (cdr xp)
- xpm (cdr xpm)))
- (if (< (+ ns ns) (- n m))
- (setq dy (nth ns c))
- (setq ns (1- ns)
- dy (nth ns d)))
- (setq y (math-add y dy)))
- (list y dy))))
-
-
-
-;;; The following algorithms come from Numerical Recipes, chapter 4.
-
-(defun calcFunc-ninteg (expr var lo hi)
- (setq lo (math-evaluate-expr lo)
- hi (math-evaluate-expr hi))
- (or (math-numberp lo) (math-infinitep lo) (math-reject-arg lo 'numberp))
- (or (math-numberp hi) (math-infinitep hi) (math-reject-arg hi 'numberp))
- (if (math-lessp hi lo)
- (math-neg (calcFunc-ninteg expr var hi lo))
- (setq expr (math-expr-subst expr var '(var DUMMY var-DUMMY)))
- (let ((var-DUMMY nil)
- (calc-symbolic-mode nil)
- (calc-prefer-frac nil)
- (sum 0))
- (setq expr (math-evaluate-expr expr))
- (if (equal lo '(neg (var inf var-inf)))
- (let ((thi (if (math-lessp hi '(float -2 0))
- hi '(float -2 0))))
- (setq sum (math-ninteg-romberg
- 'math-ninteg-midpoint expr
- (math-float lo) (math-float thi) 'inf)
- lo thi)))
- (if (equal hi '(var inf var-inf))
- (let ((tlo (if (math-lessp '(float 2 0) lo)
- lo '(float 2 0))))
- (setq sum (math-add sum
- (math-ninteg-romberg
- 'math-ninteg-midpoint expr
- (math-float tlo) (math-float hi) 'inf))
- hi tlo)))
- (or (math-equal lo hi)
- (setq sum (math-add sum
- (math-ninteg-romberg
- 'math-ninteg-midpoint expr
- (math-float lo) (math-float hi) nil))))
- sum)))
-
-
-;;; Open Romberg method; "qromo" in section 4.4.
-(defun math-ninteg-romberg (func expr lo hi mode)
- (let ((curh '(float 1 0))
- (h nil)
- (s nil)
- (j 0)
- (ss nil)
- (prec calc-internal-prec)
- (integ-temp nil))
- (math-with-extra-prec 2
- ;; Limit on "j" loop must be 14 or less to keep "it" from overflowing.
- (or (while (and (null ss) (<= (setq j (1+ j)) 8))
- (setq s (nconc s (list (funcall func expr lo hi mode)))
- h (nconc h (list curh)))
- (if (>= j 3)
- (let ((res (math-poly-interp h s '(float 0 0) nil)))
- (if (math-lessp (math-abs (nth 1 res))
- (calcFunc-scf (math-abs (car res))
- (- prec)))
- (setq math-ninteg-convergence j
- ss (car res)))))
- (if (>= j 5)
- (setq s (cdr s)
- h (cdr h)))
- (setq curh (math-div-float curh '(float 9 0))))
- ss
- (math-reject-arg nil (format "*Integral failed to converge"))))))
-
-
-(defun math-ninteg-evaluate (expr x mode)
- (if (eq mode 'inf)
- (setq x (math-div '(float 1 0) x)))
- (let* ((var-DUMMY x)
- (res (math-evaluate-expr expr)))
- (or (Math-numberp res)
- (math-reject-arg res "*Integrand does not evaluate to a number"))
- (if (eq mode 'inf)
- (setq res (math-mul res (math-sqr x))))
- res))
-
-
-(defun math-ninteg-midpoint (expr lo hi mode) ; uses "integ-temp"
- (if (eq mode 'inf)
- (let ((math-infinite-mode t) temp)
- (setq temp (math-div 1 lo)
- lo (math-div 1 hi)
- hi temp)))
- (if integ-temp
- (let* ((it3 (* 3 (car integ-temp)))
- (math-working-step-2 (* 2 (car integ-temp)))
- (math-working-step 0)
- (range (math-sub hi lo))
- (del (math-div range (math-float it3)))
- (del2 (math-add del del))
- (del3 (math-add del del2))
- (x (math-add lo (math-mul '(float 5 -1) del)))
- (sum '(float 0 0))
- (j 0) temp)
- (while (<= (setq j (1+ j)) (car integ-temp))
- (setq math-working-step (1+ math-working-step)
- temp (math-ninteg-evaluate expr x mode)
- math-working-step (1+ math-working-step)
- sum (math-add sum (math-add temp (math-ninteg-evaluate
- expr (math-add x del2)
- mode)))
- x (math-add x del3)))
- (setq integ-temp (list it3
- (math-add (math-div (nth 1 integ-temp)
- '(float 3 0))
- (math-mul sum del)))))
- (setq integ-temp (list 1 (math-mul
- (math-sub hi lo)
- (math-ninteg-evaluate
- expr
- (math-mul (math-add lo hi) '(float 5 -1))
- mode)))))
- (nth 1 integ-temp))
-
-
-
-
-
-;;; The following algorithms come from Numerical Recipes, chapter 14.
-
-(defvar math-dummy-vars [(var DUMMY var-DUMMY)])
-(defvar math-dummy-counter 0)
-(defun math-dummy-variable ()
- (if (= math-dummy-counter (length math-dummy-vars))
- (let ((symb (intern (format "math-dummy-%d" math-dummy-counter))))
- (setq math-dummy-vars (vconcat math-dummy-vars
- (vector (list 'var symb symb))))))
- (set (nth 2 (aref math-dummy-vars math-dummy-counter)) nil)
- (prog1
- (aref math-dummy-vars math-dummy-counter)
- (setq math-dummy-counter (1+ math-dummy-counter))))
-
-(defvar math-in-fit 0)
-(defvar calc-fit-to-trail nil)
-
-(defun calcFunc-fit (expr vars &optional coefs data)
- (let ((math-in-fit 10))
- (math-with-extra-prec 2
- (math-general-fit expr vars coefs data nil))))
-
-(defun calcFunc-efit (expr vars &optional coefs data)
- (let ((math-in-fit 10))
- (math-with-extra-prec 2
- (math-general-fit expr vars coefs data 'sdev))))
-
-(defun calcFunc-xfit (expr vars &optional coefs data)
- (let ((math-in-fit 10))
- (math-with-extra-prec 2
- (math-general-fit expr vars coefs data 'full))))
-
-(defun math-general-fit (expr vars coefs data mode)
- (let ((calc-simplify-mode nil)
- (math-dummy-counter math-dummy-counter)
- (math-in-fit 1)
- (extended (eq mode 'full))
- (first-coef math-dummy-counter)
- first-var
- (plain-expr expr)
- orig-expr
- have-sdevs need-chisq chisq
- (x-funcs nil)
- (y-filter nil)
- y-dummy
- (coef-filters nil)
- new-coefs
- (xy-values nil)
- (weights nil)
- (var-YVAL nil) (var-YVALX nil)
- covar beta
- n nn m mm v dummy p)
-
- ;; Validate and parse arguments.
- (or data
- (if coefs
- (setq data coefs
- coefs nil)
- (if (math-vectorp expr)
- (if (memq (length expr) '(3 4))
- (setq data vars
- vars (nth 2 expr)
- coefs (nth 3 expr)
- expr (nth 1 expr))
- (math-dimension-error))
- (setq data vars
- vars nil
- coefs nil))))
- (or (math-matrixp data) (math-reject-arg data 'matrixp))
- (setq v (1- (length data))
- n (1- (length (nth 1 data))))
- (or (math-vectorp vars) (null vars)
- (setq vars (list 'vec vars)))
- (or (math-vectorp coefs) (null coefs)
- (setq coefs (list 'vec coefs)))
- (or coefs
- (setq coefs (cons 'vec (math-all-vars-but expr vars))))
- (or vars
- (if (<= (1- (length coefs)) v)
- (math-reject-arg coefs "*Not enough variables in model")
- (setq coefs (copy-sequence coefs))
- (let ((p (nthcdr (- (length coefs) v
- (if (eq (car-safe expr) 'calcFunc-eq) 1 0))
- coefs)))
- (setq vars (cons 'vec (cdr p)))
- (setcdr p nil))))
- (or (= (1- (length vars)) v)
- (= (length vars) v)
- (math-reject-arg vars "*Number of variables does not match data"))
- (setq m (1- (length coefs)))
- (if (< m 1)
- (math-reject-arg coefs "*Need at least one parameter"))
-
- ;; Rewrite expr in terms of fitparam and fitvar, make into an equation.
- (setq p coefs)
- (while (setq p (cdr p))
- (or (eq (car-safe (car p)) 'var)
- (math-reject-arg (car p) "*Expected a variable"))
- (setq dummy (math-dummy-variable)
- expr (math-expr-subst expr (car p)
- (list 'calcFunc-fitparam
- (- math-dummy-counter first-coef)))))
- (setq first-var math-dummy-counter
- p vars)
- (while (setq p (cdr p))
- (or (eq (car-safe (car p)) 'var)
- (math-reject-arg (car p) "*Expected a variable"))
- (setq dummy (math-dummy-variable)
- expr (math-expr-subst expr (car p)
- (list 'calcFunc-fitvar
- (- math-dummy-counter first-var)))))
- (if (< math-dummy-counter (+ first-var v))
- (setq dummy (math-dummy-variable))) ; dependent variable may be unnamed
- (setq y-dummy dummy
- orig-expr expr)
- (or (eq (car-safe expr) 'calcFunc-eq)
- (setq expr (list 'calcFunc-eq (list 'calcFunc-fitvar v) expr)))
-
- (let ((calc-symbolic-mode nil))
-
- ;; Apply rewrites to put expr into a linear-like form.
- (setq expr (math-evaluate-expr expr)
- expr (math-rewrite (list 'calcFunc-fitmodel expr)
- '(var FitRules var-FitRules))
- math-in-fit 2
- expr (math-evaluate-expr expr))
- (or (and (eq (car-safe expr) 'calcFunc-fitsystem)
- (= (length expr) 4)
- (math-vectorp (nth 2 expr))
- (math-vectorp (nth 3 expr))
- (> (length (nth 2 expr)) 1)
- (= (length (nth 3 expr)) (1+ m)))
- (math-reject-arg plain-expr "*Model expression is too complex"))
- (setq y-filter (nth 1 expr)
- x-funcs (vconcat (cdr (nth 2 expr)))
- coef-filters (nth 3 expr)
- mm (length x-funcs))
- (if (equal y-filter y-dummy)
- (setq y-filter nil))
-
- ;; Build the (square) system of linear equations to be solved.
- (setq beta (cons 'vec (make-list mm 0))
- covar (cons 'vec (mapcar 'copy-sequence (make-list mm beta))))
- (let* ((ptrs (vconcat (cdr data)))
- (isigsq 1)
- (xvals (make-vector mm 0))
- (i 0)
- j k xval yval sigmasqr wt covj covjk covk betaj lud)
- (while (<= (setq i (1+ i)) n)
-
- ;; Assign various independent variables for this data point.
- (setq j 0
- sigmasqr nil)
- (while (< j v)
- (aset ptrs j (cdr (aref ptrs j)))
- (setq xval (car (aref ptrs j)))
- (if (= j (1- v))
- (if sigmasqr
- (progn
- (if (eq (car-safe xval) 'sdev)
- (setq sigmasqr (math-add (math-sqr (nth 2 xval))
- sigmasqr)
- xval (nth 1 xval)))
- (if y-filter
- (setq xval (math-make-sdev xval
- (math-sqrt sigmasqr))))))
- (if (eq (car-safe xval) 'sdev)
- (setq sigmasqr (math-add (math-sqr (nth 2 xval))
- (or sigmasqr 0))
- xval (nth 1 xval))))
- (set (nth 2 (aref math-dummy-vars (+ first-var j))) xval)
- (setq j (1+ j)))
-
- ;; Compute Y value for this data point.
- (if y-filter
- (setq yval (math-evaluate-expr y-filter))
- (setq yval (symbol-value (nth 2 y-dummy))))
- (if (eq (car-safe yval) 'sdev)
- (setq sigmasqr (math-sqr (nth 2 yval))
- yval (nth 1 yval)))
- (if (= i 1)
- (setq have-sdevs sigmasqr
- need-chisq (or extended
- (and (eq mode 'sdev) (not have-sdevs)))))
- (if have-sdevs
- (if sigmasqr
- (progn
- (setq isigsq (math-div 1 sigmasqr))
- (if need-chisq
- (setq weights (cons isigsq weights))))
- (math-reject-arg yval "*Mixed error forms and plain numbers"))
- (if sigmasqr
- (math-reject-arg yval "*Mixed error forms and plain numbers")))
-
- ;; Compute X values for this data point and update covar and beta.
- (if (eq (car-safe xval) 'sdev)
- (set (nth 2 y-dummy) (nth 1 xval)))
- (setq j 0
- covj covar
- betaj beta)
- (while (< j mm)
- (setq wt (math-evaluate-expr (aref x-funcs j)))
- (aset xvals j wt)
- (setq wt (math-mul wt isigsq)
- betaj (cdr betaj)
- covjk (car (setq covj (cdr covj)))
- k 0)
- (while (<= k j)
- (setq covjk (cdr covjk))
- (setcar covjk (math-add (car covjk)
- (math-mul wt (aref xvals k))))
- (setq k (1+ k)))
- (setcar betaj (math-add (car betaj) (math-mul wt yval)))
- (setq j (1+ j)))
- (if need-chisq
- (setq xy-values (cons (append xvals (list yval)) xy-values))))
-
- ;; Fill in symmetric half of covar matrix.
- (setq j 0
- covj covar)
- (while (< j (1- mm))
- (setq k j
- j (1+ j)
- covjk (nthcdr j (car (setq covj (cdr covj))))
- covk (nthcdr j covar))
- (while (< (setq k (1+ k)) mm)
- (setq covjk (cdr covjk)
- covk (cdr covk))
- (setcar covjk (nth j (car covk))))))
-
- ;; Solve the linear system.
- (if mode
- (progn
- (setq covar (math-matrix-inv-raw covar))
- (if covar
- (setq beta (math-mul covar beta))
- (if (math-zerop (math-abs beta))
- (setq covar (calcFunc-diag 0 (1- (length beta))))
- (math-reject-arg orig-expr "*Singular matrix")))
- (or (math-vectorp covar)
- (setq covar (list 'vec (list 'vec covar)))))
- (setq beta (math-div beta covar)))
-
- ;; Compute chi-square statistic if necessary.
- (if need-chisq
- (let (bp xp sum)
- (setq chisq 0)
- (while xy-values
- (setq bp beta
- xp (car xy-values)
- sum 0)
- (while (setq bp (cdr bp))
- (setq sum (math-add sum (math-mul (car bp) (car xp)))
- xp (cdr xp)))
- (setq sum (math-sqr (math-sub (car xp) sum)))
- (if weights (setq sum (math-mul sum (car weights))))
- (setq chisq (math-add chisq sum)
- weights (cdr weights)
- xy-values (cdr xy-values)))))
-
- ;; Convert coefficients back into original terms.
- (setq new-coefs (copy-sequence beta))
- (let* ((bp new-coefs)
- (cp covar)
- (sigdat 1)
- (math-in-fit 3)
- (j 0))
- (and mode (not have-sdevs)
- (setq sigdat (if (<= n mm)
- 0
- (math-div chisq (- n mm)))))
- (if mode
- (while (setq bp (cdr bp))
- (setcar bp (math-make-sdev
- (car bp)
- (math-sqrt (math-mul (nth (setq j (1+ j))
- (car (setq cp (cdr cp))))
- sigdat))))))
- (setq new-coefs (math-evaluate-expr coef-filters))
- (if calc-fit-to-trail
- (let ((bp new-coefs)
- (cp coefs)
- (vec nil))
- (while (setq bp (cdr bp) cp (cdr cp))
- (setq vec (cons (list 'calcFunc-eq (car cp) (car bp)) vec)))
- (setq calc-fit-to-trail (cons 'vec (nreverse vec)))))))
-
- ;; Substitute best-fit coefficients back into original formula.
- (setq expr (math-multi-subst
- orig-expr
- (let ((n v)
- (vec nil))
- (while (>= n 1)
- (setq vec (cons (list 'calcFunc-fitvar n) vec)
- n (1- n)))
- (setq n m)
- (while (>= n 1)
- (setq vec (cons (list 'calcFunc-fitparam n) vec)
- n (1- n)))
- vec)
- (append (cdr new-coefs) (cdr vars))))
-
- ;; Package the result.
- (math-normalize
- (if extended
- (list 'vec expr beta covar
- (let ((p coef-filters)
- (n 0))
- (while (and (setq n (1+ n) p (cdr p))
- (eq (car-safe (car p)) 'calcFunc-fitdummy)
- (eq (nth 1 (car p)) n)))
- (if p
- coef-filters
- (list 'vec)))
- chisq
- (if (and have-sdevs (> n mm))
- (list 'calcFunc-utpc chisq (- n mm))
- '(var nan var-nan)))
- expr))))
-
-
-(defun calcFunc-fitvar (x)
- (if (>= math-in-fit 2)
- (progn
- (setq x (aref math-dummy-vars (+ first-var x -1)))
- (or (calc-var-value (nth 2 x)) x))
- (math-reject-arg x)))
-
-(defun calcFunc-fitparam (x)
- (if (>= math-in-fit 2)
- (progn
- (setq x (aref math-dummy-vars (+ first-coef x -1)))
- (or (calc-var-value (nth 2 x)) x))
- (math-reject-arg x)))
-
-(defun calcFunc-fitdummy (x)
- (if (= math-in-fit 3)
- (nth x new-coefs)
- (math-reject-arg x)))
-
-(defun calcFunc-hasfitvars (expr)
- (if (Math-primp expr)
- 0
- (if (eq (car expr) 'calcFunc-fitvar)
- (nth 1 expr)
- (apply 'max (mapcar 'calcFunc-hasfitvars (cdr expr))))))
-
-(defun calcFunc-hasfitparams (expr)
- (if (Math-primp expr)
- 0
- (if (eq (car expr) 'calcFunc-fitparam)
- (nth 1 expr)
- (apply 'max (mapcar 'calcFunc-hasfitparams (cdr expr))))))
-
-
-(defun math-all-vars-but (expr but)
- (let* ((vars (math-all-vars-in expr))
- (p but))
- (while p
- (setq vars (delq (assoc (car-safe p) vars) vars)
- p (cdr p)))
- (sort (mapcar 'car vars)
- (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))))
-
-(defun math-all-vars-in (expr)
- (let ((vars nil)
- found)
- (math-all-vars-rec expr)
- vars))
-
-(defun math-all-vars-rec (expr)
- (if (Math-primp expr)
- (if (eq (car-safe expr) 'var)
- (or (math-const-var expr)
- (if (setq found (assoc expr vars))
- (setcdr found (1+ (cdr found)))
- (setq vars (cons (cons expr 1) vars)))))
- (while (setq expr (cdr expr))
- (math-all-vars-rec (car expr)))))
-
-;;; calcalg3.el ends here
+++ /dev/null
-;;; calccomp.el --- composition functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-comp () nil)
-
-(defconst math-eqn-special-funcs
- '( calcFunc-log
- calcFunc-ln calcFunc-exp
- calcFunc-sin calcFunc-cos calcFunc-tan
- calcFunc-sinh calcFunc-cosh calcFunc-tanh
- calcFunc-arcsin calcFunc-arccos calcFunc-arctan
- calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
-
-;;; A "composition" has one of the following forms:
-;;;
-;;; "string" A literal string
-;;;
-;;; (horiz C1 C2 ...) Horizontally abutted sub-compositions
-;;;
-;;; (set LEVEL OFF) Set left margin + offset for line-break level
-;;; (break LEVEL) A potential line-break point
-;;;
-;;; (vleft N C1 C2 ...) Vertically stacked, left-justified sub-comps
-;;; (vcent N C1 C2 ...) Vertically stacked, centered sub-comps
-;;; (vright N C1 C2 ...) Vertically stacked, right-justified sub-comps
-;;; N specifies baseline of the stack, 0=top line.
-;;;
-;;; (supscr C1 C2) Composition C1 with superscript C2
-;;; (subscr C1 C2) Composition C1 with subscript C2
-;;; (rule X) Horizontal line of X, full width of enclosing comp
-;;;
-;;; (tag X C) Composition C corresponds to sub-expression X
-
-(defun math-compose-expr (a prec)
- (let ((math-compose-level (1+ math-compose-level)))
- (cond
- ((or (and (eq a math-comp-selected) a)
- (and math-comp-tagged
- (not (eq math-comp-tagged a))))
- (let ((math-comp-selected nil))
- (and math-comp-tagged (setq math-comp-tagged a))
- (list 'tag a (math-compose-expr a prec))))
- ((and (not (consp a)) (not (integerp a)))
- (concat "'" (prin1-to-string a)))
- ((math-scalarp a)
- (if (or (eq (car-safe a) 'frac)
- (and (nth 1 calc-frac-format) (Math-integerp a)))
- (if (memq calc-language '(tex eqn math maple c fortran pascal))
- (let ((aa (math-adjust-fraction a))
- (calc-frac-format nil))
- (math-compose-expr (list '/
- (if (memq calc-language '(c fortran))
- (math-float (nth 1 aa))
- (nth 1 aa))
- (nth 2 aa)) prec))
- (if (and (eq calc-language 'big)
- (= (length (car calc-frac-format)) 1))
- (let* ((aa (math-adjust-fraction a))
- (calc-frac-format nil)
- (math-radix-explicit-format nil)
- (c (list 'horiz
- (if (math-negp (nth 1 aa))
- "- " "")
- (list 'vcent 1
- (math-format-number
- (math-abs (nth 1 aa)))
- '(rule ?-)
- (math-format-number (nth 2 aa))))))
- (if (= calc-number-radix 10)
- c
- (list 'horiz "(" c
- (list 'subscr ")"
- (int-to-string calc-number-radix)))))
- (math-format-number a)))
- (if (not (eq calc-language 'big))
- (math-format-number a prec)
- (if (memq (car-safe a) '(cplx polar))
- (if (math-zerop (nth 2 a))
- (math-compose-expr (nth 1 a) prec)
- (list 'horiz "("
- (math-compose-expr (nth 1 a) 0)
- (if (eq (car a) 'cplx) ", " "; ")
- (math-compose-expr (nth 2 a) 0) ")"))
- (if (or (= calc-number-radix 10)
- (not (Math-realp a))
- (and calc-group-digits
- (not (assoc calc-group-char '((",") (" "))))))
- (math-format-number a prec)
- (let ((s (math-format-number a prec))
- (c nil))
- (while (string-match (if (> calc-number-radix 14)
- "\\([0-9]+\\)#\\([0-9a-zA-Z., ]+\\)"
- "\\([0-9]+\\)#\\([0-9a-dA-D., ]+\\)")
- s)
- (setq c (nconc c (list (substring s 0 (match-beginning 0))
- (list 'subscr
- (math-match-substring s 2)
- (math-match-substring s 1))))
- s (substring s (match-end 0))))
- (if (string-match
- "\\*\\([0-9.]+\\)\\^\\(-?[0-9]+\\)\\()?\\)\\'" s)
- (setq s (list 'horiz
- (substring s 0 (match-beginning 0)) " "
- (list 'supscr
- (math-match-substring s 1)
- (math-match-substring s 2))
- (math-match-substring s 3))))
- (if c (cons 'horiz (nconc c (list s))) s)))))))
- ((and (get (car a) 'math-compose-forms)
- (not (eq calc-language 'unform))
- (let ((comps (get (car a) 'math-compose-forms))
- temp temp2)
- (or (and (setq temp (assq calc-language comps))
- (or (and (setq temp2 (assq (1- (length a)) (cdr temp)))
- (setq temp (apply (cdr temp2) (cdr a)))
- (math-compose-expr temp prec))
- (and (setq temp2 (assq nil (cdr temp)))
- (funcall (cdr temp2) a))))
- (and (setq temp (assq nil comps))
- (or (and (setq temp2 (assq (1- (length a)) (cdr temp)))
- (setq temp (apply (cdr temp2) (cdr a)))
- (math-compose-expr temp prec))
- (and (setq temp2 (assq nil (cdr temp)))
- (funcall (cdr temp2) a))))))))
- ((eq (car a) 'vec)
- (let* ((left-bracket (if calc-vector-brackets
- (substring calc-vector-brackets 0 1) ""))
- (right-bracket (if calc-vector-brackets
- (substring calc-vector-brackets 1 2) ""))
- (inner-brackets (memq 'R calc-matrix-brackets))
- (outer-brackets (memq 'O calc-matrix-brackets))
- (row-commas (memq 'C calc-matrix-brackets))
- (comma-spc (or calc-vector-commas " "))
- (comma (or calc-vector-commas ""))
- (vector-prec (if (or (and calc-vector-commas
- (math-vector-no-parens a))
- (memq 'P calc-matrix-brackets)) 0 1000))
- (just (cond ((eq calc-matrix-just 'right) 'vright)
- ((eq calc-matrix-just 'center) 'vcent)
- (t 'vleft)))
- (break calc-break-vectors))
- (if (and (memq calc-language '(nil big))
- (not calc-break-vectors)
- (math-matrixp a) (not (math-matrixp (nth 1 a)))
- (or calc-full-vectors
- (and (< (length a) 7) (< (length (nth 1 a)) 7))
- (progn (setq break t) nil)))
- (if (progn
- (setq vector-prec (if (or (and calc-vector-commas
- (math-vector-no-parens
- (nth 1 a)))
- (memq 'P calc-matrix-brackets))
- 0 1000))
- (= (length a) 2))
- (list 'horiz
- (concat left-bracket left-bracket " ")
- (math-compose-vector (cdr (nth 1 a)) (concat comma " ")
- vector-prec)
- (concat " " right-bracket right-bracket))
- (let* ((rows (1- (length a)))
- (cols (1- (length (nth 1 a))))
- (base (/ (1- rows) 2))
- (calc-language 'flat))
- (append '(horiz)
- (list (append '(vleft)
- (list base)
- (list (concat (and outer-brackets
- (concat left-bracket
- " "))
- (and inner-brackets
- (concat left-bracket
- " "))))
- (make-list (1- rows)
- (concat (and outer-brackets
- " ")
- (and inner-brackets
- (concat
- left-bracket
- " "))))))
- (math-compose-matrix (cdr a) 1 cols base)
- (list (append '(vleft)
- (list base)
- (make-list (1- rows)
- (if inner-brackets
- (concat " "
- right-bracket
- (and row-commas
- comma))
- (if (and outer-brackets
- row-commas)
- ";" "")))
- (list (concat
- (and inner-brackets
- (concat " "
- right-bracket))
- (and outer-brackets
- (concat
- " "
- right-bracket)))))))))
- (if (and calc-display-strings
- (cdr a)
- (math-vector-is-string a))
- (math-vector-to-string a t)
- (if (and break (cdr a)
- (not (eq calc-language 'flat)))
- (let* ((full (or calc-full-vectors (< (length a) 7)))
- (rows (if full (1- (length a)) 5))
- (base (/ (1- rows) 2))
- (just 'vleft)
- (calc-break-vectors nil))
- (list 'horiz
- (cons 'vleft (cons base
- (math-compose-rows
- (cdr a)
- (if full rows 3) t)))))
- (if (or calc-full-vectors (< (length a) 7))
- (if (and (eq calc-language 'tex)
- (math-matrixp a))
- (append '(horiz "\\matrix{ ")
- (math-compose-tex-matrix (cdr a))
- '(" }"))
- (if (and (eq calc-language 'eqn)
- (math-matrixp a))
- (append '(horiz "matrix { ")
- (math-compose-eqn-matrix
- (cdr (math-transpose a)))
- '("}"))
- (if (and (eq calc-language 'maple)
- (math-matrixp a))
- (list 'horiz
- "matrix("
- left-bracket
- (math-compose-vector (cdr a) (concat comma " ")
- vector-prec)
- right-bracket
- ")")
- (list 'horiz
- left-bracket
- (math-compose-vector (cdr a) (concat comma " ")
- vector-prec)
- right-bracket))))
- (list 'horiz
- left-bracket
- (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
- (concat comma " ") vector-prec)
- comma (if (eq calc-language 'tex) " \\ldots" " ...")
- comma " "
- (list 'break math-compose-level)
- (math-compose-expr (nth (1- (length a)) a)
- (if (equal comma "") 1000 0))
- right-bracket)))))))
- ((eq (car a) 'incomplete)
- (if (cdr (cdr a))
- (cond ((eq (nth 1 a) 'vec)
- (list 'horiz "["
- (math-compose-vector (cdr (cdr a)) ", " 0)
- " ..."))
- ((eq (nth 1 a) 'cplx)
- (list 'horiz "("
- (math-compose-vector (cdr (cdr a)) ", " 0)
- ", ..."))
- ((eq (nth 1 a) 'polar)
- (list 'horiz "("
- (math-compose-vector (cdr (cdr a)) "; " 0)
- "; ..."))
- ((eq (nth 1 a) 'intv)
- (list 'horiz
- (if (memq (nth 2 a) '(0 1)) "(" "[")
- (math-compose-vector (cdr (cdr (cdr a))) " .. " 0)
- " .. ..."))
- (t (format "%s" a)))
- (cond ((eq (nth 1 a) 'vec) "[ ...")
- ((eq (nth 1 a) 'intv)
- (if (memq (nth 2 a) '(0 1)) "( ..." "[ ..."))
- (t "( ..."))))
- ((eq (car a) 'var)
- (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
- (if v
- (symbol-name (car v))
- (if (and (eq calc-language 'tex)
- calc-language-option
- (not (= calc-language-option 0))
- (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
- (symbol-name (nth 1 a))))
- (format "\\hbox{%s}" (symbol-name (nth 1 a)))
- (if (and math-compose-hash-args
- (let ((p calc-arg-values))
- (setq v 1)
- (while (and p (not (equal (car p) a)))
- (setq p (and (eq math-compose-hash-args t) (cdr p))
- v (1+ v)))
- p))
- (if (eq math-compose-hash-args 1)
- "#"
- (format "#%d" v))
- (if (memq calc-language '(c fortran pascal maple))
- (math-to-underscores (symbol-name (nth 1 a)))
- (if (and (eq calc-language 'eqn)
- (string-match ".'\\'" (symbol-name (nth 2 a))))
- (math-compose-expr
- (list 'calcFunc-Prime
- (list
- 'var
- (intern (substring (symbol-name (nth 1 a)) 0 -1))
- (intern (substring (symbol-name (nth 2 a)) 0 -1))))
- prec)
- (symbol-name (nth 1 a)))))))))
- ((eq (car a) 'intv)
- (list 'horiz
- (if (eq calc-language 'maple) ""
- (if (memq (nth 1 a) '(0 1)) "(" "["))
- (math-compose-expr (nth 2 a) 0)
- (if (eq calc-language 'tex) " \\ldots "
- (if (eq calc-language 'eqn) " ... " " .. "))
- (math-compose-expr (nth 3 a) 0)
- (if (eq calc-language 'maple) ""
- (if (memq (nth 1 a) '(0 2)) ")" "]"))))
- ((eq (car a) 'date)
- (if (eq (car calc-date-format) 'X)
- (math-format-date a)
- (concat "<" (math-format-date a) ">")))
- ((and (eq (car a) 'calcFunc-subscr) (cdr (cdr a))
- (memq calc-language '(c pascal fortran maple)))
- (let ((args (cdr (cdr a))))
- (while (and (memq calc-language '(pascal fortran))
- (eq (car-safe (nth 1 a)) 'calcFunc-subscr))
- (setq args (append (cdr (cdr (nth 1 a))) args)
- a (nth 1 a)))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- (if (eq calc-language 'fortran) "(" "[")
- (math-compose-vector args ", " 0)
- (if (eq calc-language 'fortran) ")" "]"))))
- ((and (eq (car a) 'calcFunc-subscr) (= (length a) 3)
- (eq calc-language 'big))
- (let* ((a1 (math-compose-expr (nth 1 a) 1000))
- (calc-language 'flat)
- (a2 (math-compose-expr (nth 2 a) 0)))
- (if (or (eq (car-safe a1) 'subscr)
- (and (eq (car-safe a1) 'tag)
- (eq (car-safe (nth 2 a1)) 'subscr)
- (setq a1 (nth 2 a1))))
- (list 'subscr
- (nth 1 a1)
- (list 'horiz
- (nth 2 a1)
- ", "
- a2))
- (list 'subscr a1 a2))))
- ((and (eq (car a) 'calcFunc-subscr) (= (length a) 3)
- (eq calc-language 'math))
- (list 'horiz
- (math-compose-expr (nth 1 a) 1000)
- "[["
- (math-compose-expr (nth 2 a) 0)
- "]]"))
- ((and (eq (car a) 'calcFunc-sqrt)
- (eq calc-language 'tex))
- (list 'horiz
- "\\sqrt{"
- (math-compose-expr (nth 1 a) 0)
- "}"))
- ((and nil (eq (car a) 'calcFunc-sqrt)
- (eq calc-language 'eqn))
- (list 'horiz
- "sqrt {"
- (math-compose-expr (nth 1 a) -1)
- "}"))
- ((and (eq (car a) '^)
- (eq calc-language 'big))
- (list 'supscr
- (if (or (math-looks-negp (nth 1 a))
- (memq (car-safe (nth 1 a)) '(^ / frac calcFunc-sqrt))
- (and (eq (car-safe (nth 1 a)) 'cplx)
- (math-negp (nth 1 (nth 1 a)))
- (eq (nth 2 (nth 1 a)) 0)))
- (list 'horiz "(" (math-compose-expr (nth 1 a) 0) ")")
- (math-compose-expr (nth 1 a) 201))
- (let ((calc-language 'flat)
- (calc-number-radix 10))
- (math-compose-expr (nth 2 a) 0))))
- ((and (eq (car a) '/)
- (eq calc-language 'big))
- (let ((a1 (let ((calc-language (if (memq (car-safe (nth 1 a)) '(/ frac))
- 'flat 'big)))
- (math-compose-expr (nth 1 a) 0)))
- (a2 (let ((calc-language (if (memq (car-safe (nth 2 a)) '(/ frac))
- 'flat 'big)))
- (math-compose-expr (nth 2 a) 0))))
- (list 'vcent
- (math-comp-height a1)
- a1 '(rule ?-) a2)))
- ((and (memq (car a) '(calcFunc-sum calcFunc-prod))
- (eq calc-language 'tex)
- (= (length a) 5))
- (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")
- "_{" (math-compose-expr (nth 2 a) 0)
- "=" (math-compose-expr (nth 3 a) 0)
- "}^{" (math-compose-expr (nth 4 a) 0)
- "}{" (math-compose-expr (nth 1 a) 0) "}"))
- ((and (eq (car a) 'calcFunc-lambda)
- (> (length a) 2)
- (memq calc-language '(nil flat big)))
- (let ((p (cdr a))
- (ap calc-arg-values)
- (math-compose-hash-args (if (= (length a) 3) 1 t)))
- (while (and (cdr p) (equal (car p) (car ap)))
- (setq p (cdr p) ap (cdr ap)))
- (append '(horiz "<")
- (if (cdr p)
- (list (math-compose-vector
- (nreverse (cdr (reverse (cdr a)))) ", " 0)
- " : ")
- nil)
- (list (math-compose-expr (nth (1- (length a)) a) 0)
- ">"))))
- ((and (eq (car a) 'calcFunc-string)
- (= (length a) 2)
- (math-vectorp (nth 1 a))
- (math-vector-is-string (nth 1 a)))
- (if (eq calc-language 'unform)
- (concat "string(" (math-vector-to-string (nth 1 a) t) ")")
- (math-vector-to-string (nth 1 a) nil)))
- ((and (eq (car a) 'calcFunc-bstring)
- (= (length a) 2)
- (math-vectorp (nth 1 a))
- (math-vector-is-string (nth 1 a)))
- (if (eq calc-language 'unform)
- (concat "bstring(" (math-vector-to-string (nth 1 a) t) ")")
- (let ((c nil)
- (s (math-vector-to-string (nth 1 a) nil))
- p)
- (while (string-match "[^ ] +[^ ]" s)
- (setq p (1- (match-end 0))
- c (cons (list 'break math-compose-level)
- (cons (substring s 0 p)
- c))
- s (substring s p)))
- (setq c (nreverse (cons s c)))
- (or (= prec -123)
- (setq c (cons (list 'set math-compose-level 2) c)))
- (cons 'horiz c))))
- ((and (eq (car a) 'calcFunc-cprec)
- (not (eq calc-language 'unform))
- (= (length a) 3)
- (integerp (nth 2 a)))
- (let ((c (math-compose-expr (nth 1 a) -1)))
- (if (> prec (nth 2 a))
- (if (eq calc-language 'tex)
- (list 'horiz "\\left( " c " \\right)")
- (if (eq calc-language 'eqn)
- (list 'horiz "{left ( " c " right )}")
- (list 'horiz "(" c ")")))
- c)))
- ((and (eq (car a) 'calcFunc-choriz)
- (not (eq calc-language 'unform))
- (memq (length a) '(2 3 4))
- (math-vectorp (nth 1 a))
- (if (integerp (nth 2 a))
- (or (null (nth 3 a))
- (and (math-vectorp (nth 3 a))
- (math-vector-is-string (nth 3 a))))
- (or (null (nth 2 a))
- (and (math-vectorp (nth 2 a))
- (math-vector-is-string (nth 2 a))))))
- (let* ((cprec (and (integerp (nth 2 a)) (nth 2 a)))
- (sep (nth (if cprec 3 2) a))
- (bprec nil))
- (if sep
- (math-compose-vector (cdr (nth 1 a))
- (math-vector-to-string sep nil)
- (or cprec prec))
- (cons 'horiz (mapcar (function
- (lambda (x)
- (if (eq (car-safe x) 'calcFunc-bstring)
- (prog1
- (math-compose-expr
- x (or bprec cprec prec))
- (setq bprec -123))
- (math-compose-expr x (or cprec prec)))))
- (cdr (nth 1 a)))))))
- ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
- (not (eq calc-language 'unform))
- (memq (length a) '(2 3))
- (math-vectorp (nth 1 a))
- (or (null (nth 2 a))
- (integerp (nth 2 a))))
- (let* ((base 0)
- (v 0)
- (prec (or (nth 2 a) prec))
- (c (mapcar (function
- (lambda (x)
- (let ((b nil) (cc nil) a d)
- (if (and (memq (car-safe x) '(calcFunc-cbase
- calcFunc-ctbase
- calcFunc-cbbase))
- (memq (length x) '(1 2)))
- (setq b (car x)
- x (nth 1 x)))
- (if (and (eq (car-safe x) 'calcFunc-crule)
- (memq (length x) '(1 2))
- (or (null (nth 1 x))
- (and (math-vectorp (nth 1 x))
- (= (length (nth 1 x)) 2)
- (math-vector-is-string
- (nth 1 x)))
- (and (natnump (nth 1 x))
- (<= (nth 1 x) 255))))
- (setq cc (list
- 'rule
- (if (math-vectorp (nth 1 x))
- (aref (math-vector-to-string
- (nth 1 x) nil) 0)
- (or (nth 1 x) ?-))))
- (or (and (memq (car-safe x) '(calcFunc-cvspace
- calcFunc-ctspace
- calcFunc-cbspace))
- (memq (length x) '(2 3))
- (eq (nth 1 x) 0))
- (null x)
- (setq cc (math-compose-expr x prec))))
- (setq a (if cc (math-comp-ascent cc) 0)
- d (if cc (math-comp-descent cc) 0))
- (if (eq b 'calcFunc-cbase)
- (setq base (+ v a -1))
- (if (eq b 'calcFunc-ctbase)
- (setq base v)
- (if (eq b 'calcFunc-cbbase)
- (setq base (+ v a d -1)))))
- (setq v (+ v a d))
- cc)))
- (cdr (nth 1 a)))))
- (setq c (delq nil c))
- (if c
- (cons (if (eq (car a) 'calcFunc-cvert) 'vcent
- (if (eq (car a) 'calcFunc-clvert) 'vleft 'vright))
- (cons base c))
- " ")))
- ((and (memq (car a) '(calcFunc-csup calcFunc-csub))
- (not (eq calc-language 'unform))
- (memq (length a) '(3 4))
- (or (null (nth 3 a))
- (integerp (nth 3 a))))
- (list (if (eq (car a) 'calcFunc-csup) 'supscr 'subscr)
- (math-compose-expr (nth 1 a) (or (nth 3 a) 0))
- (math-compose-expr (nth 2 a) 0)))
- ((and (eq (car a) 'calcFunc-cflat)
- (not (eq calc-language 'unform))
- (memq (length a) '(2 3))
- (or (null (nth 2 a))
- (integerp (nth 2 a))))
- (let ((calc-language (if (memq calc-language '(nil big))
- 'flat calc-language)))
- (math-compose-expr (nth 1 a) (or (nth 2 a) 0))))
- ((and (eq (car a) 'calcFunc-cspace)
- (memq (length a) '(2 3))
- (natnump (nth 1 a)))
- (if (nth 2 a)
- (cons 'horiz (make-list (nth 1 a)
- (if (and (math-vectorp (nth 2 a))
- (math-vector-is-string (nth 2 a)))
- (math-vector-to-string (nth 2 a) nil)
- (math-compose-expr (nth 2 a) 0))))
- (make-string (nth 1 a) ?\ )))
- ((and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
- (memq (length a) '(2 3))
- (natnump (nth 1 a)))
- (if (= (nth 1 a) 0)
- ""
- (let* ((c (if (nth 2 a)
- (if (and (math-vectorp (nth 2 a))
- (math-vector-is-string (nth 2 a)))
- (math-vector-to-string (nth 2 a) nil)
- (math-compose-expr (nth 2 a) 0))
- " "))
- (ca (math-comp-ascent c))
- (cd (math-comp-descent c)))
- (cons 'vleft
- (cons (if (eq (car a) 'calcFunc-ctspace)
- (1- ca)
- (if (eq (car a) 'calcFunc-cbspace)
- (+ (* (1- (nth 1 a)) (+ ca cd)) (1- ca))
- (/ (1- (* (nth 1 a) (+ ca cd))) 2)))
- (make-list (nth 1 a) c))))))
- ((and (eq (car a) 'calcFunc-evalto)
- (setq calc-any-evaltos t)
- (memq calc-language '(tex eqn))
- (= math-compose-level (if math-comp-tagged 2 1))
- (= (length a) 3))
- (list 'horiz
- (if (eq calc-language 'tex) "\\evalto " "evalto ")
- (math-compose-expr (nth 1 a) 0)
- (if (eq calc-language 'tex) " \\to " " -> ")
- (math-compose-expr (nth 2 a) 0)))
- (t
- (let ((op (and (not (eq calc-language 'unform))
- (if (and (eq (car a) 'calcFunc-if) (= (length a) 4))
- (assoc "?" math-expr-opers)
- (math-assq2 (car a) math-expr-opers)))))
- (cond ((and op
- (or (= (length a) 3) (eq (car a) 'calcFunc-if))
- (/= (nth 3 op) -1))
- (cond
- ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
- (if (and (eq calc-language 'tex)
- (not (math-tex-expr-is-flat a)))
- (if (eq (car-safe a) '/)
- (list 'horiz "{" (math-compose-expr a -1) "}")
- (list 'horiz "\\left( "
- (math-compose-expr a -1)
- " \\right)"))
- (if (eq calc-language 'eqn)
- (if (or (eq (car-safe a) '/)
- (= (/ prec 100) 9))
- (list 'horiz "{" (math-compose-expr a -1) "}")
- (if (math-tex-expr-is-flat a)
- (list 'horiz "( " (math-compose-expr a -1) " )")
- (list 'horiz "{left ( "
- (math-compose-expr a -1)
- " right )}")))
- (list 'horiz "(" (math-compose-expr a 0) ")"))))
- ((and (eq calc-language 'tex)
- (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
- (>= prec 0))
- (list 'horiz "{" (math-compose-expr a -1) "}"))
- ((eq (car a) 'calcFunc-if)
- (list 'horiz
- (math-compose-expr (nth 1 a) (nth 2 op))
- " ? "
- (math-compose-expr (nth 2 a) 0)
- " : "
- (math-compose-expr (nth 3 a) (nth 3 op))))
- (t
- (let* ((math-comp-tagged (and math-comp-tagged
- (not (math-primp a))
- math-comp-tagged))
- (setlev (if (= prec (min (nth 2 op) (nth 3 op)))
- (progn
- (setq math-compose-level
- (1- math-compose-level))
- nil)
- math-compose-level))
- (lhs (math-compose-expr (nth 1 a) (nth 2 op)))
- (rhs (math-compose-expr (nth 2 a) (nth 3 op))))
- (and (equal (car op) "^")
- (eq (math-comp-first-char lhs) ?-)
- (setq lhs (list 'horiz "(" lhs ")")))
- (and (eq calc-language 'tex)
- (or (equal (car op) "^") (equal (car op) "_"))
- (not (and (stringp rhs) (= (length rhs) 1)))
- (setq rhs (list 'horiz "{" rhs "}")))
- (or (and (eq (car a) '*)
- (or (null calc-language)
- (assoc "2x" math-expr-opers))
- (let* ((prevt (math-prod-last-term (nth 1 a)))
- (nextt (math-prod-first-term (nth 2 a)))
- (prevc (or (math-comp-last-char lhs)
- (and (memq (car-safe prevt)
- '(^ calcFunc-subscr
- calcFunc-sqrt
- frac))
- (eq calc-language 'big)
- ?0)))
- (nextc (or (math-comp-first-char rhs)
- (and (memq (car-safe nextt)
- '(calcFunc-sqrt
- calcFunc-sum
- calcFunc-prod
- calcFunc-integ))
- (eq calc-language 'big)
- ?0))))
- (and prevc nextc
- (or (and (>= nextc ?a) (<= nextc ?z))
- (and (>= nextc ?A) (<= nextc ?Z))
- (and (>= nextc ?0) (<= nextc ?9))
- (memq nextc '(?. ?_ ?#
- ?\( ?\[ ?\{))
- (and (eq nextc ?\\)
- (not (string-match
- "\\`\\\\left("
- (math-comp-first-string
- rhs)))))
- (not (and (eq (car-safe prevt) 'var)
- (eq nextc ?\()))
- (list 'horiz
- (list 'set setlev 1)
- lhs
- (list 'break math-compose-level)
- " "
- rhs))))
- (list 'horiz
- (list 'set setlev 1)
- lhs
- (list 'break math-compose-level)
- (if (or (equal (car op) "^")
- (equal (car op) "_")
- (equal (car op) "**")
- (and (equal (car op) "*")
- (math-comp-last-char lhs)
- (math-comp-first-char rhs))
- (and (equal (car op) "/")
- (math-num-integerp (nth 1 a))
- (math-integerp (nth 2 a))))
- (car op)
- (if (and (eq calc-language 'big)
- (equal (car op) "=>"))
- " => "
- (concat " " (car op) " ")))
- rhs))))))
- ((and op (= (length a) 2) (= (nth 3 op) -1))
- (cond
- ((or (> prec (or (nth 4 op) (nth 2 op)))
- (and (not (eq (assoc (car op) math-expr-opers) op))
- (> prec 0))) ; don't write x% + y
- (if (and (eq calc-language 'tex)
- (not (math-tex-expr-is-flat a)))
- (list 'horiz "\\left( "
- (math-compose-expr a -1)
- " \\right)")
- (if (eq calc-language 'eqn)
- (if (= (/ prec 100) 9)
- (list 'horiz "{" (math-compose-expr a -1) "}")
- (if (math-tex-expr-is-flat a)
- (list 'horiz "{( " (math-compose-expr a -1) " )}")
- (list 'horiz "{left ( "
- (math-compose-expr a -1)
- " right )}")))
- (list 'horiz "(" (math-compose-expr a 0) ")"))))
- (t
- (let ((lhs (math-compose-expr (nth 1 a) (nth 2 op))))
- (list 'horiz
- lhs
- (if (or (> (length (car op)) 1)
- (not (math-comp-is-flat lhs)))
- (concat " " (car op))
- (car op)))))))
- ((and op (= (length a) 2) (= (nth 2 op) -1))
- (cond
- ((eq (nth 3 op) 0)
- (let ((lr (and (eq calc-language 'tex)
- (not (math-tex-expr-is-flat (nth 1 a))))))
- (list 'horiz
- (if lr "\\left" "")
- (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op))
- (substring (car op) 1)
- (car op))
- (if (or lr (> (length (car op)) 2)) " " "")
- (math-compose-expr (nth 1 a) -1)
- (if (or lr (> (length (car op)) 2)) " " "")
- (if lr "\\right" "")
- (car (nth 1 (memq op math-expr-opers))))))
- ((> prec (or (nth 4 op) (nth 3 op)))
- (if (and (eq calc-language 'tex)
- (not (math-tex-expr-is-flat a)))
- (list 'horiz "\\left( "
- (math-compose-expr a -1)
- " \\right)")
- (if (eq calc-language 'eqn)
- (if (= (/ prec 100) 9)
- (list 'horiz "{" (math-compose-expr a -1) "}")
- (if (math-tex-expr-is-flat a)
- (list 'horiz "{( " (math-compose-expr a -1) " )}")
- (list 'horiz "{left ( "
- (math-compose-expr a -1)
- " right )}")))
- (list 'horiz "(" (math-compose-expr a 0) ")"))))
- (t
- (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
- (list 'horiz
- (let ((ops (if (string-match "\\`u\\([^a-zA-Z]\\)\\'"
- (car op))
- (substring (car op) 1)
- (car op))))
- (if (or (> (length ops) 1)
- (not (math-comp-is-flat rhs)))
- (concat ops " ")
- ops))
- rhs)))))
- ((and (eq calc-language 'big)
- (setq op (get (car a) 'math-compose-big))
- (funcall op a prec)))
- ((and (setq op (assq calc-language
- '( ( nil . math-compose-normal )
- ( flat . math-compose-normal )
- ( big . math-compose-normal )
- ( c . math-compose-c )
- ( pascal . math-compose-pascal )
- ( fortran . math-compose-fortran )
- ( tex . math-compose-tex )
- ( eqn . math-compose-eqn )
- ( math . math-compose-math )
- ( maple . math-compose-maple ))))
- (setq op (get (car a) (cdr op)))
- (funcall op a prec)))
- (t
- (let* ((func (car a))
- (func2 (assq func '(( mod . calcFunc-makemod )
- ( sdev . calcFunc-sdev )
- ( + . calcFunc-add )
- ( - . calcFunc-sub )
- ( * . calcFunc-mul )
- ( / . calcFunc-div )
- ( % . calcFunc-mod )
- ( ^ . calcFunc-pow )
- ( neg . calcFunc-neg )
- ( | . calcFunc-vconcat ))))
- left right args)
- (if func2
- (setq func (cdr func2)))
- (if (setq func2 (rassq func math-expr-function-mapping))
- (setq func (car func2)))
- (setq func (math-remove-dashes
- (if (string-match
- "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
- (symbol-name func))
- (math-match-substring (symbol-name func) 1)
- (symbol-name func))))
- (if (memq calc-language '(c fortran pascal maple))
- (setq func (math-to-underscores func)))
- (if (and (eq calc-language 'tex)
- calc-language-option
- (not (= calc-language-option 0))
- (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
- (if (< (prefix-numeric-value calc-language-option) 0)
- (setq func (format "\\%s" func))
- (setq func (format "\\hbox{%s}" func))))
- (if (and (eq calc-language 'eqn)
- (string-match "[^']'+\\'" func))
- (let ((n (- (length func) (match-beginning 0) 1)))
- (setq func (substring func 0 (- n)))
- (while (>= (setq n (1- n)) 0)
- (setq func (concat func " prime")))))
- (cond ((and (eq calc-language 'tex)
- (or (> (length a) 2)
- (not (math-tex-expr-is-flat (nth 1 a)))))
- (setq left "\\left( "
- right " \\right)"))
- ((and (eq calc-language 'eqn)
- (or (> (length a) 2)
- (not (math-tex-expr-is-flat (nth 1 a)))))
- (setq left "{left ( "
- right " right )}"))
- ((and (or (and (eq calc-language 'tex)
- (eq (aref func 0) ?\\))
- (and (eq calc-language 'eqn)
- (memq (car a) math-eqn-special-funcs)))
- (not (string-match "\\hbox{" func))
- (= (length a) 2)
- (or (Math-realp (nth 1 a))
- (memq (car (nth 1 a)) '(var *))))
- (setq left (if (eq calc-language 'eqn) "~{" "{")
- right "}"))
- ((eq calc-language 'eqn)
- (setq left " ( "
- right " )"))
- (t (setq left calc-function-open
- right calc-function-close)))
- (list 'horiz func left
- (math-compose-vector (cdr a)
- (if (eq calc-language 'eqn)
- " , " ", ")
- 0)
- right)))))))))
-
-
-(defun math-prod-first-term (x)
- (while (eq (car-safe x) '*)
- (setq x (nth 1 x)))
- x)
-
-(defun math-prod-last-term (x)
- (while (eq (car-safe x) '*)
- (setq x (nth 2 x)))
- x)
-
-(defun math-compose-vector (a sep prec)
- (if a
- (cons 'horiz
- (cons (list 'set math-compose-level)
- (let ((c (list (math-compose-expr (car a) prec))))
- (while (setq a (cdr a))
- (setq c (cons (if (eq (car-safe (car a))
- 'calcFunc-bstring)
- (let ((math-compose-level
- (1- math-compose-level)))
- (math-compose-expr (car a) -123))
- (math-compose-expr (car a) prec))
- (cons (list 'break math-compose-level)
- (cons sep c)))))
- (nreverse c))))
- ""))
-
-(defun math-vector-no-parens (a)
- (or (cdr (cdr a))
- (not (eq (car-safe (nth 1 a)) '*))))
-
-(defun math-compose-matrix (a col cols base)
- (let ((col 0)
- (res nil))
- (while (<= (setq col (1+ col)) cols)
- (setq res (cons (cons just
- (cons base
- (mapcar (function
- (lambda (r)
- (list 'horiz
- (math-compose-expr
- (nth col r)
- vector-prec)
- (if (= col cols)
- ""
- (concat comma-spc " ")))))
- a)))
- res)))
- (nreverse res)))
-
-(defun math-compose-rows (a count first)
- (if (cdr a)
- (if (<= count 0)
- (if (< count 0)
- (math-compose-rows (cdr a) -1 nil)
- (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...")
- comma)
- (math-compose-rows (cdr a) -1 nil)))
- (cons (list 'horiz
- (if first (concat left-bracket " ") " ")
- (math-compose-expr (car a) vector-prec)
- comma)
- (math-compose-rows (cdr a) (1- count) nil)))
- (list (list 'horiz
- (if first (concat left-bracket " ") " ")
- (math-compose-expr (car a) vector-prec)
- (concat " " right-bracket)))))
-
-(defun math-compose-tex-matrix (a)
- (if (cdr a)
- (cons (math-compose-vector (cdr (car a)) " & " 0)
- (cons " \\\\ "
- (math-compose-tex-matrix (cdr a))))
- (list (math-compose-vector (cdr (car a)) " & " 0))))
-
-(defun math-compose-eqn-matrix (a)
- (if a
- (cons
- (cond ((eq calc-matrix-just 'right) "rcol ")
- ((eq calc-matrix-just 'center) "ccol ")
- (t "lcol "))
- (cons
- (list 'break math-compose-level)
- (cons
- "{ "
- (cons
- (let ((math-compose-level (1+ math-compose-level)))
- (math-compose-vector (cdr (car a)) " above " 1000))
- (cons
- " } "
- (math-compose-eqn-matrix (cdr a)))))))
- nil))
-
-(defun math-vector-is-string (a)
- (while (and (setq a (cdr a))
- (or (and (natnump (car a))
- (<= (car a) 255))
- (and (eq (car-safe (car a)) 'cplx)
- (natnump (nth 1 (car a)))
- (eq (nth 2 (car a)) 0)
- (<= (nth 1 (car a)) 255)))))
- (null a))
-
-(defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
- ( ?\\ . "\\\\" )
- ( ?\a . "\\a" )
- ( ?\b . "\\b" )
- ( ?\e . "\\e" )
- ( ?\f . "\\f" )
- ( ?\n . "\\n" )
- ( ?\r . "\\r" )
- ( ?\t . "\\t" )
- ( ?\^? . "\\^?" )))
-
-(defun math-vector-to-string (a &optional quoted)
- (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
- (cdr a))))
- (if (string-match "[\000-\037\177\\\"]" a)
- (let ((p 0)
- (pat (if quoted "[\000-\037\177\\\"]" "[\000-\037\177]"))
- (codes (if quoted math-vector-to-string-chars '((?\^? . "^?"))))
- (fmt (if quoted "\\^%c" "^%c"))
- new)
- (while (setq p (string-match pat a p))
- (if (setq new (assq (aref a p) codes))
- (setq a (concat (substring a 0 p)
- (cdr new)
- (substring a (1+ p)))
- p (+ p (length (cdr new))))
- (setq a (concat (substring a 0 p)
- (format fmt (+ (aref a p) 64))
- (substring a (1+ p)))
- p (+ p 2))))))
- (if quoted
- (concat "\"" a "\"")
- a))
-
-
-(defun math-to-underscores (x)
- (if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)
- (math-to-underscores
- (concat (math-match-substring x 1) "_" (math-match-substring x 2)))
- x))
-
-(defun math-tex-expr-is-flat (a)
- (or (Math-integerp a)
- (memq (car a) '(float var))
- (and (memq (car a) '(+ - * neg))
- (progn
- (while (and (setq a (cdr a))
- (math-tex-expr-is-flat (car a))))
- (null a)))
- (and (memq (car a) '(^ calcFunc-subscr))
- (math-tex-expr-is-flat (nth 1 a)))))
-
-(put 'calcFunc-log 'math-compose-big 'math-compose-log)
-(defun math-compose-log (a prec)
- (and (= (length a) 3)
- (list 'horiz
- (list 'subscr "log"
- (let ((calc-language 'flat))
- (math-compose-expr (nth 2 a) 1000)))
- "("
- (math-compose-expr (nth 1 a) 1000)
- ")")))
-
-(put 'calcFunc-log10 'math-compose-big 'math-compose-log10)
-(defun math-compose-log10 (a prec)
- (and (= (length a) 2)
- (list 'horiz
- (list 'subscr "log" "10")
- "("
- (math-compose-expr (nth 1 a) 1000)
- ")")))
-
-(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
-(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
-(defun math-compose-deriv (a prec)
- (when (= (length a) 3)
- (math-compose-expr (list '/
- (list 'calcFunc-choriz
- (list 'vec
- '(calcFunc-string (vec ?d))
- (nth 1 a)))
- (list 'calcFunc-choriz
- (list 'vec
- '(calcFunc-string (vec ?d))
- (nth 2 a))))
- prec)))
-
-(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
-(defun math-compose-sqrt (a prec)
- (when (= (length a) 2)
- (let* ((c (math-compose-expr (nth 1 a) 0))
- (a (math-comp-ascent c))
- (d (math-comp-descent c))
- (h (+ a d))
- (w (math-comp-width c)))
- (list 'vleft
- a
- (concat (if (= h 1) " " " ")
- (make-string (+ w 2) ?\_))
- (list 'horiz
- (if (= h 1)
- "V"
- (append (list 'vleft (1- a))
- (make-list (1- h) " |")
- '("\\|")))
- " "
- c)))))
-
-(put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
-(defun math-compose-choose (a prec)
- (let ((a1 (math-compose-expr (nth 1 a) 0))
- (a2 (math-compose-expr (nth 2 a) 0)))
- (list 'horiz
- "("
- (list 'vcent
- (math-comp-height a1)
- a1 " " a2)
- ")")))
-
-(put 'calcFunc-integ 'math-compose-big 'math-compose-integ)
-(defun math-compose-integ (a prec)
- (and (memq (length a) '(3 5))
- (eq (car-safe (nth 2 a)) 'var)
- (let* ((parens (and (>= prec 196) (/= prec 1000)))
- (var (math-compose-expr (nth 2 a) 0))
- (over (and (eq (car-safe (nth 2 a)) 'var)
- (or (and (eq (car-safe (nth 1 a)) '/)
- (math-numberp (nth 1 (nth 1 a))))
- (and (eq (car-safe (nth 1 a)) '^)
- (math-looks-negp (nth 2 (nth 1 a)))))))
- (expr (math-compose-expr (if over
- (math-mul (nth 1 a)
- (math-build-var-name
- (format
- "d%s"
- (nth 1 (nth 2 a)))))
- (nth 1 a)) 185))
- (calc-language 'flat)
- (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
- (high (and (nth 4 a) (math-compose-expr (nth 4 a) 0))))
- (list 'horiz
- (if parens "(" "")
- (append (list 'vcent (if high 3 2))
- (and high (list (list 'horiz " " high)))
- '(" /"
- " | "
- " | "
- " | "
- "/ ")
- (and low (list (list 'horiz low " "))))
- expr
- (if over
- ""
- (list 'horiz " d" var))
- (if parens ")" "")))))
-
-(put 'calcFunc-sum 'math-compose-big 'math-compose-sum)
-(defun math-compose-sum (a prec)
- (and (memq (length a) '(3 5 6))
- (let* ((expr (math-compose-expr (nth 1 a) 185))
- (calc-language 'flat)
- (var (math-compose-expr (nth 2 a) 0))
- (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
- (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
- (list 'horiz
- (if (memq prec '(180 201)) "(" "")
- (append (list 'vcent (if high 3 2))
- (and high (list high))
- '("---- "
- "\\ "
- " > "
- "/ "
- "---- ")
- (if low
- (list (list 'horiz var " = " low))
- (list var)))
- (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
- " " "")
- expr
- (if (memq prec '(180 201)) ")" "")))))
-
-(put 'calcFunc-prod 'math-compose-big 'math-compose-prod)
-(defun math-compose-prod (a prec)
- (and (memq (length a) '(3 5 6))
- (let* ((expr (math-compose-expr (nth 1 a) 198))
- (calc-language 'flat)
- (var (math-compose-expr (nth 2 a) 0))
- (low (and (nth 3 a) (math-compose-expr (nth 3 a) 0)))
- (high (and (nth 4 a) (math-compose-vector (nthcdr 4 a) ", " 0))))
- (list 'horiz
- (if (memq prec '(196 201)) "(" "")
- (append (list 'vcent (if high 3 2))
- (and high (list high))
- '("----- "
- " | | "
- " | | "
- " | | ")
- (if low
- (list (list 'horiz var " = " low))
- (list var)))
- (if (memq (car-safe (nth 1 a)) '(calcFunc-sum calcFunc-prod))
- " " "")
- expr
- (if (memq prec '(196 201)) ")" "")))))
-
-
-(defun math-stack-value-offset-fancy ()
- (let ((cwid (+ (math-comp-width c))))
- (cond ((eq calc-display-just 'right)
- (if calc-display-origin
- (setq wid (max calc-display-origin 5))
- (if (integerp calc-line-breaking)
- (setq wid calc-line-breaking)))
- (setq off (- wid cwid
- (max (- (length calc-right-label)
- (if (and (integerp calc-line-breaking)
- calc-display-origin)
- (max (- calc-line-breaking
- calc-display-origin)
- 0)
- 0))
- 0))))
- (t
- (if calc-display-origin
- (progn
- (setq off (- calc-display-origin (/ cwid 2)))
- (if (integerp calc-line-breaking)
- (setq off (min off (- calc-line-breaking cwid
- (length calc-right-label)))))
- (if (>= off 0)
- (setq wid (max wid (+ off cwid)))))
- (if (integerp calc-line-breaking)
- (setq wid calc-line-breaking))
- (setq off (/ (- wid cwid) 2)))))
- (and (integerp calc-line-breaking)
- (or (< off 0)
- (and calc-display-origin
- (> calc-line-breaking calc-display-origin)))
- (setq wid calc-line-breaking))))
-
-
-
-;;; Convert a composition to string form, with embedded \n's if necessary.
-
-(defun math-composition-to-string (c &optional width)
- (or width (setq width (calc-window-width)))
- (if calc-display-raw
- (math-comp-to-string-raw c 0)
- (if (math-comp-is-flat c)
- (math-comp-to-string-flat c width)
- (math-vert-comp-to-string
- (math-comp-simplify c width)))))
-
-(defvar math-comp-buf-string (make-vector 10 ""))
-(defvar math-comp-buf-margin (make-vector 10 0))
-(defvar math-comp-buf-level (make-vector 10 0))
-(defun math-comp-is-flat (c) ; check if c's height is 1.
- (cond ((not (consp c)) t)
- ((memq (car c) '(set break)) t)
- ((eq (car c) 'horiz)
- (while (and (setq c (cdr c))
- (math-comp-is-flat (car c))))
- (null c))
- ((memq (car c) '(vleft vcent vright))
- (and (= (length c) 3)
- (= (nth 1 c) 0)
- (math-comp-is-flat (nth 2 c))))
- ((eq (car c) 'tag)
- (math-comp-is-flat (nth 2 c)))
- (t nil)))
-
-
-;;; Convert a one-line composition to a string. Break into multiple
-;;; lines if necessary, choosing break points according to the structure
-;;; of the formula.
-
-(defun math-comp-to-string-flat (c full-width)
- (if math-comp-sel-hpos
- (let ((comp-pos 0))
- (math-comp-sel-flat-term c))
- (let ((comp-buf "")
- (comp-word "")
- (comp-pos 0)
- (comp-margin 0)
- (comp-highlight (and math-comp-selected calc-show-selections))
- (comp-level -1))
- (math-comp-to-string-flat-term '(set -1 0))
- (math-comp-to-string-flat-term c)
- (math-comp-to-string-flat-term '(break -1))
- (let ((str (aref math-comp-buf-string 0))
- (prefix ""))
- (and (> (length str) 0) (= (aref str 0) ? )
- (> (length comp-buf) 0)
- (let ((k (length comp-buf)))
- (while (not (= (aref comp-buf (setq k (1- k))) ?\n)))
- (aset comp-buf k ? )
- (if (and (< (1+ k) (length comp-buf))
- (= (aref comp-buf (1+ k)) ? ))
- (progn
- (aset comp-buf (1+ k) ?\n)
- (setq prefix " "))
- (setq prefix "\n"))))
- (concat comp-buf prefix str)))))
-
-(defun math-comp-to-string-flat-term (c)
- (cond ((not (consp c))
- (if comp-highlight
- (setq c (math-comp-highlight-string c)))
- (setq comp-word (if (= (length comp-word) 0) c (concat comp-word c))
- comp-pos (+ comp-pos (length c))))
-
- ((eq (car c) 'horiz)
- (while (setq c (cdr c))
- (math-comp-to-string-flat-term (car c))))
-
- ((eq (car c) 'set)
- (if (nth 1 c)
- (progn
- (setq comp-level (1+ comp-level))
- (if (>= comp-level (length math-comp-buf-string))
- (setq math-comp-buf-string (vconcat math-comp-buf-string
- math-comp-buf-string)
- math-comp-buf-margin (vconcat math-comp-buf-margin
- math-comp-buf-margin)
- math-comp-buf-level (vconcat math-comp-buf-level
- math-comp-buf-level)))
- (aset math-comp-buf-string comp-level "")
- (aset math-comp-buf-margin comp-level (+ comp-pos
- (or (nth 2 c) 0)))
- (aset math-comp-buf-level comp-level (nth 1 c)))))
-
- ((eq (car c) 'break)
- (if (not calc-line-breaking)
- (setq comp-buf (concat comp-buf comp-word)
- comp-word "")
- (let ((i 0) str)
- (if (and (> comp-pos full-width)
- (progn
- (while (progn
- (setq str (aref math-comp-buf-string i))
- (and (= (length str) 0) (< i comp-level)))
- (setq i (1+ i)))
- (or (> (length str) 0) (> (length comp-buf) 0))))
- (let ((prefix "") mrg wid)
- (setq mrg (aref math-comp-buf-margin i))
- (if (> mrg 12) ; indenting too far, go back to far left
- (let ((j i) (new (if calc-line-numbering 5 1)))
- '(while (<= j comp-level)
- (aset math-comp-buf-margin j
- (+ (aref math-comp-buf-margin j) (- new mrg)))
- (setq j (1+ j)))
- (setq mrg new)))
- (setq wid (+ (length str) comp-margin))
- (and (> (length str) 0) (= (aref str 0) ? )
- (> (length comp-buf) 0)
- (let ((k (length comp-buf)))
- (while (not (= (aref comp-buf (setq k (1- k))) ?\n)))
- (aset comp-buf k ? )
- (if (and (< (1+ k) (length comp-buf))
- (= (aref comp-buf (1+ k)) ? ))
- (progn
- (aset comp-buf (1+ k) ?\n)
- (setq prefix " "))
- (setq prefix "\n"))))
- (setq comp-buf (concat comp-buf prefix str "\n"
- (make-string mrg ? ))
- comp-pos (+ comp-pos (- mrg wid))
- comp-margin mrg)
- (aset math-comp-buf-string i "")
- (while (<= (setq i (1+ i)) comp-level)
- (if (> (aref math-comp-buf-margin i) wid)
- (aset math-comp-buf-margin i
- (+ (aref math-comp-buf-margin i)
- (- mrg wid))))))))
- (if (and (= (nth 1 c) (aref math-comp-buf-level comp-level))
- (< comp-pos (+ (aref math-comp-buf-margin comp-level) 2)))
- () ; avoid stupid breaks, e.g., "1 +\n really_long_expr"
- (let ((str (aref math-comp-buf-string comp-level)))
- (setq str (if (= (length str) 0)
- comp-word
- (concat str comp-word))
- comp-word "")
- (while (< (nth 1 c) (aref math-comp-buf-level comp-level))
- (setq comp-level (1- comp-level))
- (or (= (length (aref math-comp-buf-string comp-level)) 0)
- (setq str (concat (aref math-comp-buf-string comp-level)
- str))))
- (aset math-comp-buf-string comp-level str)))))
-
- ((eq (car c) 'tag)
- (cond ((eq (nth 1 c) math-comp-selected)
- (let ((comp-highlight (not calc-show-selections)))
- (math-comp-to-string-flat-term (nth 2 c))))
- ((eq (nth 1 c) t)
- (let ((comp-highlight nil))
- (math-comp-to-string-flat-term (nth 2 c))))
- (t (math-comp-to-string-flat-term (nth 2 c)))))
-
- (t (math-comp-to-string-flat-term (nth 2 c)))))
-
-(defun math-comp-highlight-string (s)
- (setq s (copy-sequence s))
- (let ((i (length s)))
- (while (>= (setq i (1- i)) 0)
- (or (memq (aref s i) '(32 ?\n))
- (aset s i (if calc-show-selections ?\. ?\#)))))
- s)
-
-(defun math-comp-sel-flat-term (c)
- (cond ((not (consp c))
- (setq comp-pos (+ comp-pos (length c))))
- ((memq (car c) '(set break)))
- ((eq (car c) 'horiz)
- (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000))
- (math-comp-sel-flat-term (car c))))
- ((eq (car c) 'tag)
- (if (<= comp-pos math-comp-sel-cpos)
- (progn
- (math-comp-sel-flat-term (nth 2 c))
- (if (> comp-pos math-comp-sel-cpos)
- (setq math-comp-sel-tag c
- math-comp-sel-cpos 1000000)))
- (math-comp-sel-flat-term (nth 2 c))))
- (t (math-comp-sel-flat-term (nth 2 c)))))
-
-
-;;; Simplify a composition to a canonical form consisting of
-;;; (vleft n "string" "string" "string" ...)
-;;; where 0 <= n < number-of-strings.
-
-(defun math-comp-simplify (c full-width)
- (let ((comp-buf (list ""))
- (comp-base 0)
- (comp-height 1)
- (comp-hpos 0)
- (comp-vpos 0)
- (comp-highlight (and math-comp-selected calc-show-selections))
- (comp-tag nil))
- (math-comp-simplify-term c)
- (cons 'vleft (cons comp-base comp-buf))))
-
-(defun math-comp-add-string (s h v)
- (and (> (length s) 0)
- (let ((vv (+ v comp-base)))
- (if math-comp-sel-hpos
- (math-comp-add-string-sel h vv (length s) 1)
- (if (< vv 0)
- (setq comp-buf (nconc (make-list (- vv) "") comp-buf)
- comp-base (- v)
- comp-height (- comp-height vv)
- vv 0)
- (if (>= vv comp-height)
- (setq comp-buf (nconc comp-buf
- (make-list (1+ (- vv comp-height)) ""))
- comp-height (1+ vv))))
- (let ((str (nthcdr vv comp-buf)))
- (setcar str (concat (car str)
- (make-string (- h (length (car str))) 32)
- (if comp-highlight
- (math-comp-highlight-string s)
- s))))))))
-
-(defun math-comp-add-string-sel (x y w h)
- (if (and (<= y math-comp-sel-vpos)
- (> (+ y h) math-comp-sel-vpos)
- (<= x math-comp-sel-hpos)
- (> (+ x w) math-comp-sel-hpos))
- (setq math-comp-sel-tag comp-tag
- math-comp-sel-vpos 10000)))
-
-(defun math-comp-simplify-term (c)
- (cond ((stringp c)
- (math-comp-add-string c comp-hpos comp-vpos)
- (setq comp-hpos (+ comp-hpos (length c))))
- ((memq (car c) '(set break))
- nil)
- ((eq (car c) 'horiz)
- (while (setq c (cdr c))
- (math-comp-simplify-term (car c))))
- ((memq (car c) '(vleft vcent vright))
- (let* ((comp-vpos (+ (- comp-vpos (nth 1 c))
- (1- (math-comp-ascent (nth 2 c)))))
- (widths (mapcar 'math-comp-width (cdr (cdr c))))
- (maxwid (apply 'max widths))
- (bias (cond ((eq (car c) 'vleft) 0)
- ((eq (car c) 'vcent) 1)
- (t 2))))
- (setq c (cdr c))
- (while (setq c (cdr c))
- (if (eq (car-safe (car c)) 'rule)
- (math-comp-add-string (make-string maxwid (nth 1 (car c)))
- comp-hpos comp-vpos)
- (let ((comp-hpos (+ comp-hpos (/ (* bias (- maxwid
- (car widths)))
- 2))))
- (math-comp-simplify-term (car c))))
- (and (cdr c)
- (setq comp-vpos (+ comp-vpos
- (+ (math-comp-descent (car c))
- (math-comp-ascent (nth 1 c))))
- widths (cdr widths))))
- (setq comp-hpos (+ comp-hpos maxwid))))
- ((eq (car c) 'supscr)
- (let* ((asc (or 1 (math-comp-ascent (nth 1 c))))
- (desc (math-comp-descent (nth 2 c)))
- (oldh (prog1
- comp-hpos
- (math-comp-simplify-term (nth 1 c))))
- (comp-vpos (- comp-vpos (+ asc desc))))
- (math-comp-simplify-term (nth 2 c))
- (if math-comp-sel-hpos
- (math-comp-add-string-sel oldh
- (- comp-vpos
- -1
- (math-comp-ascent (nth 2 c)))
- (- comp-hpos oldh)
- (math-comp-height c)))))
- ((eq (car c) 'subscr)
- (let* ((asc (math-comp-ascent (nth 2 c)))
- (desc (math-comp-descent (nth 1 c)))
- (oldv comp-vpos)
- (oldh (prog1
- comp-hpos
- (math-comp-simplify-term (nth 1 c))))
- (comp-vpos (+ comp-vpos (+ asc desc))))
- (math-comp-simplify-term (nth 2 c))
- (if math-comp-sel-hpos
- (math-comp-add-string-sel oldh oldv
- (- comp-hpos oldh)
- (math-comp-height c)))))
- ((eq (car c) 'tag)
- (cond ((eq (nth 1 c) math-comp-selected)
- (let ((comp-highlight (not calc-show-selections)))
- (math-comp-simplify-term (nth 2 c))))
- ((eq (nth 1 c) t)
- (let ((comp-highlight nil))
- (math-comp-simplify-term (nth 2 c))))
- (t (let ((comp-tag c))
- (math-comp-simplify-term (nth 2 c))))))))
-
-
-;;; Measuring a composition.
-
-(defun math-comp-first-char (c)
- (cond ((stringp c)
- (and (> (length c) 0)
- (elt c 0)))
- ((memq (car c) '(horiz subscr supscr))
- (while (and (setq c (cdr c))
- (math-comp-is-null (car c))))
- (and c (math-comp-first-char (car c))))
- ((eq (car c) 'tag)
- (math-comp-first-char (nth 2 c)))))
-
-(defun math-comp-first-string (c)
- (cond ((stringp c)
- (and (> (length c) 0)
- c))
- ((eq (car c) 'horiz)
- (while (and (setq c (cdr c))
- (math-comp-is-null (car c))))
- (and c (math-comp-first-string (car c))))
- ((eq (car c) 'tag)
- (math-comp-first-string (nth 2 c)))))
-
-(defun math-comp-last-char (c)
- (cond ((stringp c)
- (and (> (length c) 0)
- (elt c (1- (length c)))))
- ((eq (car c) 'horiz)
- (let ((c (reverse (cdr c))))
- (while (and c (math-comp-is-null (car c)))
- (setq c (cdr c)))
- (and c (math-comp-last-char (car c)))))
- ((eq (car c) 'tag)
- (math-comp-last-char (nth 2 c)))))
-
-(defun math-comp-is-null (c)
- (cond ((stringp c) (= (length c) 0))
- ((memq (car c) '(horiz subscr supscr))
- (while (and (setq c (cdr c))
- (math-comp-is-null (car c))))
- (null c))
- ((eq (car c) 'tag)
- (math-comp-is-null (nth 2 c)))
- ((memq (car c) '(set break)) t)))
-
-(defun math-comp-width (c)
- (cond ((not (consp c)) (length c))
- ((memq (car c) '(horiz subscr supscr))
- (let ((accum 0))
- (while (setq c (cdr c))
- (setq accum (+ accum (math-comp-width (car c)))))
- accum))
- ((memq (car c) '(vcent vleft vright))
- (setq c (cdr c))
- (let ((accum 0))
- (while (setq c (cdr c))
- (setq accum (max accum (math-comp-width (car c)))))
- accum))
- ((eq (car c) 'tag)
- (math-comp-width (nth 2 c)))
- (t 0)))
-
-(defun math-comp-height (c)
- (if (stringp c)
- 1
- (+ (math-comp-ascent c) (math-comp-descent c))))
-
-(defun math-comp-ascent (c)
- (cond ((not (consp c)) 1)
- ((eq (car c) 'horiz)
- (let ((accum 0))
- (while (setq c (cdr c))
- (setq accum (max accum (math-comp-ascent (car c)))))
- accum))
- ((memq (car c) '(vcent vleft vright))
- (if (> (nth 1 c) 0) (1+ (nth 1 c)) 1))
- ((eq (car c) 'supscr)
- (max (math-comp-ascent (nth 1 c)) (1+ (math-comp-height (nth 2 c)))))
- ((eq (car c) 'subscr)
- (math-comp-ascent (nth 1 c)))
- ((eq (car c) 'tag)
- (math-comp-ascent (nth 2 c)))
- (t 1)))
-
-(defun math-comp-descent (c)
- (cond ((not (consp c)) 0)
- ((eq (car c) 'horiz)
- (let ((accum 0))
- (while (setq c (cdr c))
- (setq accum (max accum (math-comp-descent (car c)))))
- accum))
- ((memq (car c) '(vcent vleft vright))
- (let ((accum (- (nth 1 c))))
- (setq c (cdr c))
- (while (setq c (cdr c))
- (setq accum (+ accum (math-comp-height (car c)))))
- (max (1- accum) 0)))
- ((eq (car c) 'supscr)
- (math-comp-descent (nth 1 c)))
- ((eq (car c) 'subscr)
- (+ (math-comp-descent (nth 1 c)) (math-comp-height (nth 2 c))))
- ((eq (car c) 'tag)
- (math-comp-descent (nth 2 c)))
- (t 0)))
-
-(defun calcFunc-cwidth (a &optional prec)
- (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
- (math-comp-width (math-compose-expr a (or prec 0))))
-
-(defun calcFunc-cheight (a &optional prec)
- (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
- (if (and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
- (memq (length a) '(2 3))
- (eq (nth 1 a) 0))
- 0
- (math-comp-height (math-compose-expr a (or prec 0)))))
-
-(defun calcFunc-cascent (a &optional prec)
- (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
- (if (and (memq (car a) '(calcFunc-cvspace calcFunc-ctspace calcFunc-cbspace))
- (memq (length a) '(2 3))
- (eq (nth 1 a) 0))
- 0
- (math-comp-ascent (math-compose-expr a (or prec 0)))))
-
-(defun calcFunc-cdescent (a &optional prec)
- (if (and prec (not (integerp prec))) (math-reject-arg prec 'fixnump))
- (math-comp-descent (math-compose-expr a (or prec 0))))
-
-
-;;; Convert a simplified composition into string form.
-
-(defun math-vert-comp-to-string (c)
- (if (stringp c)
- c
- (math-vert-comp-to-string-step (cdr (cdr c)))))
-
-(defun math-vert-comp-to-string-step (c)
- (if (cdr c)
- (concat (car c) "\n" (math-vert-comp-to-string-step (cdr c)))
- (car c)))
-
-
-;;; Convert a composition to a string in "raw" form (for debugging).
-
-(defun math-comp-to-string-raw (c indent)
- (cond ((or (not (consp c)) (eq (car c) 'set))
- (prin1-to-string c))
- ((null (cdr c))
- (concat "(" (symbol-name (car c)) ")"))
- (t
- (let ((next-indent (+ indent 2 (length (symbol-name (car c))))))
- (concat "("
- (symbol-name (car c))
- " "
- (math-comp-to-string-raw (nth 1 c) next-indent)
- (math-comp-to-string-raw-step (cdr (cdr c))
- next-indent)
- ")")))))
-
-(defun math-comp-to-string-raw-step (cl indent)
- (if cl
- (concat "\n"
- (make-string indent 32)
- (math-comp-to-string-raw (car cl) indent)
- (math-comp-to-string-raw-step (cdr cl) indent))
- ""))
-
-;;; calccomp.el ends here
+++ /dev/null
-;;; calcsel2.el --- selection functions for Calc
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
-
-;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainers: D. Goel <deego@gnufans.org>
-;; Colin Walters <walters@debian.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Code:
-
-;; This file is autoloaded from calc-ext.el.
-(require 'calc-ext)
-
-(require 'calc-macs)
-
-(defun calc-Need-calc-sel-2 () nil)
-
-
-(defun calc-commute-left (arg)
- (interactive "p")
- (if (< arg 0)
- (calc-commute-right (- arg))
- (calc-wrapper
- (calc-preserve-point)
- (let ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection))
- (if (= arg 0) (setq arg nil))
- (while (or (null arg) (>= (setq arg (1- arg)) 0))
- (let* ((entry (calc-top num 'entry))
- (expr (car entry))
- (sel (calc-auto-selection entry))
- parent new)
- (or (and sel
- (consp (setq parent (calc-find-assoc-parent-formula
- expr sel))))
- (error "No term is selected"))
- (if (and calc-assoc-selections
- (assq (car parent) calc-assoc-ops))
- (let ((outer (calc-find-parent-formula parent sel)))
- (if (eq sel (nth 2 outer))
- (setq new (calc-replace-sub-formula
- parent outer
- (cond
- ((memq (car outer)
- (nth 1 (assq (car-safe (nth 1 outer))
- calc-assoc-ops)))
- (let* ((other (nth 2 (nth 1 outer)))
- (new (calc-build-assoc-term
- (car (nth 1 outer))
- (calc-build-assoc-term
- (car outer)
- (nth 1 (nth 1 outer))
- sel)
- other)))
- (setq sel (nth 2 (nth 1 new)))
- new))
- ((eq (car outer) '-)
- (calc-build-assoc-term
- '+
- (setq sel (math-neg sel))
- (nth 1 outer)))
- ((eq (car outer) '/)
- (calc-build-assoc-term
- '*
- (setq sel (calcFunc-div 1 sel))
- (nth 1 outer)))
- (t (calc-build-assoc-term
- (car outer) sel (nth 1 outer))))))
- (let ((next (calc-find-parent-formula parent outer)))
- (if (not (and (consp next)
- (eq outer (nth 2 next))
- (eq (car next) (car outer))))
- (setq new nil)
- (setq new (calc-build-assoc-term
- (car next)
- sel
- (calc-build-assoc-term
- (car next) (nth 1 next) (nth 2 outer)))
- sel (nth 1 new)
- new (calc-replace-sub-formula
- parent next new))))))
- (if (eq (nth 1 parent) sel)
- (setq new nil)
- (let ((p (nthcdr (1- (calc-find-sub-formula parent sel))
- (setq new (copy-sequence parent)))))
- (setcar (cdr p) (car p))
- (setcar p sel))))
- (if (null new)
- (if arg
- (error "Term is already leftmost")
- (or reselect
- (calc-pop-push-list 1 (list expr) num '(nil)))
- (setq arg 0))
- (calc-pop-push-record-list
- 1 "left"
- (list (calc-replace-sub-formula expr parent new))
- num
- (list (and (or (not (eq arg 0)) reselect)
- sel))))))))))
-
-(defun calc-commute-right (arg)
- (interactive "p")
- (if (< arg 0)
- (calc-commute-left (- arg))
- (calc-wrapper
- (calc-preserve-point)
- (let ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection))
- (if (= arg 0) (setq arg nil))
- (while (or (null arg) (>= (setq arg (1- arg)) 0))
- (let* ((entry (calc-top num 'entry))
- (expr (car entry))
- (sel (calc-auto-selection entry))
- parent new)
- (or (and sel
- (consp (setq parent (calc-find-assoc-parent-formula
- expr sel))))
- (error "No term is selected"))
- (if (and calc-assoc-selections
- (assq (car parent) calc-assoc-ops))
- (let ((outer (calc-find-parent-formula parent sel)))
- (if (eq sel (nth 1 outer))
- (setq new (calc-replace-sub-formula
- parent outer
- (if (memq (car outer)
- (nth 2 (assq (car-safe (nth 2 outer))
- calc-assoc-ops)))
- (let ((other (nth 1 (nth 2 outer))))
- (calc-build-assoc-term
- (car outer)
- other
- (calc-build-assoc-term
- (car (nth 2 outer))
- sel
- (nth 2 (nth 2 outer)))))
- (let ((new (cond
- ((eq (car outer) '-)
- (calc-build-assoc-term
- '+
- (math-neg (nth 2 outer))
- sel))
- ((eq (car outer) '/)
- (calc-build-assoc-term
- '*
- (calcFunc-div 1 (nth 2 outer))
- sel))
- (t (calc-build-assoc-term
- (car outer)
- (nth 2 outer)
- sel)))))
- (setq sel (nth 2 new))
- new))))
- (let ((next (calc-find-parent-formula parent outer)))
- (if (not (and (consp next)
- (eq outer (nth 1 next))))
- (setq new nil)
- (setq new (calc-build-assoc-term
- (car outer)
- (calc-build-assoc-term
- (car next) (nth 1 outer) (nth 2 next))
- sel)
- sel (nth 2 new)
- new (calc-replace-sub-formula
- parent next new))))))
- (if (eq (nth (1- (length parent)) parent) sel)
- (setq new nil)
- (let ((p (nthcdr (calc-find-sub-formula parent sel)
- (setq new (copy-sequence parent)))))
- (setcar p (nth 1 p))
- (setcar (cdr p) sel))))
- (if (null new)
- (if arg
- (error "Term is already rightmost")
- (or reselect
- (calc-pop-push-list 1 (list expr) num '(nil)))
- (setq arg 0))
- (calc-pop-push-record-list
- 1 "rght"
- (list (calc-replace-sub-formula expr parent new))
- num
- (list (and (or (not (eq arg 0)) reselect)
- sel))))))))))
-
-(defun calc-build-assoc-term (op lhs rhs)
- (cond ((and (eq op '+) (or (math-looks-negp rhs)
- (and (eq (car-safe rhs) 'cplx)
- (math-negp (nth 1 rhs))
- (eq (nth 2 rhs) 0))))
- (list '- lhs (math-neg rhs)))
- ((and (eq op '-) (or (math-looks-negp rhs)
- (and (eq (car-safe rhs) 'cplx)
- (math-negp (nth 1 rhs))
- (eq (nth 2 rhs) 0))))
- (list '+ lhs (math-neg rhs)))
- ((and (eq op '*) (and (eq (car-safe rhs) '/)
- (or (math-equal-int (nth 1 rhs) 1)
- (equal (nth 1 rhs) '(cplx 1 0)))))
- (list '/ lhs (nth 2 rhs)))
- ((and (eq op '/) (and (eq (car-safe rhs) '/)
- (or (math-equal-int (nth 1 rhs) 1)
- (equal (nth 1 rhs) '(cplx 1 0)))))
- (list '/ lhs (nth 2 rhs)))
- (t (list op lhs rhs))))
-
-(defun calc-sel-unpack ()
- (interactive)
- (calc-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection)
- (entry (calc-top num 'entry))
- (expr (car entry))
- (sel (or (calc-auto-selection entry) expr)))
- (or (and (not (math-primp sel))
- (= (length sel) 2))
- (error "Selection must be a function of one argument"))
- (calc-pop-push-record-list 1 "unpk"
- (list (calc-replace-sub-formula
- expr sel (nth 1 sel)))
- num
- (list (and reselect (nth 1 sel)))))))
-
-(defun calc-sel-isolate ()
- (interactive)
- (calc-slow-wrapper
- (calc-preserve-point)
- (let* ((num (max 1 (calc-locate-cursor-element (point))))
- (reselect calc-keep-selection)
- (entry (calc-top num 'entry))
- (expr (car entry))
- (sel (or (calc-auto-selection entry) (error "No selection")))
- (eqn sel)
- soln)
- (while (and (or (consp (setq eqn (calc-find-parent-formula expr eqn)))
- (error "Selection must be a member of an equation"))
- (not (assq (car eqn) calc-tweak-eqn-table))))
- (setq soln (math-solve-eqn eqn sel calc-hyperbolic-flag))
- (or soln
- (error "No solution found"))
- (setq soln (calc-encase-atoms
- (if (eq (not (calc-find-sub-formula (nth 2 eqn) sel))
- (eq (nth 1 soln) sel))
- soln
- (list (nth 1 (assq (car soln) calc-tweak-eqn-table))
- (nth 2 soln)
- (nth 1 soln)))))
- (calc-pop-push-record-list 1 "isol"
- (list (calc-replace-sub-formula
- expr eqn soln))
- num
- (list (and reselect sel)))
- (calc-handle-whys))))
-
-(defun calc-sel-commute (many)
- (interactive "P")
- (let ((calc-assoc-selections nil))
- (calc-rewrite-selection "CommuteRules" many "cmut"))
- (calc-set-mode-line))
-
-(defun calc-sel-jump-equals (many)
- (interactive "P")
- (calc-rewrite-selection "JumpRules" many "jump"))
-
-(defun calc-sel-distribute (many)
- (interactive "P")
- (calc-rewrite-selection "DistribRules" many "dist"))
-
-(defun calc-sel-merge (many)
- (interactive "P")
- (calc-rewrite-selection "MergeRules" many "merg"))
-
-(defun calc-sel-negate (many)
- (interactive "P")
- (calc-rewrite-selection "NegateRules" many "jneg"))
-
-(defun calc-sel-invert (many)
- (interactive "P")
- (calc-rewrite-selection "InvertRules" many "jinv"))
-
-;;; calcsel2.el ends here
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996,97,1999,2000,01,02,2003 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
;; If we pass BUFFER to `bury-buffer', the buffer isn't removed from
;; the window.
(defun custom-bury-buffer (buffer)
- (with-current-buffer buffer
- (bury-buffer)))
+ (bury-buffer))
(defcustom custom-buffer-done-function 'custom-bury-buffer
"*Function called to remove a Custom buffer when the user is done with it.
:type 'integer
:group 'custom-buffer)
-(defun custom-get-fresh-buffer (name)
- "Get a fresh new buffer with name NAME.
-If the buffer already exist, clean it up to be like new.
-Beware: it's not quite like new. Good enough for custom, but maybe
-not for everybody."
- ;; To be more complete, we should also kill all permanent-local variables,
- ;; but it's not needed for custom.
- (let ((buf (get-buffer name)))
- (when (buffer-local-value 'buffer-file-name buf)
- ;; This will check if the file is not saved.
- (kill-buffer buf)
- (setq buf nil))
- (if (null buf)
- (get-buffer-create name)
- (with-current-buffer buf
- (kill-all-local-variables)
- (run-hooks 'kill-buffer-hook)
- (erase-buffer)
- (let ((ols (overlay-lists)))
- (dolist (ol (nconc (car ols) (cdr ols)))
- (delete-overlay ol)))
- buf))))
-
;;;###autoload
(defun custom-buffer-create (options &optional name description)
"Create a buffer containing OPTIONS.
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
that option."
- (pop-to-buffer (custom-get-fresh-buffer (or name "*Customization*")))
+ (unless name (setq name "*Customization*"))
+ (kill-buffer (get-buffer-create name))
+ (pop-to-buffer (get-buffer-create name))
(custom-buffer-create-internal options description))
;;;###autoload
SYMBOL is a customization option, and WIDGET is a widget for editing
that option."
(unless name (setq name "*Customization*"))
+ (kill-buffer (get-buffer-create name))
(let ((window (selected-window))
(pop-up-windows t)
(special-display-buffer-names nil)
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (pop-to-buffer (custom-get-fresh-buffer name))
+ (pop-to-buffer (get-buffer-create name))
(custom-buffer-create-internal options description)
(select-window window)))
(unless group
(setq group 'emacs))
(let ((name "*Customize Browser*"))
- (pop-to-buffer (custom-get-fresh-buffer name)))
+ (kill-buffer (get-buffer-create name))
+ (pop-to-buffer (get-buffer-create name)))
(custom-mode)
(widget-insert "\
Square brackets show active fields; type RET or click mouse-1
becomes the backup value, so you can get it again."
(let* ((symbol (widget-value widget))
(set (or (get symbol 'custom-set) 'set-default))
+ (comment-widget (widget-get widget :comment-widget))
(value (get symbol 'saved-value))
(comment (get symbol 'saved-variable-comment)))
(cond ((or value comment)
The value that was current before this operation
becomes the backup value, so you can get it again."
(let* ((symbol (widget-value widget))
- (set (or (get symbol 'custom-set) 'set-default)))
+ (set (or (get symbol 'custom-set) 'set-default))
+ (comment-widget (widget-get widget :comment-widget)))
(if (get symbol 'standard-value)
(progn
(custom-variable-backup-value widget)
(unless (widget-get widget :inactive)
(let ((tag (custom-face-edit-attribute-tag widget))
(from (copy-marker (widget-get widget :from)))
+ (to (widget-get widget :to))
(value (widget-value widget))
(inhibit-read-only t)
(inhibit-modification-hooks t))
(and (not (boundp symbol))
(not (eq (get symbol 'force-value)
'rogue))))))
- (comment (get symbol 'saved-variable-comment)))
+ (comment (get symbol 'saved-variable-comment))
+ sep)
;; Check `requests'.
(dolist (request requests)
(when (and (symbolp request) (not (featurep request)))
--- /dev/null
+;;; derived.el --- allow inheritance of major modes
+;;; (formerly mode-clone.el)
+
+;; Copyright (C) 1993, 1994, 1999, 2003 Free Software Foundation, Inc.
+
+;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
+;; Maintainer: FSF
+;; Keywords: extensions
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+\f
+;;; Commentary:
+
+;; GNU Emacs is already, in a sense, object oriented -- each object
+;; (buffer) belongs to a class (major mode), and that class defines
+;; the relationship between messages (input events) and methods
+;; (commands) by means of a keymap.
+;;
+;; The only thing missing is a good scheme of inheritance. It is
+;; possible to simulate a single level of inheritance with generous
+;; use of hooks and a bit of work -- sgml-mode, for example, also runs
+;; the hooks for text-mode, and keymaps can inherit from other keymaps
+;; -- but generally, each major mode ends up reinventing the wheel.
+;; Ideally, someone should redesign all of Emacs's major modes to
+;; follow a more conventional object-oriented system: when defining a
+;; new major mode, the user should need only to name the existing mode
+;; it is most similar to, then list the (few) differences.
+;;
+;; In the mean time, this package offers most of the advantages of
+;; full inheritance with the existing major modes. The macro
+;; `define-derived-mode' allows the user to make a variant of an existing
+;; major mode, with its own keymap. The new mode will inherit the key
+;; bindings of its parent, and will, in fact, run its parent first
+;; every time it is called. For example, the commands
+;;
+;; (define-derived-mode hypertext-mode text-mode "Hypertext"
+;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}"
+;; (setq case-fold-search nil))
+;;
+;; (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link)
+;;
+;; will create a function `hypertext-mode' with its own (sparse)
+;; keymap `hypertext-mode-map.' The command M-x hypertext-mode will
+;; perform the following actions:
+;;
+;; - run the command (text-mode) to get its default setup
+;; - replace the current keymap with 'hypertext-mode-map,' which will
+;; inherit from 'text-mode-map'.
+;; - replace the current syntax table with
+;; 'hypertext-mode-syntax-table', which will borrow its defaults
+;; from the current text-mode-syntax-table.
+;; - replace the current abbrev table with
+;; 'hypertext-mode-abbrev-table', which will borrow its defaults
+;; from the current text-mode-abbrev table
+;; - change the mode line to read "Hypertext"
+;; - assign the value 'hypertext-mode' to the 'major-mode' variable
+;; - run the body of commands provided in the macro -- in this case,
+;; set the local variable `case-fold-search' to nil.
+;;
+;; The advantages of this system are threefold. First, text mode is
+;; untouched -- if you had added the new keystroke to `text-mode-map,'
+;; possibly using hooks, you would have added it to all text buffers
+;; -- here, it appears only in hypertext buffers, where it makes
+;; sense. Second, it is possible to build even further, and make
+;; a derived mode from a derived mode. The commands
+;;
+;; (define-derived-mode html-mode hypertext-mode "HTML")
+;; [various key definitions]
+;;
+;; will add a new major mode for HTML with very little fuss.
+;;
+;; Note also the function `derived-mode-p' which can tell if the current
+;; mode derives from another. In a hypertext-mode, buffer, for example,
+;; (derived-mode-p 'text-mode) would return non-nil. This should always
+;; be used in place of (eq major-mode 'text-mode).
+\f
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+;;; PRIVATE: defsubst must be defined before they are first used
+
+(defsubst derived-mode-hook-name (mode)
+ "Construct the mode hook name based on mode name MODE."
+ (intern (concat (symbol-name mode) "-hook")))
+
+(defsubst derived-mode-map-name (mode)
+ "Construct a map name based on a MODE name."
+ (intern (concat (symbol-name mode) "-map")))
+
+(defsubst derived-mode-syntax-table-name (mode)
+ "Construct a syntax-table name based on a MODE name."
+ (intern (concat (symbol-name mode) "-syntax-table")))
+
+(defsubst derived-mode-abbrev-table-name (mode)
+ "Construct an abbrev-table name based on a MODE name."
+ (intern (concat (symbol-name mode) "-abbrev-table")))
+
+;; PUBLIC: define a new major mode which inherits from an existing one.
+
+;;;###autoload
+(defmacro define-derived-mode (child parent name &optional docstring &rest body)
+ "Create a new mode as a variant of an existing mode.
+
+The arguments to this command are as follow:
+
+CHILD: the name of the command for the derived mode.
+PARENT: the name of the command for the parent mode (e.g. `text-mode')
+ or nil if there is no parent.
+NAME: a string which will appear in the status line (e.g. \"Hypertext\")
+DOCSTRING: an optional documentation string--if you do not supply one,
+ the function will attempt to invent something useful.
+BODY: forms to execute just before running the
+ hooks for the new mode. Do not use `interactive' here.
+
+BODY can start with a bunch of keyword arguments. The following keyword
+ arguments are currently understood:
+:group GROUP
+ Declare the customization group that corresponds to this mode.
+:syntax-table TABLE
+ Use TABLE instead of the default.
+ A nil value means to simply use the same syntax-table as the parent.
+:abbrev-table TABLE
+ Use TABLE instead of the default.
+ A nil value means to simply use the same abbrev-table as the parent.
+
+Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
+
+ (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
+
+You could then make new key bindings for `LaTeX-thesis-mode-map'
+without changing regular LaTeX mode. In this example, BODY is empty,
+and DOCSTRING is generated by default.
+
+On a more complicated level, the following command uses `sgml-mode' as
+the parent, and then sets the variable `case-fold-search' to nil:
+
+ (define-derived-mode article-mode sgml-mode \"Article\"
+ \"Major mode for editing technical articles.\"
+ (setq case-fold-search nil))
+
+Note that if the documentation string had been left out, it would have
+been generated automatically, with a reference to the keymap."
+ (declare (debug (&define name symbolp sexp [&optional stringp]
+ [&rest keywordp sexp] def-body)))
+
+ (when (and docstring (not (stringp docstring)))
+ ;; Some trickiness, since what appears to be the docstring may really be
+ ;; the first element of the body.
+ (push docstring body)
+ (setq docstring nil))
+
+ (when (eq parent 'fundamental-mode) (setq parent nil))
+
+ (let ((map (derived-mode-map-name child))
+ (syntax (derived-mode-syntax-table-name child))
+ (abbrev (derived-mode-abbrev-table-name child))
+ (declare-abbrev t)
+ (declare-syntax t)
+ (hook (derived-mode-hook-name child))
+ (group nil))
+
+ ;; Process the keyword args.
+ (while (keywordp (car body))
+ (case (pop body)
+ (:group (setq group (pop body)))
+ (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
+ (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
+ (t (pop body))))
+
+ (setq docstring (derived-mode-make-docstring
+ parent child docstring syntax abbrev))
+
+ `(progn
+ (defvar ,map (make-sparse-keymap))
+ ,(if declare-syntax
+ `(defvar ,syntax (make-syntax-table)))
+ ,(if declare-abbrev
+ `(defvar ,abbrev
+ (progn (define-abbrev-table ',abbrev nil) ,abbrev)))
+ (put ',child 'derived-mode-parent ',parent)
+ ,(if group `(put ',child 'custom-mode-group ,group))
+
+ (defun ,child ()
+ ,docstring
+ (interactive)
+ ; Run the parent.
+ (delay-mode-hooks
+
+ (,(or parent 'kill-all-local-variables))
+ ; Identify the child mode.
+ (setq major-mode (quote ,child))
+ (setq mode-name ,name)
+ ; Identify special modes.
+ ,(when parent
+ `(progn
+ (if (get (quote ,parent) 'mode-class)
+ (put (quote ,child) 'mode-class
+ (get (quote ,parent) 'mode-class)))
+ ; Set up maps and tables.
+ (unless (keymap-parent ,map)
+ (set-keymap-parent ,map (current-local-map)))
+ ,(when declare-syntax
+ `(let ((parent (char-table-parent ,syntax)))
+ (unless (and parent
+ (not (eq parent (standard-syntax-table))))
+ (set-char-table-parent ,syntax (syntax-table)))))))
+
+ (use-local-map ,map)
+ ,(when syntax `(set-syntax-table ,syntax))
+ ,(when abbrev `(setq local-abbrev-table ,abbrev))
+ ; Splice in the body (if any).
+ ,@body
+ )
+ ;; Run the hooks, if any.
+ ;; Make the generated code work in older Emacs versions
+ ;; that do not yet have run-mode-hooks.
+ (if (fboundp 'run-mode-hooks)
+ (run-mode-hooks ',hook)
+ (run-hooks ',hook))))))
+
+;; PUBLIC: find the ultimate class of a derived mode.
+
+(defun derived-mode-class (mode)
+ "Find the class of a major MODE.
+A mode's class is the first ancestor which is NOT a derived mode.
+Use the `derived-mode-parent' property of the symbol to trace backwards.
+Since major-modes might all derive from `fundamental-mode', this function
+is not very useful."
+ (while (get mode 'derived-mode-parent)
+ (setq mode (get mode 'derived-mode-parent)))
+ mode)
+(make-obsolete 'derived-mode-class 'derived-mode-p "21.4")
+
+\f
+;;; PRIVATE
+
+(defun derived-mode-make-docstring (parent child &optional
+ docstring syntax abbrev)
+ "Construct a docstring for a new mode if none is provided."
+
+ (let ((map (derived-mode-map-name child))
+ (hook (derived-mode-hook-name child)))
+
+ (unless (stringp docstring)
+ ;; Use a default docstring.
+ (setq docstring
+ (if (null parent)
+ (format "Major-mode.
+Uses keymap `%s', abbrev table `%s' and syntax-table `%s'." map abbrev syntax)
+ (format "Major mode derived from `%s' by `define-derived-mode'.
+It inherits all of the parent's attributes, but has its own keymap,
+abbrev table and syntax table:
+
+ `%s', `%s' and `%s'
+
+which more-or-less shadow %s's corresponding tables."
+ parent map abbrev syntax parent))))
+
+ (unless (string-match (regexp-quote (symbol-name hook)) docstring)
+ ;; Make sure the docstring mentions the mode's hook.
+ (setq docstring
+ (concat docstring
+ (if (null parent)
+ "\n\nThis mode "
+ (concat
+ "\n\nIn addition to any hooks its parent mode "
+ (if (string-match (regexp-quote (format "`%s'" parent))
+ docstring) nil
+ (format "`%s' " parent))
+ "might have run,\nthis mode "))
+ (format "runs the hook `%s'" hook)
+ ", as the final step\nduring initialization.")))
+
+ (unless (string-match "\\\\[{[]" docstring)
+ ;; And don't forget to put the mode's keymap.
+ (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
+
+ docstring))
+
+\f
+;;; OBSOLETE
+;; The functions below are only provided for backward compatibility with
+;; code byte-compiled with versions of derived.el prior to Emacs-21.
+
+(defsubst derived-mode-setup-function-name (mode)
+ "Construct a setup-function name based on a MODE name."
+ (intern (concat (symbol-name mode) "-setup")))
+
+\f
+;; Utility functions for defining a derived mode.
+
+;;;###autoload
+(defun derived-mode-init-mode-variables (mode)
+ "Initialise variables for a new MODE.
+Right now, if they don't already exist, set up a blank keymap, an
+empty syntax table, and an empty abbrev table -- these will be merged
+the first time the mode is used."
+
+ (if (boundp (derived-mode-map-name mode))
+ t
+ (eval `(defvar ,(derived-mode-map-name mode)
+ (make-sparse-keymap)
+ ,(format "Keymap for %s." mode)))
+ (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
+
+ (if (boundp (derived-mode-syntax-table-name mode))
+ t
+ (eval `(defvar ,(derived-mode-syntax-table-name mode)
+ ;; Make a syntax table which doesn't specify anything
+ ;; for any char. Valid data will be merged in by
+ ;; derived-mode-merge-syntax-tables.
+ (make-char-table 'syntax-table nil)
+ ,(format "Syntax table for %s." mode)))
+ (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
+
+ (if (boundp (derived-mode-abbrev-table-name mode))
+ t
+ (eval `(defvar ,(derived-mode-abbrev-table-name mode)
+ (progn
+ (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
+ (make-abbrev-table))
+ ,(format "Abbrev table for %s." mode)))))
+\f
+;; Utility functions for running a derived mode.
+
+(defun derived-mode-set-keymap (mode)
+ "Set the keymap of the new MODE, maybe merging with the parent."
+ (let* ((map-name (derived-mode-map-name mode))
+ (new-map (eval map-name))
+ (old-map (current-local-map)))
+ (and old-map
+ (get map-name 'derived-mode-unmerged)
+ (derived-mode-merge-keymaps old-map new-map))
+ (put map-name 'derived-mode-unmerged nil)
+ (use-local-map new-map)))
+
+(defun derived-mode-set-syntax-table (mode)
+ "Set the syntax table of the new MODE, maybe merging with the parent."
+ (let* ((table-name (derived-mode-syntax-table-name mode))
+ (old-table (syntax-table))
+ (new-table (eval table-name)))
+ (if (get table-name 'derived-mode-unmerged)
+ (derived-mode-merge-syntax-tables old-table new-table))
+ (put table-name 'derived-mode-unmerged nil)
+ (set-syntax-table new-table)))
+
+(defun derived-mode-set-abbrev-table (mode)
+ "Set the abbrev table for MODE if it exists.
+Always merge its parent into it, since the merge is non-destructive."
+ (let* ((table-name (derived-mode-abbrev-table-name mode))
+ (old-table local-abbrev-table)
+ (new-table (eval table-name)))
+ (derived-mode-merge-abbrev-tables old-table new-table)
+ (setq local-abbrev-table new-table)))
+
+;;;(defun derived-mode-run-setup-function (mode)
+;;; "Run the setup function if it exists."
+
+;;; (let ((fname (derived-mode-setup-function-name mode)))
+;;; (if (fboundp fname)
+;;; (funcall fname))))
+
+(defun derived-mode-run-hooks (mode)
+ "Run the mode hook for MODE."
+ (let ((hooks-name (derived-mode-hook-name mode)))
+ (if (boundp hooks-name)
+ (run-hooks hooks-name))))
+
+;; Functions to merge maps and tables.
+
+(defun derived-mode-merge-keymaps (old new)
+ "Merge an OLD keymap into a NEW one.
+The old keymap is set to be the last cdr of the new one, so that there will
+be automatic inheritance."
+ ;; ?? Can this just use `set-keymap-parent'?
+ (let ((tail new))
+ ;; Scan the NEW map for prefix keys.
+ (while (consp tail)
+ (and (consp (car tail))
+ (let* ((key (vector (car (car tail))))
+ (subnew (lookup-key new key))
+ (subold (lookup-key old key)))
+ ;; If KEY is a prefix key in both OLD and NEW, merge them.
+ (and (keymapp subnew) (keymapp subold)
+ (derived-mode-merge-keymaps subold subnew))))
+ (and (vectorp (car tail))
+ ;; Search a vector of ASCII char bindings for prefix keys.
+ (let ((i (1- (length (car tail)))))
+ (while (>= i 0)
+ (let* ((key (vector i))
+ (subnew (lookup-key new key))
+ (subold (lookup-key old key)))
+ ;; If KEY is a prefix key in both OLD and NEW, merge them.
+ (and (keymapp subnew) (keymapp subold)
+ (derived-mode-merge-keymaps subold subnew)))
+ (setq i (1- i)))))
+ (setq tail (cdr tail))))
+ (setcdr (nthcdr (1- (length new)) new) old))
+
+(defun derived-mode-merge-syntax-tables (old new)
+ "Merge an OLD syntax table into a NEW one.
+Where the new table already has an entry, nothing is copied from the old one."
+ (set-char-table-parent new old))
+
+;; Merge an old abbrev table into a new one.
+;; This function requires internal knowledge of how abbrev tables work,
+;; presuming that they are obarrays with the abbrev as the symbol, the expansion
+;; as the value of the symbol, and the hook as the function definition.
+(defun derived-mode-merge-abbrev-tables (old new)
+ (if old
+ (mapatoms
+ (lambda (symbol)
+ (or (intern-soft (symbol-name symbol) new)
+ (define-abbrev new (symbol-name symbol)
+ (symbol-value symbol) (symbol-function symbol))))
+ old)))
+
+(provide 'derived)
+
+;;; derived.el ends here
(let (
(buffer-list (buffer-list))
(hlist desktop-buffer-handlers)
- (desktop-first-buffer)
(result)
(handler)
)
+++ /dev/null
-;;; byte-run.el --- byte-compiler support for inlining
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;; Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Maintainer: FSF
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; interface to selectively inlining functions.
-;; This only happens when source-code optimization is turned on.
-
-;;; Code:
-
-;; Redefined in byte-optimize.el.
-;; This is not documented--it's not clear that we should promote it.
-(fset 'inline 'progn)
-(put 'inline 'lisp-indent-hook 0)
-
-
-;;; Interface to inline functions.
-
-;; (defmacro proclaim-inline (&rest fns)
-;; "Cause the named functions to be open-coded when called from compiled code.
-;; They will only be compiled open-coded when byte-compile-optimize is true."
-;; (cons 'eval-and-compile
-;; (mapcar '(lambda (x)
-;; (or (memq (get x 'byte-optimizer)
-;; '(nil byte-compile-inline-expand))
-;; (error
-;; "%s already has a byte-optimizer, can't make it inline"
-;; x))
-;; (list 'put (list 'quote x)
-;; ''byte-optimizer ''byte-compile-inline-expand))
-;; fns)))
-
-;; (defmacro proclaim-notinline (&rest fns)
-;; "Cause the named functions to no longer be open-coded."
-;; (cons 'eval-and-compile
-;; (mapcar '(lambda (x)
-;; (if (eq (get x 'byte-optimizer) 'byte-compile-inline-expand)
-;; (put x 'byte-optimizer nil))
-;; (list 'if (list 'eq (list 'get (list 'quote x) ''byte-optimizer)
-;; ''byte-compile-inline-expand)
-;; (list 'put x ''byte-optimizer nil)))
-;; fns)))
-
-;; This has a special byte-hunk-handler in bytecomp.el.
-(defmacro defsubst (name arglist &rest body)
- "Define an inline function. The syntax is just like that of `defun'."
- (or (memq (get name 'byte-optimizer)
- '(nil byte-compile-inline-expand))
- (error "`%s' is a primitive" name))
- (list 'prog1
- (cons 'defun (cons name (cons arglist body)))
- (list 'eval-and-compile
- (list 'put (list 'quote name)
- ''byte-optimizer ''byte-compile-inline-expand))))
-
-(defun make-obsolete (fn new &optional when)
- "Make the byte-compiler warn that FUNCTION is obsolete.
-The warning will say that NEW should be used instead.
-If NEW is a string, that is the `use instead' message.
-If provided, WHEN should be a string indicating when the function
-was first made obsolete, for example a date or a release number."
- (interactive "aMake function obsolete: \nxObsoletion replacement: ")
- (let ((handler (get fn 'byte-compile)))
- (if (eq 'byte-compile-obsolete handler)
- (setq handler (nth 1 (get fn 'byte-obsolete-info)))
- (put fn 'byte-compile 'byte-compile-obsolete))
- (put fn 'byte-obsolete-info (list new handler when)))
- fn)
-
-(defun make-obsolete-variable (var new &optional when)
- "Make the byte-compiler warn that VARIABLE is obsolete,
-and NEW should be used instead. If NEW is a string, then that is the
-`use instead' message.
-If provided, WHEN should be a string indicating when the variable
-was first made obsolete, for example a date or a release number."
- (interactive
- (list
- (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
- (if (equal str "") (error ""))
- (intern str))
- (car (read-from-string (read-string "Obsoletion replacement: ")))))
- (put var 'byte-obsolete-variable (cons new when))
- var)
-
-(put 'dont-compile 'lisp-indent-hook 0)
-(defmacro dont-compile (&rest body)
- "Like `progn', but the body always runs interpreted (not compiled).
-If you think you need this, you're probably making a mistake somewhere."
- (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
-
-\f
-;;; interface to evaluating things at compile time and/or load time
-;;; these macro must come after any uses of them in this file, as their
-;;; definition in the file overrides the magic definitions on the
-;;; byte-compile-macro-environment.
-
-(put 'eval-when-compile 'lisp-indent-hook 0)
-(defmacro eval-when-compile (&rest body)
- "Like `progn', but evaluates the body at compile time.
-The result of the body appears to the compiler as a quoted constant."
- ;; Not necessary because we have it in b-c-initial-macro-environment
- ;; (list 'quote (eval (cons 'progn body)))
- (cons 'progn body))
-
-(put 'eval-and-compile 'lisp-indent-hook 0)
-(defmacro eval-and-compile (&rest body)
- "Like `progn', but evaluates the body at compile time and at load time."
- ;; Remember, it's magic.
- (cons 'progn body))
-
-(defun with-no-warnings (&optional first &rest body)
- "Like `progn', but prevents compiler warnings in the body."
- ;; The implementation for the interpreter is basically trivial.
- (if body (car (last body))
- first))
-
-\f
-;;; I nuked this because it's not a good idea for users to think of using it.
-;;; These options are a matter of installation preference, and have nothing to
-;;; with particular source files; it's a mistake to suggest to users
-;;; they should associate these with particular source files.
-;;; There is hardly any reason to change these parameters, anyway.
-;;; --rms.
-
-;; (put 'byte-compiler-options 'lisp-indent-hook 0)
-;; (defmacro byte-compiler-options (&rest args)
-;; "Set some compilation-parameters for this file. This will affect only the
-;; file in which it appears; this does nothing when evaluated, and when loaded
-;; from a .el file.
-;;
-;; Each argument to this macro must be a list of a key and a value.
-;;
-;; Keys: Values: Corresponding variable:
-;;
-;; verbose t, nil byte-compile-verbose
-;; optimize t, nil, source, byte byte-compile-optimize
-;; warnings list of warnings byte-compile-warnings
-;; Legal elements: (callargs redefine free-vars unresolved)
-;; file-format emacs18, emacs19 byte-compile-compatibility
-;;
-;; For example, this might appear at the top of a source file:
-;;
-;; (byte-compiler-options
-;; (optimize t)
-;; (warnings (- free-vars)) ; Don't warn about free variables
-;; (file-format emacs19))"
-;; nil)
-
-;;; byte-run.el ends here
+++ /dev/null
-;;; derived.el --- allow inheritance of major modes
-;;; (formerly mode-clone.el)
-
-;; Copyright (C) 1993, 1994, 1999, 2003 Free Software Foundation, Inc.
-
-;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
-;; Maintainer: FSF
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-\f
-;;; Commentary:
-
-;; GNU Emacs is already, in a sense, object oriented -- each object
-;; (buffer) belongs to a class (major mode), and that class defines
-;; the relationship between messages (input events) and methods
-;; (commands) by means of a keymap.
-;;
-;; The only thing missing is a good scheme of inheritance. It is
-;; possible to simulate a single level of inheritance with generous
-;; use of hooks and a bit of work -- sgml-mode, for example, also runs
-;; the hooks for text-mode, and keymaps can inherit from other keymaps
-;; -- but generally, each major mode ends up reinventing the wheel.
-;; Ideally, someone should redesign all of Emacs's major modes to
-;; follow a more conventional object-oriented system: when defining a
-;; new major mode, the user should need only to name the existing mode
-;; it is most similar to, then list the (few) differences.
-;;
-;; In the mean time, this package offers most of the advantages of
-;; full inheritance with the existing major modes. The macro
-;; `define-derived-mode' allows the user to make a variant of an existing
-;; major mode, with its own keymap. The new mode will inherit the key
-;; bindings of its parent, and will, in fact, run its parent first
-;; every time it is called. For example, the commands
-;;
-;; (define-derived-mode hypertext-mode text-mode "Hypertext"
-;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}"
-;; (setq case-fold-search nil))
-;;
-;; (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link)
-;;
-;; will create a function `hypertext-mode' with its own (sparse)
-;; keymap `hypertext-mode-map.' The command M-x hypertext-mode will
-;; perform the following actions:
-;;
-;; - run the command (text-mode) to get its default setup
-;; - replace the current keymap with 'hypertext-mode-map,' which will
-;; inherit from 'text-mode-map'.
-;; - replace the current syntax table with
-;; 'hypertext-mode-syntax-table', which will borrow its defaults
-;; from the current text-mode-syntax-table.
-;; - replace the current abbrev table with
-;; 'hypertext-mode-abbrev-table', which will borrow its defaults
-;; from the current text-mode-abbrev table
-;; - change the mode line to read "Hypertext"
-;; - assign the value 'hypertext-mode' to the 'major-mode' variable
-;; - run the body of commands provided in the macro -- in this case,
-;; set the local variable `case-fold-search' to nil.
-;;
-;; The advantages of this system are threefold. First, text mode is
-;; untouched -- if you had added the new keystroke to `text-mode-map,'
-;; possibly using hooks, you would have added it to all text buffers
-;; -- here, it appears only in hypertext buffers, where it makes
-;; sense. Second, it is possible to build even further, and make
-;; a derived mode from a derived mode. The commands
-;;
-;; (define-derived-mode html-mode hypertext-mode "HTML")
-;; [various key definitions]
-;;
-;; will add a new major mode for HTML with very little fuss.
-;;
-;; Note also the function `derived-mode-p' which can tell if the current
-;; mode derives from another. In a hypertext-mode, buffer, for example,
-;; (derived-mode-p 'text-mode) would return non-nil. This should always
-;; be used in place of (eq major-mode 'text-mode).
-\f
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-;;; PRIVATE: defsubst must be defined before they are first used
-
-(defsubst derived-mode-hook-name (mode)
- "Construct the mode hook name based on mode name MODE."
- (intern (concat (symbol-name mode) "-hook")))
-
-(defsubst derived-mode-map-name (mode)
- "Construct a map name based on a MODE name."
- (intern (concat (symbol-name mode) "-map")))
-
-(defsubst derived-mode-syntax-table-name (mode)
- "Construct a syntax-table name based on a MODE name."
- (intern (concat (symbol-name mode) "-syntax-table")))
-
-(defsubst derived-mode-abbrev-table-name (mode)
- "Construct an abbrev-table name based on a MODE name."
- (intern (concat (symbol-name mode) "-abbrev-table")))
-
-;; PUBLIC: define a new major mode which inherits from an existing one.
-
-;;;###autoload
-(defmacro define-derived-mode (child parent name &optional docstring &rest body)
- "Create a new mode as a variant of an existing mode.
-
-The arguments to this command are as follow:
-
-CHILD: the name of the command for the derived mode.
-PARENT: the name of the command for the parent mode (e.g. `text-mode')
- or nil if there is no parent.
-NAME: a string which will appear in the status line (e.g. \"Hypertext\")
-DOCSTRING: an optional documentation string--if you do not supply one,
- the function will attempt to invent something useful.
-BODY: forms to execute just before running the
- hooks for the new mode. Do not use `interactive' here.
-
-BODY can start with a bunch of keyword arguments. The following keyword
- arguments are currently understood:
-:group GROUP
- Declare the customization group that corresponds to this mode.
-:syntax-table TABLE
- Use TABLE instead of the default.
- A nil value means to simply use the same syntax-table as the parent.
-:abbrev-table TABLE
- Use TABLE instead of the default.
- A nil value means to simply use the same abbrev-table as the parent.
-
-Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
-
- (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
-
-You could then make new key bindings for `LaTeX-thesis-mode-map'
-without changing regular LaTeX mode. In this example, BODY is empty,
-and DOCSTRING is generated by default.
-
-On a more complicated level, the following command uses `sgml-mode' as
-the parent, and then sets the variable `case-fold-search' to nil:
-
- (define-derived-mode article-mode sgml-mode \"Article\"
- \"Major mode for editing technical articles.\"
- (setq case-fold-search nil))
-
-Note that if the documentation string had been left out, it would have
-been generated automatically, with a reference to the keymap."
- (declare (debug (&define name symbolp sexp [&optional stringp]
- [&rest keywordp sexp] def-body)))
-
- (when (and docstring (not (stringp docstring)))
- ;; Some trickiness, since what appears to be the docstring may really be
- ;; the first element of the body.
- (push docstring body)
- (setq docstring nil))
-
- (when (eq parent 'fundamental-mode) (setq parent nil))
-
- (let ((map (derived-mode-map-name child))
- (syntax (derived-mode-syntax-table-name child))
- (abbrev (derived-mode-abbrev-table-name child))
- (declare-abbrev t)
- (declare-syntax t)
- (hook (derived-mode-hook-name child))
- (group nil))
-
- ;; Process the keyword args.
- (while (keywordp (car body))
- (case (pop body)
- (:group (setq group (pop body)))
- (:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
- (:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
- (t (pop body))))
-
- (setq docstring (derived-mode-make-docstring
- parent child docstring syntax abbrev))
-
- `(progn
- (defvar ,map (make-sparse-keymap))
- ,(if declare-syntax
- `(defvar ,syntax (make-syntax-table)))
- ,(if declare-abbrev
- `(defvar ,abbrev
- (progn (define-abbrev-table ',abbrev nil) ,abbrev)))
- (put ',child 'derived-mode-parent ',parent)
- ,(if group `(put ',child 'custom-mode-group ,group))
-
- (defun ,child ()
- ,docstring
- (interactive)
- ; Run the parent.
- (delay-mode-hooks
-
- (,(or parent 'kill-all-local-variables))
- ; Identify the child mode.
- (setq major-mode (quote ,child))
- (setq mode-name ,name)
- ; Identify special modes.
- ,(when parent
- `(progn
- (if (get (quote ,parent) 'mode-class)
- (put (quote ,child) 'mode-class
- (get (quote ,parent) 'mode-class)))
- ; Set up maps and tables.
- (unless (keymap-parent ,map)
- (set-keymap-parent ,map (current-local-map)))
- ,(when declare-syntax
- `(let ((parent (char-table-parent ,syntax)))
- (unless (and parent
- (not (eq parent (standard-syntax-table))))
- (set-char-table-parent ,syntax (syntax-table)))))))
-
- (use-local-map ,map)
- ,(when syntax `(set-syntax-table ,syntax))
- ,(when abbrev `(setq local-abbrev-table ,abbrev))
- ; Splice in the body (if any).
- ,@body
- )
- ;; Run the hooks, if any.
- ;; Make the generated code work in older Emacs versions
- ;; that do not yet have run-mode-hooks.
- (if (fboundp 'run-mode-hooks)
- (run-mode-hooks ',hook)
- (run-hooks ',hook))))))
-
-;; PUBLIC: find the ultimate class of a derived mode.
-
-(defun derived-mode-class (mode)
- "Find the class of a major MODE.
-A mode's class is the first ancestor which is NOT a derived mode.
-Use the `derived-mode-parent' property of the symbol to trace backwards.
-Since major-modes might all derive from `fundamental-mode', this function
-is not very useful."
- (while (get mode 'derived-mode-parent)
- (setq mode (get mode 'derived-mode-parent)))
- mode)
-(make-obsolete 'derived-mode-class 'derived-mode-p "21.4")
-
-\f
-;;; PRIVATE
-
-(defun derived-mode-make-docstring (parent child &optional
- docstring syntax abbrev)
- "Construct a docstring for a new mode if none is provided."
-
- (let ((map (derived-mode-map-name child))
- (hook (derived-mode-hook-name child)))
-
- (unless (stringp docstring)
- ;; Use a default docstring.
- (setq docstring
- (if (null parent)
- (format "Major-mode.
-Uses keymap `%s', abbrev table `%s' and syntax-table `%s'." map abbrev syntax)
- (format "Major mode derived from `%s' by `define-derived-mode'.
-It inherits all of the parent's attributes, but has its own keymap,
-abbrev table and syntax table:
-
- `%s', `%s' and `%s'
-
-which more-or-less shadow %s's corresponding tables."
- parent map abbrev syntax parent))))
-
- (unless (string-match (regexp-quote (symbol-name hook)) docstring)
- ;; Make sure the docstring mentions the mode's hook.
- (setq docstring
- (concat docstring
- (if (null parent)
- "\n\nThis mode "
- (concat
- "\n\nIn addition to any hooks its parent mode "
- (if (string-match (regexp-quote (format "`%s'" parent))
- docstring) nil
- (format "`%s' " parent))
- "might have run,\nthis mode "))
- (format "runs the hook `%s'" hook)
- ", as the final step\nduring initialization.")))
-
- (unless (string-match "\\\\[{[]" docstring)
- ;; And don't forget to put the mode's keymap.
- (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
-
- docstring))
-
-\f
-;;; OBSOLETE
-;; The functions below are only provided for backward compatibility with
-;; code byte-compiled with versions of derived.el prior to Emacs-21.
-
-(defsubst derived-mode-setup-function-name (mode)
- "Construct a setup-function name based on a MODE name."
- (intern (concat (symbol-name mode) "-setup")))
-
-\f
-;; Utility functions for defining a derived mode.
-
-;;;###autoload
-(defun derived-mode-init-mode-variables (mode)
- "Initialise variables for a new MODE.
-Right now, if they don't already exist, set up a blank keymap, an
-empty syntax table, and an empty abbrev table -- these will be merged
-the first time the mode is used."
-
- (if (boundp (derived-mode-map-name mode))
- t
- (eval `(defvar ,(derived-mode-map-name mode)
- (make-sparse-keymap)
- ,(format "Keymap for %s." mode)))
- (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
-
- (if (boundp (derived-mode-syntax-table-name mode))
- t
- (eval `(defvar ,(derived-mode-syntax-table-name mode)
- ;; Make a syntax table which doesn't specify anything
- ;; for any char. Valid data will be merged in by
- ;; derived-mode-merge-syntax-tables.
- (make-char-table 'syntax-table nil)
- ,(format "Syntax table for %s." mode)))
- (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
-
- (if (boundp (derived-mode-abbrev-table-name mode))
- t
- (eval `(defvar ,(derived-mode-abbrev-table-name mode)
- (progn
- (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
- (make-abbrev-table))
- ,(format "Abbrev table for %s." mode)))))
-\f
-;; Utility functions for running a derived mode.
-
-(defun derived-mode-set-keymap (mode)
- "Set the keymap of the new MODE, maybe merging with the parent."
- (let* ((map-name (derived-mode-map-name mode))
- (new-map (eval map-name))
- (old-map (current-local-map)))
- (and old-map
- (get map-name 'derived-mode-unmerged)
- (derived-mode-merge-keymaps old-map new-map))
- (put map-name 'derived-mode-unmerged nil)
- (use-local-map new-map)))
-
-(defun derived-mode-set-syntax-table (mode)
- "Set the syntax table of the new MODE, maybe merging with the parent."
- (let* ((table-name (derived-mode-syntax-table-name mode))
- (old-table (syntax-table))
- (new-table (eval table-name)))
- (if (get table-name 'derived-mode-unmerged)
- (derived-mode-merge-syntax-tables old-table new-table))
- (put table-name 'derived-mode-unmerged nil)
- (set-syntax-table new-table)))
-
-(defun derived-mode-set-abbrev-table (mode)
- "Set the abbrev table for MODE if it exists.
-Always merge its parent into it, since the merge is non-destructive."
- (let* ((table-name (derived-mode-abbrev-table-name mode))
- (old-table local-abbrev-table)
- (new-table (eval table-name)))
- (derived-mode-merge-abbrev-tables old-table new-table)
- (setq local-abbrev-table new-table)))
-
-;;;(defun derived-mode-run-setup-function (mode)
-;;; "Run the setup function if it exists."
-
-;;; (let ((fname (derived-mode-setup-function-name mode)))
-;;; (if (fboundp fname)
-;;; (funcall fname))))
-
-(defun derived-mode-run-hooks (mode)
- "Run the mode hook for MODE."
- (let ((hooks-name (derived-mode-hook-name mode)))
- (if (boundp hooks-name)
- (run-hooks hooks-name))))
-
-;; Functions to merge maps and tables.
-
-(defun derived-mode-merge-keymaps (old new)
- "Merge an OLD keymap into a NEW one.
-The old keymap is set to be the last cdr of the new one, so that there will
-be automatic inheritance."
- ;; ?? Can this just use `set-keymap-parent'?
- (let ((tail new))
- ;; Scan the NEW map for prefix keys.
- (while (consp tail)
- (and (consp (car tail))
- (let* ((key (vector (car (car tail))))
- (subnew (lookup-key new key))
- (subold (lookup-key old key)))
- ;; If KEY is a prefix key in both OLD and NEW, merge them.
- (and (keymapp subnew) (keymapp subold)
- (derived-mode-merge-keymaps subold subnew))))
- (and (vectorp (car tail))
- ;; Search a vector of ASCII char bindings for prefix keys.
- (let ((i (1- (length (car tail)))))
- (while (>= i 0)
- (let* ((key (vector i))
- (subnew (lookup-key new key))
- (subold (lookup-key old key)))
- ;; If KEY is a prefix key in both OLD and NEW, merge them.
- (and (keymapp subnew) (keymapp subold)
- (derived-mode-merge-keymaps subold subnew)))
- (setq i (1- i)))))
- (setq tail (cdr tail))))
- (setcdr (nthcdr (1- (length new)) new) old))
-
-(defun derived-mode-merge-syntax-tables (old new)
- "Merge an OLD syntax table into a NEW one.
-Where the new table already has an entry, nothing is copied from the old one."
- (set-char-table-parent new old))
-
-;; Merge an old abbrev table into a new one.
-;; This function requires internal knowledge of how abbrev tables work,
-;; presuming that they are obarrays with the abbrev as the symbol, the expansion
-;; as the value of the symbol, and the hook as the function definition.
-(defun derived-mode-merge-abbrev-tables (old new)
- (if old
- (mapatoms
- (lambda (symbol)
- (or (intern-soft (symbol-name symbol) new)
- (define-abbrev new (symbol-name symbol)
- (symbol-value symbol) (symbol-function symbol))))
- old)))
-
-(provide 'derived)
-
-;;; derived.el ends here
+++ /dev/null
-;;; float-sup.el --- define some constants useful for floating point numbers.
-
-;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-;; Provide a meaningful error message if we are running on
-;; bare (non-float) emacs.
-
-(if (fboundp 'atan)
- nil
- (error "Floating point was disabled at compile time"))
-
-;; provide an easy hook to tell if we are running with floats or not.
-;; define pi and e via math-lib calls. (much less prone to killer typos.)
-(defconst pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")
-;; It's too inconvenient to make `e' a constant because it's used as
-;; a temporary variable all the time.
-(defvar e (exp 1) "The value of e (2.7182818...).")
-
-;; Careful when editing this file ... typos here will be hard to spot.
-;; (defconst pi 3.14159265358979323846264338327
-;; "The value of Pi (3.14159265358979323846264338327...)")
-
-(defconst degrees-to-radians (/ pi 180.0)
- "Degrees to radian conversion constant.")
-(defconst radians-to-degrees (/ 180.0 pi)
- "Radian to degree conversion constant.")
-
-;; these expand to a single multiply by a float when byte compiled
-
-(defmacro degrees-to-radians (x)
- "Convert ARG from degrees to radians."
- (list '* (/ pi 180.0) x))
-(defmacro radians-to-degrees (x)
- "Convert ARG from radians to degrees."
- (list '* (/ 180.0 pi) x))
-
-(provide 'lisp-float-type)
-
-;;; float-sup.el ends here
--- /dev/null
+;;; float.el --- obsolete floating point arithmetic package
+
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; Author: Bill Rosenblatt
+;; Maintainer: FSF
+;; Keywords: extensions
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Floating point numbers are represented by dot-pairs (mant . exp)
+;; where mant is the 24-bit signed integral mantissa and exp is the
+;; base 2 exponent.
+;;
+;; Emacs LISP supports a 24-bit signed integer data type, which has a
+;; range of -(2**23) to +(2**23)-1, or -8388608 to 8388607 decimal.
+;; This gives six significant decimal digit accuracy. Exponents can
+;; be anything in the range -(2**23) to +(2**23)-1.
+;;
+;; User interface:
+;; function f converts from integer to floating point
+;; function string-to-float converts from string to floating point
+;; function fint converts a floating point to integer (with truncation)
+;; function float-to-string converts from floating point to string
+;;
+;; Caveats:
+;; - Exponents outside of the range of +/-100 or so will cause certain
+;; functions (especially conversion routines) to take forever.
+;; - Very little checking is done for fixed point overflow/underflow.
+;; - No checking is done for over/underflow of the exponent
+;; (hardly necessary when exponent can be 2**23).
+;;
+;;
+;; Bill Rosenblatt
+;; June 20, 1986
+;;
+
+;;; Code:
+
+;; fundamental implementation constants
+(defconst exp-base 2
+ "Base of exponent in this floating point representation.")
+
+(defconst mantissa-bits 24
+ "Number of significant bits in this floating point representation.")
+
+(defconst decimal-digits 6
+ "Number of decimal digits expected to be accurate.")
+
+(defconst expt-digits 2
+ "Maximum permitted digits in a scientific notation exponent.")
+
+;; other constants
+(defconst maxbit (1- mantissa-bits)
+ "Number of highest bit")
+
+(defconst mantissa-maxval (1- (ash 1 maxbit))
+ "Maximum permissible value of mantissa")
+
+(defconst mantissa-minval (ash 1 maxbit)
+ "Minimum permissible value of mantissa")
+
+(defconst floating-point-regexp
+ "^[ \t]*\\(-?\\)\\([0-9]*\\)\
+\\(\\.\\([0-9]*\\)\\|\\)\
+\\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[ \t]*$"
+ "Regular expression to match floating point numbers. Extract matches:
+1 - minus sign
+2 - integer part
+4 - fractional part
+8 - minus sign for power of ten
+9 - power of ten
+")
+
+(defconst high-bit-mask (ash 1 maxbit)
+ "Masks all bits except the high-order (sign) bit.")
+
+(defconst second-bit-mask (ash 1 (1- maxbit))
+ "Masks all bits except the highest-order magnitude bit")
+
+;; various useful floating point constants
+(defconst _f0 '(0 . 1))
+
+(defconst _f1/2 '(4194304 . -23))
+
+(defconst _f1 '(4194304 . -22))
+
+(defconst _f10 '(5242880 . -19))
+
+;; support for decimal conversion routines
+(defvar powers-of-10 (make-vector (1+ decimal-digits) _f1))
+(aset powers-of-10 1 _f10)
+(aset powers-of-10 2 '(6553600 . -16))
+(aset powers-of-10 3 '(8192000 . -13))
+(aset powers-of-10 4 '(5120000 . -9))
+(aset powers-of-10 5 '(6400000 . -6))
+(aset powers-of-10 6 '(8000000 . -3))
+
+(defconst all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits)))
+(defconst highest-power-of-10 (aref powers-of-10 decimal-digits))
+
+(defun fashl (fnum) ; floating-point arithmetic shift left
+ (cons (ash (car fnum) 1) (1- (cdr fnum))))
+
+(defun fashr (fnum) ; floating point arithmetic shift right
+ (cons (ash (car fnum) -1) (1+ (cdr fnum))))
+
+(defun normalize (fnum)
+ (if (> (car fnum) 0) ; make sure next-to-highest bit is set
+ (while (zerop (logand (car fnum) second-bit-mask))
+ (setq fnum (fashl fnum)))
+ (if (< (car fnum) 0) ; make sure highest bit is set
+ (while (zerop (logand (car fnum) high-bit-mask))
+ (setq fnum (fashl fnum)))
+ (setq fnum _f0))) ; "standard 0"
+ fnum)
+
+(defun abs (n) ; integer absolute value
+ (if (>= n 0) n (- n)))
+
+(defun fabs (fnum) ; re-normalize after taking abs value
+ (normalize (cons (abs (car fnum)) (cdr fnum))))
+
+(defun xor (a b) ; logical exclusive or
+ (and (or a b) (not (and a b))))
+
+(defun same-sign (a b) ; two f-p numbers have same sign?
+ (not (xor (natnump (car a)) (natnump (car b)))))
+
+(defun extract-match (str i) ; used after string-match
+ (condition-case ()
+ (substring str (match-beginning i) (match-end i))
+ (error "")))
+
+;; support for the multiplication function
+(defconst halfword-bits (/ mantissa-bits 2)) ; bits in a halfword
+(defconst masklo (1- (ash 1 halfword-bits))) ; isolate the lower halfword
+(defconst maskhi (lognot masklo)) ; isolate the upper halfword
+(defconst round-limit (ash 1 (/ halfword-bits 2)))
+
+(defun hihalf (n) ; return high halfword, shifted down
+ (ash (logand n maskhi) (- halfword-bits)))
+
+(defun lohalf (n) ; return low halfword
+ (logand n masklo))
+
+;; Visible functions
+
+;; Arithmetic functions
+(defun f+ (a1 a2)
+ "Returns the sum of two floating point numbers."
+ (let ((f1 (fmax a1 a2))
+ (f2 (fmin a1 a2)))
+ (if (same-sign a1 a2)
+ (setq f1 (fashr f1) ; shift right to avoid overflow
+ f2 (fashr f2)))
+ (normalize
+ (cons (+ (car f1) (ash (car f2) (- (cdr f2) (cdr f1))))
+ (cdr f1)))))
+
+(defun f- (a1 &optional a2) ; unary or binary minus
+ "Returns the difference of two floating point numbers."
+ (if a2
+ (f+ a1 (f- a2))
+ (normalize (cons (- (car a1)) (cdr a1)))))
+
+(defun f* (a1 a2) ; multiply in halfword chunks
+ "Returns the product of two floating point numbers."
+ (let* ((i1 (car (fabs a1)))
+ (i2 (car (fabs a2)))
+ (sign (not (same-sign a1 a2)))
+ (prodlo (+ (hihalf (* (lohalf i1) (lohalf i2)))
+ (lohalf (* (hihalf i1) (lohalf i2)))
+ (lohalf (* (lohalf i1) (hihalf i2)))))
+ (prodhi (+ (* (hihalf i1) (hihalf i2))
+ (hihalf (* (hihalf i1) (lohalf i2)))
+ (hihalf (* (lohalf i1) (hihalf i2)))
+ (hihalf prodlo))))
+ (if (> (lohalf prodlo) round-limit)
+ (setq prodhi (1+ prodhi))) ; round off truncated bits
+ (normalize
+ (cons (if sign (- prodhi) prodhi)
+ (+ (cdr (fabs a1)) (cdr (fabs a2)) mantissa-bits)))))
+
+(defun f/ (a1 a2) ; SLOW subtract-and-shift algorithm
+ "Returns the quotient of two floating point numbers."
+ (if (zerop (car a2)) ; if divide by 0
+ (signal 'arith-error (list "attempt to divide by zero" a1 a2))
+ (let ((bits (1- maxbit))
+ (quotient 0)
+ (dividend (car (fabs a1)))
+ (divisor (car (fabs a2)))
+ (sign (not (same-sign a1 a2))))
+ (while (natnump bits)
+ (if (< (- dividend divisor) 0)
+ (setq quotient (ash quotient 1))
+ (setq quotient (1+ (ash quotient 1))
+ dividend (- dividend divisor)))
+ (setq dividend (ash dividend 1)
+ bits (1- bits)))
+ (normalize
+ (cons (if sign (- quotient) quotient)
+ (- (cdr (fabs a1)) (cdr (fabs a2)) (1- maxbit)))))))
+
+(defun f% (a1 a2)
+ "Returns the remainder of first floating point number divided by second."
+ (f- a1 (f* (ftrunc (f/ a1 a2)) a2)))
+
+
+;; Comparison functions
+(defun f= (a1 a2)
+ "Returns t if two floating point numbers are equal, nil otherwise."
+ (equal a1 a2))
+
+(defun f> (a1 a2)
+ "Returns t if first floating point number is greater than second,
+nil otherwise."
+ (cond ((and (natnump (car a1)) (< (car a2) 0))
+ t) ; a1 nonnegative, a2 negative
+ ((and (> (car a1) 0) (<= (car a2) 0))
+ t) ; a1 positive, a2 nonpositive
+ ((and (<= (car a1) 0) (natnump (car a2)))
+ nil) ; a1 nonpos, a2 nonneg
+ ((/= (cdr a1) (cdr a2)) ; same signs. exponents differ
+ (> (cdr a1) (cdr a2))) ; compare the mantissas.
+ (t
+ (> (car a1) (car a2))))) ; same exponents.
+
+(defun f>= (a1 a2)
+ "Returns t if first floating point number is greater than or equal to
+second, nil otherwise."
+ (or (f> a1 a2) (f= a1 a2)))
+
+(defun f< (a1 a2)
+ "Returns t if first floating point number is less than second,
+nil otherwise."
+ (not (f>= a1 a2)))
+
+(defun f<= (a1 a2)
+ "Returns t if first floating point number is less than or equal to
+second, nil otherwise."
+ (not (f> a1 a2)))
+
+(defun f/= (a1 a2)
+ "Returns t if first floating point number is not equal to second,
+nil otherwise."
+ (not (f= a1 a2)))
+
+(defun fmin (a1 a2)
+ "Returns the minimum of two floating point numbers."
+ (if (f< a1 a2) a1 a2))
+
+(defun fmax (a1 a2)
+ "Returns the maximum of two floating point numbers."
+ (if (f> a1 a2) a1 a2))
+
+(defun fzerop (fnum)
+ "Returns t if the floating point number is zero, nil otherwise."
+ (= (car fnum) 0))
+
+(defun floatp (fnum)
+ "Returns t if the arg is a floating point number, nil otherwise."
+ (and (consp fnum) (integerp (car fnum)) (integerp (cdr fnum))))
+
+;; Conversion routines
+(defun f (int)
+ "Convert the integer argument to floating point, like a C cast operator."
+ (normalize (cons int '0)))
+
+(defun int-to-hex-string (int)
+ "Convert the integer argument to a C-style hexadecimal string."
+ (let ((shiftval -20)
+ (str "0x")
+ (hex-chars "0123456789ABCDEF"))
+ (while (<= shiftval 0)
+ (setq str (concat str (char-to-string
+ (aref hex-chars
+ (logand (lsh int shiftval) 15))))
+ shiftval (+ shiftval 4)))
+ str))
+
+(defun ftrunc (fnum) ; truncate fractional part
+ "Truncate the fractional part of a floating point number."
+ (cond ((natnump (cdr fnum)) ; it's all integer, return number as is
+ fnum)
+ ((<= (cdr fnum) (- maxbit)) ; it's all fractional, return 0
+ '(0 . 1))
+ (t ; otherwise mask out fractional bits
+ (let ((mant (car fnum)) (exp (cdr fnum)))
+ (normalize
+ (cons (if (natnump mant) ; if negative, use absolute value
+ (ash (ash mant exp) (- exp))
+ (- (ash (ash (- mant) exp) (- exp))))
+ exp))))))
+
+(defun fint (fnum) ; truncate and convert to integer
+ "Convert the floating point number to integer, with truncation,
+like a C cast operator."
+ (let* ((tf (ftrunc fnum)) (tint (car tf)) (texp (cdr tf)))
+ (cond ((>= texp mantissa-bits) ; too high, return "maxint"
+ mantissa-maxval)
+ ((<= texp (- mantissa-bits)) ; too low, return "minint"
+ mantissa-minval)
+ (t ; in range
+ (ash tint texp))))) ; shift so that exponent is 0
+
+(defun float-to-string (fnum &optional sci)
+ "Convert the floating point number to a decimal string.
+Optional second argument non-nil means use scientific notation."
+ (let* ((value (fabs fnum)) (sign (< (car fnum) 0))
+ (power 0) (result 0) (str "")
+ (temp 0) (pow10 _f1))
+
+ (if (f= fnum _f0)
+ "0"
+ (if (f>= value _f1) ; find largest power of 10 <= value
+ (progn ; value >= 1, power is positive
+ (while (f<= (setq temp (f* pow10 highest-power-of-10)) value)
+ (setq pow10 temp
+ power (+ power decimal-digits)))
+ (while (f<= (setq temp (f* pow10 _f10)) value)
+ (setq pow10 temp
+ power (1+ power))))
+ (progn ; value < 1, power is negative
+ (while (f> (setq temp (f/ pow10 highest-power-of-10)) value)
+ (setq pow10 temp
+ power (- power decimal-digits)))
+ (while (f> pow10 value)
+ (setq pow10 (f/ pow10 _f10)
+ power (1- power)))))
+ ; get value in range 100000 to 999999
+ (setq value (f* (f/ value pow10) all-decimal-digs-minval)
+ result (ftrunc value))
+ (let (int)
+ (if (f> (f- value result) _f1/2) ; round up if remainder > 0.5
+ (setq int (1+ (fint result)))
+ (setq int (fint result)))
+ (setq str (int-to-string int))
+ (if (>= int 1000000)
+ (setq power (1+ power))))
+
+ (if sci ; scientific notation
+ (setq str (concat (substring str 0 1) "." (substring str 1)
+ "E" (int-to-string power)))
+
+ ; regular decimal string
+ (cond ((>= power (1- decimal-digits))
+ ; large power, append zeroes
+ (let ((zeroes (- power decimal-digits)))
+ (while (natnump zeroes)
+ (setq str (concat str "0")
+ zeroes (1- zeroes)))))
+
+ ; negative power, prepend decimal
+ ((< power 0) ; point and zeroes
+ (let ((zeroes (- (- power) 2)))
+ (while (natnump zeroes)
+ (setq str (concat "0" str)
+ zeroes (1- zeroes)))
+ (setq str (concat "0." str))))
+
+ (t ; in range, insert decimal point
+ (setq str (concat
+ (substring str 0 (1+ power))
+ "."
+ (substring str (1+ power)))))))
+
+ (if sign ; if negative, prepend minus sign
+ (concat "-" str)
+ str))))
+
+
+;; string to float conversion.
+;; accepts scientific notation, but ignores anything after the first two
+;; digits of the exponent.
+(defun string-to-float (str)
+ "Convert the string to a floating point number.
+Accepts a decimal string in scientific notation, with exponent preceded
+by either E or e. Only the six most significant digits of the integer
+and fractional parts are used; only the first two digits of the exponent
+are used. Negative signs preceding both the decimal number and the exponent
+are recognized."
+
+ (if (string-match floating-point-regexp str 0)
+ (let (power)
+ (f*
+ ; calculate the mantissa
+ (let* ((int-subst (extract-match str 2))
+ (fract-subst (extract-match str 4))
+ (digit-string (concat int-subst fract-subst))
+ (mant-sign (equal (extract-match str 1) "-"))
+ (leading-0s 0) (round-up nil))
+
+ ; get rid of leading 0's
+ (setq power (- (length int-subst) decimal-digits))
+ (while (and (< leading-0s (length digit-string))
+ (= (aref digit-string leading-0s) ?0))
+ (setq leading-0s (1+ leading-0s)))
+ (setq power (- power leading-0s)
+ digit-string (substring digit-string leading-0s))
+
+ ; if more than 6 digits, round off
+ (if (> (length digit-string) decimal-digits)
+ (setq round-up (>= (aref digit-string decimal-digits) ?5)
+ digit-string (substring digit-string 0 decimal-digits))
+ (setq power (+ power (- decimal-digits (length digit-string)))))
+
+ ; round up and add minus sign, if necessary
+ (f (* (+ (string-to-int digit-string)
+ (if round-up 1 0))
+ (if mant-sign -1 1))))
+
+ ; calculate the exponent (power of ten)
+ (let* ((expt-subst (extract-match str 9))
+ (expt-sign (equal (extract-match str 8) "-"))
+ (expt 0) (chunks 0) (tens 0) (exponent _f1)
+ (func 'f*))
+
+ (setq expt (+ (* (string-to-int
+ (substring expt-subst 0
+ (min expt-digits (length expt-subst))))
+ (if expt-sign -1 1))
+ power))
+ (if (< expt 0) ; if power of 10 negative
+ (setq expt (- expt) ; take abs val of exponent
+ func 'f/)) ; and set up to divide, not multiply
+
+ (setq chunks (/ expt decimal-digits)
+ tens (% expt decimal-digits))
+ ; divide or multiply by "chunks" of 10**6
+ (while (> chunks 0)
+ (setq exponent (funcall func exponent highest-power-of-10)
+ chunks (1- chunks)))
+ ; divide or multiply by remaining power of ten
+ (funcall func exponent (aref powers-of-10 tens)))))
+
+ _f0)) ; if invalid, return 0
+
+(provide 'float)
+
+;;; float.el ends here
+++ /dev/null
-;;; map-ynp.el --- general-purpose boolean question-asker
-
-;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@gnu.org>
-;; Maintainer: FSF
-;; Keywords: lisp, extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; map-y-or-n-p is a general-purpose question-asking function.
-;; It asks a series of y/n questions (a la y-or-n-p), and decides to
-;; apply an action to each element of a list based on the answer.
-;; The nice thing is that you also get some other possible answers
-;; to use, reminiscent of query-replace: ! to answer y to all remaining
-;; questions; ESC or q to answer n to all remaining questions; . to answer
-;; y once and then n for the remainder; and you can get help with C-h.
-
-;;; Code:
-
-(defun map-y-or-n-p (prompter actor list &optional help action-alist
- no-cursor-in-echo-area)
- "Ask a series of boolean questions.
-Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST.
-
-LIST is a list of objects, or a function of no arguments to return the next
-object or nil.
-
-If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\). If not
-a string, PROMPTER is a function of one arg (an object from LIST), which
-returns a string to be used as the prompt for that object. If the return
-value is not a string, it may be nil to ignore the object or non-nil to act
-on the object without asking the user.
-
-ACTOR is a function of one arg (an object from LIST),
-which gets called with each object that the user answers `yes' for.
-
-If HELP is given, it is a list (OBJECT OBJECTS ACTION),
-where OBJECT is a string giving the singular noun for an elt of LIST;
-OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive
-verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\"\).
-
-At the prompts, the user may enter y, Y, or SPC to act on that object;
-n, N, or DEL to skip that object; ! to act on all following objects;
-ESC or q to exit (skip all following objects); . (period) to act on the
-current object and then exit; or \\[help-command] to get help.
-
-If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys
-that will be accepted. KEY is a character; FUNCTION is a function of one
-arg (an object from LIST); HELP is a string. When the user hits KEY,
-FUNCTION is called. If it returns non-nil, the object is considered
-\"acted upon\", and the next object from LIST is processed. If it returns
-nil, the prompt is repeated for the same object.
-
-Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set
-`cursor-in-echo-area' while prompting.
-
-This function uses `query-replace-map' to define the standard responses,
-but not all of the responses which `query-replace' understands
-are meaningful here.
-
-Returns the number of actions taken."
- (let* ((actions 0)
- user-keys mouse-event map prompt char elt tail def
- ;; Non-nil means we should use mouse menus to ask.
- use-menus
- delayed-switch-frame
- (next (if (or (and list (symbolp list))
- (subrp list)
- (byte-code-function-p list)
- (and (consp list)
- (eq (car list) 'lambda)))
- (function (lambda ()
- (setq elt (funcall list))))
- (function (lambda ()
- (if list
- (progn
- (setq elt (car list)
- list (cdr list))
- t)
- nil))))))
- (if (and (listp last-nonmenu-event)
- use-dialog-box)
- ;; Make a list describing a dialog box.
- (let ((object (if help (capitalize (nth 0 help))))
- (objects (if help (capitalize (nth 1 help))))
- (action (if help (capitalize (nth 2 help)))))
- (setq map `(("Yes" . act) ("No" . skip) ("Quit" . exit)
- (,(if help (concat action " " object " And Quit")
- "Do it and Quit") . act-and-exit)
- (,(if help (concat action " All " objects)
- "Do All") . automatic)
- ,@(mapcar (lambda (elt)
- (cons (capitalize (nth 2 elt))
- (vector (nth 1 elt))))
- action-alist))
- use-menus t
- mouse-event last-nonmenu-event))
- (setq user-keys (if action-alist
- (concat (mapconcat (function
- (lambda (elt)
- (key-description
- (char-to-string (car elt)))))
- action-alist ", ")
- " ")
- "")
- ;; Make a map that defines each user key as a vector containing
- ;; its definition.
- map (cons 'keymap
- (append (mapcar (lambda (elt)
- (cons (car elt) (vector (nth 1 elt))))
- action-alist)
- query-replace-map))))
- (unwind-protect
- (progn
- (if (stringp prompter)
- (setq prompter `(lambda (object)
- (format ,prompter object))))
- (while (funcall next)
- (setq prompt (funcall prompter elt))
- (cond ((stringp prompt)
- ;; Prompt the user about this object.
- (setq quit-flag nil)
- (if use-menus
- (setq def (or (x-popup-dialog (or mouse-event use-menus)
- (cons prompt map))
- 'quit))
- ;; Prompt in the echo area.
- (let ((cursor-in-echo-area (not no-cursor-in-echo-area))
- (message-log-max nil))
- (message "%s(y, n, !, ., q, %sor %s) "
- prompt user-keys
- (key-description (vector help-char)))
- (if minibuffer-auto-raise
- (raise-frame (window-frame (minibuffer-window))))
- (while (progn
- (setq char (read-event))
- ;; If we get -1, from end of keyboard
- ;; macro, try again.
- (equal char -1)))
- ;; Show the answer to the question.
- (message "%s(y, n, !, ., q, %sor %s) %s"
- prompt user-keys
- (key-description (vector help-char))
- (single-key-description char)))
- (setq def (lookup-key map (vector char))))
- (cond ((eq def 'exit)
- (setq next (function (lambda () nil))))
- ((eq def 'act)
- ;; Act on the object.
- (funcall actor elt)
- (setq actions (1+ actions)))
- ((eq def 'skip)
- ;; Skip the object.
- )
- ((eq def 'act-and-exit)
- ;; Act on the object and then exit.
- (funcall actor elt)
- (setq actions (1+ actions)
- next (function (lambda () nil))))
- ((eq def 'quit)
- (setq quit-flag t)
- (setq next `(lambda ()
- (setq next ',next)
- ',elt)))
- ((eq def 'automatic)
- ;; Act on this and all following objects.
- (if (funcall prompter elt)
- (progn
- (funcall actor elt)
- (setq actions (1+ actions))))
- (while (funcall next)
- (if (funcall prompter elt)
- (progn
- (funcall actor elt)
- (setq actions (1+ actions))))))
- ((eq def 'help)
- (with-output-to-temp-buffer "*Help*"
- (princ
- (let ((object (if help (nth 0 help) "object"))
- (objects (if help (nth 1 help) "objects"))
- (action (if help (nth 2 help) "act on")))
- (concat
- (format "Type SPC or `y' to %s the current %s;
-DEL or `n' to skip the current %s;
-RET or `q' to exit (skip all remaining %s);
-C-g to quit (cancel the operation);
-! to %s all remaining %s;\n"
- action object object objects action
- objects)
- (mapconcat (function
- (lambda (elt)
- (format "%s to %s"
- (single-key-description
- (nth 0 elt))
- (nth 2 elt))))
- action-alist
- ";\n")
- (if action-alist ";\n")
- (format "or . (period) to %s \
-the current %s and exit."
- action object))))
- (save-excursion
- (set-buffer standard-output)
- (help-mode)))
-
- (setq next `(lambda ()
- (setq next ',next)
- ',elt)))
- ((vectorp def)
- ;; A user-defined key.
- (if (funcall (aref def 0) elt) ;Call its function.
- ;; The function has eaten this object.
- (setq actions (1+ actions))
- ;; Regurgitated; try again.
- (setq next `(lambda ()
- (setq next ',next)
- ',elt))))
- ((and (consp char)
- (eq (car char) 'switch-frame))
- ;; switch-frame event. Put it off until we're done.
- (setq delayed-switch-frame char)
- (setq next `(lambda ()
- (setq next ',next)
- ',elt)))
- (t
- ;; Random char.
- (message "Type %s for help."
- (key-description (vector help-char)))
- (beep)
- (sit-for 1)
- (setq next `(lambda ()
- (setq next ',next)
- ',elt)))))
- (prompt
- (funcall actor elt)
- (setq actions (1+ actions))))))
- (if delayed-switch-frame
- (setq unread-command-events
- (cons delayed-switch-frame unread-command-events))))
- ;; Clear the last prompt from the minibuffer.
- (let ((message-log-max nil))
- (message ""))
- ;; Return the number of actions that were taken.
- actions))
-
-;;; map-ynp.el ends here
+++ /dev/null
-;;; regi.el --- REGular expression Interpreting engine
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
-;; Maintainer: bwarsaw@cen.com
-;; Created: 24-Feb-1993
-;; Version: 1.8
-;; Last Modified: 1993/06/01 21:33:00
-;; Keywords: extensions, matching
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-\f
-(defun regi-pos (&optional position col-p)
- "Return the character position at various buffer positions.
-Optional POSITION can be one of the following symbols:
-
-`bol' == beginning of line
-`boi' == beginning of indentation
-`eol' == end of line [default]
-`bonl' == beginning of next line
-`bopl' == beginning of previous line
-
-Optional COL-P non-nil returns `current-column' instead of character position."
- (save-excursion
- (cond
- ((eq position 'bol) (beginning-of-line))
- ((eq position 'boi) (back-to-indentation))
- ((eq position 'bonl) (forward-line 1))
- ((eq position 'bopl) (forward-line -1))
- (t (end-of-line)))
- (if col-p (current-column) (point))))
-
-(defun regi-mapcar (predlist func &optional negate-p case-fold-search-p)
- "Build a regi frame where each element of PREDLIST appears exactly once.
-The frame contains elements where each member of PREDLIST is
-associated with FUNC, and optionally NEGATE-P and CASE-FOLD-SEARCH-P."
- (let (frame tail)
- (if (or negate-p case-fold-search-p)
- (setq tail (list negate-p)))
- (if case-fold-search-p
- (setq tail (append tail (list case-fold-search-p))))
- (while predlist
- (let ((element (list (car predlist) func)))
- (if tail
- (setq element (append element tail)))
- (setq frame (append frame (list element))
- predlist (cdr predlist))
- ))
- frame))
-
-\f
-(defun regi-interpret (frame &optional start end)
- "Interpret the regi frame FRAME.
-If optional START and END are supplied, they indicate the region of
-interest, and the buffer is narrowed to the beginning of the line
-containing START, and beginning of the line after the line containing
-END. Otherwise, point and mark are not set and processing continues
-until your FUNC returns the `abort' symbol (see below). Beware! Not
-supplying a START or END could put you in an infinite loop.
-
-A regi frame is a list of entries of the form:
-
- (PRED FUNC [NEGATE-P [CASE-FOLD-SEARCH]])
-
-PRED is a predicate against which each line in the region is tested,
-and if a match occurs, FUNC is `eval'd. Point is then moved to the
-beginning of the next line, the frame is reset and checking continues.
-If a match doesn't occur, the next entry is checked against the
-current line until all entries in the frame are checked. At this
-point, if no match occurred, the frame is reset and point is moved to
-the next line. Checking continues until every line in the region is
-checked. Optional NEGATE-P inverts the result of PRED before FUNC is
-called and `case-fold-search' is bound to the optional value of
-CASE-FOLD-SEARCH for the PRED check.
-
-PRED can be a string, variable, function or one of the following
-symbols: t, nil, `begin', `end', and `every'. If PRED is a string, or
-a variable or list that evaluates to a string, it is interpreted as a
-regular expression and is matched against the current line (from the
-beginning) using `looking-at'. If PRED does not evaluate to a string,
-it is interpreted as a binary value (nil or non-nil).
-
-PRED can also be one of the following symbols:
-
-t -- always produces a true outcome
-`begin' -- always executes before anything else
-`end' -- always executes after everything else
-`every' -- execute after frame is matched on a line
-
-Note that NEGATE-P and CASE-FOLD-SEARCH are meaningless if PRED is one
-of these special symbols. Only the first occurrence of each symbol in
-a frame entry is used, the rest are ignored.
-
-Your FUNC can return values which control regi processing. If a list
-is returned from your function, it can contain any combination of the
-following elements:
-
-the symbol `continue'
- Tells regi to continue processing frame-entries after a match,
- instead of resetting to the first entry and advancing to the next
- line, as is the default behavior. When returning this symbol,
- you must take care not to enter an infinite loop.
-
-the symbol `abort'
- Tells regi to terminate processing this frame. any end
- frame-entry is still processed.
-
-the list `(frame . NEWFRAME)'
- Tells regi to use NEWFRAME as its current frame. In other words,
- your FUNC can modify the executing regi frame on the fly.
-
-the list `(step . STEP)'
- Tells regi to move STEP number of lines forward during normal
- processing. By default, regi moves forward 1 line. STEP can be
- negative, but be careful of infinite loops.
-
-You should usually take care to explicitly return nil from your
-function if no action is to take place. Your FUNC will always be
-`eval'ed. The following variables will be temporarily bound to some
-useful information:
-
-`curline'
- the current line in the buffer, as a string
-
-`curframe'
- the full, current frame being executed
-
-`curentry'
- the current frame entry being executed."
-
- (save-excursion
- (save-restriction
- (let (begin-tag end-tag every-tag current-frame working-frame donep)
-
- ;; set up the narrowed region
- (and start
- end
- (let* ((tstart start)
- (start (min start end))
- (end (max start end)))
- (narrow-to-region
- (progn (goto-char end) (regi-pos 'bonl))
- (progn (goto-char start) (regi-pos 'bol)))))
-
- ;; lets find the special tags and remove them from the working
- ;; frame. note that only the last special tag is used.
- (mapcar
- (function
- (lambda (entry)
- (let ((pred (car entry))
- (func (car (cdr entry))))
- (cond
- ((eq pred 'begin) (setq begin-tag func))
- ((eq pred 'end) (setq end-tag func))
- ((eq pred 'every) (setq every-tag func))
- (t
- (setq working-frame (append working-frame (list entry))))
- ) ; end-cond
- )))
- frame) ; end-mapcar
-
- ;; execute the begin entry
- (eval begin-tag)
-
- ;; now process the frame
- (setq current-frame working-frame)
- (while (not (or donep (eobp)))
- (let* ((entry (car current-frame))
- (pred (nth 0 entry))
- (func (nth 1 entry))
- (negate-p (nth 2 entry))
- (case-fold-search (nth 3 entry))
- match-p)
- (catch 'regi-throw-top
- (cond
- ;; we are finished processing the frame for this line
- ((not current-frame)
- (setq current-frame working-frame) ;reset frame
- (forward-line 1)
- (throw 'regi-throw-top t))
- ;; see if predicate evaluates to a string
- ((stringp (setq match-p (eval pred)))
- (setq match-p (looking-at match-p)))
- ) ; end-cond
-
- ;; now that we've done the initial matching, check for
- ;; negation of match
- (and negate-p
- (setq match-p (not match-p)))
-
- ;; if the line matched, package up the argument list and
- ;; funcall the FUNC
- (if match-p
- (let* ((curline (buffer-substring
- (regi-pos 'bol)
- (regi-pos 'eol)))
- (curframe current-frame)
- (curentry entry)
- (result (eval func))
- (step (or (cdr (assq 'step result)) 1))
- )
- ;; changing frame on the fly?
- (if (assq 'frame result)
- (setq working-frame (cdr (assq 'frame result))))
-
- ;; continue processing current frame?
- (if (memq 'continue result)
- (setq current-frame (cdr current-frame))
- (forward-line step)
- (setq current-frame working-frame))
-
- ;; abort current frame?
- (if (memq 'abort result)
- (progn
- (setq donep t)
- (throw 'regi-throw-top t)))
- ) ; end-let
-
- ;; else if no match occurred, then process the next
- ;; frame-entry on the current line
- (setq current-frame (cdr current-frame))
-
- ) ; end-if match-p
- ) ; end catch
- ) ; end let
-
- ;; after every cycle, evaluate every-tag
- (eval every-tag)
- ) ; end-while
-
- ;; now process the end entry
- (eval end-tag)))))
-
-\f
-(provide 'regi)
-
-;;; regi.el ends here
+++ /dev/null
-;;; timer.el --- run a function with args at some time in future
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package gives you the capability to run Emacs Lisp commands at
-;; specified times in the future, either as one-shots or periodically.
-
-;;; Code:
-
-;; Layout of a timer vector:
-;; [triggered-p high-seconds low-seconds usecs repeat-delay
-;; function args idle-delay]
-
-(defun timer-create ()
- "Create a timer object."
- (let ((timer (make-vector 8 nil)))
- (aset timer 0 t)
- timer))
-
-(defun timerp (object)
- "Return t if OBJECT is a timer."
- (and (vectorp object) (= (length object) 8)))
-
-(defun timer-set-time (timer time &optional delta)
- "Set the trigger time of TIMER to TIME.
-TIME must be in the internal format returned by, e.g., `current-time'.
-If optional third argument DELTA is a positive number, make the timer
-fire repeatedly that many seconds apart."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 (car time))
- (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
- (aset timer 3 (or (and (consp (cdr time)) (consp (cdr (cdr time)))
- (nth 2 time))
- 0))
- (aset timer 4 (and (numberp delta) (> delta 0) delta))
- timer)
-
-(defun timer-set-idle-time (timer secs &optional repeat)
- "Set the trigger idle time of TIMER to SECS.
-If optional third argument REPEAT is non-nil, make the timer
-fire each time Emacs is idle for that many seconds."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 0)
- (aset timer 2 0)
- (aset timer 3 0)
- (timer-inc-time timer secs)
- (aset timer 4 repeat)
- timer)
-
-(defun timer-next-integral-multiple-of-time (time secs)
- "Yield the next value after TIME that is an integral multiple of SECS.
-More precisely, the next value, after TIME, that is an integral multiple
-of SECS seconds since the epoch. SECS may be a fraction."
- (let ((time-base (ash 1 16)))
- (if (fboundp 'atan)
- ;; Use floating point, taking care to not lose precision.
- (let* ((float-time-base (float time-base))
- (million 1000000.0)
- (time-usec (+ (* million
- (+ (* float-time-base (nth 0 time))
- (nth 1 time)))
- (nth 2 time)))
- (secs-usec (* million secs))
- (mod-usec (mod time-usec secs-usec))
- (next-usec (+ (- time-usec mod-usec) secs-usec))
- (time-base-million (* float-time-base million)))
- (list (floor next-usec time-base-million)
- (floor (mod next-usec time-base-million) million)
- (floor (mod next-usec million))))
- ;; Floating point is not supported.
- ;; Use integer arithmetic, avoiding overflow if possible.
- (let* ((mod-sec (mod (+ (* (mod time-base secs)
- (mod (nth 0 time) secs))
- (nth 1 time))
- secs))
- (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
- (list (+ (nth 0 time) (floor next-1-sec time-base))
- (mod next-1-sec time-base)
- 0)))))
-
-(defun timer-relative-time (time secs &optional usecs)
- "Advance TIME by SECS seconds and optionally USECS microseconds.
-SECS may be a fraction."
- (let ((high (car time))
- (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
- (micro (if (numberp (car-safe (cdr-safe (cdr time))))
- (nth 2 time)
- 0)))
- ;; Add
- (if usecs (setq micro (+ micro usecs)))
- (if (floatp secs)
- (setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
- (setq low (+ low (floor secs)))
-
- ;; Normalize
- ;; `/' rounds towards zero while `mod' returns a positive number,
- ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
- (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
- (setq micro (mod micro 1000000))
- (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
- (setq low (logand low 65535))
-
- (list high low (and (/= micro 0) micro))))
-
-(defun timer-inc-time (timer secs &optional usecs)
- "Increment the time set in TIMER by SECS seconds and USECS microseconds.
-SECS may be a fraction. If USECS is omitted, that means it is zero."
- (let ((time (timer-relative-time
- (list (aref timer 1) (aref timer 2) (aref timer 3))
- secs
- usecs)))
- (aset timer 1 (nth 0 time))
- (aset timer 2 (nth 1 time))
- (aset timer 3 (or (nth 2 time) 0))))
-
-(defun timer-set-time-with-usecs (timer time usecs &optional delta)
- "Set the trigger time of TIMER to TIME plus USECS.
-TIME must be in the internal format returned by, e.g., `current-time'.
-The microsecond count from TIME is ignored, and USECS is used instead.
-If optional fourth argument DELTA is a positive number, make the timer
-fire repeatedly that many seconds apart."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 (nth 0 time))
- (aset timer 2 (nth 1 time))
- (aset timer 3 usecs)
- (aset timer 4 (and (numberp delta) (> delta 0) delta))
- timer)
-(make-obsolete 'timer-set-time-with-usecs
- "use `timer-set-time' and `timer-inc-time' instead."
- "21.4")
-
-(defun timer-set-function (timer function &optional args)
- "Make TIMER call FUNCTION with optional ARGS when triggering."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 5 function)
- (aset timer 6 args)
- timer)
-\f
-(defun timer-activate (timer)
- "Put TIMER on the list of active timers."
- (if (and (timerp timer)
- (integerp (aref timer 1))
- (integerp (aref timer 2))
- (integerp (aref timer 3))
- (aref timer 5))
- (let ((timers timer-list)
- last)
- ;; Skip all timers to trigger before the new one.
- (while (and timers
- (or (> (aref timer 1) (aref (car timers) 1))
- (and (= (aref timer 1) (aref (car timers) 1))
- (> (aref timer 2) (aref (car timers) 2)))
- (and (= (aref timer 1) (aref (car timers) 1))
- (= (aref timer 2) (aref (car timers) 2))
- (> (aref timer 3) (aref (car timers) 3)))))
- (setq last timers
- timers (cdr timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (if last
- (setcdr last (cons timer timers))
- (setq timer-list (cons timer timers)))
- (aset timer 0 nil)
- (aset timer 7 nil)
- nil)
- (error "Invalid or uninitialized timer")))
-
-(defun timer-activate-when-idle (timer &optional dont-wait)
- "Arrange to activate TIMER whenever Emacs is next idle.
-If optional argument DONT-WAIT is non-nil, then enable the
-timer to activate immediately, or at the right time, if Emacs
-is already idle."
- (if (and (timerp timer)
- (integerp (aref timer 1))
- (integerp (aref timer 2))
- (integerp (aref timer 3))
- (aref timer 5))
- (let ((timers timer-idle-list)
- last)
- ;; Skip all timers to trigger before the new one.
- (while (and timers
- (or (> (aref timer 1) (aref (car timers) 1))
- (and (= (aref timer 1) (aref (car timers) 1))
- (> (aref timer 2) (aref (car timers) 2)))
- (and (= (aref timer 1) (aref (car timers) 1))
- (= (aref timer 2) (aref (car timers) 2))
- (> (aref timer 3) (aref (car timers) 3)))))
- (setq last timers
- timers (cdr timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (if last
- (setcdr last (cons timer timers))
- (setq timer-idle-list (cons timer timers)))
- (aset timer 0 (not dont-wait))
- (aset timer 7 t)
- nil)
- (error "Invalid or uninitialized timer")))
-
-;;;###autoload
-(defalias 'disable-timeout 'cancel-timer)
-;;;###autoload
-(defun cancel-timer (timer)
- "Remove TIMER from the list of active timers."
- (or (timerp timer)
- (error "Invalid timer"))
- (setq timer-list (delq timer timer-list))
- (setq timer-idle-list (delq timer timer-idle-list))
- nil)
-
-;;;###autoload
-(defun cancel-function-timers (function)
- "Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
- (interactive "aCancel timers of function: ")
- (let ((tail timer-list))
- (while tail
- (if (eq (aref (car tail) 5) function)
- (setq timer-list (delq (car tail) timer-list)))
- (setq tail (cdr tail))))
- (let ((tail timer-idle-list))
- (while tail
- (if (eq (aref (car tail) 5) function)
- (setq timer-idle-list (delq (car tail) timer-idle-list)))
- (setq tail (cdr tail)))))
-\f
-;; Record the last few events, for debugging.
-(defvar timer-event-last-2 nil)
-(defvar timer-event-last-1 nil)
-(defvar timer-event-last nil)
-
-(defvar timer-max-repeats 10
- "*Maximum number of times to repeat a timer, if real time jumps.")
-
-(defun timer-until (timer time)
- "Calculate number of seconds from when TIMER will run, until TIME.
-TIMER is a timer, and stands for the time when its next repeat is scheduled.
-TIME is a time-list."
- (let ((high (- (car time) (aref timer 1)))
- (low (- (nth 1 time) (aref timer 2))))
- (+ low (* high 65536))))
-
-(defun timer-event-handler (timer)
- "Call the handler for the timer TIMER.
-This function is called, by name, directly by the C code."
- (setq timer-event-last-2 timer-event-last-1)
- (setq timer-event-last-1 timer-event-last)
- (setq timer-event-last timer)
- (let ((inhibit-quit t))
- (if (timerp timer)
- (progn
- ;; Delete from queue.
- (cancel-timer timer)
- ;; Re-schedule if requested.
- (if (aref timer 4)
- (if (aref timer 7)
- (timer-activate-when-idle timer)
- (timer-inc-time timer (aref timer 4) 0)
- ;; If real time has jumped forward,
- ;; perhaps because Emacs was suspended for a long time,
- ;; limit how many times things get repeated.
- (if (and (numberp timer-max-repeats)
- (< 0 (timer-until timer (current-time))))
- (let ((repeats (/ (timer-until timer (current-time))
- (aref timer 4))))
- (if (> repeats timer-max-repeats)
- (timer-inc-time timer (* (aref timer 4) repeats)))))
- (timer-activate timer)))
- ;; Run handler.
- ;; We do this after rescheduling so that the handler function
- ;; can cancel its own timer successfully with cancel-timer.
- (condition-case nil
- (apply (aref timer 5) (aref timer 6))
- (error nil)))
- (error "Bogus timer event"))))
-
-;; This function is incompatible with the one in levents.el.
-(defun timeout-event-p (event)
- "Non-nil if EVENT is a timeout event."
- (and (listp event) (eq (car event) 'timer-event)))
-\f
-;;;###autoload
-(defun run-at-time (time repeat function &rest args)
- "Perform an action at time TIME.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds
-from now, a value from `current-time', or t (with non-nil REPEAT)
-meaning the next integral multiple of REPEAT.
-REPEAT may be an integer or floating point number.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
-
- (or (null repeat)
- (and (numberp repeat) (< 0 repeat))
- (error "Invalid repetition interval"))
-
- ;; Special case: nil means "now" and is useful when repeating.
- (if (null time)
- (setq time (current-time)))
-
- ;; Special case: t means the next integral multiple of REPEAT.
- (if (and (eq time t) repeat)
- (setq time (timer-next-integral-multiple-of-time (current-time) repeat)))
-
- ;; Handle numbers as relative times in seconds.
- (if (numberp time)
- (setq time (timer-relative-time (current-time) time)))
-
- ;; Handle relative times like "2 hours and 35 minutes"
- (if (stringp time)
- (let ((secs (timer-duration time)))
- (if secs
- (setq time (timer-relative-time (current-time) secs)))))
-
- ;; Handle "11:23pm" and the like. Interpret it as meaning today
- ;; which admittedly is rather stupid if we have passed that time
- ;; already. (Though only Emacs hackers hack Emacs at that time.)
- (if (stringp time)
- (progn
- (require 'diary-lib)
- (let ((hhmm (diary-entry-time time))
- (now (decode-time)))
- (if (>= hhmm 0)
- (setq time
- (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
- (nth 4 now) (nth 5 now) (nth 8 now)))))))
-
- (or (consp time)
- (error "Invalid time format"))
-
- (let ((timer (timer-create)))
- (timer-set-time timer time repeat)
- (timer-set-function timer function args)
- (timer-activate timer)
- timer))
-
-;;;###autoload
-(defun run-with-timer (secs repeat function &rest args)
- "Perform an action after a delay of SECS seconds.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-SECS and REPEAT may be integers or floating point numbers.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
- (apply 'run-at-time secs repeat function args))
-
-;;;###autoload
-(defun add-timeout (secs function object &optional repeat)
- "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
-If REPEAT is non-nil, repeat the timer every REPEAT seconds.
-This function is for compatibility; see also `run-with-timer'."
- (run-with-timer secs repeat function object))
-
-;;;###autoload
-(defun run-with-idle-timer (secs repeat function &rest args)
- "Perform an action the next time Emacs is idle for SECS seconds.
-The action is to call FUNCTION with arguments ARGS.
-SECS may be an integer or a floating point number.
-
-If REPEAT is non-nil, do the action each time Emacs has been idle for
-exactly SECS seconds (that is, only once for each time Emacs becomes idle).
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive
- (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
- (y-or-n-p "Repeat each time Emacs is idle? ")
- (intern (completing-read "Function: " obarray 'fboundp t))))
- (let ((timer (timer-create)))
- (timer-set-function timer function args)
- (timer-set-idle-time timer secs repeat)
- (timer-activate-when-idle timer)
- timer))
-\f
-(defun with-timeout-handler (tag)
- (throw tag 'timeout))
-
-;;;###autoload (put 'with-timeout 'lisp-indent-function 1)
-
-;;;###autoload
-(defmacro with-timeout (list &rest body)
- "Run BODY, but if it doesn't finish in SECONDS seconds, give up.
-If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
-The call should look like:
- (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
-The timeout is checked whenever Emacs waits for some kind of external
-event \(such as keyboard input, input from subprocesses, or a certain time);
-if the program loops without waiting in any way, the timeout will not
-be detected."
- (let ((seconds (car list))
- (timeout-forms (cdr list)))
- `(let ((with-timeout-tag (cons nil nil))
- with-timeout-value with-timeout-timer)
- (if (catch with-timeout-tag
- (progn
- (setq with-timeout-timer
- (run-with-timer ,seconds nil
- 'with-timeout-handler
- with-timeout-tag))
- (setq with-timeout-value (progn . ,body))
- nil))
- (progn . ,timeout-forms)
- (cancel-timer with-timeout-timer)
- with-timeout-value))))
-
-(defun y-or-n-p-with-timeout (prompt seconds default-value)
- "Like (y-or-n-p PROMPT), with a timeout.
-If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
- (with-timeout (seconds default-value)
- (y-or-n-p prompt)))
-\f
-(defvar timer-duration-words
- (list (cons "microsec" 0.000001)
- (cons "microsecond" 0.000001)
- (cons "millisec" 0.001)
- (cons "millisecond" 0.001)
- (cons "sec" 1)
- (cons "second" 1)
- (cons "min" 60)
- (cons "minute" 60)
- (cons "hour" (* 60 60))
- (cons "day" (* 24 60 60))
- (cons "week" (* 7 24 60 60))
- (cons "fortnight" (* 14 24 60 60))
- (cons "month" (* 30 24 60 60)) ; Approximation
- (cons "year" (* 365.25 24 60 60)) ; Approximation
- )
- "Alist mapping temporal words to durations in seconds")
-
-(defun timer-duration (string)
- "Return number of seconds specified by STRING, or nil if parsing fails."
- (let ((secs 0)
- (start 0)
- (case-fold-search t))
- (while (string-match
- "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*"
- string start)
- (let ((count (if (match-beginning 1)
- (string-to-number (match-string 1 string))
- 1))
- (itemsize (cdr (assoc (match-string 2 string)
- timer-duration-words))))
- (if itemsize
- (setq start (match-end 0)
- secs (+ secs (* count itemsize)))
- (setq secs nil
- start (length string)))))
- (if (= start (length string))
- secs
- (if (string-match "\\`[0-9.]+\\'" string)
- (string-to-number string)))))
-\f
-(provide 'timer)
-
-;;; timer.el ends here
+++ /dev/null
-;;; warnings.el --- log and display warnings
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This file implements the entry points `warn', `lwarn'
-;; and `display-warnings'.
-
-;;; Code:
-
-(defgroup warnings nil
- "Log and display warnings."
- :version "21.4"
- :group 'lisp)
-
-(defvar warning-levels
- '((:emergency "Emergency%s: " ding)
- (:error "Error%s: ")
- (:warning "Warning%s: ")
- (:debug "Debug%s: "))
- "List of severity level definitions for `display-warning'.
-Each element looks like (LEVEL STRING FUNCTION) and
-defines LEVEL as a severity level. STRING specifies the
-description of this level. STRING should use `%s' to
-specify where to put the warning group information,
-or it can omit the `%s' so as not to include that information.
-
-The optional FUNCTION, if non-nil, is a function to call
-with no arguments, to get the user's attention.
-
-The standard levels are :emergency, :error, :warning and :debug.
-See `display-warning' for documentation of their meanings.
-Level :debug is ignored by default (see `warning-minimum-level').")
-(put 'warning-levels 'risky-local-variable t)
-
-;; These are for compatibility with XEmacs.
-;; I don't think there is any chance of designing meaningful criteria
-;; to distinguish so many levels.
-(defvar warning-level-aliases
- '((emergency . :emergency)
- (error . :error)
- (warning . :warning)
- (notice . :warning)
- (info . :warning)
- (critical . :emergency)
- (alarm . :emergency))
- "Alist of aliases for severity levels for `display-warning'.
-Each element looks like (ALIAS . LEVEL) and defines
-ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels';
-it may not itself be an alias.")
-\f
-(defcustom warning-minimum-level :warning
- "Minimum severity level for displaying the warning buffer.
-If a warning's severity level is lower than this,
-the warning is logged in the warnings buffer, but the buffer
-is not immediately displayed. See also `warning-minimum-log-level'."
- :group 'warnings
- :type '(choice (const :emergency) (const :error) (const :warning))
- :version "21.4")
-(defvaralias 'display-warning-minimum-level 'warning-minimum-level)
-
-(defcustom warning-minimum-log-level :warning
- "Minimum severity level for logging a warning.
-If a warning severity level is lower than this,
-the warning is completely ignored."
- :group 'warnings
- :type '(choice (const :emergency) (const :error) (const :warning))
- :version "21.4")
-(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)
-
-(defcustom warning-suppress-log-types nil
- "List of warning types that should not be logged.
-If any element of this list matches the GROUP argument to `display-warning',
-the warning is completely ignored.
-The element must match the first elements of GROUP.
-Thus, (foo bar) as an element matches (foo bar)
-or (foo bar ANYTHING...) as GROUP.
-If GROUP is a symbol FOO, that is equivalent to the list (FOO),
-so only the element (FOO) will match it."
- :group 'warnings
- :type '(repeat (repeat symbol))
- :version "21.4")
-
-(defcustom warning-suppress-types nil
- "Custom groups for warnings not to display immediately.
-If any element of this list matches the GROUP argument to `display-warning',
-the warning is logged nonetheless, but the warnings buffer is
-not immediately displayed.
-The element must match an initial segment of the list GROUP.
-Thus, (foo bar) as an element matches (foo bar)
-or (foo bar ANYTHING...) as GROUP.
-If GROUP is a symbol FOO, that is equivalent to the list (FOO),
-so only the element (FOO) will match it.
-See also `warning-suppress-log-types'."
- :group 'warnings
- :type '(repeat (repeat symbol))
- :version "21.4")
-\f
-;;; The autoload cookie is so that programs can bind this variable
-;;; safely, testing the existing value, before they call one of the
-;;; warnings functions.
-;;;###autoload
-(defvar warning-prefix-function nil
- "Function to generate warning prefixes.
-This function, if non-nil, is called with two arguments,
-the severity level and its entry in `warning-levels',
-and should return the entry that should actually be used.
-The warnings buffer is current when this function is called
-and the function can insert text in it. This text becomes
-the beginning of the warning.")
-
-;;; The autoload cookie is so that programs can bind this variable
-;;; safely, testing the existing value, before they call one of the
-;;; warnings functions.
-;;;###autoload
-(defvar warning-series nil
- "Non-nil means treat multiple `display-warning' calls as a series.
-A marker indicates a position in the warnings buffer
-which is the start of the current series; it means that
-additional warnings in the same buffer should not move point.
-t means the next warning begins a series (and stores a marker here).
-A symbol with a function definition is like t, except
-also call that function before the next warning.")
-(put 'warning-series 'risky-local-variable t)
-
-;;; The autoload cookie is so that programs can bind this variable
-;;; safely, testing the existing value, before they call one of the
-;;; warnings functions.
-;;;###autoload
-(defvar warning-fill-prefix nil
- "Non-nil means fill each warning text using this string as `fill-prefix'.")
-
-;;; The autoload cookie is so that programs can bind this variable
-;;; safely, testing the existing value, before they call one of the
-;;; warnings functions.
-;;;###autoload
-(defvar warning-group-format " (%s)"
- "Format for displaying the warning group in the warning message.
-The result of formatting the group this way gets included in the
-message under the control of the string in `warning-levels'.")
-\f
-(defun warning-numeric-level (level)
- "Return a numeric measure of the warning severity level LEVEL."
- (let* ((elt (assq level warning-levels))
- (link (memq elt warning-levels)))
- (length link)))
-
-(defun warning-suppress-p (group suppress-list)
- "Non-nil if a warning with group GROUP should be suppressed.
-SUPPRESS-LIST is the list of kinds of warnings to suppress."
- (let (some-match)
- (dolist (elt suppress-list)
- (if (symbolp group)
- ;; If GROUP is a symbol, the ELT must be (GROUP).
- (if (and (consp elt)
- (eq (car elt) group)
- (null (cdr elt)))
- (setq some-match t))
- ;; If GROUP is a list, ELT must match it or some initial segment of it.
- (let ((tem1 group)
- (tem2 elt)
- (match t))
- ;; Check elements of ELT until we run out of them.
- (while tem2
- (if (not (equal (car tem1) (car tem2)))
- (setq match nil))
- (setq tem1 (cdr tem1)
- tem2 (cdr tem2)))
- ;; If ELT is an initial segment of GROUP, MATCH is t now.
- ;; So set SOME-MATCH.
- (if match
- (setq some-match t)))))
- ;; If some element of SUPPRESS-LIST matched,
- ;; we return t.
- some-match))
-\f
-;;;###autoload
-(defun display-warning (group message &optional level buffer-name)
- "Display a warning message, MESSAGE.
-GROUP should be a custom group name (a symbol),
-or else a list of symbols whose first element is a custom group name.
-\(The rest of the symbols represent subcategories, for warning purposes
-only, and you can use whatever symbols you like.)
-
-LEVEL should be either :warning, :error, or :emergency.
-:emergency -- a problem that will seriously impair Emacs operation soon
- if you do not attend to it promptly.
-:error -- data or circumstances that are inherently wrong.
-:warning -- data or circumstances that are not inherently wrong,
- but raise suspicion of a possible problem.
-:debug -- info for debugging only.
-
-BUFFER-NAME, if specified, is the name of the buffer for logging the
-warning. By default, it is `*Warnings*'.
-
-See the `warnings' custom group for user customization features.
-
-See also `warning-series', `warning-prefix-function' and
-`warning-fill-prefix' for additional programming features."
- (unless level
- (setq level :warning))
- (if (assq level warning-level-aliases)
- (setq level (cdr (assq level warning-level-aliases))))
- (or (< (warning-numeric-level level)
- (warning-numeric-level warning-minimum-log-level))
- (warning-suppress-p group warning-suppress-log-types)
- (let* ((groupname (if (consp group) (car group) group))
- (buffer (get-buffer-create (or buffer-name "*Warnings*")))
- (level-info (assq level warning-levels))
- start end)
- (with-current-buffer buffer
- (goto-char (point-max))
- (when (and warning-series (symbolp warning-series))
- (setq warning-series
- (prog1 (point-marker)
- (unless (eq warning-series t)
- (funcall warning-series)))))
- (unless (bolp)
- (newline))
- (setq start (point))
- (if warning-prefix-function
- (setq level-info (funcall warning-prefix-function
- level level-info)))
- (insert (format (nth 1 level-info)
- (format warning-group-format groupname))
- message)
- (newline)
- (when (and warning-fill-prefix (not (string-match "\n" message)))
- (let ((fill-prefix warning-fill-prefix)
- (fill-column 78))
- (fill-region start (point))))
- (setq end (point))
- (when (and (markerp warning-series)
- (eq (marker-buffer warning-series) buffer))
- (goto-char warning-series)))
- (if (nth 2 level-info)
- (funcall (nth 2 level-info)))
- (if noninteractive
- ;; Noninteractively, take the text we inserted
- ;; in the warnings buffer and print it.
- ;; Do this unconditionally, since there is no way
- ;; to view logged messages unless we output them.
- (with-current-buffer buffer
- (save-excursion
- ;; Don't include the final newline in the arg
- ;; to `message', because it adds a newline.
- (goto-char end)
- (if (bolp)
- (forward-char -1))
- (message "%s" (buffer-substring start (point)))))
- ;; Interactively, decide whether the warning merits
- ;; immediate display.
- (or (< (warning-numeric-level level)
- (warning-numeric-level warning-minimum-level))
- (warning-suppress-p group warning-suppress-types)
- (let ((window (display-buffer buffer)))
- (when (and (markerp warning-series)
- (eq (marker-buffer warning-series) buffer))
- (set-window-start window warning-series))
- (sit-for 0)))))))
-\f
-;;;###autoload
-(defun lwarn (group level message &rest args)
- "Display a warning message made from (format MESSAGE ARGS...).
-Aside from generating the message with `format',
-this is equivalent to `display-warning'.
-
-GROUP should be a custom group name (a symbol).
-or else a list of symbols whose first element is a custom group name.
-\(The rest of the symbols represent subcategories and
-can be whatever you like.)
-
-LEVEL should be either :warning, :error, or :emergency.
-:emergency -- a problem that will seriously impair Emacs operation soon
- if you do not attend to it promptly.
-:error -- invalid data or circumstances.
-:warning -- suspicious data or circumstances."
- (display-warning group (apply 'format message args) level))
-
-;;;###autoload
-(defun warn (message &rest args)
- "Display a warning message made from (format MESSAGE ARGS...).
-Aside from generating the message with `format',
-this is equivalent to `display-warning', using
-`emacs' as the group and `:warning' as the level."
- (display-warning 'emacs (apply 'format message args)))
-
-(provide 'warnings)
-
-;;; warnings.el ends here
--- /dev/null
+;;; enriched.el --- read and save files in text/enriched format
+
+;; Copyright (c) 1994, 1995, 1996, 2002 Free Software Foundation, Inc.
+
+;; Author: Boris Goldowsky <boris@gnu.org>
+;; Keywords: wp, faces
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file implements reading, editing, and saving files with
+;; text-properties such as faces, levels of indentation, and true line
+;; breaks distinguished from newlines just used to fit text into the window.
+
+;; The file format used is the MIME text/enriched format, which is a
+;; standard format defined in internet RFC 1563. All standard annotations
+;; are supported except for <smaller> and <bigger>, which are currently not
+;; possible to display.
+
+;; A separate file, enriched.doc, contains further documentation and other
+;; important information about this code. It also serves as an example
+;; file in text/enriched format. It should be in the etc directory of your
+;; emacs distribution.
+
+;;; Code:
+
+(provide 'enriched)
+
+;;;
+;;; Variables controlling the display
+;;;
+
+(defgroup enriched nil
+ "Read and save files in text/enriched format"
+ :group 'wp)
+
+(defcustom enriched-verbose t
+ "*If non-nil, give status messages when reading and writing files."
+ :type 'boolean
+ :group 'enriched)
+
+;;;
+;;; Set up faces & display table
+;;;
+
+;; Emacs doesn't have a "fixed" face by default, since all faces currently
+;; have to be fixed-width. So we just pick one that looks different from the
+;; default.
+(defface fixed
+ '((t (:weight bold)))
+ "Face used for text that must be shown in fixed width.
+Currently, emacs can only display fixed-width fonts, but this may change.
+This face is used for text specifically marked as fixed-width, for example
+in text/enriched files."
+ :group 'enriched)
+
+(defface excerpt
+ '((t (:slant italic)))
+ "Face used for text that is an excerpt from another document.
+This is used in Enriched mode for text explicitly marked as an excerpt."
+ :group 'enriched)
+
+(defconst enriched-display-table (or (copy-sequence standard-display-table)
+ (make-display-table)))
+(aset enriched-display-table ?\f (make-vector (1- (frame-width)) ?-))
+
+(defconst enriched-par-props '(left-margin right-margin justification)
+ "Text-properties that usually apply to whole paragraphs.
+These are set front-sticky everywhere except at hard newlines.")
+
+;;;
+;;; Variables controlling the file format
+;;; (bidirectional)
+
+(defconst enriched-initial-annotation
+ (lambda ()
+ (format "Content-Type: text/enriched\nText-Width: %d\n\n"
+ fill-column))
+ "What to insert at the start of a text/enriched file.
+If this is a string, it is inserted. If it is a list, it should be a lambda
+expression, which is evaluated to get the string to insert.")
+
+(defconst enriched-annotation-format "<%s%s>"
+ "General format of enriched-text annotations.")
+
+(defconst enriched-annotation-regexp "<\\(/\\)?\\([-A-Za-z0-9]+\\)>"
+ "Regular expression matching enriched-text annotations.")
+
+(defconst enriched-translations
+ '((face (bold-italic "bold" "italic")
+ (bold "bold")
+ (italic "italic")
+ (underline "underline")
+ (fixed "fixed")
+ (excerpt "excerpt")
+ (default )
+ (nil enriched-encode-other-face))
+ (left-margin (4 "indent"))
+ (right-margin (4 "indentright"))
+ (justification (none "nofill")
+ (right "flushright")
+ (left "flushleft")
+ (full "flushboth")
+ (center "center"))
+ (PARAMETER (t "param")) ; Argument of preceding annotation
+ ;; The following are not part of the standard:
+ (FUNCTION (enriched-decode-foreground "x-color")
+ (enriched-decode-background "x-bg-color")
+ (enriched-decode-display-prop "x-display"))
+ (read-only (t "x-read-only"))
+ (display (nil enriched-handle-display-prop))
+ (unknown (nil format-annotate-value))
+; (font-size (2 "bigger") ; unimplemented
+; (-2 "smaller"))
+)
+ "List of definitions of text/enriched annotations.
+See `format-annotate-region' and `format-deannotate-region' for the definition
+of this structure.")
+
+(defconst enriched-ignore
+ '(front-sticky rear-nonsticky hard)
+ "Properties that are OK to ignore when saving text/enriched files.
+Any property that is neither on this list nor dealt with by
+`enriched-translations' will generate a warning.")
+
+;;; Internal variables
+
+
+(defcustom enriched-mode-hook nil
+ "Hook run after entering/leaving Enriched mode.
+If you set variables in this hook, you should arrange for them to be restored
+to their old values if you leave Enriched mode. One way to do this is to add
+them and their old values to `enriched-old-bindings'."
+ :type 'hook
+ :group 'enriched)
+
+(defvar enriched-old-bindings nil
+ "Store old variable values that we change when entering mode.
+The value is a list of \(VAR VALUE VAR VALUE...).")
+(make-variable-buffer-local 'enriched-old-bindings)
+
+;;;
+;;; Define the mode
+;;;
+
+(put 'enriched-mode 'permanent-local t)
+;;;###autoload
+(define-minor-mode enriched-mode
+ "Minor mode for editing text/enriched files.
+These are files with embedded formatting information in the MIME standard
+text/enriched format.
+Turning the mode on runs `enriched-mode-hook'.
+
+More information about Enriched mode is available in the file
+etc/enriched.doc in the Emacs distribution directory.
+
+Commands:
+
+\\{enriched-mode-map}"
+ nil " Enriched" nil
+ (cond ((null enriched-mode)
+ ;; Turn mode off
+ (setq buffer-file-format (delq 'text/enriched buffer-file-format))
+ ;; restore old variable values
+ (while enriched-old-bindings
+ (set (pop enriched-old-bindings) (pop enriched-old-bindings))))
+
+ ((memq 'text/enriched buffer-file-format)
+ ;; Mode already on; do nothing.
+ nil)
+
+ (t ; Turn mode on
+ (push 'text/enriched buffer-file-format)
+ ;; Save old variable values before we change them.
+ ;; These will be restored if we exit Enriched mode.
+ (setq enriched-old-bindings
+ (list 'buffer-display-table buffer-display-table
+ 'indent-line-function indent-line-function
+ 'default-text-properties default-text-properties))
+ (make-local-variable 'indent-line-function)
+ (make-local-variable 'default-text-properties)
+ (setq indent-line-function 'indent-to-left-margin ;WHY?? -sm
+ buffer-display-table enriched-display-table)
+ (use-hard-newlines 1 nil)
+ (let ((sticky (plist-get default-text-properties 'front-sticky))
+ (p enriched-par-props))
+ (dolist (x p)
+ (add-to-list 'sticky x))
+ (if sticky
+ (setq default-text-properties
+ (plist-put default-text-properties
+ 'front-sticky sticky)))))))
+
+;;;
+;;; Keybindings
+;;;
+
+(defvar enriched-mode-map nil
+ "Keymap for Enriched mode.")
+
+(if (null enriched-mode-map)
+ (fset 'enriched-mode-map (setq enriched-mode-map (make-sparse-keymap))))
+
+(if (not (assq 'enriched-mode minor-mode-map-alist))
+ (setq minor-mode-map-alist
+ (cons (cons 'enriched-mode enriched-mode-map)
+ minor-mode-map-alist)))
+
+(define-key enriched-mode-map "\C-a" 'beginning-of-line-text)
+(define-key enriched-mode-map "\C-m" 'reindent-then-newline-and-indent)
+(define-key enriched-mode-map "\C-j" 'reindent-then-newline-and-indent)
+(define-key enriched-mode-map "\M-j" 'facemenu-justification-menu)
+(define-key enriched-mode-map "\M-S" 'set-justification-center)
+(define-key enriched-mode-map "\C-x\t" 'increase-left-margin)
+(define-key enriched-mode-map "\C-c\C-l" 'set-left-margin)
+(define-key enriched-mode-map "\C-c\C-r" 'set-right-margin)
+
+;;;
+;;; Some functions dealing with text-properties, especially indentation
+;;;
+
+(defun enriched-map-property-regions (prop func &optional from to)
+ "Apply a function to regions of the buffer based on a text property.
+For each contiguous region of the buffer for which the value of PROPERTY is
+eq, the FUNCTION will be called. Optional arguments FROM and TO specify the
+region over which to scan.
+
+The specified function receives three arguments: the VALUE of the property in
+the region, and the START and END of each region."
+ (save-excursion
+ (save-restriction
+ (if to (narrow-to-region (point-min) to))
+ (goto-char (or from (point-min)))
+ (let ((begin (point))
+ end
+ (marker (make-marker))
+ (val (get-text-property (point) prop)))
+ (while (setq end (text-property-not-all begin (point-max) prop val))
+ (move-marker marker end)
+ (funcall func val begin (marker-position marker))
+ (setq begin (marker-position marker)
+ val (get-text-property marker prop)))
+ (if (< begin (point-max))
+ (funcall func val begin (point-max)))))))
+
+(put 'enriched-map-property-regions 'lisp-indent-hook 1)
+
+(defun enriched-insert-indentation (&optional from to)
+ "Indent and justify each line in the region."
+ (save-excursion
+ (save-restriction
+ (if to (narrow-to-region (point-min) to))
+ (goto-char (or from (point-min)))
+ (if (not (bolp)) (forward-line 1))
+ (while (not (eobp))
+ (if (eolp)
+ nil ; skip blank lines
+ (indent-to (current-left-margin))
+ (justify-current-line t nil t))
+ (forward-line 1)))))
+
+;;;
+;;; Encoding Files
+;;;
+
+;;;###autoload
+(defun enriched-encode (from to orig-buf)
+ (if enriched-verbose (message "Enriched: encoding document..."))
+ (save-restriction
+ (narrow-to-region from to)
+ (delete-to-left-margin)
+ (unjustify-region)
+ (goto-char from)
+ (format-replace-strings '(("<" . "<<")))
+ (format-insert-annotations
+ (format-annotate-region from (point-max) enriched-translations
+ 'enriched-make-annotation enriched-ignore))
+ (goto-char from)
+ (insert (if (stringp enriched-initial-annotation)
+ enriched-initial-annotation
+ (save-excursion
+ ;; Eval this in the buffer we are annotating. This
+ ;; fixes a bug which was saving incorrect File-Width
+ ;; information, since we were looking at local
+ ;; variables in the wrong buffer.
+ (if orig-buf (set-buffer orig-buf))
+ (funcall enriched-initial-annotation))))
+ (enriched-map-property-regions 'hard
+ (lambda (v b e)
+ (if (and v (= ?\n (char-after b)))
+ (progn (goto-char b) (insert "\n"))))
+ (point) nil)
+ (if enriched-verbose (message nil))
+ ;; Return new end.
+ (point-max)))
+
+(defun enriched-make-annotation (internal-ann positive)
+ "Format an annotation INTERNAL-ANN.
+INTERNAL-ANN may be a string, for a flag, or a list of the form (PARAM VALUE).
+If POSITIVE is non-nil, this is the opening annotation;
+if nil, the matching close."
+ (cond ((stringp internal-ann)
+ (format enriched-annotation-format (if positive "" "/") internal-ann))
+ ;; Otherwise it is an annotation with parameters, represented as a list
+ (positive
+ (let ((item (car internal-ann))
+ (params (cdr internal-ann)))
+ (concat (format enriched-annotation-format "" item)
+ (mapconcat (lambda (i) (concat "<param>" i "</param>"))
+ params ""))))
+ (t (format enriched-annotation-format "/" (car internal-ann)))))
+
+(defun enriched-encode-other-face (old new)
+ "Generate annotations for random face change.
+One annotation each for foreground color, background color, italic, etc."
+ (cons (and old (enriched-face-ans old))
+ (and new (enriched-face-ans new))))
+
+(defun enriched-face-ans (face)
+ "Return annotations specifying FACE.
+FACE may be a list of faces instead of a single face;
+it can also be anything allowed as an element of a list
+which can be the value of the `face' text property."
+ (cond ((and (consp face) (eq (car face) 'foreground-color))
+ (list (list "x-color" (cdr face))))
+ ((and (consp face) (eq (car face) 'background-color))
+ (list (list "x-bg-color" (cdr face))))
+ ((and (listp face) (eq (car face) :foreground))
+ (list (list "x-color" (cadr face))))
+ ((and (listp face) (eq (car face) :background))
+ (list (list "x-bg-color" (cadr face))))
+ ((listp face)
+ (apply 'append (mapcar 'enriched-face-ans face)))
+ ((let* ((fg (face-attribute face :foreground))
+ (bg (face-attribute face :background))
+ (props (face-font face t))
+ (ans (cdr (format-annotate-single-property-change
+ 'face nil props enriched-translations))))
+ (unless (eq fg 'unspecified)
+ (setq ans (cons (list "x-color" fg) ans)))
+ (unless (eq bg 'unspecified)
+ (setq ans (cons (list "x-bg-color" bg) ans)))
+ ans))))
+
+;;;
+;;; Decoding files
+;;;
+
+;;;###autoload
+(defun enriched-decode (from to)
+ (if enriched-verbose (message "Enriched: decoding document..."))
+ (use-hard-newlines 1 'never)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region from to)
+ (goto-char from)
+
+ ;; Deal with header
+ (let ((file-width (enriched-get-file-width)))
+ (enriched-remove-header)
+
+ ;; Deal with newlines
+ (while (search-forward-regexp "\n\n+" nil t)
+ (if (current-justification)
+ (delete-char -1))
+ (set-hard-newline-properties (match-beginning 0) (point)))
+
+ ;; Translate annotations
+ (format-deannotate-region from (point-max) enriched-translations
+ 'enriched-next-annotation)
+
+ ;; Indent or fill the buffer
+ (cond (file-width ; File was filled to this width
+ (setq fill-column file-width)
+ (if enriched-verbose (message "Indenting..."))
+ (enriched-insert-indentation))
+ (t ; File was not filled.
+ (if enriched-verbose (message "Filling paragraphs..."))
+ (fill-region (point-min) (point-max))))
+ (if enriched-verbose (message nil)))
+ (point-max))))
+
+(defun enriched-next-annotation ()
+ "Find and return next text/enriched annotation.
+Any \"<<\" strings encountered are converted to \"<\".
+Return value is \(begin end name positive-p), or nil if none was found."
+ (while (and (search-forward "<" nil 1)
+ (progn (goto-char (match-beginning 0))
+ (not (looking-at enriched-annotation-regexp))))
+ (forward-char 1)
+ (if (= ?< (char-after (point)))
+ (delete-char 1)
+ ;; A single < that does not start an annotation is an error,
+ ;; which we note and then ignore.
+ (message "Warning: malformed annotation in file at %s"
+ (1- (point)))))
+ (if (not (eobp))
+ (let* ((beg (match-beginning 0))
+ (end (match-end 0))
+ (name (downcase (buffer-substring
+ (match-beginning 2) (match-end 2))))
+ (pos (not (match-beginning 1))))
+ (list beg end name pos))))
+
+(defun enriched-get-file-width ()
+ "Look for file width information on this line."
+ (save-excursion
+ (if (search-forward "Text-Width: " (+ (point) 1000) t)
+ (read (current-buffer)))))
+
+(defun enriched-remove-header ()
+ "Remove file-format header at point."
+ (while (looking-at "^[-A-Za-z]+: .*\n")
+ (delete-region (point) (match-end 0)))
+ (if (looking-at "^\n")
+ (delete-char 1)))
+
+(defun enriched-decode-foreground (from to &optional color)
+ (if color
+ (list from to 'face (list ':foreground color))
+ (message "Warning: no color specified for <x-color>")
+ nil))
+
+(defun enriched-decode-background (from to &optional color)
+ (if color
+ (list from to 'face (list ':background color))
+ (message "Warning: no color specified for <x-bg-color>")
+ nil))
+\f
+;;; Handling the `display' property.
+
+
+(defun enriched-handle-display-prop (old new)
+ "Return a list of annotations for a change in the `display' property.
+OLD is the old value of the property, NEW is the new value. Value
+is a list `(CLOSE OPEN)', where CLOSE is a list of annotations to
+close and OPEN a list of annotations to open. Each of these lists
+has the form `(ANNOTATION PARAM ...)'."
+ (let ((annotation "x-display")
+ (param (prin1-to-string (or old new))))
+ (if (null old)
+ (cons nil (list (list annotation param)))
+ (cons (list (list annotation param)) nil))))
+
+(defun enriched-decode-display-prop (start end &optional param)
+ "Decode a `display' property for text between START and END.
+PARAM is a `<param>' found for the property.
+Value is a list `(START END SYMBOL VALUE)' with START and END denoting
+the range of text to assign text property SYMBOL with value VALUE "
+ (let ((prop (when (stringp param)
+ (condition-case ()
+ (car (read-from-string param))
+ (error nil)))))
+ (unless prop
+ (message "Warning: invalid <x-display> parameter %s" param))
+ (list start end 'display prop)))
+
+;;; enriched.el ends here
+++ /dev/null
-esh-groups.el
+++ /dev/null
-;;; em-alias.el --- creation and management of command aliases
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-alias)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-alias nil
- "Command aliases allow for easy definition of alternate commands."
- :tag "Command aliases"
- :link '(info-link "(eshell)Command aliases")
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; Command aliases greatly simplify the definition of new commands.
-;; They exist as an alternative to alias functions, which are
-;; otherwise quite superior, being more flexible and natural to the
-;; Emacs Lisp environment (if somewhat trickier to define; [Alias
-;; functions]).
-;;
-;;;_* Creating aliases
-;;
-;; The user interface is simple: type 'alias' followed by the command
-;; name followed by the definition. Argument references are made
-;; using '$1', '$2', etc., or '$*'. For example:
-;;
-;; alias ll 'ls -l $*'
-;;
-;; This will cause the command 'll NEWS' to be replaced by 'ls -l
-;; NEWS'. This is then passed back to the command parser for
-;; reparsing.{Only the command text specified in the alias definition
-;; will be reparsed. Argument references (such as '$*') are handled
-;; using variable values, which means that the expansion will not be
-;; reparsed, but used directly.}
-;;
-;; To delete an alias, specify its name without a definition:
-;;
-;; alias ll
-;;
-;; Aliases are written to disk immediately after being defined or
-;; deleted. The filename in which they are kept is defined by the
-;; following variable:
-
-(defcustom eshell-aliases-file (concat eshell-directory-name "alias")
- "*The file in which aliases are kept.
-Whenever an alias is defined by the user, using the `alias' command,
-it will be written to this file. Thus, alias definitions (and
-deletions) are always permanent. This approach was chosen for the
-sake of simplicity, since that's pretty much the only benefit to be
-gained by using this module."
- :type 'file
- :group 'eshell-alias)
-
-;;;
-;; The format of this file is quite basic. It specifies the alias
-;; definitions in almost exactly the same way that the user entered
-;; them, minus any argument quoting (since interpolation is not done
-;; when the file is read). Hence, it is possible to add new aliases
-;; to the alias file directly, using a text editor rather than the
-;; `alias' command. Or, this method can be used for editing aliases
-;; that have already defined.
-;;
-;; Here is an example of a few different aliases, and they would
-;; appear in the aliases file:
-;;
-;; alias clean rm -fr **/.#*~
-;; alias commit cvs commit -m changes $*
-;; alias ll ls -l $*
-;; alias info (info)
-;; alias reindex glimpseindex -o ~/Mail
-;; alias compact for i in ~/Mail/**/*~*.bz2(Lk+50) { bzip2 -9v $i }
-;;
-;;;_* Auto-correction of bad commands
-;;
-;; When a user enters the same unknown command many times during a
-;; session, it is likely that they are experiencing a spelling
-;; difficulty associated with a certain command. To combat this,
-;; Eshell will offer to automatically define an alias for that
-;; mispelled command, once a given tolerance threshold has been
-;; reached.
-
-(defcustom eshell-bad-command-tolerance 3
- "*The number of failed commands to ignore before creating an alias."
- :type 'integer
- :link '(custom-manual "(eshell)Auto-correction of bad commands")
- :group 'eshell-alias)
-
-;;;
-;; Whenever the same bad command name is encountered this many times,
-;; the user will be prompted in the minibuffer to provide an alias
-;; name. An alias definition will then be created which will result
-;; in an equal call to the correct name. In this way, Eshell
-;; gradually learns about the commands that the user mistypes
-;; frequently, and will automatically correct them!
-;;
-;; Note that a '$*' is automatically appended at the end of the alias
-;; definition, so that entering it is unnecessary when specifying the
-;; corrected command name.
-
-;;; Code:
-
-(defcustom eshell-alias-load-hook '(eshell-alias-initialize)
- "*A hook that gets run when `eshell-alias' is loaded."
- :type 'hook
- :group 'eshell-alias)
-
-(defvar eshell-command-aliases-list nil
- "A list of command aliases currently defined by the user.
-Each element of this alias is a list of the form:
-
- (NAME DEFINITION)
-
-Where NAME is the textual name of the alias, and DEFINITION is the
-command string to replace that command with.
-
-Note: this list should not be modified in your '.emacs' file. Rather,
-any desired alias definitions should be declared using the `alias'
-command, which will automatically write them to the file named by
-`eshell-aliases-file'.")
-
-(put 'eshell-command-aliases-list 'risky-local-variable t)
-
-(defvar eshell-failed-commands-alist nil
- "An alist of command name failures.")
-
-(defun eshell-alias-initialize ()
- "Initialize the alias handling code."
- (make-local-variable 'eshell-failed-commands-alist)
- (add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t)
- (eshell-read-aliases-list)
- (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t)
- (make-local-variable 'eshell-complex-commands)
- (add-to-list 'eshell-complex-commands 'eshell-command-aliased-p))
-
-(defun eshell-command-aliased-p (name)
- (assoc name eshell-command-aliases-list))
-
-(defun eshell/alias (&optional alias &rest definition)
- "Define an ALIAS in the user's alias list using DEFINITION."
- (if (not alias)
- (eshell-for alias eshell-command-aliases-list
- (eshell-print (apply 'format "alias %s %s\n" alias)))
- (if (not definition)
- (setq eshell-command-aliases-list
- (delq (assoc alias eshell-command-aliases-list)
- eshell-command-aliases-list))
- (and (stringp definition)
- (set-text-properties 0 (length definition) nil definition))
- (let ((def (assoc alias eshell-command-aliases-list))
- (alias-def (list alias
- (eshell-flatten-and-stringify definition))))
- (if def
- (setq eshell-command-aliases-list
- (delq def eshell-command-aliases-list)))
- (setq eshell-command-aliases-list
- (cons alias-def eshell-command-aliases-list))))
- (eshell-write-aliases-list))
- nil)
-
-(defun pcomplete/eshell-mode/alias ()
- "Completion function for Eshell's `alias' command."
- (pcomplete-here (eshell-alias-completions pcomplete-stub)))
-
-(defun eshell-read-aliases-list ()
- "Read in an aliases list from `eshell-aliases-file'."
- (let ((file eshell-aliases-file))
- (when (file-readable-p file)
- (setq eshell-command-aliases-list
- (with-temp-buffer
- (let (eshell-command-aliases-list)
- (insert-file-contents file)
- (while (not (eobp))
- (if (re-search-forward
- "^alias\\s-+\\(\\S-+\\)\\s-+\\(.+\\)")
- (setq eshell-command-aliases-list
- (cons (list (match-string 1)
- (match-string 2))
- eshell-command-aliases-list)))
- (forward-line 1))
- eshell-command-aliases-list))))))
-
-(defun eshell-write-aliases-list ()
- "Write out the current aliases into `eshell-aliases-file'."
- (if (file-writable-p (file-name-directory eshell-aliases-file))
- (let ((eshell-current-handles
- (eshell-create-handles eshell-aliases-file 'overwrite)))
- (eshell/alias)
- (eshell-close-handles 0))))
-
-(defsubst eshell-lookup-alias (name)
- "Check whether NAME is aliased. Return the alias if there is one."
- (assoc name eshell-command-aliases-list))
-
-(defvar eshell-prevent-alias-expansion nil)
-
-(defun eshell-maybe-replace-by-alias (command args)
- "If COMMAND has an alias definition, call that instead using ARGS."
- (unless (and eshell-prevent-alias-expansion
- (member command eshell-prevent-alias-expansion))
- (let ((alias (eshell-lookup-alias command)))
- (if alias
- (throw 'eshell-replace-command
- (list
- 'let
- (list
- (list 'eshell-command-name
- (list 'quote eshell-last-command-name))
- (list 'eshell-command-arguments
- (list 'quote eshell-last-arguments))
- (list 'eshell-prevent-alias-expansion
- (list 'quote
- (cons command
- eshell-prevent-alias-expansion))))
- (eshell-parse-command (nth 1 alias))))))))
-
-(defun eshell-alias-completions (name)
- "Find all possible completions for NAME.
-These are all the command aliases which begin with NAME."
- (let (completions)
- (eshell-for alias eshell-command-aliases-list
- (if (string-match (concat "^" name) (car alias))
- (setq completions (cons (car alias) completions))))
- completions))
-
-(defun eshell-fix-bad-commands (name)
- "If the user repeatedly a bad command NAME, make an alias for them."
- (ignore
- (unless (file-name-directory name)
- (let ((entry (assoc name eshell-failed-commands-alist)))
- (if (not entry)
- (setq eshell-failed-commands-alist
- (cons (cons name 1) eshell-failed-commands-alist))
- (if (< (cdr entry) eshell-bad-command-tolerance)
- (setcdr entry (1+ (cdr entry)))
- (let ((alias (concat
- (read-string
- (format "Define alias for \"%s\": " name))
- " $*")))
- (eshell/alias name alias)
- (throw 'eshell-replace-command
- (list
- 'let
- (list
- (list 'eshell-command-name
- (list 'quote name))
- (list 'eshell-command-arguments
- (list 'quote eshell-last-arguments))
- (list 'eshell-prevent-alias-expansion
- (list 'quote
- (cons name
- eshell-prevent-alias-expansion))))
- (eshell-parse-command alias))))))))))
-
-;;; em-alias.el ends here
+++ /dev/null
-;;; em-banner.el --- sample module that displays a login banner
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-banner)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-banner nil
- "This sample module displays a welcome banner at login.
-It exists so that others wishing to create their own Eshell extension
-modules may have a simple template to begin with."
- :tag "Login banner"
- :link '(info-link "(eshell)Login banner")
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; There is nothing to be done or configured in order to use this
-;; module, other than to select it by customizing the variable
-;; `eshell-modules-list'. It will then display a version information
-;; message whenever Eshell is loaded.
-;;
-;; This code is only an example of a how to write a well-formed
-;; extension module for Eshell. The better way to display login text
-;; is to use the `eshell-script' module, and to echo the desired
-;; strings from the user's `eshell-login-script' file.
-;;
-;; There is one configuration variable, which demonstrates how to
-;; properly define a customization variable in an extension module.
-;; In this case, it allows the user to change the string which
-;; displays at login time.
-
-;;; User Variables:
-
-(defcustom eshell-banner-message "Welcome to the Emacs shell\n\n"
- "*The banner message to be displayed when Eshell is loaded.
-This can be any sexp, and should end with at least two newlines."
- :type 'sexp
- :group 'eshell-banner)
-
-(put 'eshell-banner-message 'risky-local-variable t)
-
-;;; Code:
-
-(require 'esh-util)
-
-(defcustom eshell-banner-load-hook '(eshell-banner-initialize)
- "*A list of functions to run when `eshell-banner' is loaded."
- :type 'hook
- :group 'eshell-banner)
-
-(defun eshell-banner-initialize ()
- "Output a welcome banner on initialization."
- ;; it's important to use `eshell-interactive-print' rather than
- ;; `insert', because `insert' doesn't know how to interact with the
- ;; I/O code used by Eshell
- (unless eshell-non-interactive-p
- (assert eshell-mode)
- (assert eshell-banner-message)
- (let ((msg (eval eshell-banner-message)))
- (assert msg)
- (eshell-interactive-print msg))))
-
-(eshell-deftest banner banner-displayed
- "Startup banner is displayed at point-min"
- (assert eshell-banner-message)
- (let ((msg (eval eshell-banner-message)))
- (assert msg)
- (goto-char (point-min))
- (looking-at msg)))
-
-;;; em-banner.el ends here
+++ /dev/null
-;;; em-basic.el --- basic shell builtin commands
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-basic)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-basic nil
- "The \"basic\" code provides a set of convenience functions which
-are traditionally considered shell builtins. Since all of the
-functionality provided by them is accessible through Lisp, they are
-not really builtins at all, but offer a command-oriented way to do the
-same thing."
- :tag "Basic shell commands"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; There are very few basic Eshell commands -- so-called builtins.
-;; They are: echo, umask, and version.
-;;
-;;;_* `echo'
-;;
-;; The `echo' command repeats its arguments to the screen. It is
-;; optional whether this is done in a Lisp-friendly fashion (so that
-;; the value of echo is useful to a Lisp command using the result of
-;; echo as an argument), or whether it should try to act like a normal
-;; shell echo, and always result in a flat string being returned.
-
-(defcustom eshell-plain-echo-behavior nil
- "*If non-nil, `echo' tries to behave like an ordinary shell echo.
-This comes at some detriment to Lisp functionality. However, the Lisp
-equivalent of `echo' can always be achieved by using `identity'."
- :type 'boolean
- :group 'eshell-basic)
-
-;;;
-;; An example of the difference is the following:
-;;
-;; echo Hello world
-;;
-;; If `eshell-plain-echo-behavior' is non-nil, this will yield the
-;; string "Hello world". If Lisp behavior is enabled, however, it
-;; will yield a list whose two elements are the strings "Hello" and
-;; "world". The way to write an equivalent expression for both would
-;; be:
-;;
-;; echo "Hello world"
-;;
-;; This always returns a single string.
-;;
-;;;_* `umask'
-;;
-;; The umask command changes the default file permissions for newly
-;; created files. It uses the same syntax as bash.
-;;
-;;;_* `version'
-;;
-;; This command reports the version number for Eshell and all its
-;; dependent module, including the date when those modules were last
-;; modified.
-
-;;; Code:
-
-(require 'esh-opt)
-
-;;; Functions:
-
-(defun eshell-echo (args &optional output-newline)
- "Implementation code for a Lisp version of `echo'.
-It returns a formatted value that should be passed to `eshell-print'
-or `eshell-printn' for display."
- (if eshell-plain-echo-behavior
- (concat (apply 'eshell-flatten-and-stringify args) "\n")
- (let ((value
- (cond
- ((= (length args) 0) "")
- ((= (length args) 1)
- (car args))
- (t
- (mapcar
- (function
- (lambda (arg)
- (if (stringp arg)
- (set-text-properties 0 (length arg) nil arg))
- arg))
- args)))))
- (if output-newline
- (cond
- ((stringp value)
- (concat value "\n"))
- ((listp value)
- (append value (list "\n")))
- (t
- (concat (eshell-stringify value) "\n")))
- value))))
-
-(defun eshell/echo (&rest args)
- "Implementation of `echo'. See `eshell-plain-echo-behavior'."
- (eshell-eval-using-options
- "echo" args
- '((?n nil nil output-newline "terminate with a newline")
- (?h "help" nil nil "output this help screen")
- :preserve-args
- :usage "[-n] [object]")
- (eshell-echo args output-newline)))
-
-(defun eshell/printnl (&rest args)
- "Print out each of the argument, separated by newlines."
- (let ((elems (eshell-flatten-list args)))
- (while elems
- (eshell-printn (eshell-echo (list (car elems))))
- (setq elems (cdr elems)))))
-
-(defun eshell/listify (&rest args)
- "Return the argument(s) as a single list."
- (if (> (length args) 1)
- args
- (if (listp (car args))
- (car args)
- (list (car args)))))
-
-(defun eshell/umask (&rest args)
- "Shell-like implementation of `umask'."
- (eshell-eval-using-options
- "umask" args
- '((?S "symbolic" nil symbolic-p "display umask symbolically")
- (?h "help" nil nil "display this usage message")
- :usage "[-S] [mode]")
- (if (or (not args) symbolic-p)
- (let ((modstr
- (concat "000"
- (format "%o"
- (logand (lognot (default-file-modes))
- 511)))))
- (setq modstr (substring modstr (- (length modstr) 3)))
- (when symbolic-p
- (let ((mode (default-file-modes)))
- (setq modstr
- (format
- "u=%s,g=%s,o=%s"
- (concat (and (= (logand mode 64) 64) "r")
- (and (= (logand mode 128) 128) "w")
- (and (= (logand mode 256) 256) "x"))
- (concat (and (= (logand mode 8) 8) "r")
- (and (= (logand mode 16) 16) "w")
- (and (= (logand mode 32) 32) "x"))
- (concat (and (= (logand mode 1) 1) "r")
- (and (= (logand mode 2) 2) "w")
- (and (= (logand mode 4) 4) "x"))))))
- (eshell-printn modstr))
- (setcar args (eshell-convert (car args)))
- (if (numberp (car args))
- (set-default-file-modes
- (- 511 (car (read-from-string
- (concat "?\\" (number-to-string (car args)))))))
- (error "setting umask symbolically is not yet implemented"))
- (eshell-print
- "Warning: umask changed for all new files created by Emacs.\n"))
- nil))
-
-(eval-when-compile
- (defvar print-func))
-
-;;; em-basic.el ends here
+++ /dev/null
-;;; em-cmpl.el --- completion using the TAB key
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-cmpl)
-
-(eval-when-compile (require 'esh-maint))
-(require 'esh-util)
-
-(defgroup eshell-cmpl nil
- "This module provides a programmable completion function bound to
-the TAB key, which allows for completing command names, file names,
-variable names, arguments, etc."
- :tag "Argument completion"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; Eshell, by using the pcomplete package, provides a full
-;; programmable completion facility that is comparable to shells like
-;; tcsh or zsh.
-;;
-;; Completions are context-sensitive, which means that pressing <TAB>
-;; after the command 'rmdir' will result in a list of directories,
-;; while doing so after 'rm' will result in a list of all file
-;; entries.
-;;
-;; Many builtin completion rules are provided, for commands such as
-;; `cvs', or RedHat's `rpm' utility. Adding new completion rules is
-;; no more difficult than writing a plain Lisp functions, and they can
-;; be debugged, profiled, and compiled using exactly the same
-;; facilities (since in fact, they *are* just Lisp functions). See
-;; the definition of the function `pcomplete/make' for an example of
-;; how to write a completion function.
-;;
-;; The completion facility is very easy to use. Just press TAB. If
-;; there are a large number of possible completions, a buffer will
-;; appear showing a list of them. Completions may be selected from
-;; that buffer using the mouse. If no completion is selected, and the
-;; user starts doing something else, the display buffer will
-;; automatically disappear.
-;;
-;; If the list of possible completions is very small, Eshell will
-;; "cycle" through them, selecting a different entry each time <TAB>
-;; is pressed. <S-TAB> may be used to cycle in the opposite
-;; direction.
-;;
-;; Glob patterns can also be cycled. For example, entering 'echo
-;; x*<tab>' will cycle through all the filenames beginning with 'x'.
-;; This is done because the glob list is treated as though it were a
-;; list of possible completions. Pressing <C-c SPC> will insert all
-;; of the matching glob patterns at point.
-;;
-;; If a Lisp form is being entered, <TAB> will complete the Lisp
-;; symbol name, in exactly the same way that <M-TAB> does in Emacs
-;; Lisp mode.
-;;
-;; The list of possible completions can be viewed at any point by
-;; pressing <M-?>.
-;;
-;; Finally, context-related help can be accessed by pressing <C-c i>.
-;; This only works well if the completion function has provided Eshell
-;; with sufficient pointers to locate the relevant help text.
-
-;;; User Variables:
-
-(defcustom eshell-cmpl-load-hook '(eshell-cmpl-initialize)
- "*A list of functions to run when `eshell-cmpl' is loaded."
- :type 'hook
- :group 'eshell-cmpl)
-
-(defcustom eshell-show-lisp-completions nil
- "*If non-nil, include Lisp functions in the command completion list.
-If this variable is nil, Lisp completion can still be done in command
-position by using M-TAB instead of TAB."
- :type 'boolean
- :group 'eshell-cmpl)
-
-(defcustom eshell-show-lisp-alternatives t
- "*If non-nil, and no other completions found, show Lisp functions.
-Setting this variable means nothing if `eshell-show-lisp-completions'
-is non-nil."
- :type 'boolean
- :group 'eshell-cmpl)
-
-(defcustom eshell-no-completion-during-jobs t
- "*If non-nil, don't allow completion while a process is running."
- :type 'boolean
- :group 'eshell-cmpl)
-
-(defcustom eshell-command-completions-alist
- '(("acroread" . "\\.pdf\\'")
- ("xpdf" . "\\.pdf\\'")
- ("ar" . "\\.[ao]\\'")
- ("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
- ("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
- ("cc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
- ("CC" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
- ("acc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
- ("bcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
- ("readelf" . "\\(\\`[^.]*\\|\\.\\([ao]\\|so\\)\\)\\'")
- ("objdump" . "\\(\\`[^.]*\\|\\.\\([ao]\\|so\\)\\)\\'")
- ("nm" . "\\(\\`[^.]*\\|\\.\\([ao]\\|so\\)\\)\\'")
- ("gdb" . "\\`\\([^.]*\\|a\\.out\\)\\'")
- ("dbx" . "\\`\\([^.]*\\|a\\.out\\)\\'")
- ("sdb" . "\\`\\([^.]*\\|a\\.out\\)\\'")
- ("adb" . "\\`\\([^.]*\\|a\\.out\\)\\'"))
- "*An alist that defines simple argument type correlations.
-This is provided for common commands, as a simplistic alternative
-to writing a completion function."
- :type '(repeat (cons string regexp))
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-file-ignore "~\\'"
- (documentation-property 'pcomplete-file-ignore
- 'variable-documentation)
- :type (get 'pcomplete-file-ignore 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-dir-ignore
- (format "\\`\\(\\.\\.?\\|CVS\\)%c\\'" directory-sep-char)
- (documentation-property 'pcomplete-dir-ignore
- 'variable-documentation)
- :type (get 'pcomplete-dir-ignore 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-ignore-case (eshell-under-windows-p)
- (documentation-property 'pcomplete-ignore-case
- 'variable-documentation)
- :type (get 'pcomplete-ignore-case 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-autolist nil
- (documentation-property 'pcomplete-autolist
- 'variable-documentation)
- :type (get 'pcomplete-autolist 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-suffix-list (list directory-sep-char ?:)
- (documentation-property 'pcomplete-suffix-list
- 'variable-documentation)
- :type (get 'pcomplete-suffix-list 'custom-type)
- :group 'pcomplete)
-
-(defcustom eshell-cmpl-recexact nil
- (documentation-property 'pcomplete-recexact
- 'variable-documentation)
- :type (get 'pcomplete-recexact 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-man-function 'man
- (documentation-property 'pcomplete-man-function
- 'variable-documentation)
- :type (get 'pcomplete-man-function 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-compare-entry-function 'file-newer-than-file-p
- (documentation-property 'pcomplete-compare-entry-function
- 'variable-documentation)
- :type (get 'pcomplete-compare-entry-function 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-expand-before-complete nil
- (documentation-property 'pcomplete-expand-before-complete
- 'variable-documentation)
- :type (get 'pcomplete-expand-before-complete 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-cycle-completions t
- (documentation-property 'pcomplete-cycle-completions
- 'variable-documentation)
- :type (get 'pcomplete-cycle-completions 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-cycle-cutoff-length 5
- (documentation-property 'pcomplete-cycle-cutoff-length
- 'variable-documentation)
- :type (get 'pcomplete-cycle-cutoff-length 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-restore-window-delay 1
- (documentation-property 'pcomplete-restore-window-delay
- 'variable-documentation)
- :type (get 'pcomplete-restore-window-delay 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-command-completion-function
- (function
- (lambda ()
- (pcomplete-here (eshell-complete-commands-list))))
- (documentation-property 'pcomplete-command-completion-function
- 'variable-documentation)
- :type (get 'pcomplete-command-completion-function 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-command-name-function
- 'eshell-completion-command-name
- (documentation-property 'pcomplete-command-name-function
- 'variable-documentation)
- :type (get 'pcomplete-command-name-function 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-default-completion-function
- (function
- (lambda ()
- (while (pcomplete-here
- (pcomplete-dirs-or-entries
- (cdr (assoc (funcall eshell-cmpl-command-name-function)
- eshell-command-completions-alist)))))))
- (documentation-property 'pcomplete-default-completion-function
- 'variable-documentation)
- :type (get 'pcomplete-default-completion-function 'custom-type)
- :group 'eshell-cmpl)
-
-(defcustom eshell-cmpl-use-paring t
- (documentation-property 'pcomplete-use-paring 'variable-documentation)
- :type (get 'pcomplete-use-paring 'custom-type)
- :group 'eshell-cmpl)
-
-;;; Functions:
-
-(defun eshell-cmpl-initialize ()
- "Initialize the completions module."
- (unless (fboundp 'pcomplete)
- (load "pcmpl-auto" t t))
- (set (make-local-variable 'pcomplete-command-completion-function)
- eshell-command-completion-function)
- (set (make-local-variable 'pcomplete-command-name-function)
- eshell-cmpl-command-name-function)
- (set (make-local-variable 'pcomplete-default-completion-function)
- eshell-default-completion-function)
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- 'eshell-complete-parse-arguments)
- (set (make-local-variable 'pcomplete-file-ignore)
- eshell-cmpl-file-ignore)
- (set (make-local-variable 'pcomplete-dir-ignore)
- eshell-cmpl-dir-ignore)
- (set (make-local-variable 'pcomplete-ignore-case)
- eshell-cmpl-ignore-case)
- (set (make-local-variable 'pcomplete-autolist)
- eshell-cmpl-autolist)
- (set (make-local-variable 'pcomplete-suffix-list)
- eshell-cmpl-suffix-list)
- (set (make-local-variable 'pcomplete-recexact)
- eshell-cmpl-recexact)
- (set (make-local-variable 'pcomplete-man-function)
- eshell-cmpl-man-function)
- (set (make-local-variable 'pcomplete-compare-entry-function)
- eshell-cmpl-compare-entry-function)
- (set (make-local-variable 'pcomplete-expand-before-complete)
- eshell-cmpl-expand-before-complete)
- (set (make-local-variable 'pcomplete-cycle-completions)
- eshell-cmpl-cycle-completions)
- (set (make-local-variable 'pcomplete-cycle-cutoff-length)
- eshell-cmpl-cycle-cutoff-length)
- (set (make-local-variable 'pcomplete-restore-window-delay)
- eshell-cmpl-restore-window-delay)
- (set (make-local-variable 'pcomplete-use-paring)
- eshell-cmpl-use-paring)
- ;; `pcomplete-arg-quote-list' should only be set after all the
- ;; load-hooks for any other extension modules have been run, which
- ;; is true at the time `eshell-mode-hook' is run
- (add-hook 'eshell-mode-hook
- (function
- (lambda ()
- (set (make-local-variable 'pcomplete-arg-quote-list)
- eshell-special-chars-outside-quoting))) nil t)
- (add-hook 'pcomplete-quote-arg-hook 'eshell-quote-backslash nil t)
- (define-key eshell-mode-map [(meta tab)] 'lisp-complete-symbol)
- (define-key eshell-mode-map [(meta control ?i)] 'lisp-complete-symbol)
- (define-key eshell-command-map [(meta ?h)] 'eshell-completion-help)
- (define-key eshell-command-map [tab] 'pcomplete-expand-and-complete)
- (define-key eshell-command-map [(control ?i)]
- 'pcomplete-expand-and-complete)
- (define-key eshell-command-map [space] 'pcomplete-expand)
- (define-key eshell-command-map [? ] 'pcomplete-expand)
- (define-key eshell-mode-map [tab] 'pcomplete)
- (define-key eshell-mode-map [(control ?i)] 'pcomplete)
- ;; jww (1999-10-19): Will this work on anything but X?
- (if (eshell-under-xemacs-p)
- (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse)
- (define-key eshell-mode-map [(shift iso-lefttab)] 'pcomplete-reverse)
- (define-key eshell-mode-map [(shift control ?i)] 'pcomplete-reverse))
- (define-key eshell-mode-map [(meta ??)] 'pcomplete-list))
-
-(defun eshell-completion-command-name ()
- "Return the command name, possibly sans globbing."
- (let ((cmd (file-name-nondirectory (pcomplete-arg 'first))))
- (setq cmd (if (and (> (length cmd) 0)
- (eq (aref cmd 0) eshell-explicit-command-char))
- (substring cmd 1)
- cmd))
- (if (eshell-under-windows-p)
- (file-name-sans-extension cmd)
- cmd)))
-
-(defun eshell-completion-help ()
- (interactive)
- (if (= (point) eshell-last-output-end)
- (describe-prefix-bindings)
- (call-interactively 'pcomplete-help)))
-
-(defun eshell-complete-parse-arguments ()
- "Parse the command line arguments for `pcomplete-argument'."
- (when (and eshell-no-completion-during-jobs
- (eshell-interactive-process))
- (insert-and-inherit "\t")
- (throw 'pcompleted t))
- (let ((end (point-marker))
- (begin (save-excursion (eshell-bol) (point)))
- (posns (list t))
- args delim)
- (when (memq this-command '(pcomplete-expand
- pcomplete-expand-and-complete))
- (run-hook-with-args 'eshell-expand-input-functions begin end)
- (if (= begin end)
- (end-of-line))
- (setq end (point-marker)))
- (if (setq delim
- (catch 'eshell-incomplete
- (ignore
- (setq args (eshell-parse-arguments begin end)))))
- (cond ((memq (car delim) '(?\{ ?\<))
- (setq begin (1+ (cadr delim))
- args (eshell-parse-arguments begin end)))
- ((eq (car delim) ?\()
- (lisp-complete-symbol)
- (throw 'pcompleted t))
- (t
- (insert-and-inherit "\t")
- (throw 'pcompleted t))))
- (when (get-text-property (1- end) 'comment)
- (insert-and-inherit "\t")
- (throw 'pcompleted t))
- (let ((pos begin))
- (while (< pos end)
- (if (get-text-property pos 'arg-begin)
- (nconc posns (list pos)))
- (setq pos (1+ pos))))
- (setq posns (cdr posns))
- (assert (= (length args) (length posns)))
- (let ((a args)
- (i 0)
- l final)
- (while a
- (if (and (consp (car a))
- (eq (caar a) 'eshell-operator))
- (setq l i))
- (setq a (cdr a) i (1+ i)))
- (and l
- (setq args (nthcdr (1+ l) args)
- posns (nthcdr (1+ l) posns))))
- (assert (= (length args) (length posns)))
- (when (and args (eq (char-syntax (char-before end)) ? ))
- (nconc args (list ""))
- (nconc posns (list (point))))
- (cons (mapcar
- (function
- (lambda (arg)
- (let ((val
- (if (listp arg)
- (let ((result
- (eshell-do-eval
- (list 'eshell-commands arg) t)))
- (assert (eq (car result) 'quote))
- (cadr result))
- arg)))
- (if (numberp val)
- (setq val (number-to-string val)))
- (or val ""))))
- args)
- posns)))
-
-(defun eshell-complete-commands-list ()
- "Generate list of applicable, visible commands."
- (let ((filename (pcomplete-arg)) glob-name)
- (if (file-name-directory filename)
- (pcomplete-executables)
- (if (and (> (length filename) 0)
- (eq (aref filename 0) eshell-explicit-command-char))
- (setq filename (substring filename 1)
- pcomplete-stub filename
- glob-name t))
- (let* ((paths (split-string (getenv "PATH") path-separator))
- (cwd (file-name-as-directory
- (expand-file-name default-directory)))
- (path "") (comps-in-path ())
- (file "") (filepath "") (completions ()))
- ;; Go thru each path in the search path, finding completions.
- (while paths
- (setq path (file-name-as-directory
- (expand-file-name (or (car paths) ".")))
- comps-in-path
- (and (file-accessible-directory-p path)
- (file-name-all-completions filename path)))
- ;; Go thru each completion found, to see whether it should
- ;; be used.
- (while comps-in-path
- (setq file (car comps-in-path)
- filepath (concat path file))
- (if (and (not (member file completions)) ;
- (or (string-equal path cwd)
- (not (file-directory-p filepath)))
- (file-executable-p filepath))
- (setq completions (cons file completions)))
- (setq comps-in-path (cdr comps-in-path)))
- (setq paths (cdr paths)))
- ;; Add aliases which are currently visible, and Lisp functions.
- (pcomplete-uniqify-list
- (if glob-name
- completions
- (setq completions
- (append (and (eshell-using-module 'eshell-alias)
- (funcall (symbol-function 'eshell-alias-completions)
- filename))
- (eshell-winnow-list
- (mapcar
- (function
- (lambda (name)
- (substring name 7)))
- (all-completions (concat "eshell/" filename)
- obarray 'functionp))
- nil '(eshell-find-alias-function))
- completions))
- (append (and (or eshell-show-lisp-completions
- (and eshell-show-lisp-alternatives
- (null completions)))
- (all-completions filename obarray 'functionp))
- completions)))))))
-
-;;; Code:
-
-;;; em-cmpl.el ends here
+++ /dev/null
-;;; em-dirs.el --- directory navigation commands
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-dirs)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-dirs nil
- "Directory navigation involves changing directories, examining the
-current directory, maintaining a directory stack, and also keeping
-track of a history of the last directory locations the user was in.
-Emacs does provide standard Lisp definitions of `pwd' and `cd', but
-they lack somewhat in feel from the typical shell equivalents."
- :tag "Directory navigation"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; The only special feature that Eshell offers in the last-dir-ring.
-;; To view the ring, enter:
-;;
-;; cd =
-;;
-;; Changing to an index within the ring is done using:
-;;
-;; cd - ; same as cd -0
-;; cd -4
-;;
-;; Or, it is possible to change the first member in the ring which
-;; matches a regexp:
-;;
-;; cd =bcc ; change to the last directory visited containing "bcc"
-;;
-;; This ring is maintained automatically, and is persisted across
-;; Eshell sessions. It is a separate mechanism from `pushd' and
-;; `popd', and the two may be used at the same time.
-
-(require 'ring)
-(require 'esh-opt)
-
-;;; User Variables:
-
-(defcustom eshell-dirs-load-hook '(eshell-dirs-initialize)
- "*A hook that gets run when `eshell-dirs' is loaded."
- :type 'hook
- :group 'eshell-dirs)
-
-(defcustom eshell-pwd-convert-function (if (eshell-under-windows-p)
- 'expand-file-name
- 'identity)
- "*The function used to normalize the value of Eshell's `pwd'.
-The value returned by `pwd' is also used when recording the
-last-visited directory in the last-dir-ring, so it will affect the
-form of the list used by 'cd ='."
- :type '(radio (function-item file-truename)
- (function-item expand-file-name)
- (function-item identity)
- (function :tag "Other"))
- :group 'eshell-dirs)
-
-(defcustom eshell-ask-to-save-last-dir 'always
- "*Determine if the last-dir-ring should be automatically saved.
-The last-dir-ring is always preserved when exiting an Eshell buffer.
-However, when Emacs is being shut down, this variable determines
-whether to prompt the user, or just save the ring.
-If set to nil, it means never ask whether to save the last-dir-ring.
-If set to t, always ask if any Eshell buffers are open at exit time.
-If set to `always', the list-dir-ring will always be saved, silently."
- :type '(choice (const :tag "Never" nil)
- (const :tag "Ask" t)
- (const :tag "Always save" always))
- :group 'eshell-dirs)
-
-(defcustom eshell-cd-shows-directory nil
- "*If non-nil, using `cd' will report the directory it changes to."
- :type 'boolean
- :group 'eshell-dirs)
-
-(defcustom eshell-cd-on-directory t
- "*If non-nil, do a cd if a directory is in command position."
- :type 'boolean
- :group 'eshell-dirs)
-
-(defcustom eshell-directory-change-hook nil
- "*A hook to run when the current directory changes."
- :type 'hook
- :group 'eshell-dirs)
-
-(defcustom eshell-list-files-after-cd nil
- "*If non-nil, call \"ls\" with any remaining args after doing a cd.
-This is provided for convenience, since the same effect is easily
-achieved by adding a function to `eshell-directory-change-hook' that
-calls \"ls\" and references `eshell-last-arguments'."
- :type 'boolean
- :group 'eshell-dirs)
-
-(defcustom eshell-pushd-tohome nil
- "*If non-nil, make pushd with no arg behave as 'pushd ~' (like `cd').
-This mirrors the optional behavior of tcsh."
- :type 'boolean
- :group 'eshell-dirs)
-
-(defcustom eshell-pushd-dextract nil
- "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
-This mirrors the optional behavior of tcsh."
- :type 'boolean
- :group 'eshell-dirs)
-
-(defcustom eshell-pushd-dunique nil
- "*If non-nil, make pushd only add unique directories to the stack.
-This mirrors the optional behavior of tcsh."
- :type 'boolean
- :group 'eshell-dirs)
-
-(defcustom eshell-dirtrack-verbose t
- "*If non-nil, show the directory stack following directory change.
-This is effective only if directory tracking is enabled."
- :type 'boolean
- :group 'eshell-dirs)
-
-(defcustom eshell-last-dir-ring-file-name
- (concat eshell-directory-name "lastdir")
- "*If non-nil, name of the file to read/write the last-dir-ring.
-See also `eshell-read-last-dir-ring' and `eshell-write-last-dir-ring'.
-If it is nil, the last-dir-ring will not be written to disk."
- :type 'file
- :group 'eshell-dirs)
-
-(defcustom eshell-last-dir-ring-size 32
- "*If non-nil, the size of the directory history ring.
-This ring is added to every time `cd' or `pushd' is used. It simply
-stores the most recent directory locations Eshell has been in. To
-return to the most recent entry, use 'cd -' (equivalent to 'cd -0').
-To return to an older entry, use 'cd -N', where N is an integer less
-than `eshell-last-dir-ring-size'. To return to the last directory
-matching a particular regexp, use 'cd =REGEXP'. To display the
-directory history list, use 'cd ='.
-
-This mechanism is very similar to that provided by `pushd', except
-it's far more automatic. `pushd' allows the user to decide which
-directories gets pushed, and its size is unlimited.
-
-`eshell-last-dir-ring' is meant for users who don't use `pushd'
-explicity very much, but every once in a while would like to return to
-a previously visited directory without having to type in the whole
-thing again."
- :type 'integer
- :group 'eshell-dirs)
-
-(defcustom eshell-last-dir-unique t
- "*If non-nil, `eshell-last-dir-ring' contains only unique entries."
- :type 'boolean
- :group 'eshell-dirs)
-
-;;; Internal Variables:
-
-(defvar eshell-dirstack nil
- "List of directories saved by pushd in the Eshell buffer.
-Thus, this does not include the current directory.")
-
-(defvar eshell-last-dir-ring nil
- "The last directory that eshell was in.")
-
-;;; Functions:
-
-(defun eshell-dirs-initialize ()
- "Initialize the builtin functions for Eshell."
- (make-local-variable 'eshell-variable-aliases-list)
- (setq eshell-variable-aliases-list
- (append
- eshell-variable-aliases-list
- '(("-" (lambda (indices)
- (if (not indices)
- (unless (ring-empty-p eshell-last-dir-ring)
- (expand-file-name
- (ring-ref eshell-last-dir-ring 0)))
- (expand-file-name
- (eshell-apply-indices eshell-last-dir-ring indices)))))
- ("+" "PWD")
- ("PWD" (lambda (indices)
- (expand-file-name (eshell/pwd))) t)
- ("OLDPWD" (lambda (indices)
- (unless (ring-empty-p eshell-last-dir-ring)
- (expand-file-name
- (ring-ref eshell-last-dir-ring 0)))) t))))
-
- (when eshell-cd-on-directory
- (make-local-variable 'eshell-interpreter-alist)
- (setq eshell-interpreter-alist
- (cons (cons 'eshell-lone-directory-p
- 'eshell-dirs-substitute-cd)
- eshell-interpreter-alist)))
-
- (add-hook 'eshell-parse-argument-hook
- 'eshell-parse-user-reference nil t)
- (if (eshell-under-windows-p)
- (add-hook 'eshell-parse-argument-hook
- 'eshell-parse-drive-letter nil t))
-
- (when (eshell-using-module 'eshell-cmpl)
- (add-hook 'pcomplete-try-first-hook
- 'eshell-complete-user-reference nil t))
-
- (make-local-variable 'eshell-dirstack)
- (make-local-variable 'eshell-last-dir-ring)
-
- (if eshell-last-dir-ring-file-name
- (eshell-read-last-dir-ring))
- (unless eshell-last-dir-ring
- (setq eshell-last-dir-ring (make-ring eshell-last-dir-ring-size)))
-
- (add-hook 'eshell-exit-hook 'eshell-write-last-dir-ring nil t)
-
- (add-hook 'kill-emacs-hook 'eshell-save-some-last-dir))
-
-(defun eshell-save-some-last-dir ()
- "Save the list-dir-ring for any open Eshell buffers."
- (eshell-for buf (buffer-list)
- (if (buffer-live-p buf)
- (with-current-buffer buf
- (if (and eshell-mode
- eshell-ask-to-save-last-dir
- (or (eq eshell-ask-to-save-last-dir 'always)
- (y-or-n-p
- (format "Save last dir ring for Eshell buffer `%s'? "
- (buffer-name buf)))))
- (eshell-write-last-dir-ring))))))
-
-(defun eshell-lone-directory-p (file)
- "Test whether FILE is just a directory name, and not a command name."
- (and (file-directory-p file)
- (or (file-name-directory file)
- (not (eshell-search-path file)))))
-
-(defun eshell-dirs-substitute-cd (&rest args)
- "Substitute the given command for a call to `cd' on that name."
- (if (> (length args) 1)
- (error "%s: command not found" (car args))
- (throw 'eshell-replace-command
- (eshell-parse-command "cd" (eshell-flatten-list args)))))
-
-(defun eshell-parse-user-reference ()
- "An argument beginning with ~ is a filename to be expanded."
- (when (and (not eshell-current-argument)
- (eq (char-after) ?~))
- (add-to-list 'eshell-current-modifiers 'expand-file-name)
- (forward-char)
- (char-to-string (char-before))))
-
-(defun eshell-parse-drive-letter ()
- "An argument beginning X:[^/] is a drive letter reference."
- (when (and (not eshell-current-argument)
- (looking-at "\\([A-Za-z]:\\)\\([^/\\\\]\\|\\'\\)"))
- (goto-char (match-end 1))
- (let* ((letter (match-string 1))
- (regexp (concat "\\`" letter))
- (path (eshell-find-previous-directory regexp)))
- (concat (or path letter)
- (char-to-string directory-sep-char)))))
-
-(defun eshell-complete-user-reference ()
- "If there is a user reference, complete it."
- (let ((arg (pcomplete-actual-arg)))
- (when (string-match "\\`~[a-z]*\\'" arg)
- (setq pcomplete-stub (substring arg 1)
- pcomplete-last-completion-raw t)
- (throw 'pcomplete-completions
- (progn
- (eshell-read-user-names)
- (pcomplete-uniqify-list
- (mapcar
- (function
- (lambda (user)
- (file-name-as-directory (cdr user))))
- eshell-user-names)))))))
-
-(defun eshell/pwd (&rest args)
- "Change output from `pwd` to be cleaner."
- (let* ((path default-directory)
- (len (length path)))
- (if (and (> len 1)
- (eq (aref path (1- len)) directory-sep-char)
- (not (and (eshell-under-windows-p)
- (string-match "\\`[A-Za-z]:[\\\\/]\\'" path))))
- (setq path (substring path 0 (1- (length path)))))
- (if eshell-pwd-convert-function
- (funcall eshell-pwd-convert-function path)
- path)))
-
-(defun eshell-expand-multiple-dots (path)
- "Convert '...' to '../..', '....' to '../../..', etc..
-
-With the following piece of advice, you can make this functionality
-available in most of Emacs, with the exception of filename completion
-in the minibuffer:
-
- (defadvice expand-file-name
- (before translate-multiple-dots
- (filename &optional directory) activate)
- (setq filename (eshell-expand-multiple-dots filename)))"
- (while (string-match "\\.\\.\\(\\.+\\)" path)
- (let* ((extra-dots (match-string 1 path))
- (len (length extra-dots))
- replace-text)
- (while (> len 0)
- (setq replace-text
- (concat replace-text
- (char-to-string directory-sep-char) "..")
- len (1- len)))
- (setq path
- (replace-match replace-text t t path 1))))
- path)
-
-(defun eshell-find-previous-directory (regexp)
- "Find the most recent last-dir matching REGEXP."
- (let ((index 0)
- (len (ring-length eshell-last-dir-ring))
- oldpath)
- (if (> (length regexp) 0)
- (while (< index len)
- (setq oldpath (ring-ref eshell-last-dir-ring index))
- (if (string-match regexp oldpath)
- (setq index len)
- (setq oldpath nil
- index (1+ index)))))
- oldpath))
-
-(eval-when-compile
- (defvar dired-directory))
-
-(defun eshell/cd (&rest args) ; all but first ignored
- "Alias to extend the behavior of `cd'."
- (setq args (eshell-flatten-list args))
- (let ((path (car args))
- (subpath (car (cdr args)))
- (case-fold-search (eshell-under-windows-p))
- handled)
- (if (numberp path)
- (setq path (number-to-string path)))
- (if (numberp subpath)
- (setq subpath (number-to-string subpath)))
- (cond
- (subpath
- (let ((curdir (eshell/pwd)))
- (if (string-match path curdir)
- (setq path (replace-match subpath nil nil curdir))
- (error "Path substring '%s' not found" path))))
- ((and path (string-match "^-\\([0-9]*\\)$" path))
- (let ((index (match-string 1 path)))
- (setq path
- (ring-remove eshell-last-dir-ring
- (if index
- (string-to-int index)
- 0)))))
- ((and path (string-match "^=\\(.*\\)$" path))
- (let ((oldpath (eshell-find-previous-directory
- (match-string 1 path))))
- (if oldpath
- (setq path oldpath)
- (let ((len (ring-length eshell-last-dir-ring))
- (index 0))
- (if (= len 0)
- (error "Directory ring empty"))
- (eshell-init-print-buffer)
- (while (< index len)
- (eshell-buffered-print
- (concat (number-to-string index) ": "
- (ring-ref eshell-last-dir-ring index) "\n"))
- (setq index (1+ index)))
- (eshell-flush)
- (setq handled t)))))
- (path
- (setq path (eshell-expand-multiple-dots path))))
- (unless handled
- (setq dired-directory (or path "~"))
- (let ((curdir (eshell/pwd)))
- (unless (equal curdir dired-directory)
- (eshell-add-to-dir-ring curdir))
- (let ((result (cd dired-directory)))
- (and eshell-cd-shows-directory
- (eshell-printn result)))
- (run-hooks 'eshell-directory-change-hook)
- (if eshell-list-files-after-cd
- (throw 'eshell-replace-command
- (eshell-parse-command "ls" (cdr args))))
- nil))))
-
-(put 'eshell/cd 'eshell-no-numeric-conversions t)
-
-(defun eshell-add-to-dir-ring (path)
- "Add PATH to the last-dir-ring, if applicable."
- (unless (and (not (ring-empty-p eshell-last-dir-ring))
- (equal path (ring-ref eshell-last-dir-ring 0)))
- (if eshell-last-dir-unique
- (let ((index 0)
- (len (ring-length eshell-last-dir-ring)))
- (while (< index len)
- (if (equal (ring-ref eshell-last-dir-ring index) path)
- (ring-remove eshell-last-dir-ring index)
- (setq index (1+ index))))))
- (ring-insert eshell-last-dir-ring path)))
-
-;;; pushd [+n | dir]
-(defun eshell/pushd (&rest args) ; all but first ignored
- "Implementation of pushd in Lisp."
- (let ((path (car args)))
- (cond
- ((null path)
- ;; no arg -- swap pwd and car of stack unless eshell-pushd-tohome
- (cond (eshell-pushd-tohome
- (eshell/pushd "~"))
- (eshell-dirstack
- (let ((old (eshell/pwd)))
- (eshell/cd (car eshell-dirstack))
- (setq eshell-dirstack (cons old (cdr eshell-dirstack)))
- (eshell/dirs t)))
- (t
- (error "pushd: No other directory"))))
- ((string-match "^\\+\\([0-9]\\)" path)
- ;; pushd +n
- (setq path (string-to-number (match-string 1 path)))
- (cond ((> path (length eshell-dirstack))
- (error "Directory stack not that deep"))
- ((= path 0)
- (error "Couldn't cd"))
- (eshell-pushd-dextract
- (let ((dir (nth (1- path) eshell-dirstack)))
- (eshell/popd path)
- (eshell/pushd (eshell/pwd))
- (eshell/cd dir)
- (eshell/dirs t)))
- (t
- (let* ((ds (cons (eshell/pwd) eshell-dirstack))
- (dslen (length ds))
- (front (nthcdr path ds))
- (back (nreverse (nthcdr (- dslen path) (reverse ds))))
- (new-ds (append front back)))
- (eshell/cd (car new-ds))
- (setq eshell-dirstack (cdr new-ds))
- (eshell/dirs t)))))
- (t
- ;; pushd <dir>
- (let ((old-wd (eshell/pwd)))
- (eshell/cd path)
- (if (or (null eshell-pushd-dunique)
- (not (member old-wd eshell-dirstack)))
- (setq eshell-dirstack (cons old-wd eshell-dirstack)))
- (eshell/dirs t)))))
- nil)
-
-(put 'eshell/pushd 'eshell-no-numeric-conversions t)
-
-;;; popd [+n]
-(defun eshell/popd (&rest args)
- "Implementation of popd in Lisp."
- (let ((ref (or (car args) "+0")))
- (unless (and (stringp ref)
- (string-match "\\`\\([+-][0-9]+\\)\\'" ref))
- (error "popd: bad arg `%s'" ref))
- (setq ref (string-to-number (match-string 1 ref)))
- (cond ((= ref 0)
- (unless eshell-dirstack
- (error "popd: Directory stack empty"))
- (eshell/cd (car eshell-dirstack))
- (setq eshell-dirstack (cdr eshell-dirstack))
- (eshell/dirs t))
- ((<= (abs ref) (length eshell-dirstack))
- (let* ((ds (cons nil eshell-dirstack))
- (cell (nthcdr (if (> ref 0)
- (1- ref)
- (+ (length eshell-dirstack) ref)) ds))
- (dir (cadr cell)))
- (eshell/cd dir)
- (setcdr cell (cdr (cdr cell)))
- (setq eshell-dirstack (cdr ds))
- (eshell/dirs t)))
- (t
- (error "Couldn't popd"))))
- nil)
-
-(put 'eshell/popd 'eshell-no-numeric-conversions t)
-
-(defun eshell/dirs (&optional if-verbose)
- "Implementation of dirs in Lisp."
- (when (or (not if-verbose) eshell-dirtrack-verbose)
- (let* ((msg "")
- (ds (cons (eshell/pwd) eshell-dirstack))
- (home (expand-file-name "~/"))
- (homelen (length home)))
- (while ds
- (let ((dir (car ds)))
- (and (>= (length dir) homelen)
- (string= home (substring dir 0 homelen))
- (setq dir (concat "~/" (substring dir homelen))))
- (setq msg (concat msg (directory-file-name dir) " "))
- (setq ds (cdr ds))))
- msg)))
-
-(defun eshell-read-last-dir-ring ()
- "Sets the buffer's `eshell-last-dir-ring' from a history file."
- (let ((file eshell-last-dir-ring-file-name))
- (cond
- ((or (null file)
- (equal file "")
- (not (file-readable-p file)))
- nil)
- (t
- (let* ((count 0)
- (size eshell-last-dir-ring-size)
- (ring (make-ring size)))
- (with-temp-buffer
- (insert-file-contents file)
- ;; Save restriction in case file is already visited...
- ;; Watch for those date stamps in history files!
- (goto-char (point-max))
- (while (and (< count size)
- (re-search-backward "^\\([^\n].*\\)$" nil t))
- (ring-insert-at-beginning ring (match-string 1))
- (setq count (1+ count)))
- ;; never allow the top element to equal the current
- ;; directory
- (while (and (not (ring-empty-p ring))
- (equal (ring-ref ring 0) (eshell/pwd)))
- (ring-remove ring 0)))
- (setq eshell-last-dir-ring ring))))))
-
-(defun eshell-write-last-dir-ring ()
- "Writes the buffer's `eshell-last-dir-ring' to a history file."
- (let ((file eshell-last-dir-ring-file-name))
- (cond
- ((or (null file)
- (equal file "")
- (null eshell-last-dir-ring)
- (ring-empty-p eshell-last-dir-ring))
- nil)
- ((not (file-writable-p file))
- (message "Cannot write last-dir-ring file %s" file))
- (t
- (let* ((ring eshell-last-dir-ring)
- (index (ring-length ring)))
- (with-temp-buffer
- (while (> index 0)
- (setq index (1- index))
- (insert (ring-ref ring index) ?\n))
- (insert (eshell/pwd) ?\n)
- (eshell-with-private-file-modes
- (write-region (point-min) (point-max) file nil
- 'no-message))))))))
-
-;;; Code:
-
-;;; em-dirs.el ends here
+++ /dev/null
-;;; em-glob.el --- extended file name globbing
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(provide 'em-glob)
-
-(eval-when-compile (require 'esh-maint))
-(require 'esh-util)
-
-(defgroup eshell-glob nil
- "This module provides extended globbing syntax, similar what is used
-by zsh for filename generation."
- :tag "Extended filename globbing"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; The globbing code used by Eshell closely follows the syntax used by
-;; zsh. Basically, here is a summary of examples:
-;;
-;; echo a* ; anything starting with 'a'
-;; echo a#b ; zero or more 'a's, then 'b'
-;; echo a##b ; one or more 'a's, then 'b'
-;; echo a? ; a followed by any character
-;; echo a*~ab ; 'a', then anything, but not 'ab'
-;; echo c*~*~ ; all files beginning with 'c', except backups (*~)
-;;
-;; Recursive globbing is also supported:
-;;
-;; echo **/*.c ; all '.c' files at or under current directory
-;; echo ***/*.c ; same as above, but traverse symbolic links
-;;
-;; Using argument predication, the recursive globbing syntax is
-;; sufficient to replace the use of 'find <expr> | xargs <cmd>' in
-;; most cases. For example, to change the readership of all files
-;; belonging to 'johnw' in the '/tmp' directory or lower, use:
-;;
-;; chmod go-r /tmp/**/*(u'johnw')
-;;
-;; The glob above matches all of the files beneath '/tmp' that are
-;; owned by the user 'johnw'. See [Value modifiers and predicates],
-;; for more information about argument predication.
-
-;;; User Variables:
-
-(defcustom eshell-glob-load-hook '(eshell-glob-initialize)
- "*A list of functions to run when `eshell-glob' is loaded."
- :type 'hook
- :group 'eshell-glob)
-
-(defcustom eshell-glob-include-dot-files nil
- "*If non-nil, glob patterns will match files beginning with a dot."
- :type 'boolean
- :group 'eshell-glob)
-
-(defcustom eshell-glob-include-dot-dot t
- "*If non-nil, glob patterns that match dots will match . and .."
- :type 'boolean
- :group 'eshell-glob)
-
-(defcustom eshell-glob-case-insensitive (eshell-under-windows-p)
- "*If non-nil, glob pattern matching will ignore case."
- :type 'boolean
- :group 'eshell-glob)
-
-(defcustom eshell-glob-show-progress nil
- "*If non-nil, display progress messages during a recursive glob.
-This option slows down recursive glob processing by quite a bit."
- :type 'boolean
- :group 'eshell-glob)
-
-(defcustom eshell-error-if-no-glob nil
- "*If non-nil, it is an error for a glob pattern not to match.
- This mimcs the behavior of zsh if non-nil, but bash if nil."
- :type 'boolean
- :group 'eshell-glob)
-
-(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?#)
- "*List of additional characters used in extended globbing."
- :type '(repeat character)
- :group 'eshell-glob)
-
-(defcustom eshell-glob-translate-alist
- '((?\] . "]")
- (?\[ . "[")
- (?? . ".")
- (?* . ".*")
- (?~ . "~")
- (?\( . "\\(")
- (?\) . "\\)")
- (?\| . "\\|")
- (?# . (lambda (str pos)
- (if (and (< (1+ pos) (length str))
- (memq (aref str (1+ pos)) '(?* ?# ?+ ??)))
- (cons (if (eq (aref str (1+ pos)) ??)
- "?"
- (if (eq (aref str (1+ pos)) ?*)
- "*" "+")) (+ pos 2))
- (cons "*" (1+ pos))))))
- "*An alist for translation of extended globbing characters."
- :type '(repeat (cons character (choice regexp function)))
- :group 'eshell-glob)
-
-;;; Internal Variables:
-
-(defvar eshell-glob-chars-regexp nil)
-
-;;; Functions:
-
-(defun eshell-glob-initialize ()
- "Initialize the extended globbing code."
- ;; it's important that `eshell-glob-chars-list' come first
- (when (boundp 'eshell-special-chars-outside-quoting)
- (set (make-local-variable 'eshell-special-chars-outside-quoting)
- (append eshell-glob-chars-list eshell-special-chars-outside-quoting)))
- (set (make-local-variable 'eshell-glob-chars-regexp)
- (format "[%s]+" (apply 'string eshell-glob-chars-list)))
- (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t)
- (add-hook 'eshell-pre-rewrite-command-hook
- 'eshell-no-command-globbing nil t))
-
-(defun eshell-no-command-globbing (terms)
- "Don't glob the command argument. Reflect this by modifying TERMS."
- (ignore
- (when (and (listp (car terms))
- (eq (caar terms) 'eshell-extended-glob))
- (setcar terms (cadr (car terms))))))
-
-(defun eshell-add-glob-modifier ()
- "Add `eshell-extended-glob' to the argument modifier list."
- (when (memq 'expand-file-name eshell-current-modifiers)
- (setq eshell-current-modifiers
- (delq 'expand-file-name eshell-current-modifiers))
- ;; if this is a glob pattern than needs to be expanded, then it
- ;; will need to expand each member of the resulting glob list
- (add-to-list 'eshell-current-modifiers
- '(lambda (list)
- (if (listp list)
- (mapcar 'expand-file-name list)
- (expand-file-name list)))))
- (add-to-list 'eshell-current-modifiers 'eshell-extended-glob))
-
-(defun eshell-parse-glob-chars ()
- "Parse a globbing delimiter.
-The character is not advanced for ordinary globbing characters, so
-that other function may have a chance to override the globbing
-interpretation."
- (when (memq (char-after) eshell-glob-chars-list)
- (if (not (memq (char-after) '(?\( ?\[)))
- (ignore (eshell-add-glob-modifier))
- (let ((here (point)))
- (forward-char)
- (let* ((delim (char-before))
- (end (eshell-find-delimiter
- delim (if (eq delim ?\[) ?\] ?\)))))
- (if (not end)
- (throw 'eshell-incomplete delim)
- (if (and (eshell-using-module 'eshell-pred)
- (eshell-arg-delimiter (1+ end)))
- (ignore (goto-char here))
- (eshell-add-glob-modifier)
- (prog1
- (buffer-substring-no-properties (1- (point)) (1+ end))
- (goto-char (1+ end))))))))))
-
-(defun eshell-glob-regexp (pattern)
- "Convert glob-pattern PATTERN to a regular expression.
-The basic syntax is:
-
- glob regexp meaning
- ---- ------ -------
- ? . matches any single character
- * .* matches any group of characters (or none)
- # * matches zero or more occurrences of preceding
- ## + matches one or more occurrences of preceding
- (x) \(x\) makes 'x' a regular expression group
- | \| boolean OR within an expression group
- [a-b] [a-b] matches a character or range
- [^a] [^a] excludes a character or range
-
-If any characters in PATTERN have the text property `eshell-escaped'
-set to true, then these characters will match themselves in the
-resulting regular expression."
- (let ((matched-in-pattern 0) ; How much of PATTERN handled
- regexp)
- (while (string-match eshell-glob-chars-regexp
- pattern matched-in-pattern)
- (let* ((op-begin (match-beginning 0))
- (op-char (aref pattern op-begin)))
- (setq regexp
- (concat regexp
- (regexp-quote
- (substring pattern matched-in-pattern op-begin))))
- (if (get-text-property op-begin 'escaped pattern)
- (setq regexp (concat regexp
- (regexp-quote (char-to-string op-char)))
- matched-in-pattern (1+ op-begin))
- (let ((xlat (assq op-char eshell-glob-translate-alist)))
- (if (not xlat)
- (error "Unrecognized globbing character '%c'" op-char)
- (if (stringp (cdr xlat))
- (setq regexp (concat regexp (cdr xlat))
- matched-in-pattern (1+ op-begin))
- (let ((result (funcall (cdr xlat) pattern op-begin)))
- (setq regexp (concat regexp (car result))
- matched-in-pattern (cdr result)))))))))
- (concat "\\`"
- regexp
- (regexp-quote (substring pattern matched-in-pattern))
- "\\'")))
-
-(defun eshell-extended-glob (glob)
- "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
-This function almost fully supports zsh style filename generation
-syntax. Things that are not supported are:
-
- ^foo for matching everything but foo
- (foo~bar) tilde within a parenthesis group
- foo<1-10> numeric ranges
- foo~x(a|b) (a|b) will be interpreted as a predicate/modifier list
-
-Mainly they are not supported because file matching is done with Emacs
-regular expressions, and these cannot support the above constructs.
-
-If this routine fails, it returns nil. Otherwise, it returns a list
-the form:
-
- (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
- (let ((paths (eshell-split-path glob))
- matches message-shown ange-cache)
- (unwind-protect
- (if (and (cdr paths)
- (file-name-absolute-p (car paths)))
- (eshell-glob-entries (file-name-as-directory (car paths))
- (cdr paths))
- (eshell-glob-entries (file-name-as-directory ".") paths))
- (if message-shown
- (message nil)))
- (or (and matches (nreverse matches))
- (if eshell-error-if-no-glob
- (error "No matches found: %s" glob)
- glob))))
-
-(eval-when-compile
- (defvar matches)
- (defvar message-shown))
-
-;; jww (1999-11-18): this function assumes that directory-sep-char is
-;; a forward slash (/)
-
-(defun eshell-glob-entries (path globs &optional recurse-p)
- "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil."
- (let* ((entries (ignore-errors
- (file-name-all-completions "" path)))
- (case-fold-search eshell-glob-case-insensitive)
- (glob (car globs))
- (len (length glob))
- dirs rdirs
- incl excl
- name isdir pathname)
- (while (cond
- ((and (= len 3) (equal glob "**/"))
- (setq recurse-p 2
- globs (cdr globs)
- glob (car globs)
- len (length glob)))
- ((and (= len 4) (equal glob "***/"))
- (setq recurse-p 3
- globs (cdr globs)
- glob (car globs)
- len (length glob)))))
- (if (and recurse-p (not glob))
- (error "'**' cannot end a globbing pattern"))
- (let ((index 1))
- (setq incl glob)
- (while (and (eq incl glob)
- (setq index (string-match "~" glob index)))
- (if (or (get-text-property index 'escaped glob)
- (or (= (1+ index) len)))
- (setq index (1+ index))
- (setq incl (substring glob 0 index)
- excl (substring glob (1+ index))))))
- ;; can't use `directory-file-name' because it strips away text
- ;; properties in the string
- (let ((len (1- (length incl))))
- (if (eq (aref incl len) directory-sep-char)
- (setq incl (substring incl 0 len)))
- (when excl
- (setq len (1- (length excl)))
- (if (eq (aref excl len) directory-sep-char)
- (setq excl (substring excl 0 len)))))
- (setq incl (eshell-glob-regexp incl)
- excl (and excl (eshell-glob-regexp excl)))
- (if (or eshell-glob-include-dot-files
- (eq (aref glob 0) ?.))
- (unless (or eshell-glob-include-dot-dot
- (cdr globs))
- (setq excl (if excl
- (concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
- "\\`\\.\\.?\\'")))
- (setq excl (if excl
- (concat "\\(\\`\\.\\|" excl "\\)")
- "\\`\\.")))
- (when (and recurse-p eshell-glob-show-progress)
- (message "Building file list...%d so far: %s"
- (length matches) path)
- (setq message-shown t))
- (if (equal path "./") (setq path ""))
- (while entries
- (setq name (car entries)
- len (length name)
- isdir (eq (aref name (1- len)) directory-sep-char))
- (if (let ((fname (directory-file-name name)))
- (and (not (and excl (string-match excl fname)))
- (string-match incl fname)))
- (if (cdr globs)
- (if isdir
- (setq dirs (cons (concat path name) dirs)))
- (setq matches (cons (concat path name) matches))))
- (if (and recurse-p isdir
- (or (> len 3)
- (not (or (and (= len 2) (equal name "./"))
- (and (= len 3) (equal name "../")))))
- (setq pathname (concat path name))
- (not (and (= recurse-p 2)
- (file-symlink-p
- (directory-file-name pathname)))))
- (setq rdirs (cons pathname rdirs)))
- (setq entries (cdr entries)))
- (setq dirs (nreverse dirs)
- rdirs (nreverse rdirs))
- (while dirs
- (eshell-glob-entries (car dirs) (cdr globs))
- (setq dirs (cdr dirs)))
- (while rdirs
- (eshell-glob-entries (car rdirs) globs recurse-p)
- (setq rdirs (cdr rdirs)))))
-
-;;; em-glob.el ends here
+++ /dev/null
-;;; em-hist.el --- history list management
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-hist)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-hist nil
- "This module provides command history management."
- :tag "History list management"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; Eshell's history facility imitates the syntax used by bash
-;; ([(bash)History Interaction]). Thus:
-;;
-;; !ls ; repeat the last command beginning with 'ls'
-;; !?ls ; repeat the last command containing ls
-;; echo !ls:2 ; echo the second arg of the last 'ls' command
-;; !ls<tab> ; complete against all possible words in this
-;; ; position, by looking at the history list
-;; !ls<C-c SPC> ; expand any matching history input at point
-;;
-;; Also, most of `comint-mode's keybindings are accepted:
-;;
-;; M-r ; search backward for a previous command by regexp
-;; M-s ; search forward for a previous command by regexp
-;; M-p ; access the last command entered, repeatable
-;; M-n ; access the first command entered, repeatable
-;;
-;; C-c M-r ; using current input, find a matching command thus, with
-;; ; 'ls' as the current input, it will go back to the same
-;; ; command that '!ls' would have selected
-;; C-c M-s ; same, but in reverse order
-;;
-;; Note that some of these keybindings are only available if the
-;; `eshell-rebind' is not in use, in which case M-p does what C-c M-r
-;; normally would do, and C-p is used instead of M-p. It may seem
-;; confusing, but the intention is to make the most useful
-;; functionality the most easily accessible. If `eshell-rebind' is
-;; not being used, history navigation will use comint's keybindings;
-;; if it is, history navigation tries to use similar keybindings to
-;; bash. This is all configurable, of course.
-
-;;; Code:
-
-(require 'ring)
-(require 'esh-opt)
-(require 'em-pred)
-
-;;; User Variables:
-
-(defcustom eshell-hist-load-hook '(eshell-hist-initialize)
- "*A list of functions to call when loading `eshell-hist'."
- :type 'hook
- :group 'eshell-hist)
-
-(defcustom eshell-hist-unload-hook
- (list
- (function
- (lambda ()
- (remove-hook 'kill-emacs-hook 'eshell-save-some-history))))
- "*A hook that gets run when `eshell-hist' is unloaded."
- :type 'hook
- :group 'eshell-hist)
-
-(defcustom eshell-history-file-name
- (concat eshell-directory-name "history")
- "*If non-nil, name of the file to read/write input history.
-See also `eshell-read-history' and `eshell-write-history'.
-If it is nil, Eshell will use the value of HISTFILE."
- :type 'file
- :group 'eshell-hist)
-
-(defcustom eshell-history-size 128
- "*Size of the input history ring. If nil, use envvar HISTSIZE."
- :type 'integer
- :group 'eshell-hist)
-
-(defcustom eshell-hist-ignoredups nil
- "*If non-nil, don't add input matching the last on the input ring.
-This mirrors the optional behavior of bash."
- :type 'boolean
- :group 'eshell-hist)
-
-(defcustom eshell-save-history-on-exit 'ask
- "*Determine if history should be automatically saved.
-History is always preserved after sanely exiting an Eshell buffer.
-However, when Emacs is being shut down, this variable determines
-whether to prompt the user.
-If set to nil, it means never save history on termination of Emacs.
-If set to `ask', ask if any Eshell buffers are open at exit time.
-If set to t, history will always be saved, silently."
- :type '(choice (const :tag "Never" nil)
- (const :tag "Ask" ask)
- (const :tag "Always save" t))
- :group 'eshell-hist)
-
-(defcustom eshell-input-filter
- (function
- (lambda (str)
- (not (string-match "\\`\\s-*\\'" str))))
- "*Predicate for filtering additions to input history.
-Takes one argument, the input. If non-nil, the input may be saved on
-the input history list. Default is to save anything that isn't all
-whitespace."
- :type 'function
- :group 'eshell-hist)
-
-(put 'eshell-input-filter 'risky-local-variable t)
-
-(defcustom eshell-hist-match-partial t
- "*If non-nil, movement through history is constrained by current input.
-Otherwise, typing <M-p> and <M-n> will always go to the next history
-element, regardless of any text on the command line. In that case,
-<C-c M-r> and <C-c M-s> still offer that functionality."
- :type 'boolean
- :group 'eshell-hist)
-
-(defcustom eshell-hist-move-to-end t
- "*If non-nil, move to the end of the buffer before cycling history."
- :type 'boolean
- :group 'eshell-hist)
-
-(defcustom eshell-hist-event-designator
- "^!\\(!\\|-?[0-9]+\\|\\??[^:^$%*?]+\\??\\|#\\)"
- "*The regexp used to identifier history event designators."
- :type 'regexp
- :group 'eshell-hist)
-
-(defcustom eshell-hist-word-designator
- "^:?\\([0-9]+\\|[$^%*]\\)?\\(\\*\\|-[0-9]*\\|[$^%*]\\)?"
- "*The regexp used to identify history word designators."
- :type 'regexp
- :group 'eshell-hist)
-
-(defcustom eshell-hist-modifier
- "^\\(:\\([hretpqx&g]\\|s/\\([^/]*\\)/\\([^/]*\\)/\\)\\)*"
- "*The regexp used to identity history modifiers."
- :type 'regexp
- :group 'eshell-hist)
-
-(defcustom eshell-hist-rebind-keys-alist
- '(([(control ?p)] . eshell-previous-input)
- ([(control ?n)] . eshell-next-input)
- ([(control up)] . eshell-previous-input)
- ([(control down)] . eshell-next-input)
- ([(control ?r)] . eshell-isearch-backward)
- ([(control ?s)] . eshell-isearch-forward)
- ([(meta ?r)] . eshell-previous-matching-input)
- ([(meta ?s)] . eshell-next-matching-input)
- ([(meta ?p)] . eshell-previous-matching-input-from-input)
- ([(meta ?n)] . eshell-next-matching-input-from-input)
- ([up] . eshell-previous-matching-input-from-input)
- ([down] . eshell-next-matching-input-from-input))
- "*History keys to bind differently if point is in input text."
- :type '(repeat (cons (vector :tag "Keys to bind"
- (repeat :inline t sexp))
- (function :tag "Command")))
- :group 'eshell-hist)
-
-;;; Internal Variables:
-
-(defvar eshell-history-ring nil)
-(defvar eshell-history-index nil)
-(defvar eshell-matching-input-from-input-string "")
-(defvar eshell-save-history-index nil)
-
-(defvar eshell-isearch-map nil)
-
-(unless eshell-isearch-map
- (setq eshell-isearch-map (copy-keymap isearch-mode-map))
- (define-key eshell-isearch-map [(control ?m)] 'eshell-isearch-return)
- (define-key eshell-isearch-map [return] 'eshell-isearch-return)
- (define-key eshell-isearch-map [(control ?r)] 'eshell-isearch-repeat-backward)
- (define-key eshell-isearch-map [(control ?s)] 'eshell-isearch-repeat-forward)
- (define-key eshell-isearch-map [(control ?g)] 'eshell-isearch-abort)
- (define-key eshell-isearch-map [backspace] 'eshell-isearch-delete-char)
- (define-key eshell-isearch-map [delete] 'eshell-isearch-delete-char)
- (defvar eshell-isearch-cancel-map)
- (define-prefix-command 'eshell-isearch-cancel-map)
- (define-key eshell-isearch-map [(control ?c)] 'eshell-isearch-cancel-map)
- (define-key eshell-isearch-cancel-map [(control ?c)] 'eshell-isearch-cancel))
-
-;;; Functions:
-
-(defun eshell-hist-initialize ()
- "Initialize the history management code for one Eshell buffer."
- (add-hook 'eshell-expand-input-functions
- 'eshell-expand-history-references nil t)
-
- (when (eshell-using-module 'eshell-cmpl)
- (add-hook 'pcomplete-try-first-hook
- 'eshell-complete-history-reference nil t))
-
- (if (and (eshell-using-module 'eshell-rebind)
- (not eshell-non-interactive-p))
- (let ((rebind-alist (symbol-value 'eshell-rebind-keys-alist)))
- (make-local-variable 'eshell-rebind-keys-alist)
- (set 'eshell-rebind-keys-alist
- (append rebind-alist eshell-hist-rebind-keys-alist))
- (set (make-local-variable 'search-invisible) t)
- (set (make-local-variable 'search-exit-option) t)
- (add-hook 'isearch-mode-hook
- (function
- (lambda ()
- (if (>= (point) eshell-last-output-end)
- (setq overriding-terminal-local-map
- eshell-isearch-map)))) nil t)
- (add-hook 'isearch-mode-end-hook
- (function
- (lambda ()
- (setq overriding-terminal-local-map nil))) nil t))
- (define-key eshell-mode-map [up] 'eshell-previous-matching-input-from-input)
- (define-key eshell-mode-map [down] 'eshell-next-matching-input-from-input)
- (define-key eshell-mode-map [(control up)] 'eshell-previous-input)
- (define-key eshell-mode-map [(control down)] 'eshell-next-input)
- (define-key eshell-mode-map [(meta ?r)] 'eshell-previous-matching-input)
- (define-key eshell-mode-map [(meta ?s)] 'eshell-next-matching-input)
- (define-key eshell-command-map [(meta ?r)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-command-map [(meta ?s)]
- 'eshell-next-matching-input-from-input)
- (if eshell-hist-match-partial
- (progn
- (define-key eshell-mode-map [(meta ?p)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-mode-map [(meta ?n)]
- 'eshell-next-matching-input-from-input)
- (define-key eshell-command-map [(meta ?p)] 'eshell-previous-input)
- (define-key eshell-command-map [(meta ?n)] 'eshell-next-input))
- (define-key eshell-mode-map [(meta ?p)] 'eshell-previous-input)
- (define-key eshell-mode-map [(meta ?n)] 'eshell-next-input)
- (define-key eshell-command-map [(meta ?p)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-command-map [(meta ?n)]
- 'eshell-next-matching-input-from-input)))
-
- (make-local-variable 'eshell-history-size)
- (or eshell-history-size
- (setq eshell-history-size (getenv "HISTSIZE")))
-
- (make-local-variable 'eshell-history-file-name)
- (or eshell-history-file-name
- (setq eshell-history-file-name (getenv "HISTFILE")))
-
- (make-local-variable 'eshell-history-index)
- (make-local-variable 'eshell-save-history-index)
-
- (if (minibuffer-window-active-p (selected-window))
- (set (make-local-variable 'eshell-save-history-on-exit) nil)
- (set (make-local-variable 'eshell-history-ring) nil)
- (if eshell-history-file-name
- (eshell-read-history nil t))
-
- (add-hook 'eshell-exit-hook 'eshell-write-history nil t))
-
- (unless eshell-history-ring
- (setq eshell-history-ring (make-ring eshell-history-size)))
-
- (add-hook 'eshell-exit-hook 'eshell-write-history nil t)
-
- (add-hook 'kill-emacs-hook 'eshell-save-some-history)
-
- (make-local-variable 'eshell-input-filter-functions)
- (add-hook 'eshell-input-filter-functions 'eshell-add-to-history nil t)
-
- (define-key eshell-command-map [(control ?l)] 'eshell-list-history)
- (define-key eshell-command-map [(control ?x)] 'eshell-get-next-from-history))
-
-(defun eshell-save-some-history ()
- "Save the history for any open Eshell buffers."
- (eshell-for buf (buffer-list)
- (if (buffer-live-p buf)
- (with-current-buffer buf
- (if (and eshell-mode
- eshell-history-file-name
- eshell-save-history-on-exit
- (or (eq eshell-save-history-on-exit t)
- (y-or-n-p
- (format "Save input history for Eshell buffer `%s'? "
- (buffer-name buf)))))
- (eshell-write-history))))))
-
-(defun eshell/history (&rest args)
- "List in help buffer the buffer's input history."
- (eshell-init-print-buffer)
- (eshell-eval-using-options
- "history" args
- '((?r "read" nil read-history
- "read from history file to current history list")
- (?w "write" nil write-history
- "write current history list to history file")
- (?a "append" nil append-history
- "append current history list to history file")
- (?h "help" nil nil "display this usage message")
- :usage "[n] [-rwa [filename]]"
- :post-usage
-"When Eshell is started, history is read from `eshell-history-file-name'.
-This is also the location where history info will be saved by this command,
-unless a different file is specified on the command line.")
- (and (or (not (ring-p eshell-history-ring))
- (ring-empty-p eshell-history-ring))
- (error "No history"))
- (let (length command file)
- (when (and args (string-match "^[0-9]+$" (car args)))
- (setq length (min (eshell-convert (car args))
- (ring-length eshell-history-ring))
- args (cdr args)))
- (and length
- (or read-history write-history append-history)
- (error "history: extra arguments"))
- (when (and args (stringp (car args)))
- (setq file (car args)
- args (cdr args)))
- (cond
- (read-history (eshell-read-history file))
- (write-history (eshell-write-history file))
- (append-history (eshell-write-history file t))
- (t
- (let* ((history nil)
- (index (1- (or length (ring-length eshell-history-ring))))
- (ref (- (ring-length eshell-history-ring) index)))
- ;; We have to build up a list ourselves from the ring vector.
- (while (>= index 0)
- (eshell-buffered-print
- (format "%5d %s\n" ref (eshell-get-history index)))
- (setq index (1- index)
- ref (1+ ref)))))))
- (eshell-flush)
- nil))
-
-(defun eshell-put-history (input &optional ring at-beginning)
- "Put a new input line into the history ring."
- (unless ring (setq ring eshell-history-ring))
- (if at-beginning
- (ring-insert-at-beginning ring input)
- (ring-insert ring input)))
-
-(defun eshell-get-history (index &optional ring)
- "Get an input line from the history ring."
- (ring-ref (or ring eshell-history-ring) index))
-
-(defun eshell-add-input-to-history (input)
- "Add the string INPUT to the history ring.
-Input is entered into the input history ring, if the value of
-variable `eshell-input-filter' returns non-nil when called on the
-input."
- (if (and (funcall eshell-input-filter input)
- (or (null eshell-hist-ignoredups)
- (not (ring-p eshell-history-ring))
- (ring-empty-p eshell-history-ring)
- (not (string-equal (eshell-get-history 0) input))))
- (eshell-put-history input))
- (setq eshell-save-history-index eshell-history-index)
- (setq eshell-history-index nil))
-
-(defun eshell-add-command-to-history ()
- "Add the command entered at `eshell-command's prompt to the history ring.
-The command is added to the input history ring, if the value of
-variable `eshell-input-filter' returns non-nil when called on the
-command.
-
-This function is supposed to be called from the minibuffer, presumably
-as a minibuffer-exit-hook."
- (eshell-add-input-to-history
- (buffer-substring (minibuffer-prompt-end) (point-max))))
-
-(defun eshell-add-to-history ()
- "Add last Eshell command to the history ring.
-The command is entered into the input history ring, if the value of
-variable `eshell-input-filter' returns non-nil when called on the
-command."
- (when (> (1- eshell-last-input-end) eshell-last-input-start)
- (let ((input (buffer-substring eshell-last-input-start
- (1- eshell-last-input-end))))
- (eshell-add-input-to-history input))))
-
-(defun eshell-read-history (&optional filename silent)
- "Sets the buffer's `eshell-history-ring' from a history file.
-The name of the file is given by the variable
-`eshell-history-file-name'. The history ring is of size
-`eshell-history-size', regardless of file size. If
-`eshell-history-file-name' is nil this function does nothing.
-
-If the optional argument SILENT is non-nil, we say nothing about a
-failure to read the history file.
-
-This function is useful for major mode commands and mode hooks.
-
-The structure of the history file should be one input command per
-line, with the most recent command last. See also
-`eshell-hist-ignoredups' and `eshell-write-history'."
- (let ((file (or filename eshell-history-file-name)))
- (cond
- ((or (null file)
- (equal file ""))
- nil)
- ((not (file-readable-p file))
- (or silent
- (message "Cannot read history file %s" file)))
- (t
- (let* ((count 0)
- (size eshell-history-size)
- (ring (make-ring size))
- (ignore-dups eshell-hist-ignoredups))
- (with-temp-buffer
- (insert-file-contents file)
- ;; Save restriction in case file is already visited...
- ;; Watch for those date stamps in history files!
- (goto-char (point-max))
- (while (and (< count size)
- (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
- nil t))
- (let ((history (match-string 1)))
- (if (or (null ignore-dups)
- (ring-empty-p ring)
- (not (string-equal (ring-ref ring 0) history)))
- (ring-insert-at-beginning
- ring (subst-char-in-string ?\177 ?\n history))))
- (setq count (1+ count))))
- (setq eshell-history-ring ring
- eshell-history-index nil))))))
-
-(defun eshell-write-history (&optional filename append)
- "Writes the buffer's `eshell-history-ring' to a history file.
-The name of the file is given by the variable
-`eshell-history-file-name'. The original contents of the file are
-lost if `eshell-history-ring' is not empty. If
-`eshell-history-file-name' is nil this function does nothing.
-
-Useful within process sentinels.
-
-See also `eshell-read-history'."
- (let ((file (or filename eshell-history-file-name)))
- (cond
- ((or (null file)
- (equal file "")
- (null eshell-history-ring)
- (ring-empty-p eshell-history-ring))
- nil)
- ((not (file-writable-p file))
- (message "Cannot write history file %s" file))
- (t
- (let* ((ring eshell-history-ring)
- (index (ring-length ring)))
- ;; Write it all out into a buffer first. Much faster, but
- ;; messier, than writing it one line at a time.
- (with-temp-buffer
- (while (> index 0)
- (setq index (1- index))
- (let ((start (point)))
- (insert (ring-ref ring index) ?\n)
- (subst-char-in-region start (1- (point)) ?\n ?\177)))
- (eshell-with-private-file-modes
- (write-region (point-min) (point-max) file append
- 'no-message))))))))
-
-(defun eshell-list-history ()
- "List in help buffer the buffer's input history."
- (interactive)
- (let (prefix prelen)
- (save-excursion
- (if (re-search-backward "!\\(.+\\)" (line-beginning-position) t)
- (setq prefix (match-string 1)
- prelen (length prefix))))
- (if (or (not (ring-p eshell-history-ring))
- (ring-empty-p eshell-history-ring))
- (message "No history")
- (let ((history nil)
- (history-buffer " *Input History*")
- (index (1- (ring-length eshell-history-ring)))
- (conf (current-window-configuration)))
- ;; We have to build up a list ourselves from the ring vector.
- (while (>= index 0)
- (let ((hist (eshell-get-history index)))
- (if (or (not prefix)
- (and (>= (length hist) prelen)
- (string= (substring hist 0 prelen) prefix)))
- (setq history (cons hist history))))
- (setq index (1- index)))
- ;; Change "completion" to "history reference"
- ;; to make the display accurate.
- (with-output-to-temp-buffer history-buffer
- (display-completion-list history)
- (set-buffer history-buffer)
- (forward-line 3)
- (while (search-backward "completion" nil 'move)
- (replace-match "history reference")))
- (eshell-redisplay)
- (message "Hit space to flush")
- (let ((ch (read-event)))
- (if (eq ch ?\ )
- (set-window-configuration conf)
- (setq unread-command-events (list ch))))))))
-
-(defun eshell-hist-word-reference (ref)
- "Return the word designator index referred to by REF."
- (cond
- ((string-match "^[0-9]+$" ref)
- (string-to-number ref))
- ((string= "^" ref) 1)
- ((string= "$" ref) nil)
- ((string= "%" ref)
- (error "`%' history word designator not yet implemented"))))
-
-(defun eshell-hist-parse-arguments (&optional silent b e)
- "Parse current command arguments in a history-code-friendly way."
- (let ((end (or e (point)))
- (begin (or b (save-excursion (eshell-bol) (point))))
- (posb (list t))
- (pose (list t))
- (textargs (list t))
- hist args)
- (unless (catch 'eshell-incomplete
- (ignore
- (setq args (eshell-parse-arguments begin end))))
- (save-excursion
- (goto-char begin)
- (while (< (point) end)
- (if (get-text-property (point) 'arg-begin)
- (nconc posb (list (point))))
- (if (get-text-property (point) 'arg-end)
- (nconc pose
- (list (if (= (1+ (point)) end)
- (1+ (point))
- (point)))))
- (forward-char))
- (setq posb (cdr posb)
- pose (cdr pose))
- (assert (= (length posb) (length args)))
- (assert (<= (length posb) (length pose))))
- (setq hist (buffer-substring-no-properties begin end))
- (let ((b posb) (e pose))
- (while b
- (nconc textargs
- (list (substring hist (- (car b) begin)
- (- (car e) begin))))
- (setq b (cdr b)
- e (cdr e))))
- (setq textargs (cdr textargs))
- (assert (= (length textargs) (length args)))
- (list textargs posb pose))))
-
-(defun eshell-expand-history-references (beg end)
- "Parse and expand any history references in current input."
- (let ((result (eshell-hist-parse-arguments t beg end)))
- (when result
- (let ((textargs (nreverse (nth 0 result)))
- (posb (nreverse (nth 1 result)))
- (pose (nreverse (nth 2 result))))
- (save-excursion
- (while textargs
- (let ((str (eshell-history-reference (car textargs))))
- (unless (eq str (car textargs))
- (goto-char (car posb))
- (insert-and-inherit str)
- (delete-char (- (car pose) (car posb)))))
- (setq textargs (cdr textargs)
- posb (cdr posb)
- pose (cdr pose))))))))
-
-(defun eshell-complete-history-reference ()
- "Complete a history reference, by completing the event designator."
- (let ((arg (pcomplete-actual-arg)))
- (when (string-match "\\`![^:^$*%]*\\'" arg)
- (setq pcomplete-stub (substring arg 1)
- pcomplete-last-completion-raw t)
- (throw 'pcomplete-completions
- (let ((history nil)
- (index (1- (ring-length eshell-history-ring)))
- (stublen (length pcomplete-stub)))
- ;; We have to build up a list ourselves from the ring
- ;; vector.
- (while (>= index 0)
- (let ((hist (eshell-get-history index)))
- (if (and (>= (length hist) stublen)
- (string= (substring hist 0 stublen)
- pcomplete-stub)
- (string-match "^\\([^:^$*% \t\n]+\\)" hist))
- (setq history (cons (match-string 1 hist)
- history))))
- (setq index (1- index)))
- (let ((fhist (list t)))
- ;; uniqify the list, but preserve the order
- (while history
- (unless (member (car history) fhist)
- (nconc fhist (list (car history))))
- (setq history (cdr history)))
- (cdr fhist)))))))
-
-(defun eshell-history-reference (reference)
- "Expand directory stack REFERENCE.
-The syntax used here was taken from the Bash info manual.
-Returns the resultant reference, or the same string REFERENCE if none
-matched."
- ;; `^string1^string2^'
- ;; Quick Substitution. Repeat the last command, replacing
- ;; STRING1 with STRING2. Equivalent to `!!:s/string1/string2/'
- (if (and (eshell-using-module 'eshell-pred)
- (string-match "\\^\\([^^]+\\)\\^\\([^^]+\\)\\^?\\s-*$"
- reference))
- (setq reference (format "!!:s/%s/%s/"
- (match-string 1 reference)
- (match-string 2 reference))))
- ;; `!'
- ;; Start a history substitution, except when followed by a
- ;; space, tab, the end of the line, = or (.
- (if (not (string-match "^![^ \t\n=\(]" reference))
- reference
- (setq eshell-history-index nil)
- (let ((event (eshell-hist-parse-event-designator reference)))
- (unless event
- (error "Could not find history event `%s'" reference))
- (setq eshell-history-index (car event)
- reference (substring reference (cdr event))
- event (eshell-get-history eshell-history-index))
- (if (not (string-match "^[:^$*%]" reference))
- event
- (let ((word (eshell-hist-parse-word-designator
- event reference)))
- (unless word
- (error "Unable to honor word designator `%s'" reference))
- (unless (string-match "^[:^$*%][[$^*%0-9-]" reference)
- (setcdr word 0))
- (setq event (car word)
- reference (substring reference (cdr word)))
- (if (not (and (eshell-using-module 'eshell-pred)
- (string-match "^:" reference)))
- event
- (eshell-hist-parse-modifier event reference)))))))
-
-(defun eshell-hist-parse-event-designator (reference)
- "Parse a history event designator beginning in REFERENCE."
- (let* ((index (string-match eshell-hist-event-designator reference))
- (end (and index (match-end 0))))
- (unless index
- (error "Invalid history event designator `%s'" reference))
- (let* ((event (match-string 1 reference))
- (pos
- (cond
- ((string= event "!") (ring-length eshell-history-ring))
- ((string= event "#") (error "!# not yet implemented"))
- ((string-match "^-?[0-9]+$" event)
- (let ((num (string-to-number event)))
- (if (>= num 0)
- (- (ring-length eshell-history-ring) num)
- (1- (abs num)))))
- ((string-match "^\\(\\??\\)\\([^?]+\\)\\??$" event)
- (let ((pref (if (> (length (match-string 1 event)) 0)
- "" "^"))
- (str (match-string 2 event)))
- (save-match-data
- (eshell-previous-matching-input-string-position
- (concat pref (regexp-quote str)) 1))))
- (t
- (error "Failed to parse event designator `%s'" event)))))
- (and pos (cons pos end)))))
-
-(defun eshell-hist-parse-word-designator (hist reference)
- "Parse a history word designator beginning for HIST in REFERENCE."
- (let* ((index (string-match eshell-hist-word-designator reference))
- (end (and index (match-end 0))))
- (unless (memq (aref reference 0) '(?: ?^ ?$ ?* ?%))
- (error "Invalid history word designator `%s'" reference))
- (let ((nth (match-string 1 reference))
- (mth (match-string 2 reference))
- (here (point))
- textargs)
- (insert hist)
- (setq textargs (car (eshell-hist-parse-arguments nil here (point))))
- (delete-region here (point))
- (if (string= nth "*")
- (if mth
- (error "Invalid history word designator `%s'"
- reference)
- (setq nth 1 mth "-$")))
- (if (not mth)
- (if nth
- (setq mth nth)
- (setq nth 0 mth "$"))
- (if (string= mth "-")
- (setq mth (- (length textargs) 2))
- (if (string= mth "*")
- (setq mth "$")
- (if (not (and (> (length mth) 1)
- (eq (aref mth 0) ?-)))
- (error "Invalid history word designator `%s'"
- reference)
- (setq mth (substring mth 1))))))
- (unless (numberp nth)
- (setq nth (eshell-hist-word-reference nth)))
- (unless (numberp mth)
- (setq mth (eshell-hist-word-reference mth)))
- (cons (mapconcat 'identity (eshell-sublist textargs nth mth) "")
- end))))
-
-(defun eshell-hist-parse-modifier (hist reference)
- "Parse a history modifier beginning for HIST in REFERENCE."
- (let ((here (point)))
- (insert reference)
- (prog1
- (save-restriction
- (narrow-to-region here (point))
- (goto-char (point-min))
- (let ((modifiers (cdr (eshell-parse-modifiers))))
- (eshell-for mod modifiers
- (setq hist (funcall mod hist)))
- hist))
- (delete-region here (point)))))
-
-(defun eshell-get-next-from-history ()
- "After fetching a line from input history, this fetches the next.
-In other words, this recalls the input line after the line you
-recalled last. You can use this to repeat a sequence of input lines."
- (interactive)
- (if eshell-save-history-index
- (progn
- (setq eshell-history-index (1+ eshell-save-history-index))
- (eshell-next-input 1))
- (message "No previous history command")))
-
-(defun eshell-search-arg (arg)
- ;; First make sure there is a ring and that we are after the process
- ;; mark
- (if (and eshell-hist-move-to-end
- (< (point) eshell-last-output-end))
- (goto-char eshell-last-output-end))
- (cond ((or (null eshell-history-ring)
- (ring-empty-p eshell-history-ring))
- (error "Empty input ring"))
- ((zerop arg)
- ;; arg of zero resets search from beginning, and uses arg of
- ;; 1
- (setq eshell-history-index nil)
- 1)
- (t
- arg)))
-
-(defun eshell-search-start (arg)
- "Index to start a directional search, starting at `eshell-history-index'."
- (if eshell-history-index
- ;; If a search is running, offset by 1 in direction of arg
- (mod (+ eshell-history-index (if (> arg 0) 1 -1))
- (ring-length eshell-history-ring))
- ;; For a new search, start from beginning or end, as appropriate
- (if (>= arg 0)
- 0 ; First elt for forward search
- ;; Last elt for backward search
- (1- (ring-length eshell-history-ring)))))
-
-(defun eshell-previous-input-string (arg)
- "Return the string ARG places along the input ring.
-Moves relative to `eshell-history-index'."
- (eshell-get-history (if eshell-history-index
- (mod (+ arg eshell-history-index)
- (ring-length eshell-history-ring))
- arg)))
-
-(defun eshell-previous-input (arg)
- "Cycle backwards through input history."
- (interactive "*p")
- (eshell-previous-matching-input "." arg))
-
-(defun eshell-next-input (arg)
- "Cycle forwards through input history."
- (interactive "*p")
- (eshell-previous-input (- arg)))
-
-(defun eshell-previous-matching-input-string (regexp arg)
- "Return the string matching REGEXP ARG places along the input ring.
-Moves relative to `eshell-history-index'."
- (let* ((pos (eshell-previous-matching-input-string-position regexp arg)))
- (if pos (eshell-get-history pos))))
-
-(defun eshell-previous-matching-input-string-position
- (regexp arg &optional start)
- "Return the index matching REGEXP ARG places along the input ring.
-Moves relative to START, or `eshell-history-index'."
- (if (or (not (ring-p eshell-history-ring))
- (ring-empty-p eshell-history-ring))
- (error "No history"))
- (let* ((len (ring-length eshell-history-ring))
- (motion (if (> arg 0) 1 -1))
- (n (mod (- (or start (eshell-search-start arg)) motion) len))
- (tried-each-ring-item nil)
- (case-fold-search (eshell-under-windows-p))
- (prev nil))
- ;; Do the whole search as many times as the argument says.
- (while (and (/= arg 0) (not tried-each-ring-item))
- ;; Step once.
- (setq prev n
- n (mod (+ n motion) len))
- ;; If we haven't reached a match, step some more.
- (while (and (< n len) (not tried-each-ring-item)
- (not (string-match regexp (eshell-get-history n))))
- (setq n (mod (+ n motion) len)
- ;; If we have gone all the way around in this search.
- tried-each-ring-item (= n prev)))
- (setq arg (if (> arg 0) (1- arg) (1+ arg))))
- ;; Now that we know which ring element to use, if we found it,
- ;; return that.
- (if (string-match regexp (eshell-get-history n))
- n)))
-
-(defun eshell-previous-matching-input (regexp arg)
- "Search backwards through input history for match for REGEXP.
-\(Previous history elements are earlier commands.)
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
- (interactive (eshell-regexp-arg "Previous input matching (regexp): "))
- (setq arg (eshell-search-arg arg))
- (let ((pos (eshell-previous-matching-input-string-position regexp arg)))
- ;; Has a match been found?
- (if (null pos)
- (error "Not found")
- (setq eshell-history-index pos)
- (unless (minibuffer-window-active-p (selected-window))
- (message "History item: %d" (- (ring-length eshell-history-ring) pos)))
- ;; Can't use kill-region as it sets this-command
- (delete-region (save-excursion (eshell-bol) (point)) (point))
- (insert-and-inherit (eshell-get-history pos)))))
-
-(defun eshell-next-matching-input (regexp arg)
- "Search forwards through input history for match for REGEXP.
-\(Later history elements are more recent commands.)
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
- (interactive (eshell-regexp-arg "Next input matching (regexp): "))
- (eshell-previous-matching-input regexp (- arg)))
-
-(defun eshell-previous-matching-input-from-input (arg)
- "Search backwards through input history for match for current input.
-\(Previous history elements are earlier commands.)
-With prefix argument N, search for Nth previous match.
-If N is negative, search forwards for the -Nth following match."
- (interactive "p")
- (if (not (memq last-command '(eshell-previous-matching-input-from-input
- eshell-next-matching-input-from-input)))
- ;; Starting a new search
- (setq eshell-matching-input-from-input-string
- (buffer-substring (save-excursion (eshell-bol) (point))
- (point))
- eshell-history-index nil))
- (eshell-previous-matching-input
- (concat "^" (regexp-quote eshell-matching-input-from-input-string))
- arg))
-
-(defun eshell-next-matching-input-from-input (arg)
- "Search forwards through input history for match for current input.
-\(Following history elements are more recent commands.)
-With prefix argument N, search for Nth following match.
-If N is negative, search backwards for the -Nth previous match."
- (interactive "p")
- (eshell-previous-matching-input-from-input (- arg)))
-
-(defun eshell-test-imatch ()
- "If isearch match good, put point at the beginning and return non-nil."
- (if (get-text-property (point) 'history)
- (progn (beginning-of-line) t)
- (let ((before (point)))
- (eshell-bol)
- (if (and (not (bolp))
- (<= (point) before))
- t
- (if isearch-forward
- (progn
- (end-of-line)
- (forward-char))
- (beginning-of-line)
- (backward-char))))))
-
-(defun eshell-return-to-prompt ()
- "Once a search string matches, insert it at the end and go there."
- (setq isearch-other-end nil)
- (let ((found (eshell-test-imatch)) before)
- (while (and (not found)
- (setq before
- (funcall (if isearch-forward
- 're-search-forward
- 're-search-backward)
- isearch-string nil t)))
- (setq found (eshell-test-imatch)))
- (if (not found)
- (progn
- (goto-char eshell-last-output-end)
- (delete-region (point) (point-max)))
- (setq before (point))
- (let ((text (buffer-substring-no-properties
- (point) (line-end-position)))
- (orig (marker-position eshell-last-output-end)))
- (goto-char eshell-last-output-end)
- (delete-region (point) (point-max))
- (when (and text (> (length text) 0))
- (insert text)
- (put-text-property (1- (point)) (point)
- 'last-search-pos before)
- (set-marker eshell-last-output-end orig)
- (goto-char eshell-last-output-end))))))
-
-(defun eshell-prepare-for-search ()
- "Make sure the old history file is at the beginning of the buffer."
- (unless (get-text-property (point-min) 'history)
- (save-excursion
- (goto-char (point-min))
- (let ((end (copy-marker (point) t)))
- (insert-file-contents eshell-history-file-name)
- (set-text-properties (point-min) end
- '(history t invisible t))))))
-
-(defun eshell-isearch-backward (&optional invert)
- "Do incremental regexp search backward through past commands."
- (interactive)
- (let ((inhibit-read-only t) end)
- (eshell-prepare-for-search)
- (goto-char (point-max))
- (set-marker eshell-last-output-end (point))
- (delete-region (point) (point-max)))
- (isearch-mode invert t 'eshell-return-to-prompt))
-
-(defun eshell-isearch-repeat-backward (&optional invert)
- "Do incremental regexp search backward through past commands."
- (interactive)
- (let ((old-pos (get-text-property (1- (point-max))
- 'last-search-pos)))
- (when old-pos
- (goto-char old-pos)
- (if invert
- (end-of-line)
- (backward-char)))
- (setq isearch-forward invert)
- (isearch-search-and-update)))
-
-(defun eshell-isearch-forward ()
- "Do incremental regexp search backward through past commands."
- (interactive)
- (eshell-isearch-backward t))
-
-(defun eshell-isearch-repeat-forward ()
- "Do incremental regexp search backward through past commands."
- (interactive)
- (eshell-isearch-repeat-backward t))
-
-(defun eshell-isearch-cancel ()
- (interactive)
- (goto-char eshell-last-output-end)
- (delete-region (point) (point-max))
- (call-interactively 'isearch-cancel))
-
-(defun eshell-isearch-abort ()
- (interactive)
- (goto-char eshell-last-output-end)
- (delete-region (point) (point-max))
- (call-interactively 'isearch-abort))
-
-(defun eshell-isearch-delete-char ()
- (interactive)
- (save-excursion
- (isearch-delete-char)))
-
-(defun eshell-isearch-return ()
- (interactive)
- (isearch-done)
- (eshell-send-input))
-
-;;; em-hist.el ends here
+++ /dev/null
-;;; em-ls.el --- implementation of ls in Lisp
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-ls)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-ls nil
- "This module implements the \"ls\" utility fully in Lisp. If it is
-passed any unrecognized command switches, it will revert to the
-operating system's version. This version of \"ls\" uses text
-properties to colorize its output based on the setting of
-`eshell-ls-use-colors'."
- :tag "Implementation of `ls' in Lisp"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; Most of the command switches recognized by GNU's ls utility are
-;; supported ([(fileutils)ls invocation]).
-
-(require 'esh-util)
-(require 'esh-opt)
-
-;;; User Variables:
-
-(defvar eshell-ls-orig-insert-directory
- (symbol-function 'insert-directory)
- "Preserve the original definition of `insert-directory'.")
-
-(defcustom eshell-ls-unload-hook
- (list
- (function
- (lambda ()
- (fset 'insert-directory eshell-ls-orig-insert-directory))))
- "*When unloading `eshell-ls', restore the definition of `insert-directory'."
- :type 'hook
- :group 'eshell-ls)
-
-(defcustom eshell-ls-initial-args nil
- "*If non-nil, this list of args is included before any call to `ls'.
-This is useful for enabling human-readable format (-h), for example."
- :type '(repeat :tag "Arguments" string)
- :group 'eshell-ls)
-
-(defcustom eshell-ls-dired-initial-args nil
- "*If non-nil, args is included before any call to `ls' in dired.
-This is useful for enabling human-readable format (-h), for example."
- :type '(repeat :tag "Arguments" string)
- :group 'eshell-ls)
-
-(defcustom eshell-ls-use-in-dired nil
- "*If non-nil, use `eshell-ls' to read directories in dired."
- :set (lambda (symbol value)
- (if value
- (unless (and (boundp 'eshell-ls-use-in-dired)
- eshell-ls-use-in-dired)
- (fset 'insert-directory 'eshell-ls-insert-directory))
- (when (and (boundp 'eshell-ls-insert-directory)
- eshell-ls-use-in-dired)
- (fset 'insert-directory eshell-ls-orig-insert-directory)))
- (setq eshell-ls-use-in-dired value))
- :type 'boolean
- :require 'em-ls
- :group 'eshell-ls)
-
-(defcustom eshell-ls-default-blocksize 1024
- "*The default blocksize to use when display file sizes with -s."
- :type 'integer
- :group 'eshell-ls)
-
-(defcustom eshell-ls-exclude-regexp nil
- "*Unless -a is specified, files matching this regexp will not be shown."
- :type '(choice regexp (const nil))
- :group 'eshell-ls)
-
-(defcustom eshell-ls-exclude-hidden t
- "*Unless -a is specified, files beginning with . will not be shown.
-Using this boolean, instead of `eshell-ls-exclude-regexp', is both
-faster and conserves more memory."
- :type 'boolean
- :group 'eshell-ls)
-
-(defcustom eshell-ls-use-colors t
- "*If non-nil, use colors in file listings."
- :type 'boolean
- :group 'eshell-ls)
-
-(defface eshell-ls-directory-face
- '((((class color) (background light)) (:foreground "Blue" :weight bold))
- (((class color) (background dark)) (:foreground "SkyBlue" :weight bold))
- (t (:weight bold)))
- "*The face used for highlight directories."
- :group 'eshell-ls)
-
-(defface eshell-ls-symlink-face
- '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold))
- (((class color) (background dark)) (:foreground "Cyan" :weight bold)))
- "*The face used for highlight symbolic links."
- :group 'eshell-ls)
-
-(defface eshell-ls-executable-face
- '((((class color) (background light)) (:foreground "ForestGreen" :weight bold))
- (((class color) (background dark)) (:foreground "Green" :weight bold)))
- "*The face used for highlighting executables (not directories, though)."
- :group 'eshell-ls)
-
-(defface eshell-ls-readonly-face
- '((((class color) (background light)) (:foreground "Brown"))
- (((class color) (background dark)) (:foreground "Pink")))
- "*The face used for highlighting read-only files."
- :group 'eshell-ls)
-
-(defface eshell-ls-unreadable-face
- '((((class color) (background light)) (:foreground "Grey30"))
- (((class color) (background dark)) (:foreground "DarkGrey")))
- "*The face used for highlighting unreadable files."
- :group 'eshell-ls)
-
-(defface eshell-ls-special-face
- '((((class color) (background light)) (:foreground "Magenta" :weight bold))
- (((class color) (background dark)) (:foreground "Magenta" :weight bold)))
- "*The face used for highlighting non-regular files."
- :group 'eshell-ls)
-
-(defface eshell-ls-missing-face
- '((((class color) (background light)) (:foreground "Red" :weight bold))
- (((class color) (background dark)) (:foreground "Red" :weight bold)))
- "*The face used for highlighting non-existant file names."
- :group 'eshell-ls)
-
-(defcustom eshell-ls-archive-regexp
- (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|"
- "zip\\|[zZ]\\|gz\\|bz2\\|deb\\|rpm\\)\\'")
- "*A regular expression that matches names of file archives.
-This typically includes both traditional archives and compressed
-files."
- :type 'regexp
- :group 'eshell-ls)
-
-(defface eshell-ls-archive-face
- '((((class color) (background light)) (:foreground "Orchid" :weight bold))
- (((class color) (background dark)) (:foreground "Orchid" :weight bold)))
- "*The face used for highlighting archived and compressed file names."
- :group 'eshell-ls)
-
-(defcustom eshell-ls-backup-regexp
- "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)"
- "*A regular expression that matches names of backup files."
- :type 'regexp
- :group 'eshell-ls)
-
-(defface eshell-ls-backup-face
- '((((class color) (background light)) (:foreground "OrangeRed"))
- (((class color) (background dark)) (:foreground "LightSalmon")))
- "*The face used for highlighting backup file names."
- :group 'eshell-ls)
-
-(defcustom eshell-ls-product-regexp
- "\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'"
- "*A regular expression that matches names of product files.
-Products are files that get generated from a source file, and hence
-ought to be recreatable if they are deleted."
- :type 'regexp
- :group 'eshell-ls)
-
-(defface eshell-ls-product-face
- '((((class color) (background light)) (:foreground "OrangeRed"))
- (((class color) (background dark)) (:foreground "LightSalmon")))
- "*The face used for highlighting files that are build products."
- :group 'eshell-ls)
-
-(defcustom eshell-ls-clutter-regexp
- "\\(^texput\\.log\\|^core\\)\\'"
- "*A regular expression that matches names of junk files.
-These are mainly files that get created for various reasons, but don't
-really need to stick around for very long."
- :type 'regexp
- :group 'eshell-ls)
-
-(defface eshell-ls-clutter-face
- '((((class color) (background light)) (:foreground "OrangeRed" :weight bold))
- (((class color) (background dark)) (:foreground "OrangeRed" :weight bold)))
- "*The face used for highlighting junk file names."
- :group 'eshell-ls)
-
-(defsubst eshell-ls-filetype-p (attrs type)
- "Test whether ATTRS specifies a directory."
- (if (nth 8 attrs)
- (eq (aref (nth 8 attrs) 0) type)))
-
-(defmacro eshell-ls-applicable (attrs index func file)
- "Test whether, for ATTRS, the user UID can do what corresponds to INDEX.
-This is really just for efficiency, to avoid having to stat the file
-yet again."
- `(if (numberp (nth 2 ,attrs))
- (if (= (user-uid) (nth 2 ,attrs))
- (not (eq (aref (nth 8 ,attrs) ,index) ?-))
- (,(eval func) ,file))
- (not (eq (aref (nth 8 ,attrs)
- (+ ,index (if (member (nth 2 ,attrs)
- (eshell-current-ange-uids))
- 0 6)))
- ?-))))
-
-(defcustom eshell-ls-highlight-alist nil
- "*This alist correlates test functions to color.
-The format of the members of this alist is
-
- (TEST-SEXP . FACE)
-
-If TEST-SEXP evals to non-nil, that face will be used to highlight the
-name of the file. The first match wins. `file' and `attrs' are in
-scope during the evaluation of TEST-SEXP."
- :type '(repeat (cons function face))
- :group 'eshell-ls)
-
-;;; Functions:
-
-(defun eshell-ls-insert-directory
- (file switches &optional wildcard full-directory-p)
- "Insert directory listing for FILE, formatted according to SWITCHES.
-Leaves point after the inserted text.
-SWITCHES may be a string of options, or a list of strings.
-Optional third arg WILDCARD means treat FILE as shell wildcard.
-Optional fourth arg FULL-DIRECTORY-P means file is a directory and
-switches do not contain `d', so that a full listing is expected.
-
-This version of the function uses `eshell/ls'. If any of the switches
-passed are not recognized, the operating system's version will be used
-instead."
- (let ((handler (find-file-name-handler file 'insert-directory)))
- (if handler
- (funcall handler 'insert-directory file switches
- wildcard full-directory-p)
- (if (stringp switches)
- (setq switches (split-string switches)))
- (let (eshell-current-handles
- eshell-current-subjob-p)
- ;; use the fancy highlighting in `eshell-ls' rather than font-lock
- (when (and eshell-ls-use-colors
- (featurep 'font-lock))
- (font-lock-mode -1)
- (setq font-lock-defaults nil)
- (if (boundp 'font-lock-buffers)
- (set 'font-lock-buffers
- (delq (current-buffer)
- (symbol-value 'font-lock-buffers)))))
- (let ((insert-func 'insert)
- (error-func 'insert)
- (flush-func 'ignore)
- eshell-ls-dired-initial-args)
- (eshell-do-ls (append switches (list file))))))))
-
-(defsubst eshell/ls (&rest args)
- "An alias version of `eshell-do-ls'."
- (let ((insert-func 'eshell-buffered-print)
- (error-func 'eshell-error)
- (flush-func 'eshell-flush))
- (eshell-do-ls args)))
-
-(put 'eshell/ls 'eshell-no-numeric-conversions t)
-
-(eval-when-compile
- (defvar block-size)
- (defvar dereference-links)
- (defvar dir-literal)
- (defvar error-func)
- (defvar flush-func)
- (defvar human-readable)
- (defvar ignore-pattern)
- (defvar insert-func)
- (defvar listing-style)
- (defvar numeric-uid-gid)
- (defvar reverse-list)
- (defvar show-all)
- (defvar show-recursive)
- (defvar show-size)
- (defvar sort-method)
- (defvar ange-cache))
-
-(defun eshell-do-ls (&rest args)
- "Implementation of \"ls\" in Lisp, passing ARGS."
- (funcall flush-func -1)
- ;; process the command arguments, and begin listing files
- (eshell-eval-using-options
- "ls" (if eshell-ls-initial-args
- (list eshell-ls-initial-args args)
- args)
- `((?a "all" nil show-all
- "show all files in directory")
- (?c nil by-ctime sort-method
- "sort by modification time")
- (?d "directory" nil dir-literal
- "list directory entries instead of contents")
- (?k "kilobytes" 1024 block-size
- "using 1024 as the block size")
- (?h "human-readable" 1024 human-readable
- "print sizes in human readable format")
- (?H "si" 1000 human-readable
- "likewise, but use powers of 1000 not 1024")
- (?I "ignore" t ignore-pattern
- "do not list implied entries matching pattern")
- (?l nil long-listing listing-style
- "use a long listing format")
- (?n "numeric-uid-gid" nil numeric-uid-gid
- "list numeric UIDs and GIDs instead of names")
- (?r "reverse" nil reverse-list
- "reverse order while sorting")
- (?s "size" nil show-size
- "print size of each file, in blocks")
- (?t nil by-mtime sort-method
- "sort by modification time")
- (?u nil by-atime sort-method
- "sort by last access time")
- (?x nil by-lines listing-style
- "list entries by lines instead of by columns")
- (?C nil by-columns listing-style
- "list entries by columns")
- (?L "deference" nil dereference-links
- "list entries pointed to by symbolic links")
- (?R "recursive" nil show-recursive
- "list subdirectories recursively")
- (?S nil by-size sort-method
- "sort by file size")
- (?U nil unsorted sort-method
- "do not sort; list entries in directory order")
- (?X nil by-extension sort-method
- "sort alphabetically by entry extension")
- (?1 nil single-column listing-style
- "list one file per line")
- (nil "help" nil nil
- "show this usage display")
- :external "ls"
- :usage "[OPTION]... [FILE]...
-List information about the FILEs (the current directory by default).
-Sort entries alphabetically across.")
- ;; setup some defaults, based on what the user selected
- (unless block-size
- (setq block-size eshell-ls-default-blocksize))
- (unless listing-style
- (setq listing-style 'by-columns))
- (unless args
- (setq args (list ".")))
- (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp) ange-cache)
- (when ignore-pattern
- (unless (eshell-using-module 'eshell-glob)
- (error (concat "-I option requires that `eshell-glob'"
- " be a member of `eshell-modules-list'")))
- (set-text-properties 0 (length ignore-pattern) nil ignore-pattern)
- (setq eshell-ls-exclude-regexp
- (if eshell-ls-exclude-regexp
- (concat "\\(" eshell-ls-exclude-regexp "\\|"
- (eshell-glob-regexp ignore-pattern) "\\)")
- (eshell-glob-regexp ignore-pattern))))
- ;; list the files!
- (eshell-ls-entries
- (mapcar (function
- (lambda (arg)
- (cons (if (and (eshell-under-windows-p)
- (file-name-absolute-p arg))
- (expand-file-name arg)
- arg)
- (eshell-file-attributes arg))))
- args)
- t (expand-file-name default-directory)))
- (funcall flush-func)))
-
-(defsubst eshell-ls-printable-size (filesize &optional by-blocksize)
- "Return a printable FILESIZE."
- (eshell-printable-size filesize human-readable
- (and by-blocksize block-size)
- eshell-ls-use-colors))
-
-(defsubst eshell-ls-size-string (attrs size-width)
- "Return the size string for ATTRS length, using SIZE-WIDTH."
- (let* ((str (eshell-ls-printable-size (nth 7 attrs) t))
- (len (length str)))
- (if (< len size-width)
- (concat (make-string (- size-width len) ? ) str)
- str)))
-
-(defun eshell-ls-annotate (fileinfo)
- "Given a FILEINFO object, return a resolved, decorated FILEINFO.
-This means resolving any symbolic links, determining what face the
-name should be displayed as, etc. Think of it as cooking a FILEINFO."
- (if (not (and (stringp (cadr fileinfo))
- (or dereference-links
- (eq listing-style 'long-listing))))
- (setcar fileinfo (eshell-ls-decorated-name fileinfo))
- (let (dir attr)
- (unless (file-name-absolute-p (cadr fileinfo))
- (setq dir (file-truename
- (file-name-directory
- (expand-file-name (car fileinfo))))))
- (setq attr
- (eshell-file-attributes
- (let ((target (if dir
- (expand-file-name (cadr fileinfo) dir)
- (cadr fileinfo))))
- (if dereference-links
- (file-truename target)
- target))))
- (if (or dereference-links
- (string-match "^\\.\\.?$" (car fileinfo)))
- (progn
- (setcdr fileinfo attr)
- (setcar fileinfo (eshell-ls-decorated-name fileinfo)))
- (assert (eq listing-style 'long-listing))
- (setcar fileinfo
- (concat (eshell-ls-decorated-name fileinfo) " -> "
- (eshell-ls-decorated-name
- (cons (cadr fileinfo) attr)))))))
- fileinfo)
-
-(defun eshell-ls-file (fileinfo &optional size-width copy-fileinfo)
- "Output FILE in long format.
-FILE may be a string, or a cons cell whose car is the filename and
-whose cdr is the list of file attributes."
- (if (not (cdr fileinfo))
- (funcall error-func (format "%s: No such file or directory\n"
- (car fileinfo)))
- (setq fileinfo
- (eshell-ls-annotate (if copy-fileinfo
- (cons (car fileinfo)
- (cdr fileinfo))
- fileinfo)))
- (let ((file (car fileinfo))
- (attrs (cdr fileinfo)))
- (if (not (eq listing-style 'long-listing))
- (if show-size
- (funcall insert-func (eshell-ls-size-string attrs size-width)
- " " file "\n")
- (funcall insert-func file "\n"))
- (let ((line
- (concat
- (if show-size
- (concat (eshell-ls-size-string attrs size-width) " "))
- (format
- "%s%4d %-8s %-8s "
- (or (nth 8 attrs) "??????????")
- (or (nth 1 attrs) 0)
- (or (let ((user (nth 2 attrs)))
- (and (not numeric-uid-gid)
- user
- (eshell-substring
- (if (numberp user)
- (user-login-name user)
- user) 8)))
- (nth 2 attrs)
- "")
- (or (let ((group (nth 3 attrs)))
- (and (not numeric-uid-gid)
- group
- (eshell-substring
- (if (numberp group)
- (eshell-group-name group)
- group) 8)))
- (nth 3 attrs)
- ""))
- (let* ((str (eshell-ls-printable-size (nth 7 attrs)))
- (len (length str)))
- (if (< len 8)
- (concat (make-string (- 8 len) ? ) str)
- str))
- " " (format-time-string
- (concat
- "%b %e "
- (if (= (nth 5 (decode-time (current-time)))
- (nth 5 (decode-time
- (nth (cond
- ((eq sort-method 'by-atime) 4)
- ((eq sort-method 'by-ctime) 6)
- (t 5)) attrs))))
- "%H:%M"
- " %Y")) (nth (cond
- ((eq sort-method 'by-atime) 4)
- ((eq sort-method 'by-ctime) 6)
- (t 5)) attrs)) " ")))
- (funcall insert-func line file "\n"))))))
-
-(defun eshell-ls-dir (dirinfo &optional insert-name root-dir size-width)
- "Output the entries in DIRINFO.
-If INSERT-NAME is non-nil, the name of DIRINFO will be output. If
-ROOT-DIR is also non-nil, and a directory name, DIRINFO will be output
-relative to that directory."
- (let ((dir (car dirinfo)))
- (if (not (cdr dirinfo))
- (funcall error-func (format "%s: No such file or directory\n" dir))
- (if dir-literal
- (eshell-ls-file dirinfo size-width)
- (if insert-name
- (funcall insert-func
- (eshell-ls-decorated-name
- (cons (concat
- (if root-dir
- (file-relative-name dir root-dir)
- (expand-file-name dir)))
- (cdr dirinfo))) ":\n"))
- (let ((entries (eshell-directory-files-and-attributes
- dir nil (and (not show-all)
- eshell-ls-exclude-hidden
- "\\`[^.]") t)))
- (when (and (not show-all) eshell-ls-exclude-regexp)
- (while (and entries (string-match eshell-ls-exclude-regexp
- (caar entries)))
- (setq entries (cdr entries)))
- (let ((e entries))
- (while (cdr e)
- (if (string-match eshell-ls-exclude-regexp (car (cadr e)))
- (setcdr e (cddr e))
- (setq e (cdr e))))))
- (when (or (eq listing-style 'long-listing) show-size)
- (let ((total 0.0))
- (setq size-width 0)
- (eshell-for e entries
- (if (nth 7 (cdr e))
- (setq total (+ total (nth 7 (cdr e)))
- size-width
- (max size-width
- (length (eshell-ls-printable-size
- (nth 7 (cdr e)) t))))))
- (funcall insert-func "total "
- (eshell-ls-printable-size total t) "\n")))
- (let ((default-directory (expand-file-name dir)))
- (if show-recursive
- (eshell-ls-entries
- (let ((e entries) (good-entries (list t)))
- (while e
- (unless (let ((len (length (caar e))))
- (and (eq (aref (caar e) 0) ?.)
- (or (= len 1)
- (and (= len 2)
- (eq (aref (caar e) 1) ?.)))))
- (nconc good-entries (list (car e))))
- (setq e (cdr e)))
- (cdr good-entries))
- nil root-dir)
- (eshell-ls-files (eshell-ls-sort-entries entries)
- size-width))))))))
-
-(defsubst eshell-ls-compare-entries (l r inx func)
- "Compare the time of two files, L and R, the attribute indexed by INX."
- (let ((lt (nth inx (cdr l)))
- (rt (nth inx (cdr r))))
- (if (equal lt rt)
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r)))
- (funcall func rt lt))))
-
-(defun eshell-ls-sort-entries (entries)
- "Sort the given ENTRIES, which may be files, directories or both.
-In Eshell's implementation of ls, ENTRIES is always reversed."
- (if (eq sort-method 'unsorted)
- (nreverse entries)
- (sort entries
- (function
- (lambda (l r)
- (let ((result
- (cond
- ((eq sort-method 'by-atime)
- (eshell-ls-compare-entries l r 4 'eshell-time-less-p))
- ((eq sort-method 'by-mtime)
- (eshell-ls-compare-entries l r 5 'eshell-time-less-p))
- ((eq sort-method 'by-ctime)
- (eshell-ls-compare-entries l r 6 'eshell-time-less-p))
- ((eq sort-method 'by-size)
- (eshell-ls-compare-entries l r 7 '<))
- ((eq sort-method 'by-extension)
- (let ((lx (file-name-extension
- (directory-file-name (car l))))
- (rx (file-name-extension
- (directory-file-name (car r)))))
- (cond
- ((or (and (not lx) (not rx))
- (equal lx rx))
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r))))
- ((not lx) t)
- ((not rx) nil)
- (t
- (string-lessp lx rx)))))
- (t
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r)))))))
- (if reverse-list
- (not result)
- result)))))))
-
-(defun eshell-ls-files (files &optional size-width copy-fileinfo)
- "Output a list of FILES.
-Each member of FILES is either a string or a cons cell of the form
-\(FILE . ATTRS)."
- (if (memq listing-style '(long-listing single-column))
- (eshell-for file files
- (if file
- (eshell-ls-file file size-width copy-fileinfo)))
- (let ((f files)
- last-f
- display-files
- ignore)
- (while f
- (if (cdar f)
- (setq last-f f
- f (cdr f))
- (unless ignore
- (funcall error-func
- (format "%s: No such file or directory\n" (caar f))))
- (if (eq f files)
- (setq files (cdr files)
- f files)
- (if (not (cdr f))
- (progn
- (setcdr last-f nil)
- (setq f nil))
- (setcar f (cadr f))
- (setcdr f (cddr f))))))
- (if (not show-size)
- (setq display-files (mapcar 'eshell-ls-annotate files))
- (eshell-for file files
- (let* ((str (eshell-ls-printable-size (nth 7 (cdr file)) t))
- (len (length str)))
- (if (< len size-width)
- (setq str (concat (make-string (- size-width len) ? ) str)))
- (setq file (eshell-ls-annotate file)
- display-files (cons (cons (concat str " " (car file))
- (cdr file))
- display-files))))
- (setq display-files (nreverse display-files)))
- (let* ((col-vals
- (if (eq listing-style 'by-columns)
- (eshell-ls-find-column-lengths display-files)
- (assert (eq listing-style 'by-lines))
- (eshell-ls-find-column-widths display-files)))
- (col-widths (car col-vals))
- (display-files (cdr col-vals))
- (columns (length col-widths))
- (col-index 1)
- need-return)
- (eshell-for file display-files
- (let ((name
- (if (car file)
- (if show-size
- (concat (substring (car file) 0 size-width)
- (eshell-ls-decorated-name
- (cons (substring (car file) size-width)
- (cdr file))))
- (eshell-ls-decorated-name file))
- "")))
- (if (< col-index columns)
- (setq need-return
- (concat need-return name
- (make-string
- (max 0 (- (aref col-widths
- (1- col-index))
- (length name))) ? ))
- col-index (1+ col-index))
- (funcall insert-func need-return name "\n")
- (setq col-index 1 need-return nil))))
- (if need-return
- (funcall insert-func need-return "\n"))))))
-
-(defun eshell-ls-entries (entries &optional separate root-dir)
- "Output PATH's directory ENTRIES, formatted according to OPTIONS.
-Each member of ENTRIES may either be a string or a cons cell, the car
-of which is the file name, and the cdr of which is the list of
-attributes.
-If SEPARATE is non-nil, directories name will be entirely separated
-from the filenames. This is the normal behavior, except when doing a
-recursive listing.
-ROOT-DIR, if non-nil, specifies the root directory of the listing, to
-which non-absolute directory names will be made relative if ever they
-need to be printed."
- (let (dirs files show-names need-return (size-width 0))
- (eshell-for entry entries
- (if (and (not dir-literal)
- (or (eshell-ls-filetype-p (cdr entry) ?d)
- (and (eshell-ls-filetype-p (cdr entry) ?l)
- (file-directory-p (car entry)))))
- (progn
- (unless separate
- (setq files (cons entry files)
- size-width
- (if show-size
- (max size-width
- (length (eshell-ls-printable-size
- (nth 7 (cdr entry)) t))))))
- (setq dirs (cons entry dirs)))
- (setq files (cons entry files)
- size-width
- (if show-size
- (max size-width
- (length (eshell-ls-printable-size
- (nth 7 (cdr entry)) t)))))))
- (when files
- (eshell-ls-files (eshell-ls-sort-entries files)
- size-width show-recursive)
- (setq need-return t))
- (setq show-names (or show-recursive
- (> (+ (length files) (length dirs)) 1)))
- (eshell-for dir (eshell-ls-sort-entries dirs)
- (if (and need-return (not dir-literal))
- (funcall insert-func "\n"))
- (eshell-ls-dir dir show-names
- (unless (file-name-absolute-p (car dir)) root-dir)
- size-width)
- (setq need-return t))))
-
-(defun eshell-ls-find-column-widths (files)
- "Find the best fitting column widths for FILES.
-It will be returned as a vector, whose length is the number of columns
-to use, and each member of which is the width of that column
-\(including spacing)."
- (let* ((numcols 0)
- (width 0)
- (widths
- (mapcar
- (function
- (lambda (file)
- (+ 2 (length (car file)))))
- files))
- ;; must account for the added space...
- (max-width (+ (window-width) 2))
- (best-width 0)
- col-widths)
-
- ;; determine the largest number of columns in the first row
- (let ((w widths))
- (while (and w (< width max-width))
- (setq width (+ width (car w))
- numcols (1+ numcols)
- w (cdr w))))
-
- ;; refine it based on the following rows
- (while (> numcols 0)
- (let ((i 0)
- (colw (make-vector numcols 0))
- (w widths))
- (while w
- (if (= i numcols)
- (setq i 0))
- (aset colw i (max (aref colw i) (car w)))
- (setq w (cdr w) i (1+ i)))
- (setq i 0 width 0)
- (while (< i numcols)
- (setq width (+ width (aref colw i))
- i (1+ i)))
- (if (and (< width max-width)
- (> width best-width))
- (setq col-widths colw
- best-width width)))
- (setq numcols (1- numcols)))
-
- (cons (or col-widths (vector max-width)) files)))
-
-(defun eshell-ls-find-column-lengths (files)
- "Find the best fitting column lengths for FILES.
-It will be returned as a vector, whose length is the number of columns
-to use, and each member of which is the width of that column
-\(including spacing)."
- (let* ((numcols 1)
- (width 0)
- (widths
- (mapcar
- (function
- (lambda (file)
- (+ 2 (length (car file)))))
- files))
- (max-width (+ (window-width) 2))
- col-widths
- colw)
-
- ;; refine it based on the following rows
- (while numcols
- (let* ((rows (ceiling (/ (length widths)
- (float numcols))))
- (w widths)
- (len (* rows numcols))
- (index 0)
- (i 0))
- (setq width 0)
- (unless (or (= rows 0)
- (<= (/ (length widths) (float rows))
- (float (1- numcols))))
- (setq colw (make-vector numcols 0))
- (while (> len 0)
- (if (= i numcols)
- (setq i 0 index (1+ index)))
- (aset colw i
- (max (aref colw i)
- (or (nth (+ (* i rows) index) w) 0)))
- (setq len (1- len) i (1+ i)))
- (setq i 0)
- (while (< i numcols)
- (setq width (+ width (aref colw i))
- i (1+ i))))
- (if (>= width max-width)
- (setq numcols nil)
- (if colw
- (setq col-widths colw))
- (if (>= numcols (length widths))
- (setq numcols nil)
- (setq numcols (1+ numcols))))))
-
- (if (not col-widths)
- (cons (vector max-width) files)
- (setq numcols (length col-widths))
- (let* ((rows (ceiling (/ (length widths)
- (float numcols))))
- (len (* rows numcols))
- (newfiles (make-list len nil))
- (index 0)
- (i 0)
- (j 0))
- (while (< j len)
- (if (= i numcols)
- (setq i 0 index (1+ index)))
- (setcar (nthcdr j newfiles)
- (nth (+ (* i rows) index) files))
- (setq j (1+ j) i (1+ i)))
- (cons col-widths newfiles)))))
-
-(defun eshell-ls-decorated-name (file)
- "Return FILE, possibly decorated.
-Use TRUENAME for predicate tests, if passed."
- (if eshell-ls-use-colors
- (let ((face
- (cond
- ((not (cdr file))
- 'eshell-ls-missing-face)
-
- ((stringp (cadr file))
- 'eshell-ls-symlink-face)
-
- ((eq (cadr file) t)
- 'eshell-ls-directory-face)
-
- ((not (eshell-ls-filetype-p (cdr file) ?-))
- 'eshell-ls-special-face)
-
- ((and (/= (user-uid) 0) ; root can execute anything
- (eshell-ls-applicable (cdr file) 3
- 'file-executable-p (car file)))
- 'eshell-ls-executable-face)
-
- ((not (eshell-ls-applicable (cdr file) 1
- 'file-readable-p (car file)))
- 'eshell-ls-unreadable-face)
-
- ((string-match eshell-ls-archive-regexp (car file))
- 'eshell-ls-archive-face)
-
- ((string-match eshell-ls-backup-regexp (car file))
- 'eshell-ls-backup-face)
-
- ((string-match eshell-ls-product-regexp (car file))
- 'eshell-ls-product-face)
-
- ((string-match eshell-ls-clutter-regexp (car file))
- 'eshell-ls-clutter-face)
-
- ((not (eshell-ls-applicable (cdr file) 2
- 'file-writable-p (car file)))
- 'eshell-ls-readonly-face)
- (eshell-ls-highlight-alist
- (let ((tests eshell-ls-highlight-alist)
- value)
- (while tests
- (if (funcall (caar tests) (car file) (cdr file))
- (setq value (cdar tests) tests nil)
- (setq tests (cdr tests))))
- value)))))
- (if face
- (add-text-properties 0 (length (car file))
- (list 'face face)
- (car file)))))
- (car file))
-
-;;; Code:
-
-;;; em-ls.el ends here
+++ /dev/null
-;;; em-pred.el --- argument predicates and modifiers (ala zsh)
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-pred)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-pred nil
- "This module allows for predicates to be applied to globbing
-patterns (similar to zsh), in addition to string modifiers which can
-be applied either to globbing results, variable references, or just
-ordinary strings."
- :tag "Value modifiers and predicates"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; Argument predication is used to affect which members of a list are
-;; selected for use as argument. This is most useful with globbing,
-;; but can be used on any list argument, to select certain members.
-;;
-;; Argument modifiers are used to manipulate argument values. For
-;; example, sorting lists, upcasing words, substituting characters,
-;; etc.
-;;
-;; Here are some examples of how to use argument predication. Most of
-;; the predicates and modifiers are modeled after those provided by
-;; zsh.
-;;
-;; ls -ld *(/) ; list all directories
-;; ls -l *(@u'johnw') ; list all symlinks owned by 'johnw'
-;; bzip2 -9v **/*(a+30) ; compress everything which hasn't been
-;; accessed in 30 days
-;; echo *.c(:o:R) ; a reversed, sorted list of C files
-;; *(^@:U^u0) ; all non-symlinks not owned by 'root', upcased
-;; chmod u-x *(U*) : remove exec bit on all executables owned by user
-;;
-;; See the zsh docs for more on the syntax ([(zsh.info)Filename
-;; Generation]).
-
-;;; Code:
-
-;;; User Variables:
-
-(defcustom eshell-pred-load-hook '(eshell-pred-initialize)
- "*A list of functions to run when `eshell-pred' is loaded."
- :type 'hook
- :group 'eshell-pred)
-
-(defcustom eshell-predicate-alist
- '((?/ . (eshell-pred-file-type ?d)) ; directories
- (?. . (eshell-pred-file-type ?-)) ; regular files
- (?s . (eshell-pred-file-type ?s)) ; sockets
- (?p . (eshell-pred-file-type ?p)) ; named pipes
- (?@ . (eshell-pred-file-type ?l)) ; symbolic links
- (?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.)
- (?r . (eshell-pred-file-mode 0400)) ; owner-readable
- (?w . (eshell-pred-file-mode 0200)) ; owner-writable
- (?x . (eshell-pred-file-mode 0100)) ; owner-executable
- (?A . (eshell-pred-file-mode 0040)) ; group-readable
- (?I . (eshell-pred-file-mode 0020)) ; group-writable
- (?E . (eshell-pred-file-mode 0010)) ; group-executable
- (?R . (eshell-pred-file-mode 0004)) ; world-readable
- (?W . (eshell-pred-file-mode 0002)) ; world-writable
- (?X . (eshell-pred-file-mode 0001)) ; world-executable
- (?s . (eshell-pred-file-mode 4000)) ; setuid
- (?S . (eshell-pred-file-mode 2000)) ; setgid
- (?t . (eshell-pred-file-mode 1000)) ; sticky bit
- (?U . '(lambda (file) ; owned by effective uid
- (if (file-exists-p file)
- (= (nth 2 (file-attributes file)) (user-uid)))))
-;;; (?G . '(lambda (file) ; owned by effective gid
-;;; (if (file-exists-p file)
-;;; (= (nth 2 (file-attributes file)) (user-uid)))))
- (?* . '(lambda (file)
- (and (file-regular-p file)
- (not (file-symlink-p file))
- (file-executable-p file))))
- (?l . (eshell-pred-file-links))
- (?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id))
- (?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id))
- (?a . (eshell-pred-file-time ?a "access" 4))
- (?m . (eshell-pred-file-time ?m "modification" 5))
- (?c . (eshell-pred-file-time ?c "change" 6))
- (?L . (eshell-pred-file-size)))
- "*A list of predicates than can be applied to a globbing pattern.
-The format of each entry is
-
- (CHAR . PREDICATE-FUNC-SEXP)"
- :type '(repeat (cons character sexp))
- :group 'eshell-pred)
-
-(put 'eshell-predicate-alist 'risky-local-variable t)
-
-(defcustom eshell-modifier-alist
- '((?e . '(lambda (lst)
- (mapcar
- (function
- (lambda (str)
- (eshell-stringify
- (car (eshell-parse-argument str))))) lst)))
- (?L . '(lambda (lst)
- (mapcar 'downcase lst)))
- (?U . '(lambda (lst)
- (mapcar 'upcase lst)))
- (?C . '(lambda (lst)
- (mapcar 'capitalize lst)))
- (?h . '(lambda (lst)
- (mapcar 'file-name-directory lst)))
- (?i . (eshell-include-members))
- (?x . (eshell-include-members t))
- (?r . '(lambda (lst)
- (mapcar 'file-name-sans-extension lst)))
- (?e . '(lambda (lst)
- (mapcar 'file-name-extension lst)))
- (?t . '(lambda (lst)
- (mapcar 'file-name-nondirectory lst)))
- (?q . '(lambda (lst)
- (mapcar 'eshell-escape-arg lst)))
- (?u . '(lambda (lst)
- (eshell-uniqify-list lst)))
- (?o . '(lambda (lst)
- (sort lst 'string-lessp)))
- (?O . '(lambda (lst)
- (nreverse (sort lst 'string-lessp))))
- (?j . (eshell-join-members))
- (?S . (eshell-split-members))
- (?R . 'reverse)
- (?g . (progn
- (forward-char)
- (if (eq (char-before) ?s)
- (eshell-pred-substitute t)
- (error "`g' modifier cannot be used alone"))))
- (?s . (eshell-pred-substitute)))
- "*A list of modifiers than can be applied to an argument expansion.
-The format of each entry is
-
- (CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)"
- :type '(repeat (cons character sexp))
- :group 'eshell-pred)
-
-(put 'eshell-modifier-alist 'risky-local-variable t)
-
-(defvar eshell-predicate-help-string
- "Eshell predicate quick reference:
-
- - follow symbolic references for predicates after the `-'
- ^ invert sense of predicates after the `^'
-
-FILE TYPE:
- / directories s sockets
- . regular files p named pipes
- * executable (files only) @ symbolic links
-
- %x file type == `x' (as by ls -l; so `c' = char device, etc.)
-
-PERMISSION BITS (for owner/group/world):
- r/A/R readable s setuid
- w/I/W writable S setgid
- x/E/X executable t sticky bit
-
-OWNERSHIP:
- U owned by effective uid
- u(UID|'user') owned by UID/user
- g(GID|'group') owned by GID/group
-
-FILE ATTRIBUTES:
- l[+-]N +/-/= N links
- a[Mwhm][+-](N|'FILE') access time +/-/= N mnths/weeks/days/mins
- if FILE specified, use as comparison basis;
- so a+'file.c' shows files accessed before
- file.c was last accessed
- m[Mwhm][+-](N|'FILE') modification time...
- c[Mwhm][+-](N|'FILE') change time...
- L[kmp][+-]N file size +/-/= N Kb/Mb/blocks
-
-EXAMPLES:
- *(^@) all non-dot files which are not symlinks
- .#*(^@) all files which are not symbolic links
- **/.#*(*) all executable files, searched recursively
- ***/*~f*(-/) recursively (though not traversing symlinks),
- find all directories (or symlinks referring to
- directories) whose names do not begin with f.
- e*(*Lk+50) executables 50k or larger beginning with 'e'")
-
-(defvar eshell-modifier-help-string
- "Eshell modifier quick reference:
-
-FOR SINGLE ARGUMENTS, or each argument of a list of strings:
- e evaluate again
- L lowercase
- U uppercase
- C capitalize
- h dirname
- t basename
- e file extension
- r strip file extension
- q escape special characters
-
- S split string at any whitespace character
- S/PAT/ split string at each occurrence of PAT
-
-FOR LISTS OF ARGUMENTS:
- o sort alphabetically
- O reverse sort alphabetically
- u uniq list (typically used after :o or :O)
- R reverse list
-
- j join list members, separated by a space
- j/PAT/ join list members, separated by PAT
- i/PAT/ exclude all members not matching PAT
- x/PAT/ exclude all members matching PAT
-
- s/pat/match/ substitute PAT with MATCH
- g/pat/match/ substitute PAT with MATCH for all occurrences
-
-EXAMPLES:
- *.c(:o) sorted list of .c files")
-
-;;; Functions:
-
-(defun eshell-display-predicate-help ()
- (interactive)
- (with-electric-help
- (function
- (lambda ()
- (insert eshell-predicate-help-string)))))
-
-(defun eshell-display-modifier-help ()
- (interactive)
- (with-electric-help
- (function
- (lambda ()
- (insert eshell-modifier-help-string)))))
-
-(defun eshell-pred-initialize ()
- "Initialize the predicate/modifier code."
- (add-hook 'eshell-parse-argument-hook
- 'eshell-parse-arg-modifier t t)
- (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help)
- (define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help))
-
-(defun eshell-apply-modifiers (lst predicates modifiers)
- "Apply to LIST a series of PREDICATES and MODIFIERS."
- (let (stringified)
- (if (stringp lst)
- (setq lst (list lst)
- stringified t))
- (when (listp lst)
- (setq lst (eshell-winnow-list lst nil predicates))
- (while modifiers
- (setq lst (funcall (car modifiers) lst)
- modifiers (cdr modifiers)))
- (if (and stringified
- (= (length lst) 1))
- (car lst)
- lst))))
-
-(defun eshell-parse-arg-modifier ()
- "Parse a modifier that has been specified after an argument.
-This function is specially for adding onto `eshell-parse-argument-hook'."
- (when (eq (char-after) ?\()
- (forward-char)
- (let ((end (eshell-find-delimiter ?\( ?\))))
- (if (not end)
- (throw 'eshell-incomplete ?\()
- (when (eshell-arg-delimiter (1+ end))
- (save-restriction
- (narrow-to-region (point) end)
- (let* ((modifiers (eshell-parse-modifiers))
- (preds (car modifiers))
- (mods (cdr modifiers)))
- (if (or preds mods)
- ;; has to go at the end, which is only natural since
- ;; syntactically it can only occur at the end
- (setq eshell-current-modifiers
- (append
- eshell-current-modifiers
- (list
- `(lambda (lst)
- (eshell-apply-modifiers
- lst (quote ,preds) (quote ,mods)))))))))
- (goto-char (1+ end))
- (eshell-finish-arg))))))
-
-(defun eshell-parse-modifiers ()
- "Parse value modifiers and predicates at point.
-If ALLOW-PREDS is non-nil, predicates will be parsed as well.
-Return a cons cell of the form
-
- (PRED-FUNC-LIST . MOD-FUNC-LIST)
-
-NEW-STRING is STRING minus any modifiers. PRED-FUNC-LIST is a list of
-predicate functions. MOD-FUNC-LIST is a list of result modifier
-functions. PRED-FUNCS take a filename and return t if the test
-succeeds; MOD-FUNCS take any string and preform a modification,
-returning the resultant string."
- (let (result negate follow preds mods)
- (condition-case err
- (while (not (eobp))
- (let ((char (char-after)))
- (cond
- ((eq char ?')
- (forward-char)
- (if (looking-at "[^|':]")
- (let ((func (read (current-buffer))))
- (if (and func (functionp func))
- (setq preds (eshell-add-pred-func func preds
- negate follow))
- (error "Invalid function predicate '%s'"
- (eshell-stringify func))))
- (error "Invalid function predicate")))
- ((eq char ?^)
- (forward-char)
- (setq negate (not negate)))
- ((eq char ?-)
- (forward-char)
- (setq follow (not follow)))
- ((eq char ?|)
- (forward-char)
- (if (looking-at "[^|':]")
- (let ((func (read (current-buffer))))
- (if (and func (functionp func))
- (setq mods
- (cons `(lambda (lst)
- (mapcar (function ,func) lst))
- mods))
- (error "Invalid function modifier '%s'"
- (eshell-stringify func))))
- (error "Invalid function modifier")))
- ((eq char ?:)
- (forward-char)
- (let ((mod (assq (char-after) eshell-modifier-alist)))
- (if (not mod)
- (error "Unknown modifier character '%c'" (char-after))
- (forward-char)
- (setq mods (cons (eval (cdr mod)) mods)))))
- (t
- (let ((pred (assq char eshell-predicate-alist)))
- (if (not pred)
- (error "Unknown predicate character '%c'" char)
- (forward-char)
- (setq preds
- (eshell-add-pred-func (eval (cdr pred)) preds
- negate follow))))))))
- (end-of-buffer
- (error "Predicate or modifier ended prematurely")))
- (cons (nreverse preds) (nreverse mods))))
-
-(defun eshell-add-pred-func (pred funcs negate follow)
- "Add the predicate function PRED to FUNCS."
- (if negate
- (setq pred `(lambda (file)
- (not (funcall ,pred file)))))
- (if follow
- (setq pred `(lambda (file)
- (funcall ,pred (file-truename file)))))
- (cons pred funcs))
-
-(defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func)
- "Return a predicate to test whether a file match a given user/group id."
- (let (ugid open close end)
- (if (looking-at "[0-9]+")
- (progn
- (setq ugid (string-to-number (match-string 0)))
- (goto-char (match-end 0)))
- (setq open (char-after))
- (if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
- (setq close (car (last '(?\) ?\] ?\> ?\})
- (length close))))
- (setq close open))
- (forward-char)
- (setq end (eshell-find-delimiter open close))
- (unless end
- (error "Malformed %s name string for modifier `%c'"
- mod-type mod-char))
- (setq ugid
- (funcall get-id-func (buffer-substring (point) end)))
- (goto-char (1+ end)))
- (unless ugid
- (error "Unknown %s name specified for modifier `%c'"
- mod-type mod-char))
- `(lambda (file)
- (let ((attrs (file-attributes file)))
- (if attrs
- (= (nth ,attr-index attrs) ,ugid))))))
-
-(defun eshell-pred-file-time (mod-char mod-type attr-index)
- "Return a predicate to test whether a file matches a certain time."
- (let* ((quantum 86400)
- qual amount when open close end)
- (when (memq (char-after) '(?M ?w ?h ?m))
- (setq quantum (char-after))
- (cond
- ((eq quantum ?M)
- (setq quantum (* 60 60 24 30)))
- ((eq quantum ?w)
- (setq quantum (* 60 60 24 7)))
- ((eq quantum ?h)
- (setq quantum (* 60 60)))
- ((eq quantum ?m)
- (setq quantum 60))
- ((eq quantum ?s)
- (setq quantum 1)))
- (forward-char))
- (when (memq (char-after) '(?+ ?-))
- (setq qual (char-after))
- (forward-char))
- (if (looking-at "[0-9]+")
- (progn
- (setq when (- (eshell-time-to-seconds (current-time))
- (* (string-to-number (match-string 0))
- quantum)))
- (goto-char (match-end 0)))
- (setq open (char-after))
- (if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
- (setq close (car (last '(?\) ?\] ?\> ?\})
- (length close))))
- (setq close open))
- (forward-char)
- (setq end (eshell-find-delimiter open close))
- (unless end
- (error "Malformed %s time modifier `%c'" mod-type mod-char))
- (let* ((file (buffer-substring (point) end))
- (attrs (file-attributes file)))
- (unless attrs
- (error "Cannot stat file `%s'" file))
- (setq when (eshell-time-to-seconds (nth attr-index attrs))))
- (goto-char (1+ end)))
- `(lambda (file)
- (let ((attrs (file-attributes file)))
- (if attrs
- (,(if (eq qual ?-)
- '<
- (if (eq qual ?+)
- '>
- '=)) ,when (eshell-time-to-seconds
- (nth ,attr-index attrs))))))))
-
-(defun eshell-pred-file-type (type)
- "Return a test which tests that the file is of a certain TYPE.
-TYPE must be a character, and should be one of the possible options
-that 'ls -l' will show in the first column of its display. "
- (when (eq type ?%)
- (setq type (char-after))
- (if (memq type '(?b ?c))
- (forward-char)
- (setq type ?%)))
- `(lambda (file)
- (let ((attrs (eshell-file-attributes (directory-file-name file))))
- (if attrs
- (memq (aref (nth 8 attrs) 0)
- ,(if (eq type ?%)
- '(?b ?c)
- (list 'quote (list type))))))))
-
-(defsubst eshell-pred-file-mode (mode)
- "Return a test which tests that MODE pertains to the file."
- `(lambda (file)
- (let ((modes (file-modes file)))
- (if modes
- (logand ,mode modes)))))
-
-(defun eshell-pred-file-links ()
- "Return a predicate to test whether a file has a given number of links."
- (let (qual amount)
- (when (memq (char-after) '(?- ?+))
- (setq qual (char-after))
- (forward-char))
- (unless (looking-at "[0-9]+")
- (error "Invalid file link count modifier `l'"))
- (setq amount (string-to-number (match-string 0)))
- (goto-char (match-end 0))
- `(lambda (file)
- (let ((attrs (eshell-file-attributes file)))
- (if attrs
- (,(if (eq qual ?-)
- '<
- (if (eq qual ?+)
- '>
- '=)) (nth 1 attrs) ,amount))))))
-
-(defun eshell-pred-file-size ()
- "Return a predicate to test whether a file is of a given size."
- (let ((quantum 1) qual amount)
- (when (memq (downcase (char-after)) '(?k ?m ?p))
- (setq qual (downcase (char-after)))
- (cond
- ((eq qual ?k)
- (setq quantum 1024))
- ((eq qual ?m)
- (setq quantum (* 1024 1024)))
- ((eq qual ?p)
- (setq quantum 512)))
- (forward-char))
- (when (memq (char-after) '(?- ?+))
- (setq qual (char-after))
- (forward-char))
- (unless (looking-at "[0-9]+")
- (error "Invalid file size modifier `L'"))
- (setq amount (* (string-to-number (match-string 0)) quantum))
- (goto-char (match-end 0))
- `(lambda (file)
- (let ((attrs (eshell-file-attributes file)))
- (if attrs
- (,(if (eq qual ?-)
- '<
- (if (eq qual ?+)
- '>
- '=)) (nth 7 attrs) ,amount))))))
-
-(defun eshell-pred-substitute (&optional repeat)
- "Return a modifier function that will substitute matches."
- (let ((delim (char-after))
- match replace end)
- (forward-char)
- (setq end (eshell-find-delimiter delim delim nil nil t)
- match (buffer-substring-no-properties (point) end))
- (goto-char (1+ end))
- (setq end (eshell-find-delimiter delim delim nil nil t)
- replace (buffer-substring-no-properties (point) end))
- (goto-char (1+ end))
- (if repeat
- `(lambda (lst)
- (mapcar
- (function
- (lambda (str)
- (let ((i 0))
- (while (setq i (string-match ,match str i))
- (setq str (replace-match ,replace t nil str))))
- str)) lst))
- `(lambda (lst)
- (mapcar
- (function
- (lambda (str)
- (if (string-match ,match str)
- (setq str (replace-match ,replace t nil str)))
- str)) lst)))))
-
-(defun eshell-include-members (&optional invert-p)
- "Include only lisp members matching a regexp."
- (let ((delim (char-after))
- regexp end)
- (forward-char)
- (setq end (eshell-find-delimiter delim delim nil nil t)
- regexp (buffer-substring-no-properties (point) end))
- (goto-char (1+ end))
- `(lambda (lst)
- (eshell-winnow-list
- lst nil '((lambda (elem)
- ,(if invert-p
- `(not (string-match ,regexp elem))
- `(string-match ,regexp elem))))))))
-
-(defun eshell-join-members ()
- "Return a modifier function that join matches."
- (let ((delim (char-after))
- str end)
- (if (not (memq delim '(?' ?/)))
- (setq delim " ")
- (forward-char)
- (setq end (eshell-find-delimiter delim delim nil nil t)
- str (buffer-substring-no-properties (point) end))
- (goto-char (1+ end)))
- `(lambda (lst)
- (mapconcat 'identity lst ,str))))
-
-(defun eshell-split-members ()
- "Return a modifier function that splits members."
- (let ((delim (char-after))
- sep end)
- (when (memq delim '(?' ?/))
- (forward-char)
- (setq end (eshell-find-delimiter delim delim nil nil t)
- sep (buffer-substring-no-properties (point) end))
- (goto-char (1+ end)))
- `(lambda (lst)
- (mapcar
- (function
- (lambda (str)
- (split-string str ,sep))) lst))))
-
-;;; em-pred.el ends here
+++ /dev/null
-;;; em-prompt.el --- command prompts
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-prompt)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-prompt nil
- "This module provides command prompts, and navigation between them,
-as is common with most shells."
- :tag "Command prompts"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; Most of the prompt navigation commands of `comint-mode' are
-;; supported, such as C-c C-n, C-c C-p, etc.
-
-;;; User Variables:
-
-(defcustom eshell-prompt-load-hook '(eshell-prompt-initialize)
- "*A list of functions to call when loading `eshell-prompt'."
- :type 'hook
- :group 'eshell-prompt)
-
-(defcustom eshell-prompt-function
- (function
- (lambda ()
- (concat (eshell/pwd)
- (if (= (user-uid) 0) " # " " $ "))))
- "*A function that returns the Eshell prompt string.
-Make sure to update `eshell-prompt-regexp' so that it will match your
-prompt."
- :type 'function
- :group 'eshell-prompt)
-
-(defcustom eshell-prompt-regexp "^[^#$\n]* [#$] "
- "*A regexp which fully matches your eshell prompt.
-This setting is important, since it affects how eshell will interpret
-the lines that are passed to it.
-If this variable is changed, all Eshell buffers must be exited and
-re-entered for it to take effect."
- :type 'regexp
- :group 'eshell-prompt)
-
-(defcustom eshell-highlight-prompt t
- "*If non-nil, Eshell should highlight the prompt."
- :type 'boolean
- :group 'eshell-prompt)
-
-(defface eshell-prompt-face
- '((((class color) (background light)) (:foreground "Red" :bold t))
- (((class color) (background dark)) (:foreground "Pink" :bold t))
- (t (:bold t)))
- "*The face used to highlight prompt strings.
-For highlighting other kinds of strings -- similar to shell mode's
-behavior -- simply use an output filer which changes text properties."
- :group 'eshell-prompt)
-
-(defcustom eshell-before-prompt-hook nil
- "*A list of functions to call before outputting the prompt."
- :type 'hook
- :options '(eshell-begin-on-new-line)
- :group 'eshell-prompt)
-
-(defcustom eshell-after-prompt-hook nil
- "*A list of functions to call after outputting the prompt.
-Note that if `eshell-scroll-show-maximum-output' is non-nil, then
-setting `eshell-show-maximum-output' here won't do much. It depends
-on whether the user wants the resizing to happen while output is
-arriving, or after."
- :type 'hook
- :options '(eshell-show-maximum-output)
- :group 'eshell-prompt)
-
-;;; Functions:
-
-(defun eshell-prompt-initialize ()
- "Initialize the prompting code."
- (unless eshell-non-interactive-p
- (add-hook 'eshell-post-command-hook 'eshell-emit-prompt nil t)
-
- (make-local-variable 'eshell-prompt-regexp)
- (if eshell-prompt-regexp
- (set (make-local-variable 'paragraph-start) eshell-prompt-regexp))
-
- (set (make-local-variable 'eshell-skip-prompt-function)
- 'eshell-skip-prompt)
-
- (define-key eshell-command-map [(control ?n)] 'eshell-next-prompt)
- (define-key eshell-command-map [(control ?p)] 'eshell-previous-prompt)))
-
-(defun eshell-emit-prompt ()
- "Emit a prompt if eshell is being used interactively."
- (run-hooks 'eshell-before-prompt-hook)
- (if (not eshell-prompt-function)
- (set-marker eshell-last-output-end (point))
- (let ((prompt (funcall eshell-prompt-function)))
- (and eshell-highlight-prompt
- (add-text-properties 0 (length prompt)
- '(read-only t
- face eshell-prompt-face
- rear-nonsticky (face read-only))
- prompt))
- (eshell-interactive-print prompt)))
- (run-hooks 'eshell-after-prompt-hook))
-
-(defun eshell-backward-matching-input (regexp arg)
- "Search backward through buffer for match for REGEXP.
-Matches are searched for on lines that match `eshell-prompt-regexp'.
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
- (interactive (eshell-regexp-arg "Backward input matching (regexp): "))
- (let* ((re (concat eshell-prompt-regexp ".*" regexp))
- (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
- (if (re-search-backward re nil t arg)
- (point)))))
- (if (null pos)
- (progn (message "Not found")
- (ding))
- (goto-char pos)
- (eshell-bol))))
-
-(defun eshell-forward-matching-input (regexp arg)
- "Search forward through buffer for match for REGEXP.
-Matches are searched for on lines that match `eshell-prompt-regexp'.
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
- (interactive (eshell-regexp-arg "Forward input matching (regexp): "))
- (eshell-backward-matching-input regexp (- arg)))
-
-(defun eshell-next-prompt (n)
- "Move to end of Nth next prompt in the buffer.
-See `eshell-prompt-regexp'."
- (interactive "p")
- (forward-paragraph n)
- (eshell-skip-prompt))
-
-(defun eshell-previous-prompt (n)
- "Move to end of Nth previous prompt in the buffer.
-See `eshell-prompt-regexp'."
- (interactive "p")
- (eshell-next-prompt (- (1+ n))))
-
-(defun eshell-skip-prompt ()
- "Skip past the text matching regexp `eshell-prompt-regexp'.
-If this takes us past the end of the current line, don't skip at all."
- (let ((eol (line-end-position)))
- (if (and (looking-at eshell-prompt-regexp)
- (<= (match-end 0) eol))
- (goto-char (match-end 0)))))
-
-;;; Code:
-
-;;; em-prompt.el ends here
+++ /dev/null
-;;; em-rebind.el --- rebind keys when point is at current input
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-rebind)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-rebind nil
- "This module allows for special keybindings that only take effect
-while the point is in a region of input text. By default, it binds
-C-a to move to the beginning of the input text (rather than just the
-beginning of the line), and C-p and C-n to move through the input
-history, C-u kills the current input text, etc. It also, if
-`eshell-confine-point-to-input' is non-nil, does not allow certain
-commands to cause the point to leave the input area, such as
-`backward-word', `previous-line', etc. This module intends to mimic
-the behavior of normal shells while the user editing new input text."
- :tag "Rebind keys at input"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;;; User Variables:
-
-(defcustom eshell-rebind-load-hook '(eshell-rebind-initialize)
- "*A list of functions to call when loading `eshell-rebind'."
- :type 'hook
- :group 'eshell-rebind)
-
-(defcustom eshell-rebind-keys-alist
- '(([(control ?a)] . eshell-bol)
- ([home] . eshell-bol)
- ([(control ?d)] . eshell-delchar-or-maybe-eof)
- ([backspace] . eshell-delete-backward-char)
- ([delete] . eshell-delete-backward-char)
- ([(control ?w)] . backward-kill-word)
- ([(control ?u)] . eshell-kill-input))
- "*Bind some keys differently if point is in input text."
- :type '(repeat (cons (vector :tag "Keys to bind"
- (repeat :inline t sexp))
- (function :tag "Command")))
- :group 'eshell-rebind)
-
-(defcustom eshell-confine-point-to-input t
- "*If non-nil, do not allow the point to leave the current input.
-This is more difficult to do nicely in Emacs than one might think.
-Basically, the `point-left' attribute is added to the input text, and
-a function is placed on that hook to take the point back to
-`eshell-last-output-end' every time the user tries to move away. But
-since there are many cases in which the point _ought_ to move away
-\(for programmatic reasons), the variable
-`eshell-cannot-leave-input-list' defines commands which are affected
-from this rule. However, this list is by no means as complete as it
-probably should be, so basically all one can hope for is that other
-people will left the point alone in the Eshell buffer. Sigh."
- :type 'boolean
- :group 'eshell-rebind)
-
-(defcustom eshell-error-if-move-away t
- "*If non-nil, consider it an error to try to move outside current input.
-This is default behavior of shells like bash."
- :type 'boolean
- :group 'eshell-rebind)
-
-(defcustom eshell-remap-previous-input t
- "*If non-nil, remap input keybindings on previous prompts as well."
- :type 'boolean
- :group 'eshell-rebind)
-
-(defcustom eshell-cannot-leave-input-list
- '(beginning-of-line-text
- beginning-of-line
- move-to-column
- move-to-column-force
- move-to-left-margin
- move-to-tab-stop
- forward-char
- backward-char
- delete-char
- delete-backward-char
- backward-delete-char
- backward-delete-char-untabify
- kill-paragraph
- backward-kill-paragraph
- kill-sentence
- backward-kill-sentence
- kill-sexp
- backward-kill-sexp
- kill-word
- backward-kill-word
- kill-region
- forward-list
- backward-list
- forward-page
- backward-page
- forward-point
- forward-paragraph
- backward-paragraph
- backward-prefix-chars
- forward-sentence
- backward-sentence
- forward-sexp
- backward-sexp
- forward-to-indentation
- backward-to-indentation
- backward-up-list
- forward-word
- backward-word
- forward-line
- previous-line
- next-line
- forward-visible-line
- forward-comment
- forward-thing)
- "*A list of commands that cannot leave the input area."
- :type '(repeat function)
- :group 'eshell-rebind)
-
-;; Internal Variables:
-
-(defvar eshell-input-keymap)
-(defvar eshell-previous-point)
-(defvar eshell-lock-keymap)
-
-;;; Functions:
-
-(defun eshell-rebind-initialize ()
- "Initialize the inputing code."
- (unless eshell-non-interactive-p
- (add-hook 'eshell-mode-hook 'eshell-setup-input-keymap nil t)
- (make-local-variable 'eshell-previous-point)
- (add-hook 'pre-command-hook 'eshell-save-previous-point nil t)
- (make-local-variable 'overriding-local-map)
- (add-hook 'post-command-hook 'eshell-rebind-input-map nil t)
- (set (make-local-variable 'eshell-lock-keymap) nil)
- (define-key eshell-command-map [(meta ?l)] 'eshell-lock-local-map)))
-
-(defun eshell-lock-local-map (&optional arg)
- "Lock or unlock the current local keymap.
-Within a prefix arg, set the local keymap to its normal value, and
-lock it at that."
- (interactive "P")
- (if (or arg (not eshell-lock-keymap))
- (progn
- (use-local-map eshell-mode-map)
- (setq eshell-lock-keymap t)
- (message "Local keymap locked in normal mode"))
- (use-local-map eshell-input-keymap)
- (setq eshell-lock-keymap nil)
- (message "Local keymap unlocked: obey context")))
-
-(defun eshell-save-previous-point ()
- "Save the location of point before the next command is run."
- (setq eshell-previous-point (point)))
-
-(defsubst eshell-point-within-input-p (pos)
- "Test whether POS is within an input range."
- (let (begin)
- (or (and (>= pos eshell-last-output-end)
- eshell-last-output-end)
- (and eshell-remap-previous-input
- (setq begin
- (save-excursion
- (eshell-bol)
- (and (not (bolp)) (point))))
- (>= pos begin)
- (<= pos (line-end-position))
- begin))))
-
-(defun eshell-rebind-input-map ()
- "Rebind the input keymap based on the location of the cursor."
- (ignore-errors
- (unless eshell-lock-keymap
- (if (eshell-point-within-input-p (point))
- (use-local-map eshell-input-keymap)
- (let (begin)
- (if (and eshell-confine-point-to-input
- (setq begin
- (eshell-point-within-input-p eshell-previous-point))
- (memq this-command eshell-cannot-leave-input-list))
- (progn
- (use-local-map eshell-input-keymap)
- (goto-char begin)
- (if (and eshell-error-if-move-away
- (not (eq this-command 'kill-region)))
- (beep)))
- (use-local-map eshell-mode-map)))))))
-
-(defun eshell-setup-input-keymap ()
- "Setup the input keymap to be used during input editing."
- (make-local-variable 'eshell-input-keymap)
- (setq eshell-input-keymap (make-sparse-keymap))
- (set-keymap-parent eshell-input-keymap eshell-mode-map)
- (let ((bindings eshell-rebind-keys-alist))
- (while bindings
- (define-key eshell-input-keymap (caar bindings)
- (cdar bindings))
- (setq bindings (cdr bindings)))))
-
-(defun eshell-delete-backward-char (n &optional killflag)
- "Delete the last character, unless it's part of the output."
- (interactive "P")
- (let ((count (prefix-numeric-value n)))
- (if (eshell-point-within-input-p (- (point) count))
- (delete-backward-char count n)
- (beep))))
-
-(defun eshell-delchar-or-maybe-eof (arg)
- "Delete ARG characters forward or send an EOF to subprocess.
-Sends an EOF only if point is at the end of the buffer and there is no
-input."
- (interactive "p")
- (let ((proc (eshell-interactive-process)))
- (if (eobp)
- (cond
- ((/= (point) eshell-last-output-end)
- (beep))
- (proc
- (process-send-eof))
- (t
- (eshell-life-is-too-much)))
- (eshell-delete-backward-char (- arg)))))
-
-;;; Code:
-
-;;; em-rebind.el ends here
+++ /dev/null
-;;; em-script.el --- Eshell script files
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-script)
-
-(eval-when-compile (require 'esh-maint))
-
-(require 'eshell)
-
-(defgroup eshell-script nil
- "This module allows for the execution of files containing Eshell
-commands, as a script file."
- :tag "Running script files."
- :group 'eshell-module)
-
-;;; Commentary:
-
-;;; User Variables:
-
-(defcustom eshell-script-load-hook '(eshell-script-initialize)
- "*A list of functions to call when loading `eshell-script'."
- :type 'hook
- :group 'eshell-script)
-
-(defcustom eshell-login-script (concat eshell-directory-name "login")
- "*If non-nil, a file to invoke when starting up Eshell interactively.
-This file should be a file containing Eshell commands, where comment
-lines begin with '#'."
- :type 'file
- :group 'eshell-script)
-
-(defcustom eshell-rc-script (concat eshell-directory-name "profile")
- "*If non-nil, a file to invoke whenever Eshell is started.
-This includes when running `eshell-command'."
- :type 'file
- :group 'eshell-script)
-
-;;; Functions:
-
-(defun eshell-script-initialize ()
- "Initialize the script parsing code."
- (make-local-variable 'eshell-interpreter-alist)
- (setq eshell-interpreter-alist
- (cons '((lambda (file)
- (string= (file-name-nondirectory file)
- "eshell")) . eshell/source)
- eshell-interpreter-alist))
- (make-local-variable 'eshell-complex-commands)
- (setq eshell-complex-commands
- (append '("source" ".") eshell-complex-commands))
- ;; these two variables are changed through usage, but we don't want
- ;; to ruin it for other modules
- (let (eshell-inside-quote-regexp
- eshell-outside-quote-regexp)
- (and (not eshell-non-interactive-p)
- eshell-login-script
- (file-readable-p eshell-login-script)
- (eshell-do-eval
- (list 'eshell-commands
- (catch 'eshell-replace-command
- (eshell-source-file eshell-login-script))) t))
- (and eshell-rc-script
- (file-readable-p eshell-rc-script)
- (eshell-do-eval
- (list 'eshell-commands
- (catch 'eshell-replace-command
- (eshell-source-file eshell-rc-script))) t))))
-
-(defun eshell-source-file (file &optional args subcommand-p)
- "Execute a series of Eshell commands in FILE, passing ARGS.
-Comments begin with '#'."
- (interactive "f")
- (let ((orig (point))
- (here (point-max))
- (inhibit-point-motion-hooks t)
- after-change-functions)
- (goto-char (point-max))
- (insert-file-contents file)
- (goto-char (point-max))
- (throw 'eshell-replace-command
- (prog1
- (list 'let
- (list (list 'eshell-command-name (list 'quote file))
- (list 'eshell-command-arguments
- (list 'quote args)))
- (let ((cmd (eshell-parse-command (cons here (point)))))
- (if subcommand-p
- (setq cmd (list 'eshell-as-subcommand cmd)))
- cmd))
- (delete-region here (point))
- (goto-char orig)))))
-
-(defun eshell/source (&rest args)
- "Source a file in a subshell environment."
- (eshell-eval-using-options
- "source" args
- '((?h "help" nil nil "show this usage screen")
- :show-usage
- :usage "FILE [ARGS]
-Invoke the Eshell commands in FILE in a subshell, binding ARGS to $1,
-$2, etc.")
- (eshell-source-file (car args) (cdr args) t)))
-
-(put 'eshell/source 'eshell-no-numeric-conversions t)
-
-(defun eshell/. (&rest args)
- "Source a file in the current environment."
- (eshell-eval-using-options
- "." args
- '((?h "help" nil nil "show this usage screen")
- :show-usage
- :usage "FILE [ARGS]
-Invoke the Eshell commands in FILE within the current shell
-environment, binding ARGS to $1, $2, etc.")
- (eshell-source-file (car args) (cdr args))))
-
-(put 'eshell/. 'eshell-no-numeric-conversions t)
-
-;;; Code:
-
-;;; em-script.el ends here
+++ /dev/null
-;;; em-smart.el --- smart display of output
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-smart)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-smart nil
- "This module combines the facility of normal, modern shells with
-some of the edit/review concepts inherent in the design of Plan 9's
-9term. See the docs for more details.
-
-Most likely you will have to turn this option on and play around with
-it to get a real sense of how it works."
- :tag "Smart display of output"
- :link '(info-link "(eshell)Smart display of output")
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; The best way to get a sense of what this code is trying to do is by
-;; using it. Basically, the philosophy represents a blend between the
-;; ease of use of modern day shells, and the review-before-you-proceed
-;; mentality of Plan 9's 9term.
-;;
-;; @ When you invoke a command, it is assumed that you want to read
-;; the output of that command.
-;;
-;; @ If the output is not what you wanted, it is assumed that you will
-;; want to edit, and then resubmit a refined version of that
-;; command.
-;;
-;; @ If the output is valid, pressing any self-inserting character key
-;; will jump to end of the buffer and insert that character, in
-;; order to begin entry of a new command.
-;;
-;; @ If you show an intention to edit the previous command -- by
-;; moving around within it -- then the next self-inserting
-;; characters will insert *there*, instead of at the bottom of the
-;; buffer.
-;;
-;; @ If you show an intention to review old commands, such as M-p or
-;; M-r, point will jump to the bottom of the buffer before invoking
-;; that command.
-;;
-;; @ If none of the above has happened yet (i.e., your point is just
-;; sitting on the previous command), you can use SPACE and BACKSPACE
-;; (or DELETE) to page forward and backward *through the output of
-;; the last command only*. It will constrain the movement of the
-;; point and window so that the maximum amount of output is always
-;; displayed at all times.
-;;
-;; @ While output is being generated from a command, the window will
-;; be constantly reconfigured (until it would otherwise make no
-;; difference) in order to always show you the most output from the
-;; command possible. This happens if you change window sizes,
-;; scroll, etc.
-;;
-;; @ Like I said, it's not really comprehensible until you try it! ;)
-;;
-;; One disadvantage of this module is that it increases Eshell's
-;; memory consumption by a factor of two or more. With small commands
-;; (such as pwd), where the screen is mostly full, consumption can
-;; increase by orders of magnitude.
-
-;;; User Variables:
-
-(defcustom eshell-smart-load-hook '(eshell-smart-initialize)
- "*A list of functions to call when loading `eshell-smart'."
- :type 'hook
- :group 'eshell-smart)
-
-(defcustom eshell-smart-unload-hook
- (list
- (function
- (lambda ()
- (remove-hook 'window-configuration-change-hook
- 'eshell-refresh-windows))))
- "*A hook that gets run when `eshell-smart' is unloaded."
- :type 'hook
- :group 'eshell-smart)
-
-(defcustom eshell-review-quick-commands nil
- "*If t, always review commands.
-Reviewing means keeping point on the text of the command that was just
-invoked, to allow corrections to be made easily.
-
-If set to nil, quick commands won't be reviewed. A quick command is a
-command that produces no output, and exits successfully.
-
-If set to `not-even-short-output', then the definition of \"quick
-command\" is extended to include commands that produce output, iff
-that output can be presented in its entirely in the Eshell window."
- :type '(choice (const :tag "No" nil)
- (const :tag "Yes" t)
- (const :tag "Not even short output"
- not-even-short-output))
- :group 'eshell-smart)
-
-(defcustom eshell-smart-display-navigate-list
- '(insert-parentheses
- mouse-yank-at-click
- mouse-yank-secondary
- yank-pop
- yank-rectangle
- yank)
- "*A list of commands which cause Eshell to jump to the end of buffer."
- :type '(repeat function)
- :group 'eshell-smart)
-
-(defcustom eshell-smart-space-goes-to-end t
- "*If non-nil, space will go to end of buffer when point-max is visible.
-That is, if a command is running and the user presses SPACE at a time
-when the end of the buffer is visible, point will go to the end of the
-buffer and smart-display will be turned off (that is, subsequently
-pressing backspace will not cause the buffer to scroll down).
-
-This feature is provided to make it very easy to watch the output of a
-long-running command, such as make, where it's more desirable to see
-the output go by than to review it afterward.
-
-Setting this variable to nil means that space and backspace will
-always have a consistent behavior, which is to move back and forth
-through displayed output. But it also means that enabling output
-tracking requires the user to manually move point to the end of the
-buffer using \\[end-of-buffer]."
- :type 'boolean
- :group 'eshell-smart)
-
-(defcustom eshell-where-to-jump 'begin
- "*This variable indicates where point should jump to after a command.
-The options are `begin', `after' or `end'."
- :type '(radio (const :tag "Beginning of command" begin)
- (const :tag "After command word" after)
- (const :tag "End of command" end))
- :group 'eshell-smart)
-
-;;; Internal Variables:
-
-(defvar eshell-smart-displayed nil)
-(defvar eshell-smart-command-done nil)
-(defvar eshell-currently-handling-window nil)
-
-;;; Functions:
-
-(defun eshell-smart-initialize ()
- "Setup Eshell smart display."
- (unless eshell-non-interactive-p
- ;; override a few variables, since they would interfere with the
- ;; smart display functionality.
- (set (make-local-variable 'eshell-scroll-to-bottom-on-output) nil)
- (set (make-local-variable 'eshell-scroll-to-bottom-on-input) nil)
- (set (make-local-variable 'eshell-scroll-show-maximum-output) t)
-
- (add-hook 'window-scroll-functions 'eshell-smart-scroll-window nil t)
- (add-hook 'window-configuration-change-hook 'eshell-refresh-windows)
-
- (add-hook 'eshell-output-filter-functions 'eshell-refresh-windows t t)
-
- (add-hook 'after-change-functions 'eshell-disable-after-change nil t)
-
- (add-hook 'eshell-input-filter-functions 'eshell-smart-display-setup nil t)
-
- (make-local-variable 'eshell-smart-command-done)
- (add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-smart-command-done t))) t t)
-
- (unless (eq eshell-review-quick-commands t)
- (add-hook 'eshell-post-command-hook
- 'eshell-smart-maybe-jump-to-end nil t))))
-
-(defun eshell-smart-scroll-window (wind start)
- "Scroll the given Eshell window accordingly."
- (unless eshell-currently-handling-window
- (let ((inhibit-point-motion-hooks t)
- (eshell-currently-handling-window t))
- (save-selected-window
- (select-window wind)
- (eshell-smart-redisplay)))))
-
-(defun eshell-refresh-windows (&optional frame)
- "Refresh all visible Eshell buffers."
- (let (affected)
- (walk-windows
- (function
- (lambda (wind)
- (with-current-buffer (window-buffer wind)
- (if eshell-mode
- (let (window-scroll-functions)
- (eshell-smart-scroll-window wind (window-start))
- (setq affected t))))))
- 0 frame)
- (if affected
- (let (window-scroll-functions)
- (eshell-redisplay)))))
-
-(defun eshell-smart-display-setup ()
- "Set the point to somewhere in the beginning of the last command."
- (cond
- ((eq eshell-where-to-jump 'begin)
- (goto-char eshell-last-input-start))
- ((eq eshell-where-to-jump 'after)
- (goto-char (next-single-property-change
- eshell-last-input-start 'arg-end))
- (if (= (point) (- eshell-last-input-end 2))
- (forward-char)))
- ((eq eshell-where-to-jump 'end)
- (goto-char (1- eshell-last-input-end)))
- (t
- (error "Invalid value for `eshell-where-to-jump'")))
- (setq eshell-smart-command-done nil)
- (add-hook 'pre-command-hook 'eshell-smart-display-move nil t)
- (eshell-refresh-windows))
-
-(defun eshell-disable-after-change (b e l)
- "Disable smart display mode if the buffer changes in any way."
- (when eshell-smart-command-done
- (remove-hook 'pre-command-hook 'eshell-smart-display-move t)
- (setq eshell-smart-command-done nil)))
-
-(defun eshell-smart-maybe-jump-to-end ()
- "Jump to the end of the input buffer.
-This is done whenever a command exits sucessfully and both the command
-and the end of the buffer are still visible."
- (when (and (= eshell-last-command-status 0)
- (if (eq eshell-review-quick-commands 'not-even-short-output)
- (and (pos-visible-in-window-p (point-max))
- (pos-visible-in-window-p eshell-last-input-start))
- (= (count-lines eshell-last-input-end
- eshell-last-output-end) 0)))
- (goto-char (point-max))
- (remove-hook 'pre-command-hook 'eshell-smart-display-move t)))
-
-(defun eshell-smart-redisplay ()
- "Display as much output as possible, smartly."
- (if (eobp)
- (save-excursion
- (recenter -1)
- ;; trigger the redisplay now, so that we catch any attempted
- ;; point motion; this is to cover for a redisplay bug
- (eshell-redisplay))
- (let ((top-point (point)))
- (and (memq 'eshell-smart-display-move pre-command-hook)
- (>= (point) eshell-last-input-start)
- (< (point) eshell-last-input-end)
- (set-window-start (selected-window)
- (line-beginning-position) t))
- (if (pos-visible-in-window-p (point-max))
- (save-excursion
- (goto-char (point-max))
- (recenter -1)
- (unless (pos-visible-in-window-p top-point)
- (goto-char top-point)
- (set-window-start (selected-window)
- (line-beginning-position) t)))))))
-
-(defun eshell-smart-goto-end ()
- "Like `end-of-buffer', but do not push a mark."
- (interactive)
- (goto-char (point-max)))
-
-(defun eshell-smart-display-move ()
- "Handle self-inserting or movement commands intelligently."
- (let (clear)
- (if (or current-prefix-arg
- (and (> (point) eshell-last-input-start)
- (< (point) eshell-last-input-end))
- (>= (point) eshell-last-output-end))
- (setq clear t)
- (cond
- ((eq this-command 'self-insert-command)
- (if (eq last-command-char ? )
- (if (and eshell-smart-space-goes-to-end
- eshell-current-command)
- (if (not (pos-visible-in-window-p (point-max)))
- (setq this-command 'scroll-up)
- (setq this-command 'eshell-smart-goto-end))
- (setq this-command 'scroll-up))
- (setq clear t)
- (goto-char (point-max))))
- ((eq this-command 'delete-backward-char)
- (setq this-command 'ignore)
- (if (< (point) eshell-last-input-start)
- (eshell-show-output)
- (if (pos-visible-in-window-p eshell-last-input-start)
- (progn
- (ignore-errors
- (scroll-down))
- (eshell-show-output))
- (scroll-down)
- (if (pos-visible-in-window-p eshell-last-input-end)
- (eshell-show-output)))))
- ((or (memq this-command eshell-smart-display-navigate-list)
- (and (eq this-command 'eshell-send-input)
- (not (and (>= (point) eshell-last-input-start)
- (< (point) eshell-last-input-end)))))
- (setq clear t)
- (goto-char (point-max)))))
- (if clear
- (remove-hook 'pre-command-hook 'eshell-smart-display-move t))))
-
-;;; Code:
-
-;;; em-smart.el ends here
+++ /dev/null
-;;; em-term.el --- running visual commands
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-term)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-term nil
- "This module causes visual commands (e.g., 'vi') to be executed by
-the `term' package, which comes with Emacs. This package handles most
-of the ANSI control codes, allowing curses-based applications to run
-within an Emacs window. The variable `eshell-visual-commands' defines
-which commands are considered visual in nature."
- :tag "Running visual commands"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; At the moment, eshell is stream-based in its interactive input and
-;; output. This means that full-screen commands, such as "vi" or
-;; "lynx", will not display correctly. These are therefore thought of
-;; as "visual" programs. In order to run these progrem under Emacs,
-;; Eshell uses the term.el package, and invokes them in a separate
-;; buffer, giving the illusion that Eshell itself is allowing these
-;; visual processes to execute.
-
-(require 'term)
-
-;;; User Variables:
-
-(defcustom eshell-term-load-hook '(eshell-term-initialize)
- "*A list of functions to call when loading `eshell-term'."
- :type 'hook
- :group 'eshell-term)
-
-(defcustom eshell-visual-commands
- '("vi" ; what is going on??
- "screen" "top" ; ok, a valid program...
- "less" "more" ; M-x view-file
- "lynx" "ncftp" ; w3.el, ange-ftp
- "pine" "tin" "trn" "elm") ; GNUS!!
- "*A list of commands that present their output in a visual fashion."
- :type '(repeat string)
- :group 'eshell-term)
-
-(defcustom eshell-term-name "eterm"
- "*Name to use for the TERM variable when running visual commands.
-See `term-term-name' in term.el for more information on how this is
-used."
- :type 'string
- :group 'eshell-term)
-
-(defcustom eshell-escape-control-x t
- "*If non-nil, allow <C-x> to be handled by Emacs key in visual buffers.
-See the variable `eshell-visual-commands'. If this variable is set to
-nil, <C-x> will send that control character to the invoked process."
- :type 'boolean
- :group 'eshell-term)
-
-;;; Internal Variables:
-
-(defvar eshell-parent-buffer)
-
-;;; Functions:
-
-(defun eshell-term-initialize ()
- "Initialize the `term' interface code."
- (make-local-variable 'eshell-interpreter-alist)
- (setq eshell-interpreter-alist
- (cons (cons (function
- (lambda (command)
- (member (file-name-nondirectory command)
- eshell-visual-commands)))
- 'eshell-exec-visual)
- eshell-interpreter-alist)))
-
-(defun eshell-exec-visual (&rest args)
- "Run the specified PROGRAM in a terminal emulation buffer.
-ARGS are passed to the program. At the moment, no piping of input is
-allowed."
- (let* (eshell-interpreter-alist
- (interp (eshell-find-interpreter (car args)))
- (program (car interp))
- (args (eshell-flatten-list
- (eshell-stringify-list (append (cdr interp)
- (cdr args)))))
- (term-buf
- (generate-new-buffer
- (concat "*" (file-name-nondirectory program) "*")))
- (eshell-buf (current-buffer)))
- (save-current-buffer
- (switch-to-buffer term-buf)
- (term-mode)
- (set (make-local-variable 'term-term-name) eshell-term-name)
- (make-local-variable 'eshell-parent-buffer)
- (setq eshell-parent-buffer eshell-buf)
- (term-exec term-buf program program nil args)
- (let ((proc (get-buffer-process term-buf)))
- (if (and proc (eq 'run (process-status proc)))
- (set-process-sentinel proc 'eshell-term-sentinel)
- (error "Failed to invoke visual command")))
- (term-char-mode)
- (if eshell-escape-control-x
- (term-set-escape-char ?\C-x))))
- nil)
-
-(defun eshell-term-sentinel (proc string)
- "Destroy the buffer visiting PROC."
- (let ((proc-buf (process-buffer proc)))
- (when (and proc-buf (buffer-live-p proc-buf)
- (not (eq 'run (process-status proc)))
- (= (process-exit-status proc) 0))
- (if (eq (current-buffer) proc-buf)
- (let ((buf (and (boundp 'eshell-parent-buffer)
- eshell-parent-buffer
- (buffer-live-p eshell-parent-buffer)
- eshell-parent-buffer)))
- (if buf
- (switch-to-buffer buf))))
- (kill-buffer proc-buf))))
-
-;; jww (1999-09-17): The code below will allow Eshell to send input
-;; characters directly to the currently running interactive process.
-;; However, since this would introduce other problems that would need
-;; solutions, I'm going to let it wait until after 2.1.
-
-; (defvar eshell-term-raw-map nil
-; "Keyboard map for sending characters directly to the inferior process.")
-; (defvar eshell-term-escape-char nil
-; "Escape character for char-sub-mode of term mode.
-; Do not change it directly; use term-set-escape-char instead.")
-; (defvar eshell-term-raw-escape-map nil)
-
-; (defun eshell-term-send-raw-string (chars)
-; (goto-char eshell-last-output-end)
-; (process-send-string (eshell-interactive-process) chars))
-
-; (defun eshell-term-send-raw ()
-; "Send the last character typed through the terminal-emulator
-; without any interpretation."
-; (interactive)
-; ;; Convert `return' to C-m, etc.
-; (if (and (symbolp last-input-char)
-; (get last-input-char 'ascii-character))
-; (setq last-input-char (get last-input-char 'ascii-character)))
-; (eshell-term-send-raw-string (make-string 1 last-input-char)))
-
-; (defun eshell-term-send-raw-meta ()
-; (interactive)
-; (if (symbolp last-input-char)
-; ;; Convert `return' to C-m, etc.
-; (let ((tmp (get last-input-char 'event-symbol-elements)))
-; (if tmp
-; (setq last-input-char (car tmp)))
-; (if (symbolp last-input-char)
-; (progn
-; (setq tmp (get last-input-char 'ascii-character))
-; (if tmp (setq last-input-char tmp))))))
-; (eshell-term-send-raw-string (if (and (numberp last-input-char)
-; (> last-input-char 127)
-; (< last-input-char 256))
-; (make-string 1 last-input-char)
-; (format "\e%c" last-input-char))))
-
-; (defun eshell-term-mouse-paste (click arg)
-; "Insert the last stretch of killed text at the position clicked on."
-; (interactive "e\nP")
-; (if (boundp 'xemacs-logo)
-; (eshell-term-send-raw-string
-; (or (condition-case () (x-get-selection) (error ()))
-; (x-get-cutbuffer)
-; (error "No selection or cut buffer available")))
-; ;; Give temporary modes such as isearch a chance to turn off.
-; (run-hooks 'mouse-leave-buffer-hook)
-; (setq this-command 'yank)
-; (eshell-term-send-raw-string
-; (current-kill (cond ((listp arg) 0)
-; ((eq arg '-) -1)
-; (t (1- arg)))))))
-
-; ;; Which would be better: "\e[A" or "\eOA"? readline accepts either.
-; ;; For my configuration it's definitely better \eOA but YMMV. -mm
-; ;; For example: vi works with \eOA while elm wants \e[A ...
-; (defun eshell-term-send-up () (interactive) (eshell-term-send-raw-string "\eOA"))
-; (defun eshell-term-send-down () (interactive) (eshell-term-send-raw-string "\eOB"))
-; (defun eshell-term-send-right () (interactive) (eshell-term-send-raw-string "\eOC"))
-; (defun eshell-term-send-left () (interactive) (eshell-term-send-raw-string "\eOD"))
-; (defun eshell-term-send-home () (interactive) (eshell-term-send-raw-string "\e[1~"))
-; (defun eshell-term-send-end () (interactive) (eshell-term-send-raw-string "\e[4~"))
-; (defun eshell-term-send-prior () (interactive) (eshell-term-send-raw-string "\e[5~"))
-; (defun eshell-term-send-next () (interactive) (eshell-term-send-raw-string "\e[6~"))
-; (defun eshell-term-send-del () (interactive) (eshell-term-send-raw-string "\C-?"))
-; (defun eshell-term-send-backspace () (interactive) (eshell-term-send-raw-string "\C-H"))
-
-; (defun eshell-term-set-escape-char (c)
-; "Change term-escape-char and keymaps that depend on it."
-; (if eshell-term-escape-char
-; (define-key eshell-term-raw-map eshell-term-escape-char 'eshell-term-send-raw))
-; (setq c (make-string 1 c))
-; (define-key eshell-term-raw-map c eshell-term-raw-escape-map)
-; ;; Define standard bindings in eshell-term-raw-escape-map
-; (define-key eshell-term-raw-escape-map "\C-x"
-; (lookup-key (current-global-map) "\C-x"))
-; (define-key eshell-term-raw-escape-map "\C-v"
-; (lookup-key (current-global-map) "\C-v"))
-; (define-key eshell-term-raw-escape-map "\C-u"
-; (lookup-key (current-global-map) "\C-u"))
-; (define-key eshell-term-raw-escape-map c 'eshell-term-send-raw))
-
-; (defun eshell-term-char-mode ()
-; "Switch to char (\"raw\") sub-mode of term mode.
-; Each character you type is sent directly to the inferior without
-; intervention from Emacs, except for the escape character (usually C-c)."
-; (interactive)
-; (if (not eshell-term-raw-map)
-; (let* ((map (make-keymap))
-; (esc-map (make-keymap))
-; (i 0))
-; (while (< i 128)
-; (define-key map (make-string 1 i) 'eshell-term-send-raw)
-; (define-key esc-map (make-string 1 i) 'eshell-term-send-raw-meta)
-; (setq i (1+ i)))
-; (define-key map "\e" esc-map)
-; (setq eshell-term-raw-map map)
-; (setq eshell-term-raw-escape-map
-; (copy-keymap (lookup-key (current-global-map) "\C-x")))
-; (if (boundp 'xemacs-logo)
-; (define-key eshell-term-raw-map [button2] 'eshell-term-mouse-paste)
-; (define-key eshell-term-raw-map [mouse-2] 'eshell-term-mouse-paste))
-; (define-key eshell-term-raw-map [up] 'eshell-term-send-up)
-; (define-key eshell-term-raw-map [down] 'eshell-term-send-down)
-; (define-key eshell-term-raw-map [right] 'eshell-term-send-right)
-; (define-key eshell-term-raw-map [left] 'eshell-term-send-left)
-; (define-key eshell-term-raw-map [delete] 'eshell-term-send-del)
-; (define-key eshell-term-raw-map [backspace] 'eshell-term-send-backspace)
-; (define-key eshell-term-raw-map [home] 'eshell-term-send-home)
-; (define-key eshell-term-raw-map [end] 'eshell-term-send-end)
-; (define-key eshell-term-raw-map [prior] 'eshell-term-send-prior)
-; (define-key eshell-term-raw-map [next] 'eshell-term-send-next)
-; (eshell-term-set-escape-char ?\C-c))))
-
-; (defun eshell-term-line-mode ()
-; "Switch to line (\"cooked\") sub-mode of eshell-term mode."
-; (use-local-map term-old-mode-map))
-
-;;; Code:
-
-;;; em-term.el ends here
+++ /dev/null
-;;; em-unix.el --- UNIX command aliases
-
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-unix)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-unix nil
- "This module defines many of the more common UNIX utilities as
-aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If
-the user passes arguments which are too complex, or are unrecognized
-by the Lisp variant, the external version will be called (if
-available). The only reason not to use them would be because they are
-usually much slower. But in several cases their tight integration
-with Eshell makes them more versatile than their traditional cousins
-\(such as being able to use `kill' to kill Eshell background processes
-by name)."
- :tag "UNIX commands in Lisp"
- :group 'eshell-module)
-
-;;; Commentary:
-
-;; This file contains implementations of several UNIX command in Emacs
-;; Lisp, for several reasons:
-;;
-;; 1) it makes them available on all platforms where the Lisp
-;; functions used are available
-;;
-;; 2) it makes their functionality accessible and modified by the
-;; Lisp programmer.
-;;
-;; 3) it allows Eshell to refrain from having to invoke external
-;; processes for common operations.
-
-(defcustom eshell-unix-load-hook '(eshell-unix-initialize)
- "*A list of functions to run when `eshell-unix' is loaded."
- :type 'hook
- :group 'eshell-unix)
-
-(defcustom eshell-plain-grep-behavior nil
- "*If non-nil, standalone \"grep\" commands will behave normally.
-Standalone in this context means not redirected, and not on the
-receiving side of a command pipeline."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-no-grep-available (not (eshell-search-path "grep"))
- "*If non-nil, no grep is available on the current machine."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-plain-diff-behavior nil
- "*If non-nil, standalone \"diff\" commands will behave normally.
-Standalone in this context means not redirected, and not on the
-receiving side of a command pipeline."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-plain-locate-behavior (eshell-under-xemacs-p)
- "*If non-nil, standalone \"locate\" commands will behave normally.
-Standalone in this context means not redirected, and not on the
-receiving side of a command pipeline."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-rm-removes-directories nil
- "*If non-nil, `rm' will remove directory entries.
-Otherwise, `rmdir' is required."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-rm-interactive-query (= (user-uid) 0)
- "*If non-nil, `rm' will query before removing anything."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-mv-interactive-query (= (user-uid) 0)
- "*If non-nil, `mv' will query before overwriting anything."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-mv-overwrite-files t
- "*If non-nil, `mv' will overwrite files without warning."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-cp-interactive-query (= (user-uid) 0)
- "*If non-nil, `cp' will query before overwriting anything."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-cp-overwrite-files t
- "*If non-nil, `cp' will overwrite files without warning."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-ln-interactive-query (= (user-uid) 0)
- "*If non-nil, `ln' will query before overwriting anything."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-ln-overwrite-files nil
- "*If non-nil, `ln' will overwrite files without warning."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-default-target-is-dot nil
- "*If non-nil, the default destination for cp, mv or ln is `.'."
- :type 'boolean
- :group 'eshell-unix)
-
-(defcustom eshell-du-prefer-over-ange nil
- "*Use Eshell's du in ange-ftp remote directories.
-Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
- :type 'boolean
- :group 'eshell-unix)
-
-(require 'esh-opt)
-
-;;; Functions:
-
-(defun eshell-unix-initialize ()
- "Initialize the UNIX support/emulation code."
- (when (eshell-using-module 'eshell-cmpl)
- (add-hook 'pcomplete-try-first-hook
- 'eshell-complete-host-reference nil t))
- (make-local-variable 'eshell-complex-commands)
- (setq eshell-complex-commands
- (append '("grep" "egrep" "fgrep" "agrep" "glimpse" "locate"
- "cat" "time" "cp" "mv" "make" "du" "diff")
- eshell-complex-commands)))
-
-(defalias 'eshell/date 'current-time-string)
-(defalias 'eshell/basename 'file-name-nondirectory)
-(defalias 'eshell/dirname 'file-name-directory)
-
-(eval-when-compile
- (defvar interactive)
- (defvar preview)
- (defvar recursive)
- (defvar verbose))
-
-(defun eshell/man (&rest args)
- "Invoke man, flattening the arguments appropriately."
- (funcall 'man (apply 'eshell-flatten-and-stringify args)))
-
-(put 'eshell/man 'eshell-no-numeric-conversions t)
-
-(defun eshell-remove-entries (path files &optional top-level)
- "From PATH, remove all of the given FILES, perhaps interactively."
- (while files
- (if (string-match "\\`\\.\\.?\\'"
- (file-name-nondirectory (car files)))
- (if top-level
- (eshell-error "rm: cannot remove `.' or `..'\n"))
- (if (and (file-directory-p (car files))
- (not (file-symlink-p (car files))))
- (let ((dir (file-name-as-directory (car files))))
- (eshell-remove-entries dir
- (mapcar
- (function
- (lambda (file)
- (concat dir file)))
- (directory-files dir)))
- (if verbose
- (eshell-printn (format "rm: removing directory `%s'"
- (car files))))
- (unless
- (or preview
- (and interactive
- (not (y-or-n-p
- (format "rm: remove directory `%s'? "
- (car files))))))
- (eshell-funcalln 'delete-directory (car files))))
- (if verbose
- (eshell-printn (format "rm: removing file `%s'"
- (car files))))
- (unless (or preview
- (and interactive
- (not (y-or-n-p
- (format "rm: remove `%s'? "
- (car files))))))
- (eshell-funcalln 'delete-file (car files)))))
- (setq files (cdr files))))
-
-(defun eshell/rm (&rest args)
- "Implementation of rm in Lisp.
-This is implemented to call either `delete-file', `kill-buffer',
-`kill-process', or `unintern', depending on the nature of the
-argument."
- (setq args (eshell-flatten-list args))
- (eshell-eval-using-options
- "rm" args
- '((?h "help" nil nil "show this usage screen")
- (?f "force" nil force-removal "force removal")
- (?i "interactive" nil interactive "prompt before any removal")
- (?n "preview" nil preview "don't change anything on disk")
- (?r "recursive" nil recursive
- "remove the contents of directories recursively")
- (?R nil nil recursive "(same)")
- (?v "verbose" nil verbose "explain what is being done")
- :preserve-args
- :external "rm"
- :show-usage
- :usage "[OPTION]... FILE...
-Remove (unlink) the FILE(s).")
- (unless interactive
- (setq interactive eshell-rm-interactive-query))
- (if (and force-removal interactive)
- (setq interactive nil))
- (while args
- (let ((entry (if (stringp (car args))
- (directory-file-name (car args))
- (if (numberp (car args))
- (number-to-string (car args))
- (car args)))))
- (cond
- ((bufferp entry)
- (if verbose
- (eshell-printn (format "rm: removing buffer `%s'" entry)))
- (unless (or preview
- (and interactive
- (not (y-or-n-p (format "rm: delete buffer `%s'? "
- entry)))))
- (eshell-funcalln 'kill-buffer entry)))
- ((eshell-processp entry)
- (if verbose
- (eshell-printn (format "rm: killing process `%s'" entry)))
- (unless (or preview
- (and interactive
- (not (y-or-n-p (format "rm: kill process `%s'? "
- entry)))))
- (eshell-funcalln 'kill-process entry)))
- ((symbolp entry)
- (if verbose
- (eshell-printn (format "rm: uninterning symbol `%s'" entry)))
- (unless
- (or preview
- (and interactive
- (not (y-or-n-p (format "rm: unintern symbol `%s'? "
- entry)))))
- (eshell-funcalln 'unintern entry)))
- ((stringp entry)
- (if (and (file-directory-p entry)
- (not (file-symlink-p entry)))
- (if (or recursive
- eshell-rm-removes-directories)
- (if (or preview
- (not interactive)
- (y-or-n-p
- (format "rm: descend into directory `%s'? "
- entry)))
- (eshell-remove-entries nil (list entry) t))
- (eshell-error (format "rm: %s: is a directory\n" entry)))
- (eshell-remove-entries nil (list entry) t)))))
- (setq args (cdr args)))
- nil))
-
-(put 'eshell/rm 'eshell-no-numeric-conversions t)
-
-(defun eshell/mkdir (&rest args)
- "Implementation of mkdir in Lisp."
- (eshell-eval-using-options
- "mkdir" args
- '((?h "help" nil nil "show this usage screen")
- :external "mkdir"
- :show-usage
- :usage "[OPTION] DIRECTORY...
-Create the DIRECTORY(ies), if they do not already exist.")
- (while args
- (eshell-funcalln 'make-directory (car args))
- (setq args (cdr args)))
- nil))
-
-(put 'eshell/mkdir 'eshell-no-numeric-conversions t)
-
-(defun eshell/rmdir (&rest args)
- "Implementation of rmdir in Lisp."
- (eshell-eval-using-options
- "rmdir" args
- '((?h "help" nil nil "show this usage screen")
- :external "rmdir"
- :show-usage
- :usage "[OPTION] DIRECTORY...
-Remove the DIRECTORY(ies), if they are empty.")
- (while args
- (eshell-funcalln 'delete-directory (car args))
- (setq args (cdr args)))
- nil))
-
-(put 'eshell/rmdir 'eshell-no-numeric-conversions t)
-
-(eval-when-compile
- (defvar no-dereference)
- (defvar preview)
- (defvar verbose))
-
-(defvar eshell-warn-dot-directories t)
-
-(defun eshell-shuffle-files (command action files target func deep &rest args)
- "Shuffle around some filesystem entries, using FUNC to do the work."
- (let ((attr-target (eshell-file-attributes target))
- (is-dir (or (file-directory-p target)
- (and preview (not eshell-warn-dot-directories))))
- attr)
- (if (and (not preview) (not is-dir)
- (> (length files) 1))
- (error "%s: when %s multiple files, last argument must be a directory"
- command action))
- (while files
- (setcar files (directory-file-name (car files)))
- (cond
- ((string-match "\\`\\.\\.?\\'"
- (file-name-nondirectory (car files)))
- (if eshell-warn-dot-directories
- (eshell-error (format "%s: %s: omitting directory\n"
- command (car files)))))
- ((and attr-target
- (or (not (eshell-under-windows-p))
- (eq system-type 'ms-dos))
- (setq attr (eshell-file-attributes (car files)))
- (nth 10 attr-target) (nth 10 attr)
- ;; Use equal, not -, since the inode and the device could
- ;; cons cells.
- (equal (nth 10 attr-target) (nth 10 attr))
- (nth 11 attr-target) (nth 11 attr)
- (equal (nth 11 attr-target) (nth 11 attr)))
- (eshell-error (format "%s: `%s' and `%s' are the same file\n"
- command (car files) target)))
- (t
- (let ((source (car files))
- (target (if is-dir
- (expand-file-name
- (file-name-nondirectory (car files)) target)
- target))
- link)
- (if (and (file-directory-p source)
- (or (not no-dereference)
- (not (file-symlink-p source)))
- (not (memq func '(make-symbolic-link
- add-name-to-file))))
- (if (and (eq func 'copy-file)
- (not recursive))
- (eshell-error (format "%s: %s: omitting directory\n"
- command (car files)))
- (let (eshell-warn-dot-directories)
- (if (and (not deep)
- (eq func 'rename-file)
- ;; Use equal, since the device might be a
- ;; cons cell.
- (equal (nth 11 (eshell-file-attributes
- (file-name-directory
- (directory-file-name
- (expand-file-name source)))))
- (nth 11 (eshell-file-attributes
- (file-name-directory
- (directory-file-name
- (expand-file-name target)))))))
- (apply 'eshell-funcalln func source target args)
- (unless (file-directory-p target)
- (if verbose
- (eshell-printn
- (format "%s: making directory %s"
- command target)))
- (unless preview
- (eshell-funcalln 'make-directory target)))
- (apply 'eshell-shuffle-files
- command action
- (mapcar
- (function
- (lambda (file)
- (concat source "/" file)))
- (directory-files source))
- target func t args)
- (when (eq func 'rename-file)
- (if verbose
- (eshell-printn
- (format "%s: deleting directory %s"
- command source)))
- (unless preview
- (eshell-funcalln 'delete-directory source))))))
- (if verbose
- (eshell-printn (format "%s: %s -> %s" command
- source target)))
- (unless preview
- (if (and no-dereference
- (setq link (file-symlink-p source)))
- (progn
- (apply 'eshell-funcalln 'make-symbolic-link
- link target args)
- (if (eq func 'rename-file)
- (if (and (file-directory-p source)
- (not (file-symlink-p source)))
- (eshell-funcalln 'delete-directory source)
- (eshell-funcalln 'delete-file source))))
- (apply 'eshell-funcalln func source target args)))))))
- (setq files (cdr files)))))
-
-(defun eshell-shorthand-tar-command (command args)
- "Rewrite `cp -v dir a.tar.gz' to `tar cvzf a.tar.gz dir'."
- (let* ((archive (car (last args)))
- (tar-args
- (cond ((string-match "z2" archive) "If")
- ((string-match "gz" archive) "zf")
- ((string-match "\\(az\\|Z\\)" archive) "Zf")
- (t "f"))))
- (if (file-exists-p archive)
- (setq tar-args (concat "u" tar-args))
- (setq tar-args (concat "c" tar-args)))
- (if verbose
- (setq tar-args (concat "v" tar-args)))
- (if (equal command "mv")
- (setq tar-args (concat "--remove-files -" tar-args)))
- ;; truncate the archive name from the arguments
- (setcdr (last args 2) nil)
- (throw 'eshell-replace-command
- (eshell-parse-command
- (format "tar %s %s" tar-args archive) args))))
-
-;; this is to avoid duplicating code...
-(defmacro eshell-mvcpln-template (command action func query-var
- force-var &optional preserve)
- `(let ((len (length args)))
- (if (or (= len 0)
- (and (= len 1) (null eshell-default-target-is-dot)))
- (error "%s: missing destination file or directory" ,command))
- (if (= len 1)
- (nconc args '(".")))
- (setq args (eshell-stringify-list (eshell-flatten-list args)))
- (if (and ,(not (equal command "ln"))
- (string-match eshell-tar-regexp (car (last args)))
- (or (> (length args) 2)
- (and (file-directory-p (car args))
- (or (not no-dereference)
- (not (file-symlink-p (car args)))))))
- (eshell-shorthand-tar-command ,command args)
- (let ((target (car (last args)))
- ange-cache)
- (setcdr (last args 2) nil)
- (eshell-shuffle-files
- ,command ,action args target ,func nil
- ,@(append
- `((if (and (or interactive
- ,query-var)
- (not force))
- 1 (or force ,force-var)))
- (if preserve
- (list preserve)))))
- nil)))
-
-(defun eshell/mv (&rest args)
- "Implementation of mv in Lisp."
- (eshell-eval-using-options
- "mv" args
- '((?f "force" nil force
- "remove existing destinations, never prompt")
- (?i "interactive" nil interactive
- "request confirmation if target already exists")
- (?n "preview" nil preview
- "don't change anything on disk")
- (?v "verbose" nil verbose
- "explain what is being done")
- (nil "help" nil nil "show this usage screen")
- :preserve-args
- :external "mv"
- :show-usage
- :usage "[OPTION]... SOURCE DEST
- or: mv [OPTION]... SOURCE... DIRECTORY
-Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
-\[OPTION] DIRECTORY...")
- (let ((no-dereference t))
- (eshell-mvcpln-template "mv" "moving" 'rename-file
- eshell-mv-interactive-query
- eshell-mv-overwrite-files))))
-
-(put 'eshell/mv 'eshell-no-numeric-conversions t)
-
-(defun eshell/cp (&rest args)
- "Implementation of cp in Lisp."
- (eshell-eval-using-options
- "cp" args
- '((?a "archive" nil archive
- "same as -dpR")
- (?d "no-dereference" nil no-dereference
- "preserve links")
- (?f "force" nil force
- "remove existing destinations, never prompt")
- (?i "interactive" nil interactive
- "request confirmation if target already exists")
- (?n "preview" nil preview
- "don't change anything on disk")
- (?p "preserve" nil preserve
- "preserve file attributes if possible")
- (?R "recursive" nil recursive
- "copy directories recursively")
- (?v "verbose" nil verbose
- "explain what is being done")
- (nil "help" nil nil "show this usage screen")
- :preserve-args
- :external "cp"
- :show-usage
- :usage "[OPTION]... SOURCE DEST
- or: cp [OPTION]... SOURCE... DIRECTORY
-Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
- (if archive
- (setq preserve t no-dereference t recursive t))
- (eshell-mvcpln-template "cp" "copying" 'copy-file
- eshell-cp-interactive-query
- eshell-cp-overwrite-files preserve)))
-
-(put 'eshell/cp 'eshell-no-numeric-conversions t)
-
-(defun eshell/ln (&rest args)
- "Implementation of ln in Lisp."
- (eshell-eval-using-options
- "ln" args
- '((?h "help" nil nil "show this usage screen")
- (?s "symbolic" nil symbolic
- "make symbolic links instead of hard links")
- (?i "interactive" nil interactive
- "request confirmation if target already exists")
- (?f "force" nil force "remove existing destinations, never prompt")
- (?n "preview" nil preview
- "don't change anything on disk")
- (?v "verbose" nil verbose "explain what is being done")
- :preserve-args
- :external "ln"
- :show-usage
- :usage "[OPTION]... TARGET [LINK_NAME]
- or: ln [OPTION]... TARGET... DIRECTORY
-Create a link to the specified TARGET with optional LINK_NAME. If there is
-more than one TARGET, the last argument must be a directory; create links
-in DIRECTORY to each TARGET. Create hard links by default, symbolic links
-with '--symbolic'. When creating hard links, each TARGET must exist.")
- (let ((no-dereference t))
- (eshell-mvcpln-template "ln" "linking"
- (if symbolic
- 'make-symbolic-link
- 'add-name-to-file)
- eshell-ln-interactive-query
- eshell-ln-overwrite-files))))
-
-(put 'eshell/ln 'eshell-no-numeric-conversions t)
-
-(defun eshell/cat (&rest args)
- "Implementation of cat in Lisp.
-If in a pipeline, or the file is not a regular file, directory or
-symlink, then revert to the system's definition of cat."
- (setq args (eshell-stringify-list (eshell-flatten-list args)))
- (if (or eshell-in-pipeline-p
- (catch 'special
- (eshell-for arg args
- (unless (or (and (stringp arg)
- (> (length arg) 0)
- (eq (aref arg 0) ?-))
- (let ((attrs (eshell-file-attributes arg)))
- (and attrs (memq (aref (nth 8 attrs) 0)
- '(?d ?l ?-)))))
- (throw 'special t)))))
- (let ((ext-cat (eshell-search-path "cat")))
- (if ext-cat
- (throw 'eshell-replace-command
- (eshell-parse-command ext-cat args))
- (if eshell-in-pipeline-p
- (error "Eshell's `cat' does not work in pipelines")
- (error "Eshell's `cat' cannot display one of the files given"))))
- (eshell-init-print-buffer)
- (eshell-eval-using-options
- "cat" args
- '((?h "help" nil nil "show this usage screen")
- :external "cat"
- :show-usage
- :usage "[OPTION] FILE...
-Concatenate FILE(s), or standard input, to standard output.")
- (eshell-for file args
- (if (string= file "-")
- (throw 'eshell-external
- (eshell-external-command "cat" args))))
- (let ((curbuf (current-buffer)))
- (eshell-for file args
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (while (not (eobp))
- (let ((str (buffer-substring
- (point) (min (1+ (line-end-position))
- (point-max)))))
- (with-current-buffer curbuf
- (eshell-buffered-print str)))
- (forward-line)))))
- (eshell-flush)
- ;; if the file does not end in a newline, do not emit one
- (setq eshell-ensure-newline-p nil))))
-
-(put 'eshell/cat 'eshell-no-numeric-conversions t)
-
-;; special front-end functions for compilation-mode buffers
-
-(defun eshell/make (&rest args)
- "Use `compile' to do background makes."
- (if (and eshell-current-subjob-p
- (eshell-interactive-output-p))
- (let ((compilation-process-setup-function
- (list 'lambda nil
- (list 'setq 'process-environment
- (list 'quote (eshell-copy-environment))))))
- (compile (concat "make " (eshell-flatten-and-stringify args))))
- (throw 'eshell-replace-command
- (eshell-parse-command "*make" (eshell-stringify-list
- (eshell-flatten-list args))))))
-
-(put 'eshell/make 'eshell-no-numeric-conversions t)
-
-(defun eshell-occur-mode-goto-occurrence ()
- "Go to the occurrence the current line describes."
- (interactive)
- (let ((pos (occur-mode-find-occurrence)))
- (pop-to-buffer (marker-buffer pos))
- (goto-char (marker-position pos))))
-
-(defun eshell-occur-mode-mouse-goto (event)
- "In Occur mode, go to the occurrence whose line you click on."
- (interactive "e")
- (let (pos)
- (save-excursion
- (set-buffer (window-buffer (posn-window (event-end event))))
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (setq pos (occur-mode-find-occurrence))))
- (pop-to-buffer (marker-buffer pos))
- (goto-char (marker-position pos))))
-
-(defun eshell-poor-mans-grep (args)
- "A poor version of grep that opens every file and uses `occur'.
-This eats up memory, since it leaves the buffers open (to speed future
-searches), and it's very slow. But, if your system has no grep
-available..."
- (save-selected-window
- (let ((default-dir default-directory))
- (with-current-buffer (get-buffer-create "*grep*")
- (let ((inhibit-read-only t)
- (default-directory default-dir))
- (erase-buffer)
- (occur-mode)
- (let ((files (eshell-stringify-list
- (eshell-flatten-list (cdr args))))
- (inhibit-redisplay t)
- string)
- (when (car args)
- (if (get-buffer "*Occur*")
- (kill-buffer (get-buffer "*Occur*")))
- (setq string nil)
- (while files
- (with-current-buffer (find-file-noselect (car files))
- (save-excursion
- (ignore-errors
- (occur (car args))))
- (if (get-buffer "*Occur*")
- (with-current-buffer (get-buffer "*Occur*")
- (setq string (buffer-string))
- (kill-buffer (current-buffer)))))
- (if string (insert string))
- (setq string nil
- files (cdr files)))))
- (local-set-key [mouse-2] 'eshell-occur-mode-mouse-goto)
- (local-set-key [(control ?c) (control ?c)]
- 'eshell-occur-mode-goto-occurrence)
- (local-set-key [(control ?m)]
- 'eshell-occur-mode-goto-occurrence)
- (local-set-key [return] 'eshell-occur-mode-goto-occurrence)
- (pop-to-buffer (current-buffer) t)
- (goto-char (point-min))
- (resize-temp-buffer-window))))))
-
-(defun eshell-grep (command args &optional maybe-use-occur)
- "Generic service function for the various grep aliases.
-It calls Emacs' grep utility if the command is not redirecting output,
-and if it's not part of a command pipeline. Otherwise, it calls the
-external command."
- (if (and maybe-use-occur eshell-no-grep-available)
- (eshell-poor-mans-grep args)
- (if (or eshell-plain-grep-behavior
- (not (and (eshell-interactive-output-p)
- (not eshell-in-pipeline-p)
- (not eshell-in-subcommand-p))))
- (throw 'eshell-replace-command
- (eshell-parse-command (concat "*" command)
- (eshell-stringify-list
- (eshell-flatten-list args))))
- (let* ((compilation-process-setup-function
- (list 'lambda nil
- (list 'setq 'process-environment
- (list 'quote (eshell-copy-environment)))))
- (args (mapconcat 'identity
- (mapcar 'shell-quote-argument
- (eshell-stringify-list
- (eshell-flatten-list args)))
- " "))
- (cmd (progn
- (set-text-properties 0 (length args)
- '(invisible t) args)
- (format "%s -n %s" command args)))
- compilation-scroll-output)
- (grep cmd)))))
-
-(defun eshell/grep (&rest args)
- "Use Emacs grep facility instead of calling external grep."
- (eshell-grep "grep" args t))
-
-(defun eshell/egrep (&rest args)
- "Use Emacs grep facility instead of calling external egrep."
- (eshell-grep "egrep" args t))
-
-(defun eshell/fgrep (&rest args)
- "Use Emacs grep facility instead of calling external fgrep."
- (eshell-grep "fgrep" args t))
-
-(defun eshell/agrep (&rest args)
- "Use Emacs grep facility instead of calling external agrep."
- (eshell-grep "agrep" args))
-
-(defun eshell/glimpse (&rest args)
- "Use Emacs grep facility instead of calling external glimpse."
- (let (null-device)
- (eshell-grep "glimpse" (append '("-z" "-y") args))))
-
-;; completions rules for some common UNIX commands
-
-(defsubst eshell-complete-hostname ()
- "Complete a command that wants a hostname for an argument."
- (pcomplete-here (eshell-read-host-names)))
-
-(defun eshell-complete-host-reference ()
- "If there is a host reference, complete it."
- (let ((arg (pcomplete-actual-arg))
- index)
- (when (setq index (string-match "@[a-z.]*\\'" arg))
- (setq pcomplete-stub (substring arg (1+ index))
- pcomplete-last-completion-raw t)
- (throw 'pcomplete-completions (eshell-read-host-names)))))
-
-(defalias 'pcomplete/ftp 'eshell-complete-hostname)
-(defalias 'pcomplete/ncftp 'eshell-complete-hostname)
-(defalias 'pcomplete/ping 'eshell-complete-hostname)
-(defalias 'pcomplete/rlogin 'eshell-complete-hostname)
-
-(defun pcomplete/telnet ()
- (require 'pcmpl-unix)
- (pcomplete-opt "xl(pcmpl-unix-user-names)")
- (eshell-complete-hostname))
-
-(defun pcomplete/rsh ()
- "Complete `rsh', which, after the user and hostname, is like xargs."
- (require 'pcmpl-unix)
- (pcomplete-opt "l(pcmpl-unix-user-names)")
- (eshell-complete-hostname)
- (pcomplete-here (funcall pcomplete-command-completion-function))
- (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
- pcomplete-default-completion-function)))
-
-(defalias 'pcomplete/ssh 'pcomplete/rsh)
-
-(eval-when-compile
- (defvar block-size)
- (defvar by-bytes)
- (defvar dereference-links)
- (defvar grand-total)
- (defvar human-readable)
- (defvar max-depth)
- (defvar only-one-filesystem)
- (defvar show-all))
-
-(defsubst eshell-du-size-string (size)
- (let* ((str (eshell-printable-size size human-readable block-size t))
- (len (length str)))
- (concat str (if (< len 8)
- (make-string (- 8 len) ? )))))
-
-(defun eshell-du-sum-directory (path depth)
- "Summarize PATH, and its member directories."
- (let ((entries (eshell-directory-files-and-attributes path))
- (size 0.0))
- (while entries
- (unless (string-match "\\`\\.\\.?\\'" (caar entries))
- (let* ((entry (concat path (char-to-string directory-sep-char)
- (caar entries)))
- (symlink (and (stringp (cadr (car entries)))
- (cadr (car entries)))))
- (unless (or (and symlink (not dereference-links))
- (and only-one-filesystem
- (/= only-one-filesystem
- (nth 12 (car entries)))))
- (if symlink
- (setq entry symlink))
- (setq size
- (+ size
- (if (eq t (cadr (car entries)))
- (eshell-du-sum-directory entry (1+ depth))
- (let ((file-size (nth 8 (car entries))))
- (prog1
- file-size
- (if show-all
- (eshell-print
- (concat (eshell-du-size-string file-size)
- entry "\n")))))))))))
- (setq entries (cdr entries)))
- (if (or (not max-depth)
- (= depth max-depth)
- (= depth 0))
- (eshell-print (concat (eshell-du-size-string size)
- (directory-file-name path) "\n")))
- size))
-
-(defun eshell/du (&rest args)
- "Implementation of \"du\" in Lisp, passing ARGS."
- (setq args (if args
- (eshell-stringify-list (eshell-flatten-list args))
- '(".")))
- (let ((ext-du (eshell-search-path "du")))
- (if (and ext-du
- (not (catch 'have-ange-path
- (eshell-for arg args
- (if (eq (find-file-name-handler (expand-file-name arg)
- 'directory-files)
- 'ange-ftp-hook-function)
- (throw 'have-ange-path t))))))
- (throw 'eshell-replace-command
- (eshell-parse-command ext-du args))
- (eshell-eval-using-options
- "du" args
- '((?a "all" nil show-all
- "write counts for all files, not just directories")
- (nil "block-size" t block-size
- "use SIZE-byte blocks (i.e., --block-size SIZE)")
- (?b "bytes" nil by-bytes
- "print size in bytes")
- (?c "total" nil grand-total
- "produce a grand total")
- (?d "max-depth" t max-depth
- "display data only this many levels of data")
- (?h "human-readable" 1024 human-readable
- "print sizes in human readable format")
- (?H "is" 1000 human-readable
- "likewise, but use powers of 1000 not 1024")
- (?k "kilobytes" 1024 block-size
- "like --block-size 1024")
- (?L "dereference" nil dereference-links
- "dereference all symbolic links")
- (?m "megabytes" 1048576 block-size
- "like --block-size 1048576")
- (?s "summarize" 0 max-depth
- "display only a total for each argument")
- (?x "one-file-system" nil only-one-filesystem
- "skip directories on different filesystems")
- (nil "help" nil nil
- "show this usage screen")
- :external "du"
- :usage "[OPTION]... FILE...
-Summarize disk usage of each FILE, recursively for directories.")
- (unless by-bytes
- (setq block-size (or block-size 1024)))
- (if (and max-depth (stringp max-depth))
- (setq max-depth (string-to-int max-depth)))
- ;; filesystem support means nothing under Windows
- (if (eshell-under-windows-p)
- (setq only-one-filesystem nil))
- (let ((size 0.0) ange-cache)
- (while args
- (if only-one-filesystem
- (setq only-one-filesystem
- (nth 11 (eshell-file-attributes
- (file-name-as-directory (car args))))))
- (setq size (+ size (eshell-du-sum-directory
- (directory-file-name (car args)) 0)))
- (setq args (cdr args)))
- (if grand-total
- (eshell-print (concat (eshell-du-size-string size)
- "total\n"))))))))
-
-(defvar eshell-time-start nil)
-
-(defun eshell-show-elapsed-time ()
- (let ((elapsed (format "%.3f secs\n"
- (- (eshell-time-to-seconds (current-time))
- eshell-time-start))))
- (set-text-properties 0 (length elapsed) '(face bold) elapsed)
- (eshell-interactive-print elapsed))
- (remove-hook 'eshell-post-command-hook 'eshell-show-elapsed-time t))
-
-(defun eshell/time (&rest args)
- "Implementation of \"time\" in Lisp."
- (let ((time-args (copy-alist args))
- (continue t)
- last-arg)
- (while (and continue args)
- (if (not (string-match "^-" (car args)))
- (progn
- (if last-arg
- (setcdr last-arg nil)
- (setq args '("")))
- (setq continue nil))
- (setq last-arg args
- args (cdr args))))
- (eshell-eval-using-options
- "time" args
- '((?h "help" nil nil "show this usage screen")
- :external "time"
- :show-usage
- :usage "COMMAND...
-Show wall-clock time elapsed during execution of COMMAND.")
- (setq eshell-time-start (eshell-time-to-seconds (current-time)))
- (add-hook 'eshell-post-command-hook 'eshell-show-elapsed-time nil t)
- ;; after setting
- (throw 'eshell-replace-command
- (eshell-parse-command (car time-args) (cdr time-args))))))
-
-(defalias 'eshell/whoami 'user-login-name)
-
-(defvar eshell-diff-window-config nil)
-
-(defun eshell-diff-quit ()
- "Restore the window configuration previous to diff'ing."
- (interactive)
- (if eshell-diff-window-config
- (set-window-configuration eshell-diff-window-config)))
-
-(defun eshell/diff (&rest args)
- "Alias \"diff\" to call Emacs `diff' function."
- (let ((orig-args (eshell-stringify-list (eshell-flatten-list args))))
- (if (or eshell-plain-diff-behavior
- (not (and (eshell-interactive-output-p)
- (not eshell-in-pipeline-p)
- (not eshell-in-subcommand-p))))
- (throw 'eshell-replace-command
- (eshell-parse-command "*diff" orig-args))
- (setq args (copy-sequence orig-args))
- (if (< (length args) 2)
- (throw 'eshell-replace-command
- (eshell-parse-command "*diff" orig-args)))
- (let ((old (car (last args 2)))
- (new (car (last args)))
- (config (current-window-configuration)))
- (if (= (length args) 2)
- (setq args nil)
- (setcdr (last args 3) nil))
- (with-current-buffer
- (condition-case err
- (diff old new (eshell-flatten-and-stringify args))
- (error
- (throw 'eshell-replace-command
- (eshell-parse-command "*diff" orig-args))))
- (when (fboundp 'diff-mode)
- (make-local-variable 'compilation-finish-functions)
- (add-hook
- 'compilation-finish-functions
- `(lambda (buff msg)
- (with-current-buffer buff
- (diff-mode)
- (set (make-local-variable 'eshell-diff-window-config)
- ,config)
- (local-set-key [?q] 'eshell-diff-quit)
- (if (fboundp 'turn-on-font-lock-if-enabled)
- (turn-on-font-lock-if-enabled))
- (goto-char (point-min))))))
- (pop-to-buffer (current-buffer))))))
- nil)
-
-(put 'eshell/diff 'eshell-no-numeric-conversions t)
-
-(defun eshell/locate (&rest args)
- "Alias \"locate\" to call Emacs `locate' function."
- (if (or eshell-plain-locate-behavior
- (not (and (eshell-interactive-output-p)
- (not eshell-in-pipeline-p)
- (not eshell-in-subcommand-p)))
- (and (stringp (car args))
- (string-match "^-" (car args))))
- (throw 'eshell-replace-command
- (eshell-parse-command "*locate" (eshell-stringify-list
- (eshell-flatten-list args))))
- (save-selected-window
- (let ((locate-history-list (list (car args))))
- (locate-with-filter (car args) (cadr args))))))
-
-(put 'eshell/locate 'eshell-no-numeric-conversions t)
-
-(defun eshell/occur (&rest args)
- "Alias \"occur\" to call Emacs `occur' function."
- (let ((inhibit-read-only t))
- (if (> (length args) 2)
- (error "usage: occur: (REGEXP &optional NLINES)")
- (apply 'occur args))))
-
-(put 'eshell/occur 'eshell-no-numeric-conversions t)
-
-;;; Code:
-
-;;; em-unix.el ends here
+++ /dev/null
-;;; em-xtra.el --- extra alias functions
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'em-xtra)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-xtra nil
- "This module defines some extra alias functions which are entirely
-optional. They can be viewed as samples for how to write Eshell alias
-functions, or as aliases which make some of Emacs' behavior more
-naturally accessible within Emacs."
- :tag "Extra alias functions"
- :group 'eshell-module)
-
-;;; Commentary:
-
-(require 'compile)
-
-;;; Functions:
-
-(defun eshell/expr (&rest args)
- "Implementation of expr, using the calc package."
- (if (not (fboundp 'calc-eval))
- (throw 'eshell-replace-command
- (eshell-parse-command "*expr" (eshell-flatten-list args)))
- ;; to fool the byte-compiler...
- (let ((func 'calc-eval))
- (funcall func (eshell-flatten-and-stringify args)))))
-
-(defun eshell/substitute (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'substitute (car args) (cadr args) :test 'equal
- (cddr args)))
-
-(defun eshell/count (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'count (car args) (cadr args) :test 'equal
- (cddr args)))
-
-(defun eshell/mismatch (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'mismatch (car args) (cadr args) :test 'equal
- (cddr args)))
-
-(defun eshell/union (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'union (car args) (cadr args) :test 'equal
- (cddr args)))
-
-(defun eshell/intersection (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'intersection (car args) (cadr args) :test 'equal
- (cddr args)))
-
-(defun eshell/set-difference (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'set-difference (car args) (cadr args) :test 'equal
- (cddr args)))
-
-(defun eshell/set-exclusive-or (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'set-exclusive-or (car args) (cadr args) :test 'equal
- (cddr args)))
-
-(defalias 'eshell/ff 'find-name-dired)
-(defalias 'eshell/gf 'find-grep-dired)
-
-(defun pcomplete/bcc32 ()
- "Completion function for Borland's C++ compiler."
- (let ((cur (pcomplete-arg 0)))
- (cond
- ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
- (pcomplete-here
- '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
- "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
- "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
- "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
- "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
- "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
- "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
- "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
- "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
- ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
- ((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
- (match-string 1 cur)))
- ((string-match "\\`-o\\(.*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
- (match-string 1 cur)))
- (t
- (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
- (while (pcomplete-here
- (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
-
-(defalias 'pcomplete/bcc 'pcomplete/bcc32)
-
-;;; Code:
-
-;;; em-xtra.el ends here
+++ /dev/null
-;;; esh-arg.el --- argument processing
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-arg)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-arg nil
- "Argument parsing involves transforming the arguments passed on the
-command line into equivalent Lisp forms that, when evaluated, will
-yield the values intended."
- :tag "Argument parsing"
- :group 'eshell)
-
-;;; Commentary:
-
-;; Parsing of arguments can be extended by adding functions to the
-;; hook `eshell-parse-argument-hook'. For a good example of this, see
-;; `eshell-parse-drive-letter', defined in eshell-dirs.el.
-
-(defcustom eshell-parse-argument-hook
- (list
- ;; a term such as #<buffer NAME>, or #<process NAME> is a buffer
- ;; or process reference
- 'eshell-parse-special-reference
-
- ;; numbers convert to numbers if they stand alone
- (function
- (lambda ()
- (when (and (not eshell-current-argument)
- (not eshell-current-quoted)
- (looking-at eshell-number-regexp)
- (eshell-arg-delimiter (match-end 0)))
- (goto-char (match-end 0))
- (let ((str (match-string 0)))
- (if (> (length str) 0)
- (add-text-properties 0 1 '(number t) str))
- str))))
-
- ;; parse any non-special characters, based on the current context
- (function
- (lambda ()
- (unless eshell-inside-quote-regexp
- (setq eshell-inside-quote-regexp
- (format "[^%s]+"
- (apply 'string eshell-special-chars-inside-quoting))))
- (unless eshell-outside-quote-regexp
- (setq eshell-outside-quote-regexp
- (format "[^%s]+"
- (apply 'string eshell-special-chars-outside-quoting))))
- (when (looking-at (if eshell-current-quoted
- eshell-inside-quote-regexp
- eshell-outside-quote-regexp))
- (goto-char (match-end 0))
- (let ((str (match-string 0)))
- (if str
- (set-text-properties 0 (length str) nil str))
- str))))
-
- ;; whitespace or a comment is an argument delimiter
- (function
- (lambda ()
- (let (comment-p)
- (when (or (looking-at "[ \t]+")
- (and (not eshell-current-argument)
- (looking-at "#\\([^<'].*\\|$\\)")
- (setq comment-p t)))
- (if comment-p
- (add-text-properties (match-beginning 0) (match-end 0)
- '(comment t)))
- (goto-char (match-end 0))
- (eshell-finish-arg)))))
-
- ;; backslash before a special character means escape it
- 'eshell-parse-backslash
-
- ;; text beginning with ' is a literally quoted
- 'eshell-parse-literal-quote
-
- ;; text beginning with " is interpolably quoted
- 'eshell-parse-double-quote
-
- ;; argument delimiter
- 'eshell-parse-delimiter)
- "*Define how to process Eshell command line arguments.
-When each function on this hook is called, point will be at the
-current position within the argument list. The function should either
-return nil, meaning that it did no argument parsing, or it should
-return the result of the parse as a sexp. It is also responsible for
-moving the point forward to reflect the amount of input text that was
-parsed.
-
-If no function handles the current character at point, it will be
-treated as a literal character."
- :type 'hook
- :group 'eshell-arg)
-
-;;; Code:
-
-;;; User Variables:
-
-(defcustom eshell-arg-load-hook '(eshell-arg-initialize)
- "*A hook that gets run when `eshell-arg' is loaded."
- :type 'hook
- :group 'eshell-arg)
-
-(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ? ?\t ?\n)
- "List of characters to recognize as argument separators."
- :type '(repeat character)
- :group 'eshell-arg)
-
-(defcustom eshell-special-chars-inside-quoting '(?\\ ?\")
- "*Characters which are still special inside double quotes."
- :type '(repeat character)
- :group 'eshell-arg)
-
-(defcustom eshell-special-chars-outside-quoting
- (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\'))
- "*Characters that require escaping outside of double quotes.
-Without escaping them, they will introduce a change in the argument."
- :type '(repeat character)
- :group 'eshell-arg)
-
-;;; Internal Variables:
-
-(defvar eshell-current-argument nil)
-(defvar eshell-current-modifiers nil)
-(defvar eshell-arg-listified nil)
-(defvar eshell-nested-argument nil)
-(defvar eshell-current-quoted nil)
-(defvar eshell-inside-quote-regexp nil)
-(defvar eshell-outside-quote-regexp nil)
-
-;;; Functions:
-
-(defun eshell-arg-initialize ()
- "Initialize the argument parsing code."
- (define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name)
- (set (make-local-variable 'eshell-inside-quote-regexp) nil)
- (set (make-local-variable 'eshell-outside-quote-regexp) nil))
-
-(defun eshell-insert-buffer-name (buffer-name)
- "Insert BUFFER-NAME into the current buffer at point."
- (interactive "BName of buffer: ")
- (insert-and-inherit "#<buffer " buffer-name ">"))
-
-(defsubst eshell-escape-arg (string)
- "Return STRING with the `escaped' property on it."
- (if (stringp string)
- (add-text-properties 0 (length string) '(escaped t) string))
- string)
-
-(defun eshell-resolve-current-argument ()
- "If there are pending modifications to be made, make them now."
- (when eshell-current-argument
- (when eshell-arg-listified
- (let ((parts eshell-current-argument))
- (while parts
- (unless (stringp (car parts))
- (setcar parts
- (list 'eshell-to-flat-string (car parts))))
- (setq parts (cdr parts)))
- (setq eshell-current-argument
- (list 'eshell-convert
- (append (list 'concat) eshell-current-argument))))
- (setq eshell-arg-listified nil))
- (while eshell-current-modifiers
- (setq eshell-current-argument
- (list (car eshell-current-modifiers) eshell-current-argument)
- eshell-current-modifiers (cdr eshell-current-modifiers))))
- (setq eshell-current-modifiers nil))
-
-(defun eshell-finish-arg (&optional argument)
- "Finish the current argument being processed."
- (if argument
- (setq eshell-current-argument argument))
- (throw 'eshell-arg-done t))
-
-(defsubst eshell-arg-delimiter (&optional pos)
- "Return non-nil if POS is an argument delimiter.
-If POS is nil, the location of point is checked."
- (let ((pos (or pos (point))))
- (or (= pos (point-max))
- (memq (char-after pos) eshell-delimiter-argument-list))))
-
-;; Argument parsing
-
-(defun eshell-parse-arguments (beg end)
- "Parse all of the arguments at point from BEG to END.
-Returns the list of arguments in their raw form.
-Point is left at the end of the arguments."
- (save-excursion
- (save-restriction
- (goto-char beg)
- (narrow-to-region beg end)
- (let ((inhibit-point-motion-hooks t)
- (args (list t))
- after-change-functions
- delim)
- (remove-text-properties (point-min) (point-max)
- '(arg-begin nil arg-end nil))
- (if (setq
- delim
- (catch 'eshell-incomplete
- (while (not (eobp))
- (let* ((here (point))
- (arg (eshell-parse-argument)))
- (if (= (point) here)
- (error "Failed to parse argument '%s'"
- (buffer-substring here (point-max))))
- (and arg (nconc args (list arg)))))))
- (if (listp delim)
- (throw 'eshell-incomplete delim)
- (throw 'eshell-incomplete
- (list delim (point) (cdr args)))))
- (cdr args)))))
-
-(defun eshell-parse-argument ()
- "Get the next argument. Leave point after it."
- (let* ((outer (null eshell-nested-argument))
- (arg-begin (and outer (point)))
- (eshell-nested-argument t)
- eshell-current-argument
- eshell-current-modifiers
- eshell-arg-listified)
- (catch 'eshell-arg-done
- (while (not (eobp))
- (let ((result
- (or (run-hook-with-args-until-success
- 'eshell-parse-argument-hook)
- (prog1
- (char-to-string (char-after))
- (forward-char)))))
- (if (not eshell-current-argument)
- (setq eshell-current-argument result)
- (unless eshell-arg-listified
- (setq eshell-current-argument
- (list eshell-current-argument)
- eshell-arg-listified t))
- (nconc eshell-current-argument (list result))))))
- (when (and outer eshell-current-argument)
- (add-text-properties arg-begin (1+ arg-begin)
- '(arg-begin t rear-nonsticky
- (arg-begin arg-end)))
- (add-text-properties (1- (point)) (point)
- '(arg-end t rear-nonsticky
- (arg-end arg-begin))))
- (eshell-resolve-current-argument)
- eshell-current-argument))
-
-(defsubst eshell-operator (&rest args)
- "A stub function that generates an error if a floating operator is found."
- (error "Unhandled operator in input text"))
-
-(defsubst eshell-looking-at-backslash-return (pos)
- "Test whether a backslash-return sequence occurs at POS."
- (and (eq (char-after pos) ?\\)
- (or (= (1+ pos) (point-max))
- (and (eq (char-after (1+ pos)) ?\n)
- (= (+ pos 2) (point-max))))))
-
-(defun eshell-quote-backslash (string &optional index)
- "Intelligently backslash the character occuring in STRING at INDEX.
-If the character is itself a backslash, it needs no escaping."
- (let ((char (aref string index)))
- (if (eq char ?\\)
- (char-to-string char)
- (if (memq char eshell-special-chars-outside-quoting)
- (string ?\\ char)))))
-
-(defun eshell-parse-backslash ()
- "Parse a single backslash (\) character, which might mean escape.
-It only means escape if the character immediately following is a
-special character that is not itself a backslash."
- (when (eq (char-after) ?\\)
- (if (eshell-looking-at-backslash-return (point))
- (throw 'eshell-incomplete ?\\)
- (if (and (not (eq (char-after (1+ (point))) ?\\))
- (if eshell-current-quoted
- (memq (char-after (1+ (point)))
- eshell-special-chars-inside-quoting)
- (memq (char-after (1+ (point)))
- eshell-special-chars-outside-quoting)))
- (progn
- (forward-char 2)
- (list 'eshell-escape-arg
- (char-to-string (char-before))))
- ;; allow \\<RET> to mean a literal "\" character followed by a
- ;; normal return, rather than a backslash followed by a line
- ;; continuator (i.e., "\\ + \n" rather than "\ + \\n"). This
- ;; is necessary because backslashes in Eshell are not special
- ;; unless they either precede something special, or precede a
- ;; backslash that precedes something special. (Mainly this is
- ;; done to make using backslash on Windows systems more
- ;; natural-feeling).
- (if (eshell-looking-at-backslash-return (1+ (point)))
- (forward-char))
- (forward-char)
- "\\"))))
-
-(defun eshell-parse-literal-quote ()
- "Parse a literally quoted string. Nothing has special meaning!"
- (if (eq (char-after) ?\')
- (let ((end (eshell-find-delimiter ?\' ?\')))
- (if (not end)
- (throw 'eshell-incomplete ?\')
- (let ((string (buffer-substring-no-properties (1+ (point)) end)))
- (goto-char (1+ end))
- (while (string-match "''" string)
- (setq string (replace-match "'" t t string)))
- (list 'eshell-escape-arg string))))))
-
-(defun eshell-parse-double-quote ()
- "Parse a double quoted string, which allows for variable interpolation."
- (when (eq (char-after) ?\")
- (let* ((end (eshell-find-delimiter ?\" ?\" nil nil t))
- (eshell-current-quoted t))
- (if (not end)
- (throw 'eshell-incomplete ?\")
- (prog1
- (save-restriction
- (forward-char)
- (narrow-to-region (point) end)
- (list 'eshell-escape-arg
- (eshell-parse-argument)))
- (goto-char (1+ end)))))))
-
-(defun eshell-parse-special-reference ()
- "Parse a special syntax reference, of the form '#<type arg>'."
- (if (and (not eshell-current-argument)
- (not eshell-current-quoted)
- (looking-at "#<\\(buffer\\|process\\)\\s-"))
- (let ((here (point)))
- (goto-char (match-end 0))
- (let* ((buffer-p (string= (match-string 1) "buffer"))
- (end (eshell-find-delimiter ?\< ?\>)))
- (if (not end)
- (throw 'eshell-incomplete ?\<)
- (if (eshell-arg-delimiter (1+ end))
- (prog1
- (list (if buffer-p 'get-buffer-create 'get-process)
- (buffer-substring-no-properties (point) end))
- (goto-char (1+ end)))
- (ignore (goto-char here))))))))
-
-(defun eshell-parse-delimiter ()
- "Parse an argument delimiter, which is essentially a command operator."
- ;; this `eshell-operator' keyword gets parsed out by
- ;; `eshell-separate-commands'. Right now the only possibility for
- ;; error is an incorrect output redirection specifier.
- (when (looking-at "[&|;\n]\\s-*")
- (let ((end (match-end 0)))
- (if eshell-current-argument
- (eshell-finish-arg)
- (eshell-finish-arg
- (prog1
- (list 'eshell-operator
- (cond
- ((eq (char-after end) ?\&)
- (setq end (1+ end)) "&&")
- ((eq (char-after end) ?\|)
- (setq end (1+ end)) "||")
- ((eq (char-after) ?\n) ";")
- (t
- (char-to-string (char-after)))))
- (goto-char end)))))))
-
-;;; esh-arg.el ends here
+++ /dev/null
-;;; esh-cmd.el --- command invocation
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-cmd)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-cmd nil
- "Executing an Eshell command is as simple as typing it in and
-pressing <RET>. There are several different kinds of commands,
-however."
- :tag "Command invocation"
- :link '(info-link "(eshell)Command invocation")
- :group 'eshell)
-
-;;; Commentary:
-
-;;;_* Invoking external commands
-;;
-;; External commands cause processes to be created, by loading
-;; external executables into memory. This is what most normal shells
-;; do, most of the time. For more information, see [External commands].
-;;
-;;;_* Invoking Lisp functions
-;;
-;; A Lisp function can be invoked using Lisp syntax, or command shell
-;; syntax. For example, to run `dired' to edit the current directory:
-;;
-;; /tmp $ (dired ".")
-;;
-;; Or:
-;;
-;; /tmp $ dired .
-;;
-;; The latter form is preferable, but the former is more precise,
-;; since it involves no translations. See [Argument parsing], to
-;; learn more about how arguments are transformed before passing them
-;; to commands.
-;;
-;; Ordinarily, if 'dired' were also available as an external command,
-;; the external version would be called in preference to any Lisp
-;; function of the same name. To change this behavior so that Lisp
-;; functions always take precedence, set
-;; `eshell-prefer-lisp-functions' to t.
-
-(defcustom eshell-prefer-lisp-functions nil
- "*If non-nil, prefer Lisp functions to external commands."
- :type 'boolean
- :group 'eshell-cmd)
-
-;;;_* Alias functions
-;;
-;; Whenever a command is specified using a simple name, such as 'ls',
-;; Eshell will first look for a Lisp function of the name `eshell/ls'.
-;; If it exists, it will be called in preference to any other command
-;; which might have matched the name 'ls' (such as command aliases,
-;; external commands, Lisp functions of that name, etc).
-;;
-;; This is the most flexible mechanism for creating new commands,
-;; since it does not pollute the global namespace, yet allows you to
-;; use all of Lisp's facilities to define that piece of functionality.
-;; Most of Eshell's "builtin" commands are defined as alias functions.
-;;
-;;;_* Lisp arguments
-;;
-;; It is possible to invoke a Lisp form as an argument. This can be
-;; done either by specifying the form as you might in Lisp, or by
-;; using the '$' character to introduce a value-interpolation:
-;;
-;; echo (+ 1 2)
-;;
-;; Or
-;;
-;; echo $(+ 1 2)
-;;
-;; The two forms are equivalent. The second is required only if the
-;; form being interpolated is within a string, or is a subexpression
-;; of a larger argument:
-;;
-;; echo x$(+ 1 2) "String $(+ 1 2)"
-;;
-;; To pass a Lisp symbol as a argument, use the alternate quoting
-;; syntax, since the single quote character is far too overused in
-;; shell syntax:
-;;
-;; echo #'lisp-symbol
-;;
-;; Backquote can also be used:
-;;
-;; echo `(list ,lisp-symbol)
-;;
-;; Lisp arguments are identified using the following regexp:
-
-(defcustom eshell-lisp-regexp "\\([(`]\\|#'\\)"
- "*A regexp which, if matched at beginning of an argument, means Lisp.
-Such arguments will be passed to `read', and then evaluated."
- :type 'regexp
- :group 'eshell-cmd)
-
-;;;_* Command hooks
-;;
-;; There are several hooks involved with command execution, which can
-;; be used either to change or augment Eshell's behavior.
-
-(defcustom eshell-pre-command-hook nil
- "*A hook run before each interactive command is invoked."
- :type 'hook
- :group 'eshell-cmd)
-
-(defcustom eshell-post-command-hook nil
- "*A hook run after each interactive command is invoked."
- :type 'hook
- :group 'eshell-cmd)
-
-(defcustom eshell-prepare-command-hook nil
- "*A set of functions called to prepare a named command.
-The command name and its argument are in `eshell-last-command-name'
-and `eshell-last-arguments'. The functions on this hook can change
-the value of these symbols if necessary.
-
-To prevent a command from executing at all, set
-`eshell-last-command-name' to nil."
- :type 'hook
- :group 'eshell-cmd)
-
-(defcustom eshell-named-command-hook nil
- "*A set of functions called before a named command is invoked.
-Each function will be passed the command name and arguments that were
-passed to `eshell-named-command'.
-
-If any of the functions returns a non-nil value, the named command
-will not be invoked, and that value will be returned from
-`eshell-named-command'.
-
-In order to substitute an alternate command form for execution, the
-hook function should throw it using the tag `eshell-replace-command'.
-For example:
-
- (add-hook 'eshell-named-command-hook 'subst-with-cd)
- (defun subst-with-cd (command args)
- (throw 'eshell-replace-command
- (eshell-parse-command \"cd\" args)))
-
-Although useless, the above code will cause any non-glob, non-Lisp
-command (i.e., 'ls' as opposed to '*ls' or '(ls)') to be replaced by a
-call to `cd' using the arguments that were passed to the function."
- :type 'hook
- :group 'eshell-cmd)
-
-(defcustom eshell-pre-rewrite-command-hook
- '(eshell-no-command-conversion
- eshell-subcommand-arg-values)
- "*A hook run before command rewriting begins.
-The terms of the command to be rewritten is passed as arguments, and
-may be modified in place. Any return value is ignored."
- :type 'hook
- :group 'eshell-cmd)
-
-(defcustom eshell-rewrite-command-hook
- '(eshell-rewrite-for-command
- eshell-rewrite-while-command
- eshell-rewrite-if-command
- eshell-rewrite-sexp-command
- eshell-rewrite-initial-subcommand
- eshell-rewrite-named-command)
- "*A set of functions used to rewrite the command argument.
-Once parsing of a command line is completed, the next step is to
-rewrite the initial argument into something runnable.
-
-A module may wish to associate special behavior with certain argument
-syntaxes at the beginning of a command line. They are welcome to do
-so by adding a function to this hook. The first function to return a
-substitute command form is the one used. Each function is passed the
-command's full argument list, which is a list of sexps (typically
-forms or strings)."
- :type 'hook
- :group 'eshell-cmd)
-
-(defcustom eshell-post-rewrite-command-hook nil
- "*A hook run after command rewriting is finished.
-Each function is passed the symbol containing the rewritten command,
-which may be modified directly. Any return value is ignored."
- :type 'hook
- :group 'eshell-cmd)
-
-(defcustom eshell-complex-commands nil
- "*A list of commands names or functions, that determine complexity.
-That is, if a command is defined by a function named eshell/NAME,
-and NAME is part of this list, it is invoked as a complex command.
-Complex commands are always correct, but run much slower. If a
-command works fine without being part of this list, then it doesn't
-need to be.
-
-If an entry is a function, it will be called with the name, and should
-return non-nil if the command is complex."
- :type '(repeat :tag "Commands"
- (choice (string :tag "Name")
- (function :tag "Predicate")))
- :group 'eshell-cmd)
-
-;;; Code:
-
-(require 'esh-util)
-(unless (eshell-under-xemacs-p)
- (require 'eldoc))
-(require 'esh-arg)
-(require 'esh-proc)
-(require 'esh-ext)
-
-;;; User Variables:
-
-(defcustom eshell-cmd-load-hook '(eshell-cmd-initialize)
- "*A hook that gets run when `eshell-cmd' is loaded."
- :type 'hook
- :group 'eshell-cmd)
-
-(defcustom eshell-debug-command nil
- "*If non-nil, enable debugging code. SSLLOOWW.
-This option is only useful for reporting bugs. If you enable it, you
-will have to visit the file 'eshell-cmd.el' and run the command
-\\[eval-buffer]."
- :type 'boolean
- :group 'eshell-cmd)
-
-(defcustom eshell-deferrable-commands
- '(eshell-named-command
- eshell-lisp-command
- eshell-process-identity)
- "*A list of functions which might return an ansychronous process.
-If they return a process object, execution of the calling Eshell
-command will wait for completion (in the background) before finishing
-the command."
- :type '(repeat function)
- :group 'eshell-cmd)
-
-(defcustom eshell-subcommand-bindings
- '((eshell-in-subcommand-p t)
- (default-directory default-directory)
- (process-environment (eshell-copy-environment)))
- "*A list of `let' bindings for subcommand environments."
- :type 'sexp
- :group 'eshell-cmd)
-
-(put 'risky-local-variable 'eshell-subcommand-bindings t)
-
-(defvar eshell-ensure-newline-p nil
- "If non-nil, ensure that a newline is emitted after a Lisp form.
-This can be changed by Lisp forms that are evaluated from the Eshell
-command line.")
-
-;;; Internal Variables:
-
-(defvar eshell-current-command nil)
-(defvar eshell-command-name nil)
-(defvar eshell-command-arguments nil)
-(defvar eshell-in-pipeline-p nil)
-(defvar eshell-in-subcommand-p nil)
-(defvar eshell-last-arguments nil)
-(defvar eshell-last-command-name nil)
-(defvar eshell-last-async-proc nil
- "When this foreground process completes, resume command evaluation.")
-
-;;; Functions:
-
-(defsubst eshell-interactive-process ()
- "Return currently running command process, if non-Lisp."
- eshell-last-async-proc)
-
-(defun eshell-cmd-initialize ()
- "Initialize the Eshell command processing module."
- (set (make-local-variable 'eshell-current-command) nil)
- (set (make-local-variable 'eshell-command-name) nil)
- (set (make-local-variable 'eshell-command-arguments) nil)
- (set (make-local-variable 'eshell-last-arguments) nil)
- (set (make-local-variable 'eshell-last-command-name) nil)
- (set (make-local-variable 'eshell-last-async-proc) nil)
-
- (add-hook 'eshell-kill-hook 'eshell-resume-command nil t)
-
- ;; make sure that if a command is over, and no process is being
- ;; waited for, that `eshell-current-command' is set to nil. This
- ;; situation can occur, for example, if a Lisp function results in
- ;; `debug' being called, and the user then types \\[top-level]
- (add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-current-command nil
- eshell-last-async-proc nil))) nil t)
-
- (add-hook 'eshell-parse-argument-hook
- 'eshell-parse-subcommand-argument nil t)
- (add-hook 'eshell-parse-argument-hook
- 'eshell-parse-lisp-argument nil t)
-
- (when (eshell-using-module 'eshell-cmpl)
- (add-hook 'pcomplete-try-first-hook
- 'eshell-complete-lisp-symbols nil t)))
-
-(eshell-deftest var last-result-var
- "\"last result\" variable"
- (eshell-command-result-p "+ 1 2; + $$ 2" "3\n5\n"))
-
-(eshell-deftest var last-result-var2
- "\"last result\" variable"
- (eshell-command-result-p "+ 1 2; + $$ $$" "3\n6\n"))
-
-(eshell-deftest var last-arg-var
- "\"last arg\" variable"
- (eshell-command-result-p "+ 1 2; + $_ 4" "3\n6\n"))
-
-(defun eshell-complete-lisp-symbols ()
- "If there is a user reference, complete it."
- (let ((arg (pcomplete-actual-arg)))
- (when (string-match (concat "\\`" eshell-lisp-regexp) arg)
- (setq pcomplete-stub (substring arg (match-end 0))
- pcomplete-last-completion-raw t)
- (throw 'pcomplete-completions
- (all-completions pcomplete-stub obarray 'boundp)))))
-
-;; Command parsing
-
-(defun eshell-parse-command (command &optional args top-level)
- "Parse the COMMAND, adding ARGS if given.
-COMMAND can either be a string, or a cons cell demarcating a buffer
-region. TOP-LEVEL, if non-nil, means that the outermost command (the
-user's input command) is being parsed, and that pre and post command
-hooks should be run before and after the command."
- (let* (sep-terms
- (terms
- (append
- (if (consp command)
- (eshell-parse-arguments (car command) (cdr command))
- (let ((here (point))
- (inhibit-point-motion-hooks t)
- after-change-functions)
- (insert command)
- (prog1
- (eshell-parse-arguments here (point))
- (delete-region here (point)))))
- args))
- (commands
- (mapcar
- (function
- (lambda (cmd)
- (if (or (not (car sep-terms))
- (string= (car sep-terms) ";"))
- (setq cmd
- (eshell-parse-pipeline cmd (not (car sep-terms))))
- (setq cmd
- (list 'eshell-do-subjob
- (list 'list (eshell-parse-pipeline cmd)))))
- (setq sep-terms (cdr sep-terms))
- (if eshell-in-pipeline-p
- cmd
- (list 'eshell-trap-errors cmd))))
- (eshell-separate-commands terms "[&;]" nil 'sep-terms))))
- (let ((cmd commands))
- (while cmd
- (if (cdr cmd)
- (setcar cmd (list 'eshell-commands (car cmd))))
- (setq cmd (cdr cmd))))
- (setq commands
- (append (list 'progn)
- (if top-level
- (list '(run-hooks 'eshell-pre-command-hook)))
- (if (not top-level)
- commands
- (list
- (list 'catch (quote 'top-level)
- (append (list 'progn) commands))
- '(run-hooks 'eshell-post-command-hook)))))
- (if top-level
- (list 'eshell-commands commands)
- commands)))
-
-(defun eshell-debug-show-parsed-args (terms)
- "Display parsed arguments in the debug buffer."
- (ignore
- (if eshell-debug-command
- (eshell-debug-command "parsed arguments" terms))))
-
-(defun eshell-no-command-conversion (terms)
- "Don't convert the command argument."
- (ignore
- (if (and (listp (car terms))
- (eq (caar terms) 'eshell-convert))
- (setcar terms (cadr (car terms))))))
-
-(defun eshell-subcommand-arg-values (terms)
- "Convert subcommand arguments {x} to ${x}, in order to take their values."
- (setq terms (cdr terms)) ; skip command argument
- (while terms
- (if (and (listp (car terms))
- (eq (caar terms) 'eshell-as-subcommand))
- (setcar terms (list 'eshell-convert
- (list 'eshell-command-to-value
- (car terms)))))
- (setq terms (cdr terms))))
-
-(defun eshell-rewrite-sexp-command (terms)
- "Rewrite a sexp in initial position, such as '(+ 1 2)'."
- ;; this occurs when a Lisp expression is in first position
- (if (and (listp (car terms))
- (eq (caar terms) 'eshell-command-to-value))
- (car (cdar terms))))
-
-(eshell-deftest cmd lisp-command
- "Evaluate Lisp command"
- (eshell-command-result-p "(+ 1 2)" "3"))
-
-(eshell-deftest cmd lisp-command-args
- "Evaluate Lisp command (ignore args)"
- (eshell-command-result-p "(+ 1 2) 3" "3"))
-
-(defun eshell-rewrite-initial-subcommand (terms)
- "Rewrite a subcommand in initial position, such as '{+ 1 2}'."
- (if (and (listp (car terms))
- (eq (caar terms) 'eshell-as-subcommand))
- (car terms)))
-
-(eshell-deftest cmd subcommand
- "Run subcommand"
- (eshell-command-result-p "{+ 1 2}" "3\n"))
-
-(eshell-deftest cmd subcommand-args
- "Run subcommand (ignore args)"
- (eshell-command-result-p "{+ 1 2} 3" "3\n"))
-
-(eshell-deftest cmd subcommand-lisp
- "Run subcommand + Lisp form"
- (eshell-command-result-p "{(+ 1 2)}" "3\n"))
-
-(defun eshell-rewrite-named-command (terms)
- "If no other rewriting rule transforms TERMS, assume a named command."
- (list (if eshell-in-pipeline-p
- 'eshell-named-command*
- 'eshell-named-command)
- (car terms)
- (and (cdr terms)
- (append (list 'list) (cdr terms)))))
-
-(eshell-deftest cmd named-command
- "Execute named command"
- (eshell-command-result-p "+ 1 2" "3\n"))
-
-(eval-when-compile
- (defvar eshell-command-body)
- (defvar eshell-test-body))
-
-(defsubst eshell-invokify-arg (arg &optional share-output silent)
- "Change ARG so it can be invoked from a structured command.
-
-SHARE-OUTPUT, if non-nil, means this invocation should share the
-current output stream, which is separately redirectable. SILENT
-means the user and/or any redirections shouldn't see any output
-from this command. If both SHARE-OUTPUT and SILENT are non-nil,
-the second is ignored."
- ;; something that begins with `eshell-convert' means that it
- ;; intends to return a Lisp value. We want to get past this,
- ;; but if it's not _actually_ a value interpolation -- in which
- ;; we leave it alone. In fact, the only time we muck with it
- ;; is in the case of a {subcommand} that has been turned into
- ;; the interpolation, ${subcommand}, by the parser because it
- ;; didn't know better.
- (if (and (listp arg)
- (eq (car arg) 'eshell-convert)
- (eq (car (cadr arg)) 'eshell-command-to-value))
- (if share-output
- (cadr (cadr arg))
- (list 'eshell-commands (cadr (cadr arg))
- silent))
- arg))
-
-(defun eshell-rewrite-for-command (terms)
- "Rewrite a `for' command into its equivalent Eshell command form.
-Because the implementation of `for' relies upon conditional evaluation
-of its argumbent (i.e., use of a Lisp special form), it must be
-implemented via rewriting, rather than as a function."
- (if (and (stringp (car terms))
- (string= (car terms) "for")
- (stringp (nth 2 terms))
- (string= (nth 2 terms) "in"))
- (let ((body (car (last terms))))
- (setcdr (last terms 2) nil)
- (list
- 'let (list (list 'for-items
- (append
- (list 'append)
- (mapcar
- (function
- (lambda (elem)
- (if (listp elem)
- elem
- (list 'list elem))))
- (cdr (cddr terms)))))
- (list 'eshell-command-body
- (list 'quote (list nil)))
- (list 'eshell-test-body
- (list 'quote (list nil))))
- (list
- 'progn
- (list
- 'while (list 'car (list 'symbol-value
- (list 'quote 'for-items)))
- (list
- 'progn
- (list 'let
- (list (list (intern (cadr terms))
- (list 'car
- (list 'symbol-value
- (list 'quote 'for-items)))))
- (list 'eshell-protect
- (eshell-invokify-arg body t)))
- (list 'setcar 'for-items
- (list 'cadr
- (list 'symbol-value
- (list 'quote 'for-items))))
- (list 'setcdr 'for-items
- (list 'cddr
- (list 'symbol-value
- (list 'quote 'for-items))))))
- (list 'eshell-close-handles
- 'eshell-last-command-status
- (list 'list (quote 'quote)
- 'eshell-last-command-result)))))))
-
-(defun eshell-structure-basic-command (func names keyword test body
- &optional else vocal-test)
- "With TERMS, KEYWORD, and two NAMES, structure a basic command.
-The first of NAMES should be the positive form, and the second the
-negative. It's not likely that users should ever need to call this
-function.
-
-If VOCAL-TEST is non-nil, it means output from the test should be
-shown, as well as output from the body."
- ;; If the test form begins with `eshell-convert', it means
- ;; something data-wise will be returned, and we should let
- ;; that determine the truth of the statement.
- (unless (eq (car test) 'eshell-convert)
- (setq test
- (list 'progn test
- (list 'eshell-exit-success-p))))
-
- ;; should we reverse the sense of the test? This depends
- ;; on the `names' parameter. If it's the symbol nil, yes.
- ;; Otherwise, it can be a pair of strings; if the keyword
- ;; we're using matches the second member of that pair (a
- ;; list), we should reverse it.
- (if (or (eq names nil)
- (and (listp names)
- (string= keyword (cadr names))))
- (setq test (list 'not test)))
-
- ;; finally, create the form that represents this structured
- ;; command
- (list
- 'let (list (list 'eshell-command-body
- (list 'quote (list nil)))
- (list 'eshell-test-body
- (list 'quote (list nil))))
- (list func test body else)
- (list 'eshell-close-handles
- 'eshell-last-command-status
- (list 'list (quote 'quote)
- 'eshell-last-command-result))))
-
-(defun eshell-rewrite-while-command (terms)
- "Rewrite a `while' command into its equivalent Eshell command form.
-Because the implementation of `while' relies upon conditional
-evaluation of its argument (i.e., use of a Lisp special form), it
-must be implemented via rewriting, rather than as a function."
- (if (and (stringp (car terms))
- (member (car terms) '("while" "until")))
- (eshell-structure-basic-command
- 'while '("while" "until") (car terms)
- (eshell-invokify-arg (cadr terms) nil t)
- (list 'eshell-protect
- (eshell-invokify-arg (car (last terms)) t)))))
-
-(defun eshell-rewrite-if-command (terms)
- "Rewrite an `if' command into its equivalent Eshell command form.
-Because the implementation of `if' relies upon conditional
-evaluation of its argument (i.e., use of a Lisp special form), it
-must be implemented via rewriting, rather than as a function."
- (if (and (stringp (car terms))
- (member (car terms) '("if" "unless")))
- (eshell-structure-basic-command
- 'if '("if" "unless") (car terms)
- (eshell-invokify-arg (cadr terms) nil t)
- (list 'eshell-protect
- (eshell-invokify-arg
- (if (= (length terms) 4)
- (car (last terms 2))
- (car (last terms))) t))
- (if (= (length terms) 4)
- (list 'eshell-protect
- (eshell-invokify-arg
- (car (last terms)))) t))))
-
-(defun eshell-exit-success-p ()
- "Return non-nil if the last command was \"successful\".
-For a bit of Lisp code, this means a return value of non-nil.
-For an external command, it means an exit code of 0."
- (if (save-match-data
- (string-match "#<\\(Lisp object\\|function .*\\)>"
- eshell-last-command-name))
- eshell-last-command-result
- (= eshell-last-command-status 0)))
-
-(defun eshell-parse-pipeline (terms &optional final-p)
- "Parse a pipeline from TERMS, return the appropriate Lisp forms."
- (let* (sep-terms
- (bigpieces (eshell-separate-commands terms "\\(&&\\|||\\)"
- nil 'sep-terms))
- (bp bigpieces)
- (results (list t))
- final)
- (while bp
- (let ((subterms (car bp)))
- (let* ((pieces (eshell-separate-commands subterms "|"))
- (p pieces))
- (while p
- (let ((cmd (car p)))
- (run-hook-with-args 'eshell-pre-rewrite-command-hook cmd)
- (setq cmd (run-hook-with-args-until-success
- 'eshell-rewrite-command-hook cmd))
- (run-hook-with-args 'eshell-post-rewrite-command-hook 'cmd)
- (setcar p cmd))
- (setq p (cdr p)))
- (nconc results
- (list
- (if (<= (length pieces) 1)
- (car pieces)
- (assert (not eshell-in-pipeline-p))
- (list 'eshell-execute-pipeline
- (list 'quote pieces))))))
- (setq bp (cdr bp))))
- ;; `results' might be empty; this happens in the case of
- ;; multi-line input
- (setq results (cdr results)
- results (nreverse results)
- final (car results)
- results (cdr results)
- sep-terms (nreverse sep-terms))
- (while results
- (assert (car sep-terms))
- (setq final (eshell-structure-basic-command
- 'if (string= (car sep-terms) "&&") "if"
- (list 'eshell-protect (car results))
- (list 'eshell-protect final)
- nil t)
- results (cdr results)
- sep-terms (cdr sep-terms)))
- final))
-
-(defun eshell-parse-subcommand-argument ()
- "Parse a subcommand argument of the form '{command}'."
- (if (and (not eshell-current-argument)
- (not eshell-current-quoted)
- (eq (char-after) ?\{)
- (or (= (point-max) (1+ (point)))
- (not (eq (char-after (1+ (point))) ?\}))))
- (let ((end (eshell-find-delimiter ?\{ ?\})))
- (if (not end)
- (throw 'eshell-incomplete ?\{)
- (when (eshell-arg-delimiter (1+ end))
- (prog1
- (list 'eshell-as-subcommand
- (eshell-parse-command (cons (1+ (point)) end)))
- (goto-char (1+ end))))))))
-
-(defun eshell-parse-lisp-argument ()
- "Parse a Lisp expression which is specified as an argument."
- (if (and (not eshell-current-argument)
- (not eshell-current-quoted)
- (looking-at eshell-lisp-regexp))
- (let* ((here (point))
- (obj
- (condition-case err
- (read (current-buffer))
- (end-of-file
- (throw 'eshell-incomplete ?\()))))
- (if (eshell-arg-delimiter)
- (list 'eshell-command-to-value
- (list 'eshell-lisp-command (list 'quote obj)))
- (ignore (goto-char here))))))
-
-(defun eshell-separate-commands (terms separator &optional
- reversed last-terms-sym)
- "Separate TERMS using SEPARATOR.
-If REVERSED is non-nil, the list of separated term groups will be
-returned in reverse order. If LAST-TERMS-SYM is a symbol, its value
-will be set to a list of all the separator operators found (or '(list
-nil)' if none)."
- (let ((sub-terms (list t))
- (eshell-sep-terms (list t))
- subchains)
- (while terms
- (if (and (consp (car terms))
- (eq (caar terms) 'eshell-operator)
- (string-match (concat "^" separator "$")
- (nth 1 (car terms))))
- (progn
- (nconc eshell-sep-terms (list (nth 1 (car terms))))
- (setq subchains (cons (cdr sub-terms) subchains)
- sub-terms (list t)))
- (nconc sub-terms (list (car terms))))
- (setq terms (cdr terms)))
- (if (> (length sub-terms) 1)
- (setq subchains (cons (cdr sub-terms) subchains)))
- (if reversed
- (progn
- (if last-terms-sym
- (set last-terms-sym (reverse (cdr eshell-sep-terms))))
- subchains) ; already reversed
- (if last-terms-sym
- (set last-terms-sym (cdr eshell-sep-terms)))
- (nreverse subchains))))
-
-;;_* Command evaluation macros
-;;
-;; The structure of the following macros is very important to
-;; `eshell-do-eval' [Iterative evaluation]:
-;;
-;; @ Don't use forms that conditionally evaluate their arguments, such
-;; as `setq', `if', `while', `let*', etc. The only special forms
-;; that can be used are `let', `condition-case' and
-;; `unwind-protect'.
-;;
-;; @ The main body of a `let' can contain only one form. Use `progn'
-;; if necessary.
-;;
-;; @ The two `special' variables are `eshell-current-handles' and
-;; `eshell-current-subjob-p'. Bind them locally with a `let' if you
-;; need to change them. Change them directly only if your intention
-;; is to change the calling environment.
-
-(defmacro eshell-do-subjob (object)
- "Evaluate a command OBJECT as a subjob.
-We indicate thet the process was run in the background by returned it
-ensconced in a list."
- `(let ((eshell-current-subjob-p t))
- ,object))
-
-(defmacro eshell-commands (object &optional silent)
- "Place a valid set of handles, and context, around command OBJECT."
- `(let ((eshell-current-handles
- (eshell-create-handles ,(not silent) 'append))
- eshell-current-subjob-p)
- ,object))
-
-(defmacro eshell-trap-errors (object)
- "Trap any errors that occur, so they are not entirely fatal.
-Also, the variable `eshell-this-command-hook' is available for the
-duration of OBJECT's evaluation. Note that functions should be added
-to this hook using `nconc', and *not* `add-hook'.
-
-Someday, when Scheme will become the dominant Emacs language, all of
-this grossness will be made to disappear by using `call/cc'..."
- `(let ((eshell-this-command-hook (list 'ignore)))
- (eshell-condition-case err
- (prog1
- ,object
- (run-hooks 'eshell-this-command-hook))
- (error
- (run-hooks 'eshell-this-command-hook)
- (eshell-errorn (error-message-string err))
- (eshell-close-handles 1)))))
-
-(defmacro eshell-copy-handles (object)
- "Duplicate current I/O handles, so OBJECT works with its own copy."
- `(let ((eshell-current-handles
- (eshell-create-handles
- (car (aref eshell-current-handles
- eshell-output-handle)) nil
- (car (aref eshell-current-handles
- eshell-error-handle)) nil)))
- ,object))
-
-(defmacro eshell-protect (object)
- "Protect I/O handles, so they aren't get closed after eval'ing OBJECT."
- `(progn
- (eshell-protect-handles eshell-current-handles)
- ,object))
-
-(defmacro eshell-do-pipelines (pipeline)
- "Execute the commands in PIPELINE, connecting each to one another."
- (when (setq pipeline (cadr pipeline))
- `(eshell-copy-handles
- (progn
- ,(when (cdr pipeline)
- `(let (nextproc)
- (progn
- (set 'nextproc
- (eshell-do-pipelines (quote ,(cdr pipeline))))
- (eshell-set-output-handle ,eshell-output-handle
- 'append nextproc)
- (eshell-set-output-handle ,eshell-error-handle
- 'append nextproc)
- (set 'tailproc (or tailproc nextproc)))))
- ,(let ((head (car pipeline)))
- (if (memq (car head) '(let progn))
- (setq head (car (last head))))
- (when (memq (car head) eshell-deferrable-commands)
- (ignore
- (setcar head
- (intern-soft
- (concat (symbol-name (car head)) "*"))))))
- ,(car pipeline)))))
-
-(defmacro eshell-do-pipelines-synchronously (pipeline)
- "Execute the commands in PIPELINE in sequence synchronously.
-Output of each command is passed as input to the next one in the pipeline.
-This is used on systems where `start-process' is not supported."
- (when (setq pipeline (cadr pipeline))
- `(let (result)
- (progn
- ,(when (cdr pipeline)
- `(let (output-marker)
- (progn
- (set 'output-marker ,(point-marker))
- (eshell-set-output-handle ,eshell-output-handle
- 'append output-marker)
- (eshell-set-output-handle ,eshell-error-handle
- 'append output-marker))))
- ,(let ((head (car pipeline)))
- (if (memq (car head) '(let progn))
- (setq head (car (last head))))
- ;;; FIXME: is deferrable significant here?
- (when (memq (car head) eshell-deferrable-commands)
- (ignore
- (setcar head
- (intern-soft
- (concat (symbol-name (car head)) "*"))))))
- ;; The last process in the pipe should get its handles
- ;; redirected as we found them before running the pipe.
- ,(if (null (cdr pipeline))
- `(progn
- (set 'eshell-current-handles tail-handles)
- (set 'eshell-in-pipeline-p nil)))
- (set 'result ,(car pipeline))
- ;; tailproc gets the result of the last successful process in
- ;; the pipeline.
- (set 'tailproc (or result tailproc))
- ,(if (cdr pipeline)
- `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))
- result))))
-
-(defalias 'eshell-process-identity 'identity)
-
-(defmacro eshell-execute-pipeline (pipeline)
- "Execute the commands in PIPELINE, connecting each to one another."
- `(let ((eshell-in-pipeline-p t) tailproc)
- (progn
- ,(if (fboundp 'start-process)
- `(eshell-do-pipelines ,pipeline)
- `(let ((tail-handles (eshell-create-handles
- (car (aref eshell-current-handles
- ,eshell-output-handle)) nil
- (car (aref eshell-current-handles
- ,eshell-error-handle)) nil)))
- (eshell-do-pipelines-synchronously ,pipeline)))
- (eshell-process-identity tailproc))))
-
-(defmacro eshell-as-subcommand (command)
- "Execute COMMAND using a temp buffer.
-This is used so that certain Lisp commands, such as `cd', when
-executed in a subshell, do not disturb the environment of the main
-Eshell buffer."
- `(let ,eshell-subcommand-bindings
- ,command))
-
-(defmacro eshell-do-command-to-value (object)
- "Run a subcommand prepared by `eshell-command-to-value'.
-This avoids the need to use `let*'."
- `(let ((eshell-current-handles
- (eshell-create-handles value 'overwrite)))
- (progn
- ,object
- (symbol-value value))))
-
-(defmacro eshell-command-to-value (object)
- "Run OBJECT synchronously, returning its result as a string.
-Returns a string comprising the output from the command."
- `(let ((value (make-symbol "eshell-temp")))
- (eshell-do-command-to-value ,object)))
-
-;;;_* Iterative evaluation
-;;
-;; Eshell runs all of its external commands asynchronously, so that
-;; Emacs is not blocked while the operation is being performed.
-;; However, this introduces certain synchronization difficulties,
-;; since the Lisp code, once it returns, will not "go back" to finish
-;; executing the commands which haven't yet been started.
-;;
-;; What Eshell does to work around this problem (basically, the lack
-;; of threads in Lisp), is that it evaluates the command sequence
-;; iteratively. Whenever an asynchronous process is begun, evaluation
-;; terminates and control is given back to Emacs. When that process
-;; finishes, it will resume the evaluation using the remainder of the
-;; command tree.
-
-(defun eshell/eshell-debug (&rest args)
- "A command for toggling certain debug variables."
- (ignore
- (cond
- ((not args)
- (if eshell-handle-errors
- (eshell-print "errors\n"))
- (if eshell-debug-command
- (eshell-print "commands\n")))
- ((or (string= (car args) "-h")
- (string= (car args) "--help"))
- (eshell-print "usage: eshell-debug [kinds]
-
-This command is used to aid in debugging problems related to Eshell
-itself. It is not useful for anything else. The recognized `kinds'
-at the moment are:
-
- errors stops Eshell from trapping errors
- commands shows command execution progress in `*eshell last cmd*'
-"))
- (t
- (while args
- (cond
- ((string= (car args) "errors")
- (setq eshell-handle-errors (not eshell-handle-errors)))
- ((string= (car args) "commands")
- (setq eshell-debug-command (not eshell-debug-command))))
- (setq args (cdr args)))))))
-
-(defun pcomplete/eshell-mode/eshell-debug ()
- "Completion for the `debug' command."
- (while (pcomplete-here '("errors" "commands"))))
-
-(defun eshell-debug-command (tag subform)
- "Output a debugging message to '*eshell last cmd*'."
- (let ((buf (get-buffer-create "*eshell last cmd*"))
- (text (eshell-stringify eshell-current-command)))
- (save-excursion
- (set-buffer buf)
- (if (not tag)
- (erase-buffer)
- (insert "\n\C-l\n" tag "\n\n" text
- (if subform
- (concat "\n\n" (eshell-stringify subform)) ""))))))
-
-(defun eshell-invoke-directly (command input)
- (let ((base (cadr (nth 2 (nth 2 (cadr command))))) name)
- (if (and (eq (car base) 'eshell-trap-errors)
- (eq (car (cadr base)) 'eshell-named-command))
- (setq name (cadr (cadr base))))
- (and name (stringp name)
- (not (member name eshell-complex-commands))
- (catch 'simple
- (progn
- (eshell-for pred eshell-complex-commands
- (if (and (functionp pred)
- (funcall pred name))
- (throw 'simple nil)))
- t))
- (fboundp (intern-soft (concat "eshell/" name))))))
-
-(defun eshell-eval-command (command &optional input)
- "Evaluate the given COMMAND iteratively."
- (if eshell-current-command
- ;; we can just stick the new command at the end of the current
- ;; one, and everything will happen as it should
- (setcdr (last (cdr eshell-current-command))
- (list (list 'let '((here (and (eobp) (point))))
- (and input
- (list 'insert-and-inherit
- (concat input "\n")))
- '(if here
- (eshell-update-markers here))
- (list 'eshell-do-eval
- (list 'quote command)))))
- (and eshell-debug-command
- (save-excursion
- (let ((buf (get-buffer-create "*eshell last cmd*")))
- (set-buffer buf)
- (erase-buffer)
- (insert "command: \"" input "\"\n"))))
- (setq eshell-current-command command)
- (let ((delim (catch 'eshell-incomplete
- (eshell-resume-eval))))
- ;; On systems that don't support async subprocesses, eshell-resume
- ;; can return t. Don't treat that as an error.
- (if (and delim (not (eq delim t)))
- (error "Unmatched delimiter: %c"
- (if (listp delim)
- (car delim)
- delim))))))
-
-(defun eshell-resume-command (proc status)
- "Resume the current command when a process ends."
- (when proc
- (unless (or (not (stringp status))
- (string= "stopped" status)
- (string-match eshell-reset-signals status))
- (if (eq proc (eshell-interactive-process))
- (eshell-resume-eval)))))
-
-(defun eshell-resume-eval ()
- "Destructively evaluate a form which may need to be deferred."
- (eshell-condition-case err
- (progn
- (setq eshell-last-async-proc nil)
- (when eshell-current-command
- (let* (retval
- (proc (catch 'eshell-defer
- (ignore
- (setq retval
- (eshell-do-eval
- eshell-current-command))))))
- (if (eshell-processp proc)
- (ignore (setq eshell-last-async-proc proc))
- (cadr retval)))))
- (error
- (error (error-message-string err)))))
-
-(defmacro eshell-manipulate (tag &rest commands)
- "Manipulate a COMMAND form, with TAG as a debug identifier."
- (if (not eshell-debug-command)
- `(progn ,@commands)
- `(progn
- (eshell-debug-command ,(eval tag) form)
- ,@commands
- (eshell-debug-command ,(concat "done " (eval tag)) form))))
-
-(put 'eshell-manipulate 'lisp-indent-function 1)
-
-;; eshell-lookup-function, eshell-functionp, and eshell-macrop taken
-;; from edebug
-
-(defsubst eshell-lookup-function (object)
- "Return the ultimate function definition of OBJECT."
- (while (and (symbolp object) (fboundp object))
- (setq object (symbol-function object)))
- object)
-
-(defconst function-p-func
- (if (fboundp 'compiled-function-p)
- 'compiled-function-p
- 'byte-code-function-p))
-
-(defsubst eshell-functionp (object)
- "Returns the function named by OBJECT, or nil if it is not a function."
- (setq object (eshell-lookup-function object))
- (if (or (subrp object)
- (funcall function-p-func object)
- (and (listp object)
- (eq (car object) 'lambda)
- (listp (car (cdr object)))))
- object))
-
-(defsubst eshell-macrop (object)
- "Return t if OBJECT is a macro or nil otherwise."
- (setq object (eshell-lookup-function object))
- (if (and (listp object)
- (eq 'macro (car object))
- (eshell-functionp (cdr object)))
- t))
-
-(defun eshell-do-eval (form &optional synchronous-p)
- "Evaluate form, simplifying it as we go.
-Unless SYNCHRONOUS-P is non-nil, throws `eshell-defer' if it needs to
-be finished later after the completion of an asynchronous subprocess."
- (cond
- ((not (listp form))
- (list 'quote (eval form)))
- ((memq (car form) '(quote function))
- form)
- (t
- ;; skip past the call to `eshell-do-eval'
- (when (eq (car form) 'eshell-do-eval)
- (setq form (cadr (cadr form))))
- ;; expand any macros directly into the form. This is done so that
- ;; we can modify any `let' forms to evaluate only once.
- (if (eshell-macrop (car form))
- (let ((exp (eshell-copy-tree (macroexpand form))))
- (eshell-manipulate (format "expanding macro `%s'"
- (symbol-name (car form)))
- (setcar form (car exp))
- (setcdr form (cdr exp)))))
- (let ((args (cdr form)))
- (cond
- ((eq (car form) 'while)
- ;; `eshell-copy-tree' is needed here so that the test argument
- ;; doesn't get modified and thus always yield the same result.
- (when (car eshell-command-body)
- (assert (not synchronous-p))
- (eshell-do-eval (car eshell-command-body))
- (setcar eshell-command-body nil)
- (setcar eshell-test-body nil))
- (unless (car eshell-test-body)
- (setcar eshell-test-body (eshell-copy-tree (car args))))
- (while (cadr (eshell-do-eval (car eshell-test-body)))
- (setcar eshell-command-body (eshell-copy-tree (cadr args)))
- (eshell-do-eval (car eshell-command-body) synchronous-p)
- (setcar eshell-command-body nil)
- (setcar eshell-test-body (eshell-copy-tree (car args))))
- (setcar eshell-command-body nil))
- ((eq (car form) 'if)
- ;; `eshell-copy-tree' is needed here so that the test argument
- ;; doesn't get modified and thus always yield the same result.
- (if (car eshell-command-body)
- (progn
- (assert (not synchronous-p))
- (eshell-do-eval (car eshell-command-body)))
- (unless (car eshell-test-body)
- (setcar eshell-test-body (eshell-copy-tree (car args))))
- (if (cadr (eshell-do-eval (car eshell-test-body)))
- (setcar eshell-command-body (eshell-copy-tree (cadr args)))
- (setcar eshell-command-body (eshell-copy-tree (car (cddr args)))))
- (eshell-do-eval (car eshell-command-body) synchronous-p))
- (setcar eshell-command-body nil)
- (setcar eshell-test-body nil))
- ((eq (car form) 'setcar)
- (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
- (eval form))
- ((eq (car form) 'setcdr)
- (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
- (eval form))
- ((memq (car form) '(let catch condition-case unwind-protect))
- ;; `let', `condition-case' and `unwind-protect' have to be
- ;; handled specially, because we only want to call
- ;; `eshell-do-eval' on their first form.
- ;;
- ;; NOTE: This requires obedience by all forms which this
- ;; function might encounter, that they do not contain
- ;; other special forms.
- (if (and (eq (car form) 'let)
- (not (eq (car (cadr args)) 'eshell-do-eval)))
- (eshell-manipulate "evaluating let args"
- (eshell-for letarg (car args)
- (if (and (listp letarg)
- (not (eq (cadr letarg) 'quote)))
- (setcdr letarg
- (list (eshell-do-eval
- (cadr letarg) synchronous-p)))))))
- (unless (eq (car form) 'unwind-protect)
- (setq args (cdr args)))
- (unless (eq (caar args) 'eshell-do-eval)
- (eshell-manipulate "handling special form"
- (setcar args (list 'eshell-do-eval
- (list 'quote (car args))
- synchronous-p))))
- (eval form))
- (t
- (if (and args (not (memq (car form) '(run-hooks))))
- (eshell-manipulate
- (format "evaluating arguments to `%s'"
- (symbol-name (car form)))
- (while args
- (setcar args (eshell-do-eval (car args) synchronous-p))
- (setq args (cdr args)))))
- (cond
- ((eq (car form) 'progn)
- (car (last form)))
- ((eq (car form) 'prog1)
- (cadr form))
- (t
- ;; If a command desire to replace its execution form with
- ;; another command form, all it needs to do is throw the new
- ;; form using the exception tag `eshell-replace-command'.
- ;; For example, let's say that the form currently being
- ;; eval'd is:
- ;;
- ;; (eshell-named-command "hello")
- ;;
- ;; Now, let's assume the 'hello' command is an Eshell alias,
- ;; the definition of which yields the command:
- ;;
- ;; (eshell-named-command "echo" (list "Hello" "world"))
- ;;
- ;; What the alias code would like to do is simply substitute
- ;; the alias form for the original form. To accomplish
- ;; this, all it needs to do is to throw the substitution
- ;; form with the `eshell-replace-command' tag, and the form
- ;; will be replaced within the current command, and
- ;; execution will then resume (iteratively) as before.
- ;; Thus, aliases can even contain references to asynchronous
- ;; sub-commands, and things will still work out as they
- ;; should.
- (let (result new-form)
- (if (setq new-form
- (catch 'eshell-replace-command
- (ignore
- (setq result (eval form)))))
- (progn
- (eshell-manipulate "substituting replacement form"
- (setcar form (car new-form))
- (setcdr form (cdr new-form)))
- (eshell-do-eval form synchronous-p))
- (if (and (memq (car form) eshell-deferrable-commands)
- (not eshell-current-subjob-p)
- result
- (eshell-processp result))
- (if synchronous-p
- (eshell/wait result)
- (eshell-manipulate "inserting ignore form"
- (setcar form 'ignore)
- (setcdr form nil))
- (throw 'eshell-defer result))
- (list 'quote result))))))))))))
-
-;; command invocation
-
-(defun eshell/which (command &rest names)
- "Identify the COMMAND, and where it is located."
- (eshell-for name (cons command names)
- (let (program alias direct)
- (if (eq (aref name 0) eshell-explicit-command-char)
- (setq name (substring name 1)
- direct t))
- (if (and (not direct)
- (eshell-using-module 'eshell-alias)
- (setq alias
- (funcall (symbol-function 'eshell-lookup-alias)
- name)))
- (setq program
- (concat name " is an alias, defined as \""
- (cadr alias) "\"")))
- (unless program
- (setq program (eshell-search-path name))
- (let* ((esym (eshell-find-alias-function name))
- (sym (or esym (intern-soft name))))
- (if (and sym (fboundp sym)
- (or esym eshell-prefer-lisp-functions
- (not program)))
- (let ((desc (let ((inhibit-redisplay t))
- (save-window-excursion
- (prog1
- (describe-function sym)
- (message nil))))))
- (setq desc (substring desc 0
- (1- (or (string-match "\n" desc)
- (length desc)))))
- (if (buffer-live-p (get-buffer "*Help*"))
- (kill-buffer "*Help*"))
- (setq program (or desc name))))))
- (if (not program)
- (eshell-error (format "which: no %s in (%s)\n"
- name (getenv "PATH")))
- (eshell-printn program)))))
-
-(put 'eshell/which 'eshell-no-numeric-conversions t)
-
-(defun eshell-named-command (command &optional args)
- "Insert output from a plain COMMAND, using ARGS.
-COMMAND may result in an alias being executed, or a plain command."
- (setq eshell-last-arguments args
- eshell-last-command-name (eshell-stringify command))
- (run-hook-with-args 'eshell-prepare-command-hook)
- (assert (stringp eshell-last-command-name))
- (if eshell-last-command-name
- (or (run-hook-with-args-until-success
- 'eshell-named-command-hook eshell-last-command-name
- eshell-last-arguments)
- (eshell-plain-command eshell-last-command-name
- eshell-last-arguments))))
-
-(defalias 'eshell-named-command* 'eshell-named-command)
-
-(defun eshell-find-alias-function (name)
- "Check whether a function called `eshell/NAME' exists."
- (let* ((sym (intern-soft (concat "eshell/" name)))
- (file (symbol-file sym)))
- ;; If the function exists, but is defined in an eshell module
- ;; that's not currently enabled, don't report it as found
- (if (and file
- (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file))
- (let ((module-sym
- (intern (file-name-sans-extension
- (file-name-nondirectory
- (concat "eshell-" (match-string 2 file)))))))
- (if (and (functionp sym)
- (or (null module-sym)
- (eshell-using-module module-sym)
- (memq module-sym (eshell-subgroups 'eshell))))
- sym))
- ;; Otherwise, if it's bound, return it.
- (if (functionp sym)
- sym))))
-
-(defun eshell-plain-command (command args)
- "Insert output from a plain COMMAND, using ARGS.
-COMMAND may result in either a Lisp function being executed by name,
-or an external command."
- (let* ((esym (eshell-find-alias-function command))
- (sym (or esym (intern-soft command))))
- (if (and sym (fboundp sym)
- (or esym eshell-prefer-lisp-functions
- (not (eshell-search-path command))))
- (eshell-lisp-command sym args)
- (eshell-external-command command args))))
-
-(defun eshell-exec-lisp (printer errprint func-or-form args form-p)
- "Execute a lisp FUNC-OR-FORM, maybe passing ARGS.
-PRINTER and ERRPRINT are functions to use for printing regular
-messages, and errors. FORM-P should be non-nil if FUNC-OR-FORM
-represent a lisp form; ARGS will be ignored in that case."
- (let (result)
- (eshell-condition-case err
- (progn
- (setq result
- (save-current-buffer
- (if form-p
- (eval func-or-form)
- (apply func-or-form args))))
- (and result (funcall printer result))
- result)
- (error
- (let ((msg (error-message-string err)))
- (if (and (not form-p)
- (string-match "^Wrong number of arguments" msg)
- (fboundp 'eldoc-get-fnsym-args-string))
- (let ((func-doc (eldoc-get-fnsym-args-string func-or-form)))
- (setq msg (format "usage: %s" func-doc))))
- (funcall errprint msg))
- nil))))
-
-(defsubst eshell-apply* (printer errprint func args)
- "Call FUNC, with ARGS, trapping errors and return them as output.
-PRINTER and ERRPRINT are functions to use for printing regular
-messages, and errors."
- (eshell-exec-lisp printer errprint func args nil))
-
-(defsubst eshell-funcall* (printer errprint func &rest args)
- "Call FUNC, with ARGS, trapping errors and return them as output."
- (eshell-apply* printer errprint func args))
-
-(defsubst eshell-eval* (printer errprint form)
- "Evaluate FORM, trapping errors and returning them."
- (eshell-exec-lisp printer errprint form nil t))
-
-(defsubst eshell-apply (func args)
- "Call FUNC, with ARGS, trapping errors and return them as output.
-PRINTER and ERRPRINT are functions to use for printing regular
-messages, and errors."
- (eshell-apply* 'eshell-print 'eshell-error func args))
-
-(defsubst eshell-funcall (func &rest args)
- "Call FUNC, with ARGS, trapping errors and return them as output."
- (eshell-apply func args))
-
-(defsubst eshell-eval (form)
- "Evaluate FORM, trapping errors and returning them."
- (eshell-eval* 'eshell-print 'eshell-error form))
-
-(defsubst eshell-applyn (func args)
- "Call FUNC, with ARGS, trapping errors and return them as output.
-PRINTER and ERRPRINT are functions to use for printing regular
-messages, and errors."
- (eshell-apply* 'eshell-printn 'eshell-errorn func args))
-
-(defsubst eshell-funcalln (func &rest args)
- "Call FUNC, with ARGS, trapping errors and return them as output."
- (eshell-applyn func args))
-
-(defsubst eshell-evaln (form)
- "Evaluate FORM, trapping errors and returning them."
- (eshell-eval* 'eshell-printn 'eshell-errorn form))
-
-(defun eshell-lisp-command (object &optional args)
- "Insert Lisp OBJECT, using ARGS if a function."
- (catch 'eshell-external ; deferred to an external command
- (let* ((eshell-ensure-newline-p (eshell-interactive-output-p))
- (result
- (if (functionp object)
- (progn
- (setq eshell-last-arguments args
- eshell-last-command-name
- (concat "#<function " (symbol-name object) ">"))
- ;; if any of the arguments are flagged as numbers
- ;; waiting for conversion, convert them now
- (unless (get object 'eshell-no-numeric-conversions)
- (while args
- (let ((arg (car args)))
- (if (and (stringp arg)
- (> (length arg) 0)
- (get-text-property 0 'number arg))
- (setcar args (string-to-number arg))))
- (setq args (cdr args))))
- (eshell-apply object eshell-last-arguments))
- (setq eshell-last-arguments args
- eshell-last-command-name "#<Lisp object>")
- (eshell-eval object))))
- (if (and eshell-ensure-newline-p
- (save-excursion
- (goto-char eshell-last-output-end)
- (not (bolp))))
- (eshell-print "\n"))
- (eshell-close-handles 0 (list 'quote result)))))
-
-(defalias 'eshell-lisp-command* 'eshell-lisp-command)
-
-;;; esh-cmd.el ends here
+++ /dev/null
-;;; esh-ext.el --- commands external to Eshell
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-ext)
-
-(eval-when-compile (require 'esh-maint))
-(require 'esh-util)
-
-(defgroup eshell-ext nil
- "External commands are invoked when operating system executables are
-loaded into memory, thus beginning a new process."
- :tag "External commands"
- :group 'eshell)
-
-;;; Commentary:
-
-;; To force a command to invoked external, either provide an explicit
-;; pathname for the command argument, or prefix the command name with
-;; an asterix character. Example:
-;;
-;; grep ; make invoke `grep' Lisp function, or `eshell/grep'
-;; /bin/grep ; will definitely invoke /bin/grep
-;; *grep ; will also invoke /bin/grep
-
-;;; User Variables:
-
-(defcustom eshell-ext-load-hook '(eshell-ext-initialize)
- "*A hook that gets run when `eshell-ext' is loaded."
- :type 'hook
- :group 'eshell-ext)
-
-(defcustom eshell-binary-suffixes exec-suffixes
- "*A list of suffixes used when searching for executable files."
- :type '(repeat string)
- :group 'eshell-ext)
-
-(defcustom eshell-force-execution nil
- "*If non-nil, try to execute binary files regardless of permissions.
-This can be useful on systems like Windows, where the operating system
-doesn't happen to honor the permission bits in certain cases; or in
-cases where you want to associate an interpreter with a particular
-kind of script file, but the language won't let you but a '#!'
-interpreter line in the file, and you don't want to make it executable
-since nothing else but Eshell will be able to understand
-`eshell-interpreter-alist'."
- :type 'boolean
- :group 'eshell-ext)
-
-(defun eshell-search-path (name)
- "Search the environment path for NAME."
- (if (file-name-absolute-p name)
- name
- (let ((list (parse-colon-path (getenv "PATH")))
- suffixes n1 n2 file)
- (while list
- (setq n1 (concat (car list) name))
- (setq suffixes eshell-binary-suffixes)
- (while suffixes
- (setq n2 (concat n1 (car suffixes)))
- (if (and (or (file-executable-p n2)
- (and eshell-force-execution
- (file-readable-p n2)))
- (not (file-directory-p n2)))
- (setq file n2 suffixes nil list nil))
- (setq suffixes (cdr suffixes)))
- (setq list (cdr list)))
- file)))
-
-(defcustom eshell-windows-shell-file
- (if (eshell-under-windows-p)
- (if (string-match "\\(\\`cmdproxy\\|sh\\)\\.\\(com\\|exe\\)"
- shell-file-name)
- (or (eshell-search-path "cmd.exe")
- (eshell-search-path "command.exe"))
- shell-file-name))
- "*The name of the shell command to use for DOS/Windows batch files.
-This defaults to nil on non-Windows systems, where this variable is
-wholly ignored."
- :type '(choice file (const nil))
- :group 'eshell-ext)
-
-(defsubst eshell-invoke-batch-file (&rest args)
- "Invoke a .BAT or .CMD file on DOS/Windows systems."
- ;; since CMD.EXE can't handle forward slashes in the initial
- ;; argument...
- (setcar args (subst-char-in-string directory-sep-char ?\\ (car args)))
- (throw 'eshell-replace-command
- (eshell-parse-command eshell-windows-shell-file (cons "/c" args))))
-
-(defcustom eshell-interpreter-alist
- (if (eshell-under-windows-p)
- '(("\\.\\(bat\\|cmd\\)\\'" . eshell-invoke-batch-file)))
- "*An alist defining interpreter substitutions.
-Each member is a cons cell of the form:
-
- (MATCH . INTERPRETER)
-
-MATCH should be a regexp, which is matched against the command name,
-or a function. If either returns a non-nil value, then INTERPRETER
-will be used for that command.
-
-If INTERPRETER is a string, it will be called as the command name,
-with the original command name passed as the first argument, with all
-subsequent arguments following. If INTERPRETER is a function, it will
-be called with all of those arguments. Note that interpreter
-functions should throw `eshell-replace-command' with the alternate
-command form, or they should return a value compatible with the
-possible return values of `eshell-external-command', which see."
- :type '(repeat (cons (choice regexp (function :tag "Predicate"))
- (choice string (function :tag "Interpreter"))))
- :group 'eshell-ext)
-
-(defcustom eshell-alternate-command-hook nil
- "*A hook run whenever external command lookup fails.
-If a functions wishes to provide an alternate command, they must throw
-it using the tag `eshell-replace-command'. This is done because the
-substituted command need not be external at all, and therefore must be
-passed up to a higher level for re-evaluation.
-
-Or, if the function returns a filename, that filename will be invoked
-with the current command arguments rather than the command specified
-by the user on the command line."
- :type 'hook
- :group 'eshell-ext)
-
-(defcustom eshell-command-interpreter-max-length 256
- "*The maximum length of any command interpreter string, plus args."
- :type 'integer
- :group 'eshell-ext)
-
-(defcustom eshell-explicit-command-char ?*
- "*If this char occurs before a command name, call it externally.
-That is, although vi may be an alias, *vi will always call the
-external version. UNIX users may prefer this variable to be \."
- :type 'character
- :group 'eshell-ext)
-
-;;; Functions:
-
-(defun eshell-ext-initialize ()
- "Initialize the external command handling code."
- (add-hook 'eshell-named-command-hook 'eshell-explicit-command nil t))
-
-(defun eshell-explicit-command (command args)
- "If a command name begins with `*', call it externally always.
-This bypasses all Lisp functions and aliases."
- (when (and (> (length command) 1)
- (eq (aref command 0) eshell-explicit-command-char))
- (let ((cmd (eshell-search-path (substring command 1))))
- (if cmd
- (or (eshell-external-command cmd args)
- (error "%s: external command failed" cmd))
- (error "%s: external command not found"
- (substring command 1))))))
-
-(defun eshell-remote-command (handler command args)
- "Insert output from a remote COMMAND, using ARGS.
-A remote command is something that executes on a different machine.
-An external command simply means external to Emacs.
-
-Note that this function is very crude at the moment. It gathers up
-all the output from the remote command, and sends it all at once,
-causing the user to wonder if anything's really going on..."
- (let ((outbuf (generate-new-buffer " *eshell remote output*"))
- (errbuf (generate-new-buffer " *eshell remote error*"))
- (exitcode 1))
- (unwind-protect
- (progn
- (setq exitcode
- (funcall handler 'shell-command
- (mapconcat 'shell-quote-argument
- (append (list command) args) " ")
- outbuf errbuf))
- (eshell-print (save-excursion (set-buffer outbuf)
- (buffer-string)))
- (eshell-error (save-excursion (set-buffer errbuf)
- (buffer-string))))
- (eshell-close-handles exitcode 'nil)
- (kill-buffer outbuf)
- (kill-buffer errbuf))))
-
-(defun eshell-external-command (command args)
- "Insert output from an external COMMAND, using ARGS."
- (setq args (eshell-stringify-list (eshell-flatten-list args)))
- (let ((handler
- (unless (or (equal default-directory "/")
- (and (eshell-under-windows-p)
- (string-match "\\`[A-Za-z]:[/\\\\]\\'"
- default-directory)))
- (find-file-name-handler default-directory
- 'shell-command))))
- (if (and handler
- (not (and (eshell-under-xemacs-p)
- (eq handler 'dired-handler-fn))))
- (eshell-remote-command handler command args))
- (let ((interp (eshell-find-interpreter command)))
- (assert interp)
- (if (functionp (car interp))
- (apply (car interp) (append (cdr interp) args))
- (eshell-gather-process-output
- (car interp) (append (cdr interp) args))))))
-
-(defun eshell/addpath (&rest args)
- "Add a set of paths to PATH."
- (eshell-eval-using-options
- "addpath" args
- '((?b "begin" nil prepend "add path element at beginning")
- (?h "help" nil nil "display this usage message")
- :usage "[-b] PATH
-Adds the given PATH to $PATH.")
- (if args
- (progn
- (if prepend
- (setq args (nreverse args)))
- (while args
- (setenv "PATH"
- (if prepend
- (concat (car args) path-separator
- (getenv "PATH"))
- (concat (getenv "PATH") path-separator
- (car args))))
- (setq args (cdr args))))
- (let ((paths (parse-colon-path (getenv "PATH"))))
- (while paths
- (eshell-printn (car paths))
- (setq paths (cdr paths)))))))
-
-(put 'eshell/addpath 'eshell-no-numeric-conversions t)
-
-(defun eshell-script-interpreter (file)
- "Extract the script to run from FILE, if it has #!<interp> in it.
-Return nil, or a list of the form:
-
- (INTERPRETER [ARGS] FILE)"
- (let ((maxlen eshell-command-interpreter-max-length))
- (if (and (file-readable-p file)
- (file-regular-p file))
- (with-temp-buffer
- (insert-file-contents-literally file nil 0 maxlen)
- (if (looking-at "#![ \t]*\\([^ \r\t\n]+\\)\\([ \t]+\\(.+\\)\\)?")
- (if (match-string 3)
- (list (match-string 1)
- (match-string 3)
- file)
- (list (match-string 1)
- file)))))))
-
-(defun eshell-find-interpreter (file &optional no-examine-p)
- "Find the command interpreter with which to execute FILE.
-If NO-EXAMINE-P is non-nil, FILE will not be inspected for a script
-line of the form #!<interp>."
- (let ((finterp
- (catch 'found
- (ignore
- (eshell-for possible eshell-interpreter-alist
- (cond
- ((functionp (car possible))
- (and (funcall (car possible) file)
- (throw 'found (cdr possible))))
- ((stringp (car possible))
- (and (string-match (car possible) file)
- (throw 'found (cdr possible))))
- (t
- (error "Invalid interpreter-alist test"))))))))
- (if finterp ; first check
- (list finterp file)
- (let ((fullname (if (file-name-directory file) file
- (eshell-search-path file)))
- (suffixes eshell-binary-suffixes))
- (if (and fullname (not (or eshell-force-execution
- (file-executable-p fullname))))
- (while suffixes
- (let ((try (concat fullname (car suffixes))))
- (if (or (file-executable-p try)
- (and eshell-force-execution
- (file-readable-p try)))
- (setq fullname try suffixes nil)
- (setq suffixes (cdr suffixes))))))
- (cond ((not (and fullname (file-exists-p fullname)))
- (let ((name (or fullname file)))
- (unless (setq fullname
- (run-hook-with-args-until-success
- 'eshell-alternate-command-hook file))
- (error "%s: command not found" name))))
- ((not (or eshell-force-execution
- (file-executable-p fullname)))
- (error "%s: Permission denied" fullname)))
- (let (interp)
- (unless no-examine-p
- (setq interp (eshell-script-interpreter fullname))
- (if interp
- (setq interp
- (cons (car (eshell-find-interpreter (car interp) t))
- (cdr interp)))))
- (or interp (list fullname)))))))
-
-;;; Code:
-
-;;; esh-ext.el ends here
+++ /dev/null
-;;; esh-io.el --- I/O management
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-io)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-io nil
- "Eshell's I/O management code provides a scheme for treating many
-different kinds of objects -- symbols, files, buffers, etc. -- as
-though they were files."
- :tag "I/O management"
- :group 'eshell)
-
-;;; Commentary:
-
-;; At the moment, only output redirection is supported in Eshell. To
-;; use input redirection, the following syntax will work, assuming
-;; that the command after the pipe is always an external command:
-;;
-;; cat <file> | <command>
-;;
-;; Otherwise, output redirection and piping are provided in a manner
-;; consistent with most shells. Therefore, only unique features are
-;; mentioned here.
-;;
-;;;_* Insertion
-;;
-;; To insert at the location of point in a buffer, use '>>>':
-;;
-;; echo alpha >>> #<buffer *scratch*>;
-;;
-;;;_* Pseudo-devices
-;;
-;; A few pseudo-devices are provided, since Emacs cannot write
-;; directly to a UNIX device file:
-;;
-;; echo alpha > /dev/null ; the bit bucket
-;; echo alpha > /dev/kill ; set the kill ring
-;; echo alpha >> /dev/clip ; append to the clipboard
-;;
-;;;_* Multiple output targets
-;;
-;; Eshell can write to multiple output targets, including pipes.
-;; Example:
-;;
-;; (+ 1 2) > a > b > c ; prints number to all three files
-;; (+ 1 2) > a | wc ; prints to 'a', and pipes to 'wc'
-
-;;; User Variables:
-
-(defcustom eshell-io-load-hook '(eshell-io-initialize)
- "*A hook that gets run when `eshell-io' is loaded."
- :type 'hook
- :group 'eshell-io)
-
-(defcustom eshell-number-of-handles 3
- "*The number of file handles that eshell supports.
-Currently this is standard input, output and error. But even all of
-these Emacs does not currently support with asynchronous processes
-\(which is what eshell uses so that you can continue doing work in
-other buffers) ."
- :type 'integer
- :group 'eshell-io)
-
-(defcustom eshell-output-handle 1
- "*The index of the standard output handle."
- :type 'integer
- :group 'eshell-io)
-
-(defcustom eshell-error-handle 2
- "*The index of the standard error handle."
- :type 'integer
- :group 'eshell-io)
-
-(defcustom eshell-buffer-shorthand nil
- "*If non-nil, a symbol name can be used for a buffer in redirection.
-If nil, redirecting to a buffer requires buffer name syntax. If this
-variable is set, redirection directly to Lisp symbols will be
-impossible.
-
-Example:
-
- echo hello > '*scratch* ; works if `eshell-buffer-shorthand' is t
- echo hello > #<buffer *scratch*> ; always works"
- :type 'boolean
- :group 'eshell-io)
-
-(defcustom eshell-print-queue-size 5
- "*The size of the print queue, for doing buffered printing.
-This is basically a speed enhancement, to avoid blocking the Lisp code
-from executing while Emacs is redisplaying."
- :type 'integer
- :group 'eshell-io)
-
-(defcustom eshell-virtual-targets
- '(("/dev/eshell" eshell-interactive-print nil)
- ("/dev/kill" (lambda (mode)
- (if (eq mode 'overwrite)
- (kill-new ""))
- 'eshell-kill-append) t)
- ("/dev/clip" (lambda (mode)
- (if (eq mode 'overwrite)
- (let ((x-select-enable-clipboard t))
- (kill-new "")))
- 'eshell-clipboard-append) t))
- "*Map virtual devices name to Emacs Lisp functions.
-If the user specifies any of the filenames above as a redirection
-target, the function in the second element will be called.
-
-If the third element is non-nil, the redirection mode is passed as an
-argument (which is the symbol `overwrite', `append' or `insert'), and
-the function is expected to return another function -- which is the
-output function. Otherwise, the second element itself is the output
-function.
-
-The output function is then called repeatedly with single strings,
-which represents successive pieces of the output of the command, until nil
-is passed, meaning EOF.
-
-NOTE: /dev/null is handled specially as a virtual target, and should
-not be added to this variable."
- :type '(repeat
- (list (string :tag "Target")
- function
- (choice (const :tag "Func returns output-func" t)
- (const :tag "Func is output-func" nil))))
- :group 'eshell-io)
-
-(put 'eshell-virtual-targets 'risky-local-variable t)
-
-;;; Internal Variables:
-
-(defvar eshell-current-handles nil)
-
-(defvar eshell-last-command-status 0
- "The exit code from the last command. 0 if successful.")
-
-(defvar eshell-last-command-result nil
- "The result of the last command. Not related to success.")
-
-(defvar eshell-output-file-buffer nil
- "If non-nil, the current buffer is a file output buffer.")
-
-(defvar eshell-print-count)
-(defvar eshell-current-redirections)
-
-;;; Functions:
-
-(defun eshell-io-initialize ()
- "Initialize the I/O subsystem code."
- (add-hook 'eshell-parse-argument-hook
- 'eshell-parse-redirection nil t)
- (make-local-variable 'eshell-current-redirections)
- (add-hook 'eshell-pre-rewrite-command-hook
- 'eshell-strip-redirections nil t)
- (add-hook 'eshell-post-rewrite-command-hook
- 'eshell-apply-redirections nil t))
-
-(defun eshell-parse-redirection ()
- "Parse an output redirection, such as '2>'."
- (if (and (not eshell-current-quoted)
- (looking-at "\\([0-9]\\)?\\(<\\|>+\\)&?\\([0-9]\\)?\\s-*"))
- (if eshell-current-argument
- (eshell-finish-arg)
- (let ((sh (match-string 1))
- (oper (match-string 2))
-; (th (match-string 3))
- )
- (if (string= oper "<")
- (error "Eshell does not support input redirection"))
- (eshell-finish-arg
- (prog1
- (list 'eshell-set-output-handle
- (or (and sh (string-to-int sh)) 1)
- (list 'quote
- (aref [overwrite append insert]
- (1- (length oper)))))
- (goto-char (match-end 0))))))))
-
-(defun eshell-strip-redirections (terms)
- "Rewrite any output redirections in TERMS."
- (setq eshell-current-redirections (list t))
- (let ((tl terms)
- (tt (cdr terms)))
- (while tt
- (if (not (and (consp (car tt))
- (eq (caar tt) 'eshell-set-output-handle)))
- (setq tt (cdr tt)
- tl (cdr tl))
- (unless (cdr tt)
- (error "Missing redirection target"))
- (nconc eshell-current-redirections
- (list (list 'ignore
- (append (car tt) (list (cadr tt))))))
- (setcdr tl (cddr tt))
- (setq tt (cddr tt))))
- (setq eshell-current-redirections
- (cdr eshell-current-redirections))))
-
-(defun eshell-apply-redirections (cmdsym)
- "Apply any redirection which were specified for COMMAND."
- (if eshell-current-redirections
- (set cmdsym
- (append (list 'progn)
- eshell-current-redirections
- (list (symbol-value cmdsym))))))
-
-(defun eshell-create-handles
- (standard-output output-mode &optional standard-error error-mode)
- "Create a new set of file handles for a command.
-The default location for standard output and standard error will go to
-STANDARD-OUTPUT and STANDARD-ERROR, respectively.
-OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert';
-a nil value of mode defaults to `insert'."
- (let ((handles (make-vector eshell-number-of-handles nil))
- (output-target (eshell-get-target standard-output output-mode))
- (error-target (eshell-get-target standard-error error-mode)))
- (aset handles eshell-output-handle (cons output-target 1))
- (if standard-error
- (aset handles eshell-error-handle (cons error-target 1))
- (aset handles eshell-error-handle (cons output-target 1)))
- handles))
-
-(defun eshell-protect-handles (handles)
- "Protect the handles in HANDLES from a being closed."
- (let ((idx 0))
- (while (< idx eshell-number-of-handles)
- (if (aref handles idx)
- (setcdr (aref handles idx)
- (1+ (cdr (aref handles idx)))))
- (setq idx (1+ idx))))
- handles)
-
-(defun eshell-close-target (target status)
- "Close an output TARGET, passing STATUS as the result.
-STATUS should be non-nil on successful termination of the output."
- (cond
- ((symbolp target) nil)
-
- ;; If we were redirecting to a file, save the file and close the
- ;; buffer.
- ((markerp target)
- (let ((buf (marker-buffer target)))
- (when buf ; somebody's already killed it!
- (save-current-buffer
- (set-buffer buf)
- (when eshell-output-file-buffer
- (save-buffer)
- (when (eq eshell-output-file-buffer t)
- (or status (set-buffer-modified-p nil))
- (kill-buffer buf)))))))
-
- ;; If we're redirecting to a process (via a pipe, or process
- ;; redirection), send it EOF so that it knows we're finished.
- ((eshell-processp target)
- (if (eq (process-status target) 'run)
- (process-send-eof target)))
-
- ;; A plain function redirection needs no additional arguments
- ;; passed.
- ((functionp target)
- (funcall target status))
-
- ;; But a more complicated function redirection (which can only
- ;; happen with aliases at the moment) has arguments that need to be
- ;; passed along with it.
- ((consp target)
- (apply (car target) status (cdr target)))))
-
-(defun eshell-close-handles (exit-code &optional result handles)
- "Close all of the current handles, taking refcounts into account.
-EXIT-CODE is the process exit code; mainly, it is zero, if the command
-completed successfully. RESULT is the quoted value of the last
-command. If nil, then the meta variables for keeping track of the
-last execution result should not be changed."
- (let ((idx 0))
- (assert (or (not result) (eq (car result) 'quote)))
- (setq eshell-last-command-status exit-code
- eshell-last-command-result (cadr result))
- (while (< idx eshell-number-of-handles)
- (let ((handles (or handles eshell-current-handles)))
- (when (aref handles idx)
- (setcdr (aref handles idx)
- (1- (cdr (aref handles idx))))
- (when (= (cdr (aref handles idx)) 0)
- (let ((target (car (aref handles idx))))
- (if (not (listp target))
- (eshell-close-target target (= exit-code 0))
- (while target
- (eshell-close-target (car target) (= exit-code 0))
- (setq target (cdr target)))))
- (setcar (aref handles idx) nil))))
- (setq idx (1+ idx)))
- nil))
-
-(defun eshell-kill-append (string)
- "Call `kill-append' with STRING, if it is indeed a string."
- (if (stringp string)
- (kill-append string nil)))
-
-(defun eshell-clipboard-append (string)
- "Call `kill-append' with STRING, if it is indeed a string."
- (if (stringp string)
- (let ((x-select-enable-clipboard t))
- (kill-append string nil))))
-
-(defun eshell-get-target (target &optional mode)
- "Convert TARGET, which is a raw argument, into a valid output target.
-MODE is either `overwrite', `append' or `insert'; if it is omitted or nil,
-it defaults to `insert'."
- (setq mode (or mode 'insert))
- (cond
- ((stringp target)
- (let ((redir (assoc target eshell-virtual-targets)))
- (if redir
- (if (nth 2 redir)
- (funcall (nth 1 redir) mode)
- (nth 1 redir))
- (let* ((exists (get-file-buffer target))
- (buf (find-file-noselect target t)))
- (with-current-buffer buf
- (if buffer-read-only
- (error "Cannot write to read-only file `%s'" target))
- (set (make-local-variable 'eshell-output-file-buffer)
- (if (eq exists buf) 0 t))
- (cond ((eq mode 'overwrite)
- (erase-buffer))
- ((eq mode 'append)
- (goto-char (point-max))))
- (point-marker))))))
- ((or (bufferp target)
- (and (boundp 'eshell-buffer-shorthand)
- (symbol-value 'eshell-buffer-shorthand)
- (symbolp target)))
- (let ((buf (if (bufferp target)
- target
- (get-buffer-create
- (symbol-name target)))))
- (with-current-buffer buf
- (cond ((eq mode 'overwrite)
- (erase-buffer))
- ((eq mode 'append)
- (goto-char (point-max))))
- (point-marker))))
- ((functionp target)
- nil)
- ((symbolp target)
- (if (eq mode 'overwrite)
- (set target nil))
- target)
- ((or (eshell-processp target)
- (markerp target))
- target)
- (t
- (error "Illegal redirection target: %s"
- (eshell-stringify target)))))
-
-(eval-when-compile
- (defvar grep-null-device))
-
-(defun eshell-set-output-handle (index mode &optional target)
- "Set handle INDEX, using MODE, to point to TARGET."
- (when target
- (if (and (stringp target)
- (or (cond
- ((boundp 'null-device)
- (string= target null-device))
- ((boundp 'grep-null-device)
- (string= target grep-null-device))
- (t nil))
- (string= target "/dev/null")))
- (aset eshell-current-handles index nil)
- (let ((where (eshell-get-target target mode))
- (current (car (aref eshell-current-handles index))))
- (if (and (listp current)
- (not (member where current)))
- (setq current (append current (list where)))
- (setq current (list where)))
- (if (not (aref eshell-current-handles index))
- (aset eshell-current-handles index (cons nil 1)))
- (setcar (aref eshell-current-handles index) current)))))
-
-(defun eshell-interactive-output-p ()
- "Return non-nil if current handles are bound for interactive display."
- (and (eq (car (aref eshell-current-handles
- eshell-output-handle)) t)
- (eq (car (aref eshell-current-handles
- eshell-error-handle)) t)))
-
-(defvar eshell-print-queue nil)
-(defvar eshell-print-queue-count -1)
-
-(defun eshell-flush (&optional reset-p)
- "Flush out any lines that have been queued for printing.
-Must be called before printing begins with -1 as its argument, and
-after all printing is over with no argument."
- (ignore
- (if reset-p
- (setq eshell-print-queue nil
- eshell-print-queue-count reset-p)
- (if eshell-print-queue
- (eshell-print eshell-print-queue))
- (eshell-flush 0))))
-
-(defun eshell-init-print-buffer ()
- "Initialize the buffered printing queue."
- (eshell-flush -1))
-
-(defun eshell-buffered-print (&rest strings)
- "A buffered print -- *for strings only*."
- (if (< eshell-print-queue-count 0)
- (progn
- (eshell-print (apply 'concat strings))
- (setq eshell-print-queue-count 0))
- (if (= eshell-print-queue-count eshell-print-queue-size)
- (eshell-flush))
- (setq eshell-print-queue
- (concat eshell-print-queue (apply 'concat strings))
- eshell-print-queue-count (1+ eshell-print-queue-count))))
-
-(defsubst eshell-print (object)
- "Output OBJECT to the standard output handle."
- (eshell-output-object object eshell-output-handle))
-
-(defsubst eshell-error (object)
- "Output OBJECT to the standard error handle."
- (eshell-output-object object eshell-error-handle))
-
-(defsubst eshell-errorn (object)
- "Output OBJECT followed by a newline to the standard error handle."
- (eshell-error object)
- (eshell-error "\n"))
-
-(defsubst eshell-printn (object)
- "Output OBJECT followed by a newline to the standard output handle."
- (eshell-print object)
- (eshell-print "\n"))
-
-(defun eshell-output-object-to-target (object target)
- "Insert OBJECT into TARGET.
-Returns what was actually sent, or nil if nothing was sent."
- (cond
- ((functionp target)
- (funcall target object))
-
- ((symbolp target)
- (if (eq target t) ; means "print to display"
- (eshell-output-filter nil (eshell-stringify object))
- (if (not (symbol-value target))
- (set target object)
- (setq object (eshell-stringify object))
- (if (not (stringp (symbol-value target)))
- (set target (eshell-stringify
- (symbol-value target))))
- (set target (concat (symbol-value target) object)))))
-
- ((markerp target)
- (if (buffer-live-p (marker-buffer target))
- (with-current-buffer (marker-buffer target)
- (let ((moving (= (point) target)))
- (save-excursion
- (goto-char target)
- (setq object (eshell-stringify object))
- (insert-and-inherit object)
- (set-marker target (point-marker)))
- (if moving
- (goto-char target))))))
-
- ((eshell-processp target)
- (when (eq (process-status target) 'run)
- (setq object (eshell-stringify object))
- (process-send-string target object)))
-
- ((consp target)
- (apply (car target) object (cdr target))))
- object)
-
-(defun eshell-output-object (object &optional handle-index handles)
- "Insert OBJECT, using HANDLE-INDEX specifically)."
- (let ((target (car (aref (or handles eshell-current-handles)
- (or handle-index eshell-output-handle)))))
- (if (and target (not (listp target)))
- (eshell-output-object-to-target object target)
- (while target
- (eshell-output-object-to-target object (car target))
- (setq target (cdr target))))))
-
-;;; Code:
-
-;;; esh-io.el ends here
+++ /dev/null
-;;; esh-maint.el --- init code for building eshell -*- no-byte-compile: t -*-
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(provide 'esh-maint)
-
-(and (fboundp 'font-lock-add-keywords)
- (font-lock-add-keywords
- 'emacs-lisp-mode
- '(("(eshell-for\\>" . font-lock-keyword-face)
- ("(eshell-deftest\\>" . font-lock-keyword-face)
- ("(eshell-condition-case\\>" . font-lock-keyword-face))))
-
-(if (file-directory-p "../pcomplete")
- (add-to-list 'load-path "../pcomplete"))
-
-(if (locate-library "pcomplete")
- (require 'pcomplete))
-
-(eval-when-compile
- (require 'cl)
- (setq cl-optimize-speed 9))
-
-;; (defun eshell-generate-autoloads ()
-;; (interactive)
-;; (require 'autoload)
-;; (setq generated-autoload-file
-;; (expand-file-name (car command-line-args-left)))
-;; (setq command-line-args-left (cdr command-line-args-left))
-;; (batch-update-autoloads))
-
-(require 'eshell)
-(require 'esh-mode) ; brings in eshell-util
-(require 'esh-opt)
-(require 'esh-test)
-
-;; (defun eshell-generate-main-menu ()
-;; "Create the main menu for the eshell documentation."
-;; (insert "@menu
-;; * The Emacs shell:: eshell.
-
-;; Core Functionality\n")
-;; (eshell-for module
-;; (sort (eshell-subgroups 'eshell)
-;; (function
-;; (lambda (a b)
-;; (string-lessp (symbol-name a)
-;; (symbol-name b)))))
-;; (insert (format "* %-34s"
-;; (concat (get module 'custom-tag) "::"))
-;; (symbol-name module) ".\n"))
-;; (insert "\nOptional Functionality\n")
-;; (eshell-for module
-;; (sort (eshell-subgroups 'eshell-module)
-;; (function
-;; (lambda (a b)
-;; (string-lessp (symbol-name a)
-;; (symbol-name b)))))
-;; (insert (format "* %-34s"
-;; (concat (get module 'custom-tag) "::"))
-;; (symbol-name module) ".\n"))
-;; (insert "@end menu\n"))
-
-;; (defun eshell-make-texi ()
-;; "Make the eshell.texi file."
-;; (interactive)
-;; (require 'eshell-auto)
-;; (require 'texidoc)
-;; (require 'pcomplete)
-;; (apply 'texidoc-files 'eshell-generate-main-menu "eshell.doci"
-;; (append
-;; (list "eshell.el")
-;; (sort (mapcar
-;; (function
-;; (lambda (sym)
-;; (let ((name (symbol-name sym)))
-;; (if (string-match "\\`eshell-\\(.*\\)" name)
-;; (setq name (concat "esh-" (match-string 1 name))))
-;; (concat name ".el"))))
-;; (eshell-subgroups 'eshell))
-;; 'string-lessp)
-;; (sort (mapcar
-;; (function
-;; (lambda (sym)
-;; (let ((name (symbol-name sym)))
-;; (if (string-match "\\`eshell-\\(.*\\)" name)
-;; (setq name (concat "em-" (match-string 1 name))))
-;; (concat name ".el"))))
-;; (eshell-subgroups 'eshell-module))
-;; 'string-lessp)
-;; (list "eshell.texi"))))
-
-;; (defun eshell-make-readme ()
-;; "Make the README file from eshell.el."
-;; (interactive)
-;; (require 'eshell-auto)
-;; (require 'texidoc)
-;; (require 'pcomplete)
-;; (texidoc-files nil "eshell.doci" "eshell.el" "README.texi")
-;; (set-buffer (get-buffer "README.texi"))
-;; (goto-char (point-min))
-;; (search-forward "@chapter")
-;; (beginning-of-line)
-;; (forward-line -1)
-;; (kill-line 2)
-;; (re-search-forward "^@section User Options")
-;; (beginning-of-line)
-;; (delete-region (point) (point-max))
-;; (insert "@bye\n")
-;; (save-buffer)
-;; (with-temp-buffer
-;; (call-process "makeinfo" nil t nil "--no-headers" "README.texi")
-;; (goto-char (point-min))
-;; (search-forward "The Emacs Shell")
-;; (beginning-of-line)
-;; (delete-region (point-min) (point))
-;; (write-file "README"))
-;; (delete-file "README.texi")
-;; (kill-buffer "README.texi"))
-
-;;; esh-maint.el ends here
+++ /dev/null
-;;; esh-mode.el --- user interface
-
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-mode)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-mode nil
- "This module contains code for handling input from the user."
- :tag "User interface"
- :group 'eshell)
-
-;;; Commentary:
-
-;; Basically, Eshell is used just like shell mode (<M-x shell>). The
-;; keystrokes for navigating the buffer, and accessing the command
-;; history, are identical. Unlike shell mode, however, Eshell mode's
-;; governing process is Emacs itself. With shell mode, an inferior
-;; shell process is executed that communicates with Emacs via comint
-;; -- a mode for handling sub-process interaction. Eshell mode, on
-;; the other hand, is a truly native Emacs shell. No subprocess are
-;; invoked except the ones requested by the user at the prompt.
-;;
-;; After entering a command, use <RET> to invoke it ([Command
-;; invocation]) . If there is a command on disk, it will be executed
-;; as in a normal shell. If there is no command by that name on disk,
-;; but a Lisp function with that name is defined, the Lisp function
-;; will be called, using the arguments passed on the command line.
-;;
-;; Some of the other features of the command interaction mode are:
-;;
-;; @ <M-RET> can be used to accumulate further commands while a
-;; command is currently running. Since all input is passed to the
-;; subprocess being executed, there is no automatic input queueing
-;; as there is with other shells.
-;;
-;; @ <C-c C-t> can be used to truncate the buffer if it grows too
-;; large.
-;;
-;; @ <C-c C-r> will move point to the beginning of the output of the
-;; last command. With a prefix argument, it will narrow to view
-;; only that output.
-;;
-;; @ <C-c C-o> will delete the output from the last command.
-;;
-;; @ <C-c C-f> will move forward a complete shell argument.
-;;
-;; @ <C-c C-b> will move backward a complete shell argument.
-
-(require 'esh-module)
-(require 'esh-cmd)
-(require 'esh-io)
-(require 'esh-var)
-
-;;; User Variables:
-
-(defcustom eshell-mode-unload-hook nil
- "*A hook that gets run when `eshell-mode' is unloaded."
- :type 'hook
- :group 'eshell-mode)
-
-(defcustom eshell-mode-hook nil
- "*A hook that gets run when `eshell-mode' is entered."
- :type 'hook
- :group 'eshell-mode)
-
-(defcustom eshell-first-time-mode-hook nil
- "*A hook that gets run the first time `eshell-mode' is entered.
-That is to say, the first time during an Emacs session."
- :type 'hook
- :group 'eshell-mode)
-
-(defcustom eshell-exit-hook '(eshell-query-kill-processes)
- "*A hook that is run whenever `eshell' is exited.
-This hook is only run if exiting actually kills the buffer."
- :type 'hook
- :group 'eshell-mode)
-
-(defcustom eshell-kill-on-exit t
- "*If non-nil, kill the Eshell buffer on the `exit' command.
-Otherwise, the buffer will simply be buried."
- :type 'boolean
- :group 'eshell-mode)
-
-(defcustom eshell-input-filter-functions nil
- "*Functions to call before input is processed.
-The input is contained in the region from `eshell-last-input-start' to
-`eshell-last-input-end'."
- :type 'hook
- :group 'eshell-mode)
-
-(defcustom eshell-send-direct-to-subprocesses nil
- "*If t, send any input immediately to a subprocess."
- :type 'boolean
- :group 'eshell-mode)
-
-(defcustom eshell-expand-input-functions nil
- "*Functions to call before input is parsed.
-Each function is passed two arguments, which bounds the region of the
-current input text."
- :type 'hook
- :group 'eshell-mode)
-
-(defcustom eshell-scroll-to-bottom-on-input nil
- "*Controls whether input to interpreter causes window to scroll.
-If nil, then do not scroll. If t or `all', scroll all windows showing
-buffer. If `this', scroll only the selected window.
-
-See `eshell-preinput-scroll-to-bottom'."
- :type '(radio (const :tag "Do not scroll Eshell windows" nil)
- (const :tag "Scroll all windows showing the buffer" all)
- (const :tag "Scroll only the selected window" this))
- :group 'eshell-mode)
-
-(defcustom eshell-scroll-to-bottom-on-output nil
- "*Controls whether interpreter output causes window to scroll.
-If nil, then do not scroll. If t or `all', scroll all windows showing
-buffer. If `this', scroll only the selected window. If `others',
-scroll only those that are not the selected window.
-
-See variable `eshell-scroll-show-maximum-output' and function
-`eshell-postoutput-scroll-to-bottom'."
- :type '(radio (const :tag "Do not scroll Eshell windows" nil)
- (const :tag "Scroll all windows showing the buffer" all)
- (const :tag "Scroll only the selected window" this)
- (const :tag "Scroll all windows other than selected" this))
- :group 'eshell-mode)
-
-(defcustom eshell-scroll-show-maximum-output t
- "*Controls how interpreter output causes window to scroll.
-If non-nil, then show the maximum output when the window is scrolled.
-
-See variable `eshell-scroll-to-bottom-on-output' and function
-`eshell-postoutput-scroll-to-bottom'."
- :type 'boolean
- :group 'eshell-mode)
-
-(defcustom eshell-buffer-maximum-lines 1024
- "*The maximum size in lines for eshell buffers.
-Eshell buffers are truncated from the top to be no greater than this
-number, if the function `eshell-truncate-buffer' is on
-`eshell-output-filter-functions'."
- :type 'integer
- :group 'eshell-mode)
-
-(defcustom eshell-output-filter-functions
- '(eshell-handle-control-codes
- eshell-watch-for-password-prompt)
- "*Functions to call before output is displayed.
-These functions are only called for output that is displayed
-interactively, and not for output which is redirected."
- :type 'hook
- :group 'eshell-mode)
-
-(defcustom eshell-preoutput-filter-functions nil
- "*Functions to call before output is inserted into the buffer.
-These functions get one argument, a string containing the text to be
-inserted. They return the string as it should be inserted."
- :type 'hook
- :group 'eshell-mode)
-
-(defcustom eshell-password-prompt-regexp
- "[Pp]ass\\(word\\|phrase\\).*:\\s *\\'"
- "*Regexp matching prompts for passwords in the inferior process.
-This is used by `eshell-watch-for-password-prompt'."
- :type 'regexp
- :group 'eshell-mode)
-
-(defcustom eshell-skip-prompt-function nil
- "*A function called from beginning of line to skip the prompt."
- :type '(choice (const nil) function)
- :group 'eshell-mode)
-
-(defcustom eshell-status-in-modeline t
- "*If non-nil, let the user know a command is running in the modeline."
- :type 'boolean
- :group 'eshell-mode)
-
-(defvar eshell-first-time-p t
- "A variable which is non-nil the first time Eshell is loaded.")
-
-;; Internal Variables:
-
-;; these are only set to `nil' initially for the sake of the
-;; byte-compiler, when compiling other files which `require' this one
-(defvar eshell-mode nil)
-(defvar eshell-mode-map nil)
-(defvar eshell-command-running-string "--")
-(defvar eshell-command-map nil)
-(defvar eshell-command-prefix nil)
-(defvar eshell-last-input-start nil)
-(defvar eshell-last-input-end nil)
-(defvar eshell-last-output-start nil)
-(defvar eshell-last-output-block-begin nil)
-(defvar eshell-last-output-end nil)
-
-(defvar eshell-currently-handling-window nil)
-(defvar eshell-mode-syntax-table nil)
-(defvar eshell-mode-abbrev-table nil)
-
-(define-abbrev-table 'eshell-mode-abbrev-table ())
-
-(eval-when-compile
- (unless (eshell-under-xemacs-p)
- (defalias 'characterp 'ignore)
- (defalias 'char-int 'ignore)))
-
-(if (not eshell-mode-syntax-table)
- (let ((i 0))
- (setq eshell-mode-syntax-table (make-syntax-table))
- (while (< i ?0)
- (modify-syntax-entry i "_ " eshell-mode-syntax-table)
- (setq i (1+ i)))
- (setq i (1+ ?9))
- (while (< i ?A)
- (modify-syntax-entry i "_ " eshell-mode-syntax-table)
- (setq i (1+ i)))
- (setq i (1+ ?Z))
- (while (< i ?a)
- (modify-syntax-entry i "_ " eshell-mode-syntax-table)
- (setq i (1+ i)))
- (setq i (1+ ?z))
- (while (< i 128)
- (modify-syntax-entry i "_ " eshell-mode-syntax-table)
- (setq i (1+ i)))
- (modify-syntax-entry ? " " eshell-mode-syntax-table)
- (modify-syntax-entry ?\t " " eshell-mode-syntax-table)
- (modify-syntax-entry ?\f " " eshell-mode-syntax-table)
- (modify-syntax-entry ?\n "> " eshell-mode-syntax-table)
- ;; Give CR the same syntax as newline, for selective-display.
- (modify-syntax-entry ?\^m "> " eshell-mode-syntax-table)
-;;; (modify-syntax-entry ?\; "< " eshell-mode-syntax-table)
- (modify-syntax-entry ?` "' " eshell-mode-syntax-table)
- (modify-syntax-entry ?' "' " eshell-mode-syntax-table)
- (modify-syntax-entry ?, "' " eshell-mode-syntax-table)
- ;; Used to be singlequote; changed for flonums.
- (modify-syntax-entry ?. "_ " eshell-mode-syntax-table)
- (modify-syntax-entry ?- "_ " eshell-mode-syntax-table)
- (modify-syntax-entry ?| ". " eshell-mode-syntax-table)
- (modify-syntax-entry ?# "' " eshell-mode-syntax-table)
- (modify-syntax-entry ?\" "\" " eshell-mode-syntax-table)
- (modify-syntax-entry ?\\ "/ " eshell-mode-syntax-table)
- (modify-syntax-entry ?\( "() " eshell-mode-syntax-table)
- (modify-syntax-entry ?\) ")( " eshell-mode-syntax-table)
- (modify-syntax-entry ?\{ "(} " eshell-mode-syntax-table)
- (modify-syntax-entry ?\} "){ " eshell-mode-syntax-table)
- (modify-syntax-entry ?\[ "(] " eshell-mode-syntax-table)
- (modify-syntax-entry ?\] ")[ " eshell-mode-syntax-table)
- ;; All non-word multibyte characters should be `symbol'.
- (if (eshell-under-xemacs-p)
- (map-char-table
- (function
- (lambda (key val)
- (and (characterp key)
- (>= (char-int key) 256)
- (/= (char-syntax key) ?w)
- (modify-syntax-entry key "_ "
- eshell-mode-syntax-table))))
- (standard-syntax-table))
- (map-char-table
- (function
- (lambda (key val)
- (and (>= key 256)
- (/= (char-syntax key) ?w)
- (modify-syntax-entry key "_ "
- eshell-mode-syntax-table))))
- (standard-syntax-table)))))
-
-;;; User Functions:
-
-;;;###autoload
-(defun eshell-mode ()
- "Emacs shell interactive mode.
-
-\\{eshell-mode-map}"
- (kill-all-local-variables)
-
- (setq major-mode 'eshell-mode)
- (setq mode-name "EShell")
- (set (make-local-variable 'eshell-mode) t)
-
- (make-local-variable 'eshell-mode-map)
- (setq eshell-mode-map (make-sparse-keymap))
- (use-local-map eshell-mode-map)
-
- (when eshell-status-in-modeline
- (make-local-variable 'eshell-command-running-string)
- (let ((fmt (copy-sequence mode-line-format)))
- (make-local-variable 'mode-line-format)
- (setq mode-line-format fmt))
- (let ((modeline (memq 'mode-line-modified mode-line-format)))
- (if modeline
- (setcar modeline 'eshell-command-running-string))))
-
- (define-key eshell-mode-map [return] 'eshell-send-input)
- (define-key eshell-mode-map [(control ?m)] 'eshell-send-input)
- (define-key eshell-mode-map [(control ?j)] 'eshell-send-input)
- (define-key eshell-mode-map [(meta return)] 'eshell-queue-input)
- (define-key eshell-mode-map [(meta control ?m)] 'eshell-queue-input)
- (define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output)
-
- (set (make-local-variable 'eshell-command-prefix)
- (make-symbol "eshell-command-prefix"))
- (fset eshell-command-prefix (make-sparse-keymap))
- (set (make-local-variable 'eshell-command-map)
- (symbol-function eshell-command-prefix))
- (define-key eshell-mode-map [(control ?c)] eshell-command-prefix)
-
- ;; without this, find-tag complains about read-only text being
- ;; modified
- (if (eq (key-binding [(meta ?.)]) 'find-tag)
- (define-key eshell-mode-map [(meta ?.)] 'eshell-find-tag))
- (define-key eshell-command-map [(meta ?o)] 'eshell-mark-output)
- (define-key eshell-command-map [(meta ?d)] 'eshell-toggle-direct-send)
-
- (define-key eshell-command-map [(control ?a)] 'eshell-bol)
- (define-key eshell-command-map [(control ?b)] 'eshell-backward-argument)
- (define-key eshell-command-map [(control ?e)] 'eshell-show-maximum-output)
- (define-key eshell-command-map [(control ?f)] 'eshell-forward-argument)
- (define-key eshell-command-map [return] 'eshell-copy-old-input)
- (define-key eshell-command-map [(control ?m)] 'eshell-copy-old-input)
- (define-key eshell-command-map [(control ?o)] 'eshell-kill-output)
- (define-key eshell-command-map [(control ?r)] 'eshell-show-output)
- (define-key eshell-command-map [(control ?t)] 'eshell-truncate-buffer)
- (define-key eshell-command-map [(control ?u)] 'eshell-kill-input)
- (define-key eshell-command-map [(control ?w)] 'backward-kill-word)
- (define-key eshell-command-map [(control ?y)] 'eshell-repeat-argument)
-
- (setq local-abbrev-table eshell-mode-abbrev-table)
- (set-syntax-table eshell-mode-syntax-table)
-
- (set (make-local-variable 'dired-directory) default-directory)
- (set (make-local-variable 'list-buffers-directory)
- (expand-file-name default-directory))
-
- ;; always set the tab width to 8 in Eshell buffers, since external
- ;; commands which do their own formatting almost always expect this
- (set (make-local-variable 'tab-width) 8)
-
- ;; don't ever use auto-fill in Eshell buffers
- (setq auto-fill-function nil)
-
- ;; always display everything from a return value
- (if (boundp 'print-length)
- (set (make-local-variable 'print-length) nil))
- (if (boundp 'print-level)
- (set (make-local-variable 'print-level) nil))
-
- ;; set require-final-newline to nil; otherwise, all redirected
- ;; output will end with a newline, whether or not the source
- ;; indicated it!
- (set (make-local-variable 'require-final-newline) nil)
-
- (set (make-local-variable 'max-lisp-eval-depth)
- (max 3000 max-lisp-eval-depth))
- (set (make-local-variable 'max-specpdl-size)
- (max 6000 max-lisp-eval-depth))
-
- (set (make-local-variable 'eshell-last-input-start) (point-marker))
- (set (make-local-variable 'eshell-last-input-end) (point-marker))
- (set (make-local-variable 'eshell-last-output-start) (point-marker))
- (set (make-local-variable 'eshell-last-output-end) (point-marker))
- (set (make-local-variable 'eshell-last-output-block-begin) (point))
-
- (let ((modules-list (copy-sequence eshell-modules-list)))
- (make-local-variable 'eshell-modules-list)
- (setq eshell-modules-list modules-list))
-
- ;; load extension modules into memory. This will cause any global
- ;; variables they define to be visible, since some of the core
- ;; modules sometimes take advantage of their functionality if used.
- (eshell-for module eshell-modules-list
- (let ((module-fullname (symbol-name module))
- module-shortname)
- (if (string-match "^eshell-\\(.*\\)" module-fullname)
- (setq module-shortname
- (concat "em-" (match-string 1 module-fullname))))
- (unless module-shortname
- (error "Invalid Eshell module name: %s" module-fullname))
- (unless (featurep (intern module-shortname))
- (load module-shortname))))
-
- (unless (file-exists-p eshell-directory-name)
- (eshell-make-private-directory eshell-directory-name t))
-
- ;; load core Eshell modules for this session
- (eshell-for module (eshell-subgroups 'eshell)
- (run-hooks (intern-soft (concat (symbol-name module)
- "-load-hook"))))
-
- ;; load extension modules for this session
- (eshell-for module eshell-modules-list
- (let ((load-hook (intern-soft (concat (symbol-name module)
- "-load-hook"))))
- (if (and load-hook (boundp load-hook))
- (run-hooks load-hook))))
-
- (if eshell-send-direct-to-subprocesses
- (add-hook 'pre-command-hook 'eshell-intercept-commands t t))
-
- (if eshell-scroll-to-bottom-on-input
- (add-hook 'pre-command-hook 'eshell-preinput-scroll-to-bottom t t))
-
- (when eshell-scroll-show-maximum-output
- (set (make-local-variable 'scroll-conservatively) 1000))
-
- (when eshell-status-in-modeline
- (add-hook 'eshell-pre-command-hook 'eshell-command-started nil t)
- (add-hook 'eshell-post-command-hook 'eshell-command-finished nil t))
-
- (add-hook 'kill-buffer-hook
- (function
- (lambda ()
- (run-hooks 'eshell-exit-hook))) t t)
-
- (if eshell-first-time-p
- (run-hooks 'eshell-first-time-mode-hook))
- (run-hooks 'eshell-mode-hook)
- (run-hooks 'eshell-post-command-hook))
-
-(put 'eshell-mode 'mode-class 'special)
-
-(eshell-deftest mode major-mode
- "Major mode is correct"
- (eq major-mode 'eshell-mode))
-
-(eshell-deftest mode eshell-mode-variable
- "`eshell-mode' is true"
- (eq eshell-mode t))
-
-(eshell-deftest var window-height
- "LINES equals window height"
- (let ((eshell-stringify-t t))
- (eshell-command-result-p "= $LINES (window-height)" "t\n")))
-
-(defun eshell-command-started ()
- "Indicate in the modeline that a command has started."
- (setq eshell-command-running-string "**")
- (force-mode-line-update))
-
-(defun eshell-command-finished ()
- "Indicate in the modeline that a command has finished."
- (setq eshell-command-running-string "--")
- (force-mode-line-update))
-
-(eshell-deftest mode command-running-p
- "Modeline shows no command running"
- (or (eshell-under-xemacs-p)
- (not eshell-status-in-modeline)
- (and (memq 'eshell-command-running-string mode-line-format)
- (equal eshell-command-running-string "--"))))
-
-;;; Internal Functions:
-
-(defun eshell-toggle-direct-send ()
- (interactive)
- (if eshell-send-direct-to-subprocesses
- (progn
- (setq eshell-send-direct-to-subprocesses nil)
- (remove-hook 'pre-command-hook 'eshell-intercept-commands t)
- (message "Sending subprocess input on RET"))
- (setq eshell-send-direct-to-subprocesses t)
- (add-hook 'pre-command-hook 'eshell-intercept-commands t t)
- (message "Sending subprocess input directly")))
-
-(defun eshell-self-insert-command (N)
- (interactive "i")
- (process-send-string
- (eshell-interactive-process)
- (char-to-string (if (symbolp last-command-char)
- (get last-command-char 'ascii-character)
- last-command-char))))
-
-(defun eshell-intercept-commands ()
- (when (and (eshell-interactive-process)
- (not (and (integerp last-input-event)
- (memq last-input-event '(?\C-x ?\C-c)))))
- (let ((possible-events (where-is-internal this-command))
- (name (symbol-name this-command))
- (intercept t))
- ;; Assume that any multikey combination which does NOT target an
- ;; Eshell command, is a combo the user wants invoked rather than
- ;; sent to the underlying subprocess.
- (unless (and (> (length name) 7)
- (equal (substring name 0 7) "eshell-"))
- (while possible-events
- (if (> (length (car possible-events)) 1)
- (setq intercept nil possible-events nil)
- (setq possible-events (cdr possible-events)))))
- (if intercept
- (setq this-command 'eshell-self-insert-command)))))
-
-(defun eshell-find-tag (&optional tagname next-p regexp-p)
- "A special version of `find-tag' that ignores read-onlyness."
- (interactive)
- (require 'etags)
- (let ((inhibit-read-only t)
- (no-default (eobp))
- (find-tag-default-function 'ignore))
- (setq tagname (car (find-tag-interactive "Find tag: ")))
- (find-tag tagname next-p regexp-p)))
-
-(defun eshell-move-argument (limit func property arg)
- "Move forward ARG arguments."
- (catch 'eshell-incomplete
- (eshell-parse-arguments (save-excursion (eshell-bol) (point))
- (line-end-position)))
- (let ((pos (save-excursion
- (funcall func 1)
- (while (and (> arg 0) (/= (point) limit))
- (if (get-text-property (point) property)
- (setq arg (1- arg)))
- (if (> arg 0)
- (funcall func 1)))
- (point))))
- (goto-char pos)
- (if (and (eq func 'forward-char)
- (= (1+ pos) limit))
- (forward-char 1))))
-
-(eshell-deftest arg forward-arg
- "Move across command arguments"
- (eshell-insert-command "echo $(+ 1 (- 4 3)) \"alpha beta\" file" 'ignore)
- (let ((here (point)) begin valid)
- (eshell-bol)
- (setq begin (point))
- (eshell-forward-argument 4)
- (setq valid (= here (point)))
- (eshell-backward-argument 4)
- (prog1
- (and valid (= begin (point)))
- (eshell-bol)
- (delete-region (point) (point-max)))))
-
-(defun eshell-forward-argument (&optional arg)
- "Move forward ARG arguments."
- (interactive "p")
- (eshell-move-argument (point-max) 'forward-char 'arg-end arg))
-
-(defun eshell-backward-argument (&optional arg)
- "Move backward ARG arguments."
- (interactive "p")
- (eshell-move-argument (point-min) 'backward-char 'arg-begin arg))
-
-(defun eshell-repeat-argument (&optional arg)
- (interactive "p")
- (let ((begin (save-excursion
- (eshell-backward-argument arg)
- (point))))
- (kill-ring-save begin (point))
- (yank)))
-
-(defun eshell-bol ()
- "Goes to the beginning of line, then skips past the prompt, if any."
- (interactive)
- (beginning-of-line)
- (and eshell-skip-prompt-function
- (funcall eshell-skip-prompt-function)))
-
-(defsubst eshell-push-command-mark ()
- "Push a mark at the end of the last input text."
- (push-mark (1- eshell-last-input-end) t))
-
-(custom-add-option 'eshell-pre-command-hook 'eshell-push-command-mark)
-
-(defsubst eshell-goto-input-start ()
- "Goto the start of the last command input.
-Putting this function on `eshell-pre-command-hook' will mimic Plan 9's
-9term behavior."
- (goto-char eshell-last-input-start))
-
-(custom-add-option 'eshell-pre-command-hook 'eshell-push-command-mark)
-
-(defsubst eshell-interactive-print (string)
- "Print STRING to the eshell display buffer."
- (eshell-output-filter nil string))
-
-(defsubst eshell-begin-on-new-line ()
- "This function outputs a newline if not at beginning of line."
- (save-excursion
- (goto-char eshell-last-output-end)
- (or (bolp)
- (eshell-interactive-print "\n"))))
-
-(defsubst eshell-reset (&optional no-hooks)
- "Output a prompt on a new line, aborting any current input.
-If NO-HOOKS is non-nil, then `eshell-post-command-hook' won't be run."
- (goto-char (point-max))
- (setq eshell-last-input-start (point-marker)
- eshell-last-input-end (point-marker)
- eshell-last-output-start (point-marker)
- eshell-last-output-block-begin (point)
- eshell-last-output-end (point-marker))
- (eshell-begin-on-new-line)
- (unless no-hooks
- (run-hooks 'eshell-post-command-hook)
- (goto-char (point-max))))
-
-(defun eshell-parse-command-input (beg end &optional args)
- "Parse the command input from BEG to END.
-The difference is that `eshell-parse-command' expects a complete
-command string (and will error if it doesn't get one), whereas this
-function will inform the caller whether more input is required.
-
-If nil is returned, more input is necessary (probably because a
-multi-line input string wasn't terminated properly). Otherwise, it
-will return the parsed command."
- (let (delim command)
- (if (setq delim
- (catch 'eshell-incomplete
- (ignore
- (setq command (eshell-parse-command (cons beg end)
- args t)))))
- (ignore
- (message "Expecting completion of delimeter %c ..."
- (if (listp delim)
- (car delim)
- delim)))
- command)))
-
-(defun eshell-update-markers (pmark)
- "Update the input and output markers relative to point and PMARK."
- (set-marker eshell-last-input-start pmark)
- (set-marker eshell-last-input-end (point))
- (set-marker eshell-last-output-end (point)))
-
-(defun eshell-queue-input (&optional use-region)
- "Queue the current input text for execution by Eshell.
-Particularly, don't send the text to the current process, even if it's
-waiting for input."
- (interactive "P")
- (eshell-send-input use-region t))
-
-(eshell-deftest mode queue-input
- "Queue command input"
- (eshell-insert-command "sleep 2")
- (eshell-insert-command "echo alpha" 'eshell-queue-input)
- (let ((count 10))
- (while (and eshell-current-command
- (> count 0))
- (sit-for 1 0)
- (setq count (1- count))))
- (eshell-match-result "alpha\n"))
-
-(defun eshell-send-input (&optional use-region queue-p no-newline)
- "Send the input received to Eshell for parsing and processing..
-After `eshell-last-output-end', sends all text from that marker to
-point as input. Before that marker, calls `eshell-get-old-input' to
-retrieve old input, copies it to the end of the buffer, and sends it.
-
-If USE-REGION is non-nil, the current region (between point and mark)
-will be used as input.
-
-If QUEUE-P is non-nil, input will be queued until the next prompt,
-rather than sent to the currently active process. If no process, the
-input is processed immediately.
-
-If NO-NEWLINE is non-nil, the input is sent without an implied final
-newline."
- (interactive "P")
- ;; Note that the input string does not include its terminal newline.
- (let ((proc-running-p (and (eshell-interactive-process)
- (not queue-p)))
- (inhibit-point-motion-hooks t)
- after-change-functions)
- (unless (and proc-running-p
- (not (eq (process-status
- (eshell-interactive-process)) 'run)))
- (if (or proc-running-p
- (>= (point) eshell-last-output-end))
- (goto-char (point-max))
- (let ((copy (eshell-get-old-input use-region)))
- (goto-char eshell-last-output-end)
- (insert-and-inherit copy)))
- (unless (or no-newline
- (and eshell-send-direct-to-subprocesses
- proc-running-p))
- (insert-before-markers-and-inherit ?\n))
- (if proc-running-p
- (progn
- (eshell-update-markers eshell-last-output-end)
- (if (or eshell-send-direct-to-subprocesses
- (= eshell-last-input-start eshell-last-input-end))
- (unless no-newline
- (process-send-string (eshell-interactive-process) "\n"))
- (process-send-region (eshell-interactive-process)
- eshell-last-input-start
- eshell-last-input-end)))
- (if (= eshell-last-output-end (point))
- (run-hooks 'eshell-post-command-hook)
- (let (input)
- (eshell-condition-case err
- (progn
- (setq input (buffer-substring-no-properties
- eshell-last-output-end (1- (point))))
- (run-hook-with-args 'eshell-expand-input-functions
- eshell-last-output-end (1- (point)))
- (let ((cmd (eshell-parse-command-input
- eshell-last-output-end (1- (point)))))
- (when cmd
- (eshell-update-markers eshell-last-output-end)
- (setq input (buffer-substring-no-properties
- eshell-last-input-start
- (1- eshell-last-input-end)))
- (run-hooks 'eshell-input-filter-functions)
- (and (catch 'eshell-terminal
- (ignore
- (if (eshell-invoke-directly cmd input)
- (eval cmd)
- (eshell-eval-command cmd input))))
- (eshell-life-is-too-much)))))
- (quit
- (eshell-reset t)
- (run-hooks 'eshell-post-command-hook)
- (signal 'quit nil))
- (error
- (eshell-reset t)
- (eshell-interactive-print
- (concat (error-message-string err) "\n"))
- (run-hooks 'eshell-post-command-hook)
- (insert-and-inherit input)))))))))
-
-; (eshell-deftest proc send-to-subprocess
-; "Send input to a subprocess"
-; ;; jww (1999-12-06): what about when bc is unavailable?
-; (if (not (eshell-search-path "bc"))
-; t
-; (eshell-insert-command "bc")
-; (eshell-insert-command "1 + 2")
-; (sit-for 1 0)
-; (forward-line -1)
-; (prog1
-; (looking-at "3\n")
-; (eshell-insert-command "quit")
-; (sit-for 1 0))))
-
-(defsubst eshell-kill-new ()
- "Add the last input text to the kill ring."
- (kill-ring-save eshell-last-input-start eshell-last-input-end))
-
-(custom-add-option 'eshell-input-filter-functions 'eshell-kill-new)
-
-(defun eshell-output-filter (process string)
- "Send the output from PROCESS (STRING) to the interactive display.
-This is done after all necessary filtering has been done."
- (let ((oprocbuf (if process (process-buffer process)
- (current-buffer)))
- (inhibit-point-motion-hooks t)
- after-change-functions)
- (let ((functions eshell-preoutput-filter-functions))
- (while (and functions string)
- (setq string (funcall (car functions) string))
- (setq functions (cdr functions))))
- (if (and string oprocbuf (buffer-name oprocbuf))
- (let ((obuf (current-buffer))
- opoint obeg oend)
- (set-buffer oprocbuf)
- (setq opoint (point))
- (setq obeg (point-min))
- (setq oend (point-max))
- (let ((buffer-read-only nil)
- (nchars (length string))
- (ostart nil))
- (widen)
- (goto-char eshell-last-output-end)
- (setq ostart (point))
- (if (<= (point) opoint)
- (setq opoint (+ opoint nchars)))
- (if (< (point) obeg)
- (setq obeg (+ obeg nchars)))
- (if (<= (point) oend)
- (setq oend (+ oend nchars)))
- (insert-before-markers string)
- (if (= (window-start (selected-window)) (point))
- (set-window-start (selected-window)
- (- (point) nchars)))
- (if (= (point) eshell-last-input-end)
- (set-marker eshell-last-input-end
- (- eshell-last-input-end nchars)))
- (set-marker eshell-last-output-start ostart)
- (set-marker eshell-last-output-end (point))
- (force-mode-line-update))
- (narrow-to-region obeg oend)
- (goto-char opoint)
- (eshell-run-output-filters)
- (set-buffer obuf)))))
-
-(defun eshell-run-output-filters ()
- "Run the `eshell-output-filter-functions' on the current output."
- (save-current-buffer
- (run-hooks 'eshell-output-filter-functions))
- (setq eshell-last-output-block-begin
- (marker-position eshell-last-output-end)))
-
-;;; jww (1999-10-23): this needs testing
-(defun eshell-preinput-scroll-to-bottom ()
- "Go to the end of buffer in all windows showing it.
-Movement occurs if point in the selected window is not after the
-process mark, and `this-command' is an insertion command. Insertion
-commands recognised are `self-insert-command', `yank', and
-`hilit-yank'. Depends on the value of
-`eshell-scroll-to-bottom-on-input'.
-
-This function should be a pre-command hook."
- (if (memq this-command '(self-insert-command yank hilit-yank))
- (let* ((selected (selected-window))
- (current (current-buffer))
- (scroll eshell-scroll-to-bottom-on-input))
- (if (< (point) eshell-last-output-end)
- (if (eq scroll 'this)
- (goto-char (point-max))
- (walk-windows
- (function
- (lambda (window)
- (when (and (eq (window-buffer window) current)
- (or (eq scroll t) (eq scroll 'all)))
- (select-window window)
- (goto-char (point-max))
- (select-window selected))))
- nil t))))))
-
-;;; jww (1999-10-23): this needs testing
-(defun eshell-postoutput-scroll-to-bottom ()
- "Go to the end of buffer in all windows showing it.
-Does not scroll if the current line is the last line in the buffer.
-Depends on the value of `eshell-scroll-to-bottom-on-output' and
-`eshell-scroll-show-maximum-output'.
-
-This function should be in the list `eshell-output-filter-functions'."
- (let* ((selected (selected-window))
- (current (current-buffer))
- (scroll eshell-scroll-to-bottom-on-output))
- (unwind-protect
- (walk-windows
- (function
- (lambda (window)
- (if (eq (window-buffer window) current)
- (progn
- (select-window window)
- (if (and (< (point) eshell-last-output-end)
- (or (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to end.
- (and (eq scroll 'this)
- (eq selected window))
- (and (eq scroll 'others)
- (not (eq selected window)))
- ;; If point was at the end, keep it at end.
- (>= (point) eshell-last-output-start)))
- (goto-char eshell-last-output-end))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (if (and eshell-scroll-show-maximum-output
- (>= (point) eshell-last-output-end))
- (save-excursion
- (goto-char (point-max))
- (recenter -1)))
- (select-window selected)))))
- nil t)
- (set-buffer current))))
-
-(custom-add-option 'eshell-output-filter-functions
- 'eshell-postoutput-scroll-to-bottom)
-
-(defun eshell-beginning-of-input ()
- "Return the location of the start of the previous input."
- eshell-last-input-start)
-
-(defun eshell-beginning-of-output ()
- "Return the location of the end of the previous output block."
- eshell-last-input-end)
-
-(defun eshell-end-of-output ()
- "Return the location of the end of the previous output block."
- (if (eshell-using-module 'eshell-prompt)
- eshell-last-output-start
- eshell-last-output-end))
-
-(defun eshell-kill-output ()
- "Kill all output from interpreter since last input.
-Does not delete the prompt."
- (interactive)
- (save-excursion
- (goto-char (eshell-beginning-of-output))
- (insert "*** output flushed ***\n")
- (delete-region (point) (eshell-end-of-output))))
-
-(eshell-deftest io flush-output
- "Flush previous output"
- (eshell-insert-command "echo alpha")
- (eshell-kill-output)
- (and (eshell-match-result (regexp-quote "*** output flushed ***\n"))
- (forward-line)
- (= (point) eshell-last-output-start)))
-
-(defun eshell-show-output (&optional arg)
- "Display start of this batch of interpreter output at top of window.
-Sets mark to the value of point when this command is run.
-With a prefix argument, narrows region to last command output."
- (interactive "P")
- (goto-char (eshell-beginning-of-output))
- (set-window-start (selected-window)
- (save-excursion
- (goto-char (eshell-beginning-of-input))
- (line-beginning-position)))
- (if arg
- (narrow-to-region (eshell-beginning-of-output)
- (eshell-end-of-output)))
- (eshell-end-of-output))
-
-(defun eshell-mark-output (&optional arg)
- "Display start of this batch of interpreter output at top of window.
-Sets mark to the value of point when this command is run.
-With a prefix argument, narrows region to last command output."
- (interactive "P")
- (push-mark (eshell-show-output arg)))
-
-(defun eshell-kill-input ()
- "Kill all text from last stuff output by interpreter to point."
- (interactive)
- (if (> (point) eshell-last-output-end)
- (kill-region eshell-last-output-end (point))
- (let ((here (point)))
- (eshell-bol)
- (kill-region (point) here))))
-
-(defun eshell-show-maximum-output ()
- "Put the end of the buffer at the bottom of the window."
- (interactive)
- (if (interactive-p)
- (widen))
- (goto-char (point-max))
- (recenter -1))
-
-(defun eshell-get-old-input (&optional use-current-region)
- "Return the command input on the current line."
- (if use-current-region
- (buffer-substring (min (point) (mark))
- (max (point) (mark)))
- (save-excursion
- (beginning-of-line)
- (and eshell-skip-prompt-function
- (funcall eshell-skip-prompt-function))
- (let ((beg (point)))
- (end-of-line)
- (buffer-substring beg (point))))))
-
-(defun eshell-copy-old-input ()
- "Insert after prompt old input at point as new input to be edited."
- (interactive)
- (let ((input (eshell-get-old-input)))
- (goto-char eshell-last-output-end)
- (insert-and-inherit input)))
-
-(eshell-deftest mode run-old-command
- "Re-run an old command"
- (eshell-insert-command "echo alpha")
- (goto-char eshell-last-input-start)
- (string= (eshell-get-old-input) "echo alpha"))
-
-(defun eshell/exit ()
- "Leave or kill the Eshell buffer, depending on `eshell-kill-on-exit'."
- (throw 'eshell-terminal t))
-
-(defun eshell-life-is-too-much ()
- "Kill the current buffer (or bury it). Good-bye Eshell."
- (interactive)
- (if (not eshell-kill-on-exit)
- (bury-buffer)
- (kill-buffer (current-buffer))))
-
-(defun eshell-truncate-buffer ()
- "Truncate the buffer to `eshell-buffer-maximum-lines'.
-This function could be on `eshell-output-filter-functions' or bound to
-a key."
- (interactive)
- (save-excursion
- (goto-char eshell-last-output-end)
- (let ((lines (count-lines 1 (point)))
- (inhibit-read-only t))
- (forward-line (- eshell-buffer-maximum-lines))
- (beginning-of-line)
- (let ((pos (point)))
- (if (bobp)
- (if (interactive-p)
- (error "Buffer too short to truncate"))
- (delete-region (point-min) (point))
- (if (interactive-p)
- (message "Truncated buffer from %d to %d lines (%.1fk freed)"
- lines eshell-buffer-maximum-lines
- (/ pos 1024.0))))))))
-
-(custom-add-option 'eshell-output-filter-functions
- 'eshell-truncate-buffer)
-
-(defun eshell-send-invisible (str)
- "Read a string without echoing.
-Then send it to the process running in the current buffer."
- (interactive "P") ; Defeat snooping via C-x ESC ESC
- (let ((str (read-passwd
- (format "Password: "
- (process-name (eshell-interactive-process))))))
- (if (stringp str)
- (process-send-string (eshell-interactive-process)
- (concat str "\n"))
- (message "Warning: text will be echoed"))))
-
-(defun eshell-watch-for-password-prompt ()
- "Prompt in the minibuffer for password and send without echoing.
-This function uses `eshell-send-invisible' to read and send a password to the
-buffer's process if STRING contains a password prompt defined by
-`eshell-password-prompt-regexp'.
-
-This function could be in the list `eshell-output-filter-functions'."
- (when (eshell-interactive-process)
- (save-excursion
- (goto-char eshell-last-output-block-begin)
- (beginning-of-line)
- (if (re-search-forward eshell-password-prompt-regexp
- eshell-last-output-end t)
- (eshell-send-invisible nil)))))
-
-(custom-add-option 'eshell-output-filter-functions
- 'eshell-watch-for-password-prompt)
-
-(defun eshell-handle-control-codes ()
- "Act properly when certain control codes are seen."
- (save-excursion
- (let ((orig (point)))
- (goto-char eshell-last-output-block-begin)
- (unless (eolp)
- (beginning-of-line))
- (while (< (point) eshell-last-output-end)
- (let ((char (char-after)))
- (cond
- ((eq char ?\r)
- (if (< (1+ (point)) eshell-last-output-end)
- (if (memq (char-after (1+ (point)))
- '(?\n ?\r))
- (delete-char 1)
- (let ((end (1+ (point))))
- (beginning-of-line)
- (delete-region (point) end)))
- (add-text-properties (point) (1+ (point))
- '(invisible t))
- (forward-char)))
- ((eq char ?\a)
- (delete-char 1)
- (beep))
- ((eq char ?\C-h)
- (delete-backward-char 1)
- (delete-char 1))
- (t
- (forward-char))))))))
-
-(custom-add-option 'eshell-output-filter-functions
- 'eshell-handle-control-codes)
-
-;;; Code:
-
-;;; esh-mode.el ends here
+++ /dev/null
-;;; esh-module.el --- Eshell modules
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-;; Keywords: processes
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-module)
-
-(eval-when-compile
- (require 'esh-maint)
- (require 'cl))
-
-(defgroup eshell-module nil
- "The `eshell-module' group is for Eshell extension modules, which
-provide optional behavior which the user can enable or disable by
-customizing the variable `eshell-modules-list'."
- :tag "Extension modules"
- :group 'eshell)
-
-;;; Commentary:
-
-(require 'esh-util)
-
-(defun eshell-load-defgroups (&optional directory)
- "Load `defgroup' statements from Eshell's module files."
- (with-current-buffer
- (find-file-noselect (expand-file-name "esh-groups.el" directory))
- (erase-buffer)
- (insert ";;; do not modify this file; it is auto-generated -*- no-byte-compile: t -*-\n\n")
- (let ((files (directory-files (or directory
- (car command-line-args-left))
- nil "\\`em-.*\\.el\\'")))
- (while files
- (message "Loading defgroup from `%s'" (car files))
- (let (defgroup)
- (catch 'handled
- (with-current-buffer (find-file-noselect (car files))
- (goto-char (point-min))
- (while t
- (forward-sexp)
- (if (eobp) (throw 'handled t))
- (backward-sexp)
- (let ((begin (point))
- (defg (looking-at "(defgroup")))
- (forward-sexp)
- (if defg
- (setq defgroup (buffer-substring begin (point))))))))
- (if defgroup
- (insert defgroup "\n\n")))
- (setq files (cdr files))))
- (save-buffer)))
-
-;; load the defgroup's for the standard extension modules, so that
-;; documentation can be provided when the user customize's
-;; `eshell-modules-list'.
-(eval-when-compile
- (when (and (boundp 'byte-compile-current-file)
- byte-compile-current-file
- (or
- (equal (file-name-nondirectory byte-compile-current-file)
- "esh-module.el")
- ;; When eshell file names are expanded from a wildcard
- ;; or by reading the Eshell directory, e.g. when they
- ;; say "make recompile" in the lisp directory, Emacs on
- ;; MS-DOS sees a truncated name "esh-modu.el" instead of
- ;; "esh-module.el".
- (and (fboundp 'msdos-long-file-names)
- (null (msdos-long-file-names))
- (equal (file-name-nondirectory byte-compile-current-file)
- "esh-modu.el"))))
- (let* ((directory (file-name-directory byte-compile-current-file))
- (elc-file (expand-file-name "esh-groups.elc" directory)))
- (eshell-load-defgroups directory)
- (if (file-exists-p elc-file) (delete-file elc-file)))))
-
-(load "esh-groups" t t)
-
-;;; User Variables:
-
-(defcustom eshell-module-unload-hook
- '(eshell-unload-extension-modules)
- "*A hook run when `eshell-module' is unloaded."
- :type 'hook
- :group 'eshell-module)
-
-(defcustom eshell-modules-list
- '(eshell-alias
- eshell-banner
- eshell-basic
- eshell-cmpl
- eshell-dirs
- eshell-glob
- eshell-hist
- eshell-ls
- eshell-pred
- eshell-prompt
- eshell-script
- eshell-term
- eshell-unix)
- "*A list of optional add-on modules to be loaded by Eshell.
-Changes will only take effect in future Eshell buffers."
- :type (append
- (list 'set ':tag "Supported modules")
- (mapcar
- (function
- (lambda (modname)
- (let ((modsym (intern modname)))
- (list 'const
- ':tag (format "%s -- %s" modname
- (get modsym 'custom-tag))
- ':link (caar (get modsym 'custom-links))
- ':doc (concat "\n" (get modsym 'group-documentation)
- "\n ")
- modsym))))
- (sort (mapcar 'symbol-name
- (eshell-subgroups 'eshell-module))
- 'string-lessp))
- '((repeat :inline t :tag "Other modules" symbol)))
- :group 'eshell-module)
-
-;;; Code:
-
-(defsubst eshell-using-module (module)
- "Return non-nil if a certain Eshell MODULE is in use.
-The MODULE should be a symbol corresponding to that module's
-customization group. Example: `eshell-cmpl' for that module."
- (memq module eshell-modules-list))
-
-(defun eshell-unload-extension-modules ()
- "Unload any memory resident extension modules."
- (eshell-for module (eshell-subgroups 'eshell-module)
- (if (featurep module)
- (ignore-errors
- (message "Unloading %s..." (symbol-name module))
- (unload-feature module)
- (message "Unloading %s...done" (symbol-name module))))))
-
-;;; esh-module.el ends here
+++ /dev/null
-;;; esh-opt.el --- command options processing
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-opt)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-opt nil
- "The options processing code handles command argument parsing for
-Eshell commands implemented in Lisp."
- :tag "Command options processing"
- :group 'eshell)
-
-;;; Commentary:
-
-;;; User Functions:
-
-(defmacro eshell-eval-using-options (name macro-args
- options &rest body-forms)
- "Process NAME's MACRO-ARGS using a set of command line OPTIONS.
-After doing so, settings will be stored in local symbols as declared
-by OPTIONS; FORMS will then be evaluated -- assuming all was OK.
-
-The syntax of OPTIONS is:
-
- '((?C nil nil multi-column \"multi-column display\")
- (nil \"help\" nil nil \"show this usage display\")
- (?r \"reverse\" nil reverse-list \"reverse order while sorting\")
- :external \"ls\"
- :usage \"[OPTION]... [FILE]...
- List information about the FILEs (the current directory by default).
- Sort entries alphabetically across.\")
-
-`eshell-eval-using-options' returns the value of the last form in
-BODY-FORMS. If instead an external command is run, the tag
-`eshell-external' will be thrown with the new process for its value.
-
-Lastly, any remaining arguments will be available in a locally
-interned variable `args' (created using a `let' form)."
- `(let ((temp-args
- ,(if (memq ':preserve-args (cadr options))
- macro-args
- (list 'eshell-stringify-list
- (list 'eshell-flatten-list macro-args)))))
- (let ,(append (mapcar (function
- (lambda (opt)
- (or (and (listp opt) (nth 3 opt))
- 'eshell-option-stub)))
- (cadr options))
- '(usage-msg last-value ext-command args))
- (eshell-do-opt ,name ,options (quote ,body-forms)))))
-
-;;; Internal Functions:
-
-(eval-when-compile
- (defvar temp-args)
- (defvar last-value)
- (defvar usage-msg)
- (defvar ext-command)
- (defvar args))
-
-(defun eshell-do-opt (name options body-forms)
- "Helper function for `eshell-eval-using-options'.
-This code doesn't really need to be macro expanded everywhere."
- (setq args temp-args)
- (if (setq
- ext-command
- (catch 'eshell-ext-command
- (when (setq
- usage-msg
- (catch 'eshell-usage
- (setq last-value nil)
- (if (and (= (length args) 0)
- (memq ':show-usage options))
- (throw 'eshell-usage
- (eshell-show-usage name options)))
- (setq args (eshell-process-args name args options)
- last-value (eval (append (list 'progn)
- body-forms)))
- nil))
- (error usage-msg))))
- (throw 'eshell-external
- (eshell-external-command ext-command args))
- last-value))
-
-(defun eshell-show-usage (name options)
- "Display the usage message for NAME, using OPTIONS."
- (let ((usage (format "usage: %s %s\n\n" name
- (cadr (memq ':usage options))))
- (extcmd (memq ':external options))
- (post-usage (memq ':post-usage options))
- had-option)
- (while options
- (when (listp (car options))
- (let ((opt (car options)))
- (setq had-option t)
- (cond ((and (nth 0 opt)
- (nth 1 opt))
- (setq usage
- (concat usage
- (format " %-20s %s\n"
- (format "-%c, --%s" (nth 0 opt)
- (nth 1 opt))
- (nth 4 opt)))))
- ((nth 0 opt)
- (setq usage
- (concat usage
- (format " %-20s %s\n"
- (format "-%c" (nth 0 opt))
- (nth 4 opt)))))
- ((nth 1 opt)
- (setq usage
- (concat usage
- (format " %-20s %s\n"
- (format " --%s" (nth 1 opt))
- (nth 4 opt)))))
- (t (setq had-option nil)))))
- (setq options (cdr options)))
- (if post-usage
- (setq usage (concat usage (and had-option "\n")
- (cadr post-usage))))
- (when extcmd
- (setq extcmd (eshell-search-path (cadr extcmd)))
- (if extcmd
- (setq usage
- (concat usage
- (format "
-This command is implemented in Lisp. If an unrecognized option is
-passed to this command, the external version '%s'
-will be called instead." extcmd)))))
- (throw 'eshell-usage usage)))
-
-(defun eshell-set-option (name ai opt options)
- "Using NAME's remaining args (index AI), set the OPT within OPTIONS.
-If the option consumes an argument for its value, the argument list
-will be modified."
- (if (not (nth 3 opt))
- (eshell-show-usage name options)
- (if (eq (nth 2 opt) t)
- (if (> ai (length args))
- (error "%s: missing option argument" name)
- (set (nth 3 opt) (nth ai args))
- (if (> ai 0)
- (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args))
- (setq args (cdr args))))
- (set (nth 3 opt) (or (nth 2 opt) t)))))
-
-(defun eshell-process-option (name switch kind ai options)
- "For NAME, process SWITCH (of type KIND), from args at index AI.
-The SWITCH will be looked up in the set of OPTIONS.
-
-SWITCH should be either a string or character. KIND should be the
-integer 0 if it's a character, or 1 if it's a string.
-
-The SWITCH is then be matched against OPTIONS. If no matching handler
-is found, and an :external command is defined (and available), it will
-be called; otherwise, an error will be triggered to say that the
-switch is unrecognized."
- (let* ((opts options)
- found)
- (while opts
- (if (and (listp (car opts))
- (nth kind (car opts))
- (if (= kind 0)
- (eq switch (nth kind (car opts)))
- (string= switch (nth kind (car opts)))))
- (progn
- (eshell-set-option name ai (car opts) options)
- (setq found t opts nil))
- (setq opts (cdr opts))))
- (unless found
- (let ((extcmd (memq ':external options)))
- (when extcmd
- (setq extcmd (eshell-search-path (cadr extcmd)))
- (if extcmd
- (throw 'eshell-ext-command extcmd)
- (if (char-valid-p switch)
- (error "%s: unrecognized option -%c" name switch)
- (error "%s: unrecognized option --%s" name switch))))))))
-
-(defun eshell-process-args (name args options)
- "Process the given ARGS using OPTIONS.
-This assumes that symbols have been intern'd by `eshell-with-options'."
- (let ((ai 0) arg)
- (while (< ai (length args))
- (setq arg (nth ai args))
- (if (not (and (stringp arg)
- (string-match "^-\\(-\\)?\\(.*\\)" arg)))
- (setq ai (1+ ai))
- (let* ((dash (match-string 1 arg))
- (switch (match-string 2 arg)))
- (if (= ai 0)
- (setq args (cdr args))
- (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)))
- (if dash
- (if (> (length switch) 0)
- (eshell-process-option name switch 1 ai options)
- (setq ai (length args)))
- (let ((len (length switch))
- (index 0))
- (while (< index len)
- (eshell-process-option name (aref switch index) 0 ai options)
- (setq index (1+ index)))))))))
- args)
-
-;;; Code:
-
-;;; esh-opt.el ends here
+++ /dev/null
-;;; esh-proc.el --- process management
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-proc)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-proc nil
- "When Eshell invokes external commands, it always does so
-asynchronously, so that Emacs isn't tied up waiting for the process to
-finish."
- :tag "Process management"
- :group 'eshell)
-
-;;; Commentary:
-
-;;; User Variables:
-
-(defcustom eshell-proc-load-hook '(eshell-proc-initialize)
- "*A hook that gets run when `eshell-proc' is loaded."
- :type 'hook
- :group 'eshell-proc)
-
-(defcustom eshell-process-wait-seconds 0
- "*The number of seconds to delay waiting for a synchronous process."
- :type 'integer
- :group 'eshell-proc)
-
-(defcustom eshell-process-wait-milliseconds 50
- "*The number of milliseconds to delay waiting for a synchronous process."
- :type 'integer
- :group 'eshell-proc)
-
-(defcustom eshell-done-messages-in-minibuffer t
- "*If non-nil, subjob \"Done\" messages will display in minibuffer."
- :type 'boolean
- :group 'eshell-proc)
-
-(defcustom eshell-delete-exited-processes t
- "*If nil, process entries will stick around until `jobs' is run.
-This variable sets the buffer-local value of `delete-exited-processes'
-in Eshell buffers.
-
-This variable causes Eshell to mimic the behavior of bash when set to
-nil. It allows the user to view the exit status of a completed subjob
-\(process) at their leisure, because the process entry remains in
-memory until the user examines it using \\[list-processes].
-
-Otherwise, if `eshell-done-messages-in-minibuffer' is nil, and this
-variable is set to t, the only indication the user will have that a
-subjob is done is that it will no longer appear in the
-\\[list-processes\\] display.
-
-Note that Eshell will have to be restarted for a change in this
-variable's value to take effect."
- :type 'boolean
- :group 'eshell-proc)
-
-(defcustom eshell-reset-signals
- "^\\(interrupt\\|killed\\|quit\\|stopped\\)"
- "*If a termination signal matches this regexp, the terminal will be reset."
- :type 'regexp
- :group 'eshell-proc)
-
-(defcustom eshell-exec-hook nil
- "*Called each time a process is exec'd by `eshell-gather-process-output'.
-It is passed one argument, which is the process that was just started.
-It is useful for things that must be done each time a process is
-executed in a eshell mode buffer (e.g., `process-kill-without-query').
-In contrast, `eshell-mode-hook' is only executed once when the buffer
-is created."
- :type 'hook
- :group 'eshell-proc)
-
-(defcustom eshell-kill-hook '(eshell-reset-after-proc)
- "*Called when a process run by `eshell-gather-process-output' has ended.
-It is passed two arguments: the process that was just ended, and the
-termination status (as a string). Note that the first argument may be
-nil, in which case the user attempted to send a signal, but there was
-no relevant process. This can be used for displaying help
-information, for example."
- :type 'hook
- :group 'eshell-proc)
-
-;;; Internal Variables:
-
-(defvar eshell-current-subjob-p nil)
-
-(defvar eshell-process-list nil
- "A list of the current status of subprocesses.")
-
-;;; Functions:
-
-(defun eshell-proc-initialize ()
- "Initialize the process handling code."
- (make-local-variable 'eshell-process-list)
- (define-key eshell-command-map [(meta ?i)] 'eshell-insert-process)
- (define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process)
- (define-key eshell-command-map [(control ?k)] 'eshell-kill-process)
- (define-key eshell-command-map [(control ?d)] 'eshell-send-eof-to-process)
-; (define-key eshell-command-map [(control ?q)] 'eshell-continue-process)
- (define-key eshell-command-map [(control ?s)] 'list-processes)
-; (define-key eshell-command-map [(control ?z)] 'eshell-stop-process)
- (define-key eshell-command-map [(control ?\\)] 'eshell-quit-process))
-
-(defun eshell-reset-after-proc (proc status)
- "Reset the command input location after a process terminates.
-The signals which will cause this to happen are matched by
-`eshell-reset-signals'."
- (if (and (stringp status)
- (string-match eshell-reset-signals status))
- (eshell-reset)))
-
-(defun eshell-wait-for-process (&rest procs)
- "Wait until PROC has successfully completed."
- (while procs
- (let ((proc (car procs)))
- (when (eshell-processp proc)
- ;; NYI: If the process gets stopped here, that's bad.
- (while (assq proc eshell-process-list)
- (if (input-pending-p)
- (discard-input))
- (sit-for eshell-process-wait-seconds
- eshell-process-wait-milliseconds))))
- (setq procs (cdr procs))))
-
-(defalias 'eshell/wait 'eshell-wait-for-process)
-
-(defun eshell/jobs (&rest args)
- "List processes, if there are any."
- (and (fboundp 'process-list)
- (process-list)
- (list-processes)))
-
-(defun eshell/kill (&rest args)
- "Kill processes, buffers, symbol or files."
- (let ((ptr args)
- (signum 'SIGINT))
- (while ptr
- (if (or (eshell-processp (car ptr))
- (and (stringp (car ptr))
- (string-match "^[A-Za-z/][A-Za-z0-9<>/]+$"
- (car ptr))))
- ;; What about when $lisp-variable is possible here?
- ;; It could very well name a process.
- (setcar ptr (get-process (car ptr))))
- (setq ptr (cdr ptr)))
- (while args
- (let ((id (if (eshell-processp (car args))
- (process-id (car args))
- (car args))))
- (when id
- (cond
- ((null id)
- (error "kill: bad signal spec"))
- ((and (numberp id) (= id 0))
- (error "kill: bad signal spec `%d'" id))
- ((and (stringp id)
- (string-match "^-?[0-9]+$" id))
- (setq signum (abs (string-to-number id))))
- ((stringp id)
- (let (case-fold-search)
- (if (string-match "^-\\([A-Z]+\\)$" id)
- (setq signum
- (intern (concat "SIG" (match-string 1 id))))
- (error "kill: bad signal spec `%s'" id))))
- ((< id 0)
- (setq signum (abs id)))
- (t
- (signal-process id signum)))))
- (setq args (cdr args)))
- nil))
-
-(defun eshell-read-process-name (prompt)
- "Read the name of a process from the minibuffer, using completion.
-The prompt will be set to PROMPT."
- (completing-read prompt
- (mapcar
- (function
- (lambda (proc)
- (cons (process-name proc) t)))
- (process-list)) nil t))
-
-(defun eshell-insert-process (process)
- "Insert the name of PROCESS into the current buffer at point."
- (interactive
- (list (get-process
- (eshell-read-process-name "Name of process: "))))
- (insert-and-inherit "#<process " (process-name process) ">"))
-
-(defsubst eshell-record-process-object (object)
- "Record OBJECT as now running."
- (if (and (eshell-processp object)
- eshell-current-subjob-p)
- (eshell-interactive-print
- (format "[%s] %d\n" (process-name object) (process-id object))))
- (setq eshell-process-list
- (cons (list object eshell-current-handles
- eshell-current-subjob-p nil nil)
- eshell-process-list)))
-
-(defun eshell-remove-process-entry (entry)
- "Record the process ENTRY as fully completed."
- (if (and (eshell-processp (car entry))
- (nth 2 entry)
- eshell-done-messages-in-minibuffer)
- (message (format "[%s]+ Done %s" (process-name (car entry))
- (process-command (car entry)))))
- (setq eshell-process-list
- (delq entry eshell-process-list)))
-
-(defvar eshell-scratch-buffer " *eshell-scratch*"
- "Scratch buffer for holding Eshell's input/output.")
-(defvar eshell-last-sync-output-start nil
- "A marker that tracks the beginning of output of the last subprocess.
-Used only on systems which do not support async subprocesses.")
-
-(defun eshell-gather-process-output (command args)
- "Gather the output from COMMAND + ARGS."
- (unless (and (file-executable-p command)
- (file-regular-p command))
- (error "%s: not an executable file" command))
- (let* ((delete-exited-processes
- (if eshell-current-subjob-p
- eshell-delete-exited-processes
- delete-exited-processes))
- (process-environment (eshell-environment-variables))
- proc decoding encoding changed)
- (cond
- ((fboundp 'start-process)
- (setq proc
- (apply 'start-process
- (file-name-nondirectory command) nil
- ;; `start-process' can't deal with relative
- ;; filenames
- (append (list (expand-file-name command)) args)))
- (eshell-record-process-object proc)
- (set-process-buffer proc (current-buffer))
- (if (eshell-interactive-output-p)
- (set-process-filter proc 'eshell-output-filter)
- (set-process-filter proc 'eshell-insertion-filter))
- (set-process-sentinel proc 'eshell-sentinel)
- (run-hook-with-args 'eshell-exec-hook proc)
- (when (fboundp 'process-coding-system)
- (let ((coding-systems (process-coding-system proc)))
- (setq decoding (car coding-systems)
- encoding (cdr coding-systems)))
- ;; If start-process decided to use some coding system for
- ;; decoding data sent from the process and the coding system
- ;; doesn't specify EOL conversion, we had better convert CRLF
- ;; to LF.
- (if (vectorp (coding-system-eol-type decoding))
- (setq decoding (coding-system-change-eol-conversion decoding 'dos)
- changed t))
- ;; Even if start-process left the coding system for encoding
- ;; data sent from the process undecided, we had better use the
- ;; same one as what we use for decoding. But, we should
- ;; suppress EOL conversion.
- (if (and decoding (not encoding))
- (setq encoding (coding-system-change-eol-conversion decoding 'unix)
- changed t))
- (if changed
- (set-process-coding-system proc decoding encoding))))
- (t
- ;; No async subprocesses...
- (let ((oldbuf (current-buffer))
- (interact-p (eshell-interactive-output-p))
- lbeg lend line proc-buf exit-status)
- (and (not (markerp eshell-last-sync-output-start))
- (setq eshell-last-sync-output-start (point-marker)))
- (setq proc-buf
- (set-buffer (get-buffer-create eshell-scratch-buffer)))
- (erase-buffer)
- (set-buffer oldbuf)
- (run-hook-with-args 'eshell-exec-hook command)
- (setq exit-status
- (apply 'call-process-region
- (append (list eshell-last-sync-output-start (point)
- command t
- eshell-scratch-buffer nil)
- args)))
- ;; When in a pipeline, record the place where the output of
- ;; this process will begin.
- (and eshell-in-pipeline-p
- (set-marker eshell-last-sync-output-start (point)))
- ;; Simulate the effect of the process filter.
- (when (numberp exit-status)
- (set-buffer proc-buf)
- (goto-char (point-min))
- (setq lbeg (point))
- (while (eq 0 (forward-line 1))
- (setq lend (point)
- line (buffer-substring-no-properties lbeg lend))
- (set-buffer oldbuf)
- (if interact-p
- (eshell-output-filter nil line)
- (eshell-output-object line))
- (setq lbeg lend)
- (set-buffer proc-buf))
- (set-buffer oldbuf))
- (eshell-update-markers eshell-last-output-end)
- ;; Simulate the effect of eshell-sentinel.
- (eshell-close-handles (if (numberp exit-status) exit-status -1))
- (run-hook-with-args 'eshell-kill-hook command exit-status)
- (or eshell-in-pipeline-p
- (setq eshell-last-sync-output-start nil))
- (if (not (numberp exit-status))
- (error "%s: external command failed: %s" command exit-status))
- (setq proc t))))
- proc))
-
-(defun eshell-insertion-filter (proc string)
- "Insert a string into the eshell buffer, or a process/file/buffer.
-PROC is the process for which we're inserting output. STRING is the
-output."
- (when (buffer-live-p (process-buffer proc))
- (set-buffer (process-buffer proc))
- (let ((entry (assq proc eshell-process-list)))
- (when entry
- (setcar (nthcdr 3 entry)
- (concat (nth 3 entry) string))
- (unless (nth 4 entry) ; already being handled?
- (while (nth 3 entry)
- (let ((data (nth 3 entry)))
- (setcar (nthcdr 3 entry) nil)
- (setcar (nthcdr 4 entry) t)
- (eshell-output-object data nil (cadr entry))
- (setcar (nthcdr 4 entry) nil))))))))
-
-(defun eshell-sentinel (proc string)
- "Generic sentinel for command processes. Reports only signals.
-PROC is the process that's exiting. STRING is the exit message."
- (when (buffer-live-p (process-buffer proc))
- (set-buffer (process-buffer proc))
- (unwind-protect
- (let* ((entry (assq proc eshell-process-list)))
-; (if (not entry)
-; (error "Sentinel called for unowned process `%s'"
-; (process-name proc))
- (when entry
- (unwind-protect
- (progn
- (unless (string= string "run")
- (unless (string-match "^\\(finished\\|exited\\)" string)
- (eshell-insertion-filter proc string))
- (eshell-close-handles (process-exit-status proc) 'nil
- (cadr entry))))
- (eshell-remove-process-entry entry))))
- (run-hook-with-args 'eshell-kill-hook proc string))))
-
-(defun eshell-process-interact (func &optional all query)
- "Interact with a process, using PROMPT if more than one, via FUNC.
-If ALL is non-nil, background processes will be interacted with as well.
-If QUERY is non-nil, query the user with QUERY before calling FUNC."
- (let (defunct result)
- (eshell-for entry eshell-process-list
- (if (and (memq (process-status (car entry))
- '(run stop open closed))
- (or all
- (not (nth 2 entry)))
- (or (not query)
- (y-or-n-p (format query (process-name (car entry))))))
- (setq result (funcall func (car entry))))
- (unless (memq (process-status (car entry))
- '(run stop open closed))
- (setq defunct (cons entry defunct))))
- ;; clean up the process list; this can get dirty if an error
- ;; occurred that brought the user into the debugger, and then they
- ;; quit, so that the sentinel was never called.
- (eshell-for d defunct
- (eshell-remove-process-entry d))
- result))
-
-(defcustom eshell-kill-process-wait-time 5
- "*Seconds to wait between sending termination signals to a subprocess."
- :type 'integer
- :group 'eshell-proc)
-
-(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
- "*Signals used to kill processes when an Eshell buffer exits.
-Eshell calls each of these signals in order when an Eshell buffer is
-killed; if the process is still alive afterwards, Eshell waits a
-number of seconds defined by `eshell-kill-process-wait-time', and
-tries the next signal in the list."
- :type '(repeat symbol)
- :group 'eshell-proc)
-
-(defcustom eshell-kill-processes-on-exit nil
- "*If non-nil, kill active processes when exiting an Eshell buffer.
-Emacs will only kill processes owned by that Eshell buffer.
-
-If nil, ownership of background and foreground processes reverts to
-Emacs itself, and will die only if the user exits Emacs, calls
-`kill-process', or terminates the processes externally.
-
-If `ask', Emacs prompts the user before killing any processes.
-
-If `every', it prompts once for every process.
-
-If t, it kills all buffer-owned processes without asking.
-
-Processes are first sent SIGHUP, then SIGINT, then SIGQUIT, then
-SIGKILL. The variable `eshell-kill-process-wait-time' specifies how
-long to delay between signals."
- :type '(choice (const :tag "Kill all, don't ask" t)
- (const :tag "Ask before killing" ask)
- (const :tag "Ask for each process" every)
- (const :tag "Don't kill subprocesses" nil))
- :group 'eshell-proc)
-
-(defun eshell-round-robin-kill (&optional query)
- "Kill current process by trying various signals in sequence.
-See the variable `eshell-kill-processes-on-exit'."
- (let ((sigs eshell-kill-process-signals))
- (while sigs
- (eshell-process-interact
- (function
- (lambda (proc)
- (signal-process (process-id proc) (car sigs)))) t query)
- (setq query nil)
- (if (not eshell-process-list)
- (setq sigs nil)
- (sleep-for eshell-kill-process-wait-time)
- (setq sigs (cdr sigs))))))
-
-(defun eshell-query-kill-processes ()
- "Kill processes belonging to the current Eshell buffer, possibly w/ query."
- (when (and eshell-kill-processes-on-exit
- eshell-process-list)
- (save-window-excursion
- (list-processes)
- (if (or (not (eq eshell-kill-processes-on-exit 'ask))
- (y-or-n-p (format "Kill processes owned by `%s'? "
- (buffer-name))))
- (eshell-round-robin-kill
- (if (eq eshell-kill-processes-on-exit 'every)
- "Kill Eshell child process `%s'? ")))
- (let ((buf (get-buffer "*Process List*")))
- (if (and buf (buffer-live-p buf))
- (kill-buffer buf)))
- (message nil))))
-
-(custom-add-option 'eshell-exit-hook 'eshell-query-kill-processes)
-
-(defun eshell-interrupt-process ()
- "Interrupt a process."
- (interactive)
- (unless (eshell-process-interact 'interrupt-process)
- (run-hook-with-args 'eshell-kill-hook nil "interrupt")))
-
-(defun eshell-kill-process ()
- "Kill a process."
- (interactive)
- (unless (eshell-process-interact 'kill-process)
- (run-hook-with-args 'eshell-kill-hook nil "killed")))
-
-(defun eshell-quit-process ()
- "Send quit signal to process."
- (interactive)
- (unless (eshell-process-interact 'quit-process)
- (run-hook-with-args 'eshell-kill-hook nil "quit")))
-
-;(defun eshell-stop-process ()
-; "Send STOP signal to process."
-; (interactive)
-; (unless (eshell-process-interact 'stop-process)
-; (run-hook-with-args 'eshell-kill-hook nil "stopped")))
-
-;(defun eshell-continue-process ()
-; "Send CONTINUE signal to process."
-; (interactive)
-; (unless (eshell-process-interact 'continue-process)
-; ;; jww (1999-09-17): this signal is not dealt with yet. For
-; ;; example, `eshell-reset' will be called, and so will
-; ;; `eshell-resume-eval'.
-; (run-hook-with-args 'eshell-kill-hook nil "continue")))
-
-(defun eshell-send-eof-to-process ()
- "Send EOF to process."
- (interactive)
- (eshell-send-input nil nil t)
- (eshell-process-interact 'process-send-eof))
-
-;;; Code:
-
-;;; esh-proc.el ends here
+++ /dev/null
-;;; esh-test.el --- Eshell test suite
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-test)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-test nil
- "This module is meant to ensure that Eshell is working correctly."
- :tag "Eshell test suite"
- :group 'eshell)
-
-;;; Commentary:
-
-;; The purpose of this module is to verify that Eshell works as
-;; expected. To run it on your system, use the command
-;; \\[eshell-test].
-
-;;; Code:
-
-(require 'esh-mode)
-
-;;; User Variables:
-
-(defface eshell-test-ok-face
- '((((class color) (background light)) (:foreground "Green" :bold t))
- (((class color) (background dark)) (:foreground "Green" :bold t)))
- "*The face used to highlight OK result strings."
- :group 'eshell-test)
-
-(defface eshell-test-failed-face
- '((((class color) (background light)) (:foreground "OrangeRed" :bold t))
- (((class color) (background dark)) (:foreground "OrangeRed" :bold t))
- (t (:bold t)))
- "*The face used to highlight FAILED result strings."
- :group 'eshell-test)
-
-(defcustom eshell-show-usage-metrics nil
- "*If non-nil, display different usage metrics for each Eshell command."
- :set (lambda (symbol value)
- (if value
- (add-hook 'eshell-mode-hook 'eshell-show-usage-metrics)
- (remove-hook 'eshell-mode-hook 'eshell-show-usage-metrics))
- (set symbol value))
- :type '(choice (const :tag "No metrics" nil)
- (const :tag "Cons cells consumed" t)
- (const :tag "Time elapsed" 0))
- :group 'eshell-test)
-
-;;; Code:
-
-(eval-when-compile
- (defvar test-buffer))
-
-(defun eshell-insert-command (text &optional func)
- "Insert a command at the end of the buffer."
- (goto-char eshell-last-output-end)
- (insert-and-inherit text)
- (funcall (or func 'eshell-send-input)))
-
-(defun eshell-match-result (regexp)
- "Insert a command at the end of the buffer."
- (goto-char eshell-last-input-end)
- (looking-at regexp))
-
-(defun eshell-command-result-p (text regexp &optional func)
- "Insert a command at the end of the buffer."
- (eshell-insert-command text func)
- (eshell-match-result regexp))
-
-(defvar eshell-test-failures nil)
-
-(defun eshell-run-test (module funcsym label command)
- "Test whether FORM evaluates to a non-nil value."
- (when (let ((sym (intern-soft (concat "eshell-" (symbol-name module)))))
- (or (memq sym (eshell-subgroups 'eshell))
- (eshell-using-module sym)))
- (with-current-buffer test-buffer
- (insert-before-markers
- (format "%-70s " (substring label 0 (min 70 (length label)))))
- (insert-before-markers " ....")
- (eshell-redisplay))
- (let ((truth (eval command)))
- (with-current-buffer test-buffer
- (delete-backward-char 6)
- (insert-before-markers
- "[" (let (str)
- (if truth
- (progn
- (setq str " OK ")
- (put-text-property 0 6 'face
- 'eshell-test-ok-face str))
- (setq str "FAILED")
- (setq eshell-test-failures (1+ eshell-test-failures))
- (put-text-property 0 6 'face
- 'eshell-test-failed-face str))
- str) "]")
- (add-text-properties (line-beginning-position) (point)
- (list 'test-func funcsym))
- (eshell-redisplay)))))
-
-(defun eshell-test-goto-func ()
- "Jump to the function that defines a particular test."
- (interactive)
- (let ((fsym (get-text-property (point) 'test-func)))
- (when fsym
- (let* ((def (symbol-function fsym))
- (library (locate-library (symbol-file fsym)))
- (name (substring (symbol-name fsym)
- (length "eshell-test--")))
- (inhibit-redisplay t))
- (find-file library)
- (goto-char (point-min))
- (re-search-forward (concat "^(eshell-deftest\\s-+\\w+\\s-+"
- name))
- (beginning-of-line)))))
-
-(defun eshell-run-one-test (&optional arg)
- "Jump to the function that defines a particular test."
- (interactive "P")
- (let ((fsym (get-text-property (point) 'test-func)))
- (when fsym
- (beginning-of-line)
- (delete-region (point) (line-end-position))
- (let ((test-buffer (current-buffer)))
- (set-buffer (let ((inhibit-redisplay t))
- (save-window-excursion (eshell t))))
- (funcall fsym)
- (unless arg
- (kill-buffer (current-buffer)))))))
-
-;;;###autoload
-(defun eshell-test (&optional arg)
- "Test Eshell to verify that it works as expected."
- (interactive "P")
- (let* ((begin (eshell-time-to-seconds (current-time)))
- (test-buffer (get-buffer-create "*eshell test*")))
- (set-buffer (let ((inhibit-redisplay t))
- (save-window-excursion (eshell t))))
- (with-current-buffer test-buffer
- (erase-buffer)
- (setq major-mode 'eshell-test-mode)
- (setq mode-name "EShell Test")
- (set (make-local-variable 'eshell-test-failures) 0)
- (local-set-key [(control ?c) (control ?c)] 'eshell-test-goto-func)
- (local-set-key [(control ?c) (control ?r)] 'eshell-run-one-test)
- (local-set-key [(control ?m)] 'eshell-test-goto-func)
- (local-set-key [return] 'eshell-test-goto-func)
-
- (insert "Testing Eshell under "
- (format "GNU Emacs %s (%s%s)"
- emacs-version
- system-configuration
- (cond ((featurep 'motif) ", Motif")
- ((featurep 'x-toolkit) ", X toolkit")
- (t ""))))
- (switch-to-buffer test-buffer)
- (delete-other-windows))
- (eshell-for funcname (sort (all-completions "eshell-test--"
- obarray 'functionp)
- 'string-lessp)
- (with-current-buffer test-buffer
- (insert "\n"))
- (funcall (intern-soft funcname)))
- (with-current-buffer test-buffer
- (insert (format "\n\n--- %s --- (completed in %d seconds)\n"
- (current-time-string)
- (- (eshell-time-to-seconds (current-time))
- begin)))
- (message "Eshell test suite completed: %s failure%s"
- (if (> eshell-test-failures 0)
- (number-to-string eshell-test-failures)
- "No")
- (if (= eshell-test-failures 1) "" "s"))))
- (goto-char eshell-last-output-end)
- (unless arg
- (kill-buffer (current-buffer))))
-
-
-(defvar eshell-metric-before-command 0)
-(defvar eshell-metric-after-command 0)
-
-(defun eshell-show-usage-metrics ()
- "If run at Eshell mode startup, metrics are shown after each command."
- (set (make-local-variable 'eshell-metric-before-command)
- (if (eq eshell-show-usage-metrics t)
- 0
- (current-time)))
- (set (make-local-variable 'eshell-metric-after-command)
- (if (eq eshell-show-usage-metrics t)
- 0
- (current-time)))
-
- (add-hook 'eshell-pre-command-hook
- (function
- (lambda ()
- (setq eshell-metric-before-command
- (if (eq eshell-show-usage-metrics t)
- (car (memory-use-counts))
- (current-time))))) nil t)
-
- (add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-metric-after-command
- (if (eq eshell-show-usage-metrics t)
- (car (memory-use-counts))
- (current-time)))
- (eshell-interactive-print
- (concat
- (int-to-string
- (if (eq eshell-show-usage-metrics t)
- (- eshell-metric-after-command
- eshell-metric-before-command 7)
- (- (eshell-time-to-seconds
- eshell-metric-after-command)
- (eshell-time-to-seconds
- eshell-metric-before-command))))
- "\n"))))
- nil t))
-
-;;; esh-test.el ends here
+++ /dev/null
-;;; esh-util.el --- general utilities
-
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-util)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-util nil
- "This is general utility code, meant for use by Eshell itself."
- :tag "General utilities"
- :group 'eshell)
-
-;;; Commentary:
-
-(require 'pp)
-
-;;; User Variables:
-
-(defcustom eshell-stringify-t t
- "*If non-nil, the string representation of t is 't'.
-If nil, t will be represented only in the exit code of the function,
-and not printed as a string. This causes Lisp functions to behave
-similarly to external commands, as far as successful result output."
- :type 'boolean
- :group 'eshell-util)
-
-(defcustom eshell-group-file "/etc/group"
- "*If non-nil, the name of the group file on your system."
- :type '(choice (const :tag "No group file" nil) file)
- :group 'eshell-util)
-
-(defcustom eshell-passwd-file "/etc/passwd"
- "*If non-nil, the name of the passwd file on your system."
- :type '(choice (const :tag "No passwd file" nil) file)
- :group 'eshell-util)
-
-(defcustom eshell-hosts-file "/etc/hosts"
- "*The name of the /etc/hosts file."
- :type '(choice (const :tag "No hosts file" nil) file)
- :group 'eshell-util)
-
-(defcustom eshell-handle-errors t
- "*If non-nil, Eshell will handle errors itself.
-Setting this to nil is offered as an aid to debugging only."
- :type 'boolean
- :group 'eshell-util)
-
-(defcustom eshell-private-file-modes 384 ; umask 177
- "*The file-modes value to use for creating \"private\" files."
- :type 'integer
- :group 'eshell-util)
-
-(defcustom eshell-private-directory-modes 448 ; umask 077
- "*The file-modes value to use for creating \"private\" directories."
- :type 'integer
- :group 'eshell-util)
-
-(defcustom eshell-tar-regexp
- "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
- "*Regular expression used to match tar file names."
- :type 'regexp
- :group 'eshell-util)
-
-(defcustom eshell-convert-numeric-arguments t
- "*If non-nil, converting arguments of numeric form to Lisp numbers.
-Numeric form is tested using the regular expression
-`eshell-number-regexp'.
-
-NOTE: If you find that numeric conversions are intefering with the
-specification of filenames (for example, in calling `find-file', or
-some other Lisp function that deals with files, not numbers), add the
-following in your .emacs file:
-
- (put 'find-file 'eshell-no-numeric-conversions t)
-
-Any function with the property `eshell-no-numeric-conversions' set to
-a non-nil value, will be passed strings, not numbers, even when an
-argument matches `eshell-number-regexp'."
- :type 'boolean
- :group 'eshell-util)
-
-(defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?"
- "*Regular expression used to match numeric arguments.
-If `eshell-convert-numeric-arguments' is non-nil, and an argument
-matches this regexp, it will be converted to a Lisp number, using the
-function `string-to-number'."
- :type 'regexp
- :group 'eshell-util)
-
-(defcustom eshell-ange-ls-uids nil
- "*List of user/host/id strings, used to determine remote ownership."
- :type '(repeat (cons :tag "Host for User/UID map"
- (string :tag "Hostname")
- (repeat (cons :tag "User/UID List"
- (string :tag "Username")
- (repeat :tag "UIDs" string)))))
- :group 'eshell-util)
-
-;;; Internal Variables:
-
-(defvar eshell-group-names nil
- "A cache to hold the names of groups.")
-
-(defvar eshell-group-timestamp nil
- "A timestamp of when the group file was read.")
-
-(defvar eshell-user-names nil
- "A cache to hold the names of users.")
-
-(defvar eshell-user-timestamp nil
- "A timestamp of when the user file was read.")
-
-(defvar eshell-host-names nil
- "A cache the names of frequently accessed hosts.")
-
-(defvar eshell-host-timestamp nil
- "A timestamp of when the hosts file was read.")
-
-;;; Functions:
-
-(defsubst eshell-under-xemacs-p ()
- "Return non-nil if we are running under XEmacs."
- (boundp 'xemacs-logo))
-
-(defsubst eshell-under-windows-p ()
- "Return non-nil if we are running under MS-DOS/Windows."
- (memq system-type '(ms-dos windows-nt)))
-
-(defmacro eshell-condition-case (tag form &rest handlers)
- "Like `condition-case', but only if `eshell-pass-through-errors' is nil."
- (if eshell-handle-errors
- `(condition-case ,tag
- ,form
- ,@handlers)
- form))
-
-(put 'eshell-condition-case 'lisp-indent-function 2)
-
-(defmacro eshell-deftest (module name label &rest forms)
- (if (and (fboundp 'cl-compiling-file) (cl-compiling-file))
- nil
- (let ((fsym (intern (concat "eshell-test--" (symbol-name name)))))
- `(eval-when-compile
- (ignore
- (defun ,fsym () ,label
- (eshell-run-test (quote ,module) (quote ,fsym) ,label
- (quote (progn ,@forms)))))))))
-
-(put 'eshell-deftest 'lisp-indent-function 2)
-
-(defun eshell-find-delimiter
- (open close &optional bound reverse-p backslash-p)
- "From point, find the CLOSE delimiter corresponding to OPEN.
-The matching is bounded by BOUND.
-If REVERSE-P is non-nil, process the region backwards.
-If BACKSLASH-P is non-nil, and OPEN and CLOSE are the same character,
-then quoting is done by a backslash, rather than a doubled delimiter."
- (save-excursion
- (let ((depth 1)
- (bound (or bound (point-max))))
- (if (if reverse-p
- (eq (char-before) close)
- (eq (char-after) open))
- (forward-char (if reverse-p -1 1)))
- (while (and (> depth 0)
- (funcall (if reverse-p '> '<) (point) bound))
- (let ((c (if reverse-p (char-before) (char-after))) nc)
- (cond ((and (not reverse-p)
- (or (not (eq open close))
- backslash-p)
- (eq c ?\\)
- (setq nc (char-after (1+ (point))))
- (or (eq nc open) (eq nc close)))
- (forward-char 1))
- ((and reverse-p
- (or (not (eq open close))
- backslash-p)
- (or (eq c open) (eq c close))
- (eq (char-before (1- (point)))
- ?\\))
- (forward-char -1))
- ((eq open close)
- (if (eq c open)
- (if (and (not backslash-p)
- (eq (if reverse-p
- (char-before (1- (point)))
- (char-after (1+ (point)))) open))
- (forward-char (if reverse-p -1 1))
- (setq depth (1- depth)))))
- ((= c open)
- (setq depth (+ depth (if reverse-p -1 1))))
- ((= c close)
- (setq depth (+ depth (if reverse-p 1 -1))))))
- (forward-char (if reverse-p -1 1)))
- (if (= depth 0)
- (if reverse-p (point) (1- (point)))))))
-
-(defun eshell-convert (string)
- "Convert STRING into a more native looking Lisp object."
- (if (not (stringp string))
- string
- (let ((len (length string)))
- (if (= len 0)
- string
- (if (eq (aref string (1- len)) ?\n)
- (setq string (substring string 0 (1- len))))
- (if (string-match "\n" string)
- (split-string string "\n")
- (if (and eshell-convert-numeric-arguments
- (string-match
- (concat "\\`\\s-*" eshell-number-regexp
- "\\s-*\\'") string))
- (string-to-number string)
- string))))))
-
-(defun eshell-sublist (l &optional n m)
- "Return from LIST the N to M elements.
-If N or M is nil, it means the end of the list."
- (let* ((a (copy-sequence l))
- result)
- (if (and m (consp (nthcdr m a)))
- (setcdr (nthcdr m a) nil))
- (if n
- (setq a (nthcdr n a))
- (setq n (1- (length a))
- a (last a)))
- a))
-
-(defun eshell-split-path (path)
- "Split a path into multiple subparts."
- (let ((len (length path))
- (i 0) (li 0)
- parts)
- (if (and (eshell-under-windows-p)
- (> len 2)
- (eq (aref path 0) directory-sep-char)
- (eq (aref path 1) directory-sep-char))
- (setq i 2))
- (while (< i len)
- (if (and (eq (aref path i) directory-sep-char)
- (not (get-text-property i 'escaped path)))
- (setq parts (cons (if (= li i)
- (char-to-string directory-sep-char)
- (substring path li (1+ i))) parts)
- li (1+ i)))
- (setq i (1+ i)))
- (if (< li i)
- (setq parts (cons (substring path li i) parts)))
- (if (and (eshell-under-windows-p)
- (string-match "\\`[A-Za-z]:\\'" (car (last parts))))
- (setcar (last parts)
- (concat (car (last parts))
- (char-to-string directory-sep-char))))
- (nreverse parts)))
-
-(defun eshell-to-flat-string (value)
- "Make value a string. If separated by newlines change them to spaces."
- (let ((text (eshell-stringify value)))
- (if (string-match "\n+\\'" text)
- (setq text (replace-match "" t t text)))
- (while (string-match "\n+" text)
- (setq text (replace-match " " t t text)))
- text))
-
-(defmacro eshell-for (for-var for-list &rest forms)
- "Iterate through a list"
- `(let ((list-iter ,for-list))
- (while list-iter
- (let ((,for-var (car list-iter)))
- ,@forms)
- (setq list-iter (cdr list-iter)))))
-
-(put 'eshell-for 'lisp-indent-function 2)
-
-(defun eshell-flatten-list (args)
- "Flatten any lists within ARGS, so that there are no sublists."
- (let ((new-list (list t)))
- (eshell-for a args
- (if (and (listp a)
- (listp (cdr a)))
- (nconc new-list (eshell-flatten-list a))
- (nconc new-list (list a))))
- (cdr new-list)))
-
-(defun eshell-uniqify-list (l)
- "Remove occurring multiples in L. You probably want to sort first."
- (let ((m l))
- (while m
- (while (and (cdr m)
- (string= (car m)
- (cadr m)))
- (setcdr m (cddr m)))
- (setq m (cdr m))))
- l)
-
-(defun eshell-stringify (object)
- "Convert OBJECT into a string value."
- (cond
- ((stringp object) object)
- ((and (listp object)
- (not (eq object nil)))
- (let ((string (pp-to-string object)))
- (substring string 0 (1- (length string)))))
- ((numberp object)
- (number-to-string object))
- (t
- (unless (and (eq object t)
- (not eshell-stringify-t))
- (pp-to-string object)))))
-
-(defsubst eshell-stringify-list (args)
- "Convert each element of ARGS into a string value."
- (mapcar 'eshell-stringify args))
-
-(defsubst eshell-flatten-and-stringify (&rest args)
- "Flatten and stringify all of the ARGS into a single string."
- (mapconcat 'eshell-stringify (eshell-flatten-list args) " "))
-
-;; the next two are from GNUS, and really should be made part of Emacs
-;; some day
-(defsubst eshell-time-less-p (t1 t2)
- "Say whether time T1 is less than time T2."
- (or (< (car t1) (car t2))
- (and (= (car t1) (car t2))
- (< (nth 1 t1) (nth 1 t2)))))
-
-(defsubst eshell-time-to-seconds (time)
- "Convert TIME to a floating point number."
- (+ (* (car time) 65536.0)
- (cadr time)
- (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
-
-(defsubst eshell-directory-files (regexp &optional directory)
- "Return a list of files in the given DIRECTORY matching REGEXP."
- (directory-files (or directory default-directory)
- directory regexp))
-
-(defun eshell-regexp-arg (prompt)
- "Return list of regexp and prefix arg using PROMPT."
- (let* (;; Don't clobber this.
- (last-command last-command)
- (regexp (read-from-minibuffer prompt nil nil nil
- 'minibuffer-history-search-history)))
- (list (if (string-equal regexp "")
- (setcar minibuffer-history-search-history
- (nth 1 minibuffer-history-search-history))
- regexp)
- (prefix-numeric-value current-prefix-arg))))
-
-(defun eshell-printable-size (filesize &optional human-readable
- block-size use-colors)
- "Return a printable FILESIZE."
- (let ((size (float (or filesize 0))))
- (if human-readable
- (if (< size human-readable)
- (if (= (round size) 0)
- "0"
- (if block-size
- "1.0k"
- (format "%.0f" size)))
- (setq size (/ size human-readable))
- (if (< size human-readable)
- (if (<= size 9.94)
- (format "%.1fk" size)
- (format "%.0fk" size))
- (setq size (/ size human-readable))
- (if (< size human-readable)
- (let ((str (if (<= size 9.94)
- (format "%.1fM" size)
- (format "%.0fM" size))))
- (if use-colors
- (put-text-property 0 (length str)
- 'face 'bold str))
- str)
- (setq size (/ size human-readable))
- (if (< size human-readable)
- (let ((str (if (<= size 9.94)
- (format "%.1fG" size)
- (format "%.0fG" size))))
- (if use-colors
- (put-text-property 0 (length str)
- 'face 'bold-italic str))
- str)))))
- (if block-size
- (setq size (/ size block-size)))
- (format "%.0f" size))))
-
-(defun eshell-winnow-list (entries exclude &optional predicates)
- "Pare down the ENTRIES list using the EXCLUDE regexp, and PREDICATES.
-The original list is not affected. If the result is only one element
-long, it will be returned itself, rather than returning a one-element
-list."
- (let ((flist (list t))
- valid p listified)
- (unless (listp entries)
- (setq entries (list entries)
- listified t))
- (eshell-for entry entries
- (unless (and exclude (string-match exclude entry))
- (setq p predicates valid (null p))
- (while p
- (if (funcall (car p) entry)
- (setq valid t)
- (setq p nil valid nil))
- (setq p (cdr p)))
- (when valid
- (nconc flist (list entry)))))
- (if listified
- (cadr flist)
- (cdr flist))))
-
-(defsubst eshell-redisplay ()
- "Allow Emacs to redisplay buffers."
- ;; for some strange reason, Emacs 21 is prone to trigger an
- ;; "args out of range" error in `sit-for', if this function
- ;; runs while point is in the minibuffer and the users attempt
- ;; to use completion. Don't ask me.
- (ignore-errors (sit-for 0 0)))
-
-(defun eshell-read-passwd-file (file)
- "Return an alist correlating gids to group names in FILE."
- (let (names)
- (when (file-readable-p file)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((fields
- (split-string (buffer-substring
- (point) (progn (end-of-line)
- (point))) ":")))
- (if (and (and fields (nth 0 fields) (nth 2 fields))
- (not (assq (string-to-int (nth 2 fields)) names)))
- (setq names (cons (cons (string-to-int (nth 2 fields))
- (nth 0 fields))
- names))))
- (forward-line))))
- names))
-
-(defun eshell-read-passwd (file result-var timestamp-var)
- "Read the contents of /etc/passwd for user names."
- (if (or (not (symbol-value result-var))
- (not (symbol-value timestamp-var))
- (eshell-time-less-p
- (symbol-value timestamp-var)
- (nth 5 (file-attributes file))))
- (progn
- (set result-var (eshell-read-passwd-file file))
- (set timestamp-var (current-time))))
- (symbol-value result-var))
-
-(defun eshell-read-group-names ()
- "Read the contents of /etc/group for group names."
- (if eshell-group-file
- (eshell-read-passwd eshell-group-file 'eshell-group-names
- 'eshell-group-timestamp)))
-
-(defsubst eshell-group-id (name)
- "Return the user id for user NAME."
- (car (rassoc name (eshell-read-group-names))))
-
-(defsubst eshell-group-name (gid)
- "Return the group name for the given GID."
- (cdr (assoc gid (eshell-read-group-names))))
-
-(defun eshell-read-user-names ()
- "Read the contents of /etc/passwd for user names."
- (if eshell-passwd-file
- (eshell-read-passwd eshell-passwd-file 'eshell-user-names
- 'eshell-user-timestamp)))
-
-(defsubst eshell-user-id (name)
- "Return the user id for user NAME."
- (car (rassoc name (eshell-read-user-names))))
-
-(defalias 'eshell-user-name 'user-login-name)
-
-(defun eshell-read-hosts-file (filename)
- "Read in the hosts from the /etc/hosts file."
- (let (hosts)
- (with-temp-buffer
- (insert-file-contents eshell-hosts-file)
- (goto-char (point-min))
- (while (re-search-forward
- "^\\(\\S-+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t)
- (if (match-string 1)
- (add-to-list 'hosts (match-string 1)))
- (if (match-string 2)
- (add-to-list 'hosts (match-string 2)))
- (if (match-string 4)
- (add-to-list 'hosts (match-string 4)))))
- (sort hosts 'string-lessp)))
-
-(defun eshell-read-hosts (file result-var timestamp-var)
- "Read the contents of /etc/passwd for user names."
- (if (or (not (symbol-value result-var))
- (not (symbol-value timestamp-var))
- (eshell-time-less-p
- (symbol-value timestamp-var)
- (nth 5 (file-attributes file))))
- (progn
- (set result-var (eshell-read-hosts-file file))
- (set timestamp-var (current-time))))
- (symbol-value result-var))
-
-(defun eshell-read-host-names ()
- "Read the contents of /etc/hosts for host names."
- (if eshell-hosts-file
- (eshell-read-hosts eshell-hosts-file 'eshell-host-names
- 'eshell-host-timestamp)))
-
-(unless (fboundp 'line-end-position)
- (defsubst line-end-position (&optional N)
- (save-excursion (end-of-line N) (point))))
-
-(unless (fboundp 'line-beginning-position)
- (defsubst line-beginning-position (&optional N)
- (save-excursion (beginning-of-line N) (point))))
-
-(unless (fboundp 'subst-char-in-string)
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-
-(defsubst eshell-copy-environment ()
- "Return an unrelated copy of `process-environment'."
- (mapcar 'concat process-environment))
-
-(defun eshell-subgroups (groupsym)
- "Return all of the subgroups of GROUPSYM."
- (let ((subgroups (get groupsym 'custom-group))
- (subg (list t)))
- (while subgroups
- (if (eq (cadr (car subgroups)) 'custom-group)
- (nconc subg (list (caar subgroups))))
- (setq subgroups (cdr subgroups)))
- (cdr subg)))
-
-(defmacro eshell-with-file-modes (modes &rest forms)
- "Evaluate, with file-modes set to MODES, the given FORMS."
- `(let ((modes (default-file-modes)))
- (set-default-file-modes ,modes)
- (unwind-protect
- (progn ,@forms)
- (set-default-file-modes modes))))
-
-(defmacro eshell-with-private-file-modes (&rest forms)
- "Evaluate FORMS with private file modes set."
- `(eshell-with-file-modes ,eshell-private-file-modes ,@forms))
-
-(defsubst eshell-make-private-directory (dir &optional parents)
- "Make DIR with file-modes set to `eshell-private-directory-modes'."
- (eshell-with-file-modes eshell-private-directory-modes
- (make-directory dir parents)))
-
-(defsubst eshell-substring (string sublen)
- "Return the beginning of STRING, up to SUBLEN bytes."
- (if string
- (if (> (length string) sublen)
- (substring string 0 sublen)
- string)))
-
-(unless (fboundp 'directory-files-and-attributes)
- (defun directory-files-and-attributes (directory &optional full match nosort)
- "Return a list of names of files and their attributes in DIRECTORY.
-There are three optional arguments:
-If FULL is non-nil, return absolute file names. Otherwise return names
- that are relative to the specified directory.
-If MATCH is non-nil, mention only file names that match the regexp MATCH.
-If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
- NOSORT is useful if you plan to sort the result yourself."
- (let ((directory (expand-file-name directory)) ange-cache)
- (mapcar
- (function
- (lambda (file)
- (cons file (eshell-file-attributes (expand-file-name file directory)))))
- (directory-files directory full match nosort)))))
-
-(eval-when-compile
- (defvar ange-cache))
-
-(defun eshell-directory-files-and-attributes (dir &optional full match nosort)
- "Make sure to use the handler for `directory-file-and-attributes'."
- (let* ((dir (expand-file-name dir))
- (dfh (find-file-name-handler dir 'directory-files)))
- (if (not dfh)
- (directory-files-and-attributes dir full match nosort)
- (let ((files (funcall dfh 'directory-files dir full match nosort))
- (fah (find-file-name-handler dir 'file-attributes)))
- (mapcar
- (function
- (lambda (file)
- (cons file (if fah
- (eshell-file-attributes
- (expand-file-name file dir))
- (file-attributes (expand-file-name file dir))))))
- files)))))
-
-(defun eshell-current-ange-uids ()
- (if (string-match "/\\([^@]+\\)@\\([^:]+\\):" default-directory)
- (let* ((host (match-string 2 default-directory))
- (user (match-string 1 default-directory))
- (host-users (assoc host eshell-ange-ls-uids)))
- (when host-users
- (setq host-users (cdr host-users))
- (cdr (assoc user host-users))))))
-
-;; Add an autoload for parse-time-string
-(if (and (not (fboundp 'parse-time-string))
- (locate-library "parse-time"))
- (autoload 'parse-time-string "parse-time"))
-
-(eval-when-compile
- (load "ange-ftp" t))
-
-(defun eshell-parse-ange-ls (dir)
- (let (entry)
- (with-temp-buffer
- (insert (ange-ftp-ls dir "-la" nil))
- (goto-char (point-min))
- (if (looking-at "^total [0-9]+$")
- (forward-line 1))
- ;; Some systems put in a blank line here.
- (if (eolp) (forward-line 1))
- (while (looking-at
- `,(concat "\\([dlscb-][rwxst-]+\\)"
- "\\s-*" "\\([0-9]+\\)" "\\s-+"
- "\\(\\S-+\\)" "\\s-+"
- "\\(\\S-+\\)" "\\s-+"
- "\\([0-9]+\\)" "\\s-+" "\\(.*\\)"))
- (let* ((perms (match-string 1))
- (links (string-to-number (match-string 2)))
- (user (match-string 3))
- (group (match-string 4))
- (size (string-to-number (match-string 5)))
- (mtime
- (if (fboundp 'parse-time-string)
- (let ((moment (parse-time-string
- (match-string 6))))
- (if (nth 0 moment)
- (setcar (nthcdr 5 moment)
- (nth 5 (decode-time (current-time))))
- (setcar (nthcdr 0 moment) 0)
- (setcar (nthcdr 1 moment) 0)
- (setcar (nthcdr 2 moment) 0))
- (apply 'encode-time moment))
- (ange-ftp-file-modtime (expand-file-name name dir))))
- (name (ange-ftp-parse-filename))
- symlink)
- (if (string-match "\\(.+\\) -> \\(.+\\)" name)
- (setq symlink (match-string 2 name)
- name (match-string 1 name)))
- (setq entry
- (cons
- (cons name
- (list (if (eq (aref perms 0) ?d)
- t
- symlink)
- links user group
- nil mtime nil
- size perms nil nil)) entry)))
- (forward-line)))
- entry))
-
-(defun eshell-file-attributes (file)
- "Return the attributes of FILE, playing tricks if it's over ange-ftp."
- (let* ((file (expand-file-name file))
- (handler (find-file-name-handler file 'file-attributes))
- entry)
- (if (not handler)
- (file-attributes file)
- (if (eq (find-file-name-handler (file-name-directory file)
- 'directory-files)
- 'ange-ftp-hook-function)
- (let ((base (file-name-nondirectory file))
- (dir (file-name-directory file)))
- (if (boundp 'ange-cache)
- (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
- (unless entry
- (setq entry (eshell-parse-ange-ls dir))
- (if (boundp 'ange-cache)
- (setq ange-cache
- (cons (cons dir entry)
- ange-cache)))
- (if entry
- (let ((fentry (assoc base (cdr entry))))
- (if fentry
- (setq entry (cdr fentry))
- (setq entry nil)))))))
- (or entry (funcall handler 'file-attributes file)))))
-
-(defalias 'eshell-copy-tree 'copy-tree)
-
-(defsubst eshell-processp (proc)
- "If the `processp' function does not exist, PROC is not a process."
- (and (fboundp 'processp) (processp proc)))
-
-; (defun eshell-copy-file
-; (file newname &optional ok-if-already-exists keep-date)
-; "Copy FILE to NEWNAME. See docs for `copy-file'."
-; (let (copied)
-; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
-; (let ((front (match-string 1 file))
-; (back (match-string 2 file))
-; buffer)
-; (if (and front (string-match eshell-tar-regexp front)
-; (setq buffer (find-file-noselect front)))
-; (with-current-buffer buffer
-; (goto-char (point-min))
-; (if (re-search-forward (concat " " (regexp-quote back)
-; "$") nil t)
-; (progn
-; (tar-copy (if (file-directory-p newname)
-; (expand-file-name
-; (file-name-nondirectory back) newname)
-; newname))
-; (setq copied t))
-; (error "%s not found in tar file %s" back front))))))
-; (unless copied
-; (copy-file file newname ok-if-already-exists keep-date))))
-
-; (defun eshell-file-attributes (filename)
-; "Return a list of attributes of file FILENAME.
-; See the documentation for `file-attributes'."
-; (let (result)
-; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
-; (let ((front (match-string 1 filename))
-; (back (match-string 2 filename))
-; buffer)
-; (when (and front (string-match eshell-tar-regexp front)
-; (setq buffer (find-file-noselect front)))
-; (with-current-buffer buffer
-; (goto-char (point-min))
-; (when (re-search-forward (concat " " (regexp-quote back)
-; "\\s-*$") nil t)
-; (let* ((descrip (tar-current-descriptor))
-; (tokens (tar-desc-tokens descrip)))
-; (setq result
-; (list
-; (cond
-; ((eq (tar-header-link-type tokens) 5)
-; t)
-; ((eq (tar-header-link-type tokens) t)
-; (tar-header-link-name tokens)))
-; 1
-; (tar-header-uid tokens)
-; (tar-header-gid tokens)
-; (tar-header-date tokens)
-; (tar-header-date tokens)
-; (tar-header-date tokens)
-; (tar-header-size tokens)
-; (concat
-; (cond
-; ((eq (tar-header-link-type tokens) 5) "d")
-; ((eq (tar-header-link-type tokens) t) "l")
-; (t "-"))
-; (tar-grind-file-mode (tar-header-mode tokens)
-; (make-string 9 ? ) 0))
-; nil nil nil))))))))
-; (or result
-; (file-attributes filename))))
-
-;;; Code:
-
-;;; esh-util.el ends here
+++ /dev/null
-;;; esh-var.el --- handling of variables
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'esh-var)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell-var nil
- "Variable interpolation is introduced whenever the '$' character
-appears unquoted in any argument (except when that argument is
-surrounded by single quotes) . It may be used to interpolate a
-variable value, a subcommand, or even the result of a Lisp form."
- :tag "Variable handling"
- :group 'eshell)
-
-;;; Commentary:
-
-;; These are the possible variable interpolation syntaxes. Also keep
-;; in mind that if an argument looks like a number, it will be
-;; converted to a number. This is not significant when invoking
-;; external commands, but it's important when calling Lisp functions.
-;;
-;; $VARIABLE
-;;
-;; Interval the value of an environment variable, or a Lisp variable
-;;
-;; $ALSO-VAR
-;;
-;; "-" is a legal part of a variable name.
-;;
-;; $<MYVAR>-TOO
-;;
-;; Only "MYVAR" is part of the variable name in this case.
-;;
-;; $#VARIABLE
-;;
-;; Returns the length of the value of VARIABLE. This could also be
-;; done using the `length' Lisp function.
-;;
-;; $(lisp)
-;;
-;; Returns result of lisp evaluation. Note: Used alone like this, it
-;; is identical to just saying (lisp); but with the variable expansion
-;; form, the result may be interpolated a larger string, such as
-;; '$(lisp)/other'.
-;;
-;; ${command}
-;;
-;; Returns the value of an eshell subcommand. See the note above
-;; regarding Lisp evaluations.
-;;
-;; $ANYVAR[10]
-;;
-;; Return the 10th element of ANYVAR. If ANYVAR's value is a string,
-;; it will be split in order to make it a list. The splitting will
-;; occur at whitespace.
-;;
-;; $ANYVAR[: 10]
-;;
-;; As above, except that splitting occurs at the colon now.
-;;
-;; $ANYVAR[: 10 20]
-;;
-;; As above, but instead of returning just a string, it now returns a
-;; list of two strings. If the result is being interpolated into a
-;; larger string, this list will be flattened into one big string,
-;; with each element separated by a space.
-;;
-;; $ANYVAR["\\\\" 10]
-;;
-;; Separate on backslash characters. Actually, the first argument --
-;; if it doesn't have the form of a number, or a plain variable name
-;; -- can be any regular expression. So to split on numbers, use
-;; '$ANYVAR["[0-9]+" 10 20]'.
-;;
-;; $ANYVAR[hello]
-;;
-;; Calls `assoc' on ANYVAR with 'hello', expecting it to be an alist.
-;;
-;; $#ANYVAR[hello]
-;;
-;; Returns the length of the cdr of the element of ANYVAR who car is
-;; equal to "hello".
-;;
-;; There are also a few special variables defined by Eshell. '$$' is
-;; the value of the last command (t or nil, in the case of an external
-;; command). This makes it possible to chain results:
-;;
-;; /tmp $ echo /var/spool/mail/johnw
-;; /var/spool/mail/johnw
-;; /tmp $ dirname $$
-;; /var/spool/mail/
-;; /tmp $ cd $$
-;; /var/spool/mail $
-;;
-;; '$_' refers to the last argument of the last command. And $?
-;; contains the exit code of the last command (0 or 1 for Lisp
-;; functions, based on successful completion).
-
-(require 'env)
-(require 'ring)
-
-;;; User Variables:
-
-(defcustom eshell-var-load-hook '(eshell-var-initialize)
- "*A list of functions to call when loading `eshell-var'."
- :type 'hook
- :group 'eshell-var)
-
-(defcustom eshell-prefer-lisp-variables nil
- "*If non-nil, prefer Lisp variables to environment variables."
- :type 'boolean
- :group 'eshell-var)
-
-(defcustom eshell-complete-export-definition t
- "*If non-nil, completing names for `export' shows current definition."
- :type 'boolean
- :group 'eshell-var)
-
-(defcustom eshell-modify-global-environment nil
- "*If non-nil, using `export' changes Emacs's global environment."
- :type 'boolean
- :group 'eshell-var)
-
-(defcustom eshell-variable-name-regexp "[A-Za-z0-9_-]+"
- "*A regexp identifying what constitutes a variable name reference.
-Note that this only applies for '$NAME'. If the syntax '$<NAME>' is
-used, then NAME can contain any character, including angle brackets,
-if they are quoted with a backslash."
- :type 'regexp
- :group 'eshell-var)
-
-(defcustom eshell-variable-aliases-list
- '(;; for eshell.el
- ("COLUMNS" (lambda (indices) (window-width)) t)
- ("LINES" (lambda (indices) (window-height)) t)
-
- ;; for eshell-cmd.el
- ("_" (lambda (indices)
- (if (not indices)
- (car (last eshell-last-arguments))
- (eshell-apply-indices eshell-last-arguments
- indices))))
- ("?" eshell-last-command-status)
- ("$" eshell-last-command-result)
- ("0" eshell-command-name)
- ("1" (lambda (indices) (nth 0 eshell-command-arguments)))
- ("2" (lambda (indices) (nth 1 eshell-command-arguments)))
- ("3" (lambda (indices) (nth 2 eshell-command-arguments)))
- ("4" (lambda (indices) (nth 3 eshell-command-arguments)))
- ("5" (lambda (indices) (nth 4 eshell-command-arguments)))
- ("6" (lambda (indices) (nth 5 eshell-command-arguments)))
- ("7" (lambda (indices) (nth 6 eshell-command-arguments)))
- ("8" (lambda (indices) (nth 7 eshell-command-arguments)))
- ("9" (lambda (indices) (nth 8 eshell-command-arguments)))
- ("*" (lambda (indices)
- (if (not indices)
- eshell-command-arguments
- (eshell-apply-indices eshell-command-arguments
- indices)))))
- "*This list provides aliasing for variable references.
-It is very similar in concept to what `eshell-user-aliases-list' does
-for commands. Each member of this defines defines the name of a
-command, and the Lisp value to return for that variable if it is
-accessed via the syntax '$NAME'.
-
-If the value is a function, that function will be called with two
-arguments: the list of the indices that was used in the reference, and
-whether the user is requesting the length of the ultimate element.
-For example, a reference of '$NAME[10][20]' would result in the
-function for alias `NAME' being called (assuming it were aliased to a
-function), and the arguments passed to this function would be the list
-'(10 20)', and nil."
- :type '(repeat (list string sexp
- (choice (const :tag "Copy to environment" t)
- (const :tag "Use only in Eshell" nil))))
- :group 'eshell-var)
-
-(put 'eshell-variable-aliases-list 'risky-local-variable t)
-
-;;; Functions:
-
-(defun eshell-var-initialize ()
- "Initialize the variable handle code."
- ;; Break the association with our parent's environment. Otherwise,
- ;; changing a variable will affect all of Emacs.
- (unless eshell-modify-global-environment
- (set (make-local-variable 'process-environment)
- (eshell-copy-environment)))
-
- (define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar)
-
- (set (make-local-variable 'eshell-special-chars-inside-quoting)
- (append eshell-special-chars-inside-quoting '(?$)))
- (set (make-local-variable 'eshell-special-chars-outside-quoting)
- (append eshell-special-chars-outside-quoting '(?$)))
-
- (add-hook 'eshell-parse-argument-hook 'eshell-interpolate-variable t t)
-
- (add-hook 'eshell-prepare-command-hook
- 'eshell-handle-local-variables nil t)
-
- (when (eshell-using-module 'eshell-cmpl)
- (add-hook 'pcomplete-try-first-hook
- 'eshell-complete-variable-reference nil t)
- (add-hook 'pcomplete-try-first-hook
- 'eshell-complete-variable-assignment nil t)))
-
-(defun eshell-handle-local-variables ()
- "Allow for the syntax 'VAR=val <command> <args>'."
- ;; strip off any null commands, which can only happen if a variable
- ;; evaluates to nil, such as "$var x", where `var' is nil. The
- ;; command name in that case becomes `x', for compatibility with
- ;; most regular shells (the difference is that they do an
- ;; interpolation pass before the argument parsing pass, but Eshell
- ;; does both at the same time).
- (while (and (not eshell-last-command-name)
- eshell-last-arguments)
- (setq eshell-last-command-name (car eshell-last-arguments)
- eshell-last-arguments (cdr eshell-last-arguments)))
- (let ((setvar "\\`\\([A-Za-z_][A-Za-z0-9_]*\\)=\\(.*\\)\\'")
- (command (eshell-stringify eshell-last-command-name))
- (args eshell-last-arguments))
- ;; local variable settings (such as 'CFLAGS=-O2 make') are handled
- ;; by making the whole command into a subcommand, and calling
- ;; setenv immediately before the command is invoked. This means
- ;; that 'BLAH=x cd blah' won't work exactly as expected, but that
- ;; is by no means a typical use of local environment variables.
- (if (and command (string-match setvar command))
- (throw
- 'eshell-replace-command
- (list
- 'eshell-as-subcommand
- (append
- (list 'progn)
- (let ((l (list t)))
- (while (string-match setvar command)
- (nconc
- l (list
- (list 'setenv (match-string 1 command)
- (match-string 2 command)
- (= (length (match-string 2 command)) 0))))
- (setq command (eshell-stringify (car args))
- args (cdr args)))
- (cdr l))
- (list (list 'eshell-named-command
- command (list 'quote args)))))))))
-
-(defun eshell-interpolate-variable ()
- "Parse a variable interpolation.
-This function is explicit for adding to `eshell-parse-argument-hook'."
- (when (and (eq (char-after) ?$)
- (/= (1+ (point)) (point-max)))
- (forward-char)
- (list 'eshell-escape-arg
- (eshell-parse-variable))))
-
-(defun eshell/define (var-alias definition)
- "Define a VAR-ALIAS using DEFINITION."
- (if (not definition)
- (setq eshell-variable-aliases-list
- (delq (assoc var-alias eshell-variable-aliases-list)
- eshell-variable-aliases-list))
- (let ((def (assoc var-alias eshell-variable-aliases-list))
- (alias-def
- (list var-alias
- (list 'quote (if (= (length definition) 1)
- (car definition)
- definition)))))
- (if def
- (setq eshell-variable-aliases-list
- (delq (assoc var-alias eshell-variable-aliases-list)
- eshell-variable-aliases-list)))
- (setq eshell-variable-aliases-list
- (cons alias-def
- eshell-variable-aliases-list))))
- nil)
-
-(defun eshell/export (&rest sets)
- "This alias allows the 'export' command to act as bash users expect."
- (while sets
- (if (and (stringp (car sets))
- (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets)))
- (setenv (match-string 1 (car sets))
- (match-string 2 (car sets))))
- (setq sets (cdr sets))))
-
-(defun pcomplete/eshell-mode/export ()
- "Completion function for Eshell's `export'."
- (while (pcomplete-here
- (if eshell-complete-export-definition
- process-environment
- (eshell-envvar-names)))))
-
-(defun eshell/unset (&rest args)
- "Unset an environment variable."
- (while args
- (if (stringp (car args))
- (setenv (car args) nil t))
- (setq args (cdr args))))
-
-(defun pcomplete/eshell-mode/unset ()
- "Completion function for Eshell's `unset'."
- (while (pcomplete-here (eshell-envvar-names))))
-
-(defun eshell/setq (&rest args)
- "Allow command-ish use of `setq'."
- (let (last-value)
- (while args
- (let ((sym (intern (car args)))
- (val (cadr args)))
- (setq last-value (set sym val)
- args (cddr args))))
- last-value))
-
-(defun pcomplete/eshell-mode/setq ()
- "Completion function for Eshell's `setq'."
- (while (and (pcomplete-here (all-completions pcomplete-stub
- obarray 'boundp))
- (pcomplete-here))))
-
-(defun eshell/env (&rest args)
- "Implemention of `env' in Lisp."
- (eshell-init-print-buffer)
- (eshell-eval-using-options
- "env" args
- '((?h "help" nil nil "show this usage screen")
- :external "env"
- :usage "<no arguments>")
- (eshell-for setting (sort (eshell-environment-variables)
- 'string-lessp)
- (eshell-buffered-print setting "\n"))
- (eshell-flush)))
-
-(defun eshell-insert-envvar (envvar-name)
- "Insert ENVVAR-NAME into the current buffer at point."
- (interactive
- (list (read-envvar-name "Name of environment variable: " t)))
- (insert-and-inherit "$" envvar-name))
-
-(defun eshell-envvar-names (&optional environment)
- "Return a list of currently visible environment variable names."
- (mapcar (function
- (lambda (x)
- (substring x 0 (string-match "=" x))))
- (or environment process-environment)))
-
-(defun eshell-environment-variables ()
- "Return a `process-environment', fully updated.
-This involves setting any variable aliases which affect the
-environment, as specified in `eshell-variable-aliases-list'."
- (let ((process-environment (eshell-copy-environment)))
- (eshell-for var-alias eshell-variable-aliases-list
- (if (nth 2 var-alias)
- (setenv (car var-alias)
- (eshell-stringify
- (or (eshell-get-variable (car var-alias)) "")))))
- process-environment))
-
-(defun eshell-parse-variable ()
- "Parse the next variable reference at point.
-The variable name could refer to either an environment variable, or a
-Lisp variable. The priority order depends on the setting of
-`eshell-prefer-lisp-variables'.
-
-Its purpose is to call `eshell-parse-variable-ref', and then to
-process any indices that come after the variable reference."
- (let* ((get-len (when (eq (char-after) ?#)
- (forward-char) t))
- value indices)
- (setq value (eshell-parse-variable-ref)
- indices (and (not (eobp))
- (eq (char-after) ?\[)
- (eshell-parse-indices))
- value (list 'let
- (list (list 'indices
- (list 'quote indices)))
- value))
- (if get-len
- (list 'length value)
- value)))
-
-(defun eshell-parse-variable-ref ()
- "Eval a variable reference.
-Returns a Lisp form which, if evaluated, will return the value of the
-variable.
-
-Possible options are:
-
- NAME an environment or Lisp variable value
- <LONG-NAME> disambiguates the length of the name
- {COMMAND} result of command is variable's value
- (LISP-FORM) result of Lisp form is variable's value"
- (let (end)
- (cond
- ((eq (char-after) ?{)
- (let ((end (eshell-find-delimiter ?\{ ?\})))
- (if (not end)
- (throw 'eshell-incomplete ?\{)
- (prog1
- (list 'eshell-convert
- (list 'eshell-command-to-value
- (list 'eshell-as-subcommand
- (eshell-parse-command
- (cons (1+ (point)) end)))))
- (goto-char (1+ end))))))
- ((memq (char-after) '(?\' ?\"))
- (let ((name (if (eq (char-after) ?\')
- (eshell-parse-literal-quote)
- (eshell-parse-double-quote))))
- (if name
- (list 'eshell-get-variable (eval name) 'indices))))
- ((eq (char-after) ?<)
- (let ((end (eshell-find-delimiter ?\< ?\>)))
- (if (not end)
- (throw 'eshell-incomplete ?\<)
- (let* ((temp (make-temp-file temporary-file-directory))
- (cmd (concat (buffer-substring (1+ (point)) end)
- " > " temp)))
- (prog1
- (list
- 'let (list (list 'eshell-current-handles
- (list 'eshell-create-handles temp
- (list 'quote 'overwrite))))
- (list
- 'progn
- (list 'eshell-as-subcommand
- (eshell-parse-command cmd))
- (list 'ignore
- (list 'nconc 'eshell-this-command-hook
- (list 'list
- (list 'function
- (list 'lambda nil
- (list 'delete-file temp))))))
- (list 'quote temp)))
- (goto-char (1+ end)))))))
- ((eq (char-after) ?\()
- (condition-case err
- (list 'eshell-command-to-value
- (list 'eshell-lisp-command
- (list 'quote (read (current-buffer)))))
- (end-of-file
- (throw 'eshell-incomplete ?\())))
- ((assoc (char-to-string (char-after))
- eshell-variable-aliases-list)
- (forward-char)
- (list 'eshell-get-variable
- (char-to-string (char-before)) 'indices))
- ((looking-at eshell-variable-name-regexp)
- (prog1
- (list 'eshell-get-variable (match-string 0) 'indices)
- (goto-char (match-end 0))))
- (t
- (error "Invalid variable reference")))))
-
-(eshell-deftest var interp-cmd
- "Interpolate command result"
- (eshell-command-result-p "+ ${+ 1 2} 3" "6\n"))
-
-(eshell-deftest var interp-lisp
- "Interpolate Lisp form evalution"
- (eshell-command-result-p "+ $(+ 1 2) 3" "6\n"))
-
-(eshell-deftest var interp-concat
- "Interpolate and concat command"
- (eshell-command-result-p "+ ${+ 1 2}3 3" "36\n"))
-
-(eshell-deftest var interp-concat-lisp
- "Interpolate and concat Lisp form"
- (eshell-command-result-p "+ $(+ 1 2)3 3" "36\n"))
-
-(eshell-deftest var interp-concat2
- "Interpolate and concat two commands"
- (eshell-command-result-p "+ ${+ 1 2}${+ 1 2} 3" "36\n"))
-
-(eshell-deftest var interp-concat-lisp2
- "Interpolate and concat two Lisp forms"
- (eshell-command-result-p "+ $(+ 1 2)$(+ 1 2) 3" "36\n"))
-
-(defun eshell-parse-indices ()
- "Parse and return a list of list of indices."
- (let (indices)
- (while (eq (char-after) ?\[)
- (let ((end (eshell-find-delimiter ?\[ ?\])))
- (if (not end)
- (throw 'eshell-incomplete ?\[)
- (forward-char)
- (let (eshell-glob-function)
- (setq indices (cons (eshell-parse-arguments (point) end)
- indices)))
- (goto-char (1+ end)))))
- (nreverse indices)))
-
-(defun eshell-get-variable (name &optional indices)
- "Get the value for the variable NAME."
- (let* ((alias (assoc name eshell-variable-aliases-list))
- (var (if alias
- (cadr alias)
- name)))
- (if (and alias (functionp var))
- (funcall var indices)
- (eshell-apply-indices
- (cond
- ((stringp var)
- (let ((sym (intern-soft var)))
- (if (and sym (boundp sym)
- (or eshell-prefer-lisp-variables
- (not (getenv var))))
- (symbol-value sym)
- (getenv var))))
- ((symbolp var)
- (symbol-value var))
- (t
- (error "Unknown variable `%s'" (eshell-stringify var))))
- indices))))
-
-(defun eshell-apply-indices (value indices)
- "Apply to VALUE all of the given INDICES, returning the sub-result.
-The format of INDICES is:
-
- ((INT-OR-NAME-OR-OTHER INT-OR-NAME INT-OR-NAME ...)
- ...)
-
-Each member of INDICES represents a level of nesting. If the first
-member of a sublist is not an integer or name, and the value it's
-reference is a string, that will be used as the regexp with which is
-to divide the string into sub-parts. The default is whitespace.
-Otherwise, each INT-OR-NAME refers to an element of the list value.
-Integers imply a direct index, and names, an associate lookup using
-`assoc'.
-
-For example, to retrieve the second element of a user's record in
-'/etc/passwd', the variable reference would look like:
-
- ${egrep johnw /etc/passwd}[: 2]"
- (while indices
- (let ((refs (car indices)))
- (when (stringp value)
- (let (separator)
- (if (not (or (not (stringp (caar indices)))
- (string-match
- (concat "^" eshell-variable-name-regexp "$")
- (caar indices))))
- (setq separator (caar indices)
- refs (cdr refs)))
- (setq value
- (mapcar 'eshell-convert
- (split-string value separator)))))
- (cond
- ((< (length refs) 0)
- (error "Illegal array variable index: %s"
- (eshell-stringify refs)))
- ((= (length refs) 1)
- (setq value (eshell-index-value value (car refs))))
- (t
- (let ((new-value (list t)))
- (while refs
- (nconc new-value
- (list (eshell-index-value value
- (car refs))))
- (setq refs (cdr refs)))
- (setq value (cdr new-value))))))
- (setq indices (cdr indices)))
- value)
-
-(defun eshell-index-value (value index)
- "Reference VALUE using the given INDEX."
- (if (stringp index)
- (cdr (assoc index value))
- (cond
- ((ring-p value)
- (if (> index (ring-length value))
- (error "Index exceeds length of ring")
- (ring-ref value index)))
- ((listp value)
- (if (> index (length value))
- (error "Index exceeds length of list")
- (nth index value)))
- ((vectorp value)
- (if (> index (length value))
- (error "Index exceeds length of vector")
- (aref value index)))
- (t
- (error "Invalid data type for indexing")))))
-
-;;;_* Variable name completion
-
-(defun eshell-complete-variable-reference ()
- "If there is a variable reference, complete it."
- (let ((arg (pcomplete-actual-arg)) index)
- (when (setq index
- (string-match
- (concat "\\$\\(" eshell-variable-name-regexp
- "\\)?\\'") arg))
- (setq pcomplete-stub (substring arg (1+ index)))
- (throw 'pcomplete-completions (eshell-variables-list)))))
-
-(defun eshell-variables-list ()
- "Generate list of applicable variables."
- (let ((argname pcomplete-stub)
- completions)
- (eshell-for alias eshell-variable-aliases-list
- (if (string-match (concat "^" argname) (car alias))
- (setq completions (cons (car alias) completions))))
- (sort
- (append
- (mapcar
- (function
- (lambda (varname)
- (let ((value (eshell-get-variable varname)))
- (if (and value
- (stringp value)
- (file-directory-p value))
- (concat varname (char-to-string directory-sep-char))
- varname))))
- (eshell-envvar-names (eshell-environment-variables)))
- (all-completions argname obarray 'boundp)
- completions)
- 'string-lessp)))
-
-(defun eshell-complete-variable-assignment ()
- "If there is a variable assignment, allow completion of entries."
- (let ((arg (pcomplete-actual-arg)) pos)
- (when (string-match (concat "\\`" eshell-variable-name-regexp "=") arg)
- (setq pos (match-end 0))
- (if (string-match "\\(:\\)[^:]*\\'" arg)
- (setq pos (match-end 1)))
- (setq pcomplete-stub (substring arg pos))
- (throw 'pcomplete-completions (pcomplete-entries)))))
-
-;;; Code:
-
-;;; esh-var.el ends here
+++ /dev/null
-;;; eshell.el --- the Emacs command shell
-
-;; Copyright (C) 1999, 2000 Free Software Foundation
-
-;; Author: John Wiegley <johnw@gnu.org>
-;; Version: 2.4.2
-;; Keywords: processes
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(provide 'eshell)
-
-(eval-when-compile (require 'esh-maint))
-
-(defgroup eshell nil
- "Eshell is a command shell implemented entirely in Emacs Lisp. It
-invokes no external processes beyond those requested by the user. It
-is intended to be a functional replacement for command shells such as
-bash, zsh, rc, 4dos; since Emacs itself is capable of handling most of
-the tasks accomplished by such tools."
- :tag "The Emacs shell"
- :link '(info-link "(eshell)The Emacs shell")
- :version "21.1"
- :group 'applications)
-
-;;; Commentary:
-
-;;;_* What does Eshell offer you?
-;;
-;; Despite the sheer fact that running an Emacs shell can be fun, here
-;; are a few of the unique features offered by Eshell:
-;;
-;; @ Integration with the Emacs Lisp programming environment
-;;
-;; @ A high degree of configurability
-;;
-;; @ The ability to have the same shell on every system Emacs has been
-;; ported to. Since Eshell imposes no external requirements, and
-;; relies upon only the Lisp functions exposed by Emacs, it is quite
-;; operating system independent. Several of the common UNIX
-;; commands, such as ls, mv, rm, ln, etc., have been implemented in
-;; Lisp in order to provide a more consistent work environment.
-;;
-;; For those who might be using an older version of Eshell, version
-;; 2.1 represents an entirely new, module-based architecture. It
-;; supports most of the features offered by modern shells. Here is a
-;; brief list of some of its more visible features:
-;;
-;; @ Command argument completion (tcsh, zsh)
-;; @ Input history management (bash)
-;; @ Intelligent output scrolling
-;; @ Pseudo-devices (such as "/dev/clip" for copying to the clipboard)
-;; @ Extended globbing (zsh)
-;; @ Argument and globbing predication (zsh)
-;; @ I/O redirection to buffers, files, symbols, processes, etc.
-;; @ Many niceties otherwise seen only in 4DOS
-;; @ Alias functions, both Lisp and Eshell-syntax
-;; @ Piping, sequenced commands, background jobs, etc...
-;;
-;;;_* Eshell is free software
-;;
-;; Eshell is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with Eshell; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-;;
-;;;_* How to begin
-;;
-;; To start using Eshell, add the following to your .emacs file:
-;;
-;; (load "eshell-auto")
-;;
-;; This will define all of the necessary autoloads.
-;;
-;; Now type `M-x eshell'. See the INSTALL file for full installation
-;; instructions.
-;;
-;;;_* Philosophy
-;;
-;; A shell is a layer which metaphorically surrounds the kernel, or
-;; heart of an operating system. This kernel can be seen as an engine
-;; of pure functionality, waiting to serve, while the user programs
-;; take advantage of that functionality to accomplish their purpose.
-;;
-;; The shell's role is to make that functionality accessible to the
-;; user in an unformed state. Very roughly, it associates kernel
-;; functionality with textual commands, allowing the user to interact
-;; with the operating system via linguistic constructs. Process
-;; invocation is perhaps the most significant form this takes, using
-;; the kernel's `fork' and `exec' functions.
-;;
-;; Other programs also interact with the functionality of the kernel,
-;; but these user applications typically offer a specific range of
-;; functionality, and thus are not classed as "shells" proper.
-;; (What they lose in quiddity, they gain in rigidity).
-;;
-;; Emacs is also a user application, but it does make the
-;; functionality of the kernel accessible through an interpreted
-;; language -- namely, Lisp. For that reason, there is little
-;; preventing Emacs from serving the same role as a modern shell. It
-;; too can manipulate the kernel in an unpredetermined way to cause
-;; system changes. All it's missing is the shell-ish linguistic
-;; model.
-;;
-;; Enter Eshell. Eshell translates "shell-like" syntax into Lisp
-;; in order to exercise the kernel in the same manner as typical
-;; system shells. There is a fundamental difference here, however,
-;; although it may seem subtle at first...
-;;
-;; Shells like csh and Bourne shell were written several decades ago,
-;; in different times, under more restrictive circumstances. This
-;; confined perspective shows itself in the paradigm used by nearly
-;; all command-line shells since. They are linear in conception, byte
-;; stream-based, sequential, and confined to movement within a single
-;; host machine.
-;;
-;; Emacs, on the other hand, is more than just a limited translator
-;; that can invoke subprocesses and redirect file handles. It also
-;; manages character buffers, windowing frames, network connections,
-;; registers, bookmarks, processes, etc. In other words, it's a very
-;; multi-dimensional environment, within which eshell emulates a highly
-;; linear methodology.
-;;
-;; Taking a moment, let's look at how this could affect the future of
-;; a shell allowed to develop in such a wider field of play:
-;;
-;; @ There is no reason why directory movement should be linear, and
-;; confined to a single file-system. Emacs, through w3 and ange-ftp,
-;; has access to the entire Web. Why not allow a user to cd to
-;; multiple directories simultaneously, for example? It might make
-;; some tasks easier, such as diff'ing files separated by very long
-;; pathnames.
-;;
-;; @ Data sources are available from anywhere Emacs can derive
-;; information from: not just from files or the output of other
-;; processes.
-;;
-;; @ Multiple shell invocations all share the same environment -- even
-;; the same process list! It would be possible to have "process
-;; views", so that one buffer is watching standard output, another
-;; standard error, and another the result of standard output grep'd
-;; through a regular expression...
-;;
-;; @ It is not necessary to "leave" the shell, losing all input and
-;; output history, environment variables, directory stack, etc.
-;; Emacs could save the contents of your eshell environment, and
-;; restore all of it (or at least as much as possible) each time you
-;; restart. This could occur automatically, without requiring
-;; complex initialization scripts.
-;;
-;; @ Typos occur all of the time; many of them are repeats of common
-;; errors, such as 'dri' for `dir'. Since executing non-existent
-;; programs is rarely the intention of the user, eshell could prompt
-;; for the replacement string, and then record that in a database of
-;; known misspellings. (Note: The typo at the beginning of this
-;; paragraph wasn't discovered until two months after I wrote the
-;; text; it was not intentional).
-;;
-;; @ Emacs' register and bookmarking facilities can be used for
-;; remembering where you've been, and what you've seen -- to varying
-;; levels of persistence. They could perhaps even be tied to
-;; specific "moments" during eshell execution, which would include
-;; the environment at that time, as well as other variables.
-;; Although this would require functionality orthogonal to Emacs'
-;; own bookmarking facilities, the interface used could be made to
-;; operate very similarly.
-;;
-;; This presents a brief idea of what the fuller dimensionality of an
-;; Emacs shell could offer. It's not just the language of a shell
-;; that determines how it's used, but also the Weltanschauung
-;; underlying its design -- and which is felt behind even the smallest
-;; feature. I would hope the freedom provided by using Emacs as a
-;; parent environment will invite rich ideas from others. It
-;; certainly feels as though all I've done so far is to tie down the
-;; horse, so to speak, so that he will run at a man's pace.
-;;
-;;;_* Influences
-;;
-;; The author of Eshell has been a long-time user of the following
-;; shells, all of which contributed to Eshell's design:
-;;
-;; @ rc
-;; @ bash
-;; @ zsh
-;; @ sh
-;; @ 4nt
-;; @ csh
-
-;;;_* Speeding up load time
-;;
-;; If you find that Eshell loads too slowly, there is something you
-;; can do to speed it up.
-;;
-;; Create a file, named /tmp/elc, containing this filelist:
-;;
-;; esh-util.elc
-;; eshell.elc
-;; esh-module.elc
-;; esh-var.elc
-;; esh-proc.elc
-;; esh-arg.elc
-;; esh-io.elc
-;; esh-ext.elc
-;; esh-cmd.elc
-;; esh-mode.elc
-;; esh-opt.elc
-;; em-alias.elc
-;; em-banner.elc
-;; em-basic.elc
-;; em-cmpl.elc
-;; em-dirs.elc
-;; em-pred.elc
-;; em-glob.elc
-;; em-hist.elc
-;; em-ls.elc
-;; em-prompt.elc
-;; em-rebind.elc
-;; em-script.elc
-;; em-smart.elc
-;; em-term.elc
-;; em-unix.elc
-;; em-xtra.elc
-;;
-;; The order is very important. Remove from the filelist any features
-;; you don't use. These all begin with "em-". If you don't use
-;; Eshell's key rebinding module, you can remove "em-rebind.elc" from
-;; the filelist. The modules you are currently using are listed in
-;; `eshell-modules-list'.
-;;
-;; Now, concatenating all of the above mentioned .elc files, in that
-;; order, to another file. Here is how to do this on UNIX:
-;;
-;; cat `cat /tmp/elc` > tmp.elc ; mv tmp.elc eshell.elc
-;;
-;; Now your eshell.elc file contains all of the .elc files that make
-;; up Eshell, in the right load order. When you next load Eshell, it
-;; will only have to read in this one file, which will greatly speed
-;; things up.
-
-;;;_* User Options
-;;
-;; The following user options modify the behavior of Eshell overall.
-
-(unless (featurep 'esh-util)
- (load "esh-util" nil t))
-
-(defsubst eshell-add-to-window-buffer-names ()
- "Add `eshell-buffer-name' to `same-window-buffer-names'."
- (add-to-list 'same-window-buffer-names eshell-buffer-name))
-
-(defsubst eshell-remove-from-window-buffer-names ()
- "Remove `eshell-buffer-name' from `same-window-buffer-names'."
- (setq same-window-buffer-names
- (delete eshell-buffer-name same-window-buffer-names)))
-
-(defcustom eshell-load-hook nil
- "*A hook run once Eshell has been loaded."
- :type 'hook
- :group 'eshell)
-
-(defcustom eshell-unload-hook
- '(eshell-remove-from-window-buffer-names
- eshell-unload-all-modules)
- "*A hook run when Eshell is unloaded from memory."
- :type 'hook
- :group 'eshell)
-
-(defcustom eshell-buffer-name "*eshell*"
- "*The basename used for Eshell buffers."
- :set (lambda (symbol value)
- ;; remove the old value of `eshell-buffer-name', if present
- (if (boundp 'eshell-buffer-name)
- (eshell-remove-from-window-buffer-names))
- (set symbol value)
- ;; add the new value
- (eshell-add-to-window-buffer-names)
- value)
- :type 'string
- :group 'eshell)
-
-(eshell-deftest mode same-window-buffer-names
- "`eshell-buffer-name' is a member of `same-window-buffer-names'"
- (member eshell-buffer-name same-window-buffer-names))
-
-(defcustom eshell-directory-name (convert-standard-filename "~/.eshell/")
- "*The directory where Eshell control files should be kept."
- :type 'directory
- :group 'eshell)
-
-(eshell-deftest mode eshell-directory-exists
- "`eshell-directory-name' exists and is writable"
- (file-writable-p eshell-directory-name))
-
-(eshell-deftest mode eshell-directory-modes
- "`eshell-directory-name' has correct access protections"
- (or (eshell-under-windows-p)
- (= (file-modes eshell-directory-name)
- eshell-private-directory-modes)))
-
-(defcustom eshell-prefer-to-shell nil
- "*If non-nil, \\[shell-command] will use Eshell instead of shell-mode."
- :set (lambda (symbol value)
- ;; modifying the global keymap directly is odious, but how
- ;; else to achieve the takeover?
- (if value
- (progn
- (define-key global-map [(meta ?!)] 'eshell-command)
-;;; (define-key global-map [(meta ?|)] 'eshell-command-on-region)
- )
- (define-key global-map [(meta ?!)] 'shell-command)
-;;; (define-key global-map [(meta ?|)] 'shell-command-on-region)
- )
- (set symbol value))
- :type 'boolean
- :require 'eshell
- :group 'eshell)
-
-;;;_* Running Eshell
-;;
-;; There are only three commands used to invoke Eshell. The first two
-;; are intended for interactive use, while the third is meant for
-;; programmers. They are:
-
-;;;###autoload
-(defun eshell (&optional arg)
- "Create an interactive Eshell buffer.
-The buffer used for Eshell sessions is determined by the value of
-`eshell-buffer-name'. If there is already an Eshell session active in
-that buffer, Emacs will simply switch to it. Otherwise, a new session
-will begin. A numeric prefix arg (as in `C-u 42 M-x eshell RET')
-switches to the session with that number, creating it if necessary. A
-nonnumeric prefix arg means to create a new session. Returns the
-buffer selected (or created)."
- (interactive "P")
- (assert eshell-buffer-name)
- (let ((buf (cond ((numberp arg)
- (get-buffer-create (format "%s<%d>"
- eshell-buffer-name
- arg)))
- (arg
- (generate-new-buffer eshell-buffer-name))
- (t
- (get-buffer-create eshell-buffer-name)))))
- ;; Simply calling `pop-to-buffer' will not mimic the way that
- ;; shell-mode buffers appear, since they always reuse the same
- ;; window that that command was invoked from. To achieve this,
- ;; it's necessary to add `eshell-buffer-name' to the variable
- ;; `same-window-buffer-names', which is done when Eshell is loaded
- (assert (and buf (buffer-live-p buf)))
- (pop-to-buffer buf)
- (unless (fboundp 'eshell-mode)
- (error "`eshell-auto' must be loaded before Eshell can be used"))
- (unless (eq major-mode 'eshell-mode)
- (eshell-mode))
- (assert (eq major-mode 'eshell-mode))
- buf))
-
-(defun eshell-return-exits-minibuffer ()
- (define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit)
- (define-key eshell-mode-map [return] 'exit-minibuffer)
- (define-key eshell-mode-map [(control ?m)] 'exit-minibuffer)
- (define-key eshell-mode-map [(control ?j)] 'exit-minibuffer)
- (define-key eshell-mode-map [(meta return)] 'exit-minibuffer)
- (define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer))
-
-(defvar eshell-non-interactive-p nil
- "A variable which is non-nil when Eshell is not running interactively.
-Modules should use this variable so that they don't clutter
-non-interactive sessions, such as when using `eshell-command'.")
-
-;;;###autoload
-(defun eshell-command (&optional command arg)
- "Execute the Eshell command string COMMAND.
-With prefix ARG, insert output into the current buffer at point."
- (interactive)
- (require 'esh-cmd)
- (unless arg
- (setq arg current-prefix-arg))
- (unwind-protect
- (let ((eshell-non-interactive-p t))
- (add-hook 'minibuffer-setup-hook 'eshell-mode)
- (add-hook 'minibuffer-exit-hook 'eshell-add-command-to-history)
- (add-hook 'eshell-mode-hook 'eshell-return-exits-minibuffer)
- (unless command
- (setq command (read-from-minibuffer "Emacs shell command: "))))
- (remove-hook 'eshell-mode-hook 'eshell-return-exits-minibuffer)
- (remove-hook 'minibuffer-exit-hook 'eshell-add-command-to-history)
- (remove-hook 'minibuffer-setup-hook 'eshell-mode))
- (unless command
- (error "No command specified!"))
- ;; redirection into the current buffer is achieved by adding an
- ;; output redirection to the end of the command, of the form
- ;; 'COMMAND >>> #<buffer BUFFER>'. This will not interfere with
- ;; other redirections, since multiple redirections merely cause the
- ;; output to be copied to multiple target locations
- (if arg
- (setq command
- (concat command
- (format " >>> #<buffer %s>"
- (buffer-name (current-buffer))))))
- (save-excursion
- (require 'esh-mode)
- (let ((buf (set-buffer (generate-new-buffer " *eshell cmd*")))
- (eshell-non-interactive-p t))
- (eshell-mode)
- (let* ((proc (eshell-eval-command
- (list 'eshell-commands
- (eshell-parse-command command))))
- intr
- (bufname (if (and proc (listp proc))
- "*EShell Async Command Output*"
- (setq intr t)
- "*EShell Command Output*")))
- (if (buffer-live-p (get-buffer bufname))
- (kill-buffer bufname))
- (rename-buffer bufname)
- ;; things get a little coarse here, since the desire is to
- ;; make the output as attractive as possible, with no
- ;; extraneous newlines
- (when intr
- (if (eshell-interactive-process)
- (eshell-wait-for-process (eshell-interactive-process)))
- (assert (not (eshell-interactive-process)))
- (goto-char (point-max))
- (while (and (bolp) (not (bobp)))
- (delete-backward-char 1)))
- (assert (and buf (buffer-live-p buf)))
- (unless arg
- (let ((len (if (not intr) 2
- (count-lines (point-min) (point-max)))))
- (cond
- ((= len 0)
- (message "(There was no command output)")
- (kill-buffer buf))
- ((= len 1)
- (message "%s" (buffer-string))
- (kill-buffer buf))
- (t
- (save-selected-window
- (select-window (display-buffer buf))
- (goto-char (point-min))
- ;; cause the output buffer to take up as little screen
- ;; real-estate as possible, if temp buffer resizing is
- ;; enabled
- (and intr temp-buffer-resize-mode
- (resize-temp-buffer-window)))))))))))
-
-;;;###autoload
-(defun eshell-command-result (command &optional status-var)
- "Execute the given Eshell COMMAND, and return the result.
-The result might be any Lisp object.
-If STATUS-VAR is a symbol, it will be set to the exit status of the
-command. This is the only way to determine whether the value returned
-corresponding to a successful execution."
- ;; a null command produces a null, successful result
- (if (not command)
- (ignore
- (if (and status-var (symbolp status-var))
- (set status-var 0)))
- (with-temp-buffer
- (require 'esh-mode)
- (let ((eshell-non-interactive-p t))
- (eshell-mode)
- (let ((result (eshell-do-eval
- (list 'eshell-commands
- (list 'eshell-command-to-value
- (eshell-parse-command command))) t)))
- (assert (eq (car result) 'quote))
- (if (and status-var (symbolp status-var))
- (set status-var eshell-last-command-status))
- (cadr result))))))
-
-(eshell-deftest mode simple-command-result
- "`eshell-command-result' works with a simple command."
- (= (eshell-command-result "+ 1 2") 3))
-
-;;;_* Reporting bugs
-;;
-;; Since Eshell has not yet been in use by a wide audience, and since
-;; the number of possible configurations is quite large, it is certain
-;; that many bugs slipped past the rigors of testing it was put
-;; through. If you do encounter a bug, on any system, please report
-;; it -- in addition to any particular oddities in your configuration
-;; -- so that the problem may be corrected for the benefit of others.
-
-(defconst eshell-report-bug-address "johnw@gnu.org"
- "E-mail address to send Eshell bug reports to.")
-
-;;;###autoload
-(defun eshell-report-bug (topic)
- "Report a bug in Eshell.
-Prompts for the TOPIC. Leaves you in a mail buffer.
-Please include any configuration details that might be involved."
- (interactive "sBug Subject: ")
- (compose-mail eshell-report-bug-address topic)
- (goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (let ((signature (buffer-substring (point) (point-max))))
- ;; Discourage users from writing non-English text.
- (set-buffer-multibyte nil)
- (delete-region (point) (point-max))
- (insert signature)
- (backward-char (length signature)))
- (insert "emacs-version: " (emacs-version))
- (insert "\n\nThere appears to be a bug in Eshell.\n\n"
- "Please describe exactly what actions "
- "triggered the bug and the precise\n"
- "symptoms of the bug:\n\n")
- ;; This is so the user has to type something in order to send
- ;; the report easily.
- (use-local-map (nconc (make-sparse-keymap) (current-local-map))))
-
-;;; Code:
-
-(defun eshell-unload-all-modules ()
- "Unload all modules that were loaded by Eshell, if possible.
-If the user has require'd in any of the modules, or customized a
-variable with a :require tag (such as `eshell-prefer-to-shell'), it
-will be impossible to unload Eshell completely without restarting
-Emacs."
- ;; if the user set `eshell-prefer-to-shell' to t, but never loaded
- ;; Eshell, then `eshell-subgroups' will be unbound
- (when (fboundp 'eshell-subgroups)
- (eshell-for module (eshell-subgroups 'eshell)
- ;; this really only unloads as many modules as possible,
- ;; since other `require' references (such as by customizing
- ;; `eshell-prefer-to-shell' to a non-nil value) might make it
- ;; impossible to unload Eshell completely
- (if (featurep module)
- (ignore-errors
- (message "Unloading %s..." (symbol-name module))
- (unload-feature module)
- (message "Unloading %s...done" (symbol-name module)))))
- (message "Unloading eshell...done")))
-
-(run-hooks 'eshell-load-hook)
-
-;;; eshell.el ends here
:type 'boolean)
(defcustom large-file-warning-threshold 10000000
- "Maximum size of file above which a confirmation is requested.
-When nil, never request confirmation."
- :group 'files
- :group 'find-file
- :type '(choice integer (const :tag "Never request confirmation" nil)))
+ "Maximum size of file above which a confirmation is requested."
+ :type 'integer)
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
"Read file FILENAME into a buffer and return the buffer.
(let ((buffer-read-only nil)
;; Keep the current buffer-file-coding-system.
(coding-system buffer-file-coding-system)
- ;; Auto-saved file shoule be read with special coding.
- (coding-system-for-read 'auto-save-coding))
+ ;; Auto-saved file shoule be read without any code conversion.
+ (coding-system-for-read 'emacs-mule-unix))
(erase-buffer)
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
--- /dev/null
+;;; float-sup.el --- define some constants useful for floating point numbers.
+
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+;; Provide a meaningful error message if we are running on
+;; bare (non-float) emacs.
+
+(if (fboundp 'atan)
+ nil
+ (error "Floating point was disabled at compile time"))
+
+;; provide an easy hook to tell if we are running with floats or not.
+;; define pi and e via math-lib calls. (much less prone to killer typos.)
+(defconst pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")
+;; It's too inconvenient to make `e' a constant because it's used as
+;; a temporary variable all the time.
+(defvar e (exp 1) "The value of e (2.7182818...).")
+
+;; Careful when editing this file ... typos here will be hard to spot.
+;; (defconst pi 3.14159265358979323846264338327
+;; "The value of Pi (3.14159265358979323846264338327...)")
+
+(defconst degrees-to-radians (/ pi 180.0)
+ "Degrees to radian conversion constant.")
+(defconst radians-to-degrees (/ 180.0 pi)
+ "Radian to degree conversion constant.")
+
+;; these expand to a single multiply by a float when byte compiled
+
+(defmacro degrees-to-radians (x)
+ "Convert ARG from degrees to radians."
+ (list '* (/ pi 180.0) x))
+(defmacro radians-to-degrees (x)
+ "Convert ARG from radians to degrees."
+ (list '* (/ 180.0 pi) x))
+
+(provide 'lisp-float-type)
+
+;;; float-sup.el ends here
For example, traditional behavior is not to list buffers whose names begin
with a space, for which the regexp is `^ '. See the source file for
example functions that filter buffernames."
- :type '(repeat (choice regexp function))
+ :type '(repeat regexp)
:group 'iswitchb)
(defcustom iswitchb-cannot-complete-hook 'iswitchb-completion-help
;; We don't want to have any undo records in the dumped Emacs.
(buffer-disable-undo "*scratch*")
-(load "emacs-lisp/byte-run")
+(load "byte-run")
(load "emacs-lisp/backquote")
(load "subr")
(load "widget")
(load "custom")
-(load "emacs-lisp/map-ynp")
+(load "map-ynp")
(load "env")
(load "cus-start")
(load "international/mule")
(and (boundp 'x-toolkit-scroll-bars)
(load "scroll-bar"))
(load "select")))
-(load "emacs-lisp/timer")
+(load "timer")
(load "isearch")
(message "%s" (garbage-collect))
(load "ls-lisp")))
(if (fboundp 'atan) ; preload some constants and
(progn ; floating pt. functions if we have float support.
- (load "emacs-lisp/float-sup")))
+ (load "float-sup")))
(message "%s" (garbage-collect))
(load "vc-hooks")
`(("\C-c\C-c" . log-edit-done)
("\C-c\C-a" . log-edit-insert-changelog)
("\C-c\C-f" . log-edit-show-files)
- ("\M-n" . log-edit-next-comment)
- ("\M-p" . log-edit-previous-comment)
- ("\M-r" . log-edit-comment-search-backward)
- ("\M-s" . log-edit-comment-search-forward)
+ ("\M-n" . vc-next-comment)
+ ("\M-p" . vc-previous-comment)
+ ("\M-r" . vc-comment-search-reverse)
+ ("\M-s" . vc-comment-search-forward)
("\C-c?" . log-edit-mode-help))
"Keymap for the `log-edit-mode' (to edit version control log messages)."
:group 'log-edit)
["List files" log-edit-show-files
:help "Show the list of relevant files."]
"--"
- ["Previous comment" log-edit-previous-comment]
- ["Next comment" log-edit-next-comment]
- ["Search comment forward" log-edit-comment-search-forward]
- ["Search comment backward" log-edit-comment-search-backward]))
+ ["Previous comment" vc-previous-comment]
+ ["Next comment" vc-next-comment]
+ ["Search comment forward" vc-comment-search-forward]
+ ["Search comment backward" vc-comment-search-reverse]))
(defcustom log-edit-confirm 'changed
"*If non-nil, `log-edit-done' will request confirmation.
(defvar log-edit-listfun nil)
(defvar log-edit-parent-buffer nil)
-;;; Originally taken from VC-Log mode
+;;; Taken from VC-Log mode
-(defconst log-edit-maximum-comment-ring-size 32
+(defconst vc-maximum-comment-ring-size 32
"Maximum number of saved comments in the comment ring.")
-(defvar log-edit-comment-ring (make-ring log-edit-maximum-comment-ring-size))
-(defvar log-edit-comment-ring-index nil)
-(defvar log-edit-last-comment-match "")
+(defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size))
+(defvar vc-comment-ring-index nil)
+(defvar vc-last-comment-match "")
-(defun log-edit-new-comment-index (stride len)
+(defun vc-new-comment-index (stride len)
"Return the comment index STRIDE elements from the current one.
-LEN is the length of `log-edit-comment-ring'."
+LEN is the length of `vc-comment-ring'."
(mod (cond
- (log-edit-comment-ring-index (+ log-edit-comment-ring-index stride))
+ (vc-comment-ring-index (+ vc-comment-ring-index stride))
;; Initialize the index on the first use of this command
;; so that the first M-p gets index 0, and the first M-n gets
;; index -1.
(t stride))
len))
-(defun log-edit-previous-comment (arg)
+(defun vc-previous-comment (arg)
"Cycle backwards through comment history.
With a numeric prefix ARG, go back ARG comments."
(interactive "*p")
- (let ((len (ring-length log-edit-comment-ring)))
+ (let ((len (ring-length vc-comment-ring)))
(if (<= len 0)
(progn (message "Empty comment ring") (ding))
;; Don't use `erase-buffer' because we don't want to `widen'.
(delete-region (point-min) (point-max))
- (setq log-edit-comment-ring-index (log-edit-new-comment-index arg len))
- (message "Comment %d" (1+ log-edit-comment-ring-index))
- (insert (ring-ref log-edit-comment-ring log-edit-comment-ring-index)))))
+ (setq vc-comment-ring-index (vc-new-comment-index arg len))
+ (message "Comment %d" (1+ vc-comment-ring-index))
+ (insert (ring-ref vc-comment-ring vc-comment-ring-index)))))
-(defun log-edit-next-comment (arg)
+(defun vc-next-comment (arg)
"Cycle forwards through comment history.
With a numeric prefix ARG, go forward ARG comments."
(interactive "*p")
- (log-edit-previous-comment (- arg)))
+ (vc-previous-comment (- arg)))
-(defun log-edit-comment-search-backward (str &optional stride)
+(defun vc-comment-search-reverse (str &optional stride)
"Search backwards through comment history for substring match of STR.
If the optional argument STRIDE is present, that is a step-width to use
when going through the comment ring."
;; Why substring rather than regexp ? -sm
(interactive
- (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
+ (list (read-string "Comment substring: " nil nil vc-last-comment-match)))
(unless stride (setq stride 1))
(if (string= str "")
- (setq str log-edit-last-comment-match)
- (setq log-edit-last-comment-match str))
+ (setq str vc-last-comment-match)
+ (setq vc-last-comment-match str))
(let* ((str (regexp-quote str))
- (len (ring-length log-edit-comment-ring))
- (n (log-edit-new-comment-index stride len)))
+ (len (ring-length vc-comment-ring))
+ (n (vc-new-comment-index stride len)))
(while (progn (when (or (>= n len) (< n 0)) (error "Not found"))
- (not (string-match str (ring-ref log-edit-comment-ring n))))
+ (not (string-match str (ring-ref vc-comment-ring n))))
(setq n (+ n stride)))
- (setq log-edit-comment-ring-index n)
- (log-edit-previous-comment 0)))
+ (setq vc-comment-ring-index n)
+ (vc-previous-comment 0)))
-(defun log-edit-comment-search-forward (str)
+(defun vc-comment-search-forward (str)
"Search forwards through comment history for a substring match of STR."
(interactive
- (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
- (log-edit-comment-search-backward str -1))
+ (list (read-string "Comment substring: " nil nil vc-last-comment-match)))
+ (vc-comment-search-reverse str -1))
-(defun log-edit-comment-to-change-log (&optional whoami file-name)
+
+
+(defun vc-comment-to-change-log (&optional whoami file-name)
"Enter last VC comment into the change log for the current file.
WHOAMI (interactive prefix) non-nil means prompt for user name
and site. FILE-NAME is the name of the change log; if nil, use
`change-log-default-name'.
-This may be useful as a `log-edit-checkin-hook' to update change logs
+This may be useful as a `vc-checkin-hook' to update change logs
automatically."
(interactive (if current-prefix-arg
(list current-prefix-arg
(prompt-for-change-log-name))))
(let (;; Extract the comment first so we get any error before doing anything.
- (comment (ring-ref log-edit-comment-ring 0))
+ (comment (ring-ref vc-comment-ring 0))
;; Don't let add-change-log-entry insert a defun name.
(add-log-current-defun-function 'ignore)
end)
(or (eobp) (looking-at "\n\n")
(insert "\n"))))
-;; Compatibility with old names.
-(defvaralias 'vc-comment-ring 'log-edit-comment-ring)
-(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "21.5")
-(defvaralias 'vc-comment-ring-index 'log-edit-comment-ring-index)
-(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "21.5")
-(defalias 'vc-previous-comment 'log-edit-previous-comment)
-(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "21.5")
-(defalias 'vc-next-comment 'log-edit-next-comment)
-(make-obsolete 'vc-next-comment 'log-edit-next-comment "21.5")
-(defalias 'vc-comment-search-reverse 'log-edit-comment-search-backward)
-(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "21.5")
-(defalias 'vc-comment-search-forward 'log-edit-comment-search-forward)
-(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "21.5")
-(defalias 'vc-comment-to-change-log 'log-edit-comment-to-change-log)
-(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "21.5")
-
;;;
;;; Actual code
;;;
commands (under C-x v for VC, for example).
\\{log-edit-mode-map}"
- (make-local-variable 'log-edit-comment-ring-index))
+ (make-local-variable 'vc-comment-ring-index))
(defun log-edit-hide-buf (&optional buf where)
(when (setq buf (get-buffer (or buf log-edit-files-buf)))
(goto-char (point-max))
(insert ?\n)))
(let ((comment (buffer-string)))
- (when (or (ring-empty-p log-edit-comment-ring)
- (not (equal comment (ring-ref log-edit-comment-ring 0))))
- (ring-insert log-edit-comment-ring comment)))
+ (when (or (ring-empty-p vc-comment-ring)
+ (not (equal comment (ring-ref vc-comment-ring 0))))
+ (ring-insert vc-comment-ring comment)))
(let ((win (get-buffer-window log-edit-files-buf)))
(if (and log-edit-confirm
(not (and (eq log-edit-confirm 'changed)
"Insert this log message into the appropriate ChangeLog file."
(interactive)
;; Yuck!
- (unless (string= (buffer-string) (ring-ref log-edit-comment-ring 0))
- (ring-insert log-edit-comment-ring (buffer-string)))
+ (unless (string= (buffer-string) (ring-ref vc-comment-ring 0))
+ (ring-insert vc-comment-ring (buffer-string)))
(dolist (f (log-edit-files))
(let ((buffer-file-name (expand-file-name f)))
(save-excursion
- (log-edit-comment-to-change-log)))))
+ (vc-comment-to-change-log)))))
;;;;
;;;; functions for getting commit message from ChangeLog a file...
-;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*-
+;;; man.el --- browse UNIX manual pages
-;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1996, 1997, 2001 Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Maintainer: FSF
(defvar Man-cooked-hook nil
"Hook run after removing backspaces but before `Man-mode' processing.")
-(defvar Man-name-regexp "[-a-zA-Z0-9_Â][-a-zA-Z0-9_.Â]*"
+(defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*"
"Regular expression describing the name of a manpage (without section).")
(defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]"
;; Update len, in case a reference spans
;; more than two lines (paranoia).
len (1- (length word))))
- (if (memq (aref word len) '(?- ?Â))
+ (if (= (aref word len) ?-)
(setq hyphenated (substring word 0 len)))
(if (string-match Man-reference-regexp word)
(aput 'Man-refpages-alist word))))
--- /dev/null
+;;; map-ynp.el --- general-purpose boolean question-asker
+
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+;; Author: Roland McGrath <roland@gnu.org>
+;; Maintainer: FSF
+;; Keywords: lisp, extensions
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; map-y-or-n-p is a general-purpose question-asking function.
+;; It asks a series of y/n questions (a la y-or-n-p), and decides to
+;; apply an action to each element of a list based on the answer.
+;; The nice thing is that you also get some other possible answers
+;; to use, reminiscent of query-replace: ! to answer y to all remaining
+;; questions; ESC or q to answer n to all remaining questions; . to answer
+;; y once and then n for the remainder; and you can get help with C-h.
+
+;;; Code:
+
+(defun map-y-or-n-p (prompter actor list &optional help action-alist
+ no-cursor-in-echo-area)
+ "Ask a series of boolean questions.
+Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST.
+
+LIST is a list of objects, or a function of no arguments to return the next
+object or nil.
+
+If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\). If not
+a string, PROMPTER is a function of one arg (an object from LIST), which
+returns a string to be used as the prompt for that object. If the return
+value is not a string, it may be nil to ignore the object or non-nil to act
+on the object without asking the user.
+
+ACTOR is a function of one arg (an object from LIST),
+which gets called with each object that the user answers `yes' for.
+
+If HELP is given, it is a list (OBJECT OBJECTS ACTION),
+where OBJECT is a string giving the singular noun for an elt of LIST;
+OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive
+verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\"\).
+
+At the prompts, the user may enter y, Y, or SPC to act on that object;
+n, N, or DEL to skip that object; ! to act on all following objects;
+ESC or q to exit (skip all following objects); . (period) to act on the
+current object and then exit; or \\[help-command] to get help.
+
+If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys
+that will be accepted. KEY is a character; FUNCTION is a function of one
+arg (an object from LIST); HELP is a string. When the user hits KEY,
+FUNCTION is called. If it returns non-nil, the object is considered
+\"acted upon\", and the next object from LIST is processed. If it returns
+nil, the prompt is repeated for the same object.
+
+Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set
+`cursor-in-echo-area' while prompting.
+
+This function uses `query-replace-map' to define the standard responses,
+but not all of the responses which `query-replace' understands
+are meaningful here.
+
+Returns the number of actions taken."
+ (let* ((actions 0)
+ user-keys mouse-event map prompt char elt tail def
+ ;; Non-nil means we should use mouse menus to ask.
+ use-menus
+ delayed-switch-frame
+ (next (if (or (and list (symbolp list))
+ (subrp list)
+ (byte-code-function-p list)
+ (and (consp list)
+ (eq (car list) 'lambda)))
+ (function (lambda ()
+ (setq elt (funcall list))))
+ (function (lambda ()
+ (if list
+ (progn
+ (setq elt (car list)
+ list (cdr list))
+ t)
+ nil))))))
+ (if (and (listp last-nonmenu-event)
+ use-dialog-box)
+ ;; Make a list describing a dialog box.
+ (let ((object (if help (capitalize (nth 0 help))))
+ (objects (if help (capitalize (nth 1 help))))
+ (action (if help (capitalize (nth 2 help)))))
+ (setq map `(("Yes" . act) ("No" . skip) ("Quit" . exit)
+ (,(if help (concat action " " object " And Quit")
+ "Do it and Quit") . act-and-exit)
+ (,(if help (concat action " All " objects)
+ "Do All") . automatic)
+ ,@(mapcar (lambda (elt)
+ (cons (capitalize (nth 2 elt))
+ (vector (nth 1 elt))))
+ action-alist))
+ use-menus t
+ mouse-event last-nonmenu-event))
+ (setq user-keys (if action-alist
+ (concat (mapconcat (function
+ (lambda (elt)
+ (key-description
+ (char-to-string (car elt)))))
+ action-alist ", ")
+ " ")
+ "")
+ ;; Make a map that defines each user key as a vector containing
+ ;; its definition.
+ map (cons 'keymap
+ (append (mapcar (lambda (elt)
+ (cons (car elt) (vector (nth 1 elt))))
+ action-alist)
+ query-replace-map))))
+ (unwind-protect
+ (progn
+ (if (stringp prompter)
+ (setq prompter `(lambda (object)
+ (format ,prompter object))))
+ (while (funcall next)
+ (setq prompt (funcall prompter elt))
+ (cond ((stringp prompt)
+ ;; Prompt the user about this object.
+ (setq quit-flag nil)
+ (if use-menus
+ (setq def (or (x-popup-dialog (or mouse-event use-menus)
+ (cons prompt map))
+ 'quit))
+ ;; Prompt in the echo area.
+ (let ((cursor-in-echo-area (not no-cursor-in-echo-area))
+ (message-log-max nil))
+ (message "%s(y, n, !, ., q, %sor %s) "
+ prompt user-keys
+ (key-description (vector help-char)))
+ (if minibuffer-auto-raise
+ (raise-frame (window-frame (minibuffer-window))))
+ (while (progn
+ (setq char (read-event))
+ ;; If we get -1, from end of keyboard
+ ;; macro, try again.
+ (equal char -1)))
+ ;; Show the answer to the question.
+ (message "%s(y, n, !, ., q, %sor %s) %s"
+ prompt user-keys
+ (key-description (vector help-char))
+ (single-key-description char)))
+ (setq def (lookup-key map (vector char))))
+ (cond ((eq def 'exit)
+ (setq next (function (lambda () nil))))
+ ((eq def 'act)
+ ;; Act on the object.
+ (funcall actor elt)
+ (setq actions (1+ actions)))
+ ((eq def 'skip)
+ ;; Skip the object.
+ )
+ ((eq def 'act-and-exit)
+ ;; Act on the object and then exit.
+ (funcall actor elt)
+ (setq actions (1+ actions)
+ next (function (lambda () nil))))
+ ((eq def 'quit)
+ (setq quit-flag t)
+ (setq next `(lambda ()
+ (setq next ',next)
+ ',elt)))
+ ((eq def 'automatic)
+ ;; Act on this and all following objects.
+ (if (funcall prompter elt)
+ (progn
+ (funcall actor elt)
+ (setq actions (1+ actions))))
+ (while (funcall next)
+ (if (funcall prompter elt)
+ (progn
+ (funcall actor elt)
+ (setq actions (1+ actions))))))
+ ((eq def 'help)
+ (with-output-to-temp-buffer "*Help*"
+ (princ
+ (let ((object (if help (nth 0 help) "object"))
+ (objects (if help (nth 1 help) "objects"))
+ (action (if help (nth 2 help) "act on")))
+ (concat
+ (format "Type SPC or `y' to %s the current %s;
+DEL or `n' to skip the current %s;
+RET or `q' to exit (skip all remaining %s);
+C-g to quit (cancel the operation);
+! to %s all remaining %s;\n"
+ action object object objects action
+ objects)
+ (mapconcat (function
+ (lambda (elt)
+ (format "%s to %s"
+ (single-key-description
+ (nth 0 elt))
+ (nth 2 elt))))
+ action-alist
+ ";\n")
+ (if action-alist ";\n")
+ (format "or . (period) to %s \
+the current %s and exit."
+ action object))))
+ (save-excursion
+ (set-buffer standard-output)
+ (help-mode)))
+
+ (setq next `(lambda ()
+ (setq next ',next)
+ ',elt)))
+ ((vectorp def)
+ ;; A user-defined key.
+ (if (funcall (aref def 0) elt) ;Call its function.
+ ;; The function has eaten this object.
+ (setq actions (1+ actions))
+ ;; Regurgitated; try again.
+ (setq next `(lambda ()
+ (setq next ',next)
+ ',elt))))
+ ((and (consp char)
+ (eq (car char) 'switch-frame))
+ ;; switch-frame event. Put it off until we're done.
+ (setq delayed-switch-frame char)
+ (setq next `(lambda ()
+ (setq next ',next)
+ ',elt)))
+ (t
+ ;; Random char.
+ (message "Type %s for help."
+ (key-description (vector help-char)))
+ (beep)
+ (sit-for 1)
+ (setq next `(lambda ()
+ (setq next ',next)
+ ',elt)))))
+ (prompt
+ (funcall actor elt)
+ (setq actions (1+ actions))))))
+ (if delayed-switch-frame
+ (setq unread-command-events
+ (cons delayed-switch-frame unread-command-events))))
+ ;; Clear the last prompt from the minibuffer.
+ (let ((message-log-max nil))
+ (message ""))
+ ;; Return the number of actions that were taken.
+ actions))
+
+;;; map-ynp.el ends here
(+ n (point)))))))
(insert string)))
-;; These were added with an eye to making possible a more CCA-compatible
-;; command set; but that turned out not to be interesting.
-
-(defun mark-beginning-of-buffer ()
- "Set mark at the beginning of the buffer."
- (interactive)
- (push-mark (point-min)))
-
-(defun mark-end-of-buffer ()
- "Set mark at the end of the buffer."
- (interactive)
- (push-mark (point-max)))
-
-(defun upcase-char (arg)
- "Uppercasify ARG chars starting from point. Point doesn't move"
- (interactive "p")
- (save-excursion
- (upcase-region (point) (progn (forward-char arg) (point)))))
-
-(defun forward-to-word (arg)
- "Move forward until encountering the beginning of a word.
-With argument, do this that many times."
- (interactive "p")
- (or (re-search-forward (if (> arg 0) "\\W\\b" "\\b\\W") nil t arg)
- (goto-char (if (> arg 0) (point-max) (point-min)))))
-
-(defun backward-to-word (arg)
- "Move backward until encountering the end of a word.
-With argument, do this that many times."
- (interactive "p")
- (forward-to-word (- arg)))
-
(provide 'misc)
;;; misc.el ends here
'mouse-wheel-down-event)
(defcustom mouse-wheel-down-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well.
- (if (eq system-type 'windows-nt)
- 'wheel-up
- (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
- mouse-wheel-down-button)))
+ (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
+ mouse-wheel-down-button))
"Event used for scrolling down."
:group 'mouse
:type 'symbol
'mouse-wheel-up-event)
(defcustom mouse-wheel-up-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well.
- (if (eq system-type 'windows-nt)
- 'wheel-down
- (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
- mouse-wheel-up-button)))
+ (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
+ mouse-wheel-up-button))
"Event used for scrolling down."
:group 'mouse
:type 'symbol
This is obsolete because you might as well use \\[newline-and-indent]."
:type 'boolean)
-(defcustom comment-empty-lines nil
- "If nil, `comment-region' does not comment out empty lines.
-If t, it always comments out empty lines.
-if `eol' it only comments out empty lines if comments are
-terminated by the end of line (i.e. `comment-end' is empty)."
- :type '(choice (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "EOl-terminated" 'eol)))
-
;;;;
;;;; Helpers
;;;;
INDENT indicates to put CS and CCS at the current indentation of the region
rather than at left margin."
;;(assert (< beg end))
- (let ((no-empty (not (or (eq comment-empty-lines t)
- (and comment-empty-lines (zerop (length ce)))))))
+ (let ((no-empty t))
;; Sanitize CE and CCE.
(if (and (stringp ce) (string= "" ce)) (setq ce nil))
(if (and (stringp cce) (string= "" cce)) (setq cce nil))
+++ /dev/null
-;;; float.el --- obsolete floating point arithmetic package
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Author: Bill Rosenblatt
-;; Maintainer: FSF
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Floating point numbers are represented by dot-pairs (mant . exp)
-;; where mant is the 24-bit signed integral mantissa and exp is the
-;; base 2 exponent.
-;;
-;; Emacs LISP supports a 24-bit signed integer data type, which has a
-;; range of -(2**23) to +(2**23)-1, or -8388608 to 8388607 decimal.
-;; This gives six significant decimal digit accuracy. Exponents can
-;; be anything in the range -(2**23) to +(2**23)-1.
-;;
-;; User interface:
-;; function f converts from integer to floating point
-;; function string-to-float converts from string to floating point
-;; function fint converts a floating point to integer (with truncation)
-;; function float-to-string converts from floating point to string
-;;
-;; Caveats:
-;; - Exponents outside of the range of +/-100 or so will cause certain
-;; functions (especially conversion routines) to take forever.
-;; - Very little checking is done for fixed point overflow/underflow.
-;; - No checking is done for over/underflow of the exponent
-;; (hardly necessary when exponent can be 2**23).
-;;
-;;
-;; Bill Rosenblatt
-;; June 20, 1986
-;;
-
-;;; Code:
-
-;; fundamental implementation constants
-(defconst exp-base 2
- "Base of exponent in this floating point representation.")
-
-(defconst mantissa-bits 24
- "Number of significant bits in this floating point representation.")
-
-(defconst decimal-digits 6
- "Number of decimal digits expected to be accurate.")
-
-(defconst expt-digits 2
- "Maximum permitted digits in a scientific notation exponent.")
-
-;; other constants
-(defconst maxbit (1- mantissa-bits)
- "Number of highest bit")
-
-(defconst mantissa-maxval (1- (ash 1 maxbit))
- "Maximum permissible value of mantissa")
-
-(defconst mantissa-minval (ash 1 maxbit)
- "Minimum permissible value of mantissa")
-
-(defconst floating-point-regexp
- "^[ \t]*\\(-?\\)\\([0-9]*\\)\
-\\(\\.\\([0-9]*\\)\\|\\)\
-\\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[ \t]*$"
- "Regular expression to match floating point numbers. Extract matches:
-1 - minus sign
-2 - integer part
-4 - fractional part
-8 - minus sign for power of ten
-9 - power of ten
-")
-
-(defconst high-bit-mask (ash 1 maxbit)
- "Masks all bits except the high-order (sign) bit.")
-
-(defconst second-bit-mask (ash 1 (1- maxbit))
- "Masks all bits except the highest-order magnitude bit")
-
-;; various useful floating point constants
-(defconst _f0 '(0 . 1))
-
-(defconst _f1/2 '(4194304 . -23))
-
-(defconst _f1 '(4194304 . -22))
-
-(defconst _f10 '(5242880 . -19))
-
-;; support for decimal conversion routines
-(defvar powers-of-10 (make-vector (1+ decimal-digits) _f1))
-(aset powers-of-10 1 _f10)
-(aset powers-of-10 2 '(6553600 . -16))
-(aset powers-of-10 3 '(8192000 . -13))
-(aset powers-of-10 4 '(5120000 . -9))
-(aset powers-of-10 5 '(6400000 . -6))
-(aset powers-of-10 6 '(8000000 . -3))
-
-(defconst all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits)))
-(defconst highest-power-of-10 (aref powers-of-10 decimal-digits))
-
-(defun fashl (fnum) ; floating-point arithmetic shift left
- (cons (ash (car fnum) 1) (1- (cdr fnum))))
-
-(defun fashr (fnum) ; floating point arithmetic shift right
- (cons (ash (car fnum) -1) (1+ (cdr fnum))))
-
-(defun normalize (fnum)
- (if (> (car fnum) 0) ; make sure next-to-highest bit is set
- (while (zerop (logand (car fnum) second-bit-mask))
- (setq fnum (fashl fnum)))
- (if (< (car fnum) 0) ; make sure highest bit is set
- (while (zerop (logand (car fnum) high-bit-mask))
- (setq fnum (fashl fnum)))
- (setq fnum _f0))) ; "standard 0"
- fnum)
-
-(defun abs (n) ; integer absolute value
- (if (>= n 0) n (- n)))
-
-(defun fabs (fnum) ; re-normalize after taking abs value
- (normalize (cons (abs (car fnum)) (cdr fnum))))
-
-(defun xor (a b) ; logical exclusive or
- (and (or a b) (not (and a b))))
-
-(defun same-sign (a b) ; two f-p numbers have same sign?
- (not (xor (natnump (car a)) (natnump (car b)))))
-
-(defun extract-match (str i) ; used after string-match
- (condition-case ()
- (substring str (match-beginning i) (match-end i))
- (error "")))
-
-;; support for the multiplication function
-(defconst halfword-bits (/ mantissa-bits 2)) ; bits in a halfword
-(defconst masklo (1- (ash 1 halfword-bits))) ; isolate the lower halfword
-(defconst maskhi (lognot masklo)) ; isolate the upper halfword
-(defconst round-limit (ash 1 (/ halfword-bits 2)))
-
-(defun hihalf (n) ; return high halfword, shifted down
- (ash (logand n maskhi) (- halfword-bits)))
-
-(defun lohalf (n) ; return low halfword
- (logand n masklo))
-
-;; Visible functions
-
-;; Arithmetic functions
-(defun f+ (a1 a2)
- "Returns the sum of two floating point numbers."
- (let ((f1 (fmax a1 a2))
- (f2 (fmin a1 a2)))
- (if (same-sign a1 a2)
- (setq f1 (fashr f1) ; shift right to avoid overflow
- f2 (fashr f2)))
- (normalize
- (cons (+ (car f1) (ash (car f2) (- (cdr f2) (cdr f1))))
- (cdr f1)))))
-
-(defun f- (a1 &optional a2) ; unary or binary minus
- "Returns the difference of two floating point numbers."
- (if a2
- (f+ a1 (f- a2))
- (normalize (cons (- (car a1)) (cdr a1)))))
-
-(defun f* (a1 a2) ; multiply in halfword chunks
- "Returns the product of two floating point numbers."
- (let* ((i1 (car (fabs a1)))
- (i2 (car (fabs a2)))
- (sign (not (same-sign a1 a2)))
- (prodlo (+ (hihalf (* (lohalf i1) (lohalf i2)))
- (lohalf (* (hihalf i1) (lohalf i2)))
- (lohalf (* (lohalf i1) (hihalf i2)))))
- (prodhi (+ (* (hihalf i1) (hihalf i2))
- (hihalf (* (hihalf i1) (lohalf i2)))
- (hihalf (* (lohalf i1) (hihalf i2)))
- (hihalf prodlo))))
- (if (> (lohalf prodlo) round-limit)
- (setq prodhi (1+ prodhi))) ; round off truncated bits
- (normalize
- (cons (if sign (- prodhi) prodhi)
- (+ (cdr (fabs a1)) (cdr (fabs a2)) mantissa-bits)))))
-
-(defun f/ (a1 a2) ; SLOW subtract-and-shift algorithm
- "Returns the quotient of two floating point numbers."
- (if (zerop (car a2)) ; if divide by 0
- (signal 'arith-error (list "attempt to divide by zero" a1 a2))
- (let ((bits (1- maxbit))
- (quotient 0)
- (dividend (car (fabs a1)))
- (divisor (car (fabs a2)))
- (sign (not (same-sign a1 a2))))
- (while (natnump bits)
- (if (< (- dividend divisor) 0)
- (setq quotient (ash quotient 1))
- (setq quotient (1+ (ash quotient 1))
- dividend (- dividend divisor)))
- (setq dividend (ash dividend 1)
- bits (1- bits)))
- (normalize
- (cons (if sign (- quotient) quotient)
- (- (cdr (fabs a1)) (cdr (fabs a2)) (1- maxbit)))))))
-
-(defun f% (a1 a2)
- "Returns the remainder of first floating point number divided by second."
- (f- a1 (f* (ftrunc (f/ a1 a2)) a2)))
-
-
-;; Comparison functions
-(defun f= (a1 a2)
- "Returns t if two floating point numbers are equal, nil otherwise."
- (equal a1 a2))
-
-(defun f> (a1 a2)
- "Returns t if first floating point number is greater than second,
-nil otherwise."
- (cond ((and (natnump (car a1)) (< (car a2) 0))
- t) ; a1 nonnegative, a2 negative
- ((and (> (car a1) 0) (<= (car a2) 0))
- t) ; a1 positive, a2 nonpositive
- ((and (<= (car a1) 0) (natnump (car a2)))
- nil) ; a1 nonpos, a2 nonneg
- ((/= (cdr a1) (cdr a2)) ; same signs. exponents differ
- (> (cdr a1) (cdr a2))) ; compare the mantissas.
- (t
- (> (car a1) (car a2))))) ; same exponents.
-
-(defun f>= (a1 a2)
- "Returns t if first floating point number is greater than or equal to
-second, nil otherwise."
- (or (f> a1 a2) (f= a1 a2)))
-
-(defun f< (a1 a2)
- "Returns t if first floating point number is less than second,
-nil otherwise."
- (not (f>= a1 a2)))
-
-(defun f<= (a1 a2)
- "Returns t if first floating point number is less than or equal to
-second, nil otherwise."
- (not (f> a1 a2)))
-
-(defun f/= (a1 a2)
- "Returns t if first floating point number is not equal to second,
-nil otherwise."
- (not (f= a1 a2)))
-
-(defun fmin (a1 a2)
- "Returns the minimum of two floating point numbers."
- (if (f< a1 a2) a1 a2))
-
-(defun fmax (a1 a2)
- "Returns the maximum of two floating point numbers."
- (if (f> a1 a2) a1 a2))
-
-(defun fzerop (fnum)
- "Returns t if the floating point number is zero, nil otherwise."
- (= (car fnum) 0))
-
-(defun floatp (fnum)
- "Returns t if the arg is a floating point number, nil otherwise."
- (and (consp fnum) (integerp (car fnum)) (integerp (cdr fnum))))
-
-;; Conversion routines
-(defun f (int)
- "Convert the integer argument to floating point, like a C cast operator."
- (normalize (cons int '0)))
-
-(defun int-to-hex-string (int)
- "Convert the integer argument to a C-style hexadecimal string."
- (let ((shiftval -20)
- (str "0x")
- (hex-chars "0123456789ABCDEF"))
- (while (<= shiftval 0)
- (setq str (concat str (char-to-string
- (aref hex-chars
- (logand (lsh int shiftval) 15))))
- shiftval (+ shiftval 4)))
- str))
-
-(defun ftrunc (fnum) ; truncate fractional part
- "Truncate the fractional part of a floating point number."
- (cond ((natnump (cdr fnum)) ; it's all integer, return number as is
- fnum)
- ((<= (cdr fnum) (- maxbit)) ; it's all fractional, return 0
- '(0 . 1))
- (t ; otherwise mask out fractional bits
- (let ((mant (car fnum)) (exp (cdr fnum)))
- (normalize
- (cons (if (natnump mant) ; if negative, use absolute value
- (ash (ash mant exp) (- exp))
- (- (ash (ash (- mant) exp) (- exp))))
- exp))))))
-
-(defun fint (fnum) ; truncate and convert to integer
- "Convert the floating point number to integer, with truncation,
-like a C cast operator."
- (let* ((tf (ftrunc fnum)) (tint (car tf)) (texp (cdr tf)))
- (cond ((>= texp mantissa-bits) ; too high, return "maxint"
- mantissa-maxval)
- ((<= texp (- mantissa-bits)) ; too low, return "minint"
- mantissa-minval)
- (t ; in range
- (ash tint texp))))) ; shift so that exponent is 0
-
-(defun float-to-string (fnum &optional sci)
- "Convert the floating point number to a decimal string.
-Optional second argument non-nil means use scientific notation."
- (let* ((value (fabs fnum)) (sign (< (car fnum) 0))
- (power 0) (result 0) (str "")
- (temp 0) (pow10 _f1))
-
- (if (f= fnum _f0)
- "0"
- (if (f>= value _f1) ; find largest power of 10 <= value
- (progn ; value >= 1, power is positive
- (while (f<= (setq temp (f* pow10 highest-power-of-10)) value)
- (setq pow10 temp
- power (+ power decimal-digits)))
- (while (f<= (setq temp (f* pow10 _f10)) value)
- (setq pow10 temp
- power (1+ power))))
- (progn ; value < 1, power is negative
- (while (f> (setq temp (f/ pow10 highest-power-of-10)) value)
- (setq pow10 temp
- power (- power decimal-digits)))
- (while (f> pow10 value)
- (setq pow10 (f/ pow10 _f10)
- power (1- power)))))
- ; get value in range 100000 to 999999
- (setq value (f* (f/ value pow10) all-decimal-digs-minval)
- result (ftrunc value))
- (let (int)
- (if (f> (f- value result) _f1/2) ; round up if remainder > 0.5
- (setq int (1+ (fint result)))
- (setq int (fint result)))
- (setq str (int-to-string int))
- (if (>= int 1000000)
- (setq power (1+ power))))
-
- (if sci ; scientific notation
- (setq str (concat (substring str 0 1) "." (substring str 1)
- "E" (int-to-string power)))
-
- ; regular decimal string
- (cond ((>= power (1- decimal-digits))
- ; large power, append zeroes
- (let ((zeroes (- power decimal-digits)))
- (while (natnump zeroes)
- (setq str (concat str "0")
- zeroes (1- zeroes)))))
-
- ; negative power, prepend decimal
- ((< power 0) ; point and zeroes
- (let ((zeroes (- (- power) 2)))
- (while (natnump zeroes)
- (setq str (concat "0" str)
- zeroes (1- zeroes)))
- (setq str (concat "0." str))))
-
- (t ; in range, insert decimal point
- (setq str (concat
- (substring str 0 (1+ power))
- "."
- (substring str (1+ power)))))))
-
- (if sign ; if negative, prepend minus sign
- (concat "-" str)
- str))))
-
-
-;; string to float conversion.
-;; accepts scientific notation, but ignores anything after the first two
-;; digits of the exponent.
-(defun string-to-float (str)
- "Convert the string to a floating point number.
-Accepts a decimal string in scientific notation, with exponent preceded
-by either E or e. Only the six most significant digits of the integer
-and fractional parts are used; only the first two digits of the exponent
-are used. Negative signs preceding both the decimal number and the exponent
-are recognized."
-
- (if (string-match floating-point-regexp str 0)
- (let (power)
- (f*
- ; calculate the mantissa
- (let* ((int-subst (extract-match str 2))
- (fract-subst (extract-match str 4))
- (digit-string (concat int-subst fract-subst))
- (mant-sign (equal (extract-match str 1) "-"))
- (leading-0s 0) (round-up nil))
-
- ; get rid of leading 0's
- (setq power (- (length int-subst) decimal-digits))
- (while (and (< leading-0s (length digit-string))
- (= (aref digit-string leading-0s) ?0))
- (setq leading-0s (1+ leading-0s)))
- (setq power (- power leading-0s)
- digit-string (substring digit-string leading-0s))
-
- ; if more than 6 digits, round off
- (if (> (length digit-string) decimal-digits)
- (setq round-up (>= (aref digit-string decimal-digits) ?5)
- digit-string (substring digit-string 0 decimal-digits))
- (setq power (+ power (- decimal-digits (length digit-string)))))
-
- ; round up and add minus sign, if necessary
- (f (* (+ (string-to-int digit-string)
- (if round-up 1 0))
- (if mant-sign -1 1))))
-
- ; calculate the exponent (power of ten)
- (let* ((expt-subst (extract-match str 9))
- (expt-sign (equal (extract-match str 8) "-"))
- (expt 0) (chunks 0) (tens 0) (exponent _f1)
- (func 'f*))
-
- (setq expt (+ (* (string-to-int
- (substring expt-subst 0
- (min expt-digits (length expt-subst))))
- (if expt-sign -1 1))
- power))
- (if (< expt 0) ; if power of 10 negative
- (setq expt (- expt) ; take abs val of exponent
- func 'f/)) ; and set up to divide, not multiply
-
- (setq chunks (/ expt decimal-digits)
- tens (% expt decimal-digits))
- ; divide or multiply by "chunks" of 10**6
- (while (> chunks 0)
- (setq exponent (funcall func exponent highest-power-of-10)
- chunks (1- chunks)))
- ; divide or multiply by remaining power of ten
- (funcall func exponent (aref powers-of-10 tens)))))
-
- _f0)) ; if invalid, return 0
-
-(provide 'float)
-
-;;; float.el ends here
+++ /dev/null
-;;; options.el --- edit Options command for Emacs
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This code provides functions to list and edit the values of all global
-;; option variables known to loaded Emacs Lisp code. There are two entry
-;; points, `list-options' and `edit' options'. The latter enters a major
-;; mode specifically for editing option values. Do `M-x describe-mode' in
-;; that context for more details.
-
-;; The customization buffer feature is intended to make this obsolete.
-
-;;; Code:
-
-;;;###autoload
-(defun list-options ()
- "Display a list of Emacs user options, with values and documentation.
-It is now better to use Customize instead."
- (interactive)
- (with-output-to-temp-buffer "*List Options*"
- (let (vars)
- (mapatoms (function (lambda (sym)
- (if (user-variable-p sym)
- (setq vars (cons sym vars))))))
- (setq vars (sort vars 'string-lessp))
- (while vars
- (let ((sym (car vars)))
- (when (boundp sym)
- (princ ";; ")
- (prin1 sym)
- (princ ":\n\t")
- (prin1 (symbol-value sym))
- (terpri)
- (princ (substitute-command-keys
- (documentation-property sym 'variable-documentation)))
- (princ "\n;;\n"))
- (setq vars (cdr vars))))
- (with-current-buffer "*List Options*"
- (Edit-options-mode)
- (setq buffer-read-only t)))))
-
-;;;###autoload
-(defun edit-options ()
- "Edit a list of Emacs user option values.
-Selects a buffer containing such a list,
-in which there are commands to set the option values.
-Type \\[describe-mode] in that buffer for a list of commands.
-
-The Custom feature is intended to make this obsolete."
- (interactive)
- (list-options)
- (pop-to-buffer "*List Options*"))
-
-(defvar Edit-options-mode-map
- (let ((map (make-keymap)))
- (define-key map "s" 'Edit-options-set)
- (define-key map "x" 'Edit-options-toggle)
- (define-key map "1" 'Edit-options-t)
- (define-key map "0" 'Edit-options-nil)
- (define-key map "p" 'backward-paragraph)
- (define-key map " " 'forward-paragraph)
- (define-key map "n" 'forward-paragraph)
- map)
- "")
-
-;; Edit Options mode is suitable only for specially formatted data.
-(put 'Edit-options-mode 'mode-class 'special)
-
-(defun Edit-options-mode ()
- "\\<Edit-options-mode-map>\
-Major mode for editing Emacs user option settings.
-Special commands are:
-\\[Edit-options-set] -- set variable point points at. New value read using minibuffer.
-\\[Edit-options-toggle] -- toggle variable, t -> nil, nil -> t.
-\\[Edit-options-t] -- set variable to t.
-\\[Edit-options-nil] -- set variable to nil.
-Changed values made by these commands take effect immediately.
-
-Each variable description is a paragraph.
-For convenience, the characters \\[backward-paragraph] and \\[forward-paragraph] move back and forward by paragraphs."
- (kill-all-local-variables)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (use-local-map Edit-options-mode-map)
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate "[^\^@-\^?]")
- (make-local-variable 'paragraph-start)
- (setq paragraph-start "\t")
- (setq truncate-lines t)
- (setq major-mode 'Edit-options-mode)
- (setq mode-name "Options")
- (run-hooks 'Edit-options-mode-hook))
-
-(defun Edit-options-set () (interactive)
- (Edit-options-modify
- (lambda (var) (eval-minibuffer (concat "New " (symbol-name var) ": ")))))
-
-(defun Edit-options-toggle () (interactive)
- (Edit-options-modify (lambda (var) (not (symbol-value var)))))
-
-(defun Edit-options-t () (interactive)
- (Edit-options-modify (lambda (var) t)))
-
-(defun Edit-options-nil () (interactive)
- (Edit-options-modify (lambda (var) nil)))
-
-(defun Edit-options-modify (modfun)
- (save-excursion
- (let ((buffer-read-only nil) var pos)
- (re-search-backward "^;; \\|\\`")
- (forward-char 3)
- (setq pos (point))
- (save-restriction
- (narrow-to-region pos (progn (end-of-line) (1- (point))))
- (goto-char pos)
- (setq var (read (current-buffer))))
- (goto-char pos)
- (forward-line 1)
- (forward-char 1)
- (save-excursion
- (set var (funcall modfun var)))
- (kill-sexp 1)
- (prin1 (symbol-value var) (current-buffer)))))
-
-(provide 'options)
-
-;;; options.el ends here
+++ /dev/null
-;;; scribe.el --- scribe mode, and its idiosyncratic commands
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; A major mode for editing source in written for the Scribe text formatter.
-;; Knows about Scribe syntax and standard layout rules. The command to
-;; run Scribe on a buffer is bogus; someone interested should fix it.
-
-;;; Code:
-
-(defgroup scribe nil
- "Scribe mode."
- :prefix "scribe-"
- :group 'wp)
-
-(defvar scribe-mode-syntax-table nil
- "Syntax table used while in scribe mode.")
-
-(defvar scribe-mode-abbrev-table nil
- "Abbrev table used while in scribe mode.")
-
-(defcustom scribe-fancy-paragraphs nil
- "*Non-nil makes Scribe mode use a different style of paragraph separation."
- :type 'boolean
- :group 'scribe)
-
-(defcustom scribe-electric-quote nil
- "*Non-nil makes insert of double quote use `` or '' depending on context."
- :type 'boolean
- :group 'scribe)
-
-(defcustom scribe-electric-parenthesis nil
- "*Non-nil makes parenthesis char ( (]}> ) automatically insert its close
-if typed after an @Command form."
- :type 'boolean
- :group 'scribe)
-
-(defconst scribe-open-parentheses "[({<"
- "Open parenthesis characters for Scribe.")
-
-(defconst scribe-close-parentheses "])}>"
- "Close parenthesis characters for Scribe.
-These should match up with `scribe-open-parenthesis'.")
-
-(if (null scribe-mode-syntax-table)
- (let ((st (syntax-table)))
- (unwind-protect
- (progn
- (setq scribe-mode-syntax-table (copy-syntax-table
- text-mode-syntax-table))
- (set-syntax-table scribe-mode-syntax-table)
- (modify-syntax-entry ?\" " ")
- (modify-syntax-entry ?\\ " ")
- (modify-syntax-entry ?@ "w ")
- (modify-syntax-entry ?< "(> ")
- (modify-syntax-entry ?> ")< ")
- (modify-syntax-entry ?[ "(] ")
- (modify-syntax-entry ?] ")[ ")
- (modify-syntax-entry ?{ "(} ")
- (modify-syntax-entry ?} "){ ")
- (modify-syntax-entry ?' "w "))
- (set-syntax-table st))))
-
-(defvar scribe-mode-map nil)
-
-(if scribe-mode-map
- nil
- (setq scribe-mode-map (make-sparse-keymap))
- (define-key scribe-mode-map "\t" 'scribe-tab)
- (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
- (define-key scribe-mode-map "\es" 'center-line)
- (define-key scribe-mode-map "\e}" 'up-list)
- (define-key scribe-mode-map "\eS" 'center-paragraph)
- (define-key scribe-mode-map "\"" 'scribe-insert-quote)
- (define-key scribe-mode-map "(" 'scribe-parenthesis)
- (define-key scribe-mode-map "[" 'scribe-parenthesis)
- (define-key scribe-mode-map "{" 'scribe-parenthesis)
- (define-key scribe-mode-map "<" 'scribe-parenthesis)
- (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter)
- (define-key scribe-mode-map "\C-c\C-t" 'scribe-section)
- (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection)
- (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment)
- (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be)
- (define-key scribe-mode-map "\C-c[" 'scribe-begin)
- (define-key scribe-mode-map "\C-c]" 'scribe-end)
- (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word)
- (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word)
- (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word))
-
-;;;###autoload
-(define-derived-mode scribe-mode text-mode "Scribe"
- "Major mode for editing files of Scribe (a text formatter) source.
-Scribe-mode is similar to text-mode, with a few extra commands added.
-\\{scribe-mode-map}
-
-Interesting variables:
-
-`scribe-fancy-paragraphs'
- Non-nil makes Scribe mode use a different style of paragraph separation.
-
-`scribe-electric-quote'
- Non-nil makes insert of double quote use `` or '' depending on context.
-
-`scribe-electric-parenthesis'
- Non-nil makes an open-parenthesis char (one of `([<{')
- automatically insert its close if typed after an @Command form."
- (set (make-local-variable 'comment-start) "@Comment[")
- (set (make-local-variable 'comment-start-skip) (concat "@Comment[" scribe-open-parentheses "]"))
- (set (make-local-variable 'comment-column) 0)
- (set (make-local-variable 'comment-end) "]")
- (set (make-local-variable 'paragraph-start)
- (concat "\\([\n\f]\\)\\|\\(@\\w+["
- scribe-open-parentheses
- "].*["
- scribe-close-parentheses
- "]$\\)"))
- (set (make-local-variable 'paragraph-separate)
- (if scribe-fancy-paragraphs paragraph-start "$"))
- (set (make-local-variable 'sentence-end)
- "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*")
- (set (make-local-variable 'compile-command)
- (concat "scribe " (buffer-file-name))))
-
-(defun scribe-tab ()
- (interactive)
- (insert "@\\"))
-
-;; This algorithm could probably be improved somewhat.
-;; Right now, it loses seriously...
-
-(defun scribe ()
- "Run Scribe on the current buffer."
- (interactive)
- (call-interactively 'compile))
-
-(defun scribe-envelop-word (string count)
- "Surround current word with Scribe construct @STRING[...].
-COUNT specifies how many words to surround. A negative count means
-to skip backward."
- (let ((spos (point)) (epos (point)) (ccoun 0) noparens)
- (if (not (zerop count))
- (progn (if (= (char-syntax (preceding-char)) ?w)
- (forward-sexp (min -1 count)))
- (setq spos (point))
- (if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
- (forward-char 2)
- (goto-char epos)
- (skip-chars-backward "\\W")
- (forward-char -1))
- (forward-sexp (max count 1))
- (setq epos (point))))
- (goto-char spos)
- (while (and (< ccoun (length scribe-open-parentheses))
- (save-excursion
- (or (search-forward (char-to-string
- (aref scribe-open-parentheses ccoun))
- epos t)
- (search-forward (char-to-string
- (aref scribe-close-parentheses ccoun))
- epos t)))
- (setq ccoun (1+ ccoun))))
- (if (>= ccoun (length scribe-open-parentheses))
- (progn (goto-char epos)
- (insert "@end(" string ")")
- (goto-char spos)
- (insert "@begin(" string ")"))
- (goto-char epos)
- (insert (aref scribe-close-parentheses ccoun))
- (goto-char spos)
- (insert "@" string (aref scribe-open-parentheses ccoun))
- (goto-char epos)
- (forward-char 3)
- (skip-chars-forward scribe-close-parentheses))))
-
-(defun scribe-underline-word (count)
- "Underline COUNT words around point by means of Scribe constructs."
- (interactive "p")
- (scribe-envelop-word "u" count))
-
-(defun scribe-bold-word (count)
- "Boldface COUNT words around point by means of Scribe constructs."
- (interactive "p")
- (scribe-envelop-word "b" count))
-
-(defun scribe-italicize-word (count)
- "Italicize COUNT words around point by means of Scribe constructs."
- (interactive "p")
- (scribe-envelop-word "i" count))
-
-(defun scribe-begin ()
- (interactive)
- (insert "\n")
- (forward-char -1)
- (scribe-envelop-word "Begin" 0)
- (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-end ()
- (interactive)
- (insert "\n")
- (forward-char -1)
- (scribe-envelop-word "End" 0)
- (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-chapter ()
- (interactive)
- (insert "\n")
- (forward-char -1)
- (scribe-envelop-word "Chapter" 0)
- (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-section ()
- (interactive)
- (insert "\n")
- (forward-char -1)
- (scribe-envelop-word "Section" 0)
- (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-subsection ()
- (interactive)
- (insert "\n")
- (forward-char -1)
- (scribe-envelop-word "SubSection" 0)
- (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-bracket-region-be (env min max)
- (interactive "sEnvironment: \nr")
- (save-excursion
- (goto-char max)
- (insert "@end(" env ")\n")
- (goto-char min)
- (insert "@begin(" env ")\n")))
-
-(defun scribe-insert-environment (env)
- (interactive "sEnvironment: ")
- (scribe-bracket-region-be env (point) (point))
- (forward-line 1)
- (insert ?\n)
- (forward-char -1))
-
-(defun scribe-insert-quote (count)
- "Insert ``, '' or \" according to preceding character.
-If `scribe-electric-quote' is non-nil, insert ``, '' or \" according
-to preceding character. With numeric arg N, always insert N \" characters.
-Else just insert \"."
- (interactive "P")
- (if (or count (not scribe-electric-quote))
- (self-insert-command (prefix-numeric-value count))
- (let (lastfore lastback lastquote)
- (insert
- (cond
- ((= (preceding-char) ?\\) ?\")
- ((bobp) "``")
- (t
- (setq lastfore (save-excursion (and (search-backward
- "``" (- (point) 1000) t)
- (point)))
- lastback (save-excursion (and (search-backward
- "''" (- (point) 1000) t)
- (point)))
- lastquote (save-excursion (and (search-backward
- "\"" (- (point) 100) t)
- (point))))
- (if (not lastquote)
- (cond ((not lastfore) "``")
- ((not lastback) "''")
- ((> lastfore lastback) "''")
- (t "``"))
- (cond ((and (not lastback) (not lastfore)) "\"")
- ((and lastback (not lastfore) (> lastquote lastback)) "\"")
- ((and lastback (not lastfore) (> lastback lastquote)) "``")
- ((and lastfore (not lastback) (> lastquote lastfore)) "\"")
- ((and lastfore (not lastback) (> lastfore lastquote)) "''")
- ((and (> lastquote lastfore) (> lastquote lastback)) "\"")
- ((> lastfore lastback) "''")
- (t "``")))))))))
-
-(defun scribe-parenthesis (count)
- "If scribe-electric-parenthesis is non-nil, insertion of an open-parenthesis
-character inserts the following close parenthesis character if the
-preceding text is of the form @Command."
- (interactive "P")
- (self-insert-command (prefix-numeric-value count))
- (let (at-command paren-char point-save)
- (if (or count (not scribe-electric-parenthesis))
- nil
- (save-excursion
- (forward-char -1)
- (setq point-save (point))
- (skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
- (setq at-command (and (equal (following-char) ?@)
- (/= (point) (1- point-save)))))
- (if (and at-command
- (setq paren-char
- (string-match (regexp-quote
- (char-to-string (preceding-char)))
- scribe-open-parentheses)))
- (save-excursion
- (insert (aref scribe-close-parentheses paren-char)))))))
-
-(provide 'scribe)
-
-;;; scribe.el ends here
--- /dev/null
+;;; options.el --- edit Options command for Emacs
+
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This code provides functions to list and edit the values of all global
+;; option variables known to loaded Emacs Lisp code. There are two entry
+;; points, `list-options' and `edit' options'. The latter enters a major
+;; mode specifically for editing option values. Do `M-x describe-mode' in
+;; that context for more details.
+
+;; The customization buffer feature is intended to make this obsolete.
+
+;;; Code:
+
+;;;###autoload
+(defun list-options ()
+ "Display a list of Emacs user options, with values and documentation.
+It is now better to use Customize instead."
+ (interactive)
+ (with-output-to-temp-buffer "*List Options*"
+ (let (vars)
+ (mapatoms (function (lambda (sym)
+ (if (user-variable-p sym)
+ (setq vars (cons sym vars))))))
+ (setq vars (sort vars 'string-lessp))
+ (while vars
+ (let ((sym (car vars)))
+ (when (boundp sym)
+ (princ ";; ")
+ (prin1 sym)
+ (princ ":\n\t")
+ (prin1 (symbol-value sym))
+ (terpri)
+ (princ (substitute-command-keys
+ (documentation-property sym 'variable-documentation)))
+ (princ "\n;;\n"))
+ (setq vars (cdr vars))))
+ (with-current-buffer "*List Options*"
+ (Edit-options-mode)
+ (setq buffer-read-only t)))))
+
+;;;###autoload
+(defun edit-options ()
+ "Edit a list of Emacs user option values.
+Selects a buffer containing such a list,
+in which there are commands to set the option values.
+Type \\[describe-mode] in that buffer for a list of commands.
+
+The Custom feature is intended to make this obsolete."
+ (interactive)
+ (list-options)
+ (pop-to-buffer "*List Options*"))
+
+(defvar Edit-options-mode-map
+ (let ((map (make-keymap)))
+ (define-key map "s" 'Edit-options-set)
+ (define-key map "x" 'Edit-options-toggle)
+ (define-key map "1" 'Edit-options-t)
+ (define-key map "0" 'Edit-options-nil)
+ (define-key map "p" 'backward-paragraph)
+ (define-key map " " 'forward-paragraph)
+ (define-key map "n" 'forward-paragraph)
+ map)
+ "")
+
+;; Edit Options mode is suitable only for specially formatted data.
+(put 'Edit-options-mode 'mode-class 'special)
+
+(defun Edit-options-mode ()
+ "\\<Edit-options-mode-map>\
+Major mode for editing Emacs user option settings.
+Special commands are:
+\\[Edit-options-set] -- set variable point points at. New value read using minibuffer.
+\\[Edit-options-toggle] -- toggle variable, t -> nil, nil -> t.
+\\[Edit-options-t] -- set variable to t.
+\\[Edit-options-nil] -- set variable to nil.
+Changed values made by these commands take effect immediately.
+
+Each variable description is a paragraph.
+For convenience, the characters \\[backward-paragraph] and \\[forward-paragraph] move back and forward by paragraphs."
+ (kill-all-local-variables)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (use-local-map Edit-options-mode-map)
+ (make-local-variable 'paragraph-separate)
+ (setq paragraph-separate "[^\^@-\^?]")
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start "\t")
+ (setq truncate-lines t)
+ (setq major-mode 'Edit-options-mode)
+ (setq mode-name "Options")
+ (run-hooks 'Edit-options-mode-hook))
+
+(defun Edit-options-set () (interactive)
+ (Edit-options-modify
+ (lambda (var) (eval-minibuffer (concat "New " (symbol-name var) ": ")))))
+
+(defun Edit-options-toggle () (interactive)
+ (Edit-options-modify (lambda (var) (not (symbol-value var)))))
+
+(defun Edit-options-t () (interactive)
+ (Edit-options-modify (lambda (var) t)))
+
+(defun Edit-options-nil () (interactive)
+ (Edit-options-modify (lambda (var) nil)))
+
+(defun Edit-options-modify (modfun)
+ (save-excursion
+ (let ((buffer-read-only nil) var pos)
+ (re-search-backward "^;; \\|\\`")
+ (forward-char 3)
+ (setq pos (point))
+ (save-restriction
+ (narrow-to-region pos (progn (end-of-line) (1- (point))))
+ (goto-char pos)
+ (setq var (read (current-buffer))))
+ (goto-char pos)
+ (forward-line 1)
+ (forward-char 1)
+ (save-excursion
+ (set var (funcall modfun var)))
+ (kill-sexp 1)
+ (prin1 (symbol-value var) (current-buffer)))))
+
+(provide 'options)
+
+;;; options.el ends here
+++ /dev/null
-;;; outline.el --- outline mode commands for Emacs
-
-;; Copyright (C) 1986, 93, 94, 95, 97, 2000, 2001
-;; Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: outlines
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package is a major mode for editing outline-format documents.
-;; An outline can be `abstracted' to show headers at any given level,
-;; with all stuff below hidden. See the Emacs manual for details.
-
-;;; Todo:
-
-;; - subtree-terminators
-;; - better handle comments before function bodies (i.e. heading)
-;; - don't bother hiding whitespace
-
-;;; Code:
-
-(defgroup outlines nil
- "Support for hierarchical outlining"
- :prefix "outline-"
- :group 'editing)
-
-(defcustom outline-regexp "[*\^L]+"
- "*Regular expression to match the beginning of a heading.
-Any line whose beginning matches this regexp is considered to start a heading.
-Note that Outline mode only checks this regexp at the start of a line,
-so the regexp need not (and usually does not) start with `^'.
-The recommended way to set this is with a Local Variables: list
-in the file it applies to. See also `outline-heading-end-regexp'."
- :type '(choice regexp (const nil))
- :group 'outlines)
-
-(defcustom outline-heading-end-regexp "\n"
- "*Regular expression to match the end of a heading line.
-You can assume that point is at the beginning of a heading when this
-regexp is searched for. The heading ends at the end of the match.
-The recommended way to set this is with a `Local Variables:' list
-in the file it applies to."
- :type 'regexp
- :group 'outlines)
-
-(defvar outline-mode-prefix-map
- (let ((map (make-sparse-keymap)))
- (define-key map "@" 'outline-mark-subtree)
- (define-key map "\C-n" 'outline-next-visible-heading)
- (define-key map "\C-p" 'outline-previous-visible-heading)
- (define-key map "\C-i" 'show-children)
- (define-key map "\C-s" 'show-subtree)
- (define-key map "\C-d" 'hide-subtree)
- (define-key map "\C-u" 'outline-up-heading)
- (define-key map "\C-f" 'outline-forward-same-level)
- (define-key map "\C-b" 'outline-backward-same-level)
- (define-key map "\C-t" 'hide-body)
- (define-key map "\C-a" 'show-all)
- (define-key map "\C-c" 'hide-entry)
- (define-key map "\C-e" 'show-entry)
- (define-key map "\C-l" 'hide-leaves)
- (define-key map "\C-k" 'show-branches)
- (define-key map "\C-q" 'hide-sublevels)
- (define-key map "\C-o" 'hide-other)
- (define-key map "\C-^" 'outline-move-subtree-up)
- (define-key map "\C-v" 'outline-move-subtree-down)
- (define-key map [(control ?<)] 'outline-promote)
- (define-key map [(control ?>)] 'outline-demote)
- (define-key map "\C-m" 'outline-insert-heading)
- ;; Where to bind outline-cycle ?
- map))
-
-(defvar outline-mode-menu-bar-map
- (let ((map (make-sparse-keymap)))
-
- (define-key map [hide] (cons "Hide" (make-sparse-keymap "Hide")))
-
- (define-key map [hide hide-other] '("Hide Other" . hide-other))
- (define-key map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels))
- (define-key map [hide hide-subtree] '("Hide Subtree" . hide-subtree))
- (define-key map [hide hide-entry] '("Hide Entry" . hide-entry))
- (define-key map [hide hide-body] '("Hide Body" . hide-body))
- (define-key map [hide hide-leaves] '("Hide Leaves" . hide-leaves))
-
- (define-key map [show] (cons "Show" (make-sparse-keymap "Show")))
-
- (define-key map [show show-subtree] '("Show Subtree" . show-subtree))
- (define-key map [show show-children] '("Show Children" . show-children))
- (define-key map [show show-branches] '("Show Branches" . show-branches))
- (define-key map [show show-entry] '("Show Entry" . show-entry))
- (define-key map [show show-all] '("Show All" . show-all))
-
- (define-key map [headings]
- (cons "Headings" (make-sparse-keymap "Headings")))
-
- (define-key map [headings demote-subtree]
- '(menu-item "Demote subtree" outline-demote))
- (define-key map [headings promote-subtree]
- '(menu-item "Promote subtree" outline-promote))
- (define-key map [headings move-subtree-down]
- '(menu-item "Move subtree down" outline-move-subtree-down))
- (define-key map [headings move-subtree-up]
- '(menu-item "Move subtree up" outline-move-subtree-up))
- (define-key map [headings copy]
- '(menu-item "Copy to kill ring" outline-headers-as-kill
- :enable mark-active))
- (define-key map [headings outline-insert-heading]
- '("New heading" . outline-insert-heading))
- (define-key map [headings outline-backward-same-level]
- '("Previous Same Level" . outline-backward-same-level))
- (define-key map [headings outline-forward-same-level]
- '("Next Same Level" . outline-forward-same-level))
- (define-key map [headings outline-previous-visible-heading]
- '("Previous" . outline-previous-visible-heading))
- (define-key map [headings outline-next-visible-heading]
- '("Next" . outline-next-visible-heading))
- (define-key map [headings outline-up-heading]
- '("Up" . outline-up-heading))
- map))
-
-(defvar outline-minor-mode-menu-bar-map
- (let ((map (make-sparse-keymap)))
- (define-key map [outline]
- (cons "Outline"
- (nconc (make-sparse-keymap "Outline")
- ;; Remove extra separator
- (cdr
- ;; Flatten the major mode's menus into a single menu.
- (apply 'append
- (mapcar (lambda (x)
- (if (consp x)
- ;; Add a separator between each
- ;; part of the unified menu.
- (cons '(--- "---") (cdr x))))
- outline-mode-menu-bar-map))))))
- map))
-
-
-(defvar outline-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c" outline-mode-prefix-map)
- (define-key map [menu-bar] outline-mode-menu-bar-map)
- map))
-
-(defvar outline-font-lock-keywords
- '(;;
- ;; Highlight headings according to the level.
- (eval . (list (concat "^\\(?:" outline-regexp "\\).+")
- 0 '(outline-font-lock-face) nil t)))
- "Additional expressions to highlight in Outline mode.")
-
-(defface outline-1 '((t :inherit font-lock-function-name-face)) "Level 1.")
-(defface outline-2 '((t :inherit font-lock-variable-name-face)) "Level 2.")
-(defface outline-3 '((t :inherit font-lock-keyword-face)) "Level 3.")
-(defface outline-4 '((t :inherit font-lock-builtin-face)) "Level 4.")
-(defface outline-5 '((t :inherit font-lock-comment-face)) "Level 5.")
-(defface outline-6 '((t :inherit font-lock-constant-face)) "Level 6.")
-(defface outline-7 '((t :inherit font-lock-type-face)) "Level 7.")
-(defface outline-8 '((t :inherit font-lock-string-face)) "Level 8.")
-
-(defvar outline-font-lock-faces
- [outline-1 outline-2 outline-3 outline-4
- outline-5 outline-6 outline-7 outline-8])
-
-(defvar outline-font-lock-levels nil)
-(make-variable-buffer-local 'outline-font-lock-levels)
-
-(defun outline-font-lock-face ()
- ;; (save-excursion
- ;; (outline-back-to-heading t)
- ;; (let* ((count 0)
- ;; (start-level (funcall outline-level))
- ;; (level start-level)
- ;; face-level)
- ;; (while (not (setq face-level
- ;; (if (or (bobp) (eq level 1)) 0
- ;; (cdr (assq level outline-font-lock-levels)))))
- ;; (outline-up-heading 1 t)
- ;; (setq count (1+ count))
- ;; (setq level (funcall outline-level)))
- ;; ;; Remember for later.
- ;; (unless (zerop count)
- ;; (setq face-level (+ face-level count))
- ;; (push (cons start-level face-level) outline-font-lock-levels))
- ;; (condition-case nil
- ;; (aref outline-font-lock-faces face-level)
- ;; (error font-lock-warning-face))))
- (save-excursion
- (goto-char (match-beginning 0))
- (looking-at outline-regexp)
- (condition-case nil
- (aref outline-font-lock-faces (1- (funcall outline-level)))
- (error font-lock-warning-face))))
-
-(defvar outline-view-change-hook nil
- "Normal hook to be run after outline visibility changes.")
-
-;;;###autoload
-(define-derived-mode outline-mode text-mode "Outline"
- "Set major mode for editing outlines with selective display.
-Headings are lines which start with asterisks: one for major headings,
-two for subheadings, etc. Lines not starting with asterisks are body lines.
-
-Body text or subheadings under a heading can be made temporarily
-invisible, or visible again. Invisible lines are attached to the end
-of the heading, so they move with it, if the line is killed and yanked
-back. A heading with text hidden under it is marked with an ellipsis (...).
-
-Commands:\\<outline-mode-map>
-\\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
-\\[outline-previous-visible-heading] outline-previous-visible-heading
-\\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
-\\[outline-backward-same-level] outline-backward-same-level
-\\[outline-up-heading] outline-up-heading move from subheading to heading
-
-\\[hide-body] make all text invisible (not headings).
-\\[show-all] make everything in buffer visible.
-\\[hide-sublevels] make only the first N levels of headers visible.
-
-The remaining commands are used when point is on a heading line.
-They apply to some of the body or subheadings of that heading.
-\\[hide-subtree] hide-subtree make body and subheadings invisible.
-\\[show-subtree] show-subtree make body and subheadings visible.
-\\[show-children] show-children make direct subheadings visible.
- No effect on body, or subheadings 2 or more levels down.
- With arg N, affects subheadings N levels down.
-\\[hide-entry] make immediately following body invisible.
-\\[show-entry] make it visible.
-\\[hide-leaves] make body under heading and under its subheadings invisible.
- The subheadings remain visible.
-\\[show-branches] make all subheadings at all levels visible.
-
-The variable `outline-regexp' can be changed to control what is a heading.
-A line is a heading if `outline-regexp' matches something at the
-beginning of the line. The longer the match, the deeper the level.
-
-Turning on outline mode calls the value of `text-mode-hook' and then of
-`outline-mode-hook', if they are non-nil."
- (make-local-variable 'line-move-ignore-invisible)
- (setq line-move-ignore-invisible t)
- ;; Cause use of ellipses for invisible text.
- (add-to-invisibility-spec '(outline . t))
- (set (make-local-variable 'paragraph-start)
- (concat paragraph-start "\\|\\(?:" outline-regexp "\\)"))
- ;; Inhibit auto-filling of header lines.
- (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp)
- (set (make-local-variable 'paragraph-separate)
- (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)"))
- (set (make-local-variable 'font-lock-defaults)
- '(outline-font-lock-keywords t nil nil backward-paragraph))
- (setq imenu-generic-expression
- (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
- (add-hook 'change-major-mode-hook 'show-all nil t))
-
-(defcustom outline-minor-mode-prefix "\C-c@"
- "*Prefix key to use for Outline commands in Outline minor mode.
-The value of this variable is checked as part of loading Outline mode.
-After that, changing the prefix key requires manipulating keymaps."
- :type 'string
- :group 'outlines)
-
-;;;###autoload
-(define-minor-mode outline-minor-mode
- "Toggle Outline minor mode.
-With arg, turn Outline minor mode on if arg is positive, off otherwise.
-See the command `outline-mode' for more information on this mode."
- nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
- (cons outline-minor-mode-prefix outline-mode-prefix-map))
- :group 'outlines
- (if outline-minor-mode
- (progn
- ;; Turn off this mode if we change major modes.
- (add-hook 'change-major-mode-hook
- (lambda () (outline-minor-mode -1))
- nil t)
- (set (make-local-variable 'line-move-ignore-invisible) t)
- ;; Cause use of ellipses for invisible text.
- (add-to-invisibility-spec '(outline . t)))
- (setq line-move-ignore-invisible nil)
- ;; Cause use of ellipses for invisible text.
- (remove-from-invisibility-spec '(outline . t))
- ;; When turning off outline mode, get rid of any outline hiding.
- (show-all)))
-\f
-(defvar outline-level 'outline-level
- "*Function of no args to compute a header's nesting level in an outline.
-It can assume point is at the beginning of a header line and that the match
-data reflects the `outline-regexp'.")
-
-(defvar outline-heading-alist ()
- "Alist associating a heading for every possible level.
-Each entry is of the form (HEADING . LEVEL).
-This alist is used two ways: to find the heading corresponding to
-a given level and to find the level of a given heading.
-If a mode or document needs several sets of outline headings (for example
-numbered and unnumbered sections), list them set by set and sorted by level
-within each set. For example in texinfo mode:
-
- (setq outline-heading-alist
- '((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4)
- (\"@subsubsection\" . 5)
- (\"@unnumbered\" . 2) (\"@unnumberedsec\" . 3)
- (\"@unnumberedsubsec\" . 4) (\"@unnumberedsubsubsec\" . 5)
- (\"@appendix\" . 2) (\"@appendixsec\" . 3)...
- (\"@appendixsubsec\" . 4) (\"@appendixsubsubsec\" . 5) ..))
-
-Instead of sorting the entries in each set, you can also separate the
-sets with nil.")
-(make-variable-buffer-local 'outline-heading-alist)
-
-;; This used to count columns rather than characters, but that made ^L
-;; appear to be at level 2 instead of 1. Columns would be better for
-;; tab handling, but the default regexp doesn't use tabs, and anyone
-;; who changes the regexp can also redefine the outline-level variable
-;; as appropriate.
-(defun outline-level ()
- "Return the depth to which a statement is nested in the outline.
-Point must be at the beginning of a header line.
-This is actually either the level specified in `outline-heading-alist'
-or else the number of characters matched by `outline-regexp'."
- (or (cdr (assoc (match-string 0) outline-heading-alist))
- (- (match-end 0) (match-beginning 0))))
-
-(defun outline-next-preface ()
- "Skip forward to just before the next heading line.
-If there's no following heading line, stop before the newline
-at the end of the buffer."
- (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
- nil 'move)
- (goto-char (match-beginning 0)))
- (if (and (bolp) (not (bobp)))
- (forward-char -1)))
-
-(defun outline-next-heading ()
- "Move to the next (possibly invisible) heading line."
- (interactive)
- ;; Make sure we don't match the heading we're at.
- (if (and (bolp) (not (eobp))) (forward-char 1))
- (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
- nil 'move)
- (goto-char (match-beginning 0))))
-
-(defun outline-previous-heading ()
- "Move to the previous (possibly invisible) heading line."
- (interactive)
- (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
- nil 'move))
-
-(defsubst outline-invisible-p (&optional pos)
- "Non-nil if the character after point is invisible."
- (get-char-property (or pos (point)) 'invisible))
-
-(defun outline-visible ()
- (not (outline-invisible-p)))
-(make-obsolete 'outline-visible 'outline-invisible-p)
-
-(defun outline-back-to-heading (&optional invisible-ok)
- "Move to previous heading line, or beg of this line if it's a heading.
-Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
- (beginning-of-line)
- (or (outline-on-heading-p invisible-ok)
- (let (found)
- (save-excursion
- (while (not found)
- (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
- nil t)
- (error "before first heading"))
- (setq found (and (or invisible-ok (not (outline-invisible-p)))
- (point)))))
- (goto-char found)
- found)))
-
-(defun outline-on-heading-p (&optional invisible-ok)
- "Return t if point is on a (visible) heading line.
-If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
- (save-excursion
- (beginning-of-line)
- (and (bolp) (or invisible-ok (not (outline-invisible-p)))
- (looking-at outline-regexp))))
-
-(defun outline-insert-heading ()
- "Insert a new heading at same depth at point."
- (interactive)
- (let ((head (save-excursion
- (condition-case nil
- (outline-back-to-heading)
- (error (outline-next-heading)))
- (if (eobp)
- (or (caar outline-heading-alist) "")
- (match-string 0)))))
- (unless (or (string-match "[ \t]\\'" head)
- (not (string-match outline-regexp (concat head " "))))
- (setq head (concat head " ")))
- (unless (bolp) (end-of-line) (newline))
- (insert head)
- (unless (eolp)
- (save-excursion (newline-and-indent)))
- (run-hooks 'outline-insert-heading-hook)))
-
-(defun outline-promote (&optional children)
- "Promote headings higher up the tree.
-If prefix argument CHILDREN is given, promote also all the children.
-If the region is active in `transient-mark-mode', promote all headings
-in the region."
- (interactive
- (list (if (and transient-mark-mode mark-active) 'region
- (outline-back-to-heading)
- (if current-prefix-arg nil 'subtree))))
- (cond
- ((eq children 'region)
- (outline-map-region 'outline-promote (region-beginning) (region-end)))
- (children
- (outline-map-region 'outline-promote
- (point)
- (save-excursion (outline-get-next-sibling) (point))))
- (t
- (outline-back-to-heading t)
- (let* ((head (match-string 0))
- (level (save-match-data (funcall outline-level)))
- (up-head (or (outline-head-from-level (1- level) head)
- (save-excursion
- (save-match-data
- (outline-up-heading 1 t)
- (match-string 0))))))
-
- (unless (rassoc level outline-heading-alist)
- (push (cons head level) outline-heading-alist))
-
- (replace-match up-head nil t)))))
-
-(defun outline-demote (&optional children)
- "Demote headings lower down the tree.
-If prefix argument CHILDREN is given, demote also all the children.
-If the region is active in `transient-mark-mode', demote all headings
-in the region."
- (interactive
- (list (if (and transient-mark-mode mark-active) 'region
- (outline-back-to-heading)
- (if current-prefix-arg nil 'subtree))))
- (cond
- ((eq children 'region)
- (outline-map-region 'outline-demote (region-beginning) (region-end)))
- (children
- (outline-map-region 'outline-demote
- (point)
- (save-excursion (outline-get-next-sibling) (point))))
- (t
- (let* ((head (match-string 0))
- (level (save-match-data (funcall outline-level)))
- (down-head
- (or (outline-head-from-level (1+ level) head)
- (save-excursion
- (save-match-data
- (while (and (progn (outline-next-heading) (not (eobp)))
- (<= (funcall outline-level) level)))
- (when (eobp)
- ;; Try again from the beginning of the buffer.
- (goto-char (point-min))
- (while (and (progn (outline-next-heading) (not (eobp)))
- (<= (funcall outline-level) level))))
- (unless (eobp)
- (looking-at outline-regexp)
- (match-string 0))))
- (save-match-data
- ;; Bummer!! There is no lower heading in the buffer.
- ;; Let's try to invent one by repeating the first char.
- (let ((new-head (concat (substring head 0 1) head)))
- (if (string-match (concat "\\`" outline-regexp) new-head)
- ;; Why bother checking that it is indeed lower level ?
- new-head
- ;; Didn't work: keep it as is so it's still a heading.
- head))))))
-
- (unless (rassoc level outline-heading-alist)
- (push (cons head level) outline-heading-alist))
- (replace-match down-head nil t)))))
-
-(defun outline-head-from-level (level head &optional alist)
- "Get new heading with level LEVEL from ALIST.
-If there are no such entries, return nil.
-ALIST defaults to `outline-heading-alist'.
-Similar to (car (rassoc LEVEL ALIST)).
-If there are several different entries with same new level, choose
-the one with the smallest distance to the assocation of HEAD in the alist.
-This makes it possible for promotion to work in modes with several
-independent sets of headings (numbered, unnumbered, appendix...)"
- (unless alist (setq alist outline-heading-alist))
- (let ((l (rassoc level alist))
- ll h hl l2 l2l)
- (cond
- ((null l) nil)
- ;; If there's no HEAD after L, any other entry for LEVEL after L
- ;; can't be much better than L.
- ((null (setq h (assoc head (setq ll (memq l alist))))) (car l))
- ;; If there's no other entry for LEVEL, just keep L.
- ((null (setq l2 (rassoc level (cdr ll)))) (car l))
- ;; Now we have L, L2, and H: see if L2 seems better than L.
- ;; If H is after L2, L2 is better.
- ((memq h (setq l2l (memq l2 (cdr ll))))
- (outline-head-from-level level head l2l))
- ;; Now we have H between L and L2.
- ;; If there's a separator between L and H, prefer L2.
- ((memq h (memq nil ll))
- (outline-head-from-level level head l2l))
- ;; If there's a separator between L2 and H, prefer L.
- ((memq l2 (memq nil (setq hl (memq h ll)))) (car l))
- ;; No separator between L and L2, check the distance.
- ((< (* 2 (length hl)) (+ (length ll) (length l2l)))
- (outline-head-from-level level head l2l))
- ;; If all else fails, just keep L.
- (t (car l)))))
-
-(defun outline-map-region (fun beg end)
- "Call FUN for every heading between BEG and END.
-When FUN is called, point is at the beginning of the heading and
-the match data is set appropriately."
- (save-excursion
- (setq end (copy-marker end))
- (goto-char beg)
- (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)
- (goto-char (match-beginning 0))
- (funcall fun)
- (while (and (progn
- (outline-next-heading)
- (< (point) end))
- (not (eobp)))
- (funcall fun)))))
-
-;; Vertical tree motion
-
-(defun outline-move-subtree-up (&optional arg)
- "Move the currrent subtree up past ARG headlines of the same level."
- (interactive "p")
- (outline-move-subtree-down (- arg)))
-
-(defun outline-move-subtree-down (&optional arg)
- "Move the currrent subtree down past ARG headlines of the same level."
- (interactive "p")
- (let ((re (concat "^" outline-regexp))
- (movfunc (if (> arg 0) 'outline-get-next-sibling
- 'outline-get-last-sibling))
- (ins-point (make-marker))
- (cnt (abs arg))
- beg end txt folded)
- ;; Select the tree
- (outline-back-to-heading)
- (setq beg (point))
- (save-match-data
- (save-excursion (outline-end-of-heading)
- (setq folded (outline-invisible-p)))
- (outline-end-of-subtree))
- (if (= (char-after) ?\n) (forward-char 1))
- (setq end (point))
- ;; Find insertion point, with error handling
- (goto-char beg)
- (while (> cnt 0)
- (or (funcall movfunc)
- (progn (goto-char beg)
- (error "Cannot move past superior level")))
- (setq cnt (1- cnt)))
- (if (> arg 0)
- ;; Moving forward - still need to move over subtree
- (progn (outline-end-of-subtree)
- (if (= (char-after) ?\n) (forward-char 1))))
- (move-marker ins-point (point))
- (insert (delete-and-extract-region beg end))
- (goto-char ins-point)
- (if folded (hide-subtree))
- (move-marker ins-point nil)))
-
-(defun outline-end-of-heading ()
- (if (re-search-forward outline-heading-end-regexp nil 'move)
- (forward-char -1)))
-
-(defun outline-next-visible-heading (arg)
- "Move to the next visible heading line.
-With argument, repeats or can move backward if negative.
-A heading line is one that starts with a `*' (or that
-`outline-regexp' matches)."
- (interactive "p")
- (if (< arg 0)
- (beginning-of-line)
- (end-of-line))
- (while (and (not (bobp)) (< arg 0))
- (while (and (not (bobp))
- (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
- nil 'move)
- (outline-invisible-p)))
- (setq arg (1+ arg)))
- (while (and (not (eobp)) (> arg 0))
- (while (and (not (eobp))
- (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
- nil 'move)
- (outline-invisible-p (match-beginning 0))))
- (setq arg (1- arg)))
- (beginning-of-line))
-
-(defun outline-previous-visible-heading (arg)
- "Move to the previous heading line.
-With argument, repeats or can move forward if negative.
-A heading line is one that starts with a `*' (or that
-`outline-regexp' matches)."
- (interactive "p")
- (outline-next-visible-heading (- arg)))
-
-(defun outline-mark-subtree ()
- "Mark the current subtree in an outlined document.
-This puts point at the start of the current subtree, and mark at the end."
- (interactive)
- (let ((beg))
- (if (outline-on-heading-p)
- ;; we are already looking at a heading
- (beginning-of-line)
- ;; else go back to previous heading
- (outline-previous-visible-heading 1))
- (setq beg (point))
- (outline-end-of-subtree)
- (push-mark (point))
- (goto-char beg)))
-\f
-
-(put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible)
-(defun outline-flag-region (from to flag)
- "Hide or show lines from FROM to TO, according to FLAG.
-If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
- (remove-overlays from to 'invisible 'outline)
- (when flag
- (let ((o (make-overlay from to)))
- (overlay-put o 'invisible 'outline)
- (overlay-put o 'isearch-open-invisible 'outline-isearch-open-invisible)))
- ;; Seems only used by lazy-lock. I.e. obsolete.
- (run-hooks 'outline-view-change-hook))
-
-(defun outline-reveal-toggle-invisible (o hidep)
- (save-excursion
- (goto-char (overlay-start o))
- (if hidep
- ;; When hiding the area again, we could just clean it up and let
- ;; reveal do the rest, by simply doing:
- ;; (remove-overlays (overlay-start o) (overlay-end o)
- ;; 'invisible 'outline)
- ;;
- ;; That works fine as long as everything is in sync, but if the
- ;; structure of the document is changed while revealing parts of it,
- ;; the resulting behavior can be ugly. I.e. we need to make
- ;; sure that we hide exactly a subtree.
- (progn
- (let ((end (overlay-end o)))
- (delete-overlay o)
- (while (progn
- (hide-subtree)
- (outline-next-visible-heading 1)
- (and (not (eobp)) (< (point) end))))))
-
- ;; When revealing, we just need to reveal sublevels. If point is
- ;; inside one of the sublevels, reveal will call us again.
- ;; But we need to preserve the original overlay.
- (let ((o1 (copy-overlay o)))
- (overlay-put o 'invisible nil) ;Show (most of) the text.
- (while (progn
- (show-entry)
- (show-children)
- ;; Normally just the above is needed.
- ;; But in odd cases, the above might fail to show anything.
- ;; To avoid an infinite loop, we have to make sure that
- ;; *something* gets shown.
- (and (equal (overlay-start o) (overlay-start o1))
- (< (point) (overlay-end o))
- (= 0 (forward-line 1)))))
- ;; If still nothing was shown, just kill the damn thing.
- (when (equal (overlay-start o) (overlay-start o1))
- ;; I've seen it happen at the end of buffer.
- (delete-overlay o1))))))
-
-;; Function to be set as an outline-isearch-open-invisible' property
-;; to the overlay that makes the outline invisible (see
-;; `outline-flag-region').
-(defun outline-isearch-open-invisible (overlay)
- ;; We rely on the fact that isearch places point on the matched text.
- (show-entry))
-\f
-(defun hide-entry ()
- "Hide the body directly following this heading."
- (interactive)
- (outline-back-to-heading)
- (outline-end-of-heading)
- (save-excursion
- (outline-flag-region (point) (progn (outline-next-preface) (point)) t)))
-
-(defun show-entry ()
- "Show the body directly following this heading.
-Show the heading too, if it is currently invisible."
- (interactive)
- (save-excursion
- (outline-back-to-heading t)
- (outline-flag-region (1- (point))
- (progn (outline-next-preface) (point)) nil)))
-
-(defun hide-body ()
- "Hide all of buffer except headings."
- (interactive)
- (hide-region-body (point-min) (point-max)))
-
-(defun hide-region-body (start end)
- "Hide all body lines in the region, but not headings."
- ;; Nullify the hook to avoid repeated calls to `outline-flag-region'
- ;; wasting lots of time running `lazy-lock-fontify-after-outline'
- ;; and run the hook finally.
- (let (outline-view-change-hook)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (if (outline-on-heading-p)
- (outline-end-of-heading))
- (while (not (eobp))
- (outline-flag-region (point)
- (progn (outline-next-preface) (point)) t)
- (unless (eobp)
- (forward-char (if (looking-at "\n\n") 2 1))
- (outline-end-of-heading))))))
- (run-hooks 'outline-view-change-hook))
-
-(defun show-all ()
- "Show all of the text in the buffer."
- (interactive)
- (outline-flag-region (point-min) (point-max) nil))
-
-(defun hide-subtree ()
- "Hide everything after this heading at deeper levels."
- (interactive)
- (outline-flag-subtree t))
-
-(defun hide-leaves ()
- "Hide all body after this heading at deeper levels."
- (interactive)
- (outline-back-to-heading)
- (save-excursion
- (outline-end-of-heading)
- (hide-region-body (point) (progn (outline-end-of-subtree) (point)))))
-
-(defun show-subtree ()
- "Show everything after this heading at deeper levels."
- (interactive)
- (outline-flag-subtree nil))
-
-(defun outline-show-heading ()
- "Show the current heading and move to its end."
- (outline-flag-region (- (point)
- (if (bobp) 0
- (if (eq (char-before (1- (point))) ?\n)
- 2 1)))
- (progn (outline-end-of-heading) (point))
- nil))
-
-(defun hide-sublevels (levels)
- "Hide everything but the top LEVELS levels of headers, in whole buffer."
- (interactive "p")
- (if (< levels 1)
- (error "Must keep at least one level of headers"))
- (let (outline-view-change-hook)
- (save-excursion
- (goto-char (point-min))
- ;; Skip the prelude, if any.
- (unless (outline-on-heading-p t) (outline-next-heading))
- ;; First hide everything.
- (outline-flag-region (point) (point-max) t)
- ;; Then unhide the top level headers.
- (outline-map-region
- (lambda ()
- (if (<= (funcall outline-level) levels)
- (outline-show-heading)))
- (point) (point-max))))
- (run-hooks 'outline-view-change-hook))
-
-(defun hide-other ()
- "Hide everything except current body and parent and top-level headings."
- (interactive)
- (hide-sublevels 1)
- (let (outline-view-change-hook)
- (save-excursion
- (outline-back-to-heading t)
- (show-entry)
- (while (condition-case nil (progn (outline-up-heading 1) (not (bobp)))
- (error nil))
- (outline-flag-region (1- (point))
- (save-excursion (forward-line 1) (point))
- nil))))
- (run-hooks 'outline-view-change-hook))
-
-(defun outline-toggle-children ()
- "Show or hide the current subtree depending on its current state."
- (interactive)
- (outline-back-to-heading)
- (if (not (outline-invisible-p (line-end-position)))
- (hide-subtree)
- (show-children)
- (show-entry)))
-
-(defun outline-flag-subtree (flag)
- (save-excursion
- (outline-back-to-heading)
- (outline-end-of-heading)
- (outline-flag-region (point)
- (progn (outline-end-of-subtree) (point))
- flag)))
-
-(defun outline-end-of-subtree ()
- (outline-back-to-heading)
- (let ((opoint (point))
- (first t)
- (level (funcall outline-level)))
- (while (and (not (eobp))
- (or first (> (funcall outline-level) level)))
- (setq first nil)
- (outline-next-heading))
- (if (bolp)
- (progn
- ;; Go to end of line before heading
- (forward-char -1)
- (if (bolp)
- ;; leave blank line before heading
- (forward-char -1))))))
-\f
-(defun show-branches ()
- "Show all subheadings of this heading, but not their bodies."
- (interactive)
- (show-children 1000))
-
-(defun show-children (&optional level)
- "Show all direct subheadings of this heading.
-Prefix arg LEVEL is how many levels below the current level should be shown.
-Default is enough to cause the following heading to appear."
- (interactive "P")
- (setq level
- (if level (prefix-numeric-value level)
- (save-excursion
- (outline-back-to-heading)
- (let ((start-level (funcall outline-level)))
- (outline-next-heading)
- (if (eobp)
- 1
- (max 1 (- (funcall outline-level) start-level)))))))
- (let (outline-view-change-hook)
- (save-excursion
- (outline-back-to-heading)
- (setq level (+ level (funcall outline-level)))
- (outline-map-region
- (lambda ()
- (if (<= (funcall outline-level) level)
- (outline-show-heading)))
- (point)
- (progn (outline-end-of-subtree)
- (if (eobp) (point-max) (1+ (point)))))))
- (run-hooks 'outline-view-change-hook))
-
-\f
-
-(defun outline-up-heading (arg &optional invisible-ok)
- "Move to the visible heading line of which the present line is a subheading.
-With argument, move up ARG levels.
-If INVISIBLE-OK is non-nil, also consider invisible lines."
- (interactive "p")
- (outline-back-to-heading invisible-ok)
- (let ((start-level (funcall outline-level)))
- (if (eq start-level 1)
- (error "Already at top level of the outline"))
- (while (and (> start-level 1) (> arg 0) (not (bobp)))
- (let ((level start-level))
- (while (not (or (< level start-level) (bobp)))
- (if invisible-ok
- (outline-previous-heading)
- (outline-previous-visible-heading 1))
- (setq level (funcall outline-level)))
- (setq start-level level))
- (setq arg (- arg 1))))
- (looking-at outline-regexp))
-
-(defun outline-forward-same-level (arg)
- "Move forward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading."
- (interactive "p")
- (outline-back-to-heading)
- (while (> arg 0)
- (let ((point-to-move-to (save-excursion
- (outline-get-next-sibling))))
- (if point-to-move-to
- (progn
- (goto-char point-to-move-to)
- (setq arg (1- arg)))
- (progn
- (setq arg 0)
- (error "No following same-level heading"))))))
-
-(defun outline-get-next-sibling ()
- "Move to next heading of the same level, and return point or nil if none."
- (let ((level (funcall outline-level)))
- (outline-next-visible-heading 1)
- (while (and (not (eobp)) (> (funcall outline-level) level))
- (outline-next-visible-heading 1))
- (if (or (eobp) (< (funcall outline-level) level))
- nil
- (point))))
-
-(defun outline-backward-same-level (arg)
- "Move backward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading."
- (interactive "p")
- (outline-back-to-heading)
- (while (> arg 0)
- (let ((point-to-move-to (save-excursion
- (outline-get-last-sibling))))
- (if point-to-move-to
- (progn
- (goto-char point-to-move-to)
- (setq arg (1- arg)))
- (progn
- (setq arg 0)
- (error "No previous same-level heading"))))))
-
-(defun outline-get-last-sibling ()
- "Move to previous heading of the same level, and return point or nil if none."
- (let ((level (funcall outline-level)))
- (outline-previous-visible-heading 1)
- (while (and (> (funcall outline-level) level)
- (not (bobp)))
- (outline-previous-visible-heading 1))
- (if (< (funcall outline-level) level)
- nil
- (point))))
-\f
-(defun outline-headers-as-kill (beg end)
- "Save the visible outline headers in region at the start of the kill ring.
-
-Text shown between the headers isn't copied. Two newlines are
-inserted between saved headers. Yanking the result may be a
-convenient way to make a table of contents of the buffer."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (let ((buffer (current-buffer))
- start end)
- (with-temp-buffer
- (with-current-buffer buffer
- ;; Boundary condition: starting on heading:
- (when (outline-on-heading-p)
- (outline-back-to-heading)
- (setq start (point)
- end (progn (outline-end-of-heading)
- (point)))
- (insert-buffer-substring buffer start end)
- (insert "\n\n")))
- (let ((temp-buffer (current-buffer)))
- (with-current-buffer buffer
- (while (outline-next-heading)
- (unless (outline-invisible-p)
- (setq start (point)
- end (progn (outline-end-of-heading) (point)))
- (with-current-buffer temp-buffer
- (insert-buffer-substring buffer start end)
- (insert "\n\n"))))))
- (kill-new (buffer-string)))))))
-
-(provide 'outline)
-(provide 'noutline)
-
-;;; outline.el ends here
(provide 'delphi)
(defconst delphi-version
- (let ((revision "$Revision: 3.9 $"))
+ (let ((revision "$Revision: 3.8 $"))
(string-match ": \\([^ ]+\\)" revision)
(match-string 1 revision))
"Version of this delphi mode.")
(delphi-step-progress p "Fontifying" delphi-fontifying-progress-step))
(delphi-progress-done)))))
-(defvar delphi-ignore-changes t
+(defconst delphi-ignore-changes t
"Internal flag to control if the delphi-mode responds to buffer changes.
Defaults to t in case the delphi-after-change function is called on a
non-delphi buffer. Set to nil in a delphi buffer. To override, just do:
;; This looks silly, but it's because `sh-here-doc-re' keeps changing.
(re-search-forward sh-here-doc-re limit t))
-(defun sh-is-quoted-p (pos)
- (and (eq (char-before pos) ?\\)
- (not (sh-is-quoted-p (1- pos)))))
-
(defun sh-font-lock-paren (start)
(save-excursion
(goto-char start)
;; Skip through one pattern
(while
(or (/= 0 (skip-syntax-backward "w_"))
- (/= 0 (skip-chars-backward "?*/\\"))
- (and (sh-is-quoted-p (1- (point)))
- (goto-char (- (point) 2)))
+ (/= 0 (skip-chars-backward "?*/"))
(when (memq (char-before) '(?\" ?\'))
(condition-case nil (progn (backward-sexp 1) t)
(error nil)))))
(setcdr elt
(setq val
(eval (if (consp (setq val (cdr val)))
- (let ((sh-shell (car (cdr val))))
+ (let ((sh-shell (car (cdr val)))
+ function)
(if (assq sh-shell list)
(setcar (cdr val)
(list 'quote
what the indentation is based on."
;; See comments before `sh-kw'.
(save-excursion
- (let ((have-result nil)
+ (let ((prev-kw nil)
+ (prev-stmt nil)
+ (have-result nil)
+ depth-bol depth-eol
this-kw
+ (state nil)
+ state-bol
+ (depth-prev-bol nil)
start
- val
+ func val
(result nil)
+ prev-lines-indent
+ (prev-list nil)
+ (this-list nil)
(align-point nil)
prev-line-end x)
(beginning-of-line)
;; Note: setting result to t means we are done and will return nil.
;;(This function never returns just t.)
(cond
- ((or (and (boundp 'font-lock-string-face) (not (bobp))
- (eq (get-text-property (1- (point)) 'face)
- font-lock-string-face))
+ ((or (and (boundp 'font-lock-string-face)
+ (eq (get-text-property (point) 'face) font-lock-string-face))
(eq (get-text-property (point) 'face) sh-heredoc-face))
(setq result t)
(setq have-result t))
;;
(if (bolp)
nil
- (let (c min-point
- (start (point)))
+ (let ((going t)
+ c n
+ min-point
+ (start (point))
+ (found nil))
(save-restriction
(narrow-to-region
(if (sh-this-is-a-continuation)
(sh-must-support-indent)
(let* ((info (sh-get-indent-info))
(var (sh-get-indent-var-for-line info))
- val old-val indent-val)
+ val val0 new-val old-val indent-val)
(if (stringp var)
(message (format "Cannot set indent - %s" var))
(setq old-val (symbol-value var))
(let ((learned-var-list nil)
(out-buffer "*indent*")
(num-diffs 0)
+ last-pos
previous-set-info
(max 17)
vec
(append (list (list 'sh-indent-comment comment-col (point-max)))
learned-var-list))
(setq sh-indent-comment comment-col)
- (let ((name (buffer-name)))
+ (let ((name (buffer-name))
+ (lines (if (and (eq (point-min) 1)
+ (eq (point-max) (1+ (buffer-size))))
+ ""
+ (format "lines %d to %d of "
+ (1+ (count-lines 1 (point-min)))
+ (1+ (count-lines 1 (point-max))))))
+ )
(sh-mark-line "\nLearned variable settings:" nil out-buffer)
(if arg
;; Set learned variables to symbolic rather than numeric
nil - we couldn't find a reasonable one."
(let* ((max (1- (length vec)))
(i 1)
- (totals (make-vector max 0)))
+ (totals (make-vector max 0))
+ (return nil)
+ j)
(while (< i max)
(aset totals i (+ (aref totals i) (* 4 (aref vec i))))
+ (setq j (/ i 2))
(if (zerop (% i 2))
(aset totals i (+ (aref totals i) (aref vec (/ i 2)))))
(if (< (* i 2) max)
+++ /dev/null
-;;; which-func.el --- print current function in mode line
-
-;; Copyright (C) 1994, 1997, 1998, 2001, 2003 Free Software Foundation, Inc.
-
-;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
-;; (doesn't seem to be responsive any more)
-;; Keywords: mode-line, imenu, tools
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package prints name of function where your current point is
-;; located in mode line. It assumes that you work with imenu package
-;; and imenu--index-alist is up to date.
-
-;; KNOWN BUGS
-;; ----------
-;; Really this package shows not "function where the current point is
-;; located now", but "nearest function which defined above the current
-;; point". So if your current point is located after end of function
-;; FOO but before begin of function BAR, FOO will be displayed in mode
-;; line.
-;; - if two windows display the same buffer, both windows
-;; show the same `which-func' information.
-
-;; TODO LIST
-;; ---------
-;; 1. Dependence on imenu package should be removed. Separate
-;; function determination mechanism should be used to determine the end
-;; of a function as well as the beginning of a function.
-;; 2. This package should be realized with the help of overlay
-;; properties instead of imenu--index-alist variable.
-
-;;; History:
-
-;; THANKS TO
-;; ---------
-;; Per Abrahamsen <abraham@iesd.auc.dk>
-;; Some ideas (inserting in mode-line, using of post-command hook
-;; and toggling this mode) have been borrowed from his package
-;; column.el
-;; Peter Eisenhauer <pipe@fzi.de>
-;; Bug fixing in case nested indexes.
-;; Terry Tateyama <ttt@ursa0.cs.utah.edu>
-;; Suggestion to use find-file-hook for first imenu
-;; index building.
-
-;;; Code:
-
-;; Variables for customization
-;; ---------------------------
-;;
-(defvar which-func-unknown "???"
- "String to display in the mode line when current function is unknown.")
-
-(defgroup which-func nil
- "Mode to display the current function name in the modeline."
- :group 'tools
- :version "20.3")
-
-(defcustom which-func-modes
- '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode makefile-mode
- sh-mode fortran-mode f90-mode)
- "List of major modes for which Which Function mode should be used.
-For other modes it is disabled. If this is equal to t,
-then Which Function mode is enabled in any major mode that supports it."
- :group 'which-func
- :type '(choice (const :tag "All modes" t)
- (repeat (symbol :tag "Major mode"))))
-
-(defcustom which-func-non-auto-modes nil
- "List of major modes where Which Function mode is inactive till Imenu is used.
-This means that Which Function mode won't really do anything
-until you use Imenu, in these modes. Note that files
-larger than `which-func-maxout' behave in this way too;
-Which Function mode doesn't do anything until you use Imenu."
- :group 'which-func
- :type '(repeat (symbol :tag "Major mode")))
-
-(defcustom which-func-maxout 500000
- "Don't automatically compute the Imenu menu if buffer is this big or bigger.
-Zero means compute the Imenu menu regardless of size."
- :group 'which-func
- :type 'integer)
-
-(defcustom which-func-format '("[" which-func-current "]")
- "Format for displaying the function in the mode line."
- :group 'which-func
- :type 'sexp)
-;;;###autoload (put 'which-func-format 'risky-local-variable t)
-
-(defvar which-func-cleanup-function nil
- "Function to transform a string before displaying it in the mode line.
-The function is called with one argument, the string to display.
-Its return value is displayed in the modeline.
-If nil, no function is called. The default value is nil.
-
-This feature can be useful if Imenu is set up to make more
-detailed entries (e.g., containing the argument list of a function),
-and you want to simplify them for the mode line
-\(e.g., removing the parameter list to just have the function name.)")
-
-;;; Code, nothing to customize below here
-;;; -------------------------------------
-;;;
-(require 'imenu)
-
-(defvar which-func-table (make-hash-table :test 'eq :weakness 'key))
-
-(defconst which-func-current
- '(:eval (gethash (selected-window) which-func-table which-func-unknown)))
-;;;###autoload (put 'which-func-current 'risky-local-variable t)
-
-(defvar which-func-mode nil
- "Non-nil means display current function name in mode line.
-This makes a difference only if `which-function-mode' is non-nil.")
-(make-variable-buffer-local 'which-func-mode)
-;;(put 'which-func-mode 'permanent-local t)
-
-(add-hook 'find-file-hook 'which-func-ff-hook t)
-
-(defun which-func-ff-hook ()
- "File find hook for Which Function mode.
-It creates the Imenu index for the buffer, if necessary."
- (setq which-func-mode
- (and which-function-mode
- (or (eq which-func-modes t)
- (member major-mode which-func-modes))))
-
- (condition-case nil
- (if (and which-func-mode
- (not (member major-mode which-func-non-auto-modes))
- (or (null which-func-maxout)
- (< buffer-saved-size which-func-maxout)
- (= which-func-maxout 0)))
- (setq imenu--index-alist
- (save-excursion (funcall imenu-create-index-function))))
- (error
- (setq which-func-mode nil))))
-
-(defun which-func-update ()
- ;; "Update the Which-Function mode display for all windows."
- ;; (walk-windows 'which-func-update-1 nil 'visible))
- (which-func-update-1 (selected-window)))
-
-(defun which-func-update-1 (window)
- "Update the Which-Function mode display for window WINDOW."
- (with-selected-window window
- (when which-func-mode
- (condition-case info
- (let ((current (which-function)))
- (unless (equal current (gethash window which-func-table))
- (puthash window current which-func-table)
- (force-mode-line-update)))
- (error
- (which-func-mode -1)
- (error "Error in which-func-update: %s" info))))))
-
-;;;###autoload
-(defalias 'which-func-mode 'which-function-mode)
-
-(defvar which-func-update-timer nil)
-
-;; This is the name people would normally expect.
-;;;###autoload
-(define-minor-mode which-function-mode
- "Toggle Which Function mode, globally.
-When Which Function mode is enabled, the current function name is
-continuously displayed in the mode line, in certain major modes.
-
-With prefix ARG, turn Which Function mode on iff arg is positive,
-and off otherwise."
- :global t :group 'which-func
- (if which-function-mode
- ;;Turn it on
- (progn
- (setq which-func-update-timer
- (run-with-idle-timer idle-update-delay t 'which-func-update))
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (setq which-func-mode
- (or (eq which-func-modes t)
- (member major-mode which-func-modes))))))
- ;; Turn it off
- (cancel-timer which-func-update-timer)
- (setq which-func-update-timer nil)
- (dolist (buf (buffer-list))
- (with-current-buffer buf (setq which-func-mode nil)))))
-
-(defvar which-function-imenu-failed nil
- "Locally t in a buffer if `imenu--make-index-alist' found nothing there.")
-
-(defun which-function ()
- "Return current function name based on point.
-Uses `imenu--index-alist' or `add-log-current-defun-function'.
-If no function name is found, return nil."
- (let (name)
- ;; If Imenu is loaded, try to make an index alist with it.
- (when (and (boundp 'imenu--index-alist) (null imenu--index-alist)
- (null which-function-imenu-failed))
- (imenu--make-index-alist)
- (unless imenu--index-alist
- (make-local-variable 'which-function-imenu-failed)
- (setq which-function-imenu-failed t)))
- ;; If we have an index alist, use it.
- (when (and (boundp 'imenu--index-alist) imenu--index-alist)
- (let ((alist imenu--index-alist)
- (minoffset (point-max))
- offset elem pair mark)
- (while alist
- (setq elem (car-safe alist)
- alist (cdr-safe alist))
- ;; Elements of alist are either ("name" . marker), or
- ;; ("submenu" ("name" . marker) ... ).
- (unless (listp (cdr elem))
- (setq elem (list elem)))
- (while elem
- (setq pair (car elem)
- elem (cdr elem))
- (and (consp pair)
- (number-or-marker-p (setq mark (cdr pair)))
- (if (>= (setq offset (- (point) mark)) 0)
- (if (< offset minoffset) ; find the closest item
- (setq minoffset offset
- name (car pair)))
- ;; Entries in order, so can skip all those after point.
- (setq elem nil)))))))
- ;; Try using add-log support.
- (when (and (null name) (boundp 'add-log-current-defun-function)
- add-log-current-defun-function)
- (setq name (funcall add-log-current-defun-function)))
- ;; Filter the name if requested.
- (when name
- (if which-func-cleanup-function
- (funcall which-func-cleanup-function name)
- name))))
-
-(provide 'which-func)
-
-;;; which-func.el ends here
--- /dev/null
+;;; regi.el --- REGular expression Interpreting engine
+
+;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
+;; Maintainer: bwarsaw@cen.com
+;; Created: 24-Feb-1993
+;; Version: 1.8
+;; Last Modified: 1993/06/01 21:33:00
+;; Keywords: extensions, matching
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+\f
+(defun regi-pos (&optional position col-p)
+ "Return the character position at various buffer positions.
+Optional POSITION can be one of the following symbols:
+
+`bol' == beginning of line
+`boi' == beginning of indentation
+`eol' == end of line [default]
+`bonl' == beginning of next line
+`bopl' == beginning of previous line
+
+Optional COL-P non-nil returns `current-column' instead of character position."
+ (save-excursion
+ (cond
+ ((eq position 'bol) (beginning-of-line))
+ ((eq position 'boi) (back-to-indentation))
+ ((eq position 'bonl) (forward-line 1))
+ ((eq position 'bopl) (forward-line -1))
+ (t (end-of-line)))
+ (if col-p (current-column) (point))))
+
+(defun regi-mapcar (predlist func &optional negate-p case-fold-search-p)
+ "Build a regi frame where each element of PREDLIST appears exactly once.
+The frame contains elements where each member of PREDLIST is
+associated with FUNC, and optionally NEGATE-P and CASE-FOLD-SEARCH-P."
+ (let (frame tail)
+ (if (or negate-p case-fold-search-p)
+ (setq tail (list negate-p)))
+ (if case-fold-search-p
+ (setq tail (append tail (list case-fold-search-p))))
+ (while predlist
+ (let ((element (list (car predlist) func)))
+ (if tail
+ (setq element (append element tail)))
+ (setq frame (append frame (list element))
+ predlist (cdr predlist))
+ ))
+ frame))
+
+\f
+(defun regi-interpret (frame &optional start end)
+ "Interpret the regi frame FRAME.
+If optional START and END are supplied, they indicate the region of
+interest, and the buffer is narrowed to the beginning of the line
+containing START, and beginning of the line after the line containing
+END. Otherwise, point and mark are not set and processing continues
+until your FUNC returns the `abort' symbol (see below). Beware! Not
+supplying a START or END could put you in an infinite loop.
+
+A regi frame is a list of entries of the form:
+
+ (PRED FUNC [NEGATE-P [CASE-FOLD-SEARCH]])
+
+PRED is a predicate against which each line in the region is tested,
+and if a match occurs, FUNC is `eval'd. Point is then moved to the
+beginning of the next line, the frame is reset and checking continues.
+If a match doesn't occur, the next entry is checked against the
+current line until all entries in the frame are checked. At this
+point, if no match occurred, the frame is reset and point is moved to
+the next line. Checking continues until every line in the region is
+checked. Optional NEGATE-P inverts the result of PRED before FUNC is
+called and `case-fold-search' is bound to the optional value of
+CASE-FOLD-SEARCH for the PRED check.
+
+PRED can be a string, variable, function or one of the following
+symbols: t, nil, `begin', `end', and `every'. If PRED is a string, or
+a variable or list that evaluates to a string, it is interpreted as a
+regular expression and is matched against the current line (from the
+beginning) using `looking-at'. If PRED does not evaluate to a string,
+it is interpreted as a binary value (nil or non-nil).
+
+PRED can also be one of the following symbols:
+
+t -- always produces a true outcome
+`begin' -- always executes before anything else
+`end' -- always executes after everything else
+`every' -- execute after frame is matched on a line
+
+Note that NEGATE-P and CASE-FOLD-SEARCH are meaningless if PRED is one
+of these special symbols. Only the first occurrence of each symbol in
+a frame entry is used, the rest are ignored.
+
+Your FUNC can return values which control regi processing. If a list
+is returned from your function, it can contain any combination of the
+following elements:
+
+the symbol `continue'
+ Tells regi to continue processing frame-entries after a match,
+ instead of resetting to the first entry and advancing to the next
+ line, as is the default behavior. When returning this symbol,
+ you must take care not to enter an infinite loop.
+
+the symbol `abort'
+ Tells regi to terminate processing this frame. any end
+ frame-entry is still processed.
+
+the list `(frame . NEWFRAME)'
+ Tells regi to use NEWFRAME as its current frame. In other words,
+ your FUNC can modify the executing regi frame on the fly.
+
+the list `(step . STEP)'
+ Tells regi to move STEP number of lines forward during normal
+ processing. By default, regi moves forward 1 line. STEP can be
+ negative, but be careful of infinite loops.
+
+You should usually take care to explicitly return nil from your
+function if no action is to take place. Your FUNC will always be
+`eval'ed. The following variables will be temporarily bound to some
+useful information:
+
+`curline'
+ the current line in the buffer, as a string
+
+`curframe'
+ the full, current frame being executed
+
+`curentry'
+ the current frame entry being executed."
+
+ (save-excursion
+ (save-restriction
+ (let (begin-tag end-tag every-tag current-frame working-frame donep)
+
+ ;; set up the narrowed region
+ (and start
+ end
+ (let* ((tstart start)
+ (start (min start end))
+ (end (max start end)))
+ (narrow-to-region
+ (progn (goto-char end) (regi-pos 'bonl))
+ (progn (goto-char start) (regi-pos 'bol)))))
+
+ ;; lets find the special tags and remove them from the working
+ ;; frame. note that only the last special tag is used.
+ (mapcar
+ (function
+ (lambda (entry)
+ (let ((pred (car entry))
+ (func (car (cdr entry))))
+ (cond
+ ((eq pred 'begin) (setq begin-tag func))
+ ((eq pred 'end) (setq end-tag func))
+ ((eq pred 'every) (setq every-tag func))
+ (t
+ (setq working-frame (append working-frame (list entry))))
+ ) ; end-cond
+ )))
+ frame) ; end-mapcar
+
+ ;; execute the begin entry
+ (eval begin-tag)
+
+ ;; now process the frame
+ (setq current-frame working-frame)
+ (while (not (or donep (eobp)))
+ (let* ((entry (car current-frame))
+ (pred (nth 0 entry))
+ (func (nth 1 entry))
+ (negate-p (nth 2 entry))
+ (case-fold-search (nth 3 entry))
+ match-p)
+ (catch 'regi-throw-top
+ (cond
+ ;; we are finished processing the frame for this line
+ ((not current-frame)
+ (setq current-frame working-frame) ;reset frame
+ (forward-line 1)
+ (throw 'regi-throw-top t))
+ ;; see if predicate evaluates to a string
+ ((stringp (setq match-p (eval pred)))
+ (setq match-p (looking-at match-p)))
+ ) ; end-cond
+
+ ;; now that we've done the initial matching, check for
+ ;; negation of match
+ (and negate-p
+ (setq match-p (not match-p)))
+
+ ;; if the line matched, package up the argument list and
+ ;; funcall the FUNC
+ (if match-p
+ (let* ((curline (buffer-substring
+ (regi-pos 'bol)
+ (regi-pos 'eol)))
+ (curframe current-frame)
+ (curentry entry)
+ (result (eval func))
+ (step (or (cdr (assq 'step result)) 1))
+ )
+ ;; changing frame on the fly?
+ (if (assq 'frame result)
+ (setq working-frame (cdr (assq 'frame result))))
+
+ ;; continue processing current frame?
+ (if (memq 'continue result)
+ (setq current-frame (cdr current-frame))
+ (forward-line step)
+ (setq current-frame working-frame))
+
+ ;; abort current frame?
+ (if (memq 'abort result)
+ (progn
+ (setq donep t)
+ (throw 'regi-throw-top t)))
+ ) ; end-let
+
+ ;; else if no match occurred, then process the next
+ ;; frame-entry on the current line
+ (setq current-frame (cdr current-frame))
+
+ ) ; end-if match-p
+ ) ; end catch
+ ) ; end let
+
+ ;; after every cycle, evaluate every-tag
+ (eval every-tag)
+ ) ; end-while
+
+ ;; now process the end entry
+ (eval end-tag)))))
+
+\f
+(provide 'regi)
+
+;;; regi.el ends here
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
;; Created: 24 Mar 2001
-;; Version: 1.6
+;; Version: 1.5
;; Keywords: convenience
;; This file is part of GNU Emacs.
;; You can use the mouse to change the `fill-column' `comment-column',
;; `goal-column', `window-margins' and `tab-stop-list' settings:
;;
-;; [header-line (shift down-mouse-1)] set left margin end to the ruler
+;; [header-line (shift down-mouse-1)] set left margin to the ruler
;; graduation where the mouse pointer is on.
;;
-;; [header-line (shift down-mouse-3)] set right margin beginning to
-;; the ruler graduation where the mouse pointer is on.
+;; [header-line (shift down-mouse-3)] set right margin to the ruler
+;; graduation where the mouse pointer is on.
;;
-;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
-;; or `goal-column' to a ruler graduation.
+;; [header-line down-mouse-2] set `fill-column', `comment-column' or
+;; `goal-column' to the ruler graduation with the mouse dragging.
;;
;; [header-line (control down-mouse-1)] add a tab stop to the ruler
;; graduation where the mouse pointer is on.
;; the `current-column' location, `ruler-mode-fill-column-char' shows
;; the `fill-column' location, `ruler-mode-comment-column-char' shows
;; the `comment-column' location, `ruler-mode-goal-column-char' shows
-;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
-;; locations. Graduations in `window-margins' and `window-fringes'
-;; areas are shown with a different foreground color.
+;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab
+;; stop locations. `window-margins' areas are shown with a different
+;; background color.
;;
;; It is also possible to customize the following characters:
;;
+;; - `ruler-mode-margins-char' character used to pad margin areas
+;; (space by default).
;; - `ruler-mode-basic-graduation-char' character used for basic
;; graduations ('.' by default).
;; - `ruler-mode-inter-graduation-char' character used for
;; `current-column' character.
;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop
;; characters.
-;; - `ruler-mode-margins-face' the face used to highlight graduations
-;; in the `window-margins' areas.
-;; - `ruler-mode-fringes-face' the face used to highlight graduations
-;; in the `window-fringes' areas.
+;; - `ruler-mode-margins-face' the face used to highlight the
+;; `window-margins' areas.
;; - `ruler-mode-column-number-face' the face used to highlight the
-;; numbered graduations.
+;; number graduations.
;;
;; `ruler-mode-default-face' inherits from the built-in `default' face.
-;; All `ruler-mode' faces inherit from `ruler-mode-default-face'.
+;; All `ruler-mode' faces inerit from `ruler-mode-default-face'.
;;
;; WARNING: To keep ruler graduations aligned on text columns it is
;; important to use the same font family and size for ruler and text
(integer :tag "Integer char value"
:validate ruler-mode-character-validate)))
+(defcustom ruler-mode-margins-char ?\s
+ "*Character used in margin areas."
+ :group 'ruler-mode
+ :type '(choice
+ (character :tag "Character")
+ (integer :tag "Integer char value"
+ :validate ruler-mode-character-validate)))
+
(defcustom ruler-mode-basic-graduation-char ?\.
"*Character used for basic graduations."
:group 'ruler-mode
"Default face used by the ruler."
:group 'ruler-mode)
-(defface ruler-mode-pad-face
- '((((type tty))
- (:inherit ruler-mode-default-face
- :background "grey50"
- ))
- (t
- (:inherit ruler-mode-default-face
- :background "grey64"
- )))
- "Face used to pad inactive ruler areas."
- :group 'ruler-mode)
-
-(defface ruler-mode-margins-face
- '((t
- (:inherit ruler-mode-default-face
- :foreground "white"
- )))
- "Face used to highlight margin areas."
- :group 'ruler-mode)
-
-(defface ruler-mode-fringes-face
- '((t
- (:inherit ruler-mode-default-face
- :foreground "green"
- )))
- "Face used to highlight fringes areas."
- :group 'ruler-mode)
-
(defface ruler-mode-column-number-face
'((t
(:inherit ruler-mode-default-face
"Face used to highlight tab stop characters."
:group 'ruler-mode)
+(defface ruler-mode-margins-face
+ '((((type tty))
+ (:inherit ruler-mode-default-face
+ :background "grey50"
+ ))
+ (t
+ (:inherit ruler-mode-default-face
+ :background "grey64"
+ )))
+ "Face used to highlight the `window-margins' areas."
+ :group 'ruler-mode)
+
(defface ruler-mode-current-column-face
'((t
(:inherit ruler-mode-default-face
"Face used to highlight the `current-column' character."
:group 'ruler-mode)
\f
-(defmacro ruler-mode-left-fringe-cols ()
- "Return the width, measured in columns, of the left fringe area."
- '(ceiling (or (car (window-fringes)) 0)
- (frame-char-width)))
-
-(defmacro ruler-mode-right-fringe-cols ()
- "Return the width, measured in columns, of the right fringe area."
- '(ceiling (or (nth 1 (window-fringes)) 0)
- (frame-char-width)))
-
-(defun ruler-mode-left-scroll-bar-cols ()
- "Return the width, measured in columns, of the right vertical scrollbar."
- (let* ((wsb (window-scroll-bars))
- (vtype (nth 2 wsb))
- (cols (nth 1 wsb)))
- (if (or (eq vtype 'left)
- (and (eq vtype t)
- (eq (frame-parameter nil 'vertical-scroll-bars) 'left)))
- (or cols
- (ceiling
- ;; nil means it's a non-toolkit scroll bar,
- ;; and its width in columns is 14 pixels rounded up.
- (or (frame-parameter nil 'scroll-bar-width) 14)
- ;; Always round up to multiple of columns.
- (frame-char-width)))
- 0)))
-
-(defun ruler-mode-right-scroll-bar-cols ()
- "Return the width, measured in columns, of the right vertical scrollbar."
- (let* ((wsb (window-scroll-bars))
- (vtype (nth 2 wsb))
- (cols (nth 1 wsb)))
- (if (or (eq vtype 'right)
- (and (eq vtype t)
- (eq (frame-parameter nil 'vertical-scroll-bars) 'right)))
- (or cols
- (ceiling
- ;; nil means it's a non-toolkit scroll bar,
- ;; and its width in columns is 14 pixels rounded up.
- (or (frame-parameter nil 'scroll-bar-width) 14)
- ;; Always round up to multiple of columns.
- (frame-char-width)))
- 0)))
-
-(defsubst ruler-mode-full-window-width ()
- "Return the full width of the selected window."
- (let ((edges (window-edges)))
- (- (nth 2 edges) (nth 0 edges))))
-
-(defsubst ruler-mode-window-col (n)
- "Return a column number relative to the selected window.
-N is a column number relative to selected frame."
- (- n
- (car (window-edges))
- (or (car (window-margins)) 0)
- (ruler-mode-left-fringe-cols)
- (ruler-mode-left-scroll-bar-cols)))
-\f
(defun ruler-mode-mouse-set-left-margin (start-event)
- "Set left margin end to the graduation where the mouse pointer is on.
+ "Set left margin to the graduation where the mouse pointer is on.
START-EVENT is the mouse click event."
(interactive "e")
(let* ((start (event-start start-event))
(end (event-end start-event))
- col w lm rm)
- (when (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq col (- (car (posn-col-row start)) (car (window-edges))
- (ruler-mode-left-scroll-bar-cols))
- w (- (ruler-mode-full-window-width)
- (ruler-mode-left-scroll-bar-cols)
- (ruler-mode-right-scroll-bar-cols)))
- (when (and (>= col 0) (< col w))
- (setq lm (window-margins)
- rm (or (cdr lm) 0)
- lm (or (car lm) 0))
- (message "Left margin set to %d (was %d)" col lm)
- (set-window-margins nil col rm))))))
+ w col m lm0 lm rm)
+ (if (eq start end) ;; mouse click
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq m (window-margins)
+ lm0 (or (car m) 0)
+ rm (or (cdr m) 0)
+ w (window-width)
+ col (car (posn-col-row start))
+ lm (min (- w rm) col))
+ (message "Left margin set to %d (was %d)" lm lm0)
+ (set-window-margins nil lm rm)))))
(defun ruler-mode-mouse-set-right-margin (start-event)
- "Set right margin beginning to the graduation where the mouse pointer is on.
+ "Set right margin to the graduation where the mouse pointer is on.
START-EVENT is the mouse click event."
(interactive "e")
(let* ((start (event-start start-event))
(end (event-end start-event))
- col w lm rm)
- (when (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq col (- (car (posn-col-row start)) (car (window-edges))
- (ruler-mode-left-scroll-bar-cols))
- w (- (ruler-mode-full-window-width)
- (ruler-mode-left-scroll-bar-cols)
- (ruler-mode-right-scroll-bar-cols)))
- (when (and (>= col 0) (< col w))
- (setq lm (window-margins)
- rm (or (cdr lm) 0)
- lm (or (car lm) 0)
- col (- w col 1))
- (message "Right margin set to %d (was %d)" col rm)
- (set-window-margins nil lm col))))))
-
-(defvar ruler-mode-dragged-symbol nil
+ m col w lm rm0 rm)
+ (if (eq start end) ;; mouse click
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq m (window-margins)
+ rm0 (or (cdr m) 0)
+ lm (or (car m) 0)
+ col (car (posn-col-row start))
+ w (window-width)
+ rm (max 0 (- w col)))
+ (message "Right margin set to %d (was %d)" rm rm0)
+ (set-window-margins nil lm rm)))))
+
+(defvar ruler-mode-mouse-current-grab-object nil
"Column symbol dragged in the ruler.
That is `fill-column', `comment-column', `goal-column', or nil when
nothing is dragged.")
(defun ruler-mode-mouse-grab-any-column (start-event)
- "Drag a column symbol on the ruler.
-Start dragging on mouse down event START-EVENT, and update the column
-symbol value with the current value of the ruler graduation while
-dragging. See also the variable `ruler-mode-dragged-symbol'."
+ "Set a column symbol to the graduation with mouse dragging.
+See also variable `ruler-mode-mouse-current-grab-object'.
+START-EVENT is the mouse down event."
(interactive "e")
- (setq ruler-mode-dragged-symbol nil)
+ (setq ruler-mode-mouse-current-grab-object nil)
(let* ((start (event-start start-event))
- col newc oldc)
+ m col w lm rm hs newc oldc)
(save-selected-window
(select-window (posn-window start))
- (setq col (ruler-mode-window-col (car (posn-col-row start)))
- newc (+ col (window-hscroll)))
- (and
- (>= col 0) (< col (window-width))
- (cond
-
- ;; Handle the fill column.
- ((eq newc fill-column)
- (setq oldc fill-column
- ruler-mode-dragged-symbol 'fill-column)
- t) ;; Start dragging
-
- ;; Handle the comment column.
- ((eq newc comment-column)
- (setq oldc comment-column
- ruler-mode-dragged-symbol 'comment-column)
- t) ;; Start dragging
-
- ;; Handle the goal column.
- ;; A. On mouse down on the goal column character on the ruler,
- ;; update the `goal-column' value while dragging.
- ;; B. If `goal-column' is nil, set the goal column where the
- ;; mouse is clicked.
- ;; C. On mouse click on the goal column character on the
- ;; ruler, unset the goal column.
- ((eq newc goal-column) ; A. Drag the goal column.
- (setq oldc goal-column
- ruler-mode-dragged-symbol 'goal-column)
- t) ;; Start dragging
-
- ((null goal-column) ; B. Set the goal column.
- (setq oldc goal-column
- goal-column newc)
- ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This
- ;; `ding' flushes the next messages about setting goal
- ;; column. So here I force fetch the event(mouse-2) and
- ;; throw away.
- (read-event)
- ;; Ding BEFORE `message' is OK.
- (when ruler-mode-set-goal-column-ding-flag
- (ding))
- (message "Goal column set to %d (click on %s again to unset it)"
- newc
- (propertize (char-to-string ruler-mode-goal-column-char)
- 'face 'ruler-mode-goal-column-face))
- nil) ;; Don't start dragging.
- )
- (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
- (posn-window start)))
- (when (eq 'goal-column ruler-mode-dragged-symbol)
- ;; C. Unset the goal column.
- (set-goal-column t))
- ;; At end of dragging, report the updated column symbol.
- (message "%s is set to %d (was %d)"
- ruler-mode-dragged-symbol
- (symbol-value ruler-mode-dragged-symbol)
- oldc))))))
+ (setq m (window-margins)
+ lm (or (car m) 0)
+ rm (or (cdr m) 0)
+ col (- (car (posn-col-row start)) lm)
+ w (window-width)
+ hs (window-hscroll)
+ newc (+ col hs))
+ ;;
+ ;; About the ways to handle the goal column:
+ ;; A. update the value of the goal column if goal-column has
+ ;; non-nil value and if the mouse is dragged
+ ;; B. set value to the goal column if goal-column has nil and if
+ ;; the mouse is just clicked, not dragged.
+ ;; C. unset value to the goal column if goal-column has non-nil
+ ;; and mouse is just clicked on goal-column character on the
+ ;; ruler, not dragged.
+ ;;
+ (and (>= col 0) (< (+ col lm rm) w)
+ (cond
+ ((eq newc fill-column)
+ (setq oldc fill-column)
+ (setq ruler-mode-mouse-current-grab-object 'fill-column)
+ t)
+ ((eq newc comment-column)
+ (setq oldc comment-column)
+ (setq ruler-mode-mouse-current-grab-object 'comment-column)
+ t)
+ ((eq newc goal-column) ; A. update goal column
+ (setq oldc goal-column)
+ (setq ruler-mode-mouse-current-grab-object 'goal-column)
+ t)
+ ((null goal-column) ; B. set goal column
+ (setq oldc goal-column)
+ (setq goal-column newc)
+ ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'.
+ ;; This `ding' flushes the next messages about setting
+ ;; goal column. So here I force fetch the event(mouse-2)
+ ;; and throw away.
+ (read-event)
+ ;; Ding BEFORE `message' is OK.
+ (if ruler-mode-set-goal-column-ding-flag
+ (ding))
+ (message
+ "Goal column %d (click `%s' on the ruler again to unset it)"
+ newc
+ (propertize (char-to-string ruler-mode-goal-column-char)
+ 'face 'ruler-mode-goal-column-face))
+ ;; don't enter drag iteration
+ nil))
+ (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
+ (posn-window start)))
+ (if (eq 'goal-column ruler-mode-mouse-current-grab-object)
+ ;; C. unset goal column
+ (set-goal-column t))
+ ;; *-column is updated; report it
+ (message "%s is set to %d (was %d)"
+ ruler-mode-mouse-current-grab-object
+ (eval ruler-mode-mouse-current-grab-object)
+ oldc))))))
(defun ruler-mode-mouse-drag-any-column-iteration (window)
"Update the ruler while dragging the mouse.
-WINDOW is the window where occurred the last down-mouse event.
-Return the symbol `drag' if the mouse has been dragged, or `click' if
-the mouse has been clicked."
- (let ((drags 0)
- event)
+WINDOW is the window where the last down-mouse event is occurred.
+Return a symbol `drag' if the mouse is actually dragged.
+Return a symbol `click' if the mouse is just clicked."
+ (let (newevent
+ (drag-count 0))
(track-mouse
- (while (mouse-movement-p (setq event (read-event)))
- (setq drags (1+ drags))
- (when (eq window (posn-window (event-end event)))
- (ruler-mode-mouse-drag-any-column event)
- (force-mode-line-update))))
- (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
+ (while (progn
+ (setq newevent (read-event))
+ (mouse-movement-p newevent))
+ (setq drag-count (1+ drag-count))
+ (if (eq window (posn-window (event-end newevent)))
+ (progn
+ (ruler-mode-mouse-drag-any-column newevent)
+ (force-mode-line-update)))))
+ (if (and (eq drag-count 0)
+ (eq 'click (car (event-modifiers newevent))))
'click
'drag)))
(defun ruler-mode-mouse-drag-any-column (start-event)
- "Update the value of the symbol dragged on the ruler.
-Called on each mouse motion event START-EVENT."
+ "Update the ruler for START-EVENT, one mouse motion event."
(let* ((start (event-start start-event))
(end (event-end start-event))
- col newc)
+ m col w lm rm hs newc)
(save-selected-window
(select-window (posn-window start))
- (setq col (ruler-mode-window-col (car (posn-col-row end)))
- newc (+ col (window-hscroll)))
- (when (and (>= col 0) (< col (window-width)))
- (set ruler-mode-dragged-symbol newc)))))
+ (setq m (window-margins)
+ lm (or (car m) 0)
+ rm (or (cdr m) 0)
+ col (- (car (posn-col-row end)) lm)
+ w (window-width)
+ hs (window-hscroll)
+ newc (+ col hs))
+ (if (and (>= col 0) (< (+ col lm rm) w))
+ (set ruler-mode-mouse-current-grab-object newc)))))
\f
(defun ruler-mode-mouse-add-tab-stop (start-event)
"Add a tab stop to the graduation where the mouse pointer is on.
START-EVENT is the mouse click event."
(interactive "e")
- (when ruler-mode-show-tab-stops
- (let* ((start (event-start start-event))
- (end (event-end start-event))
- col ts)
- (when (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq col (ruler-mode-window-col (car (posn-col-row start)))
- ts (+ col (window-hscroll)))
- (and (>= col 0) (< col (window-width))
- (not (member ts tab-stop-list))
- (progn
- (message "Tab stop set to %d" ts)
- (setq tab-stop-list (sort (cons ts tab-stop-list)
- #'<)))))))))
+ (if ruler-mode-show-tab-stops
+ (let* ((start (event-start start-event))
+ (end (event-end start-event))
+ m col w lm rm hs ts)
+ (if (eq start end) ;; mouse click
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq m (window-margins)
+ lm (or (car m) 0)
+ rm (or (cdr m) 0)
+ col (- (car (posn-col-row start)) lm)
+ w (window-width)
+ hs (window-hscroll)
+ ts (+ col hs))
+ (and (>= col 0) (< (+ col lm rm) w)
+ (not (member ts tab-stop-list))
+ (progn
+ (message "Tab stop set to %d" ts)
+ (setq tab-stop-list
+ (sort (cons ts tab-stop-list)
+ #'<)))))))))
(defun ruler-mode-mouse-del-tab-stop (start-event)
"Delete tab stop at the graduation where the mouse pointer is on.
START-EVENT is the mouse click event."
(interactive "e")
- (when ruler-mode-show-tab-stops
- (let* ((start (event-start start-event))
- (end (event-end start-event))
- col ts)
- (when (eq start end) ;; mouse click
- (save-selected-window
- (select-window (posn-window start))
- (setq col (ruler-mode-window-col (car (posn-col-row start)))
- ts (+ col (window-hscroll)))
- (and (>= col 0) (< col (window-width))
- (member ts tab-stop-list)
- (progn
- (message "Tab stop at %d deleted" ts)
- (setq tab-stop-list (delete ts tab-stop-list)))))))))
+ (if ruler-mode-show-tab-stops
+ (let* ((start (event-start start-event))
+ (end (event-end start-event))
+ m col w lm rm hs ts)
+ (if (eq start end) ;; mouse click
+ (save-selected-window
+ (select-window (posn-window start))
+ (setq m (window-margins)
+ lm (or (car m) 0)
+ rm (or (cdr m) 0)
+ col (- (car (posn-col-row start)) lm)
+ w (window-width)
+ hs (window-hscroll)
+ ts (+ col hs))
+ (and (>= col 0) (< (+ col lm rm) w)
+ (member ts tab-stop-list)
+ (progn
+ (message "Tab stop at %d deleted" ts)
+ (setq tab-stop-list
+ (delete ts tab-stop-list)))))))))
(defun ruler-mode-toggle-show-tab-stops ()
"Toggle showing of tab stops on the ruler."
;; the current one is the ruler header line format.
(when (eq header-line-format ruler-mode-header-line-format)
(kill-local-variable 'header-line-format)
- (when (local-variable-p 'ruler-mode-header-line-format-old)
+ (when ruler-mode-header-line-format-old
(setq header-line-format ruler-mode-header-line-format-old)))
(remove-hook 'post-command-hook ; remove local hook
#'force-mode-line-update t)))
mouse-2: unset goal column"
"Help string shown when mouse is on the goal column character.")
-(defconst ruler-mode-margin-help-echo
- "%s margin %S"
- "Help string shown when mouse is over a margin area.")
+(defconst ruler-mode-left-margin-help-echo
+ "Left margin %S"
+ "Help string shown when mouse is over the left margin area.")
-(defconst ruler-mode-fringe-help-echo
- "%s fringe %S"
- "Help string shown when mouse is over a fringe area.")
+(defconst ruler-mode-right-margin-help-echo
+ "Right margin %S"
+ "Help string shown when mouse is over the right margin area.")
+
+(defmacro ruler-mode-left-fringe-cols ()
+ "Return the width, measured in columns, of the left fringe area."
+ '(round (or (frame-parameter nil 'left-fringe) 0)
+ (frame-char-width)))
+
+(defmacro ruler-mode-right-fringe-cols ()
+ "Return the width, measured in columns, of the right fringe area."
+ '(round (or (frame-parameter nil 'right-fringe) 0)
+ (frame-char-width)))
+
+(defmacro ruler-mode-left-scroll-bar-cols ()
+ "Return the width, measured in columns, of the left vertical scrollbar."
+ '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'left)
+ (let ((sbw (frame-parameter nil 'scroll-bar-width)))
+ ;; nil means it's a non-toolkit scroll bar,
+ ;; and its width in columns is 14 pixels rounded up.
+ (unless sbw (setq sbw 14))
+ ;; Always round up to multiple of columns.
+ (ceiling sbw (frame-char-width)))
+ 0))
+
+(defmacro ruler-mode-right-scroll-bar-cols ()
+ "Return the width, measured in columns, of the right vertical scrollbar."
+ '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'right)
+ (round (or (frame-parameter nil 'scroll-bar-width) 0)
+ (frame-char-width))
+ 0))
\f
(defun ruler-mode-ruler ()
"Return a string ruler."
- (when ruler-mode
- (let* ((fullw (ruler-mode-full-window-width))
- (w (window-width))
- (m (window-margins))
- (lsb (ruler-mode-left-scroll-bar-cols))
- (lf (ruler-mode-left-fringe-cols))
- (lm (or (car m) 0))
- (rsb (ruler-mode-right-scroll-bar-cols))
- (rf (ruler-mode-right-fringe-cols))
- (rm (or (cdr m) 0))
- (ruler (make-string fullw ruler-mode-basic-graduation-char))
- (o (+ lsb lf lm))
- (x 0)
- (i o)
- (j (window-hscroll))
- k c l1 l2 r2 r1 h1 h2 f1 f2)
-
- ;; Setup the default properties.
- (put-text-property 0 fullw 'face 'ruler-mode-default-face ruler)
- (put-text-property 0 fullw
- 'help-echo
- (cond
- (ruler-mode-show-tab-stops
- ruler-mode-ruler-help-echo-when-tab-stops)
- (goal-column
- ruler-mode-ruler-help-echo-when-goal-column)
- (t
- ruler-mode-ruler-help-echo))
- ruler)
- ;; Setup the local map.
- (put-text-property 0 fullw 'local-map ruler-mode-map ruler)
-
- ;; Setup the active area.
- (while (< x w)
- ;; Graduations.
- (cond
- ;; Show a number graduation.
- ((= (mod j 10) 0)
- (setq c (number-to-string (/ j 10))
- m (length c)
- k i)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-column-number-face
- ruler)
- (while (and (> m 0) (>= k 0))
- (aset ruler k (aref c (setq m (1- m))))
- (setq k (1- k))))
- ;; Show an intermediate graduation.
- ((= (mod j 5) 0)
- (aset ruler i ruler-mode-inter-graduation-char)))
- ;; Special columns.
- (cond
- ;; Show the `current-column' marker.
- ((= j (current-column))
- (aset ruler i ruler-mode-current-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-current-column-face
- ruler))
- ;; Show the `goal-column' marker.
- ((and goal-column (= j goal-column))
- (aset ruler i ruler-mode-goal-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-goal-column-face
- ruler)
- (put-text-property
- i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
- ruler))
- ;; Show the `comment-column' marker.
- ((= j comment-column)
- (aset ruler i ruler-mode-comment-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-comment-column-face
- ruler)
- (put-text-property
- i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
- ruler))
- ;; Show the `fill-column' marker.
- ((= j fill-column)
- (aset ruler i ruler-mode-fill-column-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-fill-column-face
- ruler)
- (put-text-property
- i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
- ruler))
- ;; Show the `tab-stop-list' markers.
- ((and ruler-mode-show-tab-stops (member j tab-stop-list))
- (aset ruler i ruler-mode-tab-stop-char)
- (put-text-property
- i (1+ i) 'face 'ruler-mode-tab-stop-face
- ruler)))
- (setq i (1+ i)
- j (1+ j)
- x (1+ x)))
-
- ;; Highlight the fringes and margins.
- (if (nth 2 (window-fringes))
- ;; fringes outside margins.
- (setq l1 lf
- l2 lm
- r2 rm
- r1 rf
- h1 ruler-mode-fringe-help-echo
- h2 ruler-mode-margin-help-echo
- f1 'ruler-mode-fringes-face
- f2 'ruler-mode-margins-face)
- ;; fringes inside margins.
- (setq l1 lm
- l2 lf
- r2 rf
- r1 rm
- h1 ruler-mode-margin-help-echo
- h2 ruler-mode-fringe-help-echo
- f1 'ruler-mode-margins-face
- f2 'ruler-mode-fringes-face))
- (setq i lsb j (+ i l1))
- (put-text-property i j 'face f1 ruler)
- (put-text-property i j 'help-echo (format h1 "Left" l1) ruler)
- (setq i j j (+ i l2))
- (put-text-property i j 'face f2 ruler)
- (put-text-property i j 'help-echo (format h2 "Left" l2) ruler)
- (setq i (+ o w) j (+ i r2))
- (put-text-property i j 'face f2 ruler)
- (put-text-property i j 'help-echo (format h2 "Right" r2) ruler)
- (setq i j j (+ i r1))
- (put-text-property i j 'face f1 ruler)
- (put-text-property i j 'help-echo (format h1 "Right" r1) ruler)
-
- ;; Show inactive areas.
- (put-text-property 0 lsb 'face 'ruler-mode-pad-face ruler)
- (put-text-property j fullw 'face 'ruler-mode-pad-face ruler)
-
- ;; Return the ruler propertized string.
- ruler)))
+ (if ruler-mode
+ (let* ((j (+ (ruler-mode-left-fringe-cols)
+ (ruler-mode-left-scroll-bar-cols)))
+ (w (+ (window-width) j))
+ (m (window-margins))
+ (l (or (car m) 0))
+ (r (or (cdr m) 0))
+ (o (- (window-hscroll) l j))
+ (i 0)
+ (ruler (concat
+ ;; unit graduations
+ (make-string w ruler-mode-basic-graduation-char)
+ ;; extra space to fill the header line
+ (make-string (+ (ruler-mode-right-fringe-cols)
+ (ruler-mode-right-scroll-bar-cols))
+ ?\ )))
+ c k)
+
+ ;; Setup default face and help echo.
+ (put-text-property 0 (length ruler)
+ 'face 'ruler-mode-default-face
+ ruler)
+ (put-text-property 0 (length ruler)
+ 'help-echo
+ (if ruler-mode-show-tab-stops
+ ruler-mode-ruler-help-echo-when-tab-stops
+ (if goal-column
+ ruler-mode-ruler-help-echo-when-goal-column
+ ruler-mode-ruler-help-echo))
+ ruler)
+ ;; Setup the local map.
+ (put-text-property 0 (length ruler)
+ 'local-map ruler-mode-map
+ ruler)
+
+ (setq j (+ l j))
+ ;; Setup the left margin area.
+ (put-text-property
+ i j 'face 'ruler-mode-margins-face
+ ruler)
+ (put-text-property
+ i j 'help-echo (format ruler-mode-left-margin-help-echo l)
+ ruler)
+ (while (< i j)
+ (aset ruler i ruler-mode-margins-char)
+ (setq i (1+ i)))
+
+ ;; Setup the ruler area.
+ (setq r (- w r))
+ (while (< i r)
+ (setq j (+ i o))
+ (cond
+ ((= (mod j 10) 0)
+ (setq c (number-to-string (/ j 10))
+ m (length c)
+ k i)
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-column-number-face
+ ruler)
+ (while (and (> m 0) (>= k 0))
+ (aset ruler k (aref c (setq m (1- m))))
+ (setq k (1- k)))
+ )
+ ((= (mod j 5) 0)
+ (aset ruler i ruler-mode-inter-graduation-char)
+ )
+ )
+ (setq i (1+ i)))
+
+ ;; Setup the right margin area.
+ (put-text-property
+ i (length ruler) 'face 'ruler-mode-margins-face
+ ruler)
+ (put-text-property
+ i (length ruler) 'help-echo
+ (format ruler-mode-right-margin-help-echo (- w r))
+ ruler)
+ (while (< i (length ruler))
+ (aset ruler i ruler-mode-margins-char)
+ (setq i (1+ i)))
+
+ ;; Show the `goal-column' marker.
+ (if goal-column
+ (progn
+ (setq i (- goal-column o))
+ (and (>= i 0) (< i r)
+ (aset ruler i ruler-mode-goal-column-char)
+ (progn
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-goal-column-face
+ ruler)
+ (put-text-property
+ i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
+ ruler))
+ )))
+
+ ;; Show the `comment-column' marker.
+ (setq i (- comment-column o))
+ (and (>= i 0) (< i r)
+ (aset ruler i ruler-mode-comment-column-char)
+ (progn
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-comment-column-face
+ ruler)
+ (put-text-property
+ i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
+ ruler)))
+
+ ;; Show the `fill-column' marker.
+ (setq i (- fill-column o))
+ (and (>= i 0) (< i r)
+ (aset ruler i ruler-mode-fill-column-char)
+ (progn (put-text-property
+ i (1+ i) 'face 'ruler-mode-fill-column-face
+ ruler)
+ (put-text-property
+ i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
+ ruler)))
+
+ ;; Show the `tab-stop-list' markers.
+ (if ruler-mode-show-tab-stops
+ (let ((tsl tab-stop-list) ts)
+ (while tsl
+ (setq ts (car tsl)
+ tsl (cdr tsl)
+ i (- ts o))
+ (and (>= i 0) (< i r)
+ (aset ruler i ruler-mode-tab-stop-char)
+ (put-text-property
+ i (1+ i)
+ 'face (cond
+ ;; Don't override the *-column face
+ ((eq ts fill-column)
+ 'ruler-mode-fill-column-face)
+ ((eq ts comment-column)
+ 'ruler-mode-comment-column-face)
+ ((eq ts goal-column)
+ 'ruler-mode-goal-column-face)
+ (t
+ 'ruler-mode-tab-stop-face))
+ ruler)))))
+
+ ;; Show the `current-column' marker.
+ (setq i (- (current-column) o))
+ (and (>= i 0) (< i r)
+ (aset ruler i ruler-mode-current-column-char)
+ (put-text-property
+ i (1+ i) 'face 'ruler-mode-current-column-face
+ ruler))
+
+ ruler)))
(provide 'ruler-mode)
--- /dev/null
+;; In load-path, after this directory should come
+;; certain of its subdirectories. Here we specify them.
+(normal-top-level-add-to-load-path '("toolbar" "textmodes" "progmodes" "play" "obsolete" "net" "mail" "language" "international" "gnus" "eshell" "emulation" "emacs-lisp" "calendar" "calc" ))
(buffer-substring-no-properties (match-beginning num)
(match-end num)))))
-(defun looking-back (regexp)
- "Return t if text before point matches regular expression REGEXP.
-This function modifies the match data that `match-beginning',
-`match-end' and `match-data' access; save and restore the match
-data if you want to preserve them."
- (save-excursion
- (let ((beg (point)))
- (if (re-search-backward regexp nil t)
- (if (= (match-end 0) beg)
- t
- nil)
- nil))))
-
(defconst split-string-default-separators "[ \f\t\n\r\v]+"
"The default value of separators for `split-string'.
;;; mac-win.el --- support for "Macintosh windows"
-;; Copyright (C) 1999, 2000, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2002 Free Software Foundation, Inc.
;; Author: Andrew Choi <akochoi@mac.com>
'(lambda ()
(defvar mac-ready-for-drag-n-drop t)))
+(defun iconify-or-deiconify-frame ()
+ "Iconify the selected frame, or deiconify if it's currently an icon."
+ (interactive)
+ (if (eq (cdr (assq 'visibility (frame-parameters))) t)
+ (iconify-frame)
+ (make-frame-visible)))
+
; Define constant values to be set to mac-keyboard-text-encoding
(defconst kTextEncodingMacRoman 0)
(defconst kTextEncodingISOLatin1 513 "0x201")
;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event))
;; Handle mouse-wheel events with mwheel.
-(mouse-wheel-mode 1)
+;; Normally only mouse-wheel-mode and mwheel-install are autoloaded,
+;; but binding mouse-wheel must be done directly, since those functions
+;; do not recognize mouse-wheel as a valid button.
+(autoload 'mwheel-scroll "mwheel")
+(global-set-key [mouse-wheel] 'mwheel-scroll)
+(global-set-key [C-mouse-wheel] 'mwheel-scroll)
+(global-set-key [S-mouse-wheel] 'mwheel-scroll)
(defun w32-drag-n-drop-debug (event)
"Print the drag-n-drop EVENT in a readable form."
+++ /dev/null
-;;; enriched.el --- read and save files in text/enriched format
-
-;; Copyright (c) 1994, 1995, 1996, 2002 Free Software Foundation, Inc.
-
-;; Author: Boris Goldowsky <boris@gnu.org>
-;; Keywords: wp, faces
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This file implements reading, editing, and saving files with
-;; text-properties such as faces, levels of indentation, and true line
-;; breaks distinguished from newlines just used to fit text into the window.
-
-;; The file format used is the MIME text/enriched format, which is a
-;; standard format defined in internet RFC 1563. All standard annotations
-;; are supported except for <smaller> and <bigger>, which are currently not
-;; possible to display.
-
-;; A separate file, enriched.doc, contains further documentation and other
-;; important information about this code. It also serves as an example
-;; file in text/enriched format. It should be in the etc directory of your
-;; emacs distribution.
-
-;;; Code:
-
-(provide 'enriched)
-
-;;;
-;;; Variables controlling the display
-;;;
-
-(defgroup enriched nil
- "Read and save files in text/enriched format"
- :group 'wp)
-
-(defcustom enriched-verbose t
- "*If non-nil, give status messages when reading and writing files."
- :type 'boolean
- :group 'enriched)
-
-;;;
-;;; Set up faces & display table
-;;;
-
-;; Emacs doesn't have a "fixed" face by default, since all faces currently
-;; have to be fixed-width. So we just pick one that looks different from the
-;; default.
-(defface fixed
- '((t (:weight bold)))
- "Face used for text that must be shown in fixed width.
-Currently, emacs can only display fixed-width fonts, but this may change.
-This face is used for text specifically marked as fixed-width, for example
-in text/enriched files."
- :group 'enriched)
-
-(defface excerpt
- '((t (:slant italic)))
- "Face used for text that is an excerpt from another document.
-This is used in Enriched mode for text explicitly marked as an excerpt."
- :group 'enriched)
-
-(defconst enriched-display-table (or (copy-sequence standard-display-table)
- (make-display-table)))
-(aset enriched-display-table ?\f (make-vector (1- (frame-width)) ?-))
-
-(defconst enriched-par-props '(left-margin right-margin justification)
- "Text-properties that usually apply to whole paragraphs.
-These are set front-sticky everywhere except at hard newlines.")
-
-;;;
-;;; Variables controlling the file format
-;;; (bidirectional)
-
-(defconst enriched-initial-annotation
- (lambda ()
- (format "Content-Type: text/enriched\nText-Width: %d\n\n"
- fill-column))
- "What to insert at the start of a text/enriched file.
-If this is a string, it is inserted. If it is a list, it should be a lambda
-expression, which is evaluated to get the string to insert.")
-
-(defconst enriched-annotation-format "<%s%s>"
- "General format of enriched-text annotations.")
-
-(defconst enriched-annotation-regexp "<\\(/\\)?\\([-A-Za-z0-9]+\\)>"
- "Regular expression matching enriched-text annotations.")
-
-(defconst enriched-translations
- '((face (bold-italic "bold" "italic")
- (bold "bold")
- (italic "italic")
- (underline "underline")
- (fixed "fixed")
- (excerpt "excerpt")
- (default )
- (nil enriched-encode-other-face))
- (left-margin (4 "indent"))
- (right-margin (4 "indentright"))
- (justification (none "nofill")
- (right "flushright")
- (left "flushleft")
- (full "flushboth")
- (center "center"))
- (PARAMETER (t "param")) ; Argument of preceding annotation
- ;; The following are not part of the standard:
- (FUNCTION (enriched-decode-foreground "x-color")
- (enriched-decode-background "x-bg-color")
- (enriched-decode-display-prop "x-display"))
- (read-only (t "x-read-only"))
- (display (nil enriched-handle-display-prop))
- (unknown (nil format-annotate-value))
-; (font-size (2 "bigger") ; unimplemented
-; (-2 "smaller"))
-)
- "List of definitions of text/enriched annotations.
-See `format-annotate-region' and `format-deannotate-region' for the definition
-of this structure.")
-
-(defconst enriched-ignore
- '(front-sticky rear-nonsticky hard)
- "Properties that are OK to ignore when saving text/enriched files.
-Any property that is neither on this list nor dealt with by
-`enriched-translations' will generate a warning.")
-
-;;; Internal variables
-
-
-(defcustom enriched-mode-hook nil
- "Hook run after entering/leaving Enriched mode.
-If you set variables in this hook, you should arrange for them to be restored
-to their old values if you leave Enriched mode. One way to do this is to add
-them and their old values to `enriched-old-bindings'."
- :type 'hook
- :group 'enriched)
-
-(defvar enriched-old-bindings nil
- "Store old variable values that we change when entering mode.
-The value is a list of \(VAR VALUE VAR VALUE...).")
-(make-variable-buffer-local 'enriched-old-bindings)
-
-;;;
-;;; Define the mode
-;;;
-
-(put 'enriched-mode 'permanent-local t)
-;;;###autoload
-(define-minor-mode enriched-mode
- "Minor mode for editing text/enriched files.
-These are files with embedded formatting information in the MIME standard
-text/enriched format.
-Turning the mode on runs `enriched-mode-hook'.
-
-More information about Enriched mode is available in the file
-etc/enriched.doc in the Emacs distribution directory.
-
-Commands:
-
-\\{enriched-mode-map}"
- nil " Enriched" nil
- (cond ((null enriched-mode)
- ;; Turn mode off
- (setq buffer-file-format (delq 'text/enriched buffer-file-format))
- ;; restore old variable values
- (while enriched-old-bindings
- (set (pop enriched-old-bindings) (pop enriched-old-bindings))))
-
- ((memq 'text/enriched buffer-file-format)
- ;; Mode already on; do nothing.
- nil)
-
- (t ; Turn mode on
- (push 'text/enriched buffer-file-format)
- ;; Save old variable values before we change them.
- ;; These will be restored if we exit Enriched mode.
- (setq enriched-old-bindings
- (list 'buffer-display-table buffer-display-table
- 'indent-line-function indent-line-function
- 'default-text-properties default-text-properties))
- (make-local-variable 'indent-line-function)
- (make-local-variable 'default-text-properties)
- (setq indent-line-function 'indent-to-left-margin ;WHY?? -sm
- buffer-display-table enriched-display-table)
- (use-hard-newlines 1 nil)
- (let ((sticky (plist-get default-text-properties 'front-sticky))
- (p enriched-par-props))
- (dolist (x p)
- (add-to-list 'sticky x))
- (if sticky
- (setq default-text-properties
- (plist-put default-text-properties
- 'front-sticky sticky)))))))
-
-;;;
-;;; Keybindings
-;;;
-
-(defvar enriched-mode-map nil
- "Keymap for Enriched mode.")
-
-(if (null enriched-mode-map)
- (fset 'enriched-mode-map (setq enriched-mode-map (make-sparse-keymap))))
-
-(if (not (assq 'enriched-mode minor-mode-map-alist))
- (setq minor-mode-map-alist
- (cons (cons 'enriched-mode enriched-mode-map)
- minor-mode-map-alist)))
-
-(define-key enriched-mode-map "\C-a" 'beginning-of-line-text)
-(define-key enriched-mode-map "\C-m" 'reindent-then-newline-and-indent)
-(define-key enriched-mode-map "\C-j" 'reindent-then-newline-and-indent)
-(define-key enriched-mode-map "\M-j" 'facemenu-justification-menu)
-(define-key enriched-mode-map "\M-S" 'set-justification-center)
-(define-key enriched-mode-map "\C-x\t" 'increase-left-margin)
-(define-key enriched-mode-map "\C-c\C-l" 'set-left-margin)
-(define-key enriched-mode-map "\C-c\C-r" 'set-right-margin)
-
-;;;
-;;; Some functions dealing with text-properties, especially indentation
-;;;
-
-(defun enriched-map-property-regions (prop func &optional from to)
- "Apply a function to regions of the buffer based on a text property.
-For each contiguous region of the buffer for which the value of PROPERTY is
-eq, the FUNCTION will be called. Optional arguments FROM and TO specify the
-region over which to scan.
-
-The specified function receives three arguments: the VALUE of the property in
-the region, and the START and END of each region."
- (save-excursion
- (save-restriction
- (if to (narrow-to-region (point-min) to))
- (goto-char (or from (point-min)))
- (let ((begin (point))
- end
- (marker (make-marker))
- (val (get-text-property (point) prop)))
- (while (setq end (text-property-not-all begin (point-max) prop val))
- (move-marker marker end)
- (funcall func val begin (marker-position marker))
- (setq begin (marker-position marker)
- val (get-text-property marker prop)))
- (if (< begin (point-max))
- (funcall func val begin (point-max)))))))
-
-(put 'enriched-map-property-regions 'lisp-indent-hook 1)
-
-(defun enriched-insert-indentation (&optional from to)
- "Indent and justify each line in the region."
- (save-excursion
- (save-restriction
- (if to (narrow-to-region (point-min) to))
- (goto-char (or from (point-min)))
- (if (not (bolp)) (forward-line 1))
- (while (not (eobp))
- (if (eolp)
- nil ; skip blank lines
- (indent-to (current-left-margin))
- (justify-current-line t nil t))
- (forward-line 1)))))
-
-;;;
-;;; Encoding Files
-;;;
-
-;;;###autoload
-(defun enriched-encode (from to orig-buf)
- (if enriched-verbose (message "Enriched: encoding document..."))
- (save-restriction
- (narrow-to-region from to)
- (delete-to-left-margin)
- (unjustify-region)
- (goto-char from)
- (format-replace-strings '(("<" . "<<")))
- (format-insert-annotations
- (format-annotate-region from (point-max) enriched-translations
- 'enriched-make-annotation enriched-ignore))
- (goto-char from)
- (insert (if (stringp enriched-initial-annotation)
- enriched-initial-annotation
- (save-excursion
- ;; Eval this in the buffer we are annotating. This
- ;; fixes a bug which was saving incorrect File-Width
- ;; information, since we were looking at local
- ;; variables in the wrong buffer.
- (if orig-buf (set-buffer orig-buf))
- (funcall enriched-initial-annotation))))
- (enriched-map-property-regions 'hard
- (lambda (v b e)
- (if (and v (= ?\n (char-after b)))
- (progn (goto-char b) (insert "\n"))))
- (point) nil)
- (if enriched-verbose (message nil))
- ;; Return new end.
- (point-max)))
-
-(defun enriched-make-annotation (internal-ann positive)
- "Format an annotation INTERNAL-ANN.
-INTERNAL-ANN may be a string, for a flag, or a list of the form (PARAM VALUE).
-If POSITIVE is non-nil, this is the opening annotation;
-if nil, the matching close."
- (cond ((stringp internal-ann)
- (format enriched-annotation-format (if positive "" "/") internal-ann))
- ;; Otherwise it is an annotation with parameters, represented as a list
- (positive
- (let ((item (car internal-ann))
- (params (cdr internal-ann)))
- (concat (format enriched-annotation-format "" item)
- (mapconcat (lambda (i) (concat "<param>" i "</param>"))
- params ""))))
- (t (format enriched-annotation-format "/" (car internal-ann)))))
-
-(defun enriched-encode-other-face (old new)
- "Generate annotations for random face change.
-One annotation each for foreground color, background color, italic, etc."
- (cons (and old (enriched-face-ans old))
- (and new (enriched-face-ans new))))
-
-(defun enriched-face-ans (face)
- "Return annotations specifying FACE.
-FACE may be a list of faces instead of a single face;
-it can also be anything allowed as an element of a list
-which can be the value of the `face' text property."
- (cond ((and (consp face) (eq (car face) 'foreground-color))
- (list (list "x-color" (cdr face))))
- ((and (consp face) (eq (car face) 'background-color))
- (list (list "x-bg-color" (cdr face))))
- ((and (listp face) (eq (car face) :foreground))
- (list (list "x-color" (cadr face))))
- ((and (listp face) (eq (car face) :background))
- (list (list "x-bg-color" (cadr face))))
- ((listp face)
- (apply 'append (mapcar 'enriched-face-ans face)))
- ((let* ((fg (face-attribute face :foreground))
- (bg (face-attribute face :background))
- (props (face-font face t))
- (ans (cdr (format-annotate-single-property-change
- 'face nil props enriched-translations))))
- (unless (eq fg 'unspecified)
- (setq ans (cons (list "x-color" fg) ans)))
- (unless (eq bg 'unspecified)
- (setq ans (cons (list "x-bg-color" bg) ans)))
- ans))))
-
-;;;
-;;; Decoding files
-;;;
-
-;;;###autoload
-(defun enriched-decode (from to)
- (if enriched-verbose (message "Enriched: decoding document..."))
- (use-hard-newlines 1 'never)
- (save-excursion
- (save-restriction
- (narrow-to-region from to)
- (goto-char from)
-
- ;; Deal with header
- (let ((file-width (enriched-get-file-width)))
- (enriched-remove-header)
-
- ;; Deal with newlines
- (while (search-forward-regexp "\n\n+" nil t)
- (if (current-justification)
- (delete-char -1))
- (set-hard-newline-properties (match-beginning 0) (point)))
-
- ;; Translate annotations
- (format-deannotate-region from (point-max) enriched-translations
- 'enriched-next-annotation)
-
- ;; Indent or fill the buffer
- (cond (file-width ; File was filled to this width
- (setq fill-column file-width)
- (if enriched-verbose (message "Indenting..."))
- (enriched-insert-indentation))
- (t ; File was not filled.
- (if enriched-verbose (message "Filling paragraphs..."))
- (fill-region (point-min) (point-max))))
- (if enriched-verbose (message nil)))
- (point-max))))
-
-(defun enriched-next-annotation ()
- "Find and return next text/enriched annotation.
-Any \"<<\" strings encountered are converted to \"<\".
-Return value is \(begin end name positive-p), or nil if none was found."
- (while (and (search-forward "<" nil 1)
- (progn (goto-char (match-beginning 0))
- (not (looking-at enriched-annotation-regexp))))
- (forward-char 1)
- (if (= ?< (char-after (point)))
- (delete-char 1)
- ;; A single < that does not start an annotation is an error,
- ;; which we note and then ignore.
- (message "Warning: malformed annotation in file at %s"
- (1- (point)))))
- (if (not (eobp))
- (let* ((beg (match-beginning 0))
- (end (match-end 0))
- (name (downcase (buffer-substring
- (match-beginning 2) (match-end 2))))
- (pos (not (match-beginning 1))))
- (list beg end name pos))))
-
-(defun enriched-get-file-width ()
- "Look for file width information on this line."
- (save-excursion
- (if (search-forward "Text-Width: " (+ (point) 1000) t)
- (read (current-buffer)))))
-
-(defun enriched-remove-header ()
- "Remove file-format header at point."
- (while (looking-at "^[-A-Za-z]+: .*\n")
- (delete-region (point) (match-end 0)))
- (if (looking-at "^\n")
- (delete-char 1)))
-
-(defun enriched-decode-foreground (from to &optional color)
- (if color
- (list from to 'face (list ':foreground color))
- (message "Warning: no color specified for <x-color>")
- nil))
-
-(defun enriched-decode-background (from to &optional color)
- (if color
- (list from to 'face (list ':background color))
- (message "Warning: no color specified for <x-bg-color>")
- nil))
-\f
-;;; Handling the `display' property.
-
-
-(defun enriched-handle-display-prop (old new)
- "Return a list of annotations for a change in the `display' property.
-OLD is the old value of the property, NEW is the new value. Value
-is a list `(CLOSE OPEN)', where CLOSE is a list of annotations to
-close and OPEN a list of annotations to open. Each of these lists
-has the form `(ANNOTATION PARAM ...)'."
- (let ((annotation "x-display")
- (param (prin1-to-string (or old new))))
- (if (null old)
- (cons nil (list (list annotation param)))
- (cons (list (list annotation param)) nil))))
-
-(defun enriched-decode-display-prop (start end &optional param)
- "Decode a `display' property for text between START and END.
-PARAM is a `<param>' found for the property.
-Value is a list `(START END SYMBOL VALUE)' with START and END denoting
-the range of text to assign text property SYMBOL with value VALUE "
- (let ((prop (when (stringp param)
- (condition-case ()
- (car (read-from-string param))
- (error nil)))))
- (unless prop
- (message "Warning: invalid <x-display> parameter %s" param))
- (list start end 'display prop)))
-
-;;; enriched.el ends here
--- /dev/null
+;;; outline.el --- outline mode commands for Emacs
+
+;; Copyright (C) 1986, 93, 94, 95, 97, 2000, 2001
+;; Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: outlines
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package is a major mode for editing outline-format documents.
+;; An outline can be `abstracted' to show headers at any given level,
+;; with all stuff below hidden. See the Emacs manual for details.
+
+;;; Todo:
+
+;; - subtree-terminators
+;; - better handle comments before function bodies (i.e. heading)
+;; - don't bother hiding whitespace
+
+;;; Code:
+
+(defgroup outlines nil
+ "Support for hierarchical outlining"
+ :prefix "outline-"
+ :group 'editing)
+
+(defcustom outline-regexp "[*\^L]+"
+ "*Regular expression to match the beginning of a heading.
+Any line whose beginning matches this regexp is considered to start a heading.
+Note that Outline mode only checks this regexp at the start of a line,
+so the regexp need not (and usually does not) start with `^'.
+The recommended way to set this is with a Local Variables: list
+in the file it applies to. See also `outline-heading-end-regexp'."
+ :type '(choice regexp (const nil))
+ :group 'outlines)
+
+(defcustom outline-heading-end-regexp "\n"
+ "*Regular expression to match the end of a heading line.
+You can assume that point is at the beginning of a heading when this
+regexp is searched for. The heading ends at the end of the match.
+The recommended way to set this is with a `Local Variables:' list
+in the file it applies to."
+ :type 'regexp
+ :group 'outlines)
+
+(defvar outline-mode-prefix-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "@" 'outline-mark-subtree)
+ (define-key map "\C-n" 'outline-next-visible-heading)
+ (define-key map "\C-p" 'outline-previous-visible-heading)
+ (define-key map "\C-i" 'show-children)
+ (define-key map "\C-s" 'show-subtree)
+ (define-key map "\C-d" 'hide-subtree)
+ (define-key map "\C-u" 'outline-up-heading)
+ (define-key map "\C-f" 'outline-forward-same-level)
+ (define-key map "\C-b" 'outline-backward-same-level)
+ (define-key map "\C-t" 'hide-body)
+ (define-key map "\C-a" 'show-all)
+ (define-key map "\C-c" 'hide-entry)
+ (define-key map "\C-e" 'show-entry)
+ (define-key map "\C-l" 'hide-leaves)
+ (define-key map "\C-k" 'show-branches)
+ (define-key map "\C-q" 'hide-sublevels)
+ (define-key map "\C-o" 'hide-other)
+ (define-key map "\C-^" 'outline-move-subtree-up)
+ (define-key map "\C-v" 'outline-move-subtree-down)
+ (define-key map [(control ?<)] 'outline-promote)
+ (define-key map [(control ?>)] 'outline-demote)
+ (define-key map "\C-m" 'outline-insert-heading)
+ ;; Where to bind outline-cycle ?
+ map))
+
+(defvar outline-mode-menu-bar-map
+ (let ((map (make-sparse-keymap)))
+
+ (define-key map [hide] (cons "Hide" (make-sparse-keymap "Hide")))
+
+ (define-key map [hide hide-other] '("Hide Other" . hide-other))
+ (define-key map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels))
+ (define-key map [hide hide-subtree] '("Hide Subtree" . hide-subtree))
+ (define-key map [hide hide-entry] '("Hide Entry" . hide-entry))
+ (define-key map [hide hide-body] '("Hide Body" . hide-body))
+ (define-key map [hide hide-leaves] '("Hide Leaves" . hide-leaves))
+
+ (define-key map [show] (cons "Show" (make-sparse-keymap "Show")))
+
+ (define-key map [show show-subtree] '("Show Subtree" . show-subtree))
+ (define-key map [show show-children] '("Show Children" . show-children))
+ (define-key map [show show-branches] '("Show Branches" . show-branches))
+ (define-key map [show show-entry] '("Show Entry" . show-entry))
+ (define-key map [show show-all] '("Show All" . show-all))
+
+ (define-key map [headings]
+ (cons "Headings" (make-sparse-keymap "Headings")))
+
+ (define-key map [headings demote-subtree]
+ '(menu-item "Demote subtree" outline-demote))
+ (define-key map [headings promote-subtree]
+ '(menu-item "Promote subtree" outline-promote))
+ (define-key map [headings move-subtree-down]
+ '(menu-item "Move subtree down" outline-move-subtree-down))
+ (define-key map [headings move-subtree-up]
+ '(menu-item "Move subtree up" outline-move-subtree-up))
+ (define-key map [headings copy]
+ '(menu-item "Copy to kill ring" outline-headers-as-kill
+ :enable mark-active))
+ (define-key map [headings outline-insert-heading]
+ '("New heading" . outline-insert-heading))
+ (define-key map [headings outline-backward-same-level]
+ '("Previous Same Level" . outline-backward-same-level))
+ (define-key map [headings outline-forward-same-level]
+ '("Next Same Level" . outline-forward-same-level))
+ (define-key map [headings outline-previous-visible-heading]
+ '("Previous" . outline-previous-visible-heading))
+ (define-key map [headings outline-next-visible-heading]
+ '("Next" . outline-next-visible-heading))
+ (define-key map [headings outline-up-heading]
+ '("Up" . outline-up-heading))
+ map))
+
+(defvar outline-minor-mode-menu-bar-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [outline]
+ (cons "Outline"
+ (nconc (make-sparse-keymap "Outline")
+ ;; Remove extra separator
+ (cdr
+ ;; Flatten the major mode's menus into a single menu.
+ (apply 'append
+ (mapcar (lambda (x)
+ (if (consp x)
+ ;; Add a separator between each
+ ;; part of the unified menu.
+ (cons '(--- "---") (cdr x))))
+ outline-mode-menu-bar-map))))))
+ map))
+
+
+(defvar outline-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c" outline-mode-prefix-map)
+ (define-key map [menu-bar] outline-mode-menu-bar-map)
+ map))
+
+(defvar outline-font-lock-keywords
+ '(;;
+ ;; Highlight headings according to the level.
+ (eval . (list (concat "^\\(?:" outline-regexp "\\).+")
+ 0 '(outline-font-lock-face) nil t)))
+ "Additional expressions to highlight in Outline mode.")
+
+(defface outline-1 '((t :inherit font-lock-function-name-face)) "Level 1.")
+(defface outline-2 '((t :inherit font-lock-variable-name-face)) "Level 2.")
+(defface outline-3 '((t :inherit font-lock-keyword-face)) "Level 3.")
+(defface outline-4 '((t :inherit font-lock-builtin-face)) "Level 4.")
+(defface outline-5 '((t :inherit font-lock-comment-face)) "Level 5.")
+(defface outline-6 '((t :inherit font-lock-constant-face)) "Level 6.")
+(defface outline-7 '((t :inherit font-lock-type-face)) "Level 7.")
+(defface outline-8 '((t :inherit font-lock-string-face)) "Level 8.")
+
+(defvar outline-font-lock-faces
+ [outline-1 outline-2 outline-3 outline-4
+ outline-5 outline-6 outline-7 outline-8])
+
+(defvar outline-font-lock-levels nil)
+(make-variable-buffer-local 'outline-font-lock-levels)
+
+(defun outline-font-lock-face ()
+ ;; (save-excursion
+ ;; (outline-back-to-heading t)
+ ;; (let* ((count 0)
+ ;; (start-level (funcall outline-level))
+ ;; (level start-level)
+ ;; face-level)
+ ;; (while (not (setq face-level
+ ;; (if (or (bobp) (eq level 1)) 0
+ ;; (cdr (assq level outline-font-lock-levels)))))
+ ;; (outline-up-heading 1 t)
+ ;; (setq count (1+ count))
+ ;; (setq level (funcall outline-level)))
+ ;; ;; Remember for later.
+ ;; (unless (zerop count)
+ ;; (setq face-level (+ face-level count))
+ ;; (push (cons start-level face-level) outline-font-lock-levels))
+ ;; (condition-case nil
+ ;; (aref outline-font-lock-faces face-level)
+ ;; (error font-lock-warning-face))))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at outline-regexp)
+ (condition-case nil
+ (aref outline-font-lock-faces (1- (funcall outline-level)))
+ (error font-lock-warning-face))))
+
+(defvar outline-view-change-hook nil
+ "Normal hook to be run after outline visibility changes.")
+
+;;;###autoload
+(define-derived-mode outline-mode text-mode "Outline"
+ "Set major mode for editing outlines with selective display.
+Headings are lines which start with asterisks: one for major headings,
+two for subheadings, etc. Lines not starting with asterisks are body lines.
+
+Body text or subheadings under a heading can be made temporarily
+invisible, or visible again. Invisible lines are attached to the end
+of the heading, so they move with it, if the line is killed and yanked
+back. A heading with text hidden under it is marked with an ellipsis (...).
+
+Commands:\\<outline-mode-map>
+\\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
+\\[outline-previous-visible-heading] outline-previous-visible-heading
+\\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
+\\[outline-backward-same-level] outline-backward-same-level
+\\[outline-up-heading] outline-up-heading move from subheading to heading
+
+\\[hide-body] make all text invisible (not headings).
+\\[show-all] make everything in buffer visible.
+\\[hide-sublevels] make only the first N levels of headers visible.
+
+The remaining commands are used when point is on a heading line.
+They apply to some of the body or subheadings of that heading.
+\\[hide-subtree] hide-subtree make body and subheadings invisible.
+\\[show-subtree] show-subtree make body and subheadings visible.
+\\[show-children] show-children make direct subheadings visible.
+ No effect on body, or subheadings 2 or more levels down.
+ With arg N, affects subheadings N levels down.
+\\[hide-entry] make immediately following body invisible.
+\\[show-entry] make it visible.
+\\[hide-leaves] make body under heading and under its subheadings invisible.
+ The subheadings remain visible.
+\\[show-branches] make all subheadings at all levels visible.
+
+The variable `outline-regexp' can be changed to control what is a heading.
+A line is a heading if `outline-regexp' matches something at the
+beginning of the line. The longer the match, the deeper the level.
+
+Turning on outline mode calls the value of `text-mode-hook' and then of
+`outline-mode-hook', if they are non-nil."
+ (make-local-variable 'line-move-ignore-invisible)
+ (setq line-move-ignore-invisible t)
+ ;; Cause use of ellipses for invisible text.
+ (add-to-invisibility-spec '(outline . t))
+ (set (make-local-variable 'paragraph-start)
+ (concat paragraph-start "\\|\\(?:" outline-regexp "\\)"))
+ ;; Inhibit auto-filling of header lines.
+ (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp)
+ (set (make-local-variable 'paragraph-separate)
+ (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)"))
+ (set (make-local-variable 'font-lock-defaults)
+ '(outline-font-lock-keywords t nil nil backward-paragraph))
+ (setq imenu-generic-expression
+ (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
+ (add-hook 'change-major-mode-hook 'show-all nil t))
+
+(defcustom outline-minor-mode-prefix "\C-c@"
+ "*Prefix key to use for Outline commands in Outline minor mode.
+The value of this variable is checked as part of loading Outline mode.
+After that, changing the prefix key requires manipulating keymaps."
+ :type 'string
+ :group 'outlines)
+
+;;;###autoload
+(define-minor-mode outline-minor-mode
+ "Toggle Outline minor mode.
+With arg, turn Outline minor mode on if arg is positive, off otherwise.
+See the command `outline-mode' for more information on this mode."
+ nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
+ (cons outline-minor-mode-prefix outline-mode-prefix-map))
+ :group 'outlines
+ (if outline-minor-mode
+ (progn
+ ;; Turn off this mode if we change major modes.
+ (add-hook 'change-major-mode-hook
+ (lambda () (outline-minor-mode -1))
+ nil t)
+ (set (make-local-variable 'line-move-ignore-invisible) t)
+ ;; Cause use of ellipses for invisible text.
+ (add-to-invisibility-spec '(outline . t)))
+ (setq line-move-ignore-invisible nil)
+ ;; Cause use of ellipses for invisible text.
+ (remove-from-invisibility-spec '(outline . t))
+ ;; When turning off outline mode, get rid of any outline hiding.
+ (show-all)))
+\f
+(defvar outline-level 'outline-level
+ "*Function of no args to compute a header's nesting level in an outline.
+It can assume point is at the beginning of a header line and that the match
+data reflects the `outline-regexp'.")
+
+(defvar outline-heading-alist ()
+ "Alist associating a heading for every possible level.
+Each entry is of the form (HEADING . LEVEL).
+This alist is used two ways: to find the heading corresponding to
+a given level and to find the level of a given heading.
+If a mode or document needs several sets of outline headings (for example
+numbered and unnumbered sections), list them set by set and sorted by level
+within each set. For example in texinfo mode:
+
+ (setq outline-heading-alist
+ '((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4)
+ (\"@subsubsection\" . 5)
+ (\"@unnumbered\" . 2) (\"@unnumberedsec\" . 3)
+ (\"@unnumberedsubsec\" . 4) (\"@unnumberedsubsubsec\" . 5)
+ (\"@appendix\" . 2) (\"@appendixsec\" . 3)...
+ (\"@appendixsubsec\" . 4) (\"@appendixsubsubsec\" . 5) ..))
+
+Instead of sorting the entries in each set, you can also separate the
+sets with nil.")
+(make-variable-buffer-local 'outline-heading-alist)
+
+;; This used to count columns rather than characters, but that made ^L
+;; appear to be at level 2 instead of 1. Columns would be better for
+;; tab handling, but the default regexp doesn't use tabs, and anyone
+;; who changes the regexp can also redefine the outline-level variable
+;; as appropriate.
+(defun outline-level ()
+ "Return the depth to which a statement is nested in the outline.
+Point must be at the beginning of a header line.
+This is actually either the level specified in `outline-heading-alist'
+or else the number of characters matched by `outline-regexp'."
+ (or (cdr (assoc (match-string 0) outline-heading-alist))
+ (- (match-end 0) (match-beginning 0))))
+
+(defun outline-next-preface ()
+ "Skip forward to just before the next heading line.
+If there's no following heading line, stop before the newline
+at the end of the buffer."
+ (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
+ nil 'move)
+ (goto-char (match-beginning 0)))
+ (if (and (bolp) (not (bobp)))
+ (forward-char -1)))
+
+(defun outline-next-heading ()
+ "Move to the next (possibly invisible) heading line."
+ (interactive)
+ ;; Make sure we don't match the heading we're at.
+ (if (and (bolp) (not (eobp))) (forward-char 1))
+ (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
+ nil 'move)
+ (goto-char (match-beginning 0))))
+
+(defun outline-previous-heading ()
+ "Move to the previous (possibly invisible) heading line."
+ (interactive)
+ (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil 'move))
+
+(defsubst outline-invisible-p (&optional pos)
+ "Non-nil if the character after point is invisible."
+ (get-char-property (or pos (point)) 'invisible))
+
+(defun outline-visible ()
+ (not (outline-invisible-p)))
+(make-obsolete 'outline-visible 'outline-invisible-p)
+
+(defun outline-back-to-heading (&optional invisible-ok)
+ "Move to previous heading line, or beg of this line if it's a heading.
+Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
+ (beginning-of-line)
+ (or (outline-on-heading-p invisible-ok)
+ (let (found)
+ (save-excursion
+ (while (not found)
+ (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil t)
+ (error "before first heading"))
+ (setq found (and (or invisible-ok (not (outline-invisible-p)))
+ (point)))))
+ (goto-char found)
+ found)))
+
+(defun outline-on-heading-p (&optional invisible-ok)
+ "Return t if point is on a (visible) heading line.
+If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
+ (save-excursion
+ (beginning-of-line)
+ (and (bolp) (or invisible-ok (not (outline-invisible-p)))
+ (looking-at outline-regexp))))
+
+(defun outline-insert-heading ()
+ "Insert a new heading at same depth at point."
+ (interactive)
+ (let ((head (save-excursion
+ (condition-case nil
+ (outline-back-to-heading)
+ (error (outline-next-heading)))
+ (if (eobp)
+ (or (caar outline-heading-alist) "")
+ (match-string 0)))))
+ (unless (or (string-match "[ \t]\\'" head)
+ (not (string-match outline-regexp (concat head " "))))
+ (setq head (concat head " ")))
+ (unless (bolp) (end-of-line) (newline))
+ (insert head)
+ (unless (eolp)
+ (save-excursion (newline-and-indent)))
+ (run-hooks 'outline-insert-heading-hook)))
+
+(defun outline-promote (&optional children)
+ "Promote headings higher up the tree.
+If prefix argument CHILDREN is given, promote also all the children.
+If the region is active in `transient-mark-mode', promote all headings
+in the region."
+ (interactive
+ (list (if (and transient-mark-mode mark-active) 'region
+ (outline-back-to-heading)
+ (if current-prefix-arg nil 'subtree))))
+ (cond
+ ((eq children 'region)
+ (outline-map-region 'outline-promote (region-beginning) (region-end)))
+ (children
+ (outline-map-region 'outline-promote
+ (point)
+ (save-excursion (outline-get-next-sibling) (point))))
+ (t
+ (outline-back-to-heading t)
+ (let* ((head (match-string 0))
+ (level (save-match-data (funcall outline-level)))
+ (up-head (or (outline-head-from-level (1- level) head)
+ (save-excursion
+ (save-match-data
+ (outline-up-heading 1 t)
+ (match-string 0))))))
+
+ (unless (rassoc level outline-heading-alist)
+ (push (cons head level) outline-heading-alist))
+
+ (replace-match up-head nil t)))))
+
+(defun outline-demote (&optional children)
+ "Demote headings lower down the tree.
+If prefix argument CHILDREN is given, demote also all the children.
+If the region is active in `transient-mark-mode', demote all headings
+in the region."
+ (interactive
+ (list (if (and transient-mark-mode mark-active) 'region
+ (outline-back-to-heading)
+ (if current-prefix-arg nil 'subtree))))
+ (cond
+ ((eq children 'region)
+ (outline-map-region 'outline-demote (region-beginning) (region-end)))
+ (children
+ (outline-map-region 'outline-demote
+ (point)
+ (save-excursion (outline-get-next-sibling) (point))))
+ (t
+ (let* ((head (match-string 0))
+ (level (save-match-data (funcall outline-level)))
+ (down-head
+ (or (outline-head-from-level (1+ level) head)
+ (save-excursion
+ (save-match-data
+ (while (and (progn (outline-next-heading) (not (eobp)))
+ (<= (funcall outline-level) level)))
+ (when (eobp)
+ ;; Try again from the beginning of the buffer.
+ (goto-char (point-min))
+ (while (and (progn (outline-next-heading) (not (eobp)))
+ (<= (funcall outline-level) level))))
+ (unless (eobp)
+ (looking-at outline-regexp)
+ (match-string 0))))
+ (save-match-data
+ ;; Bummer!! There is no lower heading in the buffer.
+ ;; Let's try to invent one by repeating the first char.
+ (let ((new-head (concat (substring head 0 1) head)))
+ (if (string-match (concat "\\`" outline-regexp) new-head)
+ ;; Why bother checking that it is indeed lower level ?
+ new-head
+ ;; Didn't work: keep it as is so it's still a heading.
+ head))))))
+
+ (unless (rassoc level outline-heading-alist)
+ (push (cons head level) outline-heading-alist))
+ (replace-match down-head nil t)))))
+
+(defun outline-head-from-level (level head &optional alist)
+ "Get new heading with level LEVEL from ALIST.
+If there are no such entries, return nil.
+ALIST defaults to `outline-heading-alist'.
+Similar to (car (rassoc LEVEL ALIST)).
+If there are several different entries with same new level, choose
+the one with the smallest distance to the assocation of HEAD in the alist.
+This makes it possible for promotion to work in modes with several
+independent sets of headings (numbered, unnumbered, appendix...)"
+ (unless alist (setq alist outline-heading-alist))
+ (let ((l (rassoc level alist))
+ ll h hl l2 l2l)
+ (cond
+ ((null l) nil)
+ ;; If there's no HEAD after L, any other entry for LEVEL after L
+ ;; can't be much better than L.
+ ((null (setq h (assoc head (setq ll (memq l alist))))) (car l))
+ ;; If there's no other entry for LEVEL, just keep L.
+ ((null (setq l2 (rassoc level (cdr ll)))) (car l))
+ ;; Now we have L, L2, and H: see if L2 seems better than L.
+ ;; If H is after L2, L2 is better.
+ ((memq h (setq l2l (memq l2 (cdr ll))))
+ (outline-head-from-level level head l2l))
+ ;; Now we have H between L and L2.
+ ;; If there's a separator between L and H, prefer L2.
+ ((memq h (memq nil ll))
+ (outline-head-from-level level head l2l))
+ ;; If there's a separator between L2 and H, prefer L.
+ ((memq l2 (memq nil (setq hl (memq h ll)))) (car l))
+ ;; No separator between L and L2, check the distance.
+ ((< (* 2 (length hl)) (+ (length ll) (length l2l)))
+ (outline-head-from-level level head l2l))
+ ;; If all else fails, just keep L.
+ (t (car l)))))
+
+(defun outline-map-region (fun beg end)
+ "Call FUN for every heading between BEG and END.
+When FUN is called, point is at the beginning of the heading and
+the match data is set appropriately."
+ (save-excursion
+ (setq end (copy-marker end))
+ (goto-char beg)
+ (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)
+ (goto-char (match-beginning 0))
+ (funcall fun)
+ (while (and (progn
+ (outline-next-heading)
+ (< (point) end))
+ (not (eobp)))
+ (funcall fun)))))
+
+;; Vertical tree motion
+
+(defun outline-move-subtree-up (&optional arg)
+ "Move the currrent subtree up past ARG headlines of the same level."
+ (interactive "p")
+ (outline-move-subtree-down (- arg)))
+
+(defun outline-move-subtree-down (&optional arg)
+ "Move the currrent subtree down past ARG headlines of the same level."
+ (interactive "p")
+ (let ((re (concat "^" outline-regexp))
+ (movfunc (if (> arg 0) 'outline-get-next-sibling
+ 'outline-get-last-sibling))
+ (ins-point (make-marker))
+ (cnt (abs arg))
+ beg end txt folded)
+ ;; Select the tree
+ (outline-back-to-heading)
+ (setq beg (point))
+ (save-match-data
+ (save-excursion (outline-end-of-heading)
+ (setq folded (outline-invisible-p)))
+ (outline-end-of-subtree))
+ (if (= (char-after) ?\n) (forward-char 1))
+ (setq end (point))
+ ;; Find insertion point, with error handling
+ (goto-char beg)
+ (while (> cnt 0)
+ (or (funcall movfunc)
+ (progn (goto-char beg)
+ (error "Cannot move past superior level")))
+ (setq cnt (1- cnt)))
+ (if (> arg 0)
+ ;; Moving forward - still need to move over subtree
+ (progn (outline-end-of-subtree)
+ (if (= (char-after) ?\n) (forward-char 1))))
+ (move-marker ins-point (point))
+ (insert (delete-and-extract-region beg end))
+ (goto-char ins-point)
+ (if folded (hide-subtree))
+ (move-marker ins-point nil)))
+
+(defun outline-end-of-heading ()
+ (if (re-search-forward outline-heading-end-regexp nil 'move)
+ (forward-char -1)))
+
+(defun outline-next-visible-heading (arg)
+ "Move to the next visible heading line.
+With argument, repeats or can move backward if negative.
+A heading line is one that starts with a `*' (or that
+`outline-regexp' matches)."
+ (interactive "p")
+ (if (< arg 0)
+ (beginning-of-line)
+ (end-of-line))
+ (while (and (not (bobp)) (< arg 0))
+ (while (and (not (bobp))
+ (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil 'move)
+ (outline-invisible-p)))
+ (setq arg (1+ arg)))
+ (while (and (not (eobp)) (> arg 0))
+ (while (and (not (eobp))
+ (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
+ nil 'move)
+ (outline-invisible-p (match-beginning 0))))
+ (setq arg (1- arg)))
+ (beginning-of-line))
+
+(defun outline-previous-visible-heading (arg)
+ "Move to the previous heading line.
+With argument, repeats or can move forward if negative.
+A heading line is one that starts with a `*' (or that
+`outline-regexp' matches)."
+ (interactive "p")
+ (outline-next-visible-heading (- arg)))
+
+(defun outline-mark-subtree ()
+ "Mark the current subtree in an outlined document.
+This puts point at the start of the current subtree, and mark at the end."
+ (interactive)
+ (let ((beg))
+ (if (outline-on-heading-p)
+ ;; we are already looking at a heading
+ (beginning-of-line)
+ ;; else go back to previous heading
+ (outline-previous-visible-heading 1))
+ (setq beg (point))
+ (outline-end-of-subtree)
+ (push-mark (point))
+ (goto-char beg)))
+\f
+
+(put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible)
+(defun outline-flag-region (from to flag)
+ "Hide or show lines from FROM to TO, according to FLAG.
+If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
+ (remove-overlays from to 'invisible 'outline)
+ (when flag
+ (let ((o (make-overlay from to)))
+ (overlay-put o 'invisible 'outline)
+ (overlay-put o 'isearch-open-invisible 'outline-isearch-open-invisible)))
+ ;; Seems only used by lazy-lock. I.e. obsolete.
+ (run-hooks 'outline-view-change-hook))
+
+(defun outline-reveal-toggle-invisible (o hidep)
+ (save-excursion
+ (goto-char (overlay-start o))
+ (if hidep
+ ;; When hiding the area again, we could just clean it up and let
+ ;; reveal do the rest, by simply doing:
+ ;; (remove-overlays (overlay-start o) (overlay-end o)
+ ;; 'invisible 'outline)
+ ;;
+ ;; That works fine as long as everything is in sync, but if the
+ ;; structure of the document is changed while revealing parts of it,
+ ;; the resulting behavior can be ugly. I.e. we need to make
+ ;; sure that we hide exactly a subtree.
+ (progn
+ (let ((end (overlay-end o)))
+ (delete-overlay o)
+ (while (progn
+ (hide-subtree)
+ (outline-next-visible-heading 1)
+ (and (not (eobp)) (< (point) end))))))
+
+ ;; When revealing, we just need to reveal sublevels. If point is
+ ;; inside one of the sublevels, reveal will call us again.
+ ;; But we need to preserve the original overlay.
+ (let ((o1 (copy-overlay o)))
+ (overlay-put o 'invisible nil) ;Show (most of) the text.
+ (while (progn
+ (show-entry)
+ (show-children)
+ ;; Normally just the above is needed.
+ ;; But in odd cases, the above might fail to show anything.
+ ;; To avoid an infinite loop, we have to make sure that
+ ;; *something* gets shown.
+ (and (equal (overlay-start o) (overlay-start o1))
+ (< (point) (overlay-end o))
+ (= 0 (forward-line 1)))))
+ ;; If still nothing was shown, just kill the damn thing.
+ (when (equal (overlay-start o) (overlay-start o1))
+ ;; I've seen it happen at the end of buffer.
+ (delete-overlay o1))))))
+
+;; Function to be set as an outline-isearch-open-invisible' property
+;; to the overlay that makes the outline invisible (see
+;; `outline-flag-region').
+(defun outline-isearch-open-invisible (overlay)
+ ;; We rely on the fact that isearch places point on the matched text.
+ (show-entry))
+\f
+(defun hide-entry ()
+ "Hide the body directly following this heading."
+ (interactive)
+ (outline-back-to-heading)
+ (outline-end-of-heading)
+ (save-excursion
+ (outline-flag-region (point) (progn (outline-next-preface) (point)) t)))
+
+(defun show-entry ()
+ "Show the body directly following this heading.
+Show the heading too, if it is currently invisible."
+ (interactive)
+ (save-excursion
+ (outline-back-to-heading t)
+ (outline-flag-region (1- (point))
+ (progn (outline-next-preface) (point)) nil)))
+
+(defun hide-body ()
+ "Hide all of buffer except headings."
+ (interactive)
+ (hide-region-body (point-min) (point-max)))
+
+(defun hide-region-body (start end)
+ "Hide all body lines in the region, but not headings."
+ ;; Nullify the hook to avoid repeated calls to `outline-flag-region'
+ ;; wasting lots of time running `lazy-lock-fontify-after-outline'
+ ;; and run the hook finally.
+ (let (outline-view-change-hook)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (if (outline-on-heading-p)
+ (outline-end-of-heading))
+ (while (not (eobp))
+ (outline-flag-region (point)
+ (progn (outline-next-preface) (point)) t)
+ (unless (eobp)
+ (forward-char (if (looking-at "\n\n") 2 1))
+ (outline-end-of-heading))))))
+ (run-hooks 'outline-view-change-hook))
+
+(defun show-all ()
+ "Show all of the text in the buffer."
+ (interactive)
+ (outline-flag-region (point-min) (point-max) nil))
+
+(defun hide-subtree ()
+ "Hide everything after this heading at deeper levels."
+ (interactive)
+ (outline-flag-subtree t))
+
+(defun hide-leaves ()
+ "Hide all body after this heading at deeper levels."
+ (interactive)
+ (outline-back-to-heading)
+ (save-excursion
+ (outline-end-of-heading)
+ (hide-region-body (point) (progn (outline-end-of-subtree) (point)))))
+
+(defun show-subtree ()
+ "Show everything after this heading at deeper levels."
+ (interactive)
+ (outline-flag-subtree nil))
+
+(defun outline-show-heading ()
+ "Show the current heading and move to its end."
+ (outline-flag-region (- (point)
+ (if (bobp) 0
+ (if (eq (char-before (1- (point))) ?\n)
+ 2 1)))
+ (progn (outline-end-of-heading) (point))
+ nil))
+
+(defun hide-sublevels (levels)
+ "Hide everything but the top LEVELS levels of headers, in whole buffer."
+ (interactive "p")
+ (if (< levels 1)
+ (error "Must keep at least one level of headers"))
+ (let (outline-view-change-hook)
+ (save-excursion
+ (goto-char (point-min))
+ ;; Skip the prelude, if any.
+ (unless (outline-on-heading-p t) (outline-next-heading))
+ ;; First hide everything.
+ (outline-flag-region (point) (point-max) t)
+ ;; Then unhide the top level headers.
+ (outline-map-region
+ (lambda ()
+ (if (<= (funcall outline-level) levels)
+ (outline-show-heading)))
+ (point) (point-max))))
+ (run-hooks 'outline-view-change-hook))
+
+(defun hide-other ()
+ "Hide everything except current body and parent and top-level headings."
+ (interactive)
+ (hide-sublevels 1)
+ (let (outline-view-change-hook)
+ (save-excursion
+ (outline-back-to-heading t)
+ (show-entry)
+ (while (condition-case nil (progn (outline-up-heading 1) (not (bobp)))
+ (error nil))
+ (outline-flag-region (1- (point))
+ (save-excursion (forward-line 1) (point))
+ nil))))
+ (run-hooks 'outline-view-change-hook))
+
+(defun outline-toggle-children ()
+ "Show or hide the current subtree depending on its current state."
+ (interactive)
+ (outline-back-to-heading)
+ (if (not (outline-invisible-p (line-end-position)))
+ (hide-subtree)
+ (show-children)
+ (show-entry)))
+
+(defun outline-flag-subtree (flag)
+ (save-excursion
+ (outline-back-to-heading)
+ (outline-end-of-heading)
+ (outline-flag-region (point)
+ (progn (outline-end-of-subtree) (point))
+ flag)))
+
+(defun outline-end-of-subtree ()
+ (outline-back-to-heading)
+ (let ((opoint (point))
+ (first t)
+ (level (funcall outline-level)))
+ (while (and (not (eobp))
+ (or first (> (funcall outline-level) level)))
+ (setq first nil)
+ (outline-next-heading))
+ (if (bolp)
+ (progn
+ ;; Go to end of line before heading
+ (forward-char -1)
+ (if (bolp)
+ ;; leave blank line before heading
+ (forward-char -1))))))
+\f
+(defun show-branches ()
+ "Show all subheadings of this heading, but not their bodies."
+ (interactive)
+ (show-children 1000))
+
+(defun show-children (&optional level)
+ "Show all direct subheadings of this heading.
+Prefix arg LEVEL is how many levels below the current level should be shown.
+Default is enough to cause the following heading to appear."
+ (interactive "P")
+ (setq level
+ (if level (prefix-numeric-value level)
+ (save-excursion
+ (outline-back-to-heading)
+ (let ((start-level (funcall outline-level)))
+ (outline-next-heading)
+ (if (eobp)
+ 1
+ (max 1 (- (funcall outline-level) start-level)))))))
+ (let (outline-view-change-hook)
+ (save-excursion
+ (outline-back-to-heading)
+ (setq level (+ level (funcall outline-level)))
+ (outline-map-region
+ (lambda ()
+ (if (<= (funcall outline-level) level)
+ (outline-show-heading)))
+ (point)
+ (progn (outline-end-of-subtree)
+ (if (eobp) (point-max) (1+ (point)))))))
+ (run-hooks 'outline-view-change-hook))
+
+\f
+
+(defun outline-up-heading (arg &optional invisible-ok)
+ "Move to the visible heading line of which the present line is a subheading.
+With argument, move up ARG levels.
+If INVISIBLE-OK is non-nil, also consider invisible lines."
+ (interactive "p")
+ (outline-back-to-heading invisible-ok)
+ (let ((start-level (funcall outline-level)))
+ (if (eq start-level 1)
+ (error "Already at top level of the outline"))
+ (while (and (> start-level 1) (> arg 0) (not (bobp)))
+ (let ((level start-level))
+ (while (not (or (< level start-level) (bobp)))
+ (if invisible-ok
+ (outline-previous-heading)
+ (outline-previous-visible-heading 1))
+ (setq level (funcall outline-level)))
+ (setq start-level level))
+ (setq arg (- arg 1))))
+ (looking-at outline-regexp))
+
+(defun outline-forward-same-level (arg)
+ "Move forward to the ARG'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
+ (interactive "p")
+ (outline-back-to-heading)
+ (while (> arg 0)
+ (let ((point-to-move-to (save-excursion
+ (outline-get-next-sibling))))
+ (if point-to-move-to
+ (progn
+ (goto-char point-to-move-to)
+ (setq arg (1- arg)))
+ (progn
+ (setq arg 0)
+ (error "No following same-level heading"))))))
+
+(defun outline-get-next-sibling ()
+ "Move to next heading of the same level, and return point or nil if none."
+ (let ((level (funcall outline-level)))
+ (outline-next-visible-heading 1)
+ (while (and (not (eobp)) (> (funcall outline-level) level))
+ (outline-next-visible-heading 1))
+ (if (or (eobp) (< (funcall outline-level) level))
+ nil
+ (point))))
+
+(defun outline-backward-same-level (arg)
+ "Move backward to the ARG'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
+ (interactive "p")
+ (outline-back-to-heading)
+ (while (> arg 0)
+ (let ((point-to-move-to (save-excursion
+ (outline-get-last-sibling))))
+ (if point-to-move-to
+ (progn
+ (goto-char point-to-move-to)
+ (setq arg (1- arg)))
+ (progn
+ (setq arg 0)
+ (error "No previous same-level heading"))))))
+
+(defun outline-get-last-sibling ()
+ "Move to previous heading of the same level, and return point or nil if none."
+ (let ((level (funcall outline-level)))
+ (outline-previous-visible-heading 1)
+ (while (and (> (funcall outline-level) level)
+ (not (bobp)))
+ (outline-previous-visible-heading 1))
+ (if (< (funcall outline-level) level)
+ nil
+ (point))))
+\f
+(defun outline-headers-as-kill (beg end)
+ "Save the visible outline headers in region at the start of the kill ring.
+
+Text shown between the headers isn't copied. Two newlines are
+inserted between saved headers. Yanking the result may be a
+convenient way to make a table of contents of the buffer."
+ (interactive "r")
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (let ((buffer (current-buffer))
+ start end)
+ (with-temp-buffer
+ (with-current-buffer buffer
+ ;; Boundary condition: starting on heading:
+ (when (outline-on-heading-p)
+ (outline-back-to-heading)
+ (setq start (point)
+ end (progn (outline-end-of-heading)
+ (point)))
+ (insert-buffer-substring buffer start end)
+ (insert "\n\n")))
+ (let ((temp-buffer (current-buffer)))
+ (with-current-buffer buffer
+ (while (outline-next-heading)
+ (unless (outline-invisible-p)
+ (setq start (point)
+ end (progn (outline-end-of-heading) (point)))
+ (with-current-buffer temp-buffer
+ (insert-buffer-substring buffer start end)
+ (insert "\n\n"))))))
+ (kill-new (buffer-string)))))))
+
+(provide 'outline)
+(provide 'noutline)
+
+;;; outline.el ends here
--- /dev/null
+;;; scribe.el --- scribe mode, and its idiosyncratic commands
+
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: wp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; A major mode for editing source in written for the Scribe text formatter.
+;; Knows about Scribe syntax and standard layout rules. The command to
+;; run Scribe on a buffer is bogus; someone interested should fix it.
+
+;;; Code:
+
+(defgroup scribe nil
+ "Scribe mode."
+ :prefix "scribe-"
+ :group 'wp)
+
+(defvar scribe-mode-syntax-table nil
+ "Syntax table used while in scribe mode.")
+
+(defvar scribe-mode-abbrev-table nil
+ "Abbrev table used while in scribe mode.")
+
+(defcustom scribe-fancy-paragraphs nil
+ "*Non-nil makes Scribe mode use a different style of paragraph separation."
+ :type 'boolean
+ :group 'scribe)
+
+(defcustom scribe-electric-quote nil
+ "*Non-nil makes insert of double quote use `` or '' depending on context."
+ :type 'boolean
+ :group 'scribe)
+
+(defcustom scribe-electric-parenthesis nil
+ "*Non-nil makes parenthesis char ( (]}> ) automatically insert its close
+if typed after an @Command form."
+ :type 'boolean
+ :group 'scribe)
+
+(defconst scribe-open-parentheses "[({<"
+ "Open parenthesis characters for Scribe.")
+
+(defconst scribe-close-parentheses "])}>"
+ "Close parenthesis characters for Scribe.
+These should match up with `scribe-open-parenthesis'.")
+
+(if (null scribe-mode-syntax-table)
+ (let ((st (syntax-table)))
+ (unwind-protect
+ (progn
+ (setq scribe-mode-syntax-table (copy-syntax-table
+ text-mode-syntax-table))
+ (set-syntax-table scribe-mode-syntax-table)
+ (modify-syntax-entry ?\" " ")
+ (modify-syntax-entry ?\\ " ")
+ (modify-syntax-entry ?@ "w ")
+ (modify-syntax-entry ?< "(> ")
+ (modify-syntax-entry ?> ")< ")
+ (modify-syntax-entry ?[ "(] ")
+ (modify-syntax-entry ?] ")[ ")
+ (modify-syntax-entry ?{ "(} ")
+ (modify-syntax-entry ?} "){ ")
+ (modify-syntax-entry ?' "w "))
+ (set-syntax-table st))))
+
+(defvar scribe-mode-map nil)
+
+(if scribe-mode-map
+ nil
+ (setq scribe-mode-map (make-sparse-keymap))
+ (define-key scribe-mode-map "\t" 'scribe-tab)
+ (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
+ (define-key scribe-mode-map "\es" 'center-line)
+ (define-key scribe-mode-map "\e}" 'up-list)
+ (define-key scribe-mode-map "\eS" 'center-paragraph)
+ (define-key scribe-mode-map "\"" 'scribe-insert-quote)
+ (define-key scribe-mode-map "(" 'scribe-parenthesis)
+ (define-key scribe-mode-map "[" 'scribe-parenthesis)
+ (define-key scribe-mode-map "{" 'scribe-parenthesis)
+ (define-key scribe-mode-map "<" 'scribe-parenthesis)
+ (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter)
+ (define-key scribe-mode-map "\C-c\C-t" 'scribe-section)
+ (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection)
+ (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment)
+ (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be)
+ (define-key scribe-mode-map "\C-c[" 'scribe-begin)
+ (define-key scribe-mode-map "\C-c]" 'scribe-end)
+ (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word)
+ (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word)
+ (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word))
+
+;;;###autoload
+(define-derived-mode scribe-mode text-mode "Scribe"
+ "Major mode for editing files of Scribe (a text formatter) source.
+Scribe-mode is similar to text-mode, with a few extra commands added.
+\\{scribe-mode-map}
+
+Interesting variables:
+
+`scribe-fancy-paragraphs'
+ Non-nil makes Scribe mode use a different style of paragraph separation.
+
+`scribe-electric-quote'
+ Non-nil makes insert of double quote use `` or '' depending on context.
+
+`scribe-electric-parenthesis'
+ Non-nil makes an open-parenthesis char (one of `([<{')
+ automatically insert its close if typed after an @Command form."
+ (set (make-local-variable 'comment-start) "@Comment[")
+ (set (make-local-variable 'comment-start-skip) (concat "@Comment[" scribe-open-parentheses "]"))
+ (set (make-local-variable 'comment-column) 0)
+ (set (make-local-variable 'comment-end) "]")
+ (set (make-local-variable 'paragraph-start)
+ (concat "\\([\n\f]\\)\\|\\(@\\w+["
+ scribe-open-parentheses
+ "].*["
+ scribe-close-parentheses
+ "]$\\)"))
+ (set (make-local-variable 'paragraph-separate)
+ (if scribe-fancy-paragraphs paragraph-start "$"))
+ (set (make-local-variable 'sentence-end)
+ "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*")
+ (set (make-local-variable 'compile-command)
+ (concat "scribe " (buffer-file-name))))
+
+(defun scribe-tab ()
+ (interactive)
+ (insert "@\\"))
+
+;; This algorithm could probably be improved somewhat.
+;; Right now, it loses seriously...
+
+(defun scribe ()
+ "Run Scribe on the current buffer."
+ (interactive)
+ (call-interactively 'compile))
+
+(defun scribe-envelop-word (string count)
+ "Surround current word with Scribe construct @STRING[...].
+COUNT specifies how many words to surround. A negative count means
+to skip backward."
+ (let ((spos (point)) (epos (point)) (ccoun 0) noparens)
+ (if (not (zerop count))
+ (progn (if (= (char-syntax (preceding-char)) ?w)
+ (forward-sexp (min -1 count)))
+ (setq spos (point))
+ (if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
+ (forward-char 2)
+ (goto-char epos)
+ (skip-chars-backward "\\W")
+ (forward-char -1))
+ (forward-sexp (max count 1))
+ (setq epos (point))))
+ (goto-char spos)
+ (while (and (< ccoun (length scribe-open-parentheses))
+ (save-excursion
+ (or (search-forward (char-to-string
+ (aref scribe-open-parentheses ccoun))
+ epos t)
+ (search-forward (char-to-string
+ (aref scribe-close-parentheses ccoun))
+ epos t)))
+ (setq ccoun (1+ ccoun))))
+ (if (>= ccoun (length scribe-open-parentheses))
+ (progn (goto-char epos)
+ (insert "@end(" string ")")
+ (goto-char spos)
+ (insert "@begin(" string ")"))
+ (goto-char epos)
+ (insert (aref scribe-close-parentheses ccoun))
+ (goto-char spos)
+ (insert "@" string (aref scribe-open-parentheses ccoun))
+ (goto-char epos)
+ (forward-char 3)
+ (skip-chars-forward scribe-close-parentheses))))
+
+(defun scribe-underline-word (count)
+ "Underline COUNT words around point by means of Scribe constructs."
+ (interactive "p")
+ (scribe-envelop-word "u" count))
+
+(defun scribe-bold-word (count)
+ "Boldface COUNT words around point by means of Scribe constructs."
+ (interactive "p")
+ (scribe-envelop-word "b" count))
+
+(defun scribe-italicize-word (count)
+ "Italicize COUNT words around point by means of Scribe constructs."
+ (interactive "p")
+ (scribe-envelop-word "i" count))
+
+(defun scribe-begin ()
+ (interactive)
+ (insert "\n")
+ (forward-char -1)
+ (scribe-envelop-word "Begin" 0)
+ (re-search-forward (concat "[" scribe-open-parentheses "]")))
+
+(defun scribe-end ()
+ (interactive)
+ (insert "\n")
+ (forward-char -1)
+ (scribe-envelop-word "End" 0)
+ (re-search-forward (concat "[" scribe-open-parentheses "]")))
+
+(defun scribe-chapter ()
+ (interactive)
+ (insert "\n")
+ (forward-char -1)
+ (scribe-envelop-word "Chapter" 0)
+ (re-search-forward (concat "[" scribe-open-parentheses "]")))
+
+(defun scribe-section ()
+ (interactive)
+ (insert "\n")
+ (forward-char -1)
+ (scribe-envelop-word "Section" 0)
+ (re-search-forward (concat "[" scribe-open-parentheses "]")))
+
+(defun scribe-subsection ()
+ (interactive)
+ (insert "\n")
+ (forward-char -1)
+ (scribe-envelop-word "SubSection" 0)
+ (re-search-forward (concat "[" scribe-open-parentheses "]")))
+
+(defun scribe-bracket-region-be (env min max)
+ (interactive "sEnvironment: \nr")
+ (save-excursion
+ (goto-char max)
+ (insert "@end(" env ")\n")
+ (goto-char min)
+ (insert "@begin(" env ")\n")))
+
+(defun scribe-insert-environment (env)
+ (interactive "sEnvironment: ")
+ (scribe-bracket-region-be env (point) (point))
+ (forward-line 1)
+ (insert ?\n)
+ (forward-char -1))
+
+(defun scribe-insert-quote (count)
+ "Insert ``, '' or \" according to preceding character.
+If `scribe-electric-quote' is non-nil, insert ``, '' or \" according
+to preceding character. With numeric arg N, always insert N \" characters.
+Else just insert \"."
+ (interactive "P")
+ (if (or count (not scribe-electric-quote))
+ (self-insert-command (prefix-numeric-value count))
+ (let (lastfore lastback lastquote)
+ (insert
+ (cond
+ ((= (preceding-char) ?\\) ?\")
+ ((bobp) "``")
+ (t
+ (setq lastfore (save-excursion (and (search-backward
+ "``" (- (point) 1000) t)
+ (point)))
+ lastback (save-excursion (and (search-backward
+ "''" (- (point) 1000) t)
+ (point)))
+ lastquote (save-excursion (and (search-backward
+ "\"" (- (point) 100) t)
+ (point))))
+ (if (not lastquote)
+ (cond ((not lastfore) "``")
+ ((not lastback) "''")
+ ((> lastfore lastback) "''")
+ (t "``"))
+ (cond ((and (not lastback) (not lastfore)) "\"")
+ ((and lastback (not lastfore) (> lastquote lastback)) "\"")
+ ((and lastback (not lastfore) (> lastback lastquote)) "``")
+ ((and lastfore (not lastback) (> lastquote lastfore)) "\"")
+ ((and lastfore (not lastback) (> lastfore lastquote)) "''")
+ ((and (> lastquote lastfore) (> lastquote lastback)) "\"")
+ ((> lastfore lastback) "''")
+ (t "``")))))))))
+
+(defun scribe-parenthesis (count)
+ "If scribe-electric-parenthesis is non-nil, insertion of an open-parenthesis
+character inserts the following close parenthesis character if the
+preceding text is of the form @Command."
+ (interactive "P")
+ (self-insert-command (prefix-numeric-value count))
+ (let (at-command paren-char point-save)
+ (if (or count (not scribe-electric-parenthesis))
+ nil
+ (save-excursion
+ (forward-char -1)
+ (setq point-save (point))
+ (skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
+ (setq at-command (and (equal (following-char) ?@)
+ (/= (point) (1- point-save)))))
+ (if (and at-command
+ (setq paren-char
+ (string-match (regexp-quote
+ (char-to-string (preceding-char)))
+ scribe-open-parentheses)))
+ (save-excursion
+ (insert (aref scribe-close-parentheses paren-char)))))))
+
+(provide 'scribe)
+
+;;; scribe.el ends here
--- /dev/null
+;;; timer.el --- run a function with args at some time in future
+
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package gives you the capability to run Emacs Lisp commands at
+;; specified times in the future, either as one-shots or periodically.
+
+;;; Code:
+
+;; Layout of a timer vector:
+;; [triggered-p high-seconds low-seconds usecs repeat-delay
+;; function args idle-delay]
+
+(defun timer-create ()
+ "Create a timer object."
+ (let ((timer (make-vector 8 nil)))
+ (aset timer 0 t)
+ timer))
+
+(defun timerp (object)
+ "Return t if OBJECT is a timer."
+ (and (vectorp object) (= (length object) 8)))
+
+(defun timer-set-time (timer time &optional delta)
+ "Set the trigger time of TIMER to TIME.
+TIME must be in the internal format returned by, e.g., `current-time'.
+If optional third argument DELTA is a positive number, make the timer
+fire repeatedly that many seconds apart."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (aset timer 1 (car time))
+ (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
+ (aset timer 3 (or (and (consp (cdr time)) (consp (cdr (cdr time)))
+ (nth 2 time))
+ 0))
+ (aset timer 4 (and (numberp delta) (> delta 0) delta))
+ timer)
+
+(defun timer-set-idle-time (timer secs &optional repeat)
+ "Set the trigger idle time of TIMER to SECS.
+If optional third argument REPEAT is non-nil, make the timer
+fire each time Emacs is idle for that many seconds."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (aset timer 1 0)
+ (aset timer 2 0)
+ (aset timer 3 0)
+ (timer-inc-time timer secs)
+ (aset timer 4 repeat)
+ timer)
+
+(defun timer-next-integral-multiple-of-time (time secs)
+ "Yield the next value after TIME that is an integral multiple of SECS.
+More precisely, the next value, after TIME, that is an integral multiple
+of SECS seconds since the epoch. SECS may be a fraction."
+ (let ((time-base (ash 1 16)))
+ (if (fboundp 'atan)
+ ;; Use floating point, taking care to not lose precision.
+ (let* ((float-time-base (float time-base))
+ (million 1000000.0)
+ (time-usec (+ (* million
+ (+ (* float-time-base (nth 0 time))
+ (nth 1 time)))
+ (nth 2 time)))
+ (secs-usec (* million secs))
+ (mod-usec (mod time-usec secs-usec))
+ (next-usec (+ (- time-usec mod-usec) secs-usec))
+ (time-base-million (* float-time-base million)))
+ (list (floor next-usec time-base-million)
+ (floor (mod next-usec time-base-million) million)
+ (floor (mod next-usec million))))
+ ;; Floating point is not supported.
+ ;; Use integer arithmetic, avoiding overflow if possible.
+ (let* ((mod-sec (mod (+ (* (mod time-base secs)
+ (mod (nth 0 time) secs))
+ (nth 1 time))
+ secs))
+ (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
+ (list (+ (nth 0 time) (floor next-1-sec time-base))
+ (mod next-1-sec time-base)
+ 0)))))
+
+(defun timer-relative-time (time secs &optional usecs)
+ "Advance TIME by SECS seconds and optionally USECS microseconds.
+SECS may be a fraction."
+ (let ((high (car time))
+ (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
+ (micro (if (numberp (car-safe (cdr-safe (cdr time))))
+ (nth 2 time)
+ 0)))
+ ;; Add
+ (if usecs (setq micro (+ micro usecs)))
+ (if (floatp secs)
+ (setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
+ (setq low (+ low (floor secs)))
+
+ ;; Normalize
+ ;; `/' rounds towards zero while `mod' returns a positive number,
+ ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
+ (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
+ (setq micro (mod micro 1000000))
+ (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
+ (setq low (logand low 65535))
+
+ (list high low (and (/= micro 0) micro))))
+
+(defun timer-inc-time (timer secs &optional usecs)
+ "Increment the time set in TIMER by SECS seconds and USECS microseconds.
+SECS may be a fraction. If USECS is omitted, that means it is zero."
+ (let ((time (timer-relative-time
+ (list (aref timer 1) (aref timer 2) (aref timer 3))
+ secs
+ usecs)))
+ (aset timer 1 (nth 0 time))
+ (aset timer 2 (nth 1 time))
+ (aset timer 3 (or (nth 2 time) 0))))
+
+(defun timer-set-time-with-usecs (timer time usecs &optional delta)
+ "Set the trigger time of TIMER to TIME plus USECS.
+TIME must be in the internal format returned by, e.g., `current-time'.
+The microsecond count from TIME is ignored, and USECS is used instead.
+If optional fourth argument DELTA is a positive number, make the timer
+fire repeatedly that many seconds apart."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (aset timer 1 (nth 0 time))
+ (aset timer 2 (nth 1 time))
+ (aset timer 3 usecs)
+ (aset timer 4 (and (numberp delta) (> delta 0) delta))
+ timer)
+(make-obsolete 'timer-set-time-with-usecs
+ "use `timer-set-time' and `timer-inc-time' instead."
+ "21.4")
+
+(defun timer-set-function (timer function &optional args)
+ "Make TIMER call FUNCTION with optional ARGS when triggering."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (aset timer 5 function)
+ (aset timer 6 args)
+ timer)
+\f
+(defun timer-activate (timer)
+ "Put TIMER on the list of active timers."
+ (if (and (timerp timer)
+ (integerp (aref timer 1))
+ (integerp (aref timer 2))
+ (integerp (aref timer 3))
+ (aref timer 5))
+ (let ((timers timer-list)
+ last)
+ ;; Skip all timers to trigger before the new one.
+ (while (and timers
+ (or (> (aref timer 1) (aref (car timers) 1))
+ (and (= (aref timer 1) (aref (car timers) 1))
+ (> (aref timer 2) (aref (car timers) 2)))
+ (and (= (aref timer 1) (aref (car timers) 1))
+ (= (aref timer 2) (aref (car timers) 2))
+ (> (aref timer 3) (aref (car timers) 3)))))
+ (setq last timers
+ timers (cdr timers)))
+ ;; Insert new timer after last which possibly means in front of queue.
+ (if last
+ (setcdr last (cons timer timers))
+ (setq timer-list (cons timer timers)))
+ (aset timer 0 nil)
+ (aset timer 7 nil)
+ nil)
+ (error "Invalid or uninitialized timer")))
+
+(defun timer-activate-when-idle (timer &optional dont-wait)
+ "Arrange to activate TIMER whenever Emacs is next idle.
+If optional argument DONT-WAIT is non-nil, then enable the
+timer to activate immediately, or at the right time, if Emacs
+is already idle."
+ (if (and (timerp timer)
+ (integerp (aref timer 1))
+ (integerp (aref timer 2))
+ (integerp (aref timer 3))
+ (aref timer 5))
+ (let ((timers timer-idle-list)
+ last)
+ ;; Skip all timers to trigger before the new one.
+ (while (and timers
+ (or (> (aref timer 1) (aref (car timers) 1))
+ (and (= (aref timer 1) (aref (car timers) 1))
+ (> (aref timer 2) (aref (car timers) 2)))
+ (and (= (aref timer 1) (aref (car timers) 1))
+ (= (aref timer 2) (aref (car timers) 2))
+ (> (aref timer 3) (aref (car timers) 3)))))
+ (setq last timers
+ timers (cdr timers)))
+ ;; Insert new timer after last which possibly means in front of queue.
+ (if last
+ (setcdr last (cons timer timers))
+ (setq timer-idle-list (cons timer timers)))
+ (aset timer 0 (not dont-wait))
+ (aset timer 7 t)
+ nil)
+ (error "Invalid or uninitialized timer")))
+
+;;;###autoload
+(defalias 'disable-timeout 'cancel-timer)
+;;;###autoload
+(defun cancel-timer (timer)
+ "Remove TIMER from the list of active timers."
+ (or (timerp timer)
+ (error "Invalid timer"))
+ (setq timer-list (delq timer timer-list))
+ (setq timer-idle-list (delq timer timer-idle-list))
+ nil)
+
+;;;###autoload
+(defun cancel-function-timers (function)
+ "Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
+ (interactive "aCancel timers of function: ")
+ (let ((tail timer-list))
+ (while tail
+ (if (eq (aref (car tail) 5) function)
+ (setq timer-list (delq (car tail) timer-list)))
+ (setq tail (cdr tail))))
+ (let ((tail timer-idle-list))
+ (while tail
+ (if (eq (aref (car tail) 5) function)
+ (setq timer-idle-list (delq (car tail) timer-idle-list)))
+ (setq tail (cdr tail)))))
+\f
+;; Record the last few events, for debugging.
+(defvar timer-event-last-2 nil)
+(defvar timer-event-last-1 nil)
+(defvar timer-event-last nil)
+
+(defvar timer-max-repeats 10
+ "*Maximum number of times to repeat a timer, if real time jumps.")
+
+(defun timer-until (timer time)
+ "Calculate number of seconds from when TIMER will run, until TIME.
+TIMER is a timer, and stands for the time when its next repeat is scheduled.
+TIME is a time-list."
+ (let ((high (- (car time) (aref timer 1)))
+ (low (- (nth 1 time) (aref timer 2))))
+ (+ low (* high 65536))))
+
+(defun timer-event-handler (timer)
+ "Call the handler for the timer TIMER.
+This function is called, by name, directly by the C code."
+ (setq timer-event-last-2 timer-event-last-1)
+ (setq timer-event-last-1 timer-event-last)
+ (setq timer-event-last timer)
+ (let ((inhibit-quit t))
+ (if (timerp timer)
+ (progn
+ ;; Delete from queue.
+ (cancel-timer timer)
+ ;; Re-schedule if requested.
+ (if (aref timer 4)
+ (if (aref timer 7)
+ (timer-activate-when-idle timer)
+ (timer-inc-time timer (aref timer 4) 0)
+ ;; If real time has jumped forward,
+ ;; perhaps because Emacs was suspended for a long time,
+ ;; limit how many times things get repeated.
+ (if (and (numberp timer-max-repeats)
+ (< 0 (timer-until timer (current-time))))
+ (let ((repeats (/ (timer-until timer (current-time))
+ (aref timer 4))))
+ (if (> repeats timer-max-repeats)
+ (timer-inc-time timer (* (aref timer 4) repeats)))))
+ (timer-activate timer)))
+ ;; Run handler.
+ ;; We do this after rescheduling so that the handler function
+ ;; can cancel its own timer successfully with cancel-timer.
+ (condition-case nil
+ (apply (aref timer 5) (aref timer 6))
+ (error nil)))
+ (error "Bogus timer event"))))
+
+;; This function is incompatible with the one in levents.el.
+(defun timeout-event-p (event)
+ "Non-nil if EVENT is a timeout event."
+ (and (listp event) (eq (car event) 'timer-event)))
+\f
+;;;###autoload
+(defun run-at-time (time repeat function &rest args)
+ "Perform an action at time TIME.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds
+from now, a value from `current-time', or t (with non-nil REPEAT)
+meaning the next integral multiple of REPEAT.
+REPEAT may be an integer or floating point number.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+ (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
+
+ (or (null repeat)
+ (and (numberp repeat) (< 0 repeat))
+ (error "Invalid repetition interval"))
+
+ ;; Special case: nil means "now" and is useful when repeating.
+ (if (null time)
+ (setq time (current-time)))
+
+ ;; Special case: t means the next integral multiple of REPEAT.
+ (if (and (eq time t) repeat)
+ (setq time (timer-next-integral-multiple-of-time (current-time) repeat)))
+
+ ;; Handle numbers as relative times in seconds.
+ (if (numberp time)
+ (setq time (timer-relative-time (current-time) time)))
+
+ ;; Handle relative times like "2 hours and 35 minutes"
+ (if (stringp time)
+ (let ((secs (timer-duration time)))
+ (if secs
+ (setq time (timer-relative-time (current-time) secs)))))
+
+ ;; Handle "11:23pm" and the like. Interpret it as meaning today
+ ;; which admittedly is rather stupid if we have passed that time
+ ;; already. (Though only Emacs hackers hack Emacs at that time.)
+ (if (stringp time)
+ (progn
+ (require 'diary-lib)
+ (let ((hhmm (diary-entry-time time))
+ (now (decode-time)))
+ (if (>= hhmm 0)
+ (setq time
+ (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
+ (nth 4 now) (nth 5 now) (nth 8 now)))))))
+
+ (or (consp time)
+ (error "Invalid time format"))
+
+ (let ((timer (timer-create)))
+ (timer-set-time timer time repeat)
+ (timer-set-function timer function args)
+ (timer-activate timer)
+ timer))
+
+;;;###autoload
+(defun run-with-timer (secs repeat function &rest args)
+ "Perform an action after a delay of SECS seconds.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+SECS and REPEAT may be integers or floating point numbers.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+ (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
+ (apply 'run-at-time secs repeat function args))
+
+;;;###autoload
+(defun add-timeout (secs function object &optional repeat)
+ "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
+If REPEAT is non-nil, repeat the timer every REPEAT seconds.
+This function is for compatibility; see also `run-with-timer'."
+ (run-with-timer secs repeat function object))
+
+;;;###autoload
+(defun run-with-idle-timer (secs repeat function &rest args)
+ "Perform an action the next time Emacs is idle for SECS seconds.
+The action is to call FUNCTION with arguments ARGS.
+SECS may be an integer or a floating point number.
+
+If REPEAT is non-nil, do the action each time Emacs has been idle for
+exactly SECS seconds (that is, only once for each time Emacs becomes idle).
+
+This function returns a timer object which you can use in `cancel-timer'."
+ (interactive
+ (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
+ (y-or-n-p "Repeat each time Emacs is idle? ")
+ (intern (completing-read "Function: " obarray 'fboundp t))))
+ (let ((timer (timer-create)))
+ (timer-set-function timer function args)
+ (timer-set-idle-time timer secs repeat)
+ (timer-activate-when-idle timer)
+ timer))
+\f
+(defun with-timeout-handler (tag)
+ (throw tag 'timeout))
+
+;;;###autoload (put 'with-timeout 'lisp-indent-function 1)
+
+;;;###autoload
+(defmacro with-timeout (list &rest body)
+ "Run BODY, but if it doesn't finish in SECONDS seconds, give up.
+If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
+The call should look like:
+ (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
+The timeout is checked whenever Emacs waits for some kind of external
+event \(such as keyboard input, input from subprocesses, or a certain time);
+if the program loops without waiting in any way, the timeout will not
+be detected."
+ (let ((seconds (car list))
+ (timeout-forms (cdr list)))
+ `(let ((with-timeout-tag (cons nil nil))
+ with-timeout-value with-timeout-timer)
+ (if (catch with-timeout-tag
+ (progn
+ (setq with-timeout-timer
+ (run-with-timer ,seconds nil
+ 'with-timeout-handler
+ with-timeout-tag))
+ (setq with-timeout-value (progn . ,body))
+ nil))
+ (progn . ,timeout-forms)
+ (cancel-timer with-timeout-timer)
+ with-timeout-value))))
+
+(defun y-or-n-p-with-timeout (prompt seconds default-value)
+ "Like (y-or-n-p PROMPT), with a timeout.
+If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
+ (with-timeout (seconds default-value)
+ (y-or-n-p prompt)))
+\f
+(defvar timer-duration-words
+ (list (cons "microsec" 0.000001)
+ (cons "microsecond" 0.000001)
+ (cons "millisec" 0.001)
+ (cons "millisecond" 0.001)
+ (cons "sec" 1)
+ (cons "second" 1)
+ (cons "min" 60)
+ (cons "minute" 60)
+ (cons "hour" (* 60 60))
+ (cons "day" (* 24 60 60))
+ (cons "week" (* 7 24 60 60))
+ (cons "fortnight" (* 14 24 60 60))
+ (cons "month" (* 30 24 60 60)) ; Approximation
+ (cons "year" (* 365.25 24 60 60)) ; Approximation
+ )
+ "Alist mapping temporal words to durations in seconds")
+
+(defun timer-duration (string)
+ "Return number of seconds specified by STRING, or nil if parsing fails."
+ (let ((secs 0)
+ (start 0)
+ (case-fold-search t))
+ (while (string-match
+ "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*"
+ string start)
+ (let ((count (if (match-beginning 1)
+ (string-to-number (match-string 1 string))
+ 1))
+ (itemsize (cdr (assoc (match-string 2 string)
+ timer-duration-words))))
+ (if itemsize
+ (setq start (match-end 0)
+ secs (+ secs (* count itemsize)))
+ (setq secs nil
+ start (length string)))))
+ (if (= start (length string))
+ secs
+ (if (string-match "\\`[0-9.]+\\'" string)
+ (string-to-number string)))))
+\f
+(provide 'timer)
+
+;;; timer.el ends here
--- /dev/null
+;;; unused.el --- editing commands in GNU Emacs that turned out not to be used
+;;; This file is in the public domain, as it was distributed in
+;;; 1985 or 1986 without a copyright notice. Written by RMS.
+
+;; This file is part of GNU Emacs.
+
+;; Maintainer: FSF
+;; Keywords: emulations
+
+;;; Commentary:
+
+;; These were added with an eye to making possible a more CCA-compatible
+;; command set; but that turned out not to be interesting.
+
+;;; Code:
+
+(defun mark-beginning-of-buffer ()
+ "Set mark at the beginning of the buffer."
+ (interactive)
+ (push-mark (point-min)))
+
+(defun mark-end-of-buffer ()
+ "Set mark at the end of the buffer."
+ (interactive)
+ (push-mark (point-max)))
+
+(defun upcase-char (arg)
+ "Uppercasify ARG chars starting from point. Point doesn't move"
+ (interactive "p")
+ (save-excursion
+ (upcase-region (point) (progn (forward-char arg) (point)))))
+
+(defun forward-to-word (arg)
+ "Move forward until encountering the beginning of a word.
+With argument, do this that many times."
+ (interactive "p")
+ (or (re-search-forward (if (> arg 0) "\\W\\b" "\\b\\W") nil t arg)
+ (goto-char (if (> arg 0) (point-max) (point-min)))))
+
+(defun backward-to-word (arg)
+ "Move backward until encountering the end of a word.
+With argument, do this that many times."
+ (interactive "p")
+ (forward-to-word (- arg)))
+
+;;; unused.el ends here
;;; vc-hooks.el --- resident support for version-control
-;; Copyright (C) 1992,93,94,95,96,98,99,2000,2003
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1992,93,94,95,96,98,99,2000 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-hooks.el,v 1.150 2003/05/08 17:45:08 monnier Exp $
+;; $Id: vc-hooks.el,v 1.149 2003/05/07 17:22:28 monnier Exp $
;; This file is part of GNU Emacs.
(apply 'vc-default-FUN BACKEND ARGS)
It is usually called via the `vc-call' macro."
- (let ((f (assoc function-name (get backend 'vc-functions))))
- (if f (setq f (cdr f))
+ (let ((f (cdr (assoc function-name (get backend 'vc-functions)))))
+ (unless f
(setq f (vc-find-backend-function backend function-name))
- (push (cons function-name f) (get backend 'vc-functions)))
- (cond
- ((null f)
- (error "Sorry, %s is not implemented for %s" function-name backend))
- ((consp f) (apply (car f) (cdr f) args))
- (t (apply f args)))))
+ (put backend 'vc-functions (cons (cons function-name f)
+ (get backend 'vc-functions))))
+ (if (consp f)
+ (apply (car f) (cdr f) args)
+ (apply f args))))
(defmacro vc-call (fun file &rest args)
;; BEWARE!! `file' is evaluated twice!!
(vc-file-clearprops buffer-file-name)
(cond
((vc-backend buffer-file-name)
- ;; Compute the state and put it in the modeline.
(vc-mode-line buffer-file-name)
- (unless vc-make-backup-files
- ;; Use this variable, not make-backup-files,
- ;; because this is for things that depend on the file name.
- (set (make-local-variable 'backup-inhibited) t)))
+ (cond ((not vc-make-backup-files)
+ ;; Use this variable, not make-backup-files,
+ ;; because this is for things that depend on the file name.
+ (make-local-variable 'backup-inhibited)
+ (setq backup-inhibited t))))
((let* ((link (file-symlink-p buffer-file-name))
(link-type (and link (vc-backend (file-chase-links link)))))
- (cond ((not link-type) nil) ;Nothing to do.
- ((eq vc-follow-symlinks nil)
- (message
+ (if link-type
+ (cond ((eq vc-follow-symlinks nil)
+ (message
"Warning: symbolic link to %s-controlled source file" link-type))
- ((or (not (eq vc-follow-symlinks 'ask))
- ;; If we already visited this file by following
- ;; the link, don't ask again if we try to visit
- ;; it again. GUD does that, and repeated questions
- ;; are painful.
- (get-file-buffer
- (abbreviate-file-name
- (file-chase-links buffer-file-name))))
-
- (vc-follow-link)
- (message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))
- (t
- (if (yes-or-no-p (format
+ ((or (not (eq vc-follow-symlinks 'ask))
+ ;; If we already visited this file by following
+ ;; the link, don't ask again if we try to visit
+ ;; it again. GUD does that, and repeated questions
+ ;; are painful.
+ (get-file-buffer
+ (abbreviate-file-name
+ (file-chase-links buffer-file-name))))
+
+ (vc-follow-link)
+ (message "Followed link to %s" buffer-file-name)
+ (vc-find-file-hook))
+ (t
+ (if (yes-or-no-p (format
"Symbolic link to %s-controlled source file; follow link? " link-type))
- (progn (vc-follow-link)
- (message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))
- (message
+ (progn (vc-follow-link)
+ (message "Followed link to %s" buffer-file-name)
+ (vc-find-file-hook))
+ (message
"Warning: editing through the link bypasses version control")
- ))))))))
+ )))))))))
(add-hook 'find-file-hook 'vc-find-file-hook)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
;; Keywords: tools
-;; $Id: vc.el,v 1.354 2003/05/26 10:33:00 spiegel Exp $
+;; $Id: vc.el,v 1.353 2003/05/18 02:53:24 monnier Exp $
;; This file is part of GNU Emacs.
;; to be installed somewhere on Emacs's path for executables.
;;
;; If your site uses the ChangeLog convention supported by Emacs, the
-;; function log-edit-comment-to-change-log could prove a useful checkin hook,
-;; although you might prefer to use C-c C-a (i.e. log-edit-insert-changelog)
-;; from the commit buffer instead or to set `log-edit-setup-invert'.
+;; function vc-comment-to-change-log should prove a useful checkin hook.
;;
;; The vc code maintains some internal state in order to reduce expensive
;; version-control operations to a minimum. Some names are only computed
:group 'vc
:version "20.3")
-(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn")
+(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
"*List of directory names to be ignored when walking directory trees."
:type '(repeat string)
:group 'vc)
;;;###autoload
(defcustom vc-checkin-hook nil
"*Normal hook (list of functions) run after a checkin is done.
-See also `log-edit-done-hook'."
+See `run-hooks'."
:type 'hook
- :options '(log-edit-comment-to-change-log)
+ :options '(vc-comment-to-change-log)
:group 'vc)
;;;###autoload
This command runs the normal hook `view-mode-hook'."
(interactive "fView file: ")
- (unless (file-exists-p file) (error "%s does not exist" file))
(let ((had-a-buf (get-file-buffer file)))
(view-buffer (find-file-noselect file)
(and (not had-a-buf) 'kill-buffer))))
This command runs the normal hook `view-mode-hook'."
(interactive "fIn other window view file: ")
- (unless (file-exists-p file) (error "%s does not exist" file))
(let ((had-a-buf (get-file-buffer file)))
(view-buffer-other-window (find-file-noselect file) nil
(and (not had-a-buf) 'kill-buffer))))
This command runs the normal hook `view-mode-hook'."
(interactive "fIn other frame view file: ")
- (unless (file-exists-p file) (error "%s does not exist" file))
(let ((had-a-buf (get-file-buffer file)))
(view-buffer-other-frame (find-file-noselect file) nil
(and (not had-a-buf) 'kill-buffer))))
--- /dev/null
+;;; warnings.el --- log and display warnings
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file implements the entry points `warn', `lwarn'
+;; and `display-warnings'.
+
+;;; Code:
+
+(defgroup warnings nil
+ "Log and display warnings."
+ :version "21.4"
+ :group 'lisp)
+
+(defvar warning-levels
+ '((:emergency "Emergency%s: " ding)
+ (:error "Error%s: ")
+ (:warning "Warning%s: ")
+ (:debug "Debug%s: "))
+ "List of severity level definitions for `display-warning'.
+Each element looks like (LEVEL STRING FUNCTION) and
+defines LEVEL as a severity level. STRING specifies the
+description of this level. STRING should use `%s' to
+specify where to put the warning group information,
+or it can omit the `%s' so as not to include that information.
+
+The optional FUNCTION, if non-nil, is a function to call
+with no arguments, to get the user's attention.
+
+The standard levels are :emergency, :error, :warning and :debug.
+See `display-warning' for documentation of their meanings.
+Level :debug is ignored by default (see `warning-minimum-level').")
+(put 'warning-levels 'risky-local-variable t)
+
+;; These are for compatibility with XEmacs.
+;; I don't think there is any chance of designing meaningful criteria
+;; to distinguish so many levels.
+(defvar warning-level-aliases
+ '((emergency . :emergency)
+ (error . :error)
+ (warning . :warning)
+ (notice . :warning)
+ (info . :warning)
+ (critical . :emergency)
+ (alarm . :emergency))
+ "Alist of aliases for severity levels for `display-warning'.
+Each element looks like (ALIAS . LEVEL) and defines
+ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels';
+it may not itself be an alias.")
+\f
+(defcustom warning-minimum-level :warning
+ "Minimum severity level for displaying the warning buffer.
+If a warning's severity level is lower than this,
+the warning is logged in the warnings buffer, but the buffer
+is not immediately displayed. See also `warning-minimum-log-level'."
+ :group 'warnings
+ :type '(choice (const :emergency) (const :error) (const :warning))
+ :version "21.4")
+(defvaralias 'display-warning-minimum-level 'warning-minimum-level)
+
+(defcustom warning-minimum-log-level :warning
+ "Minimum severity level for logging a warning.
+If a warning severity level is lower than this,
+the warning is completely ignored."
+ :group 'warnings
+ :type '(choice (const :emergency) (const :error) (const :warning))
+ :version "21.4")
+(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)
+
+(defcustom warning-suppress-log-types nil
+ "List of warning types that should not be logged.
+If any element of this list matches the GROUP argument to `display-warning',
+the warning is completely ignored.
+The element must match the first elements of GROUP.
+Thus, (foo bar) as an element matches (foo bar)
+or (foo bar ANYTHING...) as GROUP.
+If GROUP is a symbol FOO, that is equivalent to the list (FOO),
+so only the element (FOO) will match it."
+ :group 'warnings
+ :type '(repeat (repeat symbol))
+ :version "21.4")
+
+(defcustom warning-suppress-types nil
+ "Custom groups for warnings not to display immediately.
+If any element of this list matches the GROUP argument to `display-warning',
+the warning is logged nonetheless, but the warnings buffer is
+not immediately displayed.
+The element must match an initial segment of the list GROUP.
+Thus, (foo bar) as an element matches (foo bar)
+or (foo bar ANYTHING...) as GROUP.
+If GROUP is a symbol FOO, that is equivalent to the list (FOO),
+so only the element (FOO) will match it.
+See also `warning-suppress-log-types'."
+ :group 'warnings
+ :type '(repeat (repeat symbol))
+ :version "21.4")
+\f
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
+(defvar warning-prefix-function nil
+ "Function to generate warning prefixes.
+This function, if non-nil, is called with two arguments,
+the severity level and its entry in `warning-levels',
+and should return the entry that should actually be used.
+The warnings buffer is current when this function is called
+and the function can insert text in it. This text becomes
+the beginning of the warning.")
+
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
+(defvar warning-series nil
+ "Non-nil means treat multiple `display-warning' calls as a series.
+A marker indicates a position in the warnings buffer
+which is the start of the current series; it means that
+additional warnings in the same buffer should not move point.
+t means the next warning begins a series (and stores a marker here).
+A symbol with a function definition is like t, except
+also call that function before the next warning.")
+(put 'warning-series 'risky-local-variable t)
+
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
+(defvar warning-fill-prefix nil
+ "Non-nil means fill each warning text using this string as `fill-prefix'.")
+
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
+(defvar warning-group-format " (%s)"
+ "Format for displaying the warning group in the warning message.
+The result of formatting the group this way gets included in the
+message under the control of the string in `warning-levels'.")
+\f
+(defun warning-numeric-level (level)
+ "Return a numeric measure of the warning severity level LEVEL."
+ (let* ((elt (assq level warning-levels))
+ (link (memq elt warning-levels)))
+ (length link)))
+
+(defun warning-suppress-p (group suppress-list)
+ "Non-nil if a warning with group GROUP should be suppressed.
+SUPPRESS-LIST is the list of kinds of warnings to suppress."
+ (let (some-match)
+ (dolist (elt suppress-list)
+ (if (symbolp group)
+ ;; If GROUP is a symbol, the ELT must be (GROUP).
+ (if (and (consp elt)
+ (eq (car elt) group)
+ (null (cdr elt)))
+ (setq some-match t))
+ ;; If GROUP is a list, ELT must match it or some initial segment of it.
+ (let ((tem1 group)
+ (tem2 elt)
+ (match t))
+ ;; Check elements of ELT until we run out of them.
+ (while tem2
+ (if (not (equal (car tem1) (car tem2)))
+ (setq match nil))
+ (setq tem1 (cdr tem1)
+ tem2 (cdr tem2)))
+ ;; If ELT is an initial segment of GROUP, MATCH is t now.
+ ;; So set SOME-MATCH.
+ (if match
+ (setq some-match t)))))
+ ;; If some element of SUPPRESS-LIST matched,
+ ;; we return t.
+ some-match))
+\f
+;;;###autoload
+(defun display-warning (group message &optional level buffer-name)
+ "Display a warning message, MESSAGE.
+GROUP should be a custom group name (a symbol),
+or else a list of symbols whose first element is a custom group name.
+\(The rest of the symbols represent subcategories, for warning purposes
+only, and you can use whatever symbols you like.)
+
+LEVEL should be either :warning, :error, or :emergency.
+:emergency -- a problem that will seriously impair Emacs operation soon
+ if you do not attend to it promptly.
+:error -- data or circumstances that are inherently wrong.
+:warning -- data or circumstances that are not inherently wrong,
+ but raise suspicion of a possible problem.
+:debug -- info for debugging only.
+
+BUFFER-NAME, if specified, is the name of the buffer for logging the
+warning. By default, it is `*Warnings*'.
+
+See the `warnings' custom group for user customization features.
+
+See also `warning-series', `warning-prefix-function' and
+`warning-fill-prefix' for additional programming features."
+ (unless level
+ (setq level :warning))
+ (if (assq level warning-level-aliases)
+ (setq level (cdr (assq level warning-level-aliases))))
+ (or (< (warning-numeric-level level)
+ (warning-numeric-level warning-minimum-log-level))
+ (warning-suppress-p group warning-suppress-log-types)
+ (let* ((groupname (if (consp group) (car group) group))
+ (buffer (get-buffer-create (or buffer-name "*Warnings*")))
+ (level-info (assq level warning-levels))
+ start end)
+ (with-current-buffer buffer
+ (goto-char (point-max))
+ (when (and warning-series (symbolp warning-series))
+ (setq warning-series
+ (prog1 (point-marker)
+ (unless (eq warning-series t)
+ (funcall warning-series)))))
+ (unless (bolp)
+ (newline))
+ (setq start (point))
+ (if warning-prefix-function
+ (setq level-info (funcall warning-prefix-function
+ level level-info)))
+ (insert (format (nth 1 level-info)
+ (format warning-group-format groupname))
+ message)
+ (newline)
+ (when (and warning-fill-prefix (not (string-match "\n" message)))
+ (let ((fill-prefix warning-fill-prefix)
+ (fill-column 78))
+ (fill-region start (point))))
+ (setq end (point))
+ (when (and (markerp warning-series)
+ (eq (marker-buffer warning-series) buffer))
+ (goto-char warning-series)))
+ (if (nth 2 level-info)
+ (funcall (nth 2 level-info)))
+ (if noninteractive
+ ;; Noninteractively, take the text we inserted
+ ;; in the warnings buffer and print it.
+ ;; Do this unconditionally, since there is no way
+ ;; to view logged messages unless we output them.
+ (with-current-buffer buffer
+ (save-excursion
+ ;; Don't include the final newline in the arg
+ ;; to `message', because it adds a newline.
+ (goto-char end)
+ (if (bolp)
+ (forward-char -1))
+ (message "%s" (buffer-substring start (point)))))
+ ;; Interactively, decide whether the warning merits
+ ;; immediate display.
+ (or (< (warning-numeric-level level)
+ (warning-numeric-level warning-minimum-level))
+ (warning-suppress-p group warning-suppress-types)
+ (let ((window (display-buffer buffer)))
+ (when (and (markerp warning-series)
+ (eq (marker-buffer warning-series) buffer))
+ (set-window-start window warning-series))
+ (sit-for 0)))))))
+\f
+;;;###autoload
+(defun lwarn (group level message &rest args)
+ "Display a warning message made from (format MESSAGE ARGS...).
+Aside from generating the message with `format',
+this is equivalent to `display-warning'.
+
+GROUP should be a custom group name (a symbol).
+or else a list of symbols whose first element is a custom group name.
+\(The rest of the symbols represent subcategories and
+can be whatever you like.)
+
+LEVEL should be either :warning, :error, or :emergency.
+:emergency -- a problem that will seriously impair Emacs operation soon
+ if you do not attend to it promptly.
+:error -- invalid data or circumstances.
+:warning -- suspicious data or circumstances."
+ (display-warning group (apply 'format message args) level))
+
+;;;###autoload
+(defun warn (message &rest args)
+ "Display a warning message made from (format MESSAGE ARGS...).
+Aside from generating the message with `format',
+this is equivalent to `display-warning', using
+`emacs' as the group and `:warning' as the level."
+ (display-warning 'emacs (apply 'format message args)))
+
+(provide 'warnings)
+
+;;; warnings.el ends here
--- /dev/null
+;;; which-func.el --- print current function in mode line
+
+;; Copyright (C) 1994, 1997, 1998, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
+;; (doesn't seem to be responsive any more)
+;; Keywords: mode-line, imenu, tools
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package prints name of function where your current point is
+;; located in mode line. It assumes that you work with imenu package
+;; and imenu--index-alist is up to date.
+
+;; KNOWN BUGS
+;; ----------
+;; Really this package shows not "function where the current point is
+;; located now", but "nearest function which defined above the current
+;; point". So if your current point is located after end of function
+;; FOO but before begin of function BAR, FOO will be displayed in mode
+;; line.
+;; - if two windows display the same buffer, both windows
+;; show the same `which-func' information.
+
+;; TODO LIST
+;; ---------
+;; 1. Dependence on imenu package should be removed. Separate
+;; function determination mechanism should be used to determine the end
+;; of a function as well as the beginning of a function.
+;; 2. This package should be realized with the help of overlay
+;; properties instead of imenu--index-alist variable.
+
+;;; History:
+
+;; THANKS TO
+;; ---------
+;; Per Abrahamsen <abraham@iesd.auc.dk>
+;; Some ideas (inserting in mode-line, using of post-command hook
+;; and toggling this mode) have been borrowed from his package
+;; column.el
+;; Peter Eisenhauer <pipe@fzi.de>
+;; Bug fixing in case nested indexes.
+;; Terry Tateyama <ttt@ursa0.cs.utah.edu>
+;; Suggestion to use find-file-hook for first imenu
+;; index building.
+
+;;; Code:
+
+;; Variables for customization
+;; ---------------------------
+;;
+(defvar which-func-unknown "???"
+ "String to display in the mode line when current function is unknown.")
+
+(defgroup which-func nil
+ "Mode to display the current function name in the modeline."
+ :group 'tools
+ :version "20.3")
+
+(defcustom which-func-modes
+ '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode makefile-mode
+ sh-mode fortran-mode f90-mode)
+ "List of major modes for which Which Function mode should be used.
+For other modes it is disabled. If this is equal to t,
+then Which Function mode is enabled in any major mode that supports it."
+ :group 'which-func
+ :type '(choice (const :tag "All modes" t)
+ (repeat (symbol :tag "Major mode"))))
+
+(defcustom which-func-non-auto-modes nil
+ "List of major modes where Which Function mode is inactive till Imenu is used.
+This means that Which Function mode won't really do anything
+until you use Imenu, in these modes. Note that files
+larger than `which-func-maxout' behave in this way too;
+Which Function mode doesn't do anything until you use Imenu."
+ :group 'which-func
+ :type '(repeat (symbol :tag "Major mode")))
+
+(defcustom which-func-maxout 500000
+ "Don't automatically compute the Imenu menu if buffer is this big or bigger.
+Zero means compute the Imenu menu regardless of size."
+ :group 'which-func
+ :type 'integer)
+
+(defcustom which-func-format '("[" which-func-current "]")
+ "Format for displaying the function in the mode line."
+ :group 'which-func
+ :type 'sexp)
+;;;###autoload (put 'which-func-format 'risky-local-variable t)
+
+(defvar which-func-cleanup-function nil
+ "Function to transform a string before displaying it in the mode line.
+The function is called with one argument, the string to display.
+Its return value is displayed in the modeline.
+If nil, no function is called. The default value is nil.
+
+This feature can be useful if Imenu is set up to make more
+detailed entries (e.g., containing the argument list of a function),
+and you want to simplify them for the mode line
+\(e.g., removing the parameter list to just have the function name.)")
+
+;;; Code, nothing to customize below here
+;;; -------------------------------------
+;;;
+(require 'imenu)
+
+(defvar which-func-table (make-hash-table :test 'eq :weakness 'key))
+
+(defconst which-func-current
+ '(:eval (gethash (selected-window) which-func-table which-func-unknown)))
+;;;###autoload (put 'which-func-current 'risky-local-variable t)
+
+(defvar which-func-mode nil
+ "Non-nil means display current function name in mode line.
+This makes a difference only if `which-function-mode' is non-nil.")
+(make-variable-buffer-local 'which-func-mode)
+;;(put 'which-func-mode 'permanent-local t)
+
+(add-hook 'find-file-hook 'which-func-ff-hook t)
+
+(defun which-func-ff-hook ()
+ "File find hook for Which Function mode.
+It creates the Imenu index for the buffer, if necessary."
+ (setq which-func-mode
+ (and which-function-mode
+ (or (eq which-func-modes t)
+ (member major-mode which-func-modes))))
+
+ (condition-case nil
+ (if (and which-func-mode
+ (not (member major-mode which-func-non-auto-modes))
+ (or (null which-func-maxout)
+ (< buffer-saved-size which-func-maxout)
+ (= which-func-maxout 0)))
+ (setq imenu--index-alist
+ (save-excursion (funcall imenu-create-index-function))))
+ (error
+ (setq which-func-mode nil))))
+
+(defun which-func-update ()
+ ;; "Update the Which-Function mode display for all windows."
+ ;; (walk-windows 'which-func-update-1 nil 'visible))
+ (which-func-update-1 (selected-window)))
+
+(defun which-func-update-1 (window)
+ "Update the Which-Function mode display for window WINDOW."
+ (with-selected-window window
+ (when which-func-mode
+ (condition-case info
+ (let ((current (which-function)))
+ (unless (equal current (gethash window which-func-table))
+ (puthash window current which-func-table)
+ (force-mode-line-update)))
+ (error
+ (which-func-mode -1)
+ (error "Error in which-func-update: %s" info))))))
+
+;;;###autoload
+(defalias 'which-func-mode 'which-function-mode)
+
+(defvar which-func-update-timer nil)
+
+;; This is the name people would normally expect.
+;;;###autoload
+(define-minor-mode which-function-mode
+ "Toggle Which Function mode, globally.
+When Which Function mode is enabled, the current function name is
+continuously displayed in the mode line, in certain major modes.
+
+With prefix ARG, turn Which Function mode on iff arg is positive,
+and off otherwise."
+ :global t :group 'which-func
+ (if which-function-mode
+ ;;Turn it on
+ (progn
+ (setq which-func-update-timer
+ (run-with-idle-timer idle-update-delay t 'which-func-update))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (setq which-func-mode
+ (or (eq which-func-modes t)
+ (member major-mode which-func-modes))))))
+ ;; Turn it off
+ (cancel-timer which-func-update-timer)
+ (setq which-func-update-timer nil)
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf (setq which-func-mode nil)))))
+
+(defvar which-function-imenu-failed nil
+ "Locally t in a buffer if `imenu--make-index-alist' found nothing there.")
+
+(defun which-function ()
+ "Return current function name based on point.
+Uses `imenu--index-alist' or `add-log-current-defun-function'.
+If no function name is found, return nil."
+ (let (name)
+ ;; If Imenu is loaded, try to make an index alist with it.
+ (when (and (boundp 'imenu--index-alist) (null imenu--index-alist)
+ (null which-function-imenu-failed))
+ (imenu--make-index-alist)
+ (unless imenu--index-alist
+ (make-local-variable 'which-function-imenu-failed)
+ (setq which-function-imenu-failed t)))
+ ;; If we have an index alist, use it.
+ (when (and (boundp 'imenu--index-alist) imenu--index-alist)
+ (let ((alist imenu--index-alist)
+ (minoffset (point-max))
+ offset elem pair mark)
+ (while alist
+ (setq elem (car-safe alist)
+ alist (cdr-safe alist))
+ ;; Elements of alist are either ("name" . marker), or
+ ;; ("submenu" ("name" . marker) ... ).
+ (unless (listp (cdr elem))
+ (setq elem (list elem)))
+ (while elem
+ (setq pair (car elem)
+ elem (cdr elem))
+ (and (consp pair)
+ (number-or-marker-p (setq mark (cdr pair)))
+ (if (>= (setq offset (- (point) mark)) 0)
+ (if (< offset minoffset) ; find the closest item
+ (setq minoffset offset
+ name (car pair)))
+ ;; Entries in order, so can skip all those after point.
+ (setq elem nil)))))))
+ ;; Try using add-log support.
+ (when (and (null name) (boundp 'add-log-current-defun-function)
+ add-log-current-defun-function)
+ (setq name (funcall add-log-current-defun-function)))
+ ;; Filter the name if requested.
+ (when name
+ (if which-func-cleanup-function
+ (funcall which-func-cleanup-function name)
+ name))))
+
+(provide 'which-func)
+
+;;; which-func.el ends here
;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
;;
-;; Copyright (C) 1996,97,1999,2000,01,02,2003 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
"Execute FORM without inheriting any text properties."
`(save-restriction
(let ((inhibit-read-only t)
- (inhibit-modification-hooks t))
- (narrow-to-region (point) (point))
- (prog1 (progn ,@form)
- (goto-char (point-max))))))
+ (inhibit-modification-hooks t)
+ result)
+ (insert "<>")
+ (narrow-to-region (- (point) 2) (point))
+ (goto-char (1+ (point-min)))
+ (setq result (progn ,@form))
+ (delete-region (point-min) (1+ (point-min)))
+ (delete-region (1- (point-max)) (point-max))
+ (goto-char (point-max))
+ result)))
(defface widget-inactive-face '((((class grayscale color)
(background dark))
respectively."
(let ((cur (point-min))
(widget nil)
+ (parent nil)
(overlays (if buffer
(with-current-buffer buffer (overlay-lists))
(overlay-lists))))
(or (bobp) (> arg 0) (backward-char))
(let ((wrapped 0)
(number arg)
- (old (widget-tabable-at)))
+ (old (widget-tabable-at))
+ new)
;; Forward.
(while (> arg 0)
(cond ((eobp)
(defun widget-editable-list-format-handler (widget escape)
;; We recognize the insert button.
- ;; (let ((widget-push-button-gui widget-editable-list-gui))
+;;; (let ((widget-push-button-gui widget-editable-list-gui))
(cond ((eq escape ?i)
(and (widget-get widget :indent)
(insert-char ?\ (widget-get widget :indent)))
(widget-get widget :append-button-args)))
(t
(widget-default-format-handler widget escape)))
- ;; )
+;;; )
)
(defun widget-editable-list-value-create (widget)
(defun widget-editable-list-entry-create (widget value conv)
;; Create a new entry to the list.
(let ((type (nth 0 (widget-get widget :args)))
- ;; (widget-push-button-gui widget-editable-list-gui)
+;;; (widget-push-button-gui widget-editable-list-gui)
child delete insert)
(widget-specify-insert
(save-excursion
widget type (widget-default-get type)))))
(t
(error "Unknown escape `%c'" escape)))))
- (let ((buttons (widget-get widget :buttons)))
- (if insert (push insert buttons))
- (if delete (push delete buttons))
- (widget-put widget :buttons buttons))
+ (widget-put widget
+ :buttons (cons delete
+ (cons insert
+ (widget-get widget :buttons))))
(let ((entry-from (point-min-marker))
(entry-to (point-max-marker)))
(set-marker-insertion-type entry-from t)
(set-marker-insertion-type entry-to nil)
(widget-put child :entry-from entry-from)
(widget-put child :entry-to entry-to)))
- (if insert (widget-put insert :widget child))
- (if delete (widget-put delete :widget child))
+ (widget-put insert :widget child)
+ (widget-put delete :widget child)
child))
;;; The `group' Widget.
:value-to-internal (lambda (widget value)
(list (car value) (cdr value)))
:value-to-external (lambda (widget value)
- (apply 'cons value)))
+ (cons (nth 0 value) (nth 1 value))))
(defun widget-cons-match (widget value)
(and (consp value)
(prompt (concat tag ": "))
(value (widget-value widget))
(start (widget-field-start widget))
+ (pos (cond ((< (point) start)
+ 0)
+ ((> (point) (+ start (length value)))
+ (length value))
+ (t
+ (- (point) start))))
(answer (facemenu-read-color prompt)))
(unless (zerop (length answer))
(widget-value-set widget answer)
@comment %**end of header
@set edition-number 2.07
-@set update-date 2003 Apr 17
+@set update-date 2002 Aug 23
@ignore
## Summary of shell commands to create various output formats:
Edition @value{edition-number}, @value{update-date}
-Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1997, 2001,
-2002, 2003 Free Software Foundation, Inc.
+Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1997, 2001, 2002 Free Software Foundation, Inc.
@sp 2
Published by the Free Software Foundation, Inc.@*
what is ``not true'' is false and what is ``not false'' is true.
Using this test, the @code{if} expression works as follows: when the
-value of the variable @code{buffer} is actually a buffer rather than
+value of the variable @code{buffer} is actually a buffer rather then
its name, the true-or-false-test returns false and the @code{if}
expression does not evaluate the then-part. This is fine, since we do
not need to do anything to the variable @code{buffer} if it really is
argument. In this case, this is the expression @code{(< end beg)}.
This expression does not directly determine whether the killed text in
this command is located before or after the kill text of the last
-command; what it does is determine whether the value of the variable
+command; what is does is determine whether the value of the variable
@code{end} is less than the value of the variable @code{beg}. If it
is, it means that the user is most likely heading towards the
beginning of the buffer. Also, the result of evaluating the predicate
-2003-05-28 Richard M. Stallman <rms@gnu.org>
-
- * strings.texi (Creating Strings): Clarify split-string.
-
-2003-05-22 Stephen J. Turnbull <stephen@xemacs.org>
-
- * strings.texi (Creating Strings): Update split-string specification
- and examples.
-
-2003-05-19 Richard M. Stallman <rms@gnu.org>
-
- * elisp.texi: Correct invariant section names.
-
-2003-04-20 Richard M. Stallman <rms@gnu.org>
-
- * os.texi (Timers): Explain about timers and quitting.
-
-2003-04-19 Richard M. Stallman <rms@gnu.org>
-
- * internals.texi (Writing Emacs Primitives): Strings are
- no longer special for GCPROs. Mention GCPRO5, GCPRO6.
- Explain GCPRO convention for varargs function args.
-
-2003-04-16 Richard M. Stallman <rms@gnu.org>
-
- * minibuf.texi (Minibuffer Misc): Document fn minibuffer-message.
-
-2003-04-08 Richard M. Stallman <rms@gnu.org>
-
- * files.texi (Kinds of Files): Correct return value of file-symlink-p.
-
2003-02-13 Kim F. Storm <storm@cua.dk>
* objects.texi (Character Type): New \s escape for space.
called @dfn{auto-saving}. Auto-saving prevents you from losing more
than a limited amount of work if the system crashes. By default,
auto-saves happen every 300 keystrokes, or after around 30 seconds of
-idle time. @xref{Auto Save, Auto Save, Auto-Saving: Protection Against
+idle time. @xref{Auto-Save, Auto-Save, Auto-Saving: Protection Against
Disasters, emacs, The GNU Emacs Manual}, for information on auto-save
for users. Here we describe the functions used to implement auto-saving
and the variables that control them.
@cindex buffer list
The @dfn{buffer list} is a list of all live buffers. Creating a
-buffer adds it to this list, and killing a buffer removes it. The
-order of the buffers in the list is based primarily on how recently
-each buffer has been displayed in the selected window. Buffers move
-to the front of the list when they are selected (selecting a window
-that already displays the buffer counts as selecting the buffer), and
-to the end when they are buried (see @code{bury-buffer}, below).
-Several functions, notably @code{other-buffer}, use this ordering. A
-buffer list displayed for the user also follows this order.
+buffer adds it to this list, and killing a buffer excises it. The order
+of the buffers in the list is based primarily on how recently each
+buffer has been displayed in the selected window. Buffers move to the
+front of the list when they are selected and to the end when they are
+buried (see @code{bury-buffer}, below). Several functions, notably
+@code{other-buffer}, use this ordering. A buffer list displayed for the
+user also follows this order.
In addition to the fundamental Emacs buffer list, each frame has its
own version of the buffer list, in which the buffers that have been
@end menu
All customization types are implemented as widgets; see @ref{Top, ,
-Introduction, widget, The Emacs Widget Library}, for details.
+Introduction, widget, The Emacs Widget Library} for details.
@node Simple Types
@subsection Simple Types
If @var{value1} is a relative value for the face attribute
@var{attribute}, returns it merged with the underlying value
@var{value2}; otherwise, if @var{value1} is an absolute value for the
-face attribute @var{attribute}, returns @var{value1} unchanged.
+face a attribute @var{attribute}, returns @var{value1} unchanged.
@end defun
@defun set-face-foreground face color &optional frame
@item :margin @var{margin}
The @code{:margin} property specifies how many pixels to add as an
-extra margin around the image. The value, @var{margin}, must be a
+extra margin around the image. The value, @var{margin}, must be a a
non-negative number, or a pair @code{(@var{x} . @var{y})} of such
numbers. If it is a pair, @var{x} specifies how many pixels to add
horizontally, and @var{y} specifies how many pixels to add vertically.
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License'', with the Front-Cover texts being
+Invariant Sections being ``Copying'', with the Front-Cover texts being
``A GNU Manual'', and with the Back-Cover Texts as in (a) below. A copy
of the license is included in the section entitled ``GNU Free
Documentation License''.
@defun file-symlink-p filename
@cindex file symbolic links
-If the file @var{filename} is a symbolic link, the
-@code{file-symlink-p} function returns the link target as a string.
-(Determining the file name that the link points to from the target is
-nontrivial.)
+If the file @var{filename} is a symbolic link, the @code{file-symlink-p}
+function returns the file name to which it is linked. This may be the
+name of a text file, a directory, or even another symbolic link, or it
+may be a nonexistent file name.
If the file @var{filename} is not a symbolic link (or there is no such file),
@code{file-symlink-p} returns @code{nil}.
multiple handlers, and for operations that have two file names that may
each have handlers.
-@kindex safe-magic (@r{property})
-Handlers that don't really do anything specal for actual access to the
-file---such as the ones that implement completion of host names for
-remote file names---should have a non-@code{nil} @code{safe-magic}
-property. For instance, Emacs normally ``protects'' directory names
-it finds in @code{PATH} from becoming magic, if they look like magic
-file names, by prefixing them with @samp{/:}. But if the handler that
-would be used for them has a non-@code{nil} @code{safe-magic}
-property, the @samp{/:} is not added.
-
@defvar inhibit-file-name-handlers
This variable holds a list of handlers whose use is presently inhibited
for a certain operation.
@code{UNGCPRO} cancels the protection of the variables that are
protected in the current function. It is necessary to do this explicitly.
- It suffices to ensure that at least one pointer to each object is
-GC-protected; as long as the object is not recycled, all pointers to
-it remain valid. So if you are sure that a local variable points to
-an object that will be preserved by some other pointer, that local
-variable does not need a GCPRO. (Formerly, strings were an exception
-to this rule; in older Emacs versions, every pointer to a string
-needed to be marked by GC.)
-
- The macro @code{GCPRO1} protects just one local variable. If you
-want to protect two, use @code{GCPRO2} instead; repeating
-@code{GCPRO1} will not work. Macros, @code{GCPRO3}, @code{GCPRO4},
-@code{GCPRO5}, and @code{GCPRO6} also exist. These macros implicitly
-use local variables such as @code{gcpro1}; you must declare these
-explicitly, with type @code{struct gcpro}. Thus, if you use
-@code{GCPRO2}, you must declare @code{gcpro1} and @code{gcpro2}.
+ For most data types, it suffices to protect at least one pointer to
+the object; as long as the object is not recycled, all pointers to it
+remain valid. This is not so for strings, because the garbage collector
+can move them. When the garbage collector moves a string, it relocates
+all the pointers it knows about; any other pointers become invalid.
+Therefore, you must protect all pointers to strings across any point
+where garbage collection may be possible.
+
+ The macro @code{GCPRO1} protects just one local variable. If you want
+to protect two, use @code{GCPRO2} instead; repeating @code{GCPRO1} will
+not work. Macros @code{GCPRO3} and @code{GCPRO4} also exist.
+
+ These macros implicitly use local variables such as @code{gcpro1}; you
+must declare these explicitly, with type @code{struct gcpro}. Thus, if
+you use @code{GCPRO2}, you must declare @code{gcpro1} and @code{gcpro2}.
Alas, we can't explain all the tricky details here.
- Built-in functions that take a variable number of arguments actually
-accept two arguments at the C level: the number of Lisp arguments, and
-a @code{Lisp_Object *} pointer to a C vector containing those Lisp
-arguments. This C vector may be part of a Lisp vector, but it need
-not be. The responsibility for using GCPRO to protecting the Lisp
-arguments from GC if necessary rests with the caller in this case,
-since the caller allocated or found the storage for them.
-
You must not use C initializers for static or global variables unless
the variables are never written once Emacs is dumped. These variables
with initializers are allocated in an area of memory that becomes
arguments even if it is invoked from the minibuffer. The minibuffer
command @code{next-matching-history-element} (normally @kbd{M-s} in the
minibuffer) uses this feature.
-
-@defun minibuffer-message string &optional timeout
-This function displays @var{string} temporarily at the end of the
-minibuffer text, for @var{timeout} seconds. (The default is 2
-seconds.)
-@end defun
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2003
+@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/modes
major mode command symbol should have a property named @code{mode-class}
with value @code{special}, put on as follows:
-@kindex mode-class @r{(property)}
+@cindex @code{mode-class} property
@cindex @code{special}
@example
(put 'funny-mode 'mode-class 'special)
table by itself is not sufficient.
@defvar font-lock-syntactic-keywords
-This variable enables and controls syntactic Font Lock. It is
-normally set via @code{font-lock-defaults}. Its value should be a
-list of elements of this form:
+This variable enables and controls syntactic Font Lock. Its value
+should be a list of elements of this form:
@example
(@var{matcher} @var{subexp} @var{syntax} @var{override} @var{laxmatch})
@end example
However, instead of specifying the value @var{facename} to use for the
-@code{face} property, it specifies the value @var{syntax} to use for
-the @code{syntax-table} property. Here, @var{syntax} can be a string
-(as taken by @code{modify-syntax-entry}), a syntax table, a cons cell
-(as returned by @code{string-to-syntax}), or an expression whose value
-is one of those two types. @var{override} cannot be @code{prepend} or
-@code{append}.
-
-For example, an element of the form:
-
-@example
-("\\$\\(#\\)" 1 ".")
-@end example
-
-highlights syntactically a hash character when following a dollar
-character, with a SYNTAX of @code{"."} (meaning punctuation syntax).
-Assuming that the buffer syntax table specifies hash characters to
-have comment start syntax, the element will only highlight hash
-characters that do not follow dollar characters as comments
-syntactically.
-
-An element of the form:
-
-@example
- ("\\('\\).\\('\\)"
- (1 "\"")
- (2 "\""))
-@end example
-
-highlights syntactically both single quotes which surround a single
-character, with a SYNTAX of @code{"\""} (meaning string quote syntax).
-Assuming that the buffer syntax table does not specify single quotes
-to have quote syntax, the element will only highlight single quotes of
-the form @samp{'@var{c}'} as strings syntactically. Other forms, such
-as @samp{foo'bar} or @samp{'fubar'}, will not be highlighted as
-strings.
-
+@code{face} property, it specifies the value @var{syntax} to use for the
+@code{syntax-table} property. Here, @var{syntax} can be a variable
+whose value is a syntax table, a syntax entry of the form
+@code{(@var{syntax-code} . @var{matching-char})}, or an expression whose
+value is one of those two types.
@end defvar
@node Hooks
If @var{string} is already a unibyte string, then the value is
@var{string} itself. Otherwise it is a newly created string, with no
text properties. If @var{string} is multibyte, any characters it
-contains of charset @code{eight-bit-control} or @code{eight-bit-graphic}
+contains of charset @var{eight-bit-control} or @var{eight-bit-graphic}
are converted to the corresponding single byte.
@end defun
@var{string} itself. Otherwise it is a newly created string, with no
text properties. If @var{string} is unibyte and contains any individual
8-bit bytes (i.e.@: not part of a multibyte form), they are converted to
-the corresponding multibyte character of charset @code{eight-bit-control}
-or @code{eight-bit-graphic}.
+the corresponding multibyte character of charset @var{eight-bit-control}
+or @var{eight-bit-graphic}.
@end defun
@node Character Codes
Emacs.
@end defvar
- @xref{Init Examples,, Init File Examples, emacs, The GNU Emacs Manual}, for
+ @xref{Init File Examples,,, emacs, The GNU Emacs Manual}, for
examples of how to make various commonly desired customizations in your
@file{.emacs} file.
The command-line arguments are parsed by the @code{command-line-1}
function in the @file{startup.el} file. See also @ref{Command
-Arguments, , Command Line Arguments, emacs, The GNU Emacs Manual}.
+Switches, , Command Line Switches and Arguments, emacs, The GNU Emacs
+Manual}.
@end defvar
@defvar command-line-args
@section Timers for Delayed Execution
@cindex timer
- You can set up a @dfn{timer} to call a function at a specified
-future time or after a certain length of idleness.
+ You can set up a @dfn{timer} to call a function at a specified future time or
+after a certain length of idleness.
Emacs cannot run timers at any arbitrary point in a Lisp program; it
can run them only when Emacs could accept output from a subprocess:
timer's execution may be delayed if Emacs is busy. However, the time of
execution is very precise if Emacs is idle.
- Emacs binds @code{inhibit-quit} to @code{t} before calling the timer
-function, because quitting out of many timer functions can leave
-things in an inconsistent state. This is normally unproblematical
-because most timer functions don't do a lot of work. Indeed, for a
-timer to calls a function that takes substantial time to run is likely
-to be annoying.
-
@defun run-at-time time repeat function &rest args
This function arranges to call @var{function} with arguments @var{args}
at time @var{time}. The argument @var{function} is a function to call
them in Emacs). The syntax table controls how these functions interpret
various characters; see @ref{Syntax Tables}. @xref{Parsing
Expressions}, for lower-level primitives for scanning sexps or parts of
-sexps. For user-level commands, see @ref{Parentheses,, Commands for
-Editing with Parentheses, emacs, The GNU Emacs Manual}.
+sexps. For user-level commands, see @ref{Lists Commands,,, emacs, The GNU
+Emacs Manual}.
@deffn Command forward-list &optional arg
This function moves forward across @var{arg} (default 1) balanced groups of
surrounding @samp{\( @dots{} \)} grouping can limit the grouping power of
@samp{\|}.@refill
-If you need full backtracking capability to handle multiple uses of
-@samp{\|}, use the POSIX regular expression functions (@pxref{POSIX
-Regexps}).
+Full backtracking capability exists to handle multiple uses of
+@samp{\|}, if you use the POSIX regular expression functions
+(@pxref{POSIX Regexps}).
@item \@{@var{m}\@}
is a postfix operator that repeats the previous pattern exactly @var{m}
match, as required by POSIX. This is much slower, so use these
functions only when you really need the longest match.
- The POSIX search and match functions do not properly support the
-non-greedy repetition operators. This is because POSIX backtracking
-conflicts with the semantics of non-greedy repetition.
-
@defun posix-search-forward regexp &optional limit noerror repeat
This is like @code{re-search-forward} except that it performs the full
backtracking specified by the POSIX standard for regular expression
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2003
+@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/strings
Lists}.
@end defun
-@defun split-string string separators omit-nulls
-This function splits @var{string} into substrings at matches for the
-regular expression @var{separators}. Each match for @var{separators}
-defines a splitting point; the substrings between the splitting points
-are made into a list, which is the value returned by
-@code{split-string}.
-
-If @var{omit-nulls} is @code{nil}, the result contains null strings
-whenever there are two consecutive matches for @var{separators}, or a
-match is adjacent to the beginning or end of @var{string}. If
-@var{omit-nulls} is @code{t}, these null strings are omitted from the
-result list.
-
+@defun split-string string separators
+This function splits @var{string} into substrings at matches for the regular
+expression @var{separators}. Each match for @var{separators} defines a
+splitting point; the substrings between the splitting points are made
+into a list, which is the value returned by @code{split-string}.
If @var{separators} is @code{nil} (or omitted),
-the default is the value of @code{split-string-default-separators}.
-
-As a special case, when @var{separators} is @code{nil} (or omitted),
-null strings are always omitted from the result. Thus:
-
-@example
-(split-string " two words ")
-@result{} ("two" "words")
-@end example
-
-The result is not @samp{("" "two" "words" "")}, which would rarely be
-useful. If you need such a result, use an explict value for
-@var{separators}:
-
-@example
-(split-string " two words " split-string-default-separators)
-@result{} ("" "two" "words" "")
-@end example
+the default is @code{"[ \f\t\n\r\v]+"}.
-More examples:
+For example,
@example
(split-string "Soup is good food" "o")
@result{} ("S" "up is g" "" "d f" "" "d")
-(split-string "Soup is good food" "o" t)
-@result{} ("S" "up is g" "d f" "d")
(split-string "Soup is good food" "o+")
@result{} ("S" "up is g" "d f" "d")
@end example
+When there is a match adjacent to the beginning or end of the string,
+this does not cause a null string to appear at the beginning or end
+of the list:
+
+@example
+(split-string "out to moo" "o+")
+@result{} ("ut t" " m")
+@end example
+
Empty matches do count, when not adjacent to another match:
@example
@end example
@end defun
-@defvar split-string-default-separators
-The default value of @var{separators} for @code{split-string}, initially
-@samp{"[ \f\t\n\r\v]+"}.
-@end defvar
-
@node Modifying Strings
@section Modifying Strings
@defun char-before &optional position
This function returns the character in the current buffer immediately
before position @var{position}. If @var{position} is out of range for
-this purpose, either at or before the beginning of the buffer, or beyond
+this purpose, either before the beginning of the buffer, or at or beyond
the end, then the value is @code{nil}. The default for
@var{position} is point.
@end defun
you need to explain the details of how to use the function or
variable. Please use complete sentences for the rest of the text too.
-@item
-The first line should mention all the important arguments of the
-function, and should mention them in the order that they are written
-in a function call. If the function has many arguments, then it is
-not feasible to mention them all in the first line; in that case, the
-first line should mention the first few arguments, including the most
-important arguments.
-
@item
For consistency, phrase the verb in the first sentence of a function's
documentation string as an imperative--for instance, use ``Return the
-This file is obsolete, and no longer part of the Emacs Lisp Reference Manual.
-It is still present in CVS in case we ever want to use some of it again.
-
-@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999
-@c Free Software Foundation, Inc.
-@c See the file elisp.texi for copying conditions.
-
\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename elisp
Published by the Free Software Foundation
59 Temple Place, Suite 330
Boston, MA 02111-1307 USA
+
+Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission notice
+identical to this one except for the removal of this paragraph (this
+paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+approved by the Foundation.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+section entitled ``GNU General Public License'' is included exactly as
+in the original, and provided that the entire resulting derived work is
+distributed under the terms of a permission notice identical to this
+one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that the section entitled ``GNU General Public License'' may be
+included in a translation approved by the Free Software Foundation
+instead of in the original English.
@end ifinfo
@setchapternewpage odd
-This file is obsolete, and no longer part of the Emacs Lisp Reference Manual.
-It is still present in CVS in case we ever want to use some of it again.
-
-@c This is part of the GNU Emacs Lisp Reference Manual.
-@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999
-@c Free Software Foundation, Inc.
-@c See the file elisp.texi for copying conditions.
-
-
\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename elisp
Published by the Free Software Foundation
59 Temple Place, Suite 330
Boston, MA 02111-1307 USA
+
+Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission notice
+identical to this one except for the removal of this paragraph (this
+paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+approved by the Foundation.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+section entitled ``GNU General Public License'' is included exactly as
+in the original, and provided that the entire resulting derived work is
+distributed under the terms of a permission notice identical to this
+one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that the section entitled ``GNU General Public License'' may be
+included in a translation approved by the Free Software Foundation
+instead of in the original English.
@end ifinfo
@setchapternewpage odd
By default, special display means to give the buffer a dedicated frame.
If an element is a list, instead of a string, then the @sc{car} of the
-list is the buffer name, and the rest of the list says how to create
-the frame. There are two possibilities for the rest of the list (its
-@sc{cdr}). It can be an alist, specifying frame parameters, or it can
-contain a function and arguments to give to it. (The function's first
-argument is always the buffer to be displayed; the arguments from the
-list come after that.)
-
-For example:
-
-@example
-(("myfile" (minibuffer) (menu-bar-lines . 0)))
-@end example
-
-@noindent
-specifies to display a buffer named @samp{myfile} in a dedicated frame
-with specified @code{minibuffer} and @code{menu-bar-lines} parameters.
+list is the buffer name, and the rest of the list says how to create the
+frame. There are two possibilities for the rest of the list. It can be
+an alist, specifying frame parameters, or it can contain a function and
+arguments to give to it. (The function's first argument is always the
+buffer to be displayed; the arguments from the list come after that.)
@end defopt
@defopt special-display-regexps
switching buffers in the window, and changing the size of the window.
The first two actions run @code{window-scroll-functions}; the last runs
@code{window-size-change-functions}. The paradigmatic use of these
-hooks is in the implementation of Lazy Lock mode; see @file{lazy-lock.el}.
+hooks is in the implementation of Lazy Lock mode; see @ref{Support
+Modes, Lazy Lock, Font Lock Support Modes, emacs, The GNU Emacs Manual}.
@defvar window-scroll-functions
This variable holds a list of functions that Emacs should call before
+++ /dev/null
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-\f
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-\f
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-\f
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-\f
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-\f
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) year name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Library General
-Public License instead of this License.
+++ /dev/null
-2003-04-28 Andrew Choi <akochoi@shaw.ca>
-
- * make-package: Allocate 5% extra space on disk image for
- directories and partition tables.
-
-2003-04-04 Steven Tamm <steventamm@mac.com>
-
- * make-package: Place libexec executables directly under the
- Contents/MacOS/libexec if the application is self-contained
-
-2003-04-01 Kim F. Storm <storm@cua.dk>
-
- * makefile.MPW (frame.c.x): Add dependency on BLOCKINPUT_H_GROUP.
- (xdisp.c.x): Fix to use BLOCKINPUT_H_GROUP.
-
-2003-03-21 Kim F. Storm <storm@cua.dk>
-
- * makefile.MPW (xdisp.c.x): Add dependency on blockinput.h and
- files included from it. Add dependency on keymap.h.
-
-2003-01-14 Steven Tamm <steventamm@mac.com>
-
- * make-package: Fixed problem where the building without
- specifying build directory fails.
-
-2003-01-07 Steven Tamm <steventamm@mac.com>
-
- * INSTALL: Added documentation about --enable-carbon-app and
- changed documentation concerning Emacs.app location
- Removed some of the documentation about make-package that isn't
- needed
- Changed comment about requiring root permission to install to
- saying that it might be necessary depending on where you install
- Refered to /usr caveat in more places
- * make-package (make_options): Use new carbon_appdir option to
- specify directory to install Application and lets the makefile
- install
-
-2003-01-01 Steven Tamm <steventamm@mac.com>
-
- * make-package: Now copies License and ReadMe files into the
- Resources directory. Reduces overhead size when creating
- installer disk image.
-
-2002-12-29 Steven Tamm <steventamm@mac.com>
-
- * make-package: Defaults to building the source tree in a
- separate directory. Use the new option --build-in-place to
- have old behavior. Added new option --build-dir to specify the
- build directory.
-
-2002-12-27 Steven Tamm <steventamm@mac.com>
-
- * make-package: Fix typo where tmpparent was used instead of
- tempparent for calculating installedSize and compressedSize.
-
-2002-12-10 Andreas Schwab <schwab@suse.de>
-
- * make-package: Fix syntax for find.
-
-2002-12-08 Steven Tamm <steventamm@mac.com>
-
- * INSTALL: Added description about make-package.
-
- * make-package: Fixed --self-contained option to place the
- directories in the correct locations for
- init_mac_osx_environment and use hardlink by default for the
- application. Script fails with invalid option.
-
-2002-12-02 Andrew Choi <akochoi@shaw.ca>
-
- * make-bin-dist, osx-install: Remove.
-
- * INSTALL: Remove description of make-bin-dist and osx-install.
-
-2002-12-02 Steven Tamm <steventamm@mac.com>
-
- * make-package (installprefix): Switched copying of .el files
- to be on by default. Removed symlink for emacs -> emacs-version.
-
-2002-11-30 Steven Tamm <steventamm@mac.com>
-
- * make-package: Now compresses .pax file instead of entire disk
- image to reduce installer size on disk. Also added code to
- create compressed disk image in the future.
-
- No longer copies .el files that have been compiled by default.
- Use --full-dist option to include them.
-
- Option --symlink added to reduce disk size by making
- /usr/bin/emacs and the Emacs binary inside the Emacs.app to become
- symlinks to the emacs-[version] binary.
-
- Option --self-contained added to place files shared files
- inside the Emacs.app executable (for portability between systems)
-
- Added hidden debugging option --keep-dir to keep temporary install
- directory (emacs-[version]) around after running script
-
- * README: Removed comment about mouse-2 & -3 not working (it does).
-
-2002-10-14 Andreas Schwab <schwab@suse.de>
-
- * make-package: Fix syntax for find.
-
-2002-10-08 Steven Tamm <steventamm@mac.com>
-
- * make-package: Added ability to pass command line options
- through to make and configure (-m, & -c,).
- Added option to not copy Application into installer, the default
- for X11 builds. Does not copy CVS directories into installer.
- Clarified some of the usage notes.
-
-2002-10-07 Steven Tamm <steventamm@mac.com>
-
- * make-package: Now calls make bootstrap if .elc files are missing.
-
-2002-08-27 Andrew Choi <akochoi@shaw.ca>
-
- * INSTALL: Add information on starting Emacs as a GUI application
- from the terminal.
-
-2002-08-15 Andrew Choi <akochoi@shaw.ca>
-
- * INSTALL: Add instructions for building Carbon version on Macs
- with X Window installed.
-
-2002-07-31 Andrew Choi <akochoi@shaw.ca>
-
- * Emacs.app/Contents/PkgInfo, Emacs.app/Contents/Info.plist:
- change creator code from ???? to EMAx.
-
- * INSTALL: Add instructions for building X Window version.
-
-2002-07-11 Andrew Choi <akochoi@shaw.ca>
-
- * make-package: Change -a option to -R for cp command.
-
-2002-07-05 Andrew Choi <akochoi@shaw.ca>
-
- * make-package: Add ability to handle options --help, --prefix,
- --no-conf, and --with-x.
-
-2002-07-04 Andrew Choi <akochoi@shaw.ca>
-
- * make-package: New file.
-
-2002-07-01 Andrew Choi <akochoi@shaw.ca>
-
- * Emacs.app/Contents/Resources/Emacs.icns: New file.
-
- * Emacs.app/Contents/Info.plist: Add CFBundleDocumentTypes and
- CFBundleIconFile entries.
-
-2002-04-13 Andrew Choi <akochoi@shaw.ca>
-
- * Emacs.app/Contents/Info.plist: New file.
-
- * Emacs.app/Contents/PkgInfo: New file.
-
- * Emacs.app/Contents/Resources/English.lproj/InfoPlist.strings:
- New file.
-
- * cw5-mcp.xml: Remove file.
-
- * inc/defs-cw5.h: Remove file.
-
- * cw6-mcp.xml: Update with new version.
-
- * mac/inc/defs-cw6.h: New constant MAC_OS8. Remove definition
- of constant CODEWARRIOR_VERSION_6.
-
- * mac/src/mac.c:
- * mac/src/macmenu.c:
- * mac/src/macterm.c:
- Test constant __MSL__ instead of CODEWARRIOR_VERSION_6.
-
- * src/Carbon.r: New File.
-
- * makefile.MPW: Define MAC_OS and MAC_OS8. Update with change of
- locations for mac.c, macfns.c, macgui.h, macmenu.c, macterm.c, and
- macterm.h. Generate DOC from .el instead of .elc versions of
- files listed in DONTCOMPILE in lisp/Makefile.in.
-
- * INSTALL: Add installation instructions for Mac OS X.
-
- * README: Add information for Mac OS X.
-
- * src/mac.c, inc/macgui.h, src/macfns.c, src/macmenu.c,
- src/macterm.c, inc/macterm.h: Remove from here and move to src.
-
-2002-04-12 Andrew Choi <akochoi@shaw.ca>
-
- * src/mac.c (select): Under Carbon, always return true so
- XTread_socket is called to poll input.
- (run_mac_command): Not implemented under Carbon.
- (get_wd): Call PBHGetVolSync and path_from_vol_dir_name to
- establish pathname.
- (do_applescript): Use Carbon routines AEGetDescDatASize and
- AEGetDescData.
- (Fmac_paste_function): Use Carbon routines GetCurrentScrap,
- GetScrapFlavorFlags, GetScrapFlavorSize, and GetScrapFlavorData.
- (Fmac_cut_function): Use Carbon routines ClearCurrentScrap,
- GetCurrentScrap, and PutScrapFlavor.
- (Fx_selection_exists_p): Use Carbon routines GetCurrentScrap and
- GetScrapFlavorFlags.
-
- * src/macfns.c: Synchronize with changes in w32fns.c.
- [MAC_OSX]: Include Carbon headers.
- (x_real_positions): Use Carbon routine GetWindowPortBounds.
- (x_set_scroll_bar_width): Set width of scroll bar to 16.
- (x_make_gc): Remove static qualifier.
-
- * src/macmenu.c: Synchronize with changes in w32menu.c.
- [MAC_OSX]: Include Carbon headers.
- (set_frame_menubar): Check equality of vector representation of
- scroll bars using Fequal instead of EQ.
- (mac_menu_show): Use Carbon routine GetWindowPort.
- (mac_dialog): Likewise.
- (add_menu_item): Use Carbon routines CountMenuItems,
- EnableMenuItem, and DisableMenuItem.
-
- * src/macterm.c: Synchronize with changes in w32term.c.
- [MAC_OSX]: Include Carbon headers.
- (XDrawLine): Use Carbon routine GetWindowPort.
- (XClearArea): Likewise.
- (XClearWindow): Use Carbon routines GetWindowPort and
- GetWindowPortBounds.
- (mac_draw_bitmap): Use Carbon routines GetWindowPort and
- GetPortPixMap.
- (mac_set_clip_rectangle): Use Carbon routine GetWindowPort.
- (mac_reset_clipping): Use Carbon routine GetWindowPort.
- (XFillRectangle): Likewise.
- (mac_draw_rectangle): Likewise.
- (mac_draw_rectangle_to_pixmap): Likewise.
- (mac_draw_string_common): Likewise.
- (mac_copy_area): Use Carbon routines GetWindowPort and
- GetPortPixMap.
- (mac_scroll_area): Use Carbon routines GetWindowPort and
- GetQDGlobalsScreenBits.
- (x_flush): Call Carbon routine QDFlushPortBuffer.
- (x_update_end): Use Carbon routine GetWindowPort; call x_flush.
- (x_draw_fringe_bitmap): Call mac_reset_clipping before returning.
- (x_draw_image_glyph_string): Likewise.
- (x_draw_stretch_glyph_string): Likewise.
- (construct_mouse_click): Call Carbon routine GetWindowPort.
- (note_mouse_movement): Call Carbon routine GetWindowPortBounds.
- (XTmouse_position): Call Carbon routine GetWindowPort.
- (x_scroll_bar_create): Create scroll bar with proc
- kControlScrollBarProc.
- (XTset_vertical_scroll_bar) [MAC_OSX]: Set width to 16.
- (activate_scroll_bar): Call ActivateControl instead of
- SetControlMaximum.
- (deactivate_scroll_bar): Call DeactivateControl instead of
- SetControlMaximum.
- (x_scroll_bar_handle_click): Use default case for scroll
- indicator.
- (x_scroll_bar_report_motion): Call Carbon routine GetWindowPort.
- (x_calc_absolute_position): Call Carbon routines GetWindowPort and
- GetWindowPortBounds.
- (init_font_name_table): Call Carbon Font Manager routines to
- iterate through all fonts.
- (XLoadQueryFont): Call Carbon routines GetPortTextFont,
- GetPortTextSize, and GetPortTextFace.
- (do_init_managers): Do not initialize Mac Toolbox under Carbon.
- (is_emacs_window): New function to filter out non-Emacs windows
- passed back by WaitNextEvent.
- (do_mouse_moved): Call Carbon routine GetWindowPort.
- (do_apple_menu): No apple menu handler under Carbon.
- (do_zoom_window): Call Carbon routines GetWindowPort,
- GetQDGlobalsScreenBits, SetWindowStandardState, and
- GetWindowPortBounds.
- (init_required_apple_events): Use UPP procedure type converter.
- (main): Don't define for Carbon version.
- (XTread_socket): Don't check interrupt_input_blocked. Don't call
- check_alarm. Call Carbon routines GetWindowPort,
- GetQDGlobalScreenBits, GetWindowPortBounds, and InvalWindowRect.
- (NewMacWindow): Set making_terminal_window to 0. Call Carbon
- routine GetWindowPort.
- (mac_initialize): Rename from x_initialize. Use new Doc string
- format.
-
- * inc/macterm.h: Synchronize with changes in w32term.h.
-
- * inc/macgui.h [MAC_OSX]: Use OpaqueWindowPtr* instead of
- WindowPtr.
-
-2002-01-28 Kim F. Storm <storm@cua.dk>
-
- * src/macterm.c (x_erase_phys_cursor): Don't erase cursor if
- cursor row is invisible. This can happen if cursor is on top line
- of a window, and we switch to a buffer with a header line.
-
-2001-12-22 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * cw5-mcp.xml, cw6-mcp.xml, makefile.MPW: Remove mocklisp files.
-
-2001-12-13 Eli Zaretskii <eliz@is.elta.co.il>
-
- * src/macfns.c (x_report_frame_params): Make the scroll-bar-width
- frame parameter have a numeric value all the time.
-
-2001-12-08 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * COPYING: New file.
-
-2001-12-06 Kim F. Storm <storm@cua.dk>
-
- * src/macfns.c (x_report_frame_params): Return actual fringe widths.
-
-2001-12-01 Kim F. Storm <storm@cua.dk>
-
- The following changes add left-fringe and right-fringe
- frame parameters to adjust fringe widths, or remove one or
- both fringes. See ../src/ChangeLog for details.
-
- * inc/macterm.h: Merged changes from xterm.h.
- * src/macterm.c: Merged changes from xterm.c.
- * src/macfns.c: Merged changes from xfns.c.
-
-2001-11-16 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * src/macterm.c (waiting_for_input): Remove unnecessary declaration.
-
-2001-11-16 Kim F. Storm <storm@cua.dk>
-
- The following changes are made to clean up the various internal
- references to the fringes to actually use the term `fringe'.
-
- * src/macfns.c: Use renamed symbols.
-
- * src/macterm.c: Comment fixes. Use renamed symbols.
- (fringe_bitmap_type): Renamed from bitmap_type.
- (NO_FRINGE_BITMAP): Renamed from NO_BITMAP.
- (x_draw_fringe_bitmap): Renamed from x_draw_bitmap.
- (x_draw_row_fringe_bitmaps): Renamed from x_draw_row_bitmaps.
-
- * inc/macterm.h: Comment fixes. Use renamed symbols.
- (fringes_extra): Renamed from flags_areas_extra.
- (FRAME_FRINGE_BITMAP_WIDTH): Renamed from FRAME_FLAGS_BITMAP_WIDTH.
- (FRAME_FRINGE_BITMAP_HEIGHT): Renamed from FRAME_FLAGS_BITMAP_HEIGHT.
- (FRAME_X_FRINGE_COLS): Renamed from FRAME_X_FLAGS_AREA_COLS.
- (FRAME_X_FRINGE_WIDTH): Renamed from FRAME_X_FLAGS_AREA_WIDTH.
- (FRAME_X_LEFT_FRINGE_WIDTH): Renamed from FRAME_X_LEFT_FLAGS_AREA_WIDTH.
- (FRAME_X_RIGHT_FRINGE_WIDTH): Renamed from FRAME_X_RIGHT_FLAGS_AREA_WIDTH.
-
-2001-10-20 Gerd Moellmann <gerd@gnu.org>
-
- * (Version 21.1 released.)
-
-2001-10-11 Stefan Monnier <monnier@cs.yale.edu>
-
- * src/macfns.c (x_create_bitmap_from_file, x_find_image_file):
- * src/mac.c (run_mac_command): Update calls to openp.
-
-2001-10-08 Stefan Monnier <monnier@cs.yale.edu>
-
- * src/macmenu.c (Fx_popup_menu): Use Fkeymap_prompt.
-
- * src/macterm.c: Include keymap.h.
- (note_mode_line_highlight): Use KEYMAPP.
-
-2001-10-05 Gerd Moellmann <gerd@gnu.org>
-
- * Branch for 21.1.
-
-2001-09-04 Andrew Choi <akochoi@cse.cuhk.edu.hk>
-
- * src/macmenu.c (mac_menu_show): Use refcon of selected menu item.
-
- * src/macterm.c (XTread_socket): Read all pending events in the
- event queue instead of one.
- (mac_to_x_fontname): Return name with jisx0201.1976-0 encoding if
- a script code of -smJapanese is specified.
- (x_font_name_to_mac_font_name): Also recognize the jisx0201.1976-0
- encoding.
- (init_font_name_table): Use a script code of -smJapanese instead
- of smRoman for the second entry of a Japanese font.
- (XLoadQueryFont): Recognize a font as having the smRoman script
- code if its encoding is jisx0201.1976-0.
-
- * makefile.MPW: Generate etc/DOC file from .elc files instead of
- .el files.
-
- * src/mac.c (stat): Don't fail for aliases.
- (sys_open) [__MRC__]: Set file creator and type for newly-created
- files.
- (sleep) [__MRC__]: Place loop around WaitNextEvent to check time
- elapsed instead of use WaitNextEvent call as a delay.
-
-2001-08-24 Andrew Choi <akochoi@cse.cuhk.edu.hk>
-
- * src/macterm.c (init_font_name_table): Add an additional entry to
- the font table with the script code smRoman for each Apple
- Japanese font.
- (XLoadQueryFont): Recognize a font as having the smRoman script
- code even when FontToScript returns smJapanese if it is one of
- those created above.
-
-2001-08-21 Andrew Choi <akochoi@cse.cuhk.edu.hk>
-
- * INSTALL: Add to the note on using -opt speed in MPW the function
- macterm.c (x_draw_hollow_cursor).
-
- * src/macterm.c (mac_scroll_area): Call CopyBits with local
- coordinates and portBits instead of global coordinates and
- screenBits. Set fore color and back color to black and white,
- respectively, before calling CopyBits.
-
- * src/macterm.c (local_to_global_coord): Comment out.
-
- * src/mac.c (mac-filename-to-unix): Change to
- mac-file-name-to-posix.
- (unix-filename-to-mac): Change to posix-file-name-to-mac.
- (mac_to_unix_pathname): Change to mac_to_posix_pathname.
- (unix_to_mac_pathname): Change to posix_to_mac_pathname.
-
- * src/macterm.c (do_ae_open_documents): Change call to
- mac_to_unix_pathname to mac_to_posix_pathname.
-
-2001-07-26 Andrew Choi <akochoi@i-cable.com>
-
- * inc/macterm.h (x_display_list): Declare extern.
-
-2001-07-20 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * src/macterm.c (xim_open_dpy): Fix typo.
-
-2001-06-26 Andrew Choi <akochoi@i-cable.com>
-
- * README: Change references to SourceForge site to
- ftp://ftp.gnu.org/gnu/mac/emacs/.
-
-2001-05-15 Gerd Moellmann <gerd@gnu.org>
-
- * src/macterm.c (clear_mouse_face): Check for nil tip_frame.
-
-2001-05-15 Andrew Choi <akochoi@i-cable.com>
-
- * src/Emacs.r: Change About box message.
-
- * makefile.MPW: Add md5.c.x to EmacsObjects.
-
- * src/mac.c (select): Call WaitNextEvent instead of Delay.
- (pause): Ditto.
- (sleep): Ditto.
-
- * src/macterm.c (do_app_resume): Set cursor to arrow.
- (clear_mouse_face): check for NIL Lisp object instead of null
- pointer.
-
- * INSTALL: Delete note on compiling Lisp files on a Unix system.
- Add note on turning off end of line conversion.
-
-2001-02-27 Andrew Choi <akochoi@i-cable.com>
-
- * src/macfns.c: Rename everything containing *busy_cursor* and
- similar to *hourglass*.
- Change IMAGE_POSITIVE_INTEGER_VALUE to
- IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR throughout.
- (x_set_font): If font hasn't changed, avoid recomputing faces and
- other things, as in xfns.c.
- (Qcancel_timer): New variable.
- (syms_of_macfns): Rename x-busy-pointer-shape to
- x-hourglass-pointer-shape, display-busy-cursor to
- display-hourglass, busy-cursor-delay to hourglass-delay, as in
- xfns.c.
- (x_set_tool_bar_lines): Modify as in xfns.c
- (x_change_window_heights): New function.
-
- * inc/macterm.h (struct x_output): Rename busy_cursor to
- hourglass_cursor, busy_window to hourglass_window, busy_p to
- hourglass_p, as in xterm.h.
-
- * src/macmenu.c (set_frame_menubar): Run activate-menu-bar-hook with
- safe_run_hooks, as in xmenu.c.
-
- * src/macterm.c (do_check_ram_size): New function.
-
- * src/Emacs.r: Add ALRT resource #129 for alert when there is over
- 256 MB RAM.
-
-2001-02-20 Andrew Choi <akochoi@i-cable.com>
-
- * mac/INSTALL:
- * mac/README:
- * mac/cw5-mcp.xml:
- * mac/cw6-mcp.xml:
- * mac/inc/alloca.h:
- * mac/inc/defs-cw5.h:
- * mac/inc/defs-cw6.h: Added copyright notice.
-
-2001-01-28 Andrew Choi <akochoi@i-cable.com>
-
- * src/macterm.c (mac_font_pattern_match): Allocate three more
- bytes to regex for '^', '$', and '\0'.
-
- * src/macterm.c (x_list_fonts): Protect pattern and newlist from
- garbage collection.
-
- * src/macfns.c (QCconversion): Replaces QCalgorithm.
-
- * src/macfns.c (image_ascent, lookup_image): Adapt to change of
- image margins.
-
- * src/macterm.c (x_produce_image_glyph, x_draw_image_foreground)
- (x_draw_image_relief, x_draw_image_foreground_1)
- (x_draw_image_glyph_string): Adapt to change of image margins.
-
- * src/macterm.c (mac_to_x_fontname): Change charset name of
- Simplify Chinese fonts from gb2312 to gb2312.1980 and Korean fonts
- from ksc5601 to ksc5601.1989.
-
-2000-12-12 Andrew Choi <akochoi@i-cable.com>
-
- * cw5-mcp.xml: add md5.c to project.
-
- * cw6-mcp.xml: add md5.c to project.
-
- * src/macfns.c (x_create_tip_frame, Fx_hide_tip): change to handle
- Lisp_Object type tip_frame (was struct frame *) as in xfns.c.
-
-2000-11-26 Andrew Choi <akochoi@i-cable.com>
-
- * src/macterm.c (x_handle_tool_bar_click):
- (note_tool_bar_highlight): change references to members deleted
- from struct frame as in xterm.c.
-
- * inc/epaths.h: set PATH_EXEC to ~emacs/mac instead of
- ~emacs/mac/bin.
-
-2000-10-25 Andrew Choi <akochoi@i-cable.com>
-
- * cw5-mcp.xml: renamed from emacs-cw5.mcp.xml.
-
- * cw6-mcp.xml: renamed from emacs-cw6.mcp.xml.
-
- * inc/defs-cw5.h: renamed from inc/cmdline-defs-cw5.h.
-
- * inc/defs-cw6.h: renamed from inc/cmdline-defs-cw6.h.
-
-2000-10-24 Andrew Choi <akochoi@i-cable.com>
-
- * src/macterm.c (XTread_socket): check whether Lisp variable
- mac-ready-for-drag-n-drop is bound rather than non-nil value.
-
-2000-10-20 Andrew Choi <akochoi@users.sourceforge.net>
-
- * INSTALL: New file.
-
- * README: New file.
-
- * TODO: New file.
-
- * emacs-cw5.mcp.xml: New file.
-
- * emacs-cw6.mcp.xml: New file.
-
- * makefile.MPW: New file.
-
- * inc/alloca.h: New file.
-
- * inc/cmdline-defs-cw5.h: New file.
-
- * inc/cmdline-defs-cw6.h: New file.
-
- * inc/config.h: New file.
-
- * inc/dirent.h: New file.
-
- * inc/epaths.h: New file.
-
- * inc/m-mac.h: New file.
-
- * inc/macgui.h: New file.
-
- * inc/macterm.h: New file.
-
- * inc/pwd.h: New file.
-
- * inc/s-mac.h: New file.
-
- * inc/termio.h: New file.
-
- * inc/utime.h: New file.
-
- * inc/utsname.h: New file.
-
- * inc/sys/file.h: New file.
-
- * inc/sys/ioctl.h: New file.
-
- * inc/sys/param.h: New file.
-
- * inc/sys/stat.h: New file.
-
- * inc/sys/time.h: New file.
-
- * inc/sys/types.h: New file.
-
- * src/Emacs.r: New file.
-
- * src/EmacsMPW.r: New file.
-
- * src/chdir.c: New file.
-
- * src/mac.c: New file.
-
- * src/macfns.c: New file.
-
- * src/macmenu.c: New file.
-
- * src/macterm.c: New file.
-
-;; Local Variables:
-;; coding: iso-2022-7bit-unix
-;; End:
-
- Copyright (C) 2001 Free Software Foundation, Inc.
- Copying and distribution of this file, with or without modification,
- are permitted provided the copyright notice and this notice are preserved.
+++ /dev/null
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist SYSTEM "file://localhost/System/Library/DTDs/PropertyList.dtd">
-<plist version="0.9">
-<dict>
- <key>CFBundleDevelopmentRegion</key>
- <string>English</string>
- <key>CFBundleDocumentTypes</key>
- <array>
- <dict>
- <key>CFBundleTypeExtensions</key>
- <array>
- <string>*</string>
- </array>
- <key>CFBundleTypeName</key>
- <string>All</string>
- <key>CFBundleTypeOSTypes</key>
- <array>
- <string>****</string>
- </array>
- <key>CFBundleTypeRole</key>
- <string>Viewer</string>
- </dict>
- </array>
- <key>CFBundleExecutable</key>
- <string>Emacs</string>
- <key>CFBundleIconFile</key>
- <string>Emacs.icns</string>
- <key>CFBundleIdentifier</key>
- <string>com.gnu.Emacs</string>
- <key>CFBundleInfoDictionaryVersion</key>
- <string>6.0</string>
- <key>CFBundlePackageType</key>
- <string>APPL</string>
- <key>CFBundleSignature</key>
- <string>EMAx</string>
- <key>CFBundleVersion</key>
- <string>1.1</string>
-</dict>
-</plist>
+++ /dev/null
-APPLEMAx
\ No newline at end of file
+++ /dev/null
-/* Localized versions of Info.plist keys */
-
-CFBundleName = "Emacs";
-CFBundleShortVersionString = "Emacs version 21";
-CFBundleGetInfoString = "Emacs version 21, Copyright 2002 FSF.";
+++ /dev/null
-* BUILDING EMACS ON MAC OS 8/9 AND MAC OS X -*- outline -*-
-
-Copyright (c) 2001, 2002 Free Software Foundation, Inc.
-
- Permission is granted to anyone to make or distribute verbatim
- copies of this document as received, in any medium, provided that
- the copyright notice and permission notice are preserved, and that
- the distributor grants the recipient permission for further
- redistribution as permitted by this notice.
-
- Permission is granted to distribute modified versions of this
- document, or of portions of it, under the above conditions,
- provided also that they carry prominent notices stating who last
- changed them.
-
-* BUILDING EMACS ON MAC OS X
-
-You should be able to build Emacs on Mac OS X by typing the following
-commands at the top-level directory after the source distribution is
-un-tarred.
-
- ./configure --enable-carbon-app
- make
- make install
-
-The last step may fail if you do not have permissions to install. If
-you try to install into /usr (with ./configure --prefix=/usr), then you
-must install as root using the sudo command. However, it is not
-recommended; see the notes section below for more details.
-
-The --enable-carbon-app specifies that the carbon GUI application
-should be installed into /Application. If you want it to install in a
-different location, specify --enable-carbon-app=<mydir>
-
-If you have X Window installed on your Mac and you are building Emacs
-to run under Carbon and not X Window, you need to type `./configure
---without-x' instead of `./configure'.
-
-You can type `make bootstrap' instead of `make' to rebuild everything,
-including byte-compiling the Lisp files.
-
-If you are compiling on Mac OS X versions before 10.2 and have not
-installed the GNU texinfo package on your system, the build will
-complain that makeinfo cannot be found. Instructions for installing the
-GNU texinfo package are given below. Alternatively, you can type `make
--k' instead of `make' and safely ignore the error messages and use the
-existing info files.
-
-After Emacs is installed, you can run it by typing `emacs -nw' from a
-terminal (make sure your path contains /usr/local/bin) or by
-double-clicking on /Applications/Emacs.app in the Finder. To start
-Emacs as a GUI application from the terminal, the pathname to the
-executable in the bundle, i.e.,
-
- /Application/Emacs.app/Contents/MacOS/Emacs
-
-must be typed to the shell to enable Emacs to locate its resources
-correctly. You may want to create a symlink or alias to this path to
-quickly access both the terminal and GUI versions.
-
-If you are building Emacs to run on Mac OS X and X Window, you need to
-create a directory containing statically-linked X libraries.
-
- sudo mkdir /usr/X11R6/libstatic
- cd /usr/X11R6/libstatic
- sudo ln -s ../lib/lib*.a ../lib/X11 .
-
-Instead of typing `./configure' above, type
-
- ./configure --without-carbon --with-x --x-libraries=/usr/X11R6/libstatic
-
-To use colors in a terminal, put the following lines in the file
-~/.termcap and log in again.
-
------
-# added ANSI color
-vt100|vt100-am|vt100am|dec vt100:\
- :pa#64:Co#8:Sf=\E[3%dm:Sb=\E[4%dm:op=\E[m:AF=\E[3%dm:AB=\E[4%dm:\
- :do=^J:co#80:li#24:cl=\E[;H\E[2J:sf=2*\ED:\
- :le=^H:bs:am:cm=5\E[%i%d;%dH:nd=2\E[C:up=2\E[A:\
- :ce=3\E[K:cd=50\E[J:so=2\E[7m:se=2\E[m:us=2\E[4m:ue=2\E[m:\
- :md=2\E[1m:mr=2\E[7m:mb=2\E[5m:me=2\E[m:\
- :rf=/usr/share/tabset/vt100:\
- :rs=\E>\E[?3l\E[?4l\E[?5l\E[?7h\E[?8h\E[;r\E[0m\E(B\E)B\E[2J:\
- :ks=\E[?1h\E=:ke=\E[?1l\E>:\
- :ku=\EOA:kd=\EOB:kr=\EOC:kl=\EOD:kb=^H:\
- :ho=\E[H:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:pt:sr=2*\EM:vt#3:xn:\
- :sc=\E7:rc=\E8:cs=\E[%i%d;%dr:
------
-
-To build the `info' files in versions prior to Mac OS X 10.2, you need
-to install the texinfo software.
-
-To install from source, obtain texinfo-4.2.tar.gz from ftp.gnu.org or
-a mirror. Un-tar it, enter its directory and type
-
- ./configure
- make
- make install
-
-The last step may need to be performed as root (sudo make install).
-
-You may also like to install ispell, which will allow you to use
-ispell and flyspell-mode. To install ispell from source, you first
-need to install GNU textutils.
-
-To do so, download textutils-2.0.tar.gz from ftp.gnu.org or a mirror.
-Un-tar it, enter its directory, type
-
- ./configure --host=powerpc-apple-bsd
- make
- make install
-
-Again, the last step may need to be performed as root. Note that if you
-run `make check', the test for `pr' will fail.
-
-Get and un-tar ispell-3.2.06.tar.gz. Look for it here:
-
- http://fmg-www.cs.ucla.edu/geoff/ispell.html
-
-Go into its directory, type
-
- cp local.h.samp local.h
-
-Add a line `#define TERMLIB ""' to the end of local.h.
-
-Set the environment variable TMPDIR to an existing directory. For
-example since `/tmp' exists on my machine and I am using `bash', I
-typed
-
- export TMPDIR=/tmp
-
-Run `make' and `make install', the latter as root.
-
-* BUILDING BINARY DISTRIBUTIONS FOR MAC OS X
-
-If you are intending to build a binary distribution of Emacs, there is
-a script that will greatly simplify the process. It is called
-make-package and it is contained in this directory. It will generate
-a disc image containing a installer bundle. By default the installer
-will place the emacs common files in /usr/local/* and the carbon
-application in /Applications. Typical usage would be
-
-./make-package
-
-After running, an compressed disk image of the installer will be placed
-in a file called EmacsInstaller.dmg. This file can be then distributed
-to whomever would like a binary distribution. Here are the common
-options to user
-
---with-x - Use the X11 GUI instead of the Carbon GUI.
---prefix=DIR - Place the common emacs files in the given DIR. The
- default is /usr/local. See note below if placing
- in /usr
---self-contained - Place the common emacs files inside the Emacs.app
- itself. This makes the application trivial to
- uninstall and copy between computers.
---app-symlink - Use a symlink inside the Application to the
- $prefix/bin/emacs to reduce disk space. Note, this
- option may removed in the future.
-
-If you are intending to build a binary distribution for X windows, you
-will probably want to follow the directions above to create static
-X11R6 libraries and run the make-package script like this
-
-./make-package --with-x -C,--x-libraries=/usr/X11R6/libstatic
-
-For usage of other options, use the --help option.
-
-* BUILDING EMACS ON MAC OS 8/9
-
-You can use either Metrowerks CodeWarrior Pro 6 or MPW-GM (Aug. 2001)
-to build Emacs. MPW-GM can be downloaded free of charge from Apple.
-
-In either case, you will need MPW-GM to build the make-docfile utility
-and to generate the doc string file DOC.
-
-### IMPORTANT ### You can use StuffIf Expander to decompress and untar
-the distribution. However, you *must* set the radio button in the
-Preferences->Cross Platform->Convert text files to Macintosh format to
-"Never". Otherwise the compiled Lisp files will be corrupted.
-
-(Optional) A subset of the fonts from the GNU intlfonts-1.2
-distribution converted to NFNT format can be obtained from
-
- ftp://mac-emacs.sourceforge.net/pub/mac-emacs/GNU-fonts.smi.bin
-
-To build Emacs in the MPW Shell, simply set the directory to
-...:emacs:mac: and build the target Emacs of the make file
-makefile.mpw. I.e., execute the commands
-
- make Emacs -f makefile.MPW > Emacs.MakeScript
- Emacs.MakeScript
-
-To build Emacs using CodeWarrior, start up the CodeWarrior IDE, choose
-File->Import Project... and select the file cw6-mcp.xml. When
-prompted to save the project, navigate to same directory as the file
-cw6-mcp.xml, name the project emacs-cw6.mcp, and save it there. Then
-choose Project->Make. Note that this does not build the DOC file. To
-do so, use MPW and build the target "Doc" in makefile.MPW.
-
-Once built, the Emacs application (Emacs CW or Emacs MPW) can be
-launched where it is created.
-
-To build an optimized version of Emacs in CodeWarrior, change the
-value in the Emacs Settings->Code Generation->Global Optimization
-dialog. To build a version for profiling, check the Profiler
-Information box in the Emacs Settings->Code Generation->PPC Processor
-dialog and include the Profiler PPC.Lib library.
-
-* NOTES
-
-Emacs should build and run on a PowerMac running Mac OS 8.6 - 10.2.
-
-You will need around 100 MB of disk space for the source files and
-intermediate files.
-
-It will not run on machines running Mac OS 8/9 with more than 256 MB
-of physical or virtual memory. It does not have this restriction when
-it is run under Mac OS X. But the usual 128MB buffer limit of a
-32-bit Emacs still exists.
-
-Under Mac OS 8/9, there is no support for building the LEIM directory.
-However, it can be built on Mac OS X or another platform and
-transferred to the Mac.
-
-On Mac OS 8/9, to use the same icon as when Emacs is built on Windows
-NT, define GNU_ICON in mac/src/Emacs.r. Currently Emacs uses a
-generic application icon on the Mac OS X. A better looking one is
-coming soon.
-
-On Mac OS X, installing the emacs files in /usr can cause issues with
-system sofware updates possibly overwriting the distribution. If this
-is a concern, as it should be in normal binary distributions, please
-use /usr/local as the prefix for installation.
-
-Enjoy!
-
-Andrew.
-<akochoi@mac.com>
+++ /dev/null
-Emacs for Mac OS 8/9 and Mac OS X
-
-Copyright (c) 2001, 2002 Free Software Foundation, Inc.
-
- Permission is granted to anyone to make or distribute verbatim
- copies of this document as received, in any medium, provided that
- the copyright notice and permission notice are preserved, and that
- the distributor grants the recipient permission for further
- redistribution as permitted by this notice.
-
- Permission is granted to distribute modified versions of this
- document, or of portions of it, under the above conditions,
- provided also that they carry prominent notices stating who last
- changed them.
-
-This directory contains the files needed to build Emacs on the Mac OS
-8/9 and Mac OS X. Many of the major features of the Unix version are
-supported: multiple frames, colors, scroll bars, menu bars, use of the
-mouse, fontsets, international characters, input methods, and coding
-systems.
-
-Mac OS specific support includes document drag-and-drop in the Finder,
-transfer of text to and from other applications via the clipboard, and
-sending AppleScript commands to other applications from Emacs.
-
-The following are not supported on Mac OS 8/9 : unexec (dump-emacs),
-asynchronous subprocesses (start-process), and networking
-(open-network-stream). These features work fine on Mac OS X.
-
-There is basic support for synchronous subprocesses (call-process) on
-Mac OS 8/9 although Unix commands that are used will need to be
-ported.
-
-Metrowerks CodeWarrior Pro 6 or MPW-GM (August 2001) can be used to
-build Emacs on the Mac OS 8/9. On Mac OS X, Emacs can be built using
-the Developer Tools. See the INSTALL file in this directory for
-instructions on building Emacs.
-
-Binary distributions will be available in
-
- ftp://ftp.gnu.org/gnu/mac/emacs/
-
-Read the Mac OS section of the on-line help to find out about how to
-use Emacs on the Mac.
-
-A number of things do not work yet:
-
-+ On Mac OS X, environment variables are not set up correctly when
- Emacs is started from the Finder.
-
-+ Emacs does not respond correctly to C-g when it is not reading
- input.
-
-+ No image support yet.
-
-If your Mac is connected to the Internet, report bugs by typing `M-x
-report-emacs-bug' or by choosing the entry `Send Bug Report...' in
-the `Help' menu. This will send the bug report to the address
-emacs-pretest-bug@gnu.org.
-
-Andrew.
-<akochoi@mac.com>
+++ /dev/null
-<!--
-Copyright (C) 2001 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
-
-GNU Emacs is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-
-Contributed by Andrew Choi (akochoi@mac.com).
-
-Exported from the emacs-cw6.mcp project in Metrowerks CodeWarrior Pro
-6 for distribution. This copyright notice was then added by hand.
-Choose the command File->Import Project... to recreate the
-emacs-cw6.mcp project.
-
--->
-
-<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
-<?codewarrior exportversion="1.0.1" ideversion="4.1" ?>
-
-<!DOCTYPE PROJECT [
-<!ELEMENT PROJECT (TARGETLIST, TARGETORDER, GROUPLIST, DESIGNLIST?)>
-<!ELEMENT TARGETLIST (TARGET+)>
-<!ELEMENT TARGET (NAME, SETTINGLIST, FILELIST?, LINKORDER?, SEGMENTLIST?, OVERLAYGROUPLIST?, SUBTARGETLIST?, SUBPROJECTLIST?)>
-<!ELEMENT NAME (#PCDATA)>
-<!ELEMENT USERSOURCETREETYPE (#PCDATA)>
-<!ELEMENT PATH (#PCDATA)>
-<!ELEMENT FILELIST (FILE*)>
-<!ELEMENT FILE (PATHTYPE, PATHROOT?, ACCESSPATH?, PATH, PATHFORMAT?, ROOTFILEREF?, FILEKIND?, FILEFLAGS?)>
-<!ELEMENT PATHTYPE (#PCDATA)>
-<!ELEMENT PATHROOT (#PCDATA)>
-<!ELEMENT ACCESSPATH (#PCDATA)>
-<!ELEMENT PATHFORMAT (#PCDATA)>
-<!ELEMENT ROOTFILEREF (PATHTYPE, PATHROOT?, ACCESSPATH?, PATH, PATHFORMAT?)>
-<!ELEMENT FILEKIND (#PCDATA)>
-<!ELEMENT FILEFLAGS (#PCDATA)>
-<!ELEMENT FILEREF (TARGETNAME?, PATHTYPE, PATHROOT?, ACCESSPATH?, PATH, PATHFORMAT?)>
-<!ELEMENT TARGETNAME (#PCDATA)>
-<!ELEMENT SETTINGLIST ((SETTING|PANELDATA)+)>
-<!ELEMENT SETTING (NAME?, (VALUE|(SETTING+)))>
-<!ELEMENT PANELDATA (NAME, VALUE)>
-<!ELEMENT VALUE (#PCDATA)>
-<!ELEMENT LINKORDER (FILEREF*)>
-<!ELEMENT SEGMENTLIST (SEGMENT+)>
-<!ELEMENT SEGMENT (NAME, ATTRIBUTES?, FILEREF*)>
-<!ELEMENT ATTRIBUTES (#PCDATA)>
-<!ELEMENT OVERLAYGROUPLIST (OVERLAYGROUP+)>
-<!ELEMENT OVERLAYGROUP (NAME, BASEADDRESS, OVERLAY*)>
-<!ELEMENT BASEADDRESS (#PCDATA)>
-<!ELEMENT OVERLAY (NAME, FILEREF*)>
-<!ELEMENT SUBTARGETLIST (SUBTARGET+)>
-<!ELEMENT SUBTARGET (TARGETNAME, ATTRIBUTES?, FILEREF?)>
-<!ELEMENT SUBPROJECTLIST (SUBPROJECT+)>
-<!ELEMENT SUBPROJECT (FILEREF, SUBPROJECTTARGETLIST)>
-<!ELEMENT SUBPROJECTTARGETLIST (SUBPROJECTTARGET*)>
-<!ELEMENT SUBPROJECTTARGET (TARGETNAME, ATTRIBUTES?, FILEREF?)>
-<!ELEMENT TARGETORDER (ORDEREDTARGET|ORDEREDDESIGN)*>
-<!ELEMENT ORDEREDTARGET (NAME)>
-<!ELEMENT ORDEREDDESIGN (NAME, ORDEREDTARGET+)>
-<!ELEMENT GROUPLIST (GROUP|FILEREF)*>
-<!ELEMENT GROUP (NAME, (GROUP|FILEREF)*)>
-<!ELEMENT DESIGNLIST (DESIGN+)>
-<!ELEMENT DESIGN (NAME, DESIGNDATA)>
-<!ELEMENT DESIGNDATA (#PCDATA)>
-]>
-
-<PROJECT>
- <TARGETLIST>
- <TARGET>
- <NAME>Emacs CW</NAME>
- <SETTINGLIST>
-
- <!-- Settings for "Source Trees" panel -->
- <SETTING><NAME>UserSourceTrees</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "Access Paths" panel -->
- <SETTING><NAME>AlwaysSearchUserPaths</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>InterpretDOSAndUnixPaths</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>UserSearchPaths</NAME>
- <SETTING>
- <SETTING><NAME>SearchPath</NAME>
- <SETTING><NAME>Path</NAME><VALUE>:inc:</VALUE></SETTING>
- <SETTING><NAME>PathFormat</NAME><VALUE>MacOS</VALUE></SETTING>
- <SETTING><NAME>PathRoot</NAME><VALUE>Project</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>Recursive</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>HostFlags</NAME><VALUE>All</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>SearchPath</NAME>
- <SETTING><NAME>Path</NAME><VALUE>:src:</VALUE></SETTING>
- <SETTING><NAME>PathFormat</NAME><VALUE>MacOS</VALUE></SETTING>
- <SETTING><NAME>PathRoot</NAME><VALUE>Project</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>Recursive</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>HostFlags</NAME><VALUE>All</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>SearchPath</NAME>
- <SETTING><NAME>Path</NAME><VALUE>::src:</VALUE></SETTING>
- <SETTING><NAME>PathFormat</NAME><VALUE>MacOS</VALUE></SETTING>
- <SETTING><NAME>PathRoot</NAME><VALUE>Project</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>Recursive</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>HostFlags</NAME><VALUE>All</VALUE></SETTING>
- </SETTING>
- </SETTING>
- <SETTING><NAME>SystemSearchPaths</NAME>
- <SETTING>
- <SETTING><NAME>SearchPath</NAME>
- <SETTING><NAME>Path</NAME><VALUE>:inc:</VALUE></SETTING>
- <SETTING><NAME>PathFormat</NAME><VALUE>MacOS</VALUE></SETTING>
- <SETTING><NAME>PathRoot</NAME><VALUE>Project</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>Recursive</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>HostFlags</NAME><VALUE>All</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>SearchPath</NAME>
- <SETTING><NAME>Path</NAME><VALUE>:</VALUE></SETTING>
- <SETTING><NAME>PathFormat</NAME><VALUE>MacOS</VALUE></SETTING>
- <SETTING><NAME>PathRoot</NAME><VALUE>CodeWarrior</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>Recursive</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>HostFlags</NAME><VALUE>All</VALUE></SETTING>
- </SETTING>
- </SETTING>
-
- <!-- Settings for "Debugger Runtime" panel -->
- <SETTING><NAME>MWRuntimeSettings_WorkingDirectory</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWRuntimeSettings_CommandLine</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWRuntimeSettings_HostApplication</NAME>
- <SETTING><NAME>Path</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>PathFormat</NAME><VALUE>MacOS</VALUE></SETTING>
- <SETTING><NAME>PathRoot</NAME><VALUE>Absolute</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>MWRuntimeSettings_EnvVars</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "Target Settings" panel -->
- <SETTING><NAME>Linker</NAME><VALUE>MacOS PPC Linker</VALUE></SETTING>
- <SETTING><NAME>PreLinker</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>PostLinker</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Targetname</NAME><VALUE>Emacs CW</VALUE></SETTING>
- <SETTING><NAME>OutputDirectory</NAME>
- <SETTING><NAME>Path</NAME><VALUE>:</VALUE></SETTING>
- <SETTING><NAME>PathFormat</NAME><VALUE>MacOS</VALUE></SETTING>
- <SETTING><NAME>PathRoot</NAME><VALUE>Project</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>SaveEntriesUsingRelativePaths</NAME><VALUE>false</VALUE></SETTING>
-
- <!-- Settings for "File Mappings" panel -->
- <SETTING><NAME>FileMappings</NAME>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>APPL</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>Appl</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>MMLB</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>Lib Import PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>MPLF</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>Lib Import PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>MWCD</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>RSRC</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.bh</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>Balloon Help</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.c</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW C/C++ PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.c++</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW C/C++ PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.cc</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW C/C++ PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.cp</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW C/C++ PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.cpp</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW C/C++ PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.exp</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.gc</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>GameCode Converter</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.h</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW C/C++ PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>true</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.l</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>Flex Preprocessor</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.p</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW Pascal PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.pas</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW Pascal PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.pch</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW C/C++ PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.pch++</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW C/C++ PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.ppu</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>MW Pascal PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.r</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>Rez</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.s</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>PPCAsm</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>TEXT</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.y</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>Bison Preprocessor</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>XCOF</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>XCOFF Import PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>docu</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>rsrc</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>shlb</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>PEF Import PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileType</NAME><VALUE>stub</VALUE></SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE>PEF Import PPC</VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>false</VALUE></SETTING>
- </SETTING>
- <SETTING>
- <SETTING><NAME>FileExtension</NAME><VALUE>.doc</VALUE></SETTING>
- <SETTING><NAME>Compiler</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>Precompile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Launchable</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ResourceFile</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>IgnoredByMake</NAME><VALUE>true</VALUE></SETTING>
- </SETTING>
- </SETTING>
-
- <!-- Settings for "Build Extras" panel -->
- <SETTING><NAME>CacheModDates</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>ActivateBrowser</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>DumpBrowserInfo</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>CacheSubprojects</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>UseThirdPartyDebugger</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>DebuggerCommandLine</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "Debugger Target" panel -->
- <SETTING><NAME>LogSystemMessages</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>AutoTargetDLLs</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>StopAtWatchpoints</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>PauseWhileRunning</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>PauseInterval</NAME><VALUE>5</VALUE></SETTING>
- <SETTING><NAME>PauseUIFlags</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>AltExePath</NAME>
- <SETTING><NAME>Path</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>PathFormat</NAME><VALUE>Generic</VALUE></SETTING>
- <SETTING><NAME>PathRoot</NAME><VALUE>Absolute</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>StopAtTempBPOnLaunch</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>CacheSymbolics</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>TempBPFunctionName</NAME><VALUE>main</VALUE></SETTING>
- <SETTING><NAME>TempBPType</NAME><VALUE>false</VALUE></SETTING>
- <PANELDATA><NAME>Remote Debug</NAME><VALUE>
- 00030000000000000000000006B1783006B29470000000000000030007609AE0
- 00000000000000000000000006B17830000000002E646F630000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000050000000000000002E6C6962
- 000000000000000000000000000000000000000000000000000000004C696220
- 496D706F72742078383600000000000000000000000000000000000000000000
- 000000002E6F0000000000000000000000000000000000000000000000000000
- 000000004F626A20496D706F7274207838360000000000000000000000000000
- 0000000000000000000000002E6F626A00000000000000000000000000000000
- 0000000000000000000000004F626A20496D706F727420783836000000000000
- 00000000000000000000000000000000000000002E7265730000000000000000
- 000000000000000000000000000000000000000057696E52657320496D706F72
- 7400000000000000000000000000000000000000000000000000000000000000
- 06B290200000000000ACF2E007609AE000000000000000000000000006B17830
- 000000000000544558542E637000000000000000000000000000000000000000
- 000000000000000000004D5720432F432B2B2050504300000000000000000000
- 0000000000000000000000000000544558542E63707000000000000000000000
- 0000000000000000000000000000000000004D5720432F432B2B205050430000
- 00000000000000000000000000000000000000000000544558542E6578700000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000005445
- 58542E6763000000000000000000000000000000000000000000000000000000
- 000047616D65436F646520436F6E766572746572000000000000000000000000
- 000040000000544558542E680000000000000000000000000000000000000000
- 000000000000
- </VALUE></PANELDATA>
- <PANELDATA><NAME>Auto-target</NAME><VALUE>
- 00010000
- </VALUE></PANELDATA>
-
- <!-- Settings for "Custom Keywords" panel -->
- <SETTING><NAME>CustomColor1</NAME>
- <SETTING><NAME>Red</NAME><VALUE>6168</VALUE></SETTING>
- <SETTING><NAME>Green</NAME><VALUE>24672</VALUE></SETTING>
- <SETTING><NAME>Blue</NAME><VALUE>23130</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>CustomColor2</NAME>
- <SETTING><NAME>Red</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>Green</NAME><VALUE>32767</VALUE></SETTING>
- <SETTING><NAME>Blue</NAME><VALUE>0</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>CustomColor3</NAME>
- <SETTING><NAME>Red</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>Green</NAME><VALUE>32767</VALUE></SETTING>
- <SETTING><NAME>Blue</NAME><VALUE>0</VALUE></SETTING>
- </SETTING>
- <SETTING><NAME>CustomColor4</NAME>
- <SETTING><NAME>Red</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>Green</NAME><VALUE>32767</VALUE></SETTING>
- <SETTING><NAME>Blue</NAME><VALUE>0</VALUE></SETTING>
- </SETTING>
-
- <!-- Settings for "68K CodeGen" panel -->
- <SETTING><NAME>MWCodeGen_68K_codesize</NAME><VALUE>Smart</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_structalignment</NAME><VALUE>MC68K</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_fp_mode</NAME><VALUE>SANE</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_code68020</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_profiler</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_mpwc</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_fourbyteints</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_IEEEdoubles</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_fardata</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_farvtables</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_farstrings</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_pcrelstrings</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_macsbug</NAME><VALUE>New</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_68K_a6frames</NAME><VALUE>1</VALUE></SETTING>
-
- <!-- Settings for "68K Disassembler" panel -->
- <SETTING><NAME>MWDisassembler_68K_showcode</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_68K_mix</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_68K_nohex</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_68K_showdata</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_68K_showexceptions</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_68K_showsym</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_68K_shownames</NAME><VALUE>1</VALUE></SETTING>
-
- <!-- Settings for "68K Global Optimizer" panel -->
- <SETTING><NAME>GlobalOptimizer_68K_optimizationlevel</NAME><VALUE>Level0</VALUE></SETTING>
- <SETTING><NAME>GlobalOptimizer_68K_optfor</NAME><VALUE>Speed</VALUE></SETTING>
-
- <!-- Settings for "68K Linker" panel -->
- <SETTING><NAME>MWLinker_68K_linksym</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWLinker_68K_symfullpath</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWLinker_68K_linksingle</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_68K_fastlink</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWLinker_68K_generateMap</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_68K_nolinkwarnings</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_68K_glueintosegone</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWLinker_68K_dontdeadstripinitcode</NAME><VALUE>0</VALUE></SETTING>
-
- <!-- Settings for "68K Project" panel -->
- <SETTING><NAME>MWProject_68K_type</NAME><VALUE>Application</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_outfile</NAME><VALUE>MacOS Toolbox DEBUG 68K</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_symfilename</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_filecreator</NAME><VALUE>1061109567</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_filetype</NAME><VALUE>1095782476</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_size</NAME><VALUE>384</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_flags</NAME><VALUE>22720</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrcheader</NAME><VALUE>Standard</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrcname</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrctype</NAME><VALUE>1061109567</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrcid</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrcmulti</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrcstore</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrcmerge</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrcflags</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_a4</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_minsize</NAME><VALUE>384</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrcsegtype</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_cfm68kcodegen</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_stacksize</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_thedebugger</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_rsrc_custom</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_is_rseg_app</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_is_pilot_lib</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_68K_pilot_main_entry</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "C/C++ Compiler" panel -->
- <SETTING><NAME>MWFrontEnd_C_cplusplus</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_checkprotos</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_arm</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_trigraphs</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_onlystdkeywords</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_enumsalwaysint</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_mpwpointerstyle</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_prefixname</NAME><VALUE>defs-cw6.h</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_ansistrict</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_mpwcnewline</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_wchar_type</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_enableexceptions</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_dontreusestrings</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_poolstrings</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_dontinline</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_useRTTI</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_multibyteaware</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_unsignedchars</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_autoinline</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_booltruefalse</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_direct_to_som</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_som_env_check</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_alwaysinline</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_inlinelevel</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_ecplusplus</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_objective_c</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFrontEnd_C_defer_codegen</NAME><VALUE>0</VALUE></SETTING>
-
- <!-- Settings for "C/C++ Warnings" panel -->
- <SETTING><NAME>MWWarning_C_warn_illpragma</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_emptydecl</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_possunwant</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_unusedvar</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_unusedarg</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_extracomma</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_pedantic</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warningerrors</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_hidevirtual</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_implicitconv</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_notinlined</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWWarning_C_warn_structclass</NAME><VALUE>0</VALUE></SETTING>
-
- <!-- Settings for "CFM68K" panel -->
- <SETTING><NAME>MWCFM68K_exports</NAME><VALUE>None</VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_olddefversion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_oldimpversion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_currentversion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_farthreshold</NAME><VALUE>256</VALUE></SETTING>
- <SETTING><NAME>PCFM68K_sharedata</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_fragmentname</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_initname</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_mainname</NAME><VALUE>__start</VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_termname</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_libfolder</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCFM68K_alignment</NAME><VALUE>Align_2</VALUE></SETTING>
-
- <!-- Settings for "FTP Panel" panel -->
- <SETTING><NAME>MWFTP_Post_hostName</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_username</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_password</NAME><VALUE>35kmm835kpjgj5k5td7à</VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_remoteDir</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_ftp_PathVersion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_ftp_PathType</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_ftp_PathFormat</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_ftp_tree</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_uploadDir</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_ftp_port</NAME><VALUE>21</VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_SendBin</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWFTP_Post_ShouldLog</NAME><VALUE>1</VALUE></SETTING>
-
- <!-- Settings for "Java Command Line" panel -->
- <SETTING><NAME>MWCommandLine_Java_clsName</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWCommandLine_Java_args</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "Java Language" panel -->
- <SETTING><NAME>MWJava_Language_optimize</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_warnDeprecated</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_emitMap</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_strictFileNames</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_strictFileHierarchy</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_1_1_Compatible</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_emitHeaders</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_headerType</NAME><VALUE>JNINativeHeaders</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_packageFilter</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_genComments</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>MWJava_Language_genHeaders</NAME><VALUE>false</VALUE></SETTING>
-
- <!-- Settings for "Java MRJAppBuilder" panel -->
- <SETTING><NAME>MWJava_MRJAppBuilder_outFile</NAME><VALUE>MRJApplication</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_merge</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_quitMenu</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_grow</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdoutType</NAME><VALUE>Console</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stderrType</NAME><VALUE>Console</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdinType</NAME><VALUE>Console</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_appIconPVersion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_appIconPType</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_appIconPFormat</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_appIconPTree</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_appIconFile</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_splashScreenPVersion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_splashScreenPType</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_splashScreenPFormat</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_splashScreenPTree</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_splashScreenPICTFile</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_aboutName</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdoutPVersion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdoutPType</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdoutPFormat</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdoutPTree</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdoutFile</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdoutAppend</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stderrPType</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stderrPFormat</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stderrPTree</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stderrFile</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stderrAppend</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdinPType</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdinPFormat</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdinPTree</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_MRJAppBuilder_stdinFile</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "Java Output" panel -->
- <SETTING><NAME>MWJava_Output_outputtype</NAME><VALUE>JarFile</VALUE></SETTING>
- <SETTING><NAME>MWJava_Output_outfile</NAME><VALUE>JavaClasses.jar</VALUE></SETTING>
- <SETTING><NAME>MWJava_Output_ftype</NAME><VALUE>1514754080</VALUE></SETTING>
- <SETTING><NAME>MWJava_Output_fcreator</NAME><VALUE>1297570384</VALUE></SETTING>
- <SETTING><NAME>MWJava_Output_compress</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_Output_genManifest</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_Output_trunctype</NAME><VALUE>Front</VALUE></SETTING>
- <SETTING><NAME>MWJava_Output_deleteClasses</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_Output_consoleApp</NAME><VALUE>1</VALUE></SETTING>
-
- <!-- Settings for "Java Project" panel -->
- <SETTING><NAME>MWJava_Proj_projtype</NAME><VALUE>Applet</VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_mainClassName</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_HTMLAppCreator</NAME><VALUE>1463898714</VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_HTMLAppName</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_PathVersion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_PathType</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_PathFormat</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_tree</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_HTMLAppWin32Name</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_compress</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_useVM</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_vmarguments</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJava_Proj_vmName</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "JavaDoc Project" panel -->
- <SETTING><NAME>MWJavaDoc_Proj_Version</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_Depricated</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_Author</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_Index</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_Tree</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_SunResolveToSame</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_Shortnames</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_Folder</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_GenerateAPILinks</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_scope</NAME><VALUE>Public</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_fcreator</NAME><VALUE>1297303877</VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_encodingName</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_decodingName</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWJavaDoc_Proj_javaPackagePath</NAME><VALUE>http://java.sun.com/products/jdk/1.1/docs/api/</VALUE></SETTING>
-
- <!-- Settings for "MacOS Merge Panel" panel -->
- <SETTING><NAME>MWMerge_MacOS_projectType</NAME><VALUE>Application</VALUE></SETTING>
- <SETTING><NAME>MWMerge_MacOS_outputName</NAME><VALUE>Merge Out</VALUE></SETTING>
- <SETTING><NAME>MWMerge_MacOS_outputCreator</NAME><VALUE>1061109567</VALUE></SETTING>
- <SETTING><NAME>MWMerge_MacOS_outputType</NAME><VALUE>1095782476</VALUE></SETTING>
- <SETTING><NAME>MWMerge_MacOS_suppressWarning</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWMerge_MacOS_copyFragments</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWMerge_MacOS_copyResources</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWMerge_MacOS_skipResources</NAME>
- <SETTING><VALUE> </VALUE></SETTING>
- <SETTING><VALUE>\ 6¼_À</VALUE></SETTING>
- <SETTING><VALUE>\ 6ˆ\1dx</VALUE></SETTING>
- <SETTING><VALUE>\ 6\16¡À</VALUE></SETTING>
- </SETTING>
-
- <!-- Settings for "Output Flags" panel -->
- <SETTING><NAME>FileLocked</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>ResourcesMapIsReadOnly</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>PrinterDriverIsMultiFinderCompatible</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Invisible</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>HasBundle</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>NameLocked</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Stationery</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>HasCustomIcon</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Shared</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>HasBeenInited</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>Label</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>Comments</NAME><VALUE></VALUE></SETTING>
- <PANELDATA><NAME>Packager Panel</NAME><VALUE>
- 000100003F3F3F3F4150504C06B2000100B2D900000000000000061007609AE0
- 2020202020202020203C504106B2D310524D41543E4D61634F533C2F50415448
- 464F524D41543E0D202020202020202020202020202020203C2F46494C455245
- 463E0D202020202020202020202020202020203C46494C455245463E0D202020
- 20202020202020202020202020202020203C50415448545950453E4E616D653C
- 2F50415448545950453E0D20202020202020202020202020202020202020203C
- 504154483E666E732E633C2F504154483E0D2020202020202020202020202020
- 2020202020203C50415448464F524D41543E4D61634F533C2F50415448464F52
- 4D41543E0D202020202020202020202000202020203C2F46494C455245463E0D
- 202020202020202020202020202020203C46494C455245463E0D202020202020
- 20202020202020202020202020203C50415448545950453E4E616D653C2F5041
- 5448545950453E0D20202020202020202020202020202020202020203C504154
- 483E666F6E747365742E633C2F504154483E0D20202020202020202020202020
- 202020202020203C50415448464F524D41543E4D61634F533C2F50415448464F
- 524D41543E0D202020202020202020202020202020203C2F46494C455245463E
- 0D202020202020202020202020202020203C46494C455245463E0D2020202020
- 2020202020202020202020202020203C50415448545950453E4E616D653C2F50
- 415448545950453E0D20202020202020202020202020202020202020203C5041
- 54483E6672616D652E633C2F504154483E0D2020202020202020202020202020
- 2020202020203C50415448464F524D41543E4D61634F533C2F50415448464F52
- 4D41543E0D202020202020202020202020202020203C2F46494C455245463E0D
- 202020202020202020202020202020203C46494C455245463E0D202020202020
- 20202020202020202020202020203C50415448545950453E4E616D653C2F5041
- 5448545950453E0D20202020202020202020202020202020202020203C504154
- 483E6765746C6F61646176672E633C2F50410001000D20202020202020202020
- 202020202020202020203C50415448464F524D41543E4D61634F533C2F504154
- 48464F524D41543E0D202020202020202020202020202020203C2F46494C4552
- 45463E0D202020202020202020202020202020203C46494C455245463E0D2020
- 2020202020202020202020202020202020203C50415448545950453E4E616D65
- 3C2F50415448545950453E0D2020202020202020202020202020202020202020
- 3C504154483E696E64656E742E633C2F504154483E0D20202020202020202020
- 202020202020202020203C50415448464F524D41543E4D61634F533C2F504154
- 48464F524D41543E0D202020202020202020202000202020203C2F46494C4552
- 45463E0D202020202020202020202020202020203C46494C455245463E0D2020
- 2020202020202020202020202020202020203C50415448545950453E4E616D65
- 3C2F50415448545950453E0D2020202020202020202020202020202020202020
- 3C504154483E696E7364656C2E633C2F504154483E0D20202020202020202020
- 202020202020202020203C50415448464F524D41543E4D61634F533C2F504154
- 48464F524D41543E0D202020202020202020202020202020203C2F46494C4552
- 45463E0D202020202020202020202020202020203C46494C455245463E0D2020
- 2020202020202020202020202020202020203C50415448545950453E4E616D65
- 3C2F50415448545950453E0D2020202020202020202020202020202020202020
- 3C504154483E696E74657276616C732E633C2F504154483E0D20202020202020
- 202020202020202020202020203C50415448464F524D41543E4D61634F533C2F
- 50415448464F524D41543E0D202020202020202020202020202020203C2F4649
- 4C455245463E0D202020202020202020202020202020203C46494C455245463E
- 0D20202020202020202020202020202020202020203C50415448545950453E4E
- 616D653C2F50415448545950453E0D2020202020202020202020202020202020
- 2020203C504154483E6B6579626F6172642E633C
- </VALUE></PANELDATA>
-
- <!-- Settings for "PPC CodeGen" panel -->
- <SETTING><NAME>MWCodeGen_PPC_structalignment</NAME><VALUE>PPC</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_tracebacktables</NAME><VALUE>Inline</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_processor</NAME><VALUE>Generic</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_readonlystrings</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_tocdata</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_profiler</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_fpcontract</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_schedule</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_peephole</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_processorspecific</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_altivec</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_vectortocdata</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_PPC_vrsave</NAME><VALUE>0</VALUE></SETTING>
-
- <!-- Settings for "PPC Disassembler" panel -->
- <SETTING><NAME>MWDisassembler_PPC_showcode</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_PPC_extended</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_PPC_mix</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_PPC_nohex</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_PPC_showdata</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_PPC_showexceptions</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_PPC_showsym</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWDisassembler_PPC_shownames</NAME><VALUE>1</VALUE></SETTING>
-
- <!-- Settings for "PPC Global Optimizer" panel -->
- <SETTING><NAME>GlobalOptimizer_PPC_optimizationlevel</NAME><VALUE>Level0</VALUE></SETTING>
- <SETTING><NAME>GlobalOptimizer_PPC_optfor</NAME><VALUE>Speed</VALUE></SETTING>
-
- <!-- Settings for "PPC Linker" panel -->
- <SETTING><NAME>MWLinker_PPC_linksym</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_symfullpath</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_linkmap</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_nolinkwarnings</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_dontdeadstripinitcode</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_permitmultdefs</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_linkmode</NAME><VALUE>Fast</VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_initname</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_mainname</NAME><VALUE>__start</VALUE></SETTING>
- <SETTING><NAME>MWLinker_PPC_termname</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "PPC PEF" panel -->
- <SETTING><NAME>MWPEF_exports</NAME><VALUE>None</VALUE></SETTING>
- <SETTING><NAME>MWPEF_libfolder</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWPEF_sortcode</NAME><VALUE>None</VALUE></SETTING>
- <SETTING><NAME>MWPEF_expandbss</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWPEF_sharedata</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWPEF_olddefversion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWPEF_oldimpversion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWPEF_currentversion</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWPEF_fragmentname</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWPEF_collapsereloads</NAME><VALUE>0</VALUE></SETTING>
-
- <!-- Settings for "PPC Project" panel -->
- <SETTING><NAME>MWProject_PPC_type</NAME><VALUE>Application</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_outfile</NAME><VALUE>Emacs CW</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_filecreator</NAME><VALUE>1162690936</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_filetype</NAME><VALUE>1095782476</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_size</NAME><VALUE>16384</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_minsize</NAME><VALUE>16384</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_stacksize</NAME><VALUE>512</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_flags</NAME><VALUE>22752</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_symfilename</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_rsrcname</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_rsrcheader</NAME><VALUE>Native</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_rsrctype</NAME><VALUE>1061109567</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_rsrcid</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_rsrcflags</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_rsrcstore</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWProject_PPC_rsrcmerge</NAME><VALUE>0</VALUE></SETTING>
-
- <!-- Settings for "PPCAsm Panel" panel -->
- <SETTING><NAME>MWAssembler_PPC_auxheader</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWAssembler_PPC_symmode</NAME><VALUE>Mac</VALUE></SETTING>
- <SETTING><NAME>MWAssembler_PPC_dialect</NAME><VALUE>PPC</VALUE></SETTING>
- <SETTING><NAME>MWAssembler_PPC_prefixfile</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWAssembler_PPC_typecheck</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWAssembler_PPC_warnings</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWAssembler_PPC_casesensitive</NAME><VALUE>0</VALUE></SETTING>
-
- <!-- Settings for "Rez Compiler" panel -->
- <SETTING><NAME>MWRez_Language_maxwidth</NAME><VALUE>80</VALUE></SETTING>
- <SETTING><NAME>MWRez_Language_script</NAME><VALUE>Roman</VALUE></SETTING>
- <SETTING><NAME>MWRez_Language_alignment</NAME><VALUE>Align1</VALUE></SETTING>
- <SETTING><NAME>MWRez_Language_filtermode</NAME><VALUE>FilterSkip</VALUE></SETTING>
- <SETTING><NAME>MWRez_Language_suppresswarnings</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWRez_Language_escapecontrolchars</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWRez_Language_prefixname</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWRez_Language_filteredtypes</NAME><VALUE>'CODE' 'DATA' 'PICT'</VALUE></SETTING>
-
- <!-- Settings for "WinRC Compiler" panel -->
- <SETTING><NAME>MWWinRC_prefixname</NAME><VALUE></VALUE></SETTING>
-
- <!-- Settings for "x86 CodeGen" panel -->
- <SETTING><NAME>MWCodeGen_X86_processor</NAME><VALUE>Generic</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_alignment</NAME><VALUE>bytes8</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_exceptions</NAME><VALUE>ZeroOverhead</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_extinst_mmx</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_extinst_3dnow</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_use_mmx_3dnow_convention</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_machinecodelisting</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_intrinsics</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_syminfo</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_codeviewinfo</NAME><VALUE>1</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_extinst_cmov_fcomi</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWCodeGen_X86_extinst_sse</NAME><VALUE>0</VALUE></SETTING>
-
- <!-- Settings for "x86 Disassembler" panel -->
- <SETTING><NAME>PDisasmX86_showHeaders</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showSymTab</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showCode</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showSource</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showHex</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showRelocation</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showComments</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showDebug</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showExceptions</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showData</NAME><VALUE>true</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_showRaw</NAME><VALUE>false</VALUE></SETTING>
- <SETTING><NAME>PDisasmX86_verbose</NAME><VALUE>true</VALUE></SETTING>
-
- <!-- Settings for "x86 Exceptions Panel" panel -->
- <SETTING><NAME>MWDebugger_X86_Exceptions</NAME>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- <SETTING><VALUE>0</VALUE></SETTING>
- </SETTING>
-
- <!-- Settings for "x86 Global Optimizer" panel -->
- <SETTING><NAME>GlobalOptimizer_X86_optimizationlevel</NAME><VALUE>Level0</VALUE></SETTING>
- <SETTING><NAME>GlobalOptimizer_X86_optfor</NAME><VALUE>Speed</VALUE></SETTING>
-
- <!-- Settings for "x86 Linker" panel -->
- <SETTING><NAME>MWLinker_X86_entrypointusage</NAME><VALUE>Default</VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_entrypoint</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_subsystem</NAME><VALUE>WinGUI</VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_subsysmajorid</NAME><VALUE>4</VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_subsysminorid</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_usrmajorid</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_usrminorid</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_commandfile</NAME><VALUE></VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_generatemap</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_linksym</NAME><VALUE>0</VALUE></SETTING>
- <SETTING><NAME>MWLinker_X86_linkCV</NAME><VALUE>1</VALUE></SETTING>
-
- <!-- Settings for "x86 Project" panel -->
- <SETTING><NAME>MWProject_X86_type</NAME><VALUE>Application</VALUE></SETTING>
- <SETTING><NAME>MWProject_X86_outfile</NAME><VALUE>noname.exe</VALUE></SETTING>
- <SETTING><NAME>MWProject_X86_baseaddress</NAME><VALUE>4194304</VALUE></SETTING>
- <SETTING><NAME>MWProject_X86_maxstacksize</NAME><VALUE>1024</VALUE></SETTING>
- <SETTING><NAME>MWProject_X86_minstacksize</NAME><VALUE>4</VALUE></SETTING>
- <SETTING><NAME>MWProject_X86_size</NAME><VALUE>1024</VALUE></SETTING>
- <SETTING><NAME>MWProject_X86_minsize</NAME><VALUE>4</VALUE></SETTING>
- <SETTING><NAME>MWProject_X86_importlib</NAME><VALUE></VALUE></SETTING>
- </SETTINGLIST>
- <FILELIST>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>InterfaceLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Library</FILEKIND>
- <FILEFLAGS></FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MathLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Library</FILEKIND>
- <FILEFLAGS></FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>emacs.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>process.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>floatfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>editfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macros.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>xdisp.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>window.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>minibuf.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>keymap.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>buffer.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>cmds.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>casefiddle.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>textprop.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>undo.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>syntax.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>search.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>marker.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>insdel.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>indent.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>coding.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fileio.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>alloc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>eval.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>doc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>dired.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>charset.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>ccl.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>category.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>callproc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>casetab.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>callint.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>bytecode.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>abbrev.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>print.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>data.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>intervals.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>regex.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>mktime.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>filemode.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>getloadavg.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>scroll.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>region-cache.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>doprnt.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>cm.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>termcap.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>tparam.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>sysdep.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>lread.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>frame.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>term.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>keyboard.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fontset.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>dispnew.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>Emacs.r</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>AppleScriptLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Library</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>strftime.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>TextEncodingConverter</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Library</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>xfaces.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macterm.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>composite.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>atimer.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>mac.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>alloca.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macmenu.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>AppearanceLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Library</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL C.PPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Library</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL SIOUX.PPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Library</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL RuntimePPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Library</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- <FILE>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>md5.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- <FILEKIND>Text</FILEKIND>
- <FILEFLAGS>Debug</FILEFLAGS>
- </FILE>
- </FILELIST>
- <LINKORDER>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>abbrev.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>alloc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>alloca.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>atimer.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>buffer.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>bytecode.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>callint.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>callproc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>casefiddle.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>casetab.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>category.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>ccl.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>charset.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>cm.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>cmds.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>coding.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>composite.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>data.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>dired.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>dispnew.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>doc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>doprnt.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>editfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>emacs.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>eval.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fileio.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>filemode.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>floatfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fontset.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>frame.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>getloadavg.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>indent.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>insdel.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>intervals.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>keyboard.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>keymap.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>lread.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macros.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>marker.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>md5.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>minibuf.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>mktime.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>print.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>process.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>regex.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>region-cache.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>scroll.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>search.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>strftime.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>syntax.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>term.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>termcap.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>textprop.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>tparam.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>undo.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>window.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>xdisp.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>sysdep.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>xfaces.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>mac.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macmenu.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macterm.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>InterfaceLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MathLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>AppleScriptLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>TextEncodingConverter</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>AppearanceLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>Emacs.r</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL C.PPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL SIOUX.PPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL RuntimePPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- </LINKORDER>
- </TARGET>
- </TARGETLIST>
-
- <TARGETORDER>
- <ORDEREDTARGET><NAME>Emacs CW</NAME></ORDEREDTARGET>
- </TARGETORDER>
-
- <GROUPLIST>
- <GROUP><NAME>Emacs Source</NAME>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>abbrev.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>alloc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>alloca.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>atimer.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>buffer.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>bytecode.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>callint.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>callproc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>casefiddle.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>casetab.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>category.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>ccl.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>charset.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>cm.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>cmds.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>coding.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>composite.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>data.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>dired.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>dispnew.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>doc.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>doprnt.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>editfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>emacs.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>eval.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fileio.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>filemode.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>floatfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>fontset.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>frame.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>getloadavg.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>indent.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>insdel.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>intervals.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>keyboard.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>keymap.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>lread.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macros.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>marker.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>md5.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>minibuf.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>mktime.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>print.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>process.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>regex.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>region-cache.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>scroll.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>search.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>strftime.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>syntax.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>sysdep.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>term.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>termcap.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>textprop.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>tparam.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>undo.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>window.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>xdisp.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>xfaces.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- </GROUP>
- <GROUP><NAME>Mac Source</NAME>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>mac.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macfns.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macmenu.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>macterm.c</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- </GROUP>
- <GROUP><NAME>Resources</NAME>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>Emacs.r</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- </GROUP>
- <GROUP><NAME>Mac Libraries</NAME>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>InterfaceLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MathLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>AppleScriptLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>TextEncodingConverter</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>AppearanceLib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- </GROUP>
- <GROUP><NAME>ANSI Libraries</NAME>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL C.PPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL SIOUX.PPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- <FILEREF>
- <TARGETNAME>Emacs CW</TARGETNAME>
- <PATHTYPE>Name</PATHTYPE>
- <PATH>MSL RuntimePPC.Lib</PATH>
- <PATHFORMAT>MacOS</PATHFORMAT>
- </FILEREF>
- </GROUP>
- </GROUPLIST>
-
-</PROJECT>
+++ /dev/null
-/* Copyright (C) 2001 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
-
-GNU Emacs is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _ALLOCA_H_
-#define _ALLOCA_H_
-
-#if __MRC__
-void *__alloca(size_t size);
-#endif
-
-#endif
+++ /dev/null
-/* Handcrafted Emacs site configuration file for Mac OS. -*- C -*- */
-
-/* GNU Emacs site configuration template file. -*- C -*-
- Copyright (C) 1988, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to the
-Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-
-/* No code in Emacs #includes config.h twice, but some of the code
- intended to work with other packages as well (like gmalloc.c)
- think they can include it as many times as they like. */
-#ifndef EMACS_CONFIG_H
-#define EMACS_CONFIG_H
-
-/* These are all defined in the top-level Makefile by configure.
- They're here only for reference. */
-
-/* Define GNU_MALLOC if you want to use the GNU memory allocator. */
-/* #undef GNU_MALLOC */
-
-/* Define if you are using the GNU C Library. */
-/* #undef DOUG_LEA_MALLOC */
-
-/* Define REL_ALLOC if you want to use the relocating allocator for
- buffer space. */
-/* #undef REL_ALLOC */
-
-/* Define HAVE_X_WINDOWS if you want to use the X window system. */
-/* #undef HAVE_X_WINDOWS */
-
-/* Define HAVE_X11 if you want to use version 11 of X windows.
- Otherwise, Emacs expects to use version 10. */
-/* #undef HAVE_X11 */
-
-/* Define if using an X toolkit. */
-/* #undef USE_X_TOOLKIT */
-
-/* Define this if you're using XFree386. */
-/* #undef HAVE_XFREE386 */
-
-/* Define this if you have Motif 2.1 or newer. */
-/* #undef HAVE_MOTIF_2_1 */
-
-/* Define HAVE_MENUS if you have mouse menus.
- (This is automatic if you use X, but the option to specify it remains.)
- It is also defined with other window systems that support xmenu.c. */
-#define HAVE_MENUS 1
-
-/* Define if we have the X11R6 or newer version of Xt. */
-/* #undef HAVE_X11XTR6 */
-
-/* Define if we have the X11R6 or newer version of Xlib. */
-/* #undef HAVE_X11R6 */
-
-/* Define if we have the X11R5 or newer version of Xlib. */
-/* #undef HAVE_X11R5 */
-
-/* Define if we have the XPM libary. */
-/* #undef HAVE_XPM */
-
-/* Define if we have the PNG library. */
-/* #undef HAVE_PNG */
-
-/* Define if we have the JPEG library. */
-/* #undef HAVE_JPEG */
-
-/* Define if we have the TIFF library. */
-/* #undef HAVE_TIFF */
-
-/* Define if we have the GIF library. */
-/* #undef HAVE_GIF */
-
-/* Define if libXaw3d is available. */
-/* #undef HAVE_XAW3D */
-
-/* Define if we should use toolkit scroll bars. */
-/* #undef USE_TOOLKIT_SCROLL_BARS */
-
-/* Define if we should use XIM, if it is available. */
-/* #undef USE_XIM */
-
-/* Define if netdb.h declares h_errno. */
-/* #undef HAVE_H_ERRNO */
-
-/* If we're using any sort of window system, define some consequences. */
-#ifdef HAVE_X_WINDOWS
-#define HAVE_WINDOW_SYSTEM
-#define MULTI_KBOARD
-#define HAVE_MOUSE
-#endif
-
-/* Define for MacOS */
-#define HAVE_WINDOW_SYSTEM 1
-#define HAVE_MOUSE 1
-
-/* Define USER_FULL_NAME to return a string
- that is the user's full name.
- It can assume that the variable `pw'
- points to the password file entry for this user.
-
- At some sites, the pw_gecos field contains
- the user's full name. If neither this nor any other
- field contains the right thing, use pw_name,
- giving the user's login name, since that is better than nothing. */
-#define USER_FULL_NAME pw->pw_name
-
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-/* Turned on June 1996 supposing nobody will mind it. */
-/* #undef AMPERSAND_FULL_NAME */
-
-/* Things set by --with options in the configure script. */
-
-/* Define to support POP mail retrieval. */
-/* #undef MAIL_USE_POP 1 */
-
-/* Define to support Kerberos-authenticated POP mail retrieval. */
-/* #undef KERBEROS */
-/* Define to use Kerberos 5 instead of Kerberos 4 */
-/* #undef KERBEROS5 */
-/* Define to support GSS-API in addition to (or instead of) Kerberos */
-/* #undef GSSAPI */
-
-/* Define to support using a Hesiod database to find the POP server. */
-/* #undef HESIOD */
-
-/* Header for Voxware or PCM sound card driver. */
-/* #undef HAVE_MACHINE_SOUNDCARD_H */
-/* #undef HAVE_SYS_SOUNDCARD_H */
-/* #undef HAVE_SOUNDCARD_H */
-
-/* Define HAVE_SOUND if we have sound support. We know it works
- and compiles only on the specified platforms. For others,
- it probably doesn't make sense to try. */
-
-#if defined __FreeBSD__ || defined __NetBSD__ || defined __linux__
-#ifdef HAVE_MACHINE_SOUNDCARD_H
-#define HAVE_SOUND 1
-#endif
-#ifdef HAVE_SYS_SOUNDCARD_H
-#define HAVE_SOUND 1
-#endif
-#ifdef HAVE_SOUNDCARD_H
-#define HAVE_SOUND 1
-#endif
-#endif /* __FreeBSD__ || __NetBSD__ || __linux__ */
-
-/* Some things figured out by the configure script, grouped as they are in
- configure.in. */
-#ifndef _ALL_SOURCE /* suppress warning if this is pre-defined */
-/* #undef _ALL_SOURCE */
-#endif
-
-/* #undef HAVE_SYS_SELECT_H */
-/* #undef HAVE_SYS_TIMEB_H */
-#define HAVE_SYS_TIME_H 1
-
-#ifdef __MRC__
-#undef HAVE_UNISTD_H
-#else /* CodeWarrior */
-#define HAVE_UNISTD_H 1
-#endif
-
-#define HAVE_UTIME_H 1
-/* #undef HAVE_LINUX_VERSION_H */
-/* #undef HAVE_SYS_SYSTEMINFO_H */
-/* #undef HAVE_TERMIOS_H */
-#define HAVE_LIMITS_H 1
-#define HAVE_STRING_H 1
-/* #undef HAVE_STDLIB_H */
-/* #undef HAVE_TERMCAP_H */
-/* #undef HAVE_TERM_H */
-/* #undef HAVE_STDIO_EXT_H */
-/* #undef STDC_HEADERS */
-/* #undef TIME_WITH_SYS_TIME */
-/* #undef HAVE_VFORK_H */
-#define HAVE_FCNTL_H 1
-/* #undef HAVE_SETITIMER */
-/* #undef HAVE_UALARM */
-/* #undef HAVE_SYS_WAIT_H */
-
-/* #undef HAVE_LIBDNET */
-/* #undef HAVE_LIBPTHREADS */
-/* #undef HAVE_LIBRESOLV */
-/* #undef HAVE_LIBXMU */
-/* #undef HAVE_LIBNCURSES */
-/* #undef HAVE_LIBINTL */
-/* #undef HAVE_LIBXP */
-
-/* movemail Kerberos support */
-/* libraries */
-/* #undef HAVE_LIBKRB */
-/* #undef HAVE_LIBKRB4 */
-/* #undef HAVE_LIBDES */
-/* #undef HAVE_LIBDES425 */
-/* #undef HAVE_LIBKRB5 */
-/* #undef HAVE_LIBCRYPTO */
-/* #undef HAVE_LIBCOM_ERR */
-/* header files */
-/* #undef HAVE_KRB5_H */
-/* #undef HAVE_DES_H */
-/* #undef HAVE_KRB_H */
-/* #undef HAVE_KERBEROSIV_DES_H */
-/* #undef HAVE_KERBEROSIV_KRB_H */
-/* #undef HAVE_KERBEROS_DES_H */
-/* #undef HAVE_KERBEROS_KRB_H */
-/* #undef HAVE_COM_ERR_H */
-
-/* GSS-API libraries and headers */
-/* #undef HAVE_LIBGSSAPI_KRB5 */
-/* #undef HAVE_LIBGSSAPI */
-/* #undef HAVE_GSSAPI_H */
-
-/* Mail-file locking */
-/* #undef HAVE_LIBMAIL */
-/* #undef HAVE_MAILLOCK_H */
-/* #undef HAVE_TOUCHLOCK */
-
-/* #undef HAVE_ALLOCA_H */
-
-/* #undef HAVE_DEV_PTMX */
-
-#define HAVE_GETTIMEOFDAY 1
-/* If we don't have gettimeofday,
- the test for GETTIMEOFDAY_ONE_ARGUMENT may succeed,
- but we should ignore it. */
-#ifdef HAVE_GETTIMEOFDAY
-#define GETTIMEOFDAY_ONE_ARGUMENT 1
-#endif
-/* #undef HAVE_GETHOSTNAME */
-/* #undef HAVE_GETDOMAINNAME */
-/* #undef HAVE_DUP2 */
-#define HAVE_RENAME 1
-#define HAVE_CLOSEDIR 1
-
-/* #undef TM_IN_SYS_TIME */
-/* #undef HAVE_TM_ZONE */
-/* #undef HAVE_TZNAME */
-/* #undef HAVE_TM_GMTOFF */
-
-/* #undef const */
-
-/* #undef HAVE_LONG_FILE_NAMES */
-
-/* #undef CRAY_STACKSEG_END */
-
-/* #undef UNEXEC_SRC unexelf.c
-
-/* #undef HAVE_LIBXBSD */
-/* #undef HAVE_XRMSETDATABASE */
-/* #undef HAVE_XSCREENRESOURCESTRING */
-/* #undef HAVE_XSCREENNUMBEROFSCREEN */
-/* #undef HAVE_XSETWMPROTOCOLS */
-
-#define HAVE_MKDIR 1
-#define HAVE_RMDIR 1
-/* #undef HAVE_SYSINFO */
-/* #undef HAVE_RANDOM */
-/* #undef HAVE_LRAND48 */
-/* #undef HAVE_BCOPY */
-/* #undef HAVE_BCMP */
-#define HAVE_LOGB 1
-#define HAVE_FREXP 1
-#define HAVE_FMOD 1
-
-#ifdef __MRC__
-#undef HAVE_RINT
-#else /* CodeWarrior */
-#define HAVE_RINT
-#endif
-
-/* #undef HAVE_CBRT */
-/* #undef HAVE_FTIME */
-/* #undef HAVE_RES_INIT */ /* For -lresolv on Suns. */
-/* #undef HAVE_SETSID */
-/* #undef HAVE_FPATHCONF */
-#define HAVE_SELECT 1
-/* #undef HAVE_MKTIME */
-/* #undef BROKEN_MKTIME */ /* have mktime but it's broken */
-/* #undef HAVE_EUIDACCESS */
-/* #undef HAVE_GETPAGESIZE */
-/* #undef HAVE_TZSET */
-#define HAVE_SETLOCALE 1
-/* #undef HAVE_UTIMES */
-/* #undef HAVE_SETRLIMIT */
-/* #undef HAVE_SETPGID */
-/* #undef HAVE_GETCWD */
-#define HAVE_GETWD 1
-/* #undef HAVE_SHUTDOWN */
-#define HAVE_STRFTIME 1
-/* #undef HAVE_GETADDRINFO */
-/* #undef HAVE___FPENDING */
-/* #undef HAVE_FTELLO */
-/* #undef HAVE_GETLOADAVG */
-/* #undef NLIST_STRUCT */
-/* #undef NLIST_NAME_UNION */
-/* #undef HAVE_MBLEN */
-/* #undef HAVE_MBRLEN */
-/* #undef HAVE_STRSIGNAL */
-/* #undef HAVE_GRANTPT */
-/* #undef HAVE_GETPT */
-/* #undef HAVE_SPEED_T */ /* speed_t typedef in termios.h */
-/* #undef HAVE_STRUCT_TIMEZONE */
-
-/* #undef LOCALTIME_CACHE */
-/* #undef HAVE_INET_SOCKETS */
-
-/* #undef HAVE_AIX_SMT_EXP */
-
-/* #undef vfork */
-
-/* Define if you have the ANSI `strerror' function.
- Otherwise you must have the variable `char *sys_errlist[]'. */
-#define HAVE_STRERROR 1
-
-/* Define if `sys_siglist' is declared by <signal.h>. */
-/* #undef SYS_SIGLIST_DECLARED */
-
-/* Define if `struct utimbuf' is declared by <utime.h>. */
-#define HAVE_STRUCT_UTIMBUF 1
-
-/* Define if `struct timeval' is declared by <sys/time.h>. */
-#define HAVE_TIMEVAL 1
-
-/* If using GNU, then support inline function declarations. */
-/* Don't try to switch on inline handling as detected by AC_C_INLINE
- generally, because even if non-gcc compilers accept `inline', they
- may reject `extern inline'. */
-#ifdef __GNUC__
-#define INLINE __inline__
-#else
-#define INLINE
-#endif
-
-/* Define this if you don't have struct exception in math.h. */
-/* #undef NO_MATHERR */
-
-/* Define as `void' if your compiler accepts `void *'; otherwise
- define as `char'. */
-#define POINTER_TYPE void
-#define PTR POINTER_TYPE * /* For strftime.c. */
-
-/* Number of bits in a file offset, on hosts where this is settable. */
-/* #undef _FILE_OFFSET_BITS */
-/* Define to make ftello visible on some hosts (e.g. HP-UX 10.20). */
-/* #undef _LARGEFILE_SOURCE */
-/* Define for large files, on AIX-style hosts. */
-/* #undef _LARGE_FILES */
-/* Define to make ftello visible on some hosts (e.g. glibc 2.1.3). */
-/* #undef _XOPEN_SOURCE */
-
-#ifdef __MRC__
-#define EMACS_CONFIGURATION "macos-mpw"
-#else /* Assume CodeWarrior */
-#define EMACS_CONFIGURATION "macos-cw"
-#endif
-
-#define EMACS_CONFIG_OPTIONS ""
-
-/* The configuration script defines opsysfile to be the name of the
- s/SYSTEM.h file that describes the system type you are using. The file
- is chosen based on the configuration name you give.
-
- See the file ../etc/MACHINES for a list of systems and the
- configuration names to use for them.
-
- See s/template.h for documentation on writing s/SYSTEM.h files. */
-#undef config_opsysfile
-#include "s-mac.h"
-
-/* The configuration script defines machfile to be the name of the
- m/MACHINE.h file that describes the machine you are using. The file is
- chosen based on the configuration name you give.
-
- See the file ../etc/MACHINES for a list of machines and the
- configuration names to use for them.
-
- See m/template.h for documentation on writing m/MACHINE.h files. */
-#undef config_machfile
-#include "m-mac.h"
-
-/* Load in the conversion definitions if this system
- needs them and the source file being compiled has not
- said to inhibit this. There should be no need for you
- to alter these lines. */
-
-#ifdef SHORTNAMES
-#ifndef NO_SHORTNAMES
-#include "../shortnames/remap.h"
-#endif /* not NO_SHORTNAMES */
-#endif /* SHORTNAMES */
-
-/* If no remapping takes place, static variables cannot be dumped as
- pure, so don't worry about the `static' keyword. */
-#ifdef NO_REMAP
-/* #undef static */
-#endif
-
-/* Define `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- These do not work for some USG systems yet;
- for the ones where they work, the s/SYSTEM.h file defines this flag. */
-
-#ifndef VMS
-#ifndef USG
-/* #define subprocesses */
-#endif
-#endif
-
-/* Define LD_SWITCH_SITE to contain any special flags your loader may need. */
-/* #undef LD_SWITCH_SITE */
-
-/* Define C_SWITCH_SITE to contain any special flags your compiler needs. */
-/* #undef C_SWITCH_SITE */
-
-/* Define LD_SWITCH_X_SITE to contain any special flags your loader
- may need to deal with X Windows. For instance, if you've defined
- HAVE_X_WINDOWS above and your X libraries aren't in a place that
- your loader can find on its own, you might want to add "-L/..." or
- something similar. */
-/* #undef LD_SWITCH_X_SITE */
-
-/* Define LD_SWITCH_X_SITE_AUX with an -R option
- in case it's needed (for Solaris, for example). */
-/* #undef LD_SWITCH_X_SITE_AUX */
-
-/* Define C_SWITCH_X_SITE to contain any special flags your compiler
- may need to deal with X Windows. For instance, if you've defined
- HAVE_X_WINDOWS above and your X include files aren't in a place
- that your compiler can find on its own, you might want to add
- "-I/..." or something similar. */
-/* #undef C_SWITCH_X_SITE */
-
-/* Define STACK_DIRECTION here, but not if m/foo.h did. */
-#ifndef STACK_DIRECTION
-/* #undef STACK_DIRECTION */
-#endif
-
-/* Define the return type of signal handlers if the s-xxx file
- did not already do so. */
-#define RETSIGTYPE void
-
-/* SIGTYPE is the macro we actually use. */
-#ifndef SIGTYPE
-#define SIGTYPE RETSIGTYPE
-#endif
-
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
-#define RE_TRANSLATE_P(TBL) (XFASTINT (TBL) != 0)
-#endif
-
-/* Avoid link-time collision with system mktime if we will use our own. */
-#if ! HAVE_MKTIME || BROKEN_MKTIME
-#define mktime emacs_mktime
-#endif
-
-/* The rest of the code currently tests the CPP symbol BSTRING.
- Override any claims made by the system-description files.
- Note that on some SCO version it is possible to have bcopy and not bcmp. */
-/* #undef BSTRING */
-#if defined (HAVE_BCOPY) && defined (HAVE_BCMP)
-#define BSTRING
-#endif
-
-/* Define to empty if the keyword `volatile' does not work. Warning:
- valid code using `volatile' can become incorrect without. Disable
- with care. */
-/* #undef volatile */
-
-/* Some of the files of Emacs which are intended for use with other
- programs assume that if you have a config.h file, you must declare
- the type of getenv.
-
- This declaration shouldn't appear when alloca.s or Makefile.in
- includes config.h. */
-#ifndef NOT_C_CODE
-extern char *getenv ();
-#endif
-
-#endif /* EMACS_CONFIG_H */
-
-/* These default definitions are good for almost all machines.
- The exceptions override them in m/MACHINE.h. */
-
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
-
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
-#endif
-
-/* Note that lisp.h uses this in a preprocessor conditional, so it
- would not work to use sizeof. That being so, we do all of them
- without sizeof, for uniformity's sake. */
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
-#endif
-
-#ifndef BITS_PER_LONG
-#ifdef _LP64
-#define BITS_PER_LONG 64
-#else
-#define BITS_PER_LONG 32
-#endif
-#endif
-
-/* Define if the compiler supports function prototypes. It may do so
- but not define __STDC__ (e.g. DEC C by default) or may define it as
- zero. */
-/* #undef PROTOTYPES */
-/* For mktime.c: */
-#ifndef __P
-# if defined PROTOTYPES
-# define __P(args) args
-# else
-# define __P(args) ()
-# endif /* GCC. */
-#endif /* __P */
-
-
-/* Don't include "string.h" or <stdlib.h> in non-C code. */
-#ifndef NOT_C_CODE
-#ifdef HAVE_STRING_H
-#include "string.h"
-#endif
-#ifdef HAVE_STDLIB_H
-#include <stdlib.h>
-#endif
-#endif
-
-/* Define HAVE_X_I18N if we have usable i18n support. */
-
-#ifdef HAVE_X11R6
-#define HAVE_X_I18N
-#elif defined HAVE_X11R5 && !defined X11R5_INHIBIT_I18N
-#define HAVE_X_I18N
-#endif
-
-/* Define HAVE_X11R6_XIM if we have usable X11R6-style XIM support. */
-
-#if defined HAVE_X11R6 && !defined INHIBIT_X11R6_XIM
-#define HAVE_X11R6_XIM
-#endif
-
-/* Should we enable expensive run-time checking of data types? */
-/* #undef ENABLE_CHECKING */
-
-/* #define GLYPH_DEBUG 1 */
-
-#define NO_RETURN /* nothing */
+++ /dev/null
-/* Copyright (C) 2001 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
-
-GNU Emacs is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#define emacs 1
-#define HAVE_CONFIG_H
-
-#define MAC_OS8 1
-#define MAC_OS 1
+++ /dev/null
-/* Replacement dirent.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _DIRENT_H
-#define _DIRENT_H
-
-/* for definition of FSSpec */
-#include <Files.h>
-
-/* for definition of ino_t */
-#include <sys/types.h>
-
-struct dirent {
- ino_t d_ino;
- char *d_name;
-};
-
-typedef struct DIR {
- long dir_id;
- short vol_ref_num;
- long current_index;
- int getting_volumes; /* true if this DIR struct refers to the root directory */
-} DIR;
-
-extern DIR *opendir(const char *);
-extern int closedir(DIR *);
-extern struct dirent *readdir(DIR *);
-
-#endif /* _DIRENT_H */
+++ /dev/null
-/* Hey Emacs, this is -*- C -*- code! */
-
-/* Handcrafted epaths.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-/* The default search path for Lisp function "load".
- This sets load-path. */
-#define PATH_LOADSEARCH "~emacs/lisp:~emacs/leim:~emacs/lisp/calendar:~emacs/lisp/emacs-lisp:~emacs/lisp/emulation:~emacs/lisp/progmodes:~emacs/lisp/textmodes:~emacs/lisp/international:~emacs/lisp/language:~emacs/lisp/play"
-
-/* Like PATH_LOADSEARCH, but used only when Emacs is dumping. This
- path is usually identical to PATH_LOADSEARCH except that the entry
- for the directory containing the installed lisp files has been
- replaced with ../lisp. */
-#define PATH_DUMPLOADSEARCH "~emacs/lisp"
-
-/* The extra search path for programs to invoke. This is appended to
- whatever the PATH environment variable says to set the Lisp
- variable exec-path and the first file name in it sets the Lisp
- variable exec-directory. exec-directory is used for finding
- executables and other architecture-dependent files. */
-#define PATH_EXEC "~emacs/mac"
-
-/* Where Emacs should look for its architecture-independent data
- files, like the NEWS file. The lisp variable data-directory
- is set to this value. */
-#define PATH_DATA "~emacs/data"
-
-/* Where Emacs should look for X bitmap files.
- The lisp variable x-bitmap-file-path is set based on this value. */
-/* #define PATH_BITMAPS "/usr/include/X11/bitmaps" */
-
-/* Where Emacs should look for its docstring file. The lisp variable
- doc-directory is set to this value. */
-#define PATH_DOC "../etc"
-
-/* Where the configuration process believes the info tree lives. The
- lisp variable configure-info-directory gets its value from this
- macro, and is then used to set the Info-default-directory-list. */
-#define PATH_INFO "~emacs/info"
-
-/* Where Emacs should look for the application default file. */
-/* #define PATH_X_DEFAULTS "/usr/lib/X11/%L/%T/%N%C%S:/usr/lib/X11/%l/%T/%N%C%S:/usr/lib/X11/%T/%N%C%S:/usr/lib/X11/%L/%T/%N%S:/usr/lib/X11/%l/%T/%N%S:/usr/lib/X11/%T/%N%S" */
+++ /dev/null
-/* Handcrafted m-mac.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-/* The following line tells the configuration script what sort of
- operating system this machine is likely to run.
- USUAL-OPSYS="<name of system .h file here, without the s- or .h>" */
-
-/* Define WORDS_BIG_ENDIAN iff lowest-numbered byte in a word
- is the most significant byte. */
-
-#define WORDS_BIG_ENDIAN
-
-/* Define NO_ARG_ARRAY if you cannot take the address of the first of a
- * group of arguments and treat it as an array of the arguments. */
-
-#define NO_ARG_ARRAY
-
-/* Define WORD_MACHINE if addresses and such have
- * to be corrected before they can be used as byte counts. */
-
-/* #define WORD_MACHINE */
-
-/* Now define a symbol for the cpu type, if your compiler
- does not define it automatically:
- Ones defined so far include vax, m68000, ns16000, pyramid,
- orion, tahoe, APOLLO and many others */
-
-/* Use type int rather than a union, to represent Lisp_Object */
-/* This is desirable for most machines. */
-
-#define NO_UNION_TYPE
-
-/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend
- the 24-bit bit field into an int. In other words, if bit fields
- are always unsigned.
-
- If you use NO_UNION_TYPE, this flag does not matter. */
-
-#define EXPLICIT_SIGN_EXTEND
-
-/* Data type of load average, as read out of kmem. */
-
-/* #define LOAD_AVE_TYPE long */
-
-/* Convert that into an integer that is 100 for a load average of 1.0 */
-
-/* #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) */
-
-/* Define CANNOT_DUMP on machines where unexec does not work.
- Then the function dump-emacs will not be defined
- and temacs will do (load "loadup") automatically unless told otherwise. */
-
-#define CANNOT_DUMP
-
-/* Define VIRT_ADDR_VARIES if the virtual addresses of
- pure and impure space as loaded can vary, and even their
- relative order cannot be relied on.
-
- Otherwise Emacs assumes that text space precedes data space,
- numerically. */
-
-#define VIRT_ADDR_VARIES
-
-/* Define C_ALLOCA if this machine does not support a true alloca
- and the one written in C should be used instead.
- Define HAVE_ALLOCA to say that the system provides a properly
- working alloca function and it should be used.
- Define neither one if an assembler-language alloca
- in the file alloca.s should be used. */
-
-#define C_ALLOCA
-/* #define HAVE_ALLOCA */
-
-/* Define NO_REMAP if memory segmentation makes it not work well
- to change the boundary between the text section and data section
- when Emacs is dumped. If you define this, the preloaded Lisp
- code will not be sharable; but that's better than failing completely. */
-
-/* #define NO_REMAP */
-
-/* Some really obscure 4.2-based systems (like Sequent DYNIX)
- * do not support asynchronous I/O (using SIGIO) on sockets,
- * even though it works fine on tty's. If you have one of
- * these systems, define the following, and then use it in
- * config.h (or elsewhere) to decide when (not) to use SIGIO.
- *
- * You'd think this would go in an operating-system description file,
- * but since it only occurs on some, but not all, BSD systems, the
- * reasonable place to select for it is in the machine description
- * file.
- */
-
-#define NO_SOCK_SIGIO
-
-
-/* After adding support for a new system, modify the large case
- statement in the `configure' script to recognize reasonable
- configuration names, and add a description of the system to
- `etc/MACHINES'.
-
- If you've just fixed a problem in an existing configuration file,
- you should also check `etc/MACHINES' to make sure its descriptions
- of known problems in that configuration should be updated. */
-
-/* MPW build crashes if this is not defined. */
-#ifdef __MRC__
-#define IEEE_FLOATING_POINT 1
-#endif
-
-#if 0
-/* The usual definition of XINT, which involves shifting, does not
- sign-extend properly on this machine. */
-
-#define XINT(i) (((sign_extend_temp=(i)) & 0x00800000) \
- ? (sign_extend_temp | 0xFF000000) \
- : (sign_extend_temp & 0x00FFFFFF))
-
-#ifdef emacs /* Don't do this when making xmakefile! */
-extern int sign_extend_temp;
-#endif
-#endif
+++ /dev/null
-/* Replacement pwd.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _PWD_H
-#define _PWD_H
-
-#include <sys/types.h>
-
-/* Emacs uses only pw_name and pw_dir: let's just simulate these */
-struct passwd {
- char *pw_name; /* user name */
- char *pw_dir; /* home directory */
-};
-
-struct passwd *getpwuid(uid_t);
-struct passwd *getpwnam(const char *);
-
-#endif /* _PWD_H */
+++ /dev/null
-/* Handcrafted s-mac.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-/*
- * Define symbols to identify the version of Unix this is.
- * Define all the symbols that apply correctly.
- */
-
-/* #define UNIPLUS */
-/* #define USG5 */
-/* #define USG */
-/* #define HPUX */
-/* #define UMAX */
-/* #define BSD4_1 */
-/* #define BSD4_2 */
-/* #define BSD4_3 */
-/* #define BSD_SYSTEM */
-/* #define VMS */
-
-/* SYSTEM_TYPE should indicate the kind of system you are using.
- It sets the Lisp variable system-type. */
-
-#define SYSTEM_TYPE "macos"
-
-/* NOMULTIPLEJOBS should be defined if your system's shell
- does not have "job control" (the ability to stop a program,
- run some other program, then continue the first one). */
-
-#define NOMULTIPLEJOBS
-
-/* Emacs can read input using SIGIO and buffering characters itself,
- or using CBREAK mode and making C-g cause SIGINT.
- The choice is controlled by the variable interrupt_input.
-
- Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO)
-
- Emacs uses the presence or absence of the SIGIO macro to indicate
- whether or not signal-driven I/O is possible. It uses
- INTERRUPT_INPUT to decide whether to use it by default.
-
- SIGIO can be used only on systems that implement it (4.2 and 4.3).
- CBREAK mode has two disadvantages
- 1) At least in 4.2, it is impossible to handle the Meta key properly.
- I hear that in system V this problem does not exist.
- 2) Control-G causes output to be discarded.
- I do not know whether this can be fixed in system V.
-
- Another method of doing input is planned but not implemented.
- It would have Emacs fork off a separate process
- to read the input and send it to the true Emacs process
- through a pipe. */
-
-/* #define INTERRUPT_INPUT */
-
-/* Letter to use in finding device name of first pty,
- if system supports pty's. 'a' means it is /dev/ptya0 */
-
-/* #define FIRST_PTY_LETTER 'a' */
-
-/*
- * Define HAVE_TERMIOS if the system provides POSIX-style
- * functions and macros for terminal control.
- *
- * Define HAVE_TERMIO if the system provides sysV-style ioctls
- * for terminal control.
- *
- * Do not define both. HAVE_TERMIOS is preferred, if it is
- * supported on your system.
- */
-
-/* #define HAVE_TERMIOS */
-#define HAVE_TERMIO
-
-/*
- * Define HAVE_PTYS if the system supports pty devices.
- */
-
-/* #define HAVE_PTYS */
-
-/*
- * Define NONSYSTEM_DIR_LIBRARY to make Emacs emulate
- * The 4.2 opendir, etc., library functions.
- */
-
-/* #define NONSYSTEM_DIR_LIBRARY */
-
-/* Define this symbol if your system has the functions bcopy, etc. */
-
-/* #define BSTRING */
-
-/* subprocesses should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- This is generally OS dependent, and not supported
- under most USG systems. */
-
-/* #define subprocesses */
-
-/* If your system uses COFF (Common Object File Format) then define the
- preprocessor symbol "COFF". */
-
-/* #define COFF */
-
-/* define MAIL_USE_FLOCK if the mailer uses flock
- to interlock access to /usr/spool/mail/$USER.
- The alternative is that a lock file named
- /usr/spool/mail/$USER.lock. */
-
-/* #define MAIL_USE_FLOCK */
-
-/* Define CLASH_DETECTION if you want lock files to be written
- so that Emacs can tell instantly when you try to modify
- a file that someone else has modified in his Emacs. */
-
-/* #define CLASH_DETECTION */
-
-/* Define this if your operating system declares signal handlers to
- have a type other than the usual. `The usual' is `void' for ANSI C
- systems (i.e. when the __STDC__ macro is defined), and `int' for
- pre-ANSI systems. If you're using GCC on an older system, __STDC__
- will be defined, but the system's include files will still say that
- signal returns int or whatever; in situations like that, define
- this to be what the system's include files want. */
-/* #define SIGTYPE int */
-
-/* If the character used to separate elements of the executable path
- is not ':', #define this to be the appropriate character constant. */
-/* #define SEPCHAR ':' */
-
-/* ============================================================ */
-
-/* Here, add any special hacks needed
- to make Emacs work on this system. For example,
- you might define certain system call names that don't
- exist on your system, or that do different things on
- your system and must be used only through an encapsulation
- (Which you should place, by convention, in sysdep.c). */
-
-/* Some compilers tend to put everything declared static
- into the initialized data area, which becomes pure after dumping Emacs.
- On these systems, you must #define static as nothing to foil this.
- Note that emacs carefully avoids static vars inside functions. */
-
-/* #define static */
-
-/* ============================================================ */
-
-/* After adding support for a new system, modify the large case
- statement in the `configure' script to recognize reasonable
- configuration names, and add a description of the system to
- `etc/MACHINES'.
-
- If you've just fixed a problem in an existing configuration file,
- you should also check `etc/MACHINES' to make sure its descriptions
- of known problems in that configuration should be updated. */
-
-#ifdef __MRC__
-#define __signal_max SIGTERM /* largest one in signal.h */
-#endif
-
-#define SIGHUP (__signal_max+1)
-#define SIGQUIT (__signal_max+2)
-#define SIGTRAP (__signal_max+3)
-#define SIGKILL (__signal_max+4)
-#define SIGALRM (__signal_max+5)
-#define SIGPIPE (__signal_max+6)
-#define NSIG (__signal_max+6)
-
-#ifdef __MRC__
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)
-#elif __MWERKS__
-#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->buffer_ptr - (FILE)->buffer)
-#endif
-
-#ifdef __MWERKS__
-#include <errno.h>
-#ifndef ENOENT
-#define ENOENT 100
-#endif
-#ifndef EXDEV
-#define EXDEV 101
-#endif
-#ifndef EEXIST
-#define EEXIST 102
-#endif
-#ifndef EINTR
-#define EINTR 102
-#endif
-#ifndef EACCES
-#define EACCES 103
-#endif
-#ifndef ENOTDIR
-#define ENOTDIR 104
-#endif
-#ifndef EIO
-#define EIO 105
-#endif
-#ifndef EBADF
-#define EBADF 106
-#endif
-#endif
-
-#define SYSTEM_PURESIZE_EXTRA (200*1024)
-
-/* don't know what this will do, but sysdep.c needs it */
-#define DATA_START 0
-
-/* Limited by CW's 32K limit on local data! */
-#define READ_BUF_SIZE (8 << 10)
-
-#include <utsname.h>
-void read_input_waiting ();
-
-/* #define GETTIMEOFDAY_ONE_ARGUMENT */
-
-#define SYSV_SYSTEM_DIR
-
-#define SYSTEM_MALLOC
-
-/* Constants such as O_RDONLY are defined in fcntl.h. Best solution is
- really to patch individual files to include it: callproc.c, doc.c,
- fileio.c, getloadavg.c, lread.c, and termcap.c. */
-#include <fcntl.h>
-
-#define _setjmp setjmp
-#define _longjmp longjmp
-
-#define _exit exit
-
-#define main emacs_main
-
-/* Include this here so it won't be include again when #include in emacs
- sources. Then undefine the macro definitions in it for unlink, read,
- write, access, and rmdir. */
-#ifdef __MWERKS__
-#include <unistd.h>
-#endif
-
-#undef unlink
-#define unlink sys_unlink
-#undef read
-#define read sys_read
-#undef write
-#define write sys_write
-#undef access
-#define access sys_access
-#undef rmdir
-#define rmdir sys_rmdir
-
-#define open sys_open
-#define creat sys_creat
-
-#define rename sys_rename
-#define fopen sys_fopen
-#define signal sys_signal
-
-#define gmtime sys_gmtime
-#define localtime sys_localtime
-#define ctime sys_ctime
-#define time sys_time
-
-#ifndef bcmp
-#define bcmp(s1, s2, n) memcmp ((s1), (s2), (n))
-#endif
-#ifndef bcopy
-#define bcopy(s, d, n) memcpy ((d), (s), (n))
-#endif
-#ifndef bzero
-#define bzero(s, n) memset ((s), 0, (n))
-#endif
-
-extern char *index (const char *, int);
-
-/* MPW strftime broken for "%p" format */
-#ifdef __MRC__
-#define strftime sys_strftime
-#endif
-
-#include <time.h>
-/* Editfns.c includes types.h which indirectly includes time.h before config.h.
- So gmtime (localtime) is defined and not sys_gmtime (sys_localtime). Define
- here explicitly. */
-extern struct tm *sys_gmtime (const time_t *);
-extern struct tm *sys_localtime (const time_t *);
-extern char *sys_ctime (const time_t *);
-extern time_t sys_time (time_t *);
-
-/* Emacs.c includes signal.h before config.h. Define this to make it happy. */
-#ifdef __MRC__
-#include <signal.h>
-extern __sigfun sys_signal (int signal_num, __sigfun signal_func);
-#elif __MWERKS__
-#include <signal.h>
-extern __signal_func_ptr sys_signal (int signal_num, __signal_func_ptr signal_func);
-#endif
-
-extern double atof (const char *);
-
-#define volatile
-
-#define SYMS_SYSTEM syms_of_mac()
+++ /dev/null
-/* Replacement sys/file.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _SYS_FILE_H
-#define _SYS_FILE_H
-
-#include <Files.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-
-#ifdef __MRC__
-#undef open
-#undef creat
-
-#define open mpw_open
-#define creat mpw_creat
-
-#include <fcntl.h>
-
-#undef open
-#undef creat
-
-#define open sys_open
-#define creat sys_creat
-#endif
-
-#ifdef __MWERKS__
-#include <unix.h>
-#endif
-
-mode_t umask(mode_t);
-
-void abort(void);
-void _exit(int);
-int kill(int,int);
-int alarm(int);
-int pause(void);
-char *getwd(char *);
-
-#endif /* _SYS_FILE_H */
+++ /dev/null
-/* Replacement sys/ioctl.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _SYS_IOCTL_H
-#define _SYS_IOCTL_H
-
-int ioctl(int, int, void *);
-
-#define FIONREAD 1
-#define TCGETA 2
-
-#endif /* _SYS_IOCTL_H */
+++ /dev/null
-/* Replacement sys/param.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _SYS_PARAM_H
-#define _SYS_PARAM_H
-
-#define MAXPATHLEN 255
-
-#endif /* _SYS_PARAM_H */
+++ /dev/null
-/* Replacement sys/stat.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _SYS_STAT_H
-#define _SYS_STAT_H
-
-#ifdef __MWERKS__
-#include <stat.mac.h>
-
-#if __MSL__ >= 0x6000
-#define fstat _fstat
-#endif
-
-#undef S_IFMT
-#undef S_IFBLK
-#undef S_IFCHR
-#undef S_IFIFO
-#undef S_IFREG
-#undef S_IFDIR
-#undef S_IFLNK
-
-#undef S_IRUSR
-#undef S_IWUSR
-#undef S_IXUSR
-
-#endif /* __MWERKS__ */
-
-/* Need to redefine these for CW, filemode.c assumes Unix definitions which are
- inconsistent with CW definitions because CW uses bits 8-12 for S_IFMT info.
- Bit 8 is used by S_IRUSR on Unix! */
-#define S_IFMT 0170000 /* type of file */
-#define S_IFBLK 0060000 /* block special */
-#define S_IFCHR 0020000 /* character special */
-#define S_IFIFO 0010000 /* FIFO special */
-#define S_IFREG 0100000 /* regular */
-#define S_IFDIR 0040000 /* directory */
-#define S_IFLNK 0030000 /* symbolic link */
-
-#define S_IREAD 00400
-#define S_IWRITE 00200
-#define S_IEXEC 00100
-
-/* Need to redefine these for because mode_string in filemode.c assumes Unix
- values in the lower 9 bits which are different from CW values. */
-#define S_IRUSR S_IREAD
-#define S_IWUSR S_IWRITE
-#define S_IXUSR S_IEXEC
-
-#ifdef __MRC__
-typedef unsigned long dev_t;
-
-struct stat {
- dev_t st_dev; /* ID of device containing file */
- int st_ino; /* file serial number */
- unsigned short st_mode; /* mode of file */
- int st_nlink; /* number of links to the file */
- int st_uid; /* user ID of file */
- int st_gid; /* group ID of file */
- int st_rdev; /* device ID (if file is character or block special) */
- int st_size; /* file size in bytes (if file is a regular file) */
- int st_atime; /* time of last access */
- int st_mtime; /* time of last data modification */
- int st_ctime; /* time of last status change */
-};
-#endif /* __MRC__ */
-
-#endif /* _SYS_STAT_H */
+++ /dev/null
-/* Replacement sys/time.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _SYS_TIME_H
-#define _SYS_TIME_H
-
-struct timeval {
- long tv_sec; /* seconds */
- long tv_usec; /* microseconds */
-};
-
-#endif /* _SYS_TYPES_H */
+++ /dev/null
-/* Replacement sys/types.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _SYS_TYPES_H
-#define _SYS_TYPES_H
-
-#ifdef __MWERKS__
-/* Need definitions of uid_t from stat.h */
-#include <stat.h>
-#endif /* __MWERKS__ */
-
-#ifdef __MRC__
-typedef long uid_t;
-typedef long gid_t;
-typedef long off_t;
-typedef long ino_t;
-
-typedef unsigned long mode_t;
-#endif /* __MRC__ */
-
-#endif /* _SYS_TYPES_H */
+++ /dev/null
-/* Replacement termio.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _SYS_TERMIO_H
-#define _SYS_TERMIO_H
-
-typedef unsigned char cc_t;
-typedef unsigned short tcflag_t;
-
-#define NCCS 32
-
-struct termio {
- tcflag_t c_iflag; /* input modes */
- tcflag_t c_oflag; /* output modes */
- tcflag_t c_cflag; /* control modes */
- tcflag_t c_lflag; /* local modes */
- cc_t c_cc[NCCS]; /* control chars */
-};
-
-/* c_cc subscript names */
-#define VINTR 1
-#define VQUIT 2
-#define VERASE 3
-#define VTIME 4
-#define VMIN 5
-
-/* c_iflag fields */
-#define IGNBRK 0x1 /* ignore break condition */
-#define ICRNL 0x2 /* map CR to NL on input */
-#define IXON 0x4 /* enable start/stop output control */
-
-/* c_oflag fields */
-#define ONLCR 0x1 /* map CR to NL on output */
-#define TABDLY 0x2 /* horizontal tab delays */
-#define TAB3 0x4 /* expand tab to spaces */
-
-/* c_cflag fields */
-#define CBAUD 0x1
-#define B9600 0x2
-
-/* c_lflag fields */
-#define ISIG 0x1 /* enable signals */
-#define ICANON 0x2 /* canonical input (erase and kill processing) */
-#define ECHO 0x3 /* enable echo */
-
-#define TCSETAW 4
-#define TCSETAF 5
-
-#endif /* _SYS_TERMIO_H */
+++ /dev/null
-/* Replacement utime.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _UTIME_H_
-#define _UTIME_H_
-
-#include <time.h>
-
-#define _mac_unix_epoch_offset_ (365L * 4L) * 24L * 60L * 60L
-
-struct utimbuf {
- time_t actime; /* access time (ignored on the Mac) */
- time_t modtime; /* modification time */
-};
-
-int utime(const char *path, const struct utimbuf *buf);
-
-#endif
+++ /dev/null
-/* Replacement utsname.h file for building GNU Emacs on the Macintosh.
- Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef _UTSNAME_H
-#define _UTSNAME_H
-
-struct utsname {
- char nodename[255];
-};
-
-int uname(struct utsname *name);
-
-#endif
+++ /dev/null
-#!/bin/sh
-
-#### make-package: create a Mac OS X package for use by the installer.
-#### The installer will place the Emacs OSX application in
-#### /Application/Emacs and the rest of emacs in the usual unix places
-#### under /usr/local or some other location if specified as the first
-#### argument. The disc image will be in the file EmacsInstaller.dmg.
-####
-#### Upon installation, this will leave two versions of emacs on the
-#### computer, 20.7 and 21.1.
-####
-#### Examples:
-#### ./make-package
-#### Will create an installer that will place the emacs support
-#### files inside /usr/local.
-#### ./make-package /usr
-#### Will create an installer that will place the emacs support
-#### files inside /usr. This will replace the default version of
-#### emacs included with Mac OS X.
-
-# Copyright (C) 2002 Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to the
-# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-#
-# Contributed by Steven Tamm (steventamm@mac.com).
-
-progname="$0"
-
-srcdir="`pwd`/.."
-builddir=${srcdir}
-
-## Default location to place it is /usr/local
-prefix=/usr/local
-appsdir=/Applications
-emapp=Emacs.app
-with_config=yes
-with_app=yes
-with_x=no
-comp_diskimage=no
-self_contained=no
-app_symlink=no
-full_dist=yes
-build_in_place=no
-keep_directory=no
-
-ac_prev=
-display_usage=false;
-config_options=;
-while test $# != 0
-do
- if test -n "$ac_prev"; then
- eval "$ac_prev=\$1"
- ac_prev=
- continue
- fi
- case $1 in
- -help | --help | --hel | --he | -h)
- display_usage=yes ;;
- -p | -prefix | --p | --prefix)
- ac_prev=prefix ;;
- -p=* | -prefix=* | --p=* | --prefix=*)
- prefix=`expr "x$1" : 'x[^=]*=\(.*\)'` ;;
- --build-in-place | --build-in-place )
- build_in_place=yes ;;
- --build-dir | -build-dir | --builddir | -build-dir)
- build_in_place=no
- ac_prev=builddir;;
- --build-dir=* | -build-dir=* | -builddir=* | --builddir=*)
- build_in_place=no
- builddir=`expr "x$1" : 'x[^=]*=\(.*\)'`;;
- -no-configure | -no-conf | --no-configure | --no-conf | --without-config)
- with_config=no ;;
- -no-app | --no-app | -without-app | --without-app)
- with_app=no ;;
- -without-x | --without-x)
- with_x=no ;;
- -with-x | --with-x)
- with_x=yes
- with_app=no ;;
- --without-full-dist | -without-full-dist | -no-full-dist | -no-full)
- full_dist=no ;;
- --self-contained | -self-contained | --with-self-contained-app | -sc)
- self_contained=yes ;;
- -app-symlink | --app-symlink | -symlink | --symlink | --asl)
- app_symlink=yes ;;
- --keep-dir)
- keep_directory=yes ;;
- -C,* | -c,*)
- config_options="$config_options `expr "x$1" : 'x[^,]*,\(.*\)'`" ;;
- -M,* | -m,*)
- make_options="$make_options `expr "x$1" : 'x[^,]*,\(.*\)'`" ;;
- *)
- display_usage=yes ;;
- esac
- shift
-done
-
-if test "$with_x" = "no"; then
- config_options="--without-x $config_options"
-fi
-
-if test "$display_usage" = "yes"; then
- cat <<EOF
-\`make-package' generates a Mac OS X installer package from an Emacs
-distribution. By default, this first runs ./configure on the emacs
-directory. Then make install to create the emacs distribution.
-Then some mac-specific commands to generate the required information
-for the mac package. The installer will, by default, create a
-Carbon application called Emacs in the ${appsdir} directory, with the
-shared emacs files in /usr/local
-
-Usage: $0 [OPTION]
-
-Options:
- -h, --help display this help and exit
- --prefix=DIR Set install location for the Mac OS X package
- of the emacs related file. By default /usr/local
- --no-conf Do not run the configure script before running
- make install.
- --without-app Do not create the Emacs application bundle
- --with-x Setup the install to use X Windows for its
- windowed display, instead of carbon. Implies
- --without-app.
- --without-full-dist Do not include all the .el files in the distribution.
- This is discouraged except if disk space is critical.
- --app-symlink Have the Emacs.app executable be a symlink
- to the install in [prefix]/bin/emacs and have
- the emacs executable link to emacs-${version}
- --self-contained Create an Emacs.app that is self-contained;
- prefix will be ignored and all files installed
- inside the application
- --build-in-place Build the application in the source directory
- instead of a temporary directory.
- --build-dir=DIR Build the application in the specified directory
- instead of a temporary directory. Mutually exclusive
- with --build-in-place.
- -C,option Pass option to configure
- -M,option Pass option to make
-EOF
- exit 0
-fi
-
-### Exit if a command fails.
-#set -e
-
-### Print out each line we read, for debugging's sake.
-#set -v
-
-LANGUAGE=C
-LC_ALL=C
-LC_MESSAGES=
-LANG=
-export LANGUAGE LC_ALL LC_MESSAGES LANG
-
-## Don't restrict access to any files.
-umask 0
-
-### Make sure we're running in the right place.
-if [ -f Emacs.pkg ]; then
- echo "${progname}: Package Emacs.pkg already exists.
-Perhaps a previous invocation of \`${progname}' failed to clean up after
-itself. Move or delete Emacs.pkg and try again." >&2
- exit 1
-fi
-
-if test $with_app == "yes" && [ ! -f ${emapp}/Contents/PkgInfo ]; then
- echo "${progname}: Can't find \`${emapp}/Contents/PkgInfo'" >&2
- echo "${progname} must be run in the \`mac' directory of the Emacs" >&2
- echo "distribution tree. cd to that directory and try again." >&2
- exit 1
-fi
-
-### Check whether file ../lisp/version.el exists.
-if [ ! -f ../lisp/version.el ]; then
- echo "${progname}: Can't find \`../lisp/version.el'" >&2
- exit 1
-fi
-
-### Find out which version of Emacs this is.
-shortversion=`grep 'defconst[ ]*emacs-version' ../lisp/version.el \
- | sed -e 's/^.*"\([0-9][0-9]*\.[0-9][0-9]*\).*$/\1/'`
-version=`grep 'defconst[ ]*emacs-version' ../lisp/version.el \
- | sed -e 's/^[^"]*"\([^"]*\)".*$/\1/'`
-if [ ! "${version}" ]; then
- echo "${progname}: can't find current Emacs version in \`./lisp/version.el'" >&2
- exit 1
-fi
-
-echo Version numbers are $version and $shortversion
-
-### Make sure we don't already have a directory emacs-${version}.
-
-emacsname="emacs-${version}${new_extension}"
-
-if [ -d ${emacsname} ]
-then
- echo Directory "${emacsname}" already exists >&2
- exit 1
-fi
-
-### Make sure the subdirectory is available.
-tempparent="make-package.tmp.$$"
-if [ -d ${tempparent} ]; then
- echo "${progname}: staging directory \`${tempparent}' already exists.
-Perhaps a previous invocation of \`${progname}' failed to clean up after
-itself. Check that directories whose names are of the form
-\`make-dist.tmp.NNNNN' don't contain any important information, remove
-them, and try again." >&2
- exit 1
-fi
-
-if [ -d /Volumes/Emacs ]; then
- echo "${progname}: Already have an Emacs disc image mounted. Please
-eject that disc image and try again." >&2
- exit 1
-fi
-
-tempparentfull="`pwd`/${tempparent}"
-tempparentdist=${tempparentfull}/dist
-
-if test "$build_in_place" = "no"; then
- case ${builddir} in
- ${srcdir})
- tempbuild="make-package.build.$$"
- builddir="`pwd`/${tempbuild}"
- removable_build_dir=${builddir}
- mkdir -p ${builddir}
- ;;
- [\\/]* | ?:[\\/]* ) #Absolutepath.
- mkdir -p ${builddir}
- ;;
- *)
- mkdir -p ${builddir}
- builddir=`cd $builddir && pwd`
- ;;
- esac
-fi
-# Location of install package
-packagedir=${builddir}/mac/Emacs.pkg
-
-echo Building in directory ${builddir}
-echo Installing into directory ${tempparentfull} >&2
-
-### This trap ensures that the staging directory will be cleaned up even
-### when the script is interrupted in mid-career.
-trap "echo 'Interrupted...cleaning up the staging directory'; rm -rf ${tempparent} ${removable_build_dir} ${packagedir}; exit 1" 1 2 15
-
-# Run configure in the new tempparent directory
-if test "$with_config" = "yes"; then
- (cd ${builddir}; ${srcdir}/configure ${config_options} --prefix=${prefix})
-fi
-
-installprefix=${tempparentfull}${prefix}
-if test "$self_contained" = "yes"; then
- # If selfcontained, the local directory is Resources directory
- installprefix=$tempparentfull/$appsdir/$emapp/Contents/Resources
-fi
-
-
-make_options="prefix=${installprefix} $make_options"
-
-if test "$with_app" = "yes"; then
- make_options="carbon_appdir=${tempparentfull}/Applications $make_options"
-fi
-
-## Make bootstrap if .elc files are missing from distribution
-if [ ! -f ${srcdir}/lisp/abbrev.elc ]; then
- echo "Required .elc files missing; making bootstrap..."
- if ! (cd ${builddir}; make bootstrap $make_options); then
- echo "Make bootstrap failed... Aborting make-package."
- exit 2
- fi
-fi
-
-if ! (cd ${builddir}; make install $make_options); then
- echo "Make failed... Aborting make-package."
- exit 1
-fi
-
-if test "$full_dist" == "no"; then
- echo "Removing unneeded .el files"
- sharedir=$installprefix/share/emacs/$version
- find $sharedir/lisp $sharedir/leim -name "*.elc" -print | sed 's|\(.*\)\.elc$|/bin/rm -f \1.el|' | /bin/sh -s
-fi
-
-if test "$with_app" == "yes"; then
- echo "Creating Emacs.app application"
- tempappdir=${tempparentfull}${appsdir}
- tempemapp=${tempappdir}/${emapp}/Contents/MacOS/Emacs
- ## Delete any CVS files
- find ${tempappdir} -name "CVS" -type d -exec rm -rf {} \;
-
- ## Have application be a symlink to ${prefix}/bin/emacs
- if test "$app_symlink" == "yes"; then
- echo "Creating application symlink"
- rm ${tempemapp}
- ln -s ${prefix}/bin/${emacsname} ${tempemapp}
- fi
-fi
-
-compver=powerpc-apple-darwin`uname -r`
-
-if test "$self_contained" = "yes"; then
- # Move shared files down to Resources directory
- mv $installprefix/share/emacs/$version/* $installprefix
- rm -rf $installprefix/share
- # These directories might remain in Resources
- mv $installprefix/bin $installprefix/../MacOS/bin
- mv $installprefix/libexec/emacs/$version/$compver $installprefix/../MacOS/libexec
- # Make the application binary a hard link
- rm $installprefix/../MacOS/Emacs
- ln $installprefix/../MacOS/bin/emacs $installprefix/../MacOS/Emacs
-fi
-
-
-# Remove unnecessary .el files
-#if test "$full_dist" = no; then
-#fi
-
-echo "Creating Package Info file"
-
-mkdir -p ${packagedir}
-mkdir ${packagedir}/Contents
-mkdir ${packagedir}/Contents/Resources
-mkdir ${packagedir}/Contents/Resources/English.lproj
-echo -n 'pmkrpkg1' > ${packagedir}/Contents/PkgInfo
-
-# Create ReadMe and License files
-cp ${srcdir}/COPYING ${packagedir}/Contents/Resources/License.txt
-cp ${srcdir}/mac/README ${packagedir}/Contents/Resources/ReadMe.txt
-
-infofile=${packagedir}/Contents/Resources/English.lproj/Emacs.info
-
-echo 'Title GNU Emacs' > ${infofile}
-echo "Version ${version}" >> ${infofile}
-echo "Description Install GNU Emacs ${version} as a command-line app and a Mac OS Application" >> ${infofile}
-echo 'DefaultLocation /' >> ${infofile}
-echo 'DeleteWarning' >> ${infofile}
-echo 'NeedsAuthorization YES' >> ${infofile}
-echo 'Required NO' >> ${infofile}
-echo 'Relocatable NO' >> ${infofile}
-echo 'RequiresReboot NO' >> ${infofile}
-echo 'UseUserMask NO' >> ${infofile}
-echo 'OverwritePermissions NO' >> ${infofile}
-echo 'InstallFat NO' >> ${infofile}
-
-### Set the install directory to install files as root...
-### Not sure if this is a good diea
-# echo "Setting owner to root"
-# chown -Rh 0 ${tempparentfull}
-
-echo "Creating pax file"
-(cd ${tempparentfull}; pax -w -f ${packagedir}/Contents/Resources/Emacs.pax .)
-echo "Compressing pax file"
-gzip ${packagedir}/Contents/Resources/Emacs.pax
-
-echo "Creating bom file"
-mkbom ${tempparentfull} ${packagedir}/Contents/Resources/Emacs.bom
-
-echo "Generating sizes file"
-sizesfile=${packagedir}/Contents/Resources/Emacs.sizes
-
-numFiles=`du -a ${tempparent} | wc -l`
-installedSize=`du -s ${tempparent} | cut -f1`
-compressedSize=`du -s ${packagedir} | cut -f1`
-
-echo "NumFiles ${numFiles}" > ${sizesfile}
-echo "InstalledSize ${installedSize}" >> ${sizesfile}
-echo "CompressedSize ${compressedSize}" >> ${sizesfile}
-cat ${sizesfile}
-
-echo "Creating Disc Image"
-## From hdiutil man page, a sector is 512k. Allocate an extra 5% for
-## directories and partition tables.
-sectorsAlloced=`echo 2.1*${compressedSize}|bc`
-hdiutil create -ov ${builddir}/mac/EmacsRW -sectors ${sectorsAlloced}
-## Need to format the disc image before mounting
-mountLoc=`hdid -nomount ${builddir}/mac/EmacsRW.dmg | grep HFS | cut -f1`
-/sbin/newfs_hfs -v Emacs ${mountLoc}
-hdiutil eject ${mountLoc}
-echo "Copying Package to Disc Image"
-hdid ${builddir}/mac/EmacsRW.dmg
-
-if test "$keep_directory" = "no"; then
- rm -rf ${tempparentfull}
-else
- mv ${tempparentfull} ${emacsname}
-fi
-
-if [ ! -d /Volumes/Emacs ]; then
- echo "Could not create disc image. The Emacs installer package (Emacs.pkg)
-in this directory should be correct. Please use the Disc Copy program to
-create a disc image." >&2
- exit 0
-fi
-
-cp -R ${packagedir} /Volumes/Emacs
-
-## Converting Disk Image to read-only
-echo 'Converting Disc Image to read-only'
-hdiutil eject ${mountLoc}
-hdiutil resize ${builddir}/mac/EmacsRW.dmg -sectors min
-if test "$comp_diskimage" = "yes"; then
- hdiutil convert ${builddir}/mac/EmacsRW.dmg -format UDZO -imagekey zlib-level=2 -o ${srcdir}/mac/EmacsInstaller.dmg
-else
- hdiutil convert ${builddir}/mac/EmacsRW.dmg -format UDRO -o ${srcdir}/mac/EmacsInstaller.dmg
-fi
-rm ${builddir}/mac/EmacsRW.dmg
-
-echo "Cleaning up the staging directory"
-rm -rf ${builddir}/mac/Emacs.pkg ${removable_build_dir}
-
-### make-package ends here
+++ /dev/null
-# Make file for building GNU Emacs on the Macintosh.
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-#
-# Author: Andrew Choi <akochoi@users.sourceforge.net>
-#
-# This file is part of GNU Emacs.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA. */
-#
-# Defines the following targets:
-# Emacs (default) - normal Emacs build.
-# Clean - remove all object and executable files to prepare for a fresh build.
-# Doc - generate the "DOC" file in ~emacs/etc/.
-# Make-DocFile - build the make-docfile tool, utility for generating "DOC".
-# PrepSource - prepare the source files after unstuffing the distribution.
-# PrepDist - prepare for distribution: generate diff files; move mac-win.el to {Patches}.
-
-Src = ::src: # emacs's src directory
-Includes = :inc: # mac includes directory (common for MPW and CW)
-Source = :src: # mac source directory
-Lib-Src = ::lib-src: # ~emacs/lib-src directory, containing make-docfile.c
-EmacsTarget = :Emacs MPW # pathname of target executable file
-DocTarget = ::etc: # where the generated DOC file should be placed
-Lisp = ::lisp: # emacs's lisp directory
-Make-DocFileDir = {Lib-Src} # directory containing make-docfile tool
-
-Makefile = makefile.MPW # self reference
-
-SymOption = # -sym on # remove hash mark before "-sym on" to enable source debugging
-OptOption = # -opt speed # alternatively set to -opt off or -opt size
-
-# The -noMapCR options and the two -d's must not be removed.
-
-PPCCOptions = {SymOption} {OptOption} -noMapCR -enum int ¶
- -typecheck relaxed -w off ¶
- -includes unix -i {Includes},{Src} ¶
- -d emacs=1 -d HAVE_CONFIG_H -d MAC_OS -d MAC_OS8
-
-LinkOptions = {SymOption} -d
-
-CONFIG_H_GROUP = "{Includes}config.h" "{Includes}s-mac.h" "{Includes}utsname.h" "{Includes}m-mac.h"
-DISPEXTERN_H_GROUP = "{Src}dispextern.h" "{Src}macgui.h"
-INTERVALS_H_GROUP = "{Src}intervals.h" "{Src}dispextern.h" "{Src}macgui.h"
-WINDOW_H_GROUP = "{Src}window.h" {DISPEXTERN_H_GROUP}
-BLOCKINPUT_H_GROUP = "{Src}blockinput.h" "{Src}atimer.h" "{Src}systime.h" ¶
- "{Includes}sys:time.h" "{Includes}sys:time.h"
-
-# The list all object files from the GNU Emacs 21.0 distribution.
-
-EmacsObjects = ¶
- "{Src}abbrev.c.x" ¶
- "{Src}alloc.c.x" ¶
- "{Src}alloca.c.x" ¶
- "{Src}atimer.c.x" ¶
- "{Src}buffer.c.x" ¶
- "{Src}bytecode.c.x" ¶
- "{Src}callint.c.x" ¶
- "{Src}callproc.c.x" ¶
- "{Src}casefiddle.c.x" ¶
- "{Src}casetab.c.x" ¶
- "{Src}category.c.x" ¶
- "{Src}ccl.c.x" ¶
- "{Src}charset.c.x" ¶
- "{Src}cm.c.x" ¶
- "{Src}cmds.c.x" ¶
- "{Src}coding.c.x" ¶
- "{Src}composite.c.x" ¶
- "{Src}data.c.x" ¶
- "{Src}dired.c.x" ¶
- "{Src}dispnew.c.x" ¶
- "{Src}doc.c.x" ¶
- "{Src}doprnt.c.x" ¶
- "{Src}editfns.c.x" ¶
- "{Src}emacs.c.x" ¶
- "{Src}eval.c.x" ¶
- "{Src}fileio.c.x" ¶
- "{Src}filemode.c.x" ¶
- "{Src}floatfns.c.x" ¶
- "{Src}fns.c.x" ¶
- "{Src}fontset.c.x" ¶
- "{Src}frame.c.x" ¶
- "{Src}getloadavg.c.x" ¶
- "{Src}indent.c.x" ¶
- "{Src}insdel.c.x" ¶
- "{Src}intervals.c.x" ¶
- "{Src}keyboard.c.x" ¶
- "{Src}keymap.c.x" ¶
- "{Src}lread.c.x" ¶
- "{Src}macros.c.x" ¶
- "{Src}marker.c.x" ¶
- "{Src}md5.c.x" ¶
- "{Src}minibuf.c.x" ¶
- "{Src}mktime.c.x" ¶
- "{Src}print.c.x" ¶
- "{Src}process.c.x" ¶
- "{Src}regex.c.x" ¶
- "{Src}region-cache.c.x" ¶
- "{Src}scroll.c.x" ¶
- "{Src}search.c.x" ¶
- "{Src}strftime.c.x" ¶
- "{Src}syntax.c.x" ¶
- "{Src}sysdep.c.x" ¶
- "{Src}term.c.x" ¶
- "{Src}termcap.c.x" ¶
- "{Src}textprop.c.x" ¶
- "{Src}tparam.c.x" ¶
- "{Src}undo.c.x" ¶
- "{Src}window.c.x" ¶
- "{Src}xdisp.c.x" ¶
- "{Src}xfaces.c.x"
-
-# The list of object files generated from new source files of the Macintosh port.
-
-MacObjects = ¶
- "{Src}mac.c.x" ¶
- "{Src}macfns.c.x" ¶
- "{Src}macmenu.c.x" ¶
- "{Src}macterm.c.x"
-
-# The next two are the dependency rules for building Emacs.
-
-Emacs ÄÄ {Makefile} {DocTarget}DOC {EmacsObjects} {MacObjects}
- PPCLink ¶
- {LinkOptions} ¶
- {EmacsObjects} {MacObjects} ¶
- "{SharedLibraries}InterfaceLib" ¶
- "{SharedLibraries}StdCLib" ¶
- "{SharedLibraries}MathLib" ¶
- "{SharedLibraries}AppleScriptLib" ¶
- "{SharedLibraries}TextEncodingConverter" ¶
- "{SharedLibraries}AppearanceLib" ¶
- "{PPCLibraries}StdCRuntime.o" ¶
- "{PPCLibraries}PPCCRuntime.o" ¶
- "{PPCLibraries}PPCToolLibs.o" ¶
- -o "{EmacsTarget}"
-
-Emacs ÄÄ {Makefile} "{Source}"Emacs.maclf.r "{Source}"EmacsMPW.maclf.r
- Rez -a "{Source}"Emacs.maclf.r -o "{EmacsTarget}"
- Rez -a "{Source}"EmacsMPW.maclf.r -o "{EmacsTarget}"
- SetFile "{EmacsTarget}" -t APPL -c 'EMAx' -a B
-
-# Rez cannot handle files with Unix style end lines at all. So generate
-# them. It does not hurt if Emacs.r and EmacsMPW.r already have Mac end
-# lines.
-
-"{Source}"Emacs.maclf.r Ä "{Source}"Emacs.r
- translate ¶0x0a ¶n < "{Source}"Emacs.r > "{Source}"Emacs.maclf.r
-
-"{Source}"EmacsMPW.maclf.r Ä "{Source}"EmacsMPW.r
- translate ¶0x0a ¶n < "{Source}"EmacsMPW.r > "{Source}"EmacsMPW.maclf.r
-
-# Here comes a long boring list of rules saying which files depend on which
-# other ones. I generated them by hand using the "-p" option of the MrC compiler.
-# Know about MakeMake, but this is probably more accurate.
-
-{Src}abbrev.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}charset.h" ¶
- "{Src}syntax.h"
-
-{Src}alloc.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}puresize.h" ¶
- "{Src}buffer.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}frame.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}keyboard.h" ¶
- "{Src}charset.h" ¶
- "{Src}syssignal.h"
-
-{Src}alloca.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- {BLOCKINPUT_H_GROUP}
-
-{Src}atimer.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}syssignal.h" ¶
- "{Src}systime.h" ¶
- "{Includes}sys:time.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}atimer.h" ¶
- "{Includes}sys:time.h"
-
-{Src}buffer.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Includes}sys:param.h" ¶
- "{Src}lisp.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}window.h" ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}region-cache.h" ¶
- "{Src}indent.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}frame.h"
-
-{Src}bytecode.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}syntax.h"
-
-{Src}callint.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}commands.h" ¶
- "{Src}keyboard.h" ¶
- {WINDOW_H_GROUP}
-
-{Src}callproc.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:file.h" ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Src}lisp.h" ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}ccl.h" ¶
- "{Src}coding.h" ¶
- "{Src}composite.h" ¶
- "{Includes}epaths.h" ¶
- "{Src}process.h" ¶
- "{Src}syssignal.h" ¶
- "{Src}systty.h" ¶
- "{Includes}termio.h"
-
-{Src}casefiddle Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}commands.h" ¶
- "{Src}syntax.h" ¶
- "{Src}composite.h"
-
-{Src}casetab.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h"
-
-{Src}category.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}category.h"
-
-{Src}ccl.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}charset.h" ¶
- "{Src}ccl.h" ¶
- "{Src}coding.h"
-
-{Src}charset.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- "{Src}disptab.h"
-
-{Src}cm.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}cm.h" ¶
- "{Src}termhooks.h"
-
-{Src}cmds.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}syntax.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}keyboard.h" ¶
- {DISPEXTERN_H_GROUP}
-
-{Src}coding.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}composite.h" ¶
- "{Src}ccl.h" ¶
- "{Src}coding.h" ¶
- {WINDOW_H_GROUP}
-
-{Src}composite.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- {INTERVALS_H_GROUP}
-
-{Src}data.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}puresize.h" ¶
- "{Src}charset.h" ¶
- "{Src}buffer.h" ¶
- "{Src}keyboard.h" ¶
- "{Src}frame.h" ¶
- "{Src}syssignal.h"
-
-{Src}dired.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Src}systime.h" ¶
- "{Includes}sys:time.h" ¶
- "{Includes}dirent.h" ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}commands.h" ¶
- "{Src}charset.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- "{Src}regex.h"
-
-{Src}dispnew.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}termchar.h" ¶
- "{Src}termopts.h" ¶
- "{Src}termhooks.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}cm.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}commands.h" ¶
- "{Src}disptab.h" ¶
- "{Src}indent.h" ¶
- {INTERVALS_H_GROUP} ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}process.h" ¶
- "{Src}keyboard.h" ¶
- "{Src}syssignal.h" ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h" ¶
- "{Src}systime.h"
-
-{Src}doc.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:file.h" ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}keyboard.h" ¶
- "{Src}charset.h"
-
-{Src}doprnt.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}charset.h"
-
-{Src}editfns.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}pwd.h" ¶
- "{Src}lisp.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}systime.h" ¶
- "{Includes}sys:time.h"
-
-{Src}emacs.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:file.h" ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Src}lisp.h" ¶
- "{Src}commands.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Src}systty.h" ¶
- "{Includes}termio.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}syssignal.h" ¶
- "{Src}process.h" ¶
- "{Src}termhooks.h" ¶
- "{Src}keyboard.h" ¶
- "{Src}frame.h"
-
-{Src}eval.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}commands.h" ¶
- "{Src}keyboard.h" ¶
- {DISPEXTERN_H_GROUP}
-
-{Src}fileio.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Includes}pwd.h" ¶
- "{Src}lisp.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}systime.h" ¶
- "{Includes}sys:time.h" ¶
- "{Src}commands.h"
-
-{Src}filemode.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h"
-
-{Src}floatfns.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}syssignal.h"
-
-{Src}fns.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}commands.h" ¶
- "{Src}charset.h" ¶
- "{Src}buffer.h" ¶
- "{Src}keyboard.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP}
-
-{Src}fontset.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}ccl.h" ¶
- "{Src}frame.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}fontset.h" ¶
- {WINDOW_H_GROUP}
-
-{Src}frame.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}charset.h" ¶
- "{Src}fontset.h" ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h" ¶
- "{Src}frame.h" ¶
- "{Src}fontset.h" ¶
- "{Src}termhooks.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- {DISPEXTERN_H_GROUP} ¶
- {WINDOW_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Src}commands.h" ¶
- "{Src}keyboard.h"
-
-{Src}getloadavg.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h"
-
-{Src}indent.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}category.h" ¶
- "{Src}indent.h" ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}termchar.h" ¶
- "{Src}termopts.h" ¶
- "{Src}disptab.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}region-cache.h"
-
-{Src}insdel.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- {WINDOW_H_GROUP} ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}region-cache.h"
-
-{Src}intervals.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Src}puresize.h" ¶
- "{Src}keyboard.h"
-
-{Src}keyboard.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}termchar.h" ¶
- "{Src}termopts.h" ¶
- "{Src}lisp.h" ¶
- "{Src}termhooks.h" ¶
- "{Src}macros.h" ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}keyboard.h" ¶
- "{Src}syntax.h" ¶
- {INTERVALS_H_GROUP} ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}puresize.h" ¶
- "{Src}systime.h" ¶
- "{Src}atimer.h" ¶
- "{Includes}sys:ioctl.h" ¶
- "{Src}syssignal.h" ¶
- "{Src}systty.h" ¶
- "{Includes}termio.h" ¶
- "{Includes}sys:types.h" ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h" ¶
- "{Src}systime.h"
-
-{Src}keymap.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}keyboard.h" ¶
- "{Src}termhooks.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}puresize.h" ¶
- {INTERVALS_H_GROUP}
-
-{Src}lread.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Includes}sys:file.h" ¶
- "{Src}lisp.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Includes}epaths.h" ¶
- "{Src}commands.h" ¶
- "{Src}keyboard.h" ¶
- "{Src}termhooks.h"
-
-{Src}macros.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}macros.h" ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}keyboard.h"
-
-{Src}marker.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h"
-
-{Src}minibuf.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}syntax.h" ¶
- "{Src}keyboard.h"
-
-{Src}mktime.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h"
-
-{Src}print.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}process.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}termchar.h" ¶
- "{Src}keyboard.h" ¶
- {INTERVALS_H_GROUP}
-
-{Src}process.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Src}lisp.h" ¶
- "{Src}systime.h" ¶
- "{Includes}sys:time.h" ¶
- "{Src}charset.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- "{Src}termopts.h" ¶
- "{Src}sysselect.h"
-
-{Src}regex.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}syntax.h" ¶
- "{Src}charset.h" ¶
- "{Src}category.h" ¶
- "{Src}regex.h"
-
-{Src}region-cache.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}region-cache.h"
-
-{Src}scroll.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}termchar.h" ¶
- "{Src}lisp.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP}
-
-{Src}search.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}syntax.h" ¶
- "{Src}category.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}region-cache.h" ¶
- "{Src}commands.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- {INTERVALS_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Src}regex.h"
-
-{Src}strftime.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:time.h"
-
-{Src}syntax.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}commands.h" ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}syntax.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}category.h"
-
-{Src}sysdep.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Includes}sys:ioctl.h" ¶
- "{Src}syswait.h" ¶
- "{Includes}sys:types.h" ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}termhooks.h" ¶
- "{Src}termchar.h" ¶
- "{Src}termopts.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}process.h" ¶
- "{Src}syssignal.h" ¶
- "{Src}systime.h" ¶
- "{Includes}utime.h" ¶
- "{Src}sysselect.h" ¶
- "{Includes}dirent.h" ¶
- "{Includes}sys:types.h"
-
-{Src}term.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}termchar.h" ¶
- "{Src}termopts.h" ¶
- "{Src}lisp.h" ¶
- "{Src}charset.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- "{Src}frame.h" ¶
- "{Src}disptab.h" ¶
- "{Src}termhooks.h" ¶
- "{Src}keyboard.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- {WINDOW_H_GROUP} ¶
- "{Src}cm.h" ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h"
-
-{Src}termcap.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Includes}sys:file.h"
-
-{Src}textproc.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}buffer.h" ¶
- {WINDOW_H_GROUP}
-
-{Src}tparam.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h"
-
-{Src}undo.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}commands.h"
-
-{Src}window.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}buffer.h" ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}commands.h" ¶
- "{Src}indent.h" ¶
- "{Src}termchar.h" ¶
- "{Src}disptab.h" ¶
- "{Src}keyboard.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- {BLOCKINPUT_H_GROUP} ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h"
-
-{Src}xdisp.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}termchar.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Src}charset.h" ¶
- "{Src}indent.h" ¶
- "{Src}commands.h" ¶
- "{Src}macros.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}disptab.h" ¶
- "{Src}termhooks.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}keyboard.h" ¶
- "{Src}keymap.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- "{Src}process.h" ¶
- "{Src}region-cache.h" ¶
- "{Src}fontset.h" ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h"
-
-{Src}xfaces.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Src}lisp.h" ¶
- "{Src}charset.h" ¶
- "{Src}frame.h" ¶
- "{Src}fontset.h" ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h" ¶
- "{Src}buffer.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- {BLOCKINPUT_H_GROUP} ¶
- {WINDOW_H_GROUP} ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}keyboard.h"
-
-{Src}macmenu.c.x Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}termhooks.h" ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}keyboard.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}buffer.h" ¶
- "{Includes}sys:types.h" ¶
- {DISPEXTERN_H_GROUP}
-
-{Src}mac.c Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Includes}utime.h" ¶
- "{Includes}dirent.h" ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Includes}pwd.h" ¶
- "{Includes}sys:types.h" ¶
- "{Includes}sys:param.h" ¶
- "{Src}lisp.h" ¶
- "{Src}process.h" ¶
- "{Src}sysselect.h" ¶
- "{Src}systime.h" ¶
- "{Includes}sys:time.h" ¶
- "{Includes}utsname.h"
-
-{Src}macfns.c Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- "{Src}charset.h" ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h" ¶
- "{Src}frame.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}buffer.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}fontset.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}keyboard.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Includes}epaths.h" ¶
- "{Src}termhooks.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- "{Src}systime.h" ¶
- "{Src}bitmaps:gray.xbm"
-
-{Src}macterm.c Ä ¶
- {CONFIG_H_GROUP} ¶
- "{Src}lisp.h" ¶
- {BLOCKINPUT_H_GROUP} ¶
- "{Src}syssignal.h" ¶
- "{Src}macterm.h" ¶
- "{Src}macgui.h" ¶
- "{Src}frame.h" ¶
- "{Includes}alloca.h" ¶
- "{Includes}sys:types.h" ¶
- "{Src}systty.h" ¶
- "{Includes}termio.h" ¶
- "{Src}systime.h" ¶
- "{Includes}sys:stat.h" ¶
- "{Src}charset.h" ¶
- "{Src}ccl.h" ¶
- "{Src}frame.h" ¶
- {DISPEXTERN_H_GROUP} ¶
- "{Src}fontset.h" ¶
- "{Src}termhooks.h" ¶
- "{Src}termopts.h" ¶
- "{Src}termchar.h" ¶
- "{Src}gnu.h" ¶
- "{Src}disptab.h" ¶
- "{Src}buffer.h" ¶
- {WINDOW_H_GROUP} ¶
- "{Src}keyboard.h" ¶
- {INTERVALS_H_GROUP} ¶
- "{Src}process.h" ¶
- "{Src}atimer.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h" ¶
- "{Includes}epaths.h" ¶
- "{Src}termhooks.h" ¶
- "{Src}coding.h" ¶
- "{Src}ccl.h"
-
-
-#----------------------------------------#
-# Variables and rules for target "Clean" #
-#----------------------------------------#
-
-Clean Ä
- Delete -i {EmacsObjects} {MacObjects}
- Delete -i "{EmacsTarget}"
- Delete -i stdout stderr
- Delete -i {Make-DocFile-Objects} {Make-DocFileDir}make-docfile
- Delete -i "{Source}"Emacs.maclf.r "{Source}"EmacsMPW.maclf.r
-
-DistClean Ä Clean
- Delete -i "Emacs CW"Ã…
- Delete -y "emacs Data"
- Delete -i emacs.mcp
-
-#--------------------------------------#
-# Variables and rules for target "Doc" #
-#--------------------------------------#
-
-EmacsSource = ¶
- "{Src}abbrev.c" ¶
- "{Src}alloc.c" ¶
- "{Src}alloca.c" ¶
- "{Src}atimer.c" ¶
- "{Src}buffer.c" ¶
- "{Src}bytecode.c" ¶
- "{Src}callint.c" ¶
- "{Src}callproc.c" ¶
- "{Src}casefiddle.c" ¶
- "{Src}casetab.c" ¶
- "{Src}category.c" ¶
- "{Src}ccl.c" ¶
- "{Src}charset.c" ¶
- "{Src}cm.c" ¶
- "{Src}cmds.c" ¶
- "{Src}coding.c" ¶
- "{Src}composite.c" ¶
- "{Src}data.c" ¶
- "{Src}dired.c" ¶
- "{Src}dispnew.c" ¶
- "{Src}doc.c" ¶
- "{Src}doprnt.c" ¶
- "{Src}editfns.c" ¶
- "{Src}emacs.c" ¶
- "{Src}eval.c" ¶
- "{Src}fileio.c" ¶
- "{Src}filemode.c" ¶
- "{Src}floatfns.c" ¶
- "{Src}fns.c" ¶
- "{Src}fontset.c" ¶
- "{Src}frame.c" ¶
- "{Src}getloadavg.c" ¶
- "{Src}indent.c" ¶
- "{Src}insdel.c" ¶
- "{Src}intervals.c" ¶
- "{Src}keyboard.c" ¶
- "{Src}keymap.c" ¶
- "{Src}lread.c" ¶
- "{Src}macros.c" ¶
- "{Src}marker.c" ¶
- "{Src}minibuf.c" ¶
- "{Src}mktime.c" ¶
- "{Src}print.c" ¶
- "{Src}process.c" ¶
- "{Src}regex.c" ¶
- "{Src}region-cache.c" ¶
- "{Src}scroll.c" ¶
- "{Src}search.c" ¶
- "{Src}strftime.c" ¶
- "{Src}syntax.c" ¶
- "{Src}sysdep.c" ¶
- "{Src}term.c" ¶
- "{Src}termcap.c" ¶
- "{Src}textprop.c" ¶
- "{Src}tparam.c" ¶
- "{Src}undo.c" ¶
- "{Src}window.c" ¶
- "{Src}xdisp.c" ¶
- "{Src}xfaces.c" ¶
- "{Src}xmenu.c"
-
-MacSource = ¶
- "{Src}mac.c" ¶
- "{Src}macfns.c" ¶
- "{Src}macterm.c"
-
-
-LispSource = ¶
- {Lisp}menu-bar.elc ¶
- {Lisp}mouse.elc ¶
- {Lisp}select.elc ¶
- {Lisp}scroll-bar.elc ¶
- {Lisp}vmsproc.elc ¶
- {Lisp}vms-patch.elc ¶
- {Lisp}ls-lisp.elc ¶
- {Lisp}dos-fns.elc ¶
- {Lisp}w32-fns.elc ¶
- {Lisp}dos-w32.elc ¶
- {Lisp}disp-table.elc ¶
- {Lisp}dos-vars.elc ¶
- {Lisp}international:ccl.elc ¶
- {Lisp}international:codepage.elc ¶
- {Lisp}abbrev.elc ¶
- {Lisp}buff-menu.elc ¶
- {Lisp}byte-run.elc ¶
- {Lisp}cus-start.el ¶
- {Lisp}custom.elc ¶
- {Lisp}emacs-lisp:lisp-mode.elc ¶
- {Lisp}emacs-lisp:lisp.elc ¶
- {Lisp}facemenu.elc ¶
- {Lisp}faces.elc ¶
- {Lisp}files.elc ¶
- {Lisp}float-sup.elc ¶
- {Lisp}format.elc ¶
- {Lisp}frame.elc ¶
- {Lisp}help.elc ¶
- {Lisp}indent.elc ¶
- {Lisp}isearch.elc ¶
- {Lisp}loadup.el ¶
- {Lisp}loaddefs.el ¶
- {Lisp}bindings.elc ¶
- {Lisp}map-ynp.elc ¶
- {Lisp}international:mule.elc ¶
- {Lisp}international:mule-conf.el ¶
- {Lisp}international:mule-cmds.elc ¶
- {Lisp}international:characters.elc ¶
- {Lisp}case-table.elc ¶
- {Lisp}language:chinese.elc ¶
- {Lisp}language:cyrillic.elc ¶
- {Lisp}language:indian.elc ¶
- {Lisp}language:ethiopic.elc ¶
- {Lisp}language:european.elc ¶
- {Lisp}language:tibetan.elc ¶
- {Lisp}language:vietnamese.elc ¶
- {Lisp}paths.el ¶
- {Lisp}register.elc ¶
- {Lisp}replace.elc ¶
- {Lisp}simple.elc ¶
- {Lisp}startup.elc ¶
- {Lisp}subr.elc ¶
- {Lisp}term:tty-colors.elc ¶
- {Lisp}textmodes:fill.elc ¶
- {Lisp}textmodes:page.elc ¶
- {Lisp}textmodes:paragraphs.elc ¶
- {Lisp}textmodes:text-mode.elc ¶
- {Lisp}vc-hooks.elc ¶
- {Lisp}ediff-hook.elc ¶
- {Lisp}widget.elc ¶
- {Lisp}window.elc ¶
- {Lisp}version.el
-
-LispSourceDontCompile = ¶
- {Lisp}language:devanagari.el ¶
- {Lisp}language:english.el ¶
- {Lisp}language:czech.el ¶
- {Lisp}language:slovak.el ¶
- {Lisp}language:romanian.el ¶
- {Lisp}language:greek.el ¶
- {Lisp}language:hebrew.el ¶
- {Lisp}language:japanese.el ¶
- {Lisp}language:korean.el ¶
- {Lisp}language:lao.el ¶
- {Lisp}language:thai.el ¶
- {Lisp}language:misc-lang.el
-
-Doc Ä {DocTarget}DOC
-
-{DocTarget}DOC Ä {Makefile} {EmacsSource} {MacSource} {LispSource} {LispSourceDontCompile} {Make-DocFileDir}Make-DocFile
- {Make-DocFileDir}make-docfile {EmacsSource} > {DocTarget}DOC
- {Make-DocFileDir}make-docfile {MacSource} >> {DocTarget}DOC
- {Make-DocFileDir}make-docfile {LispSource} >> {DocTarget}DOC
- {Make-DocFileDir}make-docfile {LispSourceDontCompile} >> {DocTarget}DOC
-
-
-#-----------------------------------------------#
-# Variables and rules for target "Make-DocFile" #
-#-----------------------------------------------#
-
-Make-DocFile-Includes = -i :inc:
-Make-DocFile-Sym =
-
-Make-DocFile-PPCCOptions = -typecheck relaxed -w off -noMapCR ¶
- {Make-DocFile-Includes} {Make-DocFile-Sym}
-
-Make-DocFile-Objects = ¶
- "{Lib-Src}make-docfile.c.x" ¶
- "{Source}chdir.c.x"
-
-Make-DocFile Ä {Make-DocFileDir}Make-DocFile
-
-{Make-DocFileDir}Make-DocFile Ä {Makefile} {Make-DocFile-Objects}
- PPCLink ¶
- -o {Make-DocFileDir}Make-DocFile ¶
- {Make-DocFile-Sym} ¶
- {Make-DocFile-Objects} ¶
- -t 'MPST' ¶
- -c 'MPS ' ¶
- "{SharedLibraries}InterfaceLib" ¶
- "{SharedLibraries}StdCLib" ¶
- "{SharedLibraries}MathLib" ¶
- "{PPCLibraries}StdCRuntime.o" ¶
- "{PPCLibraries}PPCCRuntime.o" ¶
- "{PPCLibraries}PPCToolLibs.o"
-
-"{Lib-Src}make-docfile.c.x" Ä {Makefile} "{Lib-Src}make-docfile.c"
- {PPCC} "{Lib-Src}make-docfile.c" -o "{Lib-Src}make-docfile.c.x" {Make-DocFile-PPCCOptions}
-
-"{Source}chdir.c.x" Ä {Makefile} "{Source}chdir.c"
- {PPCC} "{Source}chdir.c" -o "{Source}chdir.c.x" {Make-DocFile-PPCCOptions}
-
+++ /dev/null
-/* Resource definitions for GNU Emacs on the Macintosh.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#ifndef TARGET_API_MAC_CARBON
-#include "Types.r"
-/* added for finder icon balloon help --ben */
-#include "Balloons.r"
-#endif
-
-/* Define to use gnu icon */
-/* #define GNU_ICON 1 */
-
-resource 'STR#' (128) {
- {
- "TERM=macterm",
- "TERMCAP=macterm:co#80:li#40:up=up:do=do:le=le:nd=nd:cm=cm:cs=cs:ce=ce:cd=cd:cl=cl:al=al:dl=dl:",
- /* "HOME=/Ix/Data Files/Emacs Mac Port/emacs-20.4/mac/", */
- /* "MAIL=/Ix/System Folder/Eudora Folder/In" */
- }
-};
-
-resource 'STR#' (129) {
- {
- "emacs",
- "-l",
- "loadup"
- }
-};
-
-/* added for finder icon balloon help --ben */
-resource 'hfdr' (-5696) { /*help for emacs icon*/
- /*header component*/
- HelpMgrVersion, hmDefaultOptions, 0, 0,
- { /*icon component*/
- HMSTRResItem { /*use 'STR ' resource 128*/
- 128
- }
- }
-};
-
-#ifndef TARGET_API_MAC_CARBON
-/* added for finder icon balloon help --ben */
-resource 'STR ' (128) { /*help message for emacs icon*/
- "GNU Emacs\0xd1the extensible, customizable, self-documenting real-time display editor."
-};
-#endif
-
-resource 'MENU' (128, preload) {
- 128,
- textMenuProc,
- 0x7FFFFFFD,
- enabled,
- apple,
- { /* array: 2 elements */
- /* [1] */
- "About Emacs\0xc9", noIcon, noKey, noMark, plain,
- /* [2] */
- "-", noIcon, noKey, noMark, plain
- }
-};
-
-resource 'MBAR' (128, "MBAR for Menus1", preload) {
- { /* array MenuArray: 1 element */
- /* [1] */
- 128
- }
-};
-
-resource 'WIND' (128, "Window", purgeable) {
- {68, 33, 554, 754},
- kWindowFullZoomGrowDocumentProc,
- invisible,
- goAway,
- 0x0,
- "Terminal",
- kWindowStaggerMainScreen
-};
-
-resource 'WIND' (129, "Terminal window", purgeable) {
- {32, 8, 76, 620},
- kWindowModalDialogProc,
- invisible,
- goAway,
- 0x0,
- "Terminal",
- kWindowDefaultPosition
-};
-
-resource 'WIND' (130, "Dialog window", purgeable) {
- {32, 8, 42, 18},
- kWindowModalDialogProc,
- invisible,
- goAway,
- 0x0,
- "Terminal",
- kWindowDefaultPosition
-};
-
-resource 'ALRT' (128, "About Box", purgeable) {
- {40, 20, 160, 297},
- 128,
- { /* array: 4 elements */
- /* [1] */
- OK, visible, silent,
- /* [2] */
- OK, visible, silent,
- /* [3] */
- OK, visible, silent,
- /* [4] */
- OK, visible, silent
- },
- centerMainScreen
-};
-
-resource 'DITL' (128, purgeable) {
- { /* array DITLarray: 2 elements */
- /* [1] */
- {88, 185, 108, 265},
- Button {
- enabled,
- "OK"
- },
- /* [2] */
- {10, 60, 72, 278},
- StaticText {
- disabled,
- "GNU Emacs 21 for Mac OS"
- }
- }
-};
-
-resource 'ALRT' (129, "Ram Too Large", purgeable) {
- {40, 20, 160, 297},
- 129,
- { /* array: 4 elements */
- /* [1] */
- OK, visible, silent,
- /* [2] */
- OK, visible, silent,
- /* [3] */
- OK, visible, silent,
- /* [4] */
- OK, visible, silent
- },
- centerMainScreen
-};
-
-resource 'DITL' (129, purgeable) {
- { /* array DITLarray: 2 elements */
- /* [1] */
- {88, 185, 108, 265},
- Button {
- enabled,
- "OK"
- },
- /* [2] */
- {10, 60, 72, 278},
- StaticText {
- disabled,
- "Emacs does not run on a Macintosh with more than 256 MB of physical or virtual memory"
- }
- }
-};
-
-resource 'BNDL' (128) {
- 'EMAx',
- 0,
- { /* array TypeArray: 2 elements */
- /* [1] */
- 'FREF',
- { /* array IDArray: 2 elements */
- /* [1] */
- 0, 128,
- /* [2] */
- 1, 129
- },
- /* [2] */
- 'ICN#',
- { /* array IDArray: 2 elements */
- /* [1] */
- 0, 128,
- /* [2] */
- 1, 129
- }
- }
-};
-
-resource 'FREF' (128) {
- 'APPL',
- 0,
- ""
-};
-
-resource 'FREF' (129) {
- 'TEXT',
- 1,
- ""
-};
-
-resource 'vers' (1) {
- 0x1,
- 0x0,
- development,
- 0x0,
- 0,
- "d6",
- "GNU Emacs 21.1 for Mac OS\n\0xa9 2"
- "000 Free Software Foundation"
-};
-
-data 'EMAx' (0, "Owner resource") {
- $"00" /* . */
-};
-
-#ifdef GNU_ICON
-resource 'ICN#' (128) {
- { /* array: 2 elements */
- /* [1] */
- $"0000 0000 0000 0000 0000 0080 0000 0040"
- $"0100 0030 0203 5808 0408 8400 0418 0220"
- $"0420 0008 0464 9C80 04C1 0018 0000 0004"
- $"118B 0120 000A 0000 0614 8180 0204 2080"
- $"0468 0080 0480 4480 0000 0080 0148 08C0"
- $"0120 00C0 0182 4020 0388 0120 0181 2040"
- $"01E8 B040 00E0 70C0 0078 9880 003A 9880"
- $"001E 4000 000F C0",
- /* [2] */
- $"0000 0000 0000 0100 0000 0180 0000 00E0"
- $"0100 3030 0203 F818 063F FC18 0E3F FE38"
- $"1C7F FF78 1CFF FFF8 1CFF FFF8 1E7F FFFC"
- $"1FFF FF38 1FFF FF80 0FFF FF80 07FF FF80"
- $"0FFF FF80 0FFF FFC0 01FF FFC0 03FF FFC0"
- $"03FF FFC0 03FF FFE0 03FF FFE0 03FF FFE0"
- $"01FF FFC0 01FF FFC0 00FF FFC0 007F FF80"
- $"001F E700 000F C000 0004 80"
- }
-};
-#else
-resource 'ICN#' (128) {
- { /* array: 2 elements */
- /* [1] */
- $"0000 0000 0000 0000 0001 F000 07DE 0F60"
- $"0860 0090 1200 0028 1200 0008 0800 0008"
- $"0800 0008 1000 0004 1000 0004 2000 0004"
- $"2000 0044 4018 12C2 4018 0002 4018 0082"
- $"4002 0C42 2000 1E02 2004 1E42 2004 0C02"
- $"2004 0042 2002 0082 5001 8F05 8800 7004"
- $"0800 0008 0400 0010 0200 0060 01C0 0380"
- $"003F FC00 2000 0000 4000 0000 80",
- /* [2] */
- $"0000 0000 0000 0000 0001 F000 07DF FF60"
- $"0FFF FFF0 1FFF FFF8 1FFF FFF8 0FFF FFF8"
- $"0FFF FFF8 1FFF FFFC 1FFF FFFC 3FFF FFFC"
- $"3FFF FFFC 7FFF FFFE 7FFF FFFE 7FFF FFFE"
- $"7FFF FFFE 3FFF FFFE 3FFF FFFE 3FFF FFFE"
- $"3FFF FFFE 3FFF FFFE 7FFF FFFF FFFF FFFF"
- $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
- $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
- }
-};
-#endif
-
-#ifdef GNU_ICON
-resource 'icl4' (128) {
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 000C 0000 0000"
- $"0000 0000 0000 0000 0000 000C F000 0000"
- $"0000 0000 0000 0000 0000 0000 CFD0 0000"
- $"0000 000F 0000 0000 00CC 0000 00FF 0000"
- $"0000 00F0 0000 00FF CFCF F000 000C F000"
- $"0000 0FD0 00CD FD0C F000 CF00 000C D000"
- $"0000 CFC0 00DF F000 C000 00F0 00FC C000"
- $"000C DF00 0DFD 0CD0 0000 DCDD 0DC0 F000"
- $"000D 0F00 DFFC 0F00 FDDF FFDD FC0D D000"
- $"000C 0F00 FFC0 DCDF 0000 DC00 00CF F000"
- $"000C 0CD0 0C0C CDC0 000C 0CCD CCCC CF00"
- $"000F 00CF F0DC FCFF DDC0 CDDF 00FD C000"
- $"000D D000 CDC0 FCFC 0CDC CCCD C000 0000"
- $"0000 CFF0 D00F 0F0C F0CD CCCF F000 0000"
- $"0000 0CFC 00CD 0F0D D0FD CCCD F000 0000"
- $"0000 CFCC DFF0 FC0C DCCC CCCC F000 0000"
- $"0000 DFC0 FDDC 0C0C DFC0 CEDC FC00 0000"
- $"0000 000C DDCC CDC0 C00C CCCC FC00 0000"
- $"0000 00CF CF0C FC0C 0000 F00D FF00 0000"
- $"0000 00CF D0FC 0CCC C000 0CCC FF00 0000"
- $"0000 00CF F0DC 0CFC CFCD DDDC DCF0 0000"
- $"0000 00FF FCD0 FDCC DDC0 00DF 0DF0 0000"
- $"0000 00CF FDCD 0DCF CDFC CC0D 0FC0 0000"
- $"0000 000F FFFC FCD0 F0FF C000 DF00 0000"
- $"0000 000C FFF0 CDCD DFFF DCCC FF00 0000"
- $"0000 0000 CFFF FC0D F0CF F000 FC00 0000"
- $"0000 0000 0CFF FDF0 F0DF FDDD F000 0000"
- $"0000 0000 000F FFFC CFC0 0DDD 0000 0000"
- $"0000 0000 0000 FFFF FF00 0000 0000 0000"
- $"0000 0000 0000 0C00 C0"
-};
-#else
-resource 'icl4' (128) {
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 000F FFFF 0000 0000 0000"
- $"0000 0FFF FF0F FFF0 0000 FFFF 0FF0 0000"
- $"0000 FCCC CFF0 0000 0000 0000 FCCF 0000"
- $"000F 0DED CC00 0000 0000 0000 0DEC F000"
- $"000F 0DED C000 0000 0000 0000 00DD F000"
- $"0000 F0D0 0000 0000 0000 0000 0000 F000"
- $"0000 FC00 0000 0000 0000 0000 0000 F000"
- $"000F 0000 0000 0000 0000 0000 0000 0F00"
- $"000F 0000 0000 0000 0000 0000 0000 0F00"
- $"00F0 0000 0000 0000 0000 0000 0000 0F00"
- $"00F0 0000 0000 0000 0000 0000 DEC0 0F00"
- $"0F00 0000 00CE EC00 0CCC CCCC FFC0 00F0"
- $"0F00 0000 0CDF FD0C C000 000D CDC0 00F0"
- $"0F00 0000 00CE ECD0 0000 CC00 D000 00F0"
- $"0F00 0000 0000 00D0 000C EEC0 0D00 00F0"
- $"00F0 0000 0000 0D00 00CE AAEC 0D00 00F0"
- $"00F0 0000 0000 0D00 00CE AAEC 0D00 00F0"
- $"00F0 0000 0000 0D00 000C EEC0 0D00 00F0"
- $"00F0 0000 0000 0D00 0000 CC00 0D00 00F0"
- $"00F0 0000 0000 0CD0 0000 0000 E000 00F0"
- $"0F0F 0000 0000 00CD D000 EEEE 0000 0F0F"
- $"F000 F000 0000 0000 0EEE 0000 0000 0F00"
- $"0000 F000 0000 0000 0000 0D00 0000 FC00"
- $"0000 0F00 0000 0000 0000 0D00 000F C000"
- $"0000 00F0 0000 0000 0000 0C00 0FFC C000"
- $"0000 C00F FF00 0000 0000 00EE ECCC 0000"
- $"000D 0000 0CFF FFFF FEEE EECC CCC0 0000"
- $"0CF0 0000 0000 CCCC CCCC CC0C 0C00 0C00"
- $"CEC0 0000 0000 0000 0000 0000 0000 0DC0"
- $"FD00 0000 0000 0000 0000 0000 0000 00D0"
-};
-#endif
-
-#ifdef GNU_ICON
-resource 'icl8' (128) {
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 002B 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 002B FF00 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 2BFF F900 0000 0000"
- $"0000 0000 0000 00FF 0000 0000 0000 0000"
- $"0000 2B2B 0000 0000 0000 FFFF 0000 0000"
- $"0000 0000 0000 FF00 0000 0000 0000 FFFF"
- $"2BFF 2BFF FF00 0000 0000 002B FF00 0000"
- $"0000 0000 00FF F900 0000 2BF9 FFF9 002B"
- $"FF00 0000 2BFF 0000 0000 002B F900 0000"
- $"0000 0000 2BFF 2B00 0000 F9FF FF00 0000"
- $"2B00 0000 0000 FF00 0000 FF2B 2B00 0000"
- $"0000 002B F9FF 0000 00F9 FFF9 002B F900"
- $"0000 0000 F92B F9F9 00F9 2B00 FF00 0000"
- $"0000 00F9 00FF 0000 F9FF FF2B 00FF 0000"
- $"FFF9 F9FF FFFF F9F9 FF2B 00F9 F900 0000"
- $"0000 002B 00FF 0000 FFFF 2B00 F92B F9FF"
- $"0000 0000 F92B 0000 0000 2BFF FF00 0000"
- $"0000 002B 002B F900 002B 002B 2BF9 2B00"
- $"0000 002B 002B 2BF9 2B2B 2B2B 2BFF 0000"
- $"0000 00FF 0000 2BFF FF00 F92B FF2B FFFF"
- $"F9F9 2B00 2BF9 F9FF 0000 FFF9 2B00 0000"
- $"0000 00F9 F900 0000 2BF9 2B00 FF2B FF2B"
- $"002B F92B 2B2B 2BF9 2B00 0000 0000 0000"
- $"0000 0000 2BFF FF00 F900 00FF 00FF 002B"
- $"FF00 2BF9 2B2B 2BFF FF00 0000 0000 0000"
- $"0000 0000 002B FF2B 0000 2BF9 00FF 00F9"
- $"F900 FFF9 2B2B 2BF9 FF00 0000 0000 0000"
- $"0000 0000 2BFF 2B2B F9FF FF00 FF2B 002B"
- $"F92B 2B2B 2B2B 2B2B FF00 0000 0000 0000"
- $"0000 0000 F9FF 2B00 FFF9 F92B 002B 002B"
- $"F9FF 2B00 2BFC F92B FF2B 0000 0000 0000"
- $"0000 0000 0000 002B F9F9 2B2B 2BF9 2B00"
- $"2B00 002B 2B2B 2B2B FF2B 0000 0000 0000"
- $"0000 0000 0000 2BFF 2BFF 002B FF2B 002B"
- $"0000 0000 FF00 00F9 FFFF 0000 0000 0000"
- $"0000 0000 0000 2BFF F900 FF2B 002B 2B2B"
- $"2B00 0000 002B 2B2B FFFF 0000 0000 0000"
- $"0000 0000 0000 2BFF FF00 F92B 002B FF2B"
- $"2BFF 2BF9 F9F9 F92B F92B FF00 0000 0000"
- $"0000 0000 0000 FFFF FF2B F900 FFF9 2B2B"
- $"F9F9 2B00 0000 F9FF 00F9 FF00 0000 0000"
- $"0000 0000 0000 2BFF FFF9 2BF9 00F9 2BFF"
- $"2BF9 FF2B 2B2B 00F9 00FF 2B00 0000 0000"
- $"0000 0000 0000 00FF FFFF FF2B FF2B F900"
- $"FF00 FFFF 2B00 0000 F9FF 0000 0000 0000"
- $"0000 0000 0000 002B FFFF FF00 2BF9 2BF9"
- $"F9FF FFFF F92B 2B2B FFFF 0000 0000 0000"
- $"0000 0000 0000 0000 2BFF FFFF FF2B 00F9"
- $"FF00 2BFF FF00 0000 FF2B 0000 0000 0000"
- $"0000 0000 0000 0000 002B FFFF FFF9 FF00"
- $"FF00 F9FF FFF9 F9F9 FF00 0000 0000 0000"
- $"0000 0000 0000 0000 0000 00FF FFFF FF2B"
- $"2BFF 2B00 00F9 F9F9 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 FFFF FFFF"
- $"FFFF 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 002B 0000"
- $"2B"
-};
-#else
-resource 'icl8' (128) {
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 00FF"
- $"FFFF FFFF 0000 0000 0000 0000 0000 0000"
- $"0000 0000 00FF FFFF FFFF F5FF FFFF FFF5"
- $"F5F5 F5F5 FFFF FFFF 00FF FF00 0000 0000"
- $"0000 0000 FFF6 F6F6 F6FF FFF5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 FFF7 F6FF 0000 0000"
- $"0000 00FF F5F9 FBF9 F7F7 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F9 FCF6 FF00 0000"
- $"0000 00FF F5F9 FBF9 F7F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F9F9 FF00 0000"
- $"0000 0000 FFF5 F9F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 FF00 0000"
- $"0000 0000 FFF7 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 FF00 0000"
- $"0000 00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5FF 0000"
- $"0000 00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5FF 0000"
- $"0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5FF 0000"
- $"0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F9FC F6F5 F5FF 0000"
- $"00FF F5F5 F5F5 F5F5 F5F5 F7FB FBF7 F5F5"
- $"F5F6 F6F7 F7F7 F7F8 FFFF F7F5 F5F5 FF00"
- $"00FF F5F5 F5F5 F5F5 F5F6 F9FF FFF9 F5F7"
- $"F7F5 F5F5 F5F5 F5F9 F7F9 F6F5 F5F5 FF00"
- $"00FF F5F5 F5F5 F5F5 F5F5 F7FB FCF7 F9F5"
- $"F5F5 F5F5 F6F6 F5F5 F9F5 F5F5 F5F5 FF00"
- $"00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F9F5"
- $"F5F5 F5F7 FBFB F7F5 F5F9 F5F5 F5F5 FF00"
- $"0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F9 F5F5"
- $"F5F5 F7FB FDFD ACF7 F5F9 F5F5 F5F5 FF00"
- $"0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F9 F5F5"
- $"F5F5 F7FB FDFD ACF7 F5F9 F5F5 F5F5 FE00"
- $"0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F9 F5F5"
- $"F5F5 F5F7 FBFB F7F5 F5F9 F5F5 F5F5 FE00"
- $"0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F9 F5F5"
- $"F5F5 F5F5 F7F7 F5F5 F5FA F5F5 F5F5 FE00"
- $"0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F7 F9F5"
- $"F5F5 F5F5 F5F5 F5F5 FBF5 F5F5 F5F5 FF00"
- $"00FF F5FF F5F5 F5F5 F5F5 F5F5 F5F5 F7F9"
- $"F9F5 F5F5 FBFB FBFB F5F5 F5F5 F5FE F5FF"
- $"FFF5 F5F5 FFF5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5FB FBFB F5F5 F5F5 F5F5 F5F5 F5FF F5F5"
- $"F5F5 F5F5 FFF5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F9 F5F5 F5F5 F5F5 FFF6 F5F5"
- $"F5F5 F5F5 F5FF F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F9 F5F5 F5F5 F5FF F6F5 F5F5"
- $"F5F5 F5F5 F5F5 FFF5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F6 F5F5 F5FF FFF7 F6F5 F5F5"
- $"F5F5 F5F5 F7F5 F5FF FFFF F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 ACAC ACF7 F6F6 F5F5 F5F5"
- $"F5F5 F5F9 F5F5 F5F5 F5F7 FFFF FFFF FFFF"
- $"FFFC FCAC ACAC F6F6 F7F6 F6F5 F5F5 F5F5"
- $"F5F6 FFF5 F5F5 F5F5 F5F5 F5F5 F6F7 F6F7"
- $"F6F7 F6F6 F6F6 F5F6 F5F6 F5F5 F5F7 F5F5"
- $"F6FC F7F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F9 F7F5"
- $"FFF9 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F9F5"
-};
-#endif
-
-#ifdef GNU_ICON
-resource 'ics#' (128) {
- { /* array: 2 elements */
- /* [1] */
- $"0000 0008 11E6 26B4 2EEA 2906 5B14 36D8"
- $"2EA8 1A28 1D8C 1B5C 1EC8 0FE8 0780",
- /* [2] */
- $"0010 001C 11FE 37FE 7FFE 7FFE 7FFE 3FF8"
- $"3FF8 1FF8 1FFC 1FFC 1FF8 0FF8 07F0 0280"
- }
-};
-#else
-resource 'ics#' (128) {
- { /* array: 2 elements */
- /* [1] */
- $"0000 0000 0001 604B 6000 6002 0831 0078"
- $"1079 1030 1001 0802 063C 01C0",
- /* [2] */
- $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
- $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
- }
-};
-#endif
-
-#ifdef GNU_ICON
-resource 'ics4' (128) {
- $"0000 0000 000C 0000 0000 0000 000C FD00"
- $"000F 000F FFF0 0FF0 00FD 0FFC F0FF 0FD0"
- $"0DF0 FFFD FFFD FDF0 0CFD FCDF 0CDD CFF0"
- $"0FDF FDFF DDDF CFC0 00FF DFFD FFCF F000"
- $"00FC FFFC FCED F000 000F FCFC CCFD F000"
- $"000F FFCF FDDD FF00 000F FDFF DFCF FF00"
- $"000F FFFD FFDC F000 0000 FFFF FFFD F000"
- $"0000 0FFF FCDD 0000 0000 00C0 C0"
-};
-#else
-resource 'ics4' (128) {
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 00DE CEEC 000C CCCC CCFF"
- $"DFFD 0CC0 0000 0DCD CEEC D000 00CC 00D0"
- $"0000 D000 0CEE C00D 000D 0000 CEAA EC0D"
- $"000D 0000 CEAA EC0D 000D 0000 0CEE C00D"
- $"000D 0000 00CC 000D 000C D000 0000 00E0"
- $"0000 CDD0 00EE EE00 0000 000E EE00 0000"
- $"0000 0000 000D 0000 0000 0000 000D"
-};
-#endif
-
-#ifdef GNU_ICON
-resource 'ics8' (128) {
- $"0000 0000 0000 0000 0000 002B 0000 0000"
- $"0000 0000 0000 0000 0000 002B FFF9 0000"
- $"0000 00FF 0000 00FF FFFF FF00 00FF FF00"
- $"0000 FFF9 00FF FF2B FF00 FFFF 00FF F900"
- $"00F9 FF00 FFFF FFF9 FFFF FFF9 FFF9 FF00"
- $"002B FFF9 FF2B F9FF 002B F9F9 2BFF FF00"
- $"00FF F9FF FFF9 FFFF F9F9 F9FF 2BFF 2B00"
- $"0000 FFFF F9FF FFF9 FFFF 2BFF FF00 0000"
- $"0000 FF2B FFFF FF2B FF2B FCF9 FF00 0000"
- $"0000 00FF FF2B FF2B 2B2B FFF9 FF00 0000"
- $"0000 00FF FFFF 2BFF FFF9 F9F9 FFFF 0000"
- $"0000 00FF FFF9 FFFF F9FF 2BFF FFFF 0000"
- $"0000 00FF FFFF FFF9 FFFF F92B FF00 0000"
- $"0000 0000 FFFF FFFF FFFF FFF9 FF00 0000"
- $"0000 0000 00FF FFFF FF2B F9F9 0000 0000"
- $"0000 0000 0000 2B00 2B"
-};
-#else
-resource 'ics8' (128) {
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F9FC"
- $"F7FB FBF7 F5F5 F5F6 F6F7 F7F7 F7F8 FFFF"
- $"F9FF FFF9 F5F7 F7F5 F5F5 F5F5 F5F9 F7F9"
- $"F7FB FCF7 F9F5 F5F5 F5F5 F6F6 F5F5 F9F5"
- $"F5F5 F5F5 F9F5 F5F5 F5F7 FBFB F7F5 F5F9"
- $"F5F5 F5F9 F5F5 F5F5 F7FB FDFD ACF7 F5F9"
- $"F5F5 F5F9 F5F5 F5F5 F7FB FDFD ACF7 F5F9"
- $"F5F5 F5F9 F5F5 F5F5 F5F7 FBFB F7F5 F5F9"
- $"F5F5 F5F9 F5F5 F5F5 F5F5 F7F7 F5F5 F5FA"
- $"F5F5 F5F7 F9F5 F5F5 F5F5 F5F5 F5F5 FBF5"
- $"F5F5 F5F5 F7F9 F9F5 F5F5 FBFB FBFB F5F5"
- $"F5F5 F5F5 F5F5 F5FB FBFB F5F5 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F9 F5F5 F5F5"
- $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F9 F5F5 F5F5"
-};
-#endif
-
-resource 'ICN#' (129) {
- { /* array: 2 elements */
- /* [1] */
- $"0000 0300 0000 1C80 0000 E0B0 0007 00F0"
- $"0038 0070 01C0 0038 0E00 8038 7008 4038"
- $"8008 2038 8004 0038 8080 041C C086 301C"
- $"C087 311C 4007 BB8C 6167 378C 6170 070E"
- $"2130 6006 3031 FC06 3047 FE06 10E7 FF02"
- $"1867 FF82 1847 FF03 080F FE07 0C1F E03C"
- $"0C0F C1F0 0406 0F80 0400 7C00 0203 E000"
- $"031F 0000 01F8 0000 00C0",
- /* [2] */
- $"0000 0300 0000 1F80 0000 FFB0 0007 FFF0"
- $"003F FFF0 01FF FFF8 0FFF FFF8 7FFF FFF8"
- $"FFFF FFF8 FFFF FFF8 FFFF FFFC FFFF FFFC"
- $"FFFF FFFC 7FFF FFFC 7FFF FFFC 7FFF FFFE"
- $"3FFF FFFE 3FFF FFFE 3FFF FFFE 1FFF FFFE"
- $"1FFF FFFE 1FFF FFFF 0FFF FFFF 0FFF FFFC"
- $"0FFF FFF0 07FF FF80 07FF FC00 03FF E000"
- $"03FF 0000 01F8 0000 00C0"
- }
-};
-
-resource 'icl4' (129) {
- $"0000 0000 0000 0000 0000 00FF 0000 0000"
- $"0000 0000 0000 0000 000F FF0C F000 0000"
- $"0000 0000 0000 0000 FFF0 0000 F0FF 0000"
- $"0000 0000 0000 0FFF 0000 0000 FFDF 0000"
- $"0000 0000 00FF F000 0000 0000 CFEF 0000"
- $"0000 000F FF00 0000 0000 0000 00ED F000"
- $"0000 FFF0 0000 0000 DC00 0000 00AD F000"
- $"0FFF 0000 0000 E000 0DC0 0000 00FE F000"
- $"F000 0000 0000 DC00 0CD0 0000 00FE F000"
- $"F000 0000 CC00 CC00 00C0 0C00 00FA F000"
- $"F000 0000 D000 00C0 00C0 0DCC 00CF EF00"
- $"EF00 0000 E000 0EED C0ED C0DD 000F EF00"
- $"EFC0 0000 DC00 CEEF CCEF D0DD 000F AF00"
- $"DFC0 000C 00C0 CEFE D0EF D0ED E00C FF00"
- $"0EFC 00CD 0EDC 0DDE 00DF CDEE EC00 FF00"
- $"0EFC 000E 0DEE 00CC 00CC CDFE D000 FFF0"
- $"0DFC 000D CCFE C00C DEDD 0CDC 0000 CFF0"
- $"00EF C00C 0CDE 00CE FFFF AE00 0000 0FF0"
- $"00EF C000 DD0C 0DEE FFFF FEED C000 0FF0"
- $"00DF C000 DFE0 CDFF FFFF FFAF C000 0CF0"
- $"000E FC00 DEE0 CAFF FFFF FFFE D000 0CFD"
- $"000E FC00 CED0 DEFF FFFF FFFE C000 0CFF"
- $"000D FC00 0C0C EFFF FFFF AEDD 00CC CFFF"
- $"0000 EF00 000D EFFF FADD C00C CCFF FED0"
- $"0000 EF00 000C FAFF AED0 CCCF FFEE D000"
- $"0000 DF00 000C DEED CCCC FFFE ED00 0000"
- $"0000 0E00 0000 0CCC CFFF EED0 0000 0000"
- $"0000 0DFD 0000 CCFF FEED 0000 0000 0000"
- $"0000 00EF DDDF FFEE D000 0000 0000 0000"
- $"0000 000E FFFE ED00 0000 0000 0000 0000"
- $"0000 0000 DDD0"
-};
-
-resource 'icl8' (129) {
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 FFFF 0000 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 00FF FFFF 00F7 FF00 0000 0000 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"FFFF FF00 0000 0000 FF00 FFFF 0000 0000"
- $"0000 0000 0000 0000 0000 0000 00FF FFFF"
- $"0000 0000 0000 0000 FFFF FAFF 0000 0000"
- $"0000 0000 0000 0000 0000 FFFF FF00 0000"
- $"0000 0000 0000 0000 F7FF FCFF 0000 0000"
- $"0000 0000 0000 00FF FFFF 0000 0000 0000"
- $"F500 0000 0000 0000 0000 FCFA FF00 0000"
- $"0000 0000 FFFF FF00 0000 0000 0000 0000"
- $"812B 0000 0000 0000 0000 FDFA FF00 0000"
- $"00FF FFFF 0000 0000 0000 0000 FBF5 0000"
- $"0081 2B00 0000 0000 0000 FFFC FF00 0000"
- $"FF00 0000 0000 0000 00F5 0000 F9F8 0000"
- $"00F8 FA00 0000 0000 0000 FFFC FF00 0000"
- $"FF00 0000 0000 0000 F8F8 0000 F7F8 0000"
- $"00F5 2B00 002B 0000 0000 FFFD FF00 0000"
- $"FF00 0000 0000 00F5 FA00 0000 00F5 F800"
- $"0000 2B00 00FA F8F6 0000 F7FF FCFF 0000"
- $"FCFF 0000 0000 0000 FB00 0000 00FB FCF9"
- $"F600 FBFA F700 5656 0000 00FF FCFF 0000"
- $"FCFF F700 0000 0000 81F6 0000 F8FC ACFE"
- $"F72B ACFE 5600 F9FA 0000 00FF FDFF 0000"
- $"F9FF F700 0000 F5F7 F500 F600 2BAC FEFC"
- $"FA00 FCFF 81F5 FB81 FBF5 00F7 FFFF 0000"
- $"00FC FFF6 0000 2B81 00FC 81F8 0081 81FC"
- $"F500 FAFF 2B81 ACFC FCF6 0000 FFFF 0000"
- $"00FC FFF6 0000 00FB 0081 FCAC F500 F82B"
- $"0000 F8F8 2B81 FFAC F900 0000 FFFF FF00"
- $"00F9 FFF6 0000 0081 F6F8 FFAC F700 00F8"
- $"F9FC FA56 00F6 562B 0000 0000 F7FF FF00"
- $"0000 FCFF F700 00F7 002B FAFB F500 F7FC"
- $"FEFF FFFF FDFB F500 0000 0000 00FF FF00"
- $"0000 FCFF F700 0000 F9FA F5F8 0081 FCAC"
- $"FFFF FFFF FFFC AC56 2B00 0000 00FF FF00"
- $"0000 F9FF F700 0000 81FF AC00 F781 FFFF"
- $"FFFF FFFF FFFF FDFE F800 0000 00F7 FF00"
- $"0000 00FC FFF7 0000 56FC FBF5 F7FD FFFF"
- $"FFFF FFFF FFFF FFAC 8100 0000 00F6 FFF9"
- $"0000 00FC FFF7 0000 2BAC 5600 F9FC FFFF"
- $"FFFF FFFF FFFF FFFB F700 0000 00F7 FFFF"
- $"0000 00F9 FFF7 0000 F5F6 002B FBFE FFFF"
- $"FFFF FFFE FDFC FA56 0000 F7F7 F7FF FFFF"
- $"0000 0000 FCFF 0000 0000 00FA ACFF FFFF"
- $"FFFD 8156 2BF5 00F7 F7F7 FFFF FFFC F900"
- $"0000 0000 FCFF 0000 0000 00F7 FEFD FFFE"
- $"FDFC F900 F7F7 F7FF FFFF FCFC F900 0000"
- $"0000 0000 F9FF 0000 0000 00F6 56AC FBF9"
- $"F7F6 F7F7 FFFF FFFC FCF9 0000 0000 0000"
- $"0000 0000 00FC 0000 0000 0000 002B F7F7"
- $"F7FF FFFF FCFC F900 0000 0000 0000 0000"
- $"0000 0000 00F9 FFF9 0000 0000 F7F7 FFFF"
- $"FFFC FCF9 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 FCFF F9F9 F9FF FFFF FCFC"
- $"F900 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 00FC FFFF FFFC FCF9 0000"
- $"0000 0000 0000 0000 0000 0000 0000 0000"
- $"0000 0000 0000 0000 FAFA F9"
-};
-
-resource 'ics#' (129) {
- { /* array: 2 elements */
- /* [1] */
- $"0030 01CC 0E04 7006 8006 8006 8352 4412"
- $"44C3 49F1 2BF1 23C7 23B8 01C0 1E",
- /* [2] */
- $"0030 01FC 0FFC 7FFE FFFE FFFE FFFE 7FFE"
- $"7FFF 7FFF 3FFF 3FFF 3FF8 3FC0 1E"
- }
-};
-
-resource 'ics4' (129) {
- $"0000 0000 0CFF C000 0000 0CCF FFC0 EE00"
- $"00CC FFFC 0000 CEC0 CFFF C0C0 C000 0ED0"
- $"F000 C0C0 CC00 0FD0 F000 C0CD 0CCC 0DA0"
- $"FC0C C0DF CACD CCF0 DF0C DFCD 0DDA C0FC"
- $"CF0C CD0C EEDC 00EF 0FC0 FCCF FFFE C0DF"
- $"0DF0 DCDF FFFA C0CF 0CF0 0CAF FEDC CFFD"
- $"00F0 0CEE DCFF FDC0 00CD 00CF FFDC 0000"
- $"000D FFFD C000 0000 0000 CC"
-};
-
-resource 'ics8' (129) {
- $"0000 0000 0000 0000 F5F7 FFFF 2BF5 0000"
- $"0000 0000 00F6 F7FF FFFF F600 ACAC 0000"
- $"0000 F6F7 FFFF FFF6 0000 0000 F8AC F700"
- $"2BFF FFFF F600 F600 F8F5 0000 00AC FA00"
- $"FFF5 0000 F6F5 F700 F6F6 F500 F5FE FA00"
- $"FFF5 00F5 F700 F756 F5F8 2BF7 0081 FDF5"
- $"FF2B 00F6 F700 FAFE F7FD F8FA 2BF7 FF00"
- $"56FF 00F7 56FF 2B56 F556 56FD F800 FEF7"
- $"2BFF F5F6 F7FA F5F8 ACFC F92B 0000 FBFF"
- $"00FF F700 FFF8 F8FE FFFF FFFC F600 56FF"
- $"0056 FF00 FAF7 81FF FFFF FFFD 2B00 F6FF"
- $"002B FFF5 002B FDFF FFFC 56F7 F7FF FF81"
- $"0000 FFF5 00F6 FCFB FAF7 FFFF FFF9 F600"
- $"0000 F8F9 0000 F7FF FFFF F9F6 0000 0000"
- $"0000 0081 FFFF FFF9 F600 0000 0000 0000"
- $"0000 0000 F8F6"
-};
+++ /dev/null
-/* Resource definitions for GNU Emacs on the Macintosh when building
- under MPW.
-
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#include "Types.r"
-#include "CodeFragmentTypes.r"
-
-resource 'SIZE' (-1) {
- reserved,
- acceptSuspendResumeEvents,
- reserved,
- canBackground,
- doesActivateOnFGSwitch,
- backgroundAndForeground,
- dontGetFrontClicks,
- ignoreAppDiedEvents,
- is32BitCompatible,
- isHighLevelEventAware,
- onlyLocalHLEvents,
- notStationeryAware,
- dontUseTextEditServices,
- reserved,
- reserved,
- reserved,
- 16777216,
- 16777216
-};
+++ /dev/null
-/* Implementation of chdir on the Mac for use with make-docfile.
- Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Contributed by Andrew Choi (akochoi@mac.com). */
-
-#include <string.h>
-#include <Files.h>
-#include <TextUtils.h>
-
-int chdir(const char *path)
-{
- WDPBRec wdpb;
-
- Str255 mypath;
- OSErr error;
-
- strcpy(mypath, path);
- c2pstr(mypath);
-
- wdpb.ioNamePtr = mypath;
- wdpb.ioVRefNum = 0;
- wdpb.ioWDDirID = 0;
- error = PBHSetVolSync(&wdpb);
-
- return error == noErr ? 0 : -1;
-}
-2003-05-28 Richard M. Stallman <rms@gnu.org>
-
- * indent.texi (Indentation): Condense, simplify, clarify prev change.
-
-2003-05-28 Nick Roberts <nick@nick.uklinux.net>
-
- * building.texi (GDB Graphical Interface): New node.
- (Rewritten somewhat by RMS.)
-
-2003-05-28 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * custom.texi (Init Rebinding): Xref Non-ASCII Rebinding, for
- non-English letters. Explain how to set coding systems correctly
- and how to include the right coding cookie in the file.
-
-2003-05-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * trampver.texi: Version 2.0.34 released.
-
-2003-05-22 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * indent.texi (Indentation): Explain the concepts.
- (Just Spaces): Explain why preventing tabs for indentation might
- be useful.
-
-2003-05-03 Glenn Morris <gmorris@ast.cam.ac.uk>
-
- * faq.texi: Improve previous changes.
-
-2003-05-02 Glenn Morris <gmorris@ast.cam.ac.uk>
-
- * faq.texi: Update copyright and maintenance details.
- Update some package URLs, versions, and maintainers.
- Remove many references to the Emacs Lisp Archive.
-
-2003-04-23 Simon Josefsson <jas@extundo.com>
-
- * smtpmail.texi: Fix license (the invariant sections mentioned has
- never been part of the smtp manual). Align info dir entry with
- other emacs packages.
-
-2003-04-16 Richard M. Stallman <rms@gnu.org>
-
- * search.texi (Regexps): Ref to Lisp manual for more regexp features.
-
-2003-04-08 Michael Albinus <Michael.Albinus@alcatel.de>
-
- * tramp.texi: Version 2.0.33 released.
- Remove installation chapter. Remove XEmacs specifics.
-
-2003-03-29 Richard M. Stallman <rms@gnu.org>
-
- * tramp.texi (Top): Undo the previous renaming.
- (emacs-other-name, emacs-other-dir, emacs-other-file-name): Deleted.
-
-2003-03-29 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * Makefile.in (../info/tramp): Compile Emacs, instead of XEmacs,
- version of manual.
-
- * tramp.texi (Auto-save and Backup): New node.
-
-2003-03-29 Michael Albinus <Michael.Albinus@alcatel.de>
-
- * tramp.texi (Top): Include trampver.texi. Rename "Emacs" to "GNU
- Emacs" in order to have better differentiation to "XEmacs".
- `emacs-other-name', `emacs-other-dir' and `emacs-other-file-name'
- are new macros in order to point to the other Emacs flavor where
- appropriate. In info case, point to node `Installation' in order
- to explain how to generate the other way. In html case, make a
- link to the other html file.
- (Obtaining TRAMP): Added a paragraph saying to perform `autoconf'
- after CVS checkout/update.
- (Installation): Completely rewritten.
- (Installation parameters, Load paths): New sections under
- `Installation'.
-
-2003-02-28 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * tramp.texi: Version 2.0.30 released.
- Replace word "path" with "localname" where used as a component of
- a Tramp file name.
-
-2003-02-28 Michael Albinus <Michael.Albinus@alcatel.de>
-
- * tramp.texi (Frequently Asked Questions): `tramp-chunksize'
- introduced.
- (Installation): Explain what to do if files from the tramp/contrib
- directory are needed.
-
2003-02-23 Alex Schroeder <alex@emacswiki.org>
* smtpmail.texi (How Mail Works): New.
$(ENVADD) $(TEXI2DVI) ${srcdir}/emacs-mime.texi
../info/tramp: tramp.texi
- cd $(srcdir); $(MAKEINFO) -D emacs tramp.texi
+ cd $(srcdir); $(MAKEINFO) tramp.texi
tramp.dvi: tramp.texi
$(ENVADD) $(TEXI2DVI) ${srcdir}/tramp.texi
@findex define-abbrevs
The commands @kbd{M-x insert-abbrevs} and @kbd{M-x define-abbrevs} are
similar to the previous commands but work on text in an Emacs buffer.
-@kbd{M-x insert-abbrevs} inserts text into the current buffer after point,
+@kbd{M-x insert-abbrevs} inserts text into the current buffer before point,
describing all current abbrev definitions; @kbd{M-x define-abbrevs} parses
the entire current buffer and defines abbrevs accordingly.@refill
expressions, dynamic abbrev expansion skips that buffer.
A negative argument to @kbd{M-/}, as in @kbd{C-u - M-/}, says to
-search first for expansions after point, then other buffers, and
-consider expansions before point only as a last resort.
-
- If you repeat the @kbd{M-/} to look for another expansion, do not
-specify an argument. This tries all the expansions after point and
-then the expansions before point.
+search first for expansions after point, and second for expansions
+before point. If you repeat the @kbd{M-/} to look for another
+expansion, do not specify an argument. This tries all the expansions
+after point and then the expansions before point.
After you have expanded a dynamic abbrev, you can copy additional
words that follow the expansion in its original context. Simply type
last time you did @kbd{M-x compile}. If you type just @key{RET}, the
same command line is used again. For the first @kbd{M-x compile}, the
default is @samp{make -k}, which is correct most of the time for
-nontrivial programs. (@xref{Top,, Make, make, GNU Make Manual}.)
+nontrivial programs. (@xref{Make,, Make, make, GNU Make Manual}.)
The default compilation command comes from the variable
@code{compile-command}; if the appropriate compilation command for a
file is something other than @samp{make -k}, it can be useful for the
* Commands of GUD:: Key bindings for common commands.
* GUD Customization:: Defining your own commands for GUD.
* GUD Tooltips:: Showing variable values by pointing with the mouse.
-* GDB Graphical Interface:: An enhanced mode that uses GDB features to
- implement a graphical debugging environment through
- Emacs.
@end menu
@node Starting GUD
for input and output to GDB, and switches to it. If a GDB buffer
already exists, it just switches to that buffer.
-@item M-x gdba @key{RET} @var{file} @key{RET}
-Run GDB as a subprocess of Emacs, providing a graphical interface
-to GDB features through Emacs. @xref{GDB Graphical Interface}.
-
@item M-x dbx @key{RET} @var{file} @key{RET}
@findex dbx
Similar, but run DBX instead of GDB.
If you are using GDB, these additional key bindings are available:
@table @kbd
-@item C-c C-r
-@kindex C-c C-r @r{(GUD)}
-@itemx C-x C-a C-r
-@findex gud-run
-Start execution of the program (@code{gud-run}).
-
-@item C-c C-u
-@kindex C-c C-u @r{(GUD)}
-@itemx C-x C-a C-u
-@findex gud-until
-Continue execution to the current line. The program will run until
-it hits a breakpoint, terminates, gets a signal that the debugger is
-checking for, or reaches the line on which the cursor currently sits
-(@code{gud-until}).
-
@item @key{TAB}
@kindex TAB @r{(GUD)}
@findex gud-gdb-complete-command
the mouse in the GUD buffer or in source buffers with major modes in the
customizable list @code{tooltip-gud-modes}.
-@node GDB Graphical Interface
-@subsection GDB Graphical Interface
-
-@findex gdba
-The command @code{gdba} starts GDB using a graphical interface where
-you view and control the program's data using Emacs windows. You can
-still interact with GDB through the GUD buffer, but the point of this
-mode is that you can do it through menus and clicks, without needing
-to know GDB commands.
-
-@menu
-* Breakpoints Buffer:: A breakpoint control panel.
-* Stack Buffer:: Select a frame from the call stack.
-* Data Display:: Display and update expressions in their own buffer.
-* Display Buffer:: Control the displayed expressions.
-* Other Buffers:: Input/output, locals, registers and assembler buffers.
-* Layout:: Control the number of displayed buffers.
-@end menu
-
-@node Breakpoints Buffer
-@subsubsection Breakpoints Buffer
-
-The breakpoints buffer shows the existing breakpoints and watchpoints
-(@pxref{Breakpoints,,, gdb, The GNU debugger}). It has three special
-commands:
-
-@table @kbd
-@item @key{SPC}
-@kindex SPC @r{(GDB breakpoints buffer)}
-@findex gdb-toggle-breakpoint
-Enable/disable the breakpoint at the current line
-(@code{gdb-toggle-breakpoint}). On a graphical display, this changes
-the color of a bullet in the margin of the source buffer at the
-relevant line. This is red when the breakpoint is enabled and grey
-when it is disabled. Text-only terminals correspondingly display
-a @samp{B} or @samp{b}.
-
-@item @kbd{d}
-@kindex d @r{(GDB breakpoints buffer)}
-@findex gdb-delete-breakpoint
-Delete the breakpoint at the current line (@code{gdb-delete-breakpoint}).
-
-@item @key{RET}
-@kindex RET @r{(GDB breakpoints buffer)}
-@findex gdb-goto-breakpoint
-Display the file in the source buffer at the breakpoint specified at
-the current line (@code{gdb-goto-breakpoint}). Alternatively, click @kbd{Mouse-2} on the breakpoint that you wish to visit.
-@end table
-
-@node Stack Buffer
-@subsubsection Stack Buffer
-
-The stack buffer displays a @dfn{call stack}, with one line for each
-of the nested subroutine calls (@dfn{stack frames}) now active in the
-program. @xref{Backtrace,,info stack, gdb, The GNU debugger}.
-
-Move point to any frame in the stack and type @key{RET} to make it
-become the current frame (@code{gdb-frames-select}) and display the
-associated source in the source buffer. Alternatively, click
-@kbd{Mouse-2} to make the selected frame become the current one. If the
-locals buffer is displayed then its contents update to display the
-variables that are local to the new frame.
-
-@node Data Display
-@subsubsection Data Display
-@cindex displaying expressions in GDB
-
-If you want to see how a variable changes each time your program stops
-then place the cursor over the variable name and click on the display
-icon in the toolbar (@code{gud-display}).
-
-Each displayed expression has its own frame on a graphical display and
-its own buffer on a text-only terminal. Arrays and structures have
-their own display formats. To display an array as a slice, at the top
-of the display window, click @kbd{Mouse-2} on the array index that you
-want to restrict and you will be prompted in the mini-buffer for a
-start and a stop value. Click @kbd{Mouse-2} on a pointer to
-dereference it in the same frame/buffer. Click @kbd{S-Mouse-2} there
-to do the same thing but in a new frame/buffer. There are two special
-commands for these buffers:
-
-@table @kbd
-@item @kbd{v}
-@kindex v @r{(GDB data buffer)}
-@findex gdb-array-visualise
-Visualise an array using the graph program from plotutils if this is
-installed. This only works for one dimensional arrays
-(@code{gdb-array-visualise}).
-
-@item @kbd{q}
-@kindex q @r{(GDB data buffer)}
-@findex gdb-delete-expression
-Delete the displayed expression and the associated frame
-(@code{gdb-delete-expression}).
-@end table
-
-@node Display Buffer
-@subsubsection Display Buffer
-
-The display buffer shows the list of displayed expressions
-(@pxref{Auto Display,,, gdb, The GNU debugger}). As with the
-breakpoints, you can enable/disable or delete the displayed
-expressions:
-
-@table @kbd
-@item @key{SPC}
-@kindex SPC @r{(GDB display buffer)}
-@findex gdb-toggle-display
-Enable/disable the display at the current line
-(@code{gdb-toggle-display}).
-
-@item @kbd{d}
-@kindex d @r{(GDB display buffer)}
-@findex gdb-delete-display
-Delete the display at the current line (@code{gdb-delete-display}).
-@end table
-
-@node Other Buffers
-@subsubsection Other Buffers
-
-@table @asis
-@item Input/Output Buffer
-The executable program that is being debugged takes its input and
-displays its output here. Some of the commands from shell mode are
-available here. @xref{Shell Mode}.
-
-@item Locals Buffer
-The locals buffer displays the values of local variables of the
-current frame for simple data types (@pxref{Frame Info,,, gdb, The GNU
-debugger}).
-
-Arrays and structures display their type only. You must display them
-separately to examine their values. @ref{Data Display}.
-
-@item Registers Buffer
-The registers buffer displays the values held by the registers
-(@pxref{Registers,,, gdb, The GNU debugger}).
-
-@item Assembler Buffer
-The assembler buffer displays the current frame as machine code. An
-overlay arrow points to the current instruction and you can set and
-remove breakpoints as with the source buffer. Breakpoints also
-appear in the margin.
-@end table
-
-@node Layout
-@subsubsection Layout
-@cindex GDB User Interface layout
-You may choose to display the additional buffers described previously
-either in the same frame or a different one. Select GDB-windows or
-GDB-Frames from the menu-bar under the heading GUD. If the menu-bar
-is unavailable, type @code{M-x
-gdb-display-@var{buffertype}-buffer} or @code{M-x
-gdb-frame-@var{buffertype}-buffer} respectively, where @var{buffertype}
-is the relevant buffer type e.g breakpoints.
-
-@findex gdb-many-windows
-@vindex gdb-many-windows
-If @code{gdb-many-windows} is @code{nil} (the default value), then GDB starts
-with just two windows: the GUD and the source buffer. If it is @code{t}, then
-six windows with the following layout will appear:
-
-@multitable @columnfractions .5 .5
-@item GUD buffer (I/O of GDB)
-@tab Locals buffer
-@item
-@tab
-@item Source buffer
-@tab Input/Output (of debuggee) buffer
-@item
-@tab
-@item Stack buffer
-@tab Breakpoints buffer
-@end multitable
-
-To toggle this layout, do @kbd{M-x gdb-many-windows}.
-
-@findex gdb-restore-windows
-If you change the window layout, for example, while editing and
-re-compiling your program, then you can restore it with
-@code{gdb-restore-windows}.
-
@node Executing Lisp
@section Executing Lisp Expressions
inside Emacs.
@item SMTPSERVER
The name of the outgoing mail server. Used by the SMTP library
-(@pxref{Top,,Sending mail via SMTP,smtpmail}).
+(@pxref{Sending mail via SMTP,,,smtpmail}).
@cindex background mode, on @command{xterm}
@item TERM
The type of the terminal that Emacs is using. This variable must be
by listing each of the characters within the square brackets that
delimit the vector.
- Language and encoding settings can be a reason for failing key
-binding. For instance, say you have put the following in your init
-file:
-
-@example
-(global-set-key [?\M-ö] 'shell)
-@end example
-
-@noindent
-Now it can happen that the ö character read from the keyboard is
-actually different from the ö character read from your init file, even
-though they look the same. In this case, Emacs will not do what you
-intended. First you should check whether they are the same or
-different. In the above example, you would position point (the cursor)
-on the ö character and hit @kbd{C-u C-x =} (the @kbd{C-u} part is
-important). The second line of the output will contain the charset.
-Now hit the ö key and position point on the character thus produced.
-Again, hit @kbd{C-u C-x =}. If the two charsets are different, then you
-have found the problem. The solution involves putting a `coding cookie'
-in your init file, @pxref{File Variables}. For example, suppose that
-the ö character from the init file has charset latin-iso8859-1 whereas
-the ö character from the keyboard has charset latin-iso8859-15. The
-solution is to put a coding cookie into the first line of the
-@file{.emacs} file, as follows:
-
-@example
-;; -*- coding: iso8859-15; -*-
-@end example
-
-@noindent
-@xref{Non-ASCII Rebinding}, if the charset printed by @kbd{C-u C-x =} is
-`eight-bit-graphic'.
-
- If the variable @code{keyboard-coding-system} is nil, it is probably
-best to set it to the right value, according to the locale you work in.
-
@node Function Keys
@subsection Rebinding Function Keys
file your @dfn{init file} because it specifies how to initialize Emacs
for you. You can use the command line switch @samp{-q} to prevent
loading your init file, and @samp{-u} (or @samp{--user}) to specify a
-different user's init file (@pxref{Initial Options}).
+different user's init file (@pxref{Entering Emacs}).
@cindex @file{default.el}, the default init file
There can also be a @dfn{default init file}, which is the library
Allan Gottlieb (gottlieb@@allan.ultra.nyu.edu),
Aaron Gross (aaron@@bfr.co.il),
Thorbjoern Hansen (thorbjoern.hansen@@mchp.siemens.de),
-Marcus Harnisch (marcus_harnisch@@mint-tech.com),
Xiaoli Huang (hxl@@epic.com),
Andreas Jaeger (aj@@suse.de),
Lars Magne Ingebrigtsen (larsi@@ifi.uio.no),
@set VER 21.3
@copying
-Copyright 2001, 2002, 2003 Free Software Foundation, Inc.
+Copyright 2001, 2002 Free Software Foundation, Inc.
Copyright 1994,1995,1996,1997,1998,1999,2000 Reuven M. Lerner@*
Copyright 1992,1993 Steven Byrnes@*
Copyright 1990,1991,1992 Joseph Brian Wells@*
The FAQ is maintained as a Texinfo document, allowing us to create HTML,
Info, and TeX documents from a single source file, and is slowly but
surely being improved. Please bear with us as we improve on this
-format. This FAQ is maintained as a part of GNU Emacs. If you find
-any errors, or have any suggestions, please use @kbd{M-x report-emacs-bug}
-to report them.
+format. If you have any suggestions or questions, please contact
+@email{emacs-faq@@lerner.co.il, the FAQ maintainers}.
@menu
* FAQ notation::
The archive is at @uref{ftp://ftp-mailing-list-archives.gnu.org}.
-The archive can be browsed over the web at
-@uref{http://mail.gnu.org/archive/html/, the GNU mail archive}.
+As of this writing, the archives are not yet working.
Web-based Usenet search services, such as
-@uref{http://groups.google.com, Google}, also archive the
+@uref{http://www.dejanews.com, DejaNews}, also archive the
@code{gnu.*} groups.
@node Reporting bugs, Unsubscribing from Emacs lists, Newsgroup archives, General questions
@node Setting up a customization file, Colors on a TTY, Common requests, Common requests
@section How do I set up a @file{.emacs} file properly?
@cindex @file{.emacs} file, setting up
-@cindex @file{.emacs} file, locating
@cindex Init file, setting up
@cindex Customization file, setting up
-@inforef{Init File, Init File, emacs}.
+@inforef{Init File, Init File, emacs}
In general, new Emacs users should not have @file{.emacs} files, because
it causes confusing non-standard behavior. Then they send questions to
rather completely in @inforef{Init File, Init File, emacs}, for users
interested in performing frequently requested, basic tasks.
-Sometimes users are unsure as to where their @file{.emacs} file should
-be found. Visiting the file as @file{~/.emacs} from Emacs will find
-the correct file.
-
@node Colors on a TTY, Debugging a customization file, Setting up a customization file, Common requests
@section How do I get colors and syntax highlighting on a TTY?
@cindex Colors on a TTY
@cindex Set number capability in @code{vi} emulators
None of the @code{vi} emulation modes provide the ``set number''
-capability of @code{vi} (as far as we know). The @samp{setnu} package
-written by @email{kyle@@wonderworks.com, Kyle Jones} provides this
-feature. So too does @samp{wb-line-number}, written by
-@email{naoki.y.nakamura@@nifty.com, Naoki Nakamura}.
+capability of @code{vi} (as far as we know).
@node Displaying the current file name in the titlebar, Turning on abbrevs by default, Displaying the current line or column, Common requests
@section How can I modify the titlebar to contain the current file name?
@cindex @code{gnuserv}
There is an enhanced version of @samp{emacsclient}/server called
@samp{gnuserv}, written by @email{ange@@hplb.hpl.hp.com, Andy Norman}
-(@pxref{Packages that do not come with Emacs}). @samp{gnuserv} uses
-Internet domain sockets, so it can work across most network connections.
-It also supports the execution of arbitrary Emacs Lisp forms and does
-not require the client program to wait for completion.
+which is available in the Emacs Lisp Archive (@pxref{Packages that do
+not come with Emacs}). @samp{gnuserv} uses Internet domain sockets, so
+it can work across most network connections. It also supports the
+execution of arbitrary Emacs Lisp forms and does not require the client
+program to wait for completion.
The alpha version of an enhanced @samp{gnuserv} is available at
@uref{ftp://ftp.wellfleet.com/netman/psmith/emacs/gnuserv-2.1alpha.tar.gz}
-The version available from @uref{http://meltin.net/hacks/emacs/} is
-more recent, and has been tested with Emacs 21.2.
-
@end itemize
@node Compiler error messages, Indenting switch statements, Using an already running Emacs process, Common requests
If you have paragraphs with different levels of indentation, you will
have to set the fill prefix to the correct value each time you move to a
-new paragraph. There are many packages available to deal with this
-(@pxref{Packages that do not come with Emacs}). Look for ``fill'' and
-``indent'' keywords for guidance.
+new paragraph. To avoid this hassle, try one of the many packages
+available from the Emacs Lisp Archive (@pxref{Packages that do not come
+with Emacs}.) Look up ``fill'' and ``indent'' in the Lisp Code
+Directory for guidance.
@node Matching parentheses, Hiding #ifdef lines, Automatic indentation, Common requests
@section How do I show which parenthesis matches the one I'm looking at?
@cindex Selectively displaying @code{#ifdef} code
@kbd{M-x hide-ifdef-mode}. (This is a minor mode.) You might also want
-to investigate @file{cpp.el}, which is distributed with Emacs.
+to try @file{cpp.el}, available at the Emacs Lisp Archive
+(@pxref{Packages that do not come with Emacs}).
@node Repeating commands, Valid X resources, Hiding #ifdef lines, Common requests
@section Is there an equivalent to the @code{.} (dot) command of vi?
@cindex X resources
@cindex Setting X resources
-@inforef{X Resources, X Resources, emacs}.
+@inforef{Resources X, Resources X, emacs}.
You can also use a resource editor, such as editres (for X11R5 and
onwards), to look at the resource names for the menu bar, assuming Emacs
@cindex Suspending Emacs
@kbd{C-z} iconifies Emacs when running under X and suspends Emacs
-otherwise. @inforef{Frame Commands, Frame Commands, emacs}.
+otherwise. @inforef{Misc X, Misc X, emacs}.
@node Using regular expressions, Replacing text across multiple files, Forcing Emacs to iconify itself, Common requests
@section How do I use regexps (regular expressions) in Emacs?
longer between auto-saves, which might annoy you less.
You might also want to look into Sebastian Kremer's @code{auto-save}
-package (@pxref{Packages that do not come with Emacs}). This
+package, available from the Lisp Code Archive (@pxref{Packages that do not come
+with Emacs}). This
package also allows you to place all auto-save files in one directory,
such as @file{/tmp}.
default, a backslash (@samp{\}) will appear in the mode line.
If you are running a version of Emacs before 20.1, get @code{crypt++}
-(@pxref{Packages that do not come with Emacs}). Among other things,
-@code{crypt++} transparently modifies MS-DOS files as they are loaded
-and saved, allowing you to ignore the different conventions that Unix
-and MS-DOS have for delineating the end of a line.
+from the Emacs Lisp Archive (@pxref{Packages that do not come with
+Emacs}). Among other things, @code{crypt++} transparently modifies
+MS-DOS files as they are loaded and saved, allowing you to ignore the
+different conventions that Unix and MS-DOS have for delineating the end
+of a line.
@node Filling paragraphs with a single space, Escape sequences in shell output, Editing MS-DOS files, Common requests
@section How can I tell Emacs to fill paragraphs with a single space after each period?
with a shell metacharacter (@kbd{cd ../lib*}), Emacs will fail to
correctly guess the shell's new current directory. A huge variety of
fixes and enhancements to shell mode for this problem have been written
-to handle this problem (@pxref{Finding a package with particular
-functionality}).
+to handle this problem. Check the Lisp Code Directory (@pxref{Finding a
+package with particular functionality}).
You can tell Emacs the shell's current directory with the command
@kbd{M-x dirs}.
* Finding Emacs on the Internet::
* Finding a package with particular functionality::
* Packages that do not come with Emacs::
+* Submitting to the Emacs Lisp Archive::
* Current GNU distributions::
* Difference between Emacs and XEmacs::
* Emacs for MS-DOS::
modify a Lisp package, see if the author has provided any hints in the
source code.
-The command @kbd{C-h p} (@code{finder-by-keyword}) allows you to browse
-the constituent Emacs packages.
+If a package does not come with Emacs, check the Lisp Code Directory.
+The LCD was originally maintained by @email{brennan@@hal.com, Dave
+Brennan}, but was recently taken over by @email{toby@@world.std.com,
+toby knudsen}, who maintains @uref{http://www.emacs.org}. The LCD is
+currently being reorganized and updated, but you can meanwhile find many
+packages at @uref{ftp://ftp.emacs.org/pub}.
+
+For now, you can search through the LCD with @file{lispdir.el}, which is
+in the process of being updated. Download it from the LCD, in the
+@file{emacs-lisp-attic/misc} directory, and then evaluate the following
+Lisp form (@pxref{Evaluating Emacs Lisp code}):
+
+@lisp
+(setq lisp-code-directory
+ "/anonymous@@ftp.emacs.org:pub/emacs-lisp-attic/emacs-lisp/LCD-datafile.gz"
+ elisp-archive-host "ftp.emacs.org"
+ elisp-archive-directory "/pub/emacs-lisp-attic/emacs-lisp/")
+@end lisp
+
+Once you have installed @file{lispdir.el}, you can use @kbd{M-x
+lisp-dir-apropos} to search the listing. For example, @kbd{M-x
+lisp-dir-apropos @key{RET} ange-ftp @key{RET}} produces this output:
-For advice on how to find extra packages that are not part of Emacs,
-see @ref{Packages that do not come with Emacs}.
+@example
+ GNU Emacs Lisp Code Directory Apropos --- "ange-ftp"
+"~/" refers to archive.cis.ohio-state.edu:pub/elisp-archive/
+
+ ange-ftp (4.18) 15-Jul-1992
+ Andy Norman, <ange@@hplb.hpl.hp.com>
+ ~/packages/ange-ftp.tar.Z
+ transparent FTP Support for GNU Emacs
+ auto-save (1.19) 01-May-1992
+ Sebastian Kremer, <sk@@thp.uni-koeln.de>
+ ~/misc/auto-save.el.Z
+ Safer autosaving with support for ange-ftp and /tmp
+ ftp-quik (1.0) 28-Jul-1993
+ Terrence Brannon, <tb06@@pl122f.eecs.lehigh.edu>
+ ~/modes/ftp-quik.el.Z
+ Quik access to dired'ing of ange-ftp and normal paths
+@end example
-@node Packages that do not come with Emacs, Current GNU distributions, Finding a package with particular functionality, Finding Emacs and related packages
+@node Packages that do not come with Emacs, Submitting to the Emacs Lisp Archive, Finding a package with particular functionality, Finding Emacs and related packages
@section Where can I get Emacs Lisp packages that don't come with Emacs?
@cindex Unbundled packages
@cindex Finding other packages
@cindex Lisp packages that do not come with Emacs
@cindex Packages, those that do not come with Emacs
-@cindex Emacs Lisp List
-@cindex Emacs Lisp Archive
+@cindex Emacs Lisp Archive, description of
+@cindex Archive, description of the Emacs Lisp
+
+First, check the Lisp Code Directory to find the name of the package you
+are looking for (@pxref{Finding a package with particular
+functionality}). Next, check local archives and the Emacs Lisp Archive
+to find a copy of the relevant files. If you still haven't found it,
+you can send e-mail to the author asking for a copy. If you find Emacs
+Lisp code that doesn't appear in the LCD, please submit a copy to the
+LCD (@pxref{Submitting to the Emacs Lisp Archive}).
+
+You can access the Emacs Lisp Archive at
+
+@uref{ftp://archive.cis.ohio-state.edu/pub/emacs-lisp/}
-@uref{http://www.anc.ed.ac.uk/~stephen/emacs/ell.html, The Emacs Lisp
-List (ELL)}, maintained by @email{stephen@@anc.ed.ac.uk, Stephen Eglen},
-aims to provide one compact list with links to all of the current Emacs
-lisp files on the internet. The ELL can be browsed over the web, or
-from Emacs with @uref{http://www.anc.ed.ac.uk/~stephen/emacs/ell.el,
-the @file{ell} package}.
+@noindent
+or at
+
+@uref{http://www.cis.ohio-state.edu/emacs-lisp}
+
+@noindent
+Retrieve and read the file @file{README} first.
-Many authors post their packages to the @uref{news:gnu.emacs.sources,
-Emacs sources newsgroup}. You can search the archives of this
-group with @uref{http://groups.google.com, Google}, for example.
+@itemize @bullet
-Several packages are stored in
-@uref{http://emacswiki.org/elisp/, the Lisp area of the Emacs Wiki}.
+@item
+The archive maintainers do not have time to answer individual
+requests for packages or the list of packages in the archive. If you
+cannot use FTP or UUCP to access the archive yourself, try to find a
+friend who can, but please don't ask the maintainers.
-For a long time, the Emacs Lisp Archive provided a central repository
-for Emacs packages. Sadly, it has not been active for some time,
-although you can still access the old files at
+@item
+Any files with names ending in @file{.Z}, @file{.z}, or @file{.gz} are
+compressed, so you should use "binary" mode in FTP to retrieve them.
+You should also use binary mode whenever you retrieve any files with
+names ending in @file{.elc}.
-@uref{ftp://ftp.cis.ohio-state.edu/pub/emacs-lisp/WWW/index.html}
+@end itemize
-@node Current GNU distributions, Difference between Emacs and XEmacs, Packages that do not come with Emacs, Finding Emacs and related packages
+@node Submitting to the Emacs Lisp Archive, Current GNU distributions, Packages that do not come with Emacs, Finding Emacs and related packages
+@section How do I submit code to the Emacs Lisp Archive?
+@cindex Submitting code to the Emacs Lisp Archive
+@cindex Emacs Lisp Archive, submissions to
+@cindex Lisp Archive, submissions to
+@cindex Archive, submitting to the Emacs Lisp
+
+Guidelines and procedures for submission to the archive can be found in
+the file @file{GUIDELINES} in the archive directory (@pxref{Packages that
+do not come with Emacs}). It covers documentation, copyrights,
+packaging, submission, and the Lisp Code Directory Record. Anonymous
+FTP uploads are not permitted. Instead, all submissions are mailed to
+@email{elisp-archive@@cis.ohio-state.edu}. The @file{lispdir.el}
+package has a function named @code{submit-lcd-entry} which will help you
+with this.
+
+@node Current GNU distributions, Difference between Emacs and XEmacs, Submitting to the Emacs Lisp Archive, Finding Emacs and related packages
@section Where can I get other up-to-date GNU stuff?
@cindex Current GNU distributions
@cindex Sources for current GNU distributions
and more features can be expected in the future, but there are still many
differences between the two.
-The latest stable branch of XEmacs as of this writing is 21.4; you can
+The latest stable branch of XEmacs as of this writing is 21.1; you can
get it at
-@uref{ftp://ftp.xemacs.org/pub/xemacs/xemacs-21.4/xemacs-21.4.12.tar.gz}
+@uref{ftp://ftp.xemacs.org/pub/xemacs/xemacs-21.1.14.tar.gz}
More information about XEmacs, including a list of frequently asked
questions (FAQ), is available at
@cindex @code{cc-mode}
Most of these modes are now available in standard Emacs distribution.
-To get additional modes, see @ref{Finding a package with particular
-functionality}.
+To get additional modes, look in the Lisp Code Directory (@pxref{Finding
+a package with particular functionality}). For C@t{++}, if you use
+@code{lisp-dir-apropos}, you must specify the pattern with something
+like @kbd{M-x lisp-dir-apropos @key{RET} c\+\+ @key{RET}}.@footnote{
+The backslashes in @samp{\+\+} are required because @kbd{M-x
+lisp-dir-apropos} expects a regular expression as its argument
+(@pxref{Using regular expressions}), and @samp{+} has a special meaning
+in regular expressions.}
Barry Warsaw's @code{cc-mode} now works for C, C@t{++}, Objective-C, and
-Java code. It is distributed with Emacs, but has
-@uref{http://cc-mode.sourceforge.net/, its own homepage}.
+Java code. You can get the latest version from the Emacs Lisp Archive;
+@pxref{Packages that do not come with Emacs} for details. A FAQ for
+@code{cc-mode} is available at
+@uref{http://www.python.org/emacs/cc-mode/}.
@node Translating names to IP addresses, , Modes for various languages, Finding Emacs and related packages
@section What is the IP address of XXX.YYY.ZZZ?
* Supercite::
* Calc::
* VIPER::
-* AUCTeX::
+* AUC-TeX::
* BBDB::
* Ispell::
* w3-mode::
@table @b
@item Author
-@email{kyle_jones@@wonderworks.com, Kyle Jones}
+@email{kyle@@uunet.uu.net, Kyle Jones}
@item Latest version
-7.15
+6.72
@item Distribution
@uref{ftp://ftp.wonderworks.com/pub/vm/vm.tar.gz}
-@item Informational newsgroup
+@item Informational newsgroup/mailing list
@uref{news:gnu.emacs.vm.info}@*
+Subscription requests to @email{info-vm-request@@uunet.uu.net}@*
+Submissions to @email{info-vm@@uunet.uu.net}
-@item Bug reports newsgroup
+@item Bug reports newsgroup/mailing list
@uref{news:gnu.emacs.vm.bug}@*
-Or send reports to @email{bug-vm@@wonderworks.com}
+Subscription requests to @email{bug-vm-request@@uunet.uu.net}@*
+Submissions to @email{bug-vm@@uunet.uu.net}
@end table
-VM 7 works well with Emacs 21. Older versions of VM suitable for use
-with older versions of Emacs are available from
-@uref{ftp://ftp.wonderworks.com/pub/vm/, the same FTP site}.
-
+VM 6 works with Emacs 20.4, and may cause problems with Emacs 20.3 and
+below. (But note that many people seem to use Emacs 20.3 with VM 6,
+without any problems.) Risk-averse users might wish to try VM 5.97,
+available from @uref{ftp://ftp.wonderworks.com/pub/vm/, the same FTP
+site}.
@node Supercite, Calc, VM, Major packages and programs
@section Supercite --- mail and news citation package within Emacs
@table @b
@item Author
-@email{barry@@python.org, Barry Warsaw}
+@email{bwarsaw@@cen.com, Barry Warsaw}
@item Latest version
-3.54 (comes bundled with Emacs since version 20)
+3.54 (comes bundled with Emacs 20)
@item Distribution
@uref{http://www.python.org/emacs/supercite.tar.gz}
as matrices, special functions, and statistics, but is more than
adequate as a replacement for @code{xcalc} and similar programs.
-@node VIPER, AUCTeX, Calc, Major packages and programs
+@node VIPER, AUC-TeX, Calc, Major packages and programs
@section VIPER --- @code{vi} emulation for Emacs
@cindex @code{vi} emulation
@cindex VIPER
@end table
-@node AUCTeX, BBDB, VIPER, Major packages and programs
-@section AUCTeX --- enhanced LaTeX mode with debugging facilities
+@node AUC-TeX, BBDB, VIPER, Major packages and programs
+@section AUC TeX --- enhanced LaTeX mode with debugging facilities
@cindex Mode for @TeX{}
@cindex @TeX{} mode
-@cindex AUCTeX mode for editing @TeX{}
+@cindex AUC-TeX mode for editing @TeX{}
@cindex Writing and debugging @TeX{}
@table @b
@email{krab@@iesd.auc.dk, Kresten Krab Thorup} and@*
@email{abraham@@dina.kvl.dk, Per Abrahamsen}
-@item Maintainer
-@email{dak@@gnu.org, David Kastrup}
-
@item Latest version
-11.13
+9.9p
@item Distribution
-@uref{http://savannah.gnu.org/download/auctex/stable.pkg/11.13/auctex-11.13.tar.gz}
+@uref{ftp://sunsite.auc.dk/packages/auctex/auctex.tar.gz}
@item Web site
-@uref{http://www.gnu.org/software/auctex/}
+@uref{http://sunsite.auc.dk/auctex/}
@item Mailing list:
-Subscription requests to @email{auc-tex-subscribe@@sunsite.dk}@*
-Submissions to @email{auc-tex@@sunsite.dk}@*
-Development team is at @email{auc-tex_mgr@@sunsite.dk}
+Subscription requests to @email{auc-tex-request@@iesd.auc.dk}@*
+Submissions to @email{auc-tex@@iesd.auc.dk}@*
+Development team is at @email{auc-tex_mgr@@iesd.auc.dk}
@end table
-@node BBDB, Ispell, AUCTeX, Major packages and programs
+@node BBDB, Ispell, AUC-TeX, Major packages and programs
@section BBDB --- personal Info Rolodex integrated with mail/news readers
@cindex BBDB
@cindex Rolodex-like functionality
@table @b
@item Maintainer
-@email{waider@@waider.ie, Ronan Waide}
+@email{simmonmt@@acm.org, Matt Simmons}
@item Latest version
-2.34
+2.00
@item Distribution
-@uref{http://bbdb.sourceforge.net/}
+@uref{http://bbdb.sf.net/}
@item Mailing lists
-Subscription requests to @email{bbdb-info-request@@lists.sourceforge.net}@*
-Submissions to @email{bbdb-info@@lists.sourceforge.net}@*
-Release announcements: @email{bbdb-announce-request@@lists.sourceforge.net}
+Subscription requests to @email{info-bbdb-request@@xemacs.org}@*
+Submissions to @email{info-bbdb@@xemacs.org}@*
+Release announcements: @email{bbdb-announce-request@@xemacs.org}
@end table
@email{jin@@atype.com, Jin S. Choi}
@item Maintainer
-@email{warner-mailcrypt@@lothar.com, Brian Warner}
+@email{lbudney@@pobox.com, Len Budney}
@item Latest version
-3.5.8
+3.5.3
@item Distribution
-@uref{http://dl.sourceforge.net/sourceforge/mailcrypt/mailcrypt-3.5.8.tar.gz}
+@uref{http://www.nb.net/~lbudney/linux/software/mailcrypt/mailcrypt-3.5.3.tar.gz}
@item Web site
-@uref{http://mailcrypt.sourceforge.net/}
+@uref{http://www.nb.net/~lbudney/linux/software/mailcrypt.html}
@end table
@section Where can I find out more about Gnus?
@cindex FAQ for Gnus
@cindex Gnus FAQ
-@cindex Learning more about Gnus
+@cindex Learning more about GNU
+
+Look for the Gnus FAQ, available at
-For more information on Gnus, consult the Gnus manual and FAQ, which are
-part of the Gnus distribution.
+@uref{http://www.ccs.neu.edu/software/contrib/gnus/}
@node Concept index, , Mail and news, Top
@unnumbered Concept Index
Indent from point to under an indentation point in the previous line.
@end table
- Emacs supports four general categories of operations that could all
-be called `indentation':
-
-@enumerate
-@item
-Insert a tab character. You can type @kbd{C-q @key{TAB}} to do this.
-
-A tab character is displayed as a stretch of whitespace which extends
-to the next display tab stop position, and the default width of a tab
-stop is eight. @xref{Display Custom}, for more details.
-
-@item
-Advance to the next tab stop. You can set tab stops at your choice of
-column positions, then type @kbd{M-i} to advance to the next tab stop.
-The default is to have tab stops every eight columns, which means by
-default @kbd{M-i} inserts a tab character. To set the tab stops, use
-@kbd{M-x edit-tab-stops}.
-
-@item
-Align a line with the previous line. More precisely, the command
-@kbd{M-x indent-relative} indents the current line under the beginning
-of some word in the previous line. In Fundamental mode and in Text
-mode, @key{TAB} runs the command @code{indent-relative}.
-
-@item
-The most sophisticated method is @dfn{syntax-driven indentation}.
-Most programming languages have an indentation convention. For Lisp
-code, lines are indented according to their nesting in parentheses. C
-code uses the same general idea, but many details are different.
+ Most programming languages have some indentation convention. For Lisp
+code, lines are indented according to their nesting in parentheses. The
+same general idea is used for C code, though many details are different.
@kindex TAB
-Type @key{TAB} to do syntax-driven indentation, in a mode that
-supports it. It realigns the current line according with the syntax
-of the preceding lines. No matter where in the line you are when you
-type @key{TAB}, it aligns the line as a whole.
-@end enumerate
-
- Normally, all of the above methods insert an optimal mix of tabs and
-spaces to align to the desired column. @xref{Just Spaces}, for how to
-disable use of tabs. However, @kbd{C-q @key{TAB}} always inserts a
-tab, even they are disabled for the indentation commands.
+ Whatever the language, to indent a line, use the @key{TAB} command. Each
+major mode defines this command to perform the sort of indentation
+appropriate for the particular language. In Lisp mode, @key{TAB} aligns
+the line according to its depth in parentheses. No matter where in the
+line you are when you type @key{TAB}, it aligns the line as a whole. In C
+mode, @key{TAB} implements a subtle and sophisticated indentation style that
+knows about many aspects of C syntax.
+
+ In Text mode, @key{TAB} runs the command @code{tab-to-tab-stop}, which
+indents to the next tab stop column. You can set the tab stops with
+@kbd{M-x edit-tab-stops}.
-@c In Text mode, @key{TAB} runs the command @code{tab-to-tab-stop}, which
-@c indents to the next tab stop column. You can set the tab stops with
-@c @kbd{M-x edit-tab-stops}.
+ Normally, @key{TAB} inserts an optimal mix of tabs and spaces for
+the intended indentation. @xref{Just Spaces}, for how to prevent use
+of tabs.
@menu
* Indentation Commands:: Various commands and techniques for indentation.
but there is a default value which you can change as well.
@xref{Locals}.
- A tab is not always displayed in the same way. By default, tabs are
-eight columns wide, but some people like to customize their tools to
-use a different tab width. So by using spaces only, you can make sure
-that your file looks the same regardless of the tab width setting.
-
@findex tabify
@findex untabify
There are also commands to convert tabs to spaces or vice versa, always
@section Syntax of Regular Expressions
@cindex syntax of regexps
- This manual describes regular expression features that users
-typically want to use. There are additional features that are
-mainly used in Lisp programs; see @ref{Regular Expressions,,,
-elisp, the same manual}.
-
Regular expressions have a syntax in which a few characters are
special constructs and the rest are @dfn{ordinary}. An ordinary
character is a simple regular expression which matches that same
the string @samp{fo}. Still trivial. To do something nontrivial, you
need to use one of the special characters. Here is a list of them.
-@table @asis
-@item @kbd{.}@: @r{(Period)}
+@table @kbd
+@item .@: @r{(Period)}
is a special character that matches any single character except a newline.
Using concatenation, we can make regular expressions like @samp{a.b}, which
matches any three-character string that begins with @samp{a} and ends with
@samp{b}.@refill
-@item @kbd{*}
+@item *
is not a construct by itself; it is a postfix operator that means to
match the preceding regular expression repetitively as many times as
possible. Thus, @samp{o*} matches any number of @samp{o}s (including no
The next alternative is for @samp{a*} to match only two @samp{a}s.
With this choice, the rest of the regexp matches successfully.@refill
-@item @kbd{+}
+@item +
is a postfix operator, similar to @samp{*} except that it must match
the preceding expression at least once. So, for example, @samp{ca+r}
matches the strings @samp{car} and @samp{caaaar} but not the string
@samp{cr}, whereas @samp{ca*r} matches all three strings.
-@item @kbd{?}
+@item ?
is a postfix operator, similar to @samp{*} except that it can match the
preceding expression either once or not at all. For example,
@samp{ca?r} matches @samp{car} or @samp{cr}; nothing else.
-@item @kbd{*?}, @kbd{+?}, @kbd{??}
+@item *?, +?, ??
@cindex non-greedy regexp matching
are non-greedy variants of the operators above. The normal operators
@samp{*}, @samp{+}, @samp{?} are @dfn{greedy} in that they match as
a newline, it matches the whole string. Since it @emph{can} match
starting at the first @samp{a}, it does.
-@item @kbd{\@{@var{n}\@}}
+@item \@{@var{n}\@}
is a postfix operator that specifies repetition @var{n} times---that
is, the preceding regular expression must match exactly @var{n} times
in a row. For example, @samp{x\@{4\@}} matches the string @samp{xxxx}
and nothing else.
-@item @kbd{\@{@var{n},@var{m}\@}}
+@item \@{@var{n},@var{m}\@}
is a postfix operator that specifies repetition between @var{n} and
@var{m} times---that is, the preceding regular expression must match
at least @var{n} times, but no more than @var{m} times. If @var{m} is
equivalent to @samp{?}. @* @samp{\@{0,\@}} is equivalent to
@samp{*}. @* @samp{\@{1,\@}} is equivalent to @samp{+}.
-@item @kbd{[ @dots{} ]}
+@item [ @dots{} ]
is a @dfn{character set}, which begins with @samp{[} and is terminated
by @samp{]}. In the simplest case, the characters between the two
brackets are what this set can match.
be non-letters. The behavior of a mixed-case range such as @samp{A-z}
is somewhat ill-defined, and it may change in future Emacs versions.
-@item @kbd{[^ @dots{} ]}
+@item [^ @dots{} ]
@samp{[^} begins a @dfn{complemented character set}, which matches any
character except the ones specified. Thus, @samp{[^a-z0-9A-Z]} matches
all characters @emph{except} ASCII letters and digits.
mentioned as one of the characters not to match. This is in contrast to
the handling of regexps in programs such as @code{grep}.
-@item @kbd{^}
+@item ^
is a special character that matches the empty string, but only at the
beginning of a line in the text being matched. Otherwise it fails to
match anything. Thus, @samp{^foo} matches a @samp{foo} that occurs at
the beginning of a line.
-@item @kbd{$}
+@item $
is similar to @samp{^} but matches only at the end of a line. Thus,
@samp{x+$} matches a string of one @samp{x} or more at the end of a line.
-@item @kbd{\}
+@item \
has two functions: it quotes the special characters (including
@samp{\}), and it introduces additional special constructs.
is @code{sendmail-send-it}, which delivers mail using the Sendmail
installation on the local host. To send mail through a SMTP server,
set it to @code{smtpmail-send-it} and set up the Emacs SMTP library
-(@pxref{Top,, Sending mail via SMTP,smtpmail}). A third option is
+(@pxref{Sending mail via SMTP,,,smtpmail}). A third option is
@code{feedmail-send-it}, see the commentary section of the
@file{feedmail.el} package for more information.
and sending mail---Mail mode. Emacs has alternative facilities for
editing and sending mail, including
MH-E and Message mode, not documented in this manual.
-@xref{Top,,MH-E,mh-e, The Emacs Interface to MH}. @xref{Top,,,message,
+@xref{MH-E,,,mh-e, The Emacs Interface to MH}. @xref{Message,,,message,
Message Manual}. You can choose any of them as your preferred method.
The commands @code{C-x m}, @code{C-x 4 m} and @code{C-x 5 m} use
whichever agent you have specified, as do various other Emacs commands
@quotation
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU Manual'',
-and with the Back-Cover Texts as in (a) below. A copy of the license
-is included in the section entitled ``GNU Free Documentation License''
-in the Emacs manual.
+any later version published by the Free Software Foundation; with the
+Invariant Sections being ``The GNU Manifesto'', ``Distribution'' and
+``GNU GENERAL PUBLIC LICENSE'', with the Front-Cover texts being ``A GNU
+Manual'', and with the Back-Cover Texts as in (a) below. A copy of the
+license is included in the section entitled ``GNU Free Documentation
+License'' in the Emacs manual.
(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
this GNU Manual, like GNU software. Copies published by the Free
@dircategory Emacs
@direntry
-* SMTP: (smtpmail). Emacs library for sending mail via SMTP.
+* Emacs SMTP Library: (smtpmail). Emacs library for sending mail via SMTP.
@end direntry
@titlepage
@findex center-line
The command @kbd{M-s} (@code{center-line}) centers the current line
within the current fill column. With an argument @var{n}, it centers
-@var{n} lines individually and moves past them. This binding is
-made by Text mode and is available only in that and related modes
-(@pxref{Text Mode}).
+@var{n} lines individually and moves past them.
@vindex fill-column
@kindex C-x f
@c This is *so* much nicer :)
@footnotestyle end
-@c In the Tramp CVS, the version number is auto-frobbed from
-@c configure.ac, so you should edit that file and run
-@c "autoconf && ./configure" to change the version number.
-
-@c Additionally, flags are set with respect to the Emacs flavor; and
-@c depending whether Tramp is packaged into (X)Emacs, or standalone.
-
-@include trampver.texi
+@c In the Tramp CVS, the version number is auto-frobbed from the
+@c Makefile, so you should edit the top-level Makefile to change
+@c the version number.
+@macro trampver{}
+2.0.29
+@end macro
@c Entries for @command{install-info} to use
@dircategory Emacs
@sc{tramp}
@end macro
+@c Distinguish between GNU Emacs and XEmacs. Derived from the
+@c Makefile variable $(EMACS-ID). Valid values are `emacs' and `xemacs'.
+@set emacs
+
+@c Some flags which make the text independent on the (X)Emacs flavor.
+@c GNU Emacs values.
+@ifset emacs
+@set emacs-name Emacs
+@set emacs-dir emacs
+@set ftp-package-name Ange-FTP
+@set tramp-prefix /
+@set tramp-prefix-single-hop
+@set tramp-postfix :
+@set tramp-postfix-single-hop :
+@set tramp-postfix-multi-hop :
+@end ifset
+
+@c XEmacs counterparts.
+@ifset xemacs
+@set emacs-name XEmacs
+@set emacs-dir xemacs
+@set ftp-package-name EFS
+@set tramp-prefix /[
+@set tramp-prefix-single-hop [
+@set tramp-postfix ]
+@set tramp-postfix-single-hop /
+@set tramp-postfix-multi-hop :
+@end ifset
+
@c Macros for formatting a filename.
-@c trampfn is for a full filename, trampfnmhp means method, host, localname
+@c trampfn is for a full filename, trampfnmhp means method, host, path
@c were given, and so on.
-@macro trampfn(method, user, host, localname)
-@value{tramp-prefix}@value{method}@value{user}@@@value{host}@value{tramp-postfix}@value{localname}
+@macro trampfn(method, user, host, path)
+@value{tramp-prefix}@value{method}@value{user}@@@value{host}@value{tramp-postfix}@value{path}
@end macro
@copying
Copyright @copyright{} 1999, 2000, 2001, 2002, 2003 Free Software
Foundation, Inc.
-@quotation
+@quotation
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
any later version published by the Free Software Foundation; with no
You can find the latest version of this document on the web at
@uref{http://www.freesoftware.fsf.org/tramp/}.
-@c Pointer to the other Emacs flavor is necessary only in case of
-@c standalone installation. Text taken from trampinst.texi.
-@ifset tramp-inst
-@otherflavor{}
-@end ifset
-
@ifhtml
This manual is also available as a @uref{tramp_ja.html, Japanese
translation}.
* Overview:: What @tramp{} can and cannot do.
For the end user:
-
* Obtaining @tramp{}:: How to obtain @tramp{}.
* History:: History of @tramp{}.
-@ifset tramp-inst
* Installation:: Installing @tramp{} with your @value{emacs-name}.
-@end ifset
* Configuration:: Configuring @tramp{} for use.
* Usage:: An overview of the operation of @tramp{}.
* Bug Reports:: Reporting Bugs and Problems.
* Frequently Asked Questions:: Questions and answers from the mailing list.
For the developer:
-
* Version Control:: The inner workings of remote version control.
-* Files directories and localnames:: How file names, directories and localnames are mangled and managed.
+* Files directories and paths:: How file names, directories and paths are mangled and managed.
* Issues:: Debatable Issues and What Was Decided.
@detailmenu
--- The Detailed Node Listing ---
-@c
-@ifset tramp-inst
-Installing @tramp{} with your @value{emacs-name}
-
-* Installation parameters:: Parameters in order to control installation.
-* Load paths:: How to plug-in @tramp{} into your environment.
-
-@end ifset
Configuring @tramp{} for use
* Remote Programs:: How @tramp{} finds and uses programs on the remote machine.
* Remote shell setup:: Remote shell setup hints.
* Windows setup hints:: Issues with Cygwin ssh.
-* Auto-save and Backup:: Auto-save and Backup.
Using @tramp
* Remote File Ownership:: How VC determines who owns a workfile.
* Back-end Versions:: How VC determines what release your RCS is.
-How file names, directories and localnames are mangled and managed
+How file names, directories and paths are mangled and managed.
-* Localname deconstruction:: Breaking a localname into its components.
+* Path deconstruction:: Breaking a path into its components.
@end detailmenu
@end menu
@chapter Obtaining @tramp{}.
@cindex obtaining Tramp
-@tramp{} is freely available on the Internet and the latest release
-may be downloaded from
-@uref{http://savannah.nongnu.org/download/tramp/}. This
-release includes the full documentation and code for @tramp{},
-suitable for installation. But Emacs (21.4 or later) includes
-@tramp{} already, and there is a @tramp{} package for XEmacs, as well.
-So maybe it is easier to just use those. But if you want the bleeding
+@tramp{} is freely available on the Internet and the latest release may be
+downloaded from
+@uref{ftp://ls6-ftp.cs.uni-dortmund.de/pub/src/emacs/tramp.tar.gz}. This
+release includes the full documentation and code for @tramp{}, suitable
+for installation. But Emacs (21.4 or later) includes @tramp{}
+already, and there is a @tramp{} package for XEmacs, as well. So
+maybe it is easier to just use those. But if you want the bleeding
edge, read on@dots{...}
-For the especially brave, @tramp{} is available from CVS. The CVS
-version is the latest version of the code and may contain incomplete
-features or new issues. Use these versions at your own risk.
+For the especially brave, @tramp{} is available from CVS. The CVS version
+is the latest version of the code and may contain incomplete features or
+new issues. Use these versions at your own risk.
Instructions for obtaining the latest development version of @tramp{}
from CVS can be found by going to the Savannah project page at the
-following URL and then clicking on the CVS link in the navigation bar
-at the top.
+following URL and then clicking on the CVS link in the navigation bar at
+the top.
@noindent
@uref{http://savannah.gnu.org/projects/tramp/}
@end example
@noindent
-You should now have a directory @file{~/@value{emacs-dir}/tramp}
-containing the latest version of @tramp{}. You can fetch the latest
-updates from the repository by issuing the command:
+You should now have a directory @file{~/@value{emacs-dir}/tramp} containing the latest
+version of @tramp{}. You can fetch the latest updates from the repository
+by issuing the command:
@example
] @strong{cd ~/@value{emacs-dir}/tramp}
] @strong{cvs update -d}
@end example
-@noindent
-Once you've got updated files from the CVS repository, you need to run
-@command{autoconf} in order to get an up-to-date @file{configure}
-script:
-
-@example
-] @strong{cd ~/@value{emacs-dir}/tramp}
-] @strong{autoconf}
-@end example
-
@node History
@chapter History of @tramp{}
added in April 2000 and the unification of @tramp{} and Ange-FTP
filenames in July 2002.
-@c Installation chapter is necessary only in case of standalone
-@c installation. Text taken from trampinst.texi.
-@ifset tramp-inst
-@installationchapter{}
+
+@node Installation
+@chapter Installing @tramp{} into @value{emacs-name}.
+@cindex installation
+
+If you use the version that comes with your @value{emacs-name}, the
+following information is not necessary. Installing @tramp{} into your
+@value{emacs-name} is a relatively easy process, at least compared
+to rebuilding your machine from scratch. ;)
+
+Seriously though, the installation should be a fairly simple matter.
+
+The easiest way to proceed is as follows:
+
+@itemize @bullet
+@item
+Choose a directory, say @file{~/@value{emacs-dir}/}. Change into that directory and
+unpack the tarball. This will give you a directory
+@file{~/@value{emacs-dir}/tramp/} which contains subdirectories @file{lisp} for the
+Lisp code and @file{texi} for the documentation.
+
+@item
+Optionally byte-compile all files in the Lisp directory,
+@file{~/@value{emacs-dir}/tramp/lisp/}, by issuing a command like the following from
+the top level directory @file{~/@value{emacs-dir}/tramp/}:
+
+@example
+make EMACS=@value{emacs-dir} all
+@end example
+
+@item
+NOTE: If you run into problems running the example @command{make}
+command, don't despair. You can still byte compile the @file{*.el}
+files by opening @value{emacs-name} in @command{dired} (@command{C-x
+d}) mode, at @file{~/@value{emacs-dir}/tramp/lisp}. Mark the lisp files with
+@kbd{m}, then press @kbd{B} to byte compile your selections.
+
+Something similar can be done to create the info manual. Just change
+to directory @file{~/@value{emacs-dir}/tramp/texi} and load the
+@file{tramp.texi} file in @value{emacs-name}. Then press @kbd{M-x
+texinfo-format-buffer @key{RET}} to generate @file{tramp.info}.
+
+@item
+Tell @value{emacs-name} about the new Lisp directory and the
+@tramp{} package with the following lines in @file{~/.emacs}:
+
+@lisp
+(add-to-list 'load-path "~/@value{emacs-dir}/tramp/lisp/")
+(require 'tramp)
+@end lisp
+
+@item
+To be able to read the Info documentation, create a file
+@file{~/@value{emacs-dir}/tramp/texi/dir} using the
+@command{install-info} command, and add the directory to the search
+path for Info.
+
+NOTE:
+On systems using the @cite{gnu} version of @command{install-info}, the
+@command{install-info} syntax is very direct and simple. One can
+change to directory @file{~/@value{emacs-dir}/tramp/texi} and type:
+
+@example
+install-info tramp.info dir
+@end example
+
+and a @file{dir} file will be created with the @tramp{}
+entry. The info reader will know how to interpret it, but must
+be told where to find it (see below). If you want anything fancier
+you'll need to look through @kbd{man install-info}.
+
+Debian gnu/linux doesn't default to @cite{gnu} @command{install-info}
+and uses its own version. This version does not create a @file{dir}
+file for you from scratch. You must provide a skeleton @file{dir}
+file it recognizes. One can be found in a default installation of
+@value{emacs-name} at @file{/usr/info/dir}. Copy the top of this file
+down to the first occurrence of @code{* Menu} including that line plus
+one more blank line, to your working directory
+@file{~/@value{emacs-dir}/tramp/texi}, or use the sample
+@file{~/@value{emacs-dir}/tramp/texi/dir_sample}.
+
+Once a @file{dir} file is in place, this command will make the entry:
+
+@example
+install-info --infodir=. tramp.info
+@end example
+
+If you want it in a specific category see @kbd{man install-info} for
+further details.
+
+If the environment variable @env{INFOPATH} is set, add the directory
+@file{~/@value{emacs-dir}/tramp/texi/} to it. Else, add the directory to
+@ifset emacs
+@code{Info-default-directory-list}, as follows:
+
+@lisp
+(add-to-list 'Info-default-directory-list "~/@value{emacs-dir}/tramp/texi/")
+@end lisp
+@end ifset
+@ifset xemacs
+@code{Info-directory-list}, as follows:
+@lisp
+(add-to-list 'Info-directory-list "~/@value{emacs-dir}/tramp/texi/")
+@end lisp
+@end ifset
+
+@end itemize
+
+@ifset xemacs
+For @value{emacs-name}, the package @file{fsf-compat} must be installed.
+For details on package installation, see @ref{Packages, , ,xemacs}.
+@ifhtml
+(If the previous link doesn't work, try the @value{emacs-name}
+documentation at
+@uref{http://www.xemacs.org/Documentation/packageGuide.html,the
+@value{emacs-name} site}.)
+@end ifhtml
@end ifset
@node Configuration
* Remote Programs:: How @tramp{} finds and uses programs on the remote machine.
* Remote shell setup:: Remote shell setup hints.
* Windows setup hints:: Issues with Cygwin ssh.
-* Auto-save and Backup:: Auto-save and Backup.
@end menu
far, it is tested towards MS Windows NT, MS Windows 2000, and MS
Windows XP.
-The first directory in the localname must be a share name on the remote
+The first directory in the path must be a share name on the remote
host. Remember, that the @code{$} character in which default shares
usually end, must be written @code{$$} due to environment variable
substitution in file names. If no share name is given (i.e. remote
@cindex method multi
@cindex multi method
-A multi-hop file name specifies a method, a number of hops, and a
-localname (path name on the remote system). The method name is always
+A multi-hop file name specifies a method, a number of hops, and a path
+name on the remote system. The method name is always
@option{multi}.
Each hop consists of a @dfn{hop method} specification, a user name and
When you select an appropriate transfer method for your typical usage
you should set the variable @var{tramp-default-method} to reflect that
choice. This variable controls which method will be used when a method
-is not specified in the @tramp{} file name. For example:
+is not specified in the @tramp{} file path. For example:
@lisp
(setq tramp-default-method "scp")
@defun tramp-set-completion-function method function-list
This function sets @var{function-list} as list of completion functions
-for @var{method}.
+for @var{method}.
Example:
@example
@end table
-@node Auto-save and Backup
-@section Auto-save and Backup configuration
-@cindex auto-save
-@cindex backup
-@vindex backup-directory-alist
-
-Explaining auto-save is still to do.
-
-Normally, Emacs writes backup files to the same directory as the
-original files, but this behavior can be changed via the variable
-@code{backup-directory-alist}. In connection with @tramp{}, this can
-have unexpected side effects. Suppose that you specify that all backups
-should go to the directory @file{~/.emacs.d/backups/}, and then you edit
-the file @file{/su:root@@localhost:/etc/secretfile}. The effect is that
-the backup file will be owned by you and not by root, thus possibly
-enabling others to see it even if they were not intended to see it.
-
-When @code{backup-directory-alist} is nil (the default), such problems
-do not occur.
-
-If you wish to customize the variable, the workaround is to include
-special settings for Tramp files. For example, the following statement
-effectively `turns off' the effect of @code{backup-directory-alist} for
-@tramp{} files:
-
-@lisp
-(require 'tramp)
-(add-to-list 'backup-directory-alist
- (cons tramp-file-name-regexp nil))
-@end lisp
-
-
@node Windows setup hints
@section Issues with Cygwin ssh
@cindex Cygwin, issues
@cindex filename syntax
@cindex filename examples
-To access the file @var{localname} on the remote machine @var{machine} you
+To access the file @var{path} on the remote machine @var{machine} you
would specify the filename
-@file{@value{tramp-prefix}@var{machine}@value{tramp-postfix}@var{localname}}.
+@file{@value{tramp-prefix}@var{machine}@value{tramp-postfix}@var{path}}.
This will connect to @var{machine} and transfer the file using the
default method. @xref{Default Method}.
@tramp{} is available under the URL below.
@noindent
-@uref{http://savannah.nongnu.org/download/tramp/}
+@uref{ftp://ls6-ftp.cs.uni-dortmund.de/pub/src/emacs/tramp.tar.gz}
@noindent
There is also a Savannah project page.
fi
@end example
-
-@item @tramp{} doesn't transfer strings with more than 500 characters
-correctly
-
-On some few systems, the implementation of @code{process-send-string}
-seems to be broken for longer strings. This case, you should
-customize the variable @code{tramp-chunksize} to 500. For a
-description how to determine whether this is necessary see the
-documentation of @code{tramp-chunksize}.
-
@end itemize
In the case of a remote file, the @code{shell-command} interface is
used, with some wrapper code, to provide the same functionality on the
-remote machine as would be seen on the local machine.
+remote machine as would be seen on the local machine.
@node Changed workfiles
system basis and the results cached to improve performance.
-@node Files directories and localnames
-@chapter How file names, directories and localnames are mangled and managed.
+@node Files directories and paths
+@chapter How file names, directories and paths are mangled and managed.
@menu
-* Localname deconstruction:: Breaking a localname into its components.
+* Path deconstruction:: Breaking a path into its components.
@end menu
-@node Localname deconstruction
-@section Breaking a localname into its components.
+@node Path deconstruction
+@section Breaking a path into its components.
-@tramp{} file names are somewhat different, obviously, to ordinary file
+@tramp{} filenames are somewhat different, obviously, to ordinary path
names. As such, the lisp functions @code{file-name-directory} and
-@code{file-name-nondirectory} are overridden within the @tramp{}
-package.
+@code{file-name-nondirectory} are overridden within the @tramp{} package.
Their replacements are reasonably simplistic in their approach. They
-dissect the filename, call the original handler on the localname and
-then rebuild the @tramp{} file name with the result.
+dissect the filename, call the original handler on the remote path and
+then rebuild the @tramp{} path with the result.
This allows the platform specific hacks in the original handlers to take
-effect while preserving the @tramp{} file name information.
+effect while preserving the @tramp{} path information.
@node Issues
+++ /dev/null
-@c -*-texinfo-*-
-@c texi/trampver.texi. Generated from trampver.texi.in by configure.
-
-@c In the Tramp CVS, the version number is auto-frobbed from
-@c configure.ac, so you should edit that file and run
-@c "autoconf && ./configure" to change the version number.
-@macro trampver{}
-2.0.34
-@end macro
-
-@c Other flags from configuration
-@set prefix /usr/local
-@set lispdir /usr/local/share/emacs/site-lisp
-@set infodir /usr/local/info
-
-@c Some flags which make the text independent on the (X)Emacs flavor.
-@c "emacs" resp "xemacs" are set in the Makefile. Default is "emacs".
-
-@ifclear emacs
-@ifclear xemacs
-@set emacs
-@end ifclear
-@end ifclear
-
-@c Emacs values.
-@ifset emacs
-@set emacs-name Emacs
-@set emacs-dir emacs
-@set ftp-package-name Ange-FTP
-@set tramp-prefix /
-@set tramp-prefix-single-hop
-@set tramp-postfix :
-@set tramp-postfix-single-hop :
-@set tramp-postfix-multi-hop :
-@end ifset
-
-@c XEmacs counterparts.
-@ifset xemacs
-@set emacs-name XEmacs
-@set emacs-dir xemacs
-@set ftp-package-name EFS
-@set tramp-prefix /[
-@set tramp-prefix-single-hop [
-@set tramp-postfix ]
-@set tramp-postfix-single-hop /
-@set tramp-postfix-multi-hop :
-@end ifset
-
-@c Empty macro definitions in order to satisfy texi2dvi
-@macro otherflavor
-@end macro
-
-@macro installationchapter
-@end macro
-
-@c The installation chapter is needed only in case Tramp is installed
-@c standalone. That's why it is included from `trampinst.texi'.
-@c Otherwise, '/dev/null/' is tken, which leaves this part empty.
-
-
Viper uses Emacs Regular Expressions for searches. These are a superset of
Vi regular
expressions, excepting the change-of-case escapes @samp{\u}, @samp{\L},
-@dots{}, etc. @xref{Regexps,,Syntax of Regular Expressions,emacs,The
+@dots{}, etc. @xref{Regular Expressions,,Regular Expressions,emacs,The
GNU Emacs Manual}, for details.
Files specified to @kbd{:e} use @code{csh} regular expressions
(globbing, wildcards, what have you).
Additional space (@dfn{leading}) between lines, in pixels.
@item @code{menuBar} (class @code{MenuBar})
-@cindex menu bar
Give frames menu bars if @samp{on}; don't have menu bars if
@samp{off}. @xref{Lucid Resources}, and @ref{LessTif Resources}, for
how to control the appearance of the menu bar if you have one.
Name to display in the title bar of the initial Emacs frame.
@item @code{toolBar} (class @code{ToolBar})
-@cindex tool bar
Number of lines to reserve for the tool bar. A zero value suppresses
the tool bar. If the value is non-zero and
@code{auto-resize-tool-bars} is non-@code{nil}, the tool bar's size
will be changed automatically so that all tool bar items are visible.
-@item @code{useXIM} (class @code{UseXIM})
-@cindex XIM
-@cindex X input methods
-@cindex input methods, X
-Turn off use of X input methods (XIM) if @samp{false} or @samp{off}.
-This is only relevant if your Emacs is actually built with XIM
-support. It is potentially useful to turn off XIM for efficiency,
-especially slow X client/server links.
-
@item @code{verticalScrollBars} (class @code{ScrollBars})
Give frames scroll bars if @samp{on}; don't have scroll bars if
@samp{off}.
+++ /dev/null
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-\f
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-\f
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-\f
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-\f
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-\f
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) year name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Library General
-Public License instead of this License.
+++ /dev/null
-2002-04-16 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2v2.inp: New file.
-
- * sed2.inp: Remove DJGPP v2.x stuff.
-
-2002-03-27 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sedlisp.inp <bootstrap-clean>: Make sure all *.el files have
- Unix EOLs, to avoid overflowing pure storage while bootstrapping.
-
-2002-03-20 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (bootstrap-lisp-1, bootstrap-lisp, bootstrap-src)
- (bootstrap-clean-before, bootstrap-clean-after): Return to the
- top-level directory after sub-make.
- (bootstrap-lisp): Pass an absolute file name as value of ${lisp}.
-
- * sed1v2.inp: Fix editing of the rule for ${libsrc}make-docfile.
-
-2002-03-09 Eli Zaretskii <eliz@is.elta.co.il>
-
- Add support for bootstraping Emacs:
-
- * sed1v2.inp: Edit the bootstrap-* targets. Fix the mostlyclean
- target.
-
- * mainmake.v2 (maybe_bootstrap, bootstrap, bootstrap-lisp-1)
- (bootstrap-lisp, bootstrap-src, bootstrap-clean-before)
- (bootstrap-clean-after): New targets.
- (all): Depend on maybe_bootstrap.
-
-2001-12-21 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed1v2.inp: Delete _gdbinit in distclean target.
-
-2001-12-09 Pavel Jan
\e,Bm
\e(Bk <Pavel@Janik.cz>
-
- * COPYING: Moved back.
-
-2001-12-07 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp (HAVE_VFORK): Don't define: the fragment in sysdep.c
- which needed it is gone.
-
-2001-11-29 Pavel Jan
\e,Bm
\e(Bk <Pavel@Janik.cz>
-
- * COPYING: Removed.
-
-2001-11-24 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (lispintro): New target.
- (all): Add lispintro.
-
- * sed6.inp (SHELL): Comment away, for lispintro.
-
-2001-11-10 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed6.inp (texinputdir): Add, for the lispref directory.
-
- * mainmake.v2 (all): Add lispref.
- (man lispref): Add lispref.
-
-2001-10-20 Gerd Moellmann <gerd@gnu.org>
-
- * (Version 21.1 released.)
-
-2001-10-05 Gerd Moellmann <gerd@gnu.org>
-
- * Branch for 21.1.
-
-2001-07-20 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (install): Create site-lisp/subdirs.el if it is not
- already there.
-
-2001-07-06 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp: Ifdef away the test for !HAVE_MKTIME, to avoid parse
- error in "gcc -E -traditional" with GCC 3.0.
-
-2001-04-02 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sedleim.inp (srcdir=): Edit @srcdir@ into an absolute file name
- of the leim subdirectory, so that EMACSLOADPATH doesn't break when
- titdic-convert chdirs into leim/quail.
-
-2001-03-30 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sedleim.inp: Adapt to changes in leim/Makefile.in's $(TIT)
- target.
-
-2001-03-01 Eli Zaretskii <eliz@is.elta.co.il>
-
- * README: New file.
-
- * sed1.inp: Add copyright.
- * sed1v2.inp: Add copyright.
- * sed2.inp: Add copyright.
- * sed2x.inp: Add copyright.
- * sed3.inp: Add copyright.
- * sed3v2.inp: Add copyright.
- * sed4.inp: Add copyright.
- * sed5x.inp: Add copyright.
- * sed6.inp: Add copyright.
- * sedleim.inp: Add copyright.
- * sedlisp.inp: Add copyright.
-
-2001-02-20 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2, mainmake: Add copyright.
-
-2000-11-22 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp (NSIG) [__DJGPP__ == 2 && __DJGPP_MINOR__ == 1]:
- Define; it is undefined in DJGPP v2.01.
-
-2000-11-13 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp (HAVE_MKSTEMP): Define.
-
-2000-10-07 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sedleim.inp (RUN-EMACS): Remove EMACSLOADPATH setting as part of
- the command; use Make's "export EMACSLOADPATH=" instead. Remove
- the handling of `command` expansion, leim/Makefile.in doesn't use
- that anymore.
-
-2000-08-29 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp (HAVE_INDEX, HAVE_RINDEX): Define.
-
-2000-08-22 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (TAGS): Don't use [a-zA-Z]*, as it causes wildcard
- expansion to become case-sensitive and return all file names in
- upper case on plain DOS.
-
-2000-08-05 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (src): Put gdb.tmp after -a, since djecho's -a
- switch requires an argument.
-
-2000-07-31 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (src): Make the rule faster by using a single djecho
- command instead of multiple redir invocations.
- (install): Speed up by using a command.com's for loop.
-
-2000-07-23 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed3v2.inp: Define ALLOCA to an empty string.
-
-2000-07-18 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed1v2.inp: Put getloadavg.o into LIBOBJS, not GETLOADAVG_LIBS.
-
-2000-07-09 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed1v2.inp: Set LIBSOUND to an empty string.
-
-2000-06-26 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp: Define HAVE_STRUCT_TIMEZONE in src/config.h.
-
-2000-06-25 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed1v2.inp: Set GETLOADAVG_LIBS to getloadavg.o in src/Makefile.
-
-2000-06-18 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sedlisp.inp (srcdir): Edit this variable.
-
-2000-06-15 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sedlisp.inp: New file.
-
-2000-05-18 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed6.inp: Changes to allow "make foo.dvi" on DJGPP platforms:
- (ENVADD): Redefine as empty, to avoid requiring a Unixy shell.
- (TEXINPUTS): Use semi-colon; export explicitly.
- (MAKEINFO): Export explicitly.
-
-2000-05-01 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (install): Install ebrowse.exe.
-
-2000-04-14 Dave Love <fx@gnu.org>
-
- * sed1v2.inp, sed1.inp: Add LIBS, LIBOBJS.
-
-2000-03-13 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp: Add PROTOTYPES and POINTER_TYPE, per the new
- config.in.
-
-2000-01-27 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp (HAVE_SETITIMER): Define.
-
-1999-11-18 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp (HAVE_TM_GMTOFF, HAVE_MBLEN): Define.
-
- * sed1v2.inp: Convert "LC_ALL=C ./temacs" to MS-DOS equivalent.
-
-1999-07-29 Eli Zaretskii <eliz@gnu.org>
-
- * sedleim.inp (SHELL, MAKESHELL): Use /xyzzy/command as the shell.
-
-1999-07-12 Richard Stallman <rms@gnu.org>
-
- * Version 20.4 released.
-
-1999-07-01 Eli Zaretskii <eliz@gnu.org>
-
- * mainmake.v2 (SHELL, MAKESHELL): Don't use /dos/command, it can
- invoke an incompatible version of COMAMND.COM.
-
-1999-05-19 Eli Zaretskii <eliz@gnu.org>
-
- * sed1v2.inp: Use -gcoff instead of -g in CFLAGS, for those who
- have GCC configured by default to use stabs, which unexec.c
- doesn't currently support.
-
-1999-01-14 Eli Zaretskii <eliz@gnu.org>
-
- * mainmake.v2 (install): Use update instead of sed to install fns.el.
-
-1999-01-11 Eli Zaretskii <eliz@gnu.org>
-
- * mainmake.v2 (install): Install fns.el in ../bin, since Emacs
- looks for it in exec-directory.
-
-1999-01-07 Eli Zaretskii <eliz@gnu.org>
-
- * sedleim.inp: New file, for configuring the leim directory.
-
- * mainmake.v2 (src): Build files in leim if leim/Makefile exists.
- (clean): Add clean in leim.
-
-1998-11-08 Eli Zaretskii <eliz@mescaline.gnu.org>
-
- * mainmake.v2 (SHELL, MAKESHELL): Don't use `override'.
-
-1998-10-20 Eli Zaretskii <eliz@mescaline.gnu.org>
-
- * mainmake.v2: Forcibly set SHELL and MAKESHELL to force Make to
- use COMMAND.COM as the shell.
-
-1998-08-19 Richard Stallman <rms@psilocin.ai.mit.edu>
-
- * Version 20.3 released.
-
-1998-05-04 Eli Zaretskii <eliz@mescaline.gnu.org>
-
- * mainmake.v2 (TAGS tags): Fix file name wildcards in lisp
- directory.
-
-1998-04-13 Eli Zaretskii <eliz@delysid.gnu.org>
-
- * mainmake.v2 (src): Replace topdir with top_srcdir in commands
- which generate gdb.ini.
-
-1998-04-12 Eli Zaretskii <eliz@delysid.gnu.org>
-
- * mainmake.v2 (version): Determine emacs-version from
- lisp/version.el. Pass it to sub-Make's.
-
-1998-04-05 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed3v2.inp: When installing ${version},
- do it replacing @version@.
-
- * mainmake.v2 (version): Compute the version from lisp/version.el
- and pass to sub-Make's. Pass top_srcdir to sub-Make's.
-
-1997-11-20 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed6.inp: New file, configures the man directory for MSDOS.
-
- * mainmake.v2 (man): New target to build the manual.
- (all): Add the man dependency.
- (install): Change bin\\nul to bin\nul.
-
-1997-09-19 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * Version 20.2 released.
-
-1997-09-15 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * Version 20.1 released.
-
-1997-09-07 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed1v2.inp: Enlarge the stack size of temacs to 100KB.
-
-1997-08-13 Eli Zaretskii <eliz@psilocin.gnu.ai.mit.edu>
-
- * sed2.inp: (EMACS_CONFIGURATION): Set to i386-pc-msdosdjgpp.
-
-1997-08-10 +03 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed1v2.inp (CPPFLAGS, LDFLAGS): Edit to empty.
-
-1997-07-10 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp (HAVE_LOGB, HAVE_FREXP, HAVE_FMOD, HAVE_RINT)
- (HAVE_CBRT, HAVE_FPATHCONF, HAVE_SETRLIMIT): Defined.
-
- * sed1.inp, sed1v2.inp: Remove `stamp-oldxmenu' dependency, so
- MSDOS users won't need `touch' installed.
-
- * mainmake.v2 (TAGS, tags): Include new lisp subdirectories.
-
-1996-08-11 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * Version 19.33 released.
-
-1996-08-04 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * is_exec.c: Renamed from is-exec.c.
-
-1996-07-27 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * Version 19.32 released.
-
- * is-exec.c, sigaction.c: New files.
-
-1996-07-24 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (TAGS): Make sure bin/etags.exe is current. Make
- the rules always generate TAGS.
-
-1996-06-09 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp: Don't undef MULTI_FRAME.
-
-1996-05-25 Karl Heuer <kwzh@gnu.ai.mit.edu>
-
- * Version 19.31 released.
-
-1996-04-17 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed1.inp: Replace `make-docfile' with `make-doc.exe'. In case
- src/Makefile needs to rebuild `make-doc.exe', use one command per line.
- Undo the previous change.
-
-1996-04-15 Richard Stallman <rms@mole.gnu.ai.mit.edu>
-
- * sed1.inp: Change make-docfile to make-doc.exe in a second place.
-
-1996-04-15 Eli Zaretskii <eliz@is.elta.co.il>
-
- * mainmake.v2 (src): Create a file with sed commands instead of using
- a long sed command line (some versions of Sed don't handle that).
- (gdb): Merged back into src, undoing April 13 change.
- (install): Do use if statements, but not a loop.
-
-1996-04-13 Richard Stallman <rms@mole.gnu.ai.mit.edu>
-
- * mainmake.v2 (gdb): New target, broken out of src.
- (install): Use simple explicit copy commands, not a loop.
-
-1996-04-10 Eli Zaretskii <eliz@is.elta.co.il>
-
- * sed2.inp: Under DJGPP v2, use <sys/config.h> instead of most of
- config.h.in.
-
- * sed1v2.inp, sed3v2.inp, mainmake.v2: New files.
-
-1996-01-23 Karl Heuer <kwzh@gnu.ai.mit.edu>
-
- * sed2.inp (LOCALTIME_CACHE, HAVE_TZSET): Define these.
-
-1995-11-24 Richard Stallman <rms@mole.gnu.ai.mit.edu>
-
- * Version 19.30 released.
-
-1995-11-21 Richard Stallman <rms@mole.gnu.ai.mit.edu>
-
- * sed3.inp: Alter test-distrib to test-dis.
-
-1995-11-03 Karl Heuer <kwzh@gnu.ai.mit.edu>
-
- * mainmake (install): Don't mv make-doc.exe into ../bin/.
-
-1995-10-11 Kim Storm <kfstorm@wombat.gnu.ai.mit.edu>
-
- * sed1.inp: Call make-doc.exe instead of make-docfile.
-
-1995-06-08 Karl Heuer <kwzh@nutrimat.gnu.ai.mit.edu>
-
- * sed2.inp: Define STDC_HEADERS.
- Undefine MULTI_FRAME, until somebody fixes msdos.h and msdos.c.
-
-1995-01-20 Karl Heuer <kwzh@hal.gnu.ai.mit.edu>
-
- * sed3.inp: Fix sed append command to behave as intended.
-
-1995-01-20 Morten Welinder <terra@diku.dk>
-
- * sed3.inp: Delete mysterious dot. Add comment to protect blank
- line at end of file. Make sure make-docfile is compiled.
-
-1995-01-10 Karl Heuer <kwzh@hal.gnu.ai.mit.edu>
-
- * sed3.inp: Use coff2exe on make-docfile.
- * sed1.inp: Not go32, which has problems with long arg lists.
-
-1994-10-17 Morten Welinder <terra@mole.gnu.ai.mit.edu>
-
- * sed1.inp: Handle "\t#"-style comments.
- (obj): Don't add any files -- now done in src/makefile.in.in
- (temacs): Don't depend on prefix-args.
- (DOC): Reflect makefile changes regarding two-batch run.
-
- * sed2.inp: Add comments showing how to use the system malloc.
- (EMACS_CONFIG_OPTIONS): Set though not useful.
- (HAVE_MKTIME): Define.
-
- * mainmake (clean): Add target.
-
- * sed1x.inp, sed2x.inp, sed5x.inp: New files for X configuration.
-
-
-1994-07-14 Morten Welinder (terra@diku.dk)
-
- * sed2.inp (HAVE_STRERROR): Define.
-
-1994-07-08 Morten Welinder (terra@diku.dk)
-
- * sed1.inp, sed2.inp: Use "m/intel386" instead of "m/dos386.h".
-
-1994-06-01 Morten Welinder (terra@diku.dk)
-
- * sed4.inp: New file for configuring src/paths.h.
-
-1994-05-30 Richard Stallman (rms@mole.gnu.ai.mit.edu)
-
- * Version 19.25 released.
-
-1994-05-22 Morten Welinder (terra@diku.dk)
-
- * sed1.inp: Adding dos-fns.elc to the set of lisp files was moved
- to src/makefile.in.in.
-
-1994-05-20 Morten Welinder (terra@tyr.diku.dk)
-
- * sed2.inp: Reflect change from CONFIGURATION to EMACS_CONFIGURATION.
- Also set it to correct three-part value.
-
-1994-05-16 Morten Welinder (terra@tyr.diku.dk)
-
- * Version 19.23 released.
-
- * sed1.inp: Don't use `+' in regexps as different stream
- editors interpret them differently. Use `*' instead.
-
-1994-05-12 Morten Welinder (terra@diku.dk)
-
- * mainmake (install): Set the minimum stack (for running under
- DPMI) to 512K. Avoid using wildcard for matching one file.
-
-1994-05-08 Morten Welinder (terra@diku.dk)
-
- * sed3.inp: Don't pass version to [ce]tags.
-
-1994-04-30 Morten Welinder (terra@diku.dk)
-
- * sed1.inp: don't comment out the inc-vers run as that
- does not exist anymore.
- Don't reset DEBUG_MOLE as that no longer is used.
- Identify the file being patched as src/...
- * sed2.inp: Identify the file being patched as src/...
- * sed3.inp: We don't have to have the version number in here
- anymore. Instead we patch the way it is passed from make to
- the C compiler.
-
-1994-04-29 Morten Welinder (terra@diku.dk)
-
- * sed1.inp: Set CFLAGS=-O2, not -g. Handle the new
- M_FILE, S_FILE, and SET_MAKE defines. Get rid of ^Ms.
-
- * sed2.inp: We have bcmp. Configuration is "msdos".
- Get rid of ^Ms.
-
- * sed3.inp: Set CFLAGS=-O2, not -g. Correct for
- new configuration regarding utilities not to compile.
- Fix version number. Get rid of ^Ms.
-
-1994-01-08 Morten Welinder (terra@diku.dk)
-
- * sed3.inp: improve make-compatibility by not using drive
- specifications and by not specifying an explicit shell.
-
-1994-01-07 Morten Welinder (terra@diku.dk)
-
- * sed1.inp: Incorporate the actions of patch1.
- * patch1: File deleted.
-
-1993-01-05 Morten Welinder (terra@diku.dk)
-
- * mainmake: New file, makefile for the main directory.
-
- * patch1: New file. Context diff to turn src/makefile.in into
- a msdos version called makefile.
-
- * emacs.pif: New file, program information file for Emacs under
- Windows. (This file contains non-printable characters.)
-
- * emacs.ico: New file, icon for Emacs under Windows. It's so ugly
- that someone is bound to create a better. Mail uuencoded icons
- to terra@diku.dk, but be prepared to sign a copyright disclaimer.
- (This file contains non-printable characters.)
-
- * sed3.inp: New file for changing lib-src/makefile.in into
- lib-src/makefile.
-
- * sed2.inp: New file for changing src/config.h-in into src/config.h
-
- * sed1.inp: New file for changing src/makefile.in.in into src/makefile
-
-;; Local Variables:
-;; coding: iso-2022-7bit-unix
-;; End:
-
- Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2001
- Free Software Foundation, Inc.
- Copying and distribution of this file, with or without modification,
- are permitted provided the copyright notice and this notice are preserved.
+++ /dev/null
-This directory contains scripts for building the DJGPP (a.k.a. MS-DOS)
-version of Emacs, and other files useful for running that version of
-Emacs.
-
-The files emacs.ico and emacs.pif are for using the DJGPP version on
-Windows 3.X. Since these are binary files, their copyright notice is
-reproduced here:
-
-# Copyright (C) 1993
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-
+++ /dev/null
-/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
-/* IS_EXEC.C
- *
- * Given a filename or a file handle, and the extension of the file,
- * determine if the file is executable.
- * First, the file extension is checked in case it uniquely identifies
- * the file as either an executable or not. Failing this, the first
- * two bytes of the file are tested for known signatures of executable
- * files.
- *
- * Copyright (c) 1994 Eli Zaretskii <eliz@is.elta.co.il>
- *
- * This software may be used freely so long as this copyright notice is
- * left intact. There is no warranty on this software.
- *
- */
-
-#include <libc/stubs.h>
-#include <stdio.h>
-#include <string.h>
-#include <ctype.h>
-#include <errno.h>
-#include <dpmi.h>
-#include <go32.h>
-#include <io.h>
-#include <libc/farptrgs.h>
-#include <libc/dosio.h>
-
-extern unsigned short _djstat_flags;
-unsigned short _get_magic(const char *, int);
-int _is_executable(const char *, int, const char *);
-
-/*
- * Read a MAGIC NUMBER from a given file. These are the first
- * two bytes of the file, if we look at them as an unsigned short. */
-
-#define _STAT_EXEC_EXT 2 /* get execute bits from file extension? */
-#define _STAT_EXEC_MAGIC 4 /* get execute bits from magic signature? */
-
-unsigned short
-_get_magic(const char *s, int fh)
-{
- __dpmi_regs regs;
- unsigned short retval;
- unsigned short fpos_high = 0, fpos_low = 0;
- int read_fail = 0;
-
- /* If given a pathname, open the file. */
- if (s)
- {
- int handle;
- if((handle = _open(s,0)) == -1)
- return 0;
- regs.x.bx = handle;
- }
- /* Else file already open. Remember its current file position
- and move to beginning of file. */
- else
- {
- regs.x.ax = 0x4201; /* set pointer from current position */
- regs.x.bx = fh;
- regs.x.cx = regs.x.dx = 0; /* move 0 bytes (i.e., stay put) */
- __dpmi_int(0x21, ®s);
- if (regs.x.flags & 1)
- {
- errno = __doserr_to_errno(regs.x.ax);
- return 0;
- }
- fpos_high = regs.x.dx; /* got current position */
- fpos_low = regs.x.ax;
-
- regs.x.ax = 0x4200; /* set pointer from the beginning of file */
- regs.x.cx = regs.x.dx = 0; /* move to beginning of file */
- __dpmi_int(0x21, ®s);
- if (regs.x.flags & 1)
- {
- errno = __doserr_to_errno(regs.x.ax);
- return 0;
- }
- }
- regs.x.ds = __tb_segment;
- regs.x.dx = __tb_offset;
-
- /* Read 2 bytes from the file. */
- regs.x.ax = 0x3f00;
- regs.x.cx = 2;
- __dpmi_int(0x21, ®s);
-
- /* We can either (1) succeed, (2) read less than 2 bytes,
- or (3) fail to read at all. */
- if (regs.x.ax != 2)
- read_fail = (regs.x.flags & 1) ? regs.x.ax : -1;
-
- /* If called with filename, close the file. */
- if (s)
- {
- regs.x.ax = 0x3e00;
- __dpmi_int(0x21, ®s);
- if (regs.x.flags & 1)
- errno = __doserr_to_errno(regs.x.ax);
- }
- /* Else leave file pointer where we found it. */
- else
- {
- regs.x.ax = 0x4200; /* set pointer from the beginning of file */
- regs.x.bx = fh;
- regs.x.cx = fpos_high;
- regs.x.dx = fpos_low;
- __dpmi_int(0x21, ®s);
- if (regs.x.flags & 1)
- {
- errno = __doserr_to_errno(regs.x.ax);
- return 0;
- }
- }
-
- if (read_fail == 0)
- retval = _farpeekw(_dos_ds, __tb);
- else
- {
- /* The file couldn't be read: assume non-executable. If the file
- *is* executable, but was passed as a file-handle, and the user
- opened it in write-only mode, they lose... */
- retval = 0;
- if (read_fail != -1)
- errno = __doserr_to_errno(read_fail);
- }
-
- return retval;
-}
-
-/* A list of extensions which designate executable files. These
- are NOT tested for the magic number. */
-static char executables[] = "|EXE|COM|BAT|BTM|DLL|VXD|";
-
-/* A list of extensions which belong to files known to NEVER be
- executables. These exist to minimize read()'ing files while
- detecting executables by magic number. You are welcome to
- add to this list, but remember: only extensions which could
- NEVER be present in executables should go here. */
-static char non_executables[] = "\
-|A|A01|A02|A03|A04|A05|ADL|ARC|ARJ|ASC|ASM|AUX|AWK\
-|BAS|BIB|BGI|BMP\
-|C|CC|CFG|CGZ|CH3|CHR|CI|CLP|CMF|CPI|CPP|CXX\
-|DAT|DBF|DIZ|DOC|DVI\
-|E|EL|ELC\
-|F77|FN3\
-|GIF|GZ\
-|H|HLP|HPP|HXX\
-|ICO|IN|INC|INF|INI\
-|JPG\
-|L|LEX|LF|LIB|LOG|LST|LZH\
-|M|MAK|MAP|MF|MID|MPG\
-|O|OBJ\
-|PAK|PAS|PBM|PCD|PCX|PDS|PIC|PIF|PN3|PRJ|PS\
-|RAS|RGB|RLE\
-|S|SND|SY3\
-|TAR|TAZ|TEX|TGA|TGZ|TIF|TXH|TXI|TXT\
-|VOC\
-|WAV|WK1|WK3|WKB|WQ1|WQ3|WQ4|WQ5|WQ6|WQ!\
-|XBM\
-|Y\
-|ZIP|ZOO|";
-
-int
-_is_executable(const char *filename, int fhandle, const char *extension)
-{
- if (!extension && filename)
- {
- const char *cp, *ep=0;
- for (cp=filename; *cp; cp++)
- {
- if (*cp == '.')
- ep = cp;
- if (*cp == '/' || *cp == '\\' || *cp == ':')
- ep = 0;
- }
- extension = ep;
- }
- if ((_djstat_flags & _STAT_EXEC_EXT) == 0
- && extension
- && *extension
- && strlen(extension) <= ((extension[0]=='.') ? 4 : 3))
- {
- /* Search the list of extensions in executables[]. */
- char tmp_buf[6], *tp = tmp_buf;
-
- *tp++ = '|';
- if (*extension == '.')
- extension++;
- while (*extension)
- *tp++ = toupper (*extension++);
- *tp++ = '|';
- *tp = '\0';
- if (strstr(non_executables, tmp_buf))
- return 0;
- else if (strstr(executables, tmp_buf))
- return 1;
- }
-
- /* No extension, or extension doesn't define execute
- bits unambiguously. We are in for some dirty work.
- Read the first two bytes of the file and see if they
- are any of the known magic numbers which designate
- executable files.
- Unix-like shells, which have executable shell scripts
- without extensions and DON'T have "#!" as their FIRST
- TWO CHARACTERS, lose here. Sorry, folks. */
- if ( (_djstat_flags & _STAT_EXEC_MAGIC) == 0 )
- {
- switch (_get_magic(filename, fhandle))
- {
- case 0x5a4d: /* "MZ" */
- case 0x010b:
- case 0x014c:
- case 0x2123: /* "#!" */
- return 1;
- }
- }
-
- return 0;
-}
+++ /dev/null
-# Copyright (C) 1993,1994,1995,1996,2001 Free Software Foundation, Inc.
-
-# This file is part of GNU Emacs.
-
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# make all to compile and build Emacs.
-# make install to install it.
-# make TAGS to update tags tables.
-#
-# make clean or make mostlyclean
-# Delete all files from the current directory that are normally
-# created by building the program. Don't delete the files that
-# record the configuration. Also preserve files that could be made
-# by building, but normally aren't because the distribution comes
-# with them.
-#
-# Delete `.dvi' files here if they are not part of the distribution.
-#
-# make distclean
-# Delete all files from the current directory that are created by
-# configuring or building the program. If you have unpacked the
-# source and built the program without creating any other files,
-# `make distclean' should leave only the files that were in the
-# distribution.
-#
-# make realclean
-# Delete everything from the current directory that can be
-# reconstructed with this Makefile. This typically includes
-# everything deleted by distclean, plus more: C source files
-# produced by Bison, tags tables, info files, and so on.
-#
-# make extraclean
-# Still more severe - delete backup and autosave files, too.
-
-all: lib-src src
-
-lib-src: FRC
- cd lib-src
- $(MAKE)
- cd ..
-
-src: FRC
- cd src
- $(MAKE)
- cd ..
-
-install: all
- -md bin
- cd lib-src
- coff2exe hexl
- coff2exe etags
- coff2exe ctags
- coff2exe b2m
- mv -f hexl.exe etags.exe ctags.exe b2m.exe ../bin/
- cd ..
- cd src
- coff2exe emacs
- stubedit emacs.exe minstack=512k
- mv -f emacs.exe ../bin/
- cd ..
-
-FRC:
-
-TAGS tags: lib-src
- cd src
- go32 ../lib-src/etags *.[ch] ../lisp/*.el ../lisp/term/*.el
- cd ..
-
-check:
- @echo "We don't have any tests for GNU Emacs yet."
-
-clean:
- cd lib-src
- $(MAKE) clean
- cd ..
- cd src
- $(MAKE) clean
- cd ..
- cd oldxmenu
- -$(MAKE) clean
- cd ..
+++ /dev/null
-# Top-level Makefile for Emacs under MS-DOS/DJGPP v2.0 or higher. -*-makefile-*-
-
-# Copyright (C) 1996,1997,1998,1999,2000,2001,2002
-# Free Software Foundation, Inc.
-
-# This file is part of GNU Emacs.
-
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# make all to compile and build Emacs.
-# make install to install it.
-# make TAGS to update tags tables.
-#
-# make clean or make mostlyclean
-# Delete all files from the current directory that are normally
-# created by building the program. Don't delete the files that
-# record the configuration. Also preserve files that could be made
-# by building, but normally aren't because the distribution comes
-# with them.
-#
-# Delete `.dvi' files here if they are not part of the distribution.
-#
-# make distclean
-# Delete all files from the current directory that are created by
-# configuring or building the program. If you have unpacked the
-# source and built the program without creating any other files,
-# `make distclean' should leave only the files that were in the
-# distribution.
-#
-# make realclean
-# Delete everything from the current directory that can be
-# reconstructed with this Makefile. This typically includes
-# everything deleted by distclean, plus more: C source files
-# produced by Bison, tags tables, info files, and so on.
-#
-# make extraclean
-# Still more severe - delete backup and autosave files, too.
-
-# This gork is required for those who use a Unix-style shell, and
-# have SHELL in the environment pointing to it. Here we force
-# Make to use COMMAND.COM instead. This Makefile won't work otherwise.
-# (The /xyzzy directory is used to minimize the chance that someone
-# actually has such a directory with an incompatible command.com. We
-# used to have /dos there, but some Windows installations have an old
-# version of DOS stashed in that directory, and command.com from there
-# won't run on Windows, complaining about "Incorrect DOS version".
-# Make will look up PATH for the shell executable, so the directory name
-# is not important.)
-SHELL=/xyzzy/command
-MAKESHELL=/xyzzy/command
-
-# Generate a full pathname of the top-level installation directory
-top_srcdir := $(subst \,/,$(shell cd))
-
-# Find out which version of Emacs this is.
-version := ${shell sed -n -e '/(defconst emacs-version/s/^[^"]*\("[^"]*"\).*/\1/p' lisp/version.el}
-
-all: maybe_bootstrap lib-src src man lispref lispintro
-
-lib-src: FRC
- cd lib-src
- $(MAKE) top_srcdir=${top_srcdir} version=${version}
- cd ..
-
-src: FRC
- cd src
- $(MAKE) top_srcdir=${top_srcdir}
- djecho -s '/-geometry/s,^.*,set environment HOME $(top_srcdir),' \
- '/environment *TERM/s/^.*/set environment TERM internal/' \
- '/x_error_quitter/s/^.*/set environment NAME root/' >gdb.sed
- sed -f gdb.sed _gdbinit >gdb.tmp
- djecho -a gdb.tmp -s 'set environment USER root' \
- 'set environment EMACSPATH $(top_srcdir)/bin' \
- 'set environment SHELL $(subst \,/,$(COMSPEC))' \
- 'set environment PATH $(subst \,/,$(PATH))'
- update gdb.tmp gdb.ini
- rm -f gdb.tmp gdb.sed
- cd ..
- if exist leim\Makefile redir $(MAKE) -C leim top_srcdir=${top_srcdir}
-
-man lispref lispintro: FRC
- cd $@
- $(MAKE) top_srcdir=${top_srcdir}
- cd ..
-
-install: all
- if not exist bin\nul md bin
- cd lib-src
- command.com /c >/dev/null for %p in (hexl etags ctags b2m ebrowse) do\
- if exist %p.exe mv -f %p.exe ../bin
- if exist fns.el update fns.el ../bin/fns.el
- cd ..
- cd src
- stubify emacs
- stubedit emacs.exe minstack=512k
- mv -f emacs.exe ../bin/
- cd ..
- djecho -s "(if (fboundp 'normal-top-level-add-subdirs-to-load-path)" \
- " (normal-top-level-add-subdirs-to-load-path))" \
- > ./subdirs.el
- if not exist .\site-lisp\subdirs.el \
- update ./subdirs.el ./site-lisp/subdirs.el
- rm -f ./subdirs.el
-
-FRC:
-
-# We cannot use [a-zA-Z]* like the mainline distribution does, because
-# that causes all file names to be returned in upper-case on DOS...
-TAGS tags: lib-src FRC
- cd lib-src
- if exist etags.exe mv -f etags.exe ../bin
- cd ..
- cd lisp
- ../bin/etags .../*.el
- cd ..
- cd src
- ../bin/etags --include=../lisp/TAGS \
- '--regex=/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' *.c *.h s/msdos.h m/intel386.h
- cd ..
- ./bin/etags --include=src/TAGS
-
-check:
- @echo "We don't have any tests for GNU Emacs yet."
-
-clean:
- cd lib-src
- $(MAKE) clean
- cd ..
- cd src
- $(MAKE) clean
- cd ..
- cd oldxmenu
- -$(MAKE) clean
- cd ..
- cd leim
- if exist Makefile redir $(MAKE) clean
- cd ..
-
-.PHONY: bootstrap bootstrap-lisp-1 boostrap-src bootstrap-lisp bootstrap-clean
-.PHONY: maybe_bootstrap
-
-maybe_bootstrap:
- @if not exist lisp\abbrev.elc djecho \
- "Some *.elc files are missing. You should do a `make bootstrap'."
- @if not exist lisp\abbrev.elc redir -e /dev/null -oe redir fail-this-make.exe
-
-bootstrap: bootstrap-clean-before bootstrap-lisp-1 bootstrap-src bootstrap-lisp bootstrap-clean-after all info
-
-bootstrap-lisp-1:
- cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean; cd ..
-
-bootstrap-lisp:
- cd lisp; $(MAKE) $(MFLAGS) bootstrap EMACS=${top_srcdir}/src/b-emacs.exe lisp=${top_srcdir}/lisp; cd ..
-
-bootstrap-src:
- cd src; $(MAKE) $(MFLAGS) bootstrap; cd ..
-
-### Used for `bootstrap' to avoid deleting existing dumped Emacs executables.
-bootstrap-clean-before: FRC
- cd src; $(MAKE) $(MFLAGS) mostlyclean; cd ..
- cd lib-src; $(MAKE) $(MFLAGS) clean; cd ..
- cd leim; $(MAKE) $(MFLAGS) clean; cd ..
-
-bootstrap-clean-after:
- cd src; $(MAKE) $(MFLAGS) mostlyclean; cd ..
+++ /dev/null
-# -sed1.inp-------------------------------------------------------------
-# Configuration script for src/makefile
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-# In case src/Makefile needs to rebuild `make-doc.exe' (might happen under
-# Windows 95), make sure it gets built with commands that DOS
-# understands (one command per line).
-s/^#.*//
-s/^[ \f\t][ \f\t]*$//
-s/^ / /
-s/\.h\.in/.h-in/
-s!^ \./temacs! go32 temacs!
-s!/bin/sh!command.com!
-/^MAKE *=/s/^/# /
-/^SHELL *=/s/^/# /
-/^srcdir *=/s/@[^@\n]*@/./
-/^VPATH *=/s/@[^@\n]*@/./
-/^CC *=/s/@[^@\n]*@/gcc/
-/^CPP *=/s/@[^@\n]*@/gcc -e/
-/^CFLAGS *=/s/@[^@\n]*@/-O2 -g/
-/^LIBS *=/s/@[^@\n]*@//
-/^LIBOBJS *=/s/@[^@\n]*@//
-/^LN_S *=/s/@[^@\n]*@/ln -s/
-/^M_FILE *=/s!@[^@\n]*@!m/intel386.h!
-/^S_FILE *=/s!@[^@\n]*@!s/msdos.h!
-/^@SET_MAKE@$/s/@SET_MAKE@//
-/^.\${libsrc}make-docfile.*>/s!make-docfile!make-doc.exe -o ../etc/DOC!
-/^.\${libsrc}make-doc/s!>.*$!!
-/^\${libsrc}make-docfile:/c\
-${libsrc}make-doc.exe:\
- cd ..\
- cd lib-src\
- $(MAKE) ${MFLAGS} make-docfile -W make-docfile.c\
- cd ..\
- cd src
-/^ cd \${libsrc}; \${MAKE} \${MFLAGS} make-docfile/d
-/\${libsrc}make-docfile/s/-docfile[ ]/-doc.exe /
-/^[\f ]*$/d
-/^temacs:/s/prefix-args//
-/^temacs:/s/stamp-oldxmenu//
-/^ #/d
+++ /dev/null
-# -sed1v2.inp-----------------------------------------------------------
-# Configuration script for src/Makefile under DJGPP v2.x
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1996, 1997, 1999, 2000, 2002
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-s/^#.*//
-s/^[ \f\t][ \f\t]*$//
-s/^ / /
-s/\.h\.in/.h-in/
-/^ LC_ALL=C \.\/temacs/i\
- stubedit temacs.exe minstack=100k
-/^ LC_ALL=C.*temacs/s/LC_ALL=C/set &;/
-/^MAKE *=/s/^/# /
-/^SHELL *=/s/^/# /
-/^srcdir *=/s/@[^@\n]*@/./
-/^VPATH *=/s/@[^@\n]*@/./
-/^CC *=/s/@[^@\n]*@/gcc/
-/^CPP *=/s/@[^@\n]*@/gcc -e/
-/^CFLAGS *=/s/@[^@\n]*@/-O2 -gcoff/
-/^CPPFLAGS *=/s/@[^@\n]*@//
-/^LDFLAGS *=/s/@[^@\n]*@//
-/^LIBS *=/s/@[^@\n]*@//
-/^LIBOBJS *=/s/@[^@\n]*@/getloadavg.o/
-/^GETLOADAVG_LIBS *=/s/@[^@\n]*@//
-/^LIBSOUND *=/s/@LIBSOUND@//
-/^LN_S *=/s/@[^@\n]*@/ln -s/
-/^M_FILE *=/s!@[^@\n]*@!m/intel386.h!
-/^S_FILE *=/s!@[^@\n]*@!s/msdos.h!
-/^@SET_MAKE@$/s/@SET_MAKE@//
-/^.\${libsrc}make-docfile.*>/s!make-docfile!make-docfile -o ../etc/DOC!
-/^.\${libsrc}make-doc/s!>.*$!!
-/^[\f ]*$/d
-/^temacs:/s/prefix-args//
-/^temacs:/s/stamp-oldxmenu//
-/^ mv \.\/\.gdbinit/d
-/^ if test -f/c\
- command.com /c if exist .gdbinit rm -f _gdbinit
-/^ else mv \.\/\.gdbinit/d
-/^ #/d
-/^ cd.*make-docfile/s!$!; cd ${dot}${dot}/src!
-s/bootstrap-emacs/b-emacs/
-s/bootstrap-temacs/b-temacs/
-s/bootstrap-doc/b-doc/
-/rm -f bootstrap-emacs/s/b-emacs/b-emacs b-emacs.exe/
-/^ els=/c\
- ${libsrc}make-docfile -o ${etc}DOC -d ${srcdir} ${SOME_MACHINE_LISP:.elc=.el} ${shortlisp:.elc=.el} ${SOME_MACHINE_OBJECTS} ${obj}
-/^ mv -f emacs/a\
- stubify b-emacs\
- stubedit b-emacs.exe minstack=1024k\
- rm -f emacs.exe temacs.exe
-/^ rm -f/s/\\#/#/
+++ /dev/null
-# -sed1x.inp------------------------------------------------------------
-# Extra configuration script for src/makefile for DesqView/X
-# ----------------------------------------------------------------------
-s!^ cd \${oldXMenudir}; \${MAKE}.*$! ${MAKE} -C ${oldXMenudir}.!
-s!^ @true *$! @rem!
-s/DOC/DOC-X/g
-#/^LIBXMENU *=/s!= *!= ../oldxmenu/!
-/^temacs *:/s!OLDXMENU!LIBXMENU!
+++ /dev/null
-# -sed2.inp-------------------------------------------------------------
-# Configuration script for src/config.h
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2002
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-/^#undef LISP_FLOAT_TYPE *$/s/undef/define/
-/^#undef GNU_MALLOC *$/s/undef/define/
-/^#undef REL_ALLOC *$/s/undef/define/
-/^#undef HAVE_SYS_SELECT/i\
-/^#undef STDC_HEADERS *$/s/undef/define/
-/^#undef HAVE_SYS_TIMEB_H *$/s/undef/define/
-/^#undef HAVE_SYS_TIME_H *$/s/undef/define/
-# /^#undef HAVE_UNISTD_H *$/s/undef/define/
-/^#undef HAVE_GETTIMEOFDAY *$/s/undef/define/
-/^#undef HAVE_GETHOSTNAME *$/s/undef/define/
-/^#undef HAVE_DUP2 *$/s/undef/define/
-/^#undef HAVE_TM_ZONE *$/s/undef/define/
-/^#undef LOCALTIME_CACHE *$/s/undef/define/
-/^#undef HAVE_TZSET *$/s/undef/define/
-/^#undef TM_IN_SYS_TIME *$/s/undef/define/
-/^#undef TIME_WITH_SYS_TIME *$/s/undef/define/
-/^#undef HAVE_RENAME *$/s/undef/define/
-/^#undef HAVE_CLOSEDIR *$/s/undef/define/
-/^#undef HAVE_RANDOM *$/s/undef/define/
-/^#undef HAVE_MKDIR *$/s/undef/define/
-/^#undef HAVE_RMDIR *$/s/undef/define/
-/^#undef HAVE_BCMP *$/s/undef/define/
-/^#undef HAVE_BCOPY *$/s/undef/define/
-/^#undef HAVE_FREXP *$/s/undef/define/
-/^#undef HAVE_FTIME *$/s/undef/define/
-/^#undef HAVE_MKTIME *$/s/undef/define/
-/^#undef HAVE_STRERROR *$/s/undef/define/
-/^#undef HAVE_TIMEVAL *$/s/undef/define/
-s/^#define USER_FULL_NAME .*$/#define USER_FULL_NAME (getenv ("NAME"))/
-s/^#undef STACK_DIRECTION *$/#define STACK_DIRECTION -1/
-s/^#undef EMACS_CONFIGURATION *$/#define EMACS_CONFIGURATION "i386-pc-msdosdjgpp"/
-s/^#undef EMACS_CONFIG_OPTIONS *$/#define EMACS_CONFIG_OPTIONS "-"/
-s!^#undef config_opsysfile *$!#define config_opsysfile "s/msdos.h"!
-s!^#undef config_machfile *$!#define config_machfile "m/intel386.h"!
-s/^#undef PROTOTYPES *$/#define PROTOTYPES 1/
-s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/
+++ /dev/null
-# -sed2v2.inp-------------------------------------------------------------
-# Configuration script for src/config.h under DJGPP v2.x
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2002
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-
-/^#define EMACS_CONFIG_H/a\
-\
-#include <sys/version.h>\
-/* In DJGPP v2.x almost everything is already defined in a system header. */\
-#include <sys/config.h>\
-/* For those who still use DJGPP v2.01 */\
-#if __DJGPP__ == 2 && __DJGPP_MINOR__ == 1\
-#define NSIG 320\
-#endif
-
-/^#undef HAVE_ALLOCA *$/s/^.*$/#define HAVE_ALLOCA 1/
-/^#undef HAVE_SETITIMER *$/s/^.*$/#define HAVE_SETITIMER 1/
-/^#undef HAVE_STRUCT_UTIMBUF *$/s/^.*$/#define HAVE_STRUCT_UTIMBUF 1/
-/^#undef LOCALTIME_CACHE *$/s/^.*$/#define LOCALTIME_CACHE 1/
-/^#undef HAVE_TZSET *$/s/^.*$/#define HAVE_TZSET 1/
-/^#undef HAVE_LOGB *$/s/^.*$/#define HAVE_LOGB 1/
-/^#undef HAVE_FREXP *$/s/^.*$/#define HAVE_FREXP 1/
-/^#undef HAVE_FMOD *$/s/^.*$/#define HAVE_FMOD 1/
-/^#undef HAVE_RINT *$/s/^.*$/#define HAVE_RINT 1/
-/^#undef HAVE_CBRT *$/s/^.*$/#define HAVE_CBRT 1/
-/^#undef HAVE_FPATHCONF *$/s/^.*$/#define HAVE_FPATHCONF 1/
-/^#undef HAVE_SETRLIMIT *$/s/^.*$/#define HAVE_SETRLIMIT 1/
-/^#undef HAVE_TM_GMTOFF *$/s/^.*$/#define HAVE_TM_GMTOFF 1/
-/^#undef HAVE_MBLEN *$/s/^.*$/#define HAVE_MBLEN 1/
-/^#undef HAVE_STRUCT_TIMEZONE *$/s/^.*$/#define HAVE_STRUCT_TIMEZONE 1/
-/^#undef HAVE_INDEX *$/s/^.*$/#define HAVE_INDEX 1/
-/^#undef HAVE_RINDEX *$/s/^.*$/#define HAVE_RINDEX 1/
-/^#undef HAVE_MKSTEMP *$/s/^.*$/#define HAVE_MKSTEMP 1/
-/^#undef HAVE_STRUCT_TM_TM_ZONE *$/s/^.*$/#define HAVE_STRUCT_TM_TM_ZONE 1/
-/^#undef PACKAGE_BUGREPORT/s/^.*$/#define PACKAGE_BUGREPORT ""/
-/^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/
-/^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/
-/^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/
-/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION ""/
-/^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/
-
-/^#undef GNU_MALLOC *$/s/^.*$/#define GNU_MALLOC 1/
-/^#undef REL_ALLOC *$/s/^.*$/#define REL_ALLOC 1/
-
-s/^#define USER_FULL_NAME .*$/#define USER_FULL_NAME (getenv ("NAME"))/
-s/^#undef STACK_DIRECTION *$/#define STACK_DIRECTION -1/
-s/^#undef EMACS_CONFIGURATION *$/#define EMACS_CONFIGURATION "i386-pc-msdosdjgpp"/
-s/^#undef EMACS_CONFIG_OPTIONS *$/#define EMACS_CONFIG_OPTIONS "msdos"/
-s!^#undef config_opsysfile *$!#define config_opsysfile "s/msdos.h"!
-s!^#undef config_machfile *$!#define config_machfile "m/intel386.h"!
-s/^#undef PROTOTYPES *$/#define PROTOTYPES 1/
-s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/
-# ------------------------------------------------------------
-# Without this ifndef, gcc -E -traditional barfs with GCC 3.0
-# on the line which says if ! HAVE_MKTIME...
-# ------------------------------------------------------------
-/^#if ! HAVE_MKTIME || BROKEN_MKTIME/i\
-#ifndef __DJGPP__
-/^#define mktime emacs_mktime/a\
-#endif
-
-/^#undef HAVE_STDINT_H/c\
-#if __DJGPP__ > 2 || __DJGPP_MINOR__ > 3\
-#define HAVE_STDINT_H 1\
-#else\
-#undef HAVE_STDINT_H\
-#endif
-
-# Comment out any remaining undef directives, because some of them
-# might be defined in sys/config.h we include at the top of config.h.
-/^#undef BSTRING/s|#undef|# undef|
-/^#undef .*$/s|^.*$|/* & */|
+++ /dev/null
-# -sed2x.inp------------------------------------------------------------
-# Extra configuration script for src/config.h for DesqView/X
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1994
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-/^#undef HAVE_X_WINDOWS *$/s/undef/define/
-/^#undef HAVE_X11 *$/s/undef/define/
-/^#undef HAVE_X_MENU *$/s/undef/define/
-/^#undef HAVE_XSCREENNUMBEROFSCREEN *$/s/undef/define/
-/^#undef HAVE_XSETWMPROTOCOLS *$/s/undef/define/
-/^#undef HAVE_SELECT *$/s/undef/define/
+++ /dev/null
-# -sed3.inp-------------------------------------------------------------
-# Configuration script for lib-src/makefile
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1993, 1994, 1995
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-/^# DIST: /d
-/^SHELL *=/s/^/# /
-/^CC *=/s/=.*$/=gcc/
-# Actually, here we should patch in the exact version number, but only
-# [ce]tags uses it. Don't pass it. This is more update-resistant.
-/-DVERSION=/s/-DVERSION="\\"\${version}\\""//
-/^configname *=/s/=.*$/=msdos/
-/^archlibdir *=/s!=.*$!=/emacs/bin!
-/^bindir *=/s!=.*$!=/emacs/bin!
-/^libdir *=/s!=.*$!=/emacs/bin!
-/^srcdir *=/s!=.*$!=.!
-/^VPATH *=/s!=.*$!=.!
-/^CFLAGS *=/s!=.*$!=-O2 -g!
-/^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS!
-/^LOADLIBES *=/s!=.*$!=!
-/^ALLOCA *=/s!=.*$!=alloca.o!
-/^INSTALLABLES/s/emacsclient *//
-s!^ \./! go32 ./!
-/^UTILITIES=/s/ wakeup//
-/^UTILITIES=/s/ movemail//
-/^UTILITIES=/s/ emacsserver//
-/^UTILITIES=/s/ timer//
-/^all *:/s/$/ make-docfile/
-s!^ go32 ./test-distrib! go32 ./test-dis!
-/-o make-docfile/a\
- coff2exe make-docfile
+++ /dev/null
-# -sed3v2.inp-------------------------------------------------------------
-# Configuration script for lib-src/makefile under DJGPP v2
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1996, 1998, 2000
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-/^# DIST: /d
-/^SHELL *=/s/^/# /
-/^CC *=/s/=.*$/=gcc/
-/-DVERSION=/s/@version@/\${version}/
-/^configname *=/s/=.*$/=msdos/
-/^archlibdir *=/s!=.*$!=/emacs/bin!
-/^bindir *=/s!=.*$!=/emacs/bin!
-/^libdir *=/s!=.*$!=/emacs/bin!
-/^srcdir *=/s!=.*$!=.!
-/^VPATH *=/s!=.*$!=.!
-/^CFLAGS *=/s!=.*$!=-O2 -g!
-/^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS!
-/^LOADLIBES *=/s!=.*$!=!
-/^ALLOCA *=/s!@ALLOCA@!!
-/^INSTALLABLES/s/emacsclient *//
-s!^ \./! !
-/^UTILITIES=/s/ wakeup//
-/^UTILITIES=/s/ movemail//
-/^UTILITIES=/s/ emacsserver//
-/^UTILITIES=/s/ timer//
+++ /dev/null
-# -sed4.inp-------------------------------------------------------------
-# Configuration script for src/paths.h
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1994
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-/^#define *PATH_LOADSEARCH/s/".*"/rootrelativepath ("lisp")/
-/^#define *PATH_DATA/s/".*"/rootrelativepath ("etc")/
-/^#define *PATH_DOC/s/".*"/rootrelativepath ("etc")/
-/^#define *PATH_INFO/s/".*"/rootrelativepath ("info")/
+++ /dev/null
-# -sed5x.inp------------------------------------------------------------
-# Configuration script for oldxmenu/makefile for DesqView/X
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1994
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-/^srcdir *=/s/@[^@\n]*@/./
-/^VPATH *=/s/@[^@\n]*@/./
-/^C_SWITCH_X_SITE *=/s/@[^@\n]*@//
-/^CC *=/s/@[^@\n]*@/gcc/
-/^CPP *=/s/@[^@\n]*@/gcc -e/
-/^CFLAGS *=/s/@[^@\n]*@/-O2 -g/
-/^LN_S *=/s/@[^@\n]*@/ln -s/
-s/|| true//
+++ /dev/null
-# -sed6.inp------------------------------------------------------------------
-# Configuration script for man/Makefile, lispref/Makefile, and
-# lispintro/Makefile under DJGPP v2.x
-# ---------------------------------------------------------------------------
-#
-# Copyright (C) 1997, 2000, 2001
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-/^srcdir *=/s/@[^@\n]*@/./
-/^VPATH *=/s/@[^@\n]*@/./
-/^ENVADD/c\
-ENVADD =\
-export TEXINPUTS := $(srcdir)";"$(TEXINPUTS)\
-export MAKEINFO := $(MAKEINFO) -I$(srcdir)
-/^texinputdir/c\
-texinputdir =\
-export texinputdir := $(srcdir)";"$(TEXINPUTS)
-/^SHELL *=/s/^/# /
+++ /dev/null
-# -sedleim.inp-----------------------------------------------------------
-# Configuration script for leim/Makefile under DJGPP v2.x
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 1999, 2000
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-/^SHELL *=/c\
-SHELL=/xyzzy/command\
-MAKESHELL=/xyzzy/command
-
-/^version=/d
-/^prefix=/d
-/^datadir=/s|@datadir@|../..|
-/^srcdir=/s|srcdir=@srcdir@|srcdir := $(subst \\,/,$(shell cd))|
-
-/^INSTALLDIR=/c\
-INSTALLDIR=.
-
-/RUN-EMACS *=/,/^$/c\
-export EMACSLOADPATH=${buildlisppath}\
-RUN-EMACS = ${BUILT-EMACS} -batch --no-init-file --no-site-file --multibyte
-
-/^ cd ../c\
- ${MAKE} -C ../src ${MFLAGS} emacs
-
-/else make quail/c\
- if not exist quail\\nul make quail
-
-/if \[ -f $@ \]\; then true/d
-/fi$/s/; fi$//
-
-/^leim-list.el:/,/^$/ {
- /^ if/d
- /^ else/,/^ fi/d
- s| *| |
- /^ --eval/,/; \\$/s|\; \\||
-}
-
-/^install:/,/^$/c\
-install: all\
-
-/^ if test -f/d
+++ /dev/null
-# -sedlisp.inp-----------------------------------------------------------
-# Configuration script for lisp/Makefile under DJGPP v2.x
-# ----------------------------------------------------------------------
-#
-# Copyright (C) 2000, 2002
-# Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# This file is free software; as a special exception, the author gives
-# unlimited permission to copy and/or distribute it, with or without
-# modifications, as long as this notice is preserved.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# ----------------------------------------------------------------------
-
-/^lisp=/s|@srcdir@|.|
-/^VPATH=/s|@srcdir@|.|
-/^srcdir=/s|@srcdir@|.|
-/^bootstrap-clean:/a\
- command.com /c dtou .../*.el
+++ /dev/null
-/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
-#include <signal.h>
-#include <errno.h>
-
-int
-sigaction(int _sig, const struct sigaction *_act, struct sigaction *_oact)
-{
- int retval = 0;
-
- if (_oact)
- {
- void (*installed_sig)(int) = signal (_sig, SIG_IGN);
-
- /* FIXME */
- if (installed_sig == SIG_ERR)
- {
- retval = -1;
- errno = EINVAL;
- }
- else
- signal (_sig, installed_sig);
- _oact->sa_handler = installed_sig;
- retval = sigemptyset (&_oact->sa_mask);
- _oact->sa_flags = 0;
- }
- if (_act)
- {
- if (signal (_sig, _act->sa_handler) == SIG_ERR)
- {
- retval = -1;
- errno = EINVAL;
- }
- }
- return 0;
-}
-
-
-
+++ /dev/null
-*-spd
-*.pdb
+++ /dev/null
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-\f
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-\f
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-\f
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-\f
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-\f
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) year name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Library General
-Public License instead of this License.
+++ /dev/null
-2003-02-01 Jason Rumney <jasonr@gnu.org>
-
- * configure.bat: Automatically detect libXpm.
- Suppress compiler output when testing for image libraries.
- Give names of un-found libraries in messages.
-
-2003-01-31 Juanma Barranquero <lektu@terra.es>
-
- * configure.bat: Automatically detect giflib and tifflib.
-
-2003-01-29 Jason Rumney <jasonr@gnu.org>
-
- * gmake.defs (CURDIR): Disable cygpath kludge.
-
-2003-01-29 KOBAYASHI Yasuhiro <kobayays@otsukakj.co.jp>
-
- * configure.bat: Avoid endless loop when configuring without image
- support.
-
-2003-01-26 Jason Rumney <jasonr@gnu.org>
-
- * configure.bat: Automatically detect jpeglib.
-
-2003-01-25 Jason Rumney <jasonr@gnu.org>
-
- * configure.bat: Automatically detect libpng.
-
-2003-01-21 Jason Rumney <jasonr@gnu.org>
-
- * icons/hand.cur: New file.
-
-2003-01-21 David Ponce <david@dponce.com>
-
- * emacs.rc (2000-10-19T07:24:01Z!eliz@gnu.org): Declare hand cursor resource.
-
-2003-01-15 Andrew Innes <andrewi@gnu.org>
-
- * gmake.defs (CURDIR): Convert to native Windows format (with
- forward slashes), to support building with Cygwin builds of make.
-
-2002-11-17 Ben Key <BKey1@tampabay.rr.com>
-
- * nmake.defs:
- * gmake.defs: Made changes so that Emacs would link with
- WinMM.lib. This change was required for my addition of a Windows
- compatible implementation of play-sound-internal.
-
-2002-09-03 Peter Runestig <peter@runestig.com> (tiny change)
-
- * emacs.rc: Version updated to 21.3.50.
-
-2002-06-13 Jason Rumney <jasonr@gnu.org>
-
- * addpm.c (env_vars): Remove EMACSLOCKDIR.
-
- * makefile.w32-in (maybe-bootstrap, doit, maybe-bootstrap-CMD)
- (maybe-bootstrap-SH): New targets.
- (all): Depend on maybe-bootstrap.
-
-2002-05-03 Jason Rumney <jasonr@gnu.org>
-
- * inc/sys/socket.h (F_SETFL, O_NDELAY): Define.
- (sys_getpeername, fcntl): Declare as wrappers.
-
-2002-04-10 Juanma Barranquero <lektu@terra.es>
-
- * makefile.w32-in (bootstrap-nmake, bootstrap-gmake): Make DOC
- after compiling .el files.
-
-2002-03-20 Jason Rumney <jasonr@gnu.org>
-
- * inc/sys/socket.h (sys_setsockopt, sys_listen, sys_getsockname)
- (sys_accept, sys_recvfrom, sys_sendto): Declare as wrappers.
-
-2002-03-19 Kim F. Storm <storm@cua.dk>
-
- * config.nt (HAVE_SENDTO, HAVE_RECVFROM, HAVE_GETSOCKOPT)
- (HAVE_SETSOCKOPT, HAVE_GETSOCKNAME, HAVE_GETPEERNAME): Define.
- (HAVE_SYS_UN_H): Undef.
- From David Ponce <dponce@voila.fr>.
-
-2002-03-13 Jason Rumney <jasonr@gnu.org>
-
- * config.nt (STRFTIME_NO_POSIX2): Define.
-
-2002-02-18 Jason Rumney <jasonr@gnu.org>
-
- * emacs.rc: Define VS_VERSION_INFO if not already.
- Update version info.
-
-2002-01-04 Andrew Innes <andrewi@gnu.org>
-
- * gmake.defs (CFLAGS): Define _WIN32_WINNT as 0x0400, in order to
- pick up relevant bits of the Windows API definitions.
-
- * nmake.defs (CFLAGS): Define _WIN32_WINNT as 0x0400, in order to
- pick up relevant bits of the Windows API definitions.
-
-2001-12-14 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in (bootstrap): Build addsection program before
- bootstrap (required for post-processing temacs.exe).
-
-2001-12-08 Pavel Jan
\e,Bm
\e(Bk <Pavel@Janik.cz>
-
- * COPYING: New file.
-
-2001-12-03 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in (bootstrap-nmake):
- (bootstrap-gmake): Extend bootstrap process to first do
- bootstrap-clean in lisp dir and rebuild the DOC file.
- (bootstrap): Do a "normal" make after the bootstrap work.
-
-2001-11-20 Jason Rumney <jasonr@gnu.org>
-
- * INSTALL: Update table of versions of make that are suitable
- for building Emacs, based on recent feedback.
-
- * TODO, _emacs, emacs.bat.in, debug.bat.in: Removed.
-
-2001-11-19 Andrew Innes <andrewi@gnu.org>
-
- * ftime-nostartup.bat: New file.
-
- * ftime.bat: Don't include libc.lib for profiling - the profiler
- corrupts part of memcpy.
-
-2001-11-17 Jason Rumney <jasonr@gnu.org>
-
- * nmake.defs (SYS_LDFLAGS): Add setargv.obj for wildcard
- expansion. From Juanma Barranquero <lektu@terra.es>.
-
-2001-10-20 Gerd Moellmann <gerd@gnu.org>
-
- * (Version 21.1 released.)
-
-2001-10-12 Andrew Innes <andrewi@gnu.org>
-
- * inc/pwd.h (uid_t, gid_t): New typedefs.
-
-2001-10-05 Gerd Moellmann <gerd@gnu.org>
-
- * Branch for 21.1.
-
-2001-09-08 Eli Zaretskii <eliz@is.elta.co.il>
-
- * README: Update the address of the mailing list and subscription
- instructions. From Geoff Voelker <voelker@cs.ucsd.edu>.
-
-2001-09-06 Eli Zaretskii <eliz@is.elta.co.il>
-
- * INSTALL: Suggest to avoid using WinZip.
-
- * configure.bat: Make sure ../site-lisp exists; create if necessary.
-
-2001-09-05 Eli Zaretskii <eliz@is.elta.co.il>
-
- * INSTALL: Mention that "make install" can be "nmake install".
-
-2001-09-04 Eli Zaretskii <eliz@is.elta.co.il>
-
- * makefile.w32-in ($(INSTALL_DIR)/bin): Depend on $(INSTALL_DIR),
- since some versions of `mkdir' don't automatically create parent
- directories. From Bruno Grossniklaus <bruno.grossniklaus@ubs.com>.
-
-2001-08-31 Eli Zaretskii <eliz@is.elta.co.il>
-
- * subdirs.el: New file.
-
- * configure.bat: Copy subdirs.el to the site-lisp directory.
-
- * makefile.w32-in (install): Copy subdirs.el to the installation
- directory.
-
-2001-06-20 Jason Rumney <jasonr@gnu.org>
-
- * runemacs.c (WinMain): Add quotes around command in case of spaces.
-
-2001-06-01 Andrew Innes <andrewi@gnu.org>
-
- * gmake.defs (sh_output): Don't use $(warning ...) to output
- messages, since that is not supported by GNU make 3.77.
-
-2001-05-24 Jason Rumney <jasonr@gnu.org>
-
- * INSTALL: Clarify that building with MSVC requires nmake.
-
-2001-05-17 Andrew Innes <andrewi@gnu.org>
-
- * gmake.defs (NEW_CYGWIN): Output message about spurious error
- message that is to be ignored.
-
-2001-05-13 Andrew Innes <andrewi@gnu.org>
-
- * TODO: Remove file, since it is completely out of date.
-
- * README: Add copyright notice.
-
- * INSTALL: Add copyright notice.
-
-2001-04-18 Andrew Innes <andrewi@gnu.org>
-
- * nmake.defs (EMACSLOADPATH): Ensure EMACSLOADPATH is defined in
- the environment.
-
- * gmake.defs (SETLOADPATH): Remove definition.
- (EMACSLOADPATH): Ensure EMACSLOADPATH is defined in the
- environment.
-
-2001-03-26 Eli Zaretskii <eliz@is.elta.co.il>
-
- * configure.bat: Make the checkw32api* labels be distinct in the
- first 8 characters.
-
-2001-03-17 Andrew Innes <andrewi@gnu.org>
-
- * cmdproxy.c (get_next_token): Fix indefinite loop bug scanning
- escaped quotes.
-
- * gmake.defs (DEBUG_LINK): New macro.
- (LINK_FLAGS): Use it.
-
- * nmake.defs (DEBUG_LINK): New macro.
- (LINK_FLAGS): Use it.
-
-2001-03-06 Andrew Innes <andrewi@gnu.org>
-
- * INSTALL: Add --ldflags to configure line for building with
- recent versions of Cygwin GCC.
-
-2001-03-05 Eli Zaretskii <eliz@is.elta.co.il>
-
- * configure.bat: Use correct options when compiling a test program
- with Cygwin. From David Ponce <dponce@voila.fr>.
-
-2001-02-24 Andrew Innes <andrewi@gnu.org>
-
- * _emacs: Remove obsolete file.
-
- * emacs.bat.in: Remove obsolete file.
-
- * debug.bat.in: Remove obsolete file.
-
- * inc/sys/socket.h: Add copyright notice.
-
- * paths.h: Add copyright notice.
-
- * makefile.nt: Update copyright notice.
-
- * makefile.def: Update copyright notice.
-
- * configure.bat: Update copyright notice.
-
- * nmake.defs: Add copyright notice.
-
- * gmake.defs: Add copyright notice.
-
- * makefile.w32-in: Add copyright notice.
-
-2001-02-05 Andrew Innes <andrewi@gnu.org>
-
- * nmake.defs (THISDIR): New definition.
-
- * gmake.defs (THISDIR): New definition.
-
-2001-02-03 Andrew Innes <andrewi@gnu.org>
-
- * configure.bat: Leave a space before >> only when there is a
- preceding digit. Add a comment about the importance of this.
-
- * README: Replace outdated information.
-
- * INSTALL (Trouble-shooting): Add note about need to specify extra
- compiler flags with recent Cygwin ports of gcc.
-
-2001-02-01 Eli Zaretskii <eliz@is.elta.co.il>
-
- * configure.bat: Use "rm -f" instead of "del /f", as the latter
- is not supported by Windows 9X's COMMAND.COM.
-
-2001-01-31 Eli Zaretskii <eliz@is.elta.co.il>
-
- * configure.bat: Make sure redirection is preceeded by a blank, to
- avoid problems with "1>>foo" when CMD.EXE is the shell, which eats
- up the "1" part. From Rob Giardina <rob@criticalpointsoftware.com>.
-
-2001-01-30 Eli Zaretskii <eliz@is.elta.co.il>
-
- * INSTALL: Copy the table of tested combinations of development
- tools from confuigure.bat. Add suggestion to install Bash on
- Windows 9X.
-
- * configure.bat: Don't copy lisp/Makefile, it doesn't exist; copy
- lisp/Makefile.in instead. Use "rm -f" where more than one file
- needs to be deleted, since command.com in Windows 9X doesn't grok
- more than one argument.
-
-2001-01-24 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in (cleanall-other-dirs-nmake):
- (cleanall-other-dirs-gmake): New targets.
- (cleanall): Invoke them.
-
-2001-01-19 Andrew Innes <andrewi@gnu.org>
-
- * addpm.c (env_vars): Add a version-independent site-lisp
- directory to EMACSLOADPATH, after the version dependent one.
-
-2001-01-06 Andrew Innes <andrewi@gnu.org>
-
- * README: Update info about compilers.
-
- * makefile.w32-in: Use $(MAKETYPE) instead of $(SHELLTYPE) to
- select correct rule for invoking make in another directory. Amend
- rules accordingly.
- (clean): Delete $(COMPILER_TEMP_FILES) instead of *.pdb.
-
- * nmake.defs (EMACS_ICON_PATH): Delete definition.
- (COMPILER_TEMP_FILES): New definition.
- (MAKETYPE): New definition.
-
- * gmake.defs (EMACS_ICON_PATH): Delete definition.
- (COMPILER_TEMP_FILES): New definition.
- (MAKETYPE): New definition.
-
- * makefile.def (EMACS_ICON_PATH): Delete definition.
-
- * configure.bat: Be careful not to add trailing spaces when
- outputting to config.settings.
-
-2001-01-02 Andrew Innes <andrewi@gnu.org>
-
- * config.nt (RE_TRANSLATE): Use CHAR_TABLE_TRANSLATE macro rather
- than the function.
-
-2000-12-17 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in (install): Copy directories to the correct
- places.
- (real_install): Remove obsolete target.
-
-2000-12-06 Andrew Innes <andrewi@gnu.org>
-
- * nmake.defs (CURDIR): New define.
- (INSTALL_DIR): Use it.
-
- * gmake.defs (NEW_CYGWIN): New define.
- (DQUOTE) [NEW_CYGWIN]: Cygnus changed the quoting rules since b20,
- so we need to adjust how we escape embedded quotes.
- (SETLOADPATH): Set EMACSLOADPATH to an absolute directory,
- relative to $(CURDIR).
-
-2000-11-25 Jason Rumney <jasonr@gnu.org>
-
- * config.nt (GC_MARK_STACK, GC_SETJMP_WORKS): Define.
-
-2000-10-17 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in (recompile): New target to recompile lisp
- directory.
- (recompile-CMD, recompile-SH): New support targets.
-
-2000-09-24 Jason Rumney <jasonr@gnu.org>
-
- * config.nt (NO_RETURN): Define it.
-
-2000-09-17 Andrew Innes <andrewi@gnu.org>
-
- * gmake.defs: Revert to Unix line endings.
-
- * nmake.defs: Revert to Unix line endings.
-
-2000-09-16 Andrew Innes <andrewi@gnu.org>
-
- * gmake.defs (SETLOADPATH): Change definition to work from any
- subdirectory.
-
-2000-09-14 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in: Revert to Unix line endings.
-
-2000-09-14 Andrew Innes <andrewi@gnu.org>
-
- * INSTALL: Add note about expected error messages when configure
- is run.
-
- * configure.bat: Simplify the generation of makefiles (don't need
- to generate various top-level targets that invoke make in other
- directories).
-
- * gmake.defs (SHELLTYPE): New define.
- (SETLOADPATH): New define.
-
- * nmake.defs (SHELLTYPE): New define.
-
- * makefile.w32-in: Standardize indentation somewhat.
- Add bootstrap support.
- Pass $(MFLAGS) when invoking make recursively.
- Add shell-specific variants of top-level targets that invoke make
- recursively in other directories, and add necessary computed
- dependencies.
-
-2000-09-03 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in: Change to DOS line endings.
-
- * configure.bat: Change to DOS line endings.
-
- * addsection.c (_ANONYMOUS_UNION) [__GNUC__]: New define.
- (_ANONYMOUS_STRUCT) [__GNUC__]: New define.
-
- * preprep.c (_ANONYMOUS_UNION) [__GNUC__]: New define.
- (_ANONYMOUS_STRUCT) [__GNUC__]: New define.
-
- * gmake.defs (CFLAGS): No need for -D_ANONYMOUS_UNION
- -D_ANONYMOUS_STRUCT on compile line.
- (EMACS_EXTRA_C_FLAGS): No need for -DORDINARY_LINK.
- (ARCH_CFLAGS): Change optimization flags to -O2.
- (FOREACH, FORVAR, FORDO, ENDFOR): New definitions.
- (ARGQUOTE, DQUOTE): New defines.
-
- * nmake.defs (CFLAGS): No need for -D_ANONYMOUS_UNION
- -D_ANONYMOUS_STRUCT on compile line.
- (FOREACH, FORVAR, FORDO, ENDFOR): New definitions.
- (ARGQUOTE, DQUOTE): New defines.
-
-2000-08-22 Andrew Innes <andrewi@gnu.org>
-
- * configure.bat: New file.
-
- * gmake.defs: New file.
-
- * nmake.defs: New file.
-
- * makefile.w32-in: New file.
-
- * INSTALL: Rewrite to match new configure process.
-
- * config.nt [WINDOWSNT]: Don't declare getenv.
- (EMACS_CONFIG_OPTIONS): Define according to compiler being used.
-
- * addpm.c (main): Accept /q to mean install based on addpm's
- location without asking. Remove reference to emacs.bat which is
- now obsolete.
-
- * addsection.c (PTR_TO_OFFSET): Cast ptr to unsigned char*.
-
- * paths.h: Use forward slash as directory separator in all path
- definitions.
- (PATH_DUMPLOADSEARCH): Revert to definition used on Unix.
-
- * preprep.c (PTR_TO_OFFSET): Cast ptr to unsigned char *.
-
- * runemacs.c: Remove WIN32 define.
-
- * inc/sys/file.h (F_OK, X_OK, W_OK, R_OK, D_OK): Define if D_OK is
- not defined.
-
- * inc/sys/socket.h (_WINSOCK_H): Undefine if defined.
- (fd_set): Define to new name, after including winsock.h, so we can
- provide our own implementation.
-
-2000-07-05 Andrew Innes <andrewi@gnu.org>
-
- * ebuild.bat: Add support for specifying make arguments.
-
- * makefile.nt: Add support for `bootstrap' and related targets.
-
-2000-06-11 Jason Rumney <jasonr@gnu.org>
-
- * config.nt: Define POINTER_TYPE, PTR, PROTOTYPES and __P.
-
-2000-02-06 Andrew Innes <andrewi@gnu.org>
-
- * inc/sys/time.h: Add inclusion protection.
-
- * makefile.def (SYS_LDFLAGS): Add -nologo.
-
-1999-11-22 Andrew Innes <andrewi@gnu.org>
-
- * install.bat: Pass on command line arguments to make.
-
- * makefile.nt (fast_install): Bring commands up-to-date, and fix
- typo.
-
-1999-11-21 Andrew Innes <andrewi@gnu.org>
-
- * makefile.nt (all): Build leim if present.
- (install): Install leim if present.
- (clean): Clean leim if present.
-
- * addpm.c (env_vars): Include leim in default EMACSLOADPATH
- definition.
-
- * emacs.bat.in (EMACSLOADPATH): Include leim.
-
-1999-07-12 Richard Stallman <rms@gnu.org>
-
- * Version 20.4 released.
-
-1999-06-16 Andrew Innes <andrewi@gnu.org>
-
- * emacs.rc: Use an icon with a transparent background, to be in
- keeping with other applications.
-
-1999-06-03 Andrew Innes <andrewi@gnu.org>
-
- * preprep.c: Fix typo.
-
-1999-05-02 Andrew Innes <andrewi@gnu.org>
-
- * config.h: Remove obsolete file.
-
- * preprep.c (copy_executable_and_move_sections): Ifdef out a
- couple of unused switch cases that aren't defined on all
- platforms.
-
- * ftime.bat: Add another variation of the profile command, which
- only profiles extended commands.
-
-1999-03-31 Geoff Voelker <voelker@cs.washington.edu>
-
- * cmdproxy.c (main): Fix parens.
-
-1999-03-25 Andrew Innes <andrewi@gnu.org>
-
- * cmdproxy.c (main): Call GetShortPathName to normalize program
- names for comparison.
-
-1999-03-05 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.def: Compile multiple .c files when possible.
- Use BLD instead of assuming i386.
- * makefile.nt: Remove common multiple file compilation commands.
-
-1999-03-04 Geoff Voelker <voelker@cs.washington.edu>
-
- * cmdproxy.c (main): Add missing parens.
-
-1999-02-20 Andrew Innes <andrewi@gnu.org>
-
- * preprep.c: New program to allow dumped image to be profiled.
-
- * makefile.nt (preprep): New target.
- (ALL): Build it.
-
- * makefile.def (ARCH_CFLAGS): Set struct packing to 8.
-
- * ftime.bat: Invoke preprep to prepare dumped image for profiling.
- Change prep options to profile libc functions and skip the startup
- code.
-
-1999-02-15 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.nt: Create installation directory as first step.
-
-1999-01-31 Andrew Innes <andrewi@gnu.org>
-
- * addsection.c: (ROUND_UP_DST_AND_ZERO): Renamed from
- ROUND_UP_DST. Zeroes the alignment slop.
- (copy_executable_and_add_section): Update the
- SizeOfHeaders field properly.
-
-1999-01-27 Andrew Innes <andrewi@gnu.org>
-
- * makefile.nt: Do make version comparison as strings.
-
-1999-01-26 Andrew Innes <andrewi@harlequin.co.uk>
-
- * runemacs.c (WinMain): Pass explicit environment block to
- CreateProcess, to work around a bug in Windows 95/98.
-
-1999-01-22 Geoff Voelker <voelker@cs.washington.edu>
-
- * icons: New directory with Davenport's icons.
- icons/sink.ico: Renamed from emacs.ico.
-
- * makefile.nt (install, fast_install): Install Windows icons
- into etc/icons.
-
- * emacs.rc (ICON): Use icons/gnu2a32.ico as the default icon.
-
-1999-01-17 Andrew Innes <andrewi@gnu.org>
-
- * makefile.nt: (ALL): List top-level targets.
- (addsection): New top-level target.
- (install): Copy fns-*.el to bin directory.
-
- * addsection.c: New program to add static heap section to
- temacs.exe after linking, in support of new unexec method.
-
-1998-12-28 Andrew Innes <andrewi@delysid.gnu.org>
-
- * cmdproxy.c (spawn): Pass directory for child as parameter.
- (main): Save startup directory to give to spawn, then change
- directory to location of .exe in order not to prevent startup
- directory from being deleted.
-
-1998-12-08 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.nt: Do string comparision of _NMAKE_VER.
-
-1998-12-02 Geoff Voelker <voelker@cs.washington.edu>
-
- * config.nt (LOCALTIME_CACHE): Define.
-
-1998-11-13 Andrew Innes <andrewi@delysid.gnu.org>
-
- * install.bat: Convert to DOS format.
-
-1998-11-10 Andrew Innes <andrewi@harlequin.co.uk>
-
- * cmdproxy.c (main): Set environment size only when running
- command.com.
-
-1998-11-03 Theodore Jump <tjump@tertius.com>
-
- * makefile.def (SYS_LDFLAGS): Use swapfile when running from cd or net.
- (DEL_TREE): Use rd instead of rmdir.
- (ARCH_CFLAGS): Optimize for P6. Align structures on 8-byte boundaries.
- * makefile.nt: Compile multiple source files when possible.
-
-1998-10-05 Geoff Voelker <voelker@cs.washington.edu>
-
- * cmdproxy.c (main): Treat command line options as case-insensitive.
-
-1998-08-19 Richard Stallman <rms@psilocin.ai.mit.edu>
-
- * Version 20.3 released.
-
-1998-07-20 Geoff Voelker <voelker@cs.washington.edu>
-
- * addpm.c (main): Explicitly check result of message box for OK.
-
-1998-06-05 Andrew Innes <andrewi@harlequin.co.uk>
-
- * inc/sys/file.h (D_OK): Define new macro.
-
-1998-06-01 Andrew Innes <andrewi@mescaline.gnu.org>
-
- * makefile.def (CFLAGS): Do not define HAVE_NTGUI.
-
-1998-05-30 Geoff Voelker <voelker@cs.washington.edu>
-
- * emacs.rc (VS_VERSION_INFO): Define.
-
-1998-04-23 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.nt (emacs.bat, debug.bat): Create them in the
- installation directory.
-
-1998-04-23 Andrew Innes <andrewi@harlequin.co.uk>
-
- * ddeclient.c: New file. (Support program for performing limited
- interprocess communication on Windows.)
-
- * makefile.nt: Build ddeclient.
-
- * cmdproxy.c (main): Only set environment size for real shell, and
- provide extra directory argument, when running on Windows 95.
-
-1998-04-17 Geoff Voelker <voelker@cs.washington.edu>
-
- * cmdproxy.c (fail): Exit with a negative return value.
- (spawn): Return subprocess return code as an argument.
- Explicitly copy environment block.
- (main): Update to use return value argument with spawn.
- Retry if spawn failed when a subshell was not tried.
-
- * config.nt: Include new macros from src/config.in.
- (GNU_MALLOC, REL_ALLOC): Define.
- (RE_TRANSLATE_TYPE): Use Lisp_Object as type.
- (RE_TRANSLATE): Use char_table_translate.
-
- * makefile.def (CP_DIR): Preserve attributes.
-
- * makefile.nt (clean): Delete patch generated files, optimized
- build directory.
-
-1997-10-01 Geoff Voelker <voelker@cs.washington.edu>
-
- * addpm.c (env_vars): Fix misplaced % in SHELL entry.
-
-1997-09-19 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * Version 20.2 released.
-
-1997-09-15 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * Version 20.1 released.
-
-1997-09-11 Geoff Voelker <voelker@cs.washington.edu>
-
- * debug.bat.in: New file.
- * makefile.nt (debug.bat): New target.
-
-1997-09-02 Andrew Innes <andrewi@harlequin.co.uk>
-
- * addpm.c (env_vars): Put site-lisp before lisp in EMACSLOADPATH.
- Quote group name. Allow different icons to be specified.
-
- * cmdproxy.c (get_env_size): New function.
- (spawn): Explicitly pass in environment when creating subprocess.
- (main): Cleaup error messages.
- Specify dynamically sized environment block for real shell.
- Pass on unhandled switches to real shell.
- Quote program name.
-
- * makefile.def (CFLAGS_COMMON): Place pdb file in object build
- directory.
- (CFLAGS) [!MSVCNT11]: Define _CRTAPI1.
-
- * runemacs.c (WinMain): Allow Emacs process to be started with
- high or low priority.
-
- * emacs.bat.in: Remove OS dependent operations.
-
-1997-09-02 Geoff Voelker <voelker@cs.washington.edu>
-
- * addpm.c (env_vars): No longer set INFOPATH.
-
- * cmdproxy.c (get_next_token): Null terminate token returned.
-
- * emacs.bat.in (INFOPATH): No longer set INFOPATH.
-
-1997-08-10 Andrew Innes <andrewi@harlequin.co.uk>
-
- * addpm.c (env_vars): Set SHELL to cmdproxy.
- (main): Initialize idDde to 0.
- Determine emacs_path from module file name.
- Prompt for install.
-
- * makefile.def (MSVCNT11): Conditionally define it.
- (BASE_LIBS): Do not use oldnames.lib.
- (SYS_LDFLAGS): Use pdb files.
- (CFLAGS_COMMON) [!spd]: Define EMACSDEBUG.
- (ARCH_CFLAGS) [i386 && spd]: Use space optimizations.
- (ARCH_CFLAGS) [alpha && spd]: Use optimizations.
-
- * makefile.nt (ALL): Build cmdproxy.
- (cmdproxy): New target.
- (install): Install cmdproxy.
-
- * ftime.bat, debug.bat, cmdproxy.c: New files.
-
-1997-07-10 Geoff Voelker <voelker@cs.washington.edu>
-
- * inc/sys/socket.h: (shutdown): Define.
- (sys_shutdown): Export.
-
-1997-07-08 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * config.nt (RE_TRANSLATE): Copy definition from config.in.
-
-1997-07-01 Geoff Voelker <voelker@cs.washington.edu>
-
- * config.nt: Update file comments.
- Update undefs added/removed in src/config.in.
-
-1997-06-19 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefil.def, emacs.bat: Use windows95 and windowsnt instead
- of win95 and winnt, respectively.
-
-1997-01-04 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.nt (real_install): Create site-lisp in installation dir.
- * addpm.c (env_vars): Add site-lisp to EMACSLOADPATH.
- * emacs.bat.in: Add site-lisp to EMACSLOADPATH.
-
-1996-08-11 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * Version 19.33 released.
-
-1996-08-09 Geoff Voelker <voelker@cs.washington.edu>
-
- * runemacs.c (WinMain): Put a space between the binary and its args.
-
-1996-07-31 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
-
- * Version 19.32 released.
-
-1996-07-16 Andrew Innes <andrewi@harlequin.co.uk>
-
- * makefile.nt (clean): Use OBJDIR macro.
-
-1996-06-03 Kim F. Storm <kfs@olicom.dk>
-
- * runemacs.c (CHOOSE_NEWEST_EXE): New parameter macro.
- Not defined by default.
- (WinMain): Add conditional testing CHOOSE_NEWEST_EXE.
- (WinMain): Convert backslashes to slashes in env var values.
-
- * addpm.c (env_vars): Use slashes, not backslashes.
-
-1996-05-25 Karl Heuer <kwzh@gnu.ai.mit.edu>
-
- * Version 19.31 released.
-
-1996-05-13 Andrew Innes <andrewi@harlequin.co.uk>
-
- * install.bat: Set BUILD_TYPE and INSTALL_DIR before calling make;
- undo settings afterwards.
-
-1996-05-08 Andrew Innes <andrewi@harlequin.co.uk>
-
- * addpm.c (env_vars): Set SHELL registry entry to value of COMSPEC
- environment variable.
-
-1996-05-03 Andrew Innes <andrewi@harlequin.co.uk>
-
- * install.bat: Allow for optimized build.
- * makefile.def [BUILD_TYPE]: Build optimized version in its own dir.
- (ARCH_CFLAGS) [BUILD_TYPE == spd]: Build optimized version.
-
-1996-05-03 Andrew Innes <andrewi@harlequin.co.uk>
-
- * addpm.c (REG_ROOT): Don't use a trailing backslash.
- (env_vars): Rename field emacs_path to emacs_dir.
- (main): Add link to runemacs instead of emacs.
-
- * install.bat: Check if INSTALL_DIR is passed as an argument.
-
- * makefile.def (CONFIG_H) [WIN95]: Use config.nt.
-
- * makefile.nt: Build and install runemacs.exe.
-
- * runemacs.c: New file.
-
- * config.w95: File removed.
-
- * inc/netdb.h, inc/unistd.h, inc/arpa/inet.h, inc/netinet/in.h,
- inc/sys/socket.h, inc/sys/time.h: New header files.
-
- * inc/sys/file.h (F_OK, X_OK, W_OK, R_OK): New macros.
-
-1996-03-27 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.def (DEL): Defined.
- (DEL_TREE) [win95]: Defined.
- (SYS_LDFLAGS): Set executable versions to 3.10.
-
- * makefile.nt: Change uses of del to $(DEL).
-
-1996-01-17 Erik Naggum <erik@naggum.no>
-
- * All files: Update FSF's address in comment preamble.
-
-1996-01-03 George V. Reilly <georger@microcrafts.com>
-
- * emacs.ico: Now the proverbial kitchen sink icon.
-
-1995-11-24 Richard Stallman <rms@mole.gnu.ai.mit.edu>
-
- * Version 19.30 released.
-
-1995-11-22 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.def (CP_DIR): Use platform independent switches for xcopy.
-
- * makefile.nt (install, fast_install, real_install, clean):
- Don't use switches to del not supported by Win95.
-
-1995-11-07 Kevin Gallo <kgallo@microsoft.com>
-
- * makefile.nt (addpm.exe): Link with $(ADVAPI32).
- (install, fast_install): Change same-dir test to create test file in
- installation tree and thereby support read-only shares.
- (clean): Remove .pdb files.
-
- * makefile.def (NTGUI): New macro.
- [NTGUI] (CFLAGS): Define HAVE_NTGUI.
-
- * config.nt, config.w95: Update to latest src/config.in.
-
- * addpm.c (env_vars): New variable.
- (add_registry): New procedure.
- (main): Use values of configuration environment variables from
- the registry if defined, the process environment otherwise.
-
-1995-06-19 Richard Stallman <rms@mole.gnu.ai.mit.edu>
-
- * Version 19.29 released.
-
- * makefile.nt (addpm.exe): Change WinMainCRTStartup to mainCRTStartup.
-
-1995-06-13 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.nt: Define .c to .obj suffix rule.
- (addpm.obj): Compile directly, use CFLAGS.
- (addpm.exe): Link from addpm.obj.
-
- * makefile.def (MSVCNT11): Defined.
- (BASE_LIBS) [MSVCNT11]: Use oldnames.lib.
- (CFLAGS_COMMON): Defined.
- (CFLAGS) [MSVCNT11]: Define _CRTAPI1 to _cdecl.
-
-1995-06-09 Geoff Voelker <voelker@cs.washington.edu>
-
- * emacs.bat.in: Renamed from emacs.bat
- (emacs_dir): Renamed from emacs_path
- Definition removed.
-
- * addpm.c: New file.
- * makefile.nt (ALL,addpm,addpm.exe,addpm.obj): Defined.
- (all): Depend upon $(BLD) and $(ALL).
- (install): Depend upon emacs.bat.
- Create program item for Emacs.
- (clean): Delete obj.
- (emacs.bat): Defined.
- * makefile.def (EMACS_ICON_PATH,ADDPM): Defined.
-
-1995-05-27 Geoff Voelker <voelker@cs.washington.edu>
-
- * ebuild.bat, emacs.bat, fast-install.bat, install.bat:
- Add carriage returns; necessary for batch files on Win95.
-
-1995-05-25 Geoff Voelker <voelker@cs.washington.edu>
-
- * config.w95: Created.
- * config.h: Changed to config.nt.
-
- * makefile.nt (SUBDIRS): Commented out.
- (all,install,clean): Expand for-loops.
- (BUILD_CMD,INSTALL_CMD,CLEAN_CMD): Defined.
-
- * makefile.def (SYS_LIB_DIR,SYS_INC_DIR): Undefined.
- (ARCH): New definition.
- (CPU,CONFIG_H,OS_TYPE): Defined.
- (INCLUDE,LIB): Checked if valid.
- (ntwin32.mak): Included.
- (AR,CC,LINK): New definition.
- (ADVAPI32,libc,BASE_LIBS): Defined.
- (SYS_LDFLAGS): New definition.
- Update comments and preprocessor conditionals.
-
- * emacs.bat (SHELL): Conditionally defined.
- (HOME): Conditionally defined.
- (emacs_path,HOME): Update comments.
- Turn off all echo.
-
-1995-05-09 Geoff Voelker <voelker@cs.washington.edu>
-
- * _emacs, config.h, ebuild.bat, emacs.bat, emacs.rc,
- fast-install.bat, install.bat, makefile.def, makefile.nt, paths.h,
- inc/pwd.h, inc/sys/dir.h, inc/sys/file.h, inc/sys/ioctl.h,
- inc/sys/param.h: Removed carriage-returns.
-
-1995-05-06 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.def (CVTRES): Defined.
-
- * emacs.ico, emacs.rc: New files by Kevin Gallo.
-
-1995-04-10 Geoff Voelker <voelker@cs.washington.edu>
-
- * src: Remove directory.
-
- * src\config.h, src\paths.h: Moved to parent dir, src removed.
-
-1995-04-09 Geoff Voelker <voelker@cs.washington.edu>
-
- * makefile.def (INSTALL_DIR): Changed to generic directory.
-
- * emacs.bat: Added arguments when emacs.exe invoked.
-
- * ebuild.cmd, emacs.cmd, install.cmd: Changed extension to .bat.
-
-1994-12-13 voelker <voelker@cs.washington.edu>
-
- * makefile.def (CC): In configuration section.
- (COMPAT_LIB): Defined.
-
-1994-11-01 voelker <voelker@cs.washington.edu>
-
- * src/paths.h: New file.
-
- * src/config.h: New file.
-
- * inc/pwd.h: New file.
-
- * inc/sys/dir.h: New file.
-
- * inc/sys/file.h: New file.
-
- * inc/sys/ioctl.h: New file.
-
- * inc/sys/param.h: New file.
-
- * todo: New file.
-
- * README: New file.
-
- * makefile.nt: New file.
-
- * makefile.def: New file.
-
- * install.cmd: New file.
-
- * INSTALL: New file.
-
- * fast-install.cmd: New file.
-
- * emacs.cmd: New file.
-
- * ebuild.cmd: New file.
-
- * _emacs: New file.
-
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; End:
-
- Copyright (C) 1995, 1996, 1997, 1998, 1999, 2001
- Free Software Foundation, Inc.
- Copying and distribution of this file, with or without modification,
- are permitted provided the copyright notice and this notice are preserved.
+++ /dev/null
- Building and Installing Emacs
- on Windows NT/2000 and Windows 95/98/ME
-
- Copyright (c) 2001 Free Software Foundation, Inc.
- See the end of the file for copying permissions.
-
- If you used WinZip to unpack the distribution, we suggest to
- remove the files and unpack again with a different program!
- WinZip is known to create some subtle and hard to debug problems,
- such as converting files to DOS CR-LF format, not creating empty
- directories, etc. We suggest to use djtarnt.exe from the GNU FTP
- site.
-
- To compile Emacs, you will need either Microsoft Visual C++ 2.0 or
- later and nmake, or a Windows port of GCC 2.95 or later with Mingw
- and W32 API support and a port of GNU make. You can use the Cygwin
- ports of GCC, but Emacs requires the Mingw headers and libraries to
- build (latest versions of the Cygwin toolkit, at least since v1.3.3,
- include the MinGW headers and libraries as an integral part).
-
- Other compilers may work, but specific reports from people that have
- tried suggest that the Intel C compiler (for example) may produce an
- Emacs executable with strange filename completion behaviour. Unless
- you would like to assist by finding and fixing the cause of any bugs
- like this, we recommend the use of the supported compilers mentioned
- in the previous paragraph.
-
- If you build Emacs on Windows 9X or ME, not on Windows 2000 or
- Windows NT, we suggest to install the Cygwin port of Bash.
-
- Please see http://www.mingw.org for pointers to GCC/Mingw binaries.
-
- For reference, here is a list of which builds of GNU make are known
- to work or not, and whether they work in the presence and/or absence
- of sh.exe, the Cygwin port of Bash. Note that any version of make
- that is compiled with Cygwin will only work with Cygwin tools, due to
- the use of cygwin style paths. This means Cygwin make is unsuitable
- for building parts of Emacs that need to invoke Emacs itself (leim and
- "make bootstrap", for example). Also see the Trouble-shooting section
- below if you decide to go ahead and use Cygwin make.
-
- In addition, using 4NT as your shell is known to fail the build process,
- at least for 4NT version 3.01. Use cmd.exe, the default NT shell,
- instead.
-
- sh exists no sh
-
- cygwin b20.1 make (3.75): fails[1, 5] fails[2, 5]
- MSVC compiled gmake 3.77: okay okay
- MSVC compiled gmake 3.78.1: okay okay
- MSVC compiled gmake 3.79.1: okay okay
- mingw32/gcc-2.92.2 make (3.77): okay okay[4]
- cygwin compiled gmake 3.77: fails[1, 5] fails[2, 5]
- cygwin compiled make 3.78.1: fails[5] fails[2, 5]
- cygwin compiled make 3.79.1: fails[3, 5] fails[2?, 5]
- mingw32 compiled make 3.79.1: okay okay
-
- Notes:
-
- [1] doesn't cope with makefiles with DOS line endings, so must mount
- emacs source with text!=binary.
- [2] fails when needs to invoke shell commands; okay invoking gcc etc.
- [3] requires LC_MESSAGES support to build; cannot build with early
- versions of cygwin.
- [4] may fail on Windows 9X and Windows ME; if so, install Bash.
- [5] fails when building leim due to the use of cygwin style paths.
- May work if building emacs without leim.
-
-* Configuring
-
- Configuration of Emacs is now handled by running configure.bat in the
- nt subdirectory. It will detect which compiler you have available,
- and generate makefiles accordingly. You can override the compiler
- detection, and control optimization and debug settings, by specifying
- options on the command line when invoking configure.
-
- To configure Emacs to build with GCC or MSVC, whichever is available,
- simply change to the nt subdirectory and run `configure' with no
- options. To see what options are available, run `configure --help'.
-
- N.B. It is normal to see a few error messages output while configure
- is running, when gcc support is being tested. These cannot be
- surpressed because of limitations in the Windows 9x command.com shell.
-
-* Optional image library support
-
- To build Emacs with support for PNG images, the libpng and zlib
- headers must be in the include path when the configure script is
- run. This can be setup using environment variables, or by
- specifying --cflags -I... options on the command-line to
- configure.bat. Similarly, the jpeg-6b, libXpm, tiff and libungif
- headers need to be in the include path for support for those image
- formats to work. The configure script will report whether it was
- able to detect the headers.
-
- To use the PNG support, zlib.dll (or zlibd.dll) and libpng.dll (or
- libpng13.dll, or libpng13d.dll) must be on the PATH or in the same
- directory as emacs.exe when Emacs is started. Similar instructions
- apply for other image libraries. Note that tiff support depends on
- the jpeg library. If you did not compile the libraries yourself, you
- must make sure that the jpeg library you install is the same one
- that the tiff library was compiled against.
-
-* Building
-
- After running configure, simply run the appropriate `make' program for
- your compiler to build Emacs. For MSVC, this is nmake; for GCC, it is
- GNU make.
-
- As the files are compiled, you will see some warning messages
- declaring that some functions don't return a value, or that some data
- conversions will be lossy, etc. You can safely ignore these messages.
- The warnings may be fixed in the main FSF source at some point, but
- until then we will just live with them.
-
-* Installing
-
- To install Emacs after it has compiled, simply run `nmake install'
- or `make install', depending on which version of the Make utility
- do you have.
-
- By default, Emacs will be installed in the location where it was
- built, but a different location can be specified either using the
- --prefix option to configure, or by setting INSTALL_DIR when running
- make, like so:
-
- make install INSTALL_DIR=D:/emacs
-
- (for `nmake', type "nmake install INSTALL_DIR=D:/emacs" instead).
-
- The install process will run addpm to setup the registry entries, and
- to create a Start menu icon for Emacs.
-
-* Trouble-shooting
-
- The main problems that are likely to be encountered when building
- Emacs stem from using an old version of GCC, or old Mingw or W32 API
- headers. Additionally, cygwin ports of GNU make may require the Emacs
- source tree to be mounted with text!=binary, because the makefiles
- generated by configure.bat necessarily use DOS line endings. Also,
- cygwin ports of make must run in UNIX mode, either by specifying
- --unix on the command line, or MAKE_MODE=UNIX in the environment.
-
- When configure runs, it attempts to detect when GCC itself, or the
- headers it is using, are not suitable for building Emacs. GCC version
- 2.95 or later is needed, because that is when the Windows port gained
- sufficient support for anonymous structs and unions to cope with some
- definitions from winnt.h that are used by addsection.c. The W32 API
- headers that come with Cygwin b20.1 are incomplete, and do not include
- some definitions required by addsection.c, for instance. Also, older
- releases of the W32 API headers from Anders Norlander contain a typo
- in the definition of IMAGE_FIRST_SECTION in winnt.h, which
- addsection.c relies on. Versions of w32api-xxx.zip from at least
- 1999-11-18 onwards are okay.
-
- If configure succeeds, but make fails, install the Cygwin port of
- Bash, even if the table above indicates that Emacs should be able to
- build without sh.exe. (Some versions of Windows shells are too dumb
- for Makefile's used by Emacs.)
-
- If you are using certain Cygwin builds of GCC, such as Cygwin version
- 1.1.8, you may need to specify some extra compiler flags like so:
-
- configure --with-gcc --cflags -mwin32 --cflags -D__MSVCRT__
- --ldflags -mwin32
-
- However, the latest Cygwin versions, such as 1.3.3, don't need those
- switches; you can simply use "configure --with-gcc".
-
- We will attempt to auto-detect the need for these flags in a future
- release.
-
-* Debugging
-
- You should be able to debug Emacs using the debugger that is
- appropriate for the compiler you used, namely DevStudio or Windbg if
- compiled with MSVC, or gdb if compiled with gcc.
-
- Emacs functions implemented in C use a naming convention that reflects
- their names in lisp. The names of the C routines are the lisp names
- prefixed with 'F', and with dashes converted to underscores. For
- example, the function call-process is implemented in C by
- Fcall_process. Similarly, lisp variables are prefixed with 'V', again
- with dashes converted to underscores. These conventions enable you to
- easily set breakpoints or examine familiar lisp variables by name.
-
- Since Emacs data is often in the form of a lisp object, and the
- Lisp_Object type is difficult to examine manually in the MSVC
- debugger, Emacs provides a helper routine called debug_print that
- prints out a readable representation of a Lisp_Object. (If you are
- using gdb, there is a .gdbinit file in the src directory which
- provides definitions that are useful for examining lisp objects. The
- following tips are mainly of interest when using MSVC.) The output
- from debug_print is sent to stderr, and to the debugger via the
- OutputDebugString routine. The output sent to stderr should be
- displayed in the console window that was opened when the emacs.exe
- executable was started. The output sent to the debugger should be
- displayed in its "Debug" output window.
-
- When you are in the process of debugging Emacs and you would like to
- examine the contents of a Lisp_Object variable, popup the QuickWatch
- window (QuickWatch has an eyeglass symbol on its button in the
- toolbar). In the text field at the top of the window, enter
- debug_print(<variable>) and hit return. For example, start and run
- Emacs in the debugger until it is waiting for user input. Then click
- on the Break button in the debugger to halt execution. Emacs should
- halt in ZwUserGetMessage waiting for an input event. Use the Call
- Stack window to select the procedure w32_msp_pump up the call stack
- (see below for why you have to do this). Open the QuickWatch window
- and enter debug_print(Vexec_path). Evaluating this expression will
- then print out the contents of the lisp variable exec-path.
-
- If QuickWatch reports that the symbol is unknown, then check the call
- stack in the Call Stack window. If the selected frame in the call
- stack is not an Emacs procedure, then the debugger won't recognize
- Emacs symbols. Instead, select a frame that is inside an Emacs
- procedure and try using debug_print again.
-
- If QuickWatch invokes debug_print but nothing happens, then check the
- thread that is selected in the debugger. If the selected thread is
- not the last thread to run (the "current" thread), then it cannot be
- used to execute debug_print. Use the Debug menu to select the current
- thread and try using debug_print again. Note that the debugger halts
- execution (e.g., due to a breakpoint) in the context of the current
- thread, so this should only be a problem if you've explicitly switched
- threads.
-
-COPYING PERMISSIONS
-
- Permission is granted to anyone to make or distribute verbatim copies
- of this document as received, in any medium, provided that the
- copyright notice and permission notice are preserved,
- and that the distributor grants the recipient permission
- for further redistribution as permitted by this notice.
-
- Permission is granted to distribute modified versions
- of this document, or of portions of it,
- under the above conditions, provided also that they
- carry prominent notices stating who last changed them,
- and that any new or changed statements about the activities
- of the Free Software Foundation are approved by the Foundation.
+++ /dev/null
- Emacs for Windows NT/2000 and Windows 95/98/ME
-
- Copyright (c) 2001 Free Software Foundation, Inc.
- See the end of the INSTALL file in this directory for copying permissions.
-
- This directory contains support for compiling and running GNU Emacs on
- Windows NT, Windows 95, and their successors. This port supports all
- of the major functionality of the Unix version, including
- subprocesses, windowing features (fonts, colors, scroll bars, multiple
- frames, etc.), and networking support.
-
- Precompiled distributions are also available; ftp to
-
- ftp://ftp.gnu.org/gnu/windows/emacs/latest/
-
- for the latest precompiled distributions.
-
-* Building and installing
-
- See the INSTALL file in this directory for detailed instructions on
- building and installing Emacs on your system.
-
-* Further information
-
- There is a web page that serves as a FAQ for the Windows port of
- Emacs (a.k.a. NTEmacs) at:
-
- http://www.gnu.org/software/emacs/windows/ntemacs.html
-
- There is also a mailing list for discussing issues related to this
- port of Emacs. For information about the list, see this Web page:
-
- http://mail.gnu.org/mailman/listinfo/help-emacs-windows
-
- To ask questions on the mailing list, send email to
- help-emacs-windows@gnu.org. (You don't need to subscribe for that.)
- To subscribe to the list or unsubscribe from it, fill the form you
- find at http://mail.gnu.org/mailman/listinfo/help-emacs-windows as
- explained there.
-
- Another valuable source of information and help which should not be
- overlooked is the various Usenet news groups dedicated to Emacs.
- These are particularly good for help with general issues which aren't
- specific to the Windows port of Emacs. The main news groups to use
- for seeking help are:
-
- gnu.emacs.help
- comp.emacs
-
- There are also fairly regular postings and announcements of new or
- updated Emacs packages on this group:
-
- gnu.emacs.sources
-
-* Reporting bugs
-
- If you encounter a bug in this port of Emacs, we would like to hear
- about it. First check the file etc/PROBLEMS and the FAQ on the web
- page above to see if the bug is already known and if there are any
- workarounds. If not, then check whether the bug has something to do
- with code in your .emacs file, e.g. by invoking Emacs with the "-q
- --no-site-file" options.
-
- If you decide that it is a bug in Emacs that might be specific to the
- Windows port, send a message to the help-emacs-windows@gnu.org
- mailing list describing the bug, the version of Emacs that you are
- using, and the operating system that you are running on (Windows NT,
- 95 or 98 including service pack level if known). If the bug is
- related to subprocesses, also specify which shell you are using (e.g.,
- include the values of `shell-file-name' and `shell-explicit-file-name'
- in your message).
-
- If you think the bug is not specific to the Windows port of Emacs,
- then it is better to mail the bug report to bug-gnu-emacs@gnu.org so
- that it will be seen by the right people. If Emacs has been set up to
- send mail, you can use the command M-x report-emacs-bug to create and
- send the bug report, but in some cases there is a function to report
- bugs in a specific package; e.g. M-x gnus-bug for Gnus, M-x
- c-submit-bug-report for C/C++/Java mode, etc.
+++ /dev/null
-/* Add entries to the GNU Emacs Program Manager folder.
- Copyright (C) 1995 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/****************************************************************************
- *
- * Program: addpm (adds emacs to the Windows program manager)
- *
- * Usage:
- * argv[1] = install path for emacs
- * argv[2] = full path to icon for emacs (optional)
- */
-
-#include <windows.h>
-#include <ddeml.h>
-#include <stdlib.h>
-#include <stdio.h>
-
-HDDEDATA CALLBACK
-DdeCallback (UINT uType, UINT uFmt, HCONV hconv,
- HSZ hsz1, HSZ hsz2, HDDEDATA hdata,
- DWORD dwData1, DWORD dwData2)
-{
- return ((HDDEDATA) NULL);
-}
-
-#define DdeCommand(str) \
- DdeClientTransaction (str, strlen (str)+1, HConversation, (HSZ)NULL, \
- CF_TEXT, XTYP_EXECUTE, 30000, NULL)
-
-#define REG_ROOT "SOFTWARE\\GNU\\Emacs"
-
-static struct entry
-{
- char *name;
- char *value;
-}
-env_vars[] =
-{
- {"emacs_dir", NULL},
- {"EMACSLOADPATH", "%emacs_dir%/site-lisp;%emacs_dir%/../site-lisp;%emacs_dir%/lisp;%emacs_dir%/leim"},
- {"SHELL", "%emacs_dir%/bin/cmdproxy.exe"},
- {"EMACSDATA", "%emacs_dir%/etc"},
- {"EMACSPATH", "%emacs_dir%/bin"},
- /* We no longer set INFOPATH because Info-default-directory-list
- is then ignored. */
- /* {"INFOPATH", "%emacs_dir%/info"}, */
- {"EMACSDOC", "%emacs_dir%/etc"},
- {"TERM", "cmd"}
-};
-
-BOOL
-add_registry (path)
- char *path;
-{
- HKEY hrootkey = NULL;
- DWORD dwDisp;
- int i;
- BOOL ok = TRUE;
-
- /* Check both the current user and the local machine to see if we
- have any resources. */
-
- if (RegCreateKeyEx (HKEY_LOCAL_MACHINE, REG_ROOT,
- 0, "", REG_OPTION_NON_VOLATILE,
- KEY_WRITE, NULL, &hrootkey, &dwDisp) != ERROR_SUCCESS
- && RegCreateKeyEx (HKEY_CURRENT_USER, REG_ROOT,
- 0, "", REG_OPTION_NON_VOLATILE,
- KEY_WRITE, NULL, &hrootkey, &dwDisp) != ERROR_SUCCESS)
- {
- return FALSE;
- }
-
- for (i = 0; i < (sizeof (env_vars) / sizeof (env_vars[0])); i++)
- {
- char * value = env_vars[i].value ? env_vars[i].value : path;
-
- if (RegSetValueEx (hrootkey, env_vars[i].name,
- 0, REG_EXPAND_SZ,
- value, lstrlen (value) + 1) != ERROR_SUCCESS)
- ok = FALSE;
- }
-
- RegCloseKey (hrootkey);
-
- return (ok);
-}
-
-int
-main (argc, argv)
- int argc;
- char *argv[];
-{
- DWORD idDde = 0;
- HCONV HConversation;
- HSZ ProgMan;
- char modname[MAX_PATH];
- char additem[MAX_PATH*2 + 100];
- char *prog_name;
- char *emacs_path;
- char *p;
- int quiet = 0;
-
- /* If no args specified, use our location to set emacs_path. */
-#if 0
- if (argc < 2 || argc > 3)
- {
- fprintf (stderr, "usage: addpm [/q] [emacs_path [icon_path]]\n");
- exit (1);
- }
-#endif
-
- if (argc > 1 && argv[1][0] == '/' && argv[1][1] == 'q')
- {
- quiet = 1;
- --argc;
- ++argv;
- }
-
- if (argc > 1)
- emacs_path = argv[1];
- else
- {
- if (!GetModuleFileName (NULL, modname, MAX_PATH) ||
- (p = strrchr (modname, '\\')) == NULL)
- {
- fprintf (stderr, "fatal error");
- exit (1);
- }
- *p = 0;
-
- /* Set emacs_path to emacs_dir if we are in "%emacs_dir%\bin". */
- if ((p = strrchr (modname, '\\')) && stricmp (p, "\\bin") == 0)
- {
- *p = 0;
- emacs_path = modname;
- }
- else
- {
- fprintf (stderr, "usage: addpm emacs_path [icon_path]\n");
- exit (1);
- }
-
- /* Tell user what we are going to do. */
- if (!quiet)
- {
- int result;
-
- char msg[ MAX_PATH ];
- sprintf (msg, "Install Emacs at %s?\n", emacs_path);
- result = MessageBox (NULL, msg, "Install Emacs",
- MB_OKCANCEL | MB_ICONQUESTION);
- if (result != IDOK)
- {
- fprintf (stderr, "Install cancelled\n");
- exit (1);
- }
- }
- }
-
- add_registry (emacs_path);
- prog_name = "runemacs.exe";
-
- DdeInitialize (&idDde, (PFNCALLBACK)DdeCallback, APPCMD_CLIENTONLY, 0);
-
- ProgMan = DdeCreateStringHandle (idDde, "PROGMAN", CP_WINANSI);
-
- HConversation = DdeConnect (idDde, ProgMan, ProgMan, NULL);
- if (HConversation != 0)
- {
- DdeCommand ("[CreateGroup (\"Gnu Emacs\")]");
- DdeCommand ("[ReplaceItem (Emacs)]");
- if (argc > 2)
- sprintf (additem, "[AddItem (\"%s\\bin\\%s\", Emacs, \"%s\")]",
- emacs_path, prog_name, argv[2]);
- else
- sprintf (additem, "[AddItem (\"%s\\bin\\%s\", Emacs)]",
- emacs_path, prog_name);
- DdeCommand (additem);
-
- DdeDisconnect (HConversation);
- }
-
- DdeFreeStringHandle (idDde, ProgMan);
-
- DdeUninitialize (idDde);
-
- return (0);
-}
+++ /dev/null
-/* Add an uninitialized data section to an executable.
- Copyright (C) 1999 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.
-
- Andrew Innes <andrewi@harlequin.co.uk> 04-Jan-1999
- based on code from unexw32.c
-*/
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <fcntl.h>
-#include <time.h>
-#ifdef __GNUC__
-#define _ANONYMOUS_UNION
-#define _ANONYMOUS_STRUCT
-#endif
-#include <windows.h>
-
-/* Include relevant definitions from IMAGEHLP.H, which can be found
- in \\win32sdk\mstools\samples\image\include\imagehlp.h. */
-
-PIMAGE_NT_HEADERS
-(__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress,
- DWORD FileLength,
- LPDWORD HeaderSum,
- LPDWORD CheckSum);
-
-#undef min
-#undef max
-#define min(x, y) (((x) < (y)) ? (x) : (y))
-#define max(x, y) (((x) > (y)) ? (x) : (y))
-
-
-/* File handling. */
-
-typedef struct file_data {
- char *name;
- unsigned long size;
- HANDLE file;
- HANDLE file_mapping;
- unsigned char *file_base;
-} file_data;
-
-int
-open_input_file (file_data *p_file, char *filename)
-{
- HANDLE file;
- HANDLE file_mapping;
- void *file_base;
- unsigned long size, upper_size;
-
- file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL,
- OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
- if (file == INVALID_HANDLE_VALUE)
- return FALSE;
-
- size = GetFileSize (file, &upper_size);
- file_mapping = CreateFileMapping (file, NULL, PAGE_READONLY,
- 0, size, NULL);
- if (!file_mapping)
- return FALSE;
-
- file_base = MapViewOfFile (file_mapping, FILE_MAP_READ, 0, 0, size);
- if (file_base == 0)
- return FALSE;
-
- p_file->name = filename;
- p_file->size = size;
- p_file->file = file;
- p_file->file_mapping = file_mapping;
- p_file->file_base = file_base;
-
- return TRUE;
-}
-
-int
-open_output_file (file_data *p_file, char *filename, unsigned long size)
-{
- HANDLE file;
- HANDLE file_mapping;
- void *file_base;
-
- file = CreateFile (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL,
- CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
- if (file == INVALID_HANDLE_VALUE)
- return FALSE;
-
- file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE,
- 0, size, NULL);
- if (!file_mapping)
- return FALSE;
-
- file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size);
- if (file_base == 0)
- return FALSE;
-
- p_file->name = filename;
- p_file->size = size;
- p_file->file = file;
- p_file->file_mapping = file_mapping;
- p_file->file_base = file_base;
-
- return TRUE;
-}
-
-/* Close the system structures associated with the given file. */
-void
-close_file_data (file_data *p_file)
-{
- UnmapViewOfFile (p_file->file_base);
- CloseHandle (p_file->file_mapping);
- /* For the case of output files, set final size. */
- SetFilePointer (p_file->file, p_file->size, NULL, FILE_BEGIN);
- SetEndOfFile (p_file->file);
- CloseHandle (p_file->file);
-}
-
-
-/* Routines to manipulate NT executable file sections. */
-
-unsigned long
-get_unrounded_section_size (PIMAGE_SECTION_HEADER p_section)
-{
- /* The true section size, before rounding, for an initialized data or
- code section. (Supposedly some linkers swap the meaning of these
- two values.) */
- return min (p_section->SizeOfRawData,
- p_section->Misc.VirtualSize);
-}
-
-/* Return pointer to section header for named section. */
-IMAGE_SECTION_HEADER *
-find_section (char * name, IMAGE_NT_HEADERS * nt_header)
-{
- PIMAGE_SECTION_HEADER section;
- int i;
-
- section = IMAGE_FIRST_SECTION (nt_header);
-
- for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
- {
- if (strcmp (section->Name, name) == 0)
- return section;
- section++;
- }
- return NULL;
-}
-
-/* Return pointer to section header for section containing the given
- relative virtual address. */
-IMAGE_SECTION_HEADER *
-rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
-{
- PIMAGE_SECTION_HEADER section;
- int i;
-
- section = IMAGE_FIRST_SECTION (nt_header);
-
- for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
- {
- /* Some linkers (eg. the NT SDK linker I believe) swapped the
- meaning of these two values - or rather, they ignored
- VirtualSize entirely and always set it to zero. This affects
- some very old exes (eg. gzip dated Dec 1993). Since
- w32_executable_type relies on this function to work reliably,
- we need to cope with this. */
- DWORD real_size = max (section->SizeOfRawData,
- section->Misc.VirtualSize);
- if (rva >= section->VirtualAddress
- && rva < section->VirtualAddress + real_size)
- return section;
- section++;
- }
- return NULL;
-}
-
-/* Return pointer to section header for section containing the given
- offset in its raw data area. */
-IMAGE_SECTION_HEADER *
-offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header)
-{
- PIMAGE_SECTION_HEADER section;
- int i;
-
- section = IMAGE_FIRST_SECTION (nt_header);
-
- for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
- {
- if (offset >= section->PointerToRawData
- && offset < section->PointerToRawData + section->SizeOfRawData)
- return section;
- section++;
- }
- return NULL;
-}
-
-/* Return offset to an object in dst, given offset in src. We assume
- there is at least one section in both src and dst images, and that
- the some sections may have been added to dst (after sections in src). */
-static DWORD
-relocate_offset (DWORD offset,
- IMAGE_NT_HEADERS * src_nt_header,
- IMAGE_NT_HEADERS * dst_nt_header)
-{
- PIMAGE_SECTION_HEADER src_section = IMAGE_FIRST_SECTION (src_nt_header);
- PIMAGE_SECTION_HEADER dst_section = IMAGE_FIRST_SECTION (dst_nt_header);
- int i = 0;
-
- while (offset >= src_section->PointerToRawData)
- {
- if (offset < src_section->PointerToRawData + src_section->SizeOfRawData)
- break;
- i++;
- if (i == src_nt_header->FileHeader.NumberOfSections)
- {
- /* Handle offsets after the last section. */
- dst_section = IMAGE_FIRST_SECTION (dst_nt_header);
- dst_section += dst_nt_header->FileHeader.NumberOfSections - 1;
- while (dst_section->PointerToRawData == 0)
- dst_section--;
- while (src_section->PointerToRawData == 0)
- src_section--;
- return offset
- + (dst_section->PointerToRawData + dst_section->SizeOfRawData)
- - (src_section->PointerToRawData + src_section->SizeOfRawData);
- }
- src_section++;
- dst_section++;
- }
- return offset +
- (dst_section->PointerToRawData - src_section->PointerToRawData);
-}
-
-#define OFFSET_TO_RVA(offset, section) \
- (section->VirtualAddress + ((DWORD)(offset) - section->PointerToRawData))
-
-#define RVA_TO_OFFSET(rva, section) \
- (section->PointerToRawData + ((DWORD)(rva) - section->VirtualAddress))
-
-#define RVA_TO_SECTION_OFFSET(rva, section) \
- ((DWORD)(rva) - section->VirtualAddress)
-
-/* Convert address in executing image to RVA. */
-#define PTR_TO_RVA(ptr) ((DWORD)(ptr) - (DWORD) GetModuleHandle (NULL))
-
-#define PTR_TO_OFFSET(ptr, pfile_data) \
- ((unsigned char *)(ptr) - (pfile_data)->file_base)
-
-#define OFFSET_TO_PTR(offset, pfile_data) \
- ((pfile_data)->file_base + (DWORD)(offset))
-
-#define ROUND_UP(p, align) (((DWORD)(p) + (align)-1) & ~((align)-1))
-#define ROUND_DOWN(p, align) ((DWORD)(p) & ~((align)-1))
-
-
-static void
-copy_executable_and_add_section (file_data *p_infile,
- file_data *p_outfile,
- char *new_section_name,
- DWORD new_section_size)
-{
- unsigned char *dst;
- PIMAGE_DOS_HEADER dos_header;
- PIMAGE_NT_HEADERS nt_header;
- PIMAGE_NT_HEADERS dst_nt_header;
- PIMAGE_SECTION_HEADER section;
- PIMAGE_SECTION_HEADER dst_section;
- DWORD offset;
- int i;
-
-#define COPY_CHUNK(message, src, size) \
- do { \
- unsigned char *s = (void *)(src); \
- unsigned long count = (size); \
- printf ("%s\n", (message)); \
- printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \
- printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \
- printf ("\t0x%08x Size in bytes.\n", count); \
- memcpy (dst, s, count); \
- dst += count; \
- } while (0)
-
-#define DST_TO_OFFSET() PTR_TO_OFFSET (dst, p_outfile)
-#define ROUND_UP_DST_AND_ZERO(align) \
- do { \
- unsigned char *newdst = p_outfile->file_base \
- + ROUND_UP (DST_TO_OFFSET (), (align)); \
- /* Zero the alignment slop; it may actually initialize real data. */ \
- memset (dst, 0, newdst - dst); \
- dst = newdst; \
- } while (0)
-
- /* Copy the source image sequentially, ie. section by section after
- copying the headers and section table, to simplify the process of
- adding an extra section table entry (which might force the raw
- section data to be relocated).
-
- Note that dst is updated implicitly by each COPY_CHUNK. */
-
- dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base;
- nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) +
- dos_header->e_lfanew);
- section = IMAGE_FIRST_SECTION (nt_header);
-
- dst = (unsigned char *) p_outfile->file_base;
-
- COPY_CHUNK ("Copying DOS header...", dos_header,
- (DWORD) nt_header - (DWORD) dos_header);
- dst_nt_header = (PIMAGE_NT_HEADERS) dst;
- COPY_CHUNK ("Copying NT header...", nt_header,
- (DWORD) section - (DWORD) nt_header);
- dst_section = (PIMAGE_SECTION_HEADER) dst;
- COPY_CHUNK ("Copying section table...", section,
- nt_header->FileHeader.NumberOfSections * sizeof (*section));
-
- /* To improve the efficiency of demand loading, make the file
- alignment match the section alignment (VC++ 6.0 does this by
- default anyway). */
- dst_nt_header->OptionalHeader.FileAlignment =
- dst_nt_header->OptionalHeader.SectionAlignment;
-
- /* Add an uninitialized data section at the end, of the specified name
- and virtual size. */
- if (find_section (new_section_name, nt_header) == NULL)
- /* Leave room for extra section table entry; filled in below. */
- dst += sizeof (*section);
- else
- new_section_name = NULL;
-
- /* Align the first section's raw data area, and set the header size
- field accordingly. */
- ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment);
- dst_nt_header->OptionalHeader.SizeOfHeaders = DST_TO_OFFSET ();
-
- for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
- {
- char msg[100];
- sprintf (msg, "Copying raw data for %s...", section->Name);
-
- /* Update the file-relative offset for this section's raw data (if
- it has any) in case things have been relocated; we will update
- the other offsets below once we know where everything is. */
- if (dst_section->PointerToRawData)
- dst_section->PointerToRawData = DST_TO_OFFSET ();
-
- /* Can always copy the original raw data. */
- COPY_CHUNK
- (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile),
- section->SizeOfRawData);
-
- /* Round up the raw data size to the new alignment. */
- dst_section->SizeOfRawData =
- ROUND_UP (dst_section->SizeOfRawData,
- dst_nt_header->OptionalHeader.FileAlignment);
-
- /* Align the next section's raw data area. */
- ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment);
-
- section++;
- dst_section++;
- }
-
- /* Add the extra section entry (which adds no raw data). */
- if (new_section_name != NULL)
- {
- dst_nt_header->FileHeader.NumberOfSections++;
- dst_nt_header->OptionalHeader.SizeOfImage += new_section_size;
- strncpy (dst_section->Name, new_section_name, sizeof (dst_section->Name));
- dst_section->VirtualAddress =
- section[-1].VirtualAddress
- + ROUND_UP (section[-1].Misc.VirtualSize,
- dst_nt_header->OptionalHeader.SectionAlignment);
- dst_section->Misc.VirtualSize = new_section_size;
- dst_section->PointerToRawData = 0;
- dst_section->SizeOfRawData = 0;
- dst_section->Characteristics =
- IMAGE_SCN_CNT_UNINITIALIZED_DATA
- | IMAGE_SCN_MEM_READ
- | IMAGE_SCN_MEM_WRITE;
- }
-
- /* Copy remainder of source image. */
- section--;
- offset = ROUND_UP (section->PointerToRawData + section->SizeOfRawData,
- nt_header->OptionalHeader.FileAlignment);
- COPY_CHUNK
- ("Copying remainder of executable...",
- OFFSET_TO_PTR (offset, p_infile),
- p_infile->size - offset);
-
- /* Final size for new image. */
- p_outfile->size = DST_TO_OFFSET ();
-
- /* Now patch up remaining file-relative offsets. */
- section = IMAGE_FIRST_SECTION (nt_header);
- dst_section = IMAGE_FIRST_SECTION (dst_nt_header);
-
-#define ADJUST_OFFSET(var) \
- do { \
- if ((var) != 0) \
- (var) = relocate_offset ((var), nt_header, dst_nt_header); \
- } while (0)
-
- dst_nt_header->OptionalHeader.SizeOfInitializedData = 0;
- dst_nt_header->OptionalHeader.SizeOfUninitializedData = 0;
- for (i = 0; i < dst_nt_header->FileHeader.NumberOfSections; i++)
- {
- /* Recompute data sizes for completeness. */
- if (dst_section[i].Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA)
- dst_nt_header->OptionalHeader.SizeOfInitializedData +=
- ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment);
- else if (dst_section[i].Characteristics & IMAGE_SCN_CNT_UNINITIALIZED_DATA)
- dst_nt_header->OptionalHeader.SizeOfUninitializedData +=
- ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment);
-
- ADJUST_OFFSET (dst_section[i].PointerToLinenumbers);
- }
-
- ADJUST_OFFSET (dst_nt_header->FileHeader.PointerToSymbolTable);
-
- /* Update offsets in debug directory entries. */
- {
- IMAGE_DATA_DIRECTORY debug_dir =
- dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DEBUG];
- PIMAGE_DEBUG_DIRECTORY debug_entry;
-
- section = rva_to_section (debug_dir.VirtualAddress, dst_nt_header);
- if (section)
- {
- debug_entry = (PIMAGE_DEBUG_DIRECTORY)
- (RVA_TO_OFFSET (debug_dir.VirtualAddress, section) + p_outfile->file_base);
- debug_dir.Size /= sizeof (IMAGE_DEBUG_DIRECTORY);
-
- for (i = 0; i < debug_dir.Size; i++, debug_entry++)
- ADJUST_OFFSET (debug_entry->PointerToRawData);
- }
- }
-}
-
-
-int
-main (int argc, char **argv)
-{
- file_data in_file, out_file;
- char out_filename[MAX_PATH], in_filename[MAX_PATH];
- unsigned long size;
- PIMAGE_DOS_HEADER dos_header;
- PIMAGE_NT_HEADERS nt_header;
-
-#define OLD_NAME argv[1]
-#define NEW_NAME argv[2]
-#define SECTION_NAME argv[3]
-#define SECTION_SIZE argv[4]
-
- strcpy (in_filename, OLD_NAME);
- strcpy (out_filename, NEW_NAME);
-
- printf ("Dumping from %s\n", in_filename);
- printf (" to %s\n", out_filename);
-
- /* Open the undumped executable file. */
- if (!open_input_file (&in_file, in_filename))
- {
- printf ("Failed to open %s (%d)...bailing.\n",
- in_filename, GetLastError ());
- exit (1);
- }
- dos_header = (PIMAGE_DOS_HEADER) in_file.file_base;
- nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
- /* Allow for expansion due to increasing file align to section align.
- We can overestimate here, since close_file_data will update the
- size exactly. */
- size = in_file.size
- + nt_header->OptionalHeader.SectionAlignment
- * nt_header->FileHeader.NumberOfSections;
- if (!open_output_file (&out_file, out_filename, size))
- {
- printf ("Failed to open %s (%d)...bailing.\n",
- out_filename, GetLastError ());
- exit (1);
- }
-
- copy_executable_and_add_section (&in_file, &out_file,
- SECTION_NAME,
- atoi (SECTION_SIZE) * 1024 * 1024);
-
- /* Patch up header fields; profiler is picky about this. */
- {
- HANDLE hImagehelp = LoadLibrary ("imagehlp.dll");
- DWORD headersum;
- DWORD checksum;
-
- dos_header = (PIMAGE_DOS_HEADER) out_file.file_base;
- nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
-
- nt_header->OptionalHeader.CheckSum = 0;
-// nt_header->FileHeader.TimeDateStamp = time (NULL);
-// dos_header->e_cp = size / 512;
-// nt_header->OptionalHeader.SizeOfImage = size;
-
- pfnCheckSumMappedFile = (void *) GetProcAddress (hImagehelp, "CheckSumMappedFile");
- if (pfnCheckSumMappedFile)
- {
-// nt_header->FileHeader.TimeDateStamp = time (NULL);
- pfnCheckSumMappedFile (out_file.file_base,
- out_file.size,
- &headersum,
- &checksum);
- nt_header->OptionalHeader.CheckSum = checksum;
- }
- FreeLibrary (hImagehelp);
- }
-
- close_file_data (&in_file);
- close_file_data (&out_file);
-
- return 0;
-}
-
-/* eof */
+++ /dev/null
-/* Proxy shell designed for use with Emacs on Windows 95 and NT.
- Copyright (C) 1997 Free Software Foundation, Inc.
-
- Accepts subset of Unix sh(1) command-line options, for compatability
- with elisp code written for Unix. When possible, executes external
- programs directly (a common use of /bin/sh by Emacs), otherwise
- invokes the user-specified command processor to handle built-in shell
- commands, batch files and interactive mode.
-
- The main function is simply to process the "-c string" option in the
- way /bin/sh does, since the standard Windows command shells use the
- convention that everything after "/c" (the Windows equivalent of
- "-c") is the input string.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-#include <windows.h>
-
-#include <stdarg.h> /* va_args */
-#include <malloc.h> /* alloca */
-#include <stdlib.h> /* getenv */
-#include <string.h> /* strlen */
-
-
-/******* Mock C library routines *********************************/
-
-/* These routines are used primarily to minimize the executable size. */
-
-#define stdin GetStdHandle (STD_INPUT_HANDLE)
-#define stdout GetStdHandle (STD_OUTPUT_HANDLE)
-#define stderr GetStdHandle (STD_ERROR_HANDLE)
-
-int
-vfprintf(HANDLE hnd, char * msg, va_list args)
-{
- DWORD bytes_written;
- char buf[1024];
-
- wvsprintf (buf, msg, args);
- return WriteFile (hnd, buf, strlen (buf), &bytes_written, NULL);
-}
-
-int
-fprintf(HANDLE hnd, char * msg, ...)
-{
- va_list args;
- int rc;
-
- va_start (args, msg);
- rc = vfprintf (hnd, msg, args);
- va_end (args);
-
- return rc;
-}
-
-int
-printf(char * msg, ...)
-{
- va_list args;
- int rc;
-
- va_start (args, msg);
- rc = vfprintf (stdout, msg, args);
- va_end (args);
-
- return rc;
-}
-
-void
-fail (char * msg, ...)
-{
- va_list args;
-
- va_start (args, msg);
- vfprintf (stderr, msg, args);
- va_end (args);
-
- exit (-1);
-}
-
-void
-warn (char * msg, ...)
-{
- va_list args;
-
- va_start (args, msg);
- vfprintf (stderr, msg, args);
- va_end (args);
-}
-
-/******************************************************************/
-
-char *
-canon_filename (char *fname)
-{
- char *p = fname;
-
- while (*p)
- {
- if (*p == '/')
- *p = '\\';
- p++;
- }
-
- return fname;
-}
-
-char *
-skip_space (char *str)
-{
- while (isspace (*str)) str++;
- return str;
-}
-
-char *
-skip_nonspace (char *str)
-{
- while (*str && !isspace (*str)) str++;
- return str;
-}
-
-int escape_char = '\\';
-
-/* Get next token from input, advancing pointer. */
-int
-get_next_token (char * buf, char ** pSrc)
-{
- char * p = *pSrc;
- char * o = buf;
-
- p = skip_space (p);
- if (*p == '"')
- {
- int escape_char_run = 0;
-
- /* Go through src until an ending quote is found, unescaping
- quotes along the way. If the escape char is not quote, then do
- special handling of multiple escape chars preceding a quote
- char (ie. the reverse of what Emacs does to escape quotes). */
- p++;
- while (1)
- {
- if (p[0] == escape_char && escape_char != '"')
- {
- escape_char_run++;
- p++;
- continue;
- }
- else if (p[0] == '"')
- {
- while (escape_char_run > 1)
- {
- *o++ = escape_char;
- escape_char_run -= 2;
- }
-
- if (escape_char_run > 0)
- {
- /* escaped quote */
- *o++ = *p++;
- escape_char_run = 0;
- }
- else if (p[1] == escape_char && escape_char == '"')
- {
- /* quote escaped by doubling */
- *o++ = *p;
- p += 2;
- }
- else
- {
- /* The ending quote. */
- *o = '\0';
- /* Leave input pointer after token. */
- p++;
- break;
- }
- }
- else if (p[0] == '\0')
- {
- /* End of string, but no ending quote found. We might want to
- flag this as an error, but for now will consider the end as
- the end of the token. */
- *o = '\0';
- break;
- }
- else
- {
- *o++ = *p++;
- }
- }
- }
- else
- {
- /* Next token is delimited by whitespace. */
- char * p1 = skip_nonspace (p);
- memcpy (o, p, p1 - p);
- o += (p1 - p);
- *o = '\0';
- p = p1;
- }
-
- *pSrc = p;
-
- return o - buf;
-}
-
-/* Search for EXEC file in DIR. If EXEC does not have an extension,
- DIR is searched for EXEC with the standard extensions appended. */
-int
-search_dir (char *dir, char *exec, int bufsize, char *buffer)
-{
- char *exts[] = {".bat", ".cmd", ".exe", ".com"};
- int n_exts = sizeof (exts) / sizeof (char *);
- char *dummy;
- int i, rc;
-
- /* Search the directory for the program. */
- for (i = 0; i < n_exts; i++)
- {
- rc = SearchPath (dir, exec, exts[i], bufsize, buffer, &dummy);
- if (rc > 0)
- return rc;
- }
-
- return 0;
-}
-
-/* Return the absolute name of executable file PROG, including
- any file extensions. If an absolute name for PROG cannot be found,
- return NULL. */
-char *
-make_absolute (char *prog)
-{
- char absname[MAX_PATH];
- char dir[MAX_PATH];
- char curdir[MAX_PATH];
- char *p, *fname;
- char *path;
- int i;
-
- /* At least partial absolute path specified; search there. */
- if ((isalpha (prog[0]) && prog[1] == ':') ||
- (prog[0] == '\\'))
- {
- /* Split the directory from the filename. */
- fname = strrchr (prog, '\\');
- if (!fname)
- /* Only a drive specifier is given. */
- fname = prog + 2;
- strncpy (dir, prog, fname - prog);
- dir[fname - prog] = '\0';
-
- /* Search the directory for the program. */
- if (search_dir (dir, prog, MAX_PATH, absname) > 0)
- return strdup (absname);
- else
- return NULL;
- }
-
- if (GetCurrentDirectory (MAX_PATH, curdir) <= 0)
- return NULL;
-
- /* Relative path; search in current dir. */
- if (strpbrk (prog, "\\"))
- {
- if (search_dir (curdir, prog, MAX_PATH, absname) > 0)
- return strdup (absname);
- else
- return NULL;
- }
-
- /* Just filename; search current directory then PATH. */
- path = alloca (strlen (getenv ("PATH")) + strlen (curdir) + 2);
- strcpy (path, curdir);
- strcat (path, ";");
- strcat (path, getenv ("PATH"));
-
- while (*path)
- {
- /* Get next directory from path. */
- p = path;
- while (*p && *p != ';') p++;
- strncpy (dir, path, p - path);
- dir[p - path] = '\0';
-
- /* Search the directory for the program. */
- if (search_dir (dir, prog, MAX_PATH, absname) > 0)
- return strdup (absname);
-
- /* Move to the next directory. */
- path = p + 1;
- }
-
- return NULL;
-}
-
-/*****************************************************************/
-
-#if 0
-char ** _argv;
-int _argc;
-
-/* Parse commandline into argv array, allowing proper quoting of args. */
-void
-setup_argv (void)
-{
- char * cmdline = GetCommandLine ();
- int arg_bytes = 0;
-
-
-}
-#endif
-
-/* Information about child proc is global, to allow for automatic
- termination when interrupted. At the moment, only one child process
- can be running at any one time. */
-
-PROCESS_INFORMATION child;
-int interactive = TRUE;
-
-BOOL
-console_event_handler (DWORD event)
-{
- switch (event)
- {
- case CTRL_C_EVENT:
- case CTRL_BREAK_EVENT:
- if (!interactive)
- {
- /* Both command.com and cmd.exe have the annoying behaviour of
- prompting "Terminate batch job (y/n)?" when interrupted
- while running a batch file, even if running in
- non-interactive (-c) mode. Try to make up for this
- deficiency by forcibly terminating the subprocess if
- running non-interactively. */
- if (child.hProcess &&
- WaitForSingleObject (child.hProcess, 500) != WAIT_OBJECT_0)
- TerminateProcess (child.hProcess, 0);
- exit (STATUS_CONTROL_C_EXIT);
- }
- break;
-
-#if 0
- default:
- /* CLOSE, LOGOFF and SHUTDOWN events - actually we don't get these
- under Windows 95. */
- fail ("cmdproxy: received %d event\n", event);
- if (child.hProcess)
- TerminateProcess (child.hProcess, 0);
-#endif
- }
- return TRUE;
-}
-
-/* Change from normal usage; return value indicates whether spawn
- succeeded or failed - program return code is returned separately. */
-int
-spawn (char * progname, char * cmdline, char * dir, int * retcode)
-{
- BOOL success = FALSE;
- SECURITY_ATTRIBUTES sec_attrs;
- STARTUPINFO start;
- /* In theory, passing NULL for the environment block to CreateProcess
- is the same as passing the value of GetEnvironmentStrings, but
- doing this explicitly seems to cure problems running DOS programs
- in some cases. */
- char * envblock = GetEnvironmentStrings ();
-
- sec_attrs.nLength = sizeof (sec_attrs);
- sec_attrs.lpSecurityDescriptor = NULL;
- sec_attrs.bInheritHandle = FALSE;
-
- memset (&start, 0, sizeof (start));
- start.cb = sizeof (start);
-
- if (CreateProcess (progname, cmdline, &sec_attrs, NULL, TRUE,
- 0, envblock, dir, &start, &child))
- {
- success = TRUE;
- /* wait for completion and pass on return code */
- WaitForSingleObject (child.hProcess, INFINITE);
- if (retcode)
- GetExitCodeProcess (child.hProcess, (DWORD *)retcode);
- CloseHandle (child.hThread);
- CloseHandle (child.hProcess);
- child.hProcess = NULL;
- }
-
- FreeEnvironmentStrings (envblock);
-
- return success;
-}
-
-/* Return size of current environment block. */
-int
-get_env_size ()
-{
- char * start = GetEnvironmentStrings ();
- char * tmp = start;
-
- while (tmp[0] || tmp[1])
- ++tmp;
- FreeEnvironmentStrings (start);
- return tmp + 2 - start;
-}
-
-/******* Main program ********************************************/
-
-int
-main (int argc, char ** argv)
-{
- int rc;
- int need_shell;
- char * cmdline;
- char * progname;
- int envsize;
- char **pass_through_args;
- int num_pass_through_args;
- char modname[MAX_PATH];
- char path[MAX_PATH];
- char dir[MAX_PATH];
-
-
- interactive = TRUE;
-
- SetConsoleCtrlHandler ((PHANDLER_ROUTINE) console_event_handler, TRUE);
-
- if (!GetCurrentDirectory (sizeof (dir), dir))
- fail ("error: GetCurrentDirectory failed\n");
-
- /* We serve double duty: we can be called either as a proxy for the
- real shell (that is, because we are defined to be the user shell),
- or in our role as a helper application for running DOS programs.
- In the former case, we interpret the command line options as if we
- were a Unix shell, but in the latter case we simply pass our
- command line to CreateProcess. We know which case we are dealing
- with by whether argv[0] refers to ourself or to some other program.
- (This relies on an arcane feature of CreateProcess, where we can
- specify cmdproxy as the module to run, but specify a different
- program in the command line - the MSVC startup code sets argv[0]
- from the command line.) */
-
- if (!GetModuleFileName (NULL, modname, sizeof (modname)))
- fail ("error: GetModuleFileName failed\n");
-
- /* Change directory to location of .exe so startup directory can be
- deleted. */
- progname = strrchr (modname, '\\');
- *progname = '\0';
- SetCurrentDirectory (modname);
- *progname = '\\';
-
- /* Although Emacs always sets argv[0] to an absolute pathname, we
- might get run in other ways as well, so convert argv[0] to an
- absolute name before comparing to the module name. Don't get
- caught out by mixed short and long names. */
- GetShortPathName (modname, modname, sizeof (modname));
- path[0] = '\0';
- if (!SearchPath (NULL, argv[0], ".exe", sizeof (path), path, &progname)
- || !GetShortPathName (path, path, sizeof (path))
- || stricmp (modname, path) != 0)
- {
- /* We are being used as a helper to run a DOS app; just pass
- command line to DOS app without change. */
- /* TODO: fill in progname. */
- if (spawn (NULL, GetCommandLine (), dir, &rc))
- return rc;
- fail ("Could not run %s\n", GetCommandLine ());
- }
-
- /* Process command line. If running interactively (-c or /c not
- specified) then spawn a real command shell, passing it the command
- line arguments.
-
- If not running interactively, then attempt to execute the specified
- command directly. If necessary, spawn a real shell to execute the
- command.
-
- */
-
- progname = NULL;
- cmdline = NULL;
- /* If no args, spawn real shell for interactive use. */
- need_shell = TRUE;
- interactive = TRUE;
- /* Ask command.com to create an environment block with a reasonable
- amount of free space. */
- envsize = get_env_size () + 300;
- pass_through_args = (char **) alloca (argc * sizeof(char *));
- num_pass_through_args = 0;
-
- while (--argc > 0)
- {
- ++argv;
- /* Act on switches we recognize (mostly single letter switches,
- except for -e); all unrecognised switches and extra args are
- passed on to real shell if used (only really of benefit for
- interactive use, but allow for batch use as well). Accept / as
- switch char for compatability with cmd.exe. */
- if (((*argv)[0] == '-' || (*argv)[0] == '/') && (*argv)[1] != '\0')
- {
- if (((*argv)[1] == 'c' || (*argv)[1] == 'C') && ((*argv)[2] == '\0'))
- {
- if (--argc == 0)
- fail ("error: expecting arg for %s\n", *argv);
- cmdline = *(++argv);
- interactive = FALSE;
- }
- else if (((*argv)[1] == 'i' || (*argv)[1] == 'I') && ((*argv)[2] == '\0'))
- {
- if (cmdline)
- warn ("warning: %s ignored because of -c\n", *argv);
- }
- else if (((*argv)[1] == 'e' || (*argv)[1] == 'E') && ((*argv)[2] == ':'))
- {
- int requested_envsize = atoi (*argv + 3);
- /* Enforce a reasonable minimum size, as above. */
- if (requested_envsize > envsize)
- envsize = requested_envsize;
- /* For sanity, enforce a reasonable maximum. */
- if (envsize > 32768)
- envsize = 32768;
- }
- else
- {
- /* warn ("warning: unknown option %s ignored", *argv); */
- pass_through_args[num_pass_through_args++] = *argv;
- }
- }
- else
- break;
- }
-
-#if 0
- /* I think this is probably not useful - cmd.exe ignores extra
- (non-switch) args in interactive mode, and they cannot be passed on
- when -c was given. */
-
- /* Collect any remaining args after (initial) switches. */
- while (argc-- > 0)
- {
- pass_through_args[num_pass_through_args++] = *argv++;
- }
-#else
- /* Probably a mistake for there to be extra args; not fatal. */
- if (argc > 0)
- warn ("warning: extra args ignored after '%s'\n", argv[-1]);
-#endif
-
- pass_through_args[num_pass_through_args] = NULL;
-
- /* If -c option, determine if we must spawn a real shell, or if we can
- execute the command directly ourself. */
- if (cmdline)
- {
- /* If no redirection or piping, and if program can be found, then
- run program directly. Otherwise invoke a real shell. */
-
- static char copout_chars[] = "|<>&";
-
- if (strpbrk (cmdline, copout_chars) == NULL)
- {
- char *args;
-
- /* The program name is the first token of cmdline. Since
- filenames cannot legally contain embedded quotes, the value
- of escape_char doesn't matter. */
- args = cmdline;
- if (!get_next_token (path, &args))
- fail ("error: no program name specified.\n");
-
- canon_filename (path);
- progname = make_absolute (path);
-
- /* If we found the program, run it directly (if not found it
- might be an internal shell command, so don't fail). */
- if (progname != NULL)
- need_shell = FALSE;
- }
- }
-
- pass_to_shell:
- if (need_shell)
- {
- char * p;
- int extra_arg_space = 0;
- int run_command_dot_com;
-
- progname = getenv ("COMSPEC");
- if (!progname)
- fail ("error: COMSPEC is not set\n");
-
- canon_filename (progname);
- progname = make_absolute (progname);
-
- if (progname == NULL || strchr (progname, '\\') == NULL)
- fail ("error: the program %s could not be found.\n", getenv ("COMSPEC"));
-
- /* Need to set environment size when running command.com. */
- run_command_dot_com =
- (stricmp (strrchr (progname, '\\'), "command.com") == 0);
-
- /* Work out how much extra space is required for
- pass_through_args. */
- for (argv = pass_through_args; *argv != NULL; ++argv)
- /* We don't expect to have to quote switches. */
- extra_arg_space += strlen (*argv) + 2;
-
- if (cmdline)
- {
- char * buf;
-
- /* Convert to syntax expected by cmd.exe/command.com for
- running non-interactively. Always quote program name in
- case path contains spaces (fortunately it can't contain
- quotes, since they are illegal in path names). */
-
- buf = p = alloca (strlen (progname) + extra_arg_space +
- strlen (cmdline) + 16);
-
- /* Quote progname in case it contains spaces. */
- p += wsprintf (p, "\"%s\"", progname);
-
- /* Include pass_through_args verbatim; these are just switches
- so should not need quoting. */
- for (argv = pass_through_args; *argv != NULL; ++argv)
- p += wsprintf (p, " %s", *argv);
-
- if (run_command_dot_com)
- wsprintf(p, " /e:%d /c %s", envsize, cmdline);
- else
- wsprintf(p, " /c %s", cmdline);
- cmdline = buf;
- }
- else
- {
- if (run_command_dot_com)
- {
- /* Provide dir arg expected by command.com when first
- started interactively (the "command search path"). To
- avoid potential problems with spaces in command dir
- (which cannot be quoted - command.com doesn't like it),
- we always use the 8.3 form. */
- GetShortPathName (progname, path, sizeof (path));
- p = strrchr (path, '\\');
- /* Trailing slash is acceptable, so always leave it. */
- *(++p) = '\0';
- }
- else
- path[0] = '\0';
-
- cmdline = p = alloca (strlen (progname) + extra_arg_space +
- strlen (path) + 13);
-
- /* Quote progname in case it contains spaces. */
- p += wsprintf (p, "\"%s\" %s", progname, path);
-
- /* Include pass_through_args verbatim; these are just switches
- so should not need quoting. */
- for (argv = pass_through_args; *argv != NULL; ++argv)
- p += wsprintf (p, " %s", *argv);
-
- if (run_command_dot_com)
- wsprintf (p, " /e:%d", envsize);
- }
- }
-
- if (!progname)
- fail ("Internal error: program name not defined\n");
-
- if (!cmdline)
- cmdline = progname;
-
- if (spawn (progname, cmdline, dir, &rc))
- return rc;
-
- if (!need_shell)
- {
- need_shell = TRUE;
- goto pass_to_shell;
- }
-
- fail ("Could not run %s\n", progname);
-
- return 0;
-}
+++ /dev/null
-/* GNU Emacs site configuration template file. -*- C -*-
- Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to the
-Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-
-/* No code in Emacs #includes config.h twice, but some of the code
- intended to work with other packages as well (like gmalloc.c)
- think they can include it as many times as they like. */
-#ifndef EMACS_CONFIG_H
-#define EMACS_CONFIG_H
-
-/* These are all defined in the top-level Makefile by configure.
- They're here only for reference. */
-
-/* Define LISP_FLOAT_TYPE if you want emacs to support floating-point
- numbers. */
-#undef LISP_FLOAT_TYPE
-
-/* Define GNU_MALLOC if you want to use the GNU memory allocator. */
-#define GNU_MALLOC
-
-/* Define if you are using the GNU C Library. */
-#undef DOUG_LEA_MALLOC
-
-/* Define REL_ALLOC if you want to use the relocating allocator for
- buffer space. */
-#define REL_ALLOC
-
-/* Enable conservative stack marking for GC. */
-#define GC_MARK_STACK 1
-
-/* MSVC ignores the "register" keyword, so test fails even though
- setjmp does work. */
-#define GC_SETJMP_WORKS 1
-
-/* Define HAVE_X_WINDOWS if you want to use the X window system. */
-#undef HAVE_X_WINDOWS
-
-/* Define HAVE_X11 if you want to use version 11 of X windows.
- Otherwise, Emacs expects to use version 10. */
-#undef HAVE_X11
-
-/* Define if using an X toolkit. */
-#undef USE_X_TOOLKIT
-
-/* Define this if you're using XFree386. */
-#undef HAVE_XFREE386
-
-/* Define this if you have Motif 2.1 or newer. */
-#undef HAVE_MOTIF_2_1
-
-/* Define HAVE_MENUS if you have mouse menus.
- (This is automatic if you use X, but the option to specify it remains.)
- It is also defined with other window systems that support xmenu.c. */
-#undef HAVE_MENUS
-
-/* Define if we have the X11R6 or newer version of Xt. */
-#undef HAVE_X11XTR6
-
-/* Define if we have the X11R6 or newer version of Xlib. */
-#undef HAVE_X11R6
-
-/* Define if we have the X11R5 or newer version of Xlib. */
-#undef HAVE_X11R5
-
-/* Define if netdb.h declares h_errno. */
-#undef HAVE_H_ERRNO
-
-/* If we're using any sort of window system, define some consequences. */
-#ifdef HAVE_X_WINDOWS
-#define HAVE_WINDOW_SYSTEM
-#define MULTI_KBOARD
-#define HAVE_FACES
-#define HAVE_MOUSE
-#endif
-
-/* Define USE_TEXT_PROPERTIES to support visual and other properties
- on text. */
-#define USE_TEXT_PROPERTIES
-
-/* Define USER_FULL_NAME to return a string
- that is the user's full name.
- It can assume that the variable `pw'
- points to the password file entry for this user.
-
- At some sites, the pw_gecos field contains
- the user's full name. If neither this nor any other
- field contains the right thing, use pw_name,
- giving the user's login name, since that is better than nothing. */
-#define USER_FULL_NAME pw->pw_gecos
-
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-#undef AMPERSAND_FULL_NAME
-
-/* Things set by --with options in the configure script. */
-
-/* Define to support POP mail retrieval. */
-#undef MAIL_USE_POP
-
-/* Define to support Kerberos-authenticated POP mail retrieval. */
-#undef KERBEROS
-/* Define to use Kerberos 5 instead of Kerberos 4 */
-#undef KERBEROS5
-/* Define to support GSS-API in addition to (or instead of) Kerberos */
-#undef GSSAPI
-
-/* Define to support using a Hesiod database to find the POP server. */
-#undef HESIOD
-
-/* Some things figured out by the configure script, grouped as they are in
- configure.in. */
-#ifndef _ALL_SOURCE /* suppress warning if this is pre-defined */
-#undef _ALL_SOURCE
-#endif
-#undef HAVE_SYS_SELECT_H
-#undef HAVE_SYS_TIMEB_H
-#undef HAVE_SYS_TIME_H
-#undef HAVE_UNISTD_H
-#undef HAVE_UTIME_H
-#undef HAVE_LINUX_VERSION_H
-#undef HAVE_SYS_SYSTEMINFO_H
-#undef HAVE_TERMIOS_H
-#undef HAVE_LIMITS_H
-#undef HAVE_STRING_H
-#undef STDC_HEADERS
-#undef TIME_WITH_SYS_TIME
-
-#undef HAVE_LIBDNET
-#undef HAVE_LIBPTHREADS
-#undef HAVE_LIBRESOLV
-#undef HAVE_LIBXMU
-#undef HAVE_LIBNCURSES
-#undef HAVE_LIBINTL
-
-/* movemail Kerberos support */
-/* libraries */
-#undef HAVE_LIBKRB
-#undef HAVE_LIBKRB4
-#undef HAVE_LIBDES
-#undef HAVE_LIBDES425
-#undef HAVE_LIBKRB5
-#undef HAVE_LIBCRYPTO
-#undef HAVE_LIBCOM_ERR
-/* header files */
-#undef HAVE_KRB5_H
-#undef HAVE_DES_H
-#undef HAVE_KRB_H
-#undef HAVE_KERBEROSIV_DES_H
-#undef HAVE_KERBEROSIV_KRB_H
-#undef HAVE_KERBEROS_DES_H
-#undef HAVE_KERBEROS_KRB_H
-#undef HAVE_COM_ERR_H
-
-/* GSS-API libraries and headers */
-#undef HAVE_LIBGSSAPI_KRB5
-#undef HAVE_LIBGSSAPI
-#undef HAVE_GSSAPI_H
-
-/* Mail-file locking */
-#undef HAVE_LIBMAIL
-#undef HAVE_MAILLOCK_H
-#undef HAVE_TOUCHLOCK
-
-#undef HAVE_ALLOCA_H
-
-#undef HAVE_GETTIMEOFDAY
-/* If we don't have gettimeofday,
- the test for GETTIMEOFDAY_ONE_ARGUMENT may succeed,
- but we should ignore it. */
-#ifdef HAVE_GETTIMEOFDAY
-#undef GETTIMEOFDAY_ONE_ARGUMENT
-#endif
-#undef HAVE_GETHOSTNAME
-#undef HAVE_GETDOMAINNAME
-#undef HAVE_DUP2
-#undef HAVE_RENAME
-#undef HAVE_CLOSEDIR
-
-#undef TM_IN_SYS_TIME
-#undef HAVE_TM_ZONE
-#undef HAVE_TZNAME
-
-#undef const
-
-#undef HAVE_LONG_FILE_NAMES
-
-#undef CRAY_STACKSEG_END
-
-#undef UNEXEC_SRC
-
-#undef HAVE_LIBXBSD
-#undef HAVE_XRMSETDATABASE
-#undef HAVE_XSCREENRESOURCESTRING
-#undef HAVE_XSCREENNUMBEROFSCREEN
-#undef HAVE_XSETWMPROTOCOLS
-
-#undef HAVE_MKDIR
-#undef HAVE_RMDIR
-#undef HAVE_SYSINFO
-#undef HAVE_RANDOM
-#undef HAVE_LRAND48
-#undef HAVE_BCOPY
-#undef HAVE_BCMP
-#undef HAVE_LOGB
-#undef HAVE_FREXP
-#undef HAVE_FMOD
-#undef HAVE_RINT
-#undef HAVE_CBRT
-#undef HAVE_FTIME
-#undef HAVE_RES_INIT /* For -lresolv on Suns. */
-#undef HAVE_SETSID
-#undef HAVE_FPATHCONF
-#undef HAVE_SELECT
-#undef HAVE_MKTIME
-#undef HAVE_EUIDACCESS
-#undef HAVE_GETPAGESIZE
-#undef HAVE_TZSET
-#undef HAVE_SETLOCALE
-#undef HAVE_UTIMES
-#undef HAVE_SETRLIMIT
-#undef HAVE_SETPGID
-#undef HAVE_GETCWD
-#undef HAVE_SHUTDOWN
-#undef HAVE_STRFTIME
-/* Standard Windows strftime does not support POSIX.2 extensions. */
-#define STRFTIME_NO_POSIX2 1
-
-#define HAVE_SENDTO 1
-#define HAVE_RECVFROM 1
-#define HAVE_GETSOCKOPT 1
-#define HAVE_SETSOCKOPT 1
-#define HAVE_GETSOCKNAME 1
-#define HAVE_GETPEERNAME 1
-/* Local (unix) sockets are not supported. */
-#undef HAVE_SYS_UN_H
-
-#define LOCALTIME_CACHE
-#undef HAVE_INET_SOCKETS
-
-#undef HAVE_AIX_SMT_EXP
-
-/* Define if you have the ANSI `strerror' function.
- Otherwise you must have the variable `char *sys_errlist[]'. */
-#undef HAVE_STRERROR
-
-/* Define if `sys_siglist' is declared by <signal.h>. */
-#undef SYS_SIGLIST_DECLARED
-
-/* Define if `struct utimbuf' is declared by <utime.h>. */
-#undef HAVE_STRUCT_UTIMBUF
-
-/* Define if `struct timeval' is declared by <sys/time.h>. */
-#undef HAVE_TIMEVAL
-
-/* If using GNU, then support inline function declarations. */
-#ifdef __GNUC__
-#define INLINE __inline__
-#else
-#define INLINE
-#endif
-
-#undef EMACS_CONFIGURATION
-
-#undef EMACS_CONFIG_OPTIONS
-
-/* The configuration script defines opsysfile to be the name of the
- s/SYSTEM.h file that describes the system type you are using. The file
- is chosen based on the configuration name you give.
-
- See the file ../etc/MACHINES for a list of systems and the
- configuration names to use for them.
-
- See s/template.h for documentation on writing s/SYSTEM.h files. */
-#undef config_opsysfile
-#include "s/ms-w32.h"
-
-/* The configuration script defines machfile to be the name of the
- m/MACHINE.h file that describes the machine you are using. The file is
- chosen based on the configuration name you give.
-
- See the file ../etc/MACHINES for a list of machines and the
- configuration names to use for them.
-
- See m/template.h for documentation on writing m/MACHINE.h files. */
-#undef config_machfile
-#include "m/intel386.h"
-
-/* Load in the conversion definitions if this system
- needs them and the source file being compiled has not
- said to inhibit this. There should be no need for you
- to alter these lines. */
-
-#ifdef SHORTNAMES
-#ifndef NO_SHORTNAMES
-#include "../shortnames/remap.h"
-#endif /* not NO_SHORTNAMES */
-#endif /* SHORTNAMES */
-
-/* If no remapping takes place, static variables cannot be dumped as
- pure, so don't worry about the `static' keyword. */
-#ifdef NO_REMAP
-#undef static
-#endif
-
-/* Define `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- These do not work for some USG systems yet;
- for the ones where they work, the s/SYSTEM.h file defines this flag. */
-
-#ifndef VMS
-#ifndef USG
-/* #define subprocesses */
-#endif
-#endif
-
-/* Define LD_SWITCH_SITE to contain any special flags your loader may need. */
-#undef LD_SWITCH_SITE
-
-/* Define C_SWITCH_SITE to contain any special flags your compiler needs. */
-#undef C_SWITCH_SITE
-
-/* Define LD_SWITCH_X_SITE to contain any special flags your loader
- may need to deal with X Windows. For instance, if you've defined
- HAVE_X_WINDOWS above and your X libraries aren't in a place that
- your loader can find on its own, you might want to add "-L/..." or
- something similar. */
-#undef LD_SWITCH_X_SITE
-
-/* Define LD_SWITCH_X_SITE_AUX with an -R option
- in case it's needed (for Solaris, for example). */
-#undef LD_SWITCH_X_SITE_AUX
-
-/* Define C_SWITCH_X_SITE to contain any special flags your compiler
- may need to deal with X Windows. For instance, if you've defined
- HAVE_X_WINDOWS above and your X include files aren't in a place
- that your compiler can find on its own, you might want to add
- "-I/..." or something similar. */
-#undef C_SWITCH_X_SITE
-
-/* Define STACK_DIRECTION here, but not if m/foo.h did. */
-#ifndef STACK_DIRECTION
-#undef STACK_DIRECTION
-#endif
-
-/* Define the return type of signal handlers if the s-xxx file
- did not already do so. */
-#define RETSIGTYPE void
-
-/* SIGTYPE is the macro we actually use. */
-#ifndef SIGTYPE
-#define SIGTYPE RETSIGTYPE
-#endif
-
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
-#define RE_TRANSLATE_P(TBL) (XFASTINT (TBL) != 0)
-#endif
-
-/* Avoid link-time collision with system mktime if we will use our own. */
-#if ! HAVE_MKTIME || BROKEN_MKTIME
-#define mktime emacs_mktime
-#endif
-
-/* The rest of the code currently tests the CPP symbol BSTRING.
- Override any claims made by the system-description files.
- Note that on some SCO version it is possible to have bcopy and not bcmp. */
-#undef BSTRING
-#if defined (HAVE_BCOPY) && defined (HAVE_BCMP)
-#define BSTRING
-#endif
-
-/* Non-ANSI C compilers usually don't have volatile. */
-#ifndef HAVE_VOLATILE
-#ifndef __STDC__
-#define volatile
-#endif
-#endif
-
-#ifndef WINDOWSNT
-/* Some of the files of Emacs which are intended for use with other
- programs assume that if you have a config.h file, you must declare
- the type of getenv.
-
- This declaration shouldn't appear when alloca.s or Makefile.in
- includes config.h. */
-#ifndef NOT_C_CODE
-extern char *getenv ();
-#endif
-#endif
-
-#endif /* EMACS_CONFIG_H */
-
-/* These default definitions are good for almost all machines.
- The exceptions override them in m/MACHINE.h. */
-
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
-
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
-#endif
-
-/* Note that lisp.h uses this in a preprocessor conditional, so it
- would not work to use sizeof. That being so, we do all of them
- without sizeof, for uniformity's sake. */
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
-#endif
-
-#ifndef BITS_PER_LONG
-#define BITS_PER_LONG 32
-#endif
-
-#ifndef POINTER_TYPE
-#define POINTER_TYPE void
-#endif
-
-#ifndef PTR
-#define PTR POINTER_TYPE *
-#endif
-
-#ifndef PROTOTYPES
-#define PROTOTYPES 1
-#endif
-
-#ifndef __P
-#if defined PROTOTYPES
-#define __P(args) args
-#else
-#define __P(args) ()
-#endif
-#endif
-
-/* Don't include <string.h> during configure. */
-#ifndef NOT_C_CODE
-#ifdef HAVE_STRING_H
-#include "string.h"
-#endif
-#endif
-
-#ifndef NO_RETURN
-#if defined __GNUC__ && (__GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR >= 5))
-#define NO_RETURN __attribute__ ((__noreturn__))
-#else
-#define NO_RETURN /* nothing */
-#endif
-#endif
+++ /dev/null
-@echo off\r
-rem ----------------------------------------------------------------------\r
-rem Configuration script for MS Windows 95/98/Me and NT/2000/XP\r
-rem Copyright (C) 1999-2003 Free Software Foundation, Inc.\r
-\r
-rem This file is part of GNU Emacs.\r
-\r
-rem GNU Emacs is free software; you can redistribute it and/or modify\r
-rem it under the terms of the GNU General Public License as published by\r
-rem the Free Software Foundation; either version 2, or (at your option)\r
-rem any later version.\r
-\r
-rem GNU Emacs is distributed in the hope that it will be useful,\r
-rem but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
-rem GNU General Public License for more details.\r
-\r
-rem You should have received a copy of the GNU General Public License\r
-rem along with GNU Emacs; see the file COPYING. If not, write to the\r
-rem Free Software Foundation, Inc., 59 Temple Place - Suite 330,\r
-rem Boston, MA 02111-1307, USA.\r
-rem ----------------------------------------------------------------------\r
-rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS:\r
-rem\r
-rem + MS Windows 95/98/Me or NT/2000/XP\r
-rem + either MSVC 2.x or later, or gcc-2.95 or later (with gmake 3.75\r
-rem or later) and the Mingw32 and W32 API headers and libraries\r
-rem\r
-rem For reference, here is a list of which builds of gmake are known to\r
-rem work or not, and whether they work in the presence and/or absence of\r
-rem sh.exe.\r
-rem\r
-rem sh exists no sh\r
-rem cygwin b20.1 make (3.75): okay[1] fails[2]\r
-rem MSVC compiled gmake 3.77: okay okay\r
-rem MSVC compiled gmake 3.78.1: okay okay\r
-rem MSVC compiled gmake 3.79.1: okay okay\r
-rem mingw32/gcc-2.92.2 make (3.77): okay okay\r
-rem cygwin compiled gmake 3.77: okay[1] fails[2]\r
-rem cygwin compiled gmake 3.78.1: okay fails[2]\r
-rem cygwin compiled gmake 3.79.1: couldn't build make[3]\r
-rem\r
-rem [1] doesn't cope with makefiles with DOS line endings, so must mount\r
-rem emacs source with text!=binary.\r
-rem [2] fails when needs to invoke shell commands; okay invoking gcc etc.\r
-rem [3] requires LC_MESSAGES support to build; maybe 2.95.x update to\r
-rem cygwin provides this?\r
-rem\r
-\r
-rem ----------------------------------------------------------------------\r
-rem See if the environment is large enough. We need 43 (?) bytes.\r
-set $foo$=123456789_123456789_123456789_123456789_123\r
-if not "%$foo$%" == "123456789_123456789_123456789_123456789_123" goto SmallEnv\r
-set $foo$=\r
-\r
-rem ----------------------------------------------------------------------\r
-rem Make sure we are running in the nt subdir\r
-if exist configure.bat goto start\r
-echo You must run configure from the nt subdirectory.\r
-goto end\r
-\r
-:start\r
-rem ----------------------------------------------------------------------\r
-rem Default settings.\r
-set prefix=\r
-set nodebug=N\r
-set noopt=N\r
-set nocygwin=N\r
-set COMPILER=\r
-set usercflags=\r
-set userldflags=\r
-set sep1=\r
-set sep2=\r
-\r
-rem ----------------------------------------------------------------------\r
-rem Handle arguments.\r
-:again\r
-if "%1" == "-h" goto usage\r
-if "%1" == "--help" goto usage\r
-if "%1" == "--prefix" goto setprefix\r
-if "%1" == "--with-gcc" goto withgcc\r
-if "%1" == "--with-msvc" goto withmsvc\r
-if "%1" == "--no-debug" goto nodebug\r
-if "%1" == "--no-opt" goto noopt\r
-if "%1" == "--no-cygwin" goto nocygwin\r
-if "%1" == "--cflags" goto usercflags\r
-if "%1" == "--ldflags" goto userldflags\r
-if "%1" == "--without-png" goto withoutpng\r
-if "%1" == "--without-jpeg" goto withoutjpeg\r
-if "%1" == "--without-gif" goto withoutgif\r
-if "%1" == "--without-tiff" goto withouttiff\r
-if "%1" == "--without-xpm" goto withoutxpm\r
-if "%1" == "" goto checkutils\r
-:usage\r
-echo Usage: configure [options]\r
-echo Options:\r
-echo. --prefix PREFIX install Emacs in directory PREFIX\r
-echo. --with-gcc use GCC to compile Emacs\r
-echo. --with-msvc use MSVC to compile Emacs\r
-echo. --no-debug exclude debug info from executables\r
-echo. --no-opt disable optimization\r
-echo. --no-cygwin use -mno-cygwin option with GCC\r
-echo. --cflags FLAG pass FLAG to compiler\r
-echo. --ldflags FLAG pass FLAG to compiler when linking\r
-echo. --without-png do not use libpng even if it is installed\r
-echo. --without-jpeg do not use jpeg-6b even if it is installed\r
-echo. --without-gif do not use libungif even if it is installed\r
-echo. --without-tiff do not use libtiff even if it is installed\r
-echo. --without-xpm do not use libXpm even if it is installed\r
-goto end\r
-rem ----------------------------------------------------------------------\r
-:setprefix\r
-shift\r
-set prefix=%1\r
-shift\r
-goto again\r
-rem ----------------------------------------------------------------------\r
-:withgcc\r
-set COMPILER=gcc\r
-shift\r
-goto again\r
-rem ----------------------------------------------------------------------\r
-:withmsvc\r
-set COMPILER=cl\r
-shift\r
-goto again\r
-rem ----------------------------------------------------------------------\r
-:nodebug\r
-set nodebug=Y\r
-shift\r
-goto again\r
-rem ----------------------------------------------------------------------\r
-:noopt\r
-set noopt=Y\r
-shift\r
-goto again\r
-rem ----------------------------------------------------------------------\r
-:nocygwin\r
-set nocygwin=Y\r
-shift\r
-goto again\r
-rem ----------------------------------------------------------------------\r
-:usercflags\r
-shift\r
-set usercflags=%usercflags%%sep1%%1\r
-set sep1= %nothing%\r
-shift\r
-goto again\r
-rem ----------------------------------------------------------------------\r
-:userldflags\r
-shift\r
-set userldflags=%userldflags%%sep2%%1\r
-set sep2= %nothing%\r
-shift\r
-goto again\r
-rem ----------------------------------------------------------------------\r
-\r
-:withoutpng\r
-set pngsupport=N\r
-set HAVE_PNG=\r
-shift\r
-goto again\r
-\r
-rem ----------------------------------------------------------------------\r
-\r
-:withoutjpeg\r
-set jpegsupport=N\r
-set HAVE_JPEG=\r
-shift\r
-goto again\r
-\r
-rem ----------------------------------------------------------------------\r
-\r
-:withoutgif\r
-set gifsupport=N\r
-set HAVE_GIF=\r
-shift\r
-goto again\r
-\r
-rem ----------------------------------------------------------------------\r
-\r
-:withouttiff\r
-set tiffsupport=N\r
-set HAVE_TIFF=\r
-shift\r
-goto again\r
-\r
-rem ----------------------------------------------------------------------\r
-\r
-:withoutxpm\r
-set xpmsupport=N\r
-set HAVE_XPM=\r
-shift\r
-goto again\r
-\r
-rem ----------------------------------------------------------------------\r
-rem Check that necessary utilities (cp and rm) are present.\r
-:checkutils\r
-echo Checking for 'cp'...\r
-cp configure.bat junk.bat\r
-if not exist junk.bat goto needcp\r
-echo Checking for 'rm'...\r
-rm junk.bat\r
-if exist junk.bat goto needrm\r
-goto checkcompiler\r
-:needcp\r
-echo You need 'cp' (the Unix file copy program) to build Emacs.\r
-goto end\r
-:needrm\r
-del junk.bat\r
-echo You need 'rm' (the Unix file delete program) to build Emacs.\r
-goto end\r
-\r
-rem ----------------------------------------------------------------------\r
-rem Auto-detect compiler if not specified, and validate GCC if chosen.\r
-:checkcompiler\r
-if (%COMPILER%)==(cl) goto compilercheckdone\r
-if (%COMPILER%)==(gcc) goto checkgcc\r
-\r
-echo Checking whether 'cl' is available...\r
-echo main(){} >junk.c\r
-cl -nologo -c junk.c\r
-if exist junk.obj goto clOK\r
-\r
-echo Checking whether 'gcc' is available...\r
-gcc -c junk.c\r
-if not exist junk.o goto nocompiler\r
-del junk.o\r
-\r
-:checkgcc\r
-Rem WARNING -- COMMAND.COM on some systems only looks at the first\r
-Rem 8 characters of a label. So do NOT be tempted to change\r
-Rem chkapi* into something fancier like checkw32api\r
-Rem You HAVE been warned!\r
-if (%nocygwin%) == (Y) goto chkapi\r
-echo Checking whether gcc requires '-mno-cygwin'...\r
-echo #include "cygwin/version.h" >junk.c\r
-echo main(){} >>junk.c\r
-gcc -c junk.c\r
-if not exist junk.o goto chkapi\r
-gcc -mno-cygwin -c junk.c\r
-if exist junk.o set nocygwin=Y\r
-rm -f junk.c junk.o\r
-\r
-:chkapi\r
-rem ----------------------------------------------------------------------\r
-rem Older versions of the Windows API headers either don't have any of\r
-rem the IMAGE_xxx definitions (the headers that come with Cygwin b20.1\r
-rem are like this), or have a typo in the definition of\r
-rem IMAGE_FIRST_SECTION (the headers with gcc/mingw32 2.95 have this\r
-rem problem). The gcc/mingw32 2.95.2 headers are okay, as are distros\r
-rem of w32api-xxx.zip from Anders Norlander since 1999-11-18 at least.\r
-rem\r
-echo Checking whether W32 API headers are too old...\r
-echo #include "windows.h" >junk.c\r
-echo test(PIMAGE_NT_HEADERS pHeader) >>junk.c\r
-echo {PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader);} >>junk.c\r
-if (%nocygwin%) == (Y) goto chkapi1\r
-set cf=%usercflags%\r
-goto chkapi2\r
-:chkapi1\r
-set cf=%usercflags% -mno-cygwin\r
-:chkapi2\r
-echo on\r
-gcc %cf% -c junk.c\r
-echo off\r
-set cf=\r
-if exist junk.o goto gccOk\r
-\r
-:nocompiler\r
-echo.\r
-echo Configure failed.\r
-echo To configure Emacs for Windows, you need to have either\r
-echo gcc-2.95 or later with Mingw32 and the W32 API headers,\r
-echo or MSVC 2.x or later.\r
-del junk.c\r
-goto end\r
-\r
-:gccOk\r
-set COMPILER=gcc\r
-rm -f junk.c junk.o\r
-echo Using 'gcc'\r
-goto compilercheckdone\r
-\r
-:clOk\r
-set COMPILER=cl\r
-rm -f junk.c junk.obj\r
-echo Using 'MSVC'\r
-\r
-:compilercheckdone\r
-\r
-rem ----------------------------------------------------------------------\r
-rem Check for external image libraries. Since they are loaded\r
-rem dynamically, the libraries themselves do not need to be present\r
-rem at compile time, but the header files are required.\r
-\r
-if (%pngsupport%) == (N) goto pngDone\r
-\r
-echo Checking for libpng...\r
-echo #include "png.h" >junk.c\r
-echo main (){} >>junk.c\r
-rem -o option is ignored with cl, but allows result to be consistent.\r
-%COMPILER% %usercflags% -c junk.c -o junk.obj >junk.out 2>junk.err\r
-if exist junk.obj goto havePng\r
-\r
-echo ...png.h not found, building without PNG support.\r
-set HAVE_PNG=\r
-goto :pngDone\r
-\r
-:havePng\r
-echo ...PNG header available, building with PNG support.\r
-set HAVE_PNG=1\r
-\r
-:pngDone\r
-rm -f junk.c junk.obj\r
-\r
-if (%jpegsupport%) == (N) goto jpegDone\r
-\r
-echo Checking for jpeg-6b...\r
-echo #include "jconfig.h" >junk.c\r
-echo main (){} >>junk.c\r
-rem -o option is ignored with cl, but allows result to be consistent.\r
-%COMPILER% %usercflags% -c junk.c -o junk.obj >junk.out 2>junk.err\r
-if exist junk.obj goto haveJpeg\r
-\r
-echo ...jconfig.h not found, building without JPEG support.\r
-set HAVE_JPEG=\r
-goto :jpegDone\r
-\r
-:haveJpeg\r
-echo ...JPEG header available, building with JPEG support.\r
-set HAVE_JPEG=1\r
-\r
-:jpegDone\r
-rm -f junk.c junk.obj\r
-\r
-if (%gifsupport%) == (N) goto gifDone\r
-\r
-echo Checking for libgif...\r
-echo #include "gif_lib.h" >junk.c\r
-echo main (){} >>junk.c\r
-rem -o option is ignored with cl, but allows result to be consistent.\r
-%COMPILER% %usercflags% -c junk.c -o junk.obj >junk.out 2>junk.err\r
-if exist junk.obj goto haveGif\r
-\r
-echo ...gif_lib.h not found, building without GIF support.\r
-set HAVE_GIF=\r
-goto :gifDone\r
-\r
-:haveGif\r
-echo ...GIF header available, building with GIF support.\r
-set HAVE_GIF=1\r
-\r
-:gifDone\r
-rm -f junk.c junk.obj\r
-\r
-if (%tiffsupport%) == (N) goto tiffDone\r
-\r
-echo Checking for tiff...\r
-echo #include "tiffio.h" >junk.c\r
-echo main (){} >>junk.c\r
-rem -o option is ignored with cl, but allows result to be consistent.\r
-%COMPILER% %usercflags% -c junk.c -o junk.obj >junk.out 2>junk.err\r
-if exist junk.obj goto haveTiff\r
-\r
-echo ...tiffio.h not found, building without TIFF support.\r
-set HAVE_TIFF=\r
-goto :tiffDone\r
-\r
-:haveTiff\r
-echo ...TIFF header available, building with TIFF support.\r
-set HAVE_TIFF=1\r
-\r
-:tiffDone\r
-rm -f junk.c junk.obj\r
-\r
-if (%xpmsupport%) == (N) goto xpmDone\r
-\r
-echo Checking for libXpm...\r
-echo #define FOR_MSW 1 >junk.c\r
-echo #include "X11/xpm.h" >>junk.c\r
-echo main (){} >>junk.c\r
-rem -o option is ignored with cl, but allows result to be consistent.\r
-%COMPILER% %usercflags% -c junk.c -o junk.obj >junk.out 2>junk.err\r
-if exist junk.obj goto haveXpm\r
-\r
-echo ...X11/xpm.h not found, building without XPM support.\r
-set HAVE_XPM=\r
-goto :xpmDone\r
-\r
-:haveXpm\r
-echo ...XPM header available, building with XPM support.\r
-set HAVE_XPM=1\r
-\r
-:xpmDone\r
-rm -f junk.c junk.obj junk.err junk.out\r
-\r
-rem ----------------------------------------------------------------------\r
-:genmakefiles\r
-echo Generating makefiles\r
-if %COMPILER% == gcc set MAKECMD=gmake\r
-if %COMPILER% == cl set MAKECMD=nmake\r
-\r
-rem Pass on chosen settings to makefiles.\r
-rem NB. Be very careful to not have a space before redirection symbols\r
-rem except when there is a preceding digit, when a space is required.\r
-rem\r
-echo # Start of settings from configure.bat >config.settings\r
-echo COMPILER=%COMPILER%>>config.settings\r
-if (%nodebug%) == (Y) echo NODEBUG=1 >>config.settings\r
-if (%noopt%) == (Y) echo NOOPT=1 >>config.settings\r
-if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings\r
-if not "(%prefix%)" == "()" echo INSTALL_DIR=%prefix%>>config.settings\r
-if not "(%usercflags%)" == "()" echo USER_CFLAGS=%usercflags%>>config.settings\r
-if not "(%userldflags%)" == "()" echo USER_LDFLAGS=%userldflags%>>config.settings\r
-echo # End of settings from configure.bat>>config.settings\r
-echo. >>config.settings\r
-\r
-copy config.nt ..\src\config.h\r
-echo. >>..\src\config.h\r
-echo /* Start of settings from configure.bat. */ >>..\src\config.h\r
-if not "(%usercflags%)" == "()" echo #define USER_CFLAGS " %usercflags%">>..\src\config.h\r
-if not "(%userldflags%)" == "()" echo #define USER_LDFLAGS " %userldflags%">>..\src\config.h\r
-if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>..\src\config.h\r
-if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>..\src\config.h\r
-if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>..\src\config.h\r
-if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>..\src\config.h\r
-if not "(%HAVE_XPM%)" == "()" echo #define HAVE_XPM 1 >>..\src\config.h\r
-echo /* End of settings from configure.bat. */ >>..\src\config.h\r
-\r
-copy paths.h ..\src\epaths.h\r
-\r
-copy /b config.settings+%MAKECMD%.defs+..\nt\makefile.w32-in ..\nt\makefile\r
-copy /b config.settings+%MAKECMD%.defs+..\lib-src\makefile.w32-in ..\lib-src\makefile\r
-copy /b config.settings+%MAKECMD%.defs+..\src\makefile.w32-in ..\src\makefile\r
-if not exist ..\lisp\Makefile.unix rename ..\lisp\Makefile.in Makefile.unix\r
-if exist ..\lisp\makefile rm -f ../lisp/[Mm]akefile\r
-copy /b config.settings+%MAKECMD%.defs+..\lisp\makefile.w32-in ..\lisp\makefile\r
-rem Use the default (no-op) Makefile.in if the nt version is not present.\r
-if exist ..\leim\makefile.w32-in copy /b config.settings+%MAKECMD%.defs+..\leim\makefile.w32-in ..\leim\makefile\r
-if not exist ..\leim\makefile.w32-in copy /b config.settings+%MAKECMD%.defs+..\leim\Makefile.in ..\leim\makefile\r
-del config.settings\r
-\r
-Rem Some people use WinZip which doesn't create empty directories!\r
-if not exist ..\site-lisp\nul mkdir ..\site-lisp\\r
-if not exist ..\site-lisp\subdirs.el copy subdirs.el ..\site-lisp\subdirs.el\r
-\r
-echo.\r
-echo Emacs successfully configured.\r
-echo Run `%MAKECMD%' to build, then run `%MAKECMD% install' to install.\r
-goto end\r
-\r
-:SmallEnv\r
-echo Your environment size is too small. Please enlarge it and rerun configure.\r
-echo For example, type "command.com /e:2048" to have 2048 bytes available.\r
-set $foo$=\r
-:end\r
-set prefix=\r
-set nodebug=\r
-set noopt=\r
-set nocygwin=\r
-set COMPILER=\r
-set MAKECMD=\r
-set usercflags=\r
-set userldflags=\r
+++ /dev/null
-/* Simple client interface to DDE servers.
- Copyright (C) 1998 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-#include <windows.h>
-#include <ddeml.h>
-#include <stdlib.h>
-#include <stdio.h>
-
-HDDEDATA CALLBACK
-DdeCallback (UINT uType, UINT uFmt, HCONV hconv,
- HSZ hsz1, HSZ hsz2, HDDEDATA hdata,
- DWORD dwData1, DWORD dwData2)
-{
- return ((HDDEDATA) NULL);
-}
-
-#define DdeCommand(str) \
- DdeClientTransaction (str, strlen (str)+1, HConversation, (HSZ)NULL, \
- CF_TEXT, XTYP_EXECUTE, 30000, NULL)
-
-int
-main (argc, argv)
- int argc;
- char *argv[];
-{
- DWORD idDde = 0;
- HCONV HConversation;
- HSZ Server;
- HSZ Topic = 0;
- char command[1024];
-
- if (argc < 2)
- {
- fprintf (stderr, "usage: ddeclient server [topic]\n");
- exit (1);
- }
-
- DdeInitialize (&idDde, (PFNCALLBACK)DdeCallback, APPCMD_CLIENTONLY, 0);
-
- Server = DdeCreateStringHandle (idDde, argv[1], CP_WINANSI);
- if (argc > 2)
- Topic = DdeCreateStringHandle (idDde, argv[2], CP_WINANSI);
-
- HConversation = DdeConnect (idDde, Server, Topic, NULL);
- if (HConversation != 0)
- {
- while (fgets (command, sizeof(command), stdin) != NULL)
- DdeCommand (command);
-
- DdeDisconnect (HConversation);
- }
-
- DdeFreeStringHandle (idDde, Server);
- if (Topic)
- DdeFreeStringHandle (idDde, Topic);
- DdeUninitialize (idDde);
-
- return (0);
-}
+++ /dev/null
-@echo off
-if (%1) == () nmake -f makefile.nt all
-if not (%1) == () nmake -f makefile.nt %1 %2 %3 %4 %5 %6 %7 %8 %9
+++ /dev/null
-Emacs ICON icons\gnu2a32t.ico
-32649 CURSOR icons\hand.cur
-
-#ifndef VS_VERSION_INFO
-#define VS_VERSION_INFO 1
-#endif
-
-VS_VERSION_INFO VERSIONINFO
- FILEVERSION 21,3,50,0
- PRODUCTVERSION 21,3,50,0
- FILEFLAGSMASK 0x3FL
-#ifdef EMACSDEBUG
- FILEFLAGS 0x1L
-#else
- FILEFLAGS 0x0L
-#endif
- FILEOS 0x40004L
- FILETYPE 0x1L
- FILESUBTYPE 0x0L
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904B0"
- BEGIN
- VALUE "CompanyName", "Free Software Foundation\0"
- VALUE "FileDescription", "GNU Emacs for Windows NT/95/98/2000/ME/XP\0"
- VALUE "FileVersion", "21, 3, 50, 0\0"
- VALUE "InternalName", "Emacs\0"
- VALUE "LegalCopyright", "Copyright (C) 2002\0"
- VALUE "OriginalFilename", "emacs.exe"
- VALUE "ProductName", "Emacs: The extensible self-documenting text editor\0"
- VALUE "ProductVersion", "21, 3, 50, 0\0"
- VALUE "OLESelfRegister", "\0"
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x409, 1200
- END
-END
-
+++ /dev/null
-nmake -f makefile.nt fast_install\r
+++ /dev/null
-@echo off\r
-if (%1)==() echo Usage: %0 tracefile\r
-if (%1)==() goto done\r
-rem Need to fiddle with the dumped image so prep doesn't break it\r
-obj\i386\preprep ..\src\obj\i386\emacs.exe ..\src\obj\i386\pemacs.exe\r
-copy ..\src\obj\i386\temacs.map ..\src\obj\i386\pemacs.map\r
-rem -----------------------------------------------------------------\r
-rem Use this version to profile explicit commands only.\r
-rem prep /om /ft /sf _Fexecute_extended_command ..\src\obj\i386\pemacs\r
-rem -----------------------------------------------------------------\r
-rem Use this version to ignore startup code\r
-prep /om /ft /sf _command_loop_1 ..\src\obj\i386\pemacs\r
-rem -----------------------------------------------------------------\r
-rem Use this version to include startup code\r
-rem prep /om /ft ..\src\obj\i386\pemacs\r
-rem -----------------------------------------------------------------\r
-if errorlevel 1 goto done\r
-profile ..\src\obj\i386\pemacs %2 %3 %4 %5 %6 %7 %8 %9\r
-if errorlevel 1 goto done\r
-prep /m ..\src\obj\i386\pemacs\r
-if errorlevel 1 goto done\r
-plist ..\src\obj\i386\pemacs > %1\r
-:done\r
+++ /dev/null
-@echo off\r
-if (%1)==() echo Usage: %0 tracefile\r
-if (%1)==() goto done\r
-rem Need to fiddle with the dumped image so prep doesn't break it\r
-obj\i386\preprep ..\src\obj\i386\emacs.exe ..\src\obj\i386\pemacs.exe\r
-copy ..\src\obj\i386\temacs.map ..\src\obj\i386\pemacs.map\r
-rem -----------------------------------------------------------------\r
-rem Use this version to profile explicit commands only.\r
-prep /om /ft /sf _Fexecute_extended_command ..\src\obj\i386\pemacs\r
-rem -----------------------------------------------------------------\r
-rem Use this version to ignore startup code\r
-rem prep /om /ft /sf _command_loop_1 ..\src\obj\i386\pemacs\r
-rem -----------------------------------------------------------------\r
-rem Use this version to include startup code\r
-rem prep /om /ft ..\src\obj\i386\pemacs\r
-rem -----------------------------------------------------------------\r
-if errorlevel 1 goto done\r
-profile ..\src\obj\i386\pemacs %2 %3 %4 %5 %6 %7 %8 %9\r
-if errorlevel 1 goto done\r
-prep /m ..\src\obj\i386\pemacs\r
-if errorlevel 1 goto done\r
-plist ..\src\obj\i386\pemacs > %1\r
-:done\r
+++ /dev/null
-#
-# Makefile definition file for building GNU Emacs on the Microsoft W32 API.
-# Copyright (c) 2000-2001 Free Software Foundation, Inc.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# Ensure 'all' is the default target
-all:
-
-# NOTES
-#
-# I tried to force gmake to use the native shell for simplicity, by
-# setting SHELL as below, but this didn't work reliably because of
-# various case sensitivity niggles. Specifically, COMSPEC (which is in
-# fact usually spelled ComSpec on NT, to make life difficult) typically
-# references "cmd.exe" (on NT) when the file is actually called
-# "CMD.EXE" on disk for hysterical raisons. As a result, GNU make
-# thinks it doesn't exist (unless compiled with a switch to ignore
-# case), and so doesn't change which shell it will invoke to execute
-# commands.
-#
-# It would be possible, though very tedious using just gmake facilities,
-# to convert the COMSPEC value to uppercase to solve this problem, but
-# it isn't worth it. That is partly because, even when using the native
-# shell, gmake tends to not be happy with backslashes in command
-# strings. The obvious solution is to use forward slashes as much as
-# possible, which can be made to work most of the time (putting
-# filenames in quotes often helps), but there are still some internal
-# cmd.exe commands like `del' and `copy' that won't work with them.
-# Although it is possible to convert slashes to backslashes when
-# necessary, gmake requires explicitly calling its subst function, which
-# nmake does not understand). For this reason, it is simplest to
-# mandate that rm and cp be available, so we can use Unix-format file
-# names everywhere. (Fortunately both MS and GNU make, and the
-# respective compilers, are happy with Unix-format names.)
-#
-# Since we cannot easily force the choice of a particular shell, we must
-# make the effort to cope with whichever shell is being used.
-# Fortunately, the only command we need to use that is shell specific is
-# the testing of a file's existence for the purpose of working out when
-# we are copying files to their original location. That particular
-# requirement is abstracted easily enough.
-#
-# The only other problem area was the change of directory when running
-# temacs to dump emacs.exe (where gmake doesn't support cd foo in any
-# useful way), but that has been resolved by modifying the Windows
-# unexec function slightly to not require the directory change while
-# still allowing objects and binaries to be in subdirectories.
-
-# This doesn't work.
-#SHELL:=$(COMSPEC)
-
-# Determine whether make is using sh or cmd/command as shell; cmd.exe
-# will output "ECHO is on" when echo is given by itself, while sh will
-# not produce any output.
-sh_output := $(shell echo)
-ifeq "$(findstring ECHO, $(sh_output))" "ECHO"
-THE_SHELL = $(COMSPEC)$(ComSpec)
-SHELLTYPE=CMD
-else
-USING_SH = 1
-THE_SHELL = $(SHELL)
-SHELLTYPE=SH
-endif
-
-MAKETYPE=gmake
-
-# The following "ifeq" does not appear to DTRT, and therefore breaks
-# the build on mingw32. Also the -m option does not exist in many
-# (reasonably recent even) versions of Cygwin. These issues need to be
-# remedied before putting this cygpath kludge back in.
-
-# Convert CURDIR to native file name, if in Cygwin format
-#ifeq "$(shell cygpath $(CURDIR))" "$(CURDIR)"
-#CURDIR := $(shell cygpath -m $(CURDIR))
-#endif
-
-THISDIR = .
-
-# Cygwin has changed quoting rules somewhat since b20, in a way that
-# affects makefiles using sh as the command processor, so we need to
-# detect which rules to use.
-ifdef USING_SH
-sh_output := $(shell echo [Please ignore a syntax error on the next line - it is intentional] 1>&2)
-sh_output := $(shell echo foo")
-ifeq "$(sh_output)" ""
-NEW_CYGWIN = 1
-endif
-endif
-
-ALL_DEPS = $^
-EMPTY =
-SPACE = $(EMPTY) $(EMPTY)
-
-SUBSYSTEM_WINDOWS=-Wl,-subsystem,windows
-SUBSYSTEM_CONSOLE=-Wl,-subsystem,console
-
-# INSTALL_DIR is the directory into which emacs will be installed.
-#
-ifndef INSTALL_DIR
-INSTALL_DIR = $(CURDIR)/..
-endif
-
-export EMACSLOADPATH
-
-# Determine the architecture we're running on.
-# Define ARCH for our purposes;
-# Define CPU for use by ntwin32.mak;
-# Define CONFIG_H to the appropriate config.h for the system;
-#
-ifdef PROCESSOR_ARCHITECTURE
-# We're on Windows NT
-CPU = $(PROCESSOR_ARCHITECTURE)
-CONFIG_H = config.nt
-OS_TYPE = windowsnt
- ifeq "$(PROCESSOR_ARCHITECTURE)" "x86"
-ARCH = i386
-CPU = i386
- else
- ifeq "$(PROCESSOR_ARCHITECTURE)" "MIPS"
-ARCH = mips
- else
- ifeq "$(PROCESSOR_ARCHITECTURE)" "ALPHA"
-ARCH = alpha
- else
- ifeq "$(PROCESSOR_ARCHITECTURE)" "PPC"
-ARCH = ppc
- else
-error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)"
- endif
- endif
- endif
- endif
-else
-# We're on Windows 95
-ARCH = i386
-CPU = i386
-CONFIG_H = config.nt
-OS_TYPE = windows95
-endif
-
-AR = ar -rsc
-AR_OUT =
-CC = gcc
-CC_OUT = -o$(SPACE)
-LINK = gcc
-LINK_OUT = -o$(SPACE)
-RC = windres -O coff
-RC_OUT = -o$(SPACE)
-RC_INCLUDE = --include-dir$(SPACE)
-
-libc =
-baselibs =
-O = o
-A = a
-
-BASE_LIBS = $(libc) $(baselibs)
-
-ADVAPI32 = -ladvapi32
-COMDLG32 = -lcomdlg32
-GDI32 = -lgdi32
-MPR = -lmpr
-SHELL32 = -lshell32
-USER32 = -luser32
-WSOCK32 = -lwsock32
-WINMM = -lwinmm
-
-ifdef NOOPT
-DEBUG_CFLAGS = -DEMACSDEBUG
-else
-DEBUG_CFLAGS =
-endif
-CFLAGS = -I. -DWIN32_LEAN_AND_MEAN -D_WIN32_WINNT=0x0400 $(ARCH_CFLAGS) -D$(ARCH) \
- -D_CRTAPI1=_cdecl \
- $(DEBUG_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)
-EMACS_EXTRA_C_FLAGS = -DUSE_CRT_DLL=1
-
-# see comments in allocate_heap in w32heap.c before changing any of the
-# -stack, -heap, or -image-base settings.
-TEMACS_EXTRA_LINK = -Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -g $(SUBSYSTEM_CONSOLE) -Wl,-entry,__start -Wl,-Map,$(BLD)/temacs.map
-
-ifdef NOOPT
-OBJDIR = oo
-else
-OBJDIR = oo-spd
-endif
-$(OBJDIR):; -mkdir "$(OBJDIR)"
-BLD = $(OBJDIR)/$(ARCH)
-$(BLD): $(OBJDIR)
- -mkdir "$(BLD)"
-
-COMPILER_TEMP_FILES =
-
-CP = cp -f
-CP_DIR = cp -rf
-DEL = rm
-DEL_TREE = rm -r
-
-ifdef USING_SH
-
-IFNOTSAMEDIR = if [ ! -s ../same-dir.tst ] ; then
-FOREACH = for f in
-FORVAR = $${f}
-FORDO = ; do
-ENDFOR = ; done
-ENDIF = ; fi
-ARGQUOTE = '
-ifdef NEW_CYGWIN
-DQUOTE = "
-else
-DQUOTE = ""
-endif
-
-else
-
-IFNOTSAMEDIR = if not exist ../same-dir.tst
-FOREACH = for %%f in (
-FORVAR = %%f
-FORDO = ) do
-ENDFOR =
-ENDIF =
-ARGQUOTE = "
-DQUOTE = \"
-
-endif
-
-ifdef NODEBUG
-DEBUG_FLAG =
-DEBUG_LINK =
-else
-DEBUG_FLAG = -g
-DEBUG_LINK = -g
-endif
-
-ifdef NOCYGWIN
-NOCYGWIN = -mno-cygwin
-endif
-
-ifeq "$(ARCH)" "i386"
-ifdef NOOPT
-ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN)
-else
-ARCH_CFLAGS = -D_X86_=1 -c $(DEBUG_FLAG) $(NOCYGWIN) -mcpu=i686 -O2 \
- # -fbuiltin \
- # -finline-functions \
- # -fomit-frame-pointer
-endif
-ARCH_LDFLAGS = $(SYS_LDFLAGS)
-else
-ERROR Unknown architecture type "$(ARCH)".
-endif
-
-LINK_FLAGS = $(ARCH_LDFLAGS) $(DEBUG_LINK) $(NOCYGWIN) $(USER_LDFLAGS)
-
-.DEFAULT:
-
-$(BLD)/%.o: %.c
- $(CC) $(CFLAGS) $(CC_OUT)$@ $<
+++ /dev/null
-/* null version of <arpa/inet.h> - <sys/socket.h> has everything */
+++ /dev/null
-/* Convenience header for conditional use of GNU <libintl.h>.
- Copyright (C) 1995-1998, 2000-2002 Free Software Foundation, Inc.
-
- This program is free software; you can redistribute it and/or modify it
- under the terms of the GNU Library General Public License as published
- by the Free Software Foundation; either version 2, or (at your option)
- any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
-
- You should have received a copy of the GNU Library General Public
- License along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
- USA. */
-
-#ifndef _LIBGETTEXT_H
-#define _LIBGETTEXT_H 1
-
-/* NLS can be disabled through the configure --disable-nls option. */
-#if ENABLE_NLS
-
-/* Get declarations of GNU message catalog functions. */
-# include <libintl.h>
-
-#else
-
-/* Solaris /usr/include/locale.h includes /usr/include/libintl.h, which
- chokes if dcgettext is defined as a macro. So include it now, to make
- later inclusions of <locale.h> a NOP. We don't include <libintl.h>
- as well because people using "gettext.h" will not include <libintl.h>,
- and also including <libintl.h> would fail on SunOS 4, whereas <locale.h>
- is OK. */
-#if defined(__sun)
-# include <locale.h>
-#endif
-
-/* Disabled NLS.
- The casts to 'const char *' serve the purpose of producing warnings
- for invalid uses of the value returned from these functions.
- On pre-ANSI systems without 'const', the config.h file is supposed to
- contain "#define const". */
-# define gettext(Msgid) ((const char *) (Msgid))
-# define dgettext(Domainname, Msgid) ((const char *) (Msgid))
-# define dcgettext(Domainname, Msgid, Category) ((const char *) (Msgid))
-# define ngettext(Msgid1, Msgid2, N) \
- ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
-# define dngettext(Domainname, Msgid1, Msgid2, N) \
- ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
-# define dcngettext(Domainname, Msgid1, Msgid2, N, Category) \
- ((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
-# define textdomain(Domainname) ((const char *) (Domainname))
-# define bindtextdomain(Domainname, Dirname) ((const char *) (Dirname))
-# define bind_textdomain_codeset(Domainname, Codeset) ((const char *) (Codeset))
-
-#endif
-
-/* A pseudo function call that serves as a marker for the automated
- extraction of messages, but does not call gettext(). The run-time
- translation is done at a different place in the code.
- The argument, String, should be a literal string. Concatenated strings
- and other string expressions won't work.
- The macro's expansion is not parenthesized, so that it is suitable as
- initializer for static 'char[]' or 'const char[]' variables. */
-#define gettext_noop(String) String
-
-#endif /* _LIBGETTEXT_H */
+++ /dev/null
-/* null version of <netdb.h> - <sys/socket.h> has everything */
+++ /dev/null
-/* null version of <netinet/in.h> - <sys/socket.h> has everything */
+++ /dev/null
-#ifndef _PWD_H_
-#define _PWD_H_
-/*
- * pwd.h doesn't exist on NT, so we put together our own.
- */
-
-struct passwd {
- char *pw_name;
- char *pw_passwd;
- int pw_uid;
- int pw_gid;
- int pw_quota;
- char *pw_gecos;
- char *pw_dir;
- char *pw_shell;
-};
-
-typedef int uid_t;
-typedef uid_t gid_t;
-
-#endif /* _PWD_H_ */
+++ /dev/null
-/*
- * map sys\dir.h to ..\..\..\src\ndir.h
- */
-
-#include "..\..\..\src\ndir.h"
+++ /dev/null
-/*
- * sys\file.h doesn't exist on NT - only needed for these constants
- */
-
-#ifndef D_OK
-#define F_OK 0
-#define X_OK 1
-#define W_OK 2
-#define R_OK 4
-#define D_OK 8
-#endif
+++ /dev/null
-/*
- * sys\ioctl.h doesn't exist on NT...rather than including it conditionally
- * in many of the source files, we just extend the include path so that the
- * compiler will pick this up empty header instead.
- */
+++ /dev/null
-#ifndef _PARAM_H_
-#define _PARAM_H_
-
-/*
- * sys\param.h doesn't exist on NT, so we'll make one.
- */
-
-#define NBPG 4096
-
-#endif /* _PARAM_H_ */
+++ /dev/null
-/* Copyright (C) 1995 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-
-/* Workable version of <sys/socket.h> based on winsock.h */
-
-#ifndef _SOCKET_H_
-#define _SOCKET_H_
-
-/* defeat the multiple include protection */
-#ifdef _WINSOCKAPI_
-#undef _WINSOCKAPI_
-#endif
-#ifdef _WINSOCK_H
-#undef _WINSOCK_H
-#endif
-
-/* avoid confusion with our version of select */
-#ifdef select
-#undef select
-#define MUST_REDEF_SELECT
-#endif
-
-/* avoid clashing with our version of FD_SET if already defined */
-#ifdef FD_SET
-#undef FD_SET
-#undef FD_CLR
-#undef FD_ISSET
-#undef FD_ZERO
-#endif
-
-/* avoid duplicate definition of timeval */
-#ifdef HAVE_TIMEVAL
-#define timeval ws_timeval
-#endif
-
-#include <winsock.h>
-
-/* redefine select to reference our version */
-#ifdef MUST_REDEF_SELECT
-#define select sys_select
-#undef MUST_REDEF_SELECT
-#endif
-
-/* revert to our version of FD_SET */
-#undef FD_SET
-#undef FD_CLR
-#undef FD_ISSET
-#undef FD_ZERO
-
-/* allow us to provide our own version of fd_set */
-#define fd_set ws_fd_set
-#include "w32.h"
-
-#ifdef HAVE_TIMEVAL
-#undef timeval
-#endif
-
-/* shadow functions where we provide our own wrapper */
-#define socket sys_socket
-#define bind sys_bind
-#define connect sys_connect
-#define htons sys_htons
-#define ntohs sys_ntohs
-#define inet_addr sys_inet_addr
-#define gethostname sys_gethostname
-#define gethostbyname sys_gethostbyname
-#define getpeername sys_getpeername
-#define getservbyname sys_getservbyname
-#define shutdown sys_shutdown
-#define setsockopt sys_setsockopt
-#define listen sys_listen
-#define getsockname sys_getsockname
-#define accept sys_accept
-#define recvfrom sys_recvfrom
-#define sendto sys_sendto
-
-int sys_socket(int af, int type, int protocol);
-int sys_bind (int s, const struct sockaddr *addr, int namelen);
-int sys_connect (int s, const struct sockaddr *addr, int namelen);
-u_short sys_htons (u_short hostshort);
-u_short sys_ntohs (u_short netshort);
-unsigned long sys_inet_addr (const char * cp);
-int sys_gethostname (char * name, int namelen);
-struct hostent * sys_gethostbyname (const char * name);
-struct servent * sys_getservbyname (const char * name, const char * proto);
-int sys_getpeername (int s, struct sockaddr *addr, int * namelen);
-int sys_shutdown (int socket, int how);
-int sys_setsockopt (int s, int level, int oname, const char * oval, int olen);
-int sys_listen (int s, int backlog);
-int sys_getsockname (int s, struct sockaddr * name, int * namelen);
-int sys_accept (int s, struct sockaddr *addr, int *addrlen);
-int sys_recvfrom (int s, char *buf, int len, int flags,
- struct sockaddr *from, int * fromlen);
-int sys_sendto (int s, const char * buf, int len, int flags,
- const struct sockaddr *to, int tolen);
-
-/* In addition to wrappers for the winsock functions, we also provide
- an fcntl function, for setting sockets to non-blocking mode. */
-int fcntl (int s, int cmd, int options);
-#define F_SETFL 4
-#define O_NDELAY 04000
-
-/* we are providing a real h_errno variable */
-#undef h_errno
-extern int h_errno;
-
-/* map winsock error codes to standard names */
-#define EWOULDBLOCK WSAEWOULDBLOCK
-#define EINPROGRESS WSAEINPROGRESS
-#define EALREADY WSAEALREADY
-#define ENOTSOCK WSAENOTSOCK
-#define EDESTADDRREQ WSAEDESTADDRREQ
-#define EMSGSIZE WSAEMSGSIZE
-#define EPROTOTYPE WSAEPROTOTYPE
-#define ENOPROTOOPT WSAENOPROTOOPT
-#define EPROTONOSUPPORT WSAEPROTONOSUPPORT
-#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
-#define EOPNOTSUPP WSAEOPNOTSUPP
-#define EPFNOSUPPORT WSAEPFNOSUPPORT
-#define EAFNOSUPPORT WSAEAFNOSUPPORT
-#define EADDRINUSE WSAEADDRINUSE
-#define EADDRNOTAVAIL WSAEADDRNOTAVAIL
-#define ENETDOWN WSAENETDOWN
-#define ENETUNREACH WSAENETUNREACH
-#define ENETRESET WSAENETRESET
-#define ECONNABORTED WSAECONNABORTED
-#define ECONNRESET WSAECONNRESET
-#define ENOBUFS WSAENOBUFS
-#define EISCONN WSAEISCONN
-#define ENOTCONN WSAENOTCONN
-#define ESHUTDOWN WSAESHUTDOWN
-#define ETOOMANYREFS WSAETOOMANYREFS
-#define ETIMEDOUT WSAETIMEDOUT
-#define ECONNREFUSED WSAECONNREFUSED
-#define ELOOP WSAELOOP
-/* #define ENAMETOOLONG WSAENAMETOOLONG */
-#define EHOSTDOWN WSAEHOSTDOWN
-#define EHOSTUNREACH WSAEHOSTUNREACH
-/* #define ENOTEMPTY WSAENOTEMPTY */
-#define EPROCLIM WSAEPROCLIM
-#define EUSERS WSAEUSERS
-#define EDQUOT WSAEDQUOT
-#define ESTALE WSAESTALE
-#define EREMOTE WSAEREMOTE
-
-#endif /* _SOCKET_H_ */
-
-/* end of socket.h */
+++ /dev/null
-#ifndef SYS_TIME_H_INCLUDED
-#define SYS_TIME_H_INCLUDED
-
-/*
- * sys/time.h doesn't exist on NT
- */
-
-struct timeval
- {
- long tv_sec; /* seconds */
- long tv_usec; /* microseconds */
- };
-struct timezone
- {
- int tz_minuteswest; /* minutes west of Greenwich */
- int tz_dsttime; /* type of dst correction */
- };
-
-void gettimeofday (struct timeval *, struct timezone *);
-
-#endif /* SYS_TIME_H_INCLUDED */
-
-/* end of sys/time.h */
+++ /dev/null
-/* Fake unistd.h: config.h already provides most of the relevant things. */
+++ /dev/null
-@echo off\r
-if (%1) == (speed) set BUILD_TYPE=spd\r
-if (%1) == (speed) shift\r
-if not (%1) == () set INSTALL_DIR=%1\r
-if not (%1) == () shift\r
-nmake -f makefile.nt install %1 %2 %3 %4 %5 %6 %7 %8 %9\r
-set INSTALL_DIR=\r
-set BUILD_TYPE=\r
+++ /dev/null
-#
-# Makefile definition file for building GNU Emacs on Windows NT
-# Copyright (c) 1994-2001 Free Software Foundation, Inc.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-#
-# Geoff Voelker (voelker@cs.washington.edu) 9-6-94
-
-#
-# BEGIN CONFIGURATION
-#
-
-# Define the following to build the GUI version
-#
-NTGUI=1
-
-# Set INSTALL_DIR to be the directory into which you want emacs installed.
-#
-!ifndef INSTALL_DIR
-INSTALL_DIR = C:\emacs
-!endif
-
-# Define MSVCNT11 to be nonzero if you are using the MSVCNT 1.1 environment.
-# MSVCNT11 = 1
-!ifndef MSVCNT11
-MSVCNT11 = 0
-!endif
-
-#
-# END CONFIGURATION
-#
-
-#
-# Allow detection of builds with MSVC 5 or later
-#
-_NMAKE_VER_5=162
-_NMAKE_VER_4=0
-
-!IFNDEF _NMAKE_VER
-_NMAKE_VER=$(_NMAKE_VER_4)
-!ENDIF
-
-# Check that the INCLUDE and LIB environment variables are set.
-#
-!ifndef INCLUDE
-!error The INCLUDE environment variable needs to be set.
-!endif
-!ifndef LIB
-!error The LIB environment variable needs to be set.
-!endif
-
-# Determine the architecture we're running on.
-# Define ARCH for our purposes;
-# Define CPU for use by ntwin32.mak;
-# Define CONFIG_H to the appropriate config.h for the system;
-#
-!ifdef PROCESSOR_ARCHITECTURE
-# We're on Windows NT
-CPU = $(PROCESSOR_ARCHITECTURE)
-CONFIG_H = config.nt
-OS_TYPE = windowsnt
-! if "$(PROCESSOR_ARCHITECTURE)" == "x86"
-ARCH = i386
-CPU = i386
-! else
-! if "$(PROCESSOR_ARCHITECTURE)" == "MIPS"
-ARCH = mips
-! else
-! if "$(PROCESSOR_ARCHITECTURE)" == "ALPHA"
-ARCH = alpha
-! else
-! if "$(PROCESSOR_ARCHITECTURE)" == "PPC"
-ARCH = ppc
-! else
-!error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)"
-! endif
-! endif
-! endif
-! endif
-!else
-# We're on Windows 95
-ARCH = i386
-CPU = i386
-CONFIG_H = config.nt
-OS_TYPE = windows95
-!endif
-
-# Include ntwin32.mak. So far, this file seems to be supported by every
-# Microsoft compiler on NT and Windows 95 and properly defines the executable
-# names and libraries necessary to build Emacs. I do not have access
-# to any other vendor compilers, so I do not know if they supply this
-# file, too. For now I'll assume that they do.
-#
-!include <ntwin32.mak>
-
-# Using cvtres is necessary on NT 3.10 and doesn't hurt on later platforms.
-CVTRES = cvtres.exe
-AR = $(implib)
-# The assignment $(CC) = $(cc) fails even though variables are case sensitive.
-LINK_TMP = $(link)
-LINK = $(LINK_TMP)
-CC_TMP = $(cc)
-CC = $(CC_TMP)
-
-# advapi32.lib is left off of $(baselibs) on NT 3.10
-!if "$(baselibs)" == "kernel32.lib "
-ADVAPI32 = advapi32.lib
-!else
-ADVAPI32 =
-!endif
-
-# Older ntwin32.mak files do not define libc; do it for them.
-!ifndef libc
-libc = libc.lib
-!endif
-
-# The base libraries for compiling Emacs on NT. With MSVC, this should
-# include oldnames.lib.
-!if $(MSVCNT11)
-BASE_LIBS = $(libc) $(baselibs) oldnames.lib
-!else
-BASE_LIBS = $(libc) $(baselibs) -nodefaultlib:oldnames.lib
-!endif
-
-# We want any debugging info in the executable.
-!if "$(LINK)" == "link32"
-SYS_LDFLAGS = -nologo
-!else
-SYS_LDFLAGS = -nologo -release -incremental:no -version:3.10
-!endif
-
-# Tag the executables to run out of the swapfile when execute off CD or network shares
-SYS_LDFLAGS = $(SYS_LDFLAGS) -swaprun:cd -swaprun:net
-
-INC = -I.
-!if "$(BUILD_TYPE)" == "spd"
-CFLAGS_COMMON = -nologo $(INC) $(ARCH_CFLAGS) $(LOCAL_FLAGS) -DWIN32_LEAN_AND_MEAN -D$(ARCH) -Fd$(BLD)\vc.pdb
-!else
-CFLAGS_COMMON = -nologo $(INC) $(ARCH_CFLAGS) $(LOCAL_FLAGS) -DWIN32_LEAN_AND_MEAN -D$(ARCH) -Fd$(BLD)\vc.pdb -DEMACSDEBUG
-!endif
-!if $(MSVCNT11)
-CFLAGS = $(CFLAGS_COMMON) -D_CRTAPI1=_cdecl
-!else
-CFLAGS = $(CFLAGS_COMMON) -D_CRTAPI1=_cdecl
-!endif
-
-!ifdef BUILD_TYPE
-OBJDIR = obj-$(BUILD_TYPE)
-!else
-OBJDIR = obj
-!endif
-$(OBJDIR):; -mkdir $(OBJDIR)
-BLD = $(OBJDIR)\$(ARCH)
-$(BLD): $(OBJDIR)
- -mkdir $(BLD)
-
-CP = copy
-CP_DIR = xcopy /f/r/i/e/d/k
-
-!if "$(OS_TYPE)" == "windows95"
-DEL = deltree /y
-DEL_TREE = deltree /y
-!else
-DEL = del
-# NT better way of killing a deltree
-DEL_TREE = rd /s/q
-!endif
-
-# Lets us add icons to the GNU Emacs folder
-ADDPM = ..\nt\$(BLD)\addpm.exe
-
-!if "$(ARCH)" == "i386"
-!if "$(BUILD_TYPE)" == "spd"
-ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zel -W2 -H63 -Oxsb2 -G6dF -Zi -Zp8
-!else
-ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zel -W2 -H63 -Od -G3d -Zi -Zp8
-!endif
-ARCH_LDFLAGS = -align:0x1000 $(SYS_LDFLAGS)
-
-!else
-!if "$(ARCH)" == "mips"
-ARCH_CFLAGS = -D_MIPS_=1 -c -W2 -Zi -Od -Gt0
-ARCH_LDFLAGS = -align:0x1000 $(SYS_LDFLAGS)
-
-!else
-!if "$(ARCH)" == "alpha"
-!if "$(BUILD_TYPE)" == "spd"
-ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -Od -D__stdcall= -D__cdecl=
-!else
-ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -O1 -D__stdcall= -D__cdecl=
-!endif
-ARCH_LDFLAGS = -align:0x2000 $(SYS_LDFLAGS)
-
-!else
-!if "$(ARCH)" == "ppc"
-# These flags are a guess...if they don't work, please send me mail.
-ARCH_CFLAGS = -D_PPC_=1 -c -Ze -Zi -W2 -Od
-ARCH_LDFLAGS = -align:0x1000 $(SYS_LDFLAGS)
-
-!else
-!ERROR Unknown architecture type "$(ARCH)".
-!endif
-!endif
-!endif
-!endif
-
-#
-# If the compiler supports compiling multiple .c files to .o files at
-# one time, use this feature.
-#
-!IF ("$(_NMAKE_VER)" == "$(_NMAKE_VER_4)")
-.c{$(BLD)}.obj:
- $(CC) $(CFLAGS) -Fo$(BLD)\ $<
-!ELSE
-.c{$(BLD)}.obj::
- $(CC) $(CFLAGS) -Fo$(BLD)\ $<
-!ENDIF
+++ /dev/null
-#
-# Top level makefile for building GNU Emacs on Windows NT
-# Copyright (c) 1993-2000 Free Software Foundation, Inc.
-#
-# This file is part of GNU Emacs.
-#
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-#
-# Geoff Voelker (voelker@cs.washington.edu) 11-20-93
-# 9-6-94
-!include makefile.def
-
-ALL = addpm ddeclient runemacs cmdproxy addsection preprep
-!if $(MSVCNT11)
-TRES = $(BLD)\emacs.res
-!else
-TRES = $(BLD)\emacs.rbj
-!endif
-
-addpm: $(BLD) $(BLD)\addpm.exe
-$(BLD)\addpm.obj: addpm.c
-$(BLD)\addpm.exe: $(BLD)\addpm.obj
- $(LINK) -out:$@ -subsystem:console -entry:mainCRTStartup \
- $(SYS_LDFLAGS) $** $(BASE_LIBS) $(ADVAPI32) user32.lib
-
-ddeclient: $(BLD) $(BLD)\ddeclient.exe
-$(BLD)\ddeclient.obj: ddeclient.c
-$(BLD)\ddeclient.exe: $(BLD)\ddeclient.obj
- $(LINK) -out:$@ -subsystem:console -entry:mainCRTStartup \
- $(SYS_LDFLAGS) $** $(BASE_LIBS) $(ADVAPI32) user32.lib
-
-cmdproxy: $(BLD) $(BLD)\cmdproxy.exe
-$(BLD)\cmdproxy.obj: cmdproxy.c
-$(BLD)\cmdproxy.exe: $(BLD)\cmdproxy.obj
- $(LINK) -out:$@ -subsystem:console -entry:mainCRTStartup \
- $(SYS_LDFLAGS) $** $(BASE_LIBS) user32.lib
-
-addsection: $(BLD) $(BLD)\addsection.exe
-$(BLD)\addsection.obj: addsection.c
-$(BLD)\addsection.exe: $(BLD)\addsection.obj
- $(LINK) -debug:full -out:$@ -subsystem:console -entry:mainCRTStartup \
- $(SYS_LDFLAGS) $** $(BASE_LIBS) user32.lib
-
-preprep: $(BLD) $(BLD)\preprep.exe
-$(BLD)\preprep.obj: preprep.c
-$(BLD)\preprep.exe: $(BLD)\preprep.obj
- $(LINK) -debug:full -out:$@ -subsystem:console -entry:mainCRTStartup \
- $(SYS_LDFLAGS) $** $(BASE_LIBS)
-
-#
-# The resource file. NT 3.10 requires the use of cvtres; even though
-# it is not necessary on later versions, it is still ok to use it.
-#
-$(TRES): emacs.rc
- $(RC) -Fo$(BLD)\emacs.res $**
-!if !$(MSVCNT11)
- $(CVTRES) -r -$(ARCH) -o $@ $(BLD)\emacs.res
-!endif
-
-runemacs: $(BLD) $(BLD)\runemacs.exe
-$(BLD)\runemacs.obj: runemacs.c
-$(BLD)\runemacs.exe: $(BLD)\runemacs.obj $(TRES)
- $(LINK) -out:$@ -subsystem:windows -entry:WinMainCRTStartup \
- $(SYS_LDFLAGS) $** $(BASE_LIBS) $(ADVAPI32) user32.lib
-
-# Since Windows 95 does not support multiple commands on one command line
-# (e.g., in for loops), we cannot use for loops any more.
-# SUBDIRS = lib-src src lisp
-
-#
-# Build emacs
-#
-BUILD_CMD = $(MAKE) $(MFLAGS) -f makefile.nt all
-all: $(BLD) $(ALL)
- cd ..\lib-src
- $(BUILD_CMD)
- cd ..\src
- $(BUILD_CMD)
- cd ..\lisp
- $(BUILD_CMD)
- cd ..\leim
- if exist makefile.nt $(BUILD_CMD)
- cd ..\nt
-
-BOOTSTRAP_CMD = $(MAKE) $(MFLAGS) -f makefile.nt bootstrap
-bootstrap: $(BLD) $(ALL)
- cd ..\src
- $(BOOTSTRAP_CMD)
- $(BOOTCLEAN_CMD)
- cd ..\lisp
- $(BOOTSTRAP_CMD)
- cd ..\nt
-
-BOOTCLEAN_CMD = $(MAKE) $(MFLAGS) -f makefile.nt bootstrap-clean
-bootstrap-clean:
- cd ..\src
- $(BOOTCLEAN_CMD)
- cd ..\lisp
- $(BOOTCLEAN_CMD)
-
-$(INSTALL_DIR):
- - mkdir $(INSTALL_DIR)
-
-$(INSTALL_DIR)\bin:
- - mkdir $(INSTALL_DIR)\bin
-
-#
-# Build and install emacs in INSTALL_DIR
-#
-INSTALL_CMD = $(MAKE) -f makefile.nt install
-install: all $(INSTALL_DIR)
- cd ..\lib-src
- $(INSTALL_CMD)
- cd ..\src
- $(INSTALL_CMD)
- cd ..\lisp
- $(INSTALL_CMD)
- cd ..\leim
- if exist makefile.nt $(INSTALL_CMD)
- cd ..\nt
- - $(CP) $(BLD)\addpm.exe $(INSTALL_DIR)\bin
- - $(CP) $(BLD)\ddeclient.exe $(INSTALL_DIR)\bin
- - $(CP) $(BLD)\cmdproxy.exe $(INSTALL_DIR)\bin
- - $(CP) $(BLD)\runemacs.exe $(INSTALL_DIR)\bin
- - $(CP) ..\lib-src\fns-*.el $(INSTALL_DIR)\bin
- - $(ADDPM) $(INSTALL_DIR)
- - $(DEL) ..\same-dir.tst
- - $(DEL) $(INSTALL_DIR)\same-dir.tst
- - mkdir $(INSTALL_DIR)\etc\icons
- - $(CP_DIR) icons $(INSTALL_DIR)\etc\icons
- echo SameDirTest > $(INSTALL_DIR)\same-dir.tst
- if not exist ..\same-dir.tst $(MAKE) -f makefile.nt real_install
- - $(DEL) ..\same-dir.tst
- - $(DEL) $(INSTALL_DIR)\same-dir.tst
-
-#
-# This installs executables from ..\bin into the installation directory
-# without building anything.
-#
-fast_install:
- - mkdir $(INSTALL_DIR)\data
- $(CP) ..\lib-src\DOC $(INSTALL_DIR)\etc
- - mkdir $(INSTALL_DIR)\bin
- - $(CP) $(BLD)\addpm.exe $(INSTALL_DIR)\bin
- - $(CP) $(BLD)\ddeclient.exe $(INSTALL_DIR)\bin
- - $(CP) $(BLD)\cmdproxy.exe $(INSTALL_DIR)\bin
- - $(CP) $(BLD)\runemacs.exe $(INSTALL_DIR)\bin
- - $(CP) ..\lib-src\fns-*.el $(INSTALL_DIR)\bin
- - $(DEL) ..\same-dir.tst
- - $(DEL) $(INSTALL_DIR)\same-dir.tst
- echo SameDirTest > $(INSTALL_DIR)\same-dir.tst
- if not exist ..\same-dir.tst $(CP) ..\bin\emacs.exe $(INSTALL_DIR)\bin
- if not exist ..\same-dir.tst $(CP) ..\bin\etags.exe $(INSTALL_DIR)\bin
- if not exist ..\same-dir.tst $(CP) ..\bin\ctags.exe $(INSTALL_DIR)\bin
- if not exist ..\same-dir.tst $(MAKE) -f makefile.nt real_install
- - $(DEL) ..\same-dir.tst
- - $(DEL) $(INSTALL_DIR)\same-dir.tst
-
-real_install:
- - $(DEL) ..\same-dir.tst
- - $(DEL) $(INSTALL_DIR)\same-dir.tst
- echo SameDirTest > $(INSTALL_DIR)\same-dir.tst
- - mkdir $(INSTALL_DIR)\etc
- - mkdir $(INSTALL_DIR)\info
- - mkdir $(INSTALL_DIR)\lock
- - mkdir $(INSTALL_DIR)\data
- - mkdir $(INSTALL_DIR)\site-lisp
- - mkdir $(INSTALL_DIR)\etc\icons
- - $(CP_DIR) icons $(INSTALL_DIR)\etc\icons
- if not exist ..\same-dir.tst $(CP_DIR) ..\etc $(INSTALL_DIR)\etc
- if not exist ..\same-dir.tst $(CP_DIR) ..\info $(INSTALL_DIR)\info
- - $(DEL) ..\same-dir.tst
- - $(DEL) $(INSTALL_DIR)\same-dir.tst
-
-#
-# Maintenance
-#
-CLEAN_CMD = $(MAKE) -f makefile.nt clean
-clean:
- - $(DEL) *~ *.pdb
- - $(DEL) *.orig
- - $(DEL) *.rej
- - $(DEL) *.crlf
- - $(DEL_TREE) deleted
- - $(DEL_TREE) obj
- - $(DEL_TREE) obj-spd
- - $(DEL) ..\etc\DOC ..\etc\DOC-X
- cd ..\lib-src
- $(CLEAN_CMD)
- cd ..\src
- $(CLEAN_CMD)
- cd ..\lisp
- $(CLEAN_CMD)
- cd ..\leim
- if exist makefile.nt $(CLEAN_CMD)
- cd ..\nt
-
-realclean: clean
- - $(DEL_TREE) ..\bin
+++ /dev/null
-# Makefile for GNU Emacs on the Microsoft W32 API.\r
-# Copyright (c) 2000-2001 Free Software Foundation, Inc.\r
-#\r
-# Top level makefile for building GNU Emacs on Windows NT\r
-#\r
-# This file is part of GNU Emacs.\r
-#\r
-# GNU Emacs is free software; you can redistribute it and/or modify\r
-# it under the terms of the GNU General Public License as published by\r
-# the Free Software Foundation; either version 2, or (at your option)\r
-# any later version.\r
-#\r
-# GNU Emacs is distributed in the hope that it will be useful,\r
-# but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
-# GNU General Public License for more details.\r
-#\r
-# You should have received a copy of the GNU General Public License\r
-# along with GNU Emacs; see the file COPYING. If not, write to\r
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\r
-# Boston, MA 02111-1307, USA.\r
-\r
-ALL = addpm ddeclient runemacs cmdproxy addsection preprep\r
-\r
-.PHONY: $(ALL)\r
-\r
-TRES = $(BLD)/emacs.res\r
-\r
-addpm: $(BLD) $(BLD)/addpm.exe\r
-$(BLD)/addpm.exe: $(BLD)/addpm.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)\r
-\r
-ddeclient: $(BLD) $(BLD)/ddeclient.exe\r
-$(BLD)/ddeclient.exe: $(BLD)/ddeclient.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)\r
-\r
-cmdproxy: $(BLD) $(BLD)/cmdproxy.exe\r
-$(BLD)/cmdproxy.exe: $(BLD)/cmdproxy.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)\r
-\r
-addsection: $(BLD) $(BLD)/addsection.exe\r
-$(BLD)/addsection.exe: $(BLD)/addsection.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(USER32)\r
-\r
-preprep: $(BLD) $(BLD)/preprep.exe\r
-$(BLD)/preprep.exe: $(BLD)/preprep.$(O)\r
- $(LINK) $(LINK_OUT)$@ \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS)\r
-\r
-#\r
-# The resource file. NT 3.10 requires the use of cvtres; even though\r
-# it is not necessary on later versions, it is still ok to use it.\r
-#\r
-$(TRES): emacs.rc\r
- $(RC) $(RC_OUT)$(BLD)/emacs.res $(ALL_DEPS)\r
-\r
-runemacs: $(BLD) $(BLD)/runemacs.exe\r
-$(BLD)/runemacs.exe: $(BLD)/runemacs.$(O) $(TRES)\r
- $(LINK) $(LINK_OUT)$@ $(SUBSYSTEM_WINDOWS) \\r
- $(LINK_FLAGS) $(ALL_DEPS) $(BASE_LIBS) $(ADVAPI32) $(USER32)\r
-\r
-which-sh:\r
- @echo Using $(THE_SHELL) as shell.\r
-\r
-#\r
-# Build emacs\r
-#\r
-all: which-sh $(BLD) $(ALL) maybe-bootstrap all-other-dirs-$(MAKETYPE)\r
-\r
-all-other-dirs-nmake:\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\leim\r
- $(MAKE) $(MFLAGS) all\r
- cd ..\nt\r
-\r
-all-other-dirs-gmake:\r
- $(MAKE) $(MFLAGS) -C ../lib-src all\r
- $(MAKE) $(MFLAGS) -C ../src all\r
- $(MAKE) $(MFLAGS) -C ../lisp all\r
- $(MAKE) $(MFLAGS) -C ../leim all\r
-\r
-recompile: recompile-$(MAKETYPE)\r
-\r
-recompile-nmake:\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) recompile\r
- cd ..\nt\r
-\r
-recompile-gmake:\r
- $(MAKE) $(MFLAGS) -C ../lisp recompile\r
-\r
-#### Bootstrapping.\r
-\r
-### This is meant for Emacs maintainers only. It first cleans the\r
-### lisp subdirectory, removing all compiled Lisp files. Then a\r
-### special emacs executable is built from Lisp sources, which is then\r
-### used to compile Lisp files. The last step is a "normal" make.\r
-\r
-maybe-bootstrap: maybe-bootstrap-$(SHELLTYPE)\r
-\r
-# dummy target to force other targets to be evaluated.\r
-doit:\r
-\r
-maybe-bootstrap-CMD: doit\r
- @echo.\r
- @if not EXIST ..\lisp\abbrev.elc echo Essential Lisp files seem to be missing. You should either\r
- @if not EXIST ..\lisp\abbrev.elc echo do 'make bootstrap' or create 'lisp/abbrev.elc' somehow\r
- @echo.\r
- @if not EXIST ..\lisp\abbrev.elc exit -1\r
-\r
-maybe-bootstrap-SH: doit\r
- @if [ ! -f ../lisp/abbrev.elc ] ; then \\r
- echo; \\r
- echo "Essential Lisp files seem to be missing. You should either"; \\r
- echo "do \`make bootstrap' or create \`lisp/abbrev.elc' somehow."; \\r
- echo; \\r
- exit -1; \\r
- fi\r
-\r
-bootstrap: addsection bootstrap-$(MAKETYPE) all\r
-\r
-bootstrap-nmake:\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) bootstrap-clean\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) bootstrap\r
- $(MAKE) $(MFLAGS) bootstrap-clean\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) bootstrap\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) DOC\r
- cd ..\nt\r
-\r
-bootstrap-gmake:\r
- $(MAKE) $(MFLAGS) -C ../lisp bootstrap-clean\r
- $(MAKE) $(MFLAGS) -C ../src clean\r
- $(MAKE) $(MFLAGS) -C ../lib-src clean\r
- $(MAKE) $(MFLAGS) -C ../src bootstrap\r
- $(MAKE) $(MFLAGS) -C ../src bootstrap-clean\r
- $(MAKE) $(MFLAGS) -C ../lisp bootstrap\r
- $(MAKE) $(MFLAGS) -C ../lib-src DOC\r
-\r
-bootstrap-clean: bootstrap-clean-$(MAKETYPE)\r
-\r
-bootstrap-clean-nmake:\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) bootstrap-clean\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) bootstrap-clean\r
-\r
-bootstrap-clean-gmake:\r
- $(MAKE) $(MFLAGS) -C ../src bootstrap-clean\r
- $(MAKE) $(MFLAGS) -C ../lisp bootstrap-clean\r
-\r
-$(INSTALL_DIR):\r
- - mkdir "$(INSTALL_DIR)"\r
-\r
-$(INSTALL_DIR)/bin: $(INSTALL_DIR)\r
- - mkdir "$(INSTALL_DIR)/bin"\r
-\r
-#\r
-# Build and install emacs in INSTALL_DIR\r
-#\r
-install: all $(INSTALL_DIR)/bin install-other-dirs-$(MAKETYPE)\r
- - $(CP) $(BLD)/addpm.exe $(INSTALL_DIR)/bin\r
- - $(CP) $(BLD)/ddeclient.exe $(INSTALL_DIR)/bin\r
- - $(CP) $(BLD)/cmdproxy.exe $(INSTALL_DIR)/bin\r
- - $(CP) $(BLD)/runemacs.exe $(INSTALL_DIR)/bin\r
- - $(CP) ../lib-src/fns-*.el $(INSTALL_DIR)/bin\r
- - "$(INSTALL_DIR)/bin/addpm" /q\r
- - $(DEL) ../same-dir.tst\r
- - $(DEL) $(INSTALL_DIR)/same-dir.tst\r
- echo SameDirTest > "$(INSTALL_DIR)/same-dir.tst"\r
- - mkdir "$(INSTALL_DIR)/etc"\r
- - mkdir "$(INSTALL_DIR)/info"\r
- - mkdir "$(INSTALL_DIR)/lock"\r
- - mkdir "$(INSTALL_DIR)/data"\r
- - mkdir "$(INSTALL_DIR)/site-lisp"\r
- - mkdir "$(INSTALL_DIR)/etc/icons"\r
- $(IFNOTSAMEDIR) $(CP) ../site-lisp/subdirs.el $(INSTALL_DIR)/site-lisp $(ENDIF)\r
- $(IFNOTSAMEDIR) $(CP_DIR) ../etc $(INSTALL_DIR) $(ENDIF)\r
- - $(CP_DIR) icons $(INSTALL_DIR)/etc\r
- $(IFNOTSAMEDIR) $(CP_DIR) ../info $(INSTALL_DIR) $(ENDIF)\r
- - $(DEL) ../same-dir.tst\r
- - $(DEL) $(INSTALL_DIR)/same-dir.tst\r
-\r
-install-other-dirs-nmake:\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) install\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) install\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) install\r
- cd ..\leim\r
- $(MAKE) $(MFLAGS) install\r
- cd ..\nt\r
-\r
-install-other-dirs-gmake:\r
- $(MAKE) $(MFLAGS) -C ../lib-src install\r
- $(MAKE) $(MFLAGS) -C ../src install\r
- $(MAKE) $(MFLAGS) -C ../lisp install\r
- $(MAKE) $(MFLAGS) -C ../leim install\r
-\r
-#\r
-# Maintenance\r
-#\r
-clean: clean-other-dirs-$(MAKETYPE)\r
- - $(DEL) *~ $(COMPILER_TEMP_FILES)\r
- - $(DEL_TREE) $(OBJDIR)\r
- - $(DEL) ../etc/DOC ../etc/DOC-X\r
-\r
-clean-other-dirs-nmake:\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\lisp\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\leim\r
- $(MAKE) $(MFLAGS) clean\r
- cd ..\nt\r
-\r
-clean-other-dirs-gmake:\r
- $(MAKE) $(MFLAGS) -C ../lib-src clean\r
- $(MAKE) $(MFLAGS) -C ../src clean\r
- $(MAKE) $(MFLAGS) -C ../lisp clean\r
- $(MAKE) $(MFLAGS) -C ../leim clean\r
-\r
-cleanall-other-dirs-nmake:\r
- cd ..\lib-src\r
- $(MAKE) $(MFLAGS) cleanall\r
- cd ..\src\r
- $(MAKE) $(MFLAGS) cleanall\r
- cd ..\nt\r
-\r
-cleanall-other-dirs-gmake:\r
- $(MAKE) $(MFLAGS) -C ../lib-src cleanall\r
- $(MAKE) $(MFLAGS) -C ../src cleanall\r
-\r
-cleanall: clean cleanall-other-dirs-$(MAKETYPE)\r
- - $(DEL_TREE) obj\r
- - $(DEL_TREE) obj-spd\r
- - $(DEL_TREE) oo\r
- - $(DEL_TREE) oo-spd\r
-\r
-realclean: cleanall\r
- - $(DEL_TREE) ../bin\r
+++ /dev/null
-#\r
-# Makefile definition file for building GNU Emacs on the Microsoft W32 API.\r
-# Copyright (c) 2000-2001 Free Software Foundation, Inc.\r
-#\r
-# GNU Emacs is free software; you can redistribute it and/or modify\r
-# it under the terms of the GNU General Public License as published by\r
-# the Free Software Foundation; either version 2, or (at your option)\r
-# any later version.\r
-#\r
-# GNU Emacs is distributed in the hope that it will be useful,\r
-# but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
-# GNU General Public License for more details.\r
-#\r
-# You should have received a copy of the GNU General Public License\r
-# along with GNU Emacs; see the file COPYING. If not, write to\r
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,\r
-# Boston, MA 02111-1307, USA.\r
-\r
-# Ensure 'all' is the default target\r
-all:\r
-\r
-THE_SHELL = $(COMSPEC)\r
-SHELLTYPE=CMD\r
-\r
-MAKETYPE=nmake\r
-\r
-CURDIR = $(MAKEDIR:\=/)\r
-THISDIR = $(MAKEDIR)\r
-\r
-ALL_DEPS = $**\r
-\r
-SUBSYSTEM_WINDOWS=-subsystem:windows\r
-SUBSYSTEM_CONSOLE=-subsystem:console\r
-\r
-# INSTALL_DIR is the directory into which emacs will be installed.\r
-#\r
-!ifndef INSTALL_DIR\r
-INSTALL_DIR = $(CURDIR)/..\r
-!endif\r
-\r
-# Ensure EMACSLOADPATH is defined in the environment.\r
-#\r
-!if [set EMACSLOADPATH=foo]\r
-!endif\r
-\r
-# Allow detection of builds with MSVC 5 or later, so we can\r
-# speed up compiles (see rule at end).\r
-#\r
-_NMAKE_VER_5=162\r
-_NMAKE_VER_4=0\r
-\r
-!IFNDEF _NMAKE_VER\r
-_NMAKE_VER=$(_NMAKE_VER_4)\r
-!ENDIF\r
-\r
-# Check that the INCLUDE and LIB environment variables are set.\r
-#\r
-!ifndef INCLUDE\r
-!error The INCLUDE environment variable needs to be set.\r
-!endif\r
-!ifndef LIB\r
-!error The LIB environment variable needs to be set.\r
-!endif\r
-\r
-# Determine the architecture we're running on.\r
-# Define ARCH for our purposes;\r
-# Define CPU for use by ntwin32.mak;\r
-# Define CONFIG_H to the appropriate config.h for the system;\r
-#\r
-!ifdef PROCESSOR_ARCHITECTURE\r
-# We're on Windows NT\r
-CPU = $(PROCESSOR_ARCHITECTURE)\r
-CONFIG_H = config.nt\r
-OS_TYPE = windowsnt\r
-! if "$(PROCESSOR_ARCHITECTURE)" == "x86"\r
-ARCH = i386\r
-CPU = i386\r
-! else\r
-! if "$(PROCESSOR_ARCHITECTURE)" == "MIPS"\r
-ARCH = mips\r
-! else\r
-! if "$(PROCESSOR_ARCHITECTURE)" == "ALPHA"\r
-ARCH = alpha\r
-! else\r
-! if "$(PROCESSOR_ARCHITECTURE)" == "PPC"\r
-ARCH = ppc\r
-! else\r
-! error Unknown architecture type "$(PROCESSOR_ARCHITECTURE)"\r
-! endif\r
-! endif\r
-! endif\r
-! endif\r
-!else\r
-# We're on Windows 95\r
-ARCH = i386\r
-CPU = i386\r
-CONFIG_H = config.nt\r
-OS_TYPE = windows95\r
-!endif\r
-\r
-AR = lib\r
-AR_OUT = -out:\r
-CC = cl\r
-CC_OUT = -Fo\r
-LINK = link\r
-LINK_OUT = -out:\r
-RC = rc\r
-RC_OUT = -Fo\r
-RC_INCLUDE = -i\r
-\r
-libc = libc.lib\r
-baselibs =\r
-O = obj\r
-A = lib\r
-\r
-BASE_LIBS = $(libc) $(baselibs) oldnames.lib\r
-\r
-ADVAPI32 = advapi32.lib\r
-COMDLG32 = comdlg32.lib\r
-GDI32 = gdi32.lib\r
-MPR = mpr.lib\r
-SHELL32 = shell32.lib\r
-USER32 = user32.lib\r
-WSOCK32 = wsock32.lib\r
-WINMM = winmm.lib\r
-\r
-!ifdef NOOPT\r
-DEBUG_CFLAGS = -DEMACSDEBUG\r
-!else\r
-DEBUG_CFLAGS =\r
-!endif\r
-CFLAGS = -I. -DWIN32_LEAN_AND_MEAN -D_WIN32_WINNT=0x0400 $(ARCH_CFLAGS) -D$(ARCH) \\r
- -D_CRTAPI1=_cdecl $(DEBUG_CFLAGS) $(USER_CFLAGS) $(LOCAL_FLAGS)\r
-EMACS_EXTRA_C_FLAGS =\r
-\r
-SYS_LDFLAGS = -release -incremental:no -version:3.10 -swaprun:cd -swaprun:net setargv.obj\r
-\r
-# see comments in allocate_heap in w32heap.c before changing any of the\r
-# -stack, -heap, or -base settings.\r
-TEMACS_EXTRA_LINK = -stack:0x00800000 -heap:0x00100000 -base:0x01000000 -debug:full -debugtype:both -pdb:$(BLD)\temacs.pdb -machine:$(ARCH) $(SUBSYSTEM_CONSOLE) -entry:_start -map:$(BLD)\temacs.map $(EXTRA_LINK)\r
-\r
-!ifdef NOOPT\r
-OBJDIR = obj\r
-!else\r
-OBJDIR = obj-spd\r
-!endif\r
-$(OBJDIR):; -mkdir $(OBJDIR)\r
-BLD = $(OBJDIR)/$(ARCH)\r
-$(BLD): $(OBJDIR)\r
- -mkdir "$(BLD)"\r
-\r
-COMPILER_TEMP_FILES = *.pdb\r
-\r
-CP = cp -f\r
-CP_DIR = cp -rf\r
-IFNOTSAMEDIR = if not exist ..\same-dir.tst\r
-ENDIF =\r
-FOREACH = for %%f in (\r
-FORVAR = %%f\r
-FORDO = ) do\r
-ENDFOR =\r
-ARGQUOTE = "\r
-DQUOTE = \"\r
-DEL = rm\r
-DEL_TREE = rm -r\r
-\r
-!ifdef NODEBUG\r
-DEBUG_FLAG =\r
-DEBUG_LINK =\r
-!else\r
-DEBUG_FLAG = -Zi\r
-DEBUG_LINK = -debug:full -debugtype:both\r
-!endif\r
-\r
-!if "$(ARCH)" == "i386"\r
-!ifdef NOOPT\r
-ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zel -W2 -H63 -Od -G3d -Zp8 $(DEBUG_FLAG)\r
-!else\r
-ARCH_CFLAGS = -nologo -D_X86_=1 -c -Zel -W2 -H63 -Oxsb2 -Oy- -G6dF -Zp8 $(DEBUG_FLAG)\r
-!endif\r
-ARCH_LDFLAGS = $(SYS_LDFLAGS)\r
-\r
-!else\r
-!if "$(ARCH)" == "mips"\r
-ARCH_CFLAGS = -D_MIPS_=1 -c -W2 -Zi -Od -Gt0\r
-ARCH_LDFLAGS = $(SYS_LDFLAGS)\r
-\r
-!else\r
-!if "$(ARCH)" == "alpha"\r
-!if "$(BUILD_TYPE)" == "spd"\r
-ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -Od -D__stdcall= -D__cdecl=\r
-!else\r
-ARCH_CFLAGS = -D_ALPHA_=1 -c -Ze -Zi -W2 -O1 -D__stdcall= -D__cdecl=\r
-!endif\r
-ARCH_LDFLAGS = $(SYS_LDFLAGS)\r
-\r
-!else\r
-!if "$(ARCH)" == "ppc"\r
-# These flags are a guess...if they don't work, please send me mail.\r
-ARCH_CFLAGS = -D_PPC_=1 -c -Ze -Zi -W2 -Od\r
-ARCH_LDFLAGS = $(SYS_LDFLAGS)\r
-\r
-!else\r
-!ERROR Unknown architecture type "$(ARCH)".\r
-!endif\r
-!endif\r
-!endif\r
-!endif\r
-\r
-LINK_FLAGS = $(ARCH_LDFLAGS) $(DEBUG_LINK) $(USER_LDFLAGS)\r
-\r
-# From MSVC 5.0 onwards, it seem base relocation information is not included,\r
-# at least in release builds. We need to ensure the reloc info is included\r
-# in order to use the MSVC profiler.\r
-!IF ("$(_NMAKE_VER)" == "$(_NMAKE_VER_4)")\r
-EXTRA_LINK =\r
-!ELSE\r
-EXTRA_LINK = -profile\r
-!ENDIF\r
-\r
-#\r
-# If the compiler supports compiling multiple .c files to .o files at\r
-# one time, use this feature.\r
-#\r
-!IF ("$(_NMAKE_VER)" == "$(_NMAKE_VER_4)")\r
-.c{$(BLD)}.obj:\r
- $(CC) $(CFLAGS) -Fo$(BLD)\ $<\r
-!ELSE\r
-.c{$(BLD)}.obj::\r
- $(CC) $(CFLAGS) -Fo$(BLD)\ $<\r
-!ENDIF\r
+++ /dev/null
-/* Copyright (C) 1993, 1995, 1997, 1999, 2001
- Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-
-/* The default search path for Lisp function "load".
- This sets load-path. */
-/* #define PATH_LOADSEARCH "/usr/local/lib/emacs/lisp" */
-#define PATH_LOADSEARCH "C:/emacs/lisp"
-
-/* Like PATH_LOADSEARCH, but used only when Emacs is dumping. This
- path is usually identical to PATH_LOADSEARCH except that the entry
- for the directory containing the installed lisp files has been
- replaced with ../lisp. */
-#define PATH_DUMPLOADSEARCH "../lisp"
-
-/* The extra search path for programs to invoke. This is appended to
- whatever the PATH environment variable says to set the Lisp
- variable exec-path and the first file name in it sets the Lisp
- variable exec-directory. exec-directory is used for finding
- executables and other architecture-dependent files. */
-/* #define PATH_EXEC "/usr/local/lib/emacs/etc" */
-#define PATH_EXEC "C:/emacs/bin"
-
-/* Where Emacs should look for its architecture-independent data
- files, like the NEWS file. The lisp variable data-directory
- is set to this value. */
-/* #define PATH_DATA "/usr/local/lib/emacs/data" */
-#define PATH_DATA "C:/emacs/data"
-
-/* Where Emacs should look for its docstring file. The lisp variable
- doc-directory is set to this value. */
-#define PATH_DOC "C:/emacs/etc"
-
-/* The name of the directory that contains lock files with which we
- record what files are being modified in Emacs. This directory
- should be writable by everyone. THE STRING MUST END WITH A
- SLASH!!! */
-/* #define PATH_LOCK "/usr/local/lib/emacs/lock/" */
-#define PATH_LOCK "C:/emacs/lock/"
-
-/* Where the configuration process believes the info tree lives. The
- lisp variable configure-info-directory gets its value from this
- macro, and is then used to set the Info-default-directory-list. */
-/* #define PATH_INFO "/usr/local/info" */
-#define PATH_INFO "C:/emacs/info"
+++ /dev/null
-/* Pro-process emacs.exe for profiling by MSVC.
- Copyright (C) 1999 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.
-
- Andrew Innes <andrewi@harlequin.co.uk> 16-Jan-1999
- based on code from addsection.c
-*/
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <fcntl.h>
-#include <time.h>
-#ifdef __GNUC__
-#define _ANONYMOUS_UNION
-#define _ANONYMOUS_STRUCT
-#endif
-#include <windows.h>
-
-/* Include relevant definitions from IMAGEHLP.H, which can be found
- in \\win32sdk\mstools\samples\image\include\imagehlp.h. */
-
-PIMAGE_NT_HEADERS
-(__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress,
- DWORD FileLength,
- LPDWORD HeaderSum,
- LPDWORD CheckSum);
-
-#undef min
-#undef max
-#define min(x, y) (((x) < (y)) ? (x) : (y))
-#define max(x, y) (((x) > (y)) ? (x) : (y))
-
-
-/* File handling. */
-
-typedef struct file_data {
- char *name;
- unsigned long size;
- HANDLE file;
- HANDLE file_mapping;
- unsigned char *file_base;
-} file_data;
-
-int
-open_input_file (file_data *p_file, char *filename)
-{
- HANDLE file;
- HANDLE file_mapping;
- void *file_base;
- unsigned long size, upper_size;
-
- file = CreateFile (filename, GENERIC_READ, FILE_SHARE_READ, NULL,
- OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
- if (file == INVALID_HANDLE_VALUE)
- return FALSE;
-
- size = GetFileSize (file, &upper_size);
- file_mapping = CreateFileMapping (file, NULL, PAGE_READONLY,
- 0, size, NULL);
- if (!file_mapping)
- return FALSE;
-
- file_base = MapViewOfFile (file_mapping, FILE_MAP_READ, 0, 0, size);
- if (file_base == 0)
- return FALSE;
-
- p_file->name = filename;
- p_file->size = size;
- p_file->file = file;
- p_file->file_mapping = file_mapping;
- p_file->file_base = file_base;
-
- return TRUE;
-}
-
-int
-open_output_file (file_data *p_file, char *filename, unsigned long size)
-{
- HANDLE file;
- HANDLE file_mapping;
- void *file_base;
-
- file = CreateFile (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL,
- CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
- if (file == INVALID_HANDLE_VALUE)
- return FALSE;
-
- file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE,
- 0, size, NULL);
- if (!file_mapping)
- return FALSE;
-
- file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size);
- if (file_base == 0)
- return FALSE;
-
- p_file->name = filename;
- p_file->size = size;
- p_file->file = file;
- p_file->file_mapping = file_mapping;
- p_file->file_base = file_base;
-
- return TRUE;
-}
-
-int
-open_inout_file (file_data *p_file, char *filename)
-{
- HANDLE file;
- HANDLE file_mapping;
- void *file_base;
- unsigned long size, upper_size;
-
- file = CreateFile (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL,
- OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
- if (file == INVALID_HANDLE_VALUE)
- return FALSE;
-
- size = GetFileSize (file, &upper_size);
- file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE,
- 0, size, NULL);
- if (!file_mapping)
- return FALSE;
-
- file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size);
- if (file_base == 0)
- return FALSE;
-
- p_file->name = filename;
- p_file->size = size;
- p_file->file = file;
- p_file->file_mapping = file_mapping;
- p_file->file_base = file_base;
-
- return TRUE;
-}
-
-/* Close the system structures associated with the given file. */
-void
-close_file_data (file_data *p_file)
-{
- UnmapViewOfFile (p_file->file_base);
- CloseHandle (p_file->file_mapping);
- /* For the case of output files, set final size. */
- SetFilePointer (p_file->file, p_file->size, NULL, FILE_BEGIN);
- SetEndOfFile (p_file->file);
- CloseHandle (p_file->file);
-}
-
-
-/* Routines to manipulate NT executable file sections. */
-
-unsigned long
-get_unrounded_section_size (PIMAGE_SECTION_HEADER p_section)
-{
- /* The true section size, before rounding, for an initialized data or
- code section. (Supposedly some linkers swap the meaning of these
- two values.) */
- return min (p_section->SizeOfRawData,
- p_section->Misc.VirtualSize);
-}
-
-/* Return pointer to section header for named section. */
-IMAGE_SECTION_HEADER *
-find_section (char * name, IMAGE_NT_HEADERS * nt_header)
-{
- PIMAGE_SECTION_HEADER section;
- int i;
-
- section = IMAGE_FIRST_SECTION (nt_header);
-
- for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
- {
- if (strcmp (section->Name, name) == 0)
- return section;
- section++;
- }
- return NULL;
-}
-
-/* Return pointer to section header for section containing the given
- relative virtual address. */
-IMAGE_SECTION_HEADER *
-rva_to_section (DWORD rva, IMAGE_NT_HEADERS * nt_header)
-{
- PIMAGE_SECTION_HEADER section;
- int i;
-
- section = IMAGE_FIRST_SECTION (nt_header);
-
- for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
- {
- /* Some linkers (eg. the NT SDK linker I believe) swapped the
- meaning of these two values - or rather, they ignored
- VirtualSize entirely and always set it to zero. This affects
- some very old exes (eg. gzip dated Dec 1993). Since
- w32_executable_type relies on this function to work reliably,
- we need to cope with this. */
- DWORD real_size = max (section->SizeOfRawData,
- section->Misc.VirtualSize);
- if (rva >= section->VirtualAddress
- && rva < section->VirtualAddress + real_size)
- return section;
- section++;
- }
- return NULL;
-}
-
-/* Return pointer to section header for section containing the given
- offset in its raw data area. */
-IMAGE_SECTION_HEADER *
-offset_to_section (DWORD offset, IMAGE_NT_HEADERS * nt_header)
-{
- PIMAGE_SECTION_HEADER section;
- int i;
-
- section = IMAGE_FIRST_SECTION (nt_header);
-
- for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++)
- {
- if (offset >= section->PointerToRawData
- && offset < section->PointerToRawData + section->SizeOfRawData)
- return section;
- section++;
- }
- return NULL;
-}
-
-/* Return offset to an object in dst, given offset in src. We assume
- there is at least one section in both src and dst images, and that
- the some sections may have been added to dst (after sections in src). */
-static DWORD
-relocate_offset (DWORD offset,
- IMAGE_NT_HEADERS * src_nt_header,
- IMAGE_NT_HEADERS * dst_nt_header)
-{
- PIMAGE_SECTION_HEADER src_section = IMAGE_FIRST_SECTION (src_nt_header);
- PIMAGE_SECTION_HEADER dst_section = IMAGE_FIRST_SECTION (dst_nt_header);
- int i = 0;
-
- while (offset >= src_section->PointerToRawData)
- {
- if (offset < src_section->PointerToRawData + src_section->SizeOfRawData)
- break;
- i++;
- if (i == src_nt_header->FileHeader.NumberOfSections)
- {
- /* Handle offsets after the last section. */
- dst_section = IMAGE_FIRST_SECTION (dst_nt_header);
- dst_section += dst_nt_header->FileHeader.NumberOfSections - 1;
- while (dst_section->PointerToRawData == 0)
- dst_section--;
- while (src_section->PointerToRawData == 0)
- src_section--;
- return offset
- + (dst_section->PointerToRawData + dst_section->SizeOfRawData)
- - (src_section->PointerToRawData + src_section->SizeOfRawData);
- }
- src_section++;
- dst_section++;
- }
- return offset +
- (dst_section->PointerToRawData - src_section->PointerToRawData);
-}
-
-#define OFFSET_TO_RVA(offset, section) \
- (section->VirtualAddress + ((DWORD)(offset) - section->PointerToRawData))
-
-#define RVA_TO_OFFSET(rva, section) \
- (section->PointerToRawData + ((DWORD)(rva) - section->VirtualAddress))
-
-#define RVA_TO_SECTION_OFFSET(rva, section) \
- ((DWORD)(rva) - section->VirtualAddress)
-
-#define RVA_TO_PTR(var,section,filedata) \
- ((void *)(RVA_TO_OFFSET(var,section) + (filedata)->file_base))
-
-/* Convert address in executing image to RVA. */
-#define PTR_TO_RVA(ptr) ((DWORD)(ptr) - (DWORD) GetModuleHandle (NULL))
-
-#define PTR_TO_OFFSET(ptr, pfile_data) \
- ((unsigned char *)(ptr) - (pfile_data)->file_base)
-
-#define OFFSET_TO_PTR(offset, pfile_data) \
- ((pfile_data)->file_base + (DWORD)(offset))
-
-#define ROUND_UP(p, align) (((DWORD)(p) + (align)-1) & ~((align)-1))
-#define ROUND_DOWN(p, align) ((DWORD)(p) & ~((align)-1))
-
-
-/* The MSVC prep program generates a ._xe file from .exe, where relevant
- function calls etc have been patched to go through thunks (generated
- by prep) that record timing/call information. Because the thunks
- need to make references to functions imported from profile.dll, the
- import table must be expanded; the end result is that all the
- sections following .rdata are relocated to higher RVAs (add a final
- code section is added holding all the thunks). The .reloc section is
- also expanded, so that the thunks themselves are relocatable.
-
- It is this relocation which kills emacs._xe, because the dumped heap
- pointers aren't relocated, because there is no relocation data for
- either the relevant global/static variables or the heap section
- itself, both of which contain pointers into the heap. [Note that
- static variables which aren't initialized during linking may become
- initialized with heap pointers, or even pointers to other static
- variables, because of dumping.]
-
- We could potentially generate the relocation data ourselves by making
- two versions of temacs, one with an extra dummmy section before
- EMHEAP to offset it, and then compare the dumped executables from
- both. That is a lot of work though, and it doesn't solve the problem
- of dumped pointers to static variables, which also can be relocated.
-
- A better solution is to pre-process emacs.exe so that the .rdata and
- .reloc sections are moved to the end of the section table, and thus
- prep won't relocate anything else. (Of course, we leave "dead"
- copies of these two sections in place, so that the virtual address of
- everything else is unaffected.) Relocating the .reloc data is
- trivial - we just update the IMAGE_BASE_RELOCATION address in the
- header (the data itself doesn't change). Relocating the import table
- is more complicated though, because the calls to imported functions
- must be patched up. That requires us to selectively apply the base
- relocations when we encounter references to imported functions (or
- variables) in other sections, but at least the base relocations are
- easy to parse. */
-
-static void
-copy_executable_and_move_sections (file_data *p_infile,
- file_data *p_outfile)
-{
- unsigned char *dst;
- PIMAGE_DOS_HEADER dos_header;
- PIMAGE_NT_HEADERS nt_header;
- PIMAGE_NT_HEADERS dst_nt_header;
- PIMAGE_SECTION_HEADER section;
- PIMAGE_SECTION_HEADER dst_section;
- PIMAGE_SECTION_HEADER import_section;
- PIMAGE_SECTION_HEADER reloc_section;
- PIMAGE_DATA_DIRECTORY import_dir;
- PIMAGE_DATA_DIRECTORY reloc_dir;
- DWORD import_delta_rva;
- DWORD reloc_delta_rva;
- DWORD offset;
- int i;
-
-#define COPY_CHUNK(message, src, size) \
- do { \
- unsigned char *s = (void *)(src); \
- unsigned long count = (size); \
- printf ("%s\n", (message)); \
- printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \
- printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \
- printf ("\t0x%08x Size in bytes.\n", count); \
- memcpy (dst, s, count); \
- dst += count; \
- } while (0)
-
-#define DST_TO_OFFSET() PTR_TO_OFFSET (dst, p_outfile)
-#define ROUND_UP_DST_AND_ZERO(align) \
- do { \
- unsigned char *newdst = p_outfile->file_base \
- + ROUND_UP (DST_TO_OFFSET (), (align)); \
- /* Zero the alignment slop; it may actually initialize real data. */ \
- memset (dst, 0, newdst - dst); \
- dst = newdst; \
- } while (0)
-
- /* Copy the source image sequentially, ie. section by section after
- copying the headers and section table, to simplify the process of
- relocating the .rdata and .reloc section table entries (which might
- force the raw section data to be relocated).
-
- Note that dst is updated implicitly by each COPY_CHUNK. */
-
- dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base;
- nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) +
- dos_header->e_lfanew);
- section = IMAGE_FIRST_SECTION (nt_header);
-
- import_dir = &nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT];
- import_section = rva_to_section (import_dir->VirtualAddress, nt_header);
-
- reloc_dir = &nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC];
- reloc_section = rva_to_section (reloc_dir->VirtualAddress, nt_header);
- if (!reloc_section)
- {
- printf ("No relocation data, cannot prepare for profile prepping.\n");
- exit (1);
- }
-
- dst = (unsigned char *) p_outfile->file_base;
-
- COPY_CHUNK ("Copying DOS header...", dos_header,
- (DWORD) nt_header - (DWORD) dos_header);
- dst_nt_header = (PIMAGE_NT_HEADERS) dst;
- COPY_CHUNK ("Copying NT header...", nt_header,
- (DWORD) section - (DWORD) nt_header);
- dst_section = (PIMAGE_SECTION_HEADER) dst;
- COPY_CHUNK ("Copying section table...", section,
- nt_header->FileHeader.NumberOfSections * sizeof (*section));
-
- /* Leave room for extra section table entries; filled in below. */
- dst += 2 * sizeof (*section);
-
- /* Align the first section's raw data area, and set the header size
- field accordingly. */
- ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment);
- dst_nt_header->OptionalHeader.SizeOfHeaders = DST_TO_OFFSET ();
-
- for (i = 0; i < nt_header->FileHeader.NumberOfSections;
- i++, section++, dst_section++)
- {
- char msg[100];
- sprintf (msg, "Copying raw data for %s...", section->Name);
-
- /* "Blank out" the two sections being relocated. */
- if (section == import_section || section == reloc_section)
- {
- dst_section->Name[0] = 'X';
- dst_section->Misc.VirtualSize =
- ROUND_UP (dst_section->Misc.VirtualSize,
- dst_nt_header->OptionalHeader.SectionAlignment);
- dst_section->PointerToRawData = 0;
- dst_section->SizeOfRawData = 0;
- dst_section->Characteristics &= ~IMAGE_SCN_CNT_INITIALIZED_DATA;
- dst_section->Characteristics |= IMAGE_SCN_CNT_UNINITIALIZED_DATA;
- dst_section->Characteristics &= ~IMAGE_SCN_MEM_WRITE;
- continue;
- }
-
- /* Update the file-relative offset for this section's raw data (if
- it has any) in case things have been relocated; we will update
- the other offsets below once we know where everything is. */
- if (dst_section->PointerToRawData)
- dst_section->PointerToRawData = DST_TO_OFFSET ();
-
- /* Copy the original raw data. */
- COPY_CHUNK
- (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile),
- section->SizeOfRawData);
-
- /* Round up the raw data size to the new alignment. */
- dst_section->SizeOfRawData =
- ROUND_UP (dst_section->SizeOfRawData,
- dst_nt_header->OptionalHeader.FileAlignment);
-
- /* Align the next section's raw data area. */
- ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment);
- }
-
- /* Add the extra section entries, copying the raw data we skipped
- earlier. We'll patch up the data itself below. */
- if (import_section != NULL)
- {
- dst_nt_header->FileHeader.NumberOfSections++;
- dst_nt_header->OptionalHeader.SizeOfImage +=
- ROUND_UP (import_section->Misc.VirtualSize,
- dst_nt_header->OptionalHeader.SectionAlignment);
- *dst_section = *import_section;
- dst_section->VirtualAddress =
- dst_section[-1].VirtualAddress
- + ROUND_UP (dst_section[-1].Misc.VirtualSize,
- dst_nt_header->OptionalHeader.SectionAlignment);
- dst_section->PointerToRawData = DST_TO_OFFSET ();
- /* Remember delta applied to import section. */
- import_delta_rva = dst_section->VirtualAddress - import_section->VirtualAddress;
- COPY_CHUNK
- ("Relocating import directory",
- OFFSET_TO_PTR (import_section->PointerToRawData, p_infile),
- import_section->SizeOfRawData);
- ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment);
- dst_section++;
- }
- if (reloc_section != NULL)
- {
- dst_nt_header->FileHeader.NumberOfSections++;
- dst_nt_header->OptionalHeader.SizeOfImage +=
- ROUND_UP (reloc_section->Misc.VirtualSize,
- dst_nt_header->OptionalHeader.SectionAlignment);
- *dst_section = *reloc_section;
- dst_section->VirtualAddress =
- dst_section[-1].VirtualAddress
- + ROUND_UP (dst_section[-1].Misc.VirtualSize,
- dst_nt_header->OptionalHeader.SectionAlignment);
- dst_section->PointerToRawData = DST_TO_OFFSET ();
- /* Remember delta applied to reloc section. */
- reloc_delta_rva = dst_section->VirtualAddress - reloc_section->VirtualAddress;
- COPY_CHUNK
- ("Relocating base relocations directory",
- OFFSET_TO_PTR (reloc_section->PointerToRawData, p_infile),
- reloc_section->SizeOfRawData);
- ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment);
- reloc_dir = &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC];
- reloc_dir->VirtualAddress += reloc_delta_rva;
- dst_section++;
- }
-
- /* Copy remainder of source image. */
- section--;
- offset = ROUND_UP (section->PointerToRawData + section->SizeOfRawData,
- nt_header->OptionalHeader.FileAlignment);
- COPY_CHUNK
- ("Copying remainder of executable...",
- OFFSET_TO_PTR (offset, p_infile),
- p_infile->size - offset);
-
- /* Final size for new image. */
- p_outfile->size = DST_TO_OFFSET ();
-
- /* Now patch up remaining file-relative offsets. */
- printf ("Patching up raw data offsets...\n");
-
- section = IMAGE_FIRST_SECTION (nt_header);
- dst_section = IMAGE_FIRST_SECTION (dst_nt_header);
-
-#define ADJUST_OFFSET(var) \
- do { \
- if ((var) != 0) \
- (var) = relocate_offset ((var), nt_header, dst_nt_header); \
- } while (0)
-
-#define ADJUST_IMPORT_RVA(var) \
- do { \
- if ((var) != 0) \
- *((DWORD *)&(var)) += import_delta_rva; \
- } while (0)
-
- dst_nt_header->OptionalHeader.SizeOfInitializedData = 0;
- dst_nt_header->OptionalHeader.SizeOfUninitializedData = 0;
- for (i = 0; i < dst_nt_header->FileHeader.NumberOfSections; i++)
- {
- /* Recompute data sizes for completeness. */
- if (dst_section[i].Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA)
- dst_nt_header->OptionalHeader.SizeOfInitializedData +=
- ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment);
- else if (dst_section[i].Characteristics & IMAGE_SCN_CNT_UNINITIALIZED_DATA)
- dst_nt_header->OptionalHeader.SizeOfUninitializedData +=
- ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment);
-
- ADJUST_OFFSET (dst_section[i].PointerToLinenumbers);
- }
-
- ADJUST_OFFSET (dst_nt_header->FileHeader.PointerToSymbolTable);
-
- /* Update offsets in debug directory entries. Note that the debug
- directory may be in the same section as the import table, so its
- RVA may need to be adjusted too. */
- {
- PIMAGE_DATA_DIRECTORY debug_dir =
- &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DEBUG];
- PIMAGE_DEBUG_DIRECTORY debug_entry;
-
- /* Update debug_dir if part of import_section. */
- if (rva_to_section (debug_dir->VirtualAddress, nt_header) == import_section)
- debug_dir->VirtualAddress += import_delta_rva;
-
- section = rva_to_section (debug_dir->VirtualAddress, dst_nt_header);
- if (section)
- {
- int size;
-
- debug_entry = RVA_TO_PTR (debug_dir->VirtualAddress, section, p_outfile);
- size = debug_dir->Size / sizeof (IMAGE_DEBUG_DIRECTORY);
-
- for (i = 0; i < size; i++, debug_entry++)
- {
- /* The debug data itself is normally not part of any
- section, but stored after all the raw section data. So
- let relocate_offset do the work. */
- ADJUST_OFFSET (debug_entry->PointerToRawData);
- ADJUST_IMPORT_RVA (debug_entry->AddressOfRawData);
- }
- }
- }
-
- /* Update RVAs in import directory entries. */
- {
- PIMAGE_IMPORT_DESCRIPTOR imports;
- PIMAGE_THUNK_DATA import_thunks;
-
- import_dir = &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT];
- import_dir->VirtualAddress += import_delta_rva;
-
- section = rva_to_section (import_dir->VirtualAddress, dst_nt_header);
- imports = RVA_TO_PTR (import_dir->VirtualAddress, section, p_outfile);
-
- for ( ; imports->Name != 0; imports++)
- {
- ADJUST_IMPORT_RVA (imports->OriginalFirstThunk);
- ADJUST_IMPORT_RVA (imports->FirstThunk);
- ADJUST_IMPORT_RVA (imports->Name);
-
- for (import_thunks = RVA_TO_PTR (imports->OriginalFirstThunk, section, p_outfile);
- import_thunks->u1.Function != 0;
- import_thunks++)
- if ((import_thunks->u1.Ordinal >> 31) == 0)
- ADJUST_IMPORT_RVA (import_thunks->u1.Ordinal);
-
- for (import_thunks = RVA_TO_PTR (imports->FirstThunk, section, p_outfile);
- import_thunks->u1.Function != 0;
- import_thunks++)
- if ((import_thunks->u1.Ordinal >> 31) == 0)
- ADJUST_IMPORT_RVA (import_thunks->u1.Ordinal);
- }
-
- import_dir = &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IAT];
- import_dir->VirtualAddress += import_delta_rva;
- }
-
- /* Fix up references to the import section. */
- printf ("Applying fixups to import references...\n");
-
- {
- IMAGE_BASE_RELOCATION *relocs, *block, *start_block, *end_block;
- DWORD import_start = import_section->VirtualAddress + dst_nt_header->OptionalHeader.ImageBase;
- DWORD import_end = import_start + import_section->Misc.VirtualSize;
- DWORD len_import_relocs;
- DWORD len_remaining_relocs;
- int seen_high = 0;
- WORD * high_word;
- void * holder;
-
- reloc_dir = &dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC];
- reloc_section = rva_to_section (reloc_dir->VirtualAddress, dst_nt_header);
- relocs = RVA_TO_PTR (reloc_dir->VirtualAddress, reloc_section, p_outfile);
-
- /* Move the base relocations for the import section, if there are
- any; the profiler needs to be able to patch RVAs in the import
- section itself. */
- for (block = relocs, start_block = 0;
- (DWORD) block - (DWORD) relocs < reloc_dir->Size;
- block = (void *)((DWORD) block + block->SizeOfBlock))
- {
- if (block->VirtualAddress >= import_section->VirtualAddress + import_section->Misc.VirtualSize)
- {
- end_block = block;
- break;
- }
- if (block->VirtualAddress >= import_section->VirtualAddress)
- {
- if (start_block == 0)
- start_block = block;
- block->VirtualAddress += import_delta_rva;
- }
- }
- if (start_block)
- {
- len_import_relocs = (DWORD) end_block - (DWORD) start_block;
- len_remaining_relocs = (DWORD) relocs + reloc_dir->Size - (DWORD) end_block;
- holder = malloc (len_import_relocs);
- if (holder == 0)
- abort ();
- memcpy (holder, start_block, len_import_relocs);
- memcpy (start_block, end_block, len_remaining_relocs);
- memcpy ((char *) start_block + len_remaining_relocs, holder, len_import_relocs);
- free (holder);
- }
-
- /* Walk up the list of base relocations, checking for references
- to the old import section location, and patching them to
- reference the new location. */
- for (block = relocs;
- (DWORD) block - (DWORD) relocs < reloc_dir->Size;
- block = (void *)((DWORD) block + block->SizeOfBlock))
- {
- DWORD page_rva = block->VirtualAddress;
- DWORD page_offset;
- union {
- WORD word;
- DWORD dword;
- } * ploc;
- WORD *fixup;
-
- section = rva_to_section (page_rva, dst_nt_header);
- /* Don't apply fixups to the blanked sections. */
- if (section->Name[0] == 'X')
- continue;
-
- for (fixup = (WORD *) &block[1];
- (DWORD) fixup - (DWORD) block < block->SizeOfBlock;
- fixup++)
- {
- page_offset = (*fixup) & 0xfff;
- ploc = RVA_TO_PTR (page_rva + page_offset, section, p_outfile);
-
- /* Unless our assumption is wrong, all low word fixups
- should immediately follow a high fixup. */
- if (seen_high && ((*fixup) >> 12) != IMAGE_REL_BASED_LOW)
- abort ();
-
- switch ((*fixup) >> 12)
- {
- case IMAGE_REL_BASED_ABSOLUTE:
- break;
- case IMAGE_REL_BASED_HIGH:
- /* We must assume that high and low fixups occur in
- pairs, specifically a low fixup immediately follows a
- high fixup (normally separated by two bytes). We
- have to process the two fixups together, to find out
- the full pointer value and decide whether to apply
- the fixup. */
- seen_high = 1;
- high_word = &ploc->word;
- break;
- case IMAGE_REL_BASED_LOW:
- offset = (*high_word << 16) + ploc->word;
- if (offset >= import_start && offset < import_end)
- {
- (*high_word) += import_delta_rva >> 16;
- ploc->dword += import_delta_rva & 0xffff;
- }
- seen_high = 0;
- break;
- case IMAGE_REL_BASED_HIGHLOW:
- /* Docs imply two words in big-endian order, so perhaps
- this is only used on big-endian platforms, in which
- case the obvious code will work. */
- if (ploc->dword >= import_start && ploc->dword < import_end)
- ploc->dword += import_delta_rva;
- break;
- case IMAGE_REL_BASED_HIGHADJ:
- /* Docs don't say, but I guess this is the equivalent
- for little-endian platforms. */
- if (ploc->dword >= import_start && ploc->dword < import_end)
- ploc->dword += import_delta_rva;
- break;
- case IMAGE_REL_BASED_MIPS_JMPADDR:
- /* Don't know how to handle this; MIPS support has been
- dropped from NT4 anyway. */
- abort ();
- break;
-#ifdef IMAGE_REL_BASED_SECTION
- case IMAGE_REL_BASED_SECTION:
- case IMAGE_REL_BASED_REL32:
- /* Docs don't say what these values mean. */
-#endif
- default:
- abort ();
- }
- }
- }
- }
-}
-
-
-int
-main (int argc, char **argv)
-{
- PIMAGE_DOS_HEADER dos_header;
- PIMAGE_NT_HEADERS nt_header;
- file_data in_file, out_file;
- char out_filename[MAX_PATH], in_filename[MAX_PATH];
- char *ptr;
-
- strcpy (in_filename, argv[1]);
- strcpy (out_filename, argv[2]);
-
- printf ("Preparing %s for profile prepping\n", out_filename);
-
- /* Open the original (dumped) executable file for reference. */
- if (!open_input_file (&in_file, in_filename))
- {
- printf ("Failed to open %s (%d)...bailing.\n",
- in_filename, GetLastError ());
- exit (1);
- }
-
- /* Create a new image that can be prepped; we don't expect the size to
- change because we are only adding two new section table entries,
- which should fit in the alignment slop. */
- if (!open_output_file (&out_file, out_filename, in_file.size))
- {
- printf ("Failed to open %s (%d)...bailing.\n",
- out_filename, GetLastError ());
- exit (1);
- }
-
- copy_executable_and_move_sections (&in_file, &out_file);
-
- /* Patch up header fields; profiler is picky about this. */
- {
- HANDLE hImagehelp = LoadLibrary ("imagehlp.dll");
- DWORD headersum;
- DWORD checksum;
-
- dos_header = (PIMAGE_DOS_HEADER) out_file.file_base;
- nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew);
-
- nt_header->OptionalHeader.CheckSum = 0;
-// nt_header->FileHeader.TimeDateStamp = time (NULL);
-// dos_header->e_cp = size / 512;
-// nt_header->OptionalHeader.SizeOfImage = size;
-
- pfnCheckSumMappedFile = (void *) GetProcAddress (hImagehelp, "CheckSumMappedFile");
- if (pfnCheckSumMappedFile)
- {
-// nt_header->FileHeader.TimeDateStamp = time (NULL);
- pfnCheckSumMappedFile (out_file.file_base,
- out_file.size,
- &headersum,
- &checksum);
- nt_header->OptionalHeader.CheckSum = checksum;
- }
- FreeLibrary (hImagehelp);
- }
-
- close_file_data (&out_file);
- close_file_data (&in_file);
-
- return 0;
-}
-
-/* eof */
+++ /dev/null
-/*
- Simple program to start Emacs with its console window hidden.
-
- This program is provided purely for convenience, since most users will
- use Emacs in windowing (GUI) mode, and will not want to have an extra
- console window lying around. */
-
-/*
- You may want to define this if you want to be able to install updated
- emacs binaries even when other users are using the current version.
- The problem with some file servers (notably Novell) is that an open
- file cannot be overwritten, deleted, or even renamed. So if someone
- is running emacs.exe already, you cannot install a newer version.
- By defining CHOOSE_NEWEST_EXE, you can name your new emacs.exe
- something else which matches "emacs*.exe", and runemacs will
- automatically select the newest emacs executeable in the bin directory.
- (So you'll probably be able to delete the old version some hours/days
- later).
-*/
-
-/* #define CHOOSE_NEWEST_EXE */
-
-#include <windows.h>
-#include <string.h>
-#include <malloc.h>
-
-int WINAPI
-WinMain (HINSTANCE hSelf, HINSTANCE hPrev, LPSTR cmdline, int nShow)
-{
- STARTUPINFO start;
- SECURITY_ATTRIBUTES sec_attrs;
- SECURITY_DESCRIPTOR sec_desc;
- PROCESS_INFORMATION child;
- int wait_for_child = FALSE;
- DWORD priority_class = NORMAL_PRIORITY_CLASS;
- DWORD ret_code = 0;
- char *new_cmdline;
- char *p;
- char modname[MAX_PATH];
-
- if (!GetModuleFileName (NULL, modname, MAX_PATH))
- goto error;
- if ((p = strrchr (modname, '\\')) == NULL)
- goto error;
- *p = 0;
-
- new_cmdline = alloca (MAX_PATH + strlen (cmdline) + 3);
- /* Quote executable name in case of spaces in the path. */
- *new_cmdline = '"';
- strcpy (new_cmdline + 1, modname);
-
-#ifdef CHOOSE_NEWEST_EXE
- {
- /* Silly hack to allow new versions to be installed on
- server even when current version is in use. */
-
- char * best_name = alloca (MAX_PATH + 1);
- FILETIME best_time = {0,0};
- WIN32_FIND_DATA wfd;
- HANDLE fh;
- p = new_cmdline + strlen (new_cmdline);
- strcpy (p, "\\emacs*.exe\" ");
- fh = FindFirstFile (new_cmdline, &wfd);
- if (fh == INVALID_HANDLE_VALUE)
- goto error;
- do
- {
- if (wfd.ftLastWriteTime.dwHighDateTime > best_time.dwHighDateTime
- || (wfd.ftLastWriteTime.dwHighDateTime == best_time.dwHighDateTime
- && wfd.ftLastWriteTime.dwLowDateTime > best_time.dwLowDateTime))
- {
- best_time = wfd.ftLastWriteTime;
- strcpy (best_name, wfd.cFileName);
- }
- }
- while (FindNextFile (fh, &wfd));
- FindClose (fh);
- *p++ = '\\';
- strcpy (p, best_name);
- strcat (p, " ");
- }
-#else
- strcat (new_cmdline, "\\emacs.exe\" ");
-#endif
-
- /* Append original arguments if any; first look for arguments we
- recognise (-wait, -high, and -low), and apply them ourselves. */
- while (cmdline[0] == '-' || cmdline[0] == '/')
- {
- if (strncmp (cmdline+1, "wait", 4) == 0)
- {
- wait_for_child = TRUE;
- cmdline += 5;
- }
- else if (strncmp (cmdline+1, "high", 4) == 0)
- {
- priority_class = HIGH_PRIORITY_CLASS;
- cmdline += 5;
- }
- else if (strncmp (cmdline+1, "low", 3) == 0)
- {
- priority_class = IDLE_PRIORITY_CLASS;
- cmdline += 4;
- }
- else
- break;
- }
- strcat (new_cmdline, cmdline);
-
- /* Set emacs_dir variable if runemacs was in "%emacs_dir%\bin". */
- if ((p = strrchr (modname, '\\')) && stricmp (p, "\\bin") == 0)
- {
- *p = 0;
- for (p = modname; *p; p++)
- if (*p == '\\') *p = '/';
- SetEnvironmentVariable ("emacs_dir", modname);
- }
-
- memset (&start, 0, sizeof (start));
- start.cb = sizeof (start);
- start.dwFlags = STARTF_USESHOWWINDOW;
- start.wShowWindow = SW_HIDE;
-
- sec_attrs.nLength = sizeof (sec_attrs);
- sec_attrs.lpSecurityDescriptor = NULL;
- sec_attrs.bInheritHandle = FALSE;
-
- if (CreateProcess (NULL, new_cmdline, &sec_attrs, NULL, TRUE, priority_class,
- GetEnvironmentStrings (), NULL, &start, &child))
- {
- if (wait_for_child)
- {
- WaitForSingleObject (child.hProcess, INFINITE);
- GetExitCodeProcess (child.hProcess, &ret_code);
- }
- CloseHandle (child.hThread);
- CloseHandle (child.hProcess);
- }
- else
- goto error;
- return (int) ret_code;
-
-error:
- MessageBox (NULL, "Could not start Emacs.", "Error", MB_ICONSTOP);
- return 1;
-}
+++ /dev/null
-(if (fboundp 'normal-top-level-add-subdirs-to-load-path)
- (normal-top-level-add-subdirs-to-load-path))
/* On GNU/Linux systems, both methods are used by various mail
programs. I assume that most people are using newer mailers that
have heard of flock. Change this if you need to. */
-/* Debian contains a patch which says: ``On Debian/GNU/Linux systems,
- configure gets the right answers, and that means *NOT* using flock.
- Using flock is guaranteed to be the wrong thing. See Debian Policy
- for details.'' and then uses `#ifdef DEBIAN'. Unfortunately the
- Debian maintainer hasn't provided a clean fix for Emacs.
- movemail.c will use `maillock' when MAILDIR, HAVE_LIBMAIL and
- HAVE_MAILLOCK_H are defined, so the following appears to be the
- correct logic. -- fx */
-
-#if !(defined (HAVE_LIBMAIL) && defined (HAVE_MAILLOCK_H))
+
#define MAIL_USE_FLOCK
-#endif
/* Define CLASH_DETECTION if you want lock files to be written
so that Emacs can tell instantly when you try to modify
projects / emacs.git / commitdiff