Move dstool_oss to ydb/apps/dstool.

80 files changed, 69277 insertions, 0 deletions

diff --git a/contrib/libs/python/Include/cStringIO.h b/contrib/libs/python/Include/cStringIO.h
new file mode 100644
index 0000000000..3a8a908d56
--- /dev/null
+++ b/contrib/libs/python/Include/cStringIO.h
@@ -0,0 +1,7 @@
+#pragma once
+
+#ifdef USE_PYTHON3
+#error "No <cStringIO.h> in Python3"
+#else
+#include <contrib/tools/python/src/Include/cStringIO.h>
+#endif
diff --git a/contrib/libs/qhull/COPYING.txt b/contrib/libs/qhull/COPYING.txt
new file mode 100644
index 0000000000..122a00a4fa
--- /dev/null
+++ b/contrib/libs/qhull/COPYING.txt
@@ -0,0 +1,39 @@
+                    Qhull, Copyright (c) 1993-2020
+                    
+                            C.B. Barber
+                           Arlington, MA 
+                          
+                               and
+
+       The National Science and Technology Research Center for
+        Computation and Visualization of Geometric Structures
+                        (The Geometry Center)
+                       University of Minnesota
+
+                       email: qhull@qhull.org
+
+This software includes Qhull from C.B. Barber and The Geometry Center.  
+Files derived from Qhull 1.0 are copyrighted by the Geometry Center.  The
+remaining files are copyrighted by C.B. Barber.  Qhull is free software 
+and may be obtained via http from www.qhull.org.  It may be freely copied, 
+modified, and redistributed under the following conditions:
+
+1. All copyright notices must remain intact in all files.
+
+2. A copy of this text file must be distributed along with any copies 
+   of Qhull that you redistribute; this includes copies that you have 
+   modified, or copies of programs or other software products that 
+   include Qhull.
+
+3. If you modify Qhull, you must include a notice giving the
+   name of the person performing the modification, the date of
+   modification, and the reason for such modification.
+
+4. When distributing modified versions of Qhull, or other software 
+   products that include Qhull, you must provide notice that the original 
+   source code may be obtained as noted above.
+
+5. There is no warranty or other guarantee of fitness for Qhull, it is 
+   provided solely "as is".  Bug reports or fixes may be sent to 
+   qhull_bug@qhull.org; the authors may or may not act on them as 
+   they desire.
diff --git a/contrib/libs/qhull/README.txt b/contrib/libs/qhull/README.txt
new file mode 100644
index 0000000000..d5f6c05900
--- /dev/null
+++ b/contrib/libs/qhull/README.txt
@@ -0,0 +1,720 @@
+Name
+
+      qhull, rbox        2020.2        2020/08/31        (8.0.2)
+  
+Convex hull, Delaunay triangulation, Voronoi diagrams, Halfspace intersection
+
+      Documentation:
+        html/index.htm
+        <http://www.qhull.org/html>
+
+      Available from:
+        <http://www.qhull.org>
+        <http://www.qhull.org/download>
+        <http://github.com/qhull/qhull/wiki> (git@github.com:qhull/qhull.git)
+
+      News and a paper:
+        <http://www.qhull.org/news>
+        <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.117.405>
+
+     Version 1 (simplicial only):
+        <http://www.qhull.org/download/qhull-1.0.tar.gz>
+
+Purpose
+
+  Qhull is a general dimension convex hull program that reads a set 
+  of points from stdin, and outputs the smallest convex set that contains 
+  the points to stdout.  It also generates Delaunay triangulations, Voronoi 
+  diagrams, furthest-site Voronoi diagrams, and halfspace intersections
+  about a point.
+
+  Rbox is a useful tool in generating input for Qhull; it generates 
+  hypercubes, diamonds, cones, circles, simplices, spirals, 
+  lattices, and random points.
+
+  Qhull produces graphical output for Geomview.  This helps with
+  understanding the output. <http://www.geomview.org>
+
+Environment requirements
+
+  Qhull and rbox should run on all 32-bit and 64-bit computers.  Use
+  an ANSI C or C++ compiler to compile the program.  The software is 
+  self-contained.  It comes with examples and test scripts.
+
+  Qhull's C++ interface uses the STL.  The C++ test program uses QTestLib 
+  from the Qt Framework.
+
+  Qhull is copyrighted software.  Please read COPYING.txt and REGISTER.txt
+  before using or distributing Qhull.
+
+To cite Qhull, please use
+
+  Barber, C.B., Dobkin, D.P., and Huhdanpaa, H.T., "The Quickhull 
+  algorithm for convex hulls," ACM Trans. on Mathematical Software,
+  22(4):469-483, Dec 1996, http://www.qhull.org.
+
+To modify Qhull, particularly the C++ interface
+
+  Qhull is on GitHub 
+     (http://github.com/qhull/qhull/wiki, git@github.com:qhull/qhull.git)
+
+  For internal documentation, see html/qh-code.htm
+
+To install Qhull
+
+  Qhull is precompiled for Windows 32-bit, otherwise it needs compilation.
+
+  Qhull includes Makefiles for gcc and other targets, CMakeLists.txt for CMake,
+  .sln/.vcproj/.vcxproj files for Microsoft Visual Studio, and .pro files 
+  for Qt Creator.  It compiles under Windows with mingw.
+      (<https://github.com/qhull/qhull/wiki/Qhull-build-systems>)
+
+  Install and build instructions follow.  
+
+  See the end of this document for a list of distributed files.
+
+------------------
+Index
+
+Installing Qhull on Windows 10, 8, 7 (32- or 64-bit), Windows XP, and Windows NT
+Installing Qhull on Unix with gcc
+Installing Qhull with CMake 2.6 or later
+Installing Qhull with Qt
+Working with Qhull's C++ interface
+Calling Qhull from C programs
+Compiling Qhull with Microsoft Visual C++
+Compiling Qhull with Qt Creator
+Compiling Qhull with mingw/gcc on Windows
+Compiling Qhull with cygwin on Windows
+Compiling from Makfile without gcc
+Compiling on other machines and compilers
+Distributed files
+Authors
+
+------------------
+Installing Qhull on Windows 10, 8, 7 (32- or 64-bit), Windows XP, and Windows NT
+
+  The zip file contains rbox.exe, qhull.exe, qconvex.exe, qdelaunay.exe, 
+  qhalf.exe, qvoronoi.exe, testqset.exe, user_eg*.exe, documentation files, 
+  and source files.  Qhull.exe and user-eg3.exe are compiled with the reentrant 
+  library while the other executables use the non-reentrant library.
+
+  To install Qhull:
+  - Unzip the files into a directory (e.g., named 'qhull')
+  - Click on QHULL-GO or open a command window into Qhull's bin directory.
+  - Test with 'rbox D4 | qhull'
+
+  To uninstall Qhull
+  - Delete the qhull directory
+
+  To learn about Qhull:
+  - Execute 'qconvex' for a synopsis and examples.
+    Or 'qconvex --help' or 'qconvex -?'
+  - Execute 'rbox 10 | qconvex' to compute the convex hull of 10 random points.
+  - Execute 'rbox 10 | qconvex i TO file' to write results to 'file'.
+  - Browse the documentation: qhull\html\index.htm
+  - If an error occurs, Windows sends the error to stdout instead of stderr.
+    Use 'TO xxx' to send normal output to xxx
+
+  To improve the command window
+  - Double-click the window bar to increase the size of the window
+  - Right-click the window bar
+  - Select Properties
+  - Check QuickEdit Mode
+    Select text with right-click or Enter
+    Paste text with right-click
+  - Change Font to Lucinda Console
+  - Change Layout to Screen Buffer Height 999, Window Size Height 55
+  - Change Colors to Screen Background White, Screen Text Black
+  - Click OK
+  - Select 'Modify shortcut that started this window', then OK
+
+  If you regularly use qhull on a Windows host, install a bash shell such as
+    https://gitforwindows.org/     # based on MSYS2
+      https://github.com/git-for-windows/git/wiki
+      http://www.msys2.org/
+      https://github.com/msys2/msys2/wiki
+      [mar'19] Git for Windows v2.21 requires 'qhull --help'
+      Install in C:\Git\... # Not 'Program Files\...' otherwise './configure && make' fails
+    www.cygwin.com 
+    www.mingw.org/wiki/msys        # for Windows XP
+    Road Bash (www.qhull.org/bash) # based on MSYS
+
+------------------
+Installing Qhull on Unix with gcc
+
+  To build Qhull, static libraries, shared library, and C++ interface
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - make
+  - export LD_LIBRARY_PATH=$PWD/lib:$LD_LIBRARY_PATH
+  - make test
+  
+  'make install' installs Qhull at '/usr/local/'.  It installs pkg-config files 
+  at '/usr/local/lib/pkgconfig'.  Change the install directory with DESTDIR and PREFIX.
+  
+  To build 32-bit Qhull on a 64-bit host (uses 33% less memory in 4-d)
+  - make new M32=-m32
+
+  To build 32-bit Qhull without -fpic (may be faster, but shared library may fail)
+  - make new M32=-m32  FPIC=
+
+  The Makefiles may be edited for other compilers.
+  If 'testqset' exits with an error, qhull is broken
+
+  A simple Makefile for Qhull is in src/libqhull and src/libqhull_r.
+  To build the Qhull executables and libqhullstatic
+  - Extract Qhull from qhull...tgz or qhull...zip
+  - cd src/libqhull_r  # cd src/libqhull 
+  - make
+
+
+------------------
+Installing Qhull with CMake 2.6 or later
+
+  See CMakeLists.txt for examples and further build instructions
+
+  To build Qhull, static libraries, shared library, and C++ interface
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - cd build
+  - cmake --help               # List build generators
+  - cmake -G "<generator>" ..  # e.g., for MINGW-w64 -- cmake -G "MSYS Makefiles" ..
+  - cmake ..                   
+  - make
+  - ctest
+  - make install		# If MSYS or UNIX, default CMAKE_INSTALL_PREFIX is '/usr/local'
+  				# otherwise if WINDOWS, installs to ../bin, ../include, and ../lib
+  - make uninstall		# Delete the files in install_manifest.txt
+
+  The ".." is important.  It refers to the parent directory (i.e., qhull/)
+  
+  CMake installs lib/pkgconfig/qhull*.pc for use with pkg-config
+
+  If CMAKE_INSTALL_PREFIX is C:/Program Files/qhull, you may need to give 'Users' "full control" 
+  to qhull's sub-directories: bin, doc, include, lib, and man (folder > Properties > Security > Edit > Users).
+  
+  On Windows, CMake's 64-bit generators have a "Win64" tag.  Qhull's data structures 
+  are substantial larger as 64-bit code than as 32-bit code.  This may slow down Qhull.
+
+  If cmake fails with "No CMAKE_C_COMPILER could be found"
+  - cmake was not able to find the build environment specified by -G "..."
+
+  If cmake's gcc smoketest fails after a Windows update
+  - Reinstall MINGW-w64 and delete CMakeCache.txt.  A Windows update can break gcc process creation for cc1.
+
+------------------
+Installing Qhull with Qt
+
+  To build Qhull, including its C++ test program (qhulltest)
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - Load src/qhull-all.pro into QtCreator
+  - Configure the project to use a Shadow build at the same level as 'src', 'bin', and 'lib'
+    If, instead, the shadow build is a subdirectory of 'build', Qt Creator will install Qhull in 'build/bin' and 'build/lib'
+  - Build
+  
+  - Build qhulltest with a C++11 or later compiler
+  - qhulltest depends on shared libraries QtCore.a and QtTest.a.  They may need to be copied 
+    into the bin directory.  On Windows, copy Qt5Core.dll and Qt5Test.dll, e.g., /qt/5.11.2/msvc2017_64/bin
+  - If qhulltest fails with exit status 127 and no error message, 
+    check for missing Q5Core.dll and Qt5Test.dll
+
+------------------
+Working with Qhull's C++ interface
+
+  See html/qh-code.htm#cpp for calling Qhull from C++ programs
+  
+  Class and method documentation is limited
+
+  See html/qh-code.htm#reentrant for converting from Qhull-2012
+
+  Examples of using the C++ interface
+    user_eg3_r.cpp
+    qhulltest/*_test.cpp
+
+  Qhull's C++ interface is likely to change.  Stay current with GitHub.
+
+  To clone Qhull's next branch from http://github.com/qhull/qhull/wiki
+    git init
+    git clone git@github.com:qhull/qhull.git
+    cd qhull
+    git checkout next
+    ...
+    git pull origin next
+
+  Compile qhullcpp and libqhullstatic_r with the same compiler.  Both libraries
+  use the C routines setjmp() and longjmp() for error handling.  They must 
+  be compiled with the same compiler.
+
+  Qhull provides pkg-config support with build/qhull.pc.in and lib/pkgconfig/qhull*.pc
+  With back-ticks, you can compile your C++ program with the Qhull libraries:
+      g++ `pkg-config --cflags --libs qhullcpp qhullstatic_r` -o my_app my_app.cpp
+  or
+      g++ `pkg-config --cflags --libs qhullcpp qhull_r` -o my_app my_app.cpp
+
+  qhullcpp must be linked before qhull_r, otherwise the linker reports
+  an error -- "QhullUser ... multiple definition of `qh_fprintf'"
+
+------------------
+Calling Qhull from C programs
+
+  See html/qh-code.htm#library for calling Qhull from C programs
+
+  Qhull provides pkg-config support with build/qhull.pc.in and lib/pkgconfig/qhull*.pc
+  With back-ticks, you can compile your C program with the Qhull library
+      gcc `pkg-config --cflags --libs qhull_r` -o my_app my_app.c
+
+  See html/qh-code.htm#reentrant for converting from Qhull-2012
+
+  Warning: You will need to understand Qhull's data structures and read the 
+  code.  Most users will find it easier to call Qhull as an external command.
+
+  The reentrant 'C' code (src/libqhull_r), passes a pointer to qhT 
+  to most Qhull routines.  This allows multiple instances of Qhull to run 
+  at the same time.  It simplifies the C++ interface.
+
+  The non-reentrant 'C' code (src/libqhull) looks unusual.  It refers to 
+  Qhull's global data structure, qhT, through a 'qh' macro (e.g., 'qh ferr'). 
+  This allows the same code to use static memory or heap memory. 
+  If qh_QHpointer is defined, qh_qh is a pointer to an allocated qhT; 
+  otherwise qh_qh is a global static data structure of type qhT.
+
+------------------
+Compiling Qhull with Microsoft Visual C++
+
+  To compile 32-bit Qhull with Microsoft Visual C++ 2010 and later
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - Load solution build/qhull-32.sln	
+  - Right-click 'Retarget solution' from toolset v110 to your Platform Toolset
+    File > Save All
+  - Build target 'Win32'
+  - Project qhulltest requires Qt for DevStudio (http://www.qt.io)
+    Set the QTDIR environment variable to your Qt directory (e.g., c:/qt/5.2.0/5.2.0/msvc2012)
+    If QTDIR is incorrect, precompile will fail with 'Can not locate the file specified'
+  - Copy Qt shared libraries, QtCore.dll and QtTest.dll, into the bin directory
+
+  To compile 64-bit Qhull with Microsoft Visual C++ 2010 and later
+  - 64-bit Qhull has larger data structures due to 64-bit pointers.  This may slow down Qhull.
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - Load solution build/qhull-64.sln 
+  - Right-click 'Retarget solution' from toolset v110 to your Platform Toolset
+    File > Save All
+  - Build target 'x64'
+  - If build as 32-bit fails, use solution build/qhull-32.sln
+  - Project qhulltest requires Qt for DevStudio (http://www.qt.io)
+    Set the QTDIR environment variable to your Qt directory (e.g., c:/qt/5.2.0/5.2.0/msvc2012_64)
+    If QTDIR is incorrect, precompile will fail with 'Can not locate the file specified'
+  
+  If error -- MSB8020: The build tools for Visual Studio 2012 (Platform Toolset = 'v110') cannot be found.
+  - 'Project > Retarget solution' for both qhull-32.sln and qhull-64.sln
+  - 'File > Open' your preferred solution (qhull-32.sln or qhull-64.sln)
+  - 'Save All' both projects
+  - DevStudio may need a restart
+
+  To compile Qhull with Microsoft Visual C++ 2005 (vcproj files)
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - Load solution build/qhull.sln 
+  - Build target 'win32' (not 'x64')
+  - Project qhulltest requires Qt for DevStudio (http://www.qt.io)
+    Set the QTDIR environment variable to your Qt directory (e.g., c:/qt/4.7.4)
+    If QTDIR is incorrect, precompile will fail with 'Can not locate the file specified'
+
+------------------
+Compiling Qhull with Qt Creator
+
+  Qt (http://www.qt.io) is a C++ framework for Windows, Linux, and Macintosh
+
+  Qhull uses QTestLib to test qhull's C++ interface (see src/qhulltest/)
+
+  To compile Qhull with Qt Creator
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - Download the Qt SDK
+  - Start Qt Creator
+  - Load src/qhull-all.pro
+  - Configure the project to use a Shadow build at the same level as 'src', 'bin', and 'lib'
+    If, instead, the shadow build is a subdirectory of 'build', Qt Creator will install Qhull in 'build/bin' and 'build/lib'
+  - Build
+  
+  - Build qhulltest with a C++11 or later compiler
+  - qhulltest depends on shared libraries QtCore.a and QtTest.a.  They may need to be copied 
+    into the bin directory.  On Windows, copy Qt5Core.dll and Qt5Test.dll, e.g., /qt/5.11.2/msvc2017_64/bin
+  - If qhulltest fails with exit status 127 and no error message, 
+    check for missing Q5Core.dll and Qt5Test.dll
+
+------------------
+Compiling Qhull with mingw/gcc on Windows
+
+  To compile Qhull with MINGW
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - Install GitForWindows (https://gitforwindows.org/)
+    or MSYS2 (http://www.msys2.org/)
+    Install in C:\Git\... # Not 'Program Files\...' otherwise './configure && make' will not work
+  - Install MINGW-w64 with gcc (https://mingw-w64.org/)
+    1) Goto sourceforge -- https://sourceforge.net/projects/mingw-w64/files/
+    2) in folder -- mingw-w64
+    3) download installer -- MinGW-W64-install.exe
+    Run the installer
+    1) Select i686/posix/dwarf
+    2) Install in 'C:\mingw-w64' # Not 'Program Files\...'
+    Rename /c/mingw-w64/mingw32/bin/mingw32-make.exe to make.exe
+    Add the 'C:\mingw-w64\mingw32\bin' directory to your $PATH environment variable
+    Execute 'which make' to check that 'make' is mingw-w64's make
+  - Compile Qhull from the home directory
+    make help
+    make
+
+  Notes
+  - Mingw is included with Qt SDK in qt/Tools/mingw53_32
+  - If you use Windows XP
+    Install Road Bash (http://www.qhull.org/bash) or MSYS (http://www.mingw.org/wiki/msys)
+    Install MINGW (http://mingw.org/)
+
+------------------
+Compiling Qhull with cygwin on Windows
+
+  To compile Qhull with cygwin
+  - Download and extract Qhull (either GitHub, .tgz file, or .zip file)
+  - Install cygwin (http://www.cygwin.com)
+  - Include packages for gcc, make, ar, and ln
+  - make
+
+------------------
+Compiling from Makfile without gcc
+
+  The file, qhull-src.tgz, contains documentation and source files for
+  qhull and rbox.  
+
+  To unpack the tgz file
+  - tar zxf qhull-src.tgz
+  - cd qhull
+  - Use qhull/Makefile
+   Simpler Makefiles are qhull/src/libqhull/Makefile and qhull/src/libqhull_r/Makefile
+
+  Compiling qhull and rbox with Makefile
+  - in Makefile, check the CC, CCOPTS1, PRINTMAN, and PRINTC defines
+      - the defaults are gcc and enscript
+      - CCOPTS1 should include the ANSI flag.  It defines __STDC__
+  - in user.h, check the definitions of qh_SECticks and qh_CPUclock.
+      - use '#define qh_CLOCKtype 2' for timing runs longer than 1 hour
+  - type: make 
+      - this builds: qhull qconvex qdelaunay qhalf qvoronoi rbox libqhull.a libqhull_r.a
+  - type: make doc
+      - this prints the man page
+      - See also qhull/html/index.htm
+  - if your compiler reports many errors, it is probably not a ANSI C compiler
+      - you will need to set the -ansi switch or find another compiler
+  - if your compiler warns about missing prototypes for fprintf() etc.
+      - this is ok, your compiler should have these in stdio.h
+  - if your compiler warns about missing prototypes for memset() etc.
+      - include memory.h in qhull_a.h
+  - if your compiler reports "global.c: storage size of 'qh_qh' isn't known"
+      - delete the initializer "={0}" in global.c, stat.c and mem.c
+  - if your compiler warns about "stat.c: improper initializer"
+      - this is ok, the initializer is not used
+  - if you have trouble building libqhull.a with 'ar'
+      - try 'make -f Makefile.txt qhullx' 
+  - if the code compiles, the qhull test case will automatically execute
+  - if an error occurs, there's an incompatibility between machines
+      - If you can, try a different compiler 
+      - You can turn off the Qhull memory manager with qh_NOmem in mem.h
+      - You can turn off compiler optimization (-O2 in Makefile)
+      - If you find the source of the problem, please let us know
+  - to install the programs and their man pages:
+      - define MANDIR and BINDIR
+      - type 'make install'
+
+  - if you have Geomview (www.geomview.org)
+       - try  'rbox 100 | qconvex G >a' and load 'a' into Geomview
+       - run 'q_eg' for Geomview examples of Qhull output (see qh-eg.htm)
+
+------------------
+Compiling on other machines and compilers
+
+  Qhull may compile with Borland C++ 5.0 bcc32.  A Makefile is included.
+  Execute 'cd src/libqhull; make -f Mborland'.  If you use the Borland IDE, set
+  the ANSI option in Options:Project:Compiler:Source:Language-compliance.
+
+  Qhull may compile with Borland C++ 4.02 for Win32 and DOS Power Pack.  
+  Use 'cd src/libqhull; make -f Mborland -D_DPMI'.  Qhull 1.0 compiles with 
+  Borland C++ 4.02.  For rbox 1.0, use "bcc32 -WX -w- -O2-e -erbox -lc rbox.c".  
+  Use the same options for Qhull 1.0. [D. Zwick]
+
+  If you have troubles with the memory manager, you can turn it off by
+  defining qh_NOmem in mem.h.
+
+------------------
+Distributed files
+
+  README.txt           // Instructions for installing Qhull 
+  REGISTER.txt         // Qhull registration 
+  COPYING.txt          // Copyright notice 
+  QHULL-GO.lnk         // Windows icon for eg/qhull-go.bat
+  Announce.txt         // Announcement 
+  CMakeLists.txt       // CMake build file (2.6 or later)
+  File_id.diz          // Package descriptor
+  index.htm            // Home page 
+  Makefile             // Makefile for gcc and other compilers
+  qhull*.md5sum        // md5sum for all files
+
+  bin/*                // Qhull executables and dll (.zip only)
+  build/CMakeModules/CheckLFS.cmake // enables Large File Support in CMake
+  build/config.cmake.in // extract target variables
+  build/qhull.pc.in    // pkg-config template for creating lib/pkgconfig/qhull*.pc
+  build/qhull-32.sln   // 32-bit DevStudio solution and project files (2010 and later)
+  build/*-32.vcxproj
+  build/qhull-64.sln   // 64-bit DevStudio solution and project files (2010 and later)
+  build/*-64.vcxproj
+  build/qhull.sln      // DevStudio solution and project files (2005 and 2009)
+  build/*.vcproj
+  build/qhulltest/     // DevStudio project files for qhulltest (C++ and Qt)
+  build/README-build.txt // Contents of build/	
+  eg/*                 // Test scripts and geomview files from q_eg
+  html/index.htm       // Manual
+  html/qh-faq.htm      // Frequently asked questions
+  html/qh-get.htm      // Download page
+  html/qhull-cpp.xml   // C++ style notes as a Road FAQ (www.qhull.org/road)
+  src/Changes.txt      // Change history for Qhull and rbox 
+  src/qhull-all.pro    // Qt project
+
+eg/ 
+  q_benchmark          // shell script for precision and performance benchmark
+  q_benchmark-ok.txt   // reviewed output from q_benchmark
+  q_eg                 // shell script for Geomview examples (eg.01.cube)
+  q_egtest             // shell script for Geomview test examples
+  q_test               // shell script to test qhull
+  q_test.bat           // Windows batch test for QHULL-GO.bat
+                       // cd bin; ..\eg\q_test.bat >q_test.x 2>&1
+  q_test-ok.txt        // reviewed output from q_test
+  qhulltest-ok.txt     // reviewed output from qhulltest (Qt only)
+  make-qhull_qh.sh     // shell script to create non-reentrant qhull_qh from reentrant Qhull
+  make-vcproj.sh       // shell script to create vcproj and vcxprog files
+  qhull-zip.sh         // shell script to create distribution files
+  qtest.sh             // shell script for testing and logging qhull
+
+rbox consists of (bin, html):
+  rbox.exe             // Win32 executable (.zip only) 
+  rbox.htm             // html manual 
+  rbox.man             // Unix man page 
+  rbox.txt
+
+qhull consists of (bin, html):
+  qconvex.exe          // Win32 executables and dlls (.zip download only) 
+  qhull.exe            // Built with the reentrant library (about 2% slower)
+  qdelaunay.exe
+  qhalf.exe
+  qvoronoi.exe
+  qhull_r.dll
+  qhull-go.bat         // command window
+  qconvex.htm          // html manual
+  qdelaun.htm
+  qdelau_f.htm        
+  qhalf.htm
+  qvoronoi.htm
+  qvoron_f.htm
+  qh-eg.htm
+  qh-code.htm
+  qh-impre.htm
+  index.htm
+  qh-opt*.htm
+  qh-quick.htm
+  qh--*.gif            // images for manual
+  normal_voronoi_knauss_oesterle.jpg
+  qh_findbestfacet-drielsma.pdf
+  qhull.man            // Unix man page 
+  qhull.txt
+
+bin/
+  msvcr80.dll          // Visual C++ redistributable file (.zip download only)
+
+src/
+  qhull/unix.c         // Qhull and rbox applications using non-reentrant libqhullstatic.a
+  rbox/rbox.c
+  qconvex/qconvex.c    
+  qhalf/qhalf.c
+  qdelaunay/qdelaunay.c
+  qvoronoi/qvoronoi.c
+
+  qhull/unix_r.c        // Qhull and rbox applications using reentrant libqhullstatic_r.a
+  rbox/rbox_r.c
+  qconvex/qconvex_r.c   // Qhull applications built with reentrant libqhull_r/Makefile  
+  qhalf/qhalf_r.c
+  qdelaunay/qdelaun_r.c
+  qvoronoi/qvoronoi_r.c
+
+  user_eg/user_eg_r.c     // example of using qhull_r.dll from a user program
+  user_eg2/user_eg2_r.c   // example of using libqhullstatic_r.a from a user program
+  user_eg3/user_eg3_r.cpp // example of Qhull's C++ interface libqhullcpp with libqhullstatic_r.a
+  qhulltest/qhulltest.cpp // Test of Qhull's C++ interface using Qt's QTestLib
+  qhull-*.pri             // Include files for Qt projects
+  testqset_r/testqset_r.c  // Test of reentrant qset_r.c and mem_r.c
+  testqset/testqset.c     // Test of non-rentrant qset.c and mem.c
+
+src/libqhull
+  libqhull.pro         // Qt project for non-rentrant, shared library (qhull.dll)
+  index.htm            // design documentation for libqhull
+  qh-*.htm
+  qhull-exports.def    // Export Definition files for Visual C++
+  qhull-nomerge-exports.def
+  qhull_p-exports.def
+  qhull_p-nomerge-exports.def
+  Makefile             // Simple gcc Makefile for qhull and libqhullstatic.a
+  Mborland             // Makefile for Borland C++ 5.0
+
+  libqhull.h           // header file for qhull
+  user.h               // header file of user definable constants 
+  libqhull.c           // Quickhull algorithm with partitioning
+  user.c               // user re-definable functions 
+  usermem.c
+  userprintf.c
+  userprintf_rbox.c
+
+  qhull_a.h            // include files for libqhull/*.c 
+  geom.c               // geometric routines 
+  geom2.c
+  geom.h     
+  global.c             // global variables 
+  io.c                 // input-output routines 
+  io.h   
+  mem.c                // memory routines, this is stand-alone code 
+  mem.h
+  merge.c              // merging of non-convex facets 
+  merge.h
+  poly.c               // polyhedron routines 
+  poly2.c
+  poly.h 
+  qset.c               // set routines, this only depends on mem.c 
+  qset.h
+  random.c             // utilities w/ Park & Miller's random number generator
+  random.h
+  rboxlib.c            // point set generator for rbox
+  stat.c               // statistics 
+  stat.h
+
+src/libqhull_r
+  libqhull_r.pro       // Qt project for rentrant, shared library (qhull_r.dll)
+  index.htm            // design documentation for libqhull_r
+  qh-*_r.htm
+  qhull_r-exports.def  // Export Definition files for Visual C++
+  qhull_r-nomerge-exports.def
+  Makefile             // Simple gcc Makefile for qhull and libqhullstatic.a
+
+  libqhull_r.h          // header file for qhull
+  user_r.h              // header file of user definable constants 
+  libqhull_r.c          // Quickhull algorithm wi_r.hpartitioning
+  user_r.c              // user re-definable functions 
+  usermem.c
+  userprintf.c
+  userprintf_rbox.c
+  qhull_ra.h            // include files for libqhull/*_r.c
+  geom_r.c              // geometric routines 
+  geom2.c
+  geom_r.h    
+  global_r.c            // global variables 
+  io_r.c                // input-output routines 
+  io_r.h  
+  mem_r.c               // memory routines, this is stand-alone code 
+  mem.h
+  merge_r.c             // merging of non-convex facets 
+  merge.h
+  poly_r.c              // polyhedron routines 
+  poly2.c
+  poly_r.h
+  qset_r.c              // set routines, this only depends on mem_r.c
+  qset.h
+  random_r.c            // utilities w/ Park & Miller's random number generator
+  random.h
+  rboxlib_r.c           // point set generator for rbox
+  stat_r.c              // statistics 
+  stat.h
+
+src/libqhullcpp/
+  libqhullcpp.pro      // Qt project for renentrant, static C++ library     
+  Qhull.cpp            // Calls libqhull_r.c from C++
+  Qhull.h
+  qt-qhull.cpp         // Supporting methods for Qt
+
+  Coordinates.cpp      // input classes
+  Coordinates.h
+
+  PointCoordinates.cpp
+  PointCoordinates.h
+  RboxPoints.cpp       // call rboxlib.c from C++
+  RboxPoints.h
+
+  QhullFacet.cpp       // data structure classes
+  QhullFacet.h
+  QhullHyperplane.cpp
+  QhullHyperplane.h
+  QhullPoint.cpp
+  QhullPoint.h
+  QhullQh.cpp
+  QhullRidge.cpp
+  QhullRidge.h
+  QhullVertex.cpp
+  QhullVertex.h
+
+  QhullFacetList.cpp   // collection classes
+  QhullFacetList.h
+  QhullFacetSet.cpp
+  QhullFacetSet.h
+  QhullIterator.h
+  QhullLinkedList.h
+  QhullPoints.cpp
+  QhullPoints.h
+  QhullPointSet.cpp
+  QhullPointSet.h
+  QhullSet.cpp
+  QhullSet.h
+  QhullSets.h
+  QhullVertexSet.cpp
+  QhullVertexSet.h
+
+  functionObjects.h    // supporting classes
+  QhullError.cpp
+  QhullError.h
+  QhullQh.cpp
+  QhullQh.h
+  QhullStat.cpp
+  QhullStat.h
+  QhullUser.cpp
+  QhullUser.h
+  RoadError.cpp        // Supporting base classes
+  RoadError.h
+  RoadLogEvent.cpp
+  RoadLogEvent.h
+  usermem_r-cpp.cpp    // Optional override for qh_exit() to throw an error
+
+src/libqhullstatic/
+  libqhullstatic.pro   // Qt project for non-reentrant, static library     
+
+src/libqhullstatic_r/
+  libqhullstatic_r.pro // Qt project for reentrant, static library     
+
+src/qhulltest/
+  qhulltest.pro        // Qt project for test of C++ interface     
+  Coordinates_test.cpp // Test of each class
+  PointCoordinates_test.cpp
+  Qhull_test.cpp
+  QhullFacet_test.cpp
+  QhullFacetList_test.cpp
+  QhullFacetSet_test.cpp
+  QhullHyperplane_test.cpp
+  QhullLinkedList_test.cpp
+  QhullPoint_test.cpp
+  QhullPoints_test.cpp
+  QhullPointSet_test.cpp
+  QhullRidge_test.cpp
+  QhullSet_test.cpp
+  QhullVertex_test.cpp
+  QhullVertexSet_test.cpp
+  RboxPoints_test.cpp
+  RoadTest.cpp         // Run multiple test files with QTestLib
+  RoadTest.h
+
+------------------
+Authors
+
+  C. Bradford Barber                  Hannu Huhdanpaa (Version 1.0)
+  bradb@shore.net                     hannu@qhull.org
+
+  Qhull 1.0 and 2.0 were developed under NSF grants NSF/DMS-8920161 
+  and NSF-CCR-91-15793 750-7504 at the Geometry Center and Harvard 
+  University.  If you find Qhull useful, please let us know.
diff --git a/contrib/libs/qhull/REGISTER.txt b/contrib/libs/qhull/REGISTER.txt
new file mode 100644
index 0000000000..16ccb1a58d
--- /dev/null
+++ b/contrib/libs/qhull/REGISTER.txt
@@ -0,0 +1,32 @@
+Dear Qhull User
+
+We would like to find out how you are using our software.  Think of
+Qhull as a new kind of shareware: you share your science and successes 
+with us, and we share our software and support with you. 
+
+If you use Qhull, please send us a note telling
+us what you are doing with it.
+
+We need to know:
+
+  (1) What you are working on - an abstract of your work would be
+      fine.
+
+  (2) How Qhull has helped you, for example, by increasing your 
+      productivity or allowing you to do things you could not do
+      before.  If Qhull had a direct bearing on your work, please 
+      tell us about this.
+
+We encourage you to cite Qhull in your publications.  
+
+To cite Qhull, please use
+
+        Barber, C.B., Dobkin, D.P., and Huhdanpaa, H.T., "The Quickhull 
+        algorithm for convex hulls," ACM Trans. on Mathematical Software,
+        22(4):469-483, Dec 1996, http://www.qhull.org.
+
+Please send e-mail to
+
+    bradb@shore.net
+
+Thank you!
diff --git a/contrib/libs/qhull/libqhull_r/geom2_r.c b/contrib/libs/qhull/libqhull_r/geom2_r.c
new file mode 100644
index 0000000000..9e0f997f63
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/geom2_r.c
@@ -0,0 +1,2302 @@
+/*<html><pre>  -<a                             href="qh-geom_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+
+   geom2_r.c
+   infrequently used geometric routines of qhull
+
+   see qh-geom_r.htm and geom_r.h
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/geom2_r.c#17 $$Change: 3037 $
+   $DateTime: 2020/09/03 17:28:32 $$Author: bbarber $
+
+   frequently used code goes into geom_r.c
+*/
+
+#include "qhull_ra.h"
+
+/*================== functions in alphabetic order ============*/
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="copypoints">-</a>
+
+  qh_copypoints(qh, points, numpoints, dimension )
+    return qh_malloc'd copy of points
+
+  notes:
+    qh_free the returned points to avoid a memory leak
+*/
+coordT *qh_copypoints(qhT *qh, coordT *points, int numpoints, int dimension)
+{
+  int size;
+  coordT *newpoints;
+
+  size= numpoints * dimension * (int)sizeof(coordT);
+  if (!(newpoints= (coordT *)qh_malloc((size_t)size))) {
+    qh_fprintf(qh, qh->ferr, 6004, "qhull error: insufficient memory to copy %d points\n",
+        numpoints);
+    qh_errexit(qh, qh_ERRmem, NULL, NULL);
+  }
+  memcpy((char *)newpoints, (char *)points, (size_t)size); /* newpoints!=0 by QH6004 */
+  return newpoints;
+} /* copypoints */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="crossproduct">-</a>
+
+  qh_crossproduct( dim, vecA, vecB, vecC )
+    crossproduct of 2 dim vectors
+    C= A x B
+
+  notes:
+    from Glasner, Graphics Gems I, p. 639
+    only defined for dim==3
+*/
+void qh_crossproduct(int dim, realT vecA[3], realT vecB[3], realT vecC[3]){
+
+  if (dim == 3) {
+    vecC[0]=   det2_(vecA[1], vecA[2],
+                     vecB[1], vecB[2]);
+    vecC[1]= - det2_(vecA[0], vecA[2],
+                     vecB[0], vecB[2]);
+    vecC[2]=   det2_(vecA[0], vecA[1],
+                     vecB[0], vecB[1]);
+  }
+} /* vcross */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="determinant">-</a>
+
+  qh_determinant(qh, rows, dim, nearzero )
+    compute signed determinant of a square matrix
+    uses qh.NEARzero to test for degenerate matrices
+
+  returns:
+    determinant
+    overwrites rows and the matrix
+    if dim == 2 or 3
+      nearzero iff determinant < qh->NEARzero[dim-1]
+      (!quite correct, not critical)
+    if dim >= 4
+      nearzero iff diagonal[k] < qh->NEARzero[k]
+*/
+realT qh_determinant(qhT *qh, realT **rows, int dim, boolT *nearzero) {
+  realT det=0;
+  int i;
+  boolT sign= False;
+
+  *nearzero= False;
+  if (dim < 2) {
+    qh_fprintf(qh, qh->ferr, 6005, "qhull internal error (qh_determinate): only implemented for dimension >= 2\n");
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }else if (dim == 2) {
+    det= det2_(rows[0][0], rows[0][1],
+                 rows[1][0], rows[1][1]);
+    if (fabs_(det) < 10*qh->NEARzero[1])  /* QH11031 FIX: not really correct, what should this be? */
+      *nearzero= True;
+  }else if (dim == 3) {
+    det= det3_(rows[0][0], rows[0][1], rows[0][2],
+                 rows[1][0], rows[1][1], rows[1][2],
+                 rows[2][0], rows[2][1], rows[2][2]);
+    if (fabs_(det) < 10*qh->NEARzero[2])  /* QH11031 FIX: what should this be?  det 5.5e-12 was flat for qh_maxsimplex of qdelaunay 0,0 27,27 -36,36 -9,63 */
+      *nearzero= True;
+  }else {
+    qh_gausselim(qh, rows, dim, dim, &sign, nearzero);  /* if nearzero, diagonal still ok */
+    det= 1.0;
+    for (i=dim; i--; )
+      det *= (rows[i])[i];
+    if (sign)
+      det= -det;
+  }
+  return det;
+} /* determinant */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="detjoggle">-</a>
+
+  qh_detjoggle(qh, points, numpoints, dimension )
+    determine default max joggle for point array
+      as qh_distround * qh_JOGGLEdefault
+
+  returns:
+    initial value for JOGGLEmax from points and REALepsilon
+
+  notes:
+    computes DISTround since qh_maxmin not called yet
+    if qh->SCALElast, last dimension will be scaled later to MAXwidth
+
+    loop duplicated from qh_maxmin
+*/
+realT qh_detjoggle(qhT *qh, pointT *points, int numpoints, int dimension) {
+  realT abscoord, distround, joggle, maxcoord, mincoord;
+  pointT *point, *pointtemp;
+  realT maxabs= -REALmax;
+  realT sumabs= 0;
+  realT maxwidth= 0;
+  int k;
+
+  if (qh->SETroundoff)
+    distround= qh->DISTround; /* 'En' */
+  else{
+    for (k=0; k < dimension; k++) {
+      if (qh->SCALElast && k == dimension-1)
+        abscoord= maxwidth;
+      else if (qh->DELAUNAY && k == dimension-1) /* will qh_setdelaunay() */
+        abscoord= 2 * maxabs * maxabs;  /* may be low by qh->hull_dim/2 */
+      else {
+        maxcoord= -REALmax;
+        mincoord= REALmax;
+        FORALLpoint_(qh, points, numpoints) {
+          maximize_(maxcoord, point[k]);
+          minimize_(mincoord, point[k]);
+        }
+        maximize_(maxwidth, maxcoord-mincoord);
+        abscoord= fmax_(maxcoord, -mincoord);
+      }
+      sumabs += abscoord;
+      maximize_(maxabs, abscoord);
+    } /* for k */
+    distround= qh_distround(qh, qh->hull_dim, maxabs, sumabs);
+  }
+  joggle= distround * qh_JOGGLEdefault;
+  maximize_(joggle, REALepsilon * qh_JOGGLEdefault);
+  trace2((qh, qh->ferr, 2001, "qh_detjoggle: joggle=%2.2g maxwidth=%2.2g\n", joggle, maxwidth));
+  return joggle;
+} /* detjoggle */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="detmaxoutside">-</a>
+
+  qh_detmaxoutside(qh);
+    determine qh.MAXoutside target for qh_RATIO... tests of distance
+    updates option '_max-outside'
+
+  notes:
+    called from qh_addpoint and qh_detroundoff
+    accounts for qh.ONEmerge, qh.DISTround, qh.MINoutside ('Wn'), qh.max_outside
+    see qh_maxout for qh.max_outside with qh.DISTround
+*/
+
+void qh_detmaxoutside(qhT *qh) {
+  realT maxoutside;
+
+  maxoutside= fmax_(qh->max_outside, qh->ONEmerge + qh->DISTround);
+  maximize_(maxoutside, qh->MINoutside);
+  qh->MAXoutside= maxoutside;
+  trace3((qh, qh->ferr, 3056, "qh_detmaxoutside: MAXoutside %2.2g from qh.max_outside %2.2g, ONEmerge %2.2g, MINoutside %2.2g, DISTround %2.2g\n",
+      qh->MAXoutside, qh->max_outside, qh->ONEmerge, qh->MINoutside, qh->DISTround));
+} /* detmaxoutside */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="detroundoff">-</a>
+
+  qh_detroundoff(qh)
+    determine maximum roundoff errors from
+      REALepsilon, REALmax, REALmin, qh.hull_dim, qh.MAXabs_coord,
+      qh.MAXsumcoord, qh.MAXwidth, qh.MINdenom_1
+
+    accounts for qh.SETroundoff, qh.RANDOMdist, qh->MERGEexact
+      qh.premerge_cos, qh.postmerge_cos, qh.premerge_centrum,
+      qh.postmerge_centrum, qh.MINoutside,
+      qh_RATIOnearinside, qh_COPLANARratio, qh_WIDEcoplanar
+
+  returns:
+    sets qh.DISTround, etc. (see below)
+    appends precision constants to qh.qhull_options
+
+  see:
+    qh_maxmin() for qh.NEARzero
+
+  design:
+    determine qh.DISTround for distance computations
+    determine minimum denominators for qh_divzero
+    determine qh.ANGLEround for angle computations
+    adjust qh.premerge_cos,... for roundoff error
+    determine qh.ONEmerge for maximum error due to a single merge
+    determine qh.NEARinside, qh.MAXcoplanar, qh.MINvisible,
+      qh.MINoutside, qh.WIDEfacet
+    initialize qh.max_vertex and qh.minvertex
+*/
+void qh_detroundoff(qhT *qh) {
+
+  qh_option(qh, "_max-width", NULL, &qh->MAXwidth);
+  if (!qh->SETroundoff) {
+    qh->DISTround= qh_distround(qh, qh->hull_dim, qh->MAXabs_coord, qh->MAXsumcoord);
+    qh_option(qh, "Error-roundoff", NULL, &qh->DISTround);
+  }
+  qh->MINdenom= qh->MINdenom_1 * qh->MAXabs_coord;
+  qh->MINdenom_1_2= sqrt(qh->MINdenom_1 * qh->hull_dim) ;  /* if will be normalized */
+  qh->MINdenom_2= qh->MINdenom_1_2 * qh->MAXabs_coord;
+                                              /* for inner product */
+  qh->ANGLEround= 1.01 * qh->hull_dim * REALepsilon;
+  if (qh->RANDOMdist) {
+    qh->ANGLEround += qh->RANDOMfactor;
+    trace4((qh, qh->ferr, 4096, "qh_detroundoff: increase qh.ANGLEround by option 'R%2.2g'\n", qh->RANDOMfactor));
+  }
+  if (qh->premerge_cos < REALmax/2) {
+    qh->premerge_cos -= qh->ANGLEround;
+    if (qh->RANDOMdist)
+      qh_option(qh, "Angle-premerge-with-random", NULL, &qh->premerge_cos);
+  }
+  if (qh->postmerge_cos < REALmax/2) {
+    qh->postmerge_cos -= qh->ANGLEround;
+    if (qh->RANDOMdist)
+      qh_option(qh, "Angle-postmerge-with-random", NULL, &qh->postmerge_cos);
+  }
+  qh->premerge_centrum += 2 * qh->DISTround;    /*2 for centrum and distplane()*/
+  qh->postmerge_centrum += 2 * qh->DISTround;
+  if (qh->RANDOMdist && (qh->MERGEexact || qh->PREmerge))
+    qh_option(qh, "Centrum-premerge-with-random", NULL, &qh->premerge_centrum);
+  if (qh->RANDOMdist && qh->POSTmerge)
+    qh_option(qh, "Centrum-postmerge-with-random", NULL, &qh->postmerge_centrum);
+  { /* compute ONEmerge, max vertex offset for merging simplicial facets */
+    realT maxangle= 1.0, maxrho;
+
+    minimize_(maxangle, qh->premerge_cos);
+    minimize_(maxangle, qh->postmerge_cos);
+    /* max diameter * sin theta + DISTround for vertex to its hyperplane */
+    qh->ONEmerge= sqrt((realT)qh->hull_dim) * qh->MAXwidth *
+      sqrt(1.0 - maxangle * maxangle) + qh->DISTround;
+    maxrho= qh->hull_dim * qh->premerge_centrum + qh->DISTround;
+    maximize_(qh->ONEmerge, maxrho);
+    maxrho= qh->hull_dim * qh->postmerge_centrum + qh->DISTround;
+    maximize_(qh->ONEmerge, maxrho);
+    if (qh->MERGING)
+      qh_option(qh, "_one-merge", NULL, &qh->ONEmerge);
+  }
+  qh->NEARinside= qh->ONEmerge * qh_RATIOnearinside; /* only used if qh->KEEPnearinside */
+  if (qh->JOGGLEmax < REALmax/2 && (qh->KEEPcoplanar || qh->KEEPinside)) {
+    realT maxdist;             /* adjust qh.NEARinside for joggle */
+    qh->KEEPnearinside= True;
+    maxdist= sqrt((realT)qh->hull_dim) * qh->JOGGLEmax + qh->DISTround;
+    maxdist= 2*maxdist;        /* vertex and coplanar point can joggle in opposite directions */
+    maximize_(qh->NEARinside, maxdist);  /* must agree with qh_nearcoplanar() */
+  }
+  if (qh->KEEPnearinside)
+    qh_option(qh, "_near-inside", NULL, &qh->NEARinside);
+  if (qh->JOGGLEmax < qh->DISTround) {
+    qh_fprintf(qh, qh->ferr, 6006, "qhull option error: the joggle for 'QJn', %.2g, is below roundoff for distance computations, %.2g\n",
+         qh->JOGGLEmax, qh->DISTround);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (qh->MINvisible > REALmax/2) {
+    if (!qh->MERGING)
+      qh->MINvisible= qh->DISTround;
+    else if (qh->hull_dim <= 3)
+      qh->MINvisible= qh->premerge_centrum;
+    else
+      qh->MINvisible= qh_COPLANARratio * qh->premerge_centrum;
+    if (qh->APPROXhull && qh->MINvisible > qh->MINoutside)
+      qh->MINvisible= qh->MINoutside;
+    qh_option(qh, "Visible-distance", NULL, &qh->MINvisible);
+  }
+  if (qh->MAXcoplanar > REALmax/2) {
+    qh->MAXcoplanar= qh->MINvisible;
+    qh_option(qh, "U-max-coplanar", NULL, &qh->MAXcoplanar);
+  }
+  if (!qh->APPROXhull) {             /* user may specify qh->MINoutside */
+    qh->MINoutside= 2 * qh->MINvisible;
+    if (qh->premerge_cos < REALmax/2)
+      maximize_(qh->MINoutside, (1- qh->premerge_cos) * qh->MAXabs_coord);
+    qh_option(qh, "Width-outside", NULL, &qh->MINoutside);
+  }
+  qh->WIDEfacet= qh->MINoutside;
+  maximize_(qh->WIDEfacet, qh_WIDEcoplanar * qh->MAXcoplanar);
+  maximize_(qh->WIDEfacet, qh_WIDEcoplanar * qh->MINvisible);
+  qh_option(qh, "_wide-facet", NULL, &qh->WIDEfacet);
+  if (qh->MINvisible > qh->MINoutside + 3 * REALepsilon
+  && !qh->BESToutside && !qh->FORCEoutput)
+    qh_fprintf(qh, qh->ferr, 7001, "qhull input warning: minimum visibility V%.2g is greater than \nminimum outside W%.2g.  Flipped facets are likely.\n",
+             qh->MINvisible, qh->MINoutside);
+  qh->max_vertex= qh->DISTround;
+  qh->min_vertex= -qh->DISTround;
+  /* numeric constants reported in printsummary */
+  qh_detmaxoutside(qh);
+} /* detroundoff */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="detsimplex">-</a>
+
+  qh_detsimplex(qh, apex, points, dim, nearzero )
+    compute determinant of a simplex with point apex and base points
+
+  returns:
+     signed determinant and nearzero from qh_determinant
+
+  notes:
+     called by qh_maxsimplex and qh_initialvertices
+     uses qh.gm_matrix/qh.gm_row (assumes they're big enough)
+
+  design:
+    construct qm_matrix by subtracting apex from points
+    compute determinate
+*/
+realT qh_detsimplex(qhT *qh, pointT *apex, setT *points, int dim, boolT *nearzero) {
+  pointT *coorda, *coordp, *gmcoord, *point, **pointp;
+  coordT **rows;
+  int k,  i=0;
+  realT det;
+
+  zinc_(Zdetsimplex);
+  gmcoord= qh->gm_matrix;
+  rows= qh->gm_row;
+  FOREACHpoint_(points) {
+    if (i == dim)
+      break;
+    rows[i++]= gmcoord;
+    coordp= point;
+    coorda= apex;
+    for (k=dim; k--; )
+      *(gmcoord++)= *coordp++ - *coorda++;
+  }
+  if (i < dim) {
+    qh_fprintf(qh, qh->ferr, 6007, "qhull internal error (qh_detsimplex): #points %d < dimension %d\n",
+               i, dim);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  det= qh_determinant(qh, rows, dim, nearzero);
+  trace2((qh, qh->ferr, 2002, "qh_detsimplex: det=%2.2g for point p%d, dim %d, nearzero? %d\n",
+          det, qh_pointid(qh, apex), dim, *nearzero));
+  return det;
+} /* detsimplex */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="distnorm">-</a>
+
+  qh_distnorm( dim, point, normal, offset )
+    return distance from point to hyperplane at normal/offset
+
+  returns:
+    dist
+
+  notes:
+    dist > 0 if point is outside of hyperplane
+
+  see:
+    qh_distplane in geom_r.c
+*/
+realT qh_distnorm(int dim, pointT *point, pointT *normal, realT *offsetp) {
+  coordT *normalp= normal, *coordp= point;
+  realT dist;
+  int k;
+
+  dist= *offsetp;
+  for (k=dim; k--; )
+    dist += *(coordp++) * *(normalp++);
+  return dist;
+} /* distnorm */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="distround">-</a>
+
+  qh_distround(qh, dimension, maxabs, maxsumabs )
+    compute maximum round-off error for a distance computation
+      to a normalized hyperplane
+    maxabs is the maximum absolute value of a coordinate
+    maxsumabs is the maximum possible sum of absolute coordinate values
+    if qh.RANDOMdist ('Qr'), adjusts qh_distround
+
+  returns:
+    max dist round for qh.REALepsilon and qh.RANDOMdist
+
+  notes:
+    calculate roundoff error according to Golub & van Loan, 1983, Lemma 3.2-1, "Rounding Errors"
+    use sqrt(dim) since one vector is normalized
+      or use maxsumabs since one vector is < 1
+*/
+realT qh_distround(qhT *qh, int dimension, realT maxabs, realT maxsumabs) {
+  realT maxdistsum, maxround, delta;
+
+  maxdistsum= sqrt((realT)dimension) * maxabs;
+  minimize_( maxdistsum, maxsumabs);
+  maxround= REALepsilon * (dimension * maxdistsum * 1.01 + maxabs);
+              /* adds maxabs for offset */
+  if (qh->RANDOMdist) {
+    delta= qh->RANDOMfactor * maxabs;
+    maxround += delta;
+    trace4((qh, qh->ferr, 4092, "qh_distround: increase roundoff by random delta %2.2g for option 'R%2.2g'\n", delta, qh->RANDOMfactor));
+  }
+  trace4((qh, qh->ferr, 4008, "qh_distround: %2.2g, maxabs %2.2g, maxsumabs %2.2g, maxdistsum %2.2g\n",
+            maxround, maxabs, maxsumabs, maxdistsum));
+  return maxround;
+} /* distround */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="divzero">-</a>
+
+  qh_divzero( numer, denom, mindenom1, zerodiv )
+    divide by a number that's nearly zero
+    mindenom1= minimum denominator for dividing into 1.0
+
+  returns:
+    quotient
+    sets zerodiv and returns 0.0 if it would overflow
+
+  design:
+    if numer is nearly zero and abs(numer) < abs(denom)
+      return numer/denom
+    else if numer is nearly zero
+      return 0 and zerodiv
+    else if denom/numer non-zero
+      return numer/denom
+    else
+      return 0 and zerodiv
+*/
+realT qh_divzero(realT numer, realT denom, realT mindenom1, boolT *zerodiv) {
+  realT temp, numerx, denomx;
+
+
+  if (numer < mindenom1 && numer > -mindenom1) {
+    numerx= fabs_(numer);
+    denomx= fabs_(denom);
+    if (numerx < denomx) {
+      *zerodiv= False;
+      return numer/denom;
+    }else {
+      *zerodiv= True;
+      return 0.0;
+    }
+  }
+  temp= denom/numer;
+  if (temp > mindenom1 || temp < -mindenom1) {
+    *zerodiv= False;
+    return numer/denom;
+  }else {
+    *zerodiv= True;
+    return 0.0;
+  }
+} /* divzero */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="facetarea">-</a>
+
+  qh_facetarea(qh, facet )
+    return area for a facet
+
+  notes:
+    if non-simplicial,
+      uses centrum to triangulate facet and sums the projected areas.
+    if (qh->DELAUNAY),
+      computes projected area instead for last coordinate
+    assumes facet->normal exists
+    projecting tricoplanar facets to the hyperplane does not appear to make a difference
+
+  design:
+    if simplicial
+      compute area
+    else
+      for each ridge
+        compute area from centrum to ridge
+    negate area if upper Delaunay facet
+*/
+realT qh_facetarea(qhT *qh, facetT *facet) {
+  vertexT *apex;
+  pointT *centrum;
+  realT area= 0.0;
+  ridgeT *ridge, **ridgep;
+
+  if (facet->simplicial) {
+    apex= SETfirstt_(facet->vertices, vertexT);
+    area= qh_facetarea_simplex(qh, qh->hull_dim, apex->point, facet->vertices,
+                    apex, facet->toporient, facet->normal, &facet->offset);
+  }else {
+    if (qh->CENTERtype == qh_AScentrum)
+      centrum= facet->center;
+    else
+      centrum= qh_getcentrum(qh, facet);
+    FOREACHridge_(facet->ridges)
+      area += qh_facetarea_simplex(qh, qh->hull_dim, centrum, ridge->vertices,
+                 NULL, (boolT)(ridge->top == facet),  facet->normal, &facet->offset);
+    if (qh->CENTERtype != qh_AScentrum)
+      qh_memfree(qh, centrum, qh->normal_size);
+  }
+  if (facet->upperdelaunay && qh->DELAUNAY)
+    area= -area;  /* the normal should be [0,...,1] */
+  trace4((qh, qh->ferr, 4009, "qh_facetarea: f%d area %2.2g\n", facet->id, area));
+  return area;
+} /* facetarea */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="facetarea_simplex">-</a>
+
+  qh_facetarea_simplex(qh, dim, apex, vertices, notvertex, toporient, normal, offset )
+    return area for a simplex defined by
+      an apex, a base of vertices, an orientation, and a unit normal
+    if simplicial or tricoplanar facet,
+      notvertex is defined and it is skipped in vertices
+
+  returns:
+    computes area of simplex projected to plane [normal,offset]
+    returns 0 if vertex too far below plane (qh->WIDEfacet)
+      vertex can't be apex of tricoplanar facet
+
+  notes:
+    if (qh->DELAUNAY),
+      computes projected area instead for last coordinate
+    uses qh->gm_matrix/gm_row and qh->hull_dim
+    helper function for qh_facetarea
+
+  design:
+    if Notvertex
+      translate simplex to apex
+    else
+      project simplex to normal/offset
+      translate simplex to apex
+    if Delaunay
+      set last row/column to 0 with -1 on diagonal
+    else
+      set last row to Normal
+    compute determinate
+    scale and flip sign for area
+*/
+realT qh_facetarea_simplex(qhT *qh, int dim, coordT *apex, setT *vertices,
+        vertexT *notvertex,  boolT toporient, coordT *normal, realT *offset) {
+  pointT *coorda, *coordp, *gmcoord;
+  coordT **rows, *normalp;
+  int k,  i=0;
+  realT area, dist;
+  vertexT *vertex, **vertexp;
+  boolT nearzero;
+
+  gmcoord= qh->gm_matrix;
+  rows= qh->gm_row;
+  FOREACHvertex_(vertices) {
+    if (vertex == notvertex)
+      continue;
+    rows[i++]= gmcoord;
+    coorda= apex;
+    coordp= vertex->point;
+    normalp= normal;
+    if (notvertex) {
+      for (k=dim; k--; )
+        *(gmcoord++)= *coordp++ - *coorda++;
+    }else {
+      dist= *offset;
+      for (k=dim; k--; )
+        dist += *coordp++ * *normalp++;
+      if (dist < -qh->WIDEfacet) {
+        zinc_(Znoarea);
+        return 0.0;
+      }
+      coordp= vertex->point;
+      normalp= normal;
+      for (k=dim; k--; )
+        *(gmcoord++)= (*coordp++ - dist * *normalp++) - *coorda++;
+    }
+  }
+  if (i != dim-1) {
+    qh_fprintf(qh, qh->ferr, 6008, "qhull internal error (qh_facetarea_simplex): #points %d != dim %d -1\n",
+               i, dim);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  rows[i]= gmcoord;
+  if (qh->DELAUNAY) {
+    for (i=0; i < dim-1; i++)
+      rows[i][dim-1]= 0.0;
+    for (k=dim; k--; )
+      *(gmcoord++)= 0.0;
+    rows[dim-1][dim-1]= -1.0;
+  }else {
+    normalp= normal;
+    for (k=dim; k--; )
+      *(gmcoord++)= *normalp++;
+  }
+  zinc_(Zdetfacetarea);
+  area= qh_determinant(qh, rows, dim, &nearzero);
+  if (toporient)
+    area= -area;
+  area *= qh->AREAfactor;
+  trace4((qh, qh->ferr, 4010, "qh_facetarea_simplex: area=%2.2g for point p%d, toporient %d, nearzero? %d\n",
+          area, qh_pointid(qh, apex), toporient, nearzero));
+  return area;
+} /* facetarea_simplex */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="facetcenter">-</a>
+
+  qh_facetcenter(qh, vertices )
+    return Voronoi center (Voronoi vertex) for a facet's vertices
+
+  returns:
+    return temporary point equal to the center
+
+  see:
+    qh_voronoi_center()
+*/
+pointT *qh_facetcenter(qhT *qh, setT *vertices) {
+  setT *points= qh_settemp(qh, qh_setsize(qh, vertices));
+  vertexT *vertex, **vertexp;
+  pointT *center;
+
+  FOREACHvertex_(vertices)
+    qh_setappend(qh, &points, vertex->point);
+  center= qh_voronoi_center(qh, qh->hull_dim-1, points);
+  qh_settempfree(qh, &points);
+  return center;
+} /* facetcenter */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="findgooddist">-</a>
+
+  qh_findgooddist(qh, point, facetA, dist, facetlist )
+    find best good facet visible for point from facetA
+    assumes facetA is visible from point
+
+  returns:
+    best facet, i.e., good facet that is furthest from point
+      distance to best facet
+      NULL if none
+
+    moves good, visible facets (and some other visible facets)
+      to end of qh->facet_list
+
+  notes:
+    uses qh->visit_id
+
+  design:
+    initialize bestfacet if facetA is good
+    move facetA to end of facetlist
+    for each facet on facetlist
+      for each unvisited neighbor of facet
+        move visible neighbors to end of facetlist
+        update best good neighbor
+        if no good neighbors, update best facet
+*/
+facetT *qh_findgooddist(qhT *qh, pointT *point, facetT *facetA, realT *distp,
+               facetT **facetlist) {
+  realT bestdist= -REALmax, dist;
+  facetT *neighbor, **neighborp, *bestfacet=NULL, *facet;
+  boolT goodseen= False;
+
+  if (facetA->good) {
+    zzinc_(Zcheckpart);  /* calls from check_bestdist occur after print stats */
+    qh_distplane(qh, point, facetA, &bestdist);
+    bestfacet= facetA;
+    goodseen= True;
+  }
+  qh_removefacet(qh, facetA);
+  qh_appendfacet(qh, facetA);
+  *facetlist= facetA;
+  facetA->visitid= ++qh->visit_id;
+  FORALLfacet_(*facetlist) {
+    FOREACHneighbor_(facet) {
+      if (neighbor->visitid == qh->visit_id)
+        continue;
+      neighbor->visitid= qh->visit_id;
+      if (goodseen && !neighbor->good)
+        continue;
+      zzinc_(Zcheckpart);
+      qh_distplane(qh, point, neighbor, &dist);
+      if (dist > 0) {
+        qh_removefacet(qh, neighbor);
+        qh_appendfacet(qh, neighbor);
+        if (neighbor->good) {
+          goodseen= True;
+          if (dist > bestdist) {
+            bestdist= dist;
+            bestfacet= neighbor;
+          }
+        }
+      }
+    }
+  }
+  if (bestfacet) {
+    *distp= bestdist;
+    trace2((qh, qh->ferr, 2003, "qh_findgooddist: p%d is %2.2g above good facet f%d\n",
+      qh_pointid(qh, point), bestdist, bestfacet->id));
+    return bestfacet;
+  }
+  trace4((qh, qh->ferr, 4011, "qh_findgooddist: no good facet for p%d above f%d\n",
+      qh_pointid(qh, point), facetA->id));
+  return NULL;
+}  /* findgooddist */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="furthestnewvertex">-</a>
+
+  qh_furthestnewvertex(qh, unvisited, facet, &maxdist )
+    return furthest unvisited, new vertex to a facet
+
+  return:
+    NULL if no vertex is above facet
+    maxdist to facet
+    updates v.visitid
+
+  notes:
+    Ignores vertices in facetB
+    Does not change qh.vertex_visit.  Use in conjunction with qh_furthestvertex
+*/
+vertexT *qh_furthestnewvertex(qhT *qh, unsigned int unvisited, facetT *facet, realT *maxdistp /* qh.newvertex_list */) {
+  vertexT *maxvertex= NULL, *vertex;
+  coordT dist, maxdist= 0.0;
+
+  FORALLvertex_(qh->newvertex_list) {
+    if (vertex->newfacet && vertex->visitid <= unvisited) {
+      vertex->visitid= qh->vertex_visit;
+      qh_distplane(qh, vertex->point, facet, &dist);
+      if (dist > maxdist) {
+        maxdist= dist;
+        maxvertex= vertex;
+      }
+    }
+  }
+  trace4((qh, qh->ferr, 4085, "qh_furthestnewvertex: v%d dist %2.2g is furthest new vertex for f%d\n",
+    getid_(maxvertex), maxdist, facet->id));
+  *maxdistp= maxdist;
+  return maxvertex;
+} /* furthestnewvertex */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="furthestvertex">-</a>
+
+  qh_furthestvertex(qh, facetA, facetB, &maxdist, &mindist )
+    return furthest vertex in facetA from facetB, or NULL if none
+
+  return:
+    maxdist and mindist to facetB or 0.0 if none
+    updates qh.vertex_visit
+
+  notes:
+    Ignores vertices in facetB
+*/
+vertexT *qh_furthestvertex(qhT *qh, facetT *facetA, facetT *facetB, realT *maxdistp, realT *mindistp) {
+  vertexT *maxvertex= NULL, *vertex, **vertexp;
+  coordT dist, maxdist= -REALmax, mindist= REALmax;
+
+  qh->vertex_visit++;
+  FOREACHvertex_(facetB->vertices)
+    vertex->visitid= qh->vertex_visit;
+  FOREACHvertex_(facetA->vertices) {
+    if (vertex->visitid != qh->vertex_visit) {
+      vertex->visitid= qh->vertex_visit;
+      zzinc_(Zvertextests);
+      qh_distplane(qh, vertex->point, facetB, &dist);
+      if (!maxvertex) {
+        maxdist= dist;
+        mindist= dist;
+        maxvertex= vertex;
+      }else if (dist > maxdist) {
+        maxdist= dist;
+        maxvertex= vertex;
+      }else if (dist < mindist)
+        mindist= dist;
+    }
+  }
+  if (!maxvertex) {
+    trace3((qh, qh->ferr, 3067, "qh_furthestvertex: all vertices of f%d are in f%d.  Returning 0.0 for max and mindist\n",
+      facetA->id, facetB->id));
+    maxdist= mindist= 0.0;
+  }else {
+    trace4((qh, qh->ferr, 4084, "qh_furthestvertex: v%d dist %2.2g is furthest (mindist %2.2g) of f%d above f%d\n",
+      maxvertex->id, maxdist, mindist, facetA->id, facetB->id));
+  }
+  *maxdistp= maxdist;
+  *mindistp= mindist;
+  return maxvertex;
+} /* furthestvertex */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="getarea">-</a>
+
+  qh_getarea(qh, facetlist )
+    set area of all facets in facetlist
+    collect statistics
+    nop if hasAreaVolume
+
+  returns:
+    sets qh->totarea/totvol to total area and volume of convex hull
+    for Delaunay triangulation, computes projected area of the lower or upper hull
+      ignores upper hull if qh->ATinfinity
+
+  notes:
+    could compute outer volume by expanding facet area by rays from interior
+    the following attempt at perpendicular projection underestimated badly:
+      qh.totoutvol += (-dist + facet->maxoutside + qh->DISTround)
+                            * area/ qh->hull_dim;
+  design:
+    for each facet on facetlist
+      compute facet->area
+      update qh.totarea and qh.totvol
+*/
+void qh_getarea(qhT *qh, facetT *facetlist) {
+  realT area;
+  realT dist;
+  facetT *facet;
+
+  if (qh->hasAreaVolume)
+    return;
+  if (qh->REPORTfreq)
+    qh_fprintf(qh, qh->ferr, 8020, "computing area of each facet and volume of the convex hull\n");
+  else
+    trace1((qh, qh->ferr, 1001, "qh_getarea: computing area for each facet and its volume to qh.interior_point (dist*area/dim)\n"));
+  qh->totarea= qh->totvol= 0.0;
+  FORALLfacet_(facetlist) {
+    if (!facet->normal)
+      continue;
+    if (facet->upperdelaunay && qh->ATinfinity)
+      continue;
+    if (!facet->isarea) {
+      facet->f.area= qh_facetarea(qh, facet);
+      facet->isarea= True;
+    }
+    area= facet->f.area;
+    if (qh->DELAUNAY) {
+      if (facet->upperdelaunay == qh->UPPERdelaunay)
+        qh->totarea += area;
+    }else {
+      qh->totarea += area;
+      qh_distplane(qh, qh->interior_point, facet, &dist);
+      qh->totvol += -dist * area/ qh->hull_dim;
+    }
+    if (qh->PRINTstatistics) {
+      wadd_(Wareatot, area);
+      wmax_(Wareamax, area);
+      wmin_(Wareamin, area);
+    }
+  }
+  qh->hasAreaVolume= True;
+} /* getarea */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="gram_schmidt">-</a>
+
+  qh_gram_schmidt(qh, dim, row )
+    implements Gram-Schmidt orthogonalization by rows
+
+  returns:
+    false if zero norm
+    overwrites rows[dim][dim]
+
+  notes:
+    see Golub & van Loan, 1983, Algorithm 6.2-2, "Modified Gram-Schmidt"
+    overflow due to small divisors not handled
+
+  design:
+    for each row
+      compute norm for row
+      if non-zero, normalize row
+      for each remaining rowA
+        compute inner product of row and rowA
+        reduce rowA by row * inner product
+*/
+boolT qh_gram_schmidt(qhT *qh, int dim, realT **row) {
+  realT *rowi, *rowj, norm;
+  int i, j, k;
+
+  for (i=0; i < dim; i++) {
+    rowi= row[i];
+    for (norm=0.0, k=dim; k--; rowi++)
+      norm += *rowi * *rowi;
+    norm= sqrt(norm);
+    wmin_(Wmindenom, norm);
+    if (norm == 0.0)  /* either 0 or overflow due to sqrt */
+      return False;
+    for (k=dim; k--; )
+      *(--rowi) /= norm;
+    for (j=i+1; j < dim; j++) {
+      rowj= row[j];
+      for (norm=0.0, k=dim; k--; )
+        norm += *rowi++ * *rowj++;
+      for (k=dim; k--; )
+        *(--rowj) -= *(--rowi) * norm;
+    }
+  }
+  return True;
+} /* gram_schmidt */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="inthresholds">-</a>
+
+  qh_inthresholds(qh, normal, angle )
+    return True if normal within qh.lower_/upper_threshold
+
+  returns:
+    estimate of angle by summing of threshold diffs
+      angle may be NULL
+      smaller "angle" is better
+
+  notes:
+    invalid if qh.SPLITthresholds
+
+  see:
+    qh.lower_threshold in qh_initbuild()
+    qh_initthresholds()
+
+  design:
+    for each dimension
+      test threshold
+*/
+boolT qh_inthresholds(qhT *qh, coordT *normal, realT *angle) {
+  boolT within= True;
+  int k;
+  realT threshold;
+
+  if (angle)
+    *angle= 0.0;
+  for (k=0; k < qh->hull_dim; k++) {
+    threshold= qh->lower_threshold[k];
+    if (threshold > -REALmax/2) {
+      if (normal[k] < threshold)
+        within= False;
+      if (angle) {
+        threshold -= normal[k];
+        *angle += fabs_(threshold);
+      }
+    }
+    if (qh->upper_threshold[k] < REALmax/2) {
+      threshold= qh->upper_threshold[k];
+      if (normal[k] > threshold)
+        within= False;
+      if (angle) {
+        threshold -= normal[k];
+        *angle += fabs_(threshold);
+      }
+    }
+  }
+  return within;
+} /* inthresholds */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="joggleinput">-</a>
+
+  qh_joggleinput(qh)
+    randomly joggle input to Qhull by qh.JOGGLEmax
+    initial input is qh.first_point/qh.num_points of qh.hull_dim
+      repeated calls use qh.input_points/qh.num_points
+
+  returns:
+    joggles points at qh.first_point/qh.num_points
+    copies data to qh.input_points/qh.input_malloc if first time
+    determines qh.JOGGLEmax if it was zero
+    if qh.DELAUNAY
+      computes the Delaunay projection of the joggled points
+
+  notes:
+    if qh.DELAUNAY, unnecessarily joggles the last coordinate
+    the initial 'QJn' may be set larger than qh_JOGGLEmaxincrease
+
+  design:
+    if qh.DELAUNAY
+      set qh.SCALElast for reduced precision errors
+    if first call
+      initialize qh.input_points to the original input points
+      if qh.JOGGLEmax == 0
+        determine default qh.JOGGLEmax
+    else
+      increase qh.JOGGLEmax according to qh.build_cnt
+    joggle the input by adding a random number in [-qh.JOGGLEmax,qh.JOGGLEmax]
+    if qh.DELAUNAY
+      sets the Delaunay projection
+*/
+void qh_joggleinput(qhT *qh) {
+  int i, seed, size;
+  coordT *coordp, *inputp;
+  realT randr, randa, randb;
+
+  if (!qh->input_points) { /* first call */
+    qh->input_points= qh->first_point;
+    qh->input_malloc= qh->POINTSmalloc;
+    size= qh->num_points * qh->hull_dim * (int)sizeof(coordT);
+    if (!(qh->first_point= (coordT *)qh_malloc((size_t)size))) {
+      qh_fprintf(qh, qh->ferr, 6009, "qhull error: insufficient memory to joggle %d points\n",
+          qh->num_points);
+      qh_errexit(qh, qh_ERRmem, NULL, NULL);
+    }
+    qh->POINTSmalloc= True;
+    if (qh->JOGGLEmax == 0.0) {
+      qh->JOGGLEmax= qh_detjoggle(qh, qh->input_points, qh->num_points, qh->hull_dim);
+      qh_option(qh, "QJoggle", NULL, &qh->JOGGLEmax);
+    }
+  }else {                 /* repeated call */
+    if (!qh->RERUN && qh->build_cnt > qh_JOGGLEretry) {
+      if (((qh->build_cnt-qh_JOGGLEretry-1) % qh_JOGGLEagain) == 0) {
+        realT maxjoggle= qh->MAXwidth * qh_JOGGLEmaxincrease;
+        if (qh->JOGGLEmax < maxjoggle) {
+          qh->JOGGLEmax *= qh_JOGGLEincrease;
+          minimize_(qh->JOGGLEmax, maxjoggle);
+        }
+      }
+    }
+    qh_option(qh, "QJoggle", NULL, &qh->JOGGLEmax);
+  }
+  if (qh->build_cnt > 1 && qh->JOGGLEmax > fmax_(qh->MAXwidth/4, 0.1)) {
+      qh_fprintf(qh, qh->ferr, 6010, "qhull input error (qh_joggleinput): the current joggle for 'QJn', %.2g, is too large for the width\nof the input.  If possible, recompile Qhull with higher-precision reals.\n",
+                qh->JOGGLEmax);
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  /* for some reason, using qh->ROTATErandom and qh_RANDOMseed does not repeat the run. Use 'TRn' instead */
+  seed= qh_RANDOMint;
+  qh_option(qh, "_joggle-seed", &seed, NULL);
+  trace0((qh, qh->ferr, 6, "qh_joggleinput: joggle input by %4.4g with seed %d\n",
+    qh->JOGGLEmax, seed));
+  inputp= qh->input_points;
+  coordp= qh->first_point;
+  randa= 2.0 * qh->JOGGLEmax/qh_RANDOMmax;
+  randb= -qh->JOGGLEmax;
+  size= qh->num_points * qh->hull_dim;
+  for (i=size; i--; ) {
+    randr= qh_RANDOMint;
+    *(coordp++)= *(inputp++) + (randr * randa + randb);
+  }
+  if (qh->DELAUNAY) {
+    qh->last_low= qh->last_high= qh->last_newhigh= REALmax;
+    qh_setdelaunay(qh, qh->hull_dim, qh->num_points, qh->first_point);
+  }
+} /* joggleinput */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="maxabsval">-</a>
+
+  qh_maxabsval( normal, dim )
+    return pointer to maximum absolute value of a dim vector
+    returns NULL if dim=0
+*/
+realT *qh_maxabsval(realT *normal, int dim) {
+  realT maxval= -REALmax;
+  realT *maxp= NULL, *colp, absval;
+  int k;
+
+  for (k=dim, colp= normal; k--; colp++) {
+    absval= fabs_(*colp);
+    if (absval > maxval) {
+      maxval= absval;
+      maxp= colp;
+    }
+  }
+  return maxp;
+} /* maxabsval */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="maxmin">-</a>
+
+  qh_maxmin(qh, points, numpoints, dimension )
+    return max/min points for each dimension
+    determine max and min coordinates
+
+  returns:
+    returns a temporary set of max and min points
+      may include duplicate points. Does not include qh.GOODpoint
+    sets qh.NEARzero, qh.MAXabs_coord, qh.MAXsumcoord, qh.MAXwidth
+         qh.MAXlastcoord, qh.MINlastcoord
+    initializes qh.max_outside, qh.min_vertex, qh.WAScoplanar, qh.ZEROall_ok
+
+  notes:
+    loop duplicated in qh_detjoggle()
+
+  design:
+    initialize global precision variables
+    checks definition of REAL...
+    for each dimension
+      for each point
+        collect maximum and minimum point
+      collect maximum of maximums and minimum of minimums
+      determine qh.NEARzero for Gaussian Elimination
+*/
+setT *qh_maxmin(qhT *qh, pointT *points, int numpoints, int dimension) {
+  int k;
+  realT maxcoord, temp;
+  pointT *minimum, *maximum, *point, *pointtemp;
+  setT *set;
+
+  qh->max_outside= 0.0;
+  qh->MAXabs_coord= 0.0;
+  qh->MAXwidth= -REALmax;
+  qh->MAXsumcoord= 0.0;
+  qh->min_vertex= 0.0;
+  qh->WAScoplanar= False;
+  if (qh->ZEROcentrum)
+    qh->ZEROall_ok= True;
+  if (REALmin < REALepsilon && REALmin < REALmax && REALmin > -REALmax
+  && REALmax > 0.0 && -REALmax < 0.0)
+    ; /* all ok */
+  else {
+    qh_fprintf(qh, qh->ferr, 6011, "qhull error: one or more floating point constants in user_r.h are inconsistent. REALmin %g, -REALmax %g, 0.0, REALepsilon %g, REALmax %g\n",
+          REALmin, -REALmax, REALepsilon, REALmax);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  set= qh_settemp(qh, 2*dimension);
+  trace1((qh, qh->ferr, 8082, "qh_maxmin: dim             min             max           width    nearzero  min-point  max-point\n"));
+  for (k=0; k < dimension; k++) {
+    if (points == qh->GOODpointp)
+      minimum= maximum= points + dimension;
+    else
+      minimum= maximum= points;
+    FORALLpoint_(qh, points, numpoints) {
+      if (point == qh->GOODpointp)
+        continue;
+      if (maximum[k] < point[k])
+        maximum= point;
+      else if (minimum[k] > point[k])
+        minimum= point;
+    }
+    if (k == dimension-1) {
+      qh->MINlastcoord= minimum[k];
+      qh->MAXlastcoord= maximum[k];
+    }
+    if (qh->SCALElast && k == dimension-1)
+      maxcoord= qh->MAXabs_coord;
+    else {
+      maxcoord= fmax_(maximum[k], -minimum[k]);
+      if (qh->GOODpointp) {
+        temp= fmax_(qh->GOODpointp[k], -qh->GOODpointp[k]);
+        maximize_(maxcoord, temp);
+      }
+      temp= maximum[k] - minimum[k];
+      maximize_(qh->MAXwidth, temp);
+    }
+    maximize_(qh->MAXabs_coord, maxcoord);
+    qh->MAXsumcoord += maxcoord;
+    qh_setappend(qh, &set, minimum);
+    qh_setappend(qh, &set, maximum);
+    /* calculation of qh NEARzero is based on Golub & van Loan, 1983,
+       Eq. 4.4-13 for "Gaussian elimination with complete pivoting".
+       Golub & van Loan say that n^3 can be ignored and 10 be used in
+       place of rho */
+    qh->NEARzero[k]= 80 * qh->MAXsumcoord * REALepsilon;
+    trace1((qh, qh->ferr, 8106, "           %3d % 14.8e % 14.8e % 14.8e  %4.4e  p%-9d p%-d\n",
+            k, minimum[k], maximum[k], maximum[k]-minimum[k], qh->NEARzero[k], qh_pointid(qh, minimum), qh_pointid(qh, maximum)));
+    if (qh->SCALElast && k == dimension-1)
+      trace1((qh, qh->ferr, 8107, "           last coordinate scaled to (%4.4g, %4.4g), width %4.4e for option 'Qbb'\n",
+            qh->MAXabs_coord - qh->MAXwidth, qh->MAXabs_coord, qh->MAXwidth));
+  }
+  if (qh->IStracing >= 1)
+    qh_printpoints(qh, qh->ferr, "qh_maxmin: found the max and min points (by dim):", set);
+  return(set);
+} /* maxmin */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="maxouter">-</a>
+
+  qh_maxouter(qh)
+    return maximum distance from facet to outer plane
+    normally this is qh.max_outside+qh.DISTround
+    does not include qh.JOGGLEmax
+
+  see:
+    qh_outerinner()
+
+  notes:
+    need to add another qh.DISTround if testing actual point with computation
+    see qh_detmaxoutside for a qh_RATIO... target
+
+  for joggle:
+    qh_setfacetplane() updated qh.max_outer for Wnewvertexmax (max distance to vertex)
+    need to use Wnewvertexmax since could have a coplanar point for a high
+      facet that is replaced by a low facet
+    need to add qh.JOGGLEmax if testing input points
+*/
+realT qh_maxouter(qhT *qh) {
+  realT dist;
+
+  dist= fmax_(qh->max_outside, qh->DISTround);
+  dist += qh->DISTround;
+  trace4((qh, qh->ferr, 4012, "qh_maxouter: max distance from facet to outer plane is %4.4g, qh.max_outside is %4.4g\n", dist, qh->max_outside));
+  return dist;
+} /* maxouter */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="maxsimplex">-</a>
+
+  qh_maxsimplex(qh, dim, maxpoints, points, numpoints, simplex )
+    determines maximum simplex for a set of points
+    maxpoints is the subset of points with a min or max coordinate
+    may start with points already in simplex
+    skips qh.GOODpointp (assumes that it isn't in maxpoints)
+
+  returns:
+    simplex with dim+1 points
+
+  notes:
+    called by qh_initialvertices, qh_detvnorm, and qh_voronoi_center
+    requires qh.MAXwidth to estimate determinate for each vertex
+    assumes at least needed points in points
+    maximizes determinate for x,y,z,w, etc.
+    uses maxpoints as long as determinate is clearly non-zero
+
+  design:
+    initialize simplex with at least two points
+      (find points with max or min x coordinate)
+    create a simplex of dim+1 vertices as follows
+      add point from maxpoints that maximizes the determinate of the point and the simplex vertices  
+      if last point and maxdet/prevdet < qh_RATIOmaxsimplex (3.0e-2)
+        flag maybe_falsenarrow
+      if no maxpoint or maxnearzero or maybe_falsenarrow
+        search all points for maximum determinate
+        early exit if maybe_falsenarrow and !maxnearzero and maxdet > prevdet
+*/
+void qh_maxsimplex(qhT *qh, int dim, setT *maxpoints, pointT *points, int numpoints, setT **simplex) {
+  pointT *point, **pointp, *pointtemp, *maxpoint, *minx=NULL, *maxx=NULL;
+  boolT nearzero, maxnearzero= False, maybe_falsenarrow;
+  int i, sizinit;
+  realT maxdet= -1.0, prevdet= -1.0, det, mincoord= REALmax, maxcoord= -REALmax, mindet, ratio, targetdet;
+
+  if (qh->MAXwidth <= 0.0) {
+    qh_fprintf(qh, qh->ferr, 6421, "qhull internal error (qh_maxsimplex): qh.MAXwidth required for qh_maxsimplex.  Used to estimate determinate\n");
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  sizinit= qh_setsize(qh, *simplex);
+  if (sizinit >= 2) {
+    maxdet= pow(qh->MAXwidth, sizinit - 1);
+  }else {
+    if (qh_setsize(qh, maxpoints) >= 2) {
+      FOREACHpoint_(maxpoints) {
+        if (maxcoord < point[0]) {
+          maxcoord= point[0];
+          maxx= point;
+        }
+        if (mincoord > point[0]) {
+          mincoord= point[0];
+          minx= point;
+        }
+      }
+    }else {
+      FORALLpoint_(qh, points, numpoints) {
+        if (point == qh->GOODpointp)
+          continue;
+        if (maxcoord < point[0]) {
+          maxcoord= point[0];
+          maxx= point;
+        }
+        if (mincoord > point[0]) {
+          mincoord= point[0];
+          minx= point;
+        }
+      }
+    }
+    maxdet= maxcoord - mincoord;
+    qh_setunique(qh, simplex, minx);
+    if (qh_setsize(qh, *simplex) < 2)
+      qh_setunique(qh, simplex, maxx);
+    sizinit= qh_setsize(qh, *simplex);
+    if (sizinit < 2) {
+      qh_joggle_restart(qh, "input has same x coordinate");
+      if (zzval_(Zsetplane) > qh->hull_dim+1) {
+        qh_fprintf(qh, qh->ferr, 6012, "qhull precision error (qh_maxsimplex for voronoi_center): %d points with the same x coordinate %4.4g\n",
+                 qh_setsize(qh, maxpoints)+numpoints, mincoord);
+        qh_errexit(qh, qh_ERRprec, NULL, NULL);
+      }else {
+        qh_fprintf(qh, qh->ferr, 6013, "qhull input error: input is less than %d-dimensional since all points have the same x coordinate %4.4g\n",
+                 qh->hull_dim, mincoord);
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+      }
+    }
+  }
+  for (i=sizinit; i < dim+1; i++) {
+    prevdet= maxdet;
+    maxpoint= NULL;
+    maxdet= -1.0;
+    FOREACHpoint_(maxpoints) {
+      if (!qh_setin(*simplex, point) && point != maxpoint) {
+        det= qh_detsimplex(qh, point, *simplex, i, &nearzero); /* retests maxpoints if duplicate or multiple iterations */
+        if ((det= fabs_(det)) > maxdet) {
+          maxdet= det;
+          maxpoint= point;
+          maxnearzero= nearzero;
+        }
+      }
+    }
+    maybe_falsenarrow= False;
+    ratio= 1.0;
+    targetdet= prevdet * qh->MAXwidth;
+    mindet= 10 * qh_RATIOmaxsimplex * targetdet;
+    if (maxdet > 0.0) {
+      ratio= maxdet / targetdet;
+      if (ratio < qh_RATIOmaxsimplex)
+        maybe_falsenarrow= True;
+    }
+    if (!maxpoint || maxnearzero || maybe_falsenarrow) {
+      zinc_(Zsearchpoints);
+      if (!maxpoint) {
+        trace0((qh, qh->ferr, 7, "qh_maxsimplex: searching all points for %d-th initial vertex, better than mindet %4.4g, targetdet %4.4g\n",
+                i+1, mindet, targetdet));
+      }else if (qh->ALLpoints) {
+        trace0((qh, qh->ferr, 30, "qh_maxsimplex: searching all points ('Qs') for %d-th initial vertex, better than p%d det %4.4g, targetdet %4.4g, ratio %4.4g\n",
+                i+1, qh_pointid(qh, maxpoint), maxdet, targetdet, ratio));
+      }else if (maybe_falsenarrow) {
+        trace0((qh, qh->ferr, 17, "qh_maxsimplex: searching all points for %d-th initial vertex, better than p%d det %4.4g and mindet %4.4g, ratio %4.4g\n",
+                i+1, qh_pointid(qh, maxpoint), maxdet, mindet, ratio));
+      }else {
+        trace0((qh, qh->ferr, 8, "qh_maxsimplex: searching all points for %d-th initial vertex, better than p%d det %2.2g and mindet %4.4g, targetdet %4.4g\n",
+                i+1, qh_pointid(qh, maxpoint), maxdet, mindet, targetdet));
+      }
+      FORALLpoint_(qh, points, numpoints) {
+        if (point == qh->GOODpointp)
+          continue;
+        if (!qh_setin(maxpoints, point) && !qh_setin(*simplex, point)) {
+          det= qh_detsimplex(qh, point, *simplex, i, &nearzero);
+          if ((det= fabs_(det)) > maxdet) {
+            maxdet= det;
+            maxpoint= point;
+            maxnearzero= nearzero;
+            if (!maxnearzero && !qh->ALLpoints && maxdet > mindet)
+              break;
+          }
+        }
+      }
+    } /* !maxpoint */
+    if (!maxpoint) {
+      qh_fprintf(qh, qh->ferr, 6014, "qhull internal error (qh_maxsimplex): not enough points available\n");
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+    qh_setappend(qh, simplex, maxpoint);
+    trace1((qh, qh->ferr, 1002, "qh_maxsimplex: selected point p%d for %d`th initial vertex, det=%4.4g, targetdet=%4.4g, mindet=%4.4g\n",
+            qh_pointid(qh, maxpoint), i+1, maxdet, prevdet * qh->MAXwidth, mindet));
+  } /* i */
+} /* maxsimplex */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="minabsval">-</a>
+
+  qh_minabsval( normal, dim )
+    return minimum absolute value of a dim vector
+*/
+realT qh_minabsval(realT *normal, int dim) {
+  realT minval= 0;
+  realT maxval= 0;
+  realT *colp;
+  int k;
+
+  for (k=dim, colp=normal; k--; colp++) {
+    maximize_(maxval, *colp);
+    minimize_(minval, *colp);
+  }
+  return fmax_(maxval, -minval);
+} /* minabsval */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="mindiff">-</a>
+
+  qh_mindif(qh, vecA, vecB, dim )
+    return index of min abs. difference of two vectors
+*/
+int qh_mindiff(realT *vecA, realT *vecB, int dim) {
+  realT mindiff= REALmax, diff;
+  realT *vecAp= vecA, *vecBp= vecB;
+  int k, mink= 0;
+
+  for (k=0; k < dim; k++) {
+    diff= *vecAp++ - *vecBp++;
+    diff= fabs_(diff);
+    if (diff < mindiff) {
+      mindiff= diff;
+      mink= k;
+    }
+  }
+  return mink;
+} /* mindiff */
+
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="orientoutside">-</a>
+
+  qh_orientoutside(qh, facet  )
+    make facet outside oriented via qh.interior_point
+
+  returns:
+    True if facet reversed orientation.
+*/
+boolT qh_orientoutside(qhT *qh, facetT *facet) {
+  int k;
+  realT dist;
+
+  qh_distplane(qh, qh->interior_point, facet, &dist);
+  if (dist > 0) {
+    for (k=qh->hull_dim; k--; )
+      facet->normal[k]= -facet->normal[k];
+    facet->offset= -facet->offset;
+    return True;
+  }
+  return False;
+} /* orientoutside */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="outerinner">-</a>
+
+  qh_outerinner(qh, facet, outerplane, innerplane  )
+    if facet and qh.maxoutdone (i.e., qh_check_maxout)
+      returns outer and inner plane for facet
+    else
+      returns maximum outer and inner plane
+    accounts for qh.JOGGLEmax
+
+  see:
+    qh_maxouter(qh), qh_check_bestdist(), qh_check_points()
+
+  notes:
+    outerplaner or innerplane may be NULL
+    facet is const
+    Does not error (QhullFacet)
+
+    includes qh.DISTround for actual points
+    adds another qh.DISTround if testing with floating point arithmetic
+*/
+void qh_outerinner(qhT *qh, facetT *facet, realT *outerplane, realT *innerplane) {
+  realT dist, mindist;
+  vertexT *vertex, **vertexp;
+
+  if (outerplane) {
+    if (!qh_MAXoutside || !facet || !qh->maxoutdone) {
+      *outerplane= qh_maxouter(qh);       /* includes qh.DISTround */
+    }else { /* qh_MAXoutside ... */
+#if qh_MAXoutside
+      *outerplane= facet->maxoutside + qh->DISTround;
+#endif
+
+    }
+    if (qh->JOGGLEmax < REALmax/2)
+      *outerplane += qh->JOGGLEmax * sqrt((realT)qh->hull_dim);
+  }
+  if (innerplane) {
+    if (facet) {
+      mindist= REALmax;
+      FOREACHvertex_(facet->vertices) {
+        zinc_(Zdistio);
+        qh_distplane(qh, vertex->point, facet, &dist);
+        minimize_(mindist, dist);
+      }
+      *innerplane= mindist - qh->DISTround;
+    }else
+      *innerplane= qh->min_vertex - qh->DISTround;
+    if (qh->JOGGLEmax < REALmax/2)
+      *innerplane -= qh->JOGGLEmax * sqrt((realT)qh->hull_dim);
+  }
+} /* outerinner */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="pointdist">-</a>
+
+  qh_pointdist( point1, point2, dim )
+    return distance between two points
+
+  notes:
+    returns distance squared if 'dim' is negative
+*/
+coordT qh_pointdist(pointT *point1, pointT *point2, int dim) {
+  coordT dist, diff;
+  int k;
+
+  dist= 0.0;
+  for (k= (dim > 0 ? dim : -dim); k--; ) {
+    diff= *point1++ - *point2++;
+    dist += diff * diff;
+  }
+  if (dim > 0)
+    return(sqrt(dist));
+  return dist;
+} /* pointdist */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="printmatrix">-</a>
+
+  qh_printmatrix(qh, fp, string, rows, numrow, numcol )
+    print matrix to fp given by row vectors
+    print string as header
+    qh may be NULL if fp is defined
+
+  notes:
+    print a vector by qh_printmatrix(qh, fp, "", &vect, 1, len)
+*/
+void qh_printmatrix(qhT *qh, FILE *fp, const char *string, realT **rows, int numrow, int numcol) {
+  realT *rowp;
+  realT r; /*bug fix*/
+  int i,k;
+
+  qh_fprintf(qh, fp, 9001, "%s\n", string);
+  for (i=0; i < numrow; i++) {
+    rowp= rows[i];
+    for (k=0; k < numcol; k++) {
+      r= *rowp++;
+      qh_fprintf(qh, fp, 9002, "%6.3g ", r);
+    }
+    qh_fprintf(qh, fp, 9003, "\n");
+  }
+} /* printmatrix */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="printpoints">-</a>
+
+  qh_printpoints(qh, fp, string, points )
+    print pointids to fp for a set of points
+    if string, prints string and 'p' point ids
+*/
+void qh_printpoints(qhT *qh, FILE *fp, const char *string, setT *points) {
+  pointT *point, **pointp;
+
+  if (string) {
+    qh_fprintf(qh, fp, 9004, "%s", string);
+    FOREACHpoint_(points)
+      qh_fprintf(qh, fp, 9005, " p%d", qh_pointid(qh, point));
+    qh_fprintf(qh, fp, 9006, "\n");
+  }else {
+    FOREACHpoint_(points)
+      qh_fprintf(qh, fp, 9007, " %d", qh_pointid(qh, point));
+    qh_fprintf(qh, fp, 9008, "\n");
+  }
+} /* printpoints */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="projectinput">-</a>
+
+  qh_projectinput(qh)
+    project input points using qh.lower_bound/upper_bound and qh->DELAUNAY
+    if qh.lower_bound[k]=qh.upper_bound[k]= 0,
+      removes dimension k
+    if halfspace intersection
+      removes dimension k from qh.feasible_point
+    input points in qh->first_point, num_points, input_dim
+
+  returns:
+    new point array in qh->first_point of qh->hull_dim coordinates
+    sets qh->POINTSmalloc
+    if qh->DELAUNAY
+      projects points to paraboloid
+      lowbound/highbound is also projected
+    if qh->ATinfinity
+      adds point "at-infinity"
+    if qh->POINTSmalloc
+      frees old point array
+
+  notes:
+    checks that qh.hull_dim agrees with qh.input_dim, PROJECTinput, and DELAUNAY
+
+
+  design:
+    sets project[k] to -1 (delete), 0 (keep), 1 (add for Delaunay)
+    determines newdim and newnum for qh->hull_dim and qh->num_points
+    projects points to newpoints
+    projects qh.lower_bound to itself
+    projects qh.upper_bound to itself
+    if qh->DELAUNAY
+      if qh->ATINFINITY
+        projects points to paraboloid
+        computes "infinity" point as vertex average and 10% above all points
+      else
+        uses qh_setdelaunay to project points to paraboloid
+*/
+void qh_projectinput(qhT *qh) {
+  int k,i;
+  int newdim= qh->input_dim, newnum= qh->num_points;
+  signed char *project;
+  int projectsize= (qh->input_dim + 1) * (int)sizeof(*project);
+  pointT *newpoints, *coord, *infinity;
+  realT paraboloid, maxboloid= 0;
+
+  project= (signed char *)qh_memalloc(qh, projectsize);
+  memset((char *)project, 0, (size_t)projectsize);
+  for (k=0; k < qh->input_dim; k++) {   /* skip Delaunay bound */
+    if (qh->lower_bound[k] == 0.0 && qh->upper_bound[k] == 0.0) {
+      project[k]= -1;
+      newdim--;
+    }
+  }
+  if (qh->DELAUNAY) {
+    project[k]= 1;
+    newdim++;
+    if (qh->ATinfinity)
+      newnum++;
+  }
+  if (newdim != qh->hull_dim) {
+    qh_memfree(qh, project, projectsize);
+    qh_fprintf(qh, qh->ferr, 6015, "qhull internal error (qh_projectinput): dimension after projection %d != hull_dim %d\n", newdim, qh->hull_dim);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (!(newpoints= qh->temp_malloc= (coordT *)qh_malloc((size_t)(newnum * newdim) * sizeof(coordT)))) {
+    qh_memfree(qh, project, projectsize);
+    qh_fprintf(qh, qh->ferr, 6016, "qhull error: insufficient memory to project %d points\n",
+           qh->num_points);
+    qh_errexit(qh, qh_ERRmem, NULL, NULL);
+  }
+  /* qh_projectpoints throws error if mismatched dimensions */
+  qh_projectpoints(qh, project, qh->input_dim+1, qh->first_point,
+                    qh->num_points, qh->input_dim, newpoints, newdim);
+  trace1((qh, qh->ferr, 1003, "qh_projectinput: updating lower and upper_bound\n"));
+  qh_projectpoints(qh, project, qh->input_dim+1, qh->lower_bound,
+                    1, qh->input_dim+1, qh->lower_bound, newdim+1);
+  qh_projectpoints(qh, project, qh->input_dim+1, qh->upper_bound,
+                    1, qh->input_dim+1, qh->upper_bound, newdim+1);
+  if (qh->HALFspace) {
+    if (!qh->feasible_point) {
+      qh_memfree(qh, project, projectsize);
+      qh_fprintf(qh, qh->ferr, 6017, "qhull internal error (qh_projectinput): HALFspace defined without qh.feasible_point\n");
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+    qh_projectpoints(qh, project, qh->input_dim, qh->feasible_point,
+                      1, qh->input_dim, qh->feasible_point, newdim);
+  }
+  qh_memfree(qh, project, projectsize);
+  if (qh->POINTSmalloc)
+    qh_free(qh->first_point);
+  qh->first_point= newpoints;
+  qh->POINTSmalloc= True;
+  qh->temp_malloc= NULL;
+  if (qh->DELAUNAY && qh->ATinfinity) {
+    coord= qh->first_point;
+    infinity= qh->first_point + qh->hull_dim * qh->num_points;
+    for (k=qh->hull_dim-1; k--; )
+      infinity[k]= 0.0;
+    for (i=qh->num_points; i--; ) {
+      paraboloid= 0.0;
+      for (k=0; k < qh->hull_dim-1; k++) {
+        paraboloid += *coord * *coord;
+        infinity[k] += *coord;
+        coord++;
+      }
+      *(coord++)= paraboloid;
+      maximize_(maxboloid, paraboloid);
+    }
+    /* coord == infinity */
+    for (k=qh->hull_dim-1; k--; )
+      *(coord++) /= qh->num_points;
+    *(coord++)= maxboloid * 1.1;
+    qh->num_points++;
+    trace0((qh, qh->ferr, 9, "qh_projectinput: projected points to paraboloid for Delaunay\n"));
+  }else if (qh->DELAUNAY)  /* !qh->ATinfinity */
+    qh_setdelaunay(qh, qh->hull_dim, qh->num_points, qh->first_point);
+} /* projectinput */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="projectpoints">-</a>
+
+  qh_projectpoints(qh, project, n, points, numpoints, dim, newpoints, newdim )
+    project points/numpoints/dim to newpoints/newdim
+    if project[k] == -1
+      delete dimension k
+    if project[k] == 1
+      add dimension k by duplicating previous column
+    n is size of project
+
+  notes:
+    newpoints may be points if only adding dimension at end
+
+  design:
+    check that 'project' and 'newdim' agree
+    for each dimension
+      if project == -1
+        skip dimension
+      else
+        determine start of column in newpoints
+        determine start of column in points
+          if project == +1, duplicate previous column
+        copy dimension (column) from points to newpoints
+*/
+void qh_projectpoints(qhT *qh, signed char *project, int n, realT *points,
+        int numpoints, int dim, realT *newpoints, int newdim) {
+  int testdim= dim, oldk=0, newk=0, i,j=0,k;
+  realT *newp, *oldp;
+
+  for (k=0; k < n; k++)
+    testdim += project[k];
+  if (testdim != newdim) {
+    qh_fprintf(qh, qh->ferr, 6018, "qhull internal error (qh_projectpoints): newdim %d should be %d after projection\n",
+      newdim, testdim);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  for (j=0; j<n; j++) {
+    if (project[j] == -1)
+      oldk++;
+    else {
+      newp= newpoints+newk++;
+      if (project[j] == +1) {
+        if (oldk >= dim)
+          continue;
+        oldp= points+oldk;
+      }else
+        oldp= points+oldk++;
+      for (i=numpoints; i--; ) {
+        *newp= *oldp;
+        newp += newdim;
+        oldp += dim;
+      }
+    }
+    if (oldk >= dim)
+      break;
+  }
+  trace1((qh, qh->ferr, 1004, "qh_projectpoints: projected %d points from dim %d to dim %d\n",
+    numpoints, dim, newdim));
+} /* projectpoints */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="rotateinput">-</a>
+
+  qh_rotateinput(qh, rows )
+    rotate input using row matrix
+    input points given by qh->first_point, num_points, hull_dim
+    assumes rows[dim] is a scratch buffer
+    if qh->POINTSmalloc, overwrites input points, else mallocs a new array
+
+  returns:
+    rotated input
+    sets qh->POINTSmalloc
+
+  design:
+    see qh_rotatepoints
+*/
+void qh_rotateinput(qhT *qh, realT **rows) {
+
+  if (!qh->POINTSmalloc) {
+    qh->first_point= qh_copypoints(qh, qh->first_point, qh->num_points, qh->hull_dim);
+    qh->POINTSmalloc= True;
+  }
+  qh_rotatepoints(qh, qh->first_point, qh->num_points, qh->hull_dim, rows);
+}  /* rotateinput */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="rotatepoints">-</a>
+
+  qh_rotatepoints(qh, points, numpoints, dim, row )
+    rotate numpoints points by a d-dim row matrix
+    assumes rows[dim] is a scratch buffer
+
+  returns:
+    rotated points in place
+
+  design:
+    for each point
+      for each coordinate
+        use row[dim] to compute partial inner product
+      for each coordinate
+        rotate by partial inner product
+*/
+void qh_rotatepoints(qhT *qh, realT *points, int numpoints, int dim, realT **row) {
+  realT *point, *rowi, *coord= NULL, sum, *newval;
+  int i,j,k;
+
+  if (qh->IStracing >= 1)
+    qh_printmatrix(qh, qh->ferr, "qh_rotatepoints: rotate points by", row, dim, dim);
+  for (point=points, j=numpoints; j--; point += dim) {
+    newval= row[dim];
+    for (i=0; i < dim; i++) {
+      rowi= row[i];
+      coord= point;
+      for (sum=0.0, k=dim; k--; )
+        sum += *rowi++ * *coord++;
+      *(newval++)= sum;
+    }
+    for (k=dim; k--; )
+      *(--coord)= *(--newval);
+  }
+} /* rotatepoints */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="scaleinput">-</a>
+
+  qh_scaleinput(qh)
+    scale input points using qh->low_bound/high_bound
+    input points given by qh->first_point, num_points, hull_dim
+    if qh->POINTSmalloc, overwrites input points, else mallocs a new array
+
+  returns:
+    scales coordinates of points to low_bound[k], high_bound[k]
+    sets qh->POINTSmalloc
+
+  design:
+    see qh_scalepoints
+*/
+void qh_scaleinput(qhT *qh) {
+
+  if (!qh->POINTSmalloc) {
+    qh->first_point= qh_copypoints(qh, qh->first_point, qh->num_points, qh->hull_dim);
+    qh->POINTSmalloc= True;
+  }
+  qh_scalepoints(qh, qh->first_point, qh->num_points, qh->hull_dim,
+       qh->lower_bound, qh->upper_bound);
+}  /* scaleinput */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="scalelast">-</a>
+
+  qh_scalelast(qh, points, numpoints, dim, low, high, newhigh )
+    scale last coordinate to [0.0, newhigh], for Delaunay triangulation
+    input points given by points, numpoints, dim
+
+  returns:
+    changes scale of last coordinate from [low, high] to [0.0, newhigh]
+    overwrites last coordinate of each point
+    saves low/high/newhigh in qh.last_low, etc. for qh_setdelaunay()
+
+  notes:
+    to reduce precision issues, qh_scalelast makes the last coordinate similar to other coordinates
+      the last coordinate for Delaunay triangulation is the sum of squares of input coordinates
+      note that the range [0.0, newwidth] is wrong for narrow distributions with large positive coordinates (e.g., [995933.64, 995963.48])
+
+    when called by qh_setdelaunay, low/high may not match the data passed to qh_setdelaunay
+
+  design:
+    compute scale and shift factors
+    apply to last coordinate of each point
+*/
+void qh_scalelast(qhT *qh, coordT *points, int numpoints, int dim, coordT low,
+                   coordT high, coordT newhigh) {
+  realT scale, shift;
+  coordT *coord, newlow;
+  int i;
+  boolT nearzero= False;
+
+  newlow= 0.0;
+  trace4((qh, qh->ferr, 4013, "qh_scalelast: scale last coordinate from [%2.2g, %2.2g] to [%2.2g, %2.2g]\n",
+    low, high, newlow, newhigh));
+  qh->last_low= low;
+  qh->last_high= high;
+  qh->last_newhigh= newhigh;
+  scale= qh_divzero(newhigh - newlow, high - low,
+                  qh->MINdenom_1, &nearzero);
+  if (nearzero) {
+    if (qh->DELAUNAY)
+      qh_fprintf(qh, qh->ferr, 6019, "qhull input error (qh_scalelast): can not scale last coordinate to [%4.4g, %4.4g].  Input is cocircular or cospherical.   Use option 'Qz' to add a point at infinity.\n",
+             newlow, newhigh);
+    else
+      qh_fprintf(qh, qh->ferr, 6020, "qhull input error (qh_scalelast): can not scale last coordinate to [%4.4g, %4.4g].  New bounds are too wide for compared to existing bounds [%4.4g, %4.4g] (width %4.4g)\n",
+             newlow, newhigh, low, high, high-low);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  shift= newlow - low * scale;
+  coord= points + dim - 1;
+  for (i=numpoints; i--; coord += dim)
+    *coord= *coord * scale + shift;
+} /* scalelast */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="scalepoints">-</a>
+
+  qh_scalepoints(qh, points, numpoints, dim, newlows, newhighs )
+    scale points to new lowbound and highbound
+    retains old bound when newlow= -REALmax or newhigh= +REALmax
+
+  returns:
+    scaled points
+    overwrites old points
+
+  design:
+    for each coordinate
+      compute current low and high bound
+      compute scale and shift factors
+      scale all points
+      enforce new low and high bound for all points
+*/
+void qh_scalepoints(qhT *qh, pointT *points, int numpoints, int dim,
+        realT *newlows, realT *newhighs) {
+  int i,k;
+  realT shift, scale, *coord, low, high, newlow, newhigh, mincoord, maxcoord;
+  boolT nearzero= False;
+
+  for (k=0; k < dim; k++) {
+    newhigh= newhighs[k];
+    newlow= newlows[k];
+    if (newhigh > REALmax/2 && newlow < -REALmax/2)
+      continue;
+    low= REALmax;
+    high= -REALmax;
+    for (i=numpoints, coord=points+k; i--; coord += dim) {
+      minimize_(low, *coord);
+      maximize_(high, *coord);
+    }
+    if (newhigh > REALmax/2)
+      newhigh= high;
+    if (newlow < -REALmax/2)
+      newlow= low;
+    if (qh->DELAUNAY && k == dim-1 && newhigh < newlow) {
+      qh_fprintf(qh, qh->ferr, 6021, "qhull input error: 'Qb%d' or 'QB%d' inverts paraboloid since high bound %.2g < low bound %.2g\n",
+               k, k, newhigh, newlow);
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    scale= qh_divzero(newhigh - newlow, high - low,
+                  qh->MINdenom_1, &nearzero);
+    if (nearzero) {
+      qh_fprintf(qh, qh->ferr, 6022, "qhull input error: %d'th dimension's new bounds [%2.2g, %2.2g] too wide for\nexisting bounds [%2.2g, %2.2g]\n",
+              k, newlow, newhigh, low, high);
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    shift= (newlow * high - low * newhigh)/(high-low);
+    coord= points+k;
+    for (i=numpoints; i--; coord += dim)
+      *coord= *coord * scale + shift;
+    coord= points+k;
+    if (newlow < newhigh) {
+      mincoord= newlow;
+      maxcoord= newhigh;
+    }else {
+      mincoord= newhigh;
+      maxcoord= newlow;
+    }
+    for (i=numpoints; i--; coord += dim) {
+      minimize_(*coord, maxcoord);  /* because of roundoff error */
+      maximize_(*coord, mincoord);
+    }
+    trace0((qh, qh->ferr, 10, "qh_scalepoints: scaled %d'th coordinate [%2.2g, %2.2g] to [%.2g, %.2g] for %d points by %2.2g and shifted %2.2g\n",
+      k, low, high, newlow, newhigh, numpoints, scale, shift));
+  }
+} /* scalepoints */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="setdelaunay">-</a>
+
+  qh_setdelaunay(qh, dim, count, points )
+    project count points to dim-d paraboloid for Delaunay triangulation
+
+    dim is one more than the dimension of the input set
+    assumes dim is at least 3 (i.e., at least a 2-d Delaunay triangulation)
+
+    points is a dim*count realT array.  The first dim-1 coordinates
+    are the coordinates of the first input point.  array[dim] is
+    the first coordinate of the second input point.  array[2*dim] is
+    the first coordinate of the third input point.
+
+    if qh.last_low defined (i.e., 'Qbb' called qh_scalelast)
+      calls qh_scalelast to scale the last coordinate the same as the other points
+
+  returns:
+    for each point
+      sets point[dim-1] to sum of squares of coordinates
+    scale points to 'Qbb' if needed
+
+  notes:
+    to project one point, use
+      qh_setdelaunay(qh, qh->hull_dim, 1, point)
+
+    Do not use options 'Qbk', 'QBk', or 'QbB' since they scale
+    the coordinates after the original projection.
+
+*/
+void qh_setdelaunay(qhT *qh, int dim, int count, pointT *points) {
+  int i, k;
+  coordT *coordp, coord;
+  realT paraboloid;
+
+  trace0((qh, qh->ferr, 11, "qh_setdelaunay: project %d points to paraboloid for Delaunay triangulation\n", count));
+  coordp= points;
+  for (i=0; i < count; i++) {
+    coord= *coordp++;
+    paraboloid= coord*coord;
+    for (k=dim-2; k--; ) {
+      coord= *coordp++;
+      paraboloid += coord*coord;
+    }
+    *coordp++= paraboloid;
+  }
+  if (qh->last_low < REALmax/2)
+    qh_scalelast(qh, points, count, dim, qh->last_low, qh->last_high, qh->last_newhigh);
+} /* setdelaunay */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="sethalfspace">-</a>
+
+  qh_sethalfspace(qh, dim, coords, nextp, normal, offset, feasible )
+    set point to dual of halfspace relative to feasible point
+    halfspace is normal coefficients and offset.
+
+  returns:
+    false and prints error if feasible point is outside of hull
+    overwrites coordinates for point at dim coords
+    nextp= next point (coords)
+    does not call qh_errexit
+
+  design:
+    compute distance from feasible point to halfspace
+    divide each normal coefficient by -dist
+*/
+boolT qh_sethalfspace(qhT *qh, int dim, coordT *coords, coordT **nextp,
+         coordT *normal, coordT *offset, coordT *feasible) {
+  coordT *normp= normal, *feasiblep= feasible, *coordp= coords;
+  realT dist;
+  realT r; /*bug fix*/
+  int k;
+  boolT zerodiv;
+
+  dist= *offset;
+  for (k=dim; k--; )
+    dist += *(normp++) * *(feasiblep++);
+  if (dist > 0)
+    goto LABELerroroutside;
+  normp= normal;
+  if (dist < -qh->MINdenom) {
+    for (k=dim; k--; )
+      *(coordp++)= *(normp++) / -dist;
+  }else {
+    for (k=dim; k--; ) {
+      *(coordp++)= qh_divzero(*(normp++), -dist, qh->MINdenom_1, &zerodiv);
+      if (zerodiv)
+        goto LABELerroroutside;
+    }
+  }
+  *nextp= coordp;
+#ifndef qh_NOtrace
+  if (qh->IStracing >= 4) {
+    qh_fprintf(qh, qh->ferr, 8021, "qh_sethalfspace: halfspace at offset %6.2g to point: ", *offset);
+    for (k=dim, coordp=coords; k--; ) {
+      r= *coordp++;
+      qh_fprintf(qh, qh->ferr, 8022, " %6.2g", r);
+    }
+    qh_fprintf(qh, qh->ferr, 8023, "\n");
+  }
+#endif
+  return True;
+LABELerroroutside:
+  feasiblep= feasible;
+  normp= normal;
+  qh_fprintf(qh, qh->ferr, 6023, "qhull input error: feasible point is not clearly inside halfspace\nfeasible point: ");
+  for (k=dim; k--; )
+    qh_fprintf(qh, qh->ferr, 8024, qh_REAL_1, r=*(feasiblep++));
+  qh_fprintf(qh, qh->ferr, 8025, "\n     halfspace: ");
+  for (k=dim; k--; )
+    qh_fprintf(qh, qh->ferr, 8026, qh_REAL_1, r=*(normp++));
+  qh_fprintf(qh, qh->ferr, 8027, "\n     at offset: ");
+  qh_fprintf(qh, qh->ferr, 8028, qh_REAL_1, *offset);
+  qh_fprintf(qh, qh->ferr, 8029, " and distance: ");
+  qh_fprintf(qh, qh->ferr, 8030, qh_REAL_1, dist);
+  qh_fprintf(qh, qh->ferr, 8031, "\n");
+  return False;
+} /* sethalfspace */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="sethalfspace_all">-</a>
+
+  qh_sethalfspace_all(qh, dim, count, halfspaces, feasible )
+    generate dual for halfspace intersection with feasible point
+    array of count halfspaces
+      each halfspace is normal coefficients followed by offset
+      the origin is inside the halfspace if the offset is negative
+    feasible is a point inside all halfspaces (http://www.qhull.org/html/qhalf.htm#notes)
+
+  returns:
+    malloc'd array of count X dim-1 points
+
+  notes:
+    call before qh_init_B or qh_initqhull_globals
+    free memory when done
+    unused/untested code: please email bradb@shore.net if this works ok for you
+    if using option 'Fp', qh.feasible_point must be set (e.g., to 'feasible')
+    qh->feasible_point is a malloc'd array that is freed by qh_freebuffers.
+
+  design:
+    see qh_sethalfspace
+*/
+coordT *qh_sethalfspace_all(qhT *qh, int dim, int count, coordT *halfspaces, pointT *feasible) {
+  int i, newdim;
+  pointT *newpoints;
+  coordT *coordp, *normalp, *offsetp;
+
+  trace0((qh, qh->ferr, 12, "qh_sethalfspace_all: compute dual for halfspace intersection\n"));
+  newdim= dim - 1;
+  if (!(newpoints= (coordT *)qh_malloc((size_t)(count * newdim) * sizeof(coordT)))){
+    qh_fprintf(qh, qh->ferr, 6024, "qhull error: insufficient memory to compute dual of %d halfspaces\n",
+          count);
+    qh_errexit(qh, qh_ERRmem, NULL, NULL);
+  }
+  coordp= newpoints;
+  normalp= halfspaces;
+  for (i=0; i < count; i++) {
+    offsetp= normalp + newdim;
+    if (!qh_sethalfspace(qh, newdim, coordp, &coordp, normalp, offsetp, feasible)) {
+      qh_free(newpoints);  /* feasible is not inside halfspace as reported by qh_sethalfspace */
+      qh_fprintf(qh, qh->ferr, 8032, "The halfspace was at index %d\n", i);
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    normalp= offsetp + 1;
+  }
+  return newpoints;
+} /* sethalfspace_all */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="sharpnewfacets">-</a>
+
+  qh_sharpnewfacets(qh)
+
+  returns:
+    true if could be an acute angle (facets in different quadrants)
+
+  notes:
+    for qh_findbest
+
+  design:
+    for all facets on qh.newfacet_list
+      if two facets are in different quadrants
+        set issharp
+*/
+boolT qh_sharpnewfacets(qhT *qh) {
+  facetT *facet;
+  boolT issharp= False;
+  int *quadrant, k;
+
+  quadrant= (int *)qh_memalloc(qh, qh->hull_dim * (int)sizeof(int));
+  FORALLfacet_(qh->newfacet_list) {
+    if (facet == qh->newfacet_list) {
+      for (k=qh->hull_dim; k--; )
+        quadrant[ k]= (facet->normal[ k] > 0);
+    }else {
+      for (k=qh->hull_dim; k--; ) {
+        if (quadrant[ k] != (facet->normal[ k] > 0)) {
+          issharp= True;
+          break;
+        }
+      }
+    }
+    if (issharp)
+      break;
+  }
+  qh_memfree(qh, quadrant, qh->hull_dim * (int)sizeof(int));
+  trace3((qh, qh->ferr, 3001, "qh_sharpnewfacets: %d\n", issharp));
+  return issharp;
+} /* sharpnewfacets */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="vertex_bestdist">-</a>
+
+  qh_vertex_bestdist(qh, vertices )
+  qh_vertex_bestdist2(qh, vertices, vertexp, vertexp2 )
+    return nearest distance between vertices
+    optionally returns vertex and vertex2
+
+  notes:
+    called by qh_partitioncoplanar, qh_mergefacet, qh_check_maxout, qh_checkpoint
+*/
+coordT qh_vertex_bestdist(qhT *qh, setT *vertices) {
+  vertexT *vertex, *vertex2;
+
+  return qh_vertex_bestdist2(qh, vertices, &vertex, &vertex2);
+} /* vertex_bestdist */
+
+coordT qh_vertex_bestdist2(qhT *qh, setT *vertices, vertexT **vertexp/*= NULL*/, vertexT **vertexp2/*= NULL*/) {
+  vertexT *vertex, *vertexA, *bestvertex= NULL, *bestvertex2= NULL;
+  coordT dist, bestdist= REALmax;
+  int k, vertex_i, vertex_n;
+
+  FOREACHvertex_i_(qh, vertices) {
+    for (k= vertex_i+1; k < vertex_n; k++) {
+      vertexA= SETelemt_(vertices, k, vertexT);
+      dist= qh_pointdist(vertex->point, vertexA->point, -qh->hull_dim);
+      if (dist < bestdist) {
+        bestdist= dist;
+        bestvertex= vertex;
+        bestvertex2= vertexA;
+      }
+    }
+  }
+  *vertexp= bestvertex;
+  *vertexp2= bestvertex2;
+  return sqrt(bestdist);
+} /* vertex_bestdist */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="voronoi_center">-</a>
+
+  qh_voronoi_center(qh, dim, points )
+    return Voronoi center for a set of points
+    dim is the orginal dimension of the points
+    gh.gm_matrix/qh.gm_row are scratch buffers
+
+  returns:
+    center as a temporary point (qh_memalloc)
+    if non-simplicial,
+      returns center for max simplex of points
+
+  notes:
+    only called by qh_facetcenter
+    from Bowyer & Woodwark, A Programmer's Geometry, 1983, p. 65
+
+  design:
+    if non-simplicial
+      determine max simplex for points
+    translate point0 of simplex to origin
+    compute sum of squares of diagonal
+    compute determinate
+    compute Voronoi center (see Bowyer & Woodwark)
+*/
+pointT *qh_voronoi_center(qhT *qh, int dim, setT *points) {
+  pointT *point, **pointp, *point0;
+  pointT *center= (pointT *)qh_memalloc(qh, qh->center_size);
+  setT *simplex;
+  int i, j, k, size= qh_setsize(qh, points);
+  coordT *gmcoord;
+  realT *diffp, sum2, *sum2row, *sum2p, det, factor;
+  boolT nearzero, infinite;
+
+  if (size == dim+1)
+    simplex= points;
+  else if (size < dim+1) {
+    qh_memfree(qh, center, qh->center_size);
+    qh_fprintf(qh, qh->ferr, 6025, "qhull internal error (qh_voronoi_center):  need at least %d points to construct a Voronoi center\n",
+             dim+1);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    simplex= points;  /* never executed -- avoids warning */
+  }else {
+    simplex= qh_settemp(qh, dim+1);
+    qh_maxsimplex(qh, dim, points, NULL, 0, &simplex);
+  }
+  point0= SETfirstt_(simplex, pointT);
+  gmcoord= qh->gm_matrix;
+  for (k=0; k < dim; k++) {
+    qh->gm_row[k]= gmcoord;
+    FOREACHpoint_(simplex) {
+      if (point != point0)
+        *(gmcoord++)= point[k] - point0[k];
+    }
+  }
+  sum2row= gmcoord;
+  for (i=0; i < dim; i++) {
+    sum2= 0.0;
+    for (k=0; k < dim; k++) {
+      diffp= qh->gm_row[k] + i;
+      sum2 += *diffp * *diffp;
+    }
+    *(gmcoord++)= sum2;
+  }
+  det= qh_determinant(qh, qh->gm_row, dim, &nearzero);
+  factor= qh_divzero(0.5, det, qh->MINdenom, &infinite);
+  if (infinite) {
+    for (k=dim; k--; )
+      center[k]= qh_INFINITE;
+    if (qh->IStracing)
+      qh_printpoints(qh, qh->ferr, "qh_voronoi_center: at infinity for ", simplex);
+  }else {
+    for (i=0; i < dim; i++) {
+      gmcoord= qh->gm_matrix;
+      sum2p= sum2row;
+      for (k=0; k < dim; k++) {
+        qh->gm_row[k]= gmcoord;
+        if (k == i) {
+          for (j=dim; j--; )
+            *(gmcoord++)= *sum2p++;
+        }else {
+          FOREACHpoint_(simplex) {
+            if (point != point0)
+              *(gmcoord++)= point[k] - point0[k];
+          }
+        }
+      }
+      center[i]= qh_determinant(qh, qh->gm_row, dim, &nearzero)*factor + point0[i];
+    }
+#ifndef qh_NOtrace
+    if (qh->IStracing >= 3) {
+      qh_fprintf(qh, qh->ferr, 3061, "qh_voronoi_center: det %2.2g factor %2.2g ", det, factor);
+      qh_printmatrix(qh, qh->ferr, "center:", &center, 1, dim);
+      if (qh->IStracing >= 5) {
+        qh_printpoints(qh, qh->ferr, "points", simplex);
+        FOREACHpoint_(simplex)
+          qh_fprintf(qh, qh->ferr, 8034, "p%d dist %.2g, ", qh_pointid(qh, point),
+                   qh_pointdist(point, center, dim));
+        qh_fprintf(qh, qh->ferr, 8035, "\n");
+      }
+    }
+#endif
+  }
+  if (simplex != points)
+    qh_settempfree(qh, &simplex);
+  return center;
+} /* voronoi_center */
+
diff --git a/contrib/libs/qhull/libqhull_r/geom_r.c b/contrib/libs/qhull/libqhull_r/geom_r.c
new file mode 100644
index 0000000000..22faead499
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/geom_r.c
@@ -0,0 +1,1284 @@
+/*<html><pre>  -<a                             href="qh-geom_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   geom_r.c
+   geometric routines of qhull
+
+   see qh-geom_r.htm and geom_r.h
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/geom_r.c#5 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+
+   infrequent code goes into geom2_r.c
+*/
+
+#include "qhull_ra.h"
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="distplane">-</a>
+
+  qh_distplane(qh, point, facet, dist )
+    return distance from point to facet
+
+  returns:
+    dist
+    if qh.RANDOMdist, joggles result
+
+  notes:
+    dist > 0 if point is above facet (i.e., outside)
+    does not error (for qh_sortfacets, qh_outerinner)
+    for nearly coplanar points, the returned values may be duplicates
+      for example pairs of nearly incident points, rbox 175 C1,2e-13 t1538759579 | qhull d T4
+      622 qh_distplane: e-014  # count of two or more duplicate values for unique calls
+      258 qh_distplane: e-015
+      38 qh_distplane: e-016
+      40 qh_distplane: e-017
+      6 qh_distplane: e-018
+      5 qh_distplane: -e-018
+      33 qh_distplane: -e-017
+         3153 qh_distplane: -2.775557561562891e-017  # duplicated value for 3153 unique calls
+      42 qh_distplane: -e-016
+      307 qh_distplane: -e-015
+      1271 qh_distplane: -e-014
+      13 qh_distplane: -e-013
+
+  see:
+    qh_distnorm in geom2_r.c
+    qh_distplane [geom_r.c], QhullFacet::distance, and QhullHyperplane::distance are copies
+*/
+void qh_distplane(qhT *qh, pointT *point, facetT *facet, realT *dist) {
+  coordT *normal= facet->normal, *coordp, randr;
+  int k;
+
+  switch (qh->hull_dim){
+  case 2:
+    *dist= facet->offset + point[0] * normal[0] + point[1] * normal[1];
+    break;
+  case 3:
+    *dist= facet->offset + point[0] * normal[0] + point[1] * normal[1] + point[2] * normal[2];
+    break;
+  case 4:
+    *dist= facet->offset+point[0]*normal[0]+point[1]*normal[1]+point[2]*normal[2]+point[3]*normal[3];
+    break;
+  case 5:
+    *dist= facet->offset+point[0]*normal[0]+point[1]*normal[1]+point[2]*normal[2]+point[3]*normal[3]+point[4]*normal[4];
+    break;
+  case 6:
+    *dist= facet->offset+point[0]*normal[0]+point[1]*normal[1]+point[2]*normal[2]+point[3]*normal[3]+point[4]*normal[4]+point[5]*normal[5];
+    break;
+  case 7:
+    *dist= facet->offset+point[0]*normal[0]+point[1]*normal[1]+point[2]*normal[2]+point[3]*normal[3]+point[4]*normal[4]+point[5]*normal[5]+point[6]*normal[6];
+    break;
+  case 8:
+    *dist= facet->offset+point[0]*normal[0]+point[1]*normal[1]+point[2]*normal[2]+point[3]*normal[3]+point[4]*normal[4]+point[5]*normal[5]+point[6]*normal[6]+point[7]*normal[7];
+    break;
+  default:
+    *dist= facet->offset;
+    coordp= point;
+    for (k=qh->hull_dim; k--; )
+      *dist += *coordp++ * *normal++;
+    break;
+  }
+  zzinc_(Zdistplane);
+  if (!qh->RANDOMdist && qh->IStracing < 4)
+    return;
+  if (qh->RANDOMdist) {
+    randr= qh_RANDOMint;
+    *dist += (2.0 * randr / qh_RANDOMmax - 1.0) *
+      qh->RANDOMfactor * qh->MAXabs_coord;
+  }
+#ifndef qh_NOtrace
+  if (qh->IStracing >= 4) {
+    qh_fprintf(qh, qh->ferr, 8001, "qh_distplane: ");
+    qh_fprintf(qh, qh->ferr, 8002, qh_REAL_1, *dist);
+    qh_fprintf(qh, qh->ferr, 8003, "from p%d to f%d\n", qh_pointid(qh, point), facet->id);
+  }
+#endif
+  return;
+} /* distplane */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="findbest">-</a>
+
+  qh_findbest(qh, point, startfacet, bestoutside, qh_ISnewfacets, qh_NOupper, dist, isoutside, numpart )
+    find facet that is furthest below a point
+    for upperDelaunay facets
+      returns facet only if !qh_NOupper and clearly above
+
+  input:
+    starts search at 'startfacet' (can not be flipped)
+    if !bestoutside(qh_ALL), stops at qh.MINoutside
+
+  returns:
+    best facet (reports error if NULL)
+    early out if isoutside defined and bestdist > qh.MINoutside
+    dist is distance to facet
+    isoutside is true if point is outside of facet
+    numpart counts the number of distance tests
+
+  see also:
+    qh_findbestnew()
+
+  notes:
+    If merging (testhorizon), searches horizon facets of coplanar best facets because
+    after qh_distplane, this and qh_partitionpoint are the most expensive in 3-d
+      avoid calls to distplane, function calls, and real number operations.
+    caller traces result
+    Optimized for outside points.   Tried recording a search set for qh_findhorizon.
+    Made code more complicated.
+
+  when called by qh_partitionvisible():
+    indicated by qh_ISnewfacets
+    qh.newfacet_list is list of simplicial, new facets
+    qh_findbestnew set if qh_sharpnewfacets returns True (to use qh_findbestnew)
+    qh.bestfacet_notsharp set if qh_sharpnewfacets returns False
+
+  when called by qh_findfacet(), qh_partitionpoint(), qh_partitioncoplanar(),
+                 qh_check_bestdist(), qh_addpoint()
+    indicated by !qh_ISnewfacets
+    returns best facet in neighborhood of given facet
+      this is best facet overall if dist >= -qh.MAXcoplanar
+        or hull has at least a "spherical" curvature
+
+  design:
+    initialize and test for early exit
+    repeat while there are better facets
+      for each neighbor of facet
+        exit if outside facet found
+        test for better facet
+    if point is inside and partitioning
+      test for new facets with a "sharp" intersection
+      if so, future calls go to qh_findbestnew()
+    test horizon facets
+*/
+facetT *qh_findbest(qhT *qh, pointT *point, facetT *startfacet,
+                     boolT bestoutside, boolT isnewfacets, boolT noupper,
+                     realT *dist, boolT *isoutside, int *numpart) {
+  realT bestdist= -REALmax/2 /* avoid underflow */;
+  facetT *facet, *neighbor, **neighborp;
+  facetT *bestfacet= NULL, *lastfacet= NULL;
+  int oldtrace= qh->IStracing;
+  unsigned int visitid= ++qh->visit_id;
+  int numpartnew=0;
+  boolT testhorizon= True; /* needed if precise, e.g., rbox c D6 | qhull Q0 Tv */
+
+  zinc_(Zfindbest);
+#ifndef qh_NOtrace
+  if (qh->IStracing >= 4 || (qh->TRACElevel && qh->TRACEpoint >= 0 && qh->TRACEpoint == qh_pointid(qh, point))) {
+    if (qh->TRACElevel > qh->IStracing)
+      qh->IStracing= qh->TRACElevel;
+    qh_fprintf(qh, qh->ferr, 8004, "qh_findbest: point p%d starting at f%d isnewfacets? %d, unless %d exit if > %2.2g,",
+             qh_pointid(qh, point), startfacet->id, isnewfacets, bestoutside, qh->MINoutside);
+    qh_fprintf(qh, qh->ferr, 8005, " testhorizon? %d, noupper? %d,", testhorizon, noupper);
+    qh_fprintf(qh, qh->ferr, 8006, " Last qh_addpoint p%d,", qh->furthest_id);
+    qh_fprintf(qh, qh->ferr, 8007, " Last merge #%d, max_outside %2.2g\n", zzval_(Ztotmerge), qh->max_outside);
+  }
+#endif
+  if (isoutside)
+    *isoutside= True;
+  if (!startfacet->flipped) {  /* test startfacet before testing its neighbors */
+    *numpart= 1;
+    qh_distplane(qh, point, startfacet, dist);  /* this code is duplicated below */
+    if (!bestoutside && *dist >= qh->MINoutside
+    && (!startfacet->upperdelaunay || !noupper)) {
+      bestfacet= startfacet;
+      goto LABELreturn_best;
+    }
+    bestdist= *dist;
+    if (!startfacet->upperdelaunay) {
+      bestfacet= startfacet;
+    }
+  }else
+    *numpart= 0;
+  startfacet->visitid= visitid;
+  facet= startfacet;
+  while (facet) {
+    trace4((qh, qh->ferr, 4001, "qh_findbest: neighbors of f%d, bestdist %2.2g f%d\n",
+                facet->id, bestdist, getid_(bestfacet)));
+    lastfacet= facet;
+    FOREACHneighbor_(facet) {
+      if (!neighbor->newfacet && isnewfacets)
+        continue;
+      if (neighbor->visitid == visitid)
+        continue;
+      neighbor->visitid= visitid;
+      if (!neighbor->flipped) {  /* code duplicated above */
+        (*numpart)++;
+        qh_distplane(qh, point, neighbor, dist);
+        if (*dist > bestdist) {
+          if (!bestoutside && *dist >= qh->MINoutside
+          && (!neighbor->upperdelaunay || !noupper)) {
+            bestfacet= neighbor;
+            goto LABELreturn_best;
+          }
+          if (!neighbor->upperdelaunay) {
+            bestfacet= neighbor;
+            bestdist= *dist;
+            break; /* switch to neighbor */
+          }else if (!bestfacet) {
+            bestdist= *dist;
+            break; /* switch to neighbor */
+          }
+        } /* end of *dist>bestdist */
+      } /* end of !flipped */
+    } /* end of FOREACHneighbor */
+    facet= neighbor;  /* non-NULL only if *dist>bestdist */
+  } /* end of while facet (directed search) */
+  if (isnewfacets) {
+    if (!bestfacet) { /* startfacet is upperdelaunay (or flipped) w/o !flipped newfacet neighbors */
+      bestdist= -REALmax/2;
+      bestfacet= qh_findbestnew(qh, point, qh->newfacet_list, &bestdist, bestoutside, isoutside, &numpartnew);
+      testhorizon= False; /* qh_findbestnew calls qh_findbesthorizon */
+    }else if (!qh->findbest_notsharp && bestdist < -qh->DISTround) {
+      if (qh_sharpnewfacets(qh)) {
+        /* seldom used, qh_findbestnew will retest all facets */
+        zinc_(Zfindnewsharp);
+        bestfacet= qh_findbestnew(qh, point, bestfacet, &bestdist, bestoutside, isoutside, &numpartnew);
+        testhorizon= False; /* qh_findbestnew calls qh_findbesthorizon */
+        qh->findbestnew= True;
+      }else
+        qh->findbest_notsharp= True;
+    }
+  }
+  if (!bestfacet)
+    bestfacet= qh_findbestlower(qh, lastfacet, point, &bestdist, numpart); /* lastfacet is non-NULL because startfacet is non-NULL */
+  if (testhorizon) /* qh_findbestnew not called */
+    bestfacet= qh_findbesthorizon(qh, !qh_IScheckmax, point, bestfacet, noupper, &bestdist, &numpartnew);
+  *dist= bestdist;
+  if (isoutside && bestdist < qh->MINoutside)
+    *isoutside= False;
+LABELreturn_best:
+  zadd_(Zfindbesttot, *numpart);
+  zmax_(Zfindbestmax, *numpart);
+  (*numpart) += numpartnew;
+  qh->IStracing= oldtrace;
+  return bestfacet;
+}  /* findbest */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="findbesthorizon">-</a>
+
+  qh_findbesthorizon(qh, qh_IScheckmax, point, startfacet, qh_NOupper, &bestdist, &numpart )
+    search coplanar and better horizon facets from startfacet/bestdist
+    ischeckmax turns off statistics and minsearch update
+    all arguments must be initialized, including *bestdist and *numpart
+    qh.coplanarfacetset used to maintain current search set, reset whenever best facet is substantially better
+  returns(ischeckmax):
+    best facet
+    updates f.maxoutside for neighbors of searched facets (if qh_MAXoutside)
+  returns(!ischeckmax):
+    best facet that is not upperdelaunay or newfacet (qh.first_newfacet)
+    allows upperdelaunay that is clearly outside
+  returns:
+    bestdist is distance to bestfacet
+    numpart -- updates number of distance tests
+
+  notes:
+    called by qh_findbest if point is not outside a facet (directed search)
+    called by qh_findbestnew if point is not outside a new facet
+    called by qh_check_maxout for each point in hull
+    called by qh_check_bestdist for each point in hull (rarely used)
+
+    no early out -- use qh_findbest() or qh_findbestnew()
+    Searches coplanar or better horizon facets
+
+  when called by qh_check_maxout() (qh_IScheckmax)
+    startfacet must be closest to the point
+      Otherwise, if point is beyond and below startfacet, startfacet may be a local minimum
+      even though other facets are below the point.
+    updates facet->maxoutside for good, visited facets
+    may return NULL
+
+    searchdist is qh.max_outside + 2 * DISTround
+      + max( MINvisible('Vn'), MAXcoplanar('Un'));
+    This setting is a guess.  It must be at least max_outside + 2*DISTround
+    because a facet may have a geometric neighbor across a vertex
+
+  design:
+    for each horizon facet of coplanar best facets
+      continue if clearly inside
+      unless upperdelaunay or clearly outside
+         update best facet
+*/
+facetT *qh_findbesthorizon(qhT *qh, boolT ischeckmax, pointT* point, facetT *startfacet, boolT noupper, realT *bestdist, int *numpart) {
+  facetT *bestfacet= startfacet;
+  realT dist;
+  facetT *neighbor, **neighborp, *facet;
+  facetT *nextfacet= NULL; /* optimize last facet of coplanarfacetset */
+  int numpartinit= *numpart, coplanarfacetset_size, numcoplanar= 0, numfacet= 0;
+  unsigned int visitid= ++qh->visit_id;
+  boolT newbest= False; /* for tracing */
+  realT minsearch, searchdist;  /* skip facets that are too far from point */
+  boolT is_5x_minsearch;
+
+  if (!ischeckmax) {
+    zinc_(Zfindhorizon);
+  }else {
+#if qh_MAXoutside
+    if ((!qh->ONLYgood || startfacet->good) && *bestdist > startfacet->maxoutside)
+      startfacet->maxoutside= *bestdist;
+#endif
+  }
+  searchdist= qh_SEARCHdist; /* an expression, a multiple of qh.max_outside and precision constants */
+  minsearch= *bestdist - searchdist;
+  if (ischeckmax) {
+    /* Always check coplanar facets.  Needed for RBOX 1000 s Z1 G1e-13 t996564279 | QHULL Tv */
+    minimize_(minsearch, -searchdist);
+  }
+  coplanarfacetset_size= 0;
+  startfacet->visitid= visitid;
+  facet= startfacet;
+  while (True) {
+    numfacet++;
+    is_5x_minsearch= (ischeckmax && facet->nummerge > 10 && qh_setsize(qh, facet->neighbors) > 100);  /* QH11033 FIX: qh_findbesthorizon: many tests for facets with many merges and neighbors.  Can hide coplanar facets, e.g., 'rbox 1000 s Z1 G1e-13' with 4400+ neighbors */
+    trace4((qh, qh->ferr, 4002, "qh_findbesthorizon: test neighbors of f%d bestdist %2.2g f%d ischeckmax? %d noupper? %d minsearch %2.2g is_5x? %d searchdist %2.2g\n",
+                facet->id, *bestdist, getid_(bestfacet), ischeckmax, noupper,
+                minsearch, is_5x_minsearch, searchdist));
+    FOREACHneighbor_(facet) {
+      if (neighbor->visitid == visitid)
+        continue;
+      neighbor->visitid= visitid;
+      if (!neighbor->flipped) {  /* neighbors of flipped facets always searched via nextfacet */
+        qh_distplane(qh, point, neighbor, &dist); /* duplicate qh_distpane for new facets, they may be coplanar */
+        (*numpart)++;
+        if (dist > *bestdist) {
+          if (!neighbor->upperdelaunay || ischeckmax || (!noupper && dist >= qh->MINoutside)) {
+            if (!ischeckmax) {
+              minsearch= dist - searchdist;
+              if (dist > *bestdist + searchdist) {
+                zinc_(Zfindjump);  /* everything in qh.coplanarfacetset at least searchdist below */
+                coplanarfacetset_size= 0;
+              }
+            }
+            bestfacet= neighbor;
+            *bestdist= dist;
+            newbest= True;
+          }
+        }else if (is_5x_minsearch) {
+          if (dist < 5 * minsearch)
+            continue; /* skip this neighbor, do not set nextfacet.  dist is negative */
+        }else if (dist < minsearch)
+          continue;  /* skip this neighbor, do not set nextfacet.  If ischeckmax, dist can't be positive */
+#if qh_MAXoutside
+        if (ischeckmax && dist > neighbor->maxoutside)
+          neighbor->maxoutside= dist;
+#endif
+      } /* end of !flipped, need to search neighbor */
+      if (nextfacet) {
+        numcoplanar++;
+        if (!coplanarfacetset_size++) {
+          SETfirst_(qh->coplanarfacetset)= nextfacet;
+          SETtruncate_(qh->coplanarfacetset, 1);
+        }else
+          qh_setappend(qh, &qh->coplanarfacetset, nextfacet); /* Was needed for RBOX 1000 s W1e-13 P0 t996547055 | QHULL d Qbb Qc Tv
+                                                 and RBOX 1000 s Z1 G1e-13 t996564279 | qhull Tv  */
+      }
+      nextfacet= neighbor;
+    } /* end of EACHneighbor */
+    facet= nextfacet;
+    if (facet)
+      nextfacet= NULL;
+    else if (!coplanarfacetset_size)
+      break;
+    else if (!--coplanarfacetset_size) {
+      facet= SETfirstt_(qh->coplanarfacetset, facetT);
+      SETtruncate_(qh->coplanarfacetset, 0);
+    }else
+      facet= (facetT *)qh_setdellast(qh->coplanarfacetset);
+  } /* while True, i.e., "for each facet in qh.coplanarfacetset" */
+  if (!ischeckmax) {
+    zadd_(Zfindhorizontot, *numpart - numpartinit);
+    zmax_(Zfindhorizonmax, *numpart - numpartinit);
+    if (newbest)
+      zinc_(Znewbesthorizon);
+  }
+  trace4((qh, qh->ferr, 4003, "qh_findbesthorizon: p%d, newbest? %d, bestfacet f%d, bestdist %2.2g, numfacet %d, coplanarfacets %d, numdist %d\n",
+    qh_pointid(qh, point), newbest, getid_(bestfacet), *bestdist, numfacet, numcoplanar, *numpart - numpartinit));
+  return bestfacet;
+}  /* findbesthorizon */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="findbestnew">-</a>
+
+  qh_findbestnew(qh, point, startfacet, dist, isoutside, numpart )
+    find best newfacet for point
+    searches all of qh.newfacet_list starting at startfacet
+    searches horizon facets of coplanar best newfacets
+    searches all facets if startfacet == qh.facet_list
+  returns:
+    best new or horizon facet that is not upperdelaunay
+    early out if isoutside and not 'Qf'
+    dist is distance to facet
+    isoutside is true if point is outside of facet
+    numpart is number of distance tests
+
+  notes:
+    Always used for merged new facets (see qh_USEfindbestnew)
+    Avoids upperdelaunay facet unless (isoutside and outside)
+
+    Uses qh.visit_id, qh.coplanarfacetset.
+    If share visit_id with qh_findbest, coplanarfacetset is incorrect.
+
+    If merging (testhorizon), searches horizon facets of coplanar best facets because
+    a point maybe coplanar to the bestfacet, below its horizon facet,
+    and above a horizon facet of a coplanar newfacet.  For example,
+      rbox 1000 s Z1 G1e-13 | qhull
+      rbox 1000 s W1e-13 P0 t992110337 | QHULL d Qbb Qc
+
+    qh_findbestnew() used if
+       qh_sharpnewfacets -- newfacets contains a sharp angle
+       if many merges, qh_premerge found a merge, or 'Qf' (qh.findbestnew)
+
+  see also:
+    qh_partitionall() and qh_findbest()
+
+  design:
+    for each new facet starting from startfacet
+      test distance from point to facet
+      return facet if clearly outside
+      unless upperdelaunay and a lowerdelaunay exists
+         update best facet
+    test horizon facets
+*/
+facetT *qh_findbestnew(qhT *qh, pointT *point, facetT *startfacet,
+           realT *dist, boolT bestoutside, boolT *isoutside, int *numpart) {
+  realT bestdist= -REALmax/2;
+  facetT *bestfacet= NULL, *facet;
+  int oldtrace= qh->IStracing, i;
+  unsigned int visitid= ++qh->visit_id;
+  realT distoutside= 0.0;
+  boolT isdistoutside; /* True if distoutside is defined */
+  boolT testhorizon= True; /* needed if precise, e.g., rbox c D6 | qhull Q0 Tv */
+
+  if (!startfacet || !startfacet->next) {
+    if (qh->MERGING) {
+      qh_fprintf(qh, qh->ferr, 6001, "qhull topology error (qh_findbestnew): merging has formed and deleted a cone of new facets.  Can not continue.\n");
+      qh_errexit(qh, qh_ERRtopology, NULL, NULL);
+    }else {
+      qh_fprintf(qh, qh->ferr, 6002, "qhull internal error (qh_findbestnew): no new facets for point p%d\n",
+              qh->furthest_id);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+  }
+  zinc_(Zfindnew);
+  if (qh->BESToutside || bestoutside)
+    isdistoutside= False;
+  else {
+    isdistoutside= True;
+    distoutside= qh_DISToutside; /* multiple of qh.MINoutside & qh.max_outside, see user_r.h */
+  }
+  if (isoutside)
+    *isoutside= True;
+  *numpart= 0;
+#ifndef qh_NOtrace
+  if (qh->IStracing >= 4 || (qh->TRACElevel && qh->TRACEpoint >= 0 && qh->TRACEpoint == qh_pointid(qh, point))) {
+    if (qh->TRACElevel > qh->IStracing)
+      qh->IStracing= qh->TRACElevel;
+    qh_fprintf(qh, qh->ferr, 8008, "qh_findbestnew: point p%d facet f%d. Stop? %d if dist > %2.2g,",
+             qh_pointid(qh, point), startfacet->id, isdistoutside, distoutside);
+    qh_fprintf(qh, qh->ferr, 8009, " Last qh_addpoint p%d, qh.visit_id %d, vertex_visit %d,",  qh->furthest_id, visitid, qh->vertex_visit);
+    qh_fprintf(qh, qh->ferr, 8010, " Last merge #%d\n", zzval_(Ztotmerge));
+  }
+#endif
+  /* visit all new facets starting with startfacet, maybe qh->facet_list */
+  for (i=0, facet=startfacet; i < 2; i++, facet= qh->newfacet_list) {
+    FORALLfacet_(facet) {
+      if (facet == startfacet && i)
+        break;
+      facet->visitid= visitid;
+      if (!facet->flipped) {
+        qh_distplane(qh, point, facet, dist);
+        (*numpart)++;
+        if (*dist > bestdist) {
+          if (!facet->upperdelaunay || *dist >= qh->MINoutside) {
+            bestfacet= facet;
+            if (isdistoutside && *dist >= distoutside)
+              goto LABELreturn_bestnew;
+            bestdist= *dist;
+          }
+        }
+      } /* end of !flipped */
+    } /* FORALLfacet from startfacet or qh->newfacet_list */
+  }
+  if (testhorizon || !bestfacet) /* testhorizon is always True.  Keep the same code as qh_findbest */
+    bestfacet= qh_findbesthorizon(qh, !qh_IScheckmax, point, bestfacet ? bestfacet : startfacet,
+                                        !qh_NOupper, &bestdist, numpart);
+  *dist= bestdist;
+  if (isoutside && *dist < qh->MINoutside)
+    *isoutside= False;
+LABELreturn_bestnew:
+  zadd_(Zfindnewtot, *numpart);
+  zmax_(Zfindnewmax, *numpart);
+  trace4((qh, qh->ferr, 4004, "qh_findbestnew: bestfacet f%d bestdist %2.2g for p%d f%d bestoutside? %d \n",
+    getid_(bestfacet), *dist, qh_pointid(qh, point), startfacet->id, bestoutside));
+  qh->IStracing= oldtrace;
+  return bestfacet;
+}  /* findbestnew */
+
+/* ============ hyperplane functions -- keep code together [?] ============ */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="backnormal">-</a>
+
+  qh_backnormal(qh, rows, numrow, numcol, sign, normal, nearzero )
+    given an upper-triangular rows array and a sign,
+    solve for normal equation x using back substitution over rows U
+
+  returns:
+     normal= x
+
+     if will not be able to divzero() when normalized(qh.MINdenom_2 and qh.MINdenom_1_2),
+       if fails on last row
+         this means that the hyperplane intersects [0,..,1]
+         sets last coordinate of normal to sign
+       otherwise
+         sets tail of normal to [...,sign,0,...], i.e., solves for b= [0...0]
+         sets nearzero
+
+  notes:
+     assumes numrow == numcol-1
+
+     see Golub & van Loan, 1983, Eq. 4.4-9 for "Gaussian elimination with complete pivoting"
+
+     solves Ux=b where Ax=b and PA=LU
+     b= [0,...,0,sign or 0]  (sign is either -1 or +1)
+     last row of A= [0,...,0,1]
+
+     1) Ly=Pb == y=b since P only permutes the 0's of   b
+
+  design:
+    for each row from end
+      perform back substitution
+      if near zero
+        use qh_divzero for division
+        if zero divide and not last row
+          set tail of normal to 0
+*/
+void qh_backnormal(qhT *qh, realT **rows, int numrow, int numcol, boolT sign,
+        coordT *normal, boolT *nearzero) {
+  int i, j;
+  coordT *normalp, *normal_tail, *ai, *ak;
+  realT diagonal;
+  boolT waszero;
+  int zerocol= -1;
+
+  normalp= normal + numcol - 1;
+  *normalp--= (sign ? -1.0 : 1.0);
+  for (i=numrow; i--; ) {
+    *normalp= 0.0;
+    ai= rows[i] + i + 1;
+    ak= normalp+1;
+    for (j=i+1; j < numcol; j++)
+      *normalp -= *ai++ * *ak++;
+    diagonal= (rows[i])[i];
+    if (fabs_(diagonal) > qh->MINdenom_2)
+      *(normalp--) /= diagonal;
+    else {
+      waszero= False;
+      *normalp= qh_divzero(*normalp, diagonal, qh->MINdenom_1_2, &waszero);
+      if (waszero) {
+        zerocol= i;
+        *(normalp--)= (sign ? -1.0 : 1.0);
+        for (normal_tail= normalp+2; normal_tail < normal + numcol; normal_tail++)
+          *normal_tail= 0.0;
+      }else
+        normalp--;
+    }
+  }
+  if (zerocol != -1) {
+    *nearzero= True;
+    trace4((qh, qh->ferr, 4005, "qh_backnormal: zero diagonal at column %d.\n", i));
+    zzinc_(Zback0);
+    qh_joggle_restart(qh, "zero diagonal on back substitution");
+  }
+} /* backnormal */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="gausselim">-</a>
+
+  qh_gausselim(qh, rows, numrow, numcol, sign )
+    Gaussian elimination with partial pivoting
+
+  returns:
+    rows is upper triangular (includes row exchanges)
+    flips sign for each row exchange
+    sets nearzero if pivot[k] < qh.NEARzero[k], else clears it
+
+  notes:
+    if nearzero, the determinant's sign may be incorrect.
+    assumes numrow <= numcol
+
+  design:
+    for each row
+      determine pivot and exchange rows if necessary
+      test for near zero
+      perform gaussian elimination step
+*/
+void qh_gausselim(qhT *qh, realT **rows, int numrow, int numcol, boolT *sign, boolT *nearzero) {
+  realT *ai, *ak, *rowp, *pivotrow;
+  realT n, pivot, pivot_abs= 0.0, temp;
+  int i, j, k, pivoti, flip=0;
+
+  *nearzero= False;
+  for (k=0; k < numrow; k++) {
+    pivot_abs= fabs_((rows[k])[k]);
+    pivoti= k;
+    for (i=k+1; i < numrow; i++) {
+      if ((temp= fabs_((rows[i])[k])) > pivot_abs) {
+        pivot_abs= temp;
+        pivoti= i;
+      }
+    }
+    if (pivoti != k) {
+      rowp= rows[pivoti];
+      rows[pivoti]= rows[k];
+      rows[k]= rowp;
+      *sign ^= 1;
+      flip ^= 1;
+    }
+    if (pivot_abs <= qh->NEARzero[k]) {
+      *nearzero= True;
+      if (pivot_abs == 0.0) {   /* remainder of column == 0 */
+#ifndef qh_NOtrace
+        if (qh->IStracing >= 4) {
+          qh_fprintf(qh, qh->ferr, 8011, "qh_gausselim: 0 pivot at column %d. (%2.2g < %2.2g)\n", k, pivot_abs, qh->DISTround);
+          qh_printmatrix(qh, qh->ferr, "Matrix:", rows, numrow, numcol);
+        }
+#endif
+        zzinc_(Zgauss0);
+        qh_joggle_restart(qh, "zero pivot for Gaussian elimination");
+        goto LABELnextcol;
+      }
+    }
+    pivotrow= rows[k] + k;
+    pivot= *pivotrow++;  /* signed value of pivot, and remainder of row */
+    for (i=k+1; i < numrow; i++) {
+      ai= rows[i] + k;
+      ak= pivotrow;
+      n= (*ai++)/pivot;   /* divzero() not needed since |pivot| >= |*ai| */
+      for (j= numcol - (k+1); j--; )
+        *ai++ -= n * *ak++;
+    }
+  LABELnextcol:
+    ;
+  }
+  wmin_(Wmindenom, pivot_abs);  /* last pivot element */
+  if (qh->IStracing >= 5)
+    qh_printmatrix(qh, qh->ferr, "qh_gausselem: result", rows, numrow, numcol);
+} /* gausselim */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="getangle">-</a>
+
+  qh_getangle(qh, vect1, vect2 )
+    returns the dot product of two vectors
+    if qh.RANDOMdist, joggles result
+
+  notes:
+    the angle may be > 1.0 or < -1.0 because of roundoff errors
+
+*/
+realT qh_getangle(qhT *qh, pointT *vect1, pointT *vect2) {
+  realT angle= 0, randr;
+  int k;
+
+  for (k=qh->hull_dim; k--; )
+    angle += *vect1++ * *vect2++;
+  if (qh->RANDOMdist) {
+    randr= qh_RANDOMint;
+    angle += (2.0 * randr / qh_RANDOMmax - 1.0) *
+      qh->RANDOMfactor;
+  }
+  trace4((qh, qh->ferr, 4006, "qh_getangle: %4.4g\n", angle));
+  return(angle);
+} /* getangle */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="getcenter">-</a>
+
+  qh_getcenter(qh, vertices )
+    returns arithmetic center of a set of vertices as a new point
+
+  notes:
+    allocates point array for center
+*/
+pointT *qh_getcenter(qhT *qh, setT *vertices) {
+  int k;
+  pointT *center, *coord;
+  vertexT *vertex, **vertexp;
+  int count= qh_setsize(qh, vertices);
+
+  if (count < 2) {
+    qh_fprintf(qh, qh->ferr, 6003, "qhull internal error (qh_getcenter): not defined for %d points\n", count);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  center= (pointT *)qh_memalloc(qh, qh->normal_size);
+  for (k=0; k < qh->hull_dim; k++) {
+    coord= center+k;
+    *coord= 0.0;
+    FOREACHvertex_(vertices)
+      *coord += vertex->point[k];
+    *coord /= count;  /* count>=2 by QH6003 */
+  }
+  return(center);
+} /* getcenter */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="getcentrum">-</a>
+
+  qh_getcentrum(qh, facet )
+    returns the centrum for a facet as a new point
+
+  notes:
+    allocates the centrum
+*/
+pointT *qh_getcentrum(qhT *qh, facetT *facet) {
+  realT dist;
+  pointT *centrum, *point;
+
+  point= qh_getcenter(qh, facet->vertices);
+  zzinc_(Zcentrumtests);
+  qh_distplane(qh, point, facet, &dist);
+  centrum= qh_projectpoint(qh, point, facet, dist);
+  qh_memfree(qh, point, qh->normal_size);
+  trace4((qh, qh->ferr, 4007, "qh_getcentrum: for f%d, %d vertices dist= %2.2g\n",
+          facet->id, qh_setsize(qh, facet->vertices), dist));
+  return centrum;
+} /* getcentrum */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="getdistance">-</a>
+
+  qh_getdistance(qh, facet, neighbor, mindist, maxdist )
+    returns the min and max distance to neighbor of non-neighbor vertices in facet
+
+  returns:
+    the max absolute value
+
+  design:
+    for each vertex of facet that is not in neighbor
+      test the distance from vertex to neighbor
+*/
+coordT qh_getdistance(qhT *qh, facetT *facet, facetT *neighbor, coordT *mindist, coordT *maxdist) {
+  vertexT *vertex, **vertexp;
+  coordT dist, maxd, mind;
+
+  FOREACHvertex_(facet->vertices)
+    vertex->seen= False;
+  FOREACHvertex_(neighbor->vertices)
+    vertex->seen= True;
+  mind= 0.0;
+  maxd= 0.0;
+  FOREACHvertex_(facet->vertices) {
+    if (!vertex->seen) {
+      zzinc_(Zbestdist);
+      qh_distplane(qh, vertex->point, neighbor, &dist);
+      if (dist < mind)
+        mind= dist;
+      else if (dist > maxd)
+        maxd= dist;
+    }
+  }
+  *mindist= mind;
+  *maxdist= maxd;
+  mind= -mind;
+  if (maxd > mind)
+    return maxd;
+  else
+    return mind;
+} /* getdistance */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="normalize">-</a>
+
+  qh_normalize(qh, normal, dim, toporient )
+    normalize a vector and report if too small
+    does not use min norm
+
+  see:
+    qh_normalize2
+*/
+void qh_normalize(qhT *qh, coordT *normal, int dim, boolT toporient) {
+  qh_normalize2(qh, normal, dim, toporient, NULL, NULL);
+} /* normalize */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="normalize2">-</a>
+
+  qh_normalize2(qh, normal, dim, toporient, minnorm, ismin )
+    normalize a vector and report if too small
+    qh.MINdenom/MINdenom1 are the upper limits for divide overflow
+
+  returns:
+    normalized vector
+    flips sign if !toporient
+    if minnorm non-NULL,
+      sets ismin if normal < minnorm
+
+  notes:
+    if zero norm
+       sets all elements to sqrt(1.0/dim)
+    if divide by zero (divzero())
+       sets largest element to   +/-1
+       bumps Znearlysingular
+
+  design:
+    computes norm
+    test for minnorm
+    if not near zero
+      normalizes normal
+    else if zero norm
+      sets normal to standard value
+    else
+      uses qh_divzero to normalize
+      if nearzero
+        sets norm to direction of maximum value
+*/
+void qh_normalize2(qhT *qh, coordT *normal, int dim, boolT toporient,
+            realT *minnorm, boolT *ismin) {
+  int k;
+  realT *colp, *maxp, norm= 0, temp, *norm1, *norm2, *norm3;
+  boolT zerodiv;
+
+  norm1= normal+1;
+  norm2= normal+2;
+  norm3= normal+3;
+  if (dim == 2)
+    norm= sqrt((*normal)*(*normal) + (*norm1)*(*norm1));
+  else if (dim == 3)
+    norm= sqrt((*normal)*(*normal) + (*norm1)*(*norm1) + (*norm2)*(*norm2));
+  else if (dim == 4) {
+    norm= sqrt((*normal)*(*normal) + (*norm1)*(*norm1) + (*norm2)*(*norm2)
+               + (*norm3)*(*norm3));
+  }else if (dim > 4) {
+    norm= (*normal)*(*normal) + (*norm1)*(*norm1) + (*norm2)*(*norm2)
+               + (*norm3)*(*norm3);
+    for (k=dim-4, colp=normal+4; k--; colp++)
+      norm += (*colp) * (*colp);
+    norm= sqrt(norm);
+  }
+  if (minnorm) {
+    if (norm < *minnorm)
+      *ismin= True;
+    else
+      *ismin= False;
+  }
+  wmin_(Wmindenom, norm);
+  if (norm > qh->MINdenom) {
+    if (!toporient)
+      norm= -norm;
+    *normal /= norm;
+    *norm1 /= norm;
+    if (dim == 2)
+      ; /* all done */
+    else if (dim == 3)
+      *norm2 /= norm;
+    else if (dim == 4) {
+      *norm2 /= norm;
+      *norm3 /= norm;
+    }else if (dim >4) {
+      *norm2 /= norm;
+      *norm3 /= norm;
+      for (k=dim-4, colp=normal+4; k--; )
+        *colp++ /= norm;
+    }
+  }else if (norm == 0.0) {
+    temp= sqrt(1.0/dim);
+    for (k=dim, colp=normal; k--; )
+      *colp++= temp;
+  }else {
+    if (!toporient)
+      norm= -norm;
+    for (k=dim, colp=normal; k--; colp++) { /* k used below */
+      temp= qh_divzero(*colp, norm, qh->MINdenom_1, &zerodiv);
+      if (!zerodiv)
+        *colp= temp;
+      else {
+        maxp= qh_maxabsval(normal, dim);
+        temp= ((*maxp * norm >= 0.0) ? 1.0 : -1.0);
+        for (k=dim, colp=normal; k--; colp++)
+          *colp= 0.0;
+        *maxp= temp;
+        zzinc_(Znearlysingular);
+        /* qh_joggle_restart ignored for Znearlysingular, normal part of qh_sethyperplane_gauss */
+        trace0((qh, qh->ferr, 1, "qh_normalize: norm=%2.2g too small during p%d\n",
+               norm, qh->furthest_id));
+        return;
+      }
+    }
+  }
+} /* normalize */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="projectpoint">-</a>
+
+  qh_projectpoint(qh, point, facet, dist )
+    project point onto a facet by dist
+
+  returns:
+    returns a new point
+
+  notes:
+    if dist= distplane(point,facet)
+      this projects point to hyperplane
+    assumes qh_memfree_() is valid for normal_size
+*/
+pointT *qh_projectpoint(qhT *qh, pointT *point, facetT *facet, realT dist) {
+  pointT *newpoint, *np, *normal;
+  int normsize= qh->normal_size;
+  int k;
+  void **freelistp; /* used if !qh_NOmem by qh_memalloc_() */
+
+  qh_memalloc_(qh, normsize, freelistp, newpoint, pointT);
+  np= newpoint;
+  normal= facet->normal;
+  for (k=qh->hull_dim; k--; )
+    *(np++)= *point++ - dist * *normal++;
+  return(newpoint);
+} /* projectpoint */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="setfacetplane">-</a>
+
+  qh_setfacetplane(qh, facet )
+    sets the hyperplane for a facet
+    if qh.RANDOMdist, joggles hyperplane
+
+  notes:
+    uses global buffers qh.gm_matrix and qh.gm_row
+    overwrites facet->normal if already defined
+    updates Wnewvertex if PRINTstatistics
+    sets facet->upperdelaunay if upper envelope of Delaunay triangulation
+
+  design:
+    copy vertex coordinates to qh.gm_matrix/gm_row
+    compute determinate
+    if nearzero
+      recompute determinate with gaussian elimination
+      if nearzero
+        force outside orientation by testing interior point
+*/
+void qh_setfacetplane(qhT *qh, facetT *facet) {
+  pointT *point;
+  vertexT *vertex, **vertexp;
+  int normsize= qh->normal_size;
+  int k,i, oldtrace= 0;
+  realT dist;
+  void **freelistp; /* used if !qh_NOmem by qh_memalloc_() */
+  coordT *coord, *gmcoord;
+  pointT *point0= SETfirstt_(facet->vertices, vertexT)->point;
+  boolT nearzero= False;
+
+  zzinc_(Zsetplane);
+  if (!facet->normal)
+    qh_memalloc_(qh, normsize, freelistp, facet->normal, coordT);
+#ifndef qh_NOtrace
+  if (facet == qh->tracefacet) {
+    oldtrace= qh->IStracing;
+    qh->IStracing= 5;
+    qh_fprintf(qh, qh->ferr, 8012, "qh_setfacetplane: facet f%d created.\n", facet->id);
+    qh_fprintf(qh, qh->ferr, 8013, "  Last point added to hull was p%d.", qh->furthest_id);
+    if (zzval_(Ztotmerge))
+      qh_fprintf(qh, qh->ferr, 8014, "  Last merge was #%d.", zzval_(Ztotmerge));
+    qh_fprintf(qh, qh->ferr, 8015, "\n\nCurrent summary is:\n");
+      qh_printsummary(qh, qh->ferr);
+  }
+#endif
+  if (qh->hull_dim <= 4) {
+    i= 0;
+    if (qh->RANDOMdist) {
+      gmcoord= qh->gm_matrix;
+      FOREACHvertex_(facet->vertices) {
+        qh->gm_row[i++]= gmcoord;
+        coord= vertex->point;
+        for (k=qh->hull_dim; k--; )
+          *(gmcoord++)= *coord++ * qh_randomfactor(qh, qh->RANDOMa, qh->RANDOMb);
+      }
+    }else {
+      FOREACHvertex_(facet->vertices)
+       qh->gm_row[i++]= vertex->point;
+    }
+    qh_sethyperplane_det(qh, qh->hull_dim, qh->gm_row, point0, facet->toporient,
+                facet->normal, &facet->offset, &nearzero);
+  }
+  if (qh->hull_dim > 4 || nearzero) {
+    i= 0;
+    gmcoord= qh->gm_matrix;
+    FOREACHvertex_(facet->vertices) {
+      if (vertex->point != point0) {
+        qh->gm_row[i++]= gmcoord;
+        coord= vertex->point;
+        point= point0;
+        for (k=qh->hull_dim; k--; )
+          *(gmcoord++)= *coord++ - *point++;
+      }
+    }
+    qh->gm_row[i]= gmcoord;  /* for areasimplex */
+    if (qh->RANDOMdist) {
+      gmcoord= qh->gm_matrix;
+      for (i=qh->hull_dim-1; i--; ) {
+        for (k=qh->hull_dim; k--; )
+          *(gmcoord++) *= qh_randomfactor(qh, qh->RANDOMa, qh->RANDOMb);
+      }
+    }
+    qh_sethyperplane_gauss(qh, qh->hull_dim, qh->gm_row, point0, facet->toporient,
+                facet->normal, &facet->offset, &nearzero);
+    if (nearzero) {
+      if (qh_orientoutside(qh, facet)) {
+        trace0((qh, qh->ferr, 2, "qh_setfacetplane: flipped orientation due to nearzero gauss and interior_point test.  During p%d\n", qh->furthest_id));
+      /* this is part of using Gaussian Elimination.  For example in 5-d
+           1 1 1 1 0
+           1 1 1 1 1
+           0 0 0 1 0
+           0 1 0 0 0
+           1 0 0 0 0
+           norm= 0.38 0.38 -0.76 0.38 0
+         has a determinate of 1, but g.e. after subtracting pt. 0 has
+         0's in the diagonal, even with full pivoting.  It does work
+         if you subtract pt. 4 instead. */
+      }
+    }
+  }
+  facet->upperdelaunay= False;
+  if (qh->DELAUNAY) {
+    if (qh->UPPERdelaunay) {     /* matches qh_triangulate_facet and qh.lower_threshold in qh_initbuild */
+      if (facet->normal[qh->hull_dim -1] >= qh->ANGLEround * qh_ZEROdelaunay)
+        facet->upperdelaunay= True;
+    }else {
+      if (facet->normal[qh->hull_dim -1] > -qh->ANGLEround * qh_ZEROdelaunay)
+        facet->upperdelaunay= True;
+    }
+  }
+  if (qh->PRINTstatistics || qh->IStracing || qh->TRACElevel || qh->JOGGLEmax < REALmax) {
+    qh->old_randomdist= qh->RANDOMdist;
+    qh->RANDOMdist= False;
+    FOREACHvertex_(facet->vertices) {
+      if (vertex->point != point0) {
+        boolT istrace= False;
+        zinc_(Zdiststat);
+        qh_distplane(qh, vertex->point, facet, &dist);
+        dist= fabs_(dist);
+        zinc_(Znewvertex);
+        wadd_(Wnewvertex, dist);
+        if (dist > wwval_(Wnewvertexmax)) {
+          wwval_(Wnewvertexmax)= dist;
+          if (dist > qh->max_outside) {
+            qh->max_outside= dist;  /* used by qh_maxouter(qh) */
+            if (dist > qh->TRACEdist)
+              istrace= True;
+          }
+        }else if (-dist > qh->TRACEdist)
+          istrace= True;
+        if (istrace) {
+          qh_fprintf(qh, qh->ferr, 3060, "qh_setfacetplane: ====== vertex p%d(v%d) increases max_outside to %2.2g for new facet f%d last p%d\n",
+                qh_pointid(qh, vertex->point), vertex->id, dist, facet->id, qh->furthest_id);
+          qh_errprint(qh, "DISTANT", facet, NULL, NULL, NULL);
+        }
+      }
+    }
+    qh->RANDOMdist= qh->old_randomdist;
+  }
+#ifndef qh_NOtrace
+  if (qh->IStracing >= 4) {
+    qh_fprintf(qh, qh->ferr, 8017, "qh_setfacetplane: f%d offset %2.2g normal: ",
+             facet->id, facet->offset);
+    for (k=0; k < qh->hull_dim; k++)
+      qh_fprintf(qh, qh->ferr, 8018, "%2.2g ", facet->normal[k]);
+    qh_fprintf(qh, qh->ferr, 8019, "\n");
+  }
+#endif
+  qh_checkflipped(qh, facet, NULL, qh_ALL);
+  if (facet == qh->tracefacet) {
+    qh->IStracing= oldtrace;
+    qh_printfacet(qh, qh->ferr, facet);
+  }
+} /* setfacetplane */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="sethyperplane_det">-</a>
+
+  qh_sethyperplane_det(qh, dim, rows, point0, toporient, normal, offset, nearzero )
+    given dim X dim array indexed by rows[], one row per point,
+        toporient(flips all signs),
+        and point0 (any row)
+    set normalized hyperplane equation from oriented simplex
+
+  returns:
+    normal (normalized)
+    offset (places point0 on the hyperplane)
+    sets nearzero if hyperplane not through points
+
+  notes:
+    only defined for dim == 2..4
+    rows[] is not modified
+    solves det(P-V_0, V_n-V_0, ..., V_1-V_0)=0, i.e. every point is on hyperplane
+    see Bower & Woodworth, A programmer's geometry, Butterworths 1983.
+
+  derivation of 3-d minnorm
+    Goal: all vertices V_i within qh.one_merge of hyperplane
+    Plan: exactly translate the facet so that V_0 is the origin
+          exactly rotate the facet so that V_1 is on the x-axis and y_2=0.
+          exactly rotate the effective perturbation to only effect n_0
+             this introduces a factor of sqrt(3)
+    n_0 = ((y_2-y_0)*(z_1-z_0) - (z_2-z_0)*(y_1-y_0)) / norm
+    Let M_d be the max coordinate difference
+    Let M_a be the greater of M_d and the max abs. coordinate
+    Let u be machine roundoff and distround be max error for distance computation
+    The max error for n_0 is sqrt(3) u M_a M_d / norm.  n_1 is approx. 1 and n_2 is approx. 0
+    The max error for distance of V_1 is sqrt(3) u M_a M_d M_d / norm.  Offset=0 at origin
+    Then minnorm = 1.8 u M_a M_d M_d / qh.ONEmerge
+    Note that qh.one_merge is approx. 45.5 u M_a and norm is usually about M_d M_d
+
+  derivation of 4-d minnorm
+    same as above except rotate the facet so that V_1 on x-axis and w_2, y_3, w_3=0
+     [if two vertices fixed on x-axis, can rotate the other two in yzw.]
+    n_0 = det3_(...) = y_2 det2_(z_1, w_1, z_3, w_3) = - y_2 w_1 z_3
+     [all other terms contain at least two factors nearly zero.]
+    The max error for n_0 is sqrt(4) u M_a M_d M_d / norm
+    Then minnorm = 2 u M_a M_d M_d M_d / qh.ONEmerge
+    Note that qh.one_merge is approx. 82 u M_a and norm is usually about M_d M_d M_d
+*/
+void qh_sethyperplane_det(qhT *qh, int dim, coordT **rows, coordT *point0,
+          boolT toporient, coordT *normal, realT *offset, boolT *nearzero) {
+  realT maxround, dist;
+  int i;
+  pointT *point;
+
+
+  if (dim == 2) {
+    normal[0]= dY(1,0);
+    normal[1]= dX(0,1);
+    qh_normalize2(qh, normal, dim, toporient, NULL, NULL);
+    *offset= -(point0[0]*normal[0]+point0[1]*normal[1]);
+    *nearzero= False;  /* since nearzero norm => incident points */
+  }else if (dim == 3) {
+    normal[0]= det2_(dY(2,0), dZ(2,0),
+                     dY(1,0), dZ(1,0));
+    normal[1]= det2_(dX(1,0), dZ(1,0),
+                     dX(2,0), dZ(2,0));
+    normal[2]= det2_(dX(2,0), dY(2,0),
+                     dX(1,0), dY(1,0));
+    qh_normalize2(qh, normal, dim, toporient, NULL, NULL);
+    *offset= -(point0[0]*normal[0] + point0[1]*normal[1]
+               + point0[2]*normal[2]);
+    maxround= qh->DISTround;
+    for (i=dim; i--; ) {
+      point= rows[i];
+      if (point != point0) {
+        dist= *offset + (point[0]*normal[0] + point[1]*normal[1]
+               + point[2]*normal[2]);
+        if (dist > maxround || dist < -maxround) {
+          *nearzero= True;
+          break;
+        }
+      }
+    }
+  }else if (dim == 4) {
+    normal[0]= - det3_(dY(2,0), dZ(2,0), dW(2,0),
+                        dY(1,0), dZ(1,0), dW(1,0),
+                        dY(3,0), dZ(3,0), dW(3,0));
+    normal[1]=   det3_(dX(2,0), dZ(2,0), dW(2,0),
+                        dX(1,0), dZ(1,0), dW(1,0),
+                        dX(3,0), dZ(3,0), dW(3,0));
+    normal[2]= - det3_(dX(2,0), dY(2,0), dW(2,0),
+                        dX(1,0), dY(1,0), dW(1,0),
+                        dX(3,0), dY(3,0), dW(3,0));
+    normal[3]=   det3_(dX(2,0), dY(2,0), dZ(2,0),
+                        dX(1,0), dY(1,0), dZ(1,0),
+                        dX(3,0), dY(3,0), dZ(3,0));
+    qh_normalize2(qh, normal, dim, toporient, NULL, NULL);
+    *offset= -(point0[0]*normal[0] + point0[1]*normal[1]
+               + point0[2]*normal[2] + point0[3]*normal[3]);
+    maxround= qh->DISTround;
+    for (i=dim; i--; ) {
+      point= rows[i];
+      if (point != point0) {
+        dist= *offset + (point[0]*normal[0] + point[1]*normal[1]
+               + point[2]*normal[2] + point[3]*normal[3]);
+        if (dist > maxround || dist < -maxround) {
+          *nearzero= True;
+          break;
+        }
+      }
+    }
+  }
+  if (*nearzero) {
+    zzinc_(Zminnorm);
+    /* qh_joggle_restart not needed, will call qh_sethyperplane_gauss instead */
+    trace0((qh, qh->ferr, 3, "qh_sethyperplane_det: degenerate norm during p%d, use qh_sethyperplane_gauss instead.\n", qh->furthest_id));
+  }
+} /* sethyperplane_det */
+
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="sethyperplane_gauss">-</a>
+
+  qh_sethyperplane_gauss(qh, dim, rows, point0, toporient, normal, offset, nearzero )
+    given(dim-1) X dim array of rows[i]= V_{i+1} - V_0 (point0)
+    set normalized hyperplane equation from oriented simplex
+
+  returns:
+    normal (normalized)
+    offset (places point0 on the hyperplane)
+
+  notes:
+    if nearzero
+      orientation may be incorrect because of incorrect sign flips in gausselim
+    solves [V_n-V_0,...,V_1-V_0, 0 .. 0 1] * N == [0 .. 0 1]
+        or [V_n-V_0,...,V_1-V_0, 0 .. 0 1] * N == [0]
+    i.e., N is normal to the hyperplane, and the unnormalized
+        distance to [0 .. 1] is either 1 or   0
+
+  design:
+    perform gaussian elimination
+    flip sign for negative values
+    perform back substitution
+    normalize result
+    compute offset
+*/
+void qh_sethyperplane_gauss(qhT *qh, int dim, coordT **rows, pointT *point0,
+                boolT toporient, coordT *normal, coordT *offset, boolT *nearzero) {
+  coordT *pointcoord, *normalcoef;
+  int k;
+  boolT sign= toporient, nearzero2= False;
+
+  qh_gausselim(qh, rows, dim-1, dim, &sign, nearzero);
+  for (k=dim-1; k--; ) {
+    if ((rows[k])[k] < 0)
+      sign ^= 1;
+  }
+  if (*nearzero) {
+    zzinc_(Znearlysingular);
+    /* qh_joggle_restart ignored for Znearlysingular, normal part of qh_sethyperplane_gauss */
+    trace0((qh, qh->ferr, 4, "qh_sethyperplane_gauss: nearly singular or axis parallel hyperplane during p%d.\n", qh->furthest_id));
+    qh_backnormal(qh, rows, dim-1, dim, sign, normal, &nearzero2);
+  }else {
+    qh_backnormal(qh, rows, dim-1, dim, sign, normal, &nearzero2);
+    if (nearzero2) {
+      zzinc_(Znearlysingular);
+      trace0((qh, qh->ferr, 5, "qh_sethyperplane_gauss: singular or axis parallel hyperplane at normalization during p%d.\n", qh->furthest_id));
+    }
+  }
+  if (nearzero2)
+    *nearzero= True;
+  qh_normalize2(qh, normal, dim, True, NULL, NULL);
+  pointcoord= point0;
+  normalcoef= normal;
+  *offset= -(*pointcoord++ * *normalcoef++);
+  for (k=dim-1; k--; )
+    *offset -= *pointcoord++ * *normalcoef++;
+} /* sethyperplane_gauss */
+
+
+
diff --git a/contrib/libs/qhull/libqhull_r/geom_r.h b/contrib/libs/qhull/libqhull_r/geom_r.h
new file mode 100644
index 0000000000..f3f8ee8140
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/geom_r.h
@@ -0,0 +1,189 @@
+/*<html><pre>  -<a                             href="qh-geom_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+  geom_r.h
+    header file for geometric routines
+
+   see qh-geom_r.htm and geom_r.c
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/geom_r.h#2 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#ifndef qhDEFgeom
+#define qhDEFgeom 1
+
+#include "libqhull_r.h"
+
+/* ============ -macros- ======================== */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="fabs_">-</a>
+
+  fabs_(a)
+    returns the absolute value of a
+*/
+#define fabs_( a ) ((( a ) < 0 ) ? -( a ):( a ))
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="fmax_">-</a>
+
+  fmax_(a,b)
+    returns the maximum value of a and b
+*/
+#define fmax_( a,b )  ( ( a ) < ( b ) ? ( b ) : ( a ) )
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="fmin_">-</a>
+
+  fmin_(a,b)
+    returns the minimum value of a and b
+*/
+#define fmin_( a,b )  ( ( a ) > ( b ) ? ( b ) : ( a ) )
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="maximize_">-</a>
+
+  maximize_(maxval, val)
+    set maxval to val if val is greater than maxval
+*/
+#define maximize_( maxval, val ) { if (( maxval ) < ( val )) ( maxval )= ( val ); }
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="minimize_">-</a>
+
+  minimize_(minval, val)
+    set minval to val if val is less than minval
+*/
+#define minimize_( minval, val ) { if (( minval ) > ( val )) ( minval )= ( val ); }
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="det2_">-</a>
+
+  det2_(a1, a2,
+        b1, b2)
+
+    compute a 2-d determinate
+*/
+#define det2_( a1,a2,b1,b2 ) (( a1 )*( b2 ) - ( a2 )*( b1 ))
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="det3_">-</a>
+
+  det3_(a1, a2, a3,
+       b1, b2, b3,
+       c1, c2, c3)
+
+    compute a 3-d determinate
+*/
+#define det3_( a1,a2,a3,b1,b2,b3,c1,c2,c3 ) ( ( a1 )*det2_( b2,b3,c2,c3 ) \
+                - ( b1 )*det2_( a2,a3,c2,c3 ) + ( c1 )*det2_( a2,a3,b2,b3 ) )
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="dX">-</a>
+
+  dX( p1, p2 )
+  dY( p1, p2 )
+  dZ( p1, p2 )
+
+    given two indices into rows[],
+
+    compute the difference between X, Y, or Z coordinates
+*/
+#define dX( p1,p2 )  ( *( rows[p1] ) - *( rows[p2] ))
+#define dY( p1,p2 )  ( *( rows[p1]+1 ) - *( rows[p2]+1 ))
+#define dZ( p1,p2 )  ( *( rows[p1]+2 ) - *( rows[p2]+2 ))
+#define dW( p1,p2 )  ( *( rows[p1]+3 ) - *( rows[p2]+3 ))
+
+/*============= prototypes in alphabetical order, infrequent at end ======= */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void    qh_backnormal(qhT *qh, realT **rows, int numrow, int numcol, boolT sign, coordT *normal, boolT *nearzero);
+void    qh_distplane(qhT *qh, pointT *point, facetT *facet, realT *dist);
+facetT *qh_findbest(qhT *qh, pointT *point, facetT *startfacet,
+                     boolT bestoutside, boolT isnewfacets, boolT noupper,
+                     realT *dist, boolT *isoutside, int *numpart);
+facetT *qh_findbesthorizon(qhT *qh, boolT ischeckmax, pointT *point,
+                     facetT *startfacet, boolT noupper, realT *bestdist, int *numpart);
+facetT *qh_findbestnew(qhT *qh, pointT *point, facetT *startfacet, realT *dist,
+                     boolT bestoutside, boolT *isoutside, int *numpart);
+void    qh_gausselim(qhT *qh, realT **rows, int numrow, int numcol, boolT *sign, boolT *nearzero);
+realT   qh_getangle(qhT *qh, pointT *vect1, pointT *vect2);
+pointT *qh_getcenter(qhT *qh, setT *vertices);
+pointT *qh_getcentrum(qhT *qh, facetT *facet);
+coordT  qh_getdistance(qhT *qh, facetT *facet, facetT *neighbor, coordT *mindist, coordT *maxdist);
+void    qh_normalize(qhT *qh, coordT *normal, int dim, boolT toporient);
+void    qh_normalize2(qhT *qh, coordT *normal, int dim, boolT toporient,
+            realT *minnorm, boolT *ismin);
+pointT *qh_projectpoint(qhT *qh, pointT *point, facetT *facet, realT dist);
+
+void    qh_setfacetplane(qhT *qh, facetT *newfacets);
+void    qh_sethyperplane_det(qhT *qh, int dim, coordT **rows, coordT *point0,
+              boolT toporient, coordT *normal, realT *offset, boolT *nearzero);
+void    qh_sethyperplane_gauss(qhT *qh, int dim, coordT **rows, pointT *point0,
+             boolT toporient, coordT *normal, coordT *offset, boolT *nearzero);
+boolT   qh_sharpnewfacets(qhT *qh);
+
+/*========= infrequently used code in geom2_r.c =============*/
+
+coordT *qh_copypoints(qhT *qh, coordT *points, int numpoints, int dimension);
+void    qh_crossproduct(int dim, realT vecA[3], realT vecB[3], realT vecC[3]);
+realT   qh_determinant(qhT *qh, realT **rows, int dim, boolT *nearzero);
+realT   qh_detjoggle(qhT *qh, pointT *points, int numpoints, int dimension);
+void    qh_detmaxoutside(qhT *qh);
+void    qh_detroundoff(qhT *qh);
+realT   qh_detsimplex(qhT *qh, pointT *apex, setT *points, int dim, boolT *nearzero);
+realT   qh_distnorm(int dim, pointT *point, pointT *normal, realT *offsetp);
+realT   qh_distround(qhT *qh, int dimension, realT maxabs, realT maxsumabs);
+realT   qh_divzero(realT numer, realT denom, realT mindenom1, boolT *zerodiv);
+realT   qh_facetarea(qhT *qh, facetT *facet);
+realT   qh_facetarea_simplex(qhT *qh, int dim, coordT *apex, setT *vertices,
+          vertexT *notvertex,  boolT toporient, coordT *normal, realT *offset);
+pointT *qh_facetcenter(qhT *qh, setT *vertices);
+facetT *qh_findgooddist(qhT *qh, pointT *point, facetT *facetA, realT *distp, facetT **facetlist);
+vertexT *qh_furthestnewvertex(qhT *qh, unsigned int unvisited, facetT *facet, realT *maxdistp /* qh.newvertex_list */);
+vertexT *qh_furthestvertex(qhT *qh, facetT *facetA, facetT *facetB, realT *maxdistp, realT *mindistp);
+void    qh_getarea(qhT *qh, facetT *facetlist);
+boolT   qh_gram_schmidt(qhT *qh, int dim, realT **rows);
+boolT   qh_inthresholds(qhT *qh, coordT *normal, realT *angle);
+void    qh_joggleinput(qhT *qh);
+realT  *qh_maxabsval(realT *normal, int dim);
+setT   *qh_maxmin(qhT *qh, pointT *points, int numpoints, int dimension);
+realT   qh_maxouter(qhT *qh);
+void    qh_maxsimplex(qhT *qh, int dim, setT *maxpoints, pointT *points, int numpoints, setT **simplex);
+realT   qh_minabsval(realT *normal, int dim);
+int     qh_mindiff(realT *vecA, realT *vecB, int dim);
+boolT   qh_orientoutside(qhT *qh, facetT *facet);
+void    qh_outerinner(qhT *qh, facetT *facet, realT *outerplane, realT *innerplane);
+coordT  qh_pointdist(pointT *point1, pointT *point2, int dim);
+void    qh_printmatrix(qhT *qh, FILE *fp, const char *string, realT **rows, int numrow, int numcol);
+void    qh_printpoints(qhT *qh, FILE *fp, const char *string, setT *points);
+void    qh_projectinput(qhT *qh);
+void    qh_projectpoints(qhT *qh, signed char *project, int n, realT *points,
+             int numpoints, int dim, realT *newpoints, int newdim);
+void    qh_rotateinput(qhT *qh, realT **rows);
+void    qh_rotatepoints(qhT *qh, realT *points, int numpoints, int dim, realT **rows);
+void    qh_scaleinput(qhT *qh);
+void    qh_scalelast(qhT *qh, coordT *points, int numpoints, int dim, coordT low,
+                   coordT high, coordT newhigh);
+void    qh_scalepoints(qhT *qh, pointT *points, int numpoints, int dim,
+                realT *newlows, realT *newhighs);
+boolT   qh_sethalfspace(qhT *qh, int dim, coordT *coords, coordT **nextp,
+              coordT *normal, coordT *offset, coordT *feasible);
+coordT *qh_sethalfspace_all(qhT *qh, int dim, int count, coordT *halfspaces, pointT *feasible);
+coordT  qh_vertex_bestdist(qhT *qh, setT *vertices);
+coordT  qh_vertex_bestdist2(qhT *qh, setT *vertices, vertexT **vertexp, vertexT **vertexp2);
+pointT *qh_voronoi_center(qhT *qh, int dim, setT *points);
+
+#ifdef __cplusplus
+} /* extern "C"*/
+#endif
+
+#endif /* qhDEFgeom */
+
+
+
diff --git a/contrib/libs/qhull/libqhull_r/global_r.c b/contrib/libs/qhull/libqhull_r/global_r.c
new file mode 100644
index 0000000000..04b9b4d74e
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/global_r.c
@@ -0,0 +1,2268 @@
+
+/*<html><pre>  -<a                             href="qh-globa_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   global_r.c
+   initializes all the globals of the qhull application
+
+   see README
+
+   see libqhull_r.h for qh.globals and function prototypes
+
+   see qhull_ra.h for internal functions
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/global_r.c#19 $$Change: 3037 $
+   $DateTime: 2020/09/03 17:28:32 $$Author: bbarber $
+ */
+
+#include "qhull_ra.h"
+
+/*========= qh->definition -- globals defined in libqhull_r.h =======================*/
+
+/*-<a                             href  ="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="version">-</a>
+
+  qh_version
+    version string by year and date
+    qh_version2 for Unix users and -V
+
+    the revision increases on code changes only
+
+  notes:
+    change date:    Changes.txt, Announce.txt, index.htm, README.txt,
+                    qhull-news.html, Eudora signatures, CMakeLists.txt
+    change version: README.txt, qh-get.htm, File_id.diz, Makefile.txt, CMakeLists.txt
+    check that CMakeLists.txt @version is the same as qh_version2
+    change year:    Copying.txt
+    check download size
+    recompile user_eg_r.c, rbox_r.c, libqhull_r.c, qconvex_r.c, qdelaun_r.c qvoronoi_r.c, qhalf_r.c, testqset_r.c
+*/
+
+const char qh_version[]= "2020.2.r 2020/08/31";
+const char qh_version2[]= "qhull_r 8.0.2 (2020.2.r 2020/08/31)";
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="appendprint">-</a>
+
+  qh_appendprint(qh, printFormat )
+    append printFormat to qh.PRINTout unless already defined
+*/
+void qh_appendprint(qhT *qh, qh_PRINT format) {
+  int i;
+
+  for (i=0; i < qh_PRINTEND; i++) {
+    if (qh->PRINTout[i] == format && format != qh_PRINTqhull)
+      break;
+    if (!qh->PRINTout[i]) {
+      qh->PRINTout[i]= format;
+      break;
+    }
+  }
+} /* appendprint */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="checkflags">-</a>
+
+  qh_checkflags(qh, commandStr, hiddenFlags )
+    errors if commandStr contains hiddenFlags
+    hiddenFlags starts and ends with a space and is space delimited (checked)
+
+  notes:
+    ignores first word (e.g., "qconvex i")
+    use qh_strtol/strtod since strtol/strtod may or may not skip trailing spaces
+
+  see:
+    qh_initflags() initializes Qhull according to commandStr
+*/
+void qh_checkflags(qhT *qh, char *command, char *hiddenflags) {
+  char *s= command, *t, *chkerr; /* qh_skipfilename is non-const */
+  char key, opt, prevopt;
+  char chkkey[]=  "   ";    /* check one character options ('s') */
+  char chkopt[]=  "    ";   /* check two character options ('Ta') */
+  char chkopt2[]= "     ";  /* check three character options ('Q12') */
+  boolT waserr= False;
+
+  if (*hiddenflags != ' ' || hiddenflags[strlen(hiddenflags)-1] != ' ') {
+    qh_fprintf(qh, qh->ferr, 6026, "qhull internal error (qh_checkflags): hiddenflags must start and end with a space: \"%s\"\n", hiddenflags);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (strpbrk(hiddenflags, ",\n\r\t")) {
+    qh_fprintf(qh, qh->ferr, 6027, "qhull internal error (qh_checkflags): hiddenflags contains commas, newlines, or tabs: \"%s\"\n", hiddenflags);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  while (*s && !isspace(*s))  /* skip program name */
+    s++;
+  while (*s) {
+    while (*s && isspace(*s))
+      s++;
+    if (*s == '-')
+      s++;
+    if (!*s)
+      break;
+    key= *s++;
+    chkerr= NULL;
+    if (key == 'T' && (*s == 'I' || *s == 'O')) {  /* TI or TO 'file name' */
+      s= qh_skipfilename(qh, ++s);
+      continue;
+    }
+    chkkey[1]= key;
+    if (strstr(hiddenflags, chkkey)) {
+      chkerr= chkkey;
+    }else if (isupper(key)) {
+      opt= ' ';
+      prevopt= ' ';
+      chkopt[1]= key;
+      chkopt2[1]= key;
+      while (!chkerr && *s && !isspace(*s)) {
+        opt= *s++;
+        if (isalpha(opt)) {
+          chkopt[2]= opt;
+          if (strstr(hiddenflags, chkopt))
+            chkerr= chkopt;
+          if (prevopt != ' ') {
+            chkopt2[2]= prevopt;
+            chkopt2[3]= opt;
+            if (strstr(hiddenflags, chkopt2))
+              chkerr= chkopt2;
+          }
+        }else if (key == 'Q' && isdigit(opt) && prevopt != 'b'
+              && (prevopt == ' ' || islower(prevopt))) {
+            if (isdigit(*s)) {  /* Q12 */
+              chkopt2[2]= opt;
+              chkopt2[3]= *s++;
+              if (strstr(hiddenflags, chkopt2))
+                chkerr= chkopt2;
+            }else {
+              chkopt[2]= opt;
+              if (strstr(hiddenflags, chkopt))
+                chkerr= chkopt;
+            }
+        }else {
+          qh_strtod(s-1, &t);
+          if (s < t)
+            s= t;
+        }
+        prevopt= opt;
+      }
+    }
+    if (chkerr) {
+      *chkerr= '\'';
+      chkerr[strlen(chkerr)-1]=  '\'';
+      qh_fprintf(qh, qh->ferr, 6029, "qhull option error: option %s is not used with this program.\n             It may be used with qhull.\n", chkerr);
+      waserr= True;
+    }
+  }
+  if (waserr)
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+} /* checkflags */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="clear_outputflags">-</a>
+
+  qh_clear_outputflags(qh)
+    Clear output flags for QhullPoints
+*/
+void qh_clear_outputflags(qhT *qh) {
+  int i,k;
+
+  qh->ANNOTATEoutput= False;
+  qh->DOintersections= False;
+  qh->DROPdim= -1;
+  qh->FORCEoutput= False;
+  qh->GETarea= False;
+  qh->GOODpoint= 0;
+  qh->GOODpointp= NULL;
+  qh->GOODthreshold= False;
+  qh->GOODvertex= 0;
+  qh->GOODvertexp= NULL;
+  qh->IStracing= 0;
+  qh->KEEParea= False;
+  qh->KEEPmerge= False;
+  qh->KEEPminArea= REALmax;
+  qh->PRINTcentrums= False;
+  qh->PRINTcoplanar= False;
+  qh->PRINTdots= False;
+  qh->PRINTgood= False;
+  qh->PRINTinner= False;
+  qh->PRINTneighbors= False;
+  qh->PRINTnoplanes= False;
+  qh->PRINToptions1st= False;
+  qh->PRINTouter= False;
+  qh->PRINTprecision= True;
+  qh->PRINTridges= False;
+  qh->PRINTspheres= False;
+  qh->PRINTstatistics= False;
+  qh->PRINTsummary= False;
+  qh->PRINTtransparent= False;
+  qh->SPLITthresholds= False;
+  qh->TRACElevel= 0;
+  qh->TRInormals= False;
+  qh->USEstdout= False;
+  qh->VERIFYoutput= False;
+  for (k=qh->input_dim+1; k--; ) {  /* duplicated in qh_initqhull_buffers and qh_clear_outputflags */
+    qh->lower_threshold[k]= -REALmax;
+    qh->upper_threshold[k]= REALmax;
+    qh->lower_bound[k]= -REALmax;
+    qh->upper_bound[k]= REALmax;
+  }
+
+  for (i=0; i < qh_PRINTEND; i++) {
+    qh->PRINTout[i]= qh_PRINTnone;
+  }
+
+  if (!qh->qhull_commandsiz2)
+      qh->qhull_commandsiz2= (int)strlen(qh->qhull_command); /* WARN64 */
+  else {
+      qh->qhull_command[qh->qhull_commandsiz2]= '\0';
+  }
+  if (!qh->qhull_optionsiz2)
+    qh->qhull_optionsiz2= (int)strlen(qh->qhull_options);  /* WARN64 */
+  else {
+    qh->qhull_options[qh->qhull_optionsiz2]= '\0';
+    qh->qhull_optionlen= qh_OPTIONline;  /* start a new line */
+  }
+} /* clear_outputflags */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="clock">-</a>
+
+  qh_clock()
+    return user CPU time in 100ths (qh_SECtick)
+    only defined for qh_CLOCKtype == 2
+
+  notes:
+    use first value to determine time 0
+    from Stevens '92 8.15
+*/
+unsigned long qh_clock(qhT *qh) {
+
+#if (qh_CLOCKtype == 2)
+  struct tms time;
+  static long clktck;  /* initialized first call and never updated */
+  double ratio, cpu;
+  unsigned long ticks;
+
+  if (!clktck) {
+    if ((clktck= sysconf(_SC_CLK_TCK)) < 0) {
+      qh_fprintf(qh, qh->ferr, 6030, "qhull internal error (qh_clock): sysconf() failed.  Use qh_CLOCKtype 1 in user_r.h\n");
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+  }
+  if (times(&time) == -1) {
+    qh_fprintf(qh, qh->ferr, 6031, "qhull internal error (qh_clock): times() failed.  Use qh_CLOCKtype 1 in user_r.h\n");
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  ratio= qh_SECticks / (double)clktck;
+  ticks= time.tms_utime * ratio;
+  return ticks;
+#else
+  qh_fprintf(qh, qh->ferr, 6032, "qhull internal error (qh_clock): use qh_CLOCKtype 2 in user_r.h\n");
+  qh_errexit(qh, qh_ERRqhull, NULL, NULL); /* never returns */
+  return 0;
+#endif
+} /* clock */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="freebuffers">-</a>
+
+  qh_freebuffers()
+    free up global memory buffers
+
+  notes:
+    must match qh_initbuffers()
+*/
+void qh_freebuffers(qhT *qh) {
+
+  trace5((qh, qh->ferr, 5001, "qh_freebuffers: freeing up global memory buffers\n"));
+  /* allocated by qh_initqhull_buffers */
+  qh_setfree(qh, &qh->other_points);
+  qh_setfree(qh, &qh->del_vertices);
+  qh_setfree(qh, &qh->coplanarfacetset);
+  qh_memfree(qh, qh->NEARzero, qh->hull_dim * (int)sizeof(realT));
+  qh_memfree(qh, qh->lower_threshold, (qh->input_dim+1) * (int)sizeof(realT));
+  qh_memfree(qh, qh->upper_threshold, (qh->input_dim+1) * (int)sizeof(realT));
+  qh_memfree(qh, qh->lower_bound, (qh->input_dim+1) * (int)sizeof(realT));
+  qh_memfree(qh, qh->upper_bound, (qh->input_dim+1) * (int)sizeof(realT));
+  qh_memfree(qh, qh->gm_matrix, (qh->hull_dim+1) * qh->hull_dim * (int)sizeof(coordT));
+  qh_memfree(qh, qh->gm_row, (qh->hull_dim+1) * (int)sizeof(coordT *));
+  qh->NEARzero= qh->lower_threshold= qh->upper_threshold= NULL;
+  qh->lower_bound= qh->upper_bound= NULL;
+  qh->gm_matrix= NULL;
+  qh->gm_row= NULL;
+
+  if (qh->line)                /* allocated by qh_readinput, freed if no error */
+    qh_free(qh->line);
+  if (qh->half_space)
+    qh_free(qh->half_space);
+  if (qh->temp_malloc)
+    qh_free(qh->temp_malloc);
+  if (qh->feasible_point)      /* allocated by qh_readfeasible */
+    qh_free(qh->feasible_point);
+  if (qh->feasible_string)     /* allocated by qh_initflags */
+    qh_free(qh->feasible_string);
+  qh->line= qh->feasible_string= NULL;
+  qh->half_space= qh->feasible_point= qh->temp_malloc= NULL;
+  /* usually allocated by qh_readinput */
+  if (qh->first_point && qh->POINTSmalloc) {
+    qh_free(qh->first_point);
+    qh->first_point= NULL;
+  }
+  if (qh->input_points && qh->input_malloc) { /* set by qh_joggleinput */
+    qh_free(qh->input_points);
+    qh->input_points= NULL;
+  }
+  trace5((qh, qh->ferr, 5002, "qh_freebuffers: finished\n"));
+} /* freebuffers */
+
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="freebuild">-</a>
+
+  qh_freebuild(qh, allmem )
+    free global memory used by qh_initbuild and qh_buildhull
+    if !allmem,
+      does not free short memory (e.g., facetT, freed by qh_memfreeshort)
+
+  design:
+    free centrums
+    free each vertex
+    for each facet
+      free ridges
+      free outside set, coplanar set, neighbor set, ridge set, vertex set
+      free facet
+    free hash table
+    free interior point
+    free merge sets
+    free temporary sets
+*/
+void qh_freebuild(qhT *qh, boolT allmem) {
+  facetT *facet, *previousfacet= NULL;
+  vertexT *vertex, *previousvertex= NULL;
+  ridgeT *ridge, **ridgep, *previousridge= NULL;
+  mergeT *merge, **mergep;
+  int newsize;
+  boolT freeall;
+
+  /* free qhT global sets first, includes references from qh_buildhull */
+  trace5((qh, qh->ferr, 5004, "qh_freebuild: free global sets\n"));
+  FOREACHmerge_(qh->facet_mergeset)  /* usually empty */
+    qh_memfree(qh, merge, (int)sizeof(mergeT));
+  FOREACHmerge_(qh->degen_mergeset)  /* usually empty */
+    qh_memfree(qh, merge, (int)sizeof(mergeT));
+  FOREACHmerge_(qh->vertex_mergeset)  /* usually empty */
+    qh_memfree(qh, merge, (int)sizeof(mergeT));
+  qh->facet_mergeset= NULL;  /* temp set freed by qh_settempfree_all */
+  qh->degen_mergeset= NULL;  /* temp set freed by qh_settempfree_all */
+  qh->vertex_mergeset= NULL;  /* temp set freed by qh_settempfree_all */
+  qh_setfree(qh, &(qh->hash_table));
+  trace5((qh, qh->ferr, 5003, "qh_freebuild: free temporary sets (qh_settempfree_all)\n"));
+  qh_settempfree_all(qh);
+  trace1((qh, qh->ferr, 1005, "qh_freebuild: free memory from qh_inithull and qh_buildhull\n"));
+  if (qh->del_vertices)
+    qh_settruncate(qh, qh->del_vertices, 0);
+  if (allmem) {
+    while ((vertex= qh->vertex_list)) {
+      if (vertex->next)
+        qh_delvertex(qh, vertex);
+      else {
+        qh_memfree(qh, vertex, (int)sizeof(vertexT)); /* sentinel */
+        qh->newvertex_list= qh->vertex_list= NULL;
+        break;
+      }
+      previousvertex= vertex; /* in case of memory fault */
+      QHULL_UNUSED(previousvertex)
+    }
+  }else if (qh->VERTEXneighbors) {
+    FORALLvertices
+      qh_setfreelong(qh, &(vertex->neighbors));
+  }
+  qh->VERTEXneighbors= False;
+  qh->GOODclosest= NULL;
+  if (allmem) {
+    FORALLfacets {
+      FOREACHridge_(facet->ridges)
+        ridge->seen= False;
+    }
+    while ((facet= qh->facet_list)) {
+      if (!facet->newfacet || !qh->NEWtentative || qh_setsize(qh, facet->ridges) > 1) { /* skip tentative horizon ridges */
+        trace4((qh, qh->ferr, 4095, "qh_freebuild: delete the previously-seen ridges of f%d\n", facet->id));
+        FOREACHridge_(facet->ridges) {
+          if (ridge->seen)
+            qh_delridge(qh, ridge);
+          else
+            ridge->seen= True;
+          previousridge= ridge; /* in case of memory fault */
+          QHULL_UNUSED(previousridge)
+        }
+      }
+      qh_setfree(qh, &(facet->outsideset));
+      qh_setfree(qh, &(facet->coplanarset));
+      qh_setfree(qh, &(facet->neighbors));
+      qh_setfree(qh, &(facet->ridges));
+      qh_setfree(qh, &(facet->vertices));
+      if (facet->next)
+        qh_delfacet(qh, facet);
+      else {
+        qh_memfree(qh, facet, (int)sizeof(facetT));
+        qh->visible_list= qh->newfacet_list= qh->facet_list= NULL;
+      }
+      previousfacet= facet; /* in case of memory fault */
+      QHULL_UNUSED(previousfacet)
+    }
+  }else {
+    freeall= True;
+    if (qh_setlarger_quick(qh, qh->hull_dim + 1, &newsize))
+      freeall= False;
+    FORALLfacets {
+      qh_setfreelong(qh, &(facet->outsideset));
+      qh_setfreelong(qh, &(facet->coplanarset));
+      if (!facet->simplicial || freeall) {
+        qh_setfreelong(qh, &(facet->neighbors));
+        qh_setfreelong(qh, &(facet->ridges));
+        qh_setfreelong(qh, &(facet->vertices));
+      }
+    }
+  }
+  /* qh internal constants */
+  qh_memfree(qh, qh->interior_point, qh->normal_size);
+  qh->interior_point= NULL;
+} /* freebuild */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="freeqhull">-</a>
+
+  qh_freeqhull(qh, allmem )
+
+  free global memory and set qhT to 0
+  if !allmem,
+    does not free short memory (freed by qh_memfreeshort unless qh_NOmem)
+
+notes:
+  sets qh.NOerrexit in case caller forgets to
+  Does not throw errors
+
+see:
+  see qh_initqhull_start2()
+  For libqhull_r, qhstatT is part of qhT
+
+design:
+  free global and temporary memory from qh_initbuild and qh_buildhull
+  free buffers
+*/
+void qh_freeqhull(qhT *qh, boolT allmem) {
+
+  qh->NOerrexit= True;  /* no more setjmp since called at exit and ~QhullQh */
+  trace1((qh, qh->ferr, 1006, "qh_freeqhull: free global memory\n"));
+  qh_freebuild(qh, allmem);
+  qh_freebuffers(qh);
+  trace1((qh, qh->ferr, 1061, "qh_freeqhull: clear qhT except for qh.qhmem and qh.qhstat\n"));
+  /* memset is the same in qh_freeqhull() and qh_initqhull_start2() */
+  memset((char *)qh, 0, sizeof(qhT)-sizeof(qhmemT)-sizeof(qhstatT));
+  qh->NOerrexit= True;
+} /* freeqhull */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="init_A">-</a>
+
+  qh_init_A(qh, infile, outfile, errfile, argc, argv )
+    initialize memory and stdio files
+    convert input options to option string (qh.qhull_command)
+
+  notes:
+    infile may be NULL if qh_readpoints() is not called
+
+    errfile should always be defined.  It is used for reporting
+    errors.  outfile is used for output and format options.
+
+    argc/argv may be 0/NULL
+
+    called before error handling initialized
+    qh_errexit() may not be used
+*/
+void qh_init_A(qhT *qh, FILE *infile, FILE *outfile, FILE *errfile, int argc, char *argv[]) {
+  qh_meminit(qh, errfile);
+  qh_initqhull_start(qh, infile, outfile, errfile);
+  qh_init_qhull_command(qh, argc, argv);
+} /* init_A */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="init_B">-</a>
+
+  qh_init_B(qh, points, numpoints, dim, ismalloc )
+    initialize globals for points array
+
+    points has numpoints dim-dimensional points
+      points[0] is the first coordinate of the first point
+      points[1] is the second coordinate of the first point
+      points[dim] is the first coordinate of the second point
+
+    ismalloc=True
+      Qhull will call qh_free(points) on exit or input transformation
+    ismalloc=False
+      Qhull will allocate a new point array if needed for input transformation
+
+    qh.qhull_command
+      is the option string.
+      It is defined by qh_init_B(), qh_qhull_command(), or qh_initflags
+
+  returns:
+    if qh.PROJECTinput or (qh.DELAUNAY and qh.PROJECTdelaunay)
+      projects the input to a new point array
+
+        if qh.DELAUNAY,
+          qh.hull_dim is increased by one
+        if qh.ATinfinity,
+          qh_projectinput adds point-at-infinity for Delaunay tri.
+
+    if qh.SCALEinput
+      changes the upper and lower bounds of the input, see qh_scaleinput
+
+    if qh.ROTATEinput
+      rotates the input by a random rotation, see qh_rotateinput
+      if qh.DELAUNAY
+        rotates about the last coordinate
+
+  notes:
+    called after points are defined
+    qh_errexit() may be used
+*/
+void qh_init_B(qhT *qh, coordT *points, int numpoints, int dim, boolT ismalloc) {
+  qh_initqhull_globals(qh, points, numpoints, dim, ismalloc);
+  if (qh->qhmem.LASTsize == 0)
+    qh_initqhull_mem(qh);
+  /* mem_r.c and qset_r.c are initialized */
+  qh_initqhull_buffers(qh);
+  qh_initthresholds(qh, qh->qhull_command);
+  if (qh->PROJECTinput || (qh->DELAUNAY && qh->PROJECTdelaunay))
+    qh_projectinput(qh);
+  if (qh->SCALEinput)
+    qh_scaleinput(qh);
+  if (qh->ROTATErandom >= 0) {
+    qh_randommatrix(qh, qh->gm_matrix, qh->hull_dim, qh->gm_row);
+    if (qh->DELAUNAY) {
+      int k, lastk= qh->hull_dim-1;
+      for (k=0; k < lastk; k++) {
+        qh->gm_row[k][lastk]= 0.0;
+        qh->gm_row[lastk][k]= 0.0;
+      }
+      qh->gm_row[lastk][lastk]= 1.0;
+    }
+    qh_gram_schmidt(qh, qh->hull_dim, qh->gm_row);
+    qh_rotateinput(qh, qh->gm_row);
+  }
+} /* init_B */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="init_qhull_command">-</a>
+
+  qh_init_qhull_command(qh, argc, argv )
+    build qh.qhull_command from argc/argv
+    Calls qh_exit if qhull_command is too short
+
+  returns:
+    a space-delimited string of options (just as typed)
+
+  notes:
+    makes option string easy to input and output
+
+    argc/argv may be 0/NULL
+*/
+void qh_init_qhull_command(qhT *qh, int argc, char *argv[]) {
+
+  if (!qh_argv_to_command(argc, argv, qh->qhull_command, (int)sizeof(qh->qhull_command))){
+    /* Assumes qh.ferr is defined. */
+    qh_fprintf(qh, qh->ferr, 6033, "qhull input error: more than %d characters in command line.\n",
+          (int)sizeof(qh->qhull_command));
+    qh_exit(qh_ERRinput);  /* error reported, can not use qh_errexit */
+  }
+} /* init_qhull_command */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="initflags">-</a>
+
+  qh_initflags(qh, commandStr )
+    set flags and initialized constants from commandStr
+    calls qh_exit() if qh.NOerrexit
+
+  returns:
+    sets qh.qhull_command to command if needed
+
+  notes:
+    ignores first word (e.g., 'qhull' in "qhull d")
+    use qh_strtol/strtod since strtol/strtod may or may not skip trailing spaces
+
+  see:
+    qh_initthresholds() continues processing of 'Pdn' and 'PDn'
+    'prompt' in unix_r.c for documentation
+
+  design:
+    for each space-delimited option group
+      if top-level option
+        check syntax
+        append appropriate option to option string
+        set appropriate global variable or append printFormat to print options
+      else
+        for each sub-option
+          check syntax
+          append appropriate option to option string
+          set appropriate global variable or append printFormat to print options
+*/
+void qh_initflags(qhT *qh, char *command) {
+  int k, i, lastproject;
+  char *s= command, *t, *prev_s, *start, key, *lastwarning= NULL;
+  boolT isgeom= False, wasproject;
+  realT r;
+
+  if(qh->NOerrexit){
+    qh_fprintf(qh, qh->ferr, 6245, "qhull internal error (qh_initflags): qh.NOerrexit was not cleared before calling qh_initflags().  It should be cleared after setjmp().  Exit qhull.\n");
+    qh_exit(qh_ERRqhull);
+  }
+#ifdef qh_RANDOMdist
+  qh->RANDOMfactor= qh_RANDOMdist;
+  qh_option(qh, "Random-qh_RANDOMdist", NULL, &qh->RANDOMfactor);
+  qh->RANDOMdist= True;
+#endif
+  if (command <= &qh->qhull_command[0] || command > &qh->qhull_command[0] + sizeof(qh->qhull_command)) {
+    if (command != &qh->qhull_command[0]) {
+      *qh->qhull_command= '\0';
+      strncat(qh->qhull_command, command, sizeof(qh->qhull_command)-strlen(qh->qhull_command)-1);
+    }
+    while (*s && !isspace(*s))  /* skip program name */
+      s++;
+  }
+  while (*s) {
+    while (*s && isspace(*s))
+      s++;
+    if (*s == '-')
+      s++;
+    if (!*s)
+      break;
+    prev_s= s;
+    switch (*s++) {
+    case 'd':
+      qh_option(qh, "delaunay", NULL, NULL);
+      qh->DELAUNAY= True;
+      break;
+    case 'f':
+      qh_option(qh, "facets", NULL, NULL);
+      qh_appendprint(qh, qh_PRINTfacets);
+      break;
+    case 'i':
+      qh_option(qh, "incidence", NULL, NULL);
+      qh_appendprint(qh, qh_PRINTincidences);
+      break;
+    case 'm':
+      qh_option(qh, "mathematica", NULL, NULL);
+      qh_appendprint(qh, qh_PRINTmathematica);
+      break;
+    case 'n':
+      qh_option(qh, "normals", NULL, NULL);
+      qh_appendprint(qh, qh_PRINTnormals);
+      break;
+    case 'o':
+      qh_option(qh, "offFile", NULL, NULL);
+      qh_appendprint(qh, qh_PRINToff);
+      break;
+    case 'p':
+      qh_option(qh, "points", NULL, NULL);
+      qh_appendprint(qh, qh_PRINTpoints);
+      break;
+    case 's':
+      qh_option(qh, "summary", NULL, NULL);
+      qh->PRINTsummary= True;
+      break;
+    case 'v':
+      qh_option(qh, "voronoi", NULL, NULL);
+      qh->VORONOI= True;
+      qh->DELAUNAY= True;
+      break;
+    case 'A':
+      if (!isdigit(*s) && *s != '.' && *s != '-') {
+        qh_fprintf(qh, qh->ferr, 7002, "qhull input warning: no maximum cosine angle given for option 'An'.  A1.0 is coplanar\n");
+        lastwarning= s-1;
+      }else {
+        if (*s == '-') {
+          qh->premerge_cos= -qh_strtod(s, &s);
+          qh_option(qh, "Angle-premerge-", NULL, &qh->premerge_cos);
+          qh->PREmerge= True;
+        }else {
+          qh->postmerge_cos= qh_strtod(s, &s);
+          qh_option(qh, "Angle-postmerge", NULL, &qh->postmerge_cos);
+          qh->POSTmerge= True;
+        }
+        qh->MERGING= True;
+      }
+      break;
+    case 'C':
+      if (!isdigit(*s) && *s != '.' && *s != '-') {
+        qh_fprintf(qh, qh->ferr, 7003, "qhull input warning: no centrum radius given for option 'Cn'\n");
+        lastwarning= s-1;
+      }else {
+        if (*s == '-') {
+          qh->premerge_centrum= -qh_strtod(s, &s);
+          qh_option(qh, "Centrum-premerge-", NULL, &qh->premerge_centrum);
+          qh->PREmerge= True;
+        }else {
+          qh->postmerge_centrum= qh_strtod(s, &s);
+          qh_option(qh, "Centrum-postmerge", NULL, &qh->postmerge_centrum);
+          qh->POSTmerge= True;
+        }
+        qh->MERGING= True;
+      }
+      break;
+    case 'E':
+      if (*s == '-') {
+        qh_fprintf(qh, qh->ferr, 6363, "qhull option error: expecting a positive number for maximum roundoff 'En'.  Got '%s'\n", s-1);
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+      }else if (!isdigit(*s)) {
+        qh_fprintf(qh, qh->ferr, 7005, "qhull option warning: no maximum roundoff given for option 'En'\n");
+        lastwarning= s-1;
+      }else {
+        qh->DISTround= qh_strtod(s, &s);
+        qh_option(qh, "Distance-roundoff", NULL, &qh->DISTround);
+        qh->SETroundoff= True;
+      }
+      break;
+    case 'H':
+      start= s;
+      qh->HALFspace= True;
+      qh_strtod(s, &t);
+      while (t > s)  {
+        if (*t && !isspace(*t)) {
+          if (*t == ',')
+            t++;
+          else {
+            qh_fprintf(qh, qh->ferr, 6364, "qhull option error: expecting 'Hn,n,n,...' for feasible point of halfspace intersection. Got '%s'\n", start-1);
+            qh_errexit(qh, qh_ERRinput, NULL, NULL);
+          }
+        }
+        s= t;
+        qh_strtod(s, &t);
+      }
+      if (start < t) {
+        if (!(qh->feasible_string= (char *)calloc((size_t)(t-start+1), (size_t)1))) {
+          qh_fprintf(qh, qh->ferr, 6034, "qhull error: insufficient memory for 'Hn,n,n'\n");
+          qh_errexit(qh, qh_ERRmem, NULL, NULL);
+        }
+        strncpy(qh->feasible_string, start, (size_t)(t-start));
+        qh_option(qh, "Halfspace-about", NULL, NULL);
+        qh_option(qh, qh->feasible_string, NULL, NULL);
+      }else
+        qh_option(qh, "Halfspace", NULL, NULL);
+      break;
+    case 'R':
+      if (!isdigit(*s)) {
+        qh_fprintf(qh, qh->ferr, 7007, "qhull option warning: missing random perturbation for option 'Rn'\n");
+        lastwarning= s-1;
+      }else {
+        qh->RANDOMfactor= qh_strtod(s, &s);
+        qh_option(qh, "Random-perturb", NULL, &qh->RANDOMfactor);
+        qh->RANDOMdist= True;
+      }
+      break;
+    case 'V':
+      if (!isdigit(*s) && *s != '-') {
+        qh_fprintf(qh, qh->ferr, 7008, "qhull option warning: missing visible distance for option 'Vn'\n");
+        lastwarning= s-1;
+      }else {
+        qh->MINvisible= qh_strtod(s, &s);
+        qh_option(qh, "Visible", NULL, &qh->MINvisible);
+      }
+      break;
+    case 'U':
+      if (!isdigit(*s) && *s != '-') {
+        qh_fprintf(qh, qh->ferr, 7009, "qhull option warning: missing coplanar distance for option 'Un'\n");
+        lastwarning= s-1;
+      }else {
+        qh->MAXcoplanar= qh_strtod(s, &s);
+        qh_option(qh, "U-coplanar", NULL, &qh->MAXcoplanar);
+      }
+      break;
+    case 'W':
+      if (*s == '-') {
+        qh_fprintf(qh, qh->ferr, 6365, "qhull option error: expecting a positive number for outside width 'Wn'.  Got '%s'\n", s-1);
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+      }else if (!isdigit(*s)) {
+        qh_fprintf(qh, qh->ferr, 7011, "qhull option warning: missing outside width for option 'Wn'\n");
+        lastwarning= s-1;
+      }else {
+        qh->MINoutside= qh_strtod(s, &s);
+        qh_option(qh, "W-outside", NULL, &qh->MINoutside);
+        qh->APPROXhull= True;
+      }
+      break;
+    /************  sub menus ***************/
+    case 'F':
+      while (*s && !isspace(*s)) {
+        switch (*s++) {
+        case 'a':
+          qh_option(qh, "Farea", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTarea);
+          qh->GETarea= True;
+          break;
+        case 'A':
+          qh_option(qh, "FArea-total", NULL, NULL);
+          qh->GETarea= True;
+          break;
+        case 'c':
+          qh_option(qh, "Fcoplanars", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTcoplanars);
+          break;
+        case 'C':
+          qh_option(qh, "FCentrums", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTcentrums);
+          break;
+        case 'd':
+          qh_option(qh, "Fd-cdd-in", NULL, NULL);
+          qh->CDDinput= True;
+          break;
+        case 'D':
+          qh_option(qh, "FD-cdd-out", NULL, NULL);
+          qh->CDDoutput= True;
+          break;
+        case 'F':
+          qh_option(qh, "FFacets-xridge", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTfacets_xridge);
+          break;
+        case 'i':
+          qh_option(qh, "Finner", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTinner);
+          break;
+        case 'I':
+          qh_option(qh, "FIDs", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTids);
+          break;
+        case 'm':
+          qh_option(qh, "Fmerges", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTmerges);
+          break;
+        case 'M':
+          qh_option(qh, "FMaple", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTmaple);
+          break;
+        case 'n':
+          qh_option(qh, "Fneighbors", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTneighbors);
+          break;
+        case 'N':
+          qh_option(qh, "FNeighbors-vertex", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTvneighbors);
+          break;
+        case 'o':
+          qh_option(qh, "Fouter", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTouter);
+          break;
+        case 'O':
+          if (qh->PRINToptions1st) {
+            qh_option(qh, "FOptions", NULL, NULL);
+            qh_appendprint(qh, qh_PRINToptions);
+          }else
+            qh->PRINToptions1st= True;
+          break;
+        case 'p':
+          qh_option(qh, "Fpoint-intersect", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTpointintersect);
+          break;
+        case 'P':
+          qh_option(qh, "FPoint-nearest", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTpointnearest);
+          break;
+        case 'Q':
+          qh_option(qh, "FQhull", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTqhull);
+          break;
+        case 's':
+          qh_option(qh, "Fsummary", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTsummary);
+          break;
+        case 'S':
+          qh_option(qh, "FSize", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTsize);
+          qh->GETarea= True;
+          break;
+        case 't':
+          qh_option(qh, "Ftriangles", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTtriangles);
+          break;
+        case 'v':
+          /* option set in qh_initqhull_globals */
+          qh_appendprint(qh, qh_PRINTvertices);
+          break;
+        case 'V':
+          qh_option(qh, "FVertex-average", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTaverage);
+          break;
+        case 'x':
+          qh_option(qh, "Fxtremes", NULL, NULL);
+          qh_appendprint(qh, qh_PRINTextremes);
+          break;
+        default:
+          s--;
+          qh_fprintf(qh, qh->ferr, 7012, "qhull option warning: unknown 'F' output option 'F%c', skip to next space\n", (int)s[0]);
+          lastwarning= s-1;
+          while (*++s && !isspace(*s));
+          break;
+        }
+      }
+      break;
+    case 'G':
+      isgeom= True;
+      qh_appendprint(qh, qh_PRINTgeom);
+      while (*s && !isspace(*s)) {
+        switch (*s++) {
+        case 'a':
+          qh_option(qh, "Gall-points", NULL, NULL);
+          qh->PRINTdots= True;
+          break;
+        case 'c':
+          qh_option(qh, "Gcentrums", NULL, NULL);
+          qh->PRINTcentrums= True;
+          break;
+        case 'h':
+          qh_option(qh, "Gintersections", NULL, NULL);
+          qh->DOintersections= True;
+          break;
+        case 'i':
+          qh_option(qh, "Ginner", NULL, NULL);
+          qh->PRINTinner= True;
+          break;
+        case 'n':
+          qh_option(qh, "Gno-planes", NULL, NULL);
+          qh->PRINTnoplanes= True;
+          break;
+        case 'o':
+          qh_option(qh, "Gouter", NULL, NULL);
+          qh->PRINTouter= True;
+          break;
+        case 'p':
+          qh_option(qh, "Gpoints", NULL, NULL);
+          qh->PRINTcoplanar= True;
+          break;
+        case 'r':
+          qh_option(qh, "Gridges", NULL, NULL);
+          qh->PRINTridges= True;
+          break;
+        case 't':
+          qh_option(qh, "Gtransparent", NULL, NULL);
+          qh->PRINTtransparent= True;
+          break;
+        case 'v':
+          qh_option(qh, "Gvertices", NULL, NULL);
+          qh->PRINTspheres= True;
+          break;
+        case 'D':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7004, "qhull option warning: missing dimension for option 'GDn'\n");
+            lastwarning= s-2;
+          }else {
+            if (qh->DROPdim >= 0) {
+              qh_fprintf(qh, qh->ferr, 7013, "qhull option warning: can only drop one dimension.  Previous 'GD%d' ignored\n",
+                   qh->DROPdim);
+              lastwarning= s-2;
+            }
+            qh->DROPdim= qh_strtol(s, &s);
+            qh_option(qh, "GDrop-dim", &qh->DROPdim, NULL);
+          }
+          break;
+        default:
+          s--;
+          qh_fprintf(qh, qh->ferr, 7014, "qhull option warning: unknown 'G' geomview option 'G%c', skip to next space\n", (int)s[0]);
+          lastwarning= s-1;
+          while (*++s && !isspace(*s));
+          break;
+        }
+      }
+      break;
+    case 'P':
+      while (*s && !isspace(*s)) {
+        switch (*s++) {
+        case 'd': case 'D':  /* see qh_initthresholds() */
+          key= s[-1];
+          i= qh_strtol(s, &s);
+          r= 0;
+          if (*s == ':') {
+            s++;
+            r= qh_strtod(s, &s);
+          }
+          if (key == 'd')
+            qh_option(qh, "Pdrop-facets-dim-less", &i, &r);
+          else
+            qh_option(qh, "PDrop-facets-dim-more", &i, &r);
+          break;
+        case 'g':
+          qh_option(qh, "Pgood-facets", NULL, NULL);
+          qh->PRINTgood= True;
+          break;
+        case 'G':
+          qh_option(qh, "PGood-facet-neighbors", NULL, NULL);
+          qh->PRINTneighbors= True;
+          break;
+        case 'o':
+          qh_option(qh, "Poutput-forced", NULL, NULL);
+          qh->FORCEoutput= True;
+          break;
+        case 'p':
+          qh_option(qh, "Pprecision-ignore", NULL, NULL);
+          qh->PRINTprecision= False;
+          break;
+        case 'A':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7006, "qhull option warning: missing facet count for keep area option 'PAn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->KEEParea= qh_strtol(s, &s);
+            qh_option(qh, "PArea-keep", &qh->KEEParea, NULL);
+            qh->GETarea= True;
+          }
+          break;
+        case 'F':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7010, "qhull option warning: missing facet area for option 'PFn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->KEEPminArea= qh_strtod(s, &s);
+            qh_option(qh, "PFacet-area-keep", NULL, &qh->KEEPminArea);
+            qh->GETarea= True;
+          }
+          break;
+        case 'M':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7090, "qhull option warning: missing merge count for option 'PMn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->KEEPmerge= qh_strtol(s, &s);
+            qh_option(qh, "PMerge-keep", &qh->KEEPmerge, NULL);
+          }
+          break;
+        default:
+          s--;
+          qh_fprintf(qh, qh->ferr, 7015, "qhull option warning: unknown 'P' print option 'P%c', skip to next space\n", (int)s[0]);
+          lastwarning= s-1;
+          while (*++s && !isspace(*s));
+          break;
+        }
+      }
+      break;
+    case 'Q':
+      lastproject= -1;
+      while (*s && !isspace(*s)) {
+        switch (*s++) {
+        case 'a':
+          qh_option(qh, "Qallow-short", NULL, NULL);
+          qh->ALLOWshort= True;
+          break;
+        case 'b': case 'B':  /* handled by qh_initthresholds */
+          key= s[-1];
+          if (key == 'b' && *s == 'B') {
+            s++;
+            r= qh_DEFAULTbox;
+            qh->SCALEinput= True;
+            qh_option(qh, "QbBound-unit-box", NULL, &r);
+            break;
+          }
+          if (key == 'b' && *s == 'b') {
+            s++;
+            qh->SCALElast= True;
+            qh_option(qh, "Qbbound-last", NULL, NULL);
+            break;
+          }
+          k= qh_strtol(s, &s);
+          r= 0.0;
+          wasproject= False;
+          if (*s == ':') {
+            s++;
+            if ((r= qh_strtod(s, &s)) == 0.0) {
+              t= s;            /* need true dimension for memory allocation */
+              while (*t && !isspace(*t)) {
+                if (toupper(*t++) == 'B'
+                 && k == qh_strtol(t, &t)
+                 && *t++ == ':'
+                 && qh_strtod(t, &t) == 0.0) {
+                  qh->PROJECTinput++;
+                  trace2((qh, qh->ferr, 2004, "qh_initflags: project dimension %d\n", k));
+                  qh_option(qh, "Qb-project-dim", &k, NULL);
+                  wasproject= True;
+                  lastproject= k;
+                  break;
+                }
+              }
+            }
+          }
+          if (!wasproject) {
+            if (lastproject == k && r == 0.0)
+              lastproject= -1;  /* doesn't catch all possible sequences */
+            else if (key == 'b') {
+              qh->SCALEinput= True;
+              if (r == 0.0)
+                r= -qh_DEFAULTbox;
+              qh_option(qh, "Qbound-dim-low", &k, &r);
+            }else {
+              qh->SCALEinput= True;
+              if (r == 0.0)
+                r= qh_DEFAULTbox;
+              qh_option(qh, "QBound-dim-high", &k, &r);
+            }
+          }
+          break;
+        case 'c':
+          qh_option(qh, "Qcoplanar-keep", NULL, NULL);
+          qh->KEEPcoplanar= True;
+          break;
+        case 'f':
+          qh_option(qh, "Qfurthest-outside", NULL, NULL);
+          qh->BESToutside= True;
+          break;
+        case 'g':
+          qh_option(qh, "Qgood-facets-only", NULL, NULL);
+          qh->ONLYgood= True;
+          break;
+        case 'i':
+          qh_option(qh, "Qinterior-keep", NULL, NULL);
+          qh->KEEPinside= True;
+          break;
+        case 'm':
+          qh_option(qh, "Qmax-outside-only", NULL, NULL);
+          qh->ONLYmax= True;
+          break;
+        case 'r':
+          qh_option(qh, "Qrandom-outside", NULL, NULL);
+          qh->RANDOMoutside= True;
+          break;
+        case 's':
+          qh_option(qh, "Qsearch-initial-simplex", NULL, NULL);
+          qh->ALLpoints= True;
+          break;
+        case 't':
+          qh_option(qh, "Qtriangulate", NULL, NULL);
+          qh->TRIangulate= True;
+          break;
+        case 'T':
+          qh_option(qh, "QTestPoints", NULL, NULL);
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7091, "qhull option warning: missing number of test points for option 'QTn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->TESTpoints= qh_strtol(s, &s);
+            qh_option(qh, "QTestPoints", &qh->TESTpoints, NULL);
+          }
+          break;
+        case 'u':
+          qh_option(qh, "QupperDelaunay", NULL, NULL);
+          qh->UPPERdelaunay= True;
+          break;
+        case 'v':
+          qh_option(qh, "Qvertex-neighbors-convex", NULL, NULL);
+          qh->TESTvneighbors= True;
+          break;
+        case 'x':
+          qh_option(qh, "Qxact-merge", NULL, NULL);
+          qh->MERGEexact= True;
+          break;
+        case 'z':
+          qh_option(qh, "Qz-infinity-point", NULL, NULL);
+          qh->ATinfinity= True;
+          break;
+        case '0':
+          qh_option(qh, "Q0-no-premerge", NULL, NULL);
+          qh->NOpremerge= True;
+          break;
+        case '1':
+          if (!isdigit(*s)) {
+            qh_option(qh, "Q1-angle-merge", NULL, NULL);
+            qh->ANGLEmerge= True;
+            break;
+          }
+          switch (*s++) {
+          case '0':
+            qh_option(qh, "Q10-no-narrow", NULL, NULL);
+            qh->NOnarrow= True;
+            break;
+          case '1':
+            qh_option(qh, "Q11-trinormals Qtriangulate", NULL, NULL);
+            qh->TRInormals= True;
+            qh->TRIangulate= True;
+            break;
+          case '2':
+            qh_option(qh, "Q12-allow-wide", NULL, NULL);
+            qh->ALLOWwide= True;
+            break;
+          case '4':
+#ifndef qh_NOmerge
+            qh_option(qh, "Q14-merge-pinched-vertices", NULL, NULL);
+            qh->MERGEpinched= True;
+#else
+            /* ignore 'Q14' for q_benchmark testing of difficult cases for Qhull */
+            qh_fprintf(qh, qh->ferr, 7099, "qhull option warning: option 'Q14-merge-pinched' disabled due to qh_NOmerge\n");
+#endif
+            break;
+          case '7':
+            qh_option(qh, "Q15-check-duplicates", NULL, NULL);
+            qh->CHECKduplicates= True;
+            break;
+          default:
+            s--;
+            qh_fprintf(qh, qh->ferr, 7016, "qhull option warning: unknown 'Q' qhull option 'Q1%c', skip to next space\n", (int)s[0]);
+            lastwarning= s-1;
+            while (*++s && !isspace(*s));
+            break;
+          }
+          break;
+        case '2':
+          qh_option(qh, "Q2-no-merge-independent", NULL, NULL);
+          qh->MERGEindependent= False;
+          goto LABELcheckdigit;
+          break; /* no gcc warnings */
+        case '3':
+          qh_option(qh, "Q3-no-merge-vertices", NULL, NULL);
+          qh->MERGEvertices= False;
+        LABELcheckdigit:
+          if (isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7017, "qhull option warning: can not follow '1', '2', or '3' with a digit.  'Q%c%c' skipped\n", *(s-1), *s);
+            lastwarning= s-2;
+            s++;
+          }
+          break;
+        case '4':
+          qh_option(qh, "Q4-avoid-old-into-new", NULL, NULL);
+          qh->AVOIDold= True;
+          break;
+        case '5':
+          qh_option(qh, "Q5-no-check-outer", NULL, NULL);
+          qh->SKIPcheckmax= True;
+          break;
+        case '6':
+          qh_option(qh, "Q6-no-concave-merge", NULL, NULL);
+          qh->SKIPconvex= True;
+          break;
+        case '7':
+          qh_option(qh, "Q7-no-breadth-first", NULL, NULL);
+          qh->VIRTUALmemory= True;
+          break;
+        case '8':
+          qh_option(qh, "Q8-no-near-inside", NULL, NULL);
+          qh->NOnearinside= True;
+          break;
+        case '9':
+          qh_option(qh, "Q9-pick-furthest", NULL, NULL);
+          qh->PICKfurthest= True;
+          break;
+        case 'G':
+          i= qh_strtol(s, &t);
+          if (qh->GOODpoint) {
+            qh_fprintf(qh, qh->ferr, 7018, "qhull option warning: good point already defined for option 'QGn'.  Ignored\n");
+            lastwarning= s-2;
+          }else if (s == t) {
+            qh_fprintf(qh, qh->ferr, 7019, "qhull option warning: missing good point id for option 'QGn'.  Ignored\n");
+            lastwarning= s-2;
+          }else if (i < 0 || *s == '-') {
+            qh->GOODpoint= i-1;
+            qh_option(qh, "QGood-if-dont-see-point", &i, NULL);
+          }else {
+            qh->GOODpoint= i+1;
+            qh_option(qh, "QGood-if-see-point", &i, NULL);
+          }
+          s= t;
+          break;
+        case 'J':
+          if (!isdigit(*s) && *s != '-')
+            qh->JOGGLEmax= 0.0;
+          else {
+            qh->JOGGLEmax= (realT) qh_strtod(s, &s);
+            qh_option(qh, "QJoggle", NULL, &qh->JOGGLEmax);
+          }
+          break;
+        case 'R':
+          if (!isdigit(*s) && *s != '-') {
+            qh_fprintf(qh, qh->ferr, 7020, "qhull option warning: missing random seed for option 'QRn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->ROTATErandom= i= qh_strtol(s, &s);
+            if (i > 0)
+              qh_option(qh, "QRotate-id", &i, NULL );
+            else if (i < -1)
+              qh_option(qh, "QRandom-seed", &i, NULL );
+          }
+          break;
+        case 'V':
+          i= qh_strtol(s, &t);
+          if (qh->GOODvertex) {
+            qh_fprintf(qh, qh->ferr, 7021, "qhull option warning: good vertex already defined for option 'QVn'.  Ignored\n");
+            lastwarning= s-2;
+          }else if (s == t) {
+            qh_fprintf(qh, qh->ferr, 7022, "qhull option warning: no good point id given for option 'QVn'.  Ignored\n");
+            lastwarning= s-2;
+          }else if (i < 0) {
+            qh->GOODvertex= i - 1;
+            qh_option(qh, "QV-good-facets-not-point", &i, NULL);
+          }else {
+            qh_option(qh, "QV-good-facets-point", &i, NULL);
+            qh->GOODvertex= i + 1;
+          }
+          s= t;
+          break;
+        case 'w':
+          qh_option(qh, "Qwarn-allow", NULL, NULL);
+          qh->ALLOWwarning= True;
+          break;
+        default:
+          s--;
+          qh_fprintf(qh, qh->ferr, 7023, "qhull option warning: unknown 'Q' qhull option 'Q%c', skip to next space\n", (int)s[0]);
+          lastwarning= s-1;
+          while (*++s && !isspace(*s));
+          break;
+        }
+      }
+      break;
+    case 'T':
+      while (*s && !isspace(*s)) {
+        if (isdigit(*s) || *s == '-')
+          qh->IStracing= qh_strtol(s, &s);
+        else switch (*s++) {
+        case 'a':
+          qh_option(qh, "Tannotate-output", NULL, NULL);
+          qh->ANNOTATEoutput= True;
+          break;
+        case 'c':
+          qh_option(qh, "Tcheck-frequently", NULL, NULL);
+          qh->CHECKfrequently= True;
+          break;
+        case 'f':
+          qh_option(qh, "Tflush", NULL, NULL);
+          qh->FLUSHprint= True;
+          break;
+        case 's':
+          qh_option(qh, "Tstatistics", NULL, NULL);
+          qh->PRINTstatistics= True;
+          break;
+        case 'v':
+          qh_option(qh, "Tverify", NULL, NULL);
+          qh->VERIFYoutput= True;
+          break;
+        case 'z':
+          if (qh->ferr == qh_FILEstderr) {
+            /* The C++ interface captures the output in qh_fprint_qhull() */
+            qh_option(qh, "Tz-stdout", NULL, NULL);
+            qh->USEstdout= True;
+          }else if (!qh->fout) {
+            qh_fprintf(qh, qh->ferr, 7024, "qhull option warning: output file undefined(stdout).  Option 'Tz' ignored.\n");
+            lastwarning= s-2;
+          }else {
+            qh_option(qh, "Tz-stdout", NULL, NULL);
+            qh->USEstdout= True;
+            qh->ferr= qh->fout;
+            qh->qhmem.ferr= qh->fout;
+          }
+          break;
+        case 'C':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7025, "qhull option warning: missing point id for cone for trace option 'TCn'\n");
+            lastwarning= s-2;
+          }else {
+            i= qh_strtol(s, &s);
+            qh_option(qh, "TCone-stop", &i, NULL);
+            qh->STOPcone= i + 1;
+          }
+          break;
+        case 'F':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7026, "qhull option warning: missing frequency count for trace option 'TFn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->REPORTfreq= qh_strtol(s, &s);
+            qh_option(qh, "TFacet-log", &qh->REPORTfreq, NULL);
+            qh->REPORTfreq2= qh->REPORTfreq/2;  /* for tracemerging() */
+          }
+          break;
+        case 'I':
+          while (isspace(*s))
+            s++;
+          t= qh_skipfilename(qh, s);
+          {
+            char filename[qh_FILENAMElen];
+
+            qh_copyfilename(qh, filename, (int)sizeof(filename), s, (int)(t-s));   /* WARN64 */
+            s= t;
+            if (!freopen(filename, "r", stdin)) {
+              qh_fprintf(qh, qh->ferr, 6041, "qhull option error: cannot open 'TI' file \"%s\"\n", filename);
+              qh_errexit(qh, qh_ERRinput, NULL, NULL);
+            }else {
+              qh_option(qh, "TInput-file", NULL, NULL);
+              qh_option(qh, filename, NULL, NULL);
+            }
+          }
+          break;
+        case 'O':
+          while (isspace(*s))
+            s++;
+          t= qh_skipfilename(qh, s);
+          {
+            char filename[qh_FILENAMElen];
+
+            qh_copyfilename(qh, filename, (int)sizeof(filename), s, (int)(t-s));  /* WARN64 */
+            if (!qh->fout) {
+              qh_fprintf(qh, qh->ferr, 7092, "qhull option warning: qh.fout was not set by caller of qh_initflags.  Cannot use option 'TO' to redirect output.  Ignoring option 'TO'\n");
+              lastwarning= s-2;
+            }else if (!freopen(filename, "w", qh->fout)) {
+              qh_fprintf(qh, qh->ferr, 6044, "qhull option error: cannot open file \"%s\" for writing as option 'TO'.  It is already in use or read-only\n", filename);
+              qh_errexit(qh, qh_ERRinput, NULL, NULL);
+            }else {
+              qh_option(qh, "TOutput-file", NULL, NULL);
+              qh_option(qh, filename, NULL, NULL);
+            }
+            s= t;
+          }
+          break;
+        case 'A':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7093, "qhull option warning: missing count of added points for trace option 'TAn'\n");
+            lastwarning= s-2;
+          }else {
+            i= qh_strtol(s, &t);
+            qh->STOPadd= i + 1;
+            qh_option(qh, "TA-stop-add", &i, NULL);
+          }
+          s= t;
+          break;
+        case 'P':
+          if (*s == '-') {
+            if (s[1] == '1' && !isdigit(s[2])) {
+              s += 2;
+              qh->TRACEpoint= qh_IDunknown; /* qh_buildhull done */
+              qh_option(qh, "Trace-point", &qh->TRACEpoint, NULL);
+            }else {
+              qh_fprintf(qh, qh->ferr, 7100, "qhull option warning: negative point id for trace option 'TPn'.  Expecting 'TP-1' for tracing after qh_buildhull and qh_postmerge\n");
+              lastwarning= s-2;
+              while (isdigit(*(++s)))
+                ; /* skip digits */
+            }
+          }else if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7029, "qhull option warning: missing point id or -1 for trace option 'TPn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->TRACEpoint= qh_strtol(s, &s);
+            qh_option(qh, "Trace-point", &qh->TRACEpoint, NULL);
+          }
+          break;
+        case 'M':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7030, "qhull option warning: missing merge id for trace option 'TMn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->TRACEmerge= qh_strtol(s, &s);
+            qh_option(qh, "Trace-merge", &qh->TRACEmerge, NULL);
+          }
+          break;
+        case 'R':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7031, "qhull option warning: missing rerun count for trace option 'TRn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->RERUN= qh_strtol(s, &s);
+            qh_option(qh, "TRerun", &qh->RERUN, NULL);
+          }
+          break;
+        case 'V':
+          i= qh_strtol(s, &t);
+          if (s == t) {
+            qh_fprintf(qh, qh->ferr, 7032, "qhull option warning: missing furthest point id for trace option 'TVn'\n");
+            lastwarning= s-2;
+          }else if (i < 0) {
+            qh->STOPpoint= i - 1;
+            qh_option(qh, "TV-stop-before-point", &i, NULL);
+          }else {
+            qh->STOPpoint= i + 1;
+            qh_option(qh, "TV-stop-after-point", &i, NULL);
+          }
+          s= t;
+          break;
+        case 'W':
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7033, "qhull option warning: missing max width for trace option 'TWn'\n");
+            lastwarning= s-2;
+          }else {
+            qh->TRACEdist= (realT) qh_strtod(s, &s);
+            qh_option(qh, "TWide-trace", NULL, &qh->TRACEdist);
+          }
+          break;
+        default:
+          s--;
+          qh_fprintf(qh, qh->ferr, 7034, "qhull option warning: unknown 'T' trace option 'T%c', skip to next space\n", (int)s[0]);
+          lastwarning= s-2;
+          while (*++s && !isspace(*s));
+          break;
+        }
+      }
+      break;
+    default:
+      qh_fprintf(qh, qh->ferr, 7094, "qhull option warning: unknown option '%c'(%x)\n",
+        (int)s[-1], (int)s[-1]);
+      lastwarning= s-2;
+      break;
+    }
+    if (s-1 == prev_s && *s && !isspace(*s)) {
+      qh_fprintf(qh, qh->ferr, 7036, "qhull option warning: missing space after option '%c'(%x), reserved for sub-options, ignoring '%c' options to next space\n",
+               (int)*prev_s, (int)*prev_s, (int)*prev_s);
+      lastwarning= s-1;
+      while (*s && !isspace(*s))
+        s++;
+    }
+  }
+  if (qh->STOPcone && qh->JOGGLEmax < REALmax/2) {
+    qh_fprintf(qh, qh->ferr, 7078, "qhull option warning: 'TCn' (stopCone) ignored when used with 'QJn' (joggle)\n");
+    lastwarning= command;
+  }
+  if (isgeom && !qh->FORCEoutput && qh->PRINTout[1]) {
+    qh_fprintf(qh, qh->ferr, 7037, "qhull option warning: additional output formats ('Fc',etc.) are not compatible with Geomview ('G').  Use option 'Po' to override\n");
+    lastwarning= command;
+  }
+  if (lastwarning && !qh->ALLOWwarning) {
+    qh_fprintf(qh, qh->ferr, 6035, "qhull option error: see previous warnings, use 'Qw' to override: '%s' (last offset %d)\n",
+          command, (int)(lastwarning-command));
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  trace4((qh, qh->ferr, 4093, "qh_initflags: option flags initialized\n"));
+  /* set derived values in qh_initqhull_globals */
+} /* initflags */
+
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="initqhull_buffers">-</a>
+
+  qh_initqhull_buffers(qh)
+    initialize global memory buffers
+
+  notes:
+    must match qh_freebuffers()
+*/
+void qh_initqhull_buffers(qhT *qh) {
+  int k;
+
+  qh->TEMPsize= (qh->qhmem.LASTsize - (int)sizeof(setT))/SETelemsize;
+  if (qh->TEMPsize <= 0 || qh->TEMPsize > qh->qhmem.LASTsize)
+    qh->TEMPsize= 8;  /* e.g., if qh_NOmem */
+  qh->other_points= qh_setnew(qh, qh->TEMPsize);
+  qh->del_vertices= qh_setnew(qh, qh->TEMPsize);
+  qh->coplanarfacetset= qh_setnew(qh, qh->TEMPsize);
+  qh->NEARzero= (realT *)qh_memalloc(qh, qh->hull_dim * (int)sizeof(realT));
+  qh->lower_threshold= (realT *)qh_memalloc(qh, (qh->input_dim+1) * (int)sizeof(realT));
+  qh->upper_threshold= (realT *)qh_memalloc(qh, (qh->input_dim+1) * (int)sizeof(realT));
+  qh->lower_bound= (realT *)qh_memalloc(qh, (qh->input_dim+1) * (int)sizeof(realT));
+  qh->upper_bound= (realT *)qh_memalloc(qh, (qh->input_dim+1) * (int)sizeof(realT));
+  for (k=qh->input_dim+1; k--; ) {  /* duplicated in qh_initqhull_buffers and qh_clear_outputflags */
+    qh->lower_threshold[k]= -REALmax;
+    qh->upper_threshold[k]= REALmax;
+    qh->lower_bound[k]= -REALmax;
+    qh->upper_bound[k]= REALmax;
+  }
+  qh->gm_matrix= (coordT *)qh_memalloc(qh, (qh->hull_dim+1) * qh->hull_dim * (int)sizeof(coordT));
+  qh->gm_row= (coordT **)qh_memalloc(qh, (qh->hull_dim+1) * (int)sizeof(coordT *));
+} /* initqhull_buffers */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="initqhull_globals">-</a>
+
+  qh_initqhull_globals(qh, points, numpoints, dim, ismalloc )
+    initialize globals
+    if ismalloc
+      points were malloc'd and qhull should free at end
+
+  returns:
+    sets qh.first_point, num_points, input_dim, hull_dim and others
+    seeds random number generator (seed=1 if tracing)
+    modifies qh.hull_dim if ((qh.DELAUNAY and qh.PROJECTdelaunay) or qh.PROJECTinput)
+    adjust user flags as needed
+    also checks DIM3 dependencies and constants
+
+  notes:
+    do not use qh_point() since an input transformation may move them elsewhere
+    qh_initqhull_start() sets default values for non-zero globals
+    consider duplicate error checks in qh_readpoints.  It is called before qh_initqhull_globals
+
+  design:
+    initialize points array from input arguments
+    test for qh.ZEROcentrum
+      (i.e., use opposite vertex instead of cetrum for convexity testing)
+    initialize qh.CENTERtype, qh.normal_size,
+      qh.center_size, qh.TRACEpoint/level,
+    initialize and test random numbers
+    qh_initqhull_outputflags() -- adjust and test output flags
+*/
+void qh_initqhull_globals(qhT *qh, coordT *points, int numpoints, int dim, boolT ismalloc) {
+  int seed, pointsneeded, extra= 0, i, randi, k;
+  realT randr;
+  realT factorial;
+
+  time_t timedata;
+
+  trace0((qh, qh->ferr, 13, "qh_initqhull_globals: for %s | %s\n", qh->rbox_command,
+      qh->qhull_command));
+  if (numpoints < 1 || numpoints > qh_POINTSmax) {
+    qh_fprintf(qh, qh->ferr, 6412, "qhull input error (qh_initqhull_globals): expecting between 1 and %d points.  Got %d %d-d points\n",
+      qh_POINTSmax, numpoints, dim);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    /* same error message in qh_readpoints */
+  }
+  qh->POINTSmalloc= ismalloc;
+  qh->first_point= points;
+  qh->num_points= numpoints;
+  qh->hull_dim= qh->input_dim= dim;
+  if (!qh->NOpremerge && !qh->MERGEexact && !qh->PREmerge && qh->JOGGLEmax > REALmax/2) {
+    qh->MERGING= True;
+    if (qh->hull_dim <= 4) {
+      qh->PREmerge= True;
+      qh_option(qh, "_pre-merge", NULL, NULL);
+    }else {
+      qh->MERGEexact= True;
+      qh_option(qh, "Qxact-merge", NULL, NULL);
+    }
+  }else if (qh->MERGEexact)
+    qh->MERGING= True;
+  if (qh->NOpremerge && (qh->MERGEexact || qh->PREmerge))
+    qh_fprintf(qh, qh->ferr, 7095, "qhull option warning: 'Q0-no-premerge' ignored due to exact merge ('Qx') or pre-merge ('C-n' or 'A-n')\n");
+  if (!qh->NOpremerge && qh->JOGGLEmax > REALmax/2) {
+#ifdef qh_NOmerge
+    qh->JOGGLEmax= 0.0;
+#endif
+  }
+  if (qh->TRIangulate && qh->JOGGLEmax < REALmax/2 && !qh->PREmerge && !qh->POSTmerge && qh->PRINTprecision)
+    qh_fprintf(qh, qh->ferr, 7038, "qhull option warning: joggle ('QJ') produces simplicial output (i.e., triangles in 2-D).  Unless merging is requested, option 'Qt' has no effect\n");
+  if (qh->JOGGLEmax < REALmax/2 && qh->DELAUNAY && !qh->SCALEinput && !qh->SCALElast) {
+    qh->SCALElast= True;
+    qh_option(qh, "Qbbound-last-qj", NULL, NULL);
+  }
+  if (qh->MERGING && !qh->POSTmerge && qh->premerge_cos > REALmax/2
+  && qh->premerge_centrum == 0.0) {
+    qh->ZEROcentrum= True;
+    qh->ZEROall_ok= True;
+    qh_option(qh, "_zero-centrum", NULL, NULL);
+  }
+  if (qh->JOGGLEmax < REALmax/2 && REALepsilon > 2e-8 && qh->PRINTprecision)
+    qh_fprintf(qh, qh->ferr, 7039, "qhull warning: real epsilon, %2.2g, is probably too large for joggle('QJn')\nRecompile with double precision reals(see user_r.h).\n",
+          REALepsilon);
+#ifdef qh_NOmerge
+  if (qh->MERGING) {
+    qh_fprintf(qh, qh->ferr, 6045, "qhull option error: merging not installed (qh_NOmerge) for 'Qx', 'Cn' or 'An')\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+#endif
+  if (qh->DELAUNAY && qh->KEEPcoplanar && !qh->KEEPinside) {
+    qh->KEEPinside= True;
+    qh_option(qh, "Qinterior-keep", NULL, NULL);
+  }
+  if (qh->VORONOI && !qh->DELAUNAY) {
+    qh_fprintf(qh, qh->ferr, 6038, "qhull internal error (qh_initqhull_globals): if qh.VORONOI is set, qh.DELAUNAY must be set.  Qhull constructs the Delaunay triangulation in order to compute the Voronoi diagram\n");
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (qh->DELAUNAY && qh->HALFspace) {
+    qh_fprintf(qh, qh->ferr, 6046, "qhull option error: can not use Delaunay('d') or Voronoi('v') with halfspace intersection('H')\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    /* same error message in qh_readpoints */
+  }
+  if (!qh->DELAUNAY && (qh->UPPERdelaunay || qh->ATinfinity)) {
+    qh_fprintf(qh, qh->ferr, 6047, "qhull option error: use upper-Delaunay('Qu') or infinity-point('Qz') with Delaunay('d') or Voronoi('v')\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (qh->UPPERdelaunay && qh->ATinfinity) {
+    qh_fprintf(qh, qh->ferr, 6048, "qhull option error: can not use infinity-point('Qz') with upper-Delaunay('Qu')\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (qh->MERGEpinched && qh->ONLYgood) {
+    qh_fprintf(qh, qh->ferr, 6362, "qhull option error: can not use merge-pinched-vertices ('Q14') with good-facets-only ('Qg')\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (qh->MERGEpinched && qh->hull_dim == 2) {
+    trace2((qh, qh->ferr, 2108, "qh_initqhull_globals: disable qh.MERGEpinched for 2-d.  It has no effect"))
+    qh->MERGEpinched= False;
+  }
+  if (qh->SCALElast && !qh->DELAUNAY && qh->PRINTprecision)
+    qh_fprintf(qh, qh->ferr, 7040, "qhull option warning: option 'Qbb' (scale-last-coordinate) is normally used with 'd' or 'v'\n");
+  qh->DOcheckmax= (!qh->SKIPcheckmax && (qh->MERGING || qh->APPROXhull));
+  qh->KEEPnearinside= (qh->DOcheckmax && !(qh->KEEPinside && qh->KEEPcoplanar)
+                          && !qh->NOnearinside);
+  if (qh->MERGING)
+    qh->CENTERtype= qh_AScentrum;
+  else if (qh->VORONOI)
+    qh->CENTERtype= qh_ASvoronoi;
+  if (qh->TESTvneighbors && !qh->MERGING) {
+    qh_fprintf(qh, qh->ferr, 6049, "qhull option error: test vertex neighbors('Qv') needs a merge option\n");
+    qh_errexit(qh, qh_ERRinput, NULL ,NULL);
+  }
+  if (qh->PROJECTinput || (qh->DELAUNAY && qh->PROJECTdelaunay)) {
+    qh->hull_dim -= qh->PROJECTinput;
+    if (qh->DELAUNAY) {
+      qh->hull_dim++;
+      if (qh->ATinfinity)
+        extra= 1;
+    }
+  }
+  if (qh->hull_dim <= 1) {
+    qh_fprintf(qh, qh->ferr, 6050, "qhull error: dimension %d must be > 1\n", qh->hull_dim);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  for (k=2, factorial=1.0; k < qh->hull_dim; k++)
+    factorial *= k;
+  qh->AREAfactor= 1.0 / factorial;
+  trace2((qh, qh->ferr, 2005, "qh_initqhull_globals: initialize globals.  input_dim %d, numpoints %d, malloc? %d, projected %d to hull_dim %d\n",
+        qh->input_dim, numpoints, ismalloc, qh->PROJECTinput, qh->hull_dim));
+  qh->normal_size= qh->hull_dim * (int)sizeof(coordT);
+  qh->center_size= qh->normal_size - (int)sizeof(coordT);
+  pointsneeded= qh->hull_dim+1;
+  if (qh->hull_dim > qh_DIMmergeVertex) {
+    qh->MERGEvertices= False;
+    qh_option(qh, "Q3-no-merge-vertices-dim-high", NULL, NULL);
+  }
+  if (qh->GOODpoint)
+    pointsneeded++;
+#ifdef qh_NOtrace
+  if (qh->IStracing || qh->TRACEmerge || qh->TRACEpoint != qh_IDnone || qh->TRACEdist < REALmax/2) {
+      qh_fprintf(qh, qh->ferr, 6051, "qhull option error: tracing is not installed (qh_NOtrace in user_r.h).  Trace options 'Tn', 'TMn', 'TPn' and 'TWn' mostly removed.  Continue with 'Qw' (allow warning)\n");
+      if (!qh->ALLOWwarning)
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+#endif
+  if (qh->RERUN > 1) {
+    qh->TRACElastrun= qh->IStracing; /* qh_build_withrestart duplicates next conditional */
+    if (qh->IStracing && qh->IStracing != -1) {
+      qh_fprintf(qh, qh->ferr, 8162, "qh_initqhull_globals: trace last of TR%d runs at level %d\n", qh->RERUN, qh->IStracing);
+      qh->IStracing= 0;
+    }
+  }else if (qh->TRACEpoint != qh_IDnone || qh->TRACEdist < REALmax/2 || qh->TRACEmerge) {
+    qh->TRACElevel= (qh->IStracing ? qh->IStracing : 3);
+    qh->IStracing= 0;
+  }
+  if (qh->ROTATErandom == 0 || qh->ROTATErandom == -1) {
+    seed= (int)time(&timedata);
+    if (qh->ROTATErandom  == -1) {
+      seed= -seed;
+      qh_option(qh, "QRandom-seed", &seed, NULL );
+    }else
+      qh_option(qh, "QRotate-random", &seed, NULL);
+    qh->ROTATErandom= seed;
+  }
+  seed= qh->ROTATErandom;
+  if (seed == INT_MIN)    /* default value */
+    seed= 1;
+  else if (seed < 0)
+    seed= -seed;
+  qh_RANDOMseed_(qh, seed);
+  randr= 0.0;
+  for (i=1000; i--; ) {
+    randi= qh_RANDOMint;
+    randr += randi;
+    if (randi > qh_RANDOMmax) {
+      qh_fprintf(qh, qh->ferr, 8036, "\
+qhull configuration error (qh_RANDOMmax in user_r.h): random integer %d > qh_RANDOMmax (%.8g)\n",
+               randi, qh_RANDOMmax);
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+  }
+  qh_RANDOMseed_(qh, seed);
+  randr= randr/1000;
+  if (randr < qh_RANDOMmax * 0.1
+  || randr > qh_RANDOMmax * 0.9)
+    qh_fprintf(qh, qh->ferr, 8037, "\
+qhull configuration warning (qh_RANDOMmax in user_r.h): average of 1000 random integers (%.2g) is much different than expected (%.2g).  Is qh_RANDOMmax (%.2g) wrong?\n",
+             randr, qh_RANDOMmax * 0.5, qh_RANDOMmax);
+  qh->RANDOMa= 2.0 * qh->RANDOMfactor/qh_RANDOMmax;
+  qh->RANDOMb= 1.0 - qh->RANDOMfactor;
+  if (qh_HASHfactor < 1.1) {
+    qh_fprintf(qh, qh->ferr, 6052, "qhull internal error (qh_initqhull_globals): qh_HASHfactor %d must be at least 1.1.  Qhull uses linear hash probing\n",
+      qh_HASHfactor);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (numpoints+extra < pointsneeded) {
+    qh_fprintf(qh, qh->ferr, 6214, "qhull input error: not enough points(%d) to construct initial simplex (need %d)\n",
+            numpoints, pointsneeded);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  qh_initqhull_outputflags(qh);
+} /* initqhull_globals */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="initqhull_mem">-</a>
+
+  qh_initqhull_mem(qh )
+    initialize mem_r.c for qhull
+    qh.hull_dim and qh.normal_size determine some of the allocation sizes
+    if qh.MERGING,
+      includes ridgeT
+    calls qh_user_memsizes (user_r.c) to add up to 10 additional sizes for quick allocation
+      (see numsizes below)
+
+  returns:
+    mem_r.c already for qh_memalloc/qh_memfree (errors if called beforehand)
+
+  notes:
+    qh_produceoutput() prints memsizes
+
+*/
+void qh_initqhull_mem(qhT *qh) {
+  int numsizes;
+  int i;
+
+  numsizes= 8+10;
+  qh_meminitbuffers(qh, qh->IStracing, qh_MEMalign, numsizes,
+                     qh_MEMbufsize, qh_MEMinitbuf);
+  qh_memsize(qh, (int)sizeof(vertexT));
+  if (qh->MERGING) {
+    qh_memsize(qh, (int)sizeof(ridgeT));
+    qh_memsize(qh, (int)sizeof(mergeT));
+  }
+  qh_memsize(qh, (int)sizeof(facetT));
+  i= (int)sizeof(setT) + (qh->hull_dim - 1) * SETelemsize;  /* ridge.vertices */
+  qh_memsize(qh, i);
+  qh_memsize(qh, qh->normal_size);        /* normal */
+  i += SETelemsize;                 /* facet.vertices, .ridges, .neighbors */
+  qh_memsize(qh, i);
+  qh_user_memsizes(qh);
+  qh_memsetup(qh);
+} /* initqhull_mem */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="initqhull_outputflags">-</a>
+
+  qh_initqhull_outputflags
+    initialize flags concerned with output
+
+  returns:
+    adjust user flags as needed
+
+  see:
+    qh_clear_outputflags() resets the flags
+
+  design:
+    test for qh.PRINTgood (i.e., only print 'good' facets)
+    check for conflicting print output options
+*/
+void qh_initqhull_outputflags(qhT *qh) {
+  boolT printgeom= False, printmath= False, printcoplanar= False;
+  int i;
+
+  trace3((qh, qh->ferr, 3024, "qh_initqhull_outputflags: %s\n", qh->qhull_command));
+  if (!(qh->PRINTgood || qh->PRINTneighbors)) {
+    if (qh->DELAUNAY || qh->KEEParea || qh->KEEPminArea < REALmax/2 || qh->KEEPmerge
+        || (!qh->ONLYgood && (qh->GOODvertex || qh->GOODpoint))) {
+      qh->PRINTgood= True;
+      qh_option(qh, "Pgood", NULL, NULL);
+    }
+  }
+  if (qh->PRINTtransparent) {
+    if (qh->hull_dim != 4 || !qh->DELAUNAY || qh->VORONOI || qh->DROPdim >= 0) {
+      qh_fprintf(qh, qh->ferr, 6215, "qhull option error: transparent Delaunay('Gt') needs 3-d Delaunay('d') w/o 'GDn'\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    qh->DROPdim= 3;
+    qh->PRINTridges= True;
+  }
+  for (i=qh_PRINTEND; i--; ) {
+    if (qh->PRINTout[i] == qh_PRINTgeom)
+      printgeom= True;
+    else if (qh->PRINTout[i] == qh_PRINTmathematica || qh->PRINTout[i] == qh_PRINTmaple)
+      printmath= True;
+    else if (qh->PRINTout[i] == qh_PRINTcoplanars)
+      printcoplanar= True;
+    else if (qh->PRINTout[i] == qh_PRINTpointnearest)
+      printcoplanar= True;
+    else if (qh->PRINTout[i] == qh_PRINTpointintersect && !qh->HALFspace) {
+      qh_fprintf(qh, qh->ferr, 6053, "qhull option error: option 'Fp' is only used for \nhalfspace intersection('Hn,n,n').\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }else if (qh->PRINTout[i] == qh_PRINTtriangles && (qh->HALFspace || qh->VORONOI)) {
+      qh_fprintf(qh, qh->ferr, 6054, "qhull option error: option 'Ft' is not available for Voronoi vertices ('v') or halfspace intersection ('H')\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }else if (qh->PRINTout[i] == qh_PRINTcentrums && qh->VORONOI) {
+      qh_fprintf(qh, qh->ferr, 6055, "qhull option error: option 'FC' is not available for Voronoi vertices('v')\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }else if (qh->PRINTout[i] == qh_PRINTvertices) {
+      if (qh->VORONOI)
+        qh_option(qh, "Fvoronoi", NULL, NULL);
+      else
+        qh_option(qh, "Fvertices", NULL, NULL);
+    }
+  }
+  if (printcoplanar && qh->DELAUNAY && qh->JOGGLEmax < REALmax/2) {
+    if (qh->PRINTprecision)
+      qh_fprintf(qh, qh->ferr, 7041, "qhull option warning: 'QJ' (joggle) will usually prevent coincident input sites for options 'Fc' and 'FP'\n");
+  }
+  if (printmath && (qh->hull_dim > 3 || qh->VORONOI)) {
+    qh_fprintf(qh, qh->ferr, 6056, "qhull option error: Mathematica and Maple output is only available for 2-d and 3-d convex hulls and 2-d Delaunay triangulations\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (printgeom) {
+    if (qh->hull_dim > 4) {
+      qh_fprintf(qh, qh->ferr, 6057, "qhull option error: Geomview output is only available for 2-d, 3-d and 4-d\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    if (qh->PRINTnoplanes && !(qh->PRINTcoplanar + qh->PRINTcentrums
+     + qh->PRINTdots + qh->PRINTspheres + qh->DOintersections + qh->PRINTridges)) {
+      qh_fprintf(qh, qh->ferr, 6058, "qhull option error: no output specified for Geomview\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    if (qh->VORONOI && (qh->hull_dim > 3 || qh->DROPdim >= 0)) {
+      qh_fprintf(qh, qh->ferr, 6059, "qhull option error: Geomview output for Voronoi diagrams only for 2-d\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    /* can not warn about furthest-site Geomview output: no lower_threshold */
+    if (qh->hull_dim == 4 && qh->DROPdim == -1 &&
+        (qh->PRINTcoplanar || qh->PRINTspheres || qh->PRINTcentrums)) {
+      qh_fprintf(qh, qh->ferr, 7042, "qhull option warning: coplanars, vertices, and centrums output not available for 4-d output(ignored).  Could use 'GDn' instead.\n");
+      qh->PRINTcoplanar= qh->PRINTspheres= qh->PRINTcentrums= False;
+    }
+  }
+  if (!qh->KEEPcoplanar && !qh->KEEPinside && !qh->ONLYgood) {
+    if ((qh->PRINTcoplanar && qh->PRINTspheres) || printcoplanar) {
+      if (qh->QHULLfinished) {
+        qh_fprintf(qh, qh->ferr, 7072, "qhull output warning: ignoring coplanar points, option 'Qc' was not set for the first run of qhull.\n");
+      }else {
+        qh->KEEPcoplanar= True;
+        qh_option(qh, "Qcoplanar", NULL, NULL);
+      }
+    }
+  }
+  qh->PRINTdim= qh->hull_dim;
+  if (qh->DROPdim >=0) {    /* after Geomview checks */
+    if (qh->DROPdim < qh->hull_dim) {
+      qh->PRINTdim--;
+      if (!printgeom || qh->hull_dim < 3)
+        qh_fprintf(qh, qh->ferr, 7043, "qhull option warning: drop dimension 'GD%d' is only available for 3-d/4-d Geomview\n", qh->DROPdim);
+    }else
+      qh->DROPdim= -1;
+  }else if (qh->VORONOI) {
+    qh->DROPdim= qh->hull_dim-1;
+    qh->PRINTdim= qh->hull_dim-1;
+  }
+} /* qh_initqhull_outputflags */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="initqhull_start">-</a>
+
+  qh_initqhull_start(qh, infile, outfile, errfile )
+    allocate memory if needed and call qh_initqhull_start2()
+*/
+void qh_initqhull_start(qhT *qh, FILE *infile, FILE *outfile, FILE *errfile) {
+
+  qh_initstatistics(qh);
+  qh_initqhull_start2(qh, infile, outfile, errfile);
+} /* initqhull_start */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="initqhull_start2">-</a>
+
+  qh_initqhull_start2(qh, infile, outfile, errfile )
+    start initialization of qhull
+    initialize statistics, stdio, default values for global variables
+    assumes qh is allocated
+  notes:
+    report errors elsewhere, error handling and g_qhull_output [Qhull.cpp, QhullQh()] not in initialized
+  see:
+    qh_maxmin() determines the precision constants
+    qh_freeqhull()
+*/
+void qh_initqhull_start2(qhT *qh, FILE *infile, FILE *outfile, FILE *errfile) {
+  time_t timedata;
+  int seed;
+
+  qh_CPUclock; /* start the clock(for qh_clock).  One-shot. */
+  /* memset is the same in qh_freeqhull() and qh_initqhull_start2() */
+  memset((char *)qh, 0, sizeof(qhT)-sizeof(qhmemT)-sizeof(qhstatT));   /* every field is 0, FALSE, NULL */
+  qh->NOerrexit= True;
+  qh->DROPdim= -1;
+  qh->ferr= errfile;
+  qh->fin= infile;
+  qh->fout= outfile;
+  qh->furthest_id= qh_IDunknown;
+#ifndef qh_NOmerge
+  qh->JOGGLEmax= REALmax;
+#else
+  qh->JOGGLEmax= 0.0;  /* Joggle ('QJ') if qh_NOmerge */
+#endif
+  qh->KEEPminArea= REALmax;
+  qh->last_low= REALmax;
+  qh->last_high= REALmax;
+  qh->last_newhigh= REALmax;
+  qh->last_random= 1; /* reentrant only */
+  qh->lastcpu= 0.0;
+  qh->max_outside= 0.0;
+  qh->max_vertex= 0.0;
+  qh->MAXabs_coord= 0.0;
+  qh->MAXsumcoord= 0.0;
+  qh->MAXwidth= -REALmax;
+  qh->MERGEindependent= True;
+  qh->MINdenom_1= fmax_(1.0/REALmax, REALmin); /* used by qh_scalepoints */
+  qh->MINoutside= 0.0;
+  qh->MINvisible= REALmax;
+  qh->MAXcoplanar= REALmax;
+  qh->outside_err= REALmax;
+  qh->premerge_centrum= 0.0;
+  qh->premerge_cos= REALmax;
+  qh->PRINTprecision= True;
+  qh->PRINTradius= 0.0;
+  qh->postmerge_cos= REALmax;
+  qh->postmerge_centrum= 0.0;
+  qh->ROTATErandom= INT_MIN;
+  qh->MERGEvertices= True;
+  qh->totarea= 0.0;
+  qh->totvol= 0.0;
+  qh->TRACEdist= REALmax;
+  qh->TRACEpoint= qh_IDnone;    /* recompile to trace a point, or use 'TPn' */
+  qh->tracefacet_id= UINT_MAX;  /* recompile to trace a facet, set to UINT_MAX when done, see userprintf_r.c/qh_fprintf */
+  qh->traceridge_id= UINT_MAX;  /* recompile to trace a ridge, set to UINT_MAX when done, see userprintf_r.c/qh_fprintf */
+  qh->tracevertex_id= UINT_MAX; /* recompile to trace a vertex, set to UINT_MAX when done, see userprintf_r.c/qh_fprintf */
+  seed= (int)time(&timedata);
+  qh_RANDOMseed_(qh, seed);
+  qh->run_id= qh_RANDOMint;
+  if(!qh->run_id)
+      qh->run_id++;  /* guarantee non-zero */
+  qh_option(qh, "run-id", &qh->run_id, NULL);
+  strcat(qh->qhull, "qhull");
+} /* initqhull_start2 */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="initthresholds">-</a>
+
+  qh_initthresholds(qh, commandString )
+    set thresholds for printing and scaling from commandString
+
+  returns:
+    sets qh.GOODthreshold or qh.SPLITthreshold if 'Pd0D1' used
+
+  see:
+    qh_initflags(), 'Qbk' 'QBk' 'Pdk' and 'PDk'
+    qh_inthresholds()
+
+  design:
+    for each 'Pdn' or 'PDn' option
+      check syntax
+      set qh.lower_threshold or qh.upper_threshold
+    set qh.GOODthreshold if an unbounded threshold is used
+    set qh.SPLITthreshold if a bounded threshold is used
+*/
+void qh_initthresholds(qhT *qh, char *command) {
+  realT value;
+  int idx, maxdim, k;
+  char *s= command; /* non-const due to strtol */
+  char *lastoption, *lastwarning= NULL;
+  char key;
+
+  maxdim= qh->input_dim;
+  if (qh->DELAUNAY && (qh->PROJECTdelaunay || qh->PROJECTinput))
+    maxdim++;
+  while (*s) {
+    if (*s == '-')
+      s++;
+    if (*s == 'P') {
+      lastoption= s++;
+      while (*s && !isspace(key= *s++)) {
+        if (key == 'd' || key == 'D') {
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7044, "qhull option warning: no dimension given for Print option 'P%c' at: %s.  Ignored\n",
+                    key, s-1);
+            lastwarning= lastoption;
+            continue;
+          }
+          idx= qh_strtol(s, &s);
+          if (idx >= qh->hull_dim) {
+            qh_fprintf(qh, qh->ferr, 7045, "qhull option warning: dimension %d for Print option 'P%c' is >= %d.  Ignored\n",
+                idx, key, qh->hull_dim);
+            lastwarning= lastoption;
+            continue;
+          }
+          if (*s == ':') {
+            s++;
+            value= qh_strtod(s, &s);
+            if (fabs((double)value) > 1.0) {
+              qh_fprintf(qh, qh->ferr, 7046, "qhull option warning: value %2.4g for Print option 'P%c' is > +1 or < -1.  Ignored\n",
+                      value, key);
+              lastwarning= lastoption;
+              continue;
+            }
+          }else
+            value= 0.0;
+          if (key == 'd')
+            qh->lower_threshold[idx]= value;
+          else
+            qh->upper_threshold[idx]= value;
+        }
+      }
+    }else if (*s == 'Q') {
+      lastoption= s++;
+      while (*s && !isspace(key= *s++)) {
+        if (key == 'b' && *s == 'B') {
+          s++;
+          for (k=maxdim; k--; ) {
+            qh->lower_bound[k]= -qh_DEFAULTbox;
+            qh->upper_bound[k]= qh_DEFAULTbox;
+          }
+        }else if (key == 'b' && *s == 'b')
+          s++;
+        else if (key == 'b' || key == 'B') {
+          if (!isdigit(*s)) {
+            qh_fprintf(qh, qh->ferr, 7047, "qhull option warning: no dimension given for Qhull option 'Q%c'\n",
+                    key);
+            lastwarning= lastoption;
+            continue;
+          }
+          idx= qh_strtol(s, &s);
+          if (idx >= maxdim) {
+            qh_fprintf(qh, qh->ferr, 7048, "qhull option warning: dimension %d for Qhull option 'Q%c' is >= %d.  Ignored\n",
+                idx, key, maxdim);
+            lastwarning= lastoption;
+            continue;
+          }
+          if (*s == ':') {
+            s++;
+            value= qh_strtod(s, &s);
+          }else if (key == 'b')
+            value= -qh_DEFAULTbox;
+          else
+            value= qh_DEFAULTbox;
+          if (key == 'b')
+            qh->lower_bound[idx]= value;
+          else
+            qh->upper_bound[idx]= value;
+        }
+      }
+    }else {
+      while (*s && !isspace(*s))
+        s++;
+    }
+    while (isspace(*s))
+      s++;
+  }
+  for (k=qh->hull_dim; k--; ) {
+    if (qh->lower_threshold[k] > -REALmax/2) {
+      qh->GOODthreshold= True;
+      if (qh->upper_threshold[k] < REALmax/2) {
+        qh->SPLITthresholds= True;
+        qh->GOODthreshold= False;
+        break;
+      }
+    }else if (qh->upper_threshold[k] < REALmax/2)
+      qh->GOODthreshold= True;
+  }
+  if (lastwarning && !qh->ALLOWwarning) {
+    qh_fprintf(qh, qh->ferr, 6036, "qhull option error: see previous warnings, use 'Qw' to override: '%s' (last offset %d)\n",
+      command, (int)(lastwarning-command));
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+} /* initthresholds */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="lib_check">-</a>
+
+  qh_lib_check( qhullLibraryType, qhTsize, vertexTsize, ridgeTsize, facetTsize, setTsize, qhmemTsize )
+    Report error if library does not agree with caller
+
+  notes:
+    NOerrors -- qh_lib_check can not call qh_errexit()
+*/
+void qh_lib_check(int qhullLibraryType, int qhTsize, int vertexTsize, int ridgeTsize, int facetTsize, int setTsize, int qhmemTsize) {
+    int last_errcode= qh_ERRnone;
+
+#if defined(_MSC_VER) && defined(_DEBUG) && defined(QHULL_CRTDBG)  /* user_r.h */
+    /*_CrtSetBreakAlloc(744);*/  /* Break at memalloc {744}, or 'watch' _crtBreakAlloc */
+    _CrtSetDbgFlag( _CRTDBG_ALLOC_MEM_DF | _CRTDBG_DELAY_FREE_MEM_DF | _CRTDBG_LEAK_CHECK_DF | _CrtSetDbgFlag(_CRTDBG_REPORT_FLAG) );
+    _CrtSetReportMode( _CRT_ERROR, _CRTDBG_MODE_FILE | _CRTDBG_MODE_DEBUG );
+    _CrtSetReportFile( _CRT_ERROR, _CRTDBG_FILE_STDERR );
+    _CrtSetReportMode( _CRT_WARN, _CRTDBG_MODE_FILE | _CRTDBG_MODE_DEBUG );
+    _CrtSetReportFile( _CRT_WARN, _CRTDBG_FILE_STDERR );
+    _CrtSetReportMode( _CRT_ASSERT, _CRTDBG_MODE_FILE | _CRTDBG_MODE_DEBUG );
+    _CrtSetReportFile( _CRT_ASSERT, _CRTDBG_FILE_STDERR );
+#endif
+
+    if (qhullLibraryType==QHULL_NON_REENTRANT) { /* 0 */
+      qh_fprintf_stderr(6257, "qh_lib_check: Incorrect qhull library called.  Caller uses non-reentrant Qhull with a static qhT.  Qhull library is reentrant.\n");
+      last_errcode= 6257;
+    }else if (qhullLibraryType==QHULL_QH_POINTER) { /* 1 */
+      qh_fprintf_stderr(6258, "qh_lib_check: Incorrect qhull library called.  Caller uses non-reentrant Qhull with a dynamic qhT via qh_QHpointer.  Qhull library is reentrant.\n");
+      last_errcode= 6258;
+    }else if (qhullLibraryType != QHULL_REENTRANT) { /* 2 */
+      qh_fprintf_stderr(6262, "qh_lib_check: Expecting qhullLibraryType QHULL_NON_REENTRANT(0), QHULL_QH_POINTER(1), or QHULL_REENTRANT(2).  Got %d\n", qhullLibraryType);
+      last_errcode= 6262;
+    }
+    if (qhTsize != (int)sizeof(qhT)) {
+      qh_fprintf_stderr(6249, "qh_lib_check: Incorrect qhull library called.  Size of qhT for caller is %d, but for qhull library is %d.\n", qhTsize, (int)sizeof(qhT));
+      last_errcode= 6249;
+    }
+    if (vertexTsize != (int)sizeof(vertexT)) {
+      qh_fprintf_stderr(6250, "qh_lib_check: Incorrect qhull library called.  Size of vertexT for caller is %d, but for qhull library is %d.\n", vertexTsize, (int)sizeof(vertexT));
+      last_errcode= 6250;
+    }
+    if (ridgeTsize != (int)sizeof(ridgeT)) {
+      qh_fprintf_stderr(6251, "qh_lib_check: Incorrect qhull library called.  Size of ridgeT for caller is %d, but for qhull library is %d.\n", ridgeTsize, (int)sizeof(ridgeT));
+      last_errcode= 6251;
+    }
+    if (facetTsize != (int)sizeof(facetT)) {
+      qh_fprintf_stderr(6252, "qh_lib_check: Incorrect qhull library called.  Size of facetT for caller is %d, but for qhull library is %d.\n", facetTsize, (int)sizeof(facetT));
+      last_errcode= 6252;
+    }
+    if (setTsize && setTsize != (int)sizeof(setT)) {
+      qh_fprintf_stderr(6253, "qh_lib_check: Incorrect qhull library called.  Size of setT for caller is %d, but for qhull library is %d.\n", setTsize, (int)sizeof(setT));
+      last_errcode= 6253;
+    }
+    if (qhmemTsize && qhmemTsize != sizeof(qhmemT)) {
+      qh_fprintf_stderr(6254, "qh_lib_check: Incorrect qhull library called.  Size of qhmemT for caller is %d, but for qhull library is %d.\n", qhmemTsize, sizeof(qhmemT));
+      last_errcode= 6254;
+    }
+    if (last_errcode) {
+      qh_fprintf_stderr(6259, "qhull internal error (qh_lib_check): Cannot continue due to QH%d.  '%s' is not reentrant (e.g., qhull.so) or out-of-date.  Exit with %d\n",
+            last_errcode, qh_version2, last_errcode - 6200);
+      qh_exit(last_errcode - 6200);  /* can not use qh_errexit(), must be less than 255 */
+    }
+} /* lib_check */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="option">-</a>
+
+  qh_option(qh, option, intVal, realVal )
+    add an option description to qh.qhull_options
+
+  notes:
+    NOerrors -- qh_option can not call qh_errexit() [qh_initqhull_start2]
+    will be printed with statistics ('Ts') and errors
+    strlen(option) < 40
+*/
+void qh_option(qhT *qh, const char *option, int *i, realT *r) {
+  char buf[200];
+  int buflen, remainder;
+
+  if (strlen(option) > sizeof(buf)-30-30) {
+    qh_fprintf(qh, qh->ferr, 6408, "qhull internal error (qh_option): option (%d chars) has more than %d chars.  May overflow temporary buffer.  Option '%s'\n",
+        (int)strlen(option), (int)sizeof(buf)-30-30, option);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  sprintf(buf, "  %s", option);
+  if (i)
+    sprintf(buf+strlen(buf), " %d", *i);
+  if (r)
+    sprintf(buf+strlen(buf), " %2.2g", *r);
+  buflen= (int)strlen(buf);   /* WARN64 */
+  qh->qhull_optionlen += buflen;
+  remainder= (int)(sizeof(qh->qhull_options) - strlen(qh->qhull_options)) - 1;    /* WARN64 */
+  maximize_(remainder, 0);
+  if (qh->qhull_optionlen >= qh_OPTIONline && remainder > 0) {
+    strncat(qh->qhull_options, "\n", (unsigned int)remainder);
+    --remainder;
+    qh->qhull_optionlen= buflen;
+  }
+  if (buflen > remainder) {
+    trace1((qh, qh->ferr, 1058, "qh_option: option would overflow qh.qhull_options. Truncated '%s'\n", buf));
+  }
+  strncat(qh->qhull_options, buf, (unsigned int)remainder);
+} /* option */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="zero">-</a>
+
+  qh_zero( qh, errfile )
+    Initialize and zero Qhull's memory for qh_new_qhull()
+
+  notes:
+    Not needed in global_r.c because static variables are initialized to zero
+*/
+void qh_zero(qhT *qh, FILE *errfile) {
+    memset((char *)qh, 0, sizeof(qhT));   /* every field is 0, FALSE, NULL */
+    qh->NOerrexit= True;
+    qh_meminit(qh, errfile);
+} /* zero */
+
diff --git a/contrib/libs/qhull/libqhull_r/io_r.c b/contrib/libs/qhull/libqhull_r/io_r.c
new file mode 100644
index 0000000000..a80a5b14a4
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/io_r.c
@@ -0,0 +1,4128 @@
+/*<html><pre>  -<a                             href="qh-io_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   io_r.c
+   Input/Output routines of qhull application
+
+   see qh-io_r.htm and io_r.h
+
+   see user_r.c for qh_errprint and qh_printfacetlist
+
+   unix_r.c calls qh_readpoints and qh_produce_output
+
+   unix_r.c and user_r.c are the only callers of io_r.c functions
+   This allows the user to avoid loading io_r.o from qhull.a
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/io_r.c#12 $$Change: 2965 $
+   $DateTime: 2020/06/04 15:37:41 $$Author: bbarber $
+*/
+
+#include "qhull_ra.h"
+
+/*========= -functions in alphabetical order after qh_produce_output(qh)  =====*/
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="produce_output">-</a>
+
+  qh_produce_output(qh )
+  qh_produce_output2(qh )
+    prints out the result of qhull in desired format
+    qh_produce_output2 does not call qh_prepare_output
+      qh_checkpolygon is valid for qh_prepare_output
+    if qh.GETarea
+      computes and prints area and volume
+    qh.PRINTout[] is an array of output formats
+
+  notes:
+    prints output in qh.PRINTout order
+*/
+void qh_produce_output(qhT *qh) {
+    int tempsize= qh_setsize(qh, qh->qhmem.tempstack);
+
+    qh_prepare_output(qh);
+    qh_produce_output2(qh);
+    if (qh_setsize(qh, qh->qhmem.tempstack) != tempsize) {
+        qh_fprintf(qh, qh->ferr, 6206, "qhull internal error (qh_produce_output): temporary sets not empty(%d)\n",
+            qh_setsize(qh, qh->qhmem.tempstack));
+        qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+} /* produce_output */
+
+
+void qh_produce_output2(qhT *qh) {
+  int i, tempsize= qh_setsize(qh, qh->qhmem.tempstack), d_1;
+
+  fflush(NULL);
+  if (qh->PRINTsummary)
+    qh_printsummary(qh, qh->ferr);
+  else if (qh->PRINTout[0] == qh_PRINTnone)
+    qh_printsummary(qh, qh->fout);
+  for (i=0; i < qh_PRINTEND; i++)
+    qh_printfacets(qh, qh->fout, qh->PRINTout[i], qh->facet_list, NULL, !qh_ALL);
+  fflush(NULL);
+
+  qh_allstatistics(qh);
+  if (qh->PRINTprecision && !qh->MERGING && (qh->JOGGLEmax > REALmax/2 || qh->RERUN))
+    qh_printstats(qh, qh->ferr, qh->qhstat.precision, NULL);
+  if (qh->VERIFYoutput && (zzval_(Zridge) > 0 || zzval_(Zridgemid) > 0))
+    qh_printstats(qh, qh->ferr, qh->qhstat.vridges, NULL);
+  if (qh->PRINTstatistics) {
+    qh_printstatistics(qh, qh->ferr, "");
+    qh_memstatistics(qh, qh->ferr);
+    d_1= (int)sizeof(setT) + (qh->hull_dim - 1) * SETelemsize;
+    qh_fprintf(qh, qh->ferr, 8040, "\
+    size in bytes: merge %d ridge %d vertex %d facet %d\n\
+         normal %d ridge vertices %d facet vertices or neighbors %d\n",
+            (int)sizeof(mergeT), (int)sizeof(ridgeT),
+            (int)sizeof(vertexT), (int)sizeof(facetT),
+            qh->normal_size, d_1, d_1 + SETelemsize);
+  }
+  if (qh_setsize(qh, qh->qhmem.tempstack) != tempsize) {
+    qh_fprintf(qh, qh->ferr, 6065, "qhull internal error (qh_produce_output2): temporary sets not empty(%d)\n",
+             qh_setsize(qh, qh->qhmem.tempstack));
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+} /* produce_output2 */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="dfacet">-</a>
+
+  qh_dfacet(qh, id )
+    print facet by id, for debugging
+
+*/
+void qh_dfacet(qhT *qh, unsigned int id) {
+  facetT *facet;
+
+  FORALLfacets {
+    if (facet->id == id) {
+      qh_printfacet(qh, qh->fout, facet);
+      break;
+    }
+  }
+} /* dfacet */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="dvertex">-</a>
+
+  qh_dvertex(qh, id )
+    print vertex by id, for debugging
+*/
+void qh_dvertex(qhT *qh, unsigned int id) {
+  vertexT *vertex;
+
+  FORALLvertices {
+    if (vertex->id == id) {
+      qh_printvertex(qh, qh->fout, vertex);
+      break;
+    }
+  }
+} /* dvertex */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="compare_facetarea">-</a>
+
+  qh_compare_facetarea( p1, p2 )
+    used by qsort() to order facets by area
+*/
+int qh_compare_facetarea(const void *p1, const void *p2) {
+  const facetT *a= *((facetT *const*)p1), *b= *((facetT *const*)p2);
+
+  if (!a->isarea)
+    return -1;
+  if (!b->isarea)
+    return 1;
+  if (a->f.area > b->f.area)
+    return 1;
+  else if (a->f.area == b->f.area)
+    return 0;
+  return -1;
+} /* compare_facetarea */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="compare_facetvisit">-</a>
+
+  qh_compare_facetvisit( p1, p2 )
+    used by qsort() to order facets by visit id or id
+*/
+int qh_compare_facetvisit(const void *p1, const void *p2) {
+  const facetT *a= *((facetT *const*)p1), *b= *((facetT *const*)p2);
+  int i,j;
+
+  if (!(i= (int)a->visitid))
+    i= (int)(0 - a->id); /* sign distinguishes id from visitid */
+  if (!(j= (int)b->visitid))
+    j= (int)(0 - b->id);
+  return(i - j);
+} /* compare_facetvisit */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="compare_nummerge">-</a>
+
+  qh_compare_nummerge( p1, p2 )
+    used by qsort() to order facets by number of merges
+
+notes:
+    called by qh_markkeep ('PMerge-keep')
+*/
+int qh_compare_nummerge(const void *p1, const void *p2) {
+  const facetT *a= *((facetT *const*)p1), *b= *((facetT *const*)p2);
+
+  return(a->nummerge - b->nummerge);
+} /* compare_nummerge */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="copyfilename">-</a>
+
+  qh_copyfilename(qh, dest, size, source, length )
+    copy filename identified by qh_skipfilename()
+
+  notes:
+    see qh_skipfilename() for syntax
+*/
+void qh_copyfilename(qhT *qh, char *filename, int size, const char* source, int length) {
+  char c= *source;
+
+  if (length > size + 1) {
+      qh_fprintf(qh, qh->ferr, 6040, "qhull error: filename is more than %d characters, %s\n",  size-1, source);
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  strncpy(filename, source, (size_t)length);
+  filename[length]= '\0';
+  if (c == '\'' || c == '"') {
+    char *s= filename + 1;
+    char *t= filename;
+    while (*s) {
+      if (*s == c) {
+          if (s[-1] == '\\')
+              t[-1]= c;
+      }else
+          *t++= *s;
+      s++;
+    }
+    *t= '\0';
+  }
+} /* copyfilename */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="countfacets">-</a>
+
+  qh_countfacets(qh, facetlist, facets, printall,
+          numfacets, numsimplicial, totneighbors, numridges, numcoplanar, numtricoplanars  )
+    count good facets for printing and set visitid
+    if allfacets, ignores qh_skipfacet()
+
+  notes:
+    qh_printsummary and qh_countfacets must match counts
+
+  returns:
+    numfacets, numsimplicial, total neighbors, numridges, coplanars
+    each facet with ->visitid indicating 1-relative position
+      ->visitid==0 indicates not good
+
+  notes
+    numfacets >= numsimplicial
+    if qh.NEWfacets,
+      does not count visible facets (matches qh_printafacet)
+
+  design:
+    for all facets on facetlist and in facets set
+      unless facet is skipped or visible (i.e., will be deleted)
+        mark facet->visitid
+        update counts
+*/
+void qh_countfacets(qhT *qh, facetT *facetlist, setT *facets, boolT printall,
+    int *numfacetsp, int *numsimplicialp, int *totneighborsp, int *numridgesp, int *numcoplanarsp, int *numtricoplanarsp) {
+  facetT *facet, **facetp;
+  int numfacets= 0, numsimplicial= 0, numridges= 0, totneighbors= 0, numcoplanars= 0, numtricoplanars= 0;
+
+  FORALLfacet_(facetlist) {
+    if ((facet->visible && qh->NEWfacets)
+    || (!printall && qh_skipfacet(qh, facet)))
+      facet->visitid= 0;
+    else {
+      facet->visitid= (unsigned int)(++numfacets);
+      totneighbors += qh_setsize(qh, facet->neighbors);
+      if (facet->simplicial) {
+        numsimplicial++;
+        if (facet->keepcentrum && facet->tricoplanar)
+          numtricoplanars++;
+      }else
+        numridges += qh_setsize(qh, facet->ridges);
+      if (facet->coplanarset)
+        numcoplanars += qh_setsize(qh, facet->coplanarset);
+    }
+  }
+
+  FOREACHfacet_(facets) {
+    if ((facet->visible && qh->NEWfacets)
+    || (!printall && qh_skipfacet(qh, facet)))
+      facet->visitid= 0;
+    else {
+      facet->visitid= (unsigned int)(++numfacets);
+      totneighbors += qh_setsize(qh, facet->neighbors);
+      if (facet->simplicial){
+        numsimplicial++;
+        if (facet->keepcentrum && facet->tricoplanar)
+          numtricoplanars++;
+      }else
+        numridges += qh_setsize(qh, facet->ridges);
+      if (facet->coplanarset)
+        numcoplanars += qh_setsize(qh, facet->coplanarset);
+    }
+  }
+  qh->visit_id += (unsigned int)numfacets + 1;
+  *numfacetsp= numfacets;
+  *numsimplicialp= numsimplicial;
+  *totneighborsp= totneighbors;
+  *numridgesp= numridges;
+  *numcoplanarsp= numcoplanars;
+  *numtricoplanarsp= numtricoplanars;
+} /* countfacets */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="detvnorm">-</a>
+
+  qh_detvnorm(qh, vertex, vertexA, centers, offset )
+    compute separating plane of the Voronoi diagram for a pair of input sites
+    centers= set of facets (i.e., Voronoi vertices)
+      facet->visitid= 0 iff vertex-at-infinity (i.e., unbounded)
+
+  assumes:
+    qh_ASvoronoi and qh_vertexneighbors() already set
+
+  returns:
+    norm
+      a pointer into qh.gm_matrix to qh.hull_dim-1 reals
+      copy the data before reusing qh.gm_matrix
+    offset
+      if 'QVn'
+        sign adjusted so that qh.GOODvertexp is inside
+      else
+        sign adjusted so that vertex is inside
+
+    qh.gm_matrix= simplex of points from centers relative to first center
+
+  notes:
+    in io_r.c so that code for 'v Tv' can be removed by removing io_r.c
+    returns pointer into qh.gm_matrix to avoid tracking of temporary memory
+
+  design:
+    determine midpoint of input sites
+    build points as the set of Voronoi vertices
+    select a simplex from points (if necessary)
+      include midpoint if the Voronoi region is unbounded
+    relocate the first vertex of the simplex to the origin
+    compute the normalized hyperplane through the simplex
+    orient the hyperplane toward 'QVn' or 'vertex'
+    if 'Tv' or 'Ts'
+      if bounded
+        test that hyperplane is the perpendicular bisector of the input sites
+      test that Voronoi vertices not in the simplex are still on the hyperplane
+    free up temporary memory
+*/
+pointT *qh_detvnorm(qhT *qh, vertexT *vertex, vertexT *vertexA, setT *centers, realT *offsetp) {
+  facetT *facet, **facetp;
+  int  i, k, pointid, pointidA, point_i, point_n;
+  setT *simplex= NULL;
+  pointT *point, **pointp, *point0, *midpoint, *normal, *inpoint;
+  coordT *coord, *gmcoord, *normalp;
+  setT *points= qh_settemp(qh, qh->TEMPsize);
+  boolT nearzero= False;
+  boolT unbounded= False;
+  int numcenters= 0;
+  int dim= qh->hull_dim - 1;
+  realT dist, offset, angle, zero= 0.0;
+
+  midpoint= qh->gm_matrix + qh->hull_dim * qh->hull_dim;  /* last row */
+  for (k=0; k < dim; k++)
+    midpoint[k]= (vertex->point[k] + vertexA->point[k])/2;
+  FOREACHfacet_(centers) {
+    numcenters++;
+    if (!facet->visitid)
+      unbounded= True;
+    else {
+      if (!facet->center)
+        facet->center= qh_facetcenter(qh, facet->vertices);
+      qh_setappend(qh, &points, facet->center);
+    }
+  }
+  if (numcenters > dim) {
+    simplex= qh_settemp(qh, qh->TEMPsize);
+    qh_setappend(qh, &simplex, vertex->point);
+    if (unbounded)
+      qh_setappend(qh, &simplex, midpoint);
+    qh_maxsimplex(qh, dim, points, NULL, 0, &simplex);
+    qh_setdelnth(qh, simplex, 0);
+  }else if (numcenters == dim) {
+    if (unbounded)
+      qh_setappend(qh, &points, midpoint);
+    simplex= points;
+  }else {
+    qh_fprintf(qh, qh->ferr, 6216, "qhull internal error (qh_detvnorm): too few points(%d) to compute separating plane\n", numcenters);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  i= 0;
+  gmcoord= qh->gm_matrix;
+  point0= SETfirstt_(simplex, pointT);
+  FOREACHpoint_(simplex) {
+    if (qh->IStracing >= 4)
+      qh_printmatrix(qh, qh->ferr, "qh_detvnorm: Voronoi vertex or midpoint",
+                              &point, 1, dim);
+    if (point != point0) {
+      qh->gm_row[i++]= gmcoord;
+      coord= point0;
+      for (k=dim; k--; )
+        *(gmcoord++)= *point++ - *coord++;
+    }
+  }
+  qh->gm_row[i]= gmcoord;  /* does not overlap midpoint, may be used later for qh_areasimplex */
+  normal= gmcoord;
+  qh_sethyperplane_gauss(qh, dim, qh->gm_row, point0, True,
+                normal, &offset, &nearzero);
+  /* nearzero is true for axis-parallel hyperplanes (e.g., a bounding box).  Should detect degenerate hyperplanes.  See 'Tv' check following */
+  if (qh->GOODvertexp == vertexA->point)
+    inpoint= vertexA->point;
+  else
+    inpoint= vertex->point;
+  zinc_(Zdistio);
+  dist= qh_distnorm(dim, inpoint, normal, &offset);
+  if (dist > 0) {
+    offset= -offset;
+    normalp= normal;
+    for (k=dim; k--; ) {
+      *normalp= -(*normalp);
+      normalp++;
+    }
+  }
+  if (qh->VERIFYoutput || qh->PRINTstatistics) {
+    pointid= qh_pointid(qh, vertex->point);
+    pointidA= qh_pointid(qh, vertexA->point);
+    if (!unbounded) {
+      zinc_(Zdiststat);
+      dist= qh_distnorm(dim, midpoint, normal, &offset);
+      if (dist < 0)
+        dist= -dist;
+      zzinc_(Zridgemid);
+      wwmax_(Wridgemidmax, dist);
+      wwadd_(Wridgemid, dist);
+      trace4((qh, qh->ferr, 4014, "qh_detvnorm: points %d %d midpoint dist %2.2g\n",
+                 pointid, pointidA, dist));
+      for (k=0; k < dim; k++)
+        midpoint[k]= vertexA->point[k] - vertex->point[k];  /* overwrites midpoint! */
+      qh_normalize(qh, midpoint, dim, False);
+      angle= qh_distnorm(dim, midpoint, normal, &zero); /* qh_detangle uses dim+1 */
+      if (angle < 0.0)
+        angle= angle + 1.0;
+      else
+        angle= angle - 1.0;
+      if (angle < 0.0)
+        angle= -angle;
+      trace4((qh, qh->ferr, 4015, "qh_detvnorm: points %d %d angle %2.2g nearzero %d\n",
+                 pointid, pointidA, angle, nearzero));
+      if (nearzero) {
+        zzinc_(Zridge0);
+        wwmax_(Wridge0max, angle);
+        wwadd_(Wridge0, angle);
+      }else {
+        zzinc_(Zridgeok)
+        wwmax_(Wridgeokmax, angle);
+        wwadd_(Wridgeok, angle);
+      }
+    }
+    if (simplex != points) {
+      FOREACHpoint_i_(qh, points) {
+        if (!qh_setin(simplex, point)) {
+          facet= SETelemt_(centers, point_i, facetT);
+          zinc_(Zdiststat);
+          dist= qh_distnorm(dim, point, normal, &offset);
+          if (dist < 0)
+            dist= -dist;
+          zzinc_(Zridge);
+          wwmax_(Wridgemax, dist);
+          wwadd_(Wridge, dist);
+          trace4((qh, qh->ferr, 4016, "qh_detvnorm: points %d %d Voronoi vertex %d dist %2.2g\n",
+                             pointid, pointidA, facet->visitid, dist));
+        }
+      }
+    }
+  }
+  *offsetp= offset;
+  if (simplex != points)
+    qh_settempfree(qh, &simplex);
+  qh_settempfree(qh, &points);
+  return normal;
+} /* detvnorm */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="detvridge">-</a>
+
+  qh_detvridge(qh, vertexA )
+    determine Voronoi ridge from 'seen' neighbors of vertexA
+    include one vertex-at-infinite if an !neighbor->visitid
+
+  returns:
+    temporary set of centers (facets, i.e., Voronoi vertices)
+    sorted by center id
+*/
+setT *qh_detvridge(qhT *qh, vertexT *vertex) {
+  setT *centers= qh_settemp(qh, qh->TEMPsize);
+  setT *tricenters= qh_settemp(qh, qh->TEMPsize);
+  facetT *neighbor, **neighborp;
+  boolT firstinf= True;
+
+  FOREACHneighbor_(vertex) {
+    if (neighbor->seen) {
+      if (neighbor->visitid) {
+        if (!neighbor->tricoplanar || qh_setunique(qh, &tricenters, neighbor->center))
+          qh_setappend(qh, &centers, neighbor);
+      }else if (firstinf) {
+        firstinf= False;
+        qh_setappend(qh, &centers, neighbor);
+      }
+    }
+  }
+  qsort(SETaddr_(centers, facetT), (size_t)qh_setsize(qh, centers),
+             sizeof(facetT *), qh_compare_facetvisit);
+  qh_settempfree(qh, &tricenters);
+  return centers;
+} /* detvridge */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="detvridge3">-</a>
+
+  qh_detvridge3(qh, atvertex, vertex )
+    determine 3-d Voronoi ridge from 'seen' neighbors of atvertex and vertex
+    include one vertex-at-infinite for !neighbor->visitid
+    assumes all facet->seen2= True
+
+  returns:
+    temporary set of centers (facets, i.e., Voronoi vertices)
+    listed in adjacency order (!oriented)
+    all facet->seen2= True
+
+  design:
+    mark all neighbors of atvertex
+    for each adjacent neighbor of both atvertex and vertex
+      if neighbor selected
+        add neighbor to set of Voronoi vertices
+*/
+setT *qh_detvridge3(qhT *qh, vertexT *atvertex, vertexT *vertex) {
+  setT *centers= qh_settemp(qh, qh->TEMPsize);
+  setT *tricenters= qh_settemp(qh, qh->TEMPsize);
+  facetT *neighbor, **neighborp, *facet= NULL;
+  boolT firstinf= True;
+
+  FOREACHneighbor_(atvertex)
+    neighbor->seen2= False;
+  FOREACHneighbor_(vertex) {
+    if (!neighbor->seen2) {
+      facet= neighbor;
+      break;
+    }
+  }
+  while (facet) {
+    facet->seen2= True;
+    if (neighbor->seen) {
+      if (facet->visitid) {
+        if (!facet->tricoplanar || qh_setunique(qh, &tricenters, facet->center))
+          qh_setappend(qh, &centers, facet);
+      }else if (firstinf) {
+        firstinf= False;
+        qh_setappend(qh, &centers, facet);
+      }
+    }
+    FOREACHneighbor_(facet) {
+      if (!neighbor->seen2) {
+        if (qh_setin(vertex->neighbors, neighbor))
+          break;
+        else
+          neighbor->seen2= True;
+      }
+    }
+    facet= neighbor;
+  }
+  if (qh->CHECKfrequently) {
+    FOREACHneighbor_(vertex) {
+      if (!neighbor->seen2) {
+          qh_fprintf(qh, qh->ferr, 6217, "qhull internal error (qh_detvridge3): neighbors of vertex p%d are not connected at facet %d\n",
+                 qh_pointid(qh, vertex->point), neighbor->id);
+        qh_errexit(qh, qh_ERRqhull, neighbor, NULL);
+      }
+    }
+  }
+  FOREACHneighbor_(atvertex)
+    neighbor->seen2= True;
+  qh_settempfree(qh, &tricenters);
+  return centers;
+} /* detvridge3 */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="eachvoronoi">-</a>
+
+  qh_eachvoronoi(qh, fp, printvridge, vertex, visitall, innerouter, inorder )
+    if visitall,
+      visit all Voronoi ridges for vertex (i.e., an input site)
+    else
+      visit all unvisited Voronoi ridges for vertex
+      all vertex->seen= False if unvisited
+    assumes
+      all facet->seen= False
+      all facet->seen2= True (for qh_detvridge3)
+      all facet->visitid == 0 if vertex_at_infinity
+                         == index of Voronoi vertex
+                         >= qh.num_facets if ignored
+    innerouter:
+      qh_RIDGEall--  both inner (bounded) and outer(unbounded) ridges
+      qh_RIDGEinner- only inner
+      qh_RIDGEouter- only outer
+
+    if inorder
+      orders vertices for 3-d Voronoi diagrams
+
+  returns:
+    number of visited ridges (does not include previously visited ridges)
+
+    if printvridge,
+      calls printvridge( fp, vertex, vertexA, centers)
+        fp== any pointer (assumes FILE*)
+             fp may be NULL for QhullQh::qh_fprintf which calls appendQhullMessage
+        vertex,vertexA= pair of input sites that define a Voronoi ridge
+        centers= set of facets (i.e., Voronoi vertices)
+                 ->visitid == index or 0 if vertex_at_infinity
+                 ordered for 3-d Voronoi diagram
+  notes:
+    uses qh.vertex_visit
+
+  see:
+    qh_eachvoronoi_all()
+
+  design:
+    mark selected neighbors of atvertex
+    for each selected neighbor (either Voronoi vertex or vertex-at-infinity)
+      for each unvisited vertex
+        if atvertex and vertex share more than d-1 neighbors
+          bump totalcount
+          if printvridge defined
+            build the set of shared neighbors (i.e., Voronoi vertices)
+            call printvridge
+*/
+int qh_eachvoronoi(qhT *qh, FILE *fp, printvridgeT printvridge, vertexT *atvertex, boolT visitall, qh_RIDGE innerouter, boolT inorder) {
+  boolT unbounded;
+  int count;
+  facetT *neighbor, **neighborp, *neighborA, **neighborAp;
+  setT *centers;
+  setT *tricenters= qh_settemp(qh, qh->TEMPsize);
+
+  vertexT *vertex, **vertexp;
+  boolT firstinf;
+  unsigned int numfacets= (unsigned int)qh->num_facets;
+  int totridges= 0;
+
+  qh->vertex_visit++;
+  atvertex->seen= True;
+  if (visitall) {
+    FORALLvertices
+      vertex->seen= False;
+  }
+  FOREACHneighbor_(atvertex) {
+    if (neighbor->visitid < numfacets)
+      neighbor->seen= True;
+  }
+  FOREACHneighbor_(atvertex) {
+    if (neighbor->seen) {
+      FOREACHvertex_(neighbor->vertices) {
+        if (vertex->visitid != qh->vertex_visit && !vertex->seen) {
+          vertex->visitid= qh->vertex_visit;
+          count= 0;
+          firstinf= True;
+          qh_settruncate(qh, tricenters, 0);
+          FOREACHneighborA_(vertex) {
+            if (neighborA->seen) {
+              if (neighborA->visitid) {
+                if (!neighborA->tricoplanar || qh_setunique(qh, &tricenters, neighborA->center))
+                  count++;
+              }else if (firstinf) {
+                count++;
+                firstinf= False;
+              }
+            }
+          }
+          if (count >= qh->hull_dim - 1) {  /* e.g., 3 for 3-d Voronoi */
+            if (firstinf) {
+              if (innerouter == qh_RIDGEouter)
+                continue;
+              unbounded= False;
+            }else {
+              if (innerouter == qh_RIDGEinner)
+                continue;
+              unbounded= True;
+            }
+            totridges++;
+            trace4((qh, qh->ferr, 4017, "qh_eachvoronoi: Voronoi ridge of %d vertices between sites %d and %d\n",
+                  count, qh_pointid(qh, atvertex->point), qh_pointid(qh, vertex->point)));
+            if (printvridge) {
+              if (inorder && qh->hull_dim == 3+1) /* 3-d Voronoi diagram */
+                centers= qh_detvridge3(qh, atvertex, vertex);
+              else
+                centers= qh_detvridge(qh, vertex);
+              (*printvridge)(qh, fp, atvertex, vertex, centers, unbounded);
+              qh_settempfree(qh, &centers);
+            }
+          }
+        }
+      }
+    }
+  }
+  FOREACHneighbor_(atvertex)
+    neighbor->seen= False;
+  qh_settempfree(qh, &tricenters);
+  return totridges;
+} /* eachvoronoi */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="eachvoronoi_all">-</a>
+
+  qh_eachvoronoi_all(qh, fp, printvridge, isUpper, innerouter, inorder )
+    visit all Voronoi ridges
+
+    innerouter:
+      see qh_eachvoronoi()
+
+    if inorder
+      orders vertices for 3-d Voronoi diagrams
+
+  returns
+    total number of ridges
+
+    if isUpper == facet->upperdelaunay  (i.e., a Vornoi vertex)
+      facet->visitid= Voronoi vertex index(same as 'o' format)
+    else
+      facet->visitid= 0
+
+    if printvridge,
+      calls printvridge( fp, vertex, vertexA, centers)
+      [see qh_eachvoronoi]
+
+  notes:
+    Not used for qhull.exe
+    same effect as qh_printvdiagram but ridges not sorted by point id
+*/
+int qh_eachvoronoi_all(qhT *qh, FILE *fp, printvridgeT printvridge, boolT isUpper, qh_RIDGE innerouter, boolT inorder) {
+  facetT *facet;
+  vertexT *vertex;
+  int numcenters= 1;  /* vertex 0 is vertex-at-infinity */
+  int totridges= 0;
+
+  qh_clearcenters(qh, qh_ASvoronoi);
+  qh_vertexneighbors(qh);
+  maximize_(qh->visit_id, (unsigned int)qh->num_facets);
+  FORALLfacets {
+    facet->visitid= 0;
+    facet->seen= False;
+    facet->seen2= True;
+  }
+  FORALLfacets {
+    if (facet->upperdelaunay == isUpper)
+      facet->visitid= (unsigned int)(numcenters++);
+  }
+  FORALLvertices
+    vertex->seen= False;
+  FORALLvertices {
+    if (qh->GOODvertex > 0 && qh_pointid(qh, vertex->point)+1 != qh->GOODvertex)
+      continue;
+    totridges += qh_eachvoronoi(qh, fp, printvridge, vertex,
+                   !qh_ALL, innerouter, inorder);
+  }
+  return totridges;
+} /* eachvoronoi_all */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="facet2point">-</a>
+
+  qh_facet2point(qh, facet, point0, point1, mindist )
+    return two projected temporary vertices for a 2-d facet
+    may be non-simplicial
+
+  returns:
+    point0 and point1 oriented and projected to the facet
+    returns mindist (maximum distance below plane)
+*/
+void qh_facet2point(qhT *qh, facetT *facet, pointT **point0, pointT **point1, realT *mindist) {
+  vertexT *vertex0, *vertex1;
+  realT dist;
+
+  if (facet->toporient ^ qh_ORIENTclock) {
+    vertex0= SETfirstt_(facet->vertices, vertexT);
+    vertex1= SETsecondt_(facet->vertices, vertexT);
+  }else {
+    vertex1= SETfirstt_(facet->vertices, vertexT);
+    vertex0= SETsecondt_(facet->vertices, vertexT);
+  }
+  zadd_(Zdistio, 2);
+  qh_distplane(qh, vertex0->point, facet, &dist);
+  *mindist= dist;
+  *point0= qh_projectpoint(qh, vertex0->point, facet, dist);
+  qh_distplane(qh, vertex1->point, facet, &dist);
+  minimize_(*mindist, dist);
+  *point1= qh_projectpoint(qh, vertex1->point, facet, dist);
+} /* facet2point */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="facetvertices">-</a>
+
+  qh_facetvertices(qh, facetlist, facets, allfacets )
+    returns temporary set of vertices in a set and/or list of facets
+    if allfacets, ignores qh_skipfacet()
+
+  returns:
+    vertices with qh.vertex_visit
+
+  notes:
+    optimized for allfacets of facet_list
+
+  design:
+    if allfacets of facet_list
+      create vertex set from vertex_list
+    else
+      for each selected facet in facets or facetlist
+        append unvisited vertices to vertex set
+*/
+setT *qh_facetvertices(qhT *qh, facetT *facetlist, setT *facets, boolT allfacets) {
+  setT *vertices;
+  facetT *facet, **facetp;
+  vertexT *vertex, **vertexp;
+
+  qh->vertex_visit++;
+  if (facetlist == qh->facet_list && allfacets && !facets) {
+    vertices= qh_settemp(qh, qh->num_vertices);
+    FORALLvertices {
+      vertex->visitid= qh->vertex_visit;
+      qh_setappend(qh, &vertices, vertex);
+    }
+  }else {
+    vertices= qh_settemp(qh, qh->TEMPsize);
+    FORALLfacet_(facetlist) {
+      if (!allfacets && qh_skipfacet(qh, facet))
+        continue;
+      FOREACHvertex_(facet->vertices) {
+        if (vertex->visitid != qh->vertex_visit) {
+          vertex->visitid= qh->vertex_visit;
+          qh_setappend(qh, &vertices, vertex);
+        }
+      }
+    }
+  }
+  FOREACHfacet_(facets) {
+    if (!allfacets && qh_skipfacet(qh, facet))
+      continue;
+    FOREACHvertex_(facet->vertices) {
+      if (vertex->visitid != qh->vertex_visit) {
+        vertex->visitid= qh->vertex_visit;
+        qh_setappend(qh, &vertices, vertex);
+      }
+    }
+  }
+  return vertices;
+} /* facetvertices */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="geomplanes">-</a>
+
+  qh_geomplanes(qh, facet, outerplane, innerplane )
+    return outer and inner planes for Geomview
+    qh.PRINTradius is size of vertices and points (includes qh.JOGGLEmax)
+
+  notes:
+    assume precise calculations in io_r.c with roundoff covered by qh_GEOMepsilon
+*/
+void qh_geomplanes(qhT *qh, facetT *facet, realT *outerplane, realT *innerplane) {
+  realT radius;
+
+  if (qh->MERGING || qh->JOGGLEmax < REALmax/2) {
+    qh_outerinner(qh, facet, outerplane, innerplane);
+    radius= qh->PRINTradius;
+    if (qh->JOGGLEmax < REALmax/2)
+      radius -= qh->JOGGLEmax * sqrt((realT)qh->hull_dim);  /* already accounted for in qh_outerinner() */
+    *outerplane += radius;
+    *innerplane -= radius;
+    if (qh->PRINTcoplanar || qh->PRINTspheres) {
+      *outerplane += qh->MAXabs_coord * qh_GEOMepsilon;
+      *innerplane -= qh->MAXabs_coord * qh_GEOMepsilon;
+    }
+  }else
+    *innerplane= *outerplane= 0;
+} /* geomplanes */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="markkeep">-</a>
+
+  qh_markkeep(qh, facetlist )
+    restrict good facets for qh.KEEParea, qh.KEEPmerge, and qh.KEEPminArea
+    ignores visible facets (!part of convex hull)
+
+  returns:
+    may clear facet->good
+    recomputes qh.num_good
+
+  notes:
+    only called by qh_prepare_output after qh_findgood_all
+    does not throw errors except memory/corruption of qset_r.c
+
+  design:
+    get set of good facets
+    if qh.KEEParea
+      sort facets by area
+      clear facet->good for all but n largest facets
+    if qh.KEEPmerge
+      sort facets by merge count
+      clear facet->good for all but n most merged facets
+    if qh.KEEPminarea
+      clear facet->good if area too small
+    update qh.num_good
+*/
+void qh_markkeep(qhT *qh, facetT *facetlist) {
+  facetT *facet, **facetp;
+  setT *facets= qh_settemp(qh, qh->num_facets);
+  int size, count;
+
+  trace2((qh, qh->ferr, 2006, "qh_markkeep: only keep %d largest and/or %d most merged facets and/or min area %.2g\n",
+          qh->KEEParea, qh->KEEPmerge, qh->KEEPminArea));
+  FORALLfacet_(facetlist) {
+    if (!facet->visible && facet->good)
+      qh_setappend(qh, &facets, facet);
+  }
+  size= qh_setsize(qh, facets);
+  if (qh->KEEParea) {
+    qsort(SETaddr_(facets, facetT), (size_t)size,
+             sizeof(facetT *), qh_compare_facetarea);
+    if ((count= size - qh->KEEParea) > 0) {
+      FOREACHfacet_(facets) {
+        facet->good= False;
+        if (--count == 0)
+          break;
+      }
+    }
+  }
+  if (qh->KEEPmerge) {
+    qsort(SETaddr_(facets, facetT), (size_t)size,
+             sizeof(facetT *), qh_compare_nummerge);
+    if ((count= size - qh->KEEPmerge) > 0) {
+      FOREACHfacet_(facets) {
+        facet->good= False;
+        if (--count == 0)
+          break;
+      }
+    }
+  }
+  if (qh->KEEPminArea < REALmax/2) {
+    FOREACHfacet_(facets) {
+      if (!facet->isarea || facet->f.area < qh->KEEPminArea)
+        facet->good= False;
+    }
+  }
+  qh_settempfree(qh, &facets);
+  count= 0;
+  FORALLfacet_(facetlist) {
+    if (facet->good)
+      count++;
+  }
+  qh->num_good= count;
+} /* markkeep */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="markvoronoi">-</a>
+
+  qh_markvoronoi(qh, facetlist, facets, printall, isLower, numcenters )
+    mark voronoi vertices for printing by site pairs
+
+  returns:
+    temporary set of vertices indexed by pointid
+    isLower set if printing lower hull (i.e., at least one facet is lower hull)
+    numcenters= total number of Voronoi vertices
+    bumps qh.printoutnum for vertex-at-infinity
+    clears all facet->seen and sets facet->seen2
+
+    if selected
+      facet->visitid= Voronoi vertex id
+    else if upper hull (or 'Qu' and lower hull)
+      facet->visitid= 0
+    else
+      facet->visitid >= qh->num_facets
+
+  notes:
+    ignores qh.ATinfinity, if defined
+*/
+setT *qh_markvoronoi(qhT *qh, facetT *facetlist, setT *facets, boolT printall, boolT *isLowerp, int *numcentersp) {
+  int numcenters=0;
+  facetT *facet, **facetp;
+  setT *vertices;
+  boolT isLower= False;
+
+  qh->printoutnum++;
+  qh_clearcenters(qh, qh_ASvoronoi);  /* in case, qh_printvdiagram2 called by user */
+  qh_vertexneighbors(qh);
+  vertices= qh_pointvertex(qh);
+  if (qh->ATinfinity)
+    SETelem_(vertices, qh->num_points-1)= NULL;
+  qh->visit_id++;
+  maximize_(qh->visit_id, (unsigned int)qh->num_facets);
+  FORALLfacet_(facetlist) {
+    if (printall || !qh_skipfacet(qh, facet)) {
+      if (!facet->upperdelaunay) {
+        isLower= True;
+        break;
+      }
+    }
+  }
+  FOREACHfacet_(facets) {
+    if (printall || !qh_skipfacet(qh, facet)) {
+      if (!facet->upperdelaunay) {
+        isLower= True;
+        break;
+      }
+    }
+  }
+  FORALLfacets {
+    if (facet->normal && (facet->upperdelaunay == isLower))
+      facet->visitid= 0;  /* facetlist or facets may overwrite */
+    else
+      facet->visitid= qh->visit_id;
+    facet->seen= False;
+    facet->seen2= True;
+  }
+  numcenters++;  /* qh_INFINITE */
+  FORALLfacet_(facetlist) {
+    if (printall || !qh_skipfacet(qh, facet))
+      facet->visitid= (unsigned int)(numcenters++);
+  }
+  FOREACHfacet_(facets) {
+    if (printall || !qh_skipfacet(qh, facet))
+      facet->visitid= (unsigned int)(numcenters++);
+  }
+  *isLowerp= isLower;
+  *numcentersp= numcenters;
+  trace2((qh, qh->ferr, 2007, "qh_markvoronoi: isLower %d numcenters %d\n", isLower, numcenters));
+  return vertices;
+} /* markvoronoi */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="order_vertexneighbors">-</a>
+
+  qh_order_vertexneighbors(qh, vertex )
+    order facet neighbors of vertex by 2-d (orientation), 3-d (adjacency), or n-d (f.visitid,id)
+
+  notes:
+    error if qh_vertexneighbors not called beforehand
+    only 2-d orients the neighbors
+    for 4-d and higher
+      set or clear f.visitid for qh_compare_facetvisit
+      for example, use qh_markvoronoi (e.g., qh_printvornoi) or qh_countfacets (e.g., qh_printvneighbors)
+
+  design (2-d):
+    see qh_printextremes_2d
+  design (3-d):
+    initialize a new neighbor set with the first facet in vertex->neighbors
+    while vertex->neighbors non-empty
+      select next neighbor in the previous facet's neighbor set
+    set vertex->neighbors to the new neighbor set
+  design (n-d):
+    qsort by f.visitid, or f.facetid (qh_compare_facetvisit)
+    facet_id is negated (sorted before visit_id facets)
+*/
+void qh_order_vertexneighbors(qhT *qh, vertexT *vertex) {
+  setT *newset;
+  facetT *facet, *facetA, *facetB, *neighbor, **neighborp;
+  vertexT *vertexA;
+  int numneighbors;
+
+  trace4((qh, qh->ferr, 4018, "qh_order_vertexneighbors: order facet neighbors of v%d by 2-d (orientation), 3-d (adjacency), or n-d (f.visitid,id)\n", vertex->id));
+  if (!qh->VERTEXneighbors) {
+    qh_fprintf(qh, qh->ferr, 6428, "qhull internal error (qh_order_vertexneighbors): call qh_vertexneighbors before calling qh_order_vertexneighbors\n");
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (qh->hull_dim == 2) {
+    facetA= SETfirstt_(vertex->neighbors, facetT);
+    if (facetA->toporient ^ qh_ORIENTclock)
+      vertexA= SETfirstt_(facetA->vertices, vertexT);
+    else
+      vertexA= SETsecondt_(facetA->vertices, vertexT);
+    if (vertexA!=vertex) {
+      facetB= SETsecondt_(vertex->neighbors, facetT);
+      SETfirst_(vertex->neighbors)= facetB;
+      SETsecond_(vertex->neighbors)= facetA;
+    }
+  }else if (qh->hull_dim == 3) {
+    newset= qh_settemp(qh, qh_setsize(qh, vertex->neighbors));
+    facet= (facetT *)qh_setdellast(vertex->neighbors);
+    qh_setappend(qh, &newset, facet);
+    while (qh_setsize(qh, vertex->neighbors)) {
+      FOREACHneighbor_(vertex) {
+        if (qh_setin(facet->neighbors, neighbor)) {
+          qh_setdel(vertex->neighbors, neighbor);
+          qh_setappend(qh, &newset, neighbor);
+          facet= neighbor;
+          break;
+        }
+      }
+      if (!neighbor) {
+        qh_fprintf(qh, qh->ferr, 6066, "qhull internal error (qh_order_vertexneighbors): no neighbor of v%d for f%d\n",
+          vertex->id, facet->id);
+        qh_errexit(qh, qh_ERRqhull, facet, NULL);
+      }
+    }
+    qh_setfree(qh, &vertex->neighbors);
+    qh_settemppop(qh);
+    vertex->neighbors= newset;
+  }else { /* qh.hull_dim >= 4 */
+    numneighbors= qh_setsize(qh, vertex->neighbors);
+    qsort(SETaddr_(vertex->neighbors, facetT), (size_t)numneighbors,
+        sizeof(facetT *), qh_compare_facetvisit);
+  }
+} /* order_vertexneighbors */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="prepare_output">-</a>
+
+  qh_prepare_output(qh )
+    prepare for qh_produce_output2(qh) according to
+      qh.KEEPminArea, KEEParea, KEEPmerge, GOODvertex, GOODthreshold, GOODpoint, ONLYgood, SPLITthresholds
+    does not reset facet->good
+
+  notes
+    called by qh_produce_output, qh_new_qhull, Qhull.outputQhull
+    except for PRINTstatistics, no-op if previously called with same options
+*/
+void qh_prepare_output(qhT *qh) {
+  if (qh->VORONOI) {
+    qh_clearcenters(qh, qh_ASvoronoi);  /* must be before qh_triangulate */
+    qh_vertexneighbors(qh);
+  }
+  if (qh->TRIangulate && !qh->hasTriangulation) {
+    qh_triangulate(qh);
+    if (qh->VERIFYoutput && !qh->CHECKfrequently)
+      qh_checkpolygon(qh, qh->facet_list);
+  }
+  qh_findgood_all(qh, qh->facet_list);
+  if (qh->GETarea)
+    qh_getarea(qh, qh->facet_list);
+  if (qh->KEEParea || qh->KEEPmerge || qh->KEEPminArea < REALmax/2)
+    qh_markkeep(qh, qh->facet_list);
+  if (qh->PRINTstatistics)
+    qh_collectstatistics(qh);
+}
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printafacet">-</a>
+
+  qh_printafacet(qh, fp, format, facet, printall )
+    print facet to fp in given output format (see qh.PRINTout)
+
+  returns:
+    nop if !printall and qh_skipfacet()
+    nop if visible facet and NEWfacets and format != PRINTfacets
+    must match qh_countfacets
+
+  notes
+    preserves qh.visit_id
+    facet->normal may be null if PREmerge/MERGEexact and STOPcone before merge
+
+  see
+    qh_printbegin() and qh_printend()
+
+  design:
+    test for printing facet
+    call appropriate routine for format
+    or output results directly
+*/
+void qh_printafacet(qhT *qh, FILE *fp, qh_PRINT format, facetT *facet, boolT printall) {
+  realT color[4], offset, dist, outerplane, innerplane;
+  boolT zerodiv;
+  coordT *point, *normp, *coordp, **pointp, *feasiblep;
+  int k;
+  vertexT *vertex, **vertexp;
+  facetT *neighbor, **neighborp;
+
+  if (!printall && qh_skipfacet(qh, facet))
+    return;
+  if (facet->visible && qh->NEWfacets && format != qh_PRINTfacets)
+    return;
+  qh->printoutnum++;
+  switch (format) {
+  case qh_PRINTarea:
+    if (facet->isarea) {
+      qh_fprintf(qh, fp, 9009, qh_REAL_1, facet->f.area);
+      qh_fprintf(qh, fp, 9010, "\n");
+    }else
+      qh_fprintf(qh, fp, 9011, "0\n");
+    break;
+  case qh_PRINTcoplanars:
+    qh_fprintf(qh, fp, 9012, "%d", qh_setsize(qh, facet->coplanarset));
+    FOREACHpoint_(facet->coplanarset)
+      qh_fprintf(qh, fp, 9013, " %d", qh_pointid(qh, point));
+    qh_fprintf(qh, fp, 9014, "\n");
+    break;
+  case qh_PRINTcentrums:
+    qh_printcenter(qh, fp, format, NULL, facet);
+    break;
+  case qh_PRINTfacets:
+    qh_printfacet(qh, fp, facet);
+    break;
+  case qh_PRINTfacets_xridge:
+    qh_printfacetheader(qh, fp, facet);
+    break;
+  case qh_PRINTgeom:  /* either 2 , 3, or 4-d by qh_printbegin */
+    if (!facet->normal)
+      break;
+    for (k=qh->hull_dim; k--; ) {
+      color[k]= (facet->normal[k]+1.0)/2.0;
+      maximize_(color[k], -1.0);
+      minimize_(color[k], +1.0);
+    }
+    qh_projectdim3(qh, color, color);
+    if (qh->PRINTdim != qh->hull_dim)
+      qh_normalize2(qh, color, 3, True, NULL, NULL);
+    if (qh->hull_dim <= 2)
+      qh_printfacet2geom(qh, fp, facet, color);
+    else if (qh->hull_dim == 3) {
+      if (facet->simplicial)
+        qh_printfacet3geom_simplicial(qh, fp, facet, color);
+      else
+        qh_printfacet3geom_nonsimplicial(qh, fp, facet, color);
+    }else {
+      if (facet->simplicial)
+        qh_printfacet4geom_simplicial(qh, fp, facet, color);
+      else
+        qh_printfacet4geom_nonsimplicial(qh, fp, facet, color);
+    }
+    break;
+  case qh_PRINTids:
+    qh_fprintf(qh, fp, 9015, "%d\n", facet->id);
+    break;
+  case qh_PRINTincidences:
+  case qh_PRINToff:
+  case qh_PRINTtriangles:
+    if (qh->hull_dim == 3 && format != qh_PRINTtriangles)
+      qh_printfacet3vertex(qh, fp, facet, format);
+    else if (facet->simplicial || qh->hull_dim == 2 || format == qh_PRINToff)
+      qh_printfacetNvertex_simplicial(qh, fp, facet, format);
+    else
+      qh_printfacetNvertex_nonsimplicial(qh, fp, facet, qh->printoutvar++, format);
+    break;
+  case qh_PRINTinner:
+    qh_outerinner(qh, facet, NULL, &innerplane);
+    offset= facet->offset - innerplane;
+    goto LABELprintnorm;
+    break; /* prevent warning */
+  case qh_PRINTmerges:
+    qh_fprintf(qh, fp, 9016, "%d\n", facet->nummerge);
+    break;
+  case qh_PRINTnormals:
+    offset= facet->offset;
+    goto LABELprintnorm;
+    break; /* prevent warning */
+  case qh_PRINTouter:
+    qh_outerinner(qh, facet, &outerplane, NULL);
+    offset= facet->offset - outerplane;
+  LABELprintnorm:
+    if (!facet->normal) {
+      qh_fprintf(qh, fp, 9017, "no normal for facet f%d\n", facet->id);
+      break;
+    }
+    if (qh->CDDoutput) {
+      qh_fprintf(qh, fp, 9018, qh_REAL_1, -offset);
+      for (k=0; k < qh->hull_dim; k++)
+        qh_fprintf(qh, fp, 9019, qh_REAL_1, -facet->normal[k]);
+    }else {
+      for (k=0; k < qh->hull_dim; k++)
+        qh_fprintf(qh, fp, 9020, qh_REAL_1, facet->normal[k]);
+      qh_fprintf(qh, fp, 9021, qh_REAL_1, offset);
+    }
+    qh_fprintf(qh, fp, 9022, "\n");
+    break;
+  case qh_PRINTmathematica:  /* either 2 or 3-d by qh_printbegin */
+  case qh_PRINTmaple:
+    if (qh->hull_dim == 2)
+      qh_printfacet2math(qh, fp, facet, format, qh->printoutvar++);
+    else
+      qh_printfacet3math(qh, fp, facet, format, qh->printoutvar++);
+    break;
+  case qh_PRINTneighbors:
+    qh_fprintf(qh, fp, 9023, "%d", qh_setsize(qh, facet->neighbors));
+    FOREACHneighbor_(facet)
+      qh_fprintf(qh, fp, 9024, " %d",
+               neighbor->visitid ? neighbor->visitid - 1: 0 - neighbor->id);
+    qh_fprintf(qh, fp, 9025, "\n");
+    break;
+  case qh_PRINTpointintersect:
+    if (!qh->feasible_point) {
+      qh_fprintf(qh, qh->ferr, 6067, "qhull input error (qh_printafacet): option 'Fp' needs qh->feasible_point\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    if (facet->offset > 0)
+      goto LABELprintinfinite;
+    point= coordp= (coordT *)qh_memalloc(qh, qh->normal_size);
+    normp= facet->normal;
+    feasiblep= qh->feasible_point;
+    if (facet->offset < -qh->MINdenom) {
+      for (k=qh->hull_dim; k--; )
+        *(coordp++)= (*(normp++) / - facet->offset) + *(feasiblep++);
+    }else {
+      for (k=qh->hull_dim; k--; ) {
+        *(coordp++)= qh_divzero(*(normp++), facet->offset, qh->MINdenom_1,
+                                 &zerodiv) + *(feasiblep++);
+        if (zerodiv) {
+          qh_memfree(qh, point, qh->normal_size);
+          goto LABELprintinfinite;
+        }
+      }
+    }
+    qh_printpoint(qh, fp, NULL, point);
+    qh_memfree(qh, point, qh->normal_size);
+    break;
+  LABELprintinfinite:
+    for (k=qh->hull_dim; k--; )
+      qh_fprintf(qh, fp, 9026, qh_REAL_1, qh_INFINITE);
+    qh_fprintf(qh, fp, 9027, "\n");
+    break;
+  case qh_PRINTpointnearest:
+    FOREACHpoint_(facet->coplanarset) {
+      int id, id2;
+      vertex= qh_nearvertex(qh, facet, point, &dist);
+      id= qh_pointid(qh, vertex->point);
+      id2= qh_pointid(qh, point);
+      qh_fprintf(qh, fp, 9028, "%d %d %d " qh_REAL_1 "\n", id, id2, facet->id, dist);
+    }
+    break;
+  case qh_PRINTpoints:  /* VORONOI only by qh_printbegin */
+    if (qh->CDDoutput)
+      qh_fprintf(qh, fp, 9029, "1 ");
+    qh_printcenter(qh, fp, format, NULL, facet);
+    break;
+  case qh_PRINTvertices:
+    qh_fprintf(qh, fp, 9030, "%d", qh_setsize(qh, facet->vertices));
+    FOREACHvertex_(facet->vertices)
+      qh_fprintf(qh, fp, 9031, " %d", qh_pointid(qh, vertex->point));
+    qh_fprintf(qh, fp, 9032, "\n");
+    break;
+  default:
+    break;
+  }
+} /* printafacet */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printbegin">-</a>
+
+  qh_printbegin(qh )
+    prints header for all output formats
+
+  returns:
+    checks for valid format
+
+  notes:
+    uses qh.visit_id for 3/4off
+    changes qh.interior_point if printing centrums
+    qh_countfacets clears facet->visitid for non-good facets
+
+  see
+    qh_printend() and qh_printafacet()
+
+  design:
+    count facets and related statistics
+    print header for format
+*/
+void qh_printbegin(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall) {
+  int numfacets, numsimplicial, numridges, totneighbors, numcoplanars, numtricoplanars;
+  int i, num;
+  facetT *facet, **facetp;
+  vertexT *vertex, **vertexp;
+  setT *vertices;
+  pointT *point, **pointp, *pointtemp;
+
+  qh->printoutnum= 0;
+  qh_countfacets(qh, facetlist, facets, printall, &numfacets, &numsimplicial,
+      &totneighbors, &numridges, &numcoplanars, &numtricoplanars);
+  switch (format) {
+  case qh_PRINTnone:
+    break;
+  case qh_PRINTarea:
+    qh_fprintf(qh, fp, 9033, "%d\n", numfacets);
+    break;
+  case qh_PRINTcoplanars:
+    qh_fprintf(qh, fp, 9034, "%d\n", numfacets);
+    break;
+  case qh_PRINTcentrums:
+    if (qh->CENTERtype == qh_ASnone)
+      qh_clearcenters(qh, qh_AScentrum);
+    qh_fprintf(qh, fp, 9035, "%d\n%d\n", qh->hull_dim, numfacets);
+    break;
+  case qh_PRINTfacets:
+  case qh_PRINTfacets_xridge:
+    if (facetlist)
+      qh_printvertexlist(qh, fp, "Vertices and facets:\n", facetlist, facets, printall);
+    break;
+  case qh_PRINTgeom:
+    if (qh->hull_dim > 4)  /* qh_initqhull_globals also checks */
+      goto LABELnoformat;
+    if (qh->VORONOI && qh->hull_dim > 3)  /* PRINTdim == DROPdim == hull_dim-1 */
+      goto LABELnoformat;
+    if (qh->hull_dim == 2 && (qh->PRINTridges || qh->DOintersections))
+      qh_fprintf(qh, qh->ferr, 7049, "qhull warning: output for ridges and intersections not implemented in 2-d\n");
+    if (qh->hull_dim == 4 && (qh->PRINTinner || qh->PRINTouter ||
+                             (qh->PRINTdim == 4 && qh->PRINTcentrums)))
+      qh_fprintf(qh, qh->ferr, 7050, "qhull warning: output for outer/inner planes and centrums not implemented in 4-d\n");
+    if (qh->PRINTdim == 4 && (qh->PRINTspheres))
+      qh_fprintf(qh, qh->ferr, 7051, "qhull warning: output for vertices not implemented in 4-d\n");
+    if (qh->PRINTdim == 4 && qh->DOintersections && qh->PRINTnoplanes)
+      qh_fprintf(qh, qh->ferr, 7052, "qhull warning: 'Gnh' generates no output in 4-d\n");
+    if (qh->PRINTdim == 2) {
+      qh_fprintf(qh, fp, 9036, "{appearance {linewidth 3} LIST # %s | %s\n",
+              qh->rbox_command, qh->qhull_command);
+    }else if (qh->PRINTdim == 3) {
+      qh_fprintf(qh, fp, 9037, "{appearance {+edge -evert linewidth 2} LIST # %s | %s\n",
+              qh->rbox_command, qh->qhull_command);
+    }else if (qh->PRINTdim == 4) {
+      qh->visit_id++;
+      num= 0;
+      FORALLfacet_(facetlist)    /* get number of ridges to be printed */
+        qh_printend4geom(qh, NULL, facet, &num, printall);
+      FOREACHfacet_(facets)
+        qh_printend4geom(qh, NULL, facet, &num, printall);
+      qh->ridgeoutnum= num;
+      qh->printoutvar= 0;  /* counts number of ridges in output */
+      qh_fprintf(qh, fp, 9038, "LIST # %s | %s\n", qh->rbox_command, qh->qhull_command);
+    }
+
+    if (qh->PRINTdots) {
+      qh->printoutnum++;
+      num= qh->num_points + qh_setsize(qh, qh->other_points);
+      if (qh->DELAUNAY && qh->ATinfinity)
+        num--;
+      if (qh->PRINTdim == 4)
+        qh_fprintf(qh, fp, 9039, "4VECT %d %d 1\n", num, num);
+      else
+        qh_fprintf(qh, fp, 9040, "VECT %d %d 1\n", num, num);
+
+      for (i=num; i--; ) {
+        if (i % 20 == 0)
+          qh_fprintf(qh, fp, 9041, "\n");
+        qh_fprintf(qh, fp, 9042, "1 ");
+      }
+      qh_fprintf(qh, fp, 9043, "# 1 point per line\n1 ");
+      for (i=num-1; i--; ) { /* num at least 3 for D2 */
+        if (i % 20 == 0)
+          qh_fprintf(qh, fp, 9044, "\n");
+        qh_fprintf(qh, fp, 9045, "0 ");
+      }
+      qh_fprintf(qh, fp, 9046, "# 1 color for all\n");
+      FORALLpoints {
+        if (!qh->DELAUNAY || !qh->ATinfinity || qh_pointid(qh, point) != qh->num_points-1) {
+          if (qh->PRINTdim == 4)
+            qh_printpoint(qh, fp, NULL, point);
+            else
+              qh_printpoint3(qh, fp, point);
+        }
+      }
+      FOREACHpoint_(qh->other_points) {
+        if (qh->PRINTdim == 4)
+          qh_printpoint(qh, fp, NULL, point);
+        else
+          qh_printpoint3(qh, fp, point);
+      }
+      qh_fprintf(qh, fp, 9047, "0 1 1 1  # color of points\n");
+    }
+
+    if (qh->PRINTdim == 4  && !qh->PRINTnoplanes)
+      /* 4dview loads up multiple 4OFF objects slowly */
+      qh_fprintf(qh, fp, 9048, "4OFF %d %d 1\n", 3*qh->ridgeoutnum, qh->ridgeoutnum);
+    qh->PRINTcradius= 2 * qh->DISTround;  /* include test DISTround */
+    if (qh->PREmerge) {
+      maximize_(qh->PRINTcradius, qh->premerge_centrum + qh->DISTround);
+    }else if (qh->POSTmerge)
+      maximize_(qh->PRINTcradius, qh->postmerge_centrum + qh->DISTround);
+    qh->PRINTradius= qh->PRINTcradius;
+    if (qh->PRINTspheres + qh->PRINTcoplanar)
+      maximize_(qh->PRINTradius, qh->MAXabs_coord * qh_MINradius);
+    if (qh->premerge_cos < REALmax/2) {
+      maximize_(qh->PRINTradius, (1- qh->premerge_cos) * qh->MAXabs_coord);
+    }else if (!qh->PREmerge && qh->POSTmerge && qh->postmerge_cos < REALmax/2) {
+      maximize_(qh->PRINTradius, (1- qh->postmerge_cos) * qh->MAXabs_coord);
+    }
+    maximize_(qh->PRINTradius, qh->MINvisible);
+    if (qh->JOGGLEmax < REALmax/2)
+      qh->PRINTradius += qh->JOGGLEmax * sqrt((realT)qh->hull_dim);
+    if (qh->PRINTdim != 4 &&
+        (qh->PRINTcoplanar || qh->PRINTspheres || qh->PRINTcentrums)) {
+      vertices= qh_facetvertices(qh, facetlist, facets, printall);
+      if (qh->PRINTspheres && qh->PRINTdim <= 3)
+        qh_printspheres(qh, fp, vertices, qh->PRINTradius);
+      if (qh->PRINTcoplanar || qh->PRINTcentrums) {
+        qh->firstcentrum= True;
+        if (qh->PRINTcoplanar&& !qh->PRINTspheres) {
+          FOREACHvertex_(vertices)
+            qh_printpointvect2(qh, fp, vertex->point, NULL, qh->interior_point, qh->PRINTradius);
+        }
+        FORALLfacet_(facetlist) {
+          if (!printall && qh_skipfacet(qh, facet))
+            continue;
+          if (!facet->normal)
+            continue;
+          if (qh->PRINTcentrums && qh->PRINTdim <= 3)
+            qh_printcentrum(qh, fp, facet, qh->PRINTcradius);
+          if (!qh->PRINTcoplanar)
+            continue;
+          FOREACHpoint_(facet->coplanarset)
+            qh_printpointvect2(qh, fp, point, facet->normal, NULL, qh->PRINTradius);
+          FOREACHpoint_(facet->outsideset)
+            qh_printpointvect2(qh, fp, point, facet->normal, NULL, qh->PRINTradius);
+        }
+        FOREACHfacet_(facets) {
+          if (!printall && qh_skipfacet(qh, facet))
+            continue;
+          if (!facet->normal)
+            continue;
+          if (qh->PRINTcentrums && qh->PRINTdim <= 3)
+            qh_printcentrum(qh, fp, facet, qh->PRINTcradius);
+          if (!qh->PRINTcoplanar)
+            continue;
+          FOREACHpoint_(facet->coplanarset)
+            qh_printpointvect2(qh, fp, point, facet->normal, NULL, qh->PRINTradius);
+          FOREACHpoint_(facet->outsideset)
+            qh_printpointvect2(qh, fp, point, facet->normal, NULL, qh->PRINTradius);
+        }
+      }
+      qh_settempfree(qh, &vertices);
+    }
+    qh->visit_id++; /* for printing hyperplane intersections */
+    break;
+  case qh_PRINTids:
+    qh_fprintf(qh, fp, 9049, "%d\n", numfacets);
+    break;
+  case qh_PRINTincidences:
+    if (qh->VORONOI && qh->PRINTprecision)
+      qh_fprintf(qh, qh->ferr, 7053, "qhull warning: input sites of Delaunay regions (option 'i').  Use option 'p' or 'o' for Voronoi centers.  Disable warning with option 'Pp'\n");
+    qh->printoutvar= (int)qh->vertex_id;  /* centrum id for 4-d+, non-simplicial facets */
+    if (qh->hull_dim <= 3)
+      qh_fprintf(qh, fp, 9050, "%d\n", numfacets);
+    else
+      qh_fprintf(qh, fp, 9051, "%d\n", numsimplicial+numridges);
+    break;
+  case qh_PRINTinner:
+  case qh_PRINTnormals:
+  case qh_PRINTouter:
+    if (qh->CDDoutput)
+      qh_fprintf(qh, fp, 9052, "%s | %s\nbegin\n    %d %d real\n", qh->rbox_command,
+            qh->qhull_command, numfacets, qh->hull_dim+1);
+    else
+      qh_fprintf(qh, fp, 9053, "%d\n%d\n", qh->hull_dim+1, numfacets);
+    break;
+  case qh_PRINTmathematica:
+  case qh_PRINTmaple:
+    if (qh->hull_dim > 3)  /* qh_initbuffers also checks */
+      goto LABELnoformat;
+    if (qh->VORONOI)
+      qh_fprintf(qh, qh->ferr, 7054, "qhull warning: output is the Delaunay triangulation\n");
+    if (format == qh_PRINTmaple) {
+      if (qh->hull_dim == 2)
+        qh_fprintf(qh, fp, 9054, "PLOT(CURVES(\n");
+      else
+        qh_fprintf(qh, fp, 9055, "PLOT3D(POLYGONS(\n");
+    }else
+      qh_fprintf(qh, fp, 9056, "{\n");
+    qh->printoutvar= 0;   /* counts number of facets for notfirst */
+    break;
+  case qh_PRINTmerges:
+    qh_fprintf(qh, fp, 9057, "%d\n", numfacets);
+    break;
+  case qh_PRINTpointintersect:
+    qh_fprintf(qh, fp, 9058, "%d\n%d\n", qh->hull_dim, numfacets);
+    break;
+  case qh_PRINTneighbors:
+    qh_fprintf(qh, fp, 9059, "%d\n", numfacets);
+    break;
+  case qh_PRINToff:
+  case qh_PRINTtriangles:
+    if (qh->VORONOI)
+      goto LABELnoformat;
+    num= qh->hull_dim;
+    if (format == qh_PRINToff || qh->hull_dim == 2)
+      qh_fprintf(qh, fp, 9060, "%d\n%d %d %d\n", num,
+        qh->num_points+qh_setsize(qh, qh->other_points), numfacets, totneighbors/2);
+    else { /* qh_PRINTtriangles */
+      qh->printoutvar= qh->num_points+qh_setsize(qh, qh->other_points); /* first centrum */
+      if (qh->DELAUNAY)
+        num--;  /* drop last dimension */
+      qh_fprintf(qh, fp, 9061, "%d\n%d %d %d\n", num, qh->printoutvar
+        + numfacets - numsimplicial, numsimplicial + numridges, totneighbors/2);
+    }
+    FORALLpoints
+      qh_printpointid(qh, qh->fout, NULL, num, point, qh_IDunknown);
+    FOREACHpoint_(qh->other_points)
+      qh_printpointid(qh, qh->fout, NULL, num, point, qh_IDunknown);
+    if (format == qh_PRINTtriangles && qh->hull_dim > 2) {
+      FORALLfacets {
+        if (!facet->simplicial && facet->visitid)
+          qh_printcenter(qh, qh->fout, format, NULL, facet);
+      }
+    }
+    break;
+  case qh_PRINTpointnearest:
+    qh_fprintf(qh, fp, 9062, "%d\n", numcoplanars);
+    break;
+  case qh_PRINTpoints:
+    if (!qh->VORONOI)
+      goto LABELnoformat;
+    if (qh->CDDoutput)
+      qh_fprintf(qh, fp, 9063, "%s | %s\nbegin\n%d %d real\n", qh->rbox_command,
+           qh->qhull_command, numfacets, qh->hull_dim);
+    else
+      qh_fprintf(qh, fp, 9064, "%d\n%d\n", qh->hull_dim-1, numfacets);
+    break;
+  case qh_PRINTvertices:
+    qh_fprintf(qh, fp, 9065, "%d\n", numfacets);
+    break;
+  case qh_PRINTsummary:
+  default:
+  LABELnoformat:
+    qh_fprintf(qh, qh->ferr, 6068, "qhull internal error (qh_printbegin): can not use this format for dimension %d\n",
+         qh->hull_dim);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+} /* printbegin */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printcenter">-</a>
+
+  qh_printcenter(qh, fp, string, facet )
+    print facet->center as centrum or Voronoi center
+    string may be NULL.  Don't include '%' codes.
+    nop if qh->CENTERtype neither CENTERvoronoi nor CENTERcentrum
+    if upper envelope of Delaunay triangulation and point at-infinity
+      prints qh_INFINITE instead;
+
+  notes:
+    defines facet->center if needed
+    if format=PRINTgeom, adds a 0 if would otherwise be 2-d
+    Same as QhullFacet::printCenter
+*/
+void qh_printcenter(qhT *qh, FILE *fp, qh_PRINT format, const char *string, facetT *facet) {
+  int k, num;
+
+  if (qh->CENTERtype != qh_ASvoronoi && qh->CENTERtype != qh_AScentrum)
+    return;
+  if (string)
+    qh_fprintf(qh, fp, 9066, string);
+  if (qh->CENTERtype == qh_ASvoronoi) {
+    num= qh->hull_dim-1;
+    if (!facet->normal || !facet->upperdelaunay || !qh->ATinfinity) {
+      if (!facet->center)
+        facet->center= qh_facetcenter(qh, facet->vertices);
+      for (k=0; k < num; k++)
+        qh_fprintf(qh, fp, 9067, qh_REAL_1, facet->center[k]);
+    }else {
+      for (k=0; k < num; k++)
+        qh_fprintf(qh, fp, 9068, qh_REAL_1, qh_INFINITE);
+    }
+  }else /* qh.CENTERtype == qh_AScentrum */ {
+    num= qh->hull_dim;
+    if (format == qh_PRINTtriangles && qh->DELAUNAY)
+      num--;
+    if (!facet->center)
+      facet->center= qh_getcentrum(qh, facet);
+    for (k=0; k < num; k++)
+      qh_fprintf(qh, fp, 9069, qh_REAL_1, facet->center[k]);
+  }
+  if (format == qh_PRINTgeom && num == 2)
+    qh_fprintf(qh, fp, 9070, " 0\n");
+  else
+    qh_fprintf(qh, fp, 9071, "\n");
+} /* printcenter */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printcentrum">-</a>
+
+  qh_printcentrum(qh, fp, facet, radius )
+    print centrum for a facet in OOGL format
+    radius defines size of centrum
+    2-d or 3-d only
+
+  returns:
+    defines facet->center if needed
+*/
+void qh_printcentrum(qhT *qh, FILE *fp, facetT *facet, realT radius) {
+  pointT *centrum, *projpt;
+  boolT tempcentrum= False;
+  realT xaxis[4], yaxis[4], normal[4], dist;
+  realT green[3]={0, 1, 0};
+  vertexT *apex;
+  int k;
+
+  if (qh->CENTERtype == qh_AScentrum) {
+    if (!facet->center)
+      facet->center= qh_getcentrum(qh, facet);
+    centrum= facet->center;
+  }else {
+    centrum= qh_getcentrum(qh, facet);
+    tempcentrum= True;
+  }
+  qh_fprintf(qh, fp, 9072, "{appearance {-normal -edge normscale 0} ");
+  if (qh->firstcentrum) {
+    qh->firstcentrum= False;
+    qh_fprintf(qh, fp, 9073, "{INST geom { define centrum CQUAD  # f%d\n\
+-0.3 -0.3 0.0001     0 0 1 1\n\
+ 0.3 -0.3 0.0001     0 0 1 1\n\
+ 0.3  0.3 0.0001     0 0 1 1\n\
+-0.3  0.3 0.0001     0 0 1 1 } transform { \n", facet->id);
+  }else
+    qh_fprintf(qh, fp, 9074, "{INST geom { : centrum } transform { # f%d\n", facet->id);
+  apex= SETfirstt_(facet->vertices, vertexT);
+  qh_distplane(qh, apex->point, facet, &dist);
+  projpt= qh_projectpoint(qh, apex->point, facet, dist);
+  for (k=qh->hull_dim; k--; ) {
+    xaxis[k]= projpt[k] - centrum[k];
+    normal[k]= facet->normal[k];
+  }
+  if (qh->hull_dim == 2) {
+    xaxis[2]= 0;
+    normal[2]= 0;
+  }else if (qh->hull_dim == 4) {
+    qh_projectdim3(qh, xaxis, xaxis);
+    qh_projectdim3(qh, normal, normal);
+    qh_normalize2(qh, normal, qh->PRINTdim, True, NULL, NULL);
+  }
+  qh_crossproduct(3, xaxis, normal, yaxis);
+  qh_fprintf(qh, fp, 9075, "%8.4g %8.4g %8.4g 0\n", xaxis[0], xaxis[1], xaxis[2]);
+  qh_fprintf(qh, fp, 9076, "%8.4g %8.4g %8.4g 0\n", yaxis[0], yaxis[1], yaxis[2]);
+  qh_fprintf(qh, fp, 9077, "%8.4g %8.4g %8.4g 0\n", normal[0], normal[1], normal[2]);
+  qh_printpoint3(qh, fp, centrum);
+  qh_fprintf(qh, fp, 9078, "1 }}}\n");
+  qh_memfree(qh, projpt, qh->normal_size);
+  qh_printpointvect(qh, fp, centrum, facet->normal, NULL, radius, green);
+  if (tempcentrum)
+    qh_memfree(qh, centrum, qh->normal_size);
+} /* printcentrum */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printend">-</a>
+
+  qh_printend(qh, fp, format )
+    prints trailer for all output formats
+
+  see:
+    qh_printbegin() and qh_printafacet()
+
+*/
+void qh_printend(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall) {
+  int num;
+  facetT *facet, **facetp;
+
+  if (!qh->printoutnum)
+    qh_fprintf(qh, qh->ferr, 7055, "qhull warning: no facets printed\n");
+  switch (format) {
+  case qh_PRINTgeom:
+    if (qh->hull_dim == 4 && qh->DROPdim < 0  && !qh->PRINTnoplanes) {
+      qh->visit_id++;
+      num= 0;
+      FORALLfacet_(facetlist)
+        qh_printend4geom(qh, fp, facet,&num, printall);
+      FOREACHfacet_(facets)
+        qh_printend4geom(qh, fp, facet, &num, printall);
+      if (num != qh->ridgeoutnum || qh->printoutvar != qh->ridgeoutnum) {
+        qh_fprintf(qh, qh->ferr, 6069, "qhull internal error (qh_printend): number of ridges %d != number printed %d and at end %d\n", qh->ridgeoutnum, qh->printoutvar, num);
+        qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+      }
+    }else
+      qh_fprintf(qh, fp, 9079, "}\n");
+    break;
+  case qh_PRINTinner:
+  case qh_PRINTnormals:
+  case qh_PRINTouter:
+    if (qh->CDDoutput)
+      qh_fprintf(qh, fp, 9080, "end\n");
+    break;
+  case qh_PRINTmaple:
+    qh_fprintf(qh, fp, 9081, "));\n");
+    break;
+  case qh_PRINTmathematica:
+    qh_fprintf(qh, fp, 9082, "}\n");
+    break;
+  case qh_PRINTpoints:
+    if (qh->CDDoutput)
+      qh_fprintf(qh, fp, 9083, "end\n");
+    break;
+  default:
+    break;
+  }
+} /* printend */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printend4geom">-</a>
+
+  qh_printend4geom(qh, fp, facet, numridges, printall )
+    helper function for qh_printbegin/printend
+
+  returns:
+    number of printed ridges
+
+  notes:
+    just counts printed ridges if fp=NULL
+    uses facet->visitid
+    must agree with qh_printfacet4geom...
+
+  design:
+    computes color for facet from its normal
+    prints each ridge of facet
+*/
+void qh_printend4geom(qhT *qh, FILE *fp, facetT *facet, int *nump, boolT printall) {
+  realT color[3];
+  int i, num= *nump;
+  facetT *neighbor, **neighborp;
+  ridgeT *ridge, **ridgep;
+
+  if (!printall && qh_skipfacet(qh, facet))
+    return;
+  if (qh->PRINTnoplanes || (facet->visible && qh->NEWfacets))
+    return;
+  if (!facet->normal)
+    return;
+  if (fp) {
+    for (i=0; i < 3; i++) {
+      color[i]= (facet->normal[i]+1.0)/2.0;
+      maximize_(color[i], -1.0);
+      minimize_(color[i], +1.0);
+    }
+  }
+  facet->visitid= qh->visit_id;
+  if (facet->simplicial) {
+    FOREACHneighbor_(facet) {
+      if (neighbor->visitid != qh->visit_id) {
+        if (fp)
+          qh_fprintf(qh, fp, 9084, "3 %d %d %d %8.4g %8.4g %8.4g 1 # f%d f%d\n",
+                 3*num, 3*num+1, 3*num+2, color[0], color[1], color[2],
+                 facet->id, neighbor->id);
+        num++;
+      }
+    }
+  }else {
+    FOREACHridge_(facet->ridges) {
+      neighbor= otherfacet_(ridge, facet);
+      if (neighbor->visitid != qh->visit_id) {
+        if (fp)
+          qh_fprintf(qh, fp, 9085, "3 %d %d %d %8.4g %8.4g %8.4g 1 #r%d f%d f%d\n",
+                 3*num, 3*num+1, 3*num+2, color[0], color[1], color[2],
+                 ridge->id, facet->id, neighbor->id);
+        num++;
+      }
+    }
+  }
+  *nump= num;
+} /* printend4geom */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printextremes">-</a>
+
+  qh_printextremes(qh, fp, facetlist, facets, printall )
+    print extreme points for convex hulls or halfspace intersections
+
+  notes:
+    #points, followed by ids, one per line
+
+    sorted by id
+    same order as qh_printpoints_out if no coplanar/interior points
+*/
+void qh_printextremes(qhT *qh, FILE *fp, facetT *facetlist, setT *facets, boolT printall) {
+  setT *vertices, *points;
+  pointT *point;
+  vertexT *vertex, **vertexp;
+  int id;
+  int numpoints=0, point_i, point_n;
+  int allpoints= qh->num_points + qh_setsize(qh, qh->other_points);
+
+  points= qh_settemp(qh, allpoints);
+  qh_setzero(qh, points, 0, allpoints);
+  vertices= qh_facetvertices(qh, facetlist, facets, printall);
+  FOREACHvertex_(vertices) {
+    id= qh_pointid(qh, vertex->point);
+    if (id >= 0) {
+      SETelem_(points, id)= vertex->point;
+      numpoints++;
+    }
+  }
+  qh_settempfree(qh, &vertices);
+  qh_fprintf(qh, fp, 9086, "%d\n", numpoints);
+  FOREACHpoint_i_(qh, points) {
+    if (point)
+      qh_fprintf(qh, fp, 9087, "%d\n", point_i);
+  }
+  qh_settempfree(qh, &points);
+} /* printextremes */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printextremes_2d">-</a>
+
+  qh_printextremes_2d(qh, fp, facetlist, facets, printall )
+    prints point ids for facets in qh_ORIENTclock order
+
+  notes:
+    #points, followed by ids, one per line
+    if facetlist/facets are disjoint than the output includes skips
+    errors if facets form a loop
+    does not print coplanar points
+*/
+void qh_printextremes_2d(qhT *qh, FILE *fp, facetT *facetlist, setT *facets, boolT printall) {
+  int numfacets, numridges, totneighbors, numcoplanars, numsimplicial, numtricoplanars;
+  setT *vertices;
+  facetT *facet, *startfacet, *nextfacet;
+  vertexT *vertexA, *vertexB;
+
+  qh_countfacets(qh, facetlist, facets, printall, &numfacets, &numsimplicial,
+      &totneighbors, &numridges, &numcoplanars, &numtricoplanars); /* marks qh->visit_id */
+  vertices= qh_facetvertices(qh, facetlist, facets, printall);
+  qh_fprintf(qh, fp, 9088, "%d\n", qh_setsize(qh, vertices));
+  qh_settempfree(qh, &vertices);
+  if (!numfacets)
+    return;
+  facet= startfacet= facetlist ? facetlist : SETfirstt_(facets, facetT);
+  qh->vertex_visit++;
+  qh->visit_id++;
+  do {
+    if (facet->toporient ^ qh_ORIENTclock) {
+      vertexA= SETfirstt_(facet->vertices, vertexT);
+      vertexB= SETsecondt_(facet->vertices, vertexT);
+      nextfacet= SETfirstt_(facet->neighbors, facetT);
+    }else {
+      vertexA= SETsecondt_(facet->vertices, vertexT);
+      vertexB= SETfirstt_(facet->vertices, vertexT);
+      nextfacet= SETsecondt_(facet->neighbors, facetT);
+    }
+    if (facet->visitid == qh->visit_id) {
+      qh_fprintf(qh, qh->ferr, 6218, "qhull internal error (qh_printextremes_2d): loop in facet list.  facet %d nextfacet %d\n",
+                 facet->id, nextfacet->id);
+      qh_errexit2(qh, qh_ERRqhull, facet, nextfacet);
+    }
+    if (facet->visitid) {
+      if (vertexA->visitid != qh->vertex_visit) {
+        vertexA->visitid= qh->vertex_visit;
+        qh_fprintf(qh, fp, 9089, "%d\n", qh_pointid(qh, vertexA->point));
+      }
+      if (vertexB->visitid != qh->vertex_visit) {
+        vertexB->visitid= qh->vertex_visit;
+        qh_fprintf(qh, fp, 9090, "%d\n", qh_pointid(qh, vertexB->point));
+      }
+    }
+    facet->visitid= qh->visit_id;
+    facet= nextfacet;
+  }while (facet && facet != startfacet);
+} /* printextremes_2d */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printextremes_d">-</a>
+
+  qh_printextremes_d(qh, fp, facetlist, facets, printall )
+    print extreme points of input sites for Delaunay triangulations
+
+  notes:
+    #points, followed by ids, one per line
+
+    unordered
+*/
+void qh_printextremes_d(qhT *qh, FILE *fp, facetT *facetlist, setT *facets, boolT printall) {
+  setT *vertices;
+  vertexT *vertex, **vertexp;
+  boolT upperseen, lowerseen;
+  facetT *neighbor, **neighborp;
+  int numpoints=0;
+
+  vertices= qh_facetvertices(qh, facetlist, facets, printall);
+  qh_vertexneighbors(qh);
+  FOREACHvertex_(vertices) {
+    upperseen= lowerseen= False;
+    FOREACHneighbor_(vertex) {
+      if (neighbor->upperdelaunay)
+        upperseen= True;
+      else
+        lowerseen= True;
+    }
+    if (upperseen && lowerseen) {
+      vertex->seen= True;
+      numpoints++;
+    }else
+      vertex->seen= False;
+  }
+  qh_fprintf(qh, fp, 9091, "%d\n", numpoints);
+  FOREACHvertex_(vertices) {
+    if (vertex->seen)
+      qh_fprintf(qh, fp, 9092, "%d\n", qh_pointid(qh, vertex->point));
+  }
+  qh_settempfree(qh, &vertices);
+} /* printextremes_d */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet">-</a>
+
+  qh_printfacet(qh, fp, facet )
+    prints all fields of a facet to fp
+
+  notes:
+    ridges printed in neighbor order
+*/
+void qh_printfacet(qhT *qh, FILE *fp, facetT *facet) {
+
+  qh_printfacetheader(qh, fp, facet);
+  if (facet->ridges)
+    qh_printfacetridges(qh, fp, facet);
+} /* printfacet */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet2geom">-</a>
+
+  qh_printfacet2geom(qh, fp, facet, color )
+    print facet as part of a 2-d VECT for Geomview
+
+    notes:
+      assume precise calculations in io_r.c with roundoff covered by qh_GEOMepsilon
+      mindist is calculated within io_r.c.  maxoutside is calculated elsewhere
+      so a DISTround error may have occurred.
+*/
+void qh_printfacet2geom(qhT *qh, FILE *fp, facetT *facet, realT color[3]) {
+  pointT *point0, *point1;
+  realT mindist, innerplane, outerplane;
+  int k;
+
+  qh_facet2point(qh, facet, &point0, &point1, &mindist);
+  qh_geomplanes(qh, facet, &outerplane, &innerplane);
+  if (qh->PRINTouter || (!qh->PRINTnoplanes && !qh->PRINTinner))
+    qh_printfacet2geom_points(qh, fp, point0, point1, facet, outerplane, color);
+  if (qh->PRINTinner || (!qh->PRINTnoplanes && !qh->PRINTouter &&
+                outerplane - innerplane > 2 * qh->MAXabs_coord * qh_GEOMepsilon)) {
+    for (k=3; k--; )
+      color[k]= 1.0 - color[k];
+    qh_printfacet2geom_points(qh, fp, point0, point1, facet, innerplane, color);
+  }
+  qh_memfree(qh, point1, qh->normal_size);
+  qh_memfree(qh, point0, qh->normal_size);
+} /* printfacet2geom */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet2geom_points">-</a>
+
+  qh_printfacet2geom_points(qh, fp, point1, point2, facet, offset, color )
+    prints a 2-d facet as a VECT with 2 points at some offset.
+    The points are on the facet's plane.
+*/
+void qh_printfacet2geom_points(qhT *qh, FILE *fp, pointT *point1, pointT *point2,
+                               facetT *facet, realT offset, realT color[3]) {
+  pointT *p1= point1, *p2= point2;
+
+  qh_fprintf(qh, fp, 9093, "VECT 1 2 1 2 1 # f%d\n", facet->id);
+  if (offset != 0.0) {
+    p1= qh_projectpoint(qh, p1, facet, -offset);
+    p2= qh_projectpoint(qh, p2, facet, -offset);
+  }
+  qh_fprintf(qh, fp, 9094, "%8.4g %8.4g %8.4g\n%8.4g %8.4g %8.4g\n",
+           p1[0], p1[1], 0.0, p2[0], p2[1], 0.0);
+  if (offset != 0.0) {
+    qh_memfree(qh, p1, qh->normal_size);
+    qh_memfree(qh, p2, qh->normal_size);
+  }
+  qh_fprintf(qh, fp, 9095, "%8.4g %8.4g %8.4g 1.0\n", color[0], color[1], color[2]);
+} /* printfacet2geom_points */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet2math">-</a>
+
+  qh_printfacet2math(qh, fp, facet, format, notfirst )
+    print 2-d Maple or Mathematica output for a facet
+    may be non-simplicial
+
+  notes:
+    use %16.8f since Mathematica 2.2 does not handle exponential format
+    see qh_printfacet3math
+*/
+void qh_printfacet2math(qhT *qh, FILE *fp, facetT *facet, qh_PRINT format, int notfirst) {
+  pointT *point0, *point1;
+  realT mindist;
+  const char *pointfmt;
+
+  qh_facet2point(qh, facet, &point0, &point1, &mindist);
+  if (notfirst)
+    qh_fprintf(qh, fp, 9096, ",");
+  if (format == qh_PRINTmaple)
+    pointfmt= "[[%16.8f, %16.8f], [%16.8f, %16.8f]]\n";
+  else
+    pointfmt= "Line[{{%16.8f, %16.8f}, {%16.8f, %16.8f}}]\n";
+  qh_fprintf(qh, fp, 9097, pointfmt, point0[0], point0[1], point1[0], point1[1]);
+  qh_memfree(qh, point1, qh->normal_size);
+  qh_memfree(qh, point0, qh->normal_size);
+} /* printfacet2math */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet3geom_nonsimplicial">-</a>
+
+  qh_printfacet3geom_nonsimplicial(qh, fp, facet, color )
+    print Geomview OFF for a 3-d nonsimplicial facet.
+    if DOintersections, prints ridges to unvisited neighbors(qh->visit_id)
+
+  notes
+    uses facet->visitid for intersections and ridges
+*/
+void qh_printfacet3geom_nonsimplicial(qhT *qh, FILE *fp, facetT *facet, realT color[3]) {
+  ridgeT *ridge, **ridgep;
+  setT *projectedpoints, *vertices;
+  vertexT *vertex, **vertexp, *vertexA, *vertexB;
+  pointT *projpt, *point, **pointp;
+  facetT *neighbor;
+  realT dist, outerplane, innerplane;
+  int cntvertices, k;
+  realT black[3]={0, 0, 0}, green[3]={0, 1, 0};
+
+  qh_geomplanes(qh, facet, &outerplane, &innerplane);
+  vertices= qh_facet3vertex(qh, facet); /* oriented */
+  cntvertices= qh_setsize(qh, vertices);
+  projectedpoints= qh_settemp(qh, cntvertices);
+  FOREACHvertex_(vertices) {
+    zinc_(Zdistio);
+    qh_distplane(qh, vertex->point, facet, &dist);
+    projpt= qh_projectpoint(qh, vertex->point, facet, dist);
+    qh_setappend(qh, &projectedpoints, projpt);
+  }
+  if (qh->PRINTouter || (!qh->PRINTnoplanes && !qh->PRINTinner))
+    qh_printfacet3geom_points(qh, fp, projectedpoints, facet, outerplane, color);
+  if (qh->PRINTinner || (!qh->PRINTnoplanes && !qh->PRINTouter &&
+                outerplane - innerplane > 2 * qh->MAXabs_coord * qh_GEOMepsilon)) {
+    for (k=3; k--; )
+      color[k]= 1.0 - color[k];
+    qh_printfacet3geom_points(qh, fp, projectedpoints, facet, innerplane, color);
+  }
+  FOREACHpoint_(projectedpoints)
+    qh_memfree(qh, point, qh->normal_size);
+  qh_settempfree(qh, &projectedpoints);
+  qh_settempfree(qh, &vertices);
+  if ((qh->DOintersections || qh->PRINTridges)
+  && (!facet->visible || !qh->NEWfacets)) {
+    facet->visitid= qh->visit_id;
+    FOREACHridge_(facet->ridges) {
+      neighbor= otherfacet_(ridge, facet);
+      if (neighbor->visitid != qh->visit_id) {
+        if (qh->DOintersections)
+          qh_printhyperplaneintersection(qh, fp, facet, neighbor, ridge->vertices, black);
+        if (qh->PRINTridges) {
+          vertexA= SETfirstt_(ridge->vertices, vertexT);
+          vertexB= SETsecondt_(ridge->vertices, vertexT);
+          qh_printline3geom(qh, fp, vertexA->point, vertexB->point, green);
+        }
+      }
+    }
+  }
+} /* printfacet3geom_nonsimplicial */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet3geom_points">-</a>
+
+  qh_printfacet3geom_points(qh, fp, points, facet, offset )
+    prints a 3-d facet as OFF Geomview object.
+    offset is relative to the facet's hyperplane
+    Facet is determined as a list of points
+*/
+void qh_printfacet3geom_points(qhT *qh, FILE *fp, setT *points, facetT *facet, realT offset, realT color[3]) {
+  int k, n= qh_setsize(qh, points), i;
+  pointT *point, **pointp;
+  setT *printpoints;
+
+  qh_fprintf(qh, fp, 9098, "{ OFF %d 1 1 # f%d\n", n, facet->id);
+  if (offset != 0.0) {
+    printpoints= qh_settemp(qh, n);
+    FOREACHpoint_(points)
+      qh_setappend(qh, &printpoints, qh_projectpoint(qh, point, facet, -offset));
+  }else
+    printpoints= points;
+  FOREACHpoint_(printpoints) {
+    for (k=0; k < qh->hull_dim; k++) {
+      if (k == qh->DROPdim)
+        qh_fprintf(qh, fp, 9099, "0 ");
+      else
+        qh_fprintf(qh, fp, 9100, "%8.4g ", point[k]);
+    }
+    if (printpoints != points)
+      qh_memfree(qh, point, qh->normal_size);
+    qh_fprintf(qh, fp, 9101, "\n");
+  }
+  if (printpoints != points)
+    qh_settempfree(qh, &printpoints);
+  qh_fprintf(qh, fp, 9102, "%d ", n);
+  for (i=0; i < n; i++)
+    qh_fprintf(qh, fp, 9103, "%d ", i);
+  qh_fprintf(qh, fp, 9104, "%8.4g %8.4g %8.4g 1.0 }\n", color[0], color[1], color[2]);
+} /* printfacet3geom_points */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet3geom_simplicial">-</a>
+
+  qh_printfacet3geom_simplicial(qh )
+    print Geomview OFF for a 3-d simplicial facet.
+
+  notes:
+    may flip color
+    uses facet->visitid for intersections and ridges
+
+    assume precise calculations in io_r.c with roundoff covered by qh_GEOMepsilon
+    innerplane may be off by qh->DISTround.  Maxoutside is calculated elsewhere
+    so a DISTround error may have occurred.
+*/
+void qh_printfacet3geom_simplicial(qhT *qh, FILE *fp, facetT *facet, realT color[3]) {
+  setT *points, *vertices;
+  vertexT *vertex, **vertexp, *vertexA, *vertexB;
+  facetT *neighbor, **neighborp;
+  realT outerplane, innerplane;
+  realT black[3]={0, 0, 0}, green[3]={0, 1, 0};
+  int k;
+
+  qh_geomplanes(qh, facet, &outerplane, &innerplane);
+  vertices= qh_facet3vertex(qh, facet);
+  points= qh_settemp(qh, qh->TEMPsize);
+  FOREACHvertex_(vertices)
+    qh_setappend(qh, &points, vertex->point);
+  if (qh->PRINTouter || (!qh->PRINTnoplanes && !qh->PRINTinner))
+    qh_printfacet3geom_points(qh, fp, points, facet, outerplane, color);
+  if (qh->PRINTinner || (!qh->PRINTnoplanes && !qh->PRINTouter &&
+              outerplane - innerplane > 2 * qh->MAXabs_coord * qh_GEOMepsilon)) {
+    for (k=3; k--; )
+      color[k]= 1.0 - color[k];
+    qh_printfacet3geom_points(qh, fp, points, facet, innerplane, color);
+  }
+  qh_settempfree(qh, &points);
+  qh_settempfree(qh, &vertices);
+  if ((qh->DOintersections || qh->PRINTridges)
+  && (!facet->visible || !qh->NEWfacets)) {
+    facet->visitid= qh->visit_id;
+    FOREACHneighbor_(facet) {
+      if (neighbor->visitid != qh->visit_id) {
+        vertices= qh_setnew_delnthsorted(qh, facet->vertices, qh->hull_dim,
+                          SETindex_(facet->neighbors, neighbor), 0);
+        if (qh->DOintersections)
+           qh_printhyperplaneintersection(qh, fp, facet, neighbor, vertices, black);
+        if (qh->PRINTridges) {
+          vertexA= SETfirstt_(vertices, vertexT);
+          vertexB= SETsecondt_(vertices, vertexT);
+          qh_printline3geom(qh, fp, vertexA->point, vertexB->point, green);
+        }
+        qh_setfree(qh, &vertices);
+      }
+    }
+  }
+} /* printfacet3geom_simplicial */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet3math">-</a>
+
+  qh_printfacet3math(qh, fp, facet, notfirst )
+    print 3-d Maple or Mathematica output for a facet
+
+  notes:
+    may be non-simplicial
+    use %16.8f since Mathematica 2.2 does not handle exponential format
+    see qh_printfacet2math
+*/
+void qh_printfacet3math(qhT *qh, FILE *fp, facetT *facet, qh_PRINT format, int notfirst) {
+  vertexT *vertex, **vertexp;
+  setT *points, *vertices;
+  pointT *point, **pointp;
+  boolT firstpoint= True;
+  realT dist;
+  const char *pointfmt, *endfmt;
+
+  if (notfirst)
+    qh_fprintf(qh, fp, 9105, ",\n");
+  vertices= qh_facet3vertex(qh, facet);
+  points= qh_settemp(qh, qh_setsize(qh, vertices));
+  FOREACHvertex_(vertices) {
+    zinc_(Zdistio);
+    qh_distplane(qh, vertex->point, facet, &dist);
+    point= qh_projectpoint(qh, vertex->point, facet, dist);
+    qh_setappend(qh, &points, point);
+  }
+  if (format == qh_PRINTmaple) {
+    qh_fprintf(qh, fp, 9106, "[");
+    pointfmt= "[%16.8f, %16.8f, %16.8f]";
+    endfmt= "]";
+  }else {
+    qh_fprintf(qh, fp, 9107, "Polygon[{");
+    pointfmt= "{%16.8f, %16.8f, %16.8f}";
+    endfmt= "}]";
+  }
+  FOREACHpoint_(points) {
+    if (firstpoint)
+      firstpoint= False;
+    else
+      qh_fprintf(qh, fp, 9108, ",\n");
+    qh_fprintf(qh, fp, 9109, pointfmt, point[0], point[1], point[2]);
+  }
+  FOREACHpoint_(points)
+    qh_memfree(qh, point, qh->normal_size);
+  qh_settempfree(qh, &points);
+  qh_settempfree(qh, &vertices);
+  qh_fprintf(qh, fp, 9110, "%s", endfmt);
+} /* printfacet3math */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet3vertex">-</a>
+
+  qh_printfacet3vertex(qh, fp, facet, format )
+    print vertices in a 3-d facet as point ids
+
+  notes:
+    prints number of vertices first if format == qh_PRINToff
+    the facet may be non-simplicial
+*/
+void qh_printfacet3vertex(qhT *qh, FILE *fp, facetT *facet, qh_PRINT format) {
+  vertexT *vertex, **vertexp;
+  setT *vertices;
+
+  vertices= qh_facet3vertex(qh, facet);
+  if (format == qh_PRINToff)
+    qh_fprintf(qh, fp, 9111, "%d ", qh_setsize(qh, vertices));
+  FOREACHvertex_(vertices)
+    qh_fprintf(qh, fp, 9112, "%d ", qh_pointid(qh, vertex->point));
+  qh_fprintf(qh, fp, 9113, "\n");
+  qh_settempfree(qh, &vertices);
+} /* printfacet3vertex */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet4geom_nonsimplicial">-</a>
+
+  qh_printfacet4geom_nonsimplicial(qh )
+    print Geomview 4OFF file for a 4d nonsimplicial facet
+    prints all ridges to unvisited neighbors (qh.visit_id)
+    if qh.DROPdim
+      prints in OFF format
+
+  notes:
+    must agree with printend4geom()
+*/
+void qh_printfacet4geom_nonsimplicial(qhT *qh, FILE *fp, facetT *facet, realT color[3]) {
+  facetT *neighbor;
+  ridgeT *ridge, **ridgep;
+  vertexT *vertex, **vertexp;
+  pointT *point;
+  int k;
+  realT dist;
+
+  facet->visitid= qh->visit_id;
+  if (qh->PRINTnoplanes || (facet->visible && qh->NEWfacets))
+    return;
+  FOREACHridge_(facet->ridges) {
+    neighbor= otherfacet_(ridge, facet);
+    if (neighbor->visitid == qh->visit_id)
+      continue;
+    if (qh->PRINTtransparent && !neighbor->good)
+      continue;
+    if (qh->DOintersections)
+      qh_printhyperplaneintersection(qh, fp, facet, neighbor, ridge->vertices, color);
+    else {
+      if (qh->DROPdim >= 0)
+        qh_fprintf(qh, fp, 9114, "OFF 3 1 1 # f%d\n", facet->id);
+      else {
+        qh->printoutvar++;
+        qh_fprintf(qh, fp, 9115, "# r%d between f%d f%d\n", ridge->id, facet->id, neighbor->id);
+      }
+      FOREACHvertex_(ridge->vertices) {
+        zinc_(Zdistio);
+        qh_distplane(qh, vertex->point,facet, &dist);
+        point=qh_projectpoint(qh, vertex->point,facet, dist);
+        for (k=0; k < qh->hull_dim; k++) {
+          if (k != qh->DROPdim)
+            qh_fprintf(qh, fp, 9116, "%8.4g ", point[k]);
+        }
+        qh_fprintf(qh, fp, 9117, "\n");
+        qh_memfree(qh, point, qh->normal_size);
+      }
+      if (qh->DROPdim >= 0)
+        qh_fprintf(qh, fp, 9118, "3 0 1 2 %8.4g %8.4g %8.4g\n", color[0], color[1], color[2]);
+    }
+  }
+} /* printfacet4geom_nonsimplicial */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacet4geom_simplicial">-</a>
+
+  qh_printfacet4geom_simplicial(qh, fp, facet, color )
+    print Geomview 4OFF file for a 4d simplicial facet
+    prints triangles for unvisited neighbors (qh.visit_id)
+
+  notes:
+    must agree with printend4geom()
+*/
+void qh_printfacet4geom_simplicial(qhT *qh, FILE *fp, facetT *facet, realT color[3]) {
+  setT *vertices;
+  facetT *neighbor, **neighborp;
+  vertexT *vertex, **vertexp;
+  int k;
+
+  facet->visitid= qh->visit_id;
+  if (qh->PRINTnoplanes || (facet->visible && qh->NEWfacets))
+    return;
+  FOREACHneighbor_(facet) {
+    if (neighbor->visitid == qh->visit_id)
+      continue;
+    if (qh->PRINTtransparent && !neighbor->good)
+      continue;
+    vertices= qh_setnew_delnthsorted(qh, facet->vertices, qh->hull_dim,
+                          SETindex_(facet->neighbors, neighbor), 0);
+    if (qh->DOintersections)
+      qh_printhyperplaneintersection(qh, fp, facet, neighbor, vertices, color);
+    else {
+      if (qh->DROPdim >= 0)
+        qh_fprintf(qh, fp, 9119, "OFF 3 1 1 # ridge between f%d f%d\n",
+                facet->id, neighbor->id);
+      else {
+        qh->printoutvar++;
+        qh_fprintf(qh, fp, 9120, "# ridge between f%d f%d\n", facet->id, neighbor->id);
+      }
+      FOREACHvertex_(vertices) {
+        for (k=0; k < qh->hull_dim; k++) {
+          if (k != qh->DROPdim)
+            qh_fprintf(qh, fp, 9121, "%8.4g ", vertex->point[k]);
+        }
+        qh_fprintf(qh, fp, 9122, "\n");
+      }
+      if (qh->DROPdim >= 0)
+        qh_fprintf(qh, fp, 9123, "3 0 1 2 %8.4g %8.4g %8.4g\n", color[0], color[1], color[2]);
+    }
+    qh_setfree(qh, &vertices);
+  }
+} /* printfacet4geom_simplicial */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacetNvertex_nonsimplicial">-</a>
+
+  qh_printfacetNvertex_nonsimplicial(qh, fp, facet, id, format )
+    print vertices for an N-d non-simplicial facet
+    triangulates each ridge to the id
+*/
+void qh_printfacetNvertex_nonsimplicial(qhT *qh, FILE *fp, facetT *facet, int id, qh_PRINT format) {
+  vertexT *vertex, **vertexp;
+  ridgeT *ridge, **ridgep;
+
+  if (facet->visible && qh->NEWfacets)
+    return;
+  FOREACHridge_(facet->ridges) {
+    if (format == qh_PRINTtriangles)
+      qh_fprintf(qh, fp, 9124, "%d ", qh->hull_dim);
+    qh_fprintf(qh, fp, 9125, "%d ", id);
+    if ((ridge->top == facet) ^ qh_ORIENTclock) {
+      FOREACHvertex_(ridge->vertices)
+        qh_fprintf(qh, fp, 9126, "%d ", qh_pointid(qh, vertex->point));
+    }else {
+      FOREACHvertexreverse12_(ridge->vertices)
+        qh_fprintf(qh, fp, 9127, "%d ", qh_pointid(qh, vertex->point));
+    }
+    qh_fprintf(qh, fp, 9128, "\n");
+  }
+} /* printfacetNvertex_nonsimplicial */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacetNvertex_simplicial">-</a>
+
+  qh_printfacetNvertex_simplicial(qh, fp, facet, format )
+    print vertices for an N-d simplicial facet
+    prints vertices for non-simplicial facets
+      2-d facets (orientation preserved by qh_mergefacet2d)
+      PRINToff ('o') for 4-d and higher
+*/
+void qh_printfacetNvertex_simplicial(qhT *qh, FILE *fp, facetT *facet, qh_PRINT format) {
+  vertexT *vertex, **vertexp;
+
+  if (format == qh_PRINToff || format == qh_PRINTtriangles)
+    qh_fprintf(qh, fp, 9129, "%d ", qh_setsize(qh, facet->vertices));
+  if ((facet->toporient ^ qh_ORIENTclock)
+  || (qh->hull_dim > 2 && !facet->simplicial)) {
+    FOREACHvertex_(facet->vertices)
+      qh_fprintf(qh, fp, 9130, "%d ", qh_pointid(qh, vertex->point));
+  }else {
+    FOREACHvertexreverse12_(facet->vertices)
+      qh_fprintf(qh, fp, 9131, "%d ", qh_pointid(qh, vertex->point));
+  }
+  qh_fprintf(qh, fp, 9132, "\n");
+} /* printfacetNvertex_simplicial */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacetheader">-</a>
+
+  qh_printfacetheader(qh, fp, facet )
+    prints header fields of a facet to fp
+
+  notes:
+    for 'f' output and debugging
+    Same as QhullFacet::printHeader()
+*/
+void qh_printfacetheader(qhT *qh, FILE *fp, facetT *facet) {
+  pointT *point, **pointp, *furthest;
+  facetT *neighbor, **neighborp;
+  realT dist;
+
+  if (facet == qh_MERGEridge) {
+    qh_fprintf(qh, fp, 9133, " MERGEridge\n");
+    return;
+  }else if (facet == qh_DUPLICATEridge) {
+    qh_fprintf(qh, fp, 9134, " DUPLICATEridge\n");
+    return;
+  }else if (!facet) {
+    qh_fprintf(qh, fp, 9135, " NULLfacet\n");
+    return;
+  }
+  qh->old_randomdist= qh->RANDOMdist;
+  qh->RANDOMdist= False;
+  qh_fprintf(qh, fp, 9136, "- f%d\n", facet->id);
+  qh_fprintf(qh, fp, 9137, "    - flags:");
+  if (facet->toporient)
+    qh_fprintf(qh, fp, 9138, " top");
+  else
+    qh_fprintf(qh, fp, 9139, " bottom");
+  if (facet->simplicial)
+    qh_fprintf(qh, fp, 9140, " simplicial");
+  if (facet->tricoplanar)
+    qh_fprintf(qh, fp, 9141, " tricoplanar");
+  if (facet->upperdelaunay)
+    qh_fprintf(qh, fp, 9142, " upperDelaunay");
+  if (facet->visible)
+    qh_fprintf(qh, fp, 9143, " visible");
+  if (facet->newfacet)
+    qh_fprintf(qh, fp, 9144, " newfacet");
+  if (facet->tested)
+    qh_fprintf(qh, fp, 9145, " tested");
+  if (!facet->good)
+    qh_fprintf(qh, fp, 9146, " notG");
+  if (facet->seen && qh->IStracing)
+    qh_fprintf(qh, fp, 9147, " seen");
+  if (facet->seen2 && qh->IStracing)
+    qh_fprintf(qh, fp, 9418, " seen2");
+  if (facet->isarea)
+    qh_fprintf(qh, fp, 9419, " isarea");
+  if (facet->coplanarhorizon)
+    qh_fprintf(qh, fp, 9148, " coplanarhorizon");
+  if (facet->mergehorizon)
+    qh_fprintf(qh, fp, 9149, " mergehorizon");
+  if (facet->cycledone)
+    qh_fprintf(qh, fp, 9420, " cycledone");
+  if (facet->keepcentrum)
+    qh_fprintf(qh, fp, 9150, " keepcentrum");
+  if (facet->dupridge)
+    qh_fprintf(qh, fp, 9151, " dupridge");
+  if (facet->mergeridge && !facet->mergeridge2)
+    qh_fprintf(qh, fp, 9152, " mergeridge1");
+  if (facet->mergeridge2)
+    qh_fprintf(qh, fp, 9153, " mergeridge2");
+  if (facet->newmerge)
+    qh_fprintf(qh, fp, 9154, " newmerge");
+  if (facet->flipped)
+    qh_fprintf(qh, fp, 9155, " flipped");
+  if (facet->notfurthest)
+    qh_fprintf(qh, fp, 9156, " notfurthest");
+  if (facet->degenerate)
+    qh_fprintf(qh, fp, 9157, " degenerate");
+  if (facet->redundant)
+    qh_fprintf(qh, fp, 9158, " redundant");
+  qh_fprintf(qh, fp, 9159, "\n");
+  if (facet->isarea)
+    qh_fprintf(qh, fp, 9160, "    - area: %2.2g\n", facet->f.area);
+  else if (qh->NEWfacets && facet->visible && facet->f.replace)
+    qh_fprintf(qh, fp, 9161, "    - replacement: f%d\n", facet->f.replace->id);
+  else if (facet->newfacet) {
+    if (facet->f.samecycle && facet->f.samecycle != facet)
+      qh_fprintf(qh, fp, 9162, "    - shares same visible/horizon as f%d\n", facet->f.samecycle->id);
+  }else if (facet->tricoplanar /* !isarea */) {
+    if (facet->f.triowner)
+      qh_fprintf(qh, fp, 9163, "    - owner of normal & centrum is facet f%d\n", facet->f.triowner->id);
+  }else if (facet->f.newcycle)
+    qh_fprintf(qh, fp, 9164, "    - was horizon to f%d\n", facet->f.newcycle->id);
+  if (facet->nummerge == qh_MAXnummerge)
+    qh_fprintf(qh, fp, 9427, "    - merges: %dmax\n", qh_MAXnummerge);
+  else if (facet->nummerge)
+    qh_fprintf(qh, fp, 9165, "    - merges: %d\n", facet->nummerge);
+  qh_printpointid(qh, fp, "    - normal: ", qh->hull_dim, facet->normal, qh_IDunknown);
+  qh_fprintf(qh, fp, 9166, "    - offset: %10.7g\n", facet->offset);
+  if (qh->CENTERtype == qh_ASvoronoi || facet->center)
+    qh_printcenter(qh, fp, qh_PRINTfacets, "    - center: ", facet);
+#if qh_MAXoutside
+  if (facet->maxoutside > qh->DISTround) /* initial value */
+    qh_fprintf(qh, fp, 9167, "    - maxoutside: %10.7g\n", facet->maxoutside);
+#endif
+  if (!SETempty_(facet->outsideset)) {
+    furthest= (pointT *)qh_setlast(facet->outsideset);
+    if (qh_setsize(qh, facet->outsideset) < 6) {
+      qh_fprintf(qh, fp, 9168, "    - outside set(furthest p%d):\n", qh_pointid(qh, furthest));
+      FOREACHpoint_(facet->outsideset)
+        qh_printpoint(qh, fp, "     ", point);
+    }else if (qh_setsize(qh, facet->outsideset) < 21) {
+      qh_printpoints(qh, fp, "    - outside set:", facet->outsideset);
+    }else {
+      qh_fprintf(qh, fp, 9169, "    - outside set:  %d points.", qh_setsize(qh, facet->outsideset));
+      qh_printpoint(qh, fp, "  Furthest", furthest);
+    }
+#if !qh_COMPUTEfurthest
+    qh_fprintf(qh, fp, 9170, "    - furthest distance= %2.2g\n", facet->furthestdist);
+#endif
+  }
+  if (!SETempty_(facet->coplanarset)) {
+    furthest= (pointT *)qh_setlast(facet->coplanarset);
+    if (qh_setsize(qh, facet->coplanarset) < 6) {
+      qh_fprintf(qh, fp, 9171, "    - coplanar set(furthest p%d):\n", qh_pointid(qh, furthest));
+      FOREACHpoint_(facet->coplanarset)
+        qh_printpoint(qh, fp, "     ", point);
+    }else if (qh_setsize(qh, facet->coplanarset) < 21) {
+      qh_printpoints(qh, fp, "    - coplanar set:", facet->coplanarset);
+    }else {
+      qh_fprintf(qh, fp, 9172, "    - coplanar set:  %d points.", qh_setsize(qh, facet->coplanarset));
+      qh_printpoint(qh, fp, "  Furthest", furthest);
+    }
+    zinc_(Zdistio);
+    qh_distplane(qh, furthest, facet, &dist);
+    qh_fprintf(qh, fp, 9173, "      furthest distance= %2.2g\n", dist);
+  }
+  qh_printvertices(qh, fp, "    - vertices:", facet->vertices);
+  qh_fprintf(qh, fp, 9174, "    - neighboring facets:");
+  FOREACHneighbor_(facet) {
+    if (neighbor == qh_MERGEridge)
+      qh_fprintf(qh, fp, 9175, " MERGEridge");
+    else if (neighbor == qh_DUPLICATEridge)
+      qh_fprintf(qh, fp, 9176, " DUPLICATEridge");
+    else
+      qh_fprintf(qh, fp, 9177, " f%d", neighbor->id);
+  }
+  qh_fprintf(qh, fp, 9178, "\n");
+  qh->RANDOMdist= qh->old_randomdist;
+} /* printfacetheader */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacetridges">-</a>
+
+  qh_printfacetridges(qh, fp, facet )
+    prints ridges of a facet to fp
+
+  notes:
+    ridges printed in neighbor order
+    assumes the ridges exist
+    for 'f' output
+    same as QhullFacet::printRidges
+*/
+void qh_printfacetridges(qhT *qh, FILE *fp, facetT *facet) {
+  facetT *neighbor, **neighborp;
+  ridgeT *ridge, **ridgep;
+  int numridges= 0;
+  int n;
+
+  if (facet->visible && qh->NEWfacets) {
+    qh_fprintf(qh, fp, 9179, "    - ridges (tentative ids):");
+    FOREACHridge_(facet->ridges)
+      qh_fprintf(qh, fp, 9180, " r%d", ridge->id);
+    qh_fprintf(qh, fp, 9181, "\n");
+  }else {
+    qh_fprintf(qh, fp, 9182, "    - ridges:\n");
+    FOREACHridge_(facet->ridges)
+      ridge->seen= False;
+    if (qh->hull_dim == 3) {
+      ridge= SETfirstt_(facet->ridges, ridgeT);
+      while (ridge && !ridge->seen) {
+        ridge->seen= True;
+        qh_printridge(qh, fp, ridge);
+        numridges++;
+        ridge= qh_nextridge3d(ridge, facet, NULL);
+        }
+    }else {
+      FOREACHneighbor_(facet) {
+        FOREACHridge_(facet->ridges) {
+          if (otherfacet_(ridge, facet) == neighbor && !ridge->seen) {
+            ridge->seen= True;
+            qh_printridge(qh, fp, ridge);
+            numridges++;
+          }
+        }
+      }
+    }
+    n= qh_setsize(qh, facet->ridges);
+    if (n == 1 && facet->newfacet && qh->NEWtentative) {
+      qh_fprintf(qh, fp, 9411, "     - horizon ridge to visible facet\n");
+    }
+    if (numridges != n) {
+      qh_fprintf(qh, fp, 9183, "     - all ridges:");
+      FOREACHridge_(facet->ridges)
+        qh_fprintf(qh, fp, 9184, " r%d", ridge->id);
+      qh_fprintf(qh, fp, 9185, "\n");
+    }
+    /* non-3d ridges w/o non-simplicial neighbors */
+    FOREACHridge_(facet->ridges) {
+      if (!ridge->seen)
+        qh_printridge(qh, fp, ridge);
+    }
+  }
+} /* printfacetridges */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printfacets">-</a>
+
+  qh_printfacets(qh, fp, format, facetlist, facets, printall )
+    prints facetlist and/or facet set in output format
+
+  notes:
+    also used for specialized formats ('FO' and summary)
+    turns off 'Rn' option since want actual numbers
+*/
+void qh_printfacets(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall) {
+  int numfacets, numsimplicial, numridges, totneighbors, numcoplanars, numtricoplanars;
+  facetT *facet, **facetp;
+  setT *vertices;
+  coordT *center;
+  realT outerplane, innerplane;
+
+  qh->old_randomdist= qh->RANDOMdist;
+  qh->RANDOMdist= False;
+  if (qh->CDDoutput && (format == qh_PRINTcentrums || format == qh_PRINTpointintersect || format == qh_PRINToff))
+    qh_fprintf(qh, qh->ferr, 7056, "qhull warning: CDD format is not available for centrums, halfspace\nintersections, and OFF file format.\n");
+  if (format == qh_PRINTnone)
+    ; /* print nothing */
+  else if (format == qh_PRINTaverage) {
+    vertices= qh_facetvertices(qh, facetlist, facets, printall);
+    center= qh_getcenter(qh, vertices);
+    qh_fprintf(qh, fp, 9186, "%d 1\n", qh->hull_dim);
+    qh_printpointid(qh, fp, NULL, qh->hull_dim, center, qh_IDunknown);
+    qh_memfree(qh, center, qh->normal_size);
+    qh_settempfree(qh, &vertices);
+  }else if (format == qh_PRINTextremes) {
+    if (qh->DELAUNAY)
+      qh_printextremes_d(qh, fp, facetlist, facets, printall);
+    else if (qh->hull_dim == 2)
+      qh_printextremes_2d(qh, fp, facetlist, facets, printall);
+    else
+      qh_printextremes(qh, fp, facetlist, facets, printall);
+  }else if (format == qh_PRINToptions)
+    qh_fprintf(qh, fp, 9187, "Options selected for Qhull %s:\n%s\n", qh_version, qh->qhull_options);
+  else if (format == qh_PRINTpoints && !qh->VORONOI)
+    qh_printpoints_out(qh, fp, facetlist, facets, printall);
+  else if (format == qh_PRINTqhull)
+    qh_fprintf(qh, fp, 9188, "%s | %s\n", qh->rbox_command, qh->qhull_command);
+  else if (format == qh_PRINTsize) {
+    qh_fprintf(qh, fp, 9189, "0\n2 ");
+    qh_fprintf(qh, fp, 9190, qh_REAL_1, qh->totarea);
+    qh_fprintf(qh, fp, 9191, qh_REAL_1, qh->totvol);
+    qh_fprintf(qh, fp, 9192, "\n");
+  }else if (format == qh_PRINTsummary) {
+    qh_countfacets(qh, facetlist, facets, printall, &numfacets, &numsimplicial,
+      &totneighbors, &numridges, &numcoplanars, &numtricoplanars);
+    vertices= qh_facetvertices(qh, facetlist, facets, printall);
+    qh_fprintf(qh, fp, 9193, "10 %d %d %d %d %d %d %d %d %d %d\n2 ", qh->hull_dim,
+                qh->num_points + qh_setsize(qh, qh->other_points),
+                qh->num_vertices, qh->num_facets - qh->num_visible,
+                qh_setsize(qh, vertices), numfacets, numcoplanars,
+                numfacets - numsimplicial, zzval_(Zdelvertextot),
+                numtricoplanars);
+    qh_settempfree(qh, &vertices);
+    qh_outerinner(qh, NULL, &outerplane, &innerplane);
+    qh_fprintf(qh, fp, 9194, qh_REAL_2n, outerplane, innerplane);
+  }else if (format == qh_PRINTvneighbors)
+    qh_printvneighbors(qh, fp, facetlist, facets, printall);
+  else if (qh->VORONOI && format == qh_PRINToff)
+    qh_printvoronoi(qh, fp, format, facetlist, facets, printall);
+  else if (qh->VORONOI && format == qh_PRINTgeom) {
+    qh_printbegin(qh, fp, format, facetlist, facets, printall);
+    qh_printvoronoi(qh, fp, format, facetlist, facets, printall);
+    qh_printend(qh, fp, format, facetlist, facets, printall);
+  }else if (qh->VORONOI
+  && (format == qh_PRINTvertices || format == qh_PRINTinner || format == qh_PRINTouter))
+    qh_printvdiagram(qh, fp, format, facetlist, facets, printall);
+  else {
+    qh_printbegin(qh, fp, format, facetlist, facets, printall);
+    FORALLfacet_(facetlist)
+      qh_printafacet(qh, fp, format, facet, printall);
+    FOREACHfacet_(facets)
+      qh_printafacet(qh, fp, format, facet, printall);
+    qh_printend(qh, fp, format, facetlist, facets, printall);
+  }
+  qh->RANDOMdist= qh->old_randomdist;
+} /* printfacets */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printhyperplaneintersection">-</a>
+
+  qh_printhyperplaneintersection(qh, fp, facet1, facet2, vertices, color )
+    print Geomview OFF or 4OFF for the intersection of two hyperplanes in 3-d or 4-d
+*/
+void qh_printhyperplaneintersection(qhT *qh, FILE *fp, facetT *facet1, facetT *facet2,
+                   setT *vertices, realT color[3]) {
+  realT costheta, denominator, dist1, dist2, s, t, mindenom, p[4];
+  vertexT *vertex, **vertexp;
+  int i, k;
+  boolT nearzero1, nearzero2;
+
+  costheta= qh_getangle(qh, facet1->normal, facet2->normal);
+  denominator= 1 - costheta * costheta;
+  i= qh_setsize(qh, vertices);
+  if (qh->hull_dim == 3)
+    qh_fprintf(qh, fp, 9195, "VECT 1 %d 1 %d 1 ", i, i);
+  else if (qh->hull_dim == 4 && qh->DROPdim >= 0)
+    qh_fprintf(qh, fp, 9196, "OFF 3 1 1 ");
+  else
+    qh->printoutvar++;
+  qh_fprintf(qh, fp, 9197, "# intersect f%d f%d\n", facet1->id, facet2->id);
+  mindenom= 1 / (10.0 * qh->MAXabs_coord);
+  FOREACHvertex_(vertices) {
+    zadd_(Zdistio, 2);
+    qh_distplane(qh, vertex->point, facet1, &dist1);
+    qh_distplane(qh, vertex->point, facet2, &dist2);
+    s= qh_divzero(-dist1 + costheta * dist2, denominator,mindenom,&nearzero1);
+    t= qh_divzero(-dist2 + costheta * dist1, denominator,mindenom,&nearzero2);
+    if (nearzero1 || nearzero2)
+      s= t= 0.0;
+    for (k=qh->hull_dim; k--; )
+      p[k]= vertex->point[k] + facet1->normal[k] * s + facet2->normal[k] * t;
+    if (qh->PRINTdim <= 3) {
+      qh_projectdim3(qh, p, p);
+      qh_fprintf(qh, fp, 9198, "%8.4g %8.4g %8.4g # ", p[0], p[1], p[2]);
+    }else
+      qh_fprintf(qh, fp, 9199, "%8.4g %8.4g %8.4g %8.4g # ", p[0], p[1], p[2], p[3]);
+    if (nearzero1+nearzero2)
+      qh_fprintf(qh, fp, 9200, "p%d(coplanar facets)\n", qh_pointid(qh, vertex->point));
+    else
+      qh_fprintf(qh, fp, 9201, "projected p%d\n", qh_pointid(qh, vertex->point));
+  }
+  if (qh->hull_dim == 3)
+    qh_fprintf(qh, fp, 9202, "%8.4g %8.4g %8.4g 1.0\n", color[0], color[1], color[2]);
+  else if (qh->hull_dim == 4 && qh->DROPdim >= 0)
+    qh_fprintf(qh, fp, 9203, "3 0 1 2 %8.4g %8.4g %8.4g 1.0\n", color[0], color[1], color[2]);
+} /* printhyperplaneintersection */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printline3geom">-</a>
+
+  qh_printline3geom(qh, fp, pointA, pointB, color )
+    prints a line as a VECT
+    prints 0's for qh.DROPdim
+
+  notes:
+    if pointA == pointB,
+      it's a 1 point VECT
+*/
+void qh_printline3geom(qhT *qh, FILE *fp, pointT *pointA, pointT *pointB, realT color[3]) {
+  int k;
+  realT pA[4], pB[4];
+
+  qh_projectdim3(qh, pointA, pA);
+  qh_projectdim3(qh, pointB, pB);
+  if ((fabs(pA[0] - pB[0]) > 1e-3) ||
+      (fabs(pA[1] - pB[1]) > 1e-3) ||
+      (fabs(pA[2] - pB[2]) > 1e-3)) {
+    qh_fprintf(qh, fp, 9204, "VECT 1 2 1 2 1\n");
+    for (k=0; k < 3; k++)
+       qh_fprintf(qh, fp, 9205, "%8.4g ", pB[k]);
+    qh_fprintf(qh, fp, 9206, " # p%d\n", qh_pointid(qh, pointB));
+  }else
+    qh_fprintf(qh, fp, 9207, "VECT 1 1 1 1 1\n");
+  for (k=0; k < 3; k++)
+    qh_fprintf(qh, fp, 9208, "%8.4g ", pA[k]);
+  qh_fprintf(qh, fp, 9209, " # p%d\n", qh_pointid(qh, pointA));
+  qh_fprintf(qh, fp, 9210, "%8.4g %8.4g %8.4g 1\n", color[0], color[1], color[2]);
+}
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printneighborhood">-</a>
+
+  qh_printneighborhood(qh, fp, format, facetA, facetB, printall )
+    print neighborhood of one or two facets
+
+  notes:
+    calls qh_findgood_all()
+    bumps qh.visit_id
+*/
+void qh_printneighborhood(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetA, facetT *facetB, boolT printall) {
+  facetT *neighbor, **neighborp, *facet;
+  setT *facets;
+
+  if (format == qh_PRINTnone)
+    return;
+  qh_findgood_all(qh, qh->facet_list);
+  if (facetA == facetB)
+    facetB= NULL;
+  facets= qh_settemp(qh, 2*(qh_setsize(qh, facetA->neighbors)+1));
+  qh->visit_id++;
+  for (facet=facetA; facet; facet= ((facet == facetA) ? facetB : NULL)) {
+    if (facet->visitid != qh->visit_id) {
+      facet->visitid= qh->visit_id;
+      qh_setappend(qh, &facets, facet);
+    }
+    FOREACHneighbor_(facet) {
+      if (neighbor->visitid == qh->visit_id)
+        continue;
+      neighbor->visitid= qh->visit_id;
+      if (printall || !qh_skipfacet(qh, neighbor))
+        qh_setappend(qh, &facets, neighbor);
+    }
+  }
+  qh_printfacets(qh, fp, format, NULL, facets, printall);
+  qh_settempfree(qh, &facets);
+} /* printneighborhood */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printpoint">-</a>
+
+  qh_printpoint(qh, fp, string, point )
+  qh_printpointid(qh, fp, string, dim, point, id )
+    prints the coordinates of a point
+
+  returns:
+    if string is defined
+      prints 'string p%d'.  Skips p%d if id=qh_IDunknown(-1) or qh_IDnone(-3)
+
+  notes:
+    nop if point is NULL
+    Same as QhullPoint's printPoint
+*/
+void qh_printpoint(qhT *qh, FILE *fp, const char *string, pointT *point) {
+  int id= qh_pointid(qh, point);
+
+  qh_printpointid(qh, fp, string, qh->hull_dim, point, id);
+} /* printpoint */
+
+void qh_printpointid(qhT *qh, FILE *fp, const char *string, int dim, pointT *point, int id) {
+  int k;
+  realT r; /*bug fix*/
+
+  if (!point)
+    return;
+  if (string) {
+    qh_fprintf(qh, fp, 9211, "%s", string);
+    if (id != qh_IDunknown && id != qh_IDnone)
+      qh_fprintf(qh, fp, 9212, " p%d: ", id);
+  }
+  for (k=dim; k--; ) {
+    r= *point++;
+    if (string)
+      qh_fprintf(qh, fp, 9213, " %8.4g", r);
+    else
+      qh_fprintf(qh, fp, 9214, qh_REAL_1, r);
+  }
+  qh_fprintf(qh, fp, 9215, "\n");
+} /* printpointid */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printpoint3">-</a>
+
+  qh_printpoint3(qh, fp, point )
+    prints 2-d, 3-d, or 4-d point as Geomview 3-d coordinates
+*/
+void qh_printpoint3(qhT *qh, FILE *fp, pointT *point) {
+  int k;
+  realT p[4];
+
+  qh_projectdim3(qh, point, p);
+  for (k=0; k < 3; k++)
+    qh_fprintf(qh, fp, 9216, "%8.4g ", p[k]);
+  qh_fprintf(qh, fp, 9217, " # p%d\n", qh_pointid(qh, point));
+} /* printpoint3 */
+
+/*----------------------------------------
+-printpoints- print pointids for a set of points starting at index
+   see geom_r.c
+*/
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printpoints_out">-</a>
+
+  qh_printpoints_out(qh, fp, facetlist, facets, printall )
+    prints vertices, coplanar/inside points, for facets by their point coordinates
+    allows qh.CDDoutput
+
+  notes:
+    same format as qhull input
+    if no coplanar/interior points,
+      same order as qh_printextremes
+*/
+void qh_printpoints_out(qhT *qh, FILE *fp, facetT *facetlist, setT *facets, boolT printall) {
+  int allpoints= qh->num_points + qh_setsize(qh, qh->other_points);
+  int numpoints=0, point_i, point_n;
+  setT *vertices, *points;
+  facetT *facet, **facetp;
+  pointT *point, **pointp;
+  vertexT *vertex, **vertexp;
+  int id;
+
+  points= qh_settemp(qh, allpoints);
+  qh_setzero(qh, points, 0, allpoints);
+  vertices= qh_facetvertices(qh, facetlist, facets, printall);
+  FOREACHvertex_(vertices) {
+    id= qh_pointid(qh, vertex->point);
+    if (id >= 0)
+      SETelem_(points, id)= vertex->point;
+  }
+  if (qh->KEEPinside || qh->KEEPcoplanar || qh->KEEPnearinside) {
+    FORALLfacet_(facetlist) {
+      if (!printall && qh_skipfacet(qh, facet))
+        continue;
+      FOREACHpoint_(facet->coplanarset) {
+        id= qh_pointid(qh, point);
+        if (id >= 0)
+          SETelem_(points, id)= point;
+      }
+    }
+    FOREACHfacet_(facets) {
+      if (!printall && qh_skipfacet(qh, facet))
+        continue;
+      FOREACHpoint_(facet->coplanarset) {
+        id= qh_pointid(qh, point);
+        if (id >= 0)
+          SETelem_(points, id)= point;
+      }
+    }
+  }
+  qh_settempfree(qh, &vertices);
+  FOREACHpoint_i_(qh, points) {
+    if (point)
+      numpoints++;
+  }
+  if (qh->CDDoutput)
+    qh_fprintf(qh, fp, 9218, "%s | %s\nbegin\n%d %d real\n", qh->rbox_command,
+             qh->qhull_command, numpoints, qh->hull_dim + 1);
+  else
+    qh_fprintf(qh, fp, 9219, "%d\n%d\n", qh->hull_dim, numpoints);
+  FOREACHpoint_i_(qh, points) {
+    if (point) {
+      if (qh->CDDoutput)
+        qh_fprintf(qh, fp, 9220, "1 ");
+      qh_printpoint(qh, fp, NULL, point);
+    }
+  }
+  if (qh->CDDoutput)
+    qh_fprintf(qh, fp, 9221, "end\n");
+  qh_settempfree(qh, &points);
+} /* printpoints_out */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printpointvect">-</a>
+
+  qh_printpointvect(qh, fp, point, normal, center, radius, color )
+    prints a 2-d, 3-d, or 4-d point as 3-d VECT's relative to normal or to center point
+*/
+void qh_printpointvect(qhT *qh, FILE *fp, pointT *point, coordT *normal, pointT *center, realT radius, realT color[3]) {
+  realT diff[4], pointA[4];
+  int k;
+
+  for (k=qh->hull_dim; k--; ) {
+    if (center)
+      diff[k]= point[k]-center[k];
+    else if (normal)
+      diff[k]= normal[k];
+    else
+      diff[k]= 0;
+  }
+  if (center)
+    qh_normalize2(qh, diff, qh->hull_dim, True, NULL, NULL);
+  for (k=qh->hull_dim; k--; )
+    pointA[k]= point[k]+diff[k] * radius;
+  qh_printline3geom(qh, fp, point, pointA, color);
+} /* printpointvect */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printpointvect2">-</a>
+
+  qh_printpointvect2(qh, fp, point, normal, center, radius )
+    prints a 2-d, 3-d, or 4-d point as 2 3-d VECT's for an imprecise point
+*/
+void qh_printpointvect2(qhT *qh, FILE *fp, pointT *point, coordT *normal, pointT *center, realT radius) {
+  realT red[3]={1, 0, 0}, yellow[3]={1, 1, 0};
+
+  qh_printpointvect(qh, fp, point, normal, center, radius, red);
+  qh_printpointvect(qh, fp, point, normal, center, -radius, yellow);
+} /* printpointvect2 */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printridge">-</a>
+
+  qh_printridge(qh, fp, ridge )
+    prints the information in a ridge
+
+  notes:
+    for qh_printfacetridges()
+    same as operator<< [QhullRidge.cpp]
+*/
+void qh_printridge(qhT *qh, FILE *fp, ridgeT *ridge) {
+
+  qh_fprintf(qh, fp, 9222, "     - r%d", ridge->id);
+  if (ridge->tested)
+    qh_fprintf(qh, fp, 9223, " tested");
+  if (ridge->nonconvex)
+    qh_fprintf(qh, fp, 9224, " nonconvex");
+  if (ridge->mergevertex)
+    qh_fprintf(qh, fp, 9421, " mergevertex");
+  if (ridge->mergevertex2)
+    qh_fprintf(qh, fp, 9422, " mergevertex2");
+  if (ridge->simplicialtop)
+    qh_fprintf(qh, fp, 9425, " simplicialtop");
+  if (ridge->simplicialbot)
+    qh_fprintf(qh, fp, 9423, " simplicialbot");
+  qh_fprintf(qh, fp, 9225, "\n");
+  qh_printvertices(qh, fp, "           vertices:", ridge->vertices);
+  if (ridge->top && ridge->bottom)
+    qh_fprintf(qh, fp, 9226, "           between f%d and f%d\n",
+            ridge->top->id, ridge->bottom->id);
+} /* printridge */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printspheres">-</a>
+
+  qh_printspheres(qh, fp, vertices, radius )
+    prints 3-d vertices as OFF spheres
+
+  notes:
+    inflated octahedron from Stuart Levy earth/mksphere2
+*/
+void qh_printspheres(qhT *qh, FILE *fp, setT *vertices, realT radius) {
+  vertexT *vertex, **vertexp;
+
+  qh->printoutnum++;
+  qh_fprintf(qh, fp, 9227, "{appearance {-edge -normal normscale 0} {\n\
+INST geom {define vsphere OFF\n\
+18 32 48\n\
+\n\
+0 0 1\n\
+1 0 0\n\
+0 1 0\n\
+-1 0 0\n\
+0 -1 0\n\
+0 0 -1\n\
+0.707107 0 0.707107\n\
+0 -0.707107 0.707107\n\
+0.707107 -0.707107 0\n\
+-0.707107 0 0.707107\n\
+-0.707107 -0.707107 0\n\
+0 0.707107 0.707107\n\
+-0.707107 0.707107 0\n\
+0.707107 0.707107 0\n\
+0.707107 0 -0.707107\n\
+0 0.707107 -0.707107\n\
+-0.707107 0 -0.707107\n\
+0 -0.707107 -0.707107\n\
+\n\
+3 0 6 11\n\
+3 0 7 6 \n\
+3 0 9 7 \n\
+3 0 11 9\n\
+3 1 6 8 \n\
+3 1 8 14\n\
+3 1 13 6\n\
+3 1 14 13\n\
+3 2 11 13\n\
+3 2 12 11\n\
+3 2 13 15\n\
+3 2 15 12\n\
+3 3 9 12\n\
+3 3 10 9\n\
+3 3 12 16\n\
+3 3 16 10\n\
+3 4 7 10\n\
+3 4 8 7\n\
+3 4 10 17\n\
+3 4 17 8\n\
+3 5 14 17\n\
+3 5 15 14\n\
+3 5 16 15\n\
+3 5 17 16\n\
+3 6 13 11\n\
+3 7 8 6\n\
+3 9 10 7\n\
+3 11 12 9\n\
+3 14 8 17\n\
+3 15 13 14\n\
+3 16 12 15\n\
+3 17 10 16\n} transforms { TLIST\n");
+  FOREACHvertex_(vertices) {
+    qh_fprintf(qh, fp, 9228, "%8.4g 0 0 0 # v%d\n 0 %8.4g 0 0\n0 0 %8.4g 0\n",
+      radius, vertex->id, radius, radius);
+    qh_printpoint3(qh, fp, vertex->point);
+    qh_fprintf(qh, fp, 9229, "1\n");
+  }
+  qh_fprintf(qh, fp, 9230, "}}}\n");
+} /* printspheres */
+
+
+/*----------------------------------------------
+-printsummary-
+                see libqhull_r.c
+*/
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvdiagram">-</a>
+
+  qh_printvdiagram(qh, fp, format, facetlist, facets, printall )
+    print voronoi diagram
+      # of pairs of input sites
+      #indices site1 site2 vertex1 ...
+
+    sites indexed by input point id
+      point 0 is the first input point
+    vertices indexed by 'o' and 'p' order
+      vertex 0 is the 'vertex-at-infinity'
+      vertex 1 is the first Voronoi vertex
+
+  see:
+    qh_printvoronoi()
+    qh_eachvoronoi_all()
+
+  notes:
+    if all facets are upperdelaunay,
+      prints upper hull (furthest-site Voronoi diagram)
+*/
+void qh_printvdiagram(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall) {
+  setT *vertices;
+  int totcount, numcenters;
+  boolT isLower;
+  qh_RIDGE innerouter= qh_RIDGEall;
+  printvridgeT printvridge= NULL;
+
+  if (format == qh_PRINTvertices) {
+    innerouter= qh_RIDGEall;
+    printvridge= qh_printvridge;
+  }else if (format == qh_PRINTinner) {
+    innerouter= qh_RIDGEinner;
+    printvridge= qh_printvnorm;
+  }else if (format == qh_PRINTouter) {
+    innerouter= qh_RIDGEouter;
+    printvridge= qh_printvnorm;
+  }else {
+    qh_fprintf(qh, qh->ferr, 6219, "qhull internal error (qh_printvdiagram): unknown print format %d.\n", format);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  vertices= qh_markvoronoi(qh, facetlist, facets, printall, &isLower, &numcenters);
+  totcount= qh_printvdiagram2(qh, NULL, NULL, vertices, innerouter, False);
+  qh_fprintf(qh, fp, 9231, "%d\n", totcount);
+  totcount= qh_printvdiagram2(qh, fp, printvridge, vertices, innerouter, True /* inorder*/);
+  qh_settempfree(qh, &vertices);
+#if 0  /* for testing qh_eachvoronoi_all */
+  qh_fprintf(qh, fp, 9232, "\n");
+  totcount= qh_eachvoronoi_all(qh, fp, printvridge, qh->UPPERdelaunay, innerouter, True /* inorder*/);
+  qh_fprintf(qh, fp, 9233, "%d\n", totcount);
+#endif
+} /* printvdiagram */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvdiagram2">-</a>
+
+  qh_printvdiagram2(qh, fp, printvridge, vertices, innerouter, inorder )
+    visit all pairs of input sites (vertices) for selected Voronoi vertices
+    vertices may include NULLs
+
+  innerouter:
+    qh_RIDGEall   print inner ridges(bounded) and outer ridges(unbounded)
+    qh_RIDGEinner print only inner ridges
+    qh_RIDGEouter print only outer ridges
+
+  inorder:
+    print 3-d Voronoi vertices in order
+
+  assumes:
+    qh_markvoronoi marked facet->visitid for Voronoi vertices
+    all facet->seen= False
+    all facet->seen2= True
+
+  returns:
+    total number of Voronoi ridges
+    if printvridge,
+      calls printvridge( fp, vertex, vertexA, centers) for each ridge
+      [see qh_eachvoronoi()]
+
+  see:
+    qh_eachvoronoi_all()
+*/
+int qh_printvdiagram2(qhT *qh, FILE *fp, printvridgeT printvridge, setT *vertices, qh_RIDGE innerouter, boolT inorder) {
+  int totcount= 0;
+  int vertex_i, vertex_n;
+  vertexT *vertex;
+
+  FORALLvertices
+    vertex->seen= False;
+  FOREACHvertex_i_(qh, vertices) {
+    if (vertex) {
+      if (qh->GOODvertex > 0 && qh_pointid(qh, vertex->point)+1 != qh->GOODvertex)
+        continue;
+      totcount += qh_eachvoronoi(qh, fp, printvridge, vertex, !qh_ALL, innerouter, inorder);
+    }
+  }
+  return totcount;
+} /* printvdiagram2 */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvertex">-</a>
+
+  qh_printvertex(qh, fp, vertex )
+    prints the information in a vertex
+    Duplicated as operator<< [QhullVertex.cpp]
+*/
+void qh_printvertex(qhT *qh, FILE *fp, vertexT *vertex) {
+  pointT *point;
+  int k, count= 0;
+  facetT *neighbor, **neighborp;
+  realT r; /*bug fix*/
+
+  if (!vertex) {
+    qh_fprintf(qh, fp, 9234, "  NULLvertex\n");
+    return;
+  }
+  qh_fprintf(qh, fp, 9235, "- p%d(v%d):", qh_pointid(qh, vertex->point), vertex->id);
+  point= vertex->point;
+  if (point) {
+    for (k=qh->hull_dim; k--; ) {
+      r= *point++;
+      qh_fprintf(qh, fp, 9236, " %5.2g", r);
+    }
+  }
+  if (vertex->deleted)
+    qh_fprintf(qh, fp, 9237, " deleted");
+  if (vertex->delridge)
+    qh_fprintf(qh, fp, 9238, " delridge");
+  if (vertex->newfacet)
+    qh_fprintf(qh, fp, 9415, " newfacet");
+  if (vertex->seen && qh->IStracing)
+    qh_fprintf(qh, fp, 9416, " seen");
+  if (vertex->seen2 && qh->IStracing)
+    qh_fprintf(qh, fp, 9417, " seen2");
+  qh_fprintf(qh, fp, 9239, "\n");
+  if (vertex->neighbors) {
+    qh_fprintf(qh, fp, 9240, "  neighbors:");
+    FOREACHneighbor_(vertex) {
+      if (++count % 100 == 0)
+        qh_fprintf(qh, fp, 9241, "\n     ");
+      qh_fprintf(qh, fp, 9242, " f%d", neighbor->id);
+    }
+    qh_fprintf(qh, fp, 9243, "\n");
+  }
+} /* printvertex */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvertexlist">-</a>
+
+  qh_printvertexlist(qh, fp, string, facetlist, facets, printall )
+    prints vertices used by a facetlist or facet set
+    tests qh_skipfacet() if !printall
+*/
+void qh_printvertexlist(qhT *qh, FILE *fp, const char* string, facetT *facetlist,
+                         setT *facets, boolT printall) {
+  vertexT *vertex, **vertexp;
+  setT *vertices;
+
+  vertices= qh_facetvertices(qh, facetlist, facets, printall);
+  qh_fprintf(qh, fp, 9244, "%s", string);
+  FOREACHvertex_(vertices)
+    qh_printvertex(qh, fp, vertex);
+  qh_settempfree(qh, &vertices);
+} /* printvertexlist */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvertices">-</a>
+
+  qh_printvertices(qh, fp, string, vertices )
+    prints vertices in a set
+    duplicated as printVertexSet [QhullVertex.cpp]
+*/
+void qh_printvertices(qhT *qh, FILE *fp, const char* string, setT *vertices) {
+  vertexT *vertex, **vertexp;
+
+  qh_fprintf(qh, fp, 9245, "%s", string);
+  FOREACHvertex_(vertices)
+    qh_fprintf(qh, fp, 9246, " p%d(v%d)", qh_pointid(qh, vertex->point), vertex->id);
+  qh_fprintf(qh, fp, 9247, "\n");
+} /* printvertices */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvneighbors">-</a>
+
+  qh_printvneighbors(qh, fp, facetlist, facets, printall )
+    print vertex neighbors of vertices in facetlist and facets ('FN')
+
+  notes:
+    qh_countfacets clears facet->visitid for non-printed facets
+
+  design:
+    collect facet count and related statistics
+    if necessary, build neighbor sets for each vertex
+    collect vertices in facetlist and facets
+    build a point array for point->vertex and point->coplanar facet
+    for each point
+      list vertex neighbors or coplanar facet
+*/
+void qh_printvneighbors(qhT *qh, FILE *fp, facetT* facetlist, setT *facets, boolT printall) {
+  int numfacets, numsimplicial, numridges, totneighbors, numneighbors, numcoplanars, numtricoplanars;
+  setT *vertices, *vertex_points, *coplanar_points;
+  int numpoints= qh->num_points + qh_setsize(qh, qh->other_points);
+  vertexT *vertex, **vertexp;
+  int vertex_i, vertex_n;
+  facetT *facet, **facetp, *neighbor, **neighborp;
+  pointT *point, **pointp;
+
+  qh_countfacets(qh, facetlist, facets, printall, &numfacets, &numsimplicial,
+      &totneighbors, &numridges, &numcoplanars, &numtricoplanars);  /* sets facet->visitid */
+  qh_fprintf(qh, fp, 9248, "%d\n", numpoints);
+  qh_vertexneighbors(qh);
+  vertices= qh_facetvertices(qh, facetlist, facets, printall);
+  vertex_points= qh_settemp(qh, numpoints);
+  coplanar_points= qh_settemp(qh, numpoints);
+  qh_setzero(qh, vertex_points, 0, numpoints);
+  qh_setzero(qh, coplanar_points, 0, numpoints);
+  FOREACHvertex_(vertices)
+    qh_point_add(qh, vertex_points, vertex->point, vertex);
+  FORALLfacet_(facetlist) {
+    FOREACHpoint_(facet->coplanarset)
+      qh_point_add(qh, coplanar_points, point, facet);
+  }
+  FOREACHfacet_(facets) {
+    FOREACHpoint_(facet->coplanarset)
+      qh_point_add(qh, coplanar_points, point, facet);
+  }
+  FOREACHvertex_i_(qh, vertex_points) {
+    if (vertex) {
+      numneighbors= qh_setsize(qh, vertex->neighbors);
+      qh_fprintf(qh, fp, 9249, "%d", numneighbors);
+      qh_order_vertexneighbors(qh, vertex);
+      FOREACHneighbor_(vertex)
+        qh_fprintf(qh, fp, 9250, " %d",
+                 neighbor->visitid ? neighbor->visitid - 1 : 0 - neighbor->id);
+      qh_fprintf(qh, fp, 9251, "\n");
+    }else if ((facet= SETelemt_(coplanar_points, vertex_i, facetT)))
+      qh_fprintf(qh, fp, 9252, "1 %d\n",
+                  facet->visitid ? facet->visitid - 1 : 0 - facet->id);
+    else
+      qh_fprintf(qh, fp, 9253, "0\n");
+  }
+  qh_settempfree(qh, &coplanar_points);
+  qh_settempfree(qh, &vertex_points);
+  qh_settempfree(qh, &vertices);
+} /* printvneighbors */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvoronoi">-</a>
+
+  qh_printvoronoi(qh, fp, format, facetlist, facets, printall )
+    print voronoi diagram in 'o' or 'G' format
+    for 'o' format
+      prints voronoi centers for each facet and for infinity
+      for each vertex, lists ids of printed facets or infinity
+      assumes facetlist and facets are disjoint
+    for 'G' format
+      prints an OFF object
+      adds a 0 coordinate to center
+      prints infinity but does not list in vertices
+
+  see:
+    qh_printvdiagram()
+
+  notes:
+    if 'o',
+      prints a line for each point except "at-infinity"
+    if all facets are upperdelaunay,
+      reverses lower and upper hull
+*/
+void qh_printvoronoi(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall) {
+  int k, numcenters, numvertices= 0, numneighbors, numinf, vid=1, vertex_i, vertex_n;
+  facetT *facet, **facetp, *neighbor, **neighborp;
+  setT *vertices;
+  vertexT *vertex;
+  boolT isLower;
+  unsigned int numfacets= (unsigned int)qh->num_facets;
+
+  vertices= qh_markvoronoi(qh, facetlist, facets, printall, &isLower, &numcenters);
+  FOREACHvertex_i_(qh, vertices) {
+    if (vertex) {
+      numvertices++;
+      numneighbors= numinf= 0;
+      FOREACHneighbor_(vertex) {
+        if (neighbor->visitid == 0)
+          numinf= 1;
+        else if (neighbor->visitid < numfacets)
+          numneighbors++;
+      }
+      if (numinf && !numneighbors) {
+        SETelem_(vertices, vertex_i)= NULL;
+        numvertices--;
+      }
+    }
+  }
+  if (format == qh_PRINTgeom)
+    qh_fprintf(qh, fp, 9254, "{appearance {+edge -face} OFF %d %d 1 # Voronoi centers and cells\n",
+                numcenters, numvertices);
+  else
+    qh_fprintf(qh, fp, 9255, "%d\n%d %d 1\n", qh->hull_dim-1, numcenters, qh_setsize(qh, vertices));
+  if (format == qh_PRINTgeom) {
+    for (k=qh->hull_dim-1; k--; )
+      qh_fprintf(qh, fp, 9256, qh_REAL_1, 0.0);
+    qh_fprintf(qh, fp, 9257, " 0 # infinity not used\n");
+  }else {
+    for (k=qh->hull_dim-1; k--; )
+      qh_fprintf(qh, fp, 9258, qh_REAL_1, qh_INFINITE);
+    qh_fprintf(qh, fp, 9259, "\n");
+  }
+  FORALLfacet_(facetlist) {
+    if (facet->visitid && facet->visitid < numfacets) {
+      if (format == qh_PRINTgeom)
+        qh_fprintf(qh, fp, 9260, "# %d f%d\n", vid++, facet->id);
+      qh_printcenter(qh, fp, format, NULL, facet);
+    }
+  }
+  FOREACHfacet_(facets) {
+    if (facet->visitid && facet->visitid < numfacets) {
+      if (format == qh_PRINTgeom)
+        qh_fprintf(qh, fp, 9261, "# %d f%d\n", vid++, facet->id);
+      qh_printcenter(qh, fp, format, NULL, facet);
+    }
+  }
+  FOREACHvertex_i_(qh, vertices) {
+    numneighbors= 0;
+    numinf=0;
+    if (vertex) {
+      qh_order_vertexneighbors(qh, vertex);
+      FOREACHneighbor_(vertex) {
+        if (neighbor->visitid == 0)
+          numinf= 1;
+        else if (neighbor->visitid < numfacets)
+          numneighbors++;
+      }
+    }
+    if (format == qh_PRINTgeom) {
+      if (vertex) {
+        qh_fprintf(qh, fp, 9262, "%d", numneighbors);
+        FOREACHneighbor_(vertex) {
+          if (neighbor->visitid && neighbor->visitid < numfacets)
+            qh_fprintf(qh, fp, 9263, " %d", neighbor->visitid);
+        }
+        qh_fprintf(qh, fp, 9264, " # p%d(v%d)\n", vertex_i, vertex->id);
+      }else
+        qh_fprintf(qh, fp, 9265, " # p%d is coplanar or isolated\n", vertex_i);
+    }else {
+      if (numinf)
+        numneighbors++;
+      qh_fprintf(qh, fp, 9266, "%d", numneighbors);
+      if (vertex) {
+        FOREACHneighbor_(vertex) {
+          if (neighbor->visitid == 0) {
+            if (numinf) {
+              numinf= 0;
+              qh_fprintf(qh, fp, 9267, " %d", neighbor->visitid);
+            }
+          }else if (neighbor->visitid < numfacets)
+            qh_fprintf(qh, fp, 9268, " %d", neighbor->visitid);
+        }
+      }
+      qh_fprintf(qh, fp, 9269, "\n");
+    }
+  }
+  if (format == qh_PRINTgeom)
+    qh_fprintf(qh, fp, 9270, "}\n");
+  qh_settempfree(qh, &vertices);
+} /* printvoronoi */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvnorm">-</a>
+
+  qh_printvnorm(qh, fp, vertex, vertexA, centers, unbounded )
+    print one separating plane of the Voronoi diagram for a pair of input sites
+    unbounded==True if centers includes vertex-at-infinity
+
+  assumes:
+    qh_ASvoronoi and qh_vertexneighbors() already set
+
+  note:
+    parameter unbounded is UNUSED by this callback
+
+  see:
+    qh_printvdiagram()
+    qh_eachvoronoi()
+*/
+void qh_printvnorm(qhT *qh, FILE *fp, vertexT *vertex, vertexT *vertexA, setT *centers, boolT unbounded) {
+  pointT *normal;
+  realT offset;
+  int k;
+  QHULL_UNUSED(unbounded);
+
+  normal= qh_detvnorm(qh, vertex, vertexA, centers, &offset);
+  qh_fprintf(qh, fp, 9271, "%d %d %d ",
+      2+qh->hull_dim, qh_pointid(qh, vertex->point), qh_pointid(qh, vertexA->point));
+  for (k=0; k< qh->hull_dim-1; k++)
+    qh_fprintf(qh, fp, 9272, qh_REAL_1, normal[k]);
+  qh_fprintf(qh, fp, 9273, qh_REAL_1, offset);
+  qh_fprintf(qh, fp, 9274, "\n");
+} /* printvnorm */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="printvridge">-</a>
+
+  qh_printvridge(qh, fp, vertex, vertexA, centers, unbounded )
+    print one ridge of the Voronoi diagram for a pair of input sites
+    unbounded==True if centers includes vertex-at-infinity
+
+  see:
+    qh_printvdiagram()
+
+  notes:
+    the user may use a different function
+    parameter unbounded is UNUSED
+*/
+void qh_printvridge(qhT *qh, FILE *fp, vertexT *vertex, vertexT *vertexA, setT *centers, boolT unbounded) {
+  facetT *facet, **facetp;
+  QHULL_UNUSED(unbounded);
+
+  qh_fprintf(qh, fp, 9275, "%d %d %d", qh_setsize(qh, centers)+2,
+       qh_pointid(qh, vertex->point), qh_pointid(qh, vertexA->point));
+  FOREACHfacet_(centers)
+    qh_fprintf(qh, fp, 9276, " %d", facet->visitid);
+  qh_fprintf(qh, fp, 9277, "\n");
+} /* printvridge */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="projectdim3">-</a>
+
+  qh_projectdim3(qh, source, destination )
+    project 2-d 3-d or 4-d point to a 3-d point
+    uses qh.DROPdim and qh.hull_dim
+    source and destination may be the same
+
+  notes:
+    allocate 4 elements to destination just in case
+*/
+void qh_projectdim3(qhT *qh, pointT *source, pointT *destination) {
+  int i,k;
+
+  for (k=0, i=0; k < qh->hull_dim; k++) {
+    if (qh->hull_dim == 4) {
+      if (k != qh->DROPdim)
+        destination[i++]= source[k];
+    }else if (k == qh->DROPdim)
+      destination[i++]= 0;
+    else
+      destination[i++]= source[k];
+  }
+  while (i < 3)
+    destination[i++]= 0.0;
+} /* projectdim3 */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="readfeasible">-</a>
+
+  qh_readfeasible(qh, dim, curline )
+    read feasible point from current line and qh.fin
+
+  returns:
+    number of lines read from qh.fin
+    sets qh.feasible_point with malloc'd coordinates
+
+  notes:
+    checks for qh.HALFspace
+    assumes dim > 1
+
+  see:
+    qh_setfeasible
+*/
+int qh_readfeasible(qhT *qh, int dim, const char *curline) {
+  boolT isfirst= True;
+  int linecount= 0, tokcount= 0;
+  const char *s;
+  char *t, firstline[qh_MAXfirst+1];
+  coordT *coords, value;
+
+  if (!qh->HALFspace) {
+    qh_fprintf(qh, qh->ferr, 6070, "qhull input error: feasible point(dim 1 coords) is only valid for halfspace intersection\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (qh->feasible_string)
+    qh_fprintf(qh, qh->ferr, 7057, "qhull input warning: feasible point(dim 1 coords) overrides 'Hn,n,n' feasible point for halfspace intersection\n");
+  if (!(qh->feasible_point= (coordT *)qh_malloc((size_t)dim * sizeof(coordT)))) {
+    qh_fprintf(qh, qh->ferr, 6071, "qhull error: insufficient memory for feasible point\n");
+    qh_errexit(qh, qh_ERRmem, NULL, NULL);
+  }
+  coords= qh->feasible_point;
+  while ((s= (isfirst ?  curline : fgets(firstline, qh_MAXfirst, qh->fin)))) {
+    if (isfirst)
+      isfirst= False;
+    else
+      linecount++;
+    while (*s) {
+      while (isspace(*s))
+        s++;
+      value= qh_strtod(s, &t);
+      if (s == t)
+        break;
+      s= t;
+      *(coords++)= value;
+      if (++tokcount == dim) {
+        while (isspace(*s))
+          s++;
+        qh_strtod(s, &t);
+        if (s != t) {
+          qh_fprintf(qh, qh->ferr, 6072, "qhull input error: coordinates for feasible point do not finish out the line: %s\n",
+               s);
+          qh_errexit(qh, qh_ERRinput, NULL, NULL);
+        }
+        return linecount;
+      }
+    }
+  }
+  qh_fprintf(qh, qh->ferr, 6073, "qhull input error: only %d coordinates.  Could not read %d-d feasible point.\n",
+           tokcount, dim);
+  qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  return 0;
+} /* readfeasible */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="readpoints">-</a>
+
+  qh_readpoints(qh, numpoints, dimension, ismalloc )
+    read points from qh.fin into qh.first_point, qh.num_points
+    qh.fin is lines of coordinates, one per vertex, first line number of points
+    if 'rbox D4',
+      gives message
+    if qh.ATinfinity,
+      adds point-at-infinity for Delaunay triangulations
+
+  returns:
+    number of points, array of point coordinates, dimension, ismalloc True
+    if qh.DELAUNAY & !qh.PROJECTinput, projects points to paraboloid
+        and clears qh.PROJECTdelaunay
+    if qh.HALFspace, reads optional feasible point, reads halfspaces,
+        converts to dual.
+
+  for feasible point in "cdd format" in 3-d:
+    3 1
+    coordinates
+    comments
+    begin
+    n 4 real/integer
+    ...
+    end
+
+  notes:
+    dimension will change in qh_initqhull_globals if qh.PROJECTinput
+    uses malloc() since qh_mem not initialized
+    QH11012 FIX: qh_readpoints needs rewriting, too long
+*/
+coordT *qh_readpoints(qhT *qh, int *numpoints, int *dimension, boolT *ismalloc) {
+  coordT *points, *coords, *infinity= NULL;
+  realT paraboloid, maxboloid= -REALmax, value;
+  realT *coordp= NULL, *offsetp= NULL, *normalp= NULL;
+  char *s= 0, *t, firstline[qh_MAXfirst+1];
+  int diminput=0, numinput=0, dimfeasible= 0, newnum, k, tempi;
+  int firsttext=0, firstshort=0, firstlong=0, firstpoint=0;
+  int tokcount= 0, linecount=0, maxcount, coordcount=0;
+  boolT islong, isfirst= True, wasbegin= False;
+  boolT isdelaunay= qh->DELAUNAY && !qh->PROJECTinput;
+
+  if (qh->CDDinput) {
+    while ((s= fgets(firstline, qh_MAXfirst, qh->fin))) {
+      linecount++;
+      if (qh->HALFspace && linecount == 1 && isdigit(*s)) {
+        dimfeasible= qh_strtol(s, &s);
+        while (isspace(*s))
+          s++;
+        if (qh_strtol(s, &s) == 1)
+          linecount += qh_readfeasible(qh, dimfeasible, s);
+        else
+          dimfeasible= 0;
+      }else if (!memcmp(firstline, "begin", (size_t)5) || !memcmp(firstline, "BEGIN", (size_t)5))
+        break;
+      else if (!*qh->rbox_command)
+        strncat(qh->rbox_command, s, sizeof(qh->rbox_command)-1);
+    }
+    if (!s) {
+      qh_fprintf(qh, qh->ferr, 6074, "qhull input error: missing \"begin\" for cdd-formated input\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+  }
+  while (!numinput && (s= fgets(firstline, qh_MAXfirst, qh->fin))) {
+    linecount++;
+    if (!memcmp(s, "begin", (size_t)5) || !memcmp(s, "BEGIN", (size_t)5))
+      wasbegin= True;
+    while (*s) {
+      while (isspace(*s))
+        s++;
+      if (!*s)
+        break;
+      if (!isdigit(*s)) {
+        if (!*qh->rbox_command) {
+          strncat(qh->rbox_command, s, sizeof(qh->rbox_command)-1);
+          firsttext= linecount;
+        }
+        break;
+      }
+      if (!diminput)
+        diminput= qh_strtol(s, &s);
+      else {
+        numinput= qh_strtol(s, &s);
+        if (numinput == 1 && diminput >= 2 && qh->HALFspace && !qh->CDDinput) {
+          linecount += qh_readfeasible(qh, diminput, s); /* checks if ok */
+          dimfeasible= diminput;
+          diminput= numinput= 0;
+        }else
+          break;
+      }
+    }
+  }
+  if (!s) {
+    qh_fprintf(qh, qh->ferr, 6075, "qhull input error: short input file.  Did not find dimension and number of points\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (diminput > numinput) {
+    tempi= diminput;    /* exchange dim and n, e.g., for cdd input format */
+    diminput= numinput;
+    numinput= tempi;
+  }
+  if (diminput < 2) {
+    qh_fprintf(qh, qh->ferr, 6220, "qhull input error: dimension %d (first or smaller number) should be at least 2\n",
+            diminput);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (numinput < 1 || numinput > qh_POINTSmax) {
+    qh_fprintf(qh, qh->ferr, 6411, "qhull input error: expecting between 1 and %d points.  Got %d %d-d points\n",
+      qh_POINTSmax, numinput, diminput);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    /* same error message in qh_initqhull_globals */
+  }
+
+  if (isdelaunay && qh->HALFspace) {
+    qh_fprintf(qh, qh->ferr, 6037, "qhull option error (qh_readpoints): can not use Delaunay('d') or Voronoi('v') with halfspace intersection('H')\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    /* otherwise corrupted memory allocations, same error message as in qh_initqhull_globals */
+  }else if (isdelaunay) {
+    qh->PROJECTdelaunay= False;
+    if (qh->CDDinput)
+      *dimension= diminput;
+    else
+      *dimension= diminput+1;
+    *numpoints= numinput;
+    if (qh->ATinfinity)
+      (*numpoints)++;
+  }else if (qh->HALFspace) {
+    *dimension= diminput - 1;
+    *numpoints= numinput;
+    if (diminput < 3) {
+      qh_fprintf(qh, qh->ferr, 6221, "qhull input error: dimension %d (first number, includes offset) should be at least 3 for halfspaces\n",
+            diminput);
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    if (dimfeasible) {
+      if (dimfeasible != *dimension) {
+        qh_fprintf(qh, qh->ferr, 6222, "qhull input error: dimension %d of feasible point is not one less than dimension %d for halfspaces\n",
+          dimfeasible, diminput);
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+      }
+    }else
+      qh_setfeasible(qh, *dimension);
+  }else {
+    if (qh->CDDinput)
+      *dimension= diminput-1;
+    else
+      *dimension= diminput;
+    *numpoints= numinput;
+  }
+  qh->normal_size= *dimension * (int)sizeof(coordT); /* for tracing with qh_printpoint */
+  if (qh->HALFspace) {
+    qh->half_space= coordp= (coordT *)qh_malloc((size_t)qh->normal_size + sizeof(coordT));
+    if (qh->CDDinput) {
+      offsetp= qh->half_space;
+      normalp= offsetp + 1;
+    }else {
+      normalp= qh->half_space;
+      offsetp= normalp + *dimension;
+    }
+  }
+  qh->maxline= diminput * (qh_REALdigits + 5);
+  maximize_(qh->maxline, 500);
+  qh->line= (char *)qh_malloc((size_t)(qh->maxline+1) * sizeof(char));
+  *ismalloc= True;  /* use malloc since memory not setup */
+  coords= points= qh->temp_malloc=  /* numinput and diminput >=2 by QH6220 */
+        (coordT *)qh_malloc((size_t)((*numpoints)*(*dimension))*sizeof(coordT));
+  if (!coords || !qh->line || (qh->HALFspace && !qh->half_space)) {
+    qh_fprintf(qh, qh->ferr, 6076, "qhull error: insufficient memory to read %d points\n",
+            numinput);
+    qh_errexit(qh, qh_ERRmem, NULL, NULL);
+  }
+  if (isdelaunay && qh->ATinfinity) {
+    infinity= points + numinput * (*dimension);
+    for (k= (*dimension) - 1; k--; )
+      infinity[k]= 0.0;
+  }
+  maxcount= numinput * diminput;
+  paraboloid= 0.0;
+  while ((s= (isfirst ?  s : fgets(qh->line, qh->maxline, qh->fin)))) {
+    if (!isfirst) {
+      linecount++;
+      if (*s == 'e' || *s == 'E') {
+        if (!memcmp(s, "end", (size_t)3) || !memcmp(s, "END", (size_t)3)) {
+          if (qh->CDDinput )
+            break;
+          else if (wasbegin)
+            qh_fprintf(qh, qh->ferr, 7058, "qhull input warning: the input appears to be in cdd format.  If so, use 'Fd'\n");
+        }
+      }
+    }
+    islong= False;
+    while (*s) {
+      while (isspace(*s))
+        s++;
+      value= qh_strtod(s, &t);
+      if (s == t) {
+        if (!*qh->rbox_command)
+         strncat(qh->rbox_command, s, sizeof(qh->rbox_command)-1);
+        if (*s && !firsttext)
+          firsttext= linecount;
+        if (!islong && !firstshort && coordcount)
+          firstshort= linecount;
+        break;
+      }
+      if (!firstpoint)
+        firstpoint= linecount;
+      s= t;
+      if (++tokcount > maxcount)
+        continue;
+      if (qh->HALFspace) {
+        if (qh->CDDinput)
+          *(coordp++)= -value; /* both coefficients and offset */
+        else
+          *(coordp++)= value;
+      }else {
+        *(coords++)= value;
+        if (qh->CDDinput && !coordcount) {
+          if (value != 1.0) {
+            qh_fprintf(qh, qh->ferr, 6077, "qhull input error: for cdd format, point at line %d does not start with '1'\n",
+                   linecount);
+            qh_errexit(qh, qh_ERRinput, NULL, NULL);
+          }
+          coords--;
+        }else if (isdelaunay) {
+          paraboloid += value * value;
+          if (qh->ATinfinity) {
+            if (qh->CDDinput)
+              infinity[coordcount-1] += value;
+            else
+              infinity[coordcount] += value;
+          }
+        }
+      }
+      if (++coordcount == diminput) {
+        coordcount= 0;
+        if (isdelaunay) {
+          *(coords++)= paraboloid;
+          maximize_(maxboloid, paraboloid);
+          paraboloid= 0.0;
+        }else if (qh->HALFspace) {
+          if (!qh_sethalfspace(qh, *dimension, coords, &coords, normalp, offsetp, qh->feasible_point)) {
+            qh_fprintf(qh, qh->ferr, 8048, "The halfspace was on line %d\n", linecount);
+            if (wasbegin)
+              qh_fprintf(qh, qh->ferr, 8049, "The input appears to be in cdd format.  If so, you should use option 'Fd'\n");
+            qh_errexit(qh, qh_ERRinput, NULL, NULL);
+          }
+          coordp= qh->half_space;
+        }
+        while (isspace(*s))
+          s++;
+        if (*s) {
+          islong= True;
+          if (!firstlong)
+            firstlong= linecount;
+        }
+      }
+    }
+    if (!islong && !firstshort && coordcount)
+      firstshort= linecount;
+    if (!isfirst && s - qh->line >= qh->maxline) {
+      qh_fprintf(qh, qh->ferr, 6078, "qhull input error: line %d contained more than %d characters\n",
+              linecount, (int) (s - qh->line));   /* WARN64 */
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    isfirst= False;
+  }
+  if (qh->rbox_command[0])
+    qh->rbox_command[strlen(qh->rbox_command)-1]= '\0'; /* remove \n, previous qh_errexit's display command as two lines */
+  if (tokcount != maxcount) {
+    newnum= fmin_(numinput, tokcount/diminput);
+    if (qh->ALLOWshort)
+      qh_fprintf(qh, qh->ferr, 7073, "qhull warning: instead of %d points in %d-d, input contains %d points and %d extra coordinates.\n",
+          numinput, diminput, tokcount/diminput, tokcount % diminput);
+    else
+      qh_fprintf(qh, qh->ferr, 6410, "qhull error: instead of %d points in %d-d, input contains %d points and %d extra coordinates.\n",
+          numinput, diminput, tokcount/diminput, tokcount % diminput);
+    if (firsttext)
+      qh_fprintf(qh, qh->ferr, 8051, "    Line %d is the first comment.\n", firsttext);
+    qh_fprintf(qh, qh->ferr, 8033,   "    Line %d is the first point.\n", firstpoint);
+    if (firstshort)
+      qh_fprintf(qh, qh->ferr, 8052, "    Line %d is the first short line.\n", firstshort);
+    if (firstlong)
+      qh_fprintf(qh, qh->ferr, 8053, "    Line %d is the first long line.\n", firstlong);
+    if (qh->ALLOWshort)
+      qh_fprintf(qh, qh->ferr, 8054, "    Continuing with %d points.\n", newnum);
+    else {
+      qh_fprintf(qh, qh->ferr, 8077, "    Override with option 'Qa' (allow-short)\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    numinput= newnum;
+    if (isdelaunay && qh->ATinfinity) {
+      for (k= tokcount % diminput; k--; )
+        infinity[k] -= *(--coords);
+      *numpoints= newnum+1;
+    }else {
+      coords -= tokcount % diminput;
+      *numpoints= newnum;
+    }
+  }
+  if (isdelaunay && qh->ATinfinity) {
+    for (k= (*dimension) - 1; k--; )
+      infinity[k] /= numinput;
+    if (coords == infinity)
+      coords += (*dimension) -1;
+    else {
+      for (k=0; k < (*dimension) - 1; k++)
+        *(coords++)= infinity[k];
+    }
+    *(coords++)= maxboloid * 1.1;
+  }
+  if (!strcmp(qh->rbox_command, "./rbox D4"))
+    qh_fprintf(qh, qh->ferr, 8055, "\n\
+This is the qhull test case.  If any errors or core dumps occur,\n\
+recompile qhull with 'make new'.  If errors still occur, there is\n\
+an incompatibility.  You should try a different compiler.  You can also\n\
+change the choices in user_r.h.  If you discover the source of the problem,\n\
+please send mail to qhull_bug@qhull.org.\n\
+\n\
+Type 'qhull' for a short list of options.\n");
+  qh_free(qh->line);
+  qh->line= NULL;
+  if (qh->half_space) {
+    qh_free(qh->half_space);
+    qh->half_space= NULL;
+  }
+  qh->temp_malloc= NULL;
+  trace1((qh, qh->ferr, 1008,"qh_readpoints: read in %d %d-dimensional points\n",
+          numinput, diminput));
+  return(points);
+} /* readpoints */
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="setfeasible">-</a>
+
+  qh_setfeasible(qh, dim )
+    set qh.feasible_point from qh.feasible_string in "n,n,n" or "n n n" format
+
+  notes:
+    "n,n,n" already checked by qh_initflags()
+    see qh_readfeasible()
+    called only once from qh_new_qhull, otherwise leaks memory
+*/
+void qh_setfeasible(qhT *qh, int dim) {
+  int tokcount= 0;
+  char *s;
+  coordT *coords, value;
+
+  if (!(s= qh->feasible_string)) {
+    qh_fprintf(qh, qh->ferr, 6223, "qhull input error: halfspace intersection needs a feasible point.  Either prepend the input with 1 point or use 'Hn,n,n'.  See manual.\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (!(qh->feasible_point= (pointT *)qh_malloc((size_t)dim * sizeof(coordT)))) {
+    qh_fprintf(qh, qh->ferr, 6079, "qhull error: insufficient memory for 'Hn,n,n'\n");
+    qh_errexit(qh, qh_ERRmem, NULL, NULL);
+  }
+  coords= qh->feasible_point;
+  while (*s) {
+    value= qh_strtod(s, &s);
+    if (++tokcount > dim) {
+      qh_fprintf(qh, qh->ferr, 7059, "qhull input warning: more coordinates for 'H%s' than dimension %d\n",
+          qh->feasible_string, dim);
+      break;
+    }
+    *(coords++)= value;
+    if (*s)
+      s++;
+  }
+  while (++tokcount <= dim)
+    *(coords++)= 0.0;
+} /* setfeasible */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="skipfacet">-</a>
+
+  qh_skipfacet(qh, facet )
+    returns 'True' if this facet is not to be printed
+
+  notes:
+    based on the user provided slice thresholds and 'good' specifications
+*/
+boolT qh_skipfacet(qhT *qh, facetT *facet) {
+  facetT *neighbor, **neighborp;
+
+  if (qh->PRINTneighbors) {
+    if (facet->good)
+      return !qh->PRINTgood;
+    FOREACHneighbor_(facet) {
+      if (neighbor->good)
+        return False;
+    }
+    return True;
+  }else if (qh->PRINTgood)
+    return !facet->good;
+  else if (!facet->normal)
+    return True;
+  return(!qh_inthresholds(qh, facet->normal, NULL));
+} /* skipfacet */
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >-------------------------------</a><a name="skipfilename">-</a>
+
+  qh_skipfilename(qh, string )
+    returns pointer to character after filename
+
+  notes:
+    skips leading spaces
+    ends with spacing or eol
+    if starts with ' or " ends with the same, skipping \' or \"
+    For qhull, qh_argv_to_command() only uses double quotes
+*/
+char *qh_skipfilename(qhT *qh, char *filename) {
+  char *s= filename;  /* non-const due to return */
+  char c;
+
+  while (*s && isspace(*s))
+    s++;
+  c= *s++;
+  if (c == '\0') {
+    qh_fprintf(qh, qh->ferr, 6204, "qhull input error: filename expected, none found.\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  if (c == '\'' || c == '"') {
+    while (*s !=c || s[-1] == '\\') {
+      if (!*s) {
+        qh_fprintf(qh, qh->ferr, 6203, "qhull input error: missing quote after filename -- %s\n", filename);
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+      }
+      s++;
+    }
+    s++;
+  }
+  else while (*s && !isspace(*s))
+      s++;
+  return s;
+} /* skipfilename */
+
diff --git a/contrib/libs/qhull/libqhull_r/io_r.h b/contrib/libs/qhull/libqhull_r/io_r.h
new file mode 100644
index 0000000000..eb3c751492
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/io_r.h
@@ -0,0 +1,166 @@
+/*<html><pre>  -<a                             href="qh-io_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   io_r.h
+   declarations of Input/Output functions
+
+   see README, libqhull_r.h and io_r.c
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/io_r.h#3 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#ifndef qhDEFio
+#define qhDEFio 1
+
+#include "libqhull_r.h"
+
+/*============ constants and flags ==================*/
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >--------------------------------</a><a name="qh_MAXfirst">-</a>
+
+  qh_MAXfirst
+    maximum length of first two lines of stdin
+*/
+#define qh_MAXfirst  200
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >--------------------------------</a><a name="qh_MINradius">-</a>
+
+  qh_MINradius
+    min radius for Gp and Gv, fraction of maxcoord
+*/
+#define qh_MINradius 0.02
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >--------------------------------</a><a name="qh_GEOMepsilon">-</a>
+
+  qh_GEOMepsilon
+    adjust outer planes for 'lines closer' and geomview roundoff.
+    This prevents bleed through.
+*/
+#define qh_GEOMepsilon 2e-3
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >--------------------------------</a><a name="qh_WHITESPACE">-</a>
+
+  qh_WHITESPACE
+    possible values of white space
+*/
+#define qh_WHITESPACE " \n\t\v\r\f"
+
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >--------------------------------</a><a name="RIDGE">-</a>
+
+  qh_RIDGE
+    to select which ridges to print in qh_eachvoronoi
+*/
+typedef enum
+{
+    qh_RIDGEall= 0, qh_RIDGEinner, qh_RIDGEouter
+}
+qh_RIDGE;
+
+/*-<a                             href="qh-io_r.htm#TOC"
+  >--------------------------------</a><a name="printvridgeT">-</a>
+
+  printvridgeT
+    prints results of qh_printvdiagram
+
+  see:
+    <a href="io_r.c#printvridge">qh_printvridge</a> for an example
+*/
+typedef void (*printvridgeT)(qhT *qh, FILE *fp, vertexT *vertex, vertexT *vertexA, setT *centers, boolT unbounded);
+
+/*============== -prototypes in alphabetical order =========*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void    qh_dfacet(qhT *qh, unsigned int id);
+void    qh_dvertex(qhT *qh, unsigned int id);
+int     qh_compare_facetarea(const void *p1, const void *p2);
+int     qh_compare_facetvisit(const void *p1, const void *p2);
+int     qh_compare_nummerge(const void *p1, const void *p2);
+void    qh_copyfilename(qhT *qh, char *filename, int size, const char* source, int length);
+void    qh_countfacets(qhT *qh, facetT *facetlist, setT *facets, boolT printall,
+              int *numfacetsp, int *numsimplicialp, int *totneighborsp,
+              int *numridgesp, int *numcoplanarsp, int *numnumtricoplanarsp);
+pointT *qh_detvnorm(qhT *qh, vertexT *vertex, vertexT *vertexA, setT *centers, realT *offsetp);
+setT   *qh_detvridge(qhT *qh, vertexT *vertex);
+setT   *qh_detvridge3(qhT *qh, vertexT *atvertex, vertexT *vertex);
+int     qh_eachvoronoi(qhT *qh, FILE *fp, printvridgeT printvridge, vertexT *atvertex, boolT visitall, qh_RIDGE innerouter, boolT inorder);
+int     qh_eachvoronoi_all(qhT *qh, FILE *fp, printvridgeT printvridge, boolT isUpper, qh_RIDGE innerouter, boolT inorder);
+void    qh_facet2point(qhT *qh, facetT *facet, pointT **point0, pointT **point1, realT *mindist);
+setT   *qh_facetvertices(qhT *qh, facetT *facetlist, setT *facets, boolT allfacets);
+void    qh_geomplanes(qhT *qh, facetT *facet, realT *outerplane, realT *innerplane);
+void    qh_markkeep(qhT *qh, facetT *facetlist);
+setT   *qh_markvoronoi(qhT *qh, facetT *facetlist, setT *facets, boolT printall, boolT *isLowerp, int *numcentersp);
+void    qh_order_vertexneighbors(qhT *qh, vertexT *vertex);
+void    qh_prepare_output(qhT *qh);
+void    qh_printafacet(qhT *qh, FILE *fp, qh_PRINT format, facetT *facet, boolT printall);
+void    qh_printbegin(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printcenter(qhT *qh, FILE *fp, qh_PRINT format, const char *string, facetT *facet);
+void    qh_printcentrum(qhT *qh, FILE *fp, facetT *facet, realT radius);
+void    qh_printend(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printend4geom(qhT *qh, FILE *fp, facetT *facet, int *num, boolT printall);
+void    qh_printextremes(qhT *qh, FILE *fp, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printextremes_2d(qhT *qh, FILE *fp, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printextremes_d(qhT *qh, FILE *fp, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printfacet(qhT *qh, FILE *fp, facetT *facet);
+void    qh_printfacet2math(qhT *qh, FILE *fp, facetT *facet, qh_PRINT format, int notfirst);
+void    qh_printfacet2geom(qhT *qh, FILE *fp, facetT *facet, realT color[3]);
+void    qh_printfacet2geom_points(qhT *qh, FILE *fp, pointT *point1, pointT *point2,
+                               facetT *facet, realT offset, realT color[3]);
+void    qh_printfacet3math(qhT *qh, FILE *fp, facetT *facet, qh_PRINT format, int notfirst);
+void    qh_printfacet3geom_nonsimplicial(qhT *qh, FILE *fp, facetT *facet, realT color[3]);
+void    qh_printfacet3geom_points(qhT *qh, FILE *fp, setT *points, facetT *facet, realT offset, realT color[3]);
+void    qh_printfacet3geom_simplicial(qhT *qh, FILE *fp, facetT *facet, realT color[3]);
+void    qh_printfacet3vertex(qhT *qh, FILE *fp, facetT *facet, qh_PRINT format);
+void    qh_printfacet4geom_nonsimplicial(qhT *qh, FILE *fp, facetT *facet, realT color[3]);
+void    qh_printfacet4geom_simplicial(qhT *qh, FILE *fp, facetT *facet, realT color[3]);
+void    qh_printfacetNvertex_nonsimplicial(qhT *qh, FILE *fp, facetT *facet, int id, qh_PRINT format);
+void    qh_printfacetNvertex_simplicial(qhT *qh, FILE *fp, facetT *facet, qh_PRINT format);
+void    qh_printfacetheader(qhT *qh, FILE *fp, facetT *facet);
+void    qh_printfacetridges(qhT *qh, FILE *fp, facetT *facet);
+void    qh_printfacets(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printhyperplaneintersection(qhT *qh, FILE *fp, facetT *facet1, facetT *facet2,
+                   setT *vertices, realT color[3]);
+void    qh_printline3geom(qhT *qh, FILE *fp, pointT *pointA, pointT *pointB, realT color[3]);
+void    qh_printneighborhood(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetA, facetT *facetB, boolT printall);
+void    qh_printpoint(qhT *qh, FILE *fp, const char *string, pointT *point);
+void    qh_printpointid(qhT *qh, FILE *fp, const char *string, int dim, pointT *point, int id);
+void    qh_printpoint3(qhT *qh, FILE *fp, pointT *point);
+void    qh_printpoints_out(qhT *qh, FILE *fp, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printpointvect(qhT *qh, FILE *fp, pointT *point, coordT *normal, pointT *center, realT radius, realT color[3]);
+void    qh_printpointvect2(qhT *qh, FILE *fp, pointT *point, coordT *normal, pointT *center, realT radius);
+void    qh_printridge(qhT *qh, FILE *fp, ridgeT *ridge);
+void    qh_printspheres(qhT *qh, FILE *fp, setT *vertices, realT radius);
+void    qh_printvdiagram(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall);
+int     qh_printvdiagram2(qhT *qh, FILE *fp, printvridgeT printvridge, setT *vertices, qh_RIDGE innerouter, boolT inorder);
+void    qh_printvertex(qhT *qh, FILE *fp, vertexT *vertex);
+void    qh_printvertexlist(qhT *qh, FILE *fp, const char* string, facetT *facetlist,
+                         setT *facets, boolT printall);
+void    qh_printvertices(qhT *qh, FILE *fp, const char* string, setT *vertices);
+void    qh_printvneighbors(qhT *qh, FILE *fp, facetT* facetlist, setT *facets, boolT printall);
+void    qh_printvoronoi(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printvnorm(qhT *qh, FILE *fp, vertexT *vertex, vertexT *vertexA, setT *centers, boolT unbounded);
+void    qh_printvridge(qhT *qh, FILE *fp, vertexT *vertex, vertexT *vertexA, setT *centers, boolT unbounded);
+void    qh_produce_output(qhT *qh);
+void    qh_produce_output2(qhT *qh);
+void    qh_projectdim3(qhT *qh, pointT *source, pointT *destination);
+int     qh_readfeasible(qhT *qh, int dim, const char *curline);
+coordT *qh_readpoints(qhT *qh, int *numpoints, int *dimension, boolT *ismalloc);
+void    qh_setfeasible(qhT *qh, int dim);
+boolT   qh_skipfacet(qhT *qh, facetT *facet);
+char   *qh_skipfilename(qhT *qh, char *filename);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif /* qhDEFio */
diff --git a/contrib/libs/qhull/libqhull_r/libqhull_r.c b/contrib/libs/qhull/libqhull_r/libqhull_r.c
new file mode 100644
index 0000000000..0d41d7be05
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/libqhull_r.c
@@ -0,0 +1,1754 @@
+/*<html><pre>  -<a                             href="qh-qhull_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   libqhull_r.c
+   Quickhull algorithm for convex hulls
+
+   qhull() and top-level routines
+
+   see qh-qhull_r.htm, libqhull_r.h, unix_r.c
+
+   see qhull_ra.h for internal functions
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/libqhull_r.c#17 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#include "qhull_ra.h"
+
+/*============= functions in alphabetic order after qhull() =======*/
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="qhull">-</a>
+
+  qh_qhull(qh)
+    compute DIM3 convex hull of qh.num_points starting at qh.first_point
+    qh->contains all global options and variables
+
+  returns:
+    returns polyhedron
+      qh.facet_list, qh.num_facets, qh.vertex_list, qh.num_vertices,
+
+    returns global variables
+      qh.hulltime, qh.max_outside, qh.interior_point, qh.max_vertex, qh.min_vertex
+
+    returns precision constants
+      qh.ANGLEround, centrum_radius, cos_max, DISTround, MAXabs_coord, ONEmerge
+
+  notes:
+    unless needed for output
+      qh.max_vertex and qh.min_vertex are max/min due to merges
+
+  see:
+    to add individual points to either qh.num_points
+      use qh_addpoint()
+
+    if qh.GETarea
+      qh_produceoutput() returns qh.totarea and qh.totvol via qh_getarea()
+
+  design:
+    record starting time
+    initialize hull and partition points
+    build convex hull
+    unless early termination
+      update facet->maxoutside for vertices, coplanar, and near-inside points
+    error if temporary sets exist
+    record end time
+*/
+
+void qh_qhull(qhT *qh) {
+  int numoutside;
+
+  qh->hulltime= qh_CPUclock;
+  if (qh->RERUN || qh->JOGGLEmax < REALmax/2)
+    qh_build_withrestart(qh);
+  else {
+    qh_initbuild(qh);
+    qh_buildhull(qh);
+  }
+  if (!qh->STOPadd && !qh->STOPcone && !qh->STOPpoint) {
+    if (qh->ZEROall_ok && !qh->TESTvneighbors && qh->MERGEexact)
+      qh_checkzero(qh, qh_ALL);
+    if (qh->ZEROall_ok && !qh->TESTvneighbors && !qh->WAScoplanar) {
+      trace2((qh, qh->ferr, 2055, "qh_qhull: all facets are clearly convex and no coplanar points.  Post-merging and check of maxout not needed.\n"));
+      qh->DOcheckmax= False;
+    }else {
+      qh_initmergesets(qh /* qh.facet_mergeset,degen_mergeset,vertex_mergeset */);
+      if (qh->MERGEexact || (qh->hull_dim > qh_DIMreduceBuild && qh->PREmerge))
+        qh_postmerge(qh, "First post-merge", qh->premerge_centrum, qh->premerge_cos,
+             (qh->POSTmerge ? False : qh->TESTvneighbors)); /* calls qh_reducevertices */
+      else if (!qh->POSTmerge && qh->TESTvneighbors)
+        qh_postmerge(qh, "For testing vertex neighbors", qh->premerge_centrum,
+             qh->premerge_cos, True);                       /* calls qh_test_vneighbors */
+      if (qh->POSTmerge)
+        qh_postmerge(qh, "For post-merging", qh->postmerge_centrum,
+             qh->postmerge_cos, qh->TESTvneighbors);
+      if (qh->visible_list == qh->facet_list) {            /* qh_postmerge was called */
+        qh->findbestnew= True;
+        qh_partitionvisible(qh, !qh_ALL, &numoutside /* qh.visible_list */);
+        qh->findbestnew= False;
+        qh_deletevisible(qh /* qh.visible_list */);        /* stops at first !f.visible */
+        qh_resetlists(qh, False, qh_RESETvisible /* qh.visible_list newvertex_list qh.newfacet_list */);
+      }
+      qh_all_vertexmerges(qh, -1, NULL, NULL);
+      qh_freemergesets(qh);
+    }
+    if (qh->TRACEpoint == qh_IDunknown && qh->TRACElevel > qh->IStracing) {
+      qh->IStracing= qh->TRACElevel;
+      qh_fprintf(qh, qh->ferr, 2112, "qh_qhull: finished qh_buildhull and qh_postmerge, start tracing (TP-1)\n");
+    }
+    if (qh->DOcheckmax){
+      if (qh->REPORTfreq) {
+        qh_buildtracing(qh, NULL, NULL);
+        qh_fprintf(qh, qh->ferr, 8115, "\nTesting all coplanar points.\n");
+      }
+      qh_check_maxout(qh);
+    }
+    if (qh->KEEPnearinside && !qh->maxoutdone)
+      qh_nearcoplanar(qh);
+  }
+  if (qh_setsize(qh, qh->qhmem.tempstack) != 0) {
+    qh_fprintf(qh, qh->ferr, 6164, "qhull internal error (qh_qhull): temporary sets not empty(%d) at end of Qhull\n",
+             qh_setsize(qh, qh->qhmem.tempstack));
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh->hulltime= qh_CPUclock - qh->hulltime;
+  qh->QHULLfinished= True;
+  trace1((qh, qh->ferr, 1036, "Qhull: algorithm completed\n"));
+} /* qhull */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="addpoint">-</a>
+
+  qh_addpoint(qh, furthest, facet, checkdist )
+    add point (usually furthest point) above facet to hull
+    if checkdist,
+      check that point is above facet.
+      if point is not outside of the hull, uses qh_partitioncoplanar()
+      assumes that facet is defined by qh_findbestfacet()
+    else if facet specified,
+      assumes that point is above facet (major damage if below)
+    for Delaunay triangulations,
+      Use qh_setdelaunay() to lift point to paraboloid and scale by 'Qbb' if needed
+      Do not use options 'Qbk', 'QBk', or 'QbB' since they scale the coordinates.
+
+  returns:
+    returns False if user requested an early termination
+      qh.visible_list, newfacet_list, delvertex_list, NEWfacets may be defined
+    updates qh.facet_list, qh.num_facets, qh.vertex_list, qh.num_vertices
+    clear qh.maxoutdone (will need to call qh_check_maxout() for facet->maxoutside)
+    if unknown point, adds a pointer to qh.other_points
+      do not deallocate the point's coordinates
+
+  notes:
+    called from qh_initbuild, qh_buildhull, and qh_addpoint
+    tail recursive call if merged a pinchedvertex due to a duplicated ridge
+      no more than qh.num_vertices calls (QH6296)
+    assumes point is near its best facet and not at a local minimum of a lens
+      distributions.  Use qh_findbestfacet to avoid this case.
+    uses qh.visible_list, qh.newfacet_list, qh.delvertex_list, qh.NEWfacets
+    if called from a user application after qh_qhull and 'QJ' (joggle),
+      facet merging for precision problems is disabled by default
+
+  design:
+    exit if qh.STOPadd vertices 'TAn'
+    add point to other_points if needed
+    if checkdist
+      if point not above facet
+        partition coplanar point
+        exit
+    exit if pre STOPpoint requested
+    find horizon and visible facets for point
+    build cone of new facets to the horizon
+    exit if build cone fails due to qh.ONLYgood
+    tail recursive call if build cone fails due to pinched vertices
+    exit if STOPcone requested
+    merge non-convex new facets
+    if merge found, many merges, or 'Qf'
+       use qh_findbestnew() instead of qh_findbest()
+    partition outside points from visible facets
+    delete visible facets
+    check polyhedron if requested
+    exit if post STOPpoint requested
+    reset working lists of facets and vertices
+*/
+boolT qh_addpoint(qhT *qh, pointT *furthest, facetT *facet, boolT checkdist) {
+  realT dist, pbalance;
+  facetT *replacefacet, *newfacet;
+  vertexT *apex;
+  boolT isoutside= False;
+  int numpart, numpoints, goodvisible, goodhorizon, apexpointid;
+
+  qh->maxoutdone= False;
+  if (qh_pointid(qh, furthest) == qh_IDunknown)
+    qh_setappend(qh, &qh->other_points, furthest);
+  if (!facet) {
+    qh_fprintf(qh, qh->ferr, 6213, "qhull internal error (qh_addpoint): NULL facet.  Need to call qh_findbestfacet first\n");
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh_detmaxoutside(qh);
+  if (checkdist) {
+    facet= qh_findbest(qh, furthest, facet, !qh_ALL, !qh_ISnewfacets, !qh_NOupper,
+                        &dist, &isoutside, &numpart);
+    zzadd_(Zpartition, numpart);
+    if (!isoutside) {
+      zinc_(Znotmax);  /* last point of outsideset is no longer furthest. */
+      facet->notfurthest= True;
+      qh_partitioncoplanar(qh, furthest, facet, &dist, qh->findbestnew);
+      return True;
+    }
+  }
+  qh_buildtracing(qh, furthest, facet);
+  if (qh->STOPpoint < 0 && qh->furthest_id == -qh->STOPpoint-1) {
+    facet->notfurthest= True;
+    return False;
+  }
+  qh_findhorizon(qh, furthest, facet, &goodvisible, &goodhorizon);
+  if (qh->ONLYgood && !qh->GOODclosest && !(goodvisible+goodhorizon)) {
+    zinc_(Znotgood);
+    facet->notfurthest= True;
+    /* last point of outsideset is no longer furthest.  This is ok
+        since all points of the outside are likely to be bad */
+    qh_resetlists(qh, False, qh_RESETvisible /* qh.visible_list newvertex_list qh.newfacet_list */);
+    return True;
+  }
+  apex= qh_buildcone(qh, furthest, facet, goodhorizon, &replacefacet);
+  /* qh.newfacet_list, visible_list, newvertex_list */
+  if (!apex) {
+    if (qh->ONLYgood)
+      return True; /* ignore this furthest point, a good new facet was not found */
+    if (replacefacet) {
+      if (qh->retry_addpoint++ >= qh->num_vertices) {
+        qh_fprintf(qh, qh->ferr, 6296, "qhull internal error (qh_addpoint): infinite loop (%d retries) of merging pinched vertices due to dupridge for point p%d, facet f%d, and %d vertices\n",
+          qh->retry_addpoint, qh_pointid(qh, furthest), facet->id, qh->num_vertices);
+        qh_errexit(qh, qh_ERRqhull, facet, NULL);
+      }
+      /* retry qh_addpoint after resolving a dupridge via qh_merge_pinchedvertices */
+      return qh_addpoint(qh, furthest, replacefacet, True /* checkdisk */);
+    }
+    qh->retry_addpoint= 0;
+    return True; /* ignore this furthest point, resolved a dupridge by making furthest a coplanar point */
+  }
+  if (qh->retry_addpoint) {
+    zinc_(Zretryadd);
+    zadd_(Zretryaddtot, qh->retry_addpoint);
+    zmax_(Zretryaddmax, qh->retry_addpoint);
+    qh->retry_addpoint= 0;
+  }
+  apexpointid= qh_pointid(qh, apex->point);
+  zzinc_(Zprocessed);
+  if (qh->STOPcone && qh->furthest_id == qh->STOPcone-1) {
+    facet->notfurthest= True;
+    return False;  /* visible_list etc. still defined */
+  }
+  qh->findbestnew= False;
+  if (qh->PREmerge || qh->MERGEexact) {
+    qh_initmergesets(qh /* qh.facet_mergeset,degen_mergeset,vertex_mergeset */);
+    qh_premerge(qh, apexpointid, qh->premerge_centrum, qh->premerge_cos /* qh.newfacet_list */);
+    if (qh_USEfindbestnew)
+      qh->findbestnew= True;
+    else {
+      FORALLnew_facets {
+        if (!newfacet->simplicial) {
+          qh->findbestnew= True;  /* use qh_findbestnew instead of qh_findbest*/
+          break;
+        }
+      }
+    }
+  }else if (qh->BESToutside)
+    qh->findbestnew= True;
+  if (qh->IStracing >= 4)
+    qh_checkpolygon(qh, qh->visible_list);
+  qh_partitionvisible(qh, !qh_ALL, &numpoints /* qh.visible_list */);
+  qh->findbestnew= False;
+  qh->findbest_notsharp= False;
+  zinc_(Zpbalance);
+  pbalance= numpoints - (realT) qh->hull_dim /* assumes all points extreme */
+                * (qh->num_points - qh->num_vertices)/qh->num_vertices;
+  wadd_(Wpbalance, pbalance);
+  wadd_(Wpbalance2, pbalance * pbalance);
+  qh_deletevisible(qh /* qh.visible_list */);
+  zmax_(Zmaxvertex, qh->num_vertices);
+  qh->NEWfacets= False;
+  if (qh->IStracing >= 4) {
+    if (qh->num_facets < 200)
+      qh_printlists(qh);
+    qh_printfacetlist(qh, qh->newfacet_list, NULL, True);
+    qh_checkpolygon(qh, qh->facet_list);
+  }else if (qh->CHECKfrequently) {
+    if (qh->num_facets < 1000)
+      qh_checkpolygon(qh, qh->facet_list);
+    else
+      qh_checkpolygon(qh, qh->newfacet_list);
+  }
+  if (qh->STOPpoint > 0 && qh->furthest_id == qh->STOPpoint-1 && qh_setsize(qh, qh->vertex_mergeset) > 0)
+    return False;
+  qh_resetlists(qh, True, qh_RESETvisible /* qh.visible_list newvertex_list qh.newfacet_list */);
+  if (qh->facet_mergeset) {
+    /* vertex merges occur after facet merges (qh_premerge) and qh_resetlists */
+    qh_all_vertexmerges(qh, apexpointid, NULL, NULL);
+    qh_freemergesets(qh);
+  }
+  /* qh_triangulate(qh); to test qh.TRInormals */
+  if (qh->STOPpoint > 0 && qh->furthest_id == qh->STOPpoint-1)
+    return False;
+  trace2((qh, qh->ferr, 2056, "qh_addpoint: added p%d to convex hull with point balance %2.2g\n",
+    qh_pointid(qh, furthest), pbalance));
+  return True;
+} /* addpoint */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="build_withrestart">-</a>
+
+  qh_build_withrestart(qh)
+    allow restarts due to qh.JOGGLEmax while calling qh_buildhull()
+       qh_errexit always undoes qh_build_withrestart()
+    qh.FIRSTpoint/qh.NUMpoints is point array
+       it may be moved by qh_joggleinput
+*/
+void qh_build_withrestart(qhT *qh) {
+  int restart;
+  vertexT *vertex, **vertexp;
+
+  qh->ALLOWrestart= True;
+  while (True) {
+    restart= setjmp(qh->restartexit); /* simple statement for CRAY J916 */
+    if (restart) {       /* only from qh_joggle_restart() */
+      qh->last_errcode= qh_ERRnone;
+      zzinc_(Zretry);
+      wmax_(Wretrymax, qh->JOGGLEmax);
+      /* QH7078 warns about using 'TCn' with 'QJn' */
+      qh->STOPcone= qh_IDunknown; /* if break from joggle, prevents normal output */
+      FOREACHvertex_(qh->del_vertices) {
+        if (vertex->point && !vertex->partitioned)
+          vertex->partitioned= True; /* avoid error in qh_freebuild -> qh_delvertex */
+      }
+    }
+    if (!qh->RERUN && qh->JOGGLEmax < REALmax/2) {
+      if (qh->build_cnt > qh_JOGGLEmaxretry) {
+        qh_fprintf(qh, qh->ferr, 6229, "qhull input error: %d attempts to construct a convex hull with joggled input.  Increase joggle above 'QJ%2.2g' or modify qh_JOGGLE... parameters in user_r.h\n",
+           qh->build_cnt, qh->JOGGLEmax);
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+      }
+      if (qh->build_cnt && !restart)
+        break;
+    }else if (qh->build_cnt && qh->build_cnt >= qh->RERUN)
+      break;
+    qh->STOPcone= 0;
+    qh_freebuild(qh, True);  /* first call is a nop */
+    qh->build_cnt++;
+    if (!qh->qhull_optionsiz)
+      qh->qhull_optionsiz= (int)strlen(qh->qhull_options);   /* WARN64 */
+    else {
+      qh->qhull_options[qh->qhull_optionsiz]= '\0';
+      qh->qhull_optionlen= qh_OPTIONline;  /* starts a new line */
+    }
+    qh_option(qh, "_run", &qh->build_cnt, NULL);
+    if (qh->build_cnt == qh->RERUN) {
+      qh->IStracing= qh->TRACElastrun;  /* duplicated from qh_initqhull_globals */
+      if (qh->TRACEpoint != qh_IDnone || qh->TRACEdist < REALmax/2 || qh->TRACEmerge) {
+        qh->TRACElevel= (qh->IStracing? qh->IStracing : 3);
+        qh->IStracing= 0;
+      }
+      qh->qhmem.IStracing= qh->IStracing;
+    }
+    if (qh->JOGGLEmax < REALmax/2)
+      qh_joggleinput(qh);
+    qh_initbuild(qh);
+    qh_buildhull(qh);
+    if (qh->JOGGLEmax < REALmax/2 && !qh->MERGING)
+      qh_checkconvex(qh, qh->facet_list, qh_ALGORITHMfault);
+  }
+  qh->ALLOWrestart= False;
+} /* qh_build_withrestart */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="buildcone">-</a>
+
+  qh_buildcone(qh, furthest, facet, goodhorizon, &replacefacet )
+    build cone of new facets from furthest to the horizon
+    goodhorizon is count of good, horizon facets from qh_find_horizon
+
+  returns:
+    returns apex of cone with qh.newfacet_list and qh.first_newfacet (f.id)
+    returns NULL if qh.ONLYgood and no good facets
+    returns NULL and retryfacet if merging pinched vertices will resolve a dupridge
+      a horizon vertex was nearly adjacent to another vertex
+      will retry qh_addpoint
+    returns NULL if resolve a dupridge by making furthest a coplanar point
+      furthest was nearly adjacent to an existing vertex
+    updates qh.degen_mergeset (MRGridge) if resolve a dupridge by merging facets
+    updates qh.newfacet_list, visible_list, newvertex_list
+    updates qh.facet_list, vertex_list, num_facets, num_vertices
+
+  notes:
+    called by qh_addpoint
+    see qh_triangulate, it triangulates non-simplicial facets in post-processing
+
+  design:
+    make new facets for point to horizon
+    compute balance statistics
+    make hyperplanes for point
+    exit if qh.ONLYgood and not good (qh_buildcone_onlygood)
+    match neighboring new facets
+    if dupridges
+      exit if !qh.IGNOREpinched and dupridge resolved by coplanar furthest
+      retry qh_buildcone if !qh.IGNOREpinched and dupridge resolved by qh_buildcone_mergepinched
+      otherwise dupridges resolved by merging facets
+    update vertex neighbors and delete interior vertices
+*/
+vertexT *qh_buildcone(qhT *qh, pointT *furthest, facetT *facet, int goodhorizon, facetT **retryfacet) {
+  vertexT *apex;
+  realT newbalance;
+  int numnew;
+
+  *retryfacet= NULL;
+  qh->first_newfacet= qh->facet_id;
+  qh->NEWtentative= (qh->MERGEpinched || qh->ONLYgood); /* cleared by qh_attachnewfacets or qh_resetlists */
+  apex= qh_makenewfacets(qh, furthest /* qh.newfacet_list visible_list, attaches new facets if !qh.NEWtentative */);
+  numnew= (int)(qh->facet_id - qh->first_newfacet);
+  newbalance= numnew - (realT)(qh->num_facets - qh->num_visible) * qh->hull_dim / qh->num_vertices;
+  /* newbalance statistics updated below if the new facets are accepted */
+  if (qh->ONLYgood) { /* qh.MERGEpinched is false by QH6362 */
+    if (!qh_buildcone_onlygood(qh, apex, goodhorizon /* qh.newfacet_list */)) {
+      facet->notfurthest= True;
+      return NULL;
+    }
+  }else if(qh->MERGEpinched) {
+#ifndef qh_NOmerge
+    if (qh_buildcone_mergepinched(qh, apex, facet, retryfacet /* qh.newfacet_list */))
+      return NULL;
+#else
+    qh_fprintf(qh, qh->ferr, 6375, "qhull option error (qh_buildcone): option 'Q14' (qh.MERGEpinched) is not available due to qh_NOmerge\n");
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+#endif
+  }else {
+    /* qh_makenewfacets attached new facets to the horizon */
+    qh_matchnewfacets(qh); /* ignore returned value.  qh_forcedmerges will merge dupridges if any */
+    qh_makenewplanes(qh /* qh.newfacet_list */);
+    qh_update_vertexneighbors_cone(qh);
+  }
+  wadd_(Wnewbalance, newbalance);
+  wadd_(Wnewbalance2, newbalance * newbalance);
+  trace2((qh, qh->ferr, 2067, "qh_buildcone: created %d newfacets for p%d(v%d) new facet balance %2.2g\n",
+    numnew, qh_pointid(qh, furthest), apex->id, newbalance));
+  return apex;
+} /* buildcone */
+
+#ifndef qh_NOmerge
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="buildcone_mergepinched">-</a>
+
+  qh_buildcone_mergepinched(qh, apex, facet, maxdupdist, &retryfacet )
+    build cone of new facets from furthest to the horizon
+    maxdupdist>0.0 for merging dupridges (qh_matchdupridge)
+
+  returns:
+    returns True if merged a pinched vertex and deleted the cone of new facets
+      if retryfacet is set
+        a dupridge was resolved by qh_merge_pinchedvertices
+        retry qh_addpoint
+      otherwise
+        apex/furthest was partitioned as a coplanar point
+        ignore this furthest point
+    returns False if no dupridges or if dupridges will be resolved by MRGridge
+    updates qh.facet_list, qh.num_facets, qh.vertex_list, qh.num_vertices
+
+  notes:
+    only called from qh_buildcone with qh.MERGEpinched
+
+  design:
+    match neighboring new facets
+    if matching detected dupridges with a wide merge (qh_RATIOtrypinched)
+      if pinched vertices (i.e., nearly adjacent)
+        delete the cone of new facets
+        delete the apex and reset the facet lists
+        if coplanar, pinched apex
+          partition the apex as a coplanar point
+        else
+           repeatedly merge the nearest pair of pinched vertices and subsequent facet merges
+        return True
+      otherwise
+        MRGridge are better than vertex merge, but may report an error
+    attach new facets
+    make hyperplanes for point
+    update vertex neighbors and delete interior vertices
+*/
+boolT qh_buildcone_mergepinched(qhT *qh, vertexT *apex, facetT *facet, facetT **retryfacet) {
+  facetT *newfacet, *nextfacet;
+  pointT *apexpoint;
+  coordT maxdupdist;
+  int apexpointid;
+  boolT iscoplanar;
+
+  *retryfacet= NULL;
+  maxdupdist= qh_matchnewfacets(qh);
+  if (maxdupdist > qh_RATIOtrypinched * qh->ONEmerge) { /* one or more dupridges with a wide merge */
+    if (qh->IStracing >= 4 && qh->num_facets < 1000)
+      qh_printlists(qh);
+    qh_initmergesets(qh /* qh.facet_mergeset,degen_mergeset,vertex_mergeset */);
+    if (qh_getpinchedmerges(qh, apex, maxdupdist, &iscoplanar /* qh.newfacet_list, qh.vertex_mergeset */)) {
+      for (newfacet=qh->newfacet_list; newfacet && newfacet->next; newfacet= nextfacet) {
+        nextfacet= newfacet->next;
+        qh_delfacet(qh, newfacet);
+      }
+      apexpoint= apex->point;
+      apexpointid= qh_pointid(qh, apexpoint);
+      qh_delvertex(qh, apex);
+      qh_resetlists(qh, False, qh_RESETvisible /* qh.visible_list newvertex_list qh.newfacet_list */);
+      if (iscoplanar) {
+        zinc_(Zpinchedapex);
+        facet->notfurthest= True;
+        qh_partitioncoplanar(qh, apexpoint, facet, NULL, qh->findbestnew);
+      }else {
+        qh_all_vertexmerges(qh, apexpointid, facet, retryfacet);
+      }
+      qh_freemergesets(qh); /* errors if not empty */
+      return True;
+    }
+    /* MRGridge are better than vertex merge, but may report an error */
+    qh_freemergesets(qh);
+  }
+  qh_attachnewfacets(qh /* qh.visible_list */);
+  qh_makenewplanes(qh /* qh.newfacet_list */);
+  qh_update_vertexneighbors_cone(qh);
+  return False;
+} /* buildcone_mergepinched */
+#endif /* !qh_NOmerge */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="buildcone_onlygood">-</a>
+
+  qh_buildcone_onlygood(qh, apex, goodhorizon )
+    build cone of good, new facets from apex and its qh.newfacet_list to the horizon
+    goodhorizon is count of good, horizon facets from qh_find_horizon
+
+  returns:
+    False if a f.good facet or a qh.GOODclosest facet is not found
+    updates qh.facet_list, qh.num_facets, qh.vertex_list, qh.num_vertices
+
+  notes:
+    called from qh_buildcone
+    QH11030 FIX: Review effect of qh.GOODclosest on qh_buildcone_onlygood ('Qg').  qh_findgood preserves old value if didn't find a good facet.  See qh_findgood_all for disabling
+
+  design:
+    make hyperplanes for point
+    if qh_findgood fails to find a f.good facet or a qh.GOODclosest facet
+      delete cone of new facets
+      return NULL (ignores apex)
+    else
+      attach cone to horizon
+      match neighboring new facets
+*/
+boolT qh_buildcone_onlygood(qhT *qh, vertexT *apex, int goodhorizon) {
+  facetT *newfacet, *nextfacet;
+
+  qh_makenewplanes(qh /* qh.newfacet_list */);
+  if(qh_findgood(qh, qh->newfacet_list, goodhorizon) == 0) {
+    if (!qh->GOODclosest) {
+      for (newfacet=qh->newfacet_list; newfacet && newfacet->next; newfacet= nextfacet) {
+        nextfacet= newfacet->next;
+        qh_delfacet(qh, newfacet);
+      }
+      qh_delvertex(qh, apex);
+      qh_resetlists(qh, False /*no stats*/, qh_RESETvisible /* qh.visible_list newvertex_list qh.newfacet_list */);
+      zinc_(Znotgoodnew);
+      /* !good outside points dropped from hull */
+      return False;
+    }
+  }
+  qh_attachnewfacets(qh /* qh.visible_list */);
+  qh_matchnewfacets(qh); /* ignore returned value.  qh_forcedmerges will merge dupridges if any */
+  qh_update_vertexneighbors_cone(qh);
+  return True;
+} /* buildcone_onlygood */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="buildhull">-</a>
+
+  qh_buildhull(qh)
+    construct a convex hull by adding outside points one at a time
+
+  returns:
+
+  notes:
+    may be called multiple times
+    checks facet and vertex lists for incorrect flags
+    to recover from STOPcone, call qh_deletevisible and qh_resetlists
+
+  design:
+    check visible facet and newfacet flags
+    check newfacet vertex flags and qh.STOPcone/STOPpoint
+    for each facet with a furthest outside point
+      add point to facet
+      exit if qh.STOPcone or qh.STOPpoint requested
+    if qh.NARROWhull for initial simplex
+      partition remaining outside points to coplanar sets
+*/
+void qh_buildhull(qhT *qh) {
+  facetT *facet;
+  pointT *furthest;
+  vertexT *vertex;
+  int id;
+
+  trace1((qh, qh->ferr, 1037, "qh_buildhull: start build hull\n"));
+  FORALLfacets {
+    if (facet->visible || facet->newfacet) {
+      qh_fprintf(qh, qh->ferr, 6165, "qhull internal error (qh_buildhull): visible or new facet f%d in facet list\n",
+                   facet->id);
+      qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+  }
+  FORALLvertices {
+    if (vertex->newfacet) {
+      qh_fprintf(qh, qh->ferr, 6166, "qhull internal error (qh_buildhull): new vertex f%d in vertex list\n",
+                   vertex->id);
+      qh_errprint(qh, "ERRONEOUS", NULL, NULL, NULL, vertex);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+    id= qh_pointid(qh, vertex->point);
+    if ((qh->STOPpoint>0 && id == qh->STOPpoint-1) ||
+        (qh->STOPpoint<0 && id == -qh->STOPpoint-1) ||
+        (qh->STOPcone>0 && id == qh->STOPcone-1)) {
+      trace1((qh, qh->ferr, 1038,"qh_buildhull: stop point or cone P%d in initial hull\n", id));
+      return;
+    }
+  }
+  qh->facet_next= qh->facet_list;      /* advance facet when processed */
+  while ((furthest= qh_nextfurthest(qh, &facet))) {
+    qh->num_outside--;  /* if ONLYmax, furthest may not be outside */
+    if (qh->STOPadd>0 && (qh->num_vertices - qh->hull_dim - 1 >= qh->STOPadd - 1)) {
+      trace1((qh, qh->ferr, 1059, "qh_buildhull: stop after adding %d vertices\n", qh->STOPadd-1));
+      return;
+    }
+    if (!qh_addpoint(qh, furthest, facet, qh->ONLYmax))
+      break;
+  }
+  if (qh->NARROWhull) /* move points from outsideset to coplanarset */
+    qh_outcoplanar(qh /* facet_list */ );
+  if (qh->num_outside && !furthest) {
+    qh_fprintf(qh, qh->ferr, 6167, "qhull internal error (qh_buildhull): %d outside points were never processed.\n", qh->num_outside);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  trace1((qh, qh->ferr, 1039, "qh_buildhull: completed the hull construction\n"));
+} /* buildhull */
+
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="buildtracing">-</a>
+
+  qh_buildtracing(qh, furthest, facet )
+    trace an iteration of qh_buildhull() for furthest point and facet
+    if !furthest, prints progress message
+
+  returns:
+    tracks progress with qh.lastreport, lastcpu, lastfacets, lastmerges, lastplanes, lastdist
+    updates qh.furthest_id (-3 if furthest is NULL)
+    also resets visit_id, vertext_visit on wrap around
+
+  see:
+    qh_tracemerging()
+
+  design:
+    if !furthest
+      print progress message
+      exit
+    if 'TFn' iteration
+      print progress message
+    else if tracing
+      trace furthest point and facet
+    reset qh.visit_id and qh.vertex_visit if overflow may occur
+    set qh.furthest_id for tracing
+*/
+void qh_buildtracing(qhT *qh, pointT *furthest, facetT *facet) {
+  realT dist= 0;
+  double cpu;
+  int total, furthestid;
+  time_t timedata;
+  struct tm *tp;
+  vertexT *vertex;
+
+  qh->old_randomdist= qh->RANDOMdist;
+  qh->RANDOMdist= False;
+  if (!furthest) {
+    time(&timedata);
+    tp= localtime(&timedata);
+    cpu= (double)qh_CPUclock - (double)qh->hulltime;
+    cpu /= (double)qh_SECticks;
+    total= zzval_(Ztotmerge) - zzval_(Zcyclehorizon) + zzval_(Zcyclefacettot);
+    qh_fprintf(qh, qh->ferr, 8118, "\n\
+At %02d:%02d:%02d & %2.5g CPU secs, qhull has created %d facets and merged %d.\n\
+ The current hull contains %d facets and %d vertices.  Last point was p%d\n",
+      tp->tm_hour, tp->tm_min, tp->tm_sec, cpu, qh->facet_id -1,
+      total, qh->num_facets, qh->num_vertices, qh->furthest_id);
+    return;
+  }
+  furthestid= qh_pointid(qh, furthest);
+#ifndef qh_NOtrace
+  if (qh->TRACEpoint == furthestid) {
+    trace1((qh, qh->ferr, 1053, "qh_buildtracing: start trace T%d for point TP%d above facet f%d\n", qh->TRACElevel, furthestid, facet->id));
+    qh->IStracing= qh->TRACElevel;
+    qh->qhmem.IStracing= qh->TRACElevel;
+  }else if (qh->TRACEpoint != qh_IDnone && qh->TRACEdist < REALmax/2) {
+    qh->IStracing= 0;
+    qh->qhmem.IStracing= 0;
+  }
+#endif
+  if (qh->REPORTfreq && (qh->facet_id-1 > qh->lastreport + (unsigned int)qh->REPORTfreq)) {
+    qh->lastreport= qh->facet_id-1;
+    time(&timedata);
+    tp= localtime(&timedata);
+    cpu= (double)qh_CPUclock - (double)qh->hulltime;
+    cpu /= (double)qh_SECticks;
+    total= zzval_(Ztotmerge) - zzval_(Zcyclehorizon) + zzval_(Zcyclefacettot);
+    zinc_(Zdistio);
+    qh_distplane(qh, furthest, facet, &dist);
+    qh_fprintf(qh, qh->ferr, 8119, "\n\
+At %02d:%02d:%02d & %2.5g CPU secs, qhull has created %d facets and merged %d.\n\
+ The current hull contains %d facets and %d vertices.  There are %d\n\
+ outside points.  Next is point p%d(v%d), %2.2g above f%d.\n",
+      tp->tm_hour, tp->tm_min, tp->tm_sec, cpu, qh->facet_id -1,
+      total, qh->num_facets, qh->num_vertices, qh->num_outside+1,
+      furthestid, qh->vertex_id, dist, getid_(facet));
+  }else if (qh->IStracing >=1) {
+    cpu= (double)qh_CPUclock - (double)qh->hulltime;
+    cpu /= (double)qh_SECticks;
+    qh_distplane(qh, furthest, facet, &dist);
+    qh_fprintf(qh, qh->ferr, 1049, "qh_addpoint: add p%d(v%d) %2.2g above f%d to hull of %d facets, %d merges, %d outside at %4.4g CPU secs.  Previous p%d(v%d) delta %4.4g CPU, %d facets, %d merges, %d hyperplanes, %d distplanes, %d retries\n",
+      furthestid, qh->vertex_id, dist, getid_(facet), qh->num_facets, zzval_(Ztotmerge), qh->num_outside+1, cpu, qh->furthest_id, qh->vertex_id - 1,
+      cpu - qh->lastcpu, qh->num_facets - qh->lastfacets,  zzval_(Ztotmerge) - qh->lastmerges, zzval_(Zsetplane) - qh->lastplanes, zzval_(Zdistplane) - qh->lastdist, qh->retry_addpoint);
+    qh->lastcpu= cpu;
+    qh->lastfacets= qh->num_facets;
+    qh->lastmerges= zzval_(Ztotmerge);
+    qh->lastplanes= zzval_(Zsetplane);
+    qh->lastdist= zzval_(Zdistplane);
+  }
+  zmax_(Zvisit2max, (int)qh->visit_id/2);
+  if (qh->visit_id > (unsigned int) INT_MAX) { /* 31 bits */
+    zinc_(Zvisit);
+    if (!qh_checklists(qh, qh->facet_list)) {
+      qh_fprintf(qh, qh->ferr, 6370, "qhull internal error: qh_checklists failed on reset of qh.visit_id %u\n", qh->visit_id);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+    qh->visit_id= 0;
+    FORALLfacets
+      facet->visitid= 0;
+  }
+  zmax_(Zvvisit2max, (int)qh->vertex_visit/2);
+  if (qh->vertex_visit > (unsigned int) INT_MAX) { /* 31 bits */
+    zinc_(Zvvisit);
+    if (qh->visit_id && !qh_checklists(qh, qh->facet_list)) {
+      qh_fprintf(qh, qh->ferr, 6371, "qhull internal error: qh_checklists failed on reset of qh.vertex_visit %u\n", qh->vertex_visit);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+    qh->vertex_visit= 0;
+    FORALLvertices
+      vertex->visitid= 0;
+  }
+  qh->furthest_id= furthestid;
+  qh->RANDOMdist= qh->old_randomdist;
+} /* buildtracing */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="errexit2">-</a>
+
+  qh_errexit2(qh, exitcode, facet, otherfacet )
+    return exitcode to system after an error
+    report two facets
+
+  returns:
+    assumes exitcode non-zero
+
+  see:
+    normally use qh_errexit() in user_r.c(reports a facet and a ridge)
+*/
+void qh_errexit2(qhT *qh, int exitcode, facetT *facet, facetT *otherfacet) {
+  qh->tracefacet= NULL;  /* avoid infinite recursion through qh_fprintf */
+  qh->traceridge= NULL;
+  qh->tracevertex= NULL;
+  qh_errprint(qh, "ERRONEOUS", facet, otherfacet, NULL, NULL);
+  qh_errexit(qh, exitcode, NULL, NULL);
+} /* errexit2 */
+
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="findhorizon">-</a>
+
+  qh_findhorizon(qh, point, facet, goodvisible, goodhorizon )
+    given a visible facet, find the point's horizon and visible facets
+    for all facets, !facet-visible
+
+  returns:
+    returns qh.visible_list/num_visible with all visible facets
+      marks visible facets with ->visible
+    updates count of good visible and good horizon facets
+    updates qh.max_outside, qh.max_vertex, facet->maxoutside
+
+  see:
+    similar to qh_delpoint()
+
+  design:
+    move facet to qh.visible_list at end of qh.facet_list
+    for all visible facets
+     for each unvisited neighbor of a visible facet
+       compute distance of point to neighbor
+       if point above neighbor
+         move neighbor to end of qh.visible_list
+       else if point is coplanar with neighbor
+         update qh.max_outside, qh.max_vertex, neighbor->maxoutside
+         mark neighbor coplanar (will create a samecycle later)
+         update horizon statistics
+*/
+void qh_findhorizon(qhT *qh, pointT *point, facetT *facet, int *goodvisible, int *goodhorizon) {
+  facetT *neighbor, **neighborp, *visible;
+  int numhorizon= 0, coplanar= 0;
+  realT dist;
+
+  trace1((qh, qh->ferr, 1040, "qh_findhorizon: find horizon for point p%d facet f%d\n",qh_pointid(qh, point),facet->id));
+  *goodvisible= *goodhorizon= 0;
+  zinc_(Ztotvisible);
+  qh_removefacet(qh, facet);  /* visible_list at end of qh->facet_list */
+  qh_appendfacet(qh, facet);
+  qh->num_visible= 1;
+  if (facet->good)
+    (*goodvisible)++;
+  qh->visible_list= facet;
+  facet->visible= True;
+  facet->f.replace= NULL;
+  if (qh->IStracing >=4)
+    qh_errprint(qh, "visible", facet, NULL, NULL, NULL);
+  qh->visit_id++;
+  FORALLvisible_facets {
+    if (visible->tricoplanar && !qh->TRInormals) {
+      qh_fprintf(qh, qh->ferr, 6230, "qhull internal error (qh_findhorizon): does not work for tricoplanar facets.  Use option 'Q11'\n");
+      qh_errexit(qh, qh_ERRqhull, visible, NULL);
+    }
+    if (qh_setsize(qh, visible->neighbors) == 0) {
+      qh_fprintf(qh, qh->ferr, 6295, "qhull internal error (qh_findhorizon): visible facet f%d does not have neighbors\n", visible->id);
+      qh_errexit(qh, qh_ERRqhull, visible, NULL);
+    }
+    visible->visitid= qh->visit_id;
+    FOREACHneighbor_(visible) {
+      if (neighbor->visitid == qh->visit_id)
+        continue;
+      neighbor->visitid= qh->visit_id;
+      zzinc_(Znumvisibility);
+      qh_distplane(qh, point, neighbor, &dist);
+      if (dist > qh->MINvisible) {
+        zinc_(Ztotvisible);
+        qh_removefacet(qh, neighbor);  /* append to end of qh->visible_list */
+        qh_appendfacet(qh, neighbor);
+        neighbor->visible= True;
+        neighbor->f.replace= NULL;
+        qh->num_visible++;
+        if (neighbor->good)
+          (*goodvisible)++;
+        if (qh->IStracing >=4)
+          qh_errprint(qh, "visible", neighbor, NULL, NULL, NULL);
+      }else {
+        if (dist >= -qh->MAXcoplanar) {
+          neighbor->coplanarhorizon= True;
+          zzinc_(Zcoplanarhorizon);
+          qh_joggle_restart(qh, "coplanar horizon");
+          coplanar++;
+          if (qh->MERGING) {
+            if (dist > 0) {
+              maximize_(qh->max_outside, dist);
+              maximize_(qh->max_vertex, dist);
+#if qh_MAXoutside
+              maximize_(neighbor->maxoutside, dist);
+#endif
+            }else
+              minimize_(qh->min_vertex, dist);  /* due to merge later */
+          }
+          trace2((qh, qh->ferr, 2057, "qh_findhorizon: point p%d is coplanar to horizon f%d, dist=%2.7g < qh->MINvisible(%2.7g)\n",
+              qh_pointid(qh, point), neighbor->id, dist, qh->MINvisible));
+        }else
+          neighbor->coplanarhorizon= False;
+        zinc_(Ztothorizon);
+        numhorizon++;
+        if (neighbor->good)
+          (*goodhorizon)++;
+        if (qh->IStracing >=4)
+          qh_errprint(qh, "horizon", neighbor, NULL, NULL, NULL);
+      }
+    }
+  }
+  if (!numhorizon) {
+    qh_joggle_restart(qh, "empty horizon");
+    qh_fprintf(qh, qh->ferr, 6168, "qhull topology error (qh_findhorizon): empty horizon for p%d.  It was above all facets.\n", qh_pointid(qh, point));
+    if (qh->num_facets < 100) {
+      qh_printfacetlist(qh, qh->facet_list, NULL, True);
+    }
+    qh_errexit(qh, qh_ERRtopology, NULL, NULL);
+  }
+  trace1((qh, qh->ferr, 1041, "qh_findhorizon: %d horizon facets(good %d), %d visible(good %d), %d coplanar\n",
+       numhorizon, *goodhorizon, qh->num_visible, *goodvisible, coplanar));
+  if (qh->IStracing >= 4 && qh->num_facets < 100)
+    qh_printlists(qh);
+} /* findhorizon */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="joggle_restart">-</a>
+
+  qh_joggle_restart(qh, reason )
+    if joggle ('QJn') and not merging, restart on precision and topology errors
+*/
+void qh_joggle_restart(qhT *qh, const char *reason) {
+
+  if (qh->JOGGLEmax < REALmax/2) {
+    if (qh->ALLOWrestart && !qh->PREmerge && !qh->MERGEexact) {
+      trace0((qh, qh->ferr, 26, "qh_joggle_restart: qhull restart because of %s\n", reason));
+      /* May be called repeatedly if qh->ALLOWrestart */
+      longjmp(qh->restartexit, qh_ERRprec);
+    }
+  }
+} /* qh_joggle_restart */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="nextfurthest">-</a>
+
+  qh_nextfurthest(qh, visible )
+    returns next furthest point and visible facet for qh_addpoint()
+    starts search at qh.facet_next
+
+  returns:
+    removes furthest point from outside set
+    NULL if none available
+    advances qh.facet_next over facets with empty outside sets
+
+  design:
+    for each facet from qh.facet_next
+      if empty outside set
+        advance qh.facet_next
+      else if qh.NARROWhull
+        determine furthest outside point
+        if furthest point is not outside
+          advance qh.facet_next(point will be coplanar)
+    remove furthest point from outside set
+*/
+pointT *qh_nextfurthest(qhT *qh, facetT **visible) {
+  facetT *facet;
+  int size, idx, loopcount= 0;
+  realT randr, dist;
+  pointT *furthest;
+
+  while ((facet= qh->facet_next) != qh->facet_tail) {
+    if (!facet || loopcount++ > qh->num_facets) {
+      qh_fprintf(qh, qh->ferr, 6406, "qhull internal error (qh_nextfurthest): null facet or infinite loop detected for qh.facet_next f%d facet_tail f%d\n",
+        getid_(facet), getid_(qh->facet_tail));
+      qh_printlists(qh);
+      qh_errexit2(qh, qh_ERRqhull, facet, qh->facet_tail);
+    }
+    if (!facet->outsideset) {
+      qh->facet_next= facet->next;
+      continue;
+    }
+    SETreturnsize_(facet->outsideset, size);
+    if (!size) {
+      qh_setfree(qh, &facet->outsideset);
+      qh->facet_next= facet->next;
+      continue;
+    }
+    if (qh->NARROWhull) {
+      if (facet->notfurthest)
+        qh_furthestout(qh, facet);
+      furthest= (pointT *)qh_setlast(facet->outsideset);
+#if qh_COMPUTEfurthest
+      qh_distplane(qh, furthest, facet, &dist);
+      zinc_(Zcomputefurthest);
+#else
+      dist= facet->furthestdist;
+#endif
+      if (dist < qh->MINoutside) { /* remainder of outside set is coplanar for qh_outcoplanar */
+        qh->facet_next= facet->next;
+        continue;
+      }
+    }
+    if (!qh->RANDOMoutside && !qh->VIRTUALmemory) {
+      if (qh->PICKfurthest) {
+        qh_furthestnext(qh /* qh.facet_list */);
+        facet= qh->facet_next;
+      }
+      *visible= facet;
+      return ((pointT *)qh_setdellast(facet->outsideset));
+    }
+    if (qh->RANDOMoutside) {
+      int outcoplanar= 0;
+      if (qh->NARROWhull) {
+        FORALLfacets {
+          if (facet == qh->facet_next)
+            break;
+          if (facet->outsideset)
+            outcoplanar += qh_setsize(qh, facet->outsideset);
+        }
+      }
+      randr= qh_RANDOMint;
+      randr= randr/(qh_RANDOMmax+1);
+      randr= floor((qh->num_outside - outcoplanar) * randr);
+      idx= (int)randr;
+      FORALLfacet_(qh->facet_next) {
+        if (facet->outsideset) {
+          SETreturnsize_(facet->outsideset, size);
+          if (!size)
+            qh_setfree(qh, &facet->outsideset);
+          else if (size > idx) {
+            *visible= facet;
+            return ((pointT *)qh_setdelnth(qh, facet->outsideset, idx));
+          }else
+            idx -= size;
+        }
+      }
+      qh_fprintf(qh, qh->ferr, 6169, "qhull internal error (qh_nextfurthest): num_outside %d is too low\nby at least %d, or a random real %g >= 1.0\n",
+              qh->num_outside, idx+1, randr);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }else { /* VIRTUALmemory */
+      facet= qh->facet_tail->previous;
+      if (!(furthest= (pointT *)qh_setdellast(facet->outsideset))) {
+        if (facet->outsideset)
+          qh_setfree(qh, &facet->outsideset);
+        qh_removefacet(qh, facet);
+        qh_prependfacet(qh, facet, &qh->facet_list);
+        continue;
+      }
+      *visible= facet;
+      return furthest;
+    }
+  }
+  return NULL;
+} /* nextfurthest */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="partitionall">-</a>
+
+  qh_partitionall(qh, vertices, points, numpoints )
+    partitions all points in points/numpoints to the outsidesets of facets
+    vertices= vertices in qh.facet_list(!partitioned)
+
+  returns:
+    builds facet->outsideset
+    does not partition qh.GOODpoint
+    if qh.ONLYgood && !qh.MERGING,
+      does not partition qh.GOODvertex
+
+  notes:
+    faster if qh.facet_list sorted by anticipated size of outside set
+
+  design:
+    initialize pointset with all points
+    remove vertices from pointset
+    remove qh.GOODpointp from pointset (unless it's qh.STOPcone or qh.STOPpoint)
+    for all facets
+      for all remaining points in pointset
+        compute distance from point to facet
+        if point is outside facet
+          remove point from pointset (by not reappending)
+          update bestpoint
+          append point or old bestpoint to facet's outside set
+      append bestpoint to facet's outside set (furthest)
+    for all points remaining in pointset
+      partition point into facets' outside sets and coplanar sets
+*/
+void qh_partitionall(qhT *qh, setT *vertices, pointT *points, int numpoints){
+  setT *pointset;
+  vertexT *vertex, **vertexp;
+  pointT *point, **pointp, *bestpoint;
+  int size, point_i, point_n, point_end, remaining, i, id;
+  facetT *facet;
+  realT bestdist= -REALmax, dist, distoutside;
+
+  trace1((qh, qh->ferr, 1042, "qh_partitionall: partition all points into outside sets\n"));
+  pointset= qh_settemp(qh, numpoints);
+  qh->num_outside= 0;
+  pointp= SETaddr_(pointset, pointT);
+  for (i=numpoints, point= points; i--; point += qh->hull_dim)
+    *(pointp++)= point;
+  qh_settruncate(qh, pointset, numpoints);
+  FOREACHvertex_(vertices) {
+    if ((id= qh_pointid(qh, vertex->point)) >= 0)
+      SETelem_(pointset, id)= NULL;
+  }
+  id= qh_pointid(qh, qh->GOODpointp);
+  if (id >=0 && qh->STOPcone-1 != id && -qh->STOPpoint-1 != id)
+    SETelem_(pointset, id)= NULL;
+  if (qh->GOODvertexp && qh->ONLYgood && !qh->MERGING) { /* matches qhull()*/
+    if ((id= qh_pointid(qh, qh->GOODvertexp)) >= 0)
+      SETelem_(pointset, id)= NULL;
+  }
+  if (!qh->BESToutside) {  /* matches conditional for qh_partitionpoint below */
+    distoutside= qh_DISToutside; /* multiple of qh.MINoutside & qh.max_outside, see user_r.h */
+    zval_(Ztotpartition)= qh->num_points - qh->hull_dim - 1; /*misses GOOD... */
+    remaining= qh->num_facets;
+    point_end= numpoints;
+    FORALLfacets {
+      size= point_end/(remaining--) + 100;
+      facet->outsideset= qh_setnew(qh, size);
+      bestpoint= NULL;
+      point_end= 0;
+      FOREACHpoint_i_(qh, pointset) {
+        if (point) {
+          zzinc_(Zpartitionall);
+          qh_distplane(qh, point, facet, &dist);
+          if (dist < distoutside)
+            SETelem_(pointset, point_end++)= point;
+          else {
+            qh->num_outside++;
+            if (!bestpoint) {
+              bestpoint= point;
+              bestdist= dist;
+            }else if (dist > bestdist) {
+              qh_setappend(qh, &facet->outsideset, bestpoint);
+              bestpoint= point;
+              bestdist= dist;
+            }else
+              qh_setappend(qh, &facet->outsideset, point);
+          }
+        }
+      }
+      if (bestpoint) {
+        qh_setappend(qh, &facet->outsideset, bestpoint);
+#if !qh_COMPUTEfurthest
+        facet->furthestdist= bestdist;
+#endif
+      }else
+        qh_setfree(qh, &facet->outsideset);
+      qh_settruncate(qh, pointset, point_end);
+    }
+  }
+  /* if !qh->BESToutside, pointset contains points not assigned to outsideset */
+  if (qh->BESToutside || qh->MERGING || qh->KEEPcoplanar || qh->KEEPinside || qh->KEEPnearinside) {
+    qh->findbestnew= True;
+    FOREACHpoint_i_(qh, pointset) {
+      if (point)
+        qh_partitionpoint(qh, point, qh->facet_list);
+    }
+    qh->findbestnew= False;
+  }
+  zzadd_(Zpartitionall, zzval_(Zpartition));
+  zzval_(Zpartition)= 0;
+  qh_settempfree(qh, &pointset);
+  if (qh->IStracing >= 4)
+    qh_printfacetlist(qh, qh->facet_list, NULL, True);
+} /* partitionall */
+
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="partitioncoplanar">-</a>
+
+  qh_partitioncoplanar(qh, point, facet, dist, allnew )
+    partition coplanar point to a facet
+    dist is distance from point to facet
+    if dist NULL,
+      searches for bestfacet and does nothing if inside
+    if allnew (qh.findbestnew)
+      searches new facets instead of using qh_findbest()
+
+  returns:
+    qh.max_ouside updated
+    if qh.KEEPcoplanar or qh.KEEPinside
+      point assigned to best coplanarset
+    qh.repart_facetid==0 (for detecting infinite recursion via qh_partitionpoint)
+
+  notes:
+    facet->maxoutside is updated at end by qh_check_maxout
+
+  design:
+    if dist undefined
+      find best facet for point
+      if point sufficiently below facet (depends on qh.NEARinside and qh.KEEPinside)
+        exit
+    if keeping coplanar/nearinside/inside points
+      if point is above furthest coplanar point
+        append point to coplanar set (it is the new furthest)
+        update qh.max_outside
+      else
+        append point one before end of coplanar set
+    else if point is clearly outside of qh.max_outside and bestfacet->coplanarset
+    and bestfacet is more than perpendicular to facet
+      repartition the point using qh_findbest() -- it may be put on an outsideset
+    else
+      update qh.max_outside
+*/
+void qh_partitioncoplanar(qhT *qh, pointT *point, facetT *facet, realT *dist, boolT allnew) {
+  facetT *bestfacet;
+  pointT *oldfurthest;
+  realT bestdist, angle, nearest, dist2= 0.0;
+  int numpart= 0;
+  boolT isoutside, oldfindbest, repartition= False;
+
+  trace4((qh, qh->ferr, 4090, "qh_partitioncoplanar: partition coplanar point p%d starting with f%d dist? %2.2g, allnew? %d, gh.repart_facetid f%d\n",
+    qh_pointid(qh, point), facet->id, (dist ? *dist : 0.0), allnew, qh->repart_facetid));
+  qh->WAScoplanar= True;
+  if (!dist) {
+    if (allnew)
+      bestfacet= qh_findbestnew(qh, point, facet, &bestdist, qh_ALL, &isoutside, &numpart);
+    else
+      bestfacet= qh_findbest(qh, point, facet, qh_ALL, !qh_ISnewfacets, qh->DELAUNAY,
+                          &bestdist, &isoutside, &numpart);
+    zinc_(Ztotpartcoplanar);
+    zzadd_(Zpartcoplanar, numpart);
+    if (!qh->DELAUNAY && !qh->KEEPinside) { /*  for 'd', bestdist skips upperDelaunay facets */
+      if (qh->KEEPnearinside) {
+        if (bestdist < -qh->NEARinside) {
+          zinc_(Zcoplanarinside);
+          trace4((qh, qh->ferr, 4062, "qh_partitioncoplanar: point p%d is more than near-inside facet f%d dist %2.2g allnew? %d\n",
+                  qh_pointid(qh, point), bestfacet->id, bestdist, allnew));
+          qh->repart_facetid= 0;
+          return;
+        }
+      }else if (bestdist < -qh->MAXcoplanar) {
+          trace4((qh, qh->ferr, 4063, "qh_partitioncoplanar: point p%d is inside facet f%d dist %2.2g allnew? %d\n",
+                  qh_pointid(qh, point), bestfacet->id, bestdist, allnew));
+        zinc_(Zcoplanarinside);
+        qh->repart_facetid= 0;
+        return;
+      }
+    }
+  }else {
+    bestfacet= facet;
+    bestdist= *dist;
+  }
+  if(bestfacet->visible){
+    qh_fprintf(qh, qh->ferr, 6405, "qhull internal error (qh_partitioncoplanar): cannot partition coplanar p%d of f%d into visible facet f%d\n",
+        qh_pointid(qh, point), facet->id, bestfacet->id);
+    qh_errexit2(qh, qh_ERRqhull, facet, bestfacet);
+  }
+  if (bestdist > qh->max_outside) {
+    if (!dist && facet != bestfacet) { /* can't be recursive from qh_partitionpoint since facet != bestfacet */
+      zinc_(Zpartangle);
+      angle= qh_getangle(qh, facet->normal, bestfacet->normal);
+      if (angle < 0) {
+        nearest= qh_vertex_bestdist(qh, bestfacet->vertices);
+        /* typically due to deleted vertex and coplanar facets, e.g.,
+        RBOX 1000 s Z1 G1e-13 t1001185205 | QHULL Tv */
+        zinc_(Zpartcorner);
+        trace2((qh, qh->ferr, 2058, "qh_partitioncoplanar: repartition coplanar point p%d from f%d as an outside point above corner facet f%d dist %2.2g with angle %2.2g\n",
+          qh_pointid(qh, point), facet->id, bestfacet->id, bestdist, angle));
+        repartition= True;
+      }
+    }
+    if (!repartition) {
+      if (bestdist > qh->MAXoutside * qh_RATIOcoplanaroutside) {
+        nearest= qh_vertex_bestdist(qh, bestfacet->vertices);
+        if (facet->id == bestfacet->id) {
+          if (facet->id == qh->repart_facetid) {
+            qh_fprintf(qh, qh->ferr, 6404, "Qhull internal error (qh_partitioncoplanar): infinite loop due to recursive call to qh_partitionpoint.  Repartition point p%d from f%d as a outside point dist %2.2g nearest vertices %2.2g\n",
+              qh_pointid(qh, point), facet->id, bestdist, nearest);
+            qh_errexit(qh, qh_ERRqhull, facet, NULL);
+          }
+          qh->repart_facetid= facet->id; /* reset after call to qh_partitionpoint */
+        }
+        if (point == qh->coplanar_apex) {
+          /* otherwise may loop indefinitely, the point is well above a facet, yet near a vertex */
+          qh_fprintf(qh, qh->ferr, 6425, "Qhull topology error (qh_partitioncoplanar): can not repartition coplanar point p%d from f%d as outside point above f%d.  It previously failed to form a cone of facets, dist %2.2g, nearest vertices %2.2g\n",
+            qh_pointid(qh, point), facet->id, bestfacet->id, bestdist, nearest);
+          qh_errexit(qh, qh_ERRtopology, facet, NULL);
+        }
+        if (nearest < 2 * qh->MAXoutside * qh_RATIOcoplanaroutside) {
+          zinc_(Zparttwisted);
+          qh_fprintf(qh, qh->ferr, 7085, "Qhull precision warning: repartition coplanar point p%d from f%d as an outside point above twisted facet f%d dist %2.2g nearest vertices %2.2g\n",
+            qh_pointid(qh, point), facet->id, bestfacet->id, bestdist, nearest);
+        }else {
+          zinc_(Zparthidden);
+          qh_fprintf(qh, qh->ferr, 7086, "Qhull precision warning: repartition coplanar point p%d from f%d as an outside point above hidden facet f%d dist %2.2g nearest vertices %2.2g\n",
+            qh_pointid(qh, point), facet->id, bestfacet->id, bestdist, nearest);
+        }
+        repartition= True;
+      }
+    }
+    if (repartition) {
+      oldfindbest= qh->findbestnew;
+      qh->findbestnew= False;
+      qh_partitionpoint(qh, point, bestfacet);
+      qh->findbestnew= oldfindbest;
+      qh->repart_facetid= 0;
+      return;
+    }
+    qh->repart_facetid= 0;
+    qh->max_outside= bestdist;
+    if (bestdist > qh->TRACEdist || qh->IStracing >= 3) {
+      qh_fprintf(qh, qh->ferr, 3041, "qh_partitioncoplanar: == p%d from f%d increases qh.max_outside to %2.2g of f%d last p%d\n",
+                     qh_pointid(qh, point), facet->id, bestdist, bestfacet->id, qh->furthest_id);
+      qh_errprint(qh, "DISTANT", facet, bestfacet, NULL, NULL);
+    }
+  }
+  if (qh->KEEPcoplanar + qh->KEEPinside + qh->KEEPnearinside) {
+    oldfurthest= (pointT *)qh_setlast(bestfacet->coplanarset);
+    if (oldfurthest) {
+      zinc_(Zcomputefurthest);
+      qh_distplane(qh, oldfurthest, bestfacet, &dist2);
+    }
+    if (!oldfurthest || dist2 < bestdist)
+      qh_setappend(qh, &bestfacet->coplanarset, point);
+    else
+      qh_setappend2ndlast(qh, &bestfacet->coplanarset, point);
+  }
+  trace4((qh, qh->ferr, 4064, "qh_partitioncoplanar: point p%d is coplanar with facet f%d (or inside) dist %2.2g\n",
+          qh_pointid(qh, point), bestfacet->id, bestdist));
+} /* partitioncoplanar */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="partitionpoint">-</a>
+
+  qh_partitionpoint(qh, point, facet )
+    assigns point to an outside set, coplanar set, or inside set (i.e., dropt)
+    if qh.findbestnew
+      uses qh_findbestnew() to search all new facets
+    else
+      uses qh_findbest()
+
+  notes:
+    after qh_distplane(), this and qh_findbest() are most expensive in 3-d
+
+  design:
+    find best facet for point
+      (either exhaustive search of new facets or directed search from facet)
+    if qh.NARROWhull
+      retain coplanar and nearinside points as outside points
+    if point is outside bestfacet
+      if point above furthest point for bestfacet
+        append point to outside set (it becomes the new furthest)
+        if outside set was empty
+          move bestfacet to end of qh.facet_list (i.e., after qh.facet_next)
+        update bestfacet->furthestdist
+      else
+        append point one before end of outside set
+    else if point is coplanar to bestfacet
+      if keeping coplanar points or need to update qh.max_outside
+        partition coplanar point into bestfacet
+    else if near-inside point
+      partition as coplanar point into bestfacet
+    else is an inside point
+      if keeping inside points
+        partition as coplanar point into bestfacet
+*/
+void qh_partitionpoint(qhT *qh, pointT *point, facetT *facet) {
+  realT bestdist, previousdist;
+  boolT isoutside, isnewoutside= False;
+  facetT *bestfacet;
+  int numpart;
+
+  if (qh->findbestnew)
+    bestfacet= qh_findbestnew(qh, point, facet, &bestdist, qh->BESToutside, &isoutside, &numpart);
+  else
+    bestfacet= qh_findbest(qh, point, facet, qh->BESToutside, qh_ISnewfacets, !qh_NOupper,
+                          &bestdist, &isoutside, &numpart);
+  zinc_(Ztotpartition);
+  zzadd_(Zpartition, numpart);
+  if(bestfacet->visible){
+    qh_fprintf(qh, qh->ferr, 6293, "qhull internal error (qh_partitionpoint): cannot partition p%d of f%d into visible facet f%d\n",
+      qh_pointid(qh, point), facet->id, bestfacet->id);
+    qh_errexit2(qh, qh_ERRqhull, facet, bestfacet);
+  }
+  if (qh->NARROWhull) {
+    if (qh->DELAUNAY && !isoutside && bestdist >= -qh->MAXcoplanar)
+      qh_joggle_restart(qh, "nearly incident point (narrow hull)");
+    if (qh->KEEPnearinside) {
+      if (bestdist >= -qh->NEARinside)
+        isoutside= True;
+    }else if (bestdist >= -qh->MAXcoplanar)
+      isoutside= True;
+  }
+
+  if (isoutside) {
+    if (!bestfacet->outsideset
+    || !qh_setlast(bestfacet->outsideset)) { /* empty outside set */
+      qh_setappend(qh, &(bestfacet->outsideset), point);
+      if (!qh->NARROWhull || bestdist > qh->MINoutside)
+        isnewoutside= True;
+#if !qh_COMPUTEfurthest
+      bestfacet->furthestdist= bestdist;
+#endif
+    }else {
+#if qh_COMPUTEfurthest
+      zinc_(Zcomputefurthest);
+      qh_distplane(qh, oldfurthest, bestfacet, &previousdist);
+      if (previousdist < bestdist)
+        qh_setappend(qh, &(bestfacet->outsideset), point);
+      else
+        qh_setappend2ndlast(qh, &(bestfacet->outsideset), point);
+#else
+      previousdist= bestfacet->furthestdist;
+      if (previousdist < bestdist) {
+        qh_setappend(qh, &(bestfacet->outsideset), point);
+        bestfacet->furthestdist= bestdist;
+        if (qh->NARROWhull && previousdist < qh->MINoutside && bestdist >= qh->MINoutside)
+          isnewoutside= True;
+      }else
+        qh_setappend2ndlast(qh, &(bestfacet->outsideset), point);
+#endif
+    }
+    if (isnewoutside && qh->facet_next != bestfacet) {
+      if (bestfacet->newfacet) {
+        if (qh->facet_next->newfacet)
+          qh->facet_next= qh->newfacet_list; /* make sure it's after qh.facet_next */
+      }else {
+        qh_removefacet(qh, bestfacet);  /* make sure it's after qh.facet_next */
+        qh_appendfacet(qh, bestfacet);
+        if(qh->newfacet_list){
+          bestfacet->newfacet= True;
+        }
+      }
+    }
+    qh->num_outside++;
+    trace4((qh, qh->ferr, 4065, "qh_partitionpoint: point p%d is outside facet f%d newfacet? %d, newoutside? %d (or narrowhull)\n",
+          qh_pointid(qh, point), bestfacet->id, bestfacet->newfacet, isnewoutside));
+  }else if (qh->DELAUNAY || bestdist >= -qh->MAXcoplanar) { /* for 'd', bestdist skips upperDelaunay facets */
+    if (qh->DELAUNAY)
+      qh_joggle_restart(qh, "nearly incident point");
+    /* allow coplanar points with joggle, may be interior */
+    zzinc_(Zcoplanarpart);
+    if ((qh->KEEPcoplanar + qh->KEEPnearinside) || bestdist > qh->max_outside)
+      qh_partitioncoplanar(qh, point, bestfacet, &bestdist, qh->findbestnew);
+    else {
+      trace4((qh, qh->ferr, 4066, "qh_partitionpoint: point p%d is coplanar to facet f%d (dropped)\n",
+          qh_pointid(qh, point), bestfacet->id));
+    }
+  }else if (qh->KEEPnearinside && bestdist >= -qh->NEARinside) {
+    zinc_(Zpartnear);
+    qh_partitioncoplanar(qh, point, bestfacet, &bestdist, qh->findbestnew);
+  }else {
+    zinc_(Zpartinside);
+    trace4((qh, qh->ferr, 4067, "qh_partitionpoint: point p%d is inside all facets, closest to f%d dist %2.2g\n",
+          qh_pointid(qh, point), bestfacet->id, bestdist));
+    if (qh->KEEPinside)
+      qh_partitioncoplanar(qh, point, bestfacet, &bestdist, qh->findbestnew);
+  }
+} /* partitionpoint */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="partitionvisible">-</a>
+
+  qh_partitionvisible(qh, allpoints, numoutside )
+    partitions outside points in visible facets (qh.visible_list) to qh.newfacet_list
+    if keeping coplanar/near-inside/inside points
+      partitions coplanar points; repartitions if 'allpoints' (not used)
+    1st neighbor (if any) of visible facets points to a horizon facet or a new facet
+
+  returns:
+    updates outside sets and coplanar sets of qh.newfacet_list
+    updates qh.num_outside (count of outside points)
+    does not truncate f.outsideset, f.coplanarset, or qh.del_vertices (see qh_deletevisible)
+
+  notes:
+    called by qh_qhull, qh_addpoint, and qh_all_vertexmerges
+    qh.findbest_notsharp should be clear (extra work if set)
+
+  design:
+    for all visible facets with outside set or coplanar set
+      select a newfacet for visible facet
+      if outside set
+        partition outside set into new facets
+      if coplanar set and keeping coplanar/near-inside/inside points
+        if allpoints
+          partition coplanar set into new facets, may be assigned outside
+        else
+          partition coplanar set into coplanar sets of new facets
+    for each deleted vertex
+      if allpoints
+        partition vertex into new facets, may be assigned outside
+      else
+        partition vertex into coplanar sets of new facets
+*/
+void qh_partitionvisible(qhT *qh, boolT allpoints, int *numoutside /* qh.visible_list */) {
+  facetT *visible, *newfacet;
+  pointT *point, **pointp;
+  int delsize, coplanar=0, size;
+  vertexT *vertex, **vertexp;
+
+  trace3((qh, qh->ferr, 3042, "qh_partitionvisible: partition outside and coplanar points of visible and merged facets f%d into new facets f%d\n",
+    qh->visible_list->id, qh->newfacet_list->id));
+  if (qh->ONLYmax)
+    maximize_(qh->MINoutside, qh->max_vertex);
+  *numoutside= 0;
+  FORALLvisible_facets {
+    if (!visible->outsideset && !visible->coplanarset)
+      continue;
+    newfacet= qh_getreplacement(qh, visible);
+    if (!newfacet)
+      newfacet= qh->newfacet_list;
+    if (!newfacet->next) {
+      qh_fprintf(qh, qh->ferr, 6170, "qhull topology error (qh_partitionvisible): all new facets deleted as\n       degenerate facets. Can not continue.\n");
+      qh_errexit(qh, qh_ERRtopology, NULL, NULL);
+    }
+    if (visible->outsideset) {
+      size= qh_setsize(qh, visible->outsideset);
+      *numoutside += size;
+      qh->num_outside -= size;
+      FOREACHpoint_(visible->outsideset)
+        qh_partitionpoint(qh, point, newfacet);
+    }
+    if (visible->coplanarset && (qh->KEEPcoplanar + qh->KEEPinside + qh->KEEPnearinside)) {
+      size= qh_setsize(qh, visible->coplanarset);
+      coplanar += size;
+      FOREACHpoint_(visible->coplanarset) {
+        if (allpoints) /* not used */
+          qh_partitionpoint(qh, point, newfacet);
+        else
+          qh_partitioncoplanar(qh, point, newfacet, NULL, qh->findbestnew);
+      }
+    }
+  }
+  delsize= qh_setsize(qh, qh->del_vertices);
+  if (delsize > 0) {
+    trace3((qh, qh->ferr, 3049, "qh_partitionvisible: partition %d deleted vertices as coplanar? %d points into new facets f%d\n",
+      delsize, !allpoints, qh->newfacet_list->id));
+    FOREACHvertex_(qh->del_vertices) {
+      if (vertex->point && !vertex->partitioned) {
+        if (!qh->newfacet_list || qh->newfacet_list == qh->facet_tail) {
+          qh_fprintf(qh, qh->ferr, 6284, "qhull internal error (qh_partitionvisible): all new facets deleted or none defined.  Can not partition deleted v%d.\n", vertex->id);
+          qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+        }
+        if (allpoints) /* not used */
+          /* [apr'2019] infinite loop if vertex recreates the same facets from the same horizon
+             e.g., qh_partitionpoint if qh.DELAUNAY with qh.MERGEindependent for all mergetype, ../eg/qtest.sh t427764 '1000 s W1e-13 D3' 'd' */
+          qh_partitionpoint(qh, vertex->point, qh->newfacet_list);
+        else
+          qh_partitioncoplanar(qh, vertex->point, qh->newfacet_list, NULL, qh_ALL); /* search all new facets */
+        vertex->partitioned= True;
+      }
+    }
+  }
+  trace1((qh, qh->ferr, 1043,"qh_partitionvisible: partitioned %d points from outsidesets, %d points from coplanarsets, and %d deleted vertices\n", *numoutside, coplanar, delsize));
+} /* partitionvisible */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="printsummary">-</a>
+
+  qh_printsummary(qh, fp )
+    prints summary to fp
+
+  notes:
+    not in io_r.c so that user_eg.c can prevent io_r.c from loading
+    qh_printsummary and qh_countfacets must match counts
+    updates qh.facet_visit to detect infinite loop
+
+  design:
+    determine number of points, vertices, and coplanar points
+    print summary
+*/
+void qh_printsummary(qhT *qh, FILE *fp) {
+  realT ratio, outerplane, innerplane;
+  double cpu;
+  int size, id, nummerged, numpinched, numvertices, numcoplanars= 0, nonsimplicial=0, numdelaunay= 0;
+  facetT *facet;
+  const char *s;
+  int numdel= zzval_(Zdelvertextot);
+  int numtricoplanars= 0;
+  boolT goodused;
+
+  size= qh->num_points + qh_setsize(qh, qh->other_points);
+  numvertices= qh->num_vertices - qh_setsize(qh, qh->del_vertices);
+  id= qh_pointid(qh, qh->GOODpointp);
+  if (!qh_checklists(qh, qh->facet_list) && !qh->ERREXITcalled) {
+    qh_fprintf(qh, fp, 6372, "qhull internal error: qh_checklists failed at qh_printsummary\n");
+    if (qh->num_facets < 4000)
+      qh_printlists(qh);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (qh->DELAUNAY && qh->ERREXITcalled) {
+    /* update f.good and determine qh.num_good as in qh_findgood_all */
+    FORALLfacets {
+      if (facet->visible)
+        facet->good= False; /* will be deleted */
+      else if (facet->good) {
+        if (facet->normal && !qh_inthresholds(qh, facet->normal, NULL))
+          facet->good= False;
+        else
+          numdelaunay++;
+      }
+    }
+    qh->num_good= numdelaunay;
+  }
+  FORALLfacets {
+    if (facet->coplanarset)
+      numcoplanars += qh_setsize(qh, facet->coplanarset);
+    if (facet->good) {
+      if (facet->simplicial) {
+        if (facet->keepcentrum && facet->tricoplanar)
+          numtricoplanars++;
+      }else if (qh_setsize(qh, facet->vertices) != qh->hull_dim)
+        nonsimplicial++;
+    }
+  }
+  if (id >=0 && qh->STOPcone-1 != id && -qh->STOPpoint-1 != id)
+    size--;
+  if (qh->STOPadd || qh->STOPcone || qh->STOPpoint)
+    qh_fprintf(qh, fp, 9288, "\nEarly exit due to 'TAn', 'TVn', 'TCn', 'TRn', or precision error with 'QJn'.");
+  goodused= False;
+  if (qh->ERREXITcalled)
+    ; /* qh_findgood_all not called */
+  else if (qh->UPPERdelaunay) {
+    if (qh->GOODvertex || qh->GOODpoint || qh->SPLITthresholds)
+      goodused= True;
+  }else if (qh->DELAUNAY) {
+    if (qh->GOODvertex || qh->GOODpoint || qh->GOODthreshold)
+      goodused= True;
+  }else if (qh->num_good > 0 || qh->GOODthreshold)
+    goodused= True;
+  nummerged= zzval_(Ztotmerge) - zzval_(Zcyclehorizon) + zzval_(Zcyclefacettot);
+  if (qh->VORONOI) {
+    if (qh->UPPERdelaunay)
+      qh_fprintf(qh, fp, 9289, "\n\
+Furthest-site Voronoi vertices by the convex hull of %d points in %d-d:\n\n", size, qh->hull_dim);
+    else
+      qh_fprintf(qh, fp, 9290, "\n\
+Voronoi diagram by the convex hull of %d points in %d-d:\n\n", size, qh->hull_dim);
+    qh_fprintf(qh, fp, 9291, "  Number of Voronoi regions%s: %d\n",
+              qh->ATinfinity ? " and at-infinity" : "", numvertices);
+    if (numdel)
+      qh_fprintf(qh, fp, 9292, "  Total number of deleted points due to merging: %d\n", numdel);
+    if (numcoplanars - numdel > 0)
+      qh_fprintf(qh, fp, 9293, "  Number of nearly incident points: %d\n", numcoplanars - numdel);
+    else if (size - numvertices - numdel > 0)
+      qh_fprintf(qh, fp, 9294, "  Total number of nearly incident points: %d\n", size - numvertices - numdel);
+    qh_fprintf(qh, fp, 9295, "  Number of%s Voronoi vertices: %d\n",
+              goodused ? " 'good'" : "", qh->num_good);
+    if (nonsimplicial)
+      qh_fprintf(qh, fp, 9296, "  Number of%s non-simplicial Voronoi vertices: %d\n",
+              goodused ? " 'good'" : "", nonsimplicial);
+  }else if (qh->DELAUNAY) {
+    if (qh->UPPERdelaunay)
+      qh_fprintf(qh, fp, 9297, "\n\
+Furthest-site Delaunay triangulation by the convex hull of %d points in %d-d:\n\n", size, qh->hull_dim);
+    else
+      qh_fprintf(qh, fp, 9298, "\n\
+Delaunay triangulation by the convex hull of %d points in %d-d:\n\n", size, qh->hull_dim);
+    qh_fprintf(qh, fp, 9299, "  Number of input sites%s: %d\n",
+              qh->ATinfinity ? " and at-infinity" : "", numvertices);
+    if (numdel)
+      qh_fprintf(qh, fp, 9300, "  Total number of deleted points due to merging: %d\n", numdel);
+    if (numcoplanars - numdel > 0)
+      qh_fprintf(qh, fp, 9301, "  Number of nearly incident points: %d\n", numcoplanars - numdel);
+    else if (size - numvertices - numdel > 0)
+      qh_fprintf(qh, fp, 9302, "  Total number of nearly incident points: %d\n", size - numvertices - numdel);
+    qh_fprintf(qh, fp, 9303, "  Number of%s Delaunay regions: %d\n",
+              goodused ? " 'good'" : "", qh->num_good);
+    if (nonsimplicial)
+      qh_fprintf(qh, fp, 9304, "  Number of%s non-simplicial Delaunay regions: %d\n",
+              goodused ? " 'good'" : "", nonsimplicial);
+  }else if (qh->HALFspace) {
+    qh_fprintf(qh, fp, 9305, "\n\
+Halfspace intersection by the convex hull of %d points in %d-d:\n\n", size, qh->hull_dim);
+    qh_fprintf(qh, fp, 9306, "  Number of halfspaces: %d\n", size);
+    qh_fprintf(qh, fp, 9307, "  Number of non-redundant halfspaces: %d\n", numvertices);
+    if (numcoplanars) {
+      if (qh->KEEPinside && qh->KEEPcoplanar)
+        s= "similar and redundant";
+      else if (qh->KEEPinside)
+        s= "redundant";
+      else
+        s= "similar";
+      qh_fprintf(qh, fp, 9308, "  Number of %s halfspaces: %d\n", s, numcoplanars);
+    }
+    qh_fprintf(qh, fp, 9309, "  Number of intersection points: %d\n", qh->num_facets - qh->num_visible);
+    if (goodused)
+      qh_fprintf(qh, fp, 9310, "  Number of 'good' intersection points: %d\n", qh->num_good);
+    if (nonsimplicial)
+      qh_fprintf(qh, fp, 9311, "  Number of%s non-simplicial intersection points: %d\n",
+              goodused ? " 'good'" : "", nonsimplicial);
+  }else {
+    qh_fprintf(qh, fp, 9312, "\n\
+Convex hull of %d points in %d-d:\n\n", size, qh->hull_dim);
+    qh_fprintf(qh, fp, 9313, "  Number of vertices: %d\n", numvertices);
+    if (numcoplanars) {
+      if (qh->KEEPinside && qh->KEEPcoplanar)
+        s= "coplanar and interior";
+      else if (qh->KEEPinside)
+        s= "interior";
+      else
+        s= "coplanar";
+      qh_fprintf(qh, fp, 9314, "  Number of %s points: %d\n", s, numcoplanars);
+    }
+    qh_fprintf(qh, fp, 9315, "  Number of facets: %d\n", qh->num_facets - qh->num_visible);
+    if (goodused)
+      qh_fprintf(qh, fp, 9316, "  Number of 'good' facets: %d\n", qh->num_good);
+    if (nonsimplicial)
+      qh_fprintf(qh, fp, 9317, "  Number of%s non-simplicial facets: %d\n",
+              goodused ? " 'good'" : "", nonsimplicial);
+  }
+  if (numtricoplanars)
+      qh_fprintf(qh, fp, 9318, "  Number of triangulated facets: %d\n", numtricoplanars);
+  qh_fprintf(qh, fp, 9319, "\nStatistics for: %s | %s",
+                      qh->rbox_command, qh->qhull_command);
+  if (qh->ROTATErandom != INT_MIN)
+    qh_fprintf(qh, fp, 9320, " QR%d\n\n", qh->ROTATErandom);
+  else
+    qh_fprintf(qh, fp, 9321, "\n\n");
+  qh_fprintf(qh, fp, 9322, "  Number of points processed: %d\n", zzval_(Zprocessed));
+  qh_fprintf(qh, fp, 9323, "  Number of hyperplanes created: %d\n", zzval_(Zsetplane));
+  if (qh->DELAUNAY)
+    qh_fprintf(qh, fp, 9324, "  Number of facets in hull: %d\n", qh->num_facets - qh->num_visible);
+  qh_fprintf(qh, fp, 9325, "  Number of distance tests for qhull: %d\n", zzval_(Zpartition)+
+      zzval_(Zpartitionall)+zzval_(Znumvisibility)+zzval_(Zpartcoplanar));
+#if 0  /* NOTE: must print before printstatistics() */
+  {realT stddev, ave;
+  qh_fprintf(qh, fp, 9326, "  average new facet balance: %2.2g\n",
+          wval_(Wnewbalance)/zval_(Zprocessed));
+  stddev= qh_stddev(zval_(Zprocessed), wval_(Wnewbalance),
+                                 wval_(Wnewbalance2), &ave);
+  qh_fprintf(qh, fp, 9327, "  new facet standard deviation: %2.2g\n", stddev);
+  qh_fprintf(qh, fp, 9328, "  average partition balance: %2.2g\n",
+          wval_(Wpbalance)/zval_(Zpbalance));
+  stddev= qh_stddev(zval_(Zpbalance), wval_(Wpbalance),
+                                 wval_(Wpbalance2), &ave);
+  qh_fprintf(qh, fp, 9329, "  partition standard deviation: %2.2g\n", stddev);
+  }
+#endif
+  if (nummerged) {
+    qh_fprintf(qh, fp, 9330,"  Number of distance tests for merging: %d\n",zzval_(Zbestdist)+
+          zzval_(Zcentrumtests)+zzval_(Zvertextests)+zzval_(Zdistcheck)+zzval_(Zdistzero));
+    qh_fprintf(qh, fp, 9331,"  Number of distance tests for checking: %d\n",zzval_(Zcheckpart)+zzval_(Zdistconvex));
+    qh_fprintf(qh, fp, 9332,"  Number of merged facets: %d\n", nummerged);
+  }
+  numpinched= zzval_(Zpinchduplicate) + zzval_(Zpinchedvertex);
+  if (numpinched)
+    qh_fprintf(qh, fp, 9375,"  Number of merged pinched vertices: %d\n", numpinched);
+  if (!qh->RANDOMoutside && qh->QHULLfinished) {
+    cpu= (double)qh->hulltime;
+    cpu /= (double)qh_SECticks;
+    wval_(Wcpu)= cpu;
+    qh_fprintf(qh, fp, 9333, "  CPU seconds to compute hull (after input): %2.4g\n", cpu);
+  }
+  if (qh->RERUN) {
+    if (!qh->PREmerge && !qh->MERGEexact)
+      qh_fprintf(qh, fp, 9334, "  Percentage of runs with precision errors: %4.1f\n",
+           zzval_(Zretry)*100.0/qh->build_cnt);  /* careful of order */
+  }else if (qh->JOGGLEmax < REALmax/2) {
+    if (zzval_(Zretry))
+      qh_fprintf(qh, fp, 9335, "  After %d retries, input joggled by: %2.2g\n",
+         zzval_(Zretry), qh->JOGGLEmax);
+    else
+      qh_fprintf(qh, fp, 9336, "  Input joggled by: %2.2g\n", qh->JOGGLEmax);
+  }
+  if (qh->totarea != 0.0)
+    qh_fprintf(qh, fp, 9337, "  %s facet area:   %2.8g\n",
+            zzval_(Ztotmerge) ? "Approximate" : "Total", qh->totarea);
+  if (qh->totvol != 0.0)
+    qh_fprintf(qh, fp, 9338, "  %s volume:       %2.8g\n",
+            zzval_(Ztotmerge) ? "Approximate" : "Total", qh->totvol);
+  if (qh->MERGING) {
+    qh_outerinner(qh, NULL, &outerplane, &innerplane);
+    if (outerplane > 2 * qh->DISTround) {
+      qh_fprintf(qh, fp, 9339, "  Maximum distance of point above facet: %2.2g", outerplane);
+      ratio= outerplane/(qh->ONEmerge + qh->DISTround);
+      /* don't report ratio if MINoutside is large */
+      if (ratio > 0.05 && 2* qh->ONEmerge > qh->MINoutside && qh->JOGGLEmax > REALmax/2)
+        qh_fprintf(qh, fp, 9340, " (%.1fx)\n", ratio);
+      else
+        qh_fprintf(qh, fp, 9341, "\n");
+    }
+    if (innerplane < -2 * qh->DISTround) {
+      qh_fprintf(qh, fp, 9342, "  Maximum distance of vertex below facet: %2.2g", innerplane);
+      ratio= -innerplane/(qh->ONEmerge+qh->DISTround);
+      if (ratio > 0.05 && qh->JOGGLEmax > REALmax/2)
+        qh_fprintf(qh, fp, 9343, " (%.1fx)\n", ratio);
+      else
+        qh_fprintf(qh, fp, 9344, "\n");
+    }
+  }
+  qh_fprintf(qh, fp, 9345, "\n");
+} /* printsummary */
+
+
diff --git a/contrib/libs/qhull/libqhull_r/libqhull_r.h b/contrib/libs/qhull/libqhull_r/libqhull_r.h
new file mode 100644
index 0000000000..1f476b33ea
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/libqhull_r.h
@@ -0,0 +1,1227 @@
+/*<html><pre>  -<a                             href="qh-qhull_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   libqhull_r.h
+   user-level header file for using qhull.a library
+
+   see qh-qhull_r.htm, qhull_ra.h
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/libqhull_r.h#16 $$Change: 3037 $
+   $DateTime: 2020/09/03 17:28:32 $$Author: bbarber $
+
+   includes function prototypes for libqhull_r.c, geom_r.c, global_r.c, io_r.c, user_r.c
+
+   use mem_r.h for mem_r.c
+   use qset_r.h for qset_r.c
+
+   see unix_r.c for an example of using libqhull_r.h
+
+   recompile qhull if you change this file
+*/
+
+#ifndef qhDEFlibqhull
+#define qhDEFlibqhull 1
+
+/*=========================== -included files ==============*/
+
+/* user_r.h first for QHULL_CRTDBG */
+#include "user_r.h"      /* user definable constants (e.g., realT). */
+
+#include "mem_r.h"   /* Needed for qhT in libqhull_r.h */
+#include "qset_r.h"   /* Needed for QHULL_LIB_CHECK */
+/* include stat_r.h after defining boolT.  Needed for qhT in libqhull_r.h */
+
+#include <setjmp.h>
+#include <float.h>
+#include <limits.h>
+#include <time.h>
+#include <stdio.h>
+
+#ifndef __STDC__
+#ifndef __cplusplus
+#if     !defined(_MSC_VER)
+#error  Neither __STDC__ nor __cplusplus is defined.  Please use strict ANSI C or C++ to compile
+#error  Qhull.  You may need to turn off compiler extensions in your project configuration.  If
+#error  your compiler is a standard C compiler, you can delete this warning from libqhull_r.h
+#endif
+#endif
+#endif
+
+/*============ constants and basic types ====================*/
+
+extern const char qh_version[]; /* defined in global_r.c */
+extern const char qh_version2[]; /* defined in global_r.c */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="coordT">-</a>
+
+  coordT
+    coordinates and coefficients are stored as realT (i.e., double)
+
+  notes:
+    Qhull works well if realT is 'float'.  If so joggle (QJ) is not effective.
+
+    Could use 'float' for data and 'double' for calculations (realT vs. coordT)
+      This requires many type casts, and adjusted error bounds.
+      Also C compilers may do expressions in double anyway.
+*/
+#define coordT realT
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="pointT">-</a>
+
+  pointT
+    a point is an array of coordinates, usually qh.hull_dim
+    qh_pointid returns
+      qh_IDnone if point==0 or qh is undefined
+      qh_IDinterior for qh.interior_point
+      qh_IDunknown if point is neither in qh.first_point... nor qh.other_points
+
+  notes:
+    qh.STOPcone and qh.STOPpoint assume that qh_IDunknown==-1 (other negative numbers indicate points)
+    qh_IDunknown is also returned by getid_() for unknown facet, ridge, or vertex
+*/
+#define pointT coordT
+typedef enum
+{
+    qh_IDnone= -3, qh_IDinterior= -2, qh_IDunknown= -1
+}
+qh_pointT;
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >--------------------------------</a><a name="flagT">-</a>
+
+  flagT
+    Boolean flag as a bit
+*/
+#define flagT unsigned int
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >--------------------------------</a><a name="boolT">-</a>
+
+  boolT
+    boolean value, either True or False
+
+  notes:
+    needed for portability
+    Use qh_False/qh_True as synonyms
+*/
+#define boolT unsigned int
+#ifdef False
+#undef False
+#endif
+#ifdef True
+#undef True
+#endif
+#define False 0
+#define True 1
+#define qh_False 0
+#define qh_True 1
+
+#include "stat_r.h"  /* needs boolT */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >--------------------------------</a><a name="CENTERtype">-</a>
+
+  qh_CENTER
+    to distinguish facet->center
+*/
+typedef enum
+{
+    qh_ASnone= 0,    /* If not MERGING and not VORONOI */
+    qh_ASvoronoi,    /* Set by qh_clearcenters on qh_prepare_output, or if not MERGING and VORONOI */
+    qh_AScentrum     /* If MERGING (assumed during merging) */
+}
+qh_CENTER;
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >--------------------------------</a><a name="qh_PRINT">-</a>
+
+  qh_PRINT
+    output formats for printing (qh.PRINTout).
+    'Fa' 'FV' 'Fc' 'FC'
+
+
+   notes:
+   some of these names are similar to qhT names.  The similar names are only
+   used in switch statements in qh_printbegin() etc.
+*/
+typedef enum {qh_PRINTnone= 0,
+  qh_PRINTarea, qh_PRINTaverage,           /* 'Fa' 'FV' 'Fc' 'FC' */
+  qh_PRINTcoplanars, qh_PRINTcentrums,
+  qh_PRINTfacets, qh_PRINTfacets_xridge,   /* 'f' 'FF' 'G' 'FI' 'Fi' 'Fn' */
+  qh_PRINTgeom, qh_PRINTids, qh_PRINTinner, qh_PRINTneighbors,
+  qh_PRINTnormals, qh_PRINTouter, qh_PRINTmaple, /* 'n' 'Fo' 'i' 'm' 'Fm' 'FM', 'o' */
+  qh_PRINTincidences, qh_PRINTmathematica, qh_PRINTmerges, qh_PRINToff,
+  qh_PRINToptions, qh_PRINTpointintersect, /* 'FO' 'Fp' 'FP' 'p' 'FQ' 'FS' */
+  qh_PRINTpointnearest, qh_PRINTpoints, qh_PRINTqhull, qh_PRINTsize,
+  qh_PRINTsummary, qh_PRINTtriangles,      /* 'Fs' 'Ft' 'Fv' 'FN' 'Fx' */
+  qh_PRINTvertices, qh_PRINTvneighbors, qh_PRINTextremes,
+  qh_PRINTEND} qh_PRINT;
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >--------------------------------</a><a name="qh_ALL">-</a>
+
+  qh_ALL
+    argument flag for selecting everything
+*/
+#define qh_ALL      True
+#define qh_NOupper  True      /* argument for qh_findbest */
+#define qh_IScheckmax  True   /* argument for qh_findbesthorizon */
+#define qh_ISnewfacets  True  /* argument for qh_findbest */
+#define qh_RESETvisible  True /* argument for qh_resetlists */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >--------------------------------</a><a name="qh_ERR">-</a>
+
+  qh_ERR...
+    Qhull exit status codes, for indicating errors
+    See: MSG_ERROR (6000) and MSG_WARNING (7000) [user_r.h]
+*/
+#define qh_ERRnone  0    /* no error occurred during qhull */
+#define qh_ERRinput 1    /* input inconsistency */
+#define qh_ERRsingular 2 /* singular input data, calls qh_printhelp_singular */
+#define qh_ERRprec  3    /* precision error, calls qh_printhelp_degenerate */
+#define qh_ERRmem   4    /* insufficient memory, matches mem_r.h */
+#define qh_ERRqhull 5    /* internal error detected, matches mem_r.h, calls qh_printhelp_internal */
+#define qh_ERRother 6    /* other error detected */
+#define qh_ERRtopology 7 /* topology error, maybe due to nearly adjacent vertices, calls qh_printhelp_topology */
+#define qh_ERRwide 8     /* wide facet error, maybe due to nearly adjacent vertices, calls qh_printhelp_wide */
+#define qh_ERRdebug 9    /* qh_errexit from debugging code */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+>--------------------------------</a><a name="qh_FILEstderr">-</a>
+
+qh_FILEstderr
+Fake stderr to distinguish error output from normal output
+For C++ interface.  Must redefine qh_fprintf_qhull
+*/
+#define qh_FILEstderr ((FILE *)1)
+
+/* ============ -structures- ====================
+   each of the following structures is defined by a typedef
+   all realT and coordT fields occur at the beginning of a structure
+        (otherwise space may be wasted due to alignment)
+   define all flags together and pack into 32-bit number
+
+   DEFqhT and DEFsetT are likewise defined in mem_r.h, qset_r.h, and stat_r.h
+*/
+
+typedef struct vertexT vertexT;
+typedef struct ridgeT ridgeT;
+typedef struct facetT facetT;
+
+#ifndef DEFqhT
+#define DEFqhT 1
+typedef struct qhT qhT;          /* defined below */
+#endif
+
+#ifndef DEFsetT
+#define DEFsetT 1
+typedef struct setT setT;        /* defined in qset_r.h */
+#endif
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="facetT">-</a>
+
+  facetT
+    defines a facet
+
+  notes:
+   qhull() generates the hull as a list of facets.
+
+  topological information:
+    f.previous,next     doubly-linked list of facets, next is always defined
+    f.vertices          set of vertices
+    f.ridges            set of ridges
+    f.neighbors         set of neighbors
+    f.toporient         True if facet has top-orientation (else bottom)
+
+  geometric information:
+    f.offset,normal     hyperplane equation
+    f.maxoutside        offset to outer plane -- all points inside
+    f.center            centrum for testing convexity or Voronoi center for output
+    f.simplicial        True if facet is simplicial
+    f.flipped           True if facet does not include qh.interior_point
+
+  for constructing hull:
+    f.visible           True if facet on list of visible facets (will be deleted)
+    f.newfacet          True if facet on list of newly created facets
+    f.coplanarset       set of points coplanar with this facet
+                        (includes near-inside points for later testing)
+    f.outsideset        set of points outside of this facet
+    f.furthestdist      distance to furthest point of outside set
+    f.visitid           marks visited facets during a loop
+    f.replace           replacement facet for to-be-deleted, visible facets
+    f.samecycle,newcycle cycle of facets for merging into horizon facet
+
+  see below for other flags and fields
+*/
+/* QhullFacet.cpp -- Update static initializer list for s_empty_facet if add or remove fields */
+struct facetT {
+#if !qh_COMPUTEfurthest
+  coordT   furthestdist;/* distance to furthest point of outsideset */
+#endif
+#if qh_MAXoutside
+  coordT   maxoutside;  /* max computed distance of point to facet
+                        Before QHULLfinished this is an approximation
+                        since maxdist not always set for qh_mergefacet
+                        Actual outer plane is +DISTround and
+                        computed outer plane is +2*DISTround.
+                        Initial maxoutside is qh.DISTround, otherwise distance tests need to account for DISTround */
+#endif
+  coordT   offset;      /* exact offset of hyperplane from origin */
+  coordT  *normal;      /* normal of hyperplane, hull_dim coefficients */
+                        /*   if f.tricoplanar, shared with a neighbor */
+  union {               /* in order of testing */
+   realT   area;        /* area of facet, only in io_r.c if  f.isarea */
+   facetT *replace;     /* replacement facet for qh.NEWfacets with f.visible
+                             NULL if qh_mergedegen_redundant, interior, or !NEWfacets */
+   facetT *samecycle;   /* cycle of facets from the same visible/horizon intersection,
+                             if ->newfacet */
+   facetT *newcycle;    /*  in horizon facet, current samecycle of new facets */
+   facetT *trivisible;  /* visible facet for ->tricoplanar facets during qh_triangulate() */
+   facetT *triowner;    /* owner facet for ->tricoplanar, !isarea facets w/ ->keepcentrum */
+  }f;
+  coordT  *center;      /* set according to qh.CENTERtype */
+                        /*   qh_ASnone:    no center (not MERGING) */
+                        /*   qh_AScentrum: centrum for testing convexity (qh_getcentrum) */
+                        /*                 assumed qh_AScentrum while merging */
+                        /*   qh_ASvoronoi: Voronoi center (qh_facetcenter) */
+                        /* after constructing the hull, it may be changed (qh_clearcenter) */
+                        /* if tricoplanar and !keepcentrum, shared with a neighbor */
+  facetT  *previous;    /* previous facet in the facet_list or NULL, for C++ interface */
+  facetT  *next;        /* next facet in the facet_list or facet_tail */
+  setT    *vertices;    /* vertices for this facet, inverse sorted by ID
+                           if simplicial, 1st vertex was apex/furthest
+                           qh_reduce_vertices removes extraneous vertices via qh_remove_extravertices
+                           if f.visible, vertices may be on qh.del_vertices */
+  setT    *ridges;      /* explicit ridges for nonsimplicial facets or nonsimplicial neighbors.
+                           For simplicial facets, neighbors define the ridges
+                           qh_makeridges() converts simplicial facets by creating ridges prior to merging
+                           If qh.NEWtentative, new facets have horizon ridge, but not vice versa
+                           if f.visible && qh.NEWfacets, ridges is empty */
+  setT    *neighbors;   /* neighbors of the facet.  Neighbors may be f.visible
+                           If simplicial, the kth neighbor is opposite the kth vertex and the
+                           first neighbor is the horizon facet for the first vertex.
+                           dupridges marked by qh_DUPLICATEridge (0x01) and qh_MERGEridge (0x02)
+                           if f.visible && qh.NEWfacets, neighbors is empty */
+  setT    *outsideset;  /* set of points outside this facet
+                           if non-empty, last point is furthest
+                           if NARROWhull, includes coplanars (less than qh.MINoutside) for partitioning*/
+  setT    *coplanarset; /* set of points coplanar with this facet
+                           >= qh.min_vertex and <= facet->max_outside
+                           a point is assigned to the furthest facet
+                           if non-empty, last point is furthest away */
+  unsigned int visitid; /* visit_id, for visiting all neighbors,
+                           all uses are independent */
+  unsigned int id;      /* unique identifier from qh.facet_id, 1..qh.facet_id, 0 is sentinel, printed as 'f%d' */
+  unsigned int nummerge:9; /* number of merges */
+#define qh_MAXnummerge 511 /* 2^9-1 */
+                        /* 23 flags (at most 23 due to nummerge), printed by "flags:" in io_r.c */
+  flagT    tricoplanar:1; /* True if TRIangulate and simplicial and coplanar with a neighbor */
+                          /*   all tricoplanars share the same apex */
+                          /*   all tricoplanars share the same ->center, ->normal, ->offset, ->maxoutside */
+                          /*     ->keepcentrum is true for the owner.  It has the ->coplanareset */
+                          /*   if ->degenerate, does not span facet (one logical ridge) */
+                          /*   during qh_triangulate, f.trivisible points to original facet */
+  flagT    newfacet:1;  /* True if facet on qh.newfacet_list (new/qh.first_newfacet or merged) */
+  flagT    visible:1;   /* True if visible facet (will be deleted) */
+  flagT    toporient:1; /* True if created with top orientation
+                           after merging, use ridge orientation */
+  flagT    simplicial:1;/* True if simplicial facet, ->ridges may be implicit */
+  flagT    seen:1;      /* used to perform operations only once, like visitid */
+  flagT    seen2:1;     /* used to perform operations only once, like visitid */
+  flagT    flipped:1;   /* True if facet is flipped */
+  flagT    upperdelaunay:1; /* True if facet is upper envelope of Delaunay triangulation */
+  flagT    notfurthest:1; /* True if last point of outsideset is not furthest */
+
+/*-------- flags primarily for output ---------*/
+  flagT    good:1;      /* True if a facet marked good for output */
+  flagT    isarea:1;    /* True if facet->f.area is defined */
+
+/*-------- flags for merging ------------------*/
+  flagT    dupridge:1;  /* True if facet has one or more dupridge in a new facet (qh_matchneighbor),
+                             a dupridge has a subridge shared by more than one new facet */
+  flagT    mergeridge:1; /* True if facet or neighbor has a qh_MERGEridge (qh_mark_dupridges)
+                            ->normal defined for mergeridge and mergeridge2 */
+  flagT    mergeridge2:1; /* True if neighbor has a qh_MERGEridge (qh_mark_dupridges) */
+  flagT    coplanarhorizon:1;  /* True if horizon facet is coplanar at last use */
+  flagT     mergehorizon:1; /* True if will merge into horizon (its first neighbor w/ f.coplanarhorizon). */
+  flagT     cycledone:1;/* True if mergecycle_all already done */
+  flagT    tested:1;    /* True if facet convexity has been tested (false after merge */
+  flagT    keepcentrum:1; /* True if keep old centrum after a merge, or marks owner for ->tricoplanar
+                             Set by qh_updatetested if more than qh_MAXnewcentrum extra vertices
+                             Set by qh_mergefacet if |maxdist| > qh.WIDEfacet */
+  flagT    newmerge:1;  /* True if facet is newly merged for reducevertices */
+  flagT    degenerate:1; /* True if facet is degenerate (degen_mergeset or ->tricoplanar) */
+  flagT    redundant:1;  /* True if facet is redundant (degen_mergeset)
+                         Maybe merge degenerate and redundant to gain another flag */
+};
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="ridgeT">-</a>
+
+  ridgeT
+    defines a ridge
+
+  notes:
+  a ridge is hull_dim-1 simplex between two neighboring facets.  If the
+  facets are non-simplicial, there may be more than one ridge between
+  two facets.  E.G. a 4-d hypercube has two triangles between each pair
+  of neighboring facets.
+
+  topological information:
+    vertices            a set of vertices
+    top,bottom          neighboring facets with orientation
+
+  geometric information:
+    tested              True if ridge is clearly convex
+    nonconvex           True if ridge is non-convex
+*/
+/* QhullRidge.cpp -- Update static initializer list for s_empty_ridge if add or remove fields */
+struct ridgeT {
+  setT    *vertices;    /* vertices belonging to this ridge, inverse sorted by ID
+                           NULL if a degen ridge (matchsame) */
+  facetT  *top;         /* top facet for this ridge */
+  facetT  *bottom;      /* bottom facet for this ridge
+                        ridge oriented by odd/even vertex order and top/bottom */
+  unsigned int id;      /* unique identifier.  Same size as vertex_id, printed as 'r%d' */
+  flagT    seen:1;      /* used to perform operations only once */
+  flagT    tested:1;    /* True when ridge is tested for convexity by centrum or opposite vertices */
+  flagT    nonconvex:1; /* True if getmergeset detected a non-convex neighbor
+                           only one ridge between neighbors may have nonconvex */
+  flagT    mergevertex:1; /* True if pending qh_appendvertexmerge due to
+                             qh_maybe_duplicateridge or qh_maybe_duplicateridges
+                             disables check for duplicate vertices in qh_checkfacet */
+  flagT    mergevertex2:1; /* True if qh_drop_mergevertex of MRGvertices, printed but not used */
+  flagT    simplicialtop:1; /* True if top was simplicial (original vertices) */
+  flagT    simplicialbot:1; /* True if bottom was simplicial (original vertices)
+                             use qh_test_centrum_merge if top and bot, need to retest since centrum may change */
+};
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="vertexT">-</a>
+
+  vertexT
+     defines a vertex
+
+  topological information:
+    next,previous       doubly-linked list of all vertices
+    neighbors           set of adjacent facets (only if qh.VERTEXneighbors)
+
+  geometric information:
+    point               array of DIM3 coordinates
+*/
+/* QhullVertex.cpp -- Update static initializer list for s_empty_vertex if add or remove fields */
+struct vertexT {
+  vertexT *next;        /* next vertex in vertex_list or vertex_tail */
+  vertexT *previous;    /* previous vertex in vertex_list or NULL, for C++ interface */
+  pointT  *point;       /* hull_dim coordinates (coordT) */
+  setT    *neighbors;   /* neighboring facets of vertex, qh_vertexneighbors()
+                           initialized in io_r.c or after first merge
+                           qh_update_vertices for qh_addpoint or qh_triangulate
+                           updated by merges
+                           qh_order_vertexneighbors by 2-d (orientation) 3-d (adjacency), n-d (f.visitid,id) */
+  unsigned int id;      /* unique identifier, 1..qh.vertex_id,  0 for sentinel, printed as 'r%d' */
+  unsigned int visitid; /* for use with qh.vertex_visit, size must match */
+  flagT    seen:1;      /* used to perform operations only once */
+  flagT    seen2:1;     /* another seen flag */
+  flagT    deleted:1;   /* vertex will be deleted via qh.del_vertices */
+  flagT    delridge:1;  /* vertex belonged to a deleted ridge, cleared by qh_reducevertices */
+  flagT    newfacet:1;  /* true if vertex is in a new facet
+                           vertex is on qh.newvertex_list and it has a facet on qh.newfacet_list
+                           or vertex is on qh.newvertex_list due to qh_newvertices while merging
+                           cleared by qh_resetlists */
+  flagT    partitioned:1; /* true if deleted vertex has been partitioned */
+};
+
+/*======= -global variables -qh ============================*/
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh">-</a>
+
+  qhT
+   All global variables for qhull are in qhT.  It includes qhmemT, qhstatT, and rbox globals
+
+   This version of Qhull is reentrant, but it is not thread-safe.
+
+   Do not run separate threads on the same instance of qhT.
+
+   QHULL_LIB_CHECK checks that a program and the corresponding
+   qhull library were built with the same type of header files.
+
+   QHULL_LIB_TYPE is QHULL_NON_REENTRANT, QHULL_QH_POINTER, or QHULL_REENTRANT
+*/
+
+#define QHULL_NON_REENTRANT 0
+#define QHULL_QH_POINTER 1
+#define QHULL_REENTRANT 2
+
+#define QHULL_LIB_TYPE QHULL_REENTRANT
+
+#define QHULL_LIB_CHECK qh_lib_check(QHULL_LIB_TYPE, sizeof(qhT), sizeof(vertexT), sizeof(ridgeT), sizeof(facetT), sizeof(setT), sizeof(qhmemT));
+#define QHULL_LIB_CHECK_RBOX qh_lib_check(QHULL_LIB_TYPE, sizeof(qhT), sizeof(vertexT), sizeof(ridgeT), sizeof(facetT), 0, 0);
+
+struct qhT {
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-const">-</a>
+
+  qh constants
+    configuration flags and constants for Qhull
+
+  notes:
+    The user configures Qhull by defining flags.  They are
+    copied into qh by qh_setflags().  qh-quick_r.htm#options defines the flags.
+*/
+  boolT ALLpoints;        /* true 'Qs' if search all points for initial simplex */
+  boolT ALLOWshort;       /* true 'Qa' allow input with fewer or more points than coordinates */
+  boolT ALLOWwarning;     /* true 'Qw' if allow option warnings */
+  boolT ALLOWwide;        /* true 'Q12' if allow wide facets and wide dupridges, c.f. qh_WIDEmaxoutside */
+  boolT ANGLEmerge;       /* true 'Q1' if sort potential merges by type/angle instead of type/distance  */
+  boolT APPROXhull;       /* true 'Wn' if MINoutside set */
+  realT MINoutside;       /*   Minimum distance for an outside point ('Wn' or 2*qh.MINvisible) */
+  boolT ANNOTATEoutput;   /* true 'Ta' if annotate output with message codes */
+  boolT ATinfinity;       /* true 'Qz' if point num_points-1 is "at-infinity"
+                             for improving precision in Delaunay triangulations */
+  boolT AVOIDold;         /* true 'Q4' if avoid old->new merges */
+  boolT BESToutside;      /* true 'Qf' if partition points into best outsideset */
+  boolT CDDinput;         /* true 'Pc' if input uses CDD format (1.0/offset first) */
+  boolT CDDoutput;        /* true 'PC' if print normals in CDD format (offset first) */
+  boolT CHECKduplicates;  /* true 'Q15' if qh_maybe_duplicateridges after each qh_mergefacet */
+  boolT CHECKfrequently;  /* true 'Tc' if checking frequently */
+  realT premerge_cos;     /*   'A-n'   cos_max when pre merging */
+  realT postmerge_cos;    /*   'An'    cos_max when post merging */
+  boolT DELAUNAY;         /* true 'd' or 'v' if computing DELAUNAY triangulation */
+  boolT DOintersections;  /* true 'Gh' if print hyperplane intersections */
+  int   DROPdim;          /* drops dim 'GDn' for 4-d -> 3-d output */
+  boolT FLUSHprint;       /* true 'Tf' if flush after qh_fprintf for segfaults */
+  boolT FORCEoutput;      /* true 'Po' if forcing output despite degeneracies */
+  int   GOODpoint;        /* 'QGn' or 'QG-n' (n+1, n-1), good facet if visible from point n (or not) */
+  pointT *GOODpointp;     /*   the actual point */
+  boolT GOODthreshold;    /* true 'Pd/PD' if qh.lower_threshold/upper_threshold defined
+                             set if qh.UPPERdelaunay (qh_initbuild)
+                             false if qh.SPLITthreshold */
+  int   GOODvertex;       /* 'QVn' or 'QV-n' (n+1, n-1), good facet if vertex for point n (or not) */
+  pointT *GOODvertexp;     /*   the actual point */
+  boolT HALFspace;        /* true 'Hn,n,n' if halfspace intersection */
+  boolT ISqhullQh;        /* Set by Qhull.cpp on initialization */
+  int   IStracing;        /* 'Tn' trace execution, 0=none, 1=least, 4=most, -1=events */
+  int   KEEParea;         /* 'PAn' number of largest facets to keep */
+  boolT KEEPcoplanar;     /* true 'Qc' if keeping nearest facet for coplanar points */
+  boolT KEEPinside;       /* true 'Qi' if keeping nearest facet for inside points
+                              set automatically if 'd Qc' */
+  int   KEEPmerge;        /* 'PMn' number of facets to keep with most merges */
+  realT KEEPminArea;      /* 'PFn' minimum facet area to keep */
+  realT MAXcoplanar;      /* 'Un' max distance below a facet to be coplanar*/
+  int   MAXwide;          /* 'QWn' max ratio for wide facet, otherwise error unless Q12-allow-wide */
+  boolT MERGEexact;       /* true 'Qx' if exact merges (concave, degen, dupridge, flipped)
+                             tested by qh_checkzero and qh_test_*_merge */
+  boolT MERGEindependent; /* true if merging independent sets of coplanar facets. 'Q2' disables */
+  boolT MERGING;          /* true if exact-, pre- or post-merging, with angle and centrum tests */
+  realT   premerge_centrum;  /*   'C-n' centrum_radius when pre merging.  Default is round-off */
+  realT   postmerge_centrum; /*   'Cn' centrum_radius when post merging.  Default is round-off */
+  boolT MERGEpinched;     /* true 'Q14' if merging pinched vertices due to dupridge */
+  boolT MERGEvertices;    /* true if merging redundant vertices, 'Q3' disables or qh.hull_dim > qh_DIMmergeVertex */
+  realT MINvisible;       /* 'Vn' min. distance for a facet to be visible */
+  boolT NOnarrow;         /* true 'Q10' if no special processing for narrow distributions */
+  boolT NOnearinside;     /* true 'Q8' if ignore near-inside points when partitioning, qh_check_points may fail */
+  boolT NOpremerge;       /* true 'Q0' if no defaults for C-0 or Qx */
+  boolT ONLYgood;         /* true 'Qg' if process points with good visible or horizon facets */
+  boolT ONLYmax;          /* true 'Qm' if only process points that increase max_outside */
+  boolT PICKfurthest;     /* true 'Q9' if process furthest of furthest points*/
+  boolT POSTmerge;        /* true if merging after buildhull ('Cn' or 'An') */
+  boolT PREmerge;         /* true if merging during buildhull ('C-n' or 'A-n') */
+                        /* NOTE: some of these names are similar to qh_PRINT names */
+  boolT PRINTcentrums;    /* true 'Gc' if printing centrums */
+  boolT PRINTcoplanar;    /* true 'Gp' if printing coplanar points */
+  int   PRINTdim;         /* print dimension for Geomview output */
+  boolT PRINTdots;        /* true 'Ga' if printing all points as dots */
+  boolT PRINTgood;        /* true 'Pg' if printing good facets
+                             PGood set if 'd', 'PAn', 'PFn', 'PMn', 'QGn', 'QG-n', 'QVn', or 'QV-n' */
+  boolT PRINTinner;       /* true 'Gi' if printing inner planes */
+  boolT PRINTneighbors;   /* true 'PG' if printing neighbors of good facets */
+  boolT PRINTnoplanes;    /* true 'Gn' if printing no planes */
+  boolT PRINToptions1st;  /* true 'FO' if printing options to stderr */
+  boolT PRINTouter;       /* true 'Go' if printing outer planes */
+  boolT PRINTprecision;   /* false 'Pp' if not reporting precision problems */
+  qh_PRINT PRINTout[qh_PRINTEND]; /* list of output formats to print */
+  boolT PRINTridges;      /* true 'Gr' if print ridges */
+  boolT PRINTspheres;     /* true 'Gv' if print vertices as spheres */
+  boolT PRINTstatistics;  /* true 'Ts' if printing statistics to stderr */
+  boolT PRINTsummary;     /* true 's' if printing summary to stderr */
+  boolT PRINTtransparent; /* true 'Gt' if print transparent outer ridges */
+  boolT PROJECTdelaunay;  /* true if DELAUNAY, no readpoints() and
+                             need projectinput() for Delaunay in qh_init_B */
+  int   PROJECTinput;     /* number of projected dimensions 'bn:0Bn:0' */
+  boolT RANDOMdist;       /* true 'Rn' if randomly change distplane and setfacetplane */
+  realT RANDOMfactor;     /*    maximum random perturbation */
+  realT RANDOMa;          /*    qh_randomfactor is randr * RANDOMa + RANDOMb */
+  realT RANDOMb;
+  boolT RANDOMoutside;    /* true 'Qr' if select a random outside point */
+  int   REPORTfreq;       /* 'TFn' buildtracing reports every n facets */
+  int   REPORTfreq2;      /* tracemerging reports every REPORTfreq/2 facets */
+  int   RERUN;            /* 'TRn' rerun qhull n times (qh.build_cnt) */
+  int   ROTATErandom;     /* 'QRn' n<-1 random seed, n==-1 time is seed, n==0 random rotation by time, n>0 rotate input */
+  boolT SCALEinput;       /* true 'Qbk' if scaling input */
+  boolT SCALElast;        /* true 'Qbb' if scale last coord to max prev coord */
+  boolT SETroundoff;      /* true 'En' if qh.DISTround is predefined */
+  boolT SKIPcheckmax;     /* true 'Q5' if skip qh_check_maxout, qh_check_points may fail */
+  boolT SKIPconvex;       /* true 'Q6' if skip convexity testing during pre-merge */
+  boolT SPLITthresholds;  /* true 'Pd/PD' if upper_/lower_threshold defines a region
+                               else qh.GOODthresholds
+                               set if qh.DELAUNAY (qh_initbuild)
+                               used only for printing (!for qh.ONLYgood) */
+  int   STOPadd;          /* 'TAn' 1+n for stop after adding n vertices */
+  int   STOPcone;         /* 'TCn' 1+n for stopping after cone for point n */
+                          /*       also used by qh_build_withresart for err exit*/
+  int   STOPpoint;        /* 'TVn' 'TV-n' 1+n for stopping after/before(-)
+                                        adding point n */
+  int   TESTpoints;       /* 'QTn' num of test points after qh.num_points.  Test points always coplanar. */
+  boolT TESTvneighbors;   /*  true 'Qv' if test vertex neighbors at end */
+  int   TRACElevel;       /* 'Tn' conditional IStracing level */
+  int   TRACElastrun;     /*  qh.TRACElevel applies to last qh.RERUN */
+  int   TRACEpoint;       /* 'TPn' start tracing when point n is a vertex, use qh_IDunknown (-1) after qh_buildhull and qh_postmerge */
+  realT TRACEdist;        /* 'TWn' start tracing when merge distance too big */
+  int   TRACEmerge;       /* 'TMn' start tracing before this merge */
+  boolT TRIangulate;      /* true 'Qt' if triangulate non-simplicial facets */
+  boolT TRInormals;       /* true 'Q11' if triangulate duplicates ->normal and ->center (sets Qt) */
+  boolT UPPERdelaunay;    /* true 'Qu' if computing furthest-site Delaunay */
+  boolT USEstdout;        /* true 'Tz' if using stdout instead of stderr */
+  boolT VERIFYoutput;     /* true 'Tv' if verify output at end of qhull */
+  boolT VIRTUALmemory;    /* true 'Q7' if depth-first processing in buildhull */
+  boolT VORONOI;          /* true 'v' if computing Voronoi diagram, also sets qh.DELAUNAY */
+
+  /*--------input constants ---------*/
+  realT AREAfactor;       /* 1/(hull_dim-1)! for converting det's to area */
+  boolT DOcheckmax;       /* true if calling qh_check_maxout (!qh.SKIPcheckmax && qh.MERGING) */
+  char  *feasible_string;  /* feasible point 'Hn,n,n' for halfspace intersection */
+  coordT *feasible_point;  /*    as coordinates, both malloc'd */
+  boolT GETarea;          /* true 'Fa', 'FA', 'FS', 'PAn', 'PFn' if compute facet area/Voronoi volume in io_r.c */
+  boolT KEEPnearinside;   /* true if near-inside points in coplanarset */
+  int   hull_dim;         /* dimension of hull, set by initbuffers */
+  int   input_dim;        /* dimension of input, set by initbuffers */
+  int   num_points;       /* number of input points */
+  pointT *first_point;    /* array of input points, see POINTSmalloc */
+  boolT POINTSmalloc;     /*   true if qh.first_point/num_points allocated */
+  pointT *input_points;   /* copy of original qh.first_point for input points for qh_joggleinput */
+  boolT input_malloc;     /* true if qh.input_points malloc'd */
+  char  qhull_command[256];/* command line that invoked this program */
+  int   qhull_commandsiz2; /*    size of qhull_command at qh_clear_outputflags */
+  char  rbox_command[256]; /* command line that produced the input points */
+  char  qhull_options[512];/* descriptive list of options */
+  int   qhull_optionlen;  /*    length of last line */
+  int   qhull_optionsiz;  /*    size of qhull_options at qh_build_withrestart */
+  int   qhull_optionsiz2; /*    size of qhull_options at qh_clear_outputflags */
+  int   run_id;           /* non-zero, random identifier for this instance of qhull */
+  boolT VERTEXneighbors;  /* true if maintaining vertex neighbors */
+  boolT ZEROcentrum;      /* true if 'C-0' or 'C-0 Qx' and not post-merging or 'A-n'.  Sets ZEROall_ok */
+  realT *upper_threshold; /* don't print if facet->normal[k]>=upper_threshold[k]
+                             must set either GOODthreshold or SPLITthreshold
+                             if qh.DELAUNAY, default is 0.0 for upper envelope (qh_initbuild) */
+  realT *lower_threshold; /* don't print if facet->normal[k] <=lower_threshold[k] */
+  realT *upper_bound;     /* scale point[k] to new upper bound */
+  realT *lower_bound;     /* scale point[k] to new lower bound
+                             project if both upper_ and lower_bound == 0 */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-prec">-</a>
+
+  qh precision constants
+    precision constants for Qhull
+
+  notes:
+    qh_detroundoff [geom2_r.c] computes the maximum roundoff error for distance
+    and other computations.  It also sets default values for the
+    qh constants above.
+*/
+  realT ANGLEround;       /* max round off error for angles */
+  realT centrum_radius;   /* max centrum radius for convexity ('Cn' + 2*qh.DISTround) */
+  realT cos_max;          /* max cosine for convexity (roundoff added) */
+  realT DISTround;        /* max round off error for distances, qh.SETroundoff ('En') overrides qh_distround */
+  realT MAXabs_coord;     /* max absolute coordinate */
+  realT MAXlastcoord;     /* max last coordinate for qh_scalelast */
+  realT MAXoutside;       /* max target for qh.max_outside/f.maxoutside, base for qh_RATIO...
+                             recomputed at qh_addpoint, unrelated to qh_MAXoutside */
+  realT MAXsumcoord;      /* max sum of coordinates */
+  realT MAXwidth;         /* max rectilinear width of point coordinates */
+  realT MINdenom_1;       /* min. abs. value for 1/x */
+  realT MINdenom;         /*    use divzero if denominator < MINdenom */
+  realT MINdenom_1_2;     /* min. abs. val for 1/x that allows normalization */
+  realT MINdenom_2;       /*    use divzero if denominator < MINdenom_2 */
+  realT MINlastcoord;     /* min. last coordinate for qh_scalelast */
+  realT *NEARzero;        /* hull_dim array for near zero in gausselim */
+  realT NEARinside;       /* keep points for qh_check_maxout if close to facet */
+  realT ONEmerge;         /* max distance for merging simplicial facets */
+  realT outside_err;      /* application's epsilon for coplanar points
+                             qh_check_bestdist() qh_check_points() reports error if point outside */
+  realT WIDEfacet;        /* size of wide facet for skipping ridge in
+                             area computation and locking centrum */
+  boolT NARROWhull;       /* set in qh_initialhull if angle < qh_MAXnarrow */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-codetern">-</a>
+
+  qh internal constants
+    internal constants for Qhull
+*/
+  char qhull[sizeof("qhull")]; /* "qhull" for checking ownership while debugging */
+  jmp_buf errexit;        /* exit label for qh_errexit, defined by setjmp() and NOerrexit */
+  char    jmpXtra[40];    /* extra bytes in case jmp_buf is defined wrong by compiler */
+  jmp_buf restartexit;    /* restart label for qh_errexit, defined by setjmp() and ALLOWrestart */
+  char    jmpXtra2[40];   /* extra bytes in case jmp_buf is defined wrong by compiler*/
+  FILE *  fin;            /* pointer to input file, init by qh_initqhull_start2 */
+  FILE *  fout;           /* pointer to output file */
+  FILE *  ferr;           /* pointer to error file */
+  pointT *interior_point; /* center point of the initial simplex*/
+  int     normal_size;    /* size in bytes for facet normals and point coords */
+  int     center_size;    /* size in bytes for Voronoi centers */
+  int     TEMPsize;       /* size for small, temporary sets (in quick mem) */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-lists">-</a>
+
+  qh facet and vertex lists
+    defines lists of facets, new facets, visible facets, vertices, and
+    new vertices.  Includes counts, next ids, and trace ids.
+  see:
+    qh_resetlists()
+*/
+  facetT *facet_list;     /* first facet */
+  facetT *facet_tail;     /* end of facet_list (dummy facet with id 0 and next==NULL) */
+  facetT *facet_next;     /* next facet for buildhull()
+                             previous facets do not have outside sets
+                             NARROWhull: previous facets may have coplanar outside sets for qh_outcoplanar */
+  facetT *newfacet_list;  /* list of new facets to end of facet_list
+                             qh_postmerge sets newfacet_list to facet_list */
+  facetT *visible_list;   /* list of visible facets preceding newfacet_list,
+                             end of visible list if !facet->visible, same as newfacet_list
+                             qh_findhorizon sets visible_list at end of facet_list
+                             qh_willdelete prepends to visible_list
+                             qh_triangulate appends mirror facets to visible_list at end of facet_list
+                             qh_postmerge sets visible_list to facet_list
+                             qh_deletevisible deletes the visible facets */
+  int       num_visible;  /* current number of visible facets */
+  unsigned int tracefacet_id; /* set at init, then can print whenever */
+  facetT  *tracefacet;    /*   set in newfacet/mergefacet, undone in delfacet and qh_errexit */
+  unsigned int traceridge_id; /* set at init, then can print whenever */
+  ridgeT  *traceridge;    /*   set in newridge, undone in delridge, errexit, errexit2, makenew_nonsimplicial, mergecycle_ridges */
+  unsigned int tracevertex_id; /* set at buildtracing, can print whenever */
+  vertexT *tracevertex;   /*   set in newvertex, undone in delvertex and qh_errexit */
+  vertexT *vertex_list;   /* list of all vertices, to vertex_tail */
+  vertexT *vertex_tail;   /*      end of vertex_list (dummy vertex with ID 0, next NULL) */
+  vertexT *newvertex_list; /* list of vertices in newfacet_list, to vertex_tail
+                             all vertices have 'newfacet' set */
+  int   num_facets;       /* number of facets in facet_list
+                             includes visible faces (num_visible) */
+  int   num_vertices;     /* number of vertices in facet_list */
+  int   num_outside;      /* number of points in outsidesets (for tracing and RANDOMoutside)
+                               includes coplanar outsideset points for NARROWhull/qh_outcoplanar() */
+  int   num_good;         /* number of good facets (after qh_findgood_all or qh_markkeep) */
+  unsigned int facet_id;  /* ID of next, new facet from newfacet() */
+  unsigned int ridge_id;  /* ID of next, new ridge from newridge() */
+  unsigned int vertex_id; /* ID of next, new vertex from newvertex() */
+  unsigned int first_newfacet; /* ID of first_newfacet for qh_buildcone, or 0 if none */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-var">-</a>
+
+  qh global variables
+    defines minimum and maximum distances, next visit ids, several flags,
+    and other global variables.
+    initialize in qh_initbuild or qh_maxmin if used in qh_buildhull
+*/
+  unsigned long hulltime; /* ignore time to set up input and randomize */
+                          /*   use 'unsigned long' to avoid wrap-around errors */
+  boolT ALLOWrestart;     /* true if qh_joggle_restart can use qh.restartexit */
+  int   build_cnt;        /* number of calls to qh_initbuild */
+  qh_CENTER CENTERtype;   /* current type of facet->center, qh_CENTER */
+  int   furthest_id;      /* pointid of furthest point, for tracing */
+  int   last_errcode;     /* last errcode from qh_fprintf, reset in qh_build_withrestart */
+  facetT *GOODclosest;    /* closest facet to GOODthreshold in qh_findgood */
+  pointT *coplanar_apex;  /* last apex declared a coplanar point by qh_getpinchedmerges, prevents infinite loop */
+  boolT hasAreaVolume;    /* true if totarea, totvol was defined by qh_getarea */
+  boolT hasTriangulation; /* true if triangulation created by qh_triangulate */
+  boolT isRenameVertex;   /* true during qh_merge_pinchedvertices, disables duplicate ridge vertices in qh_checkfacet */
+  realT JOGGLEmax;        /* set 'QJn' if randomly joggle input. 'QJ'/'QJ0.0' sets default (qh_detjoggle) */
+  boolT maxoutdone;       /* set qh_check_maxout(), cleared by qh_addpoint() */
+  realT max_outside;      /* maximum distance from a point to a facet,
+                               before roundoff, not simplicial vertices
+                               actual outer plane is +DISTround and
+                               computed outer plane is +2*DISTround */
+  realT max_vertex;       /* maximum distance (>0) from vertex to a facet,
+                               before roundoff, due to a merge */
+  realT min_vertex;       /* minimum distance (<0) from vertex to a facet,
+                               before roundoff, due to a merge
+                               if qh.JOGGLEmax, qh_makenewplanes sets it
+                               recomputed if qh.DOcheckmax, default -qh.DISTround */
+  boolT NEWfacets;        /* true while visible facets invalid due to new or merge
+                              from qh_makecone/qh_attachnewfacets to qh_resetlists */
+  boolT NEWtentative;     /* true while new facets are tentative due to !qh.IGNOREpinched or qh.ONLYgood
+                              from qh_makecone to qh_attachnewfacets */
+  boolT findbestnew;      /* true if partitioning calls qh_findbestnew */
+  boolT findbest_notsharp; /* true if new facets are at least 90 degrees */
+  boolT NOerrexit;        /* true if qh.errexit is not available, cleared after setjmp.  See qh.ERREXITcalled */
+  realT PRINTcradius;     /* radius for printing centrums */
+  realT PRINTradius;      /* radius for printing vertex spheres and points */
+  boolT POSTmerging;      /* true when post merging */
+  int   printoutvar;      /* temporary variable for qh_printbegin, etc. */
+  int   printoutnum;      /* number of facets printed */
+  unsigned int repart_facetid; /* previous facetid to prevent recursive qh_partitioncoplanar+qh_partitionpoint */
+  int   retry_addpoint;   /* number of retries of qh_addpoint due to merging pinched vertices */
+  boolT QHULLfinished;    /* True after qhull() is finished */
+  realT totarea;          /* 'FA': total facet area computed by qh_getarea, hasAreaVolume */
+  realT totvol;           /* 'FA': total volume computed by qh_getarea, hasAreaVolume */
+  unsigned int visit_id;  /* unique ID for searching neighborhoods, */
+  unsigned int vertex_visit; /* unique ID for searching vertices, reset with qh_buildtracing */
+  boolT WAScoplanar;      /* True if qh_partitioncoplanar (qh_check_maxout) */
+  boolT ZEROall_ok;       /* True if qh_checkzero always succeeds */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-set">-</a>
+
+  qh global sets
+    defines sets for merging, initial simplex, hashing, extra input points,
+    and deleted vertices
+*/
+  setT *facet_mergeset;   /* temporary set of merges to be done */
+  setT *degen_mergeset;   /* temporary set of degenerate and redundant merges */
+  setT *vertex_mergeset;  /* temporary set of vertex merges */
+  setT *hash_table;       /* hash table for matching ridges in qh_matchfacets
+                             size is setsize() */
+  setT *other_points;     /* additional points */
+  setT *del_vertices;     /* vertices to partition and delete with visible
+                             facets.  v.deleted is set for checkfacet */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-buf">-</a>
+
+  qh global buffers
+    defines buffers for maxtrix operations, input, and error messages
+*/
+  coordT *gm_matrix;      /* (dim+1)Xdim matrix for geom_r.c */
+  coordT **gm_row;        /* array of gm_matrix rows */
+  char* line;             /* malloc'd input line of maxline+1 chars */
+  int maxline;
+  coordT *half_space;     /* malloc'd input array for halfspace (qh.normal_size+coordT) */
+  coordT *temp_malloc;    /* malloc'd input array for points */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-static">-</a>
+
+  qh static variables
+    defines static variables for individual functions
+
+  notes:
+    do not use 'static' within a function.  Multiple instances of qhull
+    may exist.
+
+    do not assume zero initialization, 'QPn' may cause a restart
+*/
+  boolT ERREXITcalled;    /* true during qh_errexit (prevents duplicate calls).  see qh.NOerrexit */
+  boolT firstcentrum;     /* for qh_printcentrum */
+  boolT old_randomdist;   /* save RANDOMdist flag during io, tracing, or statistics */
+  setT *coplanarfacetset; /* set of coplanar facets for searching qh_findbesthorizon() */
+  realT last_low;         /* qh_scalelast parameters for qh_setdelaunay */
+  realT last_high;
+  realT last_newhigh;
+  realT lastcpu;          /* for qh_buildtracing */
+  int   lastfacets;       /*   last qh.num_facets */
+  int   lastmerges;       /*   last zzval_(Ztotmerge) */ 
+  int   lastplanes;       /*   last zzval_(Zsetplane) */ 
+  int   lastdist;         /*   last zzval_(Zdistplane) */ 
+  unsigned int lastreport; /*  last qh.facet_id */
+  int mergereport;        /* for qh_tracemerging */
+  setT *old_tempstack;    /* for saving qh->qhmem.tempstack in save_qhull */
+  int   ridgeoutnum;      /* number of ridges for 4OFF output (qh_printbegin,etc) */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >--------------------------------</a><a name="qh-const">-</a>
+
+  qh memory management, rbox globals, and statistics
+
+  Replaces global data structures defined for libqhull
+*/
+  int     last_random;    /* Last random number from qh_rand (random_r.c) */
+  jmp_buf rbox_errexit;   /* errexit from rboxlib_r.c, defined by qh_rboxpoints() only */
+  char    jmpXtra3[40];   /* extra bytes in case jmp_buf is defined wrong by compiler */
+  int     rbox_isinteger;
+  double  rbox_out_offset;
+  void *  cpp_object;     /* C++ pointer.  Currently used by RboxPoints.qh_fprintf_rbox */
+  void *  cpp_other;      /* C++ pointer.  Reserved for other users */
+  void *  cpp_user;       /* C++ pointer.  Currently used by QhullUser.qh_fprintf */
+
+  /* Last, otherwise zero'd by qh_initqhull_start2 (global_r.c */
+  qhmemT  qhmem;          /* Qhull managed memory (mem_r.h) */
+  /* After qhmem because its size depends on the number of statistics */
+  qhstatT qhstat;         /* Qhull statistics (stat_r.h) */
+};
+
+/*=========== -macros- =========================*/
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="otherfacet_">-</a>
+
+  otherfacet_(ridge, facet)
+    return neighboring facet for a ridge in facet
+*/
+#define otherfacet_(ridge, facet) \
+                        (((ridge)->top == (facet)) ? (ridge)->bottom : (ridge)->top)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="getid_">-</a>
+
+  getid_(p)
+    return int ID for facet, ridge, or vertex
+    return qh_IDunknown(-1) if NULL
+    return 0 if facet_tail or vertex_tail
+*/
+#define getid_(p)       ((p) ? (int)((p)->id) : qh_IDunknown)
+
+/*============== FORALL macros ===================*/
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLfacets">-</a>
+
+  FORALLfacets { ... }
+    assign 'facet' to each facet in qh.facet_list
+
+  notes:
+    uses 'facetT *facet;'
+    assumes last facet is a sentinel
+    assumes qh defined
+
+  see:
+    FORALLfacet_( facetlist )
+*/
+#define FORALLfacets for (facet=qh->facet_list;facet && facet->next;facet=facet->next)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLpoints">-</a>
+
+  FORALLpoints { ... }
+    assign 'point' to each point in qh.first_point, qh.num_points
+
+  notes:
+    assumes qh defined
+
+  declare:
+    coordT *point, *pointtemp;
+*/
+#define FORALLpoints FORALLpoint_(qh, qh->first_point, qh->num_points)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLpoint_">-</a>
+
+  FORALLpoint_(qh, points, num) { ... }
+    assign 'point' to each point in points array of num points
+
+  declare:
+    coordT *point, *pointtemp;
+*/
+#define FORALLpoint_(qh, points, num) for (point=(points), \
+      pointtemp= (points)+qh->hull_dim*(num); point < pointtemp; point += qh->hull_dim)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLvertices">-</a>
+
+  FORALLvertices { ... }
+    assign 'vertex' to each vertex in qh.vertex_list
+
+  declare:
+    vertexT *vertex;
+
+  notes:
+    assumes qh.vertex_list terminated by NULL or a sentinel (v.next==NULL)
+    assumes qh defined
+*/
+#define FORALLvertices for (vertex=qh->vertex_list;vertex && vertex->next;vertex= vertex->next)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHfacet_">-</a>
+
+  FOREACHfacet_( facets ) { ... }
+    assign 'facet' to each facet in facets
+
+  declare:
+    facetT *facet, **facetp;
+
+  notes:
+    assumes set is not modified
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHfacet_(facets)    FOREACHsetelement_(facetT, facets, facet)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHneighbor_">-</a>
+
+  FOREACHneighbor_( facet ) { ... }
+    assign 'neighbor' to each neighbor in facet->neighbors
+
+  FOREACHneighbor_( vertex ) { ... }
+    assign 'neighbor' to each neighbor in vertex->neighbors
+
+  declare:
+    facetT *neighbor, **neighborp;
+
+  notes:
+    assumes set is not modified
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHneighbor_(facet)  FOREACHsetelement_(facetT, facet->neighbors, neighbor)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHpoint_">-</a>
+
+  FOREACHpoint_( points ) { ... }
+    assign 'point' to each point in points set
+
+  declare:
+    pointT *point, **pointp;
+
+  notes:
+    assumes set is not modified
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHpoint_(points)    FOREACHsetelement_(pointT, points, point)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHridge_">-</a>
+
+  FOREACHridge_( ridges ) { ... }
+    assign 'ridge' to each ridge in ridges set
+
+  declare:
+    ridgeT *ridge, **ridgep;
+
+  notes:
+    assumes set is not modified
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHridge_(ridges)    FOREACHsetelement_(ridgeT, ridges, ridge)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHvertex_">-</a>
+
+  FOREACHvertex_( vertices ) { ... }
+    assign 'vertex' to each vertex in vertices set
+
+  declare:
+    vertexT *vertex, **vertexp;
+
+  notes:
+    assumes set is not modified
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHvertex_(vertices) FOREACHsetelement_(vertexT, vertices,vertex)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHfacet_i_">-</a>
+
+  FOREACHfacet_i_(qh, facets ) { ... }
+    assign 'facet' and 'facet_i' for each facet in facets set
+
+  declare:
+    facetT *facet;
+    int     facet_n, facet_i;
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_i_">FOREACHsetelement_i_</a>
+*/
+#define FOREACHfacet_i_(qh, facets)    FOREACHsetelement_i_(qh, facetT, facets, facet)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHneighbor_i_">-</a>
+
+  FOREACHneighbor_i_(qh, facet ) { ... }
+    assign 'neighbor' and 'neighbor_i' for each neighbor in facet->neighbors
+
+  declare:
+    facetT *neighbor;
+    int     neighbor_n, neighbor_i;
+
+  notes:
+    see <a href="qset_r.h#FOREACHsetelement_i_">FOREACHsetelement_i_</a>
+    for facet neighbors of vertex, need to define a new macro
+*/
+#define FOREACHneighbor_i_(qh, facet)  FOREACHsetelement_i_(qh, facetT, facet->neighbors, neighbor)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHpoint_i_">-</a>
+
+  FOREACHpoint_i_(qh, points ) { ... }
+    assign 'point' and 'point_i' for each point in points set
+
+  declare:
+    pointT *point;
+    int     point_n, point_i;
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_i_">FOREACHsetelement_i_</a>
+*/
+#define FOREACHpoint_i_(qh, points)    FOREACHsetelement_i_(qh, pointT, points, point)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHridge_i_">-</a>
+
+  FOREACHridge_i_(qh, ridges ) { ... }
+    assign 'ridge' and 'ridge_i' for each ridge in ridges set
+
+  declare:
+    ridgeT *ridge;
+    int     ridge_n, ridge_i;
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_i_">FOREACHsetelement_i_</a>
+*/
+#define FOREACHridge_i_(qh, ridges)    FOREACHsetelement_i_(qh, ridgeT, ridges, ridge)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHvertex_i_">-</a>
+
+  FOREACHvertex_i_(qh, vertices ) { ... }
+    assign 'vertex' and 'vertex_i' for each vertex in vertices set
+
+  declare:
+    vertexT *vertex;
+    int     vertex_n, vertex_i;
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_i_">FOREACHsetelement_i_</a>
+*/
+#define FOREACHvertex_i_(qh, vertices) FOREACHsetelement_i_(qh, vertexT, vertices, vertex)
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/********* -libqhull_r.c prototypes (duplicated from qhull_ra.h) **********************/
+
+void    qh_qhull(qhT *qh);
+boolT   qh_addpoint(qhT *qh, pointT *furthest, facetT *facet, boolT checkdist);
+void    qh_errexit2(qhT *qh, int exitcode, facetT *facet, facetT *otherfacet);
+void    qh_printsummary(qhT *qh, FILE *fp);
+
+/********* -user_r.c prototypes (alphabetical) **********************/
+
+void    qh_errexit(qhT *qh, int exitcode, facetT *facet, ridgeT *ridge);
+void    qh_errprint(qhT *qh, const char* string, facetT *atfacet, facetT *otherfacet, ridgeT *atridge, vertexT *atvertex);
+int     qh_new_qhull(qhT *qh, int dim, int numpoints, coordT *points, boolT ismalloc,
+                char *qhull_cmd, FILE *outfile, FILE *errfile);
+int     qh_new_qhull_feaspoint(qhT *qh, int dim, int numpoints, coordT *points, boolT ismalloc,
+                char *qhull_cmd, FILE *outfile, FILE *errfile, coordT* feaspoint);
+void    qh_printfacetlist(qhT *qh, facetT *facetlist, setT *facets, boolT printall);
+void    qh_printhelp_degenerate(qhT *qh, FILE *fp);
+void    qh_printhelp_internal(qhT *qh, FILE *fp);
+void    qh_printhelp_narrowhull(qhT *qh, FILE *fp, realT minangle);
+void    qh_printhelp_singular(qhT *qh, FILE *fp);
+void    qh_printhelp_topology(qhT *qh, FILE *fp);
+void    qh_printhelp_wide(qhT *qh, FILE *fp);
+void    qh_user_memsizes(qhT *qh);
+
+/********* -usermem_r.c prototypes (alphabetical) **********************/
+void    qh_exit(int exitcode);
+void    qh_fprintf_stderr(int msgcode, const char *fmt, ... );
+void    qh_free(void *mem);
+void   *qh_malloc(size_t size);
+
+/********* -userprintf_r.c and userprintf_rbox_r.c prototypes **********************/
+void    qh_fprintf(qhT *qh, FILE *fp, int msgcode, const char *fmt, ... );
+void    qh_fprintf_rbox(qhT *qh, FILE *fp, int msgcode, const char *fmt, ... );
+
+/***** -geom_r.c/geom2_r.c/random_r.c prototypes (duplicated from geom_r.h, random_r.h) ****************/
+
+facetT *qh_findbest(qhT *qh, pointT *point, facetT *startfacet,
+                     boolT bestoutside, boolT newfacets, boolT noupper,
+                     realT *dist, boolT *isoutside, int *numpart);
+facetT *qh_findbestnew(qhT *qh, pointT *point, facetT *startfacet,
+                     realT *dist, boolT bestoutside, boolT *isoutside, int *numpart);
+boolT   qh_gram_schmidt(qhT *qh, int dim, realT **rows);
+void    qh_outerinner(qhT *qh, facetT *facet, realT *outerplane, realT *innerplane);
+void    qh_printsummary(qhT *qh, FILE *fp);
+void    qh_projectinput(qhT *qh);
+void    qh_randommatrix(qhT *qh, realT *buffer, int dim, realT **row);
+void    qh_rotateinput(qhT *qh, realT **rows);
+void    qh_scaleinput(qhT *qh);
+void    qh_setdelaunay(qhT *qh, int dim, int count, pointT *points);
+coordT  *qh_sethalfspace_all(qhT *qh, int dim, int count, coordT *halfspaces, pointT *feasible);
+
+/***** -global_r.c prototypes (alphabetical) ***********************/
+
+unsigned long qh_clock(qhT *qh);
+void    qh_checkflags(qhT *qh, char *command, char *hiddenflags);
+void    qh_clear_outputflags(qhT *qh);
+void    qh_freebuffers(qhT *qh);
+void    qh_freeqhull(qhT *qh, boolT allmem);
+void    qh_init_A(qhT *qh, FILE *infile, FILE *outfile, FILE *errfile, int argc, char *argv[]);
+void    qh_init_B(qhT *qh, coordT *points, int numpoints, int dim, boolT ismalloc);
+void    qh_init_qhull_command(qhT *qh, int argc, char *argv[]);
+void    qh_initbuffers(qhT *qh, coordT *points, int numpoints, int dim, boolT ismalloc);
+void    qh_initflags(qhT *qh, char *command);
+void    qh_initqhull_buffers(qhT *qh);
+void    qh_initqhull_globals(qhT *qh, coordT *points, int numpoints, int dim, boolT ismalloc);
+void    qh_initqhull_mem(qhT *qh);
+void    qh_initqhull_outputflags(qhT *qh);
+void    qh_initqhull_start(qhT *qh, FILE *infile, FILE *outfile, FILE *errfile);
+void    qh_initqhull_start2(qhT *qh, FILE *infile, FILE *outfile, FILE *errfile);
+void    qh_initthresholds(qhT *qh, char *command);
+void    qh_lib_check(int qhullLibraryType, int qhTsize, int vertexTsize, int ridgeTsize, int facetTsize, int setTsize, int qhmemTsize);
+void    qh_option(qhT *qh, const char *option, int *i, realT *r);
+void    qh_zero(qhT *qh, FILE *errfile);
+
+/***** -io_r.c prototypes (duplicated from io_r.h) ***********************/
+
+void    qh_dfacet(qhT *qh, unsigned int id);
+void    qh_dvertex(qhT *qh, unsigned int id);
+void    qh_printneighborhood(qhT *qh, FILE *fp, qh_PRINT format, facetT *facetA, facetT *facetB, boolT printall);
+void    qh_produce_output(qhT *qh);
+coordT *qh_readpoints(qhT *qh, int *numpoints, int *dimension, boolT *ismalloc);
+
+
+/********* -mem_r.c prototypes (duplicated from mem_r.h) **********************/
+
+void qh_meminit(qhT *qh, FILE *ferr);
+void qh_memfreeshort(qhT *qh, int *curlong, int *totlong);
+
+/********* -poly_r.c/poly2_r.c prototypes (duplicated from poly_r.h) **********************/
+
+void    qh_check_output(qhT *qh);
+void    qh_check_points(qhT *qh);
+setT   *qh_facetvertices(qhT *qh, facetT *facetlist, setT *facets, boolT allfacets);
+facetT *qh_findbestfacet(qhT *qh, pointT *point, boolT bestoutside,
+           realT *bestdist, boolT *isoutside);
+vertexT *qh_nearvertex(qhT *qh, facetT *facet, pointT *point, realT *bestdistp);
+pointT *qh_point(qhT *qh, int id);
+setT   *qh_pointfacet(qhT *qh /* qh.facet_list */);
+int     qh_pointid(qhT *qh, pointT *point);
+setT   *qh_pointvertex(qhT *qh /* qh.facet_list */);
+void    qh_setvoronoi_all(qhT *qh);
+void    qh_triangulate(qhT *qh /* qh.facet_list */);
+
+/********* -rboxlib_r.c prototypes **********************/
+int     qh_rboxpoints(qhT *qh, char* rbox_command);
+void    qh_errexit_rbox(qhT *qh, int exitcode);
+
+/********* -stat_r.c prototypes (duplicated from stat_r.h) **********************/
+
+void    qh_collectstatistics(qhT *qh);
+void    qh_printallstatistics(qhT *qh, FILE *fp, const char *string);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif /* qhDEFlibqhull */
diff --git a/contrib/libs/qhull/libqhull_r/mem_r.c b/contrib/libs/qhull/libqhull_r/mem_r.c
new file mode 100644
index 0000000000..7d5509eb4f
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/mem_r.c
@@ -0,0 +1,566 @@
+/*<html><pre>  -<a                             href="qh-mem_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+  mem_r.c
+    memory management routines for qhull
+
+  See libqhull/mem.c for a standalone program.
+
+  To initialize memory:
+
+    qh_meminit(qh, stderr);
+    qh_meminitbuffers(qh, qh->IStracing, qh_MEMalign, 7, qh_MEMbufsize,qh_MEMinitbuf);
+    qh_memsize(qh, (int)sizeof(facetT));
+    qh_memsize(qh, (int)sizeof(facetT));
+    ...
+    qh_memsetup(qh);
+
+  To free up all memory buffers:
+    qh_memfreeshort(qh, &curlong, &totlong);
+
+  if qh_NOmem,
+    malloc/free is used instead of mem_r.c
+
+  notes:
+    uses Quickfit algorithm (freelists for commonly allocated sizes)
+    assumes small sizes for freelists (it discards the tail of memory buffers)
+
+  see:
+    qh-mem_r.htm and mem_r.h
+    global_r.c (qh_initbuffers) for an example of using mem_r.c
+
+  Copyright (c) 1993-2020 The Geometry Center.
+  $Id: //main/2019/qhull/src/libqhull_r/mem_r.c#7 $$Change: 2953 $
+  $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#include "libqhull_r.h"  /* includes user_r.h and mem_r.h */
+
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifndef qh_NOmem
+
+/*============= internal functions ==============*/
+
+static int qh_intcompare(const void *i, const void *j);
+
+/*========== functions in alphabetical order ======== */
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >-------------------------------</a><a name="intcompare">-</a>
+
+  qh_intcompare( i, j )
+    used by qsort and bsearch to compare two integers
+*/
+static int qh_intcompare(const void *i, const void *j) {
+  return(*((const int *)i) - *((const int *)j));
+} /* intcompare */
+
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >--------------------------------</a><a name="memalloc">-</a>
+
+  qh_memalloc(qh, insize )
+    returns object of insize bytes
+    qhmem is the global memory structure
+
+  returns:
+    pointer to allocated memory
+    errors if insufficient memory
+
+  notes:
+    use explicit type conversion to avoid type warnings on some compilers
+    actual object may be larger than insize
+    use qh_memalloc_() for inline code for quick allocations
+    logs allocations if 'T5'
+    caller is responsible for freeing the memory.
+    short memory is freed on shutdown by qh_memfreeshort unless qh_NOmem
+
+  design:
+    if size < qh->qhmem.LASTsize
+      if qh->qhmem.freelists[size] non-empty
+        return first object on freelist
+      else
+        round up request to size of qh->qhmem.freelists[size]
+        allocate new allocation buffer if necessary
+        allocate object from allocation buffer
+    else
+      allocate object with qh_malloc() in user_r.c
+*/
+void *qh_memalloc(qhT *qh, int insize) {
+  void **freelistp, *newbuffer;
+  int idx, size, n;
+  int outsize, bufsize;
+  void *object;
+
+  if (insize<0) {
+      qh_fprintf(qh, qh->qhmem.ferr, 6235, "qhull error (qh_memalloc): negative request size (%d).  Did int overflow due to high-D?\n", insize); /* WARN64 */
+      qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+  }
+  if (insize>=0 && insize <= qh->qhmem.LASTsize) {
+    idx= qh->qhmem.indextable[insize];
+    outsize= qh->qhmem.sizetable[idx];
+    qh->qhmem.totshort += outsize;
+    freelistp= qh->qhmem.freelists+idx;
+    if ((object= *freelistp)) {
+      qh->qhmem.cntquick++;
+      qh->qhmem.totfree -= outsize;
+      *freelistp= *((void **)*freelistp);  /* replace freelist with next object */
+#ifdef qh_TRACEshort
+      n= qh->qhmem.cntshort+qh->qhmem.cntquick+qh->qhmem.freeshort;
+      if (qh->qhmem.IStracing >= 5)
+          qh_fprintf(qh, qh->qhmem.ferr, 8141, "qh_mem %p n %8d alloc quick: %d bytes (tot %d cnt %d)\n", object, n, outsize, qh->qhmem.totshort, qh->qhmem.cntshort+qh->qhmem.cntquick-qh->qhmem.freeshort);
+#endif
+      return(object);
+    }else {
+      qh->qhmem.cntshort++;
+      if (outsize > qh->qhmem.freesize) {
+        qh->qhmem.totdropped += qh->qhmem.freesize;
+        if (!qh->qhmem.curbuffer)
+          bufsize= qh->qhmem.BUFinit;
+        else
+          bufsize= qh->qhmem.BUFsize;
+        if (!(newbuffer= qh_malloc((size_t)bufsize))) {
+          qh_fprintf(qh, qh->qhmem.ferr, 6080, "qhull error (qh_memalloc): insufficient memory to allocate short memory buffer (%d bytes)\n", bufsize);
+          qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+        }
+        *((void **)newbuffer)= qh->qhmem.curbuffer;  /* prepend newbuffer to curbuffer
+                                                    list.  newbuffer!=0 by QH6080 */
+        qh->qhmem.curbuffer= newbuffer;
+        size= ((int)sizeof(void **) + qh->qhmem.ALIGNmask) & ~qh->qhmem.ALIGNmask;
+        qh->qhmem.freemem= (void *)((char *)newbuffer+size);
+        qh->qhmem.freesize= bufsize - size;
+        qh->qhmem.totbuffer += bufsize - size; /* easier to check */
+        /* Periodically test totbuffer.  It matches at beginning and exit of every call */
+        n= qh->qhmem.totshort + qh->qhmem.totfree + qh->qhmem.totdropped + qh->qhmem.freesize - outsize;
+        if (qh->qhmem.totbuffer != n) {
+            qh_fprintf(qh, qh->qhmem.ferr, 6212, "qhull internal error (qh_memalloc): short totbuffer %d != totshort+totfree... %d\n", qh->qhmem.totbuffer, n);
+            qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+        }
+      }
+      object= qh->qhmem.freemem;
+      qh->qhmem.freemem= (void *)((char *)qh->qhmem.freemem + outsize);
+      qh->qhmem.freesize -= outsize;
+      qh->qhmem.totunused += outsize - insize;
+#ifdef qh_TRACEshort
+      n= qh->qhmem.cntshort+qh->qhmem.cntquick+qh->qhmem.freeshort;
+      if (qh->qhmem.IStracing >= 5)
+          qh_fprintf(qh, qh->qhmem.ferr, 8140, "qh_mem %p n %8d alloc short: %d bytes (tot %d cnt %d)\n", object, n, outsize, qh->qhmem.totshort, qh->qhmem.cntshort+qh->qhmem.cntquick-qh->qhmem.freeshort);
+#endif
+      return object;
+    }
+  }else {                     /* long allocation */
+    if (!qh->qhmem.indextable) {
+      qh_fprintf(qh, qh->qhmem.ferr, 6081, "qhull internal error (qh_memalloc): qhmem has not been initialized.\n");
+      qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+    }
+    outsize= insize;
+    qh->qhmem.cntlong++;
+    qh->qhmem.totlong += outsize;
+    if (qh->qhmem.maxlong < qh->qhmem.totlong)
+      qh->qhmem.maxlong= qh->qhmem.totlong;
+    if (!(object= qh_malloc((size_t)outsize))) {
+      qh_fprintf(qh, qh->qhmem.ferr, 6082, "qhull error (qh_memalloc): insufficient memory to allocate %d bytes\n", outsize);
+      qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+    }
+    if (qh->qhmem.IStracing >= 5)
+      qh_fprintf(qh, qh->qhmem.ferr, 8057, "qh_mem %p n %8d alloc long: %d bytes (tot %d cnt %d)\n", object, qh->qhmem.cntlong+qh->qhmem.freelong, outsize, qh->qhmem.totlong, qh->qhmem.cntlong-qh->qhmem.freelong);
+  }
+  return(object);
+} /* memalloc */
+
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >--------------------------------</a><a name="memcheck">-</a>
+
+  qh_memcheck(qh)
+*/
+void qh_memcheck(qhT *qh) {
+  int i, count, totfree= 0;
+  void *object;
+
+  if (!qh) {
+    qh_fprintf_stderr(6243, "qhull internal error (qh_memcheck): qh is 0.  It does not point to a qhT\n");
+    qh_exit(qhmem_ERRqhull);  /* can not use qh_errexit() */
+  }
+  if (qh->qhmem.ferr == 0 || qh->qhmem.IStracing < 0 || qh->qhmem.IStracing > 10 || (((qh->qhmem.ALIGNmask+1) & qh->qhmem.ALIGNmask) != 0)) {
+    qh_fprintf_stderr(6244, "qhull internal error (qh_memcheck): either qh->qhmem is overwritten or qh->qhmem is not initialized.  Call qh_meminit or qh_new_qhull before calling qh_mem routines.  ferr 0x%x, IsTracing %d, ALIGNmask 0x%x\n", 
+          qh->qhmem.ferr, qh->qhmem.IStracing, qh->qhmem.ALIGNmask);
+    qh_exit(qhmem_ERRqhull);  /* can not use qh_errexit() */
+  }
+  if (qh->qhmem.IStracing != 0)
+    qh_fprintf(qh, qh->qhmem.ferr, 8143, "qh_memcheck: check size of freelists on qh->qhmem\nqh_memcheck: A segmentation fault indicates an overwrite of qh->qhmem\n");
+  for (i=0; i < qh->qhmem.TABLEsize; i++) {
+    count=0;
+    for (object= qh->qhmem.freelists[i]; object; object= *((void **)object))
+      count++;
+    totfree += qh->qhmem.sizetable[i] * count;
+  }
+  if (totfree != qh->qhmem.totfree) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6211, "qhull internal error (qh_memcheck): totfree %d not equal to freelist total %d\n", qh->qhmem.totfree, totfree);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  if (qh->qhmem.IStracing != 0)
+    qh_fprintf(qh, qh->qhmem.ferr, 8144, "qh_memcheck: total size of freelists totfree is the same as qh->qhmem.totfree\n", totfree);
+} /* memcheck */
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >--------------------------------</a><a name="memfree">-</a>
+
+  qh_memfree(qh, object, insize )
+    free up an object of size bytes
+    size is insize from qh_memalloc
+
+  notes:
+    object may be NULL
+    type checking warns if using (void **)object
+    use qh_memfree_() for quick free's of small objects
+
+  design:
+    if size <= qh->qhmem.LASTsize
+      append object to corresponding freelist
+    else
+      call qh_free(object)
+*/
+void qh_memfree(qhT *qh, void *object, int insize) {
+  void **freelistp;
+  int idx, outsize;
+
+  if (!object)
+    return;
+  if (insize <= qh->qhmem.LASTsize) {
+    qh->qhmem.freeshort++;
+    idx= qh->qhmem.indextable[insize];
+    outsize= qh->qhmem.sizetable[idx];
+    qh->qhmem.totfree += outsize;
+    qh->qhmem.totshort -= outsize;
+    freelistp= qh->qhmem.freelists + idx;
+    *((void **)object)= *freelistp;
+    *freelistp= object;
+#ifdef qh_TRACEshort
+    idx= qh->qhmem.cntshort+qh->qhmem.cntquick+qh->qhmem.freeshort;
+    if (qh->qhmem.IStracing >= 5)
+        qh_fprintf(qh, qh->qhmem.ferr, 8142, "qh_mem %p n %8d free short: %d bytes (tot %d cnt %d)\n", object, idx, outsize, qh->qhmem.totshort, qh->qhmem.cntshort+qh->qhmem.cntquick-qh->qhmem.freeshort);
+#endif
+  }else {
+    qh->qhmem.freelong++;
+    qh->qhmem.totlong -= insize;
+    if (qh->qhmem.IStracing >= 5)
+      qh_fprintf(qh, qh->qhmem.ferr, 8058, "qh_mem %p n %8d free long: %d bytes (tot %d cnt %d)\n", object, qh->qhmem.cntlong+qh->qhmem.freelong, insize, qh->qhmem.totlong, qh->qhmem.cntlong-qh->qhmem.freelong);
+    qh_free(object);
+  }
+} /* memfree */
+
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >-------------------------------</a><a name="memfreeshort">-</a>
+
+  qh_memfreeshort(qh, curlong, totlong )
+    frees up all short and qhmem memory allocations
+
+  returns:
+    number and size of current long allocations
+
+  notes:
+    if qh_NOmem (qh_malloc() for all allocations),
+       short objects (e.g., facetT) are not recovered.
+       use qh_freeqhull(qh, qh_ALL) instead.
+
+  see:
+    qh_freeqhull(qh, allMem)
+    qh_memtotal(qh, curlong, totlong, curshort, totshort, maxlong, totbuffer);
+*/
+void qh_memfreeshort(qhT *qh, int *curlong, int *totlong) {
+  void *buffer, *nextbuffer;
+  FILE *ferr;
+
+  *curlong= qh->qhmem.cntlong - qh->qhmem.freelong;
+  *totlong= qh->qhmem.totlong;
+  for (buffer=qh->qhmem.curbuffer; buffer; buffer= nextbuffer) {
+    nextbuffer= *((void **) buffer);
+    qh_free(buffer);
+  }
+  qh->qhmem.curbuffer= NULL;
+  if (qh->qhmem.LASTsize) {
+    qh_free(qh->qhmem.indextable);
+    qh_free(qh->qhmem.freelists);
+    qh_free(qh->qhmem.sizetable);
+  }
+  ferr= qh->qhmem.ferr;
+  memset((char *)&qh->qhmem, 0, sizeof(qh->qhmem));  /* every field is 0, FALSE, NULL */
+  qh->qhmem.ferr= ferr;
+} /* memfreeshort */
+
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >--------------------------------</a><a name="meminit">-</a>
+
+  qh_meminit(qh, ferr )
+    initialize qhmem and test sizeof(void *)
+    Does not throw errors.  qh_exit on failure
+*/
+void qh_meminit(qhT *qh, FILE *ferr) {
+
+  memset((char *)&qh->qhmem, 0, sizeof(qh->qhmem));  /* every field is 0, FALSE, NULL */
+  if (ferr)
+    qh->qhmem.ferr= ferr;
+  else
+    qh->qhmem.ferr= stderr;
+  if (sizeof(void *) < sizeof(int)) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6083, "qhull internal error (qh_meminit): sizeof(void *) %d < sizeof(int) %d.  qset_r.c will not work\n", (int)sizeof(void*), (int)sizeof(int));
+    qh_exit(qhmem_ERRqhull);  /* can not use qh_errexit() */
+  }
+  if (sizeof(void *) > sizeof(ptr_intT)) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6084, "qhull internal error (qh_meminit): sizeof(void *) %d > sizeof(ptr_intT) %d. Change ptr_intT in mem_r.h to 'long long'\n", (int)sizeof(void*), (int)sizeof(ptr_intT));
+    qh_exit(qhmem_ERRqhull);  /* can not use qh_errexit() */
+  }
+  qh_memcheck(qh);
+} /* meminit */
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >-------------------------------</a><a name="meminitbuffers">-</a>
+
+  qh_meminitbuffers(qh, tracelevel, alignment, numsizes, bufsize, bufinit )
+    initialize qhmem
+    if tracelevel >= 5, trace memory allocations
+    alignment= desired address alignment for memory allocations
+    numsizes= number of freelists
+    bufsize=  size of additional memory buffers for short allocations
+    bufinit=  size of initial memory buffer for short allocations
+*/
+void qh_meminitbuffers(qhT *qh, int tracelevel, int alignment, int numsizes, int bufsize, int bufinit) {
+
+  qh->qhmem.IStracing= tracelevel;
+  qh->qhmem.NUMsizes= numsizes;
+  qh->qhmem.BUFsize= bufsize;
+  qh->qhmem.BUFinit= bufinit;
+  qh->qhmem.ALIGNmask= alignment-1;
+  if (qh->qhmem.ALIGNmask & ~qh->qhmem.ALIGNmask) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6085, "qhull internal error (qh_meminit): memory alignment %d is not a power of 2\n", alignment);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  qh->qhmem.sizetable= (int *) calloc((size_t)numsizes, sizeof(int));
+  qh->qhmem.freelists= (void **) calloc((size_t)numsizes, sizeof(void *));
+  if (!qh->qhmem.sizetable || !qh->qhmem.freelists) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6086, "qhull error (qh_meminit): insufficient memory\n");
+    qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+  }
+  if (qh->qhmem.IStracing >= 1)
+    qh_fprintf(qh, qh->qhmem.ferr, 8059, "qh_meminitbuffers: memory initialized with alignment %d\n", alignment);
+} /* meminitbuffers */
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >-------------------------------</a><a name="memsetup">-</a>
+
+  qh_memsetup(qh)
+    set up memory after running memsize()
+*/
+void qh_memsetup(qhT *qh) {
+  int k,i;
+
+  qsort(qh->qhmem.sizetable, (size_t)qh->qhmem.TABLEsize, sizeof(int), qh_intcompare);
+  qh->qhmem.LASTsize= qh->qhmem.sizetable[qh->qhmem.TABLEsize-1];
+  if (qh->qhmem.LASTsize >= qh->qhmem.BUFsize || qh->qhmem.LASTsize >= qh->qhmem.BUFinit) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6087, "qhull error (qh_memsetup): largest mem size %d is >= buffer size %d or initial buffer size %d\n",
+            qh->qhmem.LASTsize, qh->qhmem.BUFsize, qh->qhmem.BUFinit);
+    qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+  }
+  if (!(qh->qhmem.indextable= (int *)qh_malloc((size_t)(qh->qhmem.LASTsize+1) * sizeof(int)))) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6088, "qhull error (qh_memsetup): insufficient memory\n");
+    qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+  }
+  for (k=qh->qhmem.LASTsize+1; k--; )
+    qh->qhmem.indextable[k]= k;
+  i= 0;
+  for (k=0; k <= qh->qhmem.LASTsize; k++) {
+    if (qh->qhmem.indextable[k] <= qh->qhmem.sizetable[i])
+      qh->qhmem.indextable[k]= i;
+    else
+      qh->qhmem.indextable[k]= ++i;
+  }
+} /* memsetup */
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >-------------------------------</a><a name="memsize">-</a>
+
+  qh_memsize(qh, size )
+    define a free list for this size
+*/
+void qh_memsize(qhT *qh, int size) {
+  int k;
+
+  if (qh->qhmem.LASTsize) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6089, "qhull internal error (qh_memsize): qh_memsize called after qh_memsetup\n");
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  size= (size + qh->qhmem.ALIGNmask) & ~qh->qhmem.ALIGNmask;
+  if (qh->qhmem.IStracing >= 3)
+    qh_fprintf(qh, qh->qhmem.ferr, 3078, "qh_memsize: quick memory of %d bytes\n", size);
+  for (k=qh->qhmem.TABLEsize; k--; ) {
+    if (qh->qhmem.sizetable[k] == size)
+      return;
+  }
+  if (qh->qhmem.TABLEsize < qh->qhmem.NUMsizes)
+    qh->qhmem.sizetable[qh->qhmem.TABLEsize++]= size;
+  else
+    qh_fprintf(qh, qh->qhmem.ferr, 7060, "qhull warning (qh_memsize): free list table has room for only %d sizes\n", qh->qhmem.NUMsizes);
+} /* memsize */
+
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >-------------------------------</a><a name="memstatistics">-</a>
+
+  qh_memstatistics(qh, fp )
+    print out memory statistics
+
+    Verifies that qh->qhmem.totfree == sum of freelists
+*/
+void qh_memstatistics(qhT *qh, FILE *fp) {
+  int i;
+  int count;
+  void *object;
+
+  qh_memcheck(qh);
+  qh_fprintf(qh, fp, 9278, "\nmemory statistics:\n\
+%7d quick allocations\n\
+%7d short allocations\n\
+%7d long allocations\n\
+%7d short frees\n\
+%7d long frees\n\
+%7d bytes of short memory in use\n\
+%7d bytes of short memory in freelists\n\
+%7d bytes of dropped short memory\n\
+%7d bytes of unused short memory (estimated)\n\
+%7d bytes of long memory allocated (max, except for input)\n\
+%7d bytes of long memory in use (in %d pieces)\n\
+%7d bytes of short memory buffers (minus links)\n\
+%7d bytes per short memory buffer (initially %d bytes)\n",
+           qh->qhmem.cntquick, qh->qhmem.cntshort, qh->qhmem.cntlong,
+           qh->qhmem.freeshort, qh->qhmem.freelong,
+           qh->qhmem.totshort, qh->qhmem.totfree,
+           qh->qhmem.totdropped + qh->qhmem.freesize, qh->qhmem.totunused,
+           qh->qhmem.maxlong, qh->qhmem.totlong, qh->qhmem.cntlong - qh->qhmem.freelong,
+           qh->qhmem.totbuffer, qh->qhmem.BUFsize, qh->qhmem.BUFinit);
+  if (qh->qhmem.cntlarger) {
+    qh_fprintf(qh, fp, 9279, "%7d calls to qh_setlarger\n%7.2g     average copy size\n",
+           qh->qhmem.cntlarger, ((double)qh->qhmem.totlarger)/(double)qh->qhmem.cntlarger);
+    qh_fprintf(qh, fp, 9280, "  freelists(bytes->count):");
+  }
+  for (i=0; i < qh->qhmem.TABLEsize; i++) {
+    count=0;
+    for (object= qh->qhmem.freelists[i]; object; object= *((void **)object))
+      count++;
+    qh_fprintf(qh, fp, 9281, " %d->%d", qh->qhmem.sizetable[i], count);
+  }
+  qh_fprintf(qh, fp, 9282, "\n\n");
+} /* memstatistics */
+
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >-------------------------------</a><a name="NOmem">-</a>
+
+  qh_NOmem
+    turn off quick-fit memory allocation
+
+  notes:
+    uses qh_malloc() and qh_free() instead
+*/
+#else /* qh_NOmem */
+
+void *qh_memalloc(qhT *qh, int insize) {
+  void *object;
+
+  if (!(object= qh_malloc((size_t)insize))) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6090, "qhull error (qh_memalloc): insufficient memory\n");
+    qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+  }
+  qh->qhmem.cntlong++;
+  qh->qhmem.totlong += insize;
+  if (qh->qhmem.maxlong < qh->qhmem.totlong)
+      qh->qhmem.maxlong= qh->qhmem.totlong;
+  if (qh->qhmem.IStracing >= 5)
+    qh_fprintf(qh, qh->qhmem.ferr, 8060, "qh_mem %p n %8d alloc long: %d bytes (tot %d cnt %d)\n", object, qh->qhmem.cntlong+qh->qhmem.freelong, insize, qh->qhmem.totlong, qh->qhmem.cntlong-qh->qhmem.freelong);
+  return object;
+}
+
+void qh_memcheck(qhT *qh) {
+}
+
+void qh_memfree(qhT *qh, void *object, int insize) {
+
+  if (!object)
+    return;
+  qh_free(object);
+  qh->qhmem.freelong++;
+  qh->qhmem.totlong -= insize;
+  if (qh->qhmem.IStracing >= 5)
+    qh_fprintf(qh, qh->qhmem.ferr, 8061, "qh_mem %p n %8d free long: %d bytes (tot %d cnt %d)\n", object, qh->qhmem.cntlong+qh->qhmem.freelong, insize, qh->qhmem.totlong, qh->qhmem.cntlong-qh->qhmem.freelong);
+}
+
+void qh_memfreeshort(qhT *qh, int *curlong, int *totlong) {
+  *totlong= qh->qhmem.totlong;
+  *curlong= qh->qhmem.cntlong - qh->qhmem.freelong;
+  memset((char *)&qh->qhmem, 0, sizeof(qh->qhmem));  /* every field is 0, FALSE, NULL */
+}
+
+void qh_meminit(qhT *qh, FILE *ferr) {
+
+  memset((char *)&qh->qhmem, 0, sizeof(qh->qhmem));  /* every field is 0, FALSE, NULL */
+  if (ferr)
+      qh->qhmem.ferr= ferr;
+  else
+      qh->qhmem.ferr= stderr;
+  if (sizeof(void *) < sizeof(int)) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6091, "qhull internal error (qh_meminit): sizeof(void *) %d < sizeof(int) %d.  qset_r.c will not work\n", (int)sizeof(void*), (int)sizeof(int));
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+}
+
+void qh_meminitbuffers(qhT *qh, int tracelevel, int alignment, int numsizes, int bufsize, int bufinit) {
+
+  qh->qhmem.IStracing= tracelevel;
+}
+
+void qh_memsetup(qhT *qh) {
+}
+
+void qh_memsize(qhT *qh, int size) {
+}
+
+void qh_memstatistics(qhT *qh, FILE *fp) {
+
+  qh_fprintf(qh, fp, 9409, "\nmemory statistics:\n\
+%7d long allocations\n\
+%7d long frees\n\
+%7d bytes of long memory allocated (max, except for input)\n\
+%7d bytes of long memory in use (in %d pieces)\n",
+           qh->qhmem.cntlong,
+           qh->qhmem.freelong,
+           qh->qhmem.maxlong, qh->qhmem.totlong, qh->qhmem.cntlong - qh->qhmem.freelong);
+}
+
+#endif /* qh_NOmem */
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+>-------------------------------</a><a name="memtotlong">-</a>
+
+  qh_memtotal(qh, totlong, curlong, totshort, curshort, maxlong, totbuffer )
+    Return the total, allocated long and short memory
+
+  returns:
+    Returns the total current bytes of long and short allocations
+    Returns the current count of long and short allocations
+    Returns the maximum long memory and total short buffer (minus one link per buffer)
+    Does not error (for deprecated UsingLibQhull.cpp in libqhullpcpp)
+*/
+void qh_memtotal(qhT *qh, int *totlong, int *curlong, int *totshort, int *curshort, int *maxlong, int *totbuffer) {
+    *totlong= qh->qhmem.totlong;
+    *curlong= qh->qhmem.cntlong - qh->qhmem.freelong;
+    *totshort= qh->qhmem.totshort;
+    *curshort= qh->qhmem.cntshort + qh->qhmem.cntquick - qh->qhmem.freeshort;
+    *maxlong= qh->qhmem.maxlong;
+    *totbuffer= qh->qhmem.totbuffer;
+} /* memtotlong */
+
diff --git a/contrib/libs/qhull/libqhull_r/mem_r.h b/contrib/libs/qhull/libqhull_r/mem_r.h
new file mode 100644
index 0000000000..aeb761b100
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/mem_r.h
@@ -0,0 +1,235 @@
+/*<html><pre>  -<a                             href="qh-mem_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   mem_r.h
+     prototypes for memory management functions
+
+   see qh-mem_r.htm, mem_r.c and qset_r.h
+
+   for error handling, writes message and calls
+     qh_errexit(qhT *qh, qhmem_ERRmem, NULL, NULL) if insufficient memory
+       and
+     qh_errexit(qhT *qh, qhmem_ERRqhull, NULL, NULL) otherwise
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/mem_r.h#6 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#ifndef qhDEFmem
+#define qhDEFmem 1
+
+#include <stdio.h>
+
+#ifndef DEFsetT
+#define DEFsetT 1
+typedef struct setT setT;          /* defined in qset_r.h */
+#endif
+
+#ifndef DEFqhT
+#define DEFqhT 1
+typedef struct qhT qhT;          /* defined in libqhull_r.h */
+#endif
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >-------------------------------</a><a name="NOmem">-</a>
+
+  qh_NOmem
+    turn off quick-fit memory allocation
+
+  notes:
+    mem_r.c implements Quickfit memory allocation for about 20% time
+    savings.  If it fails on your machine, try to locate the
+    problem, and send the answer to qhull@qhull.org.  If this can
+    not be done, define qh_NOmem to use malloc/free instead.
+
+    #define qh_NOmem
+*/
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+>-------------------------------</a><a name="TRACEshort">-</a>
+
+qh_TRACEshort
+Trace short and quick memory allocations at T5
+
+*/
+#define qh_TRACEshort
+
+/*-------------------------------------------
+    to avoid bus errors, memory allocation must consider alignment requirements.
+    malloc() automatically takes care of alignment.   Since mem_r.c manages
+    its own memory, we need to explicitly specify alignment in
+    qh_meminitbuffers().
+
+    A safe choice is sizeof(double).  sizeof(float) may be used if doubles
+    do not occur in data structures and pointers are the same size.  Be careful
+    of machines (e.g., DEC Alpha) with large pointers.  If gcc is available,
+    use __alignof__(double) or fmax_(__alignof__(float), __alignof__(void *)).
+
+   see <a href="user_r.h#MEMalign">qh_MEMalign</a> in user_r.h for qhull's alignment
+*/
+
+#define qhmem_ERRmem 4    /* matches qh_ERRmem in libqhull_r.h */
+#define qhmem_ERRqhull 5  /* matches qh_ERRqhull in libqhull_r.h */
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >--------------------------------</a><a name="ptr_intT">-</a>
+
+  ptr_intT
+    for casting a void * to an integer-type that holds a pointer
+    Used for integer expressions (e.g., computing qh_gethash() in poly_r.c)
+
+  notes:
+    WARN64 -- these notes indicate 64-bit issues
+    On 64-bit machines, a pointer may be larger than an 'int'.
+    qh_meminit()/mem_r.c checks that 'ptr_intT' holds a 'void*'
+    ptr_intT is typically a signed value, but not necessarily so
+    size_t is typically unsigned, but should match the parameter type
+    Qhull uses int instead of size_t except for system calls such as malloc, qsort, qh_malloc, etc.
+    This matches Qt convention and is easier to work with.
+*/
+#if (defined(__MINGW64__)) && defined(_WIN64)
+typedef long long ptr_intT;
+#elif defined(_MSC_VER) && defined(_WIN64)
+typedef long long ptr_intT;
+#else
+typedef long ptr_intT;
+#endif
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >--------------------------------</a><a name="qhmemT">-</a>
+
+  qhmemT
+    global memory structure for mem_r.c
+
+ notes:
+   users should ignore qhmem except for writing extensions
+   qhmem is allocated in mem_r.c
+
+   qhmem could be swapable like qh and qhstat, but then
+   multiple qh's and qhmem's would need to keep in synch.
+   A swapable qhmem would also waste memory buffers.  As long
+   as memory operations are atomic, there is no problem with
+   multiple qh structures being active at the same time.
+   If you need separate address spaces, you can swap the
+   contents of qh->qhmem.
+*/
+typedef struct qhmemT qhmemT;
+
+struct qhmemT {               /* global memory management variables */
+  int      BUFsize;           /* size of memory allocation buffer */
+  int      BUFinit;           /* initial size of memory allocation buffer */
+  int      TABLEsize;         /* actual number of sizes in free list table */
+  int      NUMsizes;          /* maximum number of sizes in free list table */
+  int      LASTsize;          /* last size in free list table */
+  int      ALIGNmask;         /* worst-case alignment, must be 2^n-1 */
+  void   **freelists;          /* free list table, linked by offset 0 */
+  int     *sizetable;         /* size of each freelist */
+  int     *indextable;        /* size->index table */
+  void    *curbuffer;         /* current buffer, linked by offset 0 */
+  void    *freemem;           /*   free memory in curbuffer */
+  int      freesize;          /*   size of freemem in bytes */
+  setT    *tempstack;         /* stack of temporary memory, managed by users */
+  FILE    *ferr;              /* file for reporting errors when 'qh' may be undefined */
+  int      IStracing;         /* =5 if tracing memory allocations */
+  int      cntquick;          /* count of quick allocations */
+                              /* Note: removing statistics doesn't effect speed */
+  int      cntshort;          /* count of short allocations */
+  int      cntlong;           /* count of long allocations */
+  int      freeshort;         /* count of short memfrees */
+  int      freelong;          /* count of long memfrees */
+  int      totbuffer;         /* total short memory buffers minus buffer links */
+  int      totdropped;        /* total dropped memory at end of short memory buffers (e.g., freesize) */
+  int      totfree;           /* total size of free, short memory on freelists */
+  int      totlong;           /* total size of long memory in use */
+  int      maxlong;           /*   maximum totlong */
+  int      totshort;          /* total size of short memory in use */
+  int      totunused;         /* total unused short memory (estimated, short size - request size of first allocations) */
+  int      cntlarger;         /* count of setlarger's */
+  int      totlarger;         /* total copied by setlarger */
+};
+
+
+/*==================== -macros ====================*/
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >--------------------------------</a><a name="memalloc_">-</a>
+
+  qh_memalloc_(qh, insize, freelistp, object, type)
+    returns object of size bytes
+        assumes size<=qh->qhmem.LASTsize and void **freelistp is a temp
+*/
+
+#if defined qh_NOmem
+#define qh_memalloc_(qh, insize, freelistp, object, type) {\
+  (void)freelistp; /* Avoid warnings */ \
+  object= (type *)qh_memalloc(qh, insize); }
+#elif defined qh_TRACEshort
+#define qh_memalloc_(qh, insize, freelistp, object, type) {\
+  (void)freelistp; /* Avoid warnings */ \
+  object= (type *)qh_memalloc(qh, insize); }
+#else /* !qh_NOmem */
+
+#define qh_memalloc_(qh, insize, freelistp, object, type) {\
+  freelistp= qh->qhmem.freelists + qh->qhmem.indextable[insize];\
+  if ((object= (type *)*freelistp)) {\
+    qh->qhmem.totshort += qh->qhmem.sizetable[qh->qhmem.indextable[insize]]; \
+    qh->qhmem.totfree -= qh->qhmem.sizetable[qh->qhmem.indextable[insize]]; \
+    qh->qhmem.cntquick++;  \
+    *freelistp= *((void **)*freelistp);\
+  }else object= (type *)qh_memalloc(qh, insize);}
+#endif
+
+/*-<a                             href="qh-mem_r.htm#TOC"
+  >--------------------------------</a><a name="memfree_">-</a>
+
+  qh_memfree_(qh, object, insize, freelistp)
+    free up an object
+
+  notes:
+    object may be NULL
+    assumes size<=qh->qhmem.LASTsize and void **freelistp is a temp
+*/
+#if defined qh_NOmem
+#define qh_memfree_(qh, object, insize, freelistp) {\
+  (void)freelistp; /* Avoid warnings */ \
+  qh_memfree(qh, object, insize); }
+#elif defined qh_TRACEshort
+#define qh_memfree_(qh, object, insize, freelistp) {\
+  (void)freelistp; /* Avoid warnings */ \
+  qh_memfree(qh, object, insize); }
+#else /* !qh_NOmem */
+
+#define qh_memfree_(qh, object, insize, freelistp) {\
+  if (object) { \
+    qh->qhmem.freeshort++;\
+    freelistp= qh->qhmem.freelists + qh->qhmem.indextable[insize];\
+    qh->qhmem.totshort -= qh->qhmem.sizetable[qh->qhmem.indextable[insize]]; \
+    qh->qhmem.totfree += qh->qhmem.sizetable[qh->qhmem.indextable[insize]]; \
+    *((void **)object)= *freelistp;\
+    *freelistp= object;}}
+#endif
+
+/*=============== prototypes in alphabetical order ============*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void *qh_memalloc(qhT *qh, int insize);
+void qh_memcheck(qhT *qh);
+void qh_memfree(qhT *qh, void *object, int insize);
+void qh_memfreeshort(qhT *qh, int *curlong, int *totlong);
+void qh_meminit(qhT *qh, FILE *ferr);
+void qh_meminitbuffers(qhT *qh, int tracelevel, int alignment, int numsizes,
+                        int bufsize, int bufinit);
+void qh_memsetup(qhT *qh);
+void qh_memsize(qhT *qh, int size);
+void qh_memstatistics(qhT *qh, FILE *fp);
+void qh_memtotal(qhT *qh, int *totlong, int *curlong, int *totshort, int *curshort, int *maxlong, int *totbuffer);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif /* qhDEFmem */
diff --git a/contrib/libs/qhull/libqhull_r/merge_r.c b/contrib/libs/qhull/libqhull_r/merge_r.c
new file mode 100644
index 0000000000..f3c899cd6e
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/merge_r.c
@@ -0,0 +1,5590 @@
+/*<html><pre>  -<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   merge_r.c
+   merges non-convex facets
+
+   see qh-merge_r.htm and merge_r.h
+
+   other modules call qh_premerge() and qh_postmerge()
+
+   the user may call qh_postmerge() to perform additional merges.
+
+   To remove deleted facets and vertices (qhull() in libqhull_r.c):
+     qh_partitionvisible(qh, !qh_ALL, &numoutside);  // visible_list, newfacet_list
+     qh_deletevisible();         // qh.visible_list
+     qh_resetlists(qh, False, qh_RESETvisible);       // qh.visible_list newvertex_list newfacet_list
+
+   assumes qh.CENTERtype= centrum
+
+   merges occur in qh_mergefacet and in qh_mergecycle
+   vertex->neighbors not set until the first merge occurs
+
+   Copyright (c) 1993-2020 C.B. Barber.
+   $Id: //main/2019/qhull/src/libqhull_r/merge_r.c#14 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#include "qhull_ra.h"
+
+#ifndef qh_NOmerge
+
+/* MRGnone, etc. */
+const char *mergetypes[]= {
+  "none",
+  "coplanar",
+  "anglecoplanar",
+  "concave",
+  "concavecoplanar",
+  "twisted",
+  "flip",
+  "dupridge",
+  "subridge",
+  "vertices",
+  "degen",
+  "redundant",
+  "mirror",
+  "coplanarhorizon",
+};
+
+/*===== functions(alphabetical after premerge and postmerge) ======*/
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="premerge">-</a>
+
+  qh_premerge(qh, apexpointid, maxcentrum )
+    pre-merge nonconvex facets in qh.newfacet_list for apexpointid
+    maxcentrum defines coplanar and concave (qh_test_appendmerge)
+
+  returns:
+    deleted facets added to qh.visible_list with facet->visible set
+
+  notes:
+    only called by qh_addpoint
+    uses globals, qh.MERGEexact, qh.PREmerge
+
+  design:
+    mark dupridges in qh.newfacet_list
+    merge facet cycles in qh.newfacet_list
+    merge dupridges and concave facets in qh.newfacet_list
+    check merged facet cycles for degenerate and redundant facets
+    merge degenerate and redundant facets
+    collect coplanar and concave facets
+    merge concave, coplanar, degenerate, and redundant facets
+*/
+void qh_premerge(qhT *qh, int apexpointid, realT maxcentrum, realT maxangle /* qh.newfacet_list */) {
+  boolT othermerge= False;
+
+  if (qh->ZEROcentrum && qh_checkzero(qh, !qh_ALL))
+    return;
+  trace2((qh, qh->ferr, 2008, "qh_premerge: premerge centrum %2.2g angle %4.4g for apex p%d newfacet_list f%d\n",
+            maxcentrum, maxangle, apexpointid, getid_(qh->newfacet_list)));
+  if (qh->IStracing >= 4 && qh->num_facets < 100)
+    qh_printlists(qh);
+  qh->centrum_radius= maxcentrum;
+  qh->cos_max= maxangle;
+  if (qh->hull_dim >=3) {
+    qh_mark_dupridges(qh, qh->newfacet_list, qh_ALL); /* facet_mergeset */
+    qh_mergecycle_all(qh, qh->newfacet_list, &othermerge);
+    qh_forcedmerges(qh, &othermerge /* qh.facet_mergeset */);
+  }else /* qh.hull_dim == 2 */
+    qh_mergecycle_all(qh, qh->newfacet_list, &othermerge);
+  qh_flippedmerges(qh, qh->newfacet_list, &othermerge);
+  if (!qh->MERGEexact || zzval_(Ztotmerge)) {
+    zinc_(Zpremergetot);
+    qh->POSTmerging= False;
+    qh_getmergeset_initial(qh, qh->newfacet_list);
+    qh_all_merges(qh, othermerge, False);
+  }
+} /* premerge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="postmerge">-</a>
+
+  qh_postmerge(qh, reason, maxcentrum, maxangle, vneighbors )
+    post-merge nonconvex facets as defined by maxcentrum and maxangle
+    'reason' is for reporting progress
+    if vneighbors ('Qv'),
+      calls qh_test_vneighbors at end of qh_all_merge from qh_postmerge
+
+  returns:
+    if first call (qh.visible_list != qh.facet_list),
+      builds qh.facet_newlist, qh.newvertex_list
+    deleted facets added to qh.visible_list with facet->visible
+    qh.visible_list == qh.facet_list
+
+  notes:
+    called by qh_qhull after qh_buildhull
+    called if a merge may be needed due to
+      qh.MERGEexact ('Qx'), qh_DIMreduceBuild, POSTmerge (e.g., 'Cn'), or TESTvneighbors ('Qv')
+    if firstmerge,
+      calls qh_reducevertices before qh_getmergeset
+
+  design:
+    if first call
+      set qh.visible_list and qh.newfacet_list to qh.facet_list
+      add all facets to qh.newfacet_list
+      mark non-simplicial facets, facet->newmerge
+      set qh.newvertext_list to qh.vertex_list
+      add all vertices to qh.newvertex_list
+      if a pre-merge occurred
+        set vertex->delridge {will retest the ridge}
+        if qh.MERGEexact
+          call qh_reducevertices()
+      if no pre-merging
+        merge flipped facets
+    determine non-convex facets
+    merge all non-convex facets
+*/
+void qh_postmerge(qhT *qh, const char *reason, realT maxcentrum, realT maxangle,
+                      boolT vneighbors) {
+  facetT *newfacet;
+  boolT othermerges= False;
+  vertexT *vertex;
+
+  if (qh->REPORTfreq || qh->IStracing) {
+    qh_buildtracing(qh, NULL, NULL);
+    qh_printsummary(qh, qh->ferr);
+    if (qh->PRINTstatistics)
+      qh_printallstatistics(qh, qh->ferr, "reason");
+    qh_fprintf(qh, qh->ferr, 8062, "\n%s with 'C%.2g' and 'A%.2g'\n",
+        reason, maxcentrum, maxangle);
+  }
+  trace2((qh, qh->ferr, 2009, "qh_postmerge: postmerge.  test vneighbors? %d\n",
+            vneighbors));
+  qh->centrum_radius= maxcentrum;
+  qh->cos_max= maxangle;
+  qh->POSTmerging= True;
+  if (qh->visible_list != qh->facet_list) {  /* first call due to qh_buildhull, multiple calls if qh.POSTmerge */
+    qh->NEWfacets= True;
+    qh->visible_list= qh->newfacet_list= qh->facet_list;
+    FORALLnew_facets {              /* all facets are new facets for qh_postmerge */
+      newfacet->newfacet= True;
+       if (!newfacet->simplicial)
+        newfacet->newmerge= True;   /* test f.vertices for 'delridge'.  'newmerge' was cleared at end of qh_all_merges */
+     zinc_(Zpostfacets);
+    }
+    qh->newvertex_list= qh->vertex_list;
+    FORALLvertices
+      vertex->newfacet= True;
+    if (qh->VERTEXneighbors) {  /* a merge has occurred */
+      if (qh->MERGEexact && qh->hull_dim <= qh_DIMreduceBuild)
+        qh_reducevertices(qh);  /* qh_all_merges did not call qh_reducevertices for v.delridge */
+    }
+    if (!qh->PREmerge && !qh->MERGEexact)
+      qh_flippedmerges(qh, qh->newfacet_list, &othermerges);
+  }
+  qh_getmergeset_initial(qh, qh->newfacet_list);
+  qh_all_merges(qh, False, vneighbors); /* calls qh_reducevertices before exiting */
+  FORALLnew_facets
+    newfacet->newmerge= False;   /* Was True if no vertex in f.vertices was 'delridge' */
+} /* post_merge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="all_merges">-</a>
+
+  qh_all_merges(qh, othermerge, vneighbors )
+    merge all non-convex facets
+
+    set othermerge if already merged facets (calls qh_reducevertices)
+    if vneighbors ('Qv' at qh.POSTmerge)
+      tests vertex neighbors for convexity at end (qh_test_vneighbors)
+    qh.facet_mergeset lists the non-convex ridges in qh_newfacet_list
+    qh.degen_mergeset is defined
+    if qh.MERGEexact && !qh.POSTmerging,
+      does not merge coplanar facets
+
+  returns:
+    deleted facets added to qh.visible_list with facet->visible
+    deleted vertices added qh.delvertex_list with vertex->delvertex
+
+  notes:
+    unless !qh.MERGEindependent,
+      merges facets in independent sets
+    uses qh.newfacet_list as implicit argument since merges call qh_removefacet()
+    [apr'19] restored qh_setdellast in place of qh_next_facetmerge.  Much faster for post-merge
+
+  design:
+    while merges occur
+      for each merge in qh.facet_mergeset
+        unless one of the facets was already merged in this pass
+          merge the facets
+        test merged facets for additional merges
+        add merges to qh.facet_mergeset
+        if qh.POSTmerging
+          periodically call qh_reducevertices to reduce extra vertices and redundant vertices
+      after each pass, if qh.VERTEXneighbors
+        if qh.POSTmerging or was a merge with qh.hull_dim<=5
+          call qh_reducevertices
+          update qh.facet_mergeset if degenredundant merges
+      if 'Qv' and qh.POSTmerging
+        test vertex neighbors for convexity
+*/
+void qh_all_merges(qhT *qh, boolT othermerge, boolT vneighbors) {
+  facetT *facet1, *facet2, *newfacet;
+  mergeT *merge;
+  boolT wasmerge= False, isreduce;
+  void **freelistp;  /* used if !qh_NOmem by qh_memfree_() */
+  vertexT *vertex;
+  realT angle, distance;
+  mergeType mergetype;
+  int numcoplanar=0, numconcave=0, numconcavecoplanar= 0, numdegenredun= 0, numnewmerges= 0, numtwisted= 0;
+
+  trace2((qh, qh->ferr, 2010, "qh_all_merges: starting to merge %d facet and %d degenerate merges for new facets f%d, othermerge? %d\n",
+            qh_setsize(qh, qh->facet_mergeset), qh_setsize(qh, qh->degen_mergeset), getid_(qh->newfacet_list), othermerge));
+
+  while (True) {
+    wasmerge= False;
+    while (qh_setsize(qh, qh->facet_mergeset) > 0 || qh_setsize(qh, qh->degen_mergeset) > 0) {
+      if (qh_setsize(qh, qh->degen_mergeset) > 0) {
+        numdegenredun += qh_merge_degenredundant(qh);
+        wasmerge= True;
+      }
+      while ((merge= (mergeT *)qh_setdellast(qh->facet_mergeset))) {
+        facet1= merge->facet1;
+        facet2= merge->facet2;
+        vertex= merge->vertex1;  /* not used for qh.facet_mergeset*/
+        mergetype= merge->mergetype;
+        angle= merge->angle;
+        distance= merge->distance;
+        qh_memfree_(qh, merge, (int)sizeof(mergeT), freelistp);   /* 'merge' is invalid */
+        if (facet1->visible || facet2->visible) {
+          trace3((qh, qh->ferr, 3045, "qh_all_merges: drop merge of f%d (del? %d) into f%d (del? %d) mergetype %d, dist %4.4g, angle %4.4g.  One or both facets is deleted\n",
+            facet1->id, facet1->visible, facet2->id, facet2->visible, mergetype, distance, angle));
+          continue;
+        }else if (mergetype == MRGcoplanar || mergetype == MRGanglecoplanar) {
+          if (qh->MERGEindependent) {
+            if ((!facet1->tested && facet1->newfacet)
+            || (!facet2->tested && facet2->newfacet)) {
+              trace3((qh, qh->ferr, 3064, "qh_all_merges: drop merge of f%d (tested? %d) into f%d (tested? %d) mergetype %d, dist %2.2g, angle %4.4g.  Merge independent sets of coplanar merges\n",
+                facet1->id, facet1->visible, facet2->id, facet2->visible, mergetype, distance, angle));
+              continue;
+            }
+          }
+        }
+        trace3((qh, qh->ferr, 3047, "qh_all_merges: merge f%d and f%d type %d dist %2.2g angle %4.4g\n",
+          facet1->id, facet2->id, mergetype, distance, angle));
+        if (mergetype == MRGtwisted)
+          qh_merge_twisted(qh, facet1, facet2);
+        else
+          qh_merge_nonconvex(qh, facet1, facet2, mergetype);
+        numnewmerges++;
+        numdegenredun += qh_merge_degenredundant(qh);
+        wasmerge= True;
+        if (mergetype == MRGconcave)
+          numconcave++;
+        else if (mergetype == MRGconcavecoplanar)
+          numconcavecoplanar++;
+        else if (mergetype == MRGtwisted)
+          numtwisted++;
+        else if (mergetype == MRGcoplanar || mergetype == MRGanglecoplanar)
+          numcoplanar++;
+        else {
+          qh_fprintf(qh, qh->ferr, 6394, "qhull internal error (qh_all_merges): expecting concave, coplanar, or twisted merge.  Got merge f%d f%d v%d mergetype %d\n",
+            getid_(facet1), getid_(facet2), getid_(vertex), mergetype);
+          qh_errexit2(qh, qh_ERRqhull, facet1, facet2);
+        }
+      } /* while qh_setdellast */
+      if (qh->POSTmerging && qh->hull_dim <= qh_DIMreduceBuild
+      && numnewmerges > qh_MAXnewmerges) {
+        numnewmerges= 0;
+        wasmerge= othermerge= False;
+        qh_reducevertices(qh);  /* otherwise large post merges too slow */
+      }
+      qh_getmergeset(qh, qh->newfacet_list); /* qh.facet_mergeset */
+    } /* while facet_mergeset or degen_mergeset */
+    if (qh->VERTEXneighbors) {  /* at least one merge */
+      isreduce= False;
+      if (qh->POSTmerging && qh->hull_dim >= 4) {
+        isreduce= True;
+      }else if (qh->POSTmerging || !qh->MERGEexact) {
+        if ((wasmerge || othermerge) && qh->hull_dim > 2 && qh->hull_dim <= qh_DIMreduceBuild)
+          isreduce= True;
+      }
+      if (isreduce) {
+        wasmerge= othermerge= False;
+        if (qh_reducevertices(qh)) {
+          qh_getmergeset(qh, qh->newfacet_list); /* facet_mergeset */
+          continue;
+        }
+      }
+    }
+    if (vneighbors && qh_test_vneighbors(qh /* qh.newfacet_list */))
+      continue;
+    break;
+  } /* while (True) */
+  if (wasmerge || othermerge) {
+    trace3((qh, qh->ferr, 3033, "qh_all_merges: skip qh_reducevertices due to post-merging, no qh.VERTEXneighbors (%d), or hull_dim %d ==2 or >%d\n", qh->VERTEXneighbors, qh->hull_dim, qh_DIMreduceBuild))
+    FORALLnew_facets {
+      newfacet->newmerge= False;
+    }
+  }
+  if (qh->CHECKfrequently && !qh->MERGEexact) {
+    qh->old_randomdist= qh->RANDOMdist;
+    qh->RANDOMdist= False;
+    qh_checkconvex(qh, qh->newfacet_list, qh_ALGORITHMfault);
+    /* qh_checkconnect(qh); [this is slow and it changes the facet order] */
+    qh->RANDOMdist= qh->old_randomdist;
+  }
+  trace1((qh, qh->ferr, 1009, "qh_all_merges: merged %d coplanar %d concave %d concavecoplanar %d twisted facets and %d degen or redundant facets.\n",
+    numcoplanar, numconcave, numconcavecoplanar, numtwisted, numdegenredun));
+  if (qh->IStracing >= 4 && qh->num_facets < 500)
+    qh_printlists(qh);
+} /* all_merges */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="all_vertexmerges">-</a>
+
+  qh_all_vertexmerges(qh, apexpointid, facet, &retryfacet )
+    merge vertices in qh.vertex_mergeset and subsequent merges
+
+  returns:
+    returns retryfacet for facet (if defined)
+    updates qh.facet_list, qh.num_facets, qh.vertex_list, qh.num_vertices
+    mergesets are empty
+    if merges, resets facet lists
+
+  notes:
+    called from qh_qhull, qh_addpoint, and qh_buildcone_mergepinched
+    vertex merges occur after facet merges and qh_resetlists
+
+  design:
+    while merges in vertex_mergeset (MRGvertices)
+      merge a pair of pinched vertices
+      update vertex neighbors
+      merge non-convex and degenerate facets and check for ridges with duplicate vertices
+      partition outside points of deleted, "visible" facets
+*/
+void qh_all_vertexmerges(qhT *qh, int apexpointid, facetT *facet, facetT **retryfacet) {
+  int numpoints; /* ignore count of partitioned points.  Used by qh_addpoint for Zpbalance */
+
+  if (retryfacet)
+    *retryfacet= facet;
+  while (qh_setsize(qh, qh->vertex_mergeset) > 0) {
+    trace1((qh, qh->ferr, 1057, "qh_all_vertexmerges: starting to merge %d vertex merges for apex p%d facet f%d\n",
+            qh_setsize(qh, qh->vertex_mergeset), apexpointid, getid_(facet)));
+    if (qh->IStracing >= 4  && qh->num_facets < 1000)
+      qh_printlists(qh);
+    qh_merge_pinchedvertices(qh, apexpointid /* qh.vertex_mergeset, visible_list, newvertex_list, newfacet_list */);
+    qh_update_vertexneighbors(qh); /* update neighbors of qh.newvertex_list from qh_newvertices for deleted facets on qh.visible_list */
+                           /* test ridges and merge non-convex facets */
+    qh_getmergeset(qh, qh->newfacet_list);
+    qh_all_merges(qh, True, False); /* calls qh_reducevertices */
+    if (qh->CHECKfrequently)
+      qh_checkpolygon(qh, qh->facet_list);
+    qh_partitionvisible(qh, !qh_ALL, &numpoints /* qh.visible_list qh.del_vertices*/);
+    if (retryfacet)
+      *retryfacet= qh_getreplacement(qh, *retryfacet);
+    qh_deletevisible(qh /* qh.visible_list  qh.del_vertices*/);
+    qh_resetlists(qh, False, qh_RESETvisible /* qh.visible_list newvertex_list qh.newfacet_list */);
+    if (qh->IStracing >= 4  && qh->num_facets < 1000) {
+      qh_printlists(qh);
+      qh_checkpolygon(qh, qh->facet_list);
+    }
+  }
+} /* all_vertexmerges */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="appendmergeset">-</a>
+
+  qh_appendmergeset(qh, facet, vertex, neighbor, mergetype, dist, angle )
+    appends an entry to qh.facet_mergeset or qh.degen_mergeset
+    if 'dist' is unknown, set it to 0.0
+        if 'angle' is unknown, set it to 1.0 (coplanar)
+
+  returns:
+    merge appended to facet_mergeset or degen_mergeset
+      sets ->degenerate or ->redundant if degen_mergeset
+
+  notes:
+    caller collects statistics and/or caller of qh_mergefacet
+    see: qh_test_appendmerge()
+
+  design:
+    allocate merge entry
+    if regular merge
+      append to qh.facet_mergeset
+    else if degenerate merge and qh.facet_mergeset is all degenerate
+      append to qh.degen_mergeset
+    else if degenerate merge
+      prepend to qh.degen_mergeset (merged last)
+    else if redundant merge
+      append to qh.degen_mergeset
+*/
+void qh_appendmergeset(qhT *qh, facetT *facet, facetT *neighbor, mergeType mergetype, coordT dist, realT angle) {
+  mergeT *merge, *lastmerge;
+  void **freelistp; /* used if !qh_NOmem by qh_memalloc_() */
+  const char *mergename;
+
+  if ((facet->redundant && mergetype != MRGmirror) || neighbor->redundant) {
+    trace3((qh, qh->ferr, 3051, "qh_appendmergeset: f%d is already redundant (%d) or f%d is already redundant (%d).  Ignore merge f%d and f%d type %d\n",
+      facet->id, facet->redundant, neighbor->id, neighbor->redundant, facet->id, neighbor->id, mergetype));
+    return;
+  }
+  if (facet->degenerate && mergetype == MRGdegen) {
+    trace3((qh, qh->ferr, 3077, "qh_appendmergeset: f%d is already degenerate.  Ignore merge f%d type %d (MRGdegen)\n",
+      facet->id, facet->id, mergetype));
+    return;
+  }
+  if (!qh->facet_mergeset || !qh->degen_mergeset) {
+    qh_fprintf(qh, qh->ferr, 6403, "qhull internal error (qh_appendmergeset): expecting temp set defined for qh.facet_mergeset (0x%x) and qh.degen_mergeset (0x%x).  Got NULL\n",
+      qh->facet_mergeset, qh->degen_mergeset);
+    /* otherwise qh_setappend creates a new set that is not freed by qh_freebuild() */
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (neighbor->flipped && !facet->flipped) {
+    if (mergetype != MRGdupridge) {
+      qh_fprintf(qh, qh->ferr, 6355, "qhull internal error (qh_appendmergeset): except for MRGdupridge, cannot merge a non-flipped facet f%d into flipped f%d, mergetype %d, dist %4.4g\n",
+        facet->id, neighbor->id, mergetype, dist);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }else {
+      trace2((qh, qh->ferr, 2106, "qh_appendmergeset: dupridge will merge a non-flipped facet f%d into flipped f%d, dist %4.4g\n",
+        facet->id, neighbor->id, dist));
+    }
+  }
+  qh_memalloc_(qh, (int)sizeof(mergeT), freelistp, merge, mergeT);
+  merge->angle= angle;
+  merge->distance= dist;
+  merge->facet1= facet;
+  merge->facet2= neighbor;
+  merge->vertex1= NULL;
+  merge->vertex2= NULL;
+  merge->ridge1= NULL;
+  merge->ridge2= NULL;
+  merge->mergetype= mergetype;
+  if(mergetype > 0 && mergetype < sizeof(mergetypes)/sizeof(char *))
+    mergename= mergetypes[mergetype];
+  else
+    mergename= mergetypes[MRGnone];
+  if (mergetype < MRGdegen)
+    qh_setappend(qh, &(qh->facet_mergeset), merge);
+  else if (mergetype == MRGdegen) {
+    facet->degenerate= True;
+    if (!(lastmerge= (mergeT *)qh_setlast(qh->degen_mergeset))
+    || lastmerge->mergetype == MRGdegen)
+      qh_setappend(qh, &(qh->degen_mergeset), merge);
+    else
+      qh_setaddnth(qh, &(qh->degen_mergeset), 0, merge);    /* merged last */
+  }else if (mergetype == MRGredundant) {
+    facet->redundant= True;
+    qh_setappend(qh, &(qh->degen_mergeset), merge);
+  }else /* mergetype == MRGmirror */ {
+    if (facet->redundant || neighbor->redundant) {
+      qh_fprintf(qh, qh->ferr, 6092, "qhull internal error (qh_appendmergeset): facet f%d or f%d is already a mirrored facet (i.e., 'redundant')\n",
+           facet->id, neighbor->id);
+      qh_errexit2(qh, qh_ERRqhull, facet, neighbor);
+    }
+    if (!qh_setequal(facet->vertices, neighbor->vertices)) {
+      qh_fprintf(qh, qh->ferr, 6093, "qhull internal error (qh_appendmergeset): mirrored facets f%d and f%d do not have the same vertices\n",
+           facet->id, neighbor->id);
+      qh_errexit2(qh, qh_ERRqhull, facet, neighbor);
+    }
+    facet->redundant= True;
+    neighbor->redundant= True;
+    qh_setappend(qh, &(qh->degen_mergeset), merge);
+  }
+  if (merge->mergetype >= MRGdegen) {
+    trace3((qh, qh->ferr, 3044, "qh_appendmergeset: append merge f%d and f%d type %d (%s) to qh.degen_mergeset (size %d)\n",
+      merge->facet1->id, merge->facet2->id, merge->mergetype, mergename, qh_setsize(qh, qh->degen_mergeset)));
+  }else {
+    trace3((qh, qh->ferr, 3027, "qh_appendmergeset: append merge f%d and f%d type %d (%s) dist %2.2g angle %4.4g to qh.facet_mergeset (size %d)\n",
+      merge->facet1->id, merge->facet2->id, merge->mergetype, mergename, merge->distance, merge->angle, qh_setsize(qh, qh->facet_mergeset)));
+  }
+} /* appendmergeset */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="appendvertexmerge">-</a>
+
+  qh_appendvertexmerge(qh, vertex, vertex2, mergetype, distance, ridge1, ridge2 )
+    appends a vertex merge to qh.vertex_mergeset
+    MRGsubridge includes two ridges (from MRGdupridge)
+    MRGvertices includes two ridges
+
+  notes:
+    called by qh_getpinchedmerges for MRGsubridge
+    called by qh_maybe_duplicateridge and qh_maybe_duplicateridges for MRGvertices
+    only way to add a vertex merge to qh.vertex_mergeset
+    checked by qh_next_vertexmerge
+*/
+void qh_appendvertexmerge(qhT *qh, vertexT *vertex, vertexT *destination, mergeType mergetype, realT distance, ridgeT *ridge1, ridgeT *ridge2) {
+  mergeT *merge;
+  void **freelistp; /* used if !qh_NOmem by qh_memalloc_() */
+  const char *mergename;
+
+  if (!qh->vertex_mergeset) {
+    qh_fprintf(qh, qh->ferr, 6387, "qhull internal error (qh_appendvertexmerge): expecting temp set defined for qh.vertex_mergeset (0x%x).  Got NULL\n",
+      qh->vertex_mergeset);
+    /* otherwise qh_setappend creates a new set that is not freed by qh_freebuild() */
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh_memalloc_(qh, (int)sizeof(mergeT), freelistp, merge, mergeT);
+  merge->angle= qh_ANGLEnone;
+  merge->distance= distance;
+  merge->facet1= NULL;
+  merge->facet2= NULL;
+  merge->vertex1= vertex;
+  merge->vertex2= destination;
+  merge->ridge1= ridge1;
+  merge->ridge2= ridge2;
+  merge->mergetype= mergetype;
+  if(mergetype > 0 && mergetype < sizeof(mergetypes)/sizeof(char *))
+    mergename= mergetypes[mergetype];
+  else
+    mergename= mergetypes[MRGnone];
+  if (mergetype == MRGvertices) {
+    if (!ridge1 || !ridge2 || ridge1 == ridge2) {
+      qh_fprintf(qh, qh->ferr, 6106, "qhull internal error (qh_appendvertexmerge): expecting two distinct ridges for MRGvertices.  Got r%d r%d\n",
+        getid_(ridge1), getid_(ridge2));
+      qh_errexit(qh, qh_ERRqhull, NULL, ridge1);
+    }
+  }
+  qh_setappend(qh, &(qh->vertex_mergeset), merge);
+  trace3((qh, qh->ferr, 3034, "qh_appendvertexmerge: append merge v%d into v%d r%d r%d dist %2.2g type %d (%s)\n",
+    vertex->id, destination->id, getid_(ridge1), getid_(ridge2), distance, merge->mergetype, mergename));
+} /* appendvertexmerge */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="basevertices">-</a>
+
+  qh_basevertices(qh, samecycle )
+    return temporary set of base vertices for samecycle
+    samecycle is first facet in the cycle
+    assumes apex is SETfirst_( samecycle->vertices )
+
+  returns:
+    vertices(settemp)
+    all ->seen are cleared
+
+  notes:
+    uses qh_vertex_visit;
+
+  design:
+    for each facet in samecycle
+      for each unseen vertex in facet->vertices
+        append to result
+*/
+setT *qh_basevertices(qhT *qh, facetT *samecycle) {
+  facetT *same;
+  vertexT *apex, *vertex, **vertexp;
+  setT *vertices= qh_settemp(qh, qh->TEMPsize);
+
+  apex= SETfirstt_(samecycle->vertices, vertexT);
+  apex->visitid= ++qh->vertex_visit;
+  FORALLsame_cycle_(samecycle) {
+    if (same->mergeridge)
+      continue;
+    FOREACHvertex_(same->vertices) {
+      if (vertex->visitid != qh->vertex_visit) {
+        qh_setappend(qh, &vertices, vertex);
+        vertex->visitid= qh->vertex_visit;
+        vertex->seen= False;
+      }
+    }
+  }
+  trace4((qh, qh->ferr, 4019, "qh_basevertices: found %d vertices\n",
+         qh_setsize(qh, vertices)));
+  return vertices;
+} /* basevertices */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="check_dupridge">-</a>
+
+  qh_check_dupridge(qh, facet1, dist1, facet2, dist2 )
+    Check dupridge between facet1 and facet2 for wide merge
+    dist1 is the maximum distance of facet1's vertices to facet2
+    dist2 is the maximum distance of facet2's vertices to facet1
+
+  returns
+    Level 1 log of the dupridge with the minimum distance between vertices
+    Throws error if the merge will increase the maximum facet width by qh_WIDEduplicate (100x)
+
+  notes:
+    only called from qh_forcedmerges
+*/
+void qh_check_dupridge(qhT *qh, facetT *facet1, realT dist1, facetT *facet2, realT dist2) {
+  vertexT *vertex, **vertexp, *vertexA, **vertexAp;
+  realT dist, innerplane, mergedist, outerplane, prevdist, ratio, vertexratio;
+  realT minvertex= REALmax;
+
+  mergedist= fmin_(dist1, dist2);
+  qh_outerinner(qh, NULL, &outerplane, &innerplane);  /* ratio from qh_printsummary */
+  FOREACHvertex_(facet1->vertices) {     /* The dupridge is between facet1 and facet2, so either facet can be tested */
+    FOREACHvertexA_(facet1->vertices) {
+      if (vertex > vertexA){   /* Test each pair once */
+        dist= qh_pointdist(vertex->point, vertexA->point, qh->hull_dim);
+        minimize_(minvertex, dist);
+        /* Not quite correct.  A facet may have a dupridge and another pair of nearly adjacent vertices. */
+      }
+    }
+  }
+  prevdist= fmax_(outerplane, innerplane);
+  maximize_(prevdist, qh->ONEmerge + qh->DISTround);
+  maximize_(prevdist, qh->MINoutside + qh->DISTround);
+  ratio= mergedist/prevdist;
+  vertexratio= minvertex/prevdist;
+  trace0((qh, qh->ferr, 16, "qh_check_dupridge: dupridge between f%d and f%d (vertex dist %2.2g), dist %2.2g, reverse dist %2.2g, ratio %2.2g while processing p%d\n",
+        facet1->id, facet2->id, minvertex, dist1, dist2, ratio, qh->furthest_id));
+  if (ratio > qh_WIDEduplicate) {
+    qh_fprintf(qh, qh->ferr, 6271, "qhull topology error (qh_check_dupridge): wide merge (%.1fx wider) due to dupridge between f%d and f%d (vertex dist %2.2g), merge dist %2.2g, while processing p%d\n- Allow error with option 'Q12'\n",
+      ratio, facet1->id, facet2->id, minvertex, mergedist, qh->furthest_id);
+    if (vertexratio < qh_WIDEpinched)
+      qh_fprintf(qh, qh->ferr, 8145, "- Experimental option merge-pinched-vertices ('Q14') may avoid this error.  It merges nearly adjacent vertices.\n");
+    if (qh->DELAUNAY)
+      qh_fprintf(qh, qh->ferr, 8145, "- A bounding box for the input sites may alleviate this error.\n");
+    if (!qh->ALLOWwide)
+      qh_errexit2(qh, qh_ERRwide, facet1, facet2);
+  }
+} /* check_dupridge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="checkconnect">-</a>
+
+  qh_checkconnect(qh)
+    check that new facets are connected
+    new facets are on qh.newfacet_list
+
+  notes:
+    this is slow and it changes the order of the facets
+    uses qh.visit_id
+
+  design:
+    move first new facet to end of qh.facet_list
+    for all newly appended facets
+      append unvisited neighbors to end of qh.facet_list
+    for all new facets
+      report error if unvisited
+*/
+void qh_checkconnect(qhT *qh /* qh.newfacet_list */) {
+  facetT *facet, *newfacet, *errfacet= NULL, *neighbor, **neighborp;
+
+  facet= qh->newfacet_list;
+  qh_removefacet(qh, facet);
+  qh_appendfacet(qh, facet);
+  facet->visitid= ++qh->visit_id;
+  FORALLfacet_(facet) {
+    FOREACHneighbor_(facet) {
+      if (neighbor->visitid != qh->visit_id) {
+        qh_removefacet(qh, neighbor);
+        qh_appendfacet(qh, neighbor);
+        neighbor->visitid= qh->visit_id;
+      }
+    }
+  }
+  FORALLnew_facets {
+    if (newfacet->visitid == qh->visit_id)
+      break;
+    qh_fprintf(qh, qh->ferr, 6094, "qhull internal error (qh_checkconnect): f%d is not attached to the new facets\n",
+         newfacet->id);
+    errfacet= newfacet;
+  }
+  if (errfacet)
+    qh_errexit(qh, qh_ERRqhull, errfacet, NULL);
+} /* checkconnect */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="checkdelfacet">-</a>
+
+  qh_checkdelfacet(qh, facet, mergeset )
+    check that mergeset does not reference facet
+
+*/
+void qh_checkdelfacet(qhT *qh, facetT *facet, setT *mergeset) {
+  mergeT *merge, **mergep;
+
+  FOREACHmerge_(mergeset) {
+    if (merge->facet1 == facet || merge->facet2 == facet) {
+      qh_fprintf(qh, qh->ferr, 6390, "qhull internal error (qh_checkdelfacet): cannot delete f%d.  It is referenced by merge f%d f%d mergetype %d\n",
+        facet->id, merge->facet1->id, getid_(merge->facet2), merge->mergetype);
+      qh_errexit2(qh, qh_ERRqhull, merge->facet1, merge->facet2);
+    }
+  }
+} /* checkdelfacet */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="checkdelridge">-</a>
+
+  qh_checkdelridge(qh)
+    check that qh_delridge_merge is not needed for deleted ridges
+
+    notes:
+      called from qh_mergecycle, qh_makenewfacets, qh_attachnewfacets
+      errors if qh.vertex_mergeset is non-empty
+      errors if any visible or new facet has a ridge with r.nonconvex set
+      assumes that vertex.delfacet is not needed
+*/
+void qh_checkdelridge(qhT *qh /* qh.visible_facets, vertex_mergeset */) {
+  facetT *newfacet, *visible;
+  ridgeT *ridge, **ridgep;
+
+  if (!SETempty_(qh->vertex_mergeset)) {
+    qh_fprintf(qh, qh->ferr, 6382, "qhull internal error (qh_checkdelridge): expecting empty qh.vertex_mergeset in order to avoid calling qh_delridge_merge.  Got %d merges\n", qh_setsize(qh, qh->vertex_mergeset));
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+
+  FORALLnew_facets {
+    FOREACHridge_(newfacet->ridges) {
+      if (ridge->nonconvex) {
+        qh_fprintf(qh, qh->ferr, 6313, "qhull internal error (qh_checkdelridge): unexpected 'nonconvex' flag for ridge r%d in newfacet f%d.  Otherwise need to call qh_delridge_merge\n",
+           ridge->id, newfacet->id);
+        qh_errexit(qh, qh_ERRqhull, newfacet, ridge);
+      }
+    }
+  }
+
+  FORALLvisible_facets {
+    FOREACHridge_(visible->ridges) {
+      if (ridge->nonconvex) {
+        qh_fprintf(qh, qh->ferr, 6385, "qhull internal error (qh_checkdelridge): unexpected 'nonconvex' flag for ridge r%d in visible facet f%d.  Otherwise need to call qh_delridge_merge\n",
+          ridge->id, visible->id);
+        qh_errexit(qh, qh_ERRqhull, visible, ridge);
+      }
+    }
+  }
+} /* checkdelridge */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="checkzero">-</a>
+
+  qh_checkzero(qh, testall )
+    check that facets are clearly convex for qh.DISTround with qh.MERGEexact
+
+    if testall,
+      test all facets for qh.MERGEexact post-merging
+    else
+      test qh.newfacet_list
+
+    if qh.MERGEexact,
+      allows coplanar ridges
+      skips convexity test while qh.ZEROall_ok
+
+  returns:
+    True if all facets !flipped, !dupridge, normal
+         if all horizon facets are simplicial
+         if all vertices are clearly below neighbor
+         if all opposite vertices of horizon are below
+    clears qh.ZEROall_ok if any problems or coplanar facets
+
+  notes:
+    called by qh_premerge (qh.CHECKzero, 'C-0') and qh_qhull ('Qx')
+    uses qh.vertex_visit
+    horizon facets may define multiple new facets
+
+  design:
+    for all facets in qh.newfacet_list or qh.facet_list
+      check for flagged faults (flipped, etc.)
+    for all facets in qh.newfacet_list or qh.facet_list
+      for each neighbor of facet
+        skip horizon facets for qh.newfacet_list
+        test the opposite vertex
+      if qh.newfacet_list
+        test the other vertices in the facet's horizon facet
+*/
+boolT qh_checkzero(qhT *qh, boolT testall) {
+  facetT *facet, *neighbor;
+  facetT *horizon, *facetlist;
+  int neighbor_i, neighbor_n;
+  vertexT *vertex, **vertexp;
+  realT dist;
+
+  if (testall)
+    facetlist= qh->facet_list;
+  else {
+    facetlist= qh->newfacet_list;
+    FORALLfacet_(facetlist) {
+      horizon= SETfirstt_(facet->neighbors, facetT);
+      if (!horizon->simplicial)
+        goto LABELproblem;
+      if (facet->flipped || facet->dupridge || !facet->normal)
+        goto LABELproblem;
+    }
+    if (qh->MERGEexact && qh->ZEROall_ok) {
+      trace2((qh, qh->ferr, 2011, "qh_checkzero: skip convexity check until first pre-merge\n"));
+      return True;
+    }
+  }
+  FORALLfacet_(facetlist) {
+    qh->vertex_visit++;
+    horizon= NULL;
+    FOREACHneighbor_i_(qh, facet) {
+      if (!neighbor_i && !testall) {
+        horizon= neighbor;
+        continue; /* horizon facet tested in qh_findhorizon */
+      }
+      vertex= SETelemt_(facet->vertices, neighbor_i, vertexT);
+      vertex->visitid= qh->vertex_visit;
+      zzinc_(Zdistzero);
+      qh_distplane(qh, vertex->point, neighbor, &dist);
+      if (dist >= -2 * qh->DISTround) {  /* need 2x for qh_distround and 'Rn' for qh_checkconvex, same as qh.premerge_centrum */
+        qh->ZEROall_ok= False;
+        if (!qh->MERGEexact || testall || dist > qh->DISTround)
+          goto LABELnonconvex;
+      }
+    }
+    if (!testall && horizon) {
+      FOREACHvertex_(horizon->vertices) {
+        if (vertex->visitid != qh->vertex_visit) {
+          zzinc_(Zdistzero);
+          qh_distplane(qh, vertex->point, facet, &dist);
+          if (dist >= -2 * qh->DISTround) {
+            qh->ZEROall_ok= False;
+            if (!qh->MERGEexact || dist > qh->DISTround)
+              goto LABELnonconvexhorizon;
+          }
+          break;
+        }
+      }
+    }
+  }
+  trace2((qh, qh->ferr, 2012, "qh_checkzero: testall %d, facets are %s\n", testall,
+        (qh->MERGEexact && !testall) ?
+           "not concave, flipped, or dupridge" : "clearly convex"));
+  return True;
+
+ LABELproblem:
+  qh->ZEROall_ok= False;
+  trace2((qh, qh->ferr, 2013, "qh_checkzero: qh_premerge is needed.  New facet f%d or its horizon f%d is non-simplicial, flipped, dupridge, or mergehorizon\n",
+       facet->id, horizon->id));
+  return False;
+
+ LABELnonconvex:
+  trace2((qh, qh->ferr, 2014, "qh_checkzero: facet f%d and f%d are not clearly convex.  v%d dist %.2g\n",
+         facet->id, neighbor->id, vertex->id, dist));
+  return False;
+
+ LABELnonconvexhorizon:
+  trace2((qh, qh->ferr, 2060, "qh_checkzero: facet f%d and horizon f%d are not clearly convex.  v%d dist %.2g\n",
+      facet->id, horizon->id, vertex->id, dist));
+  return False;
+} /* checkzero */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="compare_anglemerge">-</a>
+
+  qh_compare_anglemerge( mergeA, mergeB )
+    used by qsort() to order qh.facet_mergeset by mergetype and angle (qh.ANGLEmerge, 'Q1')
+    lower numbered mergetypes done first (MRGcoplanar before MRGconcave)
+
+  notes:
+    qh_all_merges processes qh.facet_mergeset by qh_setdellast
+    [mar'19] evaluated various options with eg/q_benchmark and merging of pinched vertices (Q14)
+*/
+int qh_compare_anglemerge(const void *p1, const void *p2) {
+  const mergeT *a= *((mergeT *const*)p1), *b= *((mergeT *const*)p2);
+
+  if (a->mergetype != b->mergetype)
+    return (a->mergetype < b->mergetype ? 1 : -1); /* select MRGcoplanar (1) before MRGconcave (3) */
+  else
+    return (a->angle > b->angle ? 1 : -1);         /* select coplanar merge (1.0) before sharp merge (-0.5) */
+} /* compare_anglemerge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="compare_facetmerge">-</a>
+
+  qh_compare_facetmerge( mergeA, mergeB )
+    used by qsort() to order merges by mergetype, first merge, first
+    lower numbered mergetypes done first (MRGcoplanar before MRGconcave)
+    if same merge type, flat merges are first
+
+  notes:
+    qh_all_merges processes qh.facet_mergeset by qh_setdellast
+    [mar'19] evaluated various options with eg/q_benchmark and merging of pinched vertices (Q14)
+*/
+int qh_compare_facetmerge(const void *p1, const void *p2) {
+  const mergeT *a= *((mergeT *const*)p1), *b= *((mergeT *const*)p2);
+
+  if (a->mergetype != b->mergetype)
+    return (a->mergetype < b->mergetype ? 1 : -1); /* select MRGcoplanar (1) before MRGconcave (3) */
+  else if (a->mergetype == MRGanglecoplanar)
+    return (a->angle > b->angle ? 1 : -1);         /* if MRGanglecoplanar, select coplanar merge (1.0) before sharp merge (-0.5) */
+  else
+    return (a->distance < b->distance ? 1 : -1);   /* select flat (0.0) merge before wide (1e-10) merge */
+} /* compare_facetmerge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="comparevisit">-</a>
+
+  qh_comparevisit( vertexA, vertexB )
+    used by qsort() to order vertices by their visitid
+
+  notes:
+    only called by qh_find_newvertex
+*/
+int qh_comparevisit(const void *p1, const void *p2) {
+  const vertexT *a= *((vertexT *const*)p1), *b= *((vertexT *const*)p2);
+
+  if (a->visitid > b->visitid)
+    return 1;
+  return -1;
+} /* comparevisit */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="copynonconvex">-</a>
+
+  qh_copynonconvex(qh, atridge )
+    set non-convex flag on other ridges (if any) between same neighbors
+
+  notes:
+    may be faster if use smaller ridge set
+
+  design:
+    for each ridge of atridge's top facet
+      if ridge shares the same neighbor
+        set nonconvex flag
+*/
+void qh_copynonconvex(qhT *qh, ridgeT *atridge) {
+  facetT *facet, *otherfacet;
+  ridgeT *ridge, **ridgep;
+
+  facet= atridge->top;
+  otherfacet= atridge->bottom;
+  atridge->nonconvex= False;
+  FOREACHridge_(facet->ridges) {
+    if (otherfacet == ridge->top || otherfacet == ridge->bottom) {
+      if (ridge != atridge) {
+        ridge->nonconvex= True;
+        trace4((qh, qh->ferr, 4020, "qh_copynonconvex: moved nonconvex flag from r%d to r%d between f%d and f%d\n",
+                atridge->id, ridge->id, facet->id, otherfacet->id));
+        break;
+      }
+    }
+  }
+} /* copynonconvex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="degen_redundant_facet">-</a>
+
+  qh_degen_redundant_facet(qh, facet )
+    check for a degenerate (too few neighbors) or redundant (subset of vertices) facet
+
+  notes:
+    called at end of qh_mergefacet, qh_renamevertex, and qh_reducevertices
+    bumps vertex_visit
+    called if a facet was redundant but no longer is (qh_merge_degenredundant)
+    qh_appendmergeset() only appends first reference to facet (i.e., redundant)
+    see: qh_test_redundant_neighbors, qh_maydropneighbor
+
+  design:
+    test for redundant neighbor
+    test for degenerate facet
+*/
+void qh_degen_redundant_facet(qhT *qh, facetT *facet) {
+  vertexT *vertex, **vertexp;
+  facetT *neighbor, **neighborp;
+
+  trace3((qh, qh->ferr, 3028, "qh_degen_redundant_facet: test facet f%d for degen/redundant\n",
+          facet->id));
+  if (facet->flipped) {
+    trace2((qh, qh->ferr, 3074, "qh_degen_redundant_facet: f%d is flipped, will merge later\n", facet->id));
+    return;
+  }
+  FOREACHneighbor_(facet) {
+    if (neighbor->flipped) /* disallow merge of non-flipped into flipped, neighbor will be merged later */
+      continue;
+    if (neighbor->visible) {
+      qh_fprintf(qh, qh->ferr, 6357, "qhull internal error (qh_degen_redundant_facet): facet f%d has deleted neighbor f%d (qh.visible_list)\n",
+        facet->id, neighbor->id);
+      qh_errexit2(qh, qh_ERRqhull, facet, neighbor);
+    }
+    qh->vertex_visit++;
+    FOREACHvertex_(neighbor->vertices)
+      vertex->visitid= qh->vertex_visit;
+    FOREACHvertex_(facet->vertices) {
+      if (vertex->visitid != qh->vertex_visit)
+        break;
+    }
+    if (!vertex) {
+      trace2((qh, qh->ferr, 2015, "qh_degen_redundant_facet: f%d is contained in f%d.  merge\n", facet->id, neighbor->id));
+      qh_appendmergeset(qh, facet, neighbor, MRGredundant, 0.0, 1.0);
+      return;
+    }
+  }
+  if (qh_setsize(qh, facet->neighbors) < qh->hull_dim) {
+    qh_appendmergeset(qh, facet, facet, MRGdegen, 0.0, 1.0);
+    trace2((qh, qh->ferr, 2016, "qh_degen_redundant_facet: f%d is degenerate.\n", facet->id));
+  }
+} /* degen_redundant_facet */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="delridge_merge">-</a>
+
+  qh_delridge_merge(qh, ridge )
+    delete ridge due to a merge
+
+  notes:
+    only called by merge_r.c (qh_mergeridges, qh_renameridgevertex)
+    ridges also freed in qh_freeqhull and qh_mergecycle_ridges
+
+  design:
+    if needed, moves ridge.nonconvex to another ridge
+    sets vertex.delridge for qh_reducevertices
+    deletes ridge from qh.vertex_mergeset
+    deletes ridge from its neighboring facets
+    frees up its memory
+*/
+void qh_delridge_merge(qhT *qh, ridgeT *ridge) {
+  vertexT *vertex, **vertexp;
+  mergeT *merge;
+  int merge_i, merge_n;
+
+  trace3((qh, qh->ferr, 3036, "qh_delridge_merge: delete ridge r%d between f%d and f%d\n",
+    ridge->id, ridge->top->id, ridge->bottom->id));
+  if (ridge->nonconvex)
+    qh_copynonconvex(qh, ridge);
+  FOREACHvertex_(ridge->vertices)
+    vertex->delridge= True;
+  FOREACHmerge_i_(qh, qh->vertex_mergeset) {
+    if (merge->ridge1 == ridge || merge->ridge2 == ridge) {
+      trace3((qh, qh->ferr, 3029, "qh_delridge_merge: drop merge of v%d into v%d (dist %2.2g r%d r%d) due to deleted, duplicated ridge r%d\n",
+        merge->vertex1->id, merge->vertex2->id, merge->distance, merge->ridge1->id, merge->ridge2->id, ridge->id));
+      if (merge->ridge1 == ridge)
+        merge->ridge2->mergevertex= False;
+      else
+        merge->ridge1->mergevertex= False;
+      qh_setdelnth(qh, qh->vertex_mergeset, merge_i);
+      merge_i--; merge_n--; /* next merge after deleted */
+    }
+  }
+  qh_setdel(ridge->top->ridges, ridge);
+  qh_setdel(ridge->bottom->ridges, ridge);
+  qh_delridge(qh, ridge);
+} /* delridge_merge */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="drop_mergevertex">-</a>
+
+  qh_drop_mergevertex(qh, merge )
+
+  clear mergevertex flags for ridges of a vertex merge
+*/
+void qh_drop_mergevertex(qhT *qh, mergeT *merge)
+{
+  if (merge->mergetype == MRGvertices) {
+    merge->ridge1->mergevertex= False;
+    merge->ridge1->mergevertex2= True;
+    merge->ridge2->mergevertex= False;
+    merge->ridge2->mergevertex2= True;
+    trace3((qh, qh->ferr, 3032, "qh_drop_mergevertex: unset mergevertex for r%d and r%d due to dropped vertex merge v%d to v%d.  Sets mergevertex2\n",
+      merge->ridge1->id, merge->ridge2->id, merge->vertex1->id, merge->vertex2->id));
+  }
+} /* drop_mergevertex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="find_newvertex">-</a>
+
+  qh_find_newvertex(qh, oldvertex, vertices, ridges )
+    locate new vertex for renaming old vertex
+    vertices is a set of possible new vertices
+      vertices sorted by number of deleted ridges
+
+  returns:
+    newvertex or NULL
+      each ridge includes both newvertex and oldvertex
+    vertices without oldvertex sorted by number of deleted ridges
+    qh.vertex_visit updated
+    sets v.seen
+
+  notes:
+    called by qh_redundant_vertex due to vertex->delridge and qh_rename_sharedvertex
+    sets vertex->visitid to 0..setsize() for vertices
+    new vertex is in one of the ridges
+    renaming will not cause a duplicate ridge
+    renaming will minimize the number of deleted ridges
+    newvertex may not be adjacent in the dual (though unlikely)
+
+  design:
+    for each vertex in vertices
+      set vertex->visitid to number of ridges
+    remove unvisited vertices
+    set qh.vertex_visit above all possible values
+    sort vertices by number of ridges (minimize ridges that need renaming
+    add each ridge to qh.hash_table
+    for each vertex in vertices
+      find the first vertex that would not cause a duplicate ridge after a rename
+*/
+vertexT *qh_find_newvertex(qhT *qh, vertexT *oldvertex, setT *vertices, setT *ridges) {
+  vertexT *vertex, **vertexp;
+  setT *newridges;
+  ridgeT *ridge, **ridgep;
+  int size, hashsize;
+  int hash;
+  unsigned int maxvisit;
+
+#ifndef qh_NOtrace
+  if (qh->IStracing >= 4) {
+    qh_fprintf(qh, qh->ferr, 8063, "qh_find_newvertex: find new vertex for v%d from ",
+             oldvertex->id);
+    FOREACHvertex_(vertices)
+      qh_fprintf(qh, qh->ferr, 8064, "v%d ", vertex->id);
+    FOREACHridge_(ridges)
+      qh_fprintf(qh, qh->ferr, 8065, "r%d ", ridge->id);
+    qh_fprintf(qh, qh->ferr, 8066, "\n");
+  }
+#endif
+  FOREACHridge_(ridges) {
+    FOREACHvertex_(ridge->vertices)
+      vertex->seen= False;
+  }
+  FOREACHvertex_(vertices) {
+    vertex->visitid= 0;  /* v.visitid will be number of ridges */
+    vertex->seen= True;
+  }
+  FOREACHridge_(ridges) {
+    FOREACHvertex_(ridge->vertices) {
+      if (vertex->seen)
+        vertex->visitid++;
+    }
+  }
+  FOREACHvertex_(vertices) {
+    if (!vertex->visitid) {
+      qh_setdelnth(qh, vertices, SETindex_(vertices,vertex));
+      vertexp--; /* repeat since deleted this vertex */
+    }
+  }
+  maxvisit= (unsigned int)qh_setsize(qh, ridges);
+  maximize_(qh->vertex_visit, maxvisit);
+  if (!qh_setsize(qh, vertices)) {
+    trace4((qh, qh->ferr, 4023, "qh_find_newvertex: vertices not in ridges for v%d\n",
+            oldvertex->id));
+    return NULL;
+  }
+  qsort(SETaddr_(vertices, vertexT), (size_t)qh_setsize(qh, vertices),
+                sizeof(vertexT *), qh_comparevisit);
+  /* can now use qh->vertex_visit */
+  if (qh->PRINTstatistics) {
+    size= qh_setsize(qh, vertices);
+    zinc_(Zintersect);
+    zadd_(Zintersecttot, size);
+    zmax_(Zintersectmax, size);
+  }
+  hashsize= qh_newhashtable(qh, qh_setsize(qh, ridges));
+  FOREACHridge_(ridges)
+    qh_hashridge(qh, qh->hash_table, hashsize, ridge, oldvertex);
+  FOREACHvertex_(vertices) {
+    newridges= qh_vertexridges(qh, vertex, !qh_ALL);
+    FOREACHridge_(newridges) {
+      if (qh_hashridge_find(qh, qh->hash_table, hashsize, ridge, vertex, oldvertex, &hash)) {
+        zinc_(Zvertexridge);
+        break;
+      }
+    }
+    qh_settempfree(qh, &newridges);
+    if (!ridge)
+      break;  /* found a rename */
+  }
+  if (vertex) {
+    /* counted in qh_renamevertex */
+    trace2((qh, qh->ferr, 2020, "qh_find_newvertex: found v%d for old v%d from %d vertices and %d ridges.\n",
+      vertex->id, oldvertex->id, qh_setsize(qh, vertices), qh_setsize(qh, ridges)));
+  }else {
+    zinc_(Zfindfail);
+    trace0((qh, qh->ferr, 14, "qh_find_newvertex: no vertex for renaming v%d (all duplicated ridges) during p%d\n",
+      oldvertex->id, qh->furthest_id));
+  }
+  qh_setfree(qh, &qh->hash_table);
+  return vertex;
+} /* find_newvertex */
+
+/*-<a                             href="qh-geom2_r.htm#TOC"
+  >-------------------------------</a><a name="findbest_pinchedvertex">-</a>
+
+  qh_findbest_pinchedvertex(qh, merge, apex, nearestp, distp )
+    Determine the best pinched vertex to rename as its nearest neighboring vertex
+    Renaming will remove a duplicate MRGdupridge in newfacet_list
+
+  returns:
+    pinched vertex (either apex or subridge), nearest vertex (subridge or neighbor vertex), and the distance between them
+
+  notes:
+    only called by qh_getpinchedmerges
+    assumes qh.VERTEXneighbors
+    see qh_findbest_ridgevertex
+
+  design:
+    if the facets have the same vertices
+      return the nearest vertex pair
+    else
+      the subridge is the intersection of the two new facets minus the apex
+      the subridge consists of qh.hull_dim-2 horizon vertices
+      the subridge is also a matched ridge for the new facets (its duplicate)
+      determine the nearest vertex to the apex
+      determine the nearest pair of subridge vertices
+      for each vertex in the subridge
+        determine the nearest neighbor vertex (not in the subridge)
+*/
+vertexT *qh_findbest_pinchedvertex(qhT *qh, mergeT *merge, vertexT *apex, vertexT **nearestp, coordT *distp /* qh.newfacet_list */) {
+  vertexT *vertex, **vertexp, *vertexA, **vertexAp;
+  vertexT *bestvertex= NULL, *bestpinched= NULL;
+  setT *subridge, *maybepinched;
+  coordT dist, bestdist= REALmax;
+  coordT pincheddist= (qh->ONEmerge+qh->DISTround)*qh_RATIOpinchedsubridge;
+
+  if (!merge->facet1->simplicial || !merge->facet2->simplicial) {
+    qh_fprintf(qh, qh->ferr, 6351, "qhull internal error (qh_findbest_pinchedvertex): expecting merge of adjacent, simplicial new facets.  f%d or f%d is not simplicial\n",
+      merge->facet1->id, merge->facet2->id);
+    qh_errexit2(qh, qh_ERRqhull, merge->facet1, merge->facet2);
+  }
+  subridge= qh_vertexintersect_new(qh, merge->facet1->vertices, merge->facet2->vertices); /* new setT.  No error_exit() */
+  if (qh_setsize(qh, subridge) == qh->hull_dim) { /* duplicate vertices */
+    bestdist= qh_vertex_bestdist2(qh, subridge, &bestvertex, &bestpinched);
+    if(bestvertex == apex) {
+      bestvertex= bestpinched;
+      bestpinched= apex;
+    }
+  }else {
+    qh_setdel(subridge, apex);
+    if (qh_setsize(qh, subridge) != qh->hull_dim - 2) {
+      qh_fprintf(qh, qh->ferr, 6409, "qhull internal error (qh_findbest_pinchedvertex): expecting subridge of qh.hull_dim-2 vertices for the intersection of new facets f%d and f%d minus their apex.  Got %d vertices\n",
+          merge->facet1->id, merge->facet2->id, qh_setsize(qh, subridge));
+      qh_errexit2(qh, qh_ERRqhull, merge->facet1, merge->facet2);
+    }
+    FOREACHvertex_(subridge) {
+      dist= qh_pointdist(vertex->point, apex->point, qh->hull_dim);
+      if (dist < bestdist) {
+        bestpinched= apex;
+        bestvertex= vertex;
+        bestdist= dist;
+      }
+    }
+    if (bestdist > pincheddist) {
+      FOREACHvertex_(subridge) {
+        FOREACHvertexA_(subridge) {
+          if (vertexA->id > vertex->id) { /* once per vertex pair, do not compare addresses */
+            dist= qh_pointdist(vertexA->point, vertex->point, qh->hull_dim);
+            if (dist < bestdist) {
+              bestpinched= vertexA;
+              bestvertex= vertex;
+              bestdist= dist;
+            }
+          }
+        }
+      }
+    }
+    if (bestdist > pincheddist) {
+      FOREACHvertexA_(subridge) {
+        maybepinched= qh_neighbor_vertices(qh, vertexA, subridge); /* subridge and apex tested above */
+        FOREACHvertex_(maybepinched) {
+          dist= qh_pointdist(vertex->point, vertexA->point, qh->hull_dim);
+          if (dist < bestdist) {
+            bestvertex= vertex;
+            bestpinched= vertexA;
+            bestdist= dist;
+          }
+        }
+        qh_settempfree(qh, &maybepinched);
+      }
+    }
+  }
+  *distp= bestdist;
+  qh_setfree(qh, &subridge); /* qh_err_exit not called since allocated */
+  if (!bestvertex) {  /* should never happen if qh.hull_dim > 2 */
+    qh_fprintf(qh, qh->ferr, 6274, "qhull internal error (qh_findbest_pinchedvertex): did not find best vertex for subridge of dupridge between f%d and f%d, while processing p%d\n", merge->facet1->id, merge->facet2->id, qh->furthest_id);
+    qh_errexit2(qh, qh_ERRqhull, merge->facet1, merge->facet2);
+  }
+  *nearestp= bestvertex;
+  trace2((qh, qh->ferr, 2061, "qh_findbest_pinchedvertex: best pinched p%d(v%d) and vertex p%d(v%d) are closest (%2.2g) for duplicate subridge between f%d and f%d\n",
+      qh_pointid(qh, bestpinched->point), bestpinched->id, qh_pointid(qh, bestvertex->point), bestvertex->id, bestdist, merge->facet1->id, merge->facet2->id));
+  return bestpinched;
+} /* findbest_pinchedvertex */
+
+/*-<a                             href="qh-geom2_r.htm#TOC"
+  >-------------------------------</a><a name="findbest_ridgevertex">-</a>
+
+  qh_findbest_ridgevertex(qh, ridge, pinchedp, distp )
+    Determine the best vertex/pinched-vertex to merge for ridges with the same vertices
+
+  returns:
+    vertex, pinched vertex, and the distance between them
+
+  notes:
+    assumes qh.hull_dim>=3
+    see qh_findbest_pinchedvertex
+
+*/
+vertexT *qh_findbest_ridgevertex(qhT *qh, ridgeT *ridge, vertexT **pinchedp, coordT *distp) {
+  vertexT *bestvertex;
+
+  *distp= qh_vertex_bestdist2(qh, ridge->vertices, &bestvertex, pinchedp);
+  trace4((qh, qh->ferr, 4069, "qh_findbest_ridgevertex: best pinched p%d(v%d) and vertex p%d(v%d) are closest (%2.2g) for duplicated ridge r%d (same vertices) between f%d and f%d\n",
+      qh_pointid(qh, (*pinchedp)->point), (*pinchedp)->id, qh_pointid(qh, bestvertex->point), bestvertex->id, *distp, ridge->id, ridge->top->id, ridge->bottom->id));
+  return bestvertex;
+} /* findbest_ridgevertex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="findbest_test">-</a>
+
+  qh_findbest_test(qh, testcentrum, facet, neighbor, &bestfacet, &dist, &mindist, &maxdist )
+    test neighbor of facet for qh_findbestneighbor()
+    if testcentrum,
+      tests centrum (assumes it is defined)
+    else
+      tests vertices
+    initially *bestfacet==NULL and *dist==REALmax
+
+  returns:
+    if a better facet (i.e., vertices/centrum of facet closer to neighbor)
+      updates bestfacet, dist, mindist, and maxdist
+
+  notes:
+    called by qh_findbestneighbor
+    ignores pairs of flipped facets, unless that's all there is
+*/
+void qh_findbest_test(qhT *qh, boolT testcentrum, facetT *facet, facetT *neighbor,
+      facetT **bestfacet, realT *distp, realT *mindistp, realT *maxdistp) {
+  realT dist, mindist, maxdist;
+
+  if (facet->flipped && neighbor->flipped && *bestfacet && !(*bestfacet)->flipped)
+    return; /* do not merge flipped into flipped facets */
+  if (testcentrum) {
+    zzinc_(Zbestdist);
+    qh_distplane(qh, facet->center, neighbor, &dist);
+    dist *= qh->hull_dim; /* estimate furthest vertex */
+    if (dist < 0) {
+      maxdist= 0;
+      mindist= dist;
+      dist= -dist;
+    }else {
+      mindist= 0;
+      maxdist= dist;
+    }
+  }else
+    dist= qh_getdistance(qh, facet, neighbor, &mindist, &maxdist);
+  if (dist < *distp) {
+    *bestfacet= neighbor;
+    *mindistp= mindist;
+    *maxdistp= maxdist;
+    *distp= dist;
+  }
+} /* findbest_test */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="findbestneighbor">-</a>
+
+  qh_findbestneighbor(qh, facet, dist, mindist, maxdist )
+    finds best neighbor (least dist) of a facet for merging
+
+  returns:
+    returns min and max distances and their max absolute value
+
+  notes:
+    error if qh_ASvoronoi
+    avoids merging old into new
+    assumes ridge->nonconvex only set on one ridge between a pair of facets
+    could use an early out predicate but not worth it
+
+  design:
+    if a large facet
+      will test centrum
+    else
+      will test vertices
+    if a large facet
+      test nonconvex neighbors for best merge
+    else
+      test all neighbors for the best merge
+    if testing centrum
+      get distance information
+*/
+facetT *qh_findbestneighbor(qhT *qh, facetT *facet, realT *distp, realT *mindistp, realT *maxdistp) {
+  facetT *neighbor, **neighborp, *bestfacet= NULL;
+  ridgeT *ridge, **ridgep;
+  boolT nonconvex= True, testcentrum= False;
+  int size= qh_setsize(qh, facet->vertices);
+
+  if(qh->CENTERtype==qh_ASvoronoi){
+    qh_fprintf(qh, qh->ferr, 6272, "qhull internal error: cannot call qh_findbestneighor for f%d while qh.CENTERtype is qh_ASvoronoi\n", facet->id);
+    qh_errexit(qh, qh_ERRqhull, facet, NULL);
+  }
+  *distp= REALmax;
+  if (size > qh_BESTcentrum2 * qh->hull_dim + qh_BESTcentrum) {
+    testcentrum= True;
+    zinc_(Zbestcentrum);
+    if (!facet->center)
+       facet->center= qh_getcentrum(qh, facet);
+  }
+  if (size > qh->hull_dim + qh_BESTnonconvex) {
+    FOREACHridge_(facet->ridges) {
+      if (ridge->nonconvex) {
+        neighbor= otherfacet_(ridge, facet);
+        qh_findbest_test(qh, testcentrum, facet, neighbor,
+                          &bestfacet, distp, mindistp, maxdistp);
+      }
+    }
+  }
+  if (!bestfacet) {
+    nonconvex= False;
+    FOREACHneighbor_(facet)
+      qh_findbest_test(qh, testcentrum, facet, neighbor,
+                        &bestfacet, distp, mindistp, maxdistp);
+  }
+  if (!bestfacet) {
+    qh_fprintf(qh, qh->ferr, 6095, "qhull internal error (qh_findbestneighbor): no neighbors for f%d\n", facet->id);
+    qh_errexit(qh, qh_ERRqhull, facet, NULL);
+  }
+  if (testcentrum)
+    qh_getdistance(qh, facet, bestfacet, mindistp, maxdistp);
+  trace3((qh, qh->ferr, 3002, "qh_findbestneighbor: f%d is best neighbor for f%d testcentrum? %d nonconvex? %d dist %2.2g min %2.2g max %2.2g\n",
+     bestfacet->id, facet->id, testcentrum, nonconvex, *distp, *mindistp, *maxdistp));
+  return(bestfacet);
+} /* findbestneighbor */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="flippedmerges">-</a>
+
+  qh_flippedmerges(qh, facetlist, wasmerge )
+    merge flipped facets into best neighbor
+    assumes qh.facet_mergeset at top of temporary stack
+
+  returns:
+    no flipped facets on facetlist
+    sets wasmerge if merge occurred
+    degen/redundant merges passed through
+
+  notes:
+    othermerges not needed since qh.facet_mergeset is empty before & after
+      keep it in case of change
+
+  design:
+    append flipped facets to qh.facetmergeset
+    for each flipped merge
+      find best neighbor
+      merge facet into neighbor
+      merge degenerate and redundant facets
+    remove flipped merges from qh.facet_mergeset
+*/
+void qh_flippedmerges(qhT *qh, facetT *facetlist, boolT *wasmerge) {
+  facetT *facet, *neighbor, *facet1;
+  realT dist, mindist, maxdist;
+  mergeT *merge, **mergep;
+  setT *othermerges;
+  int nummerge= 0, numdegen= 0;
+
+  trace4((qh, qh->ferr, 4024, "qh_flippedmerges: begin\n"));
+  FORALLfacet_(facetlist) {
+    if (facet->flipped && !facet->visible)
+      qh_appendmergeset(qh, facet, facet, MRGflip, 0.0, 1.0);
+  }
+  othermerges= qh_settemppop(qh);
+  if(othermerges != qh->facet_mergeset) {
+    qh_fprintf(qh, qh->ferr, 6392, "qhull internal error (qh_flippedmerges): facet_mergeset (%d merges) not at top of tempstack (%d merges)\n",
+        qh_setsize(qh, qh->facet_mergeset), qh_setsize(qh, othermerges));
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh->facet_mergeset= qh_settemp(qh, qh->TEMPsize);
+  qh_settemppush(qh, othermerges);
+  FOREACHmerge_(othermerges) {
+    facet1= merge->facet1;
+    if (merge->mergetype != MRGflip || facet1->visible)
+      continue;
+    if (qh->TRACEmerge-1 == zzval_(Ztotmerge))
+      qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+    neighbor= qh_findbestneighbor(qh, facet1, &dist, &mindist, &maxdist);
+    trace0((qh, qh->ferr, 15, "qh_flippedmerges: merge flipped f%d into f%d dist %2.2g during p%d\n",
+      facet1->id, neighbor->id, dist, qh->furthest_id));
+    qh_mergefacet(qh, facet1, neighbor, merge->mergetype, &mindist, &maxdist, !qh_MERGEapex);
+    nummerge++;
+    if (qh->PRINTstatistics) {
+      zinc_(Zflipped);
+      wadd_(Wflippedtot, dist);
+      wmax_(Wflippedmax, dist);
+    }
+  }
+  FOREACHmerge_(othermerges) {
+    if (merge->facet1->visible || merge->facet2->visible)
+      qh_memfree(qh, merge, (int)sizeof(mergeT)); /* invalidates merge and othermerges */
+    else
+      qh_setappend(qh, &qh->facet_mergeset, merge);
+  }
+  qh_settempfree(qh, &othermerges);
+  numdegen += qh_merge_degenredundant(qh); /* somewhat better here than after each flipped merge -- qtest.sh 10 '500 C1,2e-13 D4' 'd Qbb' */
+  if (nummerge)
+    *wasmerge= True;
+  trace1((qh, qh->ferr, 1010, "qh_flippedmerges: merged %d flipped and %d degenredundant facets into a good neighbor\n",
+    nummerge, numdegen));
+} /* flippedmerges */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="forcedmerges">-</a>
+
+  qh_forcedmerges(qh, wasmerge )
+    merge dupridges
+    calls qh_check_dupridge to report an error on wide merges
+    assumes qh_settemppop is qh.facet_mergeset
+
+  returns:
+    removes all dupridges on facet_mergeset
+    wasmerge set if merge
+    qh.facet_mergeset may include non-forced merges(none for now)
+    qh.degen_mergeset includes degen/redun merges
+
+  notes:
+    called by qh_premerge
+    dupridges occur when the horizon is pinched,
+        i.e. a subridge occurs in more than two horizon ridges.
+     could rename vertices that pinch the horizon
+    assumes qh_merge_degenredundant() has not be called
+    othermerges isn't needed since facet_mergeset is empty afterwards
+      keep it in case of change
+
+  design:
+    for each dupridge
+      find current facets by chasing f.replace links
+      check for wide merge due to dupridge
+      determine best direction for facet
+      merge one facet into the other
+      remove dupridges from qh.facet_mergeset
+*/
+void qh_forcedmerges(qhT *qh, boolT *wasmerge) {
+  facetT *facet1, *facet2, *merging, *merged, *newfacet;
+  mergeT *merge, **mergep;
+  realT dist, mindist, maxdist, dist2, mindist2, maxdist2;
+  setT *othermerges;
+  int nummerge=0, numflip=0, numdegen= 0;
+  boolT wasdupridge= False;
+
+  if (qh->TRACEmerge-1 == zzval_(Ztotmerge))
+    qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+  trace3((qh, qh->ferr, 3054, "qh_forcedmerges: merge dupridges\n"));
+  othermerges= qh_settemppop(qh); /* was facet_mergeset */
+  if (qh->facet_mergeset != othermerges ) {
+      qh_fprintf(qh, qh->ferr, 6279, "qhull internal error (qh_forcedmerges): qh_settemppop (size %d) is not qh->facet_mergeset (size %d)\n",
+          qh_setsize(qh, othermerges), qh_setsize(qh, qh->facet_mergeset));
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh->facet_mergeset= qh_settemp(qh, qh->TEMPsize);
+  qh_settemppush(qh, othermerges);
+  FOREACHmerge_(othermerges) {
+    if (merge->mergetype != MRGdupridge)
+        continue;
+    wasdupridge= True;
+    if (qh->TRACEmerge-1 == zzval_(Ztotmerge))
+        qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+    facet1= qh_getreplacement(qh, merge->facet1);  /* must exist, no qh_merge_degenredunant */
+    facet2= qh_getreplacement(qh, merge->facet2);  /* previously merged facet, if any */
+    if (facet1 == facet2)
+      continue;
+    if (!qh_setin(facet2->neighbors, facet1)) {
+      qh_fprintf(qh, qh->ferr, 6096, "qhull internal error (qh_forcedmerges): f%d and f%d had a dupridge but as f%d and f%d they are no longer neighbors\n",
+               merge->facet1->id, merge->facet2->id, facet1->id, facet2->id);
+      qh_errexit2(qh, qh_ERRqhull, facet1, facet2);
+    }
+    dist= qh_getdistance(qh, facet1, facet2, &mindist, &maxdist);
+    dist2= qh_getdistance(qh, facet2, facet1, &mindist2, &maxdist2);
+    qh_check_dupridge(qh, facet1, dist, facet2, dist2);
+    if (dist < dist2) {
+      if (facet2->flipped && !facet1->flipped && dist2 < qh_WIDEdupridge*(qh->ONEmerge+qh->DISTround)) { /* prefer merge of flipped facet */
+        merging= facet2;
+        merged= facet1;
+        dist= dist2;
+        mindist= mindist2;
+        maxdist= maxdist2;
+      }else {
+        merging= facet1;
+        merged= facet2;
+      }
+    }else {
+      if (facet1->flipped && !facet2->flipped && dist < qh_WIDEdupridge*(qh->ONEmerge+qh->DISTround)) { /* prefer merge of flipped facet */
+        merging= facet1;
+        merged= facet2;
+      }else {
+        merging= facet2;
+        merged= facet1;
+        dist= dist2;
+        mindist= mindist2;
+        maxdist= maxdist2;
+      }
+    }
+    qh_mergefacet(qh, merging, merged, merge->mergetype, &mindist, &maxdist, !qh_MERGEapex);
+    numdegen += qh_merge_degenredundant(qh); /* better here than at end -- qtest.sh 10 '500 C1,2e-13 D4' 'd Qbb' */
+    if (facet1->flipped) {
+      zinc_(Zmergeflipdup);
+      numflip++;
+    }else
+      nummerge++;
+    if (qh->PRINTstatistics) {
+      zinc_(Zduplicate);
+      wadd_(Wduplicatetot, dist);
+      wmax_(Wduplicatemax, dist);
+    }
+  }
+  FOREACHmerge_(othermerges) {
+    if (merge->mergetype == MRGdupridge)
+      qh_memfree(qh, merge, (int)sizeof(mergeT)); /* invalidates merge and othermerges */
+    else
+      qh_setappend(qh, &qh->facet_mergeset, merge);
+  }
+  qh_settempfree(qh, &othermerges);
+  if (wasdupridge) {
+    FORALLnew_facets {
+      if (newfacet->dupridge) {
+        newfacet->dupridge= False;
+        newfacet->mergeridge= False;
+        newfacet->mergeridge2= False;
+        if (qh_setsize(qh, newfacet->neighbors) < qh->hull_dim) { /* not tested for MRGdupridge */
+          qh_appendmergeset(qh, newfacet, newfacet, MRGdegen, 0.0, 1.0);
+          trace2((qh, qh->ferr, 2107, "qh_forcedmerges: dupridge f%d is degenerate with fewer than %d neighbors\n",
+                      newfacet->id, qh->hull_dim));
+        }
+      }
+    }
+    numdegen += qh_merge_degenredundant(qh);
+  }
+  if (nummerge || numflip) {
+    *wasmerge= True;
+    trace1((qh, qh->ferr, 1011, "qh_forcedmerges: merged %d facets, %d flipped facets, and %d degenredundant facets across dupridges\n",
+                  nummerge, numflip, numdegen));
+  }
+} /* forcedmerges */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="freemergesets">-</a>
+
+  qh_freemergesets(qh )
+    free the merge sets
+
+  notes:
+    matches qh_initmergesets
+*/
+void qh_freemergesets(qhT *qh) {
+
+  if (!qh->facet_mergeset || !qh->degen_mergeset || !qh->vertex_mergeset) {
+    qh_fprintf(qh, qh->ferr, 6388, "qhull internal error (qh_freemergesets): expecting mergesets.  Got a NULL mergeset, qh.facet_mergeset (0x%x), qh.degen_mergeset (0x%x), qh.vertex_mergeset (0x%x)\n",
+      qh->facet_mergeset, qh->degen_mergeset, qh->vertex_mergeset);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (!SETempty_(qh->facet_mergeset) || !SETempty_(qh->degen_mergeset) || !SETempty_(qh->vertex_mergeset)) {
+    qh_fprintf(qh, qh->ferr, 6389, "qhull internal error (qh_freemergesets): expecting empty mergesets.  Got qh.facet_mergeset (%d merges), qh.degen_mergeset (%d merges), qh.vertex_mergeset (%d merges)\n",
+      qh_setsize(qh, qh->facet_mergeset), qh_setsize(qh, qh->degen_mergeset), qh_setsize(qh, qh->vertex_mergeset));
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh_settempfree(qh, &qh->facet_mergeset);
+  qh_settempfree(qh, &qh->vertex_mergeset);
+  qh_settempfree(qh, &qh->degen_mergeset);
+} /* freemergesets */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="getmergeset">-</a>
+
+  qh_getmergeset(qh, facetlist )
+    determines nonconvex facets on facetlist
+    tests !tested ridges and nonconvex ridges of !tested facets
+
+  returns:
+    returns sorted qh.facet_mergeset of facet-neighbor pairs to be merged
+    all ridges tested
+
+  notes:
+    facetlist is qh.facet_newlist, use qh_getmergeset_initial for all facets
+    assumes no nonconvex ridges with both facets tested
+    uses facet->tested/ridge->tested to prevent duplicate tests
+    can not limit tests to modified ridges since the centrum changed
+    uses qh.visit_id
+
+  design:
+    for each facet on facetlist
+      for each ridge of facet
+        if untested ridge
+          test ridge for convexity
+          if non-convex
+            append ridge to qh.facet_mergeset
+    sort qh.facet_mergeset by mergetype and angle or distance
+*/
+void qh_getmergeset(qhT *qh, facetT *facetlist) {
+  facetT *facet, *neighbor, **neighborp;
+  ridgeT *ridge, **ridgep;
+  int nummerges;
+  boolT simplicial;
+
+  nummerges= qh_setsize(qh, qh->facet_mergeset);
+  trace4((qh, qh->ferr, 4026, "qh_getmergeset: started.\n"));
+  qh->visit_id++;
+  FORALLfacet_(facetlist) {
+    if (facet->tested)
+      continue;
+    facet->visitid= qh->visit_id;
+    FOREACHneighbor_(facet)
+      neighbor->seen= False;
+    /* facet must be non-simplicial due to merge to qh.facet_newlist */
+    FOREACHridge_(facet->ridges) {
+      if (ridge->tested && !ridge->nonconvex)
+        continue;
+      /* if r.tested & r.nonconvex, need to retest and append merge */
+      neighbor= otherfacet_(ridge, facet);
+      if (neighbor->seen) { /* another ridge for this facet-neighbor pair was already tested in this loop */
+        ridge->tested= True;
+        ridge->nonconvex= False;   /* only one ridge is marked nonconvex per facet-neighbor pair */
+      }else if (neighbor->visitid != qh->visit_id) {
+        neighbor->seen= True;
+        ridge->nonconvex= False;
+        simplicial= False;
+        if (ridge->simplicialbot && ridge->simplicialtop)
+          simplicial= True;
+        if (qh_test_appendmerge(qh, facet, neighbor, simplicial))
+          ridge->nonconvex= True;
+        ridge->tested= True;
+      }
+    }
+    facet->tested= True;
+  }
+  nummerges= qh_setsize(qh, qh->facet_mergeset);
+  if (qh->ANGLEmerge)
+    qsort(SETaddr_(qh->facet_mergeset, mergeT), (size_t)nummerges, sizeof(mergeT *), qh_compare_anglemerge);
+  else
+    qsort(SETaddr_(qh->facet_mergeset, mergeT), (size_t)nummerges, sizeof(mergeT *), qh_compare_facetmerge);
+  nummerges += qh_setsize(qh, qh->degen_mergeset);
+  if (qh->POSTmerging) {
+    zadd_(Zmergesettot2, nummerges);
+  }else {
+    zadd_(Zmergesettot, nummerges);
+    zmax_(Zmergesetmax, nummerges);
+  }
+  trace2((qh, qh->ferr, 2021, "qh_getmergeset: %d merges found\n", nummerges));
+} /* getmergeset */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="getmergeset_initial">-</a>
+
+  qh_getmergeset_initial(qh, facetlist )
+    determine initial qh.facet_mergeset for facets
+    tests all facet/neighbor pairs on facetlist
+
+  returns:
+    sorted qh.facet_mergeset with nonconvex ridges
+    sets facet->tested, ridge->tested, and ridge->nonconvex
+
+  notes:
+    uses visit_id, assumes ridge->nonconvex is False
+    see qh_getmergeset
+
+  design:
+    for each facet on facetlist
+      for each untested neighbor of facet
+        test facet and neighbor for convexity
+        if non-convex
+          append merge to qh.facet_mergeset
+          mark one of the ridges as nonconvex
+    sort qh.facet_mergeset by mergetype and angle or distance
+*/
+void qh_getmergeset_initial(qhT *qh, facetT *facetlist) {
+  facetT *facet, *neighbor, **neighborp;
+  ridgeT *ridge, **ridgep;
+  int nummerges;
+  boolT simplicial;
+
+  qh->visit_id++;
+  FORALLfacet_(facetlist) {
+    facet->visitid= qh->visit_id;
+    FOREACHneighbor_(facet) {
+      if (neighbor->visitid != qh->visit_id) {
+        simplicial= False; /* ignores r.simplicialtop/simplicialbot.  Need to test horizon facets */
+        if (facet->simplicial && neighbor->simplicial)
+          simplicial= True;
+        if (qh_test_appendmerge(qh, facet, neighbor, simplicial)) {
+          FOREACHridge_(neighbor->ridges) {
+            if (facet == otherfacet_(ridge, neighbor)) {
+              ridge->nonconvex= True;
+              break;    /* only one ridge is marked nonconvex */
+            }
+          }
+        }
+      }
+    }
+    facet->tested= True;
+    FOREACHridge_(facet->ridges)
+      ridge->tested= True;
+  }
+  nummerges= qh_setsize(qh, qh->facet_mergeset);
+  if (qh->ANGLEmerge)
+    qsort(SETaddr_(qh->facet_mergeset, mergeT), (size_t)nummerges, sizeof(mergeT *), qh_compare_anglemerge);
+  else
+    qsort(SETaddr_(qh->facet_mergeset, mergeT), (size_t)nummerges, sizeof(mergeT *), qh_compare_facetmerge);
+  nummerges += qh_setsize(qh, qh->degen_mergeset);
+  if (qh->POSTmerging) {
+    zadd_(Zmergeinittot2, nummerges);
+  }else {
+    zadd_(Zmergeinittot, nummerges);
+    zmax_(Zmergeinitmax, nummerges);
+  }
+  trace2((qh, qh->ferr, 2022, "qh_getmergeset_initial: %d merges found\n", nummerges));
+} /* getmergeset_initial */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="getpinchedmerges">-</a>
+
+  qh_getpinchedmerges(qh, apex, maxdist, iscoplanar )
+    get pinched merges for dupridges in qh.facet_mergeset
+    qh.NEWtentative==True
+      qh.newfacet_list with apex
+      qh.horizon_list is attached to qh.visible_list instead of qh.newfacet_list
+      maxdist for vertex-facet of a dupridge
+    qh.facet_mergeset is empty
+    qh.vertex_mergeset is a temporary set
+
+  returns:
+    False if nearest vertex would increase facet width by more than maxdist or qh_WIDEpinched
+    True and iscoplanar, if the pinched vertex is the apex (i.e., make the apex a coplanar point)
+    True and !iscoplanar, if should merge a pinched vertex of a dupridge
+      qh.vertex_mergeset contains one or more MRGsubridge with a pinched vertex and a nearby, neighboring vertex
+    qh.facet_mergeset is empty
+
+  notes:
+    called by qh_buildcone_mergepinched
+    hull_dim >= 3
+    a pinched vertex is in a dupridge and the horizon
+    selects the pinched vertex that is closest to its neighbor
+
+  design:
+    for each dupridge
+        determine the best pinched vertex to be merged into a neighboring vertex
+        if merging the pinched vertex would produce a wide merge (qh_WIDEpinched)
+           ignore pinched vertex with a warning, and use qh_merge_degenredundant instead
+        else
+           append the pinched vertex to vertex_mergeset for merging
+*/
+boolT qh_getpinchedmerges(qhT *qh, vertexT *apex, coordT maxdupdist, boolT *iscoplanar /* qh.newfacet_list, qh.vertex_mergeset */) {
+  mergeT *merge, **mergep, *bestmerge= NULL;
+  vertexT *nearest, *pinched, *bestvertex= NULL, *bestpinched= NULL;
+  boolT result;
+  coordT dist, prevdist, bestdist= REALmax/(qh_RATIOcoplanarapex+1.0); /* allow *3.0 */
+  realT ratio;
+
+  trace2((qh, qh->ferr, 2062, "qh_getpinchedmerges: try to merge pinched vertices for dupridges in new facets with apex p%d(v%d) max dupdist %2.2g\n",
+      qh_pointid(qh, apex->point), apex->id, maxdupdist));
+  *iscoplanar= False;
+  prevdist= fmax_(qh->ONEmerge + qh->DISTround, qh->MINoutside + qh->DISTround);
+  maximize_(prevdist, qh->max_outside);
+  maximize_(prevdist, -qh->min_vertex);
+  qh_mark_dupridges(qh, qh->newfacet_list, !qh_ALL); /* qh.facet_mergeset, creates ridges */
+  /* qh_mark_dupridges is called a second time in qh_premerge */
+  FOREACHmerge_(qh->facet_mergeset) {  /* read-only */
+    if (merge->mergetype != MRGdupridge) {
+      qh_fprintf(qh, qh->ferr, 6393, "qhull internal error (qh_getpinchedmerges): expecting MRGdupridge from qh_mark_dupridges.  Got merge f%d f%d type %d\n",
+        getid_(merge->facet1), getid_(merge->facet2), merge->mergetype);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+    /* dist is distance between vertices */
+    pinched= qh_findbest_pinchedvertex(qh, merge, apex, &nearest, &dist /* qh.newfacet_list */);
+    if (pinched == apex && dist < qh_RATIOcoplanarapex*bestdist) { /* prefer coplanar apex since it always works */
+      bestdist= dist/qh_RATIOcoplanarapex;
+      bestmerge= merge;
+      bestpinched= pinched;
+      bestvertex= nearest;
+    }else if (dist < bestdist) {
+      bestdist= dist;
+      bestmerge= merge;
+      bestpinched= pinched;
+      bestvertex= nearest;
+    }
+  }
+  result= False;
+  if (bestmerge && bestdist < maxdupdist) {
+    ratio= bestdist / prevdist;
+    if (ratio > qh_WIDEpinched) {
+      if (bestmerge->facet1->mergehorizon || bestmerge->facet2->mergehorizon) { /* e.g., rbox 175 C3,2e-13 t1539182828 | qhull d */
+        trace1((qh, qh->ferr, 1051, "qh_getpinchedmerges: dupridge (MRGdupridge) of coplanar horizon would produce a wide merge (%.0fx) due to pinched vertices v%d and v%d (dist %2.2g) for f%d and f%d.  qh_mergecycle_all will merge one or both facets\n",
+          ratio, bestpinched->id, bestvertex->id, bestdist, bestmerge->facet1->id, bestmerge->facet2->id));
+      }else {
+        qh_fprintf(qh, qh->ferr, 7081, "qhull precision warning (qh_getpinchedmerges): pinched vertices v%d and v%d (dist %2.2g, %.0fx) would produce a wide merge for f%d and f%d.  Will merge dupridge instead\n",
+          bestpinched->id, bestvertex->id, bestdist, ratio, bestmerge->facet1->id, bestmerge->facet2->id);
+      }
+    }else {
+      if (bestpinched == apex) {
+        trace2((qh, qh->ferr, 2063, "qh_getpinchedmerges: will make the apex a coplanar point.  apex p%d(v%d) is the nearest vertex to v%d on dupridge.  Dist %2.2g\n",
+          qh_pointid(qh, apex->point), apex->id, bestvertex->id, bestdist*qh_RATIOcoplanarapex));
+        qh->coplanar_apex= apex->point;
+        *iscoplanar= True;
+        result= True;
+      }else if (qh_setin(bestmerge->facet1->vertices, bestpinched) != qh_setin(bestmerge->facet2->vertices, bestpinched)) { /* pinched in one facet but not the other facet */
+        trace2((qh, qh->ferr, 2064, "qh_getpinchedmerges: will merge new facets to resolve dupridge between f%d and f%d with pinched v%d and v%d\n",
+          bestmerge->facet1->id, bestmerge->facet2->id, bestpinched->id, bestvertex->id));
+        qh_appendvertexmerge(qh, bestpinched, bestvertex, MRGsubridge, bestdist, NULL, NULL);
+        result= True;
+      }else {
+        trace2((qh, qh->ferr, 2065, "qh_getpinchedmerges: will merge pinched v%d into v%d to resolve dupridge between f%d and f%d\n",
+          bestpinched->id, bestvertex->id, bestmerge->facet1->id, bestmerge->facet2->id));
+        qh_appendvertexmerge(qh, bestpinched, bestvertex, MRGsubridge, bestdist, NULL, NULL);
+        result= True;
+      }
+    }
+  }
+  /* delete MRGdupridge, qh_mark_dupridges is called a second time in qh_premerge */
+  while ((merge= (mergeT *)qh_setdellast(qh->facet_mergeset)))
+    qh_memfree(qh, merge, (int)sizeof(mergeT));
+  return result;
+}/* getpinchedmerges */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="hasmerge">-</a>
+
+  qh_hasmerge( mergeset, mergetype, facetA, facetB )
+    True if mergeset has mergetype for facetA and facetB
+*/
+boolT   qh_hasmerge(setT *mergeset, mergeType type, facetT *facetA, facetT *facetB) {
+  mergeT *merge, **mergep;
+
+  FOREACHmerge_(mergeset) {
+    if (merge->mergetype == type) {
+      if (merge->facet1 == facetA && merge->facet2 == facetB)
+        return True;
+      if (merge->facet1 == facetB && merge->facet2 == facetA)
+        return True;
+    }
+  }
+  return False;
+}/* hasmerge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="hashridge">-</a>
+
+  qh_hashridge(qh, hashtable, hashsize, ridge, oldvertex )
+    add ridge to hashtable without oldvertex
+
+  notes:
+    assumes hashtable is large enough
+
+  design:
+    determine hash value for ridge without oldvertex
+    find next empty slot for ridge
+*/
+void qh_hashridge(qhT *qh, setT *hashtable, int hashsize, ridgeT *ridge, vertexT *oldvertex) {
+  int hash;
+  ridgeT *ridgeA;
+
+  hash= qh_gethash(qh, hashsize, ridge->vertices, qh->hull_dim-1, 0, oldvertex);
+  while (True) {
+    if (!(ridgeA= SETelemt_(hashtable, hash, ridgeT))) {
+      SETelem_(hashtable, hash)= ridge;
+      break;
+    }else if (ridgeA == ridge)
+      break;
+    if (++hash == hashsize)
+      hash= 0;
+  }
+} /* hashridge */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="hashridge_find">-</a>
+
+  qh_hashridge_find(qh, hashtable, hashsize, ridge, vertex, oldvertex, hashslot )
+    returns matching ridge without oldvertex in hashtable
+      for ridge without vertex
+    if oldvertex is NULL
+      matches with any one skip
+
+  returns:
+    matching ridge or NULL
+    if no match,
+      if ridge already in   table
+        hashslot= -1
+      else
+        hashslot= next NULL index
+
+  notes:
+    assumes hashtable is large enough
+    can't match ridge to itself
+
+  design:
+    get hash value for ridge without vertex
+    for each hashslot
+      return match if ridge matches ridgeA without oldvertex
+*/
+ridgeT *qh_hashridge_find(qhT *qh, setT *hashtable, int hashsize, ridgeT *ridge,
+              vertexT *vertex, vertexT *oldvertex, int *hashslot) {
+  int hash;
+  ridgeT *ridgeA;
+
+  *hashslot= 0;
+  zinc_(Zhashridge);
+  hash= qh_gethash(qh, hashsize, ridge->vertices, qh->hull_dim-1, 0, vertex);
+  while ((ridgeA= SETelemt_(hashtable, hash, ridgeT))) {
+    if (ridgeA == ridge)
+      *hashslot= -1;
+    else {
+      zinc_(Zhashridgetest);
+      if (qh_setequal_except(ridge->vertices, vertex, ridgeA->vertices, oldvertex))
+        return ridgeA;
+    }
+    if (++hash == hashsize)
+      hash= 0;
+  }
+  if (!*hashslot)
+    *hashslot= hash;
+  return NULL;
+} /* hashridge_find */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="initmergesets">-</a>
+
+  qh_initmergesets(qh )
+    initialize the merge sets
+    if 'all', include qh.degen_mergeset
+
+  notes:
+    matches qh_freemergesets
+*/
+void qh_initmergesets(qhT *qh /* qh.facet_mergeset,degen_mergeset,vertex_mergeset */) {
+
+  if (qh->facet_mergeset || qh->degen_mergeset || qh->vertex_mergeset) {
+    qh_fprintf(qh, qh->ferr, 6386, "qhull internal error (qh_initmergesets): expecting NULL mergesets.  Got qh.facet_mergeset (0x%x), qh.degen_mergeset (0x%x), qh.vertex_mergeset (0x%x)\n",
+      qh->facet_mergeset, qh->degen_mergeset, qh->vertex_mergeset);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh->degen_mergeset= qh_settemp(qh, qh->TEMPsize);
+  qh->vertex_mergeset= qh_settemp(qh, qh->TEMPsize);
+  qh->facet_mergeset= qh_settemp(qh, qh->TEMPsize); /* last temporary set for qh_forcedmerges */
+} /* initmergesets */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="makeridges">-</a>
+
+  qh_makeridges(qh, facet )
+    creates explicit ridges between simplicial facets
+
+  returns:
+    facet with ridges and without qh_MERGEridge
+    ->simplicial is False
+    if facet was tested, new ridges are tested
+
+  notes:
+    allows qh_MERGEridge flag
+    uses existing ridges
+    duplicate neighbors ok if ridges already exist (qh_mergecycle_ridges)
+
+  see:
+    qh_mergecycle_ridges()
+    qh_rename_adjacentvertex for qh_merge_pinchedvertices
+
+  design:
+    look for qh_MERGEridge neighbors
+    mark neighbors that already have ridges
+    for each unprocessed neighbor of facet
+      create a ridge for neighbor and facet
+    if any qh_MERGEridge neighbors
+      delete qh_MERGEridge flags (previously processed by qh_mark_dupridges)
+*/
+void qh_makeridges(qhT *qh, facetT *facet) {
+  facetT *neighbor, **neighborp;
+  ridgeT *ridge, **ridgep;
+  int neighbor_i, neighbor_n;
+  boolT toporient, mergeridge= False;
+
+  if (!facet->simplicial)
+    return;
+  trace4((qh, qh->ferr, 4027, "qh_makeridges: make ridges for f%d\n", facet->id));
+  facet->simplicial= False;
+  FOREACHneighbor_(facet) {
+    if (neighbor == qh_MERGEridge)
+      mergeridge= True;
+    else
+      neighbor->seen= False;
+  }
+  FOREACHridge_(facet->ridges)
+    otherfacet_(ridge, facet)->seen= True;
+  FOREACHneighbor_i_(qh, facet) {
+    if (neighbor == qh_MERGEridge)
+      continue;  /* fixed by qh_mark_dupridges */
+    else if (!neighbor->seen) {  /* no current ridges */
+      ridge= qh_newridge(qh);
+      ridge->vertices= qh_setnew_delnthsorted(qh, facet->vertices, qh->hull_dim,
+                                                          neighbor_i, 0);
+      toporient= (boolT)(facet->toporient ^ (neighbor_i & 0x1));
+      if (toporient) {
+        ridge->top= facet;
+        ridge->bottom= neighbor;
+        ridge->simplicialtop= True;
+        ridge->simplicialbot= neighbor->simplicial;
+      }else {
+        ridge->top= neighbor;
+        ridge->bottom= facet;
+        ridge->simplicialtop= neighbor->simplicial;
+        ridge->simplicialbot= True;
+      }
+      if (facet->tested && !mergeridge)
+        ridge->tested= True;
+#if 0 /* this also works */
+      flip= (facet->toporient ^ neighbor->toporient)^(skip1 & 0x1) ^ (skip2 & 0x1);
+      if (facet->toporient ^ (skip1 & 0x1) ^ flip) {
+        ridge->top= neighbor;
+        ridge->bottom= facet;
+        ridge->simplicialtop= True;
+        ridge->simplicialbot= neighbor->simplicial;
+      }else {
+        ridge->top= facet;
+        ridge->bottom= neighbor;
+        ridge->simplicialtop= neighbor->simplicial;
+        ridge->simplicialbot= True;
+      }
+#endif
+      qh_setappend(qh, &(facet->ridges), ridge);
+      trace5((qh, qh->ferr, 5005, "makeridges: appended r%d to ridges for f%d.  Next is ridges for neighbor f%d\n",
+            ridge->id, facet->id, neighbor->id));
+      qh_setappend(qh, &(neighbor->ridges), ridge);
+      if (qh->ridge_id == qh->traceridge_id)
+        qh->traceridge= ridge;
+    }
+  }
+  if (mergeridge) {
+    while (qh_setdel(facet->neighbors, qh_MERGEridge))
+      ; /* delete each one */
+  }
+} /* makeridges */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mark_dupridges">-</a>
+
+  qh_mark_dupridges(qh, facetlist, allmerges )
+    add duplicated ridges to qh.facet_mergeset
+    facet-dupridge is true if it contains a subridge shared by more than one new facet
+    for each such facet, one has a neighbor marked qh_MERGEridge
+    allmerges is true if merging dupridges
+    allmerges is false if merging pinched vertices followed by retry addpoint
+      qh_mark_dupridges will be called again if pinched vertices not found
+
+  returns:
+    dupridges on qh.facet_mergeset (MRGdupridge)
+    f.mergeridge and f.mergeridge2 set for facet
+    f.mergeridge set for neighbor
+    if allmerges is true
+      make ridges for facets with dupridges as marked by qh_MERGEridge and both sides facet->dupridge
+      removes qh_MERGEridge from neighbor sets
+
+  notes:
+    called by qh_premerge and qh_getpinchedmerges
+    dupridges are due to duplicate subridges
+        i.e. a subridge occurs in more than two horizon ridges.
+        i.e., a ridge has more than two neighboring facets
+    dupridges occur in at least two cases
+    1) a pinched horizon with nearly adjacent vertices -> merge the vertices (qh_getpinchedmerges)
+    2) more than one newfacet for a horizon face -> merge coplanar facets (qh_premerge)
+    qh_matchdupridge previously identified the furthest apart pair of facets to retain
+       they must have a matching subridge and the same orientation
+    only way to set facet->mergeridge and mergeridge2
+    uses qh.visit_id
+
+  design:
+    for all facets on facetlist
+      if facet contains a dupridge
+        for each neighbor of facet
+          if neighbor marked qh_MERGEridge (one side of the merge)
+            set facet->mergeridge
+          else
+            if neighbor contains a dupridge
+            and the back link is qh_MERGEridge
+              append dupridge to qh.facet_mergeset
+   exit if !allmerges for repeating qh_mark_dupridges later
+   for each dupridge
+     make ridge sets in preparation for merging
+     remove qh_MERGEridge from neighbor set
+   for each dupridge
+     restore the missing neighbor from the neighbor set that was qh_MERGEridge
+     add the missing ridge for this neighbor
+*/
+void qh_mark_dupridges(qhT *qh, facetT *facetlist, boolT allmerges) {
+  facetT *facet, *neighbor, **neighborp;
+  int nummerge=0;
+  mergeT *merge, **mergep;
+
+  trace4((qh, qh->ferr, 4028, "qh_mark_dupridges: identify dupridges in facetlist f%d, allmerges? %d\n",
+    facetlist->id, allmerges));
+  FORALLfacet_(facetlist) {  /* not necessary for first call */
+    facet->mergeridge2= False;
+    facet->mergeridge= False;
+  }
+  FORALLfacet_(facetlist) {
+    if (facet->dupridge) {
+      FOREACHneighbor_(facet) {
+        if (neighbor == qh_MERGEridge) {
+          facet->mergeridge= True;
+          continue;
+        }
+        if (neighbor->dupridge) {
+          if (!qh_setin(neighbor->neighbors, facet)) { /* i.e., it is qh_MERGEridge, neighbors are distinct */
+            qh_appendmergeset(qh, facet, neighbor, MRGdupridge, 0.0, 1.0);
+            facet->mergeridge2= True;
+            facet->mergeridge= True;
+            nummerge++;
+          }else if (qh_setequal(facet->vertices, neighbor->vertices)) { /* neighbors are the same except for horizon and qh_MERGEridge, see QH7085 */
+            trace3((qh, qh->ferr, 3043, "qh_mark_dupridges): dupridge due to duplicate vertices for subridges f%d and f%d\n",
+                 facet->id, neighbor->id));
+            qh_appendmergeset(qh, facet, neighbor, MRGdupridge, 0.0, 1.0);
+            facet->mergeridge2= True;
+            facet->mergeridge= True;
+            nummerge++;
+            break; /* same for all neighbors */
+          }
+        }
+      }
+    }
+  }
+  if (!nummerge)
+    return;
+  if (!allmerges) {
+    trace1((qh, qh->ferr, 1012, "qh_mark_dupridges: found %d duplicated ridges (MRGdupridge) for qh_getpinchedmerges\n", nummerge));
+    return;
+  }
+  trace1((qh, qh->ferr, 1048, "qh_mark_dupridges: found %d duplicated ridges (MRGdupridge) for qh_premerge.  Prepare facets for merging\n", nummerge));
+  /* make ridges in preparation for merging */
+  FORALLfacet_(facetlist) {
+    if (facet->mergeridge && !facet->mergeridge2)
+      qh_makeridges(qh, facet);
+  }
+  trace3((qh, qh->ferr, 3075, "qh_mark_dupridges: restore missing neighbors and ridges due to qh_MERGEridge\n"));
+  FOREACHmerge_(qh->facet_mergeset) {   /* restore the missing neighbors */
+    if (merge->mergetype == MRGdupridge) { /* only between simplicial facets */
+      if (merge->facet2->mergeridge2 && qh_setin(merge->facet2->neighbors, merge->facet1)) {
+        /* Due to duplicate or multiple subridges, e.g., ../eg/qtest.sh t712682 '200 s W1e-13  C1,1e-13 D5' 'd'
+            merge->facet1:    - neighboring facets: f27779 f59186 f59186 f59186 MERGEridge f59186
+            merge->facet2:    - neighboring facets: f27779 f59100 f59100 f59100 f59100 f59100
+           or, ../eg/qtest.sh 100 '500 s W1e-13 C1,1e-13 D4' 'd'
+           both facets will be degenerate after merge, consider for special case handling
+        */
+        qh_fprintf(qh, qh->ferr, 6361, "qhull topological error (qh_mark_dupridges): multiple dupridges for f%d and f%d, including reverse\n",
+          merge->facet1->id, merge->facet2->id);
+        qh_errexit2(qh, qh_ERRtopology, merge->facet1, merge->facet2);
+      }else
+        qh_setappend(qh, &merge->facet2->neighbors, merge->facet1);
+      qh_makeridges(qh, merge->facet1);   /* and the missing ridges */
+    }
+  }
+} /* mark_dupridges */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="maybe_duplicateridge">-</a>
+
+  qh_maybe_duplicateridge(qh, ridge )
+    add MRGvertices if neighboring facet has another ridge with the same vertices
+
+  returns:
+    adds rename requests to qh.vertex_mergeset
+
+  notes:
+    called by qh_renamevertex
+    nop if 2-D
+    expensive test
+    Duplicate ridges may lead to new facets with same vertex set (QH7084), will try merging vertices
+    same as qh_maybe_duplicateridges
+
+  design:
+    for the two neighbors
+      if non-simplicial
+        for each ridge with the same first and last vertices (max id and min id)
+          if the remaining vertices are the same
+            get the closest pair of vertices
+            add to vertex_mergeset for merging
+*/
+void qh_maybe_duplicateridge(qhT *qh, ridgeT *ridgeA) {
+  ridgeT *ridge, **ridgep;
+  vertexT *vertex, *pinched;
+  facetT *neighbor;
+  coordT dist;
+  int i, k, last= qh->hull_dim-2;
+
+  if (qh->hull_dim < 3 )
+    return;
+
+  for (neighbor= ridgeA->top, i=0; i<2; neighbor= ridgeA->bottom, i++) {
+    if (!neighbor->simplicial && neighbor->nummerge > 0) { /* skip degenerate neighbors with both new and old vertices that will be merged */
+      FOREACHridge_(neighbor->ridges) {
+        if (ridge != ridgeA && SETfirst_(ridge->vertices) == SETfirst_(ridgeA->vertices)) {
+          if (SETelem_(ridge->vertices, last) == SETelem_(ridgeA->vertices, last)) {
+            for (k=1; k<last; k++) {
+              if (SETelem_(ridge->vertices, k) != SETelem_(ridgeA->vertices, k))
+                break;
+            }
+            if (k == last) {
+              vertex= qh_findbest_ridgevertex(qh, ridge, &pinched, &dist);
+              trace2((qh, qh->ferr, 2069, "qh_maybe_duplicateridge: will merge v%d into v%d (dist %2.2g) due to duplicate ridges r%d/r%d with the same vertices.  mergevertex set\n",
+                pinched->id, vertex->id, dist, ridgeA->id, ridge->id, ridgeA->top->id, ridgeA->bottom->id, ridge->top->id, ridge->bottom->id));
+              qh_appendvertexmerge(qh, pinched, vertex, MRGvertices, dist, ridgeA, ridge);
+              ridge->mergevertex= True; /* disables check for duplicate vertices in qh_checkfacet */
+              ridgeA->mergevertex= True;
+            }
+          }
+        }
+      }
+    }
+  }
+} /* maybe_duplicateridge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="maybe_duplicateridges">-</a>
+
+  qh_maybe_duplicateridges(qh, facet )
+    if Q15, add MRGvertices if facet has ridges with the same vertices
+
+  returns:
+    adds rename requests to qh.vertex_mergeset
+
+  notes:
+    called at end of qh_mergefacet and qh_mergecycle_all
+    only enabled if qh.CHECKduplicates ('Q15') and 3-D or more
+    expensive test, not worth it
+    same as qh_maybe_duplicateridge
+
+  design:
+    for all ridge pairs in facet
+        if the same first and last vertices (max id and min id)
+          if the remaining vertices are the same
+            get the closest pair of vertices
+            add to vertex_mergeset for merging
+*/
+void qh_maybe_duplicateridges(qhT *qh, facetT *facet) {
+  facetT *otherfacet;
+  ridgeT *ridge, *ridge2;
+  vertexT *vertex, *pinched;
+  coordT dist;
+  int ridge_i, ridge_n, i, k, last_v= qh->hull_dim-2;
+
+  if (qh->hull_dim < 3 || !qh->CHECKduplicates)
+    return;
+
+  FOREACHridge_i_(qh, facet->ridges) {
+    otherfacet= otherfacet_(ridge, facet);
+    if (otherfacet->degenerate || otherfacet->redundant || otherfacet->dupridge || otherfacet->flipped) /* will merge */
+      continue;
+    for (i=ridge_i+1; i < ridge_n; i++) {
+      ridge2= SETelemt_(facet->ridges, i, ridgeT);
+      otherfacet= otherfacet_(ridge2, facet);
+      if (otherfacet->degenerate || otherfacet->redundant || otherfacet->dupridge || otherfacet->flipped) /* will merge */
+        continue;
+      /* optimize qh_setequal(ridge->vertices, ridge2->vertices) */
+      if (SETelem_(ridge->vertices, last_v) == SETelem_(ridge2->vertices, last_v)) { /* SETfirst is likely to be the same */
+        if (SETfirst_(ridge->vertices) == SETfirst_(ridge2->vertices)) {
+          for (k=1; k<last_v; k++) {
+            if (SETelem_(ridge->vertices, k) != SETelem_(ridge2->vertices, k))
+              break;
+          }
+          if (k == last_v) {
+            vertex= qh_findbest_ridgevertex(qh, ridge, &pinched, &dist);
+            if (ridge->top == ridge2->bottom && ridge->bottom == ridge2->top) {
+              /* proof that ridges may have opposite orientation */
+              trace2((qh, qh->ferr, 2088, "qh_maybe_duplicateridges: will merge v%d into v%d (dist %2.2g) due to opposite oriented ridges r%d/r%d for f%d and f%d\n",
+                pinched->id, vertex->id, dist, ridge->id, ridge2->id, ridge->top->id, ridge->bottom->id));
+            }else {
+              trace2((qh, qh->ferr, 2083, "qh_maybe_duplicateridges: will merge v%d into v%d (dist %2.2g) due to duplicate ridges with the same vertices r%d/r%d in merged facet f%d\n",
+                pinched->id, vertex->id, dist, ridge->id, ridge2->id, facet->id));
+            }
+            qh_appendvertexmerge(qh, pinched, vertex, MRGvertices, dist, ridge, ridge2);
+            ridge->mergevertex= True; /* disables check for duplicate vertices in qh_checkfacet */
+            ridge2->mergevertex= True;
+          }
+        }
+      }
+    }
+  }
+} /* maybe_duplicateridges */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="maydropneighbor">-</a>
+
+  qh_maydropneighbor(qh, facet )
+    drop neighbor relationship if ridge was deleted between a non-simplicial facet and its neighbors
+
+  returns:
+    for deleted ridges
+      ridges made for simplicial neighbors
+      neighbor sets updated
+      appends degenerate facets to qh.facet_mergeset
+
+  notes:
+    called by qh_renamevertex
+    assumes neighbors do not include qh_MERGEridge (qh_makeridges)
+    won't cause redundant facets since vertex inclusion is the same
+    may drop vertex and neighbor if no ridge
+    uses qh.visit_id
+
+  design:
+    visit all neighbors with ridges
+    for each unvisited neighbor of facet
+      delete neighbor and facet from the non-simplicial neighbor sets
+      if neighbor becomes degenerate
+        append neighbor to qh.degen_mergeset
+    if facet is degenerate
+      append facet to qh.degen_mergeset
+*/
+void qh_maydropneighbor(qhT *qh, facetT *facet) {
+  ridgeT *ridge, **ridgep;
+  facetT *neighbor, **neighborp;
+
+  qh->visit_id++;
+  trace4((qh, qh->ferr, 4029, "qh_maydropneighbor: test f%d for no ridges to a neighbor\n",
+          facet->id));
+  if (facet->simplicial) {
+    qh_fprintf(qh, qh->ferr, 6278, "qhull internal error (qh_maydropneighbor): not valid for simplicial f%d while adding furthest p%d\n",
+      facet->id, qh->furthest_id);
+    qh_errexit(qh, qh_ERRqhull, facet, NULL);
+  }
+  FOREACHridge_(facet->ridges) {
+    ridge->top->visitid= qh->visit_id;
+    ridge->bottom->visitid= qh->visit_id;
+  }
+  FOREACHneighbor_(facet) {
+    if (neighbor->visible) {
+      qh_fprintf(qh, qh->ferr, 6358, "qhull internal error (qh_maydropneighbor): facet f%d has deleted neighbor f%d (qh.visible_list)\n",
+            facet->id, neighbor->id);
+      qh_errexit2(qh, qh_ERRqhull, facet, neighbor);
+    }
+    if (neighbor->visitid != qh->visit_id) {
+      trace2((qh, qh->ferr, 2104, "qh_maydropneighbor: facets f%d and f%d are no longer neighbors while adding furthest p%d\n",
+            facet->id, neighbor->id, qh->furthest_id));
+      if (neighbor->simplicial) {
+        qh_fprintf(qh, qh->ferr, 6280, "qhull internal error (qh_maydropneighbor): not valid for simplicial neighbor f%d of f%d while adding furthest p%d\n",
+            neighbor->id, facet->id, qh->furthest_id);
+        qh_errexit2(qh, qh_ERRqhull, neighbor, facet);
+      }
+      zinc_(Zdropneighbor);
+      qh_setdel(neighbor->neighbors, facet);
+      if (qh_setsize(qh, neighbor->neighbors) < qh->hull_dim) {
+        zinc_(Zdropdegen);
+        qh_appendmergeset(qh, neighbor, neighbor, MRGdegen, 0.0, qh_ANGLEnone);
+        trace2((qh, qh->ferr, 2023, "qh_maydropneighbors: f%d is degenerate.\n", neighbor->id));
+      }
+      qh_setdel(facet->neighbors, neighbor);
+      neighborp--;  /* repeat, deleted a neighbor */
+    }
+  }
+  if (qh_setsize(qh, facet->neighbors) < qh->hull_dim) {
+    zinc_(Zdropdegen);
+    qh_appendmergeset(qh, facet, facet, MRGdegen, 0.0, qh_ANGLEnone);
+    trace2((qh, qh->ferr, 2024, "qh_maydropneighbors: f%d is degenerate.\n", facet->id));
+  }
+} /* maydropneighbor */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="merge_degenredundant">-</a>
+
+  qh_merge_degenredundant(qh)
+    merge all degenerate and redundant facets
+    qh.degen_mergeset contains merges from  qh_test_degen_neighbors, qh_test_redundant_neighbors, and qh_degen_redundant_facet
+
+  returns:
+    number of merges performed
+    resets facet->degenerate/redundant
+    if deleted (visible) facet has no neighbors
+      sets ->f.replace to NULL
+
+  notes:
+    redundant merges happen before degenerate ones
+    merging and renaming vertices can result in degen/redundant facets
+    check for coplanar and convex neighbors afterwards
+
+  design:
+    for each merge on qh.degen_mergeset
+      if redundant merge
+        if non-redundant facet merged into redundant facet
+          recheck facet for redundancy
+        else
+          merge redundant facet into other facet
+*/
+int qh_merge_degenredundant(qhT *qh) {
+  int size;
+  mergeT *merge;
+  facetT *bestneighbor, *facet1, *facet2, *facet3;
+  realT dist, mindist, maxdist;
+  vertexT *vertex, **vertexp;
+  int nummerges= 0;
+  mergeType mergetype;
+  setT *mergedfacets;
+
+  trace2((qh, qh->ferr, 2095, "qh_merge_degenredundant: merge %d degenerate, redundant, and mirror facets\n",
+    qh_setsize(qh, qh->degen_mergeset)));
+  mergedfacets= qh_settemp(qh, qh->TEMPsize);
+  while ((merge= (mergeT *)qh_setdellast(qh->degen_mergeset))) {
+    facet1= merge->facet1;
+    facet2= merge->facet2;
+    mergetype= merge->mergetype;
+    qh_memfree(qh, merge, (int)sizeof(mergeT)); /* 'merge' is invalidated */
+    if (facet1->visible)
+      continue;
+    facet1->degenerate= False;
+    facet1->redundant= False;
+    if (qh->TRACEmerge-1 == zzval_(Ztotmerge))
+      qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+    if (mergetype == MRGredundant) {
+      zinc_(Zredundant);
+      facet3= qh_getreplacement(qh, facet2); /* the same facet if !facet2.visible */
+      if (!facet3) {
+          qh_fprintf(qh, qh->ferr, 6097, "qhull internal error (qh_merge_degenredunant): f%d is redundant but visible f%d has no replacement\n",
+               facet1->id, getid_(facet2));
+          qh_errexit2(qh, qh_ERRqhull, facet1, facet2);
+      }
+      qh_setunique(qh, &mergedfacets, facet3);
+      if (facet1 == facet3) {
+        continue;
+      }
+      trace2((qh, qh->ferr, 2025, "qh_merge_degenredundant: merge redundant f%d into f%d (arg f%d)\n",
+            facet1->id, facet3->id, facet2->id));
+      qh_mergefacet(qh, facet1, facet3, mergetype, NULL, NULL, !qh_MERGEapex);
+      /* merge distance is already accounted for */
+      nummerges++;
+    }else {  /* mergetype == MRGdegen or MRGmirror, other merges may have fixed */
+      if (!(size= qh_setsize(qh, facet1->neighbors))) {
+        zinc_(Zdelfacetdup);
+        trace2((qh, qh->ferr, 2026, "qh_merge_degenredundant: facet f%d has no neighbors.  Deleted\n", facet1->id));
+        qh_willdelete(qh, facet1, NULL);
+        FOREACHvertex_(facet1->vertices) {
+          qh_setdel(vertex->neighbors, facet1);
+          if (!SETfirst_(vertex->neighbors)) {
+            zinc_(Zdegenvertex);
+            trace2((qh, qh->ferr, 2027, "qh_merge_degenredundant: deleted v%d because f%d has no neighbors\n",
+                 vertex->id, facet1->id));
+            vertex->deleted= True;
+            qh_setappend(qh, &qh->del_vertices, vertex);
+          }
+        }
+        nummerges++;
+      }else if (size < qh->hull_dim) {
+        bestneighbor= qh_findbestneighbor(qh, facet1, &dist, &mindist, &maxdist);
+        trace2((qh, qh->ferr, 2028, "qh_merge_degenredundant: facet f%d has %d neighbors, merge into f%d dist %2.2g\n",
+              facet1->id, size, bestneighbor->id, dist));
+        qh_mergefacet(qh, facet1, bestneighbor, mergetype, &mindist, &maxdist, !qh_MERGEapex);
+        nummerges++;
+        if (qh->PRINTstatistics) {
+          zinc_(Zdegen);
+          wadd_(Wdegentot, dist);
+          wmax_(Wdegenmax, dist);
+        }
+      } /* else, another merge fixed the degeneracy and redundancy tested */
+    }
+  }
+  qh_settempfree(qh, &mergedfacets);
+  return nummerges;
+} /* merge_degenredundant */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="merge_nonconvex">-</a>
+
+  qh_merge_nonconvex(qh, facet1, facet2, mergetype )
+    remove non-convex ridge between facet1 into facet2
+    mergetype gives why the facet's are non-convex
+
+  returns:
+    merges one of the facets into the best neighbor
+
+  notes:
+    mergetype is MRGcoplanar..MRGconvex
+
+  design:
+    if one of the facets is a new facet
+      prefer merging new facet into old facet
+    find best neighbors for both facets
+    merge the nearest facet into its best neighbor
+    update the statistics
+*/
+void qh_merge_nonconvex(qhT *qh, facetT *facet1, facetT *facet2, mergeType mergetype) {
+  facetT *bestfacet, *bestneighbor, *neighbor, *merging, *merged;
+  realT dist, dist2, mindist, mindist2, maxdist, maxdist2;
+
+  if (mergetype < MRGcoplanar || mergetype > MRGconcavecoplanar) {
+    qh_fprintf(qh, qh->ferr, 6398, "qhull internal error (qh_merge_nonconvex): expecting mergetype MRGcoplanar..MRGconcavecoplanar.  Got merge f%d and f%d type %d\n",
+      facet1->id, facet2->id, mergetype);
+    qh_errexit2(qh, qh_ERRqhull, facet1, facet2);
+  }
+  if (qh->TRACEmerge-1 == zzval_(Ztotmerge))
+    qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+  trace3((qh, qh->ferr, 3003, "qh_merge_nonconvex: merge #%d for f%d and f%d type %d\n",
+      zzval_(Ztotmerge) + 1, facet1->id, facet2->id, mergetype));
+  /* concave or coplanar */
+  if (!facet1->newfacet) {
+    bestfacet= facet2;   /* avoid merging old facet if new is ok */
+    facet2= facet1;
+    facet1= bestfacet;
+  }else
+    bestfacet= facet1;
+  bestneighbor= qh_findbestneighbor(qh, bestfacet, &dist, &mindist, &maxdist);
+  neighbor= qh_findbestneighbor(qh, facet2, &dist2, &mindist2, &maxdist2);
+  if (dist < dist2) {
+    merging= bestfacet;
+    merged= bestneighbor;
+  }else if (qh->AVOIDold && !facet2->newfacet
+  && ((mindist >= -qh->MAXcoplanar && maxdist <= qh->max_outside)
+       || dist * 1.5 < dist2)) {
+    zinc_(Zavoidold);
+    wadd_(Wavoidoldtot, dist);
+    wmax_(Wavoidoldmax, dist);
+    trace2((qh, qh->ferr, 2029, "qh_merge_nonconvex: avoid merging old facet f%d dist %2.2g.  Use f%d dist %2.2g instead\n",
+           facet2->id, dist2, facet1->id, dist2));
+    merging= bestfacet;
+    merged= bestneighbor;
+  }else {
+    merging= facet2;
+    merged= neighbor;
+    dist= dist2;
+    mindist= mindist2;
+    maxdist= maxdist2;
+  }
+  qh_mergefacet(qh, merging, merged, mergetype, &mindist, &maxdist, !qh_MERGEapex);
+  /* caller merges qh_degenredundant */
+  if (qh->PRINTstatistics) {
+    if (mergetype == MRGanglecoplanar) {
+      zinc_(Zacoplanar);
+      wadd_(Wacoplanartot, dist);
+      wmax_(Wacoplanarmax, dist);
+    }else if (mergetype == MRGconcave) {
+      zinc_(Zconcave);
+      wadd_(Wconcavetot, dist);
+      wmax_(Wconcavemax, dist);
+    }else if (mergetype == MRGconcavecoplanar) {
+      zinc_(Zconcavecoplanar);
+      wadd_(Wconcavecoplanartot, dist);
+      wmax_(Wconcavecoplanarmax, dist);
+    }else { /* MRGcoplanar */
+      zinc_(Zcoplanar);
+      wadd_(Wcoplanartot, dist);
+      wmax_(Wcoplanarmax, dist);
+    }
+  }
+} /* merge_nonconvex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="merge_pinchedvertices">-</a>
+
+  qh_merge_pinchedvertices(qh, apex )
+    merge pinched vertices in qh.vertex_mergeset to avoid qh_forcedmerges of dupridges
+
+  notes:
+    only called by qh_all_vertexmerges
+    hull_dim >= 3
+
+  design:
+    make vertex neighbors if necessary
+    for each pinched vertex
+      determine the ridges for the pinched vertex (make ridges as needed)
+      merge the pinched vertex into the horizon vertex
+      merge the degenerate and redundant facets that result
+    check and resolve new dupridges
+*/
+void qh_merge_pinchedvertices(qhT *qh, int apexpointid /* qh.newfacet_list */) {
+  mergeT *merge, *mergeA, **mergeAp;
+  vertexT *vertex, *vertex2;
+  realT dist;
+  boolT firstmerge= True;
+
+  qh_vertexneighbors(qh);
+  if (qh->visible_list || qh->newfacet_list || qh->newvertex_list) {
+    qh_fprintf(qh, qh->ferr, 6402, "qhull internal error (qh_merge_pinchedvertices): qh.visible_list (f%d), newfacet_list (f%d), or newvertex_list (v%d) not empty\n",
+      getid_(qh->visible_list), getid_(qh->newfacet_list), getid_(qh->newvertex_list));
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh->visible_list= qh->newfacet_list= qh->facet_tail;
+  qh->newvertex_list= qh->vertex_tail;
+  qh->isRenameVertex= True; /* disable duplicate ridge vertices check in qh_checkfacet */
+  while ((merge= qh_next_vertexmerge(qh /* qh.vertex_mergeset */))) { /* only one at a time from qh_getpinchedmerges */
+    if (qh->TRACEmerge-1 == zzval_(Ztotmerge))
+      qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+    if (merge->mergetype == MRGsubridge) {
+      zzinc_(Zpinchedvertex);
+      trace1((qh, qh->ferr, 1050, "qh_merge_pinchedvertices: merge one of %d pinched vertices before adding apex p%d.  Try to resolve duplicate ridges in newfacets\n",
+        qh_setsize(qh, qh->vertex_mergeset)+1, apexpointid));
+      qh_remove_mergetype(qh, qh->vertex_mergeset, MRGsubridge);
+    }else {
+      zzinc_(Zpinchduplicate);
+      if (firstmerge)
+        trace1((qh, qh->ferr, 1056, "qh_merge_pinchedvertices: merge %d pinched vertices from dupridges in merged facets, apex p%d\n",
+           qh_setsize(qh, qh->vertex_mergeset)+1, apexpointid));
+      firstmerge= False;
+    }
+    vertex= merge->vertex1;
+    vertex2= merge->vertex2;
+    dist= merge->distance;
+    qh_memfree(qh, merge, (int)sizeof(mergeT)); /* merge is invalidated */
+    qh_rename_adjacentvertex(qh, vertex, vertex2, dist);
+#ifndef qh_NOtrace
+    if (qh->IStracing >= 2) {
+      FOREACHmergeA_(qh->degen_mergeset) {
+        if (mergeA->mergetype== MRGdegen) {
+          qh_fprintf(qh, qh->ferr, 2072, "qh_merge_pinchedvertices: merge degenerate f%d into an adjacent facet\n", mergeA->facet1->id);
+        }else {
+          qh_fprintf(qh, qh->ferr, 2084, "qh_merge_pinchedvertices: merge f%d into f%d mergeType %d\n", mergeA->facet1->id, mergeA->facet2->id, mergeA->mergetype);
+        }
+      }
+    }
+#endif
+    qh_merge_degenredundant(qh); /* simplicial facets with both old and new vertices */
+  }
+  qh->isRenameVertex= False;
+}/* merge_pinchedvertices */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="merge_twisted">-</a>
+
+  qh_merge_twisted(qh, facet1, facet2 )
+    remove twisted ridge between facet1 into facet2 or report error
+
+  returns:
+    merges one of the facets into the best neighbor
+
+  notes:
+    a twisted ridge has opposite vertices that are convex and concave
+
+  design:
+    find best neighbors for both facets
+    error if wide merge
+    merge the nearest facet into its best neighbor
+    update statistics
+*/
+void qh_merge_twisted(qhT *qh, facetT *facet1, facetT *facet2) {
+  facetT *neighbor2, *neighbor, *merging, *merged;
+  vertexT *bestvertex, *bestpinched;
+  realT dist, dist2, mindist, mindist2, maxdist, maxdist2, mintwisted, bestdist;
+
+  if (qh->TRACEmerge-1 == zzval_(Ztotmerge))
+    qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+  trace3((qh, qh->ferr, 3050, "qh_merge_twisted: merge #%d for twisted f%d and f%d\n",
+      zzval_(Ztotmerge) + 1, facet1->id, facet2->id));
+  /* twisted */
+  neighbor= qh_findbestneighbor(qh, facet1, &dist, &mindist, &maxdist);
+  neighbor2= qh_findbestneighbor(qh, facet2, &dist2, &mindist2, &maxdist2);
+  mintwisted= qh_RATIOtwisted * qh->ONEmerge;
+  maximize_(mintwisted, facet1->maxoutside);
+  maximize_(mintwisted, facet2->maxoutside);
+  if (dist > mintwisted && dist2 > mintwisted) {
+    bestdist= qh_vertex_bestdist2(qh, facet1->vertices, &bestvertex, &bestpinched);
+    if (bestdist > mintwisted) {
+      qh_fprintf(qh, qh->ferr, 6417, "qhull precision error (qh_merge_twisted): twisted facet f%d does not contain pinched vertices.  Too wide to merge into neighbor.  mindist %2.2g maxdist %2.2g vertexdist %2.2g maxpinched %2.2g neighbor f%d mindist %2.2g maxdist %2.2g\n",
+        facet1->id, mindist, maxdist, bestdist, mintwisted, facet2->id, mindist2, maxdist2);
+    }else {
+      qh_fprintf(qh, qh->ferr, 6418, "qhull precision error (qh_merge_twisted): twisted facet f%d with pinched vertices.  Could merge vertices, but too wide to merge into neighbor.   mindist %2.2g maxdist %2.2g vertexdist %2.2g neighbor f%d mindist %2.2g maxdist %2.2g\n",
+        facet1->id, mindist, maxdist, bestdist, facet2->id, mindist2, maxdist2);
+    }
+    qh_errexit2(qh, qh_ERRwide, facet1, facet2);
+  }
+  if (dist < dist2) {
+    merging= facet1;
+    merged= neighbor;
+  }else {
+    /* ignores qh.AVOIDold ('Q4') */
+    merging= facet2;
+    merged= neighbor2;
+    dist= dist2;
+    mindist= mindist2;
+    maxdist= maxdist2;
+  }
+  qh_mergefacet(qh, merging, merged, MRGtwisted, &mindist, &maxdist, !qh_MERGEapex);
+  /* caller merges qh_degenredundant */
+  zinc_(Ztwisted);
+  wadd_(Wtwistedtot, dist);
+  wmax_(Wtwistedmax, dist);
+} /* merge_twisted */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergecycle">-</a>
+
+  qh_mergecycle(qh, samecycle, newfacet )
+    merge a cycle of facets starting at samecycle into a newfacet
+    newfacet is a horizon facet with ->normal
+    samecycle facets are simplicial from an apex
+
+  returns:
+    initializes vertex neighbors on first merge
+    samecycle deleted (placed on qh.visible_list)
+    newfacet at end of qh.facet_list
+    deleted vertices on qh.del_vertices
+
+  notes:
+    only called by qh_mergecycle_all for multiple, same cycle facets
+    see qh_mergefacet
+
+  design:
+    make vertex neighbors if necessary
+    make ridges for newfacet
+    merge neighbor sets of samecycle into newfacet
+    merge ridges of samecycle into newfacet
+    merge vertex neighbors of samecycle into newfacet
+    make apex of samecycle the apex of newfacet
+    if newfacet wasn't a new facet
+      add its vertices to qh.newvertex_list
+    delete samecycle facets a make newfacet a newfacet
+*/
+void qh_mergecycle(qhT *qh, facetT *samecycle, facetT *newfacet) {
+  int traceonce= False, tracerestore= 0;
+  vertexT *apex;
+#ifndef qh_NOtrace
+  facetT *same;
+#endif
+
+  zzinc_(Ztotmerge);
+  if (qh->REPORTfreq2 && qh->POSTmerging) {
+    if (zzval_(Ztotmerge) > qh->mergereport + qh->REPORTfreq2)
+      qh_tracemerging(qh);
+  }
+#ifndef qh_NOtrace
+  if (qh->TRACEmerge == zzval_(Ztotmerge))
+    qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+  trace2((qh, qh->ferr, 2030, "qh_mergecycle: merge #%d for facets from cycle f%d into coplanar horizon f%d\n",
+        zzval_(Ztotmerge), samecycle->id, newfacet->id));
+  if (newfacet == qh->tracefacet) {
+    tracerestore= qh->IStracing;
+    qh->IStracing= 4;
+    qh_fprintf(qh, qh->ferr, 8068, "qh_mergecycle: ========= trace merge %d of samecycle %d into trace f%d, furthest is p%d\n",
+               zzval_(Ztotmerge), samecycle->id, newfacet->id,  qh->furthest_id);
+    traceonce= True;
+  }
+  if (qh->IStracing >=4) {
+    qh_fprintf(qh, qh->ferr, 8069, "  same cycle:");
+    FORALLsame_cycle_(samecycle)
+      qh_fprintf(qh, qh->ferr, 8070, " f%d", same->id);
+    qh_fprintf(qh, qh->ferr, 8071, "\n");
+  }
+  if (qh->IStracing >=4)
+    qh_errprint(qh, "MERGING CYCLE", samecycle, newfacet, NULL, NULL);
+#endif /* !qh_NOtrace */
+  if (newfacet->tricoplanar) {
+    if (!qh->TRInormals) {
+      qh_fprintf(qh, qh->ferr, 6224, "qhull internal error (qh_mergecycle): does not work for tricoplanar facets.  Use option 'Q11'\n");
+      qh_errexit(qh, qh_ERRqhull, newfacet, NULL);
+    }
+    newfacet->tricoplanar= False;
+    newfacet->keepcentrum= False;
+  }
+  if (qh->CHECKfrequently)
+    qh_checkdelridge(qh);
+  if (!qh->VERTEXneighbors)
+    qh_vertexneighbors(qh);
+  apex= SETfirstt_(samecycle->vertices, vertexT);
+  qh_makeridges(qh, newfacet);
+  qh_mergecycle_neighbors(qh, samecycle, newfacet);
+  qh_mergecycle_ridges(qh, samecycle, newfacet);
+  qh_mergecycle_vneighbors(qh, samecycle, newfacet);
+  if (SETfirstt_(newfacet->vertices, vertexT) != apex)
+    qh_setaddnth(qh, &newfacet->vertices, 0, apex);  /* apex has last id */
+  if (!newfacet->newfacet)
+    qh_newvertices(qh, newfacet->vertices);
+  qh_mergecycle_facets(qh, samecycle, newfacet);
+  qh_tracemerge(qh, samecycle, newfacet, MRGcoplanarhorizon);
+  /* check for degen_redundant_neighbors after qh_forcedmerges() */
+  if (traceonce) {
+    qh_fprintf(qh, qh->ferr, 8072, "qh_mergecycle: end of trace facet\n");
+    qh->IStracing= tracerestore;
+  }
+} /* mergecycle */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergecycle_all">-</a>
+
+  qh_mergecycle_all(qh, facetlist, wasmerge )
+    merge all samecycles of coplanar facets into horizon
+    don't merge facets with ->mergeridge (these already have ->normal)
+    all facets are simplicial from apex
+    all facet->cycledone == False
+
+  returns:
+    all newfacets merged into coplanar horizon facets
+    deleted vertices on  qh.del_vertices
+    sets wasmerge if any merge
+
+  notes:
+    called by qh_premerge
+    calls qh_mergecycle for multiple, same cycle facets
+
+  design:
+    for each facet on facetlist
+      skip facets with dupridges and normals
+      check that facet is in a samecycle (->mergehorizon)
+      if facet only member of samecycle
+        sets vertex->delridge for all vertices except apex
+        merge facet into horizon
+      else
+        mark all facets in samecycle
+        remove facets with dupridges from samecycle
+        merge samecycle into horizon (deletes facets from facetlist)
+*/
+void qh_mergecycle_all(qhT *qh, facetT *facetlist, boolT *wasmerge) {
+  facetT *facet, *same, *prev, *horizon, *newfacet;
+  facetT *samecycle= NULL, *nextfacet, *nextsame;
+  vertexT *apex, *vertex, **vertexp;
+  int cycles=0, total=0, facets, nummerge, numdegen= 0;
+
+  trace2((qh, qh->ferr, 2031, "qh_mergecycle_all: merge new facets into coplanar horizon facets.  Bulk merge a cycle of facets with the same horizon facet\n"));
+  for (facet=facetlist; facet && (nextfacet= facet->next); facet= nextfacet) {
+    if (facet->normal)
+      continue;
+    if (!facet->mergehorizon) {
+      qh_fprintf(qh, qh->ferr, 6225, "qhull internal error (qh_mergecycle_all): f%d without normal\n", facet->id);
+      qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+    horizon= SETfirstt_(facet->neighbors, facetT);
+    if (facet->f.samecycle == facet) {
+      if (qh->TRACEmerge-1 == zzval_(Ztotmerge))
+        qh->qhmem.IStracing= qh->IStracing= qh->TRACElevel;
+      zinc_(Zonehorizon);
+      /* merge distance done in qh_findhorizon */
+      apex= SETfirstt_(facet->vertices, vertexT);
+      FOREACHvertex_(facet->vertices) {
+        if (vertex != apex)
+          vertex->delridge= True;
+      }
+      horizon->f.newcycle= NULL;
+      qh_mergefacet(qh, facet, horizon, MRGcoplanarhorizon, NULL, NULL, qh_MERGEapex);
+    }else {
+      samecycle= facet;
+      facets= 0;
+      prev= facet;
+      for (same= facet->f.samecycle; same;  /* FORALLsame_cycle_(facet) */
+           same= (same == facet ? NULL :nextsame)) { /* ends at facet */
+        nextsame= same->f.samecycle;
+        if (same->cycledone || same->visible)
+          qh_infiniteloop(qh, same);
+        same->cycledone= True;
+        if (same->normal) {
+          prev->f.samecycle= same->f.samecycle; /* unlink ->mergeridge */
+          same->f.samecycle= NULL;
+        }else {
+          prev= same;
+          facets++;
+        }
+      }
+      while (nextfacet && nextfacet->cycledone)  /* will delete samecycle */
+        nextfacet= nextfacet->next;
+      horizon->f.newcycle= NULL;
+      qh_mergecycle(qh, samecycle, horizon);
+      nummerge= horizon->nummerge + facets;
+      if (nummerge > qh_MAXnummerge)
+        horizon->nummerge= qh_MAXnummerge;
+      else
+        horizon->nummerge= (short unsigned int)nummerge; /* limited to 9 bits by qh_MAXnummerge, -Wconversion */
+      zzinc_(Zcyclehorizon);
+      total += facets;
+      zzadd_(Zcyclefacettot, facets);
+      zmax_(Zcyclefacetmax, facets);
+    }
+    cycles++;
+  }
+  if (cycles) {
+    FORALLnew_facets {
+      /* qh_maybe_duplicateridges postponed since qh_mergecycle_ridges deletes ridges without calling qh_delridge_merge */
+      if (newfacet->coplanarhorizon) {
+        qh_test_redundant_neighbors(qh, newfacet);
+        qh_maybe_duplicateridges(qh, newfacet);
+        newfacet->coplanarhorizon= False;
+      }
+    }
+    numdegen += qh_merge_degenredundant(qh);
+    *wasmerge= True;
+    trace1((qh, qh->ferr, 1013, "qh_mergecycle_all: merged %d same cycles or facets into coplanar horizons and %d degenredundant facets\n",
+      cycles, numdegen));
+  }
+} /* mergecycle_all */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergecycle_facets">-</a>
+
+  qh_mergecycle_facets(qh, samecycle, newfacet )
+    finish merge of samecycle into newfacet
+
+  returns:
+    samecycle prepended to visible_list for later deletion and partitioning
+      each facet->f.replace == newfacet
+
+    newfacet moved to end of qh.facet_list
+      makes newfacet a newfacet (get's facet1->id if it was old)
+      sets newfacet->newmerge
+      clears newfacet->center (unless merging into a large facet)
+      clears newfacet->tested and ridge->tested for facet1
+
+    adds neighboring facets to facet_mergeset if redundant or degenerate
+
+  design:
+    make newfacet a new facet and set its flags
+    move samecycle facets to qh.visible_list for later deletion
+    unless newfacet is large
+      remove its centrum
+*/
+void qh_mergecycle_facets(qhT *qh, facetT *samecycle, facetT *newfacet) {
+  facetT *same, *next;
+
+  trace4((qh, qh->ferr, 4030, "qh_mergecycle_facets: make newfacet new and samecycle deleted\n"));
+  qh_removefacet(qh, newfacet);  /* append as a newfacet to end of qh->facet_list */
+  qh_appendfacet(qh, newfacet);
+  newfacet->newfacet= True;
+  newfacet->simplicial= False;
+  newfacet->newmerge= True;
+
+  for (same= samecycle->f.samecycle; same; same= (same == samecycle ?  NULL : next)) {
+    next= same->f.samecycle;  /* reused by willdelete */
+    qh_willdelete(qh, same, newfacet);
+  }
+  if (newfacet->center
+      && qh_setsize(qh, newfacet->vertices) <= qh->hull_dim + qh_MAXnewcentrum) {
+    qh_memfree(qh, newfacet->center, qh->normal_size);
+    newfacet->center= NULL;
+  }
+  trace3((qh, qh->ferr, 3004, "qh_mergecycle_facets: merged facets from cycle f%d into f%d\n",
+             samecycle->id, newfacet->id));
+} /* mergecycle_facets */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergecycle_neighbors">-</a>
+
+  qh_mergecycle_neighbors(qh, samecycle, newfacet )
+    add neighbors for samecycle facets to newfacet
+
+  returns:
+    newfacet with updated neighbors and vice-versa
+    newfacet has ridges
+    all neighbors of newfacet marked with qh.visit_id
+    samecycle facets marked with qh.visit_id-1
+    ridges updated for simplicial neighbors of samecycle with a ridge
+
+  notes:
+    assumes newfacet not in samecycle
+    usually, samecycle facets are new, simplicial facets without internal ridges
+      not so if horizon facet is coplanar to two different samecycles
+
+  see:
+    qh_mergeneighbors()
+
+  design:
+    check samecycle
+    delete neighbors from newfacet that are also in samecycle
+    for each neighbor of a facet in samecycle
+      if neighbor is simplicial
+        if first visit
+          move the neighbor relation to newfacet
+          update facet links for its ridges
+        else
+          make ridges for neighbor
+          remove samecycle reference
+      else
+        update neighbor sets
+*/
+void qh_mergecycle_neighbors(qhT *qh, facetT *samecycle, facetT *newfacet) {
+  facetT *same, *neighbor, **neighborp;
+  int delneighbors= 0, newneighbors= 0;
+  unsigned int samevisitid;
+  ridgeT *ridge, **ridgep;
+
+  samevisitid= ++qh->visit_id;
+  FORALLsame_cycle_(samecycle) {
+    if (same->visitid == samevisitid || same->visible)
+      qh_infiniteloop(qh, samecycle);
+    same->visitid= samevisitid;
+  }
+  newfacet->visitid= ++qh->visit_id;
+  trace4((qh, qh->ferr, 4031, "qh_mergecycle_neighbors: delete shared neighbors from newfacet\n"));
+  FOREACHneighbor_(newfacet) {
+    if (neighbor->visitid == samevisitid) {
+      SETref_(neighbor)= NULL;  /* samecycle neighbors deleted */
+      delneighbors++;
+    }else
+      neighbor->visitid= qh->visit_id;
+  }
+  qh_setcompact(qh, newfacet->neighbors);
+
+  trace4((qh, qh->ferr, 4032, "qh_mergecycle_neighbors: update neighbors\n"));
+  FORALLsame_cycle_(samecycle) {
+    FOREACHneighbor_(same) {
+      if (neighbor->visitid == samevisitid)
+        continue;
+      if (neighbor->simplicial) {
+        if (neighbor->visitid != qh->visit_id) {
+          qh_setappend(qh, &newfacet->neighbors, neighbor);
+          qh_setreplace(qh, neighbor->neighbors, same, newfacet);
+          newneighbors++;
+          neighbor->visitid= qh->visit_id;
+          FOREACHridge_(neighbor->ridges) { /* update ridge in case of qh_makeridges */
+            if (ridge->top == same) {
+              ridge->top= newfacet;
+              break;
+            }else if (ridge->bottom == same) {
+              ridge->bottom= newfacet;
+              break;
+            }
+          }
+        }else {
+          qh_makeridges(qh, neighbor);
+          qh_setdel(neighbor->neighbors, same);
+          /* same can't be horizon facet for neighbor */
+        }
+      }else { /* non-simplicial neighbor */
+        qh_setdel(neighbor->neighbors, same);
+        if (neighbor->visitid != qh->visit_id) {
+          qh_setappend(qh, &neighbor->neighbors, newfacet);
+          qh_setappend(qh, &newfacet->neighbors, neighbor);
+          neighbor->visitid= qh->visit_id;
+          newneighbors++;
+        }
+      }
+    }
+  }
+  trace2((qh, qh->ferr, 2032, "qh_mergecycle_neighbors: deleted %d neighbors and added %d\n",
+             delneighbors, newneighbors));
+} /* mergecycle_neighbors */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergecycle_ridges">-</a>
+
+  qh_mergecycle_ridges(qh, samecycle, newfacet )
+    add ridges/neighbors for facets in samecycle to newfacet
+    all new/old neighbors of newfacet marked with qh.visit_id
+    facets in samecycle marked with qh.visit_id-1
+    newfacet marked with qh.visit_id
+
+  returns:
+    newfacet has merged ridges
+
+  notes:
+    ridge already updated for simplicial neighbors of samecycle with a ridge
+    qh_checkdelridge called by qh_mergecycle
+
+  see:
+    qh_mergeridges()
+    qh_makeridges()
+
+  design:
+    remove ridges between newfacet and samecycle
+    for each facet in samecycle
+      for each ridge in facet
+        update facet pointers in ridge
+        skip ridges processed in qh_mergecycle_neighors
+        free ridges between newfacet and samecycle
+        free ridges between facets of samecycle (on 2nd visit)
+        append remaining ridges to newfacet
+      if simplicial facet
+        for each neighbor of facet
+          if simplicial facet
+          and not samecycle facet or newfacet
+            make ridge between neighbor and newfacet
+*/
+void qh_mergecycle_ridges(qhT *qh, facetT *samecycle, facetT *newfacet) {
+  facetT *same, *neighbor= NULL;
+  int numold=0, numnew=0;
+  int neighbor_i, neighbor_n;
+  unsigned int samevisitid;
+  ridgeT *ridge, **ridgep;
+  boolT toporient;
+  void **freelistp; /* used if !qh_NOmem by qh_memfree_() */
+
+  trace4((qh, qh->ferr, 4033, "qh_mergecycle_ridges: delete shared ridges from newfacet\n"));
+  samevisitid= qh->visit_id -1;
+  FOREACHridge_(newfacet->ridges) {
+    neighbor= otherfacet_(ridge, newfacet);
+    if (neighbor->visitid == samevisitid)
+      SETref_(ridge)= NULL; /* ridge free'd below */
+  }
+  qh_setcompact(qh, newfacet->ridges);
+
+  trace4((qh, qh->ferr, 4034, "qh_mergecycle_ridges: add ridges to newfacet\n"));
+  FORALLsame_cycle_(samecycle) {
+    FOREACHridge_(same->ridges) {
+      if (ridge->top == same) {
+        ridge->top= newfacet;
+        neighbor= ridge->bottom;
+      }else if (ridge->bottom == same) {
+        ridge->bottom= newfacet;
+        neighbor= ridge->top;
+      }else if (ridge->top == newfacet || ridge->bottom == newfacet) {
+        qh_setappend(qh, &newfacet->ridges, ridge);
+        numold++;  /* already set by qh_mergecycle_neighbors */
+        continue;
+      }else {
+        qh_fprintf(qh, qh->ferr, 6098, "qhull internal error (qh_mergecycle_ridges): bad ridge r%d\n", ridge->id);
+        qh_errexit(qh, qh_ERRqhull, NULL, ridge);
+      }
+      if (neighbor == newfacet) {
+        if (qh->traceridge == ridge)
+          qh->traceridge= NULL;
+        qh_setfree(qh, &(ridge->vertices));
+        qh_memfree_(qh, ridge, (int)sizeof(ridgeT), freelistp);
+        numold++;
+      }else if (neighbor->visitid == samevisitid) {
+        qh_setdel(neighbor->ridges, ridge);
+        if (qh->traceridge == ridge)
+          qh->traceridge= NULL;
+        qh_setfree(qh, &(ridge->vertices));
+        qh_memfree_(qh, ridge, (int)sizeof(ridgeT), freelistp);
+        numold++;
+      }else {
+        qh_setappend(qh, &newfacet->ridges, ridge);
+        numold++;
+      }
+    }
+    if (same->ridges)
+      qh_settruncate(qh, same->ridges, 0);
+    if (!same->simplicial)
+      continue;
+    FOREACHneighbor_i_(qh, same) {       /* note: !newfact->simplicial */
+      if (neighbor->visitid != samevisitid && neighbor->simplicial) {
+        ridge= qh_newridge(qh);
+        ridge->vertices= qh_setnew_delnthsorted(qh, same->vertices, qh->hull_dim,
+                                                          neighbor_i, 0);
+        toporient= (boolT)(same->toporient ^ (neighbor_i & 0x1));
+        if (toporient) {
+          ridge->top= newfacet;
+          ridge->bottom= neighbor;
+          ridge->simplicialbot= True;
+        }else {
+          ridge->top= neighbor;
+          ridge->bottom= newfacet;
+          ridge->simplicialtop= True;
+        }
+        qh_setappend(qh, &(newfacet->ridges), ridge);
+        qh_setappend(qh, &(neighbor->ridges), ridge);
+        if (qh->ridge_id == qh->traceridge_id)
+          qh->traceridge= ridge;
+        numnew++;
+      }
+    }
+  }
+
+  trace2((qh, qh->ferr, 2033, "qh_mergecycle_ridges: found %d old ridges and %d new ones\n",
+             numold, numnew));
+} /* mergecycle_ridges */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergecycle_vneighbors">-</a>
+
+  qh_mergecycle_vneighbors(qh, samecycle, newfacet )
+    create vertex neighbors for newfacet from vertices of facets in samecycle
+    samecycle marked with visitid == qh.visit_id - 1
+
+  returns:
+    newfacet vertices with updated neighbors
+    marks newfacet with qh.visit_id-1
+    deletes vertices that are merged away
+    sets delridge on all vertices (faster here than in mergecycle_ridges)
+
+  see:
+    qh_mergevertex_neighbors()
+
+  design:
+    for each vertex of samecycle facet
+      set vertex->delridge
+      delete samecycle facets from vertex neighbors
+      append newfacet to vertex neighbors
+      if vertex only in newfacet
+        delete it from newfacet
+        add it to qh.del_vertices for later deletion
+*/
+void qh_mergecycle_vneighbors(qhT *qh, facetT *samecycle, facetT *newfacet) {
+  facetT *neighbor, **neighborp;
+  unsigned int mergeid;
+  vertexT *vertex, **vertexp, *apex;
+  setT *vertices;
+
+  trace4((qh, qh->ferr, 4035, "qh_mergecycle_vneighbors: update vertex neighbors for newfacet\n"));
+  mergeid= qh->visit_id - 1;
+  newfacet->visitid= mergeid;
+  vertices= qh_basevertices(qh, samecycle); /* temp */
+  apex= SETfirstt_(samecycle->vertices, vertexT);
+  qh_setappend(qh, &vertices, apex);
+  FOREACHvertex_(vertices) {
+    vertex->delridge= True;
+    FOREACHneighbor_(vertex) {
+      if (neighbor->visitid == mergeid)
+        SETref_(neighbor)= NULL;
+    }
+    qh_setcompact(qh, vertex->neighbors);
+    qh_setappend(qh, &vertex->neighbors, newfacet);
+    if (!SETsecond_(vertex->neighbors)) {
+      zinc_(Zcyclevertex);
+      trace2((qh, qh->ferr, 2034, "qh_mergecycle_vneighbors: deleted v%d when merging cycle f%d into f%d\n",
+        vertex->id, samecycle->id, newfacet->id));
+      qh_setdelsorted(newfacet->vertices, vertex);
+      vertex->deleted= True;
+      qh_setappend(qh, &qh->del_vertices, vertex);
+    }
+  }
+  qh_settempfree(qh, &vertices);
+  trace3((qh, qh->ferr, 3005, "qh_mergecycle_vneighbors: merged vertices from cycle f%d into f%d\n",
+             samecycle->id, newfacet->id));
+} /* mergecycle_vneighbors */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergefacet">-</a>
+
+  qh_mergefacet(qh, facet1, facet2, mergetype, mindist, maxdist, mergeapex )
+    merges facet1 into facet2
+    mergeapex==qh_MERGEapex if merging new facet into coplanar horizon (optimizes qh_mergesimplex)
+
+  returns:
+    qh.max_outside and qh.min_vertex updated
+    initializes vertex neighbors on first merge
+
+  note:
+    mergetype only used for logging and error reporting
+
+  returns:
+    facet2 contains facet1's vertices, neighbors, and ridges
+      facet2 moved to end of qh.facet_list
+      makes facet2 a newfacet
+      sets facet2->newmerge set
+      clears facet2->center (unless merging into a large facet)
+      clears facet2->tested and ridge->tested for facet1
+
+    facet1 prepended to visible_list for later deletion and partitioning
+      facet1->f.replace == facet2
+
+    adds neighboring facets to facet_mergeset if redundant or degenerate
+
+  notes:
+    when done, tests facet1 and facet2 for degenerate or redundant neighbors and dupridges
+    mindist/maxdist may be NULL (only if both NULL)
+    traces merge if fmax_(maxdist,-mindist) > TRACEdist
+
+  see:
+    qh_mergecycle()
+
+  design:
+    trace merge and check for degenerate simplex
+    make ridges for both facets
+    update qh.max_outside, qh.max_vertex, qh.min_vertex
+    update facet2->maxoutside and keepcentrum
+    update facet2->nummerge
+    update tested flags for facet2
+    if facet1 is simplicial
+      merge facet1 into facet2
+    else
+      merge facet1's neighbors into facet2
+      merge facet1's ridges into facet2
+      merge facet1's vertices into facet2
+      merge facet1's vertex neighbors into facet2
+      add facet2's vertices to qh.new_vertexlist
+    move facet2 to end of qh.newfacet_list
+    unless MRGcoplanarhorizon
+      test facet2 for redundant neighbors
+      test facet1 for degenerate neighbors
+      test for redundant facet2
+      maybe test for duplicate ridges ('Q15')
+    move facet1 to qh.visible_list for later deletion
+*/
+void qh_mergefacet(qhT *qh, facetT *facet1, facetT *facet2, mergeType mergetype, realT *mindist, realT *maxdist, boolT mergeapex) {
+  boolT traceonce= False;
+  vertexT *vertex, **vertexp;
+  realT mintwisted, vertexdist;
+  realT onemerge;
+  int tracerestore=0, nummerge;
+  const char *mergename;
+
+  if(mergetype > 0 && mergetype < sizeof(mergetypes)/sizeof(char *))
+    mergename= mergetypes[mergetype];
+  else
+    mergename= mergetypes[MRGnone];
+  if (facet1->tricoplanar || facet2->tricoplanar) {
+    if (!qh->TRInormals) {
+      qh_fprintf(qh, qh->ferr, 6226, "qhull internal error (qh_mergefacet): merge f%d into f%d for mergetype %d (%s) does not work for tricoplanar facets.  Use option 'Q11'\n",
+        facet1->id, facet2->id, mergetype, mergename);
+      qh_errexit2(qh, qh_ERRqhull, facet1, facet2);
+    }
+    if (facet2->tricoplanar) {
+      facet2->tricoplanar= False;
+      facet2->keepcentrum= False;
+    }
+  }
+  zzinc_(Ztotmerge);
+  if (qh->REPORTfreq2 && qh->POSTmerging) {
+    if (zzval_(Ztotmerge) > qh->mergereport + qh->REPORTfreq2)
+      qh_tracemerging(qh);
+  }
+#ifndef qh_NOtrace
+  if (qh->build_cnt >= qh->RERUN) {
+    if (mindist && (-*mindist > qh->TRACEdist || *maxdist > qh->TRACEdist)) {
+      tracerestore= 0;
+      qh->IStracing= qh->TRACElevel;
+      traceonce= True;
+      qh_fprintf(qh, qh->ferr, 8075, "qh_mergefacet: ========= trace wide merge #%d(%2.2g) for f%d into f%d for mergetype %d (%s), last point was p%d\n",
+          zzval_(Ztotmerge), fmax_(-*mindist, *maxdist), facet1->id, facet2->id, mergetype, mergename, qh->furthest_id);
+    }else if (facet1 == qh->tracefacet || facet2 == qh->tracefacet) {
+      tracerestore= qh->IStracing;
+      qh->IStracing= 4;
+      traceonce= True;
+      qh_fprintf(qh, qh->ferr, 8076, "qh_mergefacet: ========= trace merge #%d for f%d into f%d for mergetype %d (%s), furthest is p%d\n",
+                 zzval_(Ztotmerge), facet1->id, facet2->id, mergetype, mergename, qh->furthest_id);
+    }
+  }
+  if (qh->IStracing >= 2) {
+    realT mergemin= -2;
+    realT mergemax= -2;
+
+    if (mindist) {
+      mergemin= *mindist;
+      mergemax= *maxdist;
+    }
+    qh_fprintf(qh, qh->ferr, 2081, "qh_mergefacet: #%d merge f%d into f%d for merge for mergetype %d (%s), mindist= %2.2g, maxdist= %2.2g, max_outside %2.2g\n",
+    zzval_(Ztotmerge), facet1->id, facet2->id, mergetype, mergename, mergemin, mergemax, qh->max_outside);
+  }
+#endif /* !qh_NOtrace */
+  if(!qh->ALLOWwide && mindist) {
+    mintwisted= qh_WIDEmaxoutside * qh->ONEmerge;  /* same as qh_merge_twisted and qh_check_maxout (poly2) */
+    maximize_(mintwisted, facet1->maxoutside);
+    maximize_(mintwisted, facet2->maxoutside);
+    if (*maxdist > mintwisted || -*mindist > mintwisted) {
+      vertexdist= qh_vertex_bestdist(qh, facet1->vertices);
+      onemerge= qh->ONEmerge + qh->DISTround;
+      if (vertexdist > mintwisted) {
+        qh_fprintf(qh, qh->ferr, 6347, "qhull precision error (qh_mergefacet): wide merge for facet f%d into f%d for mergetype %d (%s).  maxdist %2.2g (%.1fx) mindist %2.2g (%.1fx) vertexdist %2.2g  Allow with 'Q12' (allow-wide)\n",
+          facet1->id, facet2->id, mergetype, mergename, *maxdist, *maxdist/onemerge, *mindist, -*mindist/onemerge, vertexdist);
+      }else {
+        qh_fprintf(qh, qh->ferr, 6348, "qhull precision error (qh_mergefacet): wide merge for pinched facet f%d into f%d for mergetype %d (%s).  maxdist %2.2g (%.fx) mindist %2.2g (%.1fx) vertexdist %2.2g  Allow with 'Q12' (allow-wide)\n",
+          facet1->id, facet2->id, mergetype, mergename, *maxdist, *maxdist/onemerge, *mindist, -*mindist/onemerge, vertexdist);
+      }
+      qh_errexit2(qh, qh_ERRwide, facet1, facet2);
+    }
+  }
+  if (facet1 == facet2 || facet1->visible || facet2->visible) {
+    qh_fprintf(qh, qh->ferr, 6099, "qhull internal error (qh_mergefacet): either f%d and f%d are the same or one is a visible facet, mergetype %d (%s)\n",
+             facet1->id, facet2->id, mergetype, mergename);
+    qh_errexit2(qh, qh_ERRqhull, facet1, facet2);
+  }
+  if (qh->num_facets - qh->num_visible <= qh->hull_dim + 1) {
+    qh_fprintf(qh, qh->ferr, 6227, "qhull topology error: Only %d facets remain.  The input is too degenerate or the convexity constraints are too strong.\n", 
+          qh->hull_dim+1);
+    if (qh->hull_dim >= 5 && !qh->MERGEexact)
+      qh_fprintf(qh, qh->ferr, 8079, "    Option 'Qx' may avoid this problem.\n");
+    qh_errexit(qh, qh_ERRtopology, NULL, NULL);
+  }
+  if (!qh->VERTEXneighbors)
+    qh_vertexneighbors(qh);
+  qh_makeridges(qh, facet1);
+  qh_makeridges(qh, facet2);
+  if (qh->IStracing >=4)
+    qh_errprint(qh, "MERGING", facet1, facet2, NULL, NULL);
+  if (mindist) {
+    maximize_(qh->max_outside, *maxdist);
+    maximize_(qh->max_vertex, *maxdist);
+#if qh_MAXoutside
+    maximize_(facet2->maxoutside, *maxdist);
+#endif
+    minimize_(qh->min_vertex, *mindist);
+    if (!facet2->keepcentrum
+    && (*maxdist > qh->WIDEfacet || *mindist < -qh->WIDEfacet)) {
+      facet2->keepcentrum= True;
+      zinc_(Zwidefacet);
+    }
+  }
+  nummerge= facet1->nummerge + facet2->nummerge + 1;
+  if (nummerge >= qh_MAXnummerge)
+    facet2->nummerge= qh_MAXnummerge;
+  else
+    facet2->nummerge= (short unsigned int)nummerge; /* limited to 9 bits by qh_MAXnummerge, -Wconversion */
+  facet2->newmerge= True;
+  facet2->dupridge= False;
+  qh_updatetested(qh, facet1, facet2);
+  if (qh->hull_dim > 2 && qh_setsize(qh, facet1->vertices) == qh->hull_dim)
+    qh_mergesimplex(qh, facet1, facet2, mergeapex);
+  else {
+    qh->vertex_visit++;
+    FOREACHvertex_(facet2->vertices)
+      vertex->visitid= qh->vertex_visit;
+    if (qh->hull_dim == 2)
+      qh_mergefacet2d(qh, facet1, facet2);
+    else {
+      qh_mergeneighbors(qh, facet1, facet2);
+      qh_mergevertices(qh, facet1->vertices, &facet2->vertices);
+    }
+    qh_mergeridges(qh, facet1, facet2);
+    qh_mergevertex_neighbors(qh, facet1, facet2);
+    if (!facet2->newfacet)
+      qh_newvertices(qh, facet2->vertices);
+  }
+  if (facet2->coplanarhorizon) {
+    zinc_(Zmergeintocoplanar);
+  }else if (!facet2->newfacet) {
+    zinc_(Zmergeintohorizon);
+  }else if (!facet1->newfacet && facet2->newfacet) {
+    zinc_(Zmergehorizon);
+  }else {
+    zinc_(Zmergenew);
+  }
+  qh_removefacet(qh, facet2);  /* append as a newfacet to end of qh->facet_list */
+  qh_appendfacet(qh, facet2);
+  facet2->newfacet= True;
+  facet2->tested= False;
+  qh_tracemerge(qh, facet1, facet2, mergetype);
+  if (traceonce) {
+    qh_fprintf(qh, qh->ferr, 8080, "qh_mergefacet: end of wide tracing\n");
+    qh->IStracing= tracerestore;
+  }
+  if (mergetype != MRGcoplanarhorizon) {
+    trace3((qh, qh->ferr, 3076, "qh_mergefacet: check f%d and f%d for redundant and degenerate neighbors\n",
+        facet1->id, facet2->id));
+    qh_test_redundant_neighbors(qh, facet2);
+    qh_test_degen_neighbors(qh, facet1);  /* after qh_test_redundant_neighbors since MRGdegen more difficult than MRGredundant
+                                             and before qh_willdelete which clears facet1.neighbors */
+    qh_degen_redundant_facet(qh, facet2); /* may occur in qh_merge_pinchedvertices, e.g., rbox 175 C3,2e-13 D4 t1545228104 | qhull d */
+    qh_maybe_duplicateridges(qh, facet2);
+  }
+  qh_willdelete(qh, facet1, facet2);
+} /* mergefacet */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergefacet2d">-</a>
+
+  qh_mergefacet2d(qh, facet1, facet2 )
+    in 2d, merges neighbors and vertices of facet1 into facet2
+
+  returns:
+    build ridges for neighbors if necessary
+    facet2 looks like a simplicial facet except for centrum, ridges
+      neighbors are opposite the corresponding vertex
+      maintains orientation of facet2
+
+  notes:
+    qh_mergefacet() retains non-simplicial structures
+      they are not needed in 2d, but later routines may use them
+    preserves qh.vertex_visit for qh_mergevertex_neighbors()
+
+  design:
+    get vertices and neighbors
+    determine new vertices and neighbors
+    set new vertices and neighbors and adjust orientation
+    make ridges for new neighbor if needed
+*/
+void qh_mergefacet2d(qhT *qh, facetT *facet1, facetT *facet2) {
+  vertexT *vertex1A, *vertex1B, *vertex2A, *vertex2B, *vertexA, *vertexB;
+  facetT *neighbor1A, *neighbor1B, *neighbor2A, *neighbor2B, *neighborA, *neighborB;
+
+  vertex1A= SETfirstt_(facet1->vertices, vertexT);
+  vertex1B= SETsecondt_(facet1->vertices, vertexT);
+  vertex2A= SETfirstt_(facet2->vertices, vertexT);
+  vertex2B= SETsecondt_(facet2->vertices, vertexT);
+  neighbor1A= SETfirstt_(facet1->neighbors, facetT);
+  neighbor1B= SETsecondt_(facet1->neighbors, facetT);
+  neighbor2A= SETfirstt_(facet2->neighbors, facetT);
+  neighbor2B= SETsecondt_(facet2->neighbors, facetT);
+  if (vertex1A == vertex2A) {
+    vertexA= vertex1B;
+    vertexB= vertex2B;
+    neighborA= neighbor2A;
+    neighborB= neighbor1A;
+  }else if (vertex1A == vertex2B) {
+    vertexA= vertex1B;
+    vertexB= vertex2A;
+    neighborA= neighbor2B;
+    neighborB= neighbor1A;
+  }else if (vertex1B == vertex2A) {
+    vertexA= vertex1A;
+    vertexB= vertex2B;
+    neighborA= neighbor2A;
+    neighborB= neighbor1B;
+  }else { /* 1B == 2B */
+    vertexA= vertex1A;
+    vertexB= vertex2A;
+    neighborA= neighbor2B;
+    neighborB= neighbor1B;
+  }
+  /* vertexB always from facet2, neighborB always from facet1 */
+  if (vertexA->id > vertexB->id) {
+    SETfirst_(facet2->vertices)= vertexA;
+    SETsecond_(facet2->vertices)= vertexB;
+    if (vertexB == vertex2A)
+      facet2->toporient= !facet2->toporient;
+    SETfirst_(facet2->neighbors)= neighborA;
+    SETsecond_(facet2->neighbors)= neighborB;
+  }else {
+    SETfirst_(facet2->vertices)= vertexB;
+    SETsecond_(facet2->vertices)= vertexA;
+    if (vertexB == vertex2B)
+      facet2->toporient= !facet2->toporient;
+    SETfirst_(facet2->neighbors)= neighborB;
+    SETsecond_(facet2->neighbors)= neighborA;
+  }
+  /* qh_makeridges not needed since neighborB is not degenerate */
+  qh_setreplace(qh, neighborB->neighbors, facet1, facet2);
+  trace4((qh, qh->ferr, 4036, "qh_mergefacet2d: merged v%d and neighbor f%d of f%d into f%d\n",
+       vertexA->id, neighborB->id, facet1->id, facet2->id));
+} /* mergefacet2d */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergeneighbors">-</a>
+
+  qh_mergeneighbors(qh, facet1, facet2 )
+    merges the neighbors of facet1 into facet2
+
+  notes:
+    only called by qh_mergefacet
+    qh.hull_dim >= 3
+    see qh_mergecycle_neighbors
+
+  design:
+    for each neighbor of facet1
+      if neighbor is also a neighbor of facet2
+        if neighbor is simplicial
+          make ridges for later deletion as a degenerate facet
+        update its neighbor set
+      else
+        move the neighbor relation to facet2
+    remove the neighbor relation for facet1 and facet2
+*/
+void qh_mergeneighbors(qhT *qh, facetT *facet1, facetT *facet2) {
+  facetT *neighbor, **neighborp;
+
+  trace4((qh, qh->ferr, 4037, "qh_mergeneighbors: merge neighbors of f%d and f%d\n",
+          facet1->id, facet2->id));
+  qh->visit_id++;
+  FOREACHneighbor_(facet2) {
+    neighbor->visitid= qh->visit_id;
+  }
+  FOREACHneighbor_(facet1) {
+    if (neighbor->visitid == qh->visit_id) {
+      if (neighbor->simplicial)    /* is degen, needs ridges */
+        qh_makeridges(qh, neighbor);
+      if (SETfirstt_(neighbor->neighbors, facetT) != facet1) /*keep newfacet->horizon*/
+        qh_setdel(neighbor->neighbors, facet1);
+      else {
+        qh_setdel(neighbor->neighbors, facet2);
+        qh_setreplace(qh, neighbor->neighbors, facet1, facet2);
+      }
+    }else if (neighbor != facet2) {
+      qh_setappend(qh, &(facet2->neighbors), neighbor);
+      qh_setreplace(qh, neighbor->neighbors, facet1, facet2);
+    }
+  }
+  qh_setdel(facet1->neighbors, facet2);  /* here for makeridges */
+  qh_setdel(facet2->neighbors, facet1);
+} /* mergeneighbors */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergeridges">-</a>
+
+  qh_mergeridges(qh, facet1, facet2 )
+    merges the ridge set of facet1 into facet2
+
+  returns:
+    may delete all ridges for a vertex
+    sets vertex->delridge on deleted ridges
+
+  see:
+    qh_mergecycle_ridges()
+
+  design:
+    delete ridges between facet1 and facet2
+      mark (delridge) vertices on these ridges for later testing
+    for each remaining ridge
+      rename facet1 to facet2
+*/
+void qh_mergeridges(qhT *qh, facetT *facet1, facetT *facet2) {
+  ridgeT *ridge, **ridgep;
+
+  trace4((qh, qh->ferr, 4038, "qh_mergeridges: merge ridges of f%d into f%d\n",
+          facet1->id, facet2->id));
+  FOREACHridge_(facet2->ridges) {
+    if ((ridge->top == facet1) || (ridge->bottom == facet1)) {
+      /* ridge.nonconvex is irrelevant due to merge */
+      qh_delridge_merge(qh, ridge);  /* expensive in high-d, could rebuild */
+      ridgep--; /* deleted this ridge, repeat with next ridge*/
+    }
+  }
+  FOREACHridge_(facet1->ridges) {
+    if (ridge->top == facet1) {
+      ridge->top= facet2;
+      ridge->simplicialtop= False;
+    }else { /* ridge.bottom is facet1 */
+      ridge->bottom= facet2;
+      ridge->simplicialbot= False;
+    }
+    qh_setappend(qh, &(facet2->ridges), ridge);
+  }
+} /* mergeridges */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergesimplex">-</a>
+
+  qh_mergesimplex(qh, facet1, facet2, mergeapex )
+    merge simplicial facet1 into facet2
+    mergeapex==qh_MERGEapex if merging samecycle into horizon facet
+      vertex id is latest (most recently created)
+    facet1 may be contained in facet2
+    ridges exist for both facets
+
+  returns:
+    facet2 with updated vertices, ridges, neighbors
+    updated neighbors for facet1's vertices
+    facet1 not deleted
+    sets vertex->delridge on deleted ridges
+
+  notes:
+    special case code since this is the most common merge
+    called from qh_mergefacet()
+
+  design:
+    if qh_MERGEapex
+      add vertices of facet2 to qh.new_vertexlist if necessary
+      add apex to facet2
+    else
+      for each ridge between facet1 and facet2
+        set vertex->delridge
+      determine the apex for facet1 (i.e., vertex to be merged)
+      unless apex already in facet2
+        insert apex into vertices for facet2
+      add vertices of facet2 to qh.new_vertexlist if necessary
+      add apex to qh.new_vertexlist if necessary
+      for each vertex of facet1
+        if apex
+          rename facet1 to facet2 in its vertex neighbors
+        else
+          delete facet1 from vertex neighbors
+          if only in facet2
+            add vertex to qh.del_vertices for later deletion
+      for each ridge of facet1
+        delete ridges between facet1 and facet2
+        append other ridges to facet2 after renaming facet to facet2
+*/
+void qh_mergesimplex(qhT *qh, facetT *facet1, facetT *facet2, boolT mergeapex) {
+  vertexT *vertex, **vertexp, *opposite;
+  ridgeT *ridge, **ridgep;
+  boolT isnew= False;
+  facetT *neighbor, **neighborp, *otherfacet;
+
+  if (mergeapex) {
+    opposite= SETfirstt_(facet1->vertices, vertexT); /* apex is opposite facet2.  It has the last vertex id */
+    trace4((qh, qh->ferr, 4086, "qh_mergesimplex: merge apex v%d of f%d into facet f%d\n",
+      opposite->id, facet1->id, facet2->id));
+    if (!facet2->newfacet)
+      qh_newvertices(qh, facet2->vertices);  /* apex, the first vertex, is already new */
+    if (SETfirstt_(facet2->vertices, vertexT) != opposite) {
+      qh_setaddnth(qh, &facet2->vertices, 0, opposite);
+      isnew= True;
+    }
+  }else {
+    zinc_(Zmergesimplex);
+    FOREACHvertex_(facet1->vertices)
+      vertex->seen= False;
+    FOREACHridge_(facet1->ridges) {
+      if (otherfacet_(ridge, facet1) == facet2) {
+        FOREACHvertex_(ridge->vertices) {
+          vertex->seen= True;
+          vertex->delridge= True;
+        }
+        break;
+      }
+    }
+    FOREACHvertex_(facet1->vertices) {
+      if (!vertex->seen)
+        break;  /* must occur */
+    }
+    opposite= vertex;
+    trace4((qh, qh->ferr, 4039, "qh_mergesimplex: merge opposite v%d of f%d into facet f%d\n",
+          opposite->id, facet1->id, facet2->id));
+    isnew= qh_addfacetvertex(qh, facet2, opposite);
+    if (!facet2->newfacet)
+      qh_newvertices(qh, facet2->vertices);
+    else if (!opposite->newfacet) {
+      qh_removevertex(qh, opposite);
+      qh_appendvertex(qh, opposite);
+    }
+  }
+  trace4((qh, qh->ferr, 4040, "qh_mergesimplex: update vertex neighbors of f%d\n",
+          facet1->id));
+  FOREACHvertex_(facet1->vertices) {
+    if (vertex == opposite && isnew)
+      qh_setreplace(qh, vertex->neighbors, facet1, facet2);
+    else {
+      qh_setdel(vertex->neighbors, facet1);
+      if (!SETsecond_(vertex->neighbors))
+        qh_mergevertex_del(qh, vertex, facet1, facet2);
+    }
+  }
+  trace4((qh, qh->ferr, 4041, "qh_mergesimplex: merge ridges and neighbors of f%d into f%d\n",
+          facet1->id, facet2->id));
+  qh->visit_id++;
+  FOREACHneighbor_(facet2)
+    neighbor->visitid= qh->visit_id;
+  FOREACHridge_(facet1->ridges) {
+    otherfacet= otherfacet_(ridge, facet1);
+    if (otherfacet == facet2) {
+      /* ridge.nonconvex is irrelevant due to merge */
+      qh_delridge_merge(qh, ridge);  /* expensive in high-d, could rebuild */
+      ridgep--; /* deleted this ridge, repeat with next ridge*/
+      qh_setdel(facet2->neighbors, facet1); /* a simplicial facet may have duplicate neighbors, need to delete each one */
+    }else if (otherfacet->dupridge && !qh_setin(otherfacet->neighbors, facet1)) {
+      qh_fprintf(qh, qh->ferr, 6356, "qhull topology error (qh_mergesimplex): f%d is a dupridge of f%d, cannot merge f%d into f%d\n",
+        facet1->id, otherfacet->id, facet1->id, facet2->id);
+      qh_errexit2(qh, qh_ERRqhull, facet1, otherfacet);
+    }else {
+      trace4((qh, qh->ferr, 4059, "qh_mergesimplex: move r%d with f%d to f%d, new neighbor? %d, maybe horizon? %d\n",
+        ridge->id, otherfacet->id, facet2->id, (otherfacet->visitid != qh->visit_id), (SETfirstt_(otherfacet->neighbors, facetT) == facet1)));
+      qh_setappend(qh, &facet2->ridges, ridge);
+      if (otherfacet->visitid != qh->visit_id) {
+        qh_setappend(qh, &facet2->neighbors, otherfacet);
+        qh_setreplace(qh, otherfacet->neighbors, facet1, facet2);
+        otherfacet->visitid= qh->visit_id;
+      }else {
+        if (otherfacet->simplicial)    /* is degen, needs ridges */
+          qh_makeridges(qh, otherfacet);
+        if (SETfirstt_(otherfacet->neighbors, facetT) == facet1) {
+          /* keep new, otherfacet->neighbors->horizon */
+          qh_setdel(otherfacet->neighbors, facet2);
+          qh_setreplace(qh, otherfacet->neighbors, facet1, facet2);
+        }else {
+          /* facet2 is already a neighbor of otherfacet, by f.visitid */
+          qh_setdel(otherfacet->neighbors, facet1);
+        }
+      }
+      if (ridge->top == facet1) { /* wait until after qh_makeridges */
+        ridge->top= facet2;
+        ridge->simplicialtop= False;
+      }else {
+        ridge->bottom= facet2;
+        ridge->simplicialbot= False;
+      }
+    }
+  }
+  trace3((qh, qh->ferr, 3006, "qh_mergesimplex: merged simplex f%d v%d into facet f%d\n",
+          facet1->id, opposite->id, facet2->id));
+} /* mergesimplex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergevertex_del">-</a>
+
+  qh_mergevertex_del(qh, vertex, facet1, facet2 )
+    delete a vertex because of merging facet1 into facet2
+
+  returns:
+    deletes vertex from facet2
+    adds vertex to qh.del_vertices for later deletion
+*/
+void qh_mergevertex_del(qhT *qh, vertexT *vertex, facetT *facet1, facetT *facet2) {
+
+  zinc_(Zmergevertex);
+  trace2((qh, qh->ferr, 2035, "qh_mergevertex_del: deleted v%d when merging f%d into f%d\n",
+          vertex->id, facet1->id, facet2->id));
+  qh_setdelsorted(facet2->vertices, vertex);
+  vertex->deleted= True;
+  qh_setappend(qh, &qh->del_vertices, vertex);
+} /* mergevertex_del */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergevertex_neighbors">-</a>
+
+  qh_mergevertex_neighbors(qh, facet1, facet2 )
+    merge the vertex neighbors of facet1 to facet2
+
+  returns:
+    if vertex is current qh.vertex_visit
+      deletes facet1 from vertex->neighbors
+    else
+      renames facet1 to facet2 in vertex->neighbors
+    deletes vertices if only one neighbor
+
+  notes:
+    assumes vertex neighbor sets are good
+*/
+void qh_mergevertex_neighbors(qhT *qh, facetT *facet1, facetT *facet2) {
+  vertexT *vertex, **vertexp;
+
+  trace4((qh, qh->ferr, 4042, "qh_mergevertex_neighbors: merge vertex neighborset for f%d into f%d\n",
+          facet1->id, facet2->id));
+  if (qh->tracevertex) {
+    qh_fprintf(qh, qh->ferr, 8081, "qh_mergevertex_neighbors: of f%d into f%d at furthest p%d f0= %p\n",
+             facet1->id, facet2->id, qh->furthest_id, qh->tracevertex->neighbors->e[0].p);
+    qh_errprint(qh, "TRACE", NULL, NULL, NULL, qh->tracevertex);
+  }
+  FOREACHvertex_(facet1->vertices) {
+    if (vertex->visitid != qh->vertex_visit)
+      qh_setreplace(qh, vertex->neighbors, facet1, facet2);
+    else {
+      qh_setdel(vertex->neighbors, facet1);
+      if (!SETsecond_(vertex->neighbors))
+        qh_mergevertex_del(qh, vertex, facet1, facet2);
+    }
+  }
+  if (qh->tracevertex)
+    qh_errprint(qh, "TRACE", NULL, NULL, NULL, qh->tracevertex);
+} /* mergevertex_neighbors */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="mergevertices">-</a>
+
+  qh_mergevertices(qh, vertices1, vertices2 )
+    merges the vertex set of facet1 into facet2
+
+  returns:
+    replaces vertices2 with merged set
+    preserves vertex_visit for qh_mergevertex_neighbors
+    updates qh.newvertex_list
+
+  design:
+    create a merged set of both vertices (in inverse id order)
+*/
+void qh_mergevertices(qhT *qh, setT *vertices1, setT **vertices2) {
+  int newsize= qh_setsize(qh, vertices1)+qh_setsize(qh, *vertices2) - qh->hull_dim + 1;
+  setT *mergedvertices;
+  vertexT *vertex, **vertexp, **vertex2= SETaddr_(*vertices2, vertexT);
+
+  mergedvertices= qh_settemp(qh, newsize);
+  FOREACHvertex_(vertices1) {
+    if (!*vertex2 || vertex->id > (*vertex2)->id)
+      qh_setappend(qh, &mergedvertices, vertex);
+    else {
+      while (*vertex2 && (*vertex2)->id > vertex->id)
+        qh_setappend(qh, &mergedvertices, *vertex2++);
+      if (!*vertex2 || (*vertex2)->id < vertex->id)
+        qh_setappend(qh, &mergedvertices, vertex);
+      else
+        qh_setappend(qh, &mergedvertices, *vertex2++);
+    }
+  }
+  while (*vertex2)
+    qh_setappend(qh, &mergedvertices, *vertex2++);
+  if (newsize < qh_setsize(qh, mergedvertices)) {
+    qh_fprintf(qh, qh->ferr, 6100, "qhull internal error (qh_mergevertices): facets did not share a ridge\n");
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh_setfree(qh, vertices2);
+  *vertices2= mergedvertices;
+  qh_settemppop(qh);
+} /* mergevertices */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="neighbor_intersections">-</a>
+
+  qh_neighbor_intersections(qh, vertex )
+    return intersection of all vertices in vertex->neighbors except for vertex
+
+  returns:
+    returns temporary set of vertices
+    does not include vertex
+    NULL if a neighbor is simplicial
+    NULL if empty set
+
+  notes:
+    only called by qh_redundant_vertex for qh_reducevertices
+      so f.vertices does not contain extraneous vertices that are not in f.ridges
+    used for renaming vertices
+
+  design:
+    initialize the intersection set with vertices of the first two neighbors
+    delete vertex from the intersection
+    for each remaining neighbor
+      intersect its vertex set with the intersection set
+      return NULL if empty
+    return the intersection set
+*/
+setT *qh_neighbor_intersections(qhT *qh, vertexT *vertex) {
+  facetT *neighbor, **neighborp, *neighborA, *neighborB;
+  setT *intersect;
+  int neighbor_i, neighbor_n;
+
+  FOREACHneighbor_(vertex) {
+    if (neighbor->simplicial)
+      return NULL;
+  }
+  neighborA= SETfirstt_(vertex->neighbors, facetT);
+  neighborB= SETsecondt_(vertex->neighbors, facetT);
+  zinc_(Zintersectnum);
+  if (!neighborA)
+    return NULL;
+  if (!neighborB)
+    intersect= qh_setcopy(qh, neighborA->vertices, 0);
+  else
+    intersect= qh_vertexintersect_new(qh, neighborA->vertices, neighborB->vertices);
+  qh_settemppush(qh, intersect);
+  qh_setdelsorted(intersect, vertex);
+  FOREACHneighbor_i_(qh, vertex) {
+    if (neighbor_i >= 2) {
+      zinc_(Zintersectnum);
+      qh_vertexintersect(qh, &intersect, neighbor->vertices);
+      if (!SETfirst_(intersect)) {
+        zinc_(Zintersectfail);
+        qh_settempfree(qh, &intersect);
+        return NULL;
+      }
+    }
+  }
+  trace3((qh, qh->ferr, 3007, "qh_neighbor_intersections: %d vertices in neighbor intersection of v%d\n",
+          qh_setsize(qh, intersect), vertex->id));
+  return intersect;
+} /* neighbor_intersections */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="neighbor_vertices">-</a>
+
+  qh_neighbor_vertices(qh, vertex )
+    return neighboring vertices for a vertex (not in subridge)
+    assumes vertices have full vertex->neighbors
+
+  returns:
+    temporary set of vertices
+
+  notes:
+    updates qh.visit_id and qh.vertex_visit
+    similar to qh_vertexridges
+
+*/
+setT *qh_neighbor_vertices(qhT *qh, vertexT *vertexA, setT *subridge) {
+  facetT *neighbor, **neighborp;
+  vertexT *vertex, **vertexp;
+  setT *vertices= qh_settemp(qh, qh->TEMPsize);
+
+  qh->visit_id++;
+  FOREACHneighbor_(vertexA)
+    neighbor->visitid= qh->visit_id;
+  qh->vertex_visit++;
+  vertexA->visitid= qh->vertex_visit;
+  FOREACHvertex_(subridge) {
+    vertex->visitid= qh->vertex_visit;
+  }
+  FOREACHneighbor_(vertexA) {
+    if (*neighborp)   /* no new ridges in last neighbor */
+      qh_neighbor_vertices_facet(qh, vertexA, neighbor, &vertices);
+  }
+  trace3((qh, qh->ferr, 3035, "qh_neighbor_vertices: %d non-subridge, vertex neighbors for v%d\n",
+    qh_setsize(qh, vertices), vertexA->id));
+  return vertices;
+} /* neighbor_vertices */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="neighbor_vertices_facet">-</a>
+
+  qh_neighbor_vertices_facet(qh, vertex, facet, vertices )
+    add neighboring vertices on ridges for vertex in facet
+    neighbor->visitid==qh.visit_id if it hasn't been visited
+    v.visitid==qh.vertex_visit if it is already in vertices
+
+  returns:
+    vertices updated
+    sets facet->visitid to qh.visit_id-1
+
+  notes:
+    only called by qh_neighbor_vertices
+    similar to qh_vertexridges_facet
+
+  design:
+    for each ridge of facet
+      if ridge of visited neighbor (i.e., unprocessed)
+        if vertex in ridge
+          append unprocessed vertices of ridge
+    mark facet processed
+*/
+void qh_neighbor_vertices_facet(qhT *qh, vertexT *vertexA, facetT *facet, setT **vertices) {
+  ridgeT *ridge, **ridgep;
+  facetT *neighbor;
+  vertexT *second, *last, *vertex, **vertexp;
+  int last_i= qh->hull_dim-2, count= 0;
+  boolT isridge;
+
+  if (facet->simplicial) {
+    FOREACHvertex_(facet->vertices) {
+      if (vertex->visitid != qh->vertex_visit) {
+        vertex->visitid= qh->vertex_visit;
+        qh_setappend(qh, vertices, vertex);
+        count++;
+      }
+    }
+  }else {
+    FOREACHridge_(facet->ridges) {
+      neighbor= otherfacet_(ridge, facet);
+      if (neighbor->visitid == qh->visit_id) {
+        isridge= False;
+        if (SETfirst_(ridge->vertices) == vertexA) {
+          isridge= True;
+        }else if (last_i > 2) {
+          second= SETsecondt_(ridge->vertices, vertexT);
+          last= SETelemt_(ridge->vertices, last_i, vertexT);
+          if (second->id >= vertexA->id && last->id <= vertexA->id) { /* vertices inverse sorted by id */
+            if (second == vertexA || last == vertexA)
+              isridge= True;
+            else if (qh_setin(ridge->vertices, vertexA))
+              isridge= True;
+          }
+        }else if (SETelem_(ridge->vertices, last_i) == vertexA) {
+          isridge= True;
+        }else if (last_i > 1 && SETsecond_(ridge->vertices) == vertexA) {
+          isridge= True;
+        }
+        if (isridge) {
+          FOREACHvertex_(ridge->vertices) {
+            if (vertex->visitid != qh->vertex_visit) {
+              vertex->visitid= qh->vertex_visit;
+              qh_setappend(qh, vertices, vertex);
+              count++;
+            }
+          }
+        }
+      }
+    }
+  }
+  facet->visitid= qh->visit_id-1;
+  if (count) {
+    trace4((qh, qh->ferr, 4079, "qh_neighbor_vertices_facet: found %d vertex neighbors for v%d in f%d (simplicial? %d)\n",
+      count, vertexA->id, facet->id, facet->simplicial));
+  }
+} /* neighbor_vertices_facet */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="newvertices">-</a>
+
+  qh_newvertices(qh, vertices )
+    add vertices to end of qh.vertex_list (marks as new vertices)
+
+  returns:
+    vertices on qh.newvertex_list
+    vertex->newfacet set
+*/
+void qh_newvertices(qhT *qh, setT *vertices) {
+  vertexT *vertex, **vertexp;
+
+  FOREACHvertex_(vertices) {
+    if (!vertex->newfacet) {
+      qh_removevertex(qh, vertex);
+      qh_appendvertex(qh, vertex);
+    }
+  }
+} /* newvertices */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="next_vertexmerge">-</a>
+
+  qh_next_vertexmerge(qh )
+    return next vertex merge from qh.vertex_mergeset
+
+  returns:
+    vertex merge either MRGvertices or MRGsubridge
+    drops merges of deleted vertices
+
+  notes:
+    called from qh_merge_pinchedvertices
+*/
+mergeT *qh_next_vertexmerge(qhT *qh /* qh.vertex_mergeset */) {
+  mergeT *merge;
+  int merge_i, merge_n, best_i= -1;
+  realT bestdist= REALmax;
+
+  FOREACHmerge_i_(qh, qh->vertex_mergeset) {
+    if (!merge->vertex1 || !merge->vertex2) {
+      qh_fprintf(qh, qh->ferr, 6299, "qhull internal error (qh_next_vertexmerge): expecting two vertices for vertex merge.  Got v%d v%d and optional f%d\n",
+        getid_(merge->vertex1), getid_(merge->vertex2), getid_(merge->facet1));
+      qh_errexit(qh, qh_ERRqhull, merge->facet1, NULL);
+    }
+    if (merge->vertex1->deleted || merge->vertex2->deleted) {
+      trace3((qh, qh->ferr, 3030, "qh_next_vertexmerge: drop merge of v%d (del? %d) into v%d (del? %d) due to deleted vertex of r%d and r%d\n",
+        merge->vertex1->id, merge->vertex1->deleted, merge->vertex2->id, merge->vertex2->deleted, getid_(merge->ridge1), getid_(merge->ridge2)));
+      qh_drop_mergevertex(qh, merge);
+      qh_setdelnth(qh, qh->vertex_mergeset, merge_i);
+      merge_i--; merge_n--;
+      qh_memfree(qh, merge, (int)sizeof(mergeT));
+    }else if (merge->distance < bestdist) {
+      bestdist= merge->distance;
+      best_i= merge_i;
+    }
+  }
+  merge= NULL;
+  if (best_i >= 0) {
+    merge= SETelemt_(qh->vertex_mergeset, best_i, mergeT);
+    if (bestdist/qh->ONEmerge > qh_WIDEpinched) {
+      if (merge->mergetype==MRGvertices) {
+        if (merge->ridge1->top == merge->ridge2->bottom && merge->ridge1->bottom == merge->ridge2->top)
+          qh_fprintf(qh, qh->ferr, 6391, "qhull topology error (qh_next_vertexmerge): no nearly adjacent vertices to resolve opposite oriented ridges r%d and r%d in f%d and f%d.  Nearest v%d and v%d dist %2.2g (%.1fx)\n",
+            merge->ridge1->id, merge->ridge2->id, merge->ridge1->top->id, merge->ridge1->bottom->id, merge->vertex1->id, merge->vertex2->id, bestdist, bestdist/qh->ONEmerge);
+        else
+          qh_fprintf(qh, qh->ferr, 6381, "qhull topology error (qh_next_vertexmerge): no nearly adjacent vertices to resolve duplicate ridges r%d and r%d.  Nearest v%d and v%d dist %2.2g (%.1fx)\n",
+            merge->ridge1->id, merge->ridge2->id, merge->vertex1->id, merge->vertex2->id, bestdist, bestdist/qh->ONEmerge);
+      }else {
+        qh_fprintf(qh, qh->ferr, 6208, "qhull topology error (qh_next_vertexmerge): no nearly adjacent vertices to resolve dupridge.  Nearest v%d and v%d dist %2.2g (%.1fx)\n",
+          merge->vertex1->id, merge->vertex2->id, bestdist, bestdist/qh->ONEmerge);
+      }
+      /* it may be possible to find a different vertex, after other vertex merges have occurred */
+      qh_errexit(qh, qh_ERRtopology, NULL, merge->ridge1);
+    }
+    qh_setdelnth(qh, qh->vertex_mergeset, best_i);
+  }
+  return merge;
+} /* next_vertexmerge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="opposite_horizonfacet">-</a>
+
+  qh_opposite_horizonfacet(qh, merge, opposite )
+    return horizon facet for one of the merge facets, and its opposite vertex across the ridge
+    assumes either facet1 or facet2 of merge is 'mergehorizon'
+    assumes both facets are simplicial facets on qh.new_facetlist
+
+  returns:
+    horizon facet and opposite vertex
+
+  notes:
+    called by qh_getpinchedmerges
+*/
+facetT *qh_opposite_horizonfacet(qhT *qh, mergeT *merge, vertexT **opposite) {
+  facetT *facet, *horizon, *otherfacet;
+  int neighbor_i;
+
+  if (!merge->facet1->simplicial || !merge->facet2->simplicial || (!merge->facet1->mergehorizon && !merge->facet2->mergehorizon)) {
+    qh_fprintf(qh, qh->ferr, 6273, "qhull internal error (qh_opposite_horizonfacet): expecting merge of simplicial facets, at least one of which is mergehorizon.  Either simplicial or mergehorizon is wrong\n");
+    qh_errexit2(qh, qh_ERRqhull, merge->facet1, merge->facet2);
+  }
+  if (merge->facet1->mergehorizon) {
+    facet= merge->facet1;
+    otherfacet= merge->facet2;
+  }else {
+    facet= merge->facet2;
+    otherfacet= merge->facet1;
+  }
+  horizon= SETfirstt_(facet->neighbors, facetT);
+  neighbor_i= qh_setindex(otherfacet->neighbors, facet);
+  if (neighbor_i==-1)
+    neighbor_i= qh_setindex(otherfacet->neighbors, qh_MERGEridge);
+  if (neighbor_i==-1) {
+    qh_fprintf(qh, qh->ferr, 6238, "qhull internal error (qh_opposite_horizonfacet): merge facet f%d not connected to mergehorizon f%d\n",
+      otherfacet->id, facet->id);
+    qh_errexit2(qh, qh_ERRqhull, otherfacet, facet);
+  }
+  *opposite= SETelemt_(otherfacet->vertices, neighbor_i, vertexT);
+  return horizon;
+} /* opposite_horizonfacet */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="reducevertices">-</a>
+
+  qh_reducevertices(qh)
+    reduce extra vertices, shared vertices, and redundant vertices
+    facet->newmerge is set if merged since last call
+    vertex->delridge is set if vertex was on a deleted ridge
+    if !qh.MERGEvertices, only removes extra vertices
+
+  returns:
+    True if also merged degen_redundant facets
+    vertices are renamed if possible
+    clears facet->newmerge and vertex->delridge
+
+  notes:
+    called by qh_all_merges and qh_postmerge
+    ignored if 2-d
+
+  design:
+    merge any degenerate or redundant facets
+    repeat until no more degenerate or redundant facets
+      for each newly merged facet
+        remove extra vertices
+      if qh.MERGEvertices
+        for each newly merged facet
+          for each vertex
+            if vertex was on a deleted ridge
+              rename vertex if it is shared
+        for each new, undeleted vertex
+          remove delridge flag
+          if vertex is redundant
+            merge degenerate or redundant facets
+*/
+boolT qh_reducevertices(qhT *qh) {
+  int numshare=0, numrename= 0;
+  boolT degenredun= False;
+  facetT *newfacet;
+  vertexT *vertex, **vertexp;
+
+  if (qh->hull_dim == 2)
+    return False;
+  trace2((qh, qh->ferr, 2101, "qh_reducevertices: reduce extra vertices, shared vertices, and redundant vertices\n"));
+  if (qh_merge_degenredundant(qh))
+    degenredun= True;
+LABELrestart:
+  FORALLnew_facets {
+    if (newfacet->newmerge) {
+      if (!qh->MERGEvertices)
+        newfacet->newmerge= False;
+      if (qh_remove_extravertices(qh, newfacet)) {
+        qh_degen_redundant_facet(qh, newfacet);
+        if (qh_merge_degenredundant(qh)) {
+          degenredun= True;
+          goto LABELrestart;
+        }
+      }
+    }
+  }
+  if (!qh->MERGEvertices)
+    return False;
+  FORALLnew_facets {
+    if (newfacet->newmerge) {
+      newfacet->newmerge= False;
+      FOREACHvertex_(newfacet->vertices) {
+        if (vertex->delridge) {
+          if (qh_rename_sharedvertex(qh, vertex, newfacet)) {
+            numshare++;
+            if (qh_merge_degenredundant(qh)) {
+              degenredun= True;
+              goto LABELrestart;
+            }
+            vertexp--; /* repeat since deleted vertex */
+          }
+        }
+      }
+    }
+  }
+  FORALLvertex_(qh->newvertex_list) {
+    if (vertex->delridge && !vertex->deleted) {
+      vertex->delridge= False;
+      if (qh->hull_dim >= 4 && qh_redundant_vertex(qh, vertex)) {
+        numrename++;
+        if (qh_merge_degenredundant(qh)) {
+          degenredun= True;
+          goto LABELrestart;
+        }
+      }
+    }
+  }
+  trace1((qh, qh->ferr, 1014, "qh_reducevertices: renamed %d shared vertices and %d redundant vertices. Degen? %d\n",
+          numshare, numrename, degenredun));
+  return degenredun;
+} /* reducevertices */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="redundant_vertex">-</a>
+
+  qh_redundant_vertex(qh, vertex )
+    rename a redundant vertex if qh_find_newvertex succeeds
+    assumes vertices have full vertex->neighbors
+
+  returns:
+    if find a replacement vertex
+      returns new vertex
+      qh_renamevertex sets vertex->deleted for redundant vertex
+
+  notes:
+    only called by qh_reducevertices for vertex->delridge and hull_dim >= 4
+    may add degenerate facets to qh.facet_mergeset
+    doesn't change vertex->neighbors or create redundant facets
+
+  design:
+    intersect vertices of all facet neighbors of vertex
+    determine ridges for these vertices
+    if find a new vertex for vertex among these ridges and vertices
+      rename vertex to the new vertex
+*/
+vertexT *qh_redundant_vertex(qhT *qh, vertexT *vertex) {
+  vertexT *newvertex= NULL;
+  setT *vertices, *ridges;
+
+  trace3((qh, qh->ferr, 3008, "qh_redundant_vertex: check if v%d from a deleted ridge can be renamed\n", vertex->id));
+  if ((vertices= qh_neighbor_intersections(qh, vertex))) {
+    ridges= qh_vertexridges(qh, vertex, !qh_ALL);
+    if ((newvertex= qh_find_newvertex(qh, vertex, vertices, ridges))) {
+      zinc_(Zrenameall);
+      qh_renamevertex(qh, vertex, newvertex, ridges, NULL, NULL); /* ridges invalidated */
+    }
+    qh_settempfree(qh, &ridges);
+    qh_settempfree(qh, &vertices);
+  }
+  return newvertex;
+} /* redundant_vertex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="remove_extravertices">-</a>
+
+  qh_remove_extravertices(qh, facet )
+    remove extra vertices from non-simplicial facets
+
+  returns:
+    returns True if it finds them
+      deletes facet from vertex neighbors
+      facet may be redundant (test with qh_degen_redundant)
+
+  notes:
+    called by qh_renamevertex and qh_reducevertices
+    a merge (qh_reducevertices) or qh_renamevertex may drop all ridges for a vertex in a facet
+
+  design:
+    for each vertex in facet
+      if vertex not in a ridge (i.e., no longer used)
+        delete vertex from facet
+        delete facet from vertex's neighbors
+        unless vertex in another facet
+          add vertex to qh.del_vertices for later deletion
+*/
+boolT qh_remove_extravertices(qhT *qh, facetT *facet) {
+  ridgeT *ridge, **ridgep;
+  vertexT *vertex, **vertexp;
+  boolT foundrem= False;
+
+  if (facet->simplicial) {
+    return False;
+  }
+  trace4((qh, qh->ferr, 4043, "qh_remove_extravertices: test non-simplicial f%d for extra vertices\n",
+          facet->id));
+  FOREACHvertex_(facet->vertices)
+    vertex->seen= False;
+  FOREACHridge_(facet->ridges) {
+    FOREACHvertex_(ridge->vertices)
+      vertex->seen= True;
+  }
+  FOREACHvertex_(facet->vertices) {
+    if (!vertex->seen) {
+      foundrem= True;
+      zinc_(Zremvertex);
+      qh_setdelsorted(facet->vertices, vertex);
+      qh_setdel(vertex->neighbors, facet);
+      if (!qh_setsize(qh, vertex->neighbors)) {
+        vertex->deleted= True;
+        qh_setappend(qh, &qh->del_vertices, vertex);
+        zinc_(Zremvertexdel);
+        trace2((qh, qh->ferr, 2036, "qh_remove_extravertices: v%d deleted because it's lost all ridges\n", vertex->id));
+      }else
+        trace3((qh, qh->ferr, 3009, "qh_remove_extravertices: v%d removed from f%d because it's lost all ridges\n", vertex->id, facet->id));
+      vertexp--; /*repeat*/
+    }
+  }
+  return foundrem;
+} /* remove_extravertices */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="remove_mergetype">-</a>
+
+  qh_remove_mergetype(qh, mergeset, mergetype )
+    Remove mergetype merges from mergeset
+
+  notes:
+    Does not preserve order
+*/
+void qh_remove_mergetype(qhT *qh, setT *mergeset, mergeType type) {
+  mergeT *merge;
+  int merge_i, merge_n;
+
+  FOREACHmerge_i_(qh, mergeset) {
+    if (merge->mergetype == type) {
+        trace3((qh, qh->ferr, 3037, "qh_remove_mergetype: remove merge f%d f%d v%d v%d r%d r%d dist %2.2g type %d",
+            getid_(merge->facet1), getid_(merge->facet2), getid_(merge->vertex1), getid_(merge->vertex2), getid_(merge->ridge1), getid_(merge->ridge2), merge->distance, type));
+        qh_setdelnth(qh, mergeset, merge_i);
+        merge_i--; merge_n--;  /* repeat with next merge */
+    }
+  }
+} /* remove_mergetype */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="rename_adjacentvertex">-</a>
+
+  qh_rename_adjacentvertex(qh, oldvertex, newvertex )
+    renames oldvertex as newvertex.  Must be adjacent (i.e., in the same subridge)
+    no-op if either vertex is deleted
+
+  notes:
+    called from qh_merge_pinchedvertices
+
+  design:
+    for all neighbors of oldvertex
+      if simplicial, rename oldvertex to newvertex and drop if degenerate
+      if needed, add oldvertex neighbor to newvertex
+    determine ridges for oldvertex
+    rename oldvertex as newvertex in ridges (qh_renamevertex)
+*/
+void qh_rename_adjacentvertex(qhT *qh, vertexT *oldvertex, vertexT *newvertex, realT dist) {
+  setT *ridges;
+  facetT *neighbor, **neighborp, *maxfacet= NULL;
+  ridgeT *ridge, **ridgep;
+  boolT istrace= False;
+  int oldsize= qh_setsize(qh, oldvertex->neighbors);
+  int newsize= qh_setsize(qh, newvertex->neighbors);
+  coordT maxdist2= -REALmax, dist2;
+
+  if (qh->IStracing >= 4 || oldvertex->id == qh->tracevertex_id || newvertex->id == qh->tracevertex_id) {
+    istrace= True;
+  }
+  zzinc_(Ztotmerge);
+  if (istrace) {
+    qh_fprintf(qh, qh->ferr, 2071, "qh_rename_adjacentvertex: merge #%d rename v%d (%d neighbors) to v%d (%d neighbors) dist %2.2g\n",
+      zzval_(Ztotmerge), oldvertex->id, oldsize, newvertex->id, newsize, dist);
+  }
+  if (oldvertex->deleted || newvertex->deleted) {
+    if (istrace || qh->IStracing >= 2) {
+      qh_fprintf(qh, qh->ferr, 2072, "qh_rename_adjacentvertex: ignore rename.  Either v%d (%d) or v%d (%d) is deleted\n",
+        oldvertex->id, oldvertex->deleted, newvertex->id, newvertex->deleted);
+    }
+    return;
+  }
+  if (oldsize == 0 || newsize == 0) {
+    qh_fprintf(qh, qh->ferr, 2072, "qhull internal error (qh_rename_adjacentvertex): expecting neighbor facets for v%d and v%d.  Got %d and %d neighbors resp.\n",
+      oldvertex->id, newvertex->id, oldsize, newsize);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  FOREACHneighbor_(oldvertex) {
+    if (neighbor->simplicial) {
+      if (qh_setin(neighbor->vertices, newvertex)) {
+        if (istrace || qh->IStracing >= 2) {
+          qh_fprintf(qh, qh->ferr, 2070, "qh_rename_adjacentvertex: simplicial f%d contains old v%d and new v%d.  Will be marked degenerate by qh_renamevertex\n",
+            neighbor->id, oldvertex->id, newvertex->id);
+        }
+        qh_makeridges(qh, neighbor); /* no longer simplicial, nummerge==0, skipped by qh_maybe_duplicateridge */
+      }else {
+        qh_replacefacetvertex(qh, neighbor, oldvertex, newvertex);
+        qh_setunique(qh, &newvertex->neighbors, neighbor);
+        qh_newvertices(qh, neighbor->vertices);  /* for qh_update_vertexneighbors of vertex neighbors */
+      }
+    }
+  }
+  ridges= qh_vertexridges(qh, oldvertex, qh_ALL);
+  if (istrace) {
+    FOREACHridge_(ridges) {
+      qh_printridge(qh, qh->ferr, ridge);
+    }
+  }
+  FOREACHneighbor_(oldvertex) {
+    if (!neighbor->simplicial){
+      qh_addfacetvertex(qh, neighbor, newvertex);
+      qh_setunique(qh, &newvertex->neighbors, neighbor);
+      qh_newvertices(qh, neighbor->vertices);  /* for qh_update_vertexneighbors of vertex neighbors */
+      if (qh->newfacet_list == qh->facet_tail) {
+        qh_removefacet(qh, neighbor);  /* add a neighbor to newfacet_list so that qh_partitionvisible has a newfacet */
+        qh_appendfacet(qh, neighbor);
+        neighbor->newfacet= True;
+      }
+    }
+  }
+  qh_renamevertex(qh, oldvertex, newvertex, ridges, NULL, NULL);  /* ridges invalidated */
+  if (oldvertex->deleted && !oldvertex->partitioned) {
+    FOREACHneighbor_(newvertex) {
+      if (!neighbor->visible) {
+        qh_distplane(qh, oldvertex->point, neighbor, &dist2);
+        if (dist2>maxdist2) {
+          maxdist2= dist2;
+          maxfacet= neighbor;
+        }
+      }
+    }
+    trace2((qh, qh->ferr, 2096, "qh_rename_adjacentvertex: partition old p%d(v%d) as a coplanar point for furthest f%d dist %2.2g.  Maybe repartition later (QH0031)\n",
+      qh_pointid(qh, oldvertex->point), oldvertex->id, maxfacet->id, maxdist2))
+    qh_partitioncoplanar(qh, oldvertex->point, maxfacet, NULL, !qh_ALL);  /* faster with maxdist2, otherwise duplicates distance tests from maxdist2/dist2 */
+    oldvertex->partitioned= True;
+  }
+  qh_settempfree(qh, &ridges);
+} /* rename_adjacentvertex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="rename_sharedvertex">-</a>
+
+  qh_rename_sharedvertex(qh, vertex, facet )
+    detect and rename if shared vertex in facet
+    vertices have full ->neighbors
+
+  returns:
+    newvertex or NULL
+    the vertex may still exist in other facets (i.e., a neighbor was pinched)
+    does not change facet->neighbors
+    updates vertex->neighbors
+
+  notes:
+    only called by qh_reducevertices after qh_remove_extravertices
+       so f.vertices does not contain extraneous vertices
+    a shared vertex for a facet is only in ridges to one neighbor
+    this may undo a pinched facet
+
+    it does not catch pinches involving multiple facets.  These appear
+      to be difficult to detect, since an exhaustive search is too expensive.
+
+  design:
+    if vertex only has two neighbors
+      determine the ridges that contain the vertex
+      determine the vertices shared by both neighbors
+      if can find a new vertex in this set
+        rename the vertex to the new vertex
+*/
+vertexT *qh_rename_sharedvertex(qhT *qh, vertexT *vertex, facetT *facet) {
+  facetT *neighbor, **neighborp, *neighborA= NULL;
+  setT *vertices, *ridges;
+  vertexT *newvertex= NULL;
+
+  if (qh_setsize(qh, vertex->neighbors) == 2) {
+    neighborA= SETfirstt_(vertex->neighbors, facetT);
+    if (neighborA == facet)
+      neighborA= SETsecondt_(vertex->neighbors, facetT);
+  }else if (qh->hull_dim == 3)
+    return NULL;
+  else {
+    qh->visit_id++;
+    FOREACHneighbor_(facet)
+      neighbor->visitid= qh->visit_id;
+    FOREACHneighbor_(vertex) {
+      if (neighbor->visitid == qh->visit_id) {
+        if (neighborA)
+          return NULL;
+        neighborA= neighbor;
+      }
+    }
+  }
+  if (!neighborA) {
+    qh_fprintf(qh, qh->ferr, 6101, "qhull internal error (qh_rename_sharedvertex): v%d's neighbors not in f%d\n",
+        vertex->id, facet->id);
+    qh_errprint(qh, "ERRONEOUS", facet, NULL, NULL, vertex);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (neighborA) { /* avoid warning */
+    /* the vertex is shared by facet and neighborA */
+    ridges= qh_settemp(qh, qh->TEMPsize);
+    neighborA->visitid= ++qh->visit_id;
+    qh_vertexridges_facet(qh, vertex, facet, &ridges);
+    trace2((qh, qh->ferr, 2037, "qh_rename_sharedvertex: p%d(v%d) is shared by f%d(%d ridges) and f%d\n",
+      qh_pointid(qh, vertex->point), vertex->id, facet->id, qh_setsize(qh, ridges), neighborA->id));
+    zinc_(Zintersectnum);
+    vertices= qh_vertexintersect_new(qh, facet->vertices, neighborA->vertices);
+    qh_setdel(vertices, vertex);
+    qh_settemppush(qh, vertices);
+    if ((newvertex= qh_find_newvertex(qh, vertex, vertices, ridges)))
+      qh_renamevertex(qh, vertex, newvertex, ridges, facet, neighborA);  /* ridges invalidated */
+    qh_settempfree(qh, &vertices);
+    qh_settempfree(qh, &ridges);
+  }
+  return newvertex;
+} /* rename_sharedvertex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="renameridgevertex">-</a>
+
+  qh_renameridgevertex(qh, ridge, oldvertex, newvertex )
+    renames oldvertex as newvertex in ridge
+
+  returns:
+    True if renames oldvertex
+    False if deleted the ridge
+
+  notes:
+    called by qh_renamevertex
+    caller sets newvertex->delridge for deleted ridges (qh_reducevertices)
+
+  design:
+    delete oldvertex from ridge
+    if newvertex already in ridge
+      copy ridge->noconvex to another ridge if possible
+      delete the ridge
+    else
+      insert newvertex into the ridge
+      adjust the ridge's orientation
+*/
+boolT qh_renameridgevertex(qhT *qh, ridgeT *ridge, vertexT *oldvertex, vertexT *newvertex) {
+  int nth= 0, oldnth;
+  facetT *temp;
+  vertexT *vertex, **vertexp;
+
+  oldnth= qh_setindex(ridge->vertices, oldvertex);
+  if (oldnth < 0) {
+    qh_fprintf(qh, qh->ferr, 6424, "qhull internal error (qh_renameridgevertex): oldvertex v%d not found in r%d.  Cannot rename to v%d\n",
+        oldvertex->id, ridge->id, newvertex->id);
+    qh_errexit(qh, qh_ERRqhull, NULL, ridge);
+  }
+  qh_setdelnthsorted(qh, ridge->vertices, oldnth);
+  FOREACHvertex_(ridge->vertices) {
+    if (vertex == newvertex) {
+      zinc_(Zdelridge);
+      if (ridge->nonconvex) /* only one ridge has nonconvex set */
+        qh_copynonconvex(qh, ridge);
+      trace2((qh, qh->ferr, 2038, "qh_renameridgevertex: ridge r%d deleted.  It contained both v%d and v%d\n",
+        ridge->id, oldvertex->id, newvertex->id));
+      qh_delridge_merge(qh, ridge); /* ridge.vertices deleted */
+      return False;
+    }
+    if (vertex->id < newvertex->id)
+      break;
+    nth++;
+  }
+  qh_setaddnth(qh, &ridge->vertices, nth, newvertex);
+  ridge->simplicialtop= False;
+  ridge->simplicialbot= False;
+  if (abs(oldnth - nth)%2) {
+    trace3((qh, qh->ferr, 3010, "qh_renameridgevertex: swapped the top and bottom of ridge r%d\n",
+            ridge->id));
+    temp= ridge->top;
+    ridge->top= ridge->bottom;
+    ridge->bottom= temp;
+  }
+  return True;
+} /* renameridgevertex */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="renamevertex">-</a>
+
+  qh_renamevertex(qh, oldvertex, newvertex, ridges, oldfacet, neighborA )
+    renames oldvertex as newvertex in ridges of non-simplicial neighbors
+    set oldfacet/neighborA if oldvertex is shared between two facets (qh_rename_sharedvertex)
+    otherwise qh_redundant_vertex or qh_rename_adjacentvertex
+
+  returns:
+    if oldfacet and multiple neighbors, oldvertex may still exist afterwards
+    otherwise sets oldvertex->deleted for later deletion
+    one or more ridges maybe deleted
+    ridges is invalidated
+    merges may be added to degen_mergeset via qh_maydropneighbor or qh_degen_redundant_facet
+
+  notes:
+    qh_rename_sharedvertex can not change neighbors of newvertex (since it's a subset)
+    qh_redundant_vertex due to vertex->delridge for qh_reducevertices
+    qh_rename_adjacentvertex for complete renames
+
+  design:
+    for each ridge in ridges
+      rename oldvertex to newvertex and delete degenerate ridges
+    if oldfacet not defined
+      for each non-simplicial neighbor of oldvertex
+        delete oldvertex from neighbor's vertices
+        remove extra vertices from neighbor
+      add oldvertex to qh.del_vertices
+    else if oldvertex only between oldfacet and neighborA
+      delete oldvertex from oldfacet and neighborA
+      add oldvertex to qh.del_vertices
+    else oldvertex is in oldfacet and neighborA and other facets (i.e., pinched)
+      delete oldvertex from oldfacet
+      delete oldfacet from old vertex's neighbors
+      remove extra vertices (e.g., oldvertex) from neighborA
+*/
+void qh_renamevertex(qhT *qh, vertexT *oldvertex, vertexT *newvertex, setT *ridges, facetT *oldfacet, facetT *neighborA) {
+  facetT *neighbor, **neighborp;
+  ridgeT *ridge, **ridgep;
+  int topsize, bottomsize;
+  boolT istrace= False;
+
+#ifndef qh_NOtrace
+  if (qh->IStracing >= 2 || oldvertex->id == qh->tracevertex_id ||
+        newvertex->id == qh->tracevertex_id) {
+    istrace= True;
+    qh_fprintf(qh, qh->ferr, 2086, "qh_renamevertex: rename v%d to v%d in %d ridges with old f%d and neighbor f%d\n",
+      oldvertex->id, newvertex->id, qh_setsize(qh, ridges), getid_(oldfacet), getid_(neighborA));
+  }
+#endif
+  FOREACHridge_(ridges) {
+    if (qh_renameridgevertex(qh, ridge, oldvertex, newvertex)) { /* ridge is deleted if False, invalidating ridges */
+      topsize= qh_setsize(qh, ridge->top->vertices);
+      bottomsize= qh_setsize(qh, ridge->bottom->vertices);
+      if (topsize < qh->hull_dim || (topsize == qh->hull_dim && !ridge->top->simplicial && qh_setin(ridge->top->vertices, newvertex))) {
+        trace4((qh, qh->ferr, 4070, "qh_renamevertex: ignore duplicate check for r%d.  top f%d (size %d) will be degenerate after rename v%d to v%d\n",
+          ridge->id, ridge->top->id, topsize, oldvertex->id, newvertex->id));
+      }else if (bottomsize < qh->hull_dim || (bottomsize == qh->hull_dim && !ridge->bottom->simplicial && qh_setin(ridge->bottom->vertices, newvertex))) {
+        trace4((qh, qh->ferr, 4071, "qh_renamevertex: ignore duplicate check for r%d.  bottom f%d (size %d) will be degenerate after rename v%d to v%d\n",
+          ridge->id, ridge->bottom->id, bottomsize, oldvertex->id, newvertex->id));
+      }else
+        qh_maybe_duplicateridge(qh, ridge);
+    }
+  }
+  if (!oldfacet) {
+    /* stat Zrenameall or Zpinchduplicate */
+    if (istrace)
+      qh_fprintf(qh, qh->ferr, 2087, "qh_renamevertex: renaming v%d to v%d in several facets for qh_redundant_vertex or MRGsubridge\n",
+               oldvertex->id, newvertex->id);
+    FOREACHneighbor_(oldvertex) {
+      if (neighbor->simplicial) {
+        qh_degen_redundant_facet(qh, neighbor); /* e.g., rbox 175 C3,2e-13 D4 t1545235541 | qhull d */
+      }else {
+        if (istrace)
+          qh_fprintf(qh, qh->ferr, 4080, "qh_renamevertex: rename vertices in non-simplicial neighbor f%d of v%d\n", neighbor->id, oldvertex->id);
+        qh_maydropneighbor(qh, neighbor);
+        qh_setdelsorted(neighbor->vertices, oldvertex); /* if degenerate, qh_degen_redundant_facet will add to mergeset */
+        if (qh_remove_extravertices(qh, neighbor))
+          neighborp--; /* neighbor deleted from oldvertex neighborset */
+        qh_degen_redundant_facet(qh, neighbor); /* either direction may be redundant, faster if combine? */
+        qh_test_redundant_neighbors(qh, neighbor);
+        qh_test_degen_neighbors(qh, neighbor);
+      }
+    }
+    if (!oldvertex->deleted) {
+      oldvertex->deleted= True;
+      qh_setappend(qh, &qh->del_vertices, oldvertex);
+    }
+  }else if (qh_setsize(qh, oldvertex->neighbors) == 2) {
+    zinc_(Zrenameshare);
+    if (istrace)
+      qh_fprintf(qh, qh->ferr, 3039, "qh_renamevertex: renaming v%d to v%d in oldfacet f%d for qh_rename_sharedvertex\n",
+               oldvertex->id, newvertex->id, oldfacet->id);
+    FOREACHneighbor_(oldvertex) {
+      qh_setdelsorted(neighbor->vertices, oldvertex);
+      qh_degen_redundant_facet(qh, neighbor);
+    }
+    oldvertex->deleted= True;
+    qh_setappend(qh, &qh->del_vertices, oldvertex);
+  }else {
+    zinc_(Zrenamepinch);
+    if (istrace || qh->IStracing >= 1)
+      qh_fprintf(qh, qh->ferr, 3040, "qh_renamevertex: renaming pinched v%d to v%d between f%d and f%d\n",
+               oldvertex->id, newvertex->id, oldfacet->id, neighborA->id);
+    qh_setdelsorted(oldfacet->vertices, oldvertex);
+    qh_setdel(oldvertex->neighbors, oldfacet);
+    if (qh_remove_extravertices(qh, neighborA))
+      qh_degen_redundant_facet(qh, neighborA);
+  }
+  if (oldfacet)
+    qh_degen_redundant_facet(qh, oldfacet);
+} /* renamevertex */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="test_appendmerge">-</a>
+
+  qh_test_appendmerge(qh, facet, neighbor, simplicial )
+    test convexity and append to qh.facet_mergeset if non-convex
+    if pre-merging,
+      no-op if qh.SKIPconvex, or qh.MERGEexact and coplanar
+    if simplicial, assumes centrum test is valid (e.g., adjacent, simplicial new facets)
+
+  returns:
+    true if appends facet/neighbor to qh.facet_mergeset
+    sets facet->center as needed
+    does not change facet->seen
+
+  notes:
+    called from qh_getmergeset_initial, qh_getmergeset, and qh_test_vneighbors
+    must be at least as strong as qh_checkconvex (poly2_r.c)
+    assumes !f.flipped
+
+  design:
+    exit if qh.SKIPconvex ('Q0') and !qh.POSTmerging
+    if qh.cos_max ('An') is defined and merging coplanars
+      if the angle between facet normals is too shallow
+        append an angle-coplanar merge to qh.mergeset
+        return True
+    test convexity of facet and neighbor
+*/
+boolT qh_test_appendmerge(qhT *qh, facetT *facet, facetT *neighbor, boolT simplicial) {
+  realT angle= -REALmax;
+  boolT okangle= False;
+
+  if (qh->SKIPconvex && !qh->POSTmerging)
+    return False;
+  if (qh->cos_max < REALmax/2 && (!qh->MERGEexact || qh->POSTmerging)) {
+    angle= qh_getangle(qh, facet->normal, neighbor->normal);
+    okangle= True;
+    zinc_(Zangletests);
+    if (angle > qh->cos_max) {
+      zinc_(Zcoplanarangle);
+      qh_appendmergeset(qh, facet, neighbor, MRGanglecoplanar, 0.0, angle);
+      trace2((qh, qh->ferr, 2039, "qh_test_appendmerge: coplanar angle %4.4g between f%d and f%d\n",
+         angle, facet->id, neighbor->id));
+      return True;
+    }
+  }
+  if (simplicial || qh->hull_dim <= 3)
+    return qh_test_centrum_merge(qh, facet, neighbor, angle, okangle);
+  else
+    return qh_test_nonsimplicial_merge(qh, facet, neighbor, angle, okangle);
+} /* test_appendmerge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="test_centrum_merge">-</a>
+
+  qh_test_centrum_merge(qh, facet, neighbor, angle, okangle )
+    test centrum convexity and append non-convex facets to qh.facet_mergeset
+    'angle' is angle between facets if okangle is true, otherwise use 0.0
+
+  returns:
+    true if append facet/neighbor to qh.facet_mergeset
+    sets facet->center as needed
+    does not change facet->seen
+
+  notes:
+    called from test_appendmerge if adjacent simplicial facets or 2-d/3-d
+    at least as strict as qh_checkconvex, including qh.DISTround ('En' and 'Rn')
+
+  design:
+    make facet's centrum if needed
+    if facet's centrum is above the neighbor (qh.centrum_radius)
+      set isconcave
+
+    if facet's centrum is not below the neighbor (-qh.centrum_radius)
+      set iscoplanar
+    make neighbor's centrum if needed
+    if neighbor's centrum is above the facet
+      set isconcave
+    else if neighbor's centrum is not below the facet
+      set iscoplanar
+    if isconcave or iscoplanar and merging coplanars
+      get angle if needed (qh.ANGLEmerge 'An')
+      append concave-coplanar, concave ,or coplanar merge to qh.mergeset
+*/
+boolT qh_test_centrum_merge(qhT *qh, facetT *facet, facetT *neighbor, realT angle, boolT okangle) {
+  coordT dist, dist2, mergedist;
+  boolT isconcave= False, iscoplanar= False;
+
+  if (!facet->center)
+    facet->center= qh_getcentrum(qh, facet);
+  zzinc_(Zcentrumtests);
+  qh_distplane(qh, facet->center, neighbor, &dist);
+  if (dist > qh->centrum_radius)
+    isconcave= True;
+  else if (dist >= -qh->centrum_radius)
+    iscoplanar= True;
+  if (!neighbor->center)
+    neighbor->center= qh_getcentrum(qh, neighbor);
+  zzinc_(Zcentrumtests);
+  qh_distplane(qh, neighbor->center, facet, &dist2);
+  if (dist2 > qh->centrum_radius)
+    isconcave= True;
+  else if (!iscoplanar && dist2 >= -qh->centrum_radius)
+    iscoplanar= True;
+  if (!isconcave && (!iscoplanar || (qh->MERGEexact && !qh->POSTmerging)))
+    return False;
+  if (!okangle && qh->ANGLEmerge) {
+    angle= qh_getangle(qh, facet->normal, neighbor->normal);
+    zinc_(Zangletests);
+  }
+  if (isconcave && iscoplanar) {
+    zinc_(Zconcavecoplanarridge);
+    if (dist > dist2)
+      qh_appendmergeset(qh, facet, neighbor, MRGconcavecoplanar, dist, angle);
+    else
+      qh_appendmergeset(qh, neighbor, facet, MRGconcavecoplanar, dist2, angle);
+    trace0((qh, qh->ferr, 36, "qh_test_centrum_merge: concave f%d to coplanar f%d, dist %4.4g and reverse dist %4.4g, angle %4.4g during p%d\n",
+           facet->id, neighbor->id, dist, dist2, angle, qh->furthest_id));
+  }else if (isconcave) {
+    mergedist= fmax_(dist, dist2);
+    zinc_(Zconcaveridge);
+    qh_appendmergeset(qh, facet, neighbor, MRGconcave, mergedist, angle);
+    trace0((qh, qh->ferr, 37, "qh_test_centrum_merge: concave f%d to f%d, dist %4.4g and reverse dist %4.4g, angle %4.4g during p%d\n",
+      facet->id, neighbor->id, dist, dist2, angle, qh->furthest_id));
+  }else /* iscoplanar */ {
+    mergedist= fmin_(fabs_(dist), fabs_(dist2));
+    zinc_(Zcoplanarcentrum);
+    qh_appendmergeset(qh, facet, neighbor, MRGcoplanar, mergedist, angle);
+    trace2((qh, qh->ferr, 2097, "qh_test_centrum_merge: coplanar f%d to f%d dist %4.4g, reverse dist %4.4g angle %4.4g\n",
+              facet->id, neighbor->id, dist, dist2, angle));
+  }
+  return True;
+} /* test_centrum_merge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="test_degen_neighbors">-</a>
+
+  qh_test_degen_neighbors(qh, facet )
+    append degenerate neighbors to qh.degen_mergeset
+
+  notes:
+  called at end of qh_mergefacet() and qh_renamevertex()
+  call after test_redundant_facet() since MRGredundant is less expensive then MRGdegen
+    a degenerate facet has fewer than hull_dim neighbors
+    see: qh_merge_degenredundant()
+
+*/
+void qh_test_degen_neighbors(qhT *qh, facetT *facet) {
+  facetT *neighbor, **neighborp;
+  int size;
+
+  trace4((qh, qh->ferr, 4073, "qh_test_degen_neighbors: test for degenerate neighbors of f%d\n", facet->id));
+  FOREACHneighbor_(facet) {
+    if (neighbor->visible) {
+      qh_fprintf(qh, qh->ferr, 6359, "qhull internal error (qh_test_degen_neighbors): facet f%d has deleted neighbor f%d (qh.visible_list)\n",
+        facet->id, neighbor->id);
+      qh_errexit2(qh, qh_ERRqhull, facet, neighbor);
+    }
+    if (neighbor->degenerate || neighbor->redundant || neighbor->dupridge) /* will merge or delete */
+      continue;
+    /* merge flipped-degenerate facet before flipped facets */
+    if ((size= qh_setsize(qh, neighbor->neighbors)) < qh->hull_dim) {
+      qh_appendmergeset(qh, neighbor, neighbor, MRGdegen, 0.0, 1.0);
+      trace2((qh, qh->ferr, 2019, "qh_test_degen_neighbors: f%d is degenerate with %d neighbors.  Neighbor of f%d.\n", neighbor->id, size, facet->id));
+    }
+  }
+} /* test_degen_neighbors */
+
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="test_nonsimplicial_merge">-</a>
+
+  qh_test_nonsimplicial_merge(qh, facet, neighbor, angle, okangle )
+    test centrum and vertex convexity and append non-convex or redundant facets to qh.facet_mergeset
+    'angle' is angle between facets if okangle is true, otherwise use 0.0
+    skips coplanar merges if pre-merging with qh.MERGEexact ('Qx')
+
+  returns:
+    true if appends facet/neighbor to qh.facet_mergeset
+    sets facet->center as needed
+    does not change facet->seen
+
+  notes:
+    only called from test_appendmerge if a non-simplicial facet and at least 4-d
+    at least as strict as qh_checkconvex, including qh.DISTround ('En' and 'Rn')
+      centrums must be < -qh.centrum_radius
+    tests vertices as well as centrums since a facet may be twisted relative to its neighbor
+
+  design:
+    set precision constants for maxoutside, clearlyconcave, minvertex, and coplanarcentrum
+      use maxoutside for coplanarcentrum if premerging with 'Qx' and qh_MAXcoplanarcentrum merges
+      otherwise use qh.centrum_radious for coplanarcentrum
+    make facet and neighbor centrums if needed
+    isconcave if a centrum is above neighbor (coplanarcentrum)
+    iscoplanar if a centrum is not below neighbor (-qh.centrum_radius)
+    maybeconvex if a centrum is clearly below neighbor (-clearyconvex)
+    return False if both centrums clearly below neighbor (-clearyconvex)
+    return MRGconcave if isconcave
+
+    facets are neither clearly convex nor clearly concave
+    test vertices as well as centrums
+    if maybeconvex
+      determine mindist and maxdist for vertices of the other facet
+      maybe MRGredundant
+    otherwise
+      determine mindist and maxdist for vertices of either facet
+      maybe MRGredundant
+      maybeconvex if a vertex is clearly below neighbor (-clearconvex)
+
+    vertices are concave if dist > clearlyconcave
+    vertices are twisted if dist > maxoutside (isconcave and maybeconvex)
+    return False if not concave and pre-merge of 'Qx' (qh.MERGEexact)
+    vertices are coplanar if dist in -minvertex..maxoutside
+    if !isconcave, vertices are coplanar if dist >= -qh.MAXcoplanar (n*qh.premerge_centrum)
+
+    return False if neither concave nor coplanar
+    return MRGtwisted if isconcave and maybeconvex
+    return MRGconcavecoplanar if isconcave and isconvex
+    return MRGconcave if isconcave
+    return MRGcoplanar if iscoplanar
+*/
+boolT qh_test_nonsimplicial_merge(qhT *qh, facetT *facet, facetT *neighbor, realT angle, boolT okangle) {
+  coordT dist, mindist, maxdist, mindist2, maxdist2, dist2, maxoutside, clearlyconcave, minvertex, clearlyconvex, mergedist, coplanarcentrum;
+  boolT isconcave= False, iscoplanar= False, maybeconvex= False, isredundant= False;
+  vertexT *maxvertex= NULL, *maxvertex2= NULL;
+
+  maxoutside= fmax_(neighbor->maxoutside, qh->ONEmerge + qh->DISTround);
+  maxoutside= fmax_(maxoutside, facet->maxoutside);
+  clearlyconcave= qh_RATIOconcavehorizon * maxoutside;
+  minvertex= fmax_(-qh->min_vertex, qh->MAXcoplanar); /* non-negative, not available per facet, not used for iscoplanar */
+  clearlyconvex= qh_RATIOconvexmerge * minvertex; /* must be convex for MRGtwisted */
+  if (qh->MERGEexact && !qh->POSTmerging && (facet->nummerge > qh_MAXcoplanarcentrum || neighbor->nummerge > qh_MAXcoplanarcentrum))
+    coplanarcentrum= maxoutside;
+  else
+    coplanarcentrum= qh->centrum_radius;
+
+  if (!facet->center)
+    facet->center= qh_getcentrum(qh, facet);
+  zzinc_(Zcentrumtests);
+  qh_distplane(qh, facet->center, neighbor, &dist);
+  if (dist > coplanarcentrum)
+    isconcave= True;
+  else if (dist >= -qh->centrum_radius)
+    iscoplanar= True;
+  else if (dist < -clearlyconvex)
+    maybeconvex= True;
+  if (!neighbor->center)
+    neighbor->center= qh_getcentrum(qh, neighbor);
+  zzinc_(Zcentrumtests);
+  qh_distplane(qh, neighbor->center, facet, &dist2);
+  if (dist2 > coplanarcentrum)
+    isconcave= True;
+  else if (dist2 >= -qh->centrum_radius)
+    iscoplanar= True;
+  else if (dist2 < -clearlyconvex) {
+    if (maybeconvex)
+      return False; /* both centrums clearly convex */
+    maybeconvex= True;
+  }
+  if (isconcave) {
+    if (!okangle && qh->ANGLEmerge) {
+      angle= qh_getangle(qh, facet->normal, neighbor->normal);
+      zinc_(Zangletests);
+    }
+    mergedist= fmax_(dist, dist2);
+    zinc_(Zconcaveridge);
+    qh_appendmergeset(qh, facet, neighbor, MRGconcave, mergedist, angle);
+    trace0((qh, qh->ferr, 18, "qh_test_nonsimplicial_merge: concave centrum for f%d or f%d, dist %4.4g and reverse dist %4.4g, angle %4.4g during p%d\n",
+      facet->id, neighbor->id, dist, dist2, angle, qh->furthest_id));
+    return True;
+  }
+  /* neither clearly convex nor clearly concave, test vertices as well as centrums */
+  if (maybeconvex) {
+    if (dist < -clearlyconvex) {
+      maxdist= dist;  /* facet centrum clearly convex, no need to test its vertex distance */
+      mindist= dist;
+      maxvertex2= qh_furthestvertex(qh, neighbor, facet, &maxdist2, &mindist2);
+      if (!maxvertex2) {
+        qh_appendmergeset(qh, neighbor, facet, MRGredundant, maxdist2, qh_ANGLEnone);
+        isredundant= True;
+      }
+    }else { /* dist2 < -clearlyconvex */
+      maxdist2= dist2;   /* neighbor centrum clearly convex, no need to test its vertex distance */
+      mindist2= dist2;
+      maxvertex= qh_furthestvertex(qh, facet, neighbor, &maxdist, &mindist);
+      if (!maxvertex) {
+        qh_appendmergeset(qh, facet, neighbor, MRGredundant, maxdist, qh_ANGLEnone);
+        isredundant= True;
+      }
+    }
+  }else {
+    maxvertex= qh_furthestvertex(qh, facet, neighbor, &maxdist, &mindist);
+    if (maxvertex) {
+      maxvertex2= qh_furthestvertex(qh, neighbor, facet, &maxdist2, &mindist2);
+      if (!maxvertex2) {
+        qh_appendmergeset(qh, neighbor, facet, MRGredundant, maxdist2, qh_ANGLEnone);
+        isredundant= True;
+      }else if (mindist < -clearlyconvex || mindist2 < -clearlyconvex)
+        maybeconvex= True;
+    }else { /* !maxvertex */
+      qh_appendmergeset(qh, facet, neighbor, MRGredundant, maxdist, qh_ANGLEnone);
+      isredundant= True;
+    }
+  }
+  if (isredundant) {
+    zinc_(Zredundantmerge);
+    return True;
+  }
+
+  if (maxdist > clearlyconcave || maxdist2 > clearlyconcave)
+    isconcave= True;
+  else if (maybeconvex) {
+    if (maxdist > maxoutside || maxdist2 > maxoutside)
+      isconcave= True;  /* MRGtwisted */
+  }
+  if (!isconcave && qh->MERGEexact && !qh->POSTmerging)
+    return False;
+  if (isconcave && !iscoplanar) {
+    if (maxdist < maxoutside && (-qh->MAXcoplanar || (maxdist2 < maxoutside && mindist2 >= -qh->MAXcoplanar)))
+      iscoplanar= True; /* MRGconcavecoplanar */
+  }else if (!iscoplanar) {
+    if (mindist >= -qh->MAXcoplanar || mindist2 >= -qh->MAXcoplanar)
+      iscoplanar= True;  /* MRGcoplanar */
+  }
+  if (!isconcave && !iscoplanar)
+    return False;
+  if (!okangle && qh->ANGLEmerge) {
+    angle= qh_getangle(qh, facet->normal, neighbor->normal);
+    zinc_(Zangletests);
+  }
+  if (isconcave && maybeconvex) {
+    zinc_(Ztwistedridge);
+    if (maxdist > maxdist2)
+      qh_appendmergeset(qh, facet, neighbor, MRGtwisted, maxdist, angle);
+    else
+      qh_appendmergeset(qh, neighbor, facet, MRGtwisted, maxdist2, angle);
+    trace0((qh, qh->ferr, 27, "qh_test_nonsimplicial_merge: twisted concave f%d v%d to f%d v%d, dist %4.4g and reverse dist %4.4g, angle %4.4g during p%d\n",
+           facet->id, getid_(maxvertex), neighbor->id, getid_(maxvertex2), maxdist, maxdist2, angle, qh->furthest_id));
+  }else if (isconcave && iscoplanar) {
+    zinc_(Zconcavecoplanarridge);
+    if (maxdist > maxdist2)
+      qh_appendmergeset(qh, facet, neighbor, MRGconcavecoplanar, maxdist, angle);
+    else
+      qh_appendmergeset(qh, neighbor, facet, MRGconcavecoplanar, maxdist2, angle);
+    trace0((qh, qh->ferr, 28, "qh_test_nonsimplicial_merge: concave coplanar f%d v%d to f%d v%d, dist %4.4g and reverse dist %4.4g, angle %4.4g during p%d\n",
+      facet->id, getid_(maxvertex), neighbor->id, getid_(maxvertex2), maxdist, maxdist2, angle, qh->furthest_id));
+  }else if (isconcave) {
+    mergedist= fmax_(maxdist, maxdist2);
+    zinc_(Zconcaveridge);
+    qh_appendmergeset(qh, facet, neighbor, MRGconcave, mergedist, angle);
+    trace0((qh, qh->ferr, 29, "qh_test_nonsimplicial_merge: concave f%d v%d to f%d v%d, dist %4.4g and reverse dist %4.4g, angle %4.4g during p%d\n",
+      facet->id, getid_(maxvertex), neighbor->id, getid_(maxvertex2), maxdist, maxdist2, angle, qh->furthest_id));
+  }else /* iscoplanar */ {
+    mergedist= fmax_(fmax_(maxdist, maxdist2), fmax_(-mindist, -mindist2));
+    zinc_(Zcoplanarcentrum);
+    qh_appendmergeset(qh, facet, neighbor, MRGcoplanar, mergedist, angle);
+    trace2((qh, qh->ferr, 2099, "qh_test_nonsimplicial_merge: coplanar f%d v%d to f%d v%d, dist %4.4g and reverse dist %4.4g, angle %4.4g during p%d\n",
+      facet->id, getid_(maxvertex), neighbor->id, getid_(maxvertex2), maxdist, maxdist2, angle, qh->furthest_id));
+  }
+  return True;
+} /* test_nonsimplicial_merge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="test_redundant_neighbors">-</a>
+
+  qh_test_redundant_neighbors(qh, facet )
+    append degenerate facet or its redundant neighbors to qh.degen_mergeset
+
+  returns:
+    bumps vertex_visit
+
+  notes:
+    called at end of qh_mergefacet(), qh_mergecycle_all(), and qh_renamevertex
+    call before qh_test_degen_neighbors (MRGdegen are more likely to cause problems)
+    a redundant neighbor's vertices is a subset of the facet's vertices
+    with pinched and flipped facets, a redundant neighbor may have a wildly different normal
+
+    see qh_merge_degenredundant() and qh_-_facet()
+
+  design:
+    if facet is degenerate
+       appends facet to degen_mergeset
+    else
+       appends redundant neighbors of facet to degen_mergeset
+*/
+void qh_test_redundant_neighbors(qhT *qh, facetT *facet) {
+  vertexT *vertex, **vertexp;
+  facetT *neighbor, **neighborp;
+  int size;
+
+  trace4((qh, qh->ferr, 4022, "qh_test_redundant_neighbors: test neighbors of f%d vertex_visit %d\n",
+          facet->id, qh->vertex_visit+1));
+  if ((size= qh_setsize(qh, facet->neighbors)) < qh->hull_dim) {
+    qh_appendmergeset(qh, facet, facet, MRGdegen, 0.0, 1.0);
+    trace2((qh, qh->ferr, 2017, "qh_test_redundant_neighbors: f%d is degenerate with %d neighbors.\n", facet->id, size));
+  }else {
+    qh->vertex_visit++;
+    FOREACHvertex_(facet->vertices)
+      vertex->visitid= qh->vertex_visit;
+    FOREACHneighbor_(facet) {
+      if (neighbor->visible) {
+        qh_fprintf(qh, qh->ferr, 6360, "qhull internal error (qh_test_redundant_neighbors): facet f%d has deleted neighbor f%d (qh.visible_list)\n",
+          facet->id, neighbor->id);
+        qh_errexit2(qh, qh_ERRqhull, facet, neighbor);
+      }
+      if (neighbor->degenerate || neighbor->redundant || neighbor->dupridge) /* will merge or delete */
+        continue;
+      if (facet->flipped && !neighbor->flipped) /* do not merge non-flipped into flipped */
+        continue;
+      /* merge redundant-flipped facet first */
+      /* uses early out instead of checking vertex count */
+      FOREACHvertex_(neighbor->vertices) {
+        if (vertex->visitid != qh->vertex_visit)
+          break;
+      }
+      if (!vertex) {
+        qh_appendmergeset(qh, neighbor, facet, MRGredundant, 0.0, 1.0);
+        trace2((qh, qh->ferr, 2018, "qh_test_redundant_neighbors: f%d is contained in f%d.  merge\n", neighbor->id, facet->id));
+      }
+    }
+  }
+} /* test_redundant_neighbors */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="test_vneighbors">-</a>
+
+  qh_test_vneighbors(qh)
+    test vertex neighbors for convexity
+    tests all facets on qh.newfacet_list
+
+  returns:
+    true if non-convex vneighbors appended to qh.facet_mergeset
+    initializes vertex neighbors if needed
+
+  notes:
+    called by qh_all_merges from qh_postmerge if qh.TESTvneighbors ('Qv')
+    assumes all facet neighbors have been tested
+    this can be expensive
+    this does not guarantee that a centrum is below all facets
+      but it is unlikely
+    uses qh.visit_id
+
+  design:
+    build vertex neighbors if necessary
+    for all new facets
+      for all vertices
+        for each unvisited facet neighbor of the vertex
+          test new facet and neighbor for convexity
+*/
+boolT qh_test_vneighbors(qhT *qh /* qh.newfacet_list */) {
+  facetT *newfacet, *neighbor, **neighborp;
+  vertexT *vertex, **vertexp;
+  int nummerges= 0;
+
+  trace1((qh, qh->ferr, 1015, "qh_test_vneighbors: testing vertex neighbors for convexity\n"));
+  if (!qh->VERTEXneighbors)
+    qh_vertexneighbors(qh);
+  FORALLnew_facets
+    newfacet->seen= False;
+  FORALLnew_facets {
+    newfacet->seen= True;
+    newfacet->visitid= qh->visit_id++;
+    FOREACHneighbor_(newfacet)
+      newfacet->visitid= qh->visit_id;
+    FOREACHvertex_(newfacet->vertices) {
+      FOREACHneighbor_(vertex) {
+        if (neighbor->seen || neighbor->visitid == qh->visit_id)
+          continue;
+        if (qh_test_appendmerge(qh, newfacet, neighbor, False)) /* ignores optimization for simplicial ridges */
+          nummerges++;
+      }
+    }
+  }
+  zadd_(Ztestvneighbor, nummerges);
+  trace1((qh, qh->ferr, 1016, "qh_test_vneighbors: found %d non-convex, vertex neighbors\n",
+           nummerges));
+  return (nummerges > 0);
+} /* test_vneighbors */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="tracemerge">-</a>
+
+  qh_tracemerge(qh, facet1, facet2 )
+    print trace message after merge
+*/
+void qh_tracemerge(qhT *qh, facetT *facet1, facetT *facet2, mergeType mergetype) {
+  boolT waserror= False;
+  const char *mergename;
+
+#ifndef qh_NOtrace
+  if(mergetype > 0 && mergetype < sizeof(mergetypes)/sizeof(char *))
+    mergename= mergetypes[mergetype];
+  else
+    mergename= mergetypes[MRGnone];
+  if (qh->IStracing >= 4)
+    qh_errprint(qh, "MERGED", facet2, NULL, NULL, NULL);
+  if (facet2 == qh->tracefacet || (qh->tracevertex && qh->tracevertex->newfacet)) {
+    qh_fprintf(qh, qh->ferr, 8085, "qh_tracemerge: trace facet and vertex after merge of f%d into f%d type %d (%s), furthest p%d\n",
+      facet1->id, facet2->id, mergetype, mergename, qh->furthest_id);
+    if (facet2 != qh->tracefacet)
+      qh_errprint(qh, "TRACE", qh->tracefacet,
+        (qh->tracevertex && qh->tracevertex->neighbors) ?
+           SETfirstt_(qh->tracevertex->neighbors, facetT) : NULL,
+        NULL, qh->tracevertex);
+  }
+  if (qh->tracevertex) {
+    if (qh->tracevertex->deleted)
+      qh_fprintf(qh, qh->ferr, 8086, "qh_tracemerge: trace vertex deleted at furthest p%d\n",
+            qh->furthest_id);
+    else
+      qh_checkvertex(qh, qh->tracevertex, qh_ALL, &waserror);
+  }
+  if (qh->tracefacet && qh->tracefacet->normal && !qh->tracefacet->visible)
+    qh_checkfacet(qh, qh->tracefacet, True /* newmerge */, &waserror);
+#endif /* !qh_NOtrace */
+  if (qh->CHECKfrequently || qh->IStracing >= 4) { /* can't check polygon here */
+    if (qh->IStracing >= 4 && qh->num_facets < 500) {
+      qh_printlists(qh);
+    }
+    qh_checkfacet(qh, facet2, True /* newmerge */, &waserror);
+  }
+  if (waserror)
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL); /* erroneous facet logged by qh_checkfacet */
+} /* tracemerge */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="tracemerging">-</a>
+
+  qh_tracemerging(qh)
+    print trace message during POSTmerging
+
+  returns:
+    updates qh.mergereport
+
+  notes:
+    called from qh_mergecycle() and qh_mergefacet()
+
+  see:
+    qh_buildtracing()
+*/
+void qh_tracemerging(qhT *qh) {
+  realT cpu;
+  int total;
+  time_t timedata;
+  struct tm *tp;
+
+  qh->mergereport= zzval_(Ztotmerge);
+  time(&timedata);
+  tp= localtime(&timedata);
+  cpu= qh_CPUclock;
+  cpu /= qh_SECticks;
+  total= zzval_(Ztotmerge) - zzval_(Zcyclehorizon) + zzval_(Zcyclefacettot);
+  qh_fprintf(qh, qh->ferr, 8087, "\n\
+At %d:%d:%d & %2.5g CPU secs, qhull has merged %d facets with max_outside %2.2g, min_vertex %2.2g.\n\
+  The hull contains %d facets and %d vertices.\n",
+      tp->tm_hour, tp->tm_min, tp->tm_sec, cpu, total, qh->max_outside, qh->min_vertex,
+      qh->num_facets - qh->num_visible,
+      qh->num_vertices-qh_setsize(qh, qh->del_vertices));
+} /* tracemerging */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="updatetested">-</a>
+
+  qh_updatetested(qh, facet1, facet2 )
+    clear facet2->tested and facet1->ridge->tested for merge
+
+  returns:
+    deletes facet2->center unless it's already large
+      if so, clears facet2->ridge->tested
+
+  notes:
+    only called by qh_mergefacet
+
+  design:
+    clear facet2->tested
+    clear ridge->tested for facet1's ridges
+    if facet2 has a centrum
+      if facet2 is large
+        set facet2->keepcentrum
+      else if facet2 has 3 vertices due to many merges, or not large and post merging
+        clear facet2->keepcentrum
+      unless facet2->keepcentrum
+        clear facet2->center to recompute centrum later
+        clear ridge->tested for facet2's ridges
+*/
+void qh_updatetested(qhT *qh, facetT *facet1, facetT *facet2) {
+  ridgeT *ridge, **ridgep;
+  int size;
+
+  facet2->tested= False;
+  FOREACHridge_(facet1->ridges)
+    ridge->tested= False;
+  if (!facet2->center)
+    return;
+  size= qh_setsize(qh, facet2->vertices);
+  if (!facet2->keepcentrum) {
+    if (size > qh->hull_dim + qh_MAXnewcentrum) {
+      facet2->keepcentrum= True;
+      zinc_(Zwidevertices);
+    }
+  }else if (size <= qh->hull_dim + qh_MAXnewcentrum) {
+    /* center and keepcentrum was set */
+    if (size == qh->hull_dim || qh->POSTmerging)
+      facet2->keepcentrum= False; /* if many merges need to recompute centrum */
+  }
+  if (!facet2->keepcentrum) {
+    qh_memfree(qh, facet2->center, qh->normal_size);
+    facet2->center= NULL;
+    FOREACHridge_(facet2->ridges)
+      ridge->tested= False;
+  }
+} /* updatetested */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="vertexridges">-</a>
+
+  qh_vertexridges(qh, vertex, allneighbors )
+    return temporary set of ridges adjacent to a vertex
+    vertex->neighbors defined (qh_vertexneighbors)
+
+  notes:
+    uses qh.visit_id
+    does not include implicit ridges for simplicial facets
+    skips last neighbor, unless allneighbors.  For new facets, the last neighbor shares ridges with adjacent neighbors
+    if the last neighbor is not simplicial, it will have ridges for its simplicial neighbors
+    Use allneighbors when a new cone is attached to an existing convex hull
+    similar to qh_neighbor_vertices
+
+  design:
+    for each neighbor of vertex
+      add ridges that include the vertex to ridges
+*/
+setT *qh_vertexridges(qhT *qh, vertexT *vertex, boolT allneighbors) {
+  facetT *neighbor, **neighborp;
+  setT *ridges= qh_settemp(qh, qh->TEMPsize);
+  int size;
+
+  qh->visit_id += 2;  /* visit_id for vertex neighbors, visit_id-1 for facets of visited ridges */
+  FOREACHneighbor_(vertex)
+    neighbor->visitid= qh->visit_id;
+  FOREACHneighbor_(vertex) {
+    if (*neighborp || allneighbors)   /* no new ridges in last neighbor */
+      qh_vertexridges_facet(qh, vertex, neighbor, &ridges);
+  }
+  if (qh->PRINTstatistics || qh->IStracing) {
+    size= qh_setsize(qh, ridges);
+    zinc_(Zvertexridge);
+    zadd_(Zvertexridgetot, size);
+    zmax_(Zvertexridgemax, size);
+    trace3((qh, qh->ferr, 3011, "qh_vertexridges: found %d ridges for v%d\n",
+             size, vertex->id));
+  }
+  return ridges;
+} /* vertexridges */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="vertexridges_facet">-</a>
+
+  qh_vertexridges_facet(qh, vertex, facet, ridges )
+    add adjacent ridges for vertex in facet
+    neighbor->visitid==qh.visit_id if it hasn't been visited
+
+  returns:
+    ridges updated
+    sets facet->visitid to qh.visit_id-1
+
+  design:
+    for each ridge of facet
+      if ridge of visited neighbor (i.e., unprocessed)
+        if vertex in ridge
+          append ridge
+    mark facet processed
+*/
+void qh_vertexridges_facet(qhT *qh, vertexT *vertex, facetT *facet, setT **ridges) {
+  ridgeT *ridge, **ridgep;
+  facetT *neighbor;
+  int last_i= qh->hull_dim-2;
+  vertexT *second, *last;
+
+  FOREACHridge_(facet->ridges) {
+    neighbor= otherfacet_(ridge, facet);
+    if (neighbor->visitid == qh->visit_id) {
+      if (SETfirst_(ridge->vertices) == vertex) {
+        qh_setappend(qh, ridges, ridge);
+      }else if (last_i > 2) {
+        second= SETsecondt_(ridge->vertices, vertexT);
+        last= SETelemt_(ridge->vertices, last_i, vertexT);
+        if (second->id >= vertex->id && last->id <= vertex->id) { /* vertices inverse sorted by id */
+          if (second == vertex || last == vertex)
+            qh_setappend(qh, ridges, ridge);
+          else if (qh_setin(ridge->vertices, vertex))
+            qh_setappend(qh, ridges, ridge);
+        }
+      }else if (SETelem_(ridge->vertices, last_i) == vertex
+          || (last_i > 1 && SETsecond_(ridge->vertices) == vertex)) {
+        qh_setappend(qh, ridges, ridge);
+      }
+    }
+  }
+  facet->visitid= qh->visit_id-1;
+} /* vertexridges_facet */
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >-------------------------------</a><a name="willdelete">-</a>
+
+  qh_willdelete(qh, facet, replace )
+    moves facet to visible list for qh_deletevisible
+    sets facet->f.replace to replace (may be NULL)
+    clears f.ridges and f.neighbors -- no longer valid
+
+  returns:
+    bumps qh.num_visible
+*/
+void qh_willdelete(qhT *qh, facetT *facet, facetT *replace) {
+
+  trace4((qh, qh->ferr, 4081, "qh_willdelete: move f%d to visible list, set its replacement as f%d, and clear f.neighbors and f.ridges\n", facet->id, getid_(replace)));
+  if (!qh->visible_list && qh->newfacet_list) {
+    qh_fprintf(qh, qh->ferr, 6378, "qhull internal error (qh_willdelete): expecting qh.visible_list at before qh.newfacet_list f%d.   Got NULL\n",
+        qh->newfacet_list->id);
+    qh_errexit2(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh_removefacet(qh, facet);
+  qh_prependfacet(qh, facet, &qh->visible_list);
+  qh->num_visible++;
+  facet->visible= True;
+  facet->f.replace= replace;
+  if (facet->ridges)
+    SETfirst_(facet->ridges)= NULL;
+  if (facet->neighbors)
+    SETfirst_(facet->neighbors)= NULL;
+} /* willdelete */
+
+#else /* qh_NOmerge */
+
+void qh_all_vertexmerges(qhT *qh, int apexpointid, facetT *facet, facetT **retryfacet) {
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(apexpointid)
+  QHULL_UNUSED(facet)
+  QHULL_UNUSED(retryfacet)
+}
+void qh_premerge(qhT *qh, int apexpointid, realT maxcentrum, realT maxangle) {
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(apexpointid)
+  QHULL_UNUSED(maxcentrum)
+  QHULL_UNUSED(maxangle)
+}
+void qh_postmerge(qhT *qh, const char *reason, realT maxcentrum, realT maxangle,
+                      boolT vneighbors) {
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(reason)
+  QHULL_UNUSED(maxcentrum)
+  QHULL_UNUSED(maxangle)
+  QHULL_UNUSED(vneighbors)
+}
+void qh_checkdelfacet(qhT *qh, facetT *facet, setT *mergeset) {
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(facet)
+  QHULL_UNUSED(mergeset)
+}
+void qh_checkdelridge(qhT *qh /* qh.visible_facets, vertex_mergeset */) {
+  QHULL_UNUSED(qh)
+}
+boolT qh_checkzero(qhT *qh, boolT testall) {
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(testall)
+    
+  return True;
+}
+void qh_freemergesets(qhT *qh) {
+  QHULL_UNUSED(qh)
+}
+void qh_initmergesets(qhT *qh) {
+  QHULL_UNUSED(qh)
+}
+void qh_merge_pinchedvertices(qhT *qh, int apexpointid /* qh.newfacet_list */) {
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(apexpointid)
+}
+#endif /* qh_NOmerge */
+
diff --git a/contrib/libs/qhull/libqhull_r/merge_r.h b/contrib/libs/qhull/libqhull_r/merge_r.h
new file mode 100644
index 0000000000..a0d4091ec8
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/merge_r.h
@@ -0,0 +1,238 @@
+/*<html><pre>  -<a                             href="qh-merge_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   merge_r.h
+   header file for merge_r.c
+
+   see qh-merge_r.htm and merge_r.c
+
+   Copyright (c) 1993-2020 C.B. Barber.
+   $Id: //main/2019/qhull/src/libqhull_r/merge_r.h#2 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#ifndef qhDEFmerge
+#define qhDEFmerge 1
+
+#include "libqhull_r.h"
+
+
+/*============ -constants- ==============*/
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >--------------------------------</a><a name="qh_ANGLEnone">-</a>
+
+  qh_ANGLEnone
+    indicates missing angle for mergeT->angle
+*/
+#define qh_ANGLEnone 2.0
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >--------------------------------</a><a name="MRG">-</a>
+
+  MRG... (mergeType)
+    indicates the type of a merge (mergeT->type)
+    MRGcoplanar...MRGtwisted set by qh_test_centrum_merge, qh_test_nonsimplicial_merge
+*/
+typedef enum {  /* must match mergetypes[] */
+  MRGnone= 0,
+                  /* MRGcoplanar..MRGtwisted go into qh.facet_mergeset for qh_all_merges 
+                     qh_compare_facetmerge selects lower mergetypes for merging first */
+  MRGcoplanar,          /* (1) centrum coplanar if centrum ('Cn') or vertex not clearly above or below neighbor */
+  MRGanglecoplanar,     /* (2) angle coplanar if angle ('An') is coplanar */
+  MRGconcave,           /* (3) concave ridge */
+  MRGconcavecoplanar,   /* (4) concave and coplanar ridge, one side concave, other side coplanar */
+  MRGtwisted,           /* (5) twisted ridge, both concave and convex, facet1 is wider */
+                  /* MRGflip go into qh.facet_mergeset for qh_flipped_merges */
+  MRGflip,              /* (6) flipped facet if qh.interior_point is above facet, w/ facet1 == facet2 */
+                  /* MRGdupridge go into qh.facet_mergeset for qh_forcedmerges */
+  MRGdupridge,          /* (7) dupridge if more than two neighbors.  Set by qh_mark_dupridges for qh_MERGEridge */
+                  /* MRGsubridge and MRGvertices go into vertex_mergeset */
+  MRGsubridge,          /* (8) merge pinched vertex to remove the subridge of a MRGdupridge */
+  MRGvertices,          /* (9) merge pinched vertex to remove a facet's ridges with the same vertices */
+                  /* MRGdegen, MRGredundant, and MRGmirror go into qh.degen_mergeset */
+  MRGdegen,             /* (10) degenerate facet (!enough neighbors) facet1 == facet2 */
+  MRGredundant,         /* (11) redundant facet (vertex subset) */
+                        /* merge_degenredundant assumes degen < redundant */
+  MRGmirror,            /* (12) mirror facets: same vertices due to null facets in qh_triangulate 
+                           f.redundant for both facets*/
+                  /* MRGcoplanarhorizon for qh_mergecycle_all only */
+  MRGcoplanarhorizon,   /* (13) new facet coplanar with the horizon (qh_mergecycle_all) */
+  ENDmrg
+} mergeType;
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >--------------------------------</a><a name="qh_MERGEapex">-</a>
+
+  qh_MERGEapex
+    flag for qh_mergefacet() to indicate an apex merge
+*/
+#define qh_MERGEapex     True
+
+/*============ -structures- ====================*/
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >--------------------------------</a><a name="mergeT">-</a>
+
+  mergeT
+    structure used to merge facets
+*/
+
+typedef struct mergeT mergeT;
+struct mergeT {         /* initialize in qh_appendmergeset */
+  realT   angle;        /* cosine of angle between normals of facet1 and facet2, 
+                           null value and right angle is 0.0, coplanar is 1.0, narrow is -1.0 */
+  realT   distance;     /* absolute value of distance between vertices, centrum and facet, or vertex and facet */
+  facetT *facet1;       /* will merge facet1 into facet2 */
+  facetT *facet2;
+  vertexT *vertex1;     /* will merge vertext1 into vertex2 for MRGsubridge or MRGvertices */
+  vertexT *vertex2;
+  ridgeT  *ridge1;      /* the duplicate ridges resolved by MRGvertices */
+  ridgeT  *ridge2;      /* merge is deleted if either ridge is deleted (qh_delridge) */
+  mergeType mergetype;
+};
+
+
+/*=========== -macros- =========================*/
+
+/*-<a                             href="qh-merge_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHmerge_">-</a>
+
+  FOREACHmerge_( merges ) {...}
+    assign 'merge' to each merge in merges
+
+  notes:
+    uses 'mergeT *merge, **mergep;'
+    if qh_mergefacet(),
+      restart or use qh_setdellast() since qh.facet_mergeset may change
+    see <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHmerge_(merges) FOREACHsetelement_(mergeT, merges, merge)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHmergeA_">-</a>
+
+  FOREACHmergeA_( vertices ) { ... }
+    assign 'mergeA' to each merge in merges
+
+  notes:
+    uses 'mergeT *mergeA, *mergeAp;'
+    see <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHmergeA_(merges) FOREACHsetelement_(mergeT, merges, mergeA)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHmerge_i_">-</a>
+
+  FOREACHmerge_i_(qh, vertices ) { ... }
+    assign 'merge' and 'merge_i' for each merge in mergeset
+
+  declare:
+    mergeT *merge;
+    int     merge_n, merge_i;
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_i_">FOREACHsetelement_i_</a>
+*/
+#define FOREACHmerge_i_(qh, mergeset) FOREACHsetelement_i_(qh, mergeT, mergeset, merge)
+
+/*============ prototypes in alphabetical order after pre/postmerge =======*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void    qh_premerge(qhT *qh, int apexpointid, realT maxcentrum, realT maxangle);
+void    qh_postmerge(qhT *qh, const char *reason, realT maxcentrum, realT maxangle,
+             boolT vneighbors);
+void    qh_all_merges(qhT *qh, boolT othermerge, boolT vneighbors);
+void    qh_all_vertexmerges(qhT *qh, int apexpointid, facetT *facet, facetT **retryfacet);
+void    qh_appendmergeset(qhT *qh, facetT *facet, facetT *neighbor, mergeType mergetype, coordT dist, realT angle);
+void    qh_appendvertexmerge(qhT *qh, vertexT *vertex, vertexT *destination, mergeType mergetype, realT distance, ridgeT *ridge1, ridgeT *ridge2);
+setT   *qh_basevertices(qhT *qh, facetT *samecycle);
+void    qh_check_dupridge(qhT *qh, facetT *facet1, realT dist1, facetT *facet2, realT dist2);
+void    qh_checkconnect(qhT *qh /* qh.new_facets */);
+void    qh_checkdelfacet(qhT *qh, facetT *facet, setT *mergeset);
+void    qh_checkdelridge(qhT *qh /* qh.visible_facets, vertex_mergeset */);
+boolT   qh_checkzero(qhT *qh, boolT testall);
+int     qh_compare_anglemerge(const void *p1, const void *p2);
+int     qh_compare_facetmerge(const void *p1, const void *p2);
+int     qh_comparevisit(const void *p1, const void *p2);
+void    qh_copynonconvex(qhT *qh, ridgeT *atridge);
+void    qh_degen_redundant_facet(qhT *qh, facetT *facet);
+void    qh_drop_mergevertex(qhT *qh, mergeT *merge);
+void    qh_delridge_merge(qhT *qh, ridgeT *ridge);
+vertexT *qh_find_newvertex(qhT *qh, vertexT *oldvertex, setT *vertices, setT *ridges);
+vertexT *qh_findbest_pinchedvertex(qhT *qh, mergeT *merge, vertexT *apex, vertexT **pinchedp, realT *distp /* qh.newfacet_list */);
+vertexT *qh_findbest_ridgevertex(qhT *qh, ridgeT *ridge, vertexT **pinchedp, coordT *distp);
+void    qh_findbest_test(qhT *qh, boolT testcentrum, facetT *facet, facetT *neighbor,
+           facetT **bestfacet, realT *distp, realT *mindistp, realT *maxdistp);
+facetT *qh_findbestneighbor(qhT *qh, facetT *facet, realT *distp, realT *mindistp, realT *maxdistp);
+void    qh_flippedmerges(qhT *qh, facetT *facetlist, boolT *wasmerge);
+void    qh_forcedmerges(qhT *qh, boolT *wasmerge);
+void    qh_freemergesets(qhT *qh);
+void    qh_getmergeset(qhT *qh, facetT *facetlist);
+void    qh_getmergeset_initial(qhT *qh, facetT *facetlist);
+boolT   qh_getpinchedmerges(qhT *qh, vertexT *apex, coordT maxdupdist, boolT *iscoplanar /* qh.newfacet_list, vertex_mergeset */);
+boolT   qh_hasmerge(setT *mergeset, mergeType type, facetT *facetA, facetT *facetB);
+void    qh_hashridge(qhT *qh, setT *hashtable, int hashsize, ridgeT *ridge, vertexT *oldvertex);
+ridgeT *qh_hashridge_find(qhT *qh, setT *hashtable, int hashsize, ridgeT *ridge,
+              vertexT *vertex, vertexT *oldvertex, int *hashslot);
+void    qh_initmergesets(qhT *qh);
+void    qh_makeridges(qhT *qh, facetT *facet);
+void    qh_mark_dupridges(qhT *qh, facetT *facetlist, boolT allmerges);
+void    qh_maybe_duplicateridge(qhT *qh, ridgeT *ridge);
+void    qh_maybe_duplicateridges(qhT *qh, facetT *facet);
+void    qh_maydropneighbor(qhT *qh, facetT *facet);
+int     qh_merge_degenredundant(qhT *qh);
+void    qh_merge_nonconvex(qhT *qh, facetT *facet1, facetT *facet2, mergeType mergetype);
+void    qh_merge_pinchedvertices(qhT *qh, int apexpointid /* qh.newfacet_list */);
+void    qh_merge_twisted(qhT *qh, facetT *facet1, facetT *facet2);
+void    qh_mergecycle(qhT *qh, facetT *samecycle, facetT *newfacet);
+void    qh_mergecycle_all(qhT *qh, facetT *facetlist, boolT *wasmerge);
+void    qh_mergecycle_facets(qhT *qh, facetT *samecycle, facetT *newfacet);
+void    qh_mergecycle_neighbors(qhT *qh, facetT *samecycle, facetT *newfacet);
+void    qh_mergecycle_ridges(qhT *qh, facetT *samecycle, facetT *newfacet);
+void    qh_mergecycle_vneighbors(qhT *qh, facetT *samecycle, facetT *newfacet);
+void    qh_mergefacet(qhT *qh, facetT *facet1, facetT *facet2, mergeType mergetype, realT *mindist, realT *maxdist, boolT mergeapex);
+void    qh_mergefacet2d(qhT *qh, facetT *facet1, facetT *facet2);
+void    qh_mergeneighbors(qhT *qh, facetT *facet1, facetT *facet2);
+void    qh_mergeridges(qhT *qh, facetT *facet1, facetT *facet2);
+void    qh_mergesimplex(qhT *qh, facetT *facet1, facetT *facet2, boolT mergeapex);
+void    qh_mergevertex_del(qhT *qh, vertexT *vertex, facetT *facet1, facetT *facet2);
+void    qh_mergevertex_neighbors(qhT *qh, facetT *facet1, facetT *facet2);
+void    qh_mergevertices(qhT *qh, setT *vertices1, setT **vertices);
+setT   *qh_neighbor_intersections(qhT *qh, vertexT *vertex);
+setT   *qh_neighbor_vertices(qhT *qh, vertexT *vertex, setT *subridge);
+void    qh_neighbor_vertices_facet(qhT *qh, vertexT *vertexA, facetT *facet, setT **vertices);
+void    qh_newvertices(qhT *qh, setT *vertices);
+mergeT *qh_next_vertexmerge(qhT *qh);
+facetT *qh_opposite_horizonfacet(qhT *qh, mergeT *merge, vertexT **vertex);
+boolT   qh_reducevertices(qhT *qh);
+vertexT *qh_redundant_vertex(qhT *qh, vertexT *vertex);
+boolT   qh_remove_extravertices(qhT *qh, facetT *facet);
+void    qh_remove_mergetype(qhT *qh, setT *mergeset, mergeType type);
+void    qh_rename_adjacentvertex(qhT *qh, vertexT *oldvertex, vertexT *newvertex, realT dist);
+vertexT *qh_rename_sharedvertex(qhT *qh, vertexT *vertex, facetT *facet);
+boolT   qh_renameridgevertex(qhT *qh, ridgeT *ridge, vertexT *oldvertex, vertexT *newvertex);
+void    qh_renamevertex(qhT *qh, vertexT *oldvertex, vertexT *newvertex, setT *ridges,
+                        facetT *oldfacet, facetT *neighborA);
+boolT   qh_test_appendmerge(qhT *qh, facetT *facet, facetT *neighbor, boolT simplicial);
+void    qh_test_degen_neighbors(qhT *qh, facetT *facet);
+boolT   qh_test_centrum_merge(qhT *qh, facetT *facet, facetT *neighbor, realT angle, boolT okangle);
+boolT   qh_test_nonsimplicial_merge(qhT *qh, facetT *facet, facetT *neighbor, realT angle, boolT okangle);
+void    qh_test_redundant_neighbors(qhT *qh, facetT *facet);
+boolT   qh_test_vneighbors(qhT *qh /* qh.newfacet_list */);
+void    qh_tracemerge(qhT *qh, facetT *facet1, facetT *facet2, mergeType mergetype);
+void    qh_tracemerging(qhT *qh);
+void    qh_undo_newfacets(qhT *qh);
+void    qh_updatetested(qhT *qh, facetT *facet1, facetT *facet2);
+setT   *qh_vertexridges(qhT *qh, vertexT *vertex, boolT allneighbors);
+void    qh_vertexridges_facet(qhT *qh, vertexT *vertex, facetT *facet, setT **ridges);
+void    qh_willdelete(qhT *qh, facetT *facet, facetT *replace);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif /* qhDEFmerge */
diff --git a/contrib/libs/qhull/libqhull_r/poly2_r.c b/contrib/libs/qhull/libqhull_r/poly2_r.c
new file mode 100644
index 0000000000..1ab52444ff
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/poly2_r.c
@@ -0,0 +1,3958 @@
+/*<html><pre>  -<a                             href="qh-poly_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   poly2_r.c
+   implements polygons and simplicies
+
+   see qh-poly_r.htm, poly_r.h and libqhull_r.h
+
+   frequently used code is in poly_r.c
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/poly2_r.c#20 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#include "qhull_ra.h"
+
+/*======== functions in alphabetical order ==========*/
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="addfacetvertex">-</a>
+
+  qh_addfacetvertex(qh, facet, newvertex )
+    add newvertex to facet.vertices if not already there
+    vertices are inverse sorted by vertex->id
+
+  returns:
+    True if new vertex for facet
+
+  notes:
+    see qh_replacefacetvertex
+*/
+boolT qh_addfacetvertex(qhT *qh, facetT *facet, vertexT *newvertex) {
+  vertexT *vertex;
+  int vertex_i= 0, vertex_n;
+  boolT isnew= True;
+
+  FOREACHvertex_i_(qh, facet->vertices) {
+    if (vertex->id < newvertex->id) {
+      break;
+    }else if (vertex->id == newvertex->id) {
+      isnew= False;
+      break;
+    }
+  }
+  if (isnew)
+    qh_setaddnth(qh, &facet->vertices, vertex_i, newvertex);
+  return isnew;
+} /* addfacetvertex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="addhash">-</a>
+
+  qh_addhash( newelem, hashtable, hashsize, hash )
+    add newelem to linear hash table at hash if not already there
+*/
+void qh_addhash(void *newelem, setT *hashtable, int hashsize, int hash) {
+  int scan;
+  void *elem;
+
+  for (scan= (int)hash; (elem= SETelem_(hashtable, scan));
+       scan= (++scan >= hashsize ? 0 : scan)) {
+    if (elem == newelem)
+      break;
+  }
+  /* loop terminates because qh_HASHfactor >= 1.1 by qh_initbuffers */
+  if (!elem)
+    SETelem_(hashtable, scan)= newelem;
+} /* addhash */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="check_bestdist">-</a>
+
+  qh_check_bestdist(qh)
+    check that all points are within max_outside of the nearest facet
+    if qh.ONLYgood,
+      ignores !good facets
+
+  see:
+    qh_check_maxout(), qh_outerinner()
+
+  notes:
+    only called from qh_check_points()
+      seldom used since qh.MERGING is almost always set
+    if notverified>0 at end of routine
+      some points were well inside the hull.  If the hull contains
+      a lens-shaped component, these points were not verified.  Use
+      options 'Qi Tv' to verify all points.  (Exhaustive check also verifies)
+
+  design:
+    determine facet for each point (if any)
+    for each point
+      start with the assigned facet or with the first facet
+      find the best facet for the point and check all coplanar facets
+      error if point is outside of facet
+*/
+void qh_check_bestdist(qhT *qh) {
+  boolT waserror= False, unassigned;
+  facetT *facet, *bestfacet, *errfacet1= NULL, *errfacet2= NULL;
+  facetT *facetlist;
+  realT dist, maxoutside, maxdist= -REALmax;
+  pointT *point;
+  int numpart= 0, facet_i, facet_n, notgood= 0, notverified= 0;
+  setT *facets;
+
+  trace1((qh, qh->ferr, 1020, "qh_check_bestdist: check points below nearest facet.  Facet_list f%d\n",
+      qh->facet_list->id));
+  maxoutside= qh_maxouter(qh);
+  maxoutside += qh->DISTround;
+  /* one more qh.DISTround for check computation */
+  trace1((qh, qh->ferr, 1021, "qh_check_bestdist: check that all points are within %2.2g of best facet\n", maxoutside));
+  facets= qh_pointfacet(qh /* qh.facet_list */);
+  if (!qh_QUICKhelp && qh->PRINTprecision)
+    qh_fprintf(qh, qh->ferr, 8091, "\n\
+qhull output completed.  Verifying that %d points are\n\
+below %2.2g of the nearest %sfacet.\n",
+             qh_setsize(qh, facets), maxoutside, (qh->ONLYgood ?  "good " : ""));
+  FOREACHfacet_i_(qh, facets) {  /* for each point with facet assignment */
+    if (facet)
+      unassigned= False;
+    else {
+      unassigned= True;
+      facet= qh->facet_list;
+    }
+    point= qh_point(qh, facet_i);
+    if (point == qh->GOODpointp)
+      continue;
+    qh_distplane(qh, point, facet, &dist);
+    numpart++;
+    bestfacet= qh_findbesthorizon(qh, !qh_IScheckmax, point, facet, qh_NOupper, &dist, &numpart);
+    /* occurs after statistics reported */
+    maximize_(maxdist, dist);
+    if (dist > maxoutside) {
+      if (qh->ONLYgood && !bestfacet->good
+      && !((bestfacet= qh_findgooddist(qh, point, bestfacet, &dist, &facetlist))
+      && dist > maxoutside))
+        notgood++;
+      else {
+        waserror= True;
+        qh_fprintf(qh, qh->ferr, 6109, "qhull precision error (qh_check_bestdist): point p%d is outside facet f%d, distance= %6.8g maxoutside= %6.8g\n",
+                facet_i, bestfacet->id, dist, maxoutside);
+        if (errfacet1 != bestfacet) {
+          errfacet2= errfacet1;
+          errfacet1= bestfacet;
+        }
+      }
+    }else if (unassigned && dist < -qh->MAXcoplanar)
+      notverified++;
+  }
+  qh_settempfree(qh, &facets);
+  if (notverified && !qh->DELAUNAY && !qh_QUICKhelp && qh->PRINTprecision)
+    qh_fprintf(qh, qh->ferr, 8092, "\n%d points were well inside the hull.  If the hull contains\n\
+a lens-shaped component, these points were not verified.  Use\n\
+options 'Qci Tv' to verify all points.\n", notverified);
+  if (maxdist > qh->outside_err) {
+    qh_fprintf(qh, qh->ferr, 6110, "qhull precision error (qh_check_bestdist): a coplanar point is %6.2g from convex hull.  The maximum value is qh.outside_err (%6.2g)\n",
+              maxdist, qh->outside_err);
+    qh_errexit2(qh, qh_ERRprec, errfacet1, errfacet2);
+  }else if (waserror && qh->outside_err > REALmax/2)
+    qh_errexit2(qh, qh_ERRprec, errfacet1, errfacet2);
+  /* else if waserror, the error was logged to qh.ferr but does not effect the output */
+  trace0((qh, qh->ferr, 20, "qh_check_bestdist: max distance outside %2.2g\n", maxdist));
+} /* check_bestdist */
+
+#ifndef qh_NOmerge
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="check_maxout">-</a>
+
+  qh_check_maxout(qh)
+    updates qh.max_outside by checking all points against bestfacet
+    if qh.ONLYgood, ignores !good facets
+
+  returns:
+    updates facet->maxoutside via qh_findbesthorizon()
+    sets qh.maxoutdone
+    if printing qh.min_vertex (qh_outerinner),
+      it is updated to the current vertices
+    removes inside/coplanar points from coplanarset as needed
+
+  notes:
+    defines coplanar as qh.min_vertex instead of qh.MAXcoplanar
+    may not need to check near-inside points because of qh.MAXcoplanar
+      and qh.KEEPnearinside (before it was -qh.DISTround)
+
+  see also:
+    qh_check_bestdist()
+
+  design:
+    if qh.min_vertex is needed
+      for all neighbors of all vertices
+        test distance from vertex to neighbor
+    determine facet for each point (if any)
+    for each point with an assigned facet
+      find the best facet for the point and check all coplanar facets
+        (updates outer planes)
+    remove near-inside points from coplanar sets
+*/
+void qh_check_maxout(qhT *qh) {
+  facetT *facet, *bestfacet, *neighbor, **neighborp, *facetlist, *maxbestfacet= NULL, *minfacet, *maxfacet, *maxpointfacet;
+  realT dist, maxoutside, mindist, nearest;
+  realT maxoutside_base, minvertex_base;
+  pointT *point, *maxpoint= NULL;
+  int numpart= 0, facet_i, facet_n, notgood= 0;
+  setT *facets, *vertices;
+  vertexT *vertex, *minvertex;
+
+  trace1((qh, qh->ferr, 1022, "qh_check_maxout: check and update qh.min_vertex %2.2g and qh.max_outside %2.2g\n", qh->min_vertex, qh->max_outside));
+  minvertex_base= fmin_(qh->min_vertex, -(qh->ONEmerge+qh->DISTround));
+  maxoutside= mindist= 0.0;
+  minvertex= qh->vertex_list;
+  maxfacet= minfacet= maxpointfacet= qh->facet_list;
+  if (qh->VERTEXneighbors
+  && (qh->PRINTsummary || qh->KEEPinside || qh->KEEPcoplanar
+        || qh->TRACElevel || qh->PRINTstatistics || qh->VERIFYoutput || qh->CHECKfrequently
+        || qh->PRINTout[0] == qh_PRINTsummary || qh->PRINTout[0] == qh_PRINTnone)) {
+    trace1((qh, qh->ferr, 1023, "qh_check_maxout: determine actual minvertex\n"));
+    vertices= qh_pointvertex(qh /* qh.facet_list */);
+    FORALLvertices {
+      FOREACHneighbor_(vertex) {
+        zinc_(Zdistvertex);  /* distance also computed by main loop below */
+        qh_distplane(qh, vertex->point, neighbor, &dist);
+        if (dist < mindist) {
+          if (qh->min_vertex/minvertex_base > qh_WIDEmaxoutside && (qh->PRINTprecision || !qh->ALLOWwide)) {
+            nearest= qh_vertex_bestdist(qh, neighbor->vertices);
+            /* should be caught in qh_mergefacet */
+            qh_fprintf(qh, qh->ferr, 7083, "Qhull precision warning: in post-processing (qh_check_maxout) p%d(v%d) is %2.2g below f%d nearest vertices %2.2g\n",
+              qh_pointid(qh, vertex->point), vertex->id, dist, neighbor->id, nearest);
+          }
+          mindist= dist;
+          minvertex= vertex;
+          minfacet= neighbor;
+        }
+#ifndef qh_NOtrace
+        if (-dist > qh->TRACEdist || dist > qh->TRACEdist
+        || neighbor == qh->tracefacet || vertex == qh->tracevertex) {
+          nearest= qh_vertex_bestdist(qh, neighbor->vertices);
+          qh_fprintf(qh, qh->ferr, 8093, "qh_check_maxout: p%d(v%d) is %.2g from f%d nearest vertices %2.2g\n",
+                    qh_pointid(qh, vertex->point), vertex->id, dist, neighbor->id, nearest);
+        }
+#endif
+      }
+    }
+    if (qh->MERGING) {
+      wmin_(Wminvertex, qh->min_vertex);
+    }
+    qh->min_vertex= mindist;
+    qh_settempfree(qh, &vertices);
+  }
+  trace1((qh, qh->ferr, 1055, "qh_check_maxout: determine actual maxoutside\n"));
+  maxoutside_base= fmax_(qh->max_outside, qh->ONEmerge+qh->DISTround);
+  /* maxoutside_base is same as qh.MAXoutside without qh.MINoutside (qh_detmaxoutside) */
+  facets= qh_pointfacet(qh /* qh.facet_list */);
+  FOREACHfacet_i_(qh, facets) {     /* for each point with facet assignment */
+    if (facet) {
+      point= qh_point(qh, facet_i);
+      if (point == qh->GOODpointp)
+        continue;
+      zzinc_(Ztotcheck);
+      qh_distplane(qh, point, facet, &dist);
+      numpart++;
+      bestfacet= qh_findbesthorizon(qh, qh_IScheckmax, point, facet, !qh_NOupper, &dist, &numpart);
+      if (bestfacet && dist >= maxoutside) { 
+        if (qh->ONLYgood && !bestfacet->good
+        && !((bestfacet= qh_findgooddist(qh, point, bestfacet, &dist, &facetlist))
+        && dist > maxoutside)) {       
+          notgood++;
+        }else if (dist/maxoutside_base > qh_WIDEmaxoutside && (qh->PRINTprecision || !qh->ALLOWwide)) {
+          nearest= qh_vertex_bestdist(qh, bestfacet->vertices);
+          if (nearest < fmax_(qh->ONEmerge, qh->max_outside) * qh_RATIOcoplanaroutside * 2) {
+            qh_fprintf(qh, qh->ferr, 7087, "Qhull precision warning: in post-processing (qh_check_maxout) p%d for f%d is %2.2g above twisted facet f%d nearest vertices %2.2g\n",
+              qh_pointid(qh, point), facet->id, dist, bestfacet->id, nearest);
+          }else {
+            qh_fprintf(qh, qh->ferr, 7088, "Qhull precision warning: in post-processing (qh_check_maxout) p%d for f%d is %2.2g above hidden facet f%d nearest vertices %2.2g\n",
+              qh_pointid(qh, point), facet->id, dist, bestfacet->id, nearest);
+          }
+          maxbestfacet= bestfacet;
+        }
+        maxoutside= dist;
+        maxfacet= bestfacet;
+        maxpoint= point;
+        maxpointfacet= facet;
+      }
+      if (dist > qh->TRACEdist || (bestfacet && bestfacet == qh->tracefacet))
+        qh_fprintf(qh, qh->ferr, 8094, "qh_check_maxout: p%d is %.2g above f%d\n",
+              qh_pointid(qh, point), dist, (bestfacet ? bestfacet->id : UINT_MAX));
+    }
+  }
+  zzadd_(Zcheckpart, numpart);
+  qh_settempfree(qh, &facets);
+  wval_(Wmaxout)= maxoutside - qh->max_outside;
+  wmax_(Wmaxoutside, qh->max_outside);
+  if (!qh->APPROXhull && maxoutside > qh->DISTround) { /* initial value for f.maxoutside */
+    FORALLfacets {
+      if (maxoutside < facet->maxoutside) {
+        if (!qh->KEEPcoplanar) {
+          maxoutside= facet->maxoutside;
+        }else if (maxoutside + qh->DISTround < facet->maxoutside) { /* maxoutside is computed distance, e.g., rbox 100 s D3 t1547136913 | qhull R1e-3 Tcv Qc */
+          qh_fprintf(qh, qh->ferr, 7082, "Qhull precision warning (qh_check_maxout): f%d.maxoutside (%4.4g) is greater than computed qh.max_outside (%2.2g) + qh.DISTround (%2.2g).  It should be less than or equal\n",
+            facet->id, facet->maxoutside, maxoutside, qh->DISTround); 
+        }
+      }
+    }
+  }
+  qh->max_outside= maxoutside; 
+  qh_nearcoplanar(qh /* qh.facet_list */);
+  qh->maxoutdone= True;
+  trace1((qh, qh->ferr, 1024, "qh_check_maxout:  p%d(v%d) is qh.min_vertex %2.2g below facet f%d.  Point p%d for f%d is qh.max_outside %2.2g above f%d.  %d points are outside of not-good facets\n", 
+    qh_pointid(qh, minvertex->point), minvertex->id, qh->min_vertex, minfacet->id, qh_pointid(qh, maxpoint), maxpointfacet->id, qh->max_outside, maxfacet->id, notgood));
+  if(!qh->ALLOWwide) {
+    if (maxoutside/maxoutside_base > qh_WIDEmaxoutside) {
+      qh_fprintf(qh, qh->ferr, 6297, "Qhull precision error (qh_check_maxout): large increase in qh.max_outside during post-processing dist %2.2g (%.1fx).  See warning QH0032/QH0033.  Allow with 'Q12' (allow-wide) and 'Pp'\n",
+        maxoutside, maxoutside/maxoutside_base);
+      qh_errexit(qh, qh_ERRwide, maxbestfacet, NULL);
+    }else if (!qh->APPROXhull && maxoutside_base > (qh->ONEmerge * qh_WIDEmaxoutside2)) {
+      if (maxoutside > (qh->ONEmerge * qh_WIDEmaxoutside2)) {  /* wide facets may have been deleted */
+        qh_fprintf(qh, qh->ferr, 6298, "Qhull precision error (qh_check_maxout): a facet merge, vertex merge, vertex, or coplanar point produced a wide facet %2.2g (%.1fx). Trace with option 'TWn' to identify the merge.   Allow with 'Q12' (allow-wide)\n",
+          maxoutside_base, maxoutside_base/(qh->ONEmerge + qh->DISTround));
+        qh_errexit(qh, qh_ERRwide, maxbestfacet, NULL);
+      }
+    }else if (qh->min_vertex/minvertex_base > qh_WIDEmaxoutside) {
+      qh_fprintf(qh, qh->ferr, 6354, "Qhull precision error (qh_check_maxout): large increase in qh.min_vertex during post-processing dist %2.2g (%.1fx).  See warning QH7083.  Allow with 'Q12' (allow-wide) and 'Pp'\n",
+        qh->min_vertex, qh->min_vertex/minvertex_base);
+      qh_errexit(qh, qh_ERRwide, minfacet, NULL);
+    }else if (minvertex_base < -(qh->ONEmerge * qh_WIDEmaxoutside2)) {
+      if (qh->min_vertex < -(qh->ONEmerge * qh_WIDEmaxoutside2)) {  /* wide facets may have been deleted */
+        qh_fprintf(qh, qh->ferr, 6380, "Qhull precision error (qh_check_maxout): a facet or vertex merge produced a wide facet: v%d below f%d distance %2.2g (%.1fx). Trace with option 'TWn' to identify the merge.  Allow with 'Q12' (allow-wide)\n",
+          minvertex->id, minfacet->id, mindist, -qh->min_vertex/(qh->ONEmerge + qh->DISTround));
+        qh_errexit(qh, qh_ERRwide, minfacet, NULL);
+      }
+    }
+  }
+} /* check_maxout */
+#else /* qh_NOmerge */
+void qh_check_maxout(qhT *qh) {
+  QHULL_UNUSED(qh)
+}
+#endif
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="check_output">-</a>
+
+  qh_check_output(qh)
+    performs the checks at the end of qhull algorithm
+    Maybe called after Voronoi output.  If so, it recomputes centrums since they are Voronoi centers instead.
+*/
+void qh_check_output(qhT *qh) {
+  int i;
+
+  if (qh->STOPcone)
+    return;
+  if (qh->VERIFYoutput || qh->IStracing || qh->CHECKfrequently) {
+    qh_checkpolygon(qh, qh->facet_list);
+    qh_checkflipped_all(qh, qh->facet_list);
+    qh_checkconvex(qh, qh->facet_list, qh_ALGORITHMfault);
+  }else if (!qh->MERGING && qh_newstats(qh, qh->qhstat.precision, &i)) {
+    qh_checkflipped_all(qh, qh->facet_list);
+    qh_checkconvex(qh, qh->facet_list, qh_ALGORITHMfault);
+  }
+} /* check_output */
+
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="check_point">-</a>
+
+  qh_check_point(qh, point, facet, maxoutside, maxdist, errfacet1, errfacet2, errcount )
+    check that point is less than maxoutside from facet
+
+  notes:
+    only called from qh_checkpoints
+    reports up to qh_MAXcheckpoint-1 errors per facet
+*/
+void qh_check_point(qhT *qh, pointT *point, facetT *facet, realT *maxoutside, realT *maxdist, facetT **errfacet1, facetT **errfacet2, int *errcount) {
+  realT dist, nearest;
+
+  /* occurs after statistics reported */
+  qh_distplane(qh, point, facet, &dist);
+  maximize_(*maxdist, dist);
+  if (dist > *maxoutside) {
+    (*errcount)++;
+    if (*errfacet1 != facet) {
+      *errfacet2= *errfacet1;
+      *errfacet1= facet;
+    }
+    if (*errcount < qh_MAXcheckpoint) {
+      nearest= qh_vertex_bestdist(qh, facet->vertices);
+      qh_fprintf(qh, qh->ferr, 6111, "qhull precision error: point p%d is outside facet f%d, distance= %6.8g maxoutside= %6.8g nearest vertices %2.2g\n",
+                qh_pointid(qh, point), facet->id, dist, *maxoutside, nearest);
+    }
+  }
+} /* qh_check_point */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="check_points">-</a>
+
+  qh_check_points(qh)
+    checks that all points are inside all facets
+
+  notes:
+    if many points and qh_check_maxout not called (i.e., !qh.MERGING),
+       calls qh_findbesthorizon via qh_check_bestdist (seldom done).
+    ignores flipped facets
+    maxoutside includes 2 qh.DISTrounds
+      one qh.DISTround for the computed distances in qh_check_points
+    qh_printafacet and qh_printsummary needs only one qh.DISTround
+    the computation for qh.VERIFYdirect does not account for qh.other_points
+
+  design:
+    if many points
+      use qh_check_bestdist()
+    else
+      for all facets
+        for all points
+          check that point is inside facet
+*/
+void qh_check_points(qhT *qh) {
+  facetT *facet, *errfacet1= NULL, *errfacet2= NULL;
+  realT total, maxoutside, maxdist= -REALmax;
+  pointT *point, **pointp, *pointtemp;
+  int errcount;
+  boolT testouter;
+
+  maxoutside= qh_maxouter(qh);
+  maxoutside += qh->DISTround;
+  /* one more qh.DISTround for check computation */
+  trace1((qh, qh->ferr, 1025, "qh_check_points: check all points below %2.2g of all facet planes\n",
+          maxoutside));
+  if (qh->num_good)   /* miss counts other_points and !good facets */
+     total= (float)qh->num_good * (float)qh->num_points;
+  else
+     total= (float)qh->num_facets * (float)qh->num_points;
+  if (total >= qh_VERIFYdirect && !qh->maxoutdone) {
+    if (!qh_QUICKhelp && qh->SKIPcheckmax && qh->MERGING)
+      qh_fprintf(qh, qh->ferr, 7075, "qhull input warning: merging without checking outer planes('Q5' or 'Po').  Verify may report that a point is outside of a facet.\n");
+    qh_check_bestdist(qh);
+  }else {
+    if (qh_MAXoutside && qh->maxoutdone)
+      testouter= True;
+    else
+      testouter= False;
+    if (!qh_QUICKhelp) {
+      if (qh->MERGEexact)
+        qh_fprintf(qh, qh->ferr, 7076, "qhull input warning: exact merge ('Qx').  Verify may report that a point is outside of a facet.  See qh-optq.htm#Qx\n");
+      else if (qh->SKIPcheckmax || qh->NOnearinside)
+        qh_fprintf(qh, qh->ferr, 7077, "qhull input warning: no outer plane check ('Q5') or no processing of near-inside points ('Q8').  Verify may report that a point is outside of a facet.\n");
+    }
+    if (qh->PRINTprecision) {
+      if (testouter)
+        qh_fprintf(qh, qh->ferr, 8098, "\n\
+Output completed.  Verifying that all points are below outer planes of\n\
+all %sfacets.  Will make %2.0f distance computations.\n",
+              (qh->ONLYgood ?  "good " : ""), total);
+      else
+        qh_fprintf(qh, qh->ferr, 8099, "\n\
+Output completed.  Verifying that all points are below %2.2g of\n\
+all %sfacets.  Will make %2.0f distance computations.\n",
+              maxoutside, (qh->ONLYgood ?  "good " : ""), total);
+    }
+    FORALLfacets {
+      if (!facet->good && qh->ONLYgood)
+        continue;
+      if (facet->flipped)
+        continue;
+      if (!facet->normal) {
+        qh_fprintf(qh, qh->ferr, 7061, "qhull warning (qh_check_points): missing normal for facet f%d\n", facet->id);
+        if (!errfacet1)
+          errfacet1= facet;
+        continue;
+      }
+      if (testouter) {
+#if qh_MAXoutside
+        maxoutside= facet->maxoutside + 2 * qh->DISTround;
+        /* one DISTround to actual point and another to computed point */
+#endif
+      }
+      errcount= 0;
+      FORALLpoints {
+        if (point != qh->GOODpointp)
+          qh_check_point(qh, point, facet, &maxoutside, &maxdist, &errfacet1, &errfacet2, &errcount);
+      }
+      FOREACHpoint_(qh->other_points) {
+        if (point != qh->GOODpointp)
+          qh_check_point(qh, point, facet, &maxoutside, &maxdist, &errfacet1, &errfacet2, &errcount);
+      }
+      if (errcount >= qh_MAXcheckpoint) {
+        qh_fprintf(qh, qh->ferr, 6422, "qhull precision error (qh_check_points): %d additional points outside facet f%d, maxdist= %6.8g\n",
+             errcount-qh_MAXcheckpoint+1, facet->id, maxdist);
+      }
+    }
+    if (maxdist > qh->outside_err) {
+      qh_fprintf(qh, qh->ferr, 6112, "qhull precision error (qh_check_points): a coplanar point is %6.2g from convex hull.  The maximum value(qh.outside_err) is %6.2g\n",
+                maxdist, qh->outside_err );
+      qh_errexit2(qh, qh_ERRprec, errfacet1, errfacet2 );
+    }else if (errfacet1 && qh->outside_err > REALmax/2)
+        qh_errexit2(qh, qh_ERRprec, errfacet1, errfacet2 );
+    /* else if errfacet1, the error was logged to qh.ferr but does not effect the output */
+    trace0((qh, qh->ferr, 21, "qh_check_points: max distance outside %2.2g\n", maxdist));
+  }
+} /* check_points */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="checkconvex">-</a>
+
+  qh_checkconvex(qh, facetlist, fault )
+    check that each ridge in facetlist is convex
+    fault = qh_DATAfault if reporting errors from qh_initialhull with qh.ZEROcentrum
+          = qh_ALGORITHMfault otherwise
+
+  returns:
+    counts Zconcaveridges and Zcoplanarridges
+    errors if !qh.FORCEoutput ('Fo') and concaveridge or if merging a coplanar ridge
+    overwrites Voronoi centers if set by qh_setvoronoi_all/qh_ASvoronoi
+
+  notes:
+    called by qh_initial_hull, qh_check_output, qh_all_merges ('Tc'), qh_build_withrestart ('QJ')
+    does not test f.tricoplanar facets (qh_triangulate)
+    must be no stronger than qh_test_appendmerge
+    if not merging,
+      tests vertices for neighboring simplicial facets < -qh.DISTround
+    else if ZEROcentrum and simplicial facet,
+      tests vertices for neighboring simplicial facets < 0.0
+      tests centrums of neighboring nonsimplicial facets < 0.0
+    else if ZEROcentrum 
+      tests centrums of neighboring facets < 0.0
+    else 
+      tests centrums of neighboring facets < -qh.DISTround ('En' 'Rn')
+    Does not test against -qh.centrum_radius since repeated computations may have different round-off errors (e.g., 'Rn')
+
+  design:
+    for all facets
+      report flipped facets
+      if ZEROcentrum and simplicial neighbors
+        test vertices against neighbor
+      else
+        test centrum against neighbor
+*/
+void qh_checkconvex(qhT *qh, facetT *facetlist, int fault) {
+  facetT *facet, *neighbor, **neighborp, *errfacet1=NULL, *errfacet2=NULL;
+  vertexT *vertex;
+  realT dist;
+  pointT *centrum;
+  boolT waserror= False, centrum_warning= False, tempcentrum= False, first_nonsimplicial= False, tested_simplicial, allsimplicial;
+  int neighbor_i, neighbor_n;
+
+  if (qh->ZEROcentrum) {
+    trace1((qh, qh->ferr, 1064, "qh_checkconvex: check that facets are not-flipped and for qh.ZEROcentrum that simplicial vertices are below their neighbor (dist<0.0)\n"));
+    first_nonsimplicial= True;
+  }else if (!qh->MERGING) {
+    trace1((qh, qh->ferr, 1026, "qh_checkconvex: check that facets are not-flipped and that simplicial vertices are convex by qh.DISTround ('En', 'Rn')\n"));
+    first_nonsimplicial= True;
+  }else
+    trace1((qh, qh->ferr, 1062, "qh_checkconvex: check that facets are not-flipped and that their centrums are convex by qh.DISTround ('En', 'Rn') \n"));
+  if (!qh->RERUN) {
+    zzval_(Zconcaveridges)= 0;
+    zzval_(Zcoplanarridges)= 0;
+  }
+  FORALLfacet_(facetlist) {
+    if (facet->flipped) {
+      qh_joggle_restart(qh, "flipped facet"); /* also tested by qh_checkflipped */
+      qh_fprintf(qh, qh->ferr, 6113, "qhull precision error: f%d is flipped (interior point is outside)\n",
+               facet->id);
+      errfacet1= facet;
+      waserror= True;
+      continue;
+    }
+    if (facet->tricoplanar)
+      continue;
+    if (qh->MERGING && (!qh->ZEROcentrum || !facet->simplicial)) {
+      allsimplicial= False;
+      tested_simplicial= False;
+    }else {
+      allsimplicial= True;
+      tested_simplicial= True;
+      FOREACHneighbor_i_(qh, facet) {
+        if (neighbor->tricoplanar)
+          continue;
+        if (!neighbor->simplicial) {
+          allsimplicial= False;
+          continue;
+        }
+        vertex= SETelemt_(facet->vertices, neighbor_i, vertexT);
+        qh_distplane(qh, vertex->point, neighbor, &dist);
+        if (dist >= -qh->DISTround) {
+          if (fault == qh_DATAfault) {
+            qh_joggle_restart(qh, "non-convex initial simplex");
+            if (dist > qh->DISTround)
+              qh_fprintf(qh, qh->ferr, 6114, "qhull precision error: initial simplex is not convex, since p%d(v%d) is %6.4g above opposite f%d\n", 
+                  qh_pointid(qh, vertex->point), vertex->id, dist, neighbor->id);
+            else
+              qh_fprintf(qh, qh->ferr, 6379, "qhull precision error: initial simplex is not convex, since p%d(v%d) is within roundoff of opposite facet f%d (dist %6.4g)\n",
+                  qh_pointid(qh, vertex->point), vertex->id, neighbor->id, dist);
+            qh_errexit(qh, qh_ERRsingular, neighbor, NULL);
+          }
+          if (dist > qh->DISTround) {
+            zzinc_(Zconcaveridges);
+            qh_joggle_restart(qh, "concave ridge");
+            qh_fprintf(qh, qh->ferr, 6115, "qhull precision error: f%d is concave to f%d, since p%d(v%d) is %6.4g above f%d\n",
+              facet->id, neighbor->id, qh_pointid(qh, vertex->point), vertex->id, dist, neighbor->id);
+            errfacet1= facet;
+            errfacet2= neighbor;
+            waserror= True;
+          }else if (qh->ZEROcentrum) {
+            if (dist > 0.0) {     /* qh_checkzero checked convex (dist < (- 2*qh->DISTround)), computation may differ e.g. 'Rn' */
+              zzinc_(Zcoplanarridges);
+              qh_joggle_restart(qh, "coplanar ridge");
+              qh_fprintf(qh, qh->ferr, 6116, "qhull precision error: f%d is clearly not convex to f%d, since p%d(v%d) is %6.4g above or coplanar with f%d with qh.ZEROcentrum\n",
+                facet->id, neighbor->id, qh_pointid(qh, vertex->point), vertex->id, dist, neighbor->id);
+              errfacet1= facet;
+              errfacet2= neighbor;
+              waserror= True;
+            }
+          }else {
+            zzinc_(Zcoplanarridges);
+            qh_joggle_restart(qh, "coplanar ridge");
+            trace0((qh, qh->ferr, 22, "qhull precision error: f%d is coplanar to f%d, since p%d(v%d) is within %6.4g of f%d, during p%d\n",
+              facet->id, neighbor->id, qh_pointid(qh, vertex->point), vertex->id, dist, neighbor->id, qh->furthest_id));
+          }
+        }
+      }
+    }
+    if (!allsimplicial) {
+      if (first_nonsimplicial) {
+        trace1((qh, qh->ferr, 1063, "qh_checkconvex: starting with f%d, also check that centrums of non-simplicial ridges are below their neighbors (dist<0.0)\n",
+             facet->id));
+        first_nonsimplicial= False;
+      }
+      if (qh->CENTERtype == qh_AScentrum) {
+        if (!facet->center)
+          facet->center= qh_getcentrum(qh, facet);
+        centrum= facet->center;
+      }else {
+        if (!centrum_warning && !facet->simplicial) {  /* recomputed centrum correct for simplicial facets */
+           centrum_warning= True;
+           qh_fprintf(qh, qh->ferr, 7062, "qhull warning: recomputing centrums for convexity test.  This may lead to false, precision errors.\n");
+        }
+        centrum= qh_getcentrum(qh, facet);
+        tempcentrum= True;
+      }
+      FOREACHneighbor_(facet) {
+        if (neighbor->simplicial && tested_simplicial) /* tested above since f.simplicial */
+          continue;
+        if (neighbor->tricoplanar)
+          continue;
+        zzinc_(Zdistconvex);
+        qh_distplane(qh, centrum, neighbor, &dist);
+        if (dist > qh->DISTround) {
+          zzinc_(Zconcaveridges);
+          qh_joggle_restart(qh, "concave ridge");
+          qh_fprintf(qh, qh->ferr, 6117, "qhull precision error: f%d is concave to f%d.  Centrum of f%d is %6.4g above f%d\n",
+            facet->id, neighbor->id, facet->id, dist, neighbor->id);
+          errfacet1= facet;
+          errfacet2= neighbor;
+          waserror= True;
+        }else if (dist >= 0.0) {   /* if arithmetic always rounds the same,
+                                     can test against centrum radius instead */
+          zzinc_(Zcoplanarridges);
+          qh_joggle_restart(qh, "coplanar ridge");
+          qh_fprintf(qh, qh->ferr, 6118, "qhull precision error: f%d is coplanar or concave to f%d.  Centrum of f%d is %6.4g above f%d\n",
+            facet->id, neighbor->id, facet->id, dist, neighbor->id);
+          errfacet1= facet;
+          errfacet2= neighbor;
+          waserror= True;
+        }
+      }
+      if (tempcentrum)
+        qh_memfree(qh, centrum, qh->normal_size);
+    }
+  }
+  if (waserror && !qh->FORCEoutput)
+    qh_errexit2(qh, qh_ERRprec, errfacet1, errfacet2);
+} /* checkconvex */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="checkfacet">-</a>
+
+  qh_checkfacet(qh, facet, newmerge, waserror )
+    checks for consistency errors in facet
+    newmerge set if from merge_r.c
+
+  returns:
+    sets waserror if any error occurs
+
+  checks:
+    vertex ids are inverse sorted
+    unless newmerge, at least hull_dim neighbors and vertices (exactly if simplicial)
+    if non-simplicial, at least as many ridges as neighbors
+    neighbors are not duplicated
+    ridges are not duplicated
+    in 3-d, ridges=verticies
+    (qh.hull_dim-1) ridge vertices
+    neighbors are reciprocated
+    ridge neighbors are facet neighbors and a ridge for every neighbor
+    simplicial neighbors match facetintersect
+    vertex intersection matches vertices of common ridges
+    vertex neighbors and facet vertices agree
+    all ridges have distinct vertex sets
+
+  notes:
+    called by qh_tracemerge and qh_checkpolygon
+    uses neighbor->seen
+
+  design:
+    check sets
+    check vertices
+    check sizes of neighbors and vertices
+    check for qh_MERGEridge and qh_DUPLICATEridge flags
+    check neighbor set
+    check ridge set
+    check ridges, neighbors, and vertices
+*/
+void qh_checkfacet(qhT *qh, facetT *facet, boolT newmerge, boolT *waserrorp) {
+  facetT *neighbor, **neighborp, *errother=NULL;
+  ridgeT *ridge, **ridgep, *errridge= NULL, *ridge2;
+  vertexT *vertex, **vertexp;
+  unsigned int previousid= INT_MAX;
+  int numneighbors, numvertices, numridges=0, numRvertices=0;
+  boolT waserror= False;
+  int skipA, skipB, ridge_i, ridge_n, i, last_v= qh->hull_dim-2;
+  setT *intersection;
+
+  trace4((qh, qh->ferr, 4088, "qh_checkfacet: check f%d newmerge? %d\n", facet->id, newmerge));
+  if (facet->id >= qh->facet_id) {
+    qh_fprintf(qh, qh->ferr, 6414, "qhull internal error (qh_checkfacet): unknown facet id f%d >= qh.facet_id (%d)\n", facet->id, qh->facet_id);
+    waserror= True;
+  }
+  if (facet->visitid > qh->visit_id) {
+    qh_fprintf(qh, qh->ferr, 6415, "qhull internal error (qh_checkfacet): expecting f%d.visitid <= qh.visit_id (%d).  Got visitid %d\n", facet->id, qh->visit_id, facet->visitid);
+    waserror= True;
+  }
+  if (facet->visible && !qh->NEWtentative) {
+    qh_fprintf(qh, qh->ferr, 6119, "qhull internal error (qh_checkfacet): facet f%d is on qh.visible_list\n",
+      facet->id);
+    qh_errexit(qh, qh_ERRqhull, facet, NULL);
+  }
+  if (facet->redundant && !facet->visible && qh_setsize(qh, qh->degen_mergeset)==0) {
+    qh_fprintf(qh, qh->ferr, 6399, "qhull internal error (qh_checkfacet): redundant facet f%d not on qh.visible_list\n",
+      facet->id);
+    waserror= True;
+  }
+  if (facet->degenerate && !facet->visible && qh_setsize(qh, qh->degen_mergeset)==0) { 
+    qh_fprintf(qh, qh->ferr, 6400, "qhull internal error (qh_checkfacet): degenerate facet f%d is not on qh.visible_list and qh.degen_mergeset is empty\n",
+      facet->id);
+    waserror= True;
+  }
+  if (!facet->normal) {
+    qh_fprintf(qh, qh->ferr, 6120, "qhull internal error (qh_checkfacet): facet f%d does not have a normal\n",
+      facet->id);
+    waserror= True;
+  }
+  if (!facet->newfacet) {
+    if (facet->dupridge) {
+      qh_fprintf(qh, qh->ferr, 6349, "qhull internal error (qh_checkfacet): f%d is 'dupridge' but it is not a newfacet on qh.newfacet_list f%d\n",
+        facet->id, getid_(qh->newfacet_list));
+      waserror= True;
+    }
+    if (facet->newmerge) {
+      qh_fprintf(qh, qh->ferr, 6383, "qhull internal error (qh_checkfacet): f%d is 'newmerge' but it is not a newfacet on qh.newfacet_list f%d.  Missing call to qh_reducevertices\n",  
+        facet->id, getid_(qh->newfacet_list));
+      waserror= True;
+    }
+  }
+  qh_setcheck(qh, facet->vertices, "vertices for f", facet->id);
+  qh_setcheck(qh, facet->ridges, "ridges for f", facet->id);
+  qh_setcheck(qh, facet->outsideset, "outsideset for f", facet->id);
+  qh_setcheck(qh, facet->coplanarset, "coplanarset for f", facet->id);
+  qh_setcheck(qh, facet->neighbors, "neighbors for f", facet->id);
+  FOREACHvertex_(facet->vertices) {
+    if (vertex->deleted) {
+      qh_fprintf(qh, qh->ferr, 6121, "qhull internal error (qh_checkfacet): deleted vertex v%d in f%d\n", vertex->id, facet->id);
+      qh_errprint(qh, "ERRONEOUS", NULL, NULL, NULL, vertex);
+      waserror= True;
+    }
+    if (vertex->id >= previousid) {
+      qh_fprintf(qh, qh->ferr, 6122, "qhull internal error (qh_checkfacet): vertices of f%d are not in descending id order at v%d\n", facet->id, vertex->id);
+      waserror= True;
+      break;
+    }
+    previousid= vertex->id;
+  }
+  numneighbors= qh_setsize(qh, facet->neighbors);
+  numvertices= qh_setsize(qh, facet->vertices);
+  numridges= qh_setsize(qh, facet->ridges);
+  if (facet->simplicial) {
+    if (numvertices+numneighbors != 2*qh->hull_dim
+    && !facet->degenerate && !facet->redundant) {
+      qh_fprintf(qh, qh->ferr, 6123, "qhull internal error (qh_checkfacet): for simplicial facet f%d, #vertices %d + #neighbors %d != 2*qh->hull_dim\n",
+                facet->id, numvertices, numneighbors);
+      qh_setprint(qh, qh->ferr, "", facet->neighbors);
+      waserror= True;
+    }
+  }else { /* non-simplicial */
+    if (!newmerge
+    &&(numvertices < qh->hull_dim || numneighbors < qh->hull_dim)
+    && !facet->degenerate && !facet->redundant) {
+      qh_fprintf(qh, qh->ferr, 6124, "qhull internal error (qh_checkfacet): for facet f%d, #vertices %d or #neighbors %d < qh->hull_dim\n",
+         facet->id, numvertices, numneighbors);
+       waserror= True;
+    }
+    /* in 3-d, can get a vertex twice in an edge list, e.g., RBOX 1000 s W1e-13 t995849315 D2 | QHULL d Tc Tv TP624 TW1e-13 T4 */
+    if (numridges < numneighbors
+    ||(qh->hull_dim == 3 && numvertices > numridges && !qh->NEWfacets)
+    ||(qh->hull_dim == 2 && numridges + numvertices + numneighbors != 6)) {
+      if (!facet->degenerate && !facet->redundant) {
+        qh_fprintf(qh, qh->ferr, 6125, "qhull internal error (qh_checkfacet): for facet f%d, #ridges %d < #neighbors %d or(3-d) > #vertices %d or(2-d) not all 2\n",
+            facet->id, numridges, numneighbors, numvertices);
+        waserror= True;
+      }
+    }
+  }
+  FOREACHneighbor_(facet) {
+    if (neighbor == qh_MERGEridge || neighbor == qh_DUPLICATEridge) {
+      qh_fprintf(qh, qh->ferr, 6126, "qhull internal error (qh_checkfacet): facet f%d still has a MERGEridge or DUPLICATEridge neighbor\n", facet->id);
+      qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+    if (neighbor->visible) {
+      qh_fprintf(qh, qh->ferr, 6401, "qhull internal error (qh_checkfacet): facet f%d has deleted neighbor f%d (qh.visible_list)\n",
+        facet->id, neighbor->id);
+      errother= neighbor;
+      waserror= True;
+    }
+    neighbor->seen= True;
+  }
+  FOREACHneighbor_(facet) {
+    if (!qh_setin(neighbor->neighbors, facet)) {
+      qh_fprintf(qh, qh->ferr, 6127, "qhull internal error (qh_checkfacet): facet f%d has neighbor f%d, but f%d does not have neighbor f%d\n",
+              facet->id, neighbor->id, neighbor->id, facet->id);
+      errother= neighbor;
+      waserror= True;
+    }
+    if (!neighbor->seen) {
+      qh_fprintf(qh, qh->ferr, 6128, "qhull internal error (qh_checkfacet): facet f%d has a duplicate neighbor f%d\n",
+              facet->id, neighbor->id);
+      errother= neighbor;
+      waserror= True;
+    }
+    neighbor->seen= False;
+  }
+  FOREACHridge_(facet->ridges) {
+    qh_setcheck(qh, ridge->vertices, "vertices for r", ridge->id);
+    ridge->seen= False;
+  }
+  FOREACHridge_(facet->ridges) {
+    if (ridge->seen) {
+      qh_fprintf(qh, qh->ferr, 6129, "qhull internal error (qh_checkfacet): facet f%d has a duplicate ridge r%d\n",
+              facet->id, ridge->id);
+      errridge= ridge;
+      waserror= True;
+    }
+    ridge->seen= True;
+    numRvertices= qh_setsize(qh, ridge->vertices);
+    if (numRvertices != qh->hull_dim - 1) {
+      qh_fprintf(qh, qh->ferr, 6130, "qhull internal error (qh_checkfacet): ridge between f%d and f%d has %d vertices\n",
+                ridge->top->id, ridge->bottom->id, numRvertices);
+      errridge= ridge;
+      waserror= True;
+    }
+    neighbor= otherfacet_(ridge, facet);
+    neighbor->seen= True;
+    if (!qh_setin(facet->neighbors, neighbor)) {
+      qh_fprintf(qh, qh->ferr, 6131, "qhull internal error (qh_checkfacet): for facet f%d, neighbor f%d of ridge r%d not in facet\n",
+           facet->id, neighbor->id, ridge->id);
+      errridge= ridge;
+      waserror= True;
+    }
+    if (!facet->newfacet && !neighbor->newfacet) {
+      if ((!ridge->tested) | ridge->nonconvex | ridge->mergevertex) {
+        qh_fprintf(qh, qh->ferr, 6384, "qhull internal error (qh_checkfacet): ridge r%d is nonconvex (%d), mergevertex (%d) or not tested (%d) for facet f%d, neighbor f%d\n",
+          ridge->id, ridge->nonconvex, ridge->mergevertex, ridge->tested, facet->id, neighbor->id);
+        errridge= ridge;
+        waserror= True;
+      }
+    }
+  }
+  if (!facet->simplicial) {
+    FOREACHneighbor_(facet) {
+      if (!neighbor->seen) {
+        qh_fprintf(qh, qh->ferr, 6132, "qhull internal error (qh_checkfacet): facet f%d does not have a ridge for neighbor f%d\n",
+              facet->id, neighbor->id);
+        errother= neighbor;
+        waserror= True;
+      }
+      intersection= qh_vertexintersect_new(qh, facet->vertices, neighbor->vertices);
+      qh_settemppush(qh, intersection);
+      FOREACHvertex_(facet->vertices) {
+        vertex->seen= False;
+        vertex->seen2= False;
+      }
+      FOREACHvertex_(intersection)
+        vertex->seen= True;
+      FOREACHridge_(facet->ridges) {
+        if (neighbor != otherfacet_(ridge, facet))
+            continue;
+        FOREACHvertex_(ridge->vertices) {
+          if (!vertex->seen) {
+            qh_fprintf(qh, qh->ferr, 6133, "qhull internal error (qh_checkfacet): vertex v%d in r%d not in f%d intersect f%d\n",
+                  vertex->id, ridge->id, facet->id, neighbor->id);
+            qh_errexit(qh, qh_ERRqhull, facet, ridge);
+          }
+          vertex->seen2= True;
+        }
+      }
+      if (!newmerge) {
+        FOREACHvertex_(intersection) {
+          if (!vertex->seen2) {
+            if (!qh->MERGING) {
+              qh_fprintf(qh, qh->ferr, 6420, "qhull topology error (qh_checkfacet): vertex v%d in f%d intersect f%d but not in a ridge.  Last point was p%d\n",
+                     vertex->id, facet->id, neighbor->id, qh->furthest_id);
+              if (!qh->FORCEoutput) {
+                qh_errprint(qh, "ERRONEOUS", facet, neighbor, NULL, vertex);
+                qh_errexit(qh, qh_ERRtopology, NULL, NULL);
+              }
+            }else {
+              trace4((qh, qh->ferr, 4025, "qh_checkfacet: vertex v%d in f%d intersect f%d but not in a ridge.  Repaired by qh_remove_extravertices in qh_reducevertices\n",
+                vertex->id, facet->id, neighbor->id));
+            }
+          }
+        }
+      }
+      qh_settempfree(qh, &intersection);
+    }
+  }else { /* simplicial */
+    FOREACHneighbor_(facet) {
+      if (neighbor->simplicial && !facet->degenerate && !neighbor->degenerate) {
+        skipA= SETindex_(facet->neighbors, neighbor);
+        skipB= qh_setindex(neighbor->neighbors, facet);
+        if (skipA<0 || skipB<0 || !qh_setequal_skip(facet->vertices, skipA, neighbor->vertices, skipB)) {
+          qh_fprintf(qh, qh->ferr, 6135, "qhull internal error (qh_checkfacet): facet f%d skip %d and neighbor f%d skip %d do not match \n",
+                   facet->id, skipA, neighbor->id, skipB);
+          errother= neighbor;
+          waserror= True;
+        }
+      }
+    }
+  }
+  if (!newmerge && qh->CHECKduplicates && qh->hull_dim < 5 && (qh->IStracing > 2 || qh->CHECKfrequently)) {
+    FOREACHridge_i_(qh, facet->ridges) {           /* expensive, if was merge and qh_maybe_duplicateridges hasn't been called yet */
+      if (!ridge->mergevertex) {
+        for (i=ridge_i+1; i < ridge_n; i++) {
+          ridge2= SETelemt_(facet->ridges, i, ridgeT);
+          if (SETelem_(ridge->vertices, last_v) == SETelem_(ridge2->vertices, last_v)) { /* SETfirst is likely to be the same */
+            if (SETfirst_(ridge->vertices) == SETfirst_(ridge2->vertices)) {
+              if (qh_setequal(ridge->vertices, ridge2->vertices)) {
+                qh_fprintf(qh, qh->ferr, 6294, "qhull internal error (qh_checkfacet): ridges r%d and r%d (f%d) have the same vertices\n", /* same as duplicate ridge */
+                    ridge->id, ridge2->id, facet->id);
+                errridge= ridge;
+                waserror= True;
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+  if (waserror) {
+    qh_errprint(qh, "ERRONEOUS", facet, errother, errridge, NULL);
+    *waserrorp= True;
+  }
+} /* checkfacet */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="checkflipped_all">-</a>
+
+  qh_checkflipped_all(qh, facetlist )
+    checks orientation of facets in list against interior point
+
+  notes:
+    called by qh_checkoutput
+*/
+void qh_checkflipped_all(qhT *qh, facetT *facetlist) {
+  facetT *facet;
+  boolT waserror= False;
+  realT dist;
+
+  if (facetlist == qh->facet_list)
+    zzval_(Zflippedfacets)= 0;
+  FORALLfacet_(facetlist) {
+    if (facet->normal && !qh_checkflipped(qh, facet, &dist, !qh_ALL)) {
+      qh_fprintf(qh, qh->ferr, 6136, "qhull precision error: facet f%d is flipped, distance= %6.12g\n",
+              facet->id, dist);
+      if (!qh->FORCEoutput) {
+        qh_errprint(qh, "ERRONEOUS", facet, NULL, NULL, NULL);
+        waserror= True;
+      }
+    }
+  }
+  if (waserror) {
+    qh_fprintf(qh, qh->ferr, 8101, "\n\
+A flipped facet occurs when its distance to the interior point is\n\
+greater than or equal to %2.2g, the maximum roundoff error.\n", -qh->DISTround);
+    qh_errexit(qh, qh_ERRprec, NULL, NULL);
+  }
+} /* checkflipped_all */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="checklists">-</a>
+
+  qh_checklists(qh, facetlist )
+    Check and repair facetlist and qh.vertex_list for infinite loops or overwritten facets
+    Checks that qh.newvertex_list is on qh.vertex_list
+    if facetlist is qh.facet_list
+      Checks that qh.visible_list and qh.newfacet_list are on qh.facet_list
+    Updates qh.facetvisit and qh.vertexvisit
+
+  returns:
+    True if no errors found
+    If false, repairs erroneous lists to prevent infinite loops by FORALL macros
+
+  notes:
+    called by qh_buildtracing, qh_checkpolygon, qh_collectstatistics, qh_printfacetlist, qh_printsummary
+    not called by qh_printlists
+
+  design:
+    if facetlist
+      check qh.facet_tail
+      for each facet
+        check for infinite loop or overwritten facet
+        check previous facet
+      if facetlist is qh.facet_list
+        check qh.next_facet, qh.visible_list and qh.newfacet_list
+    if vertexlist
+      check qh.vertex_tail
+      for each vertex
+        check for infinite loop or overwritten vertex
+        check previous vertex
+      check qh.newvertex_list
+*/
+boolT qh_checklists(qhT *qh, facetT *facetlist) {
+  facetT *facet, *errorfacet= NULL, *errorfacet2= NULL, *previousfacet;
+  vertexT *vertex, *vertexlist, *previousvertex, *errorvertex= NULL;
+  boolT waserror= False, newseen= False, nextseen= False, newvertexseen= False, visibleseen= False;
+
+  if (facetlist == qh->newfacet_list || facetlist == qh->visible_list) {
+    vertexlist= qh->vertex_list;
+    previousvertex= NULL;
+    trace2((qh, qh->ferr, 2110, "qh_checklists: check qh.%s_list f%d and qh.vertex_list v%d\n", 
+        (facetlist == qh->newfacet_list ? "newfacet" : "visible"), facetlist->id, getid_(vertexlist)));
+  }else {
+    vertexlist= qh->vertex_list;
+    previousvertex= NULL;
+    trace2((qh, qh->ferr, 2111, "qh_checklists: check %slist f%d and qh.vertex_list v%d\n", 
+        (facetlist == qh->facet_list ? "qh.facet_" : "facet"), getid_(facetlist), getid_(vertexlist)));
+  }
+  if (facetlist) {
+    if (qh->facet_tail == NULL || qh->facet_tail->id != 0 || qh->facet_tail->next != NULL) {
+      qh_fprintf(qh, qh->ferr, 6397, "qhull internal error (qh_checklists): either qh.facet_tail f%d is NULL, or its id is not 0, or its next is not NULL\n", 
+          getid_(qh->facet_tail));
+      qh_errexit(qh, qh_ERRqhull, qh->facet_tail, NULL);
+    }
+    previousfacet= (facetlist == qh->facet_list ? NULL : facetlist->previous);
+    qh->visit_id++;
+    FORALLfacet_(facetlist) {
+      if (facet->visitid >= qh->visit_id || facet->id >= qh->facet_id) {
+        waserror= True;
+        errorfacet= facet;
+        errorfacet2= previousfacet;
+        if (facet->visitid == qh->visit_id)
+          qh_fprintf(qh, qh->ferr, 6039, "qhull internal error (qh_checklists): f%d already in facetlist causing an infinite loop ... f%d > f%d ... > f%d > f%d.  Truncate facetlist at f%d\n", 
+            facet->id, facet->id, facet->next->id, getid_(previousfacet), facet->id, getid_(previousfacet));
+        else
+          qh_fprintf(qh, qh->ferr, 6350, "qhull internal error (qh_checklists): unknown or overwritten facet f%d, either id >= qh.facet_id (%d) or f.visitid %u > qh.visit_id %u.  Facetlist terminated at previous facet f%d\n", 
+              facet->id, qh->facet_id, facet->visitid, qh->visit_id, getid_(previousfacet));
+        if (previousfacet)
+          previousfacet->next= qh->facet_tail;
+        else
+          facetlist= qh->facet_tail;
+        break;
+      }
+      facet->visitid= qh->visit_id;
+      if (facet->previous != previousfacet) {
+        qh_fprintf(qh, qh->ferr, 6416, "qhull internal error (qh_checklists): expecting f%d.previous == f%d.  Got f%d\n",
+          facet->id, getid_(previousfacet), getid_(facet->previous));
+        waserror= True;
+        errorfacet= facet;
+        errorfacet2= facet->previous;
+      }
+      previousfacet= facet;
+      if (facetlist == qh->facet_list) {
+        if (facet == qh->visible_list) {
+          if(newseen){
+            qh_fprintf(qh, qh->ferr, 6285, "qhull internal error (qh_checklists): qh.visible_list f%d is after qh.newfacet_list f%d.  It should be at, before, or NULL\n",
+              facet->id, getid_(qh->newfacet_list));
+            waserror= True;
+            errorfacet= facet;
+            errorfacet2= qh->newfacet_list;
+          }
+          visibleseen= True;
+        }
+        if (facet == qh->newfacet_list)
+          newseen= True;
+        if (facet == qh->facet_next)
+          nextseen= True;
+      }
+    }
+    if (facetlist == qh->facet_list) {
+      if (!nextseen && qh->facet_next && qh->facet_next->next) {
+        qh_fprintf(qh, qh->ferr, 6369, "qhull internal error (qh_checklists): qh.facet_next f%d for qh_addpoint is not on qh.facet_list f%d\n", 
+          qh->facet_next->id, facetlist->id);
+        waserror= True;
+        errorfacet= qh->facet_next;
+        errorfacet2= facetlist;
+      }
+      if (!newseen && qh->newfacet_list && qh->newfacet_list->next) {
+        qh_fprintf(qh, qh->ferr, 6286, "qhull internal error (qh_checklists): qh.newfacet_list f%d is not on qh.facet_list f%d\n", 
+          qh->newfacet_list->id, facetlist->id);
+        waserror= True;
+        errorfacet= qh->newfacet_list;
+        errorfacet2= facetlist;
+      }
+      if (!visibleseen && qh->visible_list && qh->visible_list->next) {
+        qh_fprintf(qh, qh->ferr, 6138, "qhull internal error (qh_checklists): qh.visible_list f%d is not on qh.facet_list f%d\n", 
+          qh->visible_list->id, facetlist->id);
+        waserror= True;
+        errorfacet= qh->visible_list;
+        errorfacet2= facetlist;
+      }
+    }
+  }
+  if (vertexlist) {
+    if (qh->vertex_tail == NULL || qh->vertex_tail->id != 0 || qh->vertex_tail->next != NULL) {
+      qh_fprintf(qh, qh->ferr, 6366, "qhull internal error (qh_checklists): either qh.vertex_tail v%d is NULL, or its id is not 0, or its next is not NULL\n", 
+           getid_(qh->vertex_tail));
+      qh_errprint(qh, "ERRONEOUS", errorfacet, errorfacet2, NULL, qh->vertex_tail);
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+    }
+    qh->vertex_visit++;
+    FORALLvertex_(vertexlist) {
+      if (vertex->visitid >= qh->vertex_visit || vertex->id >= qh->vertex_id) {
+        waserror= True;
+        errorvertex= vertex;
+        if (vertex->visitid == qh->visit_id)
+          qh_fprintf(qh, qh->ferr, 6367, "qhull internal error (qh_checklists): v%d already in vertexlist causing an infinite loop ... v%d > v%d ... > v%d > v%d.  Truncate vertexlist at v%d\n", 
+            vertex->id, vertex->id, vertex->next->id, getid_(previousvertex), vertex->id, getid_(previousvertex));
+        else
+          qh_fprintf(qh, qh->ferr, 6368, "qhull internal error (qh_checklists): unknown or overwritten vertex v%d, either id >= qh.vertex_id (%d) or v.visitid %u > qh.visit_id %u.  vertexlist terminated at previous vertex v%d\n", 
+            vertex->id, qh->vertex_id, vertex->visitid, qh->visit_id, getid_(previousvertex));
+        if (previousvertex)
+          previousvertex->next= qh->vertex_tail;
+        else
+          vertexlist= qh->vertex_tail;
+        break;
+      }
+      vertex->visitid= qh->vertex_visit;
+      if (vertex->previous != previousvertex) {
+        qh_fprintf(qh, qh->ferr, 6427, "qhull internal error (qh_checklists): expecting v%d.previous == v%d.  Got v%d\n",
+              vertex->id, previousvertex, getid_(vertex->previous));
+        waserror= True;
+        errorvertex= vertex;
+      }
+      previousvertex= vertex;
+      if(vertex == qh->newvertex_list)
+        newvertexseen= True;
+    }
+    if(!newvertexseen && qh->newvertex_list && qh->newvertex_list->next) {
+      qh_fprintf(qh, qh->ferr, 6287, "qhull internal error (qh_checklists): new vertex list v%d is not on vertex list\n", qh->newvertex_list->id);
+      waserror= True;
+      errorvertex= qh->newvertex_list;
+    }
+  }
+  if (waserror) {
+    qh_errprint(qh, "ERRONEOUS", errorfacet, errorfacet2, NULL, errorvertex);
+    return False;
+  }
+  return True;
+} /* checklists */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="checkpolygon">-</a>
+
+  qh_checkpolygon(qh, facetlist )
+    checks the correctness of the structure
+
+  notes:
+    called by qh_addpoint, qh_all_vertexmerge, qh_check_output, qh_initialhull, qh_prepare_output, qh_triangulate
+    call with qh.facet_list or qh.newfacet_list or another list
+    checks num_facets and num_vertices if qh.facet_list
+
+  design:
+    check and repair lists for infinite loop
+    for each facet
+      check f.newfacet and f.visible
+      check facet and outside set if qh.NEWtentative and not f.newfacet, or not f.visible
+    initializes vertexlist for qh.facet_list or qh.newfacet_list
+    for each vertex
+      check vertex
+      check v.newfacet
+    for each facet
+      count f.ridges
+      check and count f.vertices
+    if checking qh.facet_list
+      check facet count
+      if qh.VERTEXneighbors
+        check and count v.neighbors for all vertices
+        check v.neighbors count and report possible causes of mismatch
+        check that facets are in their v.neighbors
+      check vertex count
+*/
+void qh_checkpolygon(qhT *qh, facetT *facetlist) {
+  facetT *facet, *neighbor, **neighborp;
+  facetT *errorfacet= NULL, *errorfacet2= NULL;
+  vertexT *vertex, **vertexp, *vertexlist;
+  int numfacets= 0, numvertices= 0, numridges= 0;
+  int totvneighbors= 0, totfacetvertices= 0;
+  boolT waserror= False, newseen= False, newvertexseen= False, nextseen= False, visibleseen= False;
+  boolT checkfacet;
+
+  trace1((qh, qh->ferr, 1027, "qh_checkpolygon: check all facets from f%d, qh.NEWtentative? %d\n", facetlist->id, qh->NEWtentative));
+  if (!qh_checklists(qh, facetlist)) {
+    waserror= True;
+    qh_fprintf(qh, qh->ferr, 6374, "qhull internal error: qh_checklists failed in qh_checkpolygon\n");
+    if (qh->num_facets < 4000)
+      qh_printlists(qh);
+  }
+  if (facetlist != qh->facet_list || qh->ONLYgood)
+    nextseen= True; /* allow f.outsideset */
+  FORALLfacet_(facetlist) {
+    if (facet == qh->visible_list)
+      visibleseen= True;
+    if (facet == qh->newfacet_list)
+      newseen= True;
+    if (facet->newfacet && !newseen && !visibleseen) {
+        qh_fprintf(qh, qh->ferr, 6289, "qhull internal error (qh_checkpolygon): f%d is 'newfacet' but it is not on qh.newfacet_list f%d or visible_list f%d\n",  facet->id, getid_(qh->newfacet_list), getid_(qh->visible_list));
+        qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+    if (!facet->newfacet && newseen) {
+        qh_fprintf(qh, qh->ferr, 6292, "qhull internal error (qh_checkpolygon): f%d is on qh.newfacet_list f%d but it is not 'newfacet'\n",  facet->id, getid_(qh->newfacet_list));
+        qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+    if (facet->visible != (visibleseen & !newseen)) {
+      if(facet->visible)
+        qh_fprintf(qh, qh->ferr, 6290, "qhull internal error (qh_checkpolygon): f%d is 'visible' but it is not on qh.visible_list f%d\n", facet->id, getid_(qh->visible_list));
+      else
+        qh_fprintf(qh, qh->ferr, 6291, "qhull internal error (qh_checkpolygon): f%d is on qh.visible_list f%d but it is not 'visible'\n", facet->id, qh->newfacet_list->id);
+      qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+    if (qh->NEWtentative) {
+      checkfacet= !facet->newfacet;
+    }else {
+      checkfacet= !facet->visible;
+    }
+    if(checkfacet) {
+      if (!nextseen) {
+        if (facet == qh->facet_next)  /* previous facets do not have outsideset */
+          nextseen= True;
+        else if (qh_setsize(qh, facet->outsideset)) {
+          if (!qh->NARROWhull
+#if !qh_COMPUTEfurthest
+          || facet->furthestdist >= qh->MINoutside
+#endif
+          ) {
+            qh_fprintf(qh, qh->ferr, 6137, "qhull internal error (qh_checkpolygon): f%d has outside points before qh.facet_next f%d\n",
+                     facet->id, getid_(qh->facet_next));
+            qh_errexit2(qh, qh_ERRqhull, facet, qh->facet_next);
+          }
+        }
+      }
+      numfacets++;
+      qh_checkfacet(qh, facet, False, &waserror);
+    }else if (facet->visible && qh->NEWfacets) {
+      if (!SETempty_(facet->neighbors) || !SETempty_(facet->ridges)) {
+        qh_fprintf(qh, qh->ferr, 6376, "qhull internal error (qh_checkpolygon): expecting empty f.neighbors and f.ridges for visible facet f%d.  Got %d neighbors and %d ridges\n", 
+          facet->id, qh_setsize(qh, facet->neighbors), qh_setsize(qh, facet->ridges));
+        qh_errexit(qh, qh_ERRqhull, facet, NULL);
+      }
+    }
+  }
+  if (facetlist == qh->facet_list) {
+    vertexlist= qh->vertex_list;
+  }else if (facetlist == qh->newfacet_list) {
+    vertexlist= qh->newvertex_list;
+  }else {
+    vertexlist= NULL;
+  }
+  FORALLvertex_(vertexlist) {
+    qh_checkvertex(qh, vertex, !qh_ALL, &waserror);
+    if(vertex == qh->newvertex_list)
+      newvertexseen= True;
+    vertex->seen= False;
+    vertex->visitid= 0;
+    if(vertex->newfacet && !newvertexseen && !vertex->deleted) {
+      qh_fprintf(qh, qh->ferr, 6288, "qhull internal error (qh_checkpolygon): v%d is 'newfacet' but it is not on new vertex list v%d\n", vertex->id, getid_(qh->newvertex_list));
+      qh_errexit(qh, qh_ERRqhull, qh->visible_list, NULL);
+    }
+  }
+  FORALLfacet_(facetlist) {
+    if (facet->visible)
+      continue;
+    if (facet->simplicial)
+      numridges += qh->hull_dim;
+    else
+      numridges += qh_setsize(qh, facet->ridges);
+    FOREACHvertex_(facet->vertices) {
+      vertex->visitid++;
+      if (!vertex->seen) {
+        vertex->seen= True;
+        numvertices++;
+        if (qh_pointid(qh, vertex->point) == qh_IDunknown) {
+          qh_fprintf(qh, qh->ferr, 6139, "qhull internal error (qh_checkpolygon): unknown point %p for vertex v%d first_point %p\n",
+                   vertex->point, vertex->id, qh->first_point);
+          waserror= True;
+        }
+      }
+    }
+  }
+  qh->vertex_visit += (unsigned int)numfacets;
+  if (facetlist == qh->facet_list) {
+    if (numfacets != qh->num_facets - qh->num_visible) {
+      qh_fprintf(qh, qh->ferr, 6140, "qhull internal error (qh_checkpolygon): actual number of facets is %d, cumulative facet count is %d - %d visible facets\n",
+              numfacets, qh->num_facets, qh->num_visible);
+      waserror= True;
+    }
+    qh->vertex_visit++;
+    if (qh->VERTEXneighbors) {
+      FORALLvertices {
+        if (!vertex->neighbors) {
+          qh_fprintf(qh, qh->ferr, 6407, "qhull internal error (qh_checkpolygon): missing vertex neighbors for v%d\n", vertex->id);
+          waserror= True;
+        }
+        qh_setcheck(qh, vertex->neighbors, "neighbors for v", vertex->id);
+        if (vertex->deleted)
+          continue;
+        totvneighbors += qh_setsize(qh, vertex->neighbors);
+      }
+      FORALLfacet_(facetlist) {
+        if (!facet->visible)
+          totfacetvertices += qh_setsize(qh, facet->vertices);
+      }
+      if (totvneighbors != totfacetvertices) {
+        qh_fprintf(qh, qh->ferr, 6141, "qhull internal error (qh_checkpolygon): vertex neighbors inconsistent (tot_vneighbors %d != tot_facetvertices %d).  Maybe duplicate or missing vertex\n",
+                totvneighbors, totfacetvertices);
+        waserror= True;
+        FORALLvertices {
+          if (vertex->deleted)
+            continue;
+          qh->visit_id++;
+          FOREACHneighbor_(vertex) {
+            if (neighbor->visitid==qh->visit_id) {
+              qh_fprintf(qh, qh->ferr, 6275, "qhull internal error (qh_checkpolygon): facet f%d occurs twice in neighbors of vertex v%d\n",
+                  neighbor->id, vertex->id);
+              errorfacet2= errorfacet;
+              errorfacet= neighbor;
+            }
+            neighbor->visitid= qh->visit_id;
+            if (!qh_setin(neighbor->vertices, vertex)) {
+              qh_fprintf(qh, qh->ferr, 6276, "qhull internal error (qh_checkpolygon): facet f%d is a neighbor of vertex v%d but v%d is not a vertex of f%d\n",
+                  neighbor->id, vertex->id, vertex->id, neighbor->id);
+              errorfacet2= errorfacet;
+              errorfacet= neighbor;
+            }
+          }
+        }
+        FORALLfacet_(facetlist){
+          if (!facet->visible) {
+            /* vertices are inverse sorted and are unlikely to be duplicated */
+            FOREACHvertex_(facet->vertices){
+              if (!qh_setin(vertex->neighbors, facet)) {
+                qh_fprintf(qh, qh->ferr, 6277, "qhull internal error (qh_checkpolygon): v%d is a vertex of facet f%d but f%d is not a neighbor of v%d\n",
+                  vertex->id, facet->id, facet->id, vertex->id);
+                errorfacet2= errorfacet;
+                errorfacet= facet;
+              }
+            }
+          }
+        }
+      }
+    }
+    if (numvertices != qh->num_vertices - qh_setsize(qh, qh->del_vertices)) {
+      qh_fprintf(qh, qh->ferr, 6142, "qhull internal error (qh_checkpolygon): actual number of vertices is %d, cumulative vertex count is %d\n",
+              numvertices, qh->num_vertices - qh_setsize(qh, qh->del_vertices));
+      waserror= True;
+    }
+    if (qh->hull_dim == 2 && numvertices != numfacets) {
+      qh_fprintf(qh, qh->ferr, 6143, "qhull internal error (qh_checkpolygon): #vertices %d != #facets %d\n",
+        numvertices, numfacets);
+      waserror= True;
+    }
+    if (qh->hull_dim == 3 && numvertices + numfacets - numridges/2 != 2) {
+      qh_fprintf(qh, qh->ferr, 7063, "qhull warning: #vertices %d + #facets %d - #edges %d != 2.  A vertex appears twice in a edge list.  May occur during merging.\n",
+          numvertices, numfacets, numridges/2);
+      /* occurs if lots of merging and a vertex ends up twice in an edge list.  e.g., RBOX 1000 s W1e-13 t995849315 D2 | QHULL d Tc Tv */
+    }
+  }
+  if (waserror)
+    qh_errexit2(qh, qh_ERRqhull, errorfacet, errorfacet2);
+} /* checkpolygon */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="checkvertex">-</a>
+
+  qh_checkvertex(qh, vertex, allchecks, &waserror )
+    check vertex for consistency
+    if allchecks, checks vertex->neighbors
+
+  returns:
+    sets waserror if any error occurs
+
+  notes:
+    called by qh_tracemerge and qh_checkpolygon
+    neighbors checked efficiently in qh_checkpolygon
+*/
+void qh_checkvertex(qhT *qh, vertexT *vertex, boolT allchecks, boolT *waserrorp) {
+  boolT waserror= False;
+  facetT *neighbor, **neighborp, *errfacet=NULL;
+
+  if (qh_pointid(qh, vertex->point) == qh_IDunknown) {
+    qh_fprintf(qh, qh->ferr, 6144, "qhull internal error (qh_checkvertex): unknown point id %p\n", vertex->point);
+    waserror= True;
+  }
+  if (vertex->id >= qh->vertex_id) {
+    qh_fprintf(qh, qh->ferr, 6145, "qhull internal error (qh_checkvertex): unknown vertex id v%d >= qh.vertex_id (%d)\n", vertex->id, qh->vertex_id);
+    waserror= True;
+  }
+  if (vertex->visitid > qh->vertex_visit) {
+    qh_fprintf(qh, qh->ferr, 6413, "qhull internal error (qh_checkvertex): expecting v%d.visitid <= qh.vertex_visit (%d).  Got visitid %d\n", vertex->id, qh->vertex_visit, vertex->visitid);
+    waserror= True;
+  }
+  if (allchecks && !waserror && !vertex->deleted) {
+    if (qh_setsize(qh, vertex->neighbors)) {
+      FOREACHneighbor_(vertex) {
+        if (!qh_setin(neighbor->vertices, vertex)) {
+          qh_fprintf(qh, qh->ferr, 6146, "qhull internal error (qh_checkvertex): neighbor f%d does not contain v%d\n", neighbor->id, vertex->id);
+          errfacet= neighbor;
+          waserror= True;
+        }
+      }
+    }
+  }
+  if (waserror) {
+    qh_errprint(qh, "ERRONEOUS", NULL, NULL, NULL, vertex);
+    if (errfacet)
+      qh_errexit(qh, qh_ERRqhull, errfacet, NULL);
+    *waserrorp= True;
+  }
+} /* checkvertex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="clearcenters">-</a>
+
+  qh_clearcenters(qh, type )
+    clear old data from facet->center
+
+  notes:
+    sets new centertype
+    nop if CENTERtype is the same
+*/
+void qh_clearcenters(qhT *qh, qh_CENTER type) {
+  facetT *facet;
+
+  if (qh->CENTERtype != type) {
+    FORALLfacets {
+      if (facet->tricoplanar && !facet->keepcentrum)
+          facet->center= NULL;  /* center is owned by the ->keepcentrum facet */
+      else if (qh->CENTERtype == qh_ASvoronoi){
+        if (facet->center) {
+          qh_memfree(qh, facet->center, qh->center_size);
+          facet->center= NULL;
+        }
+      }else /* qh.CENTERtype == qh_AScentrum */ {
+        if (facet->center) {
+          qh_memfree(qh, facet->center, qh->normal_size);
+          facet->center= NULL;
+        }
+      }
+    }
+    qh->CENTERtype= type;
+  }
+  trace2((qh, qh->ferr, 2043, "qh_clearcenters: switched to center type %d\n", type));
+} /* clearcenters */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="createsimplex">-</a>
+
+  qh_createsimplex(qh, vertices )
+    creates a simplex from a set of vertices
+
+  returns:
+    initializes qh.facet_list to the simplex
+
+  notes: 
+    only called by qh_initialhull
+
+  design:
+    for each vertex
+      create a new facet
+    for each new facet
+      create its neighbor set
+*/
+void qh_createsimplex(qhT *qh, setT *vertices /* qh.facet_list */) {
+  facetT *facet= NULL, *newfacet;
+  boolT toporient= True;
+  int vertex_i, vertex_n, nth;
+  setT *newfacets= qh_settemp(qh, qh->hull_dim+1);
+  vertexT *vertex;
+
+  FOREACHvertex_i_(qh, vertices) {
+    newfacet= qh_newfacet(qh);
+    newfacet->vertices= qh_setnew_delnthsorted(qh, vertices, vertex_n, vertex_i, 0);
+    if (toporient)
+      newfacet->toporient= True;
+    qh_appendfacet(qh, newfacet);
+    newfacet->newfacet= True;
+    qh_appendvertex(qh, vertex);
+    qh_setappend(qh, &newfacets, newfacet);
+    toporient ^= True;
+  }
+  FORALLnew_facets {
+    nth= 0;
+    FORALLfacet_(qh->newfacet_list) {
+      if (facet != newfacet)
+        SETelem_(newfacet->neighbors, nth++)= facet;
+    }
+    qh_settruncate(qh, newfacet->neighbors, qh->hull_dim);
+  }
+  qh_settempfree(qh, &newfacets);
+  trace1((qh, qh->ferr, 1028, "qh_createsimplex: created simplex\n"));
+} /* createsimplex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="delridge">-</a>
+
+  qh_delridge(qh, ridge )
+    delete a ridge's vertices and frees its memory
+
+  notes:
+    assumes r.top->ridges and r.bottom->ridges have been updated
+*/
+void qh_delridge(qhT *qh, ridgeT *ridge) {
+
+  if (ridge == qh->traceridge)
+    qh->traceridge= NULL;
+  qh_setfree(qh, &(ridge->vertices));
+  qh_memfree(qh, ridge, (int)sizeof(ridgeT));
+} /* delridge */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="delvertex">-</a>
+
+  qh_delvertex(qh, vertex )
+    deletes a vertex and frees its memory
+
+  notes:
+    assumes vertex->adjacencies have been updated if needed
+    unlinks from vertex_list
+*/
+void qh_delvertex(qhT *qh, vertexT *vertex) {
+
+  if (vertex->deleted && !vertex->partitioned && !qh->NOerrexit) {
+    qh_fprintf(qh, qh->ferr, 6395, "qhull internal error (qh_delvertex): vertex v%d was deleted but it was not partitioned as a coplanar point\n",
+      vertex->id);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if (vertex == qh->tracevertex)
+    qh->tracevertex= NULL;
+  qh_removevertex(qh, vertex);
+  qh_setfree(qh, &vertex->neighbors);
+  qh_memfree(qh, vertex, (int)sizeof(vertexT));
+} /* delvertex */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="facet3vertex">-</a>
+
+  qh_facet3vertex(qh )
+    return temporary set of 3-d vertices in qh_ORIENTclock order
+
+  design:
+    if simplicial facet
+      build set from facet->vertices with facet->toporient
+    else
+      for each ridge in order
+        build set from ridge's vertices
+*/
+setT *qh_facet3vertex(qhT *qh, facetT *facet) {
+  ridgeT *ridge, *firstridge;
+  vertexT *vertex;
+  int cntvertices, cntprojected=0;
+  setT *vertices;
+
+  cntvertices= qh_setsize(qh, facet->vertices);
+  vertices= qh_settemp(qh, cntvertices);
+  if (facet->simplicial) {
+    if (cntvertices != 3) {
+      qh_fprintf(qh, qh->ferr, 6147, "qhull internal error (qh_facet3vertex): only %d vertices for simplicial facet f%d\n",
+                  cntvertices, facet->id);
+      qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+    qh_setappend(qh, &vertices, SETfirst_(facet->vertices));
+    if (facet->toporient ^ qh_ORIENTclock)
+      qh_setappend(qh, &vertices, SETsecond_(facet->vertices));
+    else
+      qh_setaddnth(qh, &vertices, 0, SETsecond_(facet->vertices));
+    qh_setappend(qh, &vertices, SETelem_(facet->vertices, 2));
+  }else {
+    ridge= firstridge= SETfirstt_(facet->ridges, ridgeT);   /* no infinite */
+    while ((ridge= qh_nextridge3d(ridge, facet, &vertex))) {
+      qh_setappend(qh, &vertices, vertex);
+      if (++cntprojected > cntvertices || ridge == firstridge)
+        break;
+    }
+    if (!ridge || cntprojected != cntvertices) {
+      qh_fprintf(qh, qh->ferr, 6148, "qhull internal error (qh_facet3vertex): ridges for facet %d don't match up.  got at least %d\n",
+                  facet->id, cntprojected);
+      qh_errexit(qh, qh_ERRqhull, facet, ridge);
+    }
+  }
+  return vertices;
+} /* facet3vertex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="findbestfacet">-</a>
+
+  qh_findbestfacet(qh, point, bestoutside, bestdist, isoutside )
+    find facet that is furthest below a point
+
+    for Delaunay triangulations,
+      Use qh_setdelaunay() to lift point to paraboloid and scale by 'Qbb' if needed
+      Do not use options 'Qbk', 'QBk', or 'QbB' since they scale the coordinates.
+
+  returns:
+    if bestoutside is set (e.g., qh_ALL)
+      returns best facet that is not upperdelaunay
+      if Delaunay and inside, point is outside circumsphere of bestfacet
+    else
+      returns first facet below point
+      if point is inside, returns nearest, !upperdelaunay facet
+    distance to facet
+    isoutside set if outside of facet
+
+  notes:
+    Distance is measured by distance to the facet's hyperplane.  For
+    Delaunay facets, this is not the same as the containing facet.  It may
+    be an adjacent facet or a different tricoplanar facet.  See 
+    <a href="../html/qh-code.htm#findfacet">locate a facet with qh_findbestfacet()</a>
+
+    For tricoplanar facets, this finds one of the tricoplanar facets closest
+    to the point.  
+
+    If inside, qh_findbestfacet performs an exhaustive search
+       this may be too conservative.  Sometimes it is clearly required.
+
+    qh_findbestfacet is not used by qhull.
+    uses qh.visit_id and qh.coplanarset
+
+  see:
+    <a href="geom_r.c#findbest">qh_findbest</a>
+*/
+facetT *qh_findbestfacet(qhT *qh, pointT *point, boolT bestoutside,
+           realT *bestdist, boolT *isoutside) {
+  facetT *bestfacet= NULL;
+  int numpart, totpart= 0;
+
+  bestfacet= qh_findbest(qh, point, qh->facet_list,
+                            bestoutside, !qh_ISnewfacets, bestoutside /* qh_NOupper */,
+                            bestdist, isoutside, &totpart);
+  if (*bestdist < -qh->DISTround) {
+    bestfacet= qh_findfacet_all(qh, point, !qh_NOupper, bestdist, isoutside, &numpart);
+    totpart += numpart;
+    if ((isoutside && *isoutside && bestoutside)
+    || (isoutside && !*isoutside && bestfacet->upperdelaunay)) {
+      bestfacet= qh_findbest(qh, point, bestfacet,
+                            bestoutside, False, bestoutside,
+                            bestdist, isoutside, &totpart);
+      totpart += numpart;
+    }
+  }
+  trace3((qh, qh->ferr, 3014, "qh_findbestfacet: f%d dist %2.2g isoutside %d totpart %d\n",
+          bestfacet->id, *bestdist, (isoutside ? *isoutside : UINT_MAX), totpart));
+  return bestfacet;
+} /* findbestfacet */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="findbestlower">-</a>
+
+  qh_findbestlower(qh, facet, point, bestdist, numpart )
+    returns best non-upper, non-flipped neighbor of facet for point
+    if needed, searches vertex neighbors
+
+  returns:
+    returns bestdist and updates numpart
+
+  notes:
+    called by qh_findbest() for points above an upperdelaunay facet
+    if Delaunay and inside, point is outside of circumsphere of bestfacet
+
+*/
+facetT *qh_findbestlower(qhT *qh, facetT *upperfacet, pointT *point, realT *bestdistp, int *numpart) {
+  facetT *neighbor, **neighborp, *bestfacet= NULL;
+  realT bestdist= -REALmax/2 /* avoid underflow */;
+  realT dist;
+  vertexT *vertex;
+  boolT isoutside= False;  /* not used */
+
+  zinc_(Zbestlower);
+  FOREACHneighbor_(upperfacet) {
+    if (neighbor->upperdelaunay || neighbor->flipped)
+      continue;
+    (*numpart)++;
+    qh_distplane(qh, point, neighbor, &dist);
+    if (dist > bestdist) {
+      bestfacet= neighbor;
+      bestdist= dist;
+    }
+  }
+  if (!bestfacet) {
+    zinc_(Zbestlowerv);
+    /* rarely called, numpart does not count nearvertex computations */
+    vertex= qh_nearvertex(qh, upperfacet, point, &dist);
+    qh_vertexneighbors(qh);
+    FOREACHneighbor_(vertex) {
+      if (neighbor->upperdelaunay || neighbor->flipped)
+        continue;
+      (*numpart)++;
+      qh_distplane(qh, point, neighbor, &dist);
+      if (dist > bestdist) {
+        bestfacet= neighbor;
+        bestdist= dist;
+      }
+    }
+  }
+  if (!bestfacet) {
+    zinc_(Zbestlowerall);  /* invoked once per point in outsideset */
+    zmax_(Zbestloweralln, qh->num_facets);
+    /* [dec'15] Previously reported as QH6228 */
+    trace3((qh, qh->ferr, 3025, "qh_findbestlower: all neighbors of facet %d are flipped or upper Delaunay.  Search all facets\n",
+        upperfacet->id));
+    /* rarely called */
+    bestfacet= qh_findfacet_all(qh, point, qh_NOupper, &bestdist, &isoutside, numpart);
+  }
+  *bestdistp= bestdist;
+  trace3((qh, qh->ferr, 3015, "qh_findbestlower: f%d dist %2.2g for f%d p%d\n",
+          bestfacet->id, bestdist, upperfacet->id, qh_pointid(qh, point)));
+  return bestfacet;
+} /* findbestlower */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="findfacet_all">-</a>
+
+  qh_findfacet_all(qh, point, noupper, bestdist, isoutside, numpart )
+    exhaustive search for facet below a point
+    ignore flipped and visible facets, f.normal==NULL, and if noupper, f.upperdelaunay facets
+
+    for Delaunay triangulations,
+      Use qh_setdelaunay() to lift point to paraboloid and scale by 'Qbb' if needed
+      Do not use options 'Qbk', 'QBk', or 'QbB' since they scale the coordinates.
+
+  returns:
+    returns first facet below point
+    if point is inside,
+      returns nearest facet
+    distance to facet
+    isoutside if point is outside of the hull
+    number of distance tests
+
+  notes:
+    called by qh_findbestlower if all neighbors are flipped or upper Delaunay (QH3025)
+    primarily for library users (qh_findbestfacet), rarely used by Qhull
+*/
+facetT *qh_findfacet_all(qhT *qh, pointT *point, boolT noupper, realT *bestdist, boolT *isoutside,
+                          int *numpart) {
+  facetT *bestfacet= NULL, *facet;
+  realT dist;
+  int totpart= 0;
+
+  *bestdist= -REALmax;
+  *isoutside= False;
+  FORALLfacets {
+    if (facet->flipped || !facet->normal || facet->visible)
+      continue;
+    if (noupper && facet->upperdelaunay)
+      continue;
+    totpart++;
+    qh_distplane(qh, point, facet, &dist);
+    if (dist > *bestdist) {
+      *bestdist= dist;
+      bestfacet= facet;
+      if (dist > qh->MINoutside) {
+        *isoutside= True;
+        break;
+      }
+    }
+  }
+  *numpart= totpart;
+  trace3((qh, qh->ferr, 3016, "qh_findfacet_all: p%d, noupper? %d, f%d, dist %2.2g, isoutside %d, totpart %d\n",
+      qh_pointid(qh, point), noupper, getid_(bestfacet), *bestdist, *isoutside, totpart));
+  return bestfacet;
+} /* findfacet_all */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="findgood">-</a>
+
+  qh_findgood(qh, facetlist, goodhorizon )
+    identify good facets for qh.PRINTgood and qh_buildcone_onlygood
+    goodhorizon is count of good, horizon facets from qh_find_horizon, otherwise 0 from qh_findgood_all
+    if not qh.MERGING and qh.GOODvertex>0
+      facet includes point as vertex
+      if !match, returns goodhorizon
+    if qh.GOODpoint
+      facet is visible or coplanar (>0) or not visible (<0)
+    if qh.GOODthreshold
+      facet->normal matches threshold
+    if !goodhorizon and !match,
+      selects facet with closest angle to thresholds
+      sets GOODclosest
+
+  returns:
+    number of new, good facets found
+    determines facet->good
+    may update qh.GOODclosest
+
+  notes:
+    called from qh_initbuild, qh_buildcone_onlygood, and qh_findgood_all
+    qh_findgood_all (called from qh_prepare_output) further reduces the good region
+
+  design:
+    count good facets
+    if not merging, clear good facets that fail qh.GOODvertex ('QVn', but not 'QV-n')
+    clear good facets that fail qh.GOODpoint ('QGn' or 'QG-n')
+    clear good facets that fail qh.GOODthreshold
+    if !goodhorizon and !find f.good,
+      sets GOODclosest to facet with closest angle to thresholds
+*/
+int qh_findgood(qhT *qh, facetT *facetlist, int goodhorizon) {
+  facetT *facet, *bestfacet= NULL;
+  realT angle, bestangle= REALmax, dist;
+  int  numgood=0;
+
+  FORALLfacet_(facetlist) {
+    if (facet->good)
+      numgood++;
+  }
+  if (qh->GOODvertex>0 && !qh->MERGING) {
+    FORALLfacet_(facetlist) {
+      if (facet->good && !qh_isvertex(qh->GOODvertexp, facet->vertices)) {
+        facet->good= False;
+        numgood--;
+      }
+    }
+  }
+  if (qh->GOODpoint && numgood) {
+    FORALLfacet_(facetlist) {
+      if (facet->good && facet->normal) {
+        zinc_(Zdistgood);
+        qh_distplane(qh, qh->GOODpointp, facet, &dist);
+        if ((qh->GOODpoint > 0) ^ (dist > 0.0)) {
+          facet->good= False;
+          numgood--;
+        }
+      }
+    }
+  }
+  if (qh->GOODthreshold && (numgood || goodhorizon || qh->GOODclosest)) {
+    FORALLfacet_(facetlist) {
+      if (facet->good && facet->normal) {
+        if (!qh_inthresholds(qh, facet->normal, &angle)) {
+          facet->good= False;
+          numgood--;
+          if (angle < bestangle) {
+            bestangle= angle;
+            bestfacet= facet;
+          }
+        }
+      }
+    }
+    if (numgood == 0 && (goodhorizon == 0 || qh->GOODclosest)) {
+      if (qh->GOODclosest) {
+        if (qh->GOODclosest->visible)
+          qh->GOODclosest= NULL;
+        else {
+          qh_inthresholds(qh, qh->GOODclosest->normal, &angle);
+          if (angle < bestangle)
+            bestfacet= qh->GOODclosest;
+        }
+      }
+      if (bestfacet && bestfacet != qh->GOODclosest) {   /* numgood == 0 */
+        if (qh->GOODclosest)
+          qh->GOODclosest->good= False;
+        qh->GOODclosest= bestfacet;
+        bestfacet->good= True;
+        numgood++;
+        trace2((qh, qh->ferr, 2044, "qh_findgood: f%d is closest(%2.2g) to thresholds\n",
+           bestfacet->id, bestangle));
+        return numgood;
+      }
+    }else if (qh->GOODclosest) { /* numgood > 0 */
+      qh->GOODclosest->good= False;
+      qh->GOODclosest= NULL;
+    }
+  }
+  zadd_(Zgoodfacet, numgood);
+  trace2((qh, qh->ferr, 2045, "qh_findgood: found %d good facets with %d good horizon and qh.GOODclosest f%d\n",
+               numgood, goodhorizon, getid_(qh->GOODclosest)));
+  if (!numgood && qh->GOODvertex>0 && !qh->MERGING)
+    return goodhorizon;
+  return numgood;
+} /* findgood */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="findgood_all">-</a>
+
+  qh_findgood_all(qh, facetlist )
+    apply other constraints for good facets (used by qh.PRINTgood)
+    if qh.GOODvertex
+      facet includes (>0) or doesn't include (<0) point as vertex
+      if last good facet and ONLYgood, prints warning and continues
+    if qh.SPLITthresholds (e.g., qh.DELAUNAY)
+      facet->normal matches threshold, or if none, the closest one
+    calls qh_findgood
+    nop if good not used
+
+  returns:
+    clears facet->good if not good
+    sets qh.num_good
+
+  notes:
+    called by qh_prepare_output and qh_printneighborhood
+    unless qh.ONLYgood, calls qh_findgood first
+
+  design:
+    uses qh_findgood to mark good facets
+    clear f.good for failed qh.GOODvertex
+    clear f.good for failed qh.SPLITthreholds
+       if no more good facets, select best of qh.SPLITthresholds
+*/
+void qh_findgood_all(qhT *qh, facetT *facetlist) {
+  facetT *facet, *bestfacet=NULL;
+  realT angle, bestangle= REALmax;
+  int  numgood=0, startgood;
+
+  if (!qh->GOODvertex && !qh->GOODthreshold && !qh->GOODpoint
+  && !qh->SPLITthresholds)
+    return;
+  if (!qh->ONLYgood)
+    qh_findgood(qh, qh->facet_list, 0);
+  FORALLfacet_(facetlist) {
+    if (facet->good)
+      numgood++;
+  }
+  if (qh->GOODvertex <0 || (qh->GOODvertex > 0 && qh->MERGING)) {
+    FORALLfacet_(facetlist) {
+      if (facet->good && ((qh->GOODvertex > 0) ^ !!qh_isvertex(qh->GOODvertexp, facet->vertices))) { /* convert to bool */
+        if (!--numgood) {
+          if (qh->ONLYgood) {
+            qh_fprintf(qh, qh->ferr, 7064, "qhull warning: good vertex p%d does not match last good facet f%d.  Ignored.\n",
+               qh_pointid(qh, qh->GOODvertexp), facet->id);
+            return;
+          }else if (qh->GOODvertex > 0)
+            qh_fprintf(qh, qh->ferr, 7065, "qhull warning: point p%d is not a vertex('QV%d').\n",
+                qh->GOODvertex-1, qh->GOODvertex-1);
+          else
+            qh_fprintf(qh, qh->ferr, 7066, "qhull warning: point p%d is a vertex for every facet('QV-%d').\n",
+                -qh->GOODvertex - 1, -qh->GOODvertex - 1);
+        }
+        facet->good= False;
+      }
+    }
+  }
+  startgood= numgood;
+  if (qh->SPLITthresholds) {
+    FORALLfacet_(facetlist) {
+      if (facet->good) {
+        if (!qh_inthresholds(qh, facet->normal, &angle)) {
+          facet->good= False;
+          numgood--;
+          if (angle < bestangle) {
+            bestangle= angle;
+            bestfacet= facet;
+          }
+        }
+      }
+    }
+    if (!numgood && bestfacet) {
+      bestfacet->good= True;
+      numgood++;
+      trace0((qh, qh->ferr, 23, "qh_findgood_all: f%d is closest(%2.2g) to split thresholds\n",
+           bestfacet->id, bestangle));
+      return;
+    }
+  }
+  if (numgood == 1 && !qh->PRINTgood && qh->GOODclosest && qh->GOODclosest->good) {
+    trace2((qh, qh->ferr, 2109, "qh_findgood_all: undo selection of qh.GOODclosest f%d since it would fail qh_inthresholds in qh_skipfacet\n",
+      qh->GOODclosest->id));
+    qh->GOODclosest->good= False;
+    numgood= 0;
+  }
+  qh->num_good= numgood;
+  trace0((qh, qh->ferr, 24, "qh_findgood_all: %d good facets remain out of %d facets\n",
+        numgood, startgood));
+} /* findgood_all */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="furthestnext">-</a>
+
+  qh_furthestnext()
+    set qh.facet_next to facet with furthest of all furthest points
+    searches all facets on qh.facet_list
+
+  notes:
+    this may help avoid precision problems
+*/
+void qh_furthestnext(qhT *qh /* qh.facet_list */) {
+  facetT *facet, *bestfacet= NULL;
+  realT dist, bestdist= -REALmax;
+
+  FORALLfacets {
+    if (facet->outsideset) {
+#if qh_COMPUTEfurthest
+      pointT *furthest;
+      furthest= (pointT *)qh_setlast(facet->outsideset);
+      zinc_(Zcomputefurthest);
+      qh_distplane(qh, furthest, facet, &dist);
+#else
+      dist= facet->furthestdist;
+#endif
+      if (dist > bestdist) {
+        bestfacet= facet;
+        bestdist= dist;
+      }
+    }
+  }
+  if (bestfacet) {
+    qh_removefacet(qh, bestfacet);
+    qh_prependfacet(qh, bestfacet, &qh->facet_next);
+    trace1((qh, qh->ferr, 1029, "qh_furthestnext: made f%d next facet(dist %.2g)\n",
+            bestfacet->id, bestdist));
+  }
+} /* furthestnext */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="furthestout">-</a>
+
+  qh_furthestout(qh, facet )
+    make furthest outside point the last point of outsideset
+
+  returns:
+    updates facet->outsideset
+    clears facet->notfurthest
+    sets facet->furthestdist
+
+  design:
+    determine best point of outsideset
+    make it the last point of outsideset
+*/
+void qh_furthestout(qhT *qh, facetT *facet) {
+  pointT *point, **pointp, *bestpoint= NULL;
+  realT dist, bestdist= -REALmax;
+
+  FOREACHpoint_(facet->outsideset) {
+    qh_distplane(qh, point, facet, &dist);
+    zinc_(Zcomputefurthest);
+    if (dist > bestdist) {
+      bestpoint= point;
+      bestdist= dist;
+    }
+  }
+  if (bestpoint) {
+    qh_setdel(facet->outsideset, point);
+    qh_setappend(qh, &facet->outsideset, point);
+#if !qh_COMPUTEfurthest
+    facet->furthestdist= bestdist;
+#endif
+  }
+  facet->notfurthest= False;
+  trace3((qh, qh->ferr, 3017, "qh_furthestout: p%d is furthest outside point of f%d\n",
+          qh_pointid(qh, point), facet->id));
+} /* furthestout */
+
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="infiniteloop">-</a>
+
+  qh_infiniteloop(qh, facet )
+    report infinite loop error due to facet
+*/
+void qh_infiniteloop(qhT *qh, facetT *facet) {
+
+  qh_fprintf(qh, qh->ferr, 6149, "qhull internal error (qh_infiniteloop): potential infinite loop detected.  If visible, f.replace. If newfacet, f.samecycle\n");
+  qh_errexit(qh, qh_ERRqhull, facet, NULL);
+} /* qh_infiniteloop */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="initbuild">-</a>
+
+  qh_initbuild()
+    initialize hull and outside sets with point array
+    qh.FIRSTpoint/qh.NUMpoints is point array
+    if qh.GOODpoint
+      adds qh.GOODpoint to initial hull
+
+  returns:
+    qh_facetlist with initial hull
+    points partioned into outside sets, coplanar sets, or inside
+    initializes qh.GOODpointp, qh.GOODvertexp,
+
+  design:
+    initialize global variables used during qh_buildhull
+    determine precision constants and points with max/min coordinate values
+      if qh.SCALElast, scale last coordinate(for 'd')
+    initialize qh.newfacet_list, qh.facet_tail
+    initialize qh.vertex_list, qh.newvertex_list, qh.vertex_tail
+    determine initial vertices
+    build initial simplex
+    partition input points into facets of initial simplex
+    set up lists
+    if qh.ONLYgood
+      check consistency
+      add qh.GOODvertex if defined
+*/
+void qh_initbuild(qhT *qh) {
+  setT *maxpoints, *vertices;
+  facetT *facet;
+  int i, numpart;
+  realT dist;
+  boolT isoutside;
+
+  if (qh->PRINTstatistics) {
+    qh_fprintf(qh, qh->ferr, 9350, "qhull %s Statistics: %s | %s\n",
+      qh_version, qh->rbox_command, qh->qhull_command);
+    fflush(NULL);
+  }
+  qh->furthest_id= qh_IDunknown;
+  qh->lastreport= 0;
+  qh->lastfacets= 0;
+  qh->lastmerges= 0;
+  qh->lastplanes= 0;
+  qh->lastdist= 0;
+  qh->facet_id= qh->vertex_id= qh->ridge_id= 0;
+  qh->visit_id= qh->vertex_visit= 0;
+  qh->maxoutdone= False;
+
+  if (qh->GOODpoint > 0)
+    qh->GOODpointp= qh_point(qh, qh->GOODpoint-1);
+  else if (qh->GOODpoint < 0)
+    qh->GOODpointp= qh_point(qh, -qh->GOODpoint-1);
+  if (qh->GOODvertex > 0)
+    qh->GOODvertexp= qh_point(qh, qh->GOODvertex-1);
+  else if (qh->GOODvertex < 0)
+    qh->GOODvertexp= qh_point(qh, -qh->GOODvertex-1);
+  if ((qh->GOODpoint
+       && (qh->GOODpointp < qh->first_point  /* also catches !GOODpointp */
+           || qh->GOODpointp > qh_point(qh, qh->num_points-1)))
+  || (qh->GOODvertex
+       && (qh->GOODvertexp < qh->first_point  /* also catches !GOODvertexp */
+           || qh->GOODvertexp > qh_point(qh, qh->num_points-1)))) {
+    qh_fprintf(qh, qh->ferr, 6150, "qhull input error: either QGn or QVn point is > p%d\n",
+             qh->num_points-1);
+    qh_errexit(qh, qh_ERRinput, NULL, NULL);
+  }
+  maxpoints= qh_maxmin(qh, qh->first_point, qh->num_points, qh->hull_dim);
+  if (qh->SCALElast)
+    qh_scalelast(qh, qh->first_point, qh->num_points, qh->hull_dim, qh->MINlastcoord, qh->MAXlastcoord, qh->MAXabs_coord);
+  qh_detroundoff(qh);
+  if (qh->DELAUNAY && qh->upper_threshold[qh->hull_dim-1] > REALmax/2
+                  && qh->lower_threshold[qh->hull_dim-1] < -REALmax/2) {
+    for (i=qh_PRINTEND; i--; ) {
+      if (qh->PRINTout[i] == qh_PRINTgeom && qh->DROPdim < 0
+          && !qh->GOODthreshold && !qh->SPLITthresholds)
+        break;  /* in this case, don't set upper_threshold */
+    }
+    if (i < 0) {
+      if (qh->UPPERdelaunay) { /* matches qh.upperdelaunay in qh_setfacetplane */
+        qh->lower_threshold[qh->hull_dim-1]= qh->ANGLEround * qh_ZEROdelaunay;
+        qh->GOODthreshold= True;
+      }else {
+        qh->upper_threshold[qh->hull_dim-1]= -qh->ANGLEround * qh_ZEROdelaunay;
+        if (!qh->GOODthreshold)
+          qh->SPLITthresholds= True; /* build upper-convex hull even if Qg */
+          /* qh_initqhull_globals errors if Qg without Pdk/etc. */
+      }
+    }
+  }
+  trace4((qh, qh->ferr, 4091, "qh_initbuild: create sentinels for qh.facet_tail and qh.vertex_tail\n"));
+  qh->facet_list= qh->newfacet_list= qh->facet_tail= qh_newfacet(qh);
+  qh->num_facets= qh->num_vertices= qh->num_visible= 0;
+  qh->vertex_list= qh->newvertex_list= qh->vertex_tail= qh_newvertex(qh, NULL);
+  vertices= qh_initialvertices(qh, qh->hull_dim, maxpoints, qh->first_point, qh->num_points);
+  qh_initialhull(qh, vertices);  /* initial qh->facet_list */
+  qh_partitionall(qh, vertices, qh->first_point, qh->num_points);
+  if (qh->PRINToptions1st || qh->TRACElevel || qh->IStracing) {
+    if (qh->TRACElevel || qh->IStracing)
+      qh_fprintf(qh, qh->ferr, 8103, "\nTrace level T%d, IStracing %d, point TP%d, merge TM%d, dist TW%2.2g, qh.tracefacet_id %d, traceridge_id %d, tracevertex_id %d, last qh.RERUN %d, %s | %s\n",
+         qh->TRACElevel, qh->IStracing, qh->TRACEpoint, qh->TRACEmerge, qh->TRACEdist, qh->tracefacet_id, qh->traceridge_id, qh->tracevertex_id, qh->TRACElastrun, qh->rbox_command, qh->qhull_command);
+    qh_fprintf(qh, qh->ferr, 8104, "Options selected for Qhull %s:\n%s\n", qh_version, qh->qhull_options);
+  }
+  qh_resetlists(qh, False, qh_RESETvisible /* qh.visible_list newvertex_list qh.newfacet_list */);
+  qh->facet_next= qh->facet_list;
+  qh_furthestnext(qh /* qh.facet_list */);
+  if (qh->PREmerge) {
+    qh->cos_max= qh->premerge_cos;
+    qh->centrum_radius= qh->premerge_centrum; /* overwritten by qh_premerge */
+  }
+  if (qh->ONLYgood) {
+    if (qh->GOODvertex > 0 && qh->MERGING) {
+      qh_fprintf(qh, qh->ferr, 6151, "qhull input error: 'Qg QVn' (only good vertex) does not work with merging.\nUse 'QJ' to joggle the input or 'Q0' to turn off merging.\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    if (!(qh->GOODthreshold || qh->GOODpoint
+         || (!qh->MERGEexact && !qh->PREmerge && qh->GOODvertexp))) {
+      qh_fprintf(qh, qh->ferr, 6152, "qhull input error: 'Qg' (ONLYgood) needs a good threshold('Pd0D0'), a good point(QGn or QG-n), or a good vertex with 'QJ' or 'Q0' (QVn).\n");
+      qh_errexit(qh, qh_ERRinput, NULL, NULL);
+    }
+    if (qh->GOODvertex > 0  && !qh->MERGING  /* matches qh_partitionall */
+    && !qh_isvertex(qh->GOODvertexp, vertices)) {
+      facet= qh_findbestnew(qh, qh->GOODvertexp, qh->facet_list,
+                          &dist, !qh_ALL, &isoutside, &numpart);
+      zadd_(Zdistgood, numpart);
+      if (!isoutside) {
+        qh_fprintf(qh, qh->ferr, 6153, "qhull input error: point for QV%d is inside initial simplex.  It can not be made a vertex.\n",
+               qh_pointid(qh, qh->GOODvertexp));
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+      }
+      if (!qh_addpoint(qh, qh->GOODvertexp, facet, False)) {
+        qh_settempfree(qh, &vertices);
+        qh_settempfree(qh, &maxpoints);
+        return;
+      }
+    }
+    qh_findgood(qh, qh->facet_list, 0);
+  }
+  qh_settempfree(qh, &vertices);
+  qh_settempfree(qh, &maxpoints);
+  trace1((qh, qh->ferr, 1030, "qh_initbuild: initial hull created and points partitioned\n"));
+} /* initbuild */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="initialhull">-</a>
+
+  qh_initialhull(qh, vertices )
+    constructs the initial hull as a DIM3 simplex of vertices
+
+  notes:
+    only called by qh_initbuild
+
+  design:
+    creates a simplex (initializes lists)
+    determines orientation of simplex
+    sets hyperplanes for facets
+    doubles checks orientation (in case of axis-parallel facets with Gaussian elimination)
+    checks for flipped facets and qh.NARROWhull
+    checks the result
+*/
+void qh_initialhull(qhT *qh, setT *vertices) {
+  facetT *facet, *firstfacet, *neighbor, **neighborp;
+  realT angle, minangle= REALmax, dist;
+
+  qh_createsimplex(qh, vertices /* qh.facet_list */);
+  qh_resetlists(qh, False, qh_RESETvisible);
+  qh->facet_next= qh->facet_list;      /* advance facet when processed */
+  qh->interior_point= qh_getcenter(qh, vertices);
+  if (qh->IStracing) {
+    qh_fprintf(qh, qh->ferr, 8105, "qh_initialhull: ");
+    qh_printpoint(qh, qh->ferr, "qh.interior_point", qh->interior_point);
+  }
+  firstfacet= qh->facet_list;
+  qh_setfacetplane(qh, firstfacet);   /* qh_joggle_restart if flipped */
+  if (firstfacet->flipped) {
+    trace1((qh, qh->ferr, 1065, "qh_initialhull: ignore f%d flipped.  Test qh.interior_point (p-2) for clearly flipped\n", firstfacet->id));
+    firstfacet->flipped= False;
+  }
+  zzinc_(Zdistcheck);
+  qh_distplane(qh, qh->interior_point, firstfacet, &dist);
+  if (dist > qh->DISTround) {  /* clearly flipped */
+    trace1((qh, qh->ferr, 1060, "qh_initialhull: initial orientation incorrect, qh.interior_point is %2.2g from f%d.  Reversing orientation of all facets\n",
+          dist, firstfacet->id));
+    FORALLfacets
+      facet->toporient ^= (unsigned char)True;
+    qh_setfacetplane(qh, firstfacet);
+  }
+  FORALLfacets {
+    if (facet != firstfacet)
+      qh_setfacetplane(qh, facet);    /* qh_joggle_restart if flipped */
+  }
+  FORALLfacets {
+    if (facet->flipped) {
+      trace1((qh, qh->ferr, 1066, "qh_initialhull: ignore f%d flipped.  Test qh.interior_point (p-2) for clearly flipped\n", facet->id));
+      facet->flipped= False;
+    }
+    zzinc_(Zdistcheck);
+    qh_distplane(qh, qh->interior_point, facet, &dist);  /* duplicates qh_setfacetplane */
+    if (dist > qh->DISTround) {  /* clearly flipped, due to axis-parallel facet or coplanar firstfacet */
+      trace1((qh, qh->ferr, 1031, "qh_initialhull: initial orientation incorrect, qh.interior_point is %2.2g from f%d.  Either axis-parallel facet or coplanar firstfacet f%d.  Force outside orientation of all facets\n"));
+      FORALLfacets { /* reuse facet, then 'break' */
+        facet->flipped= False;
+        facet->toporient ^= (unsigned char)True;
+        qh_orientoutside(qh, facet);  /* force outside orientation for f.normal */
+      }
+      break;
+    }
+  }
+  FORALLfacets {
+    if (!qh_checkflipped(qh, facet, NULL, qh_ALL)) {
+      if (qh->DELAUNAY && ! qh->ATinfinity) {
+        qh_joggle_restart(qh, "initial Delaunay cocircular or cospherical");
+        if (qh->UPPERdelaunay)
+          qh_fprintf(qh, qh->ferr, 6240, "Qhull precision error: initial Delaunay input sites are cocircular or cospherical.  Option 'Qs' searches all points.  Use option 'QJ' to joggle the input, otherwise cannot compute the upper Delaunay triangulation or upper Voronoi diagram of cocircular/cospherical points.\n");
+        else
+          qh_fprintf(qh, qh->ferr, 6239, "Qhull precision error: initial Delaunay input sites are cocircular or cospherical.  Use option 'Qz' for the Delaunay triangulation or Voronoi diagram of cocircular/cospherical points; it adds a point \"at infinity\".  Alternatively use option 'QJ' to joggle the input.  Use option 'Qs' to search all points for the initial simplex.\n");
+        qh_printvertexlist(qh, qh->ferr, "\ninput sites with last coordinate projected to a paraboloid\n", qh->facet_list, NULL, qh_ALL);
+        qh_errexit(qh, qh_ERRinput, NULL, NULL);
+      }else {
+        qh_joggle_restart(qh, "initial simplex is flat");
+        qh_fprintf(qh, qh->ferr, 6154, "Qhull precision error: Initial simplex is flat (facet %d is coplanar with the interior point)\n",
+                   facet->id);
+        qh_errexit(qh, qh_ERRsingular, NULL, NULL);  /* calls qh_printhelp_singular */
+      }
+    }
+    FOREACHneighbor_(facet) {
+      angle= qh_getangle(qh, facet->normal, neighbor->normal);
+      minimize_( minangle, angle);
+    }
+  }
+  if (minangle < qh_MAXnarrow && !qh->NOnarrow) {
+    realT diff= 1.0 + minangle;
+
+    qh->NARROWhull= True;
+    qh_option(qh, "_narrow-hull", NULL, &diff);
+    if (minangle < qh_WARNnarrow && !qh->RERUN && qh->PRINTprecision)
+      qh_printhelp_narrowhull(qh, qh->ferr, minangle);
+  }
+  zzval_(Zprocessed)= qh->hull_dim+1;
+  qh_checkpolygon(qh, qh->facet_list);
+  qh_checkconvex(qh, qh->facet_list, qh_DATAfault);
+  if (qh->IStracing >= 1) {
+    qh_fprintf(qh, qh->ferr, 8105, "qh_initialhull: simplex constructed\n");
+  }
+} /* initialhull */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="initialvertices">-</a>
+
+  qh_initialvertices(qh, dim, maxpoints, points, numpoints )
+    determines a non-singular set of initial vertices
+    maxpoints may include duplicate points
+
+  returns:
+    temporary set of dim+1 vertices in descending order by vertex id
+    if qh.RANDOMoutside && !qh.ALLpoints
+      picks random points
+    if dim >= qh_INITIALmax,
+      uses min/max x and max points with non-zero determinants
+
+  notes:
+    unless qh.ALLpoints,
+      uses maxpoints as long as determinate is non-zero
+*/
+setT *qh_initialvertices(qhT *qh, int dim, setT *maxpoints, pointT *points, int numpoints) {
+  pointT *point, **pointp;
+  setT *vertices, *simplex, *tested;
+  realT randr;
+  int idx, point_i, point_n, k;
+  boolT nearzero= False;
+
+  vertices= qh_settemp(qh, dim + 1);
+  simplex= qh_settemp(qh, dim + 1);
+  if (qh->ALLpoints)
+    qh_maxsimplex(qh, dim, NULL, points, numpoints, &simplex);
+  else if (qh->RANDOMoutside) {
+    while (qh_setsize(qh, simplex) != dim+1) {
+      randr= qh_RANDOMint;
+      randr= randr/(qh_RANDOMmax+1);
+      randr= floor(qh->num_points * randr);
+      idx= (int)randr;
+      while (qh_setin(simplex, qh_point(qh, idx))) {
+        idx++; /* in case qh_RANDOMint always returns the same value */
+        idx= idx < qh->num_points ? idx : 0;
+      }
+      qh_setappend(qh, &simplex, qh_point(qh, idx));
+    }
+  }else if (qh->hull_dim >= qh_INITIALmax) {
+    tested= qh_settemp(qh, dim+1);
+    qh_setappend(qh, &simplex, SETfirst_(maxpoints));   /* max and min X coord */
+    qh_setappend(qh, &simplex, SETsecond_(maxpoints));
+    qh_maxsimplex(qh, fmin_(qh_INITIALsearch, dim), maxpoints, points, numpoints, &simplex);
+    k= qh_setsize(qh, simplex);
+    FOREACHpoint_i_(qh, maxpoints) {
+      if (k >= dim)  /* qh_maxsimplex for last point */
+        break;
+      if (point_i & 0x1) {     /* first try up to dim, max. coord. points */
+        if (!qh_setin(simplex, point) && !qh_setin(tested, point)){
+          qh_detsimplex(qh, point, simplex, k, &nearzero);
+          if (nearzero)
+            qh_setappend(qh, &tested, point);
+          else {
+            qh_setappend(qh, &simplex, point);
+            k++;
+          }
+        }
+      }
+    }
+    FOREACHpoint_i_(qh, maxpoints) {
+      if (k >= dim)  /* qh_maxsimplex for last point */
+        break;
+      if ((point_i & 0x1) == 0) {  /* then test min. coord points */
+        if (!qh_setin(simplex, point) && !qh_setin(tested, point)){
+          qh_detsimplex(qh, point, simplex, k, &nearzero);
+          if (nearzero)
+            qh_setappend(qh, &tested, point);
+          else {
+            qh_setappend(qh, &simplex, point);
+            k++;
+          }
+        }
+      }
+    }
+    /* remove tested points from maxpoints */
+    FOREACHpoint_i_(qh, maxpoints) {
+      if (qh_setin(simplex, point) || qh_setin(tested, point))
+        SETelem_(maxpoints, point_i)= NULL;
+    }
+    qh_setcompact(qh, maxpoints);
+    idx= 0;
+    while (k < dim && (point= qh_point(qh, idx++))) {
+      if (!qh_setin(simplex, point) && !qh_setin(tested, point)){
+        qh_detsimplex(qh, point, simplex, k, &nearzero);
+        if (!nearzero){
+          qh_setappend(qh, &simplex, point);
+          k++;
+        }
+      }
+    }
+    qh_settempfree(qh, &tested);
+    qh_maxsimplex(qh, dim, maxpoints, points, numpoints, &simplex);
+  }else /* qh.hull_dim < qh_INITIALmax */
+    qh_maxsimplex(qh, dim, maxpoints, points, numpoints, &simplex);
+  FOREACHpoint_(simplex)
+    qh_setaddnth(qh, &vertices, 0, qh_newvertex(qh, point)); /* descending order */
+  qh_settempfree(qh, &simplex);
+  return vertices;
+} /* initialvertices */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="isvertex">-</a>
+
+  qh_isvertex( point, vertices )
+    returns vertex if point is in vertex set, else returns NULL
+
+  notes:
+    for qh.GOODvertex
+*/
+vertexT *qh_isvertex(pointT *point, setT *vertices) {
+  vertexT *vertex, **vertexp;
+
+  FOREACHvertex_(vertices) {
+    if (vertex->point == point)
+      return vertex;
+  }
+  return NULL;
+} /* isvertex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="makenewfacets">-</a>
+
+  qh_makenewfacets(qh, point )
+    make new facets from point and qh.visible_list
+
+  returns:
+    apex (point) of the new facets
+    qh.newfacet_list= list of new facets with hyperplanes and ->newfacet
+    qh.newvertex_list= list of vertices in new facets with ->newfacet set
+
+    if (qh.NEWtentative)
+      newfacets reference horizon facets, but not vice versa
+      ridges reference non-simplicial horizon ridges, but not vice versa
+      does not change existing facets
+    else
+      sets qh.NEWfacets
+      new facets attached to horizon facets and ridges
+      for visible facets,
+        visible->r.replace is corresponding new facet
+
+  see also:
+    qh_makenewplanes() -- make hyperplanes for facets
+    qh_attachnewfacets() -- attachnewfacets if not done here qh->NEWtentative
+    qh_matchnewfacets() -- match up neighbors
+    qh_update_vertexneighbors() -- update vertex neighbors and delvertices
+    qh_deletevisible() -- delete visible facets
+    qh_checkpolygon() --check the result
+    qh_triangulate() -- triangulate a non-simplicial facet
+
+  design:
+    for each visible facet
+      make new facets to its horizon facets
+      update its f.replace
+      clear its neighbor set
+*/
+vertexT *qh_makenewfacets(qhT *qh, pointT *point /* qh.visible_list */) {
+  facetT *visible, *newfacet= NULL, *newfacet2= NULL, *neighbor, **neighborp;
+  vertexT *apex;
+  int numnew=0;
+
+  if (qh->CHECKfrequently) {
+    qh_checkdelridge(qh);
+  }
+  qh->newfacet_list= qh->facet_tail;
+  qh->newvertex_list= qh->vertex_tail;
+  apex= qh_newvertex(qh, point);
+  qh_appendvertex(qh, apex);
+  qh->visit_id++;
+  FORALLvisible_facets {
+    FOREACHneighbor_(visible)
+      neighbor->seen= False;
+    if (visible->ridges) {
+      visible->visitid= qh->visit_id;
+      newfacet2= qh_makenew_nonsimplicial(qh, visible, apex, &numnew);
+    }
+    if (visible->simplicial)
+      newfacet= qh_makenew_simplicial(qh, visible, apex, &numnew);
+    if (!qh->NEWtentative) {
+      if (newfacet2)  /* newfacet is null if all ridges defined */
+        newfacet= newfacet2;
+      if (newfacet)
+        visible->f.replace= newfacet;
+      else
+        zinc_(Zinsidevisible);
+      if (visible->ridges)      /* ridges and neighbors are no longer valid for visible facet */
+        SETfirst_(visible->ridges)= NULL;
+      SETfirst_(visible->neighbors)= NULL;
+    }
+  }
+  if (!qh->NEWtentative)
+    qh->NEWfacets= True;
+  trace1((qh, qh->ferr, 1032, "qh_makenewfacets: created %d new facets f%d..f%d from point p%d to horizon\n",
+    numnew, qh->first_newfacet, qh->facet_id-1, qh_pointid(qh, point)));
+  if (qh->IStracing >= 4)
+    qh_printfacetlist(qh, qh->newfacet_list, NULL, qh_ALL);
+  return apex;
+} /* makenewfacets */
+
+#ifndef qh_NOmerge
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="matchdupridge">-</a>
+
+  qh_matchdupridge(qh, atfacet, atskip, hashsize, hashcount )
+    match duplicate ridges in qh.hash_table for atfacet@atskip
+    duplicates marked with ->dupridge and qh_DUPLICATEridge
+
+  returns:
+    vertex-facet distance (>0.0) for qh_MERGEridge ridge
+    updates hashcount
+    set newfacet, facet, matchfacet's hyperplane (removes from mergecycle of coplanarhorizon facets)
+
+  see also:
+    qh_matchneighbor
+
+  notes:
+    only called by qh_matchnewfacets for qh_buildcone and qh_triangulate_facet
+    assumes atfacet is simplicial
+    assumes atfacet->neighbors @ atskip == qh_DUPLICATEridge
+    usually keeps ridge with the widest merge
+    both MRGdupridge and MRGflipped are required merges -- rbox 100 C1,2e-13 D4 t1 | qhull d Qbb
+      can merge flipped f11842 skip 3 into f11862 skip 2 and vice versa (forced by goodmatch/goodmatch2)
+         blocks -- cannot merge f11862 skip 2 and f11863 skip2 (the widest merge)
+         must block -- can merge f11843 skip 3 into f11842 flipped skip 3, but not vice versa
+      can merge f11843 skip 3 into f11863 skip 2, but not vice versa
+    working/unused.h: [jan'19] Dropped qh_matchdupridge_coplanarhorizon, it was the same or slightly worse.  Complex addition, rarely occurs
+
+  design:
+    compute hash value for atfacet and atskip
+    repeat twice -- once to make best matches, once to match the rest
+      for each possible facet in qh.hash_table
+        if it is a matching facet with the same orientation and pass 2
+          make match
+          unless tricoplanar, mark match for merging (qh_MERGEridge)
+          [e.g., tricoplanar RBOX s 1000 t993602376 | QHULL C-1e-3 d Qbb FA Qt]
+        if it is a matching facet with the same orientation and pass 1
+          test if this is a better match
+      if pass 1,
+        make best match (it will not be merged)
+        set newfacet, facet, matchfacet's hyperplane (removes from mergecycle of coplanarhorizon facets)
+
+*/
+coordT qh_matchdupridge(qhT *qh, facetT *atfacet, int atskip, int hashsize, int *hashcount) {
+  boolT same, ismatch, isduplicate= False;
+  int hash, scan;
+  facetT *facet, *newfacet, *nextfacet;
+  facetT *maxmatch= NULL, *maxmatch2= NULL, *goodmatch= NULL, *goodmatch2= NULL;
+  int skip, newskip, nextskip= 0, makematch;
+  int maxskip= 0, maxskip2= 0, goodskip= 0, goodskip2= 0;
+  coordT maxdist= -REALmax, maxdist2= 0.0, dupdist, dupdist2, low, high, maxgood, gooddist= 0.0;
+
+  maxgood= qh_WIDEdupridge * (qh->ONEmerge + qh->DISTround); 
+  hash= qh_gethash(qh, hashsize, atfacet->vertices, qh->hull_dim, 1,
+                     SETelem_(atfacet->vertices, atskip));
+  trace2((qh, qh->ferr, 2046, "qh_matchdupridge: find dupridge matches for f%d skip %d hash %d hashcount %d\n",
+          atfacet->id, atskip, hash, *hashcount));
+  for (makematch=0; makematch < 2; makematch++) { /* makematch is false on the first pass and 1 on the second */
+    qh->visit_id++;
+    for (newfacet=atfacet, newskip=atskip; newfacet; newfacet= nextfacet, newskip= nextskip) {
+      zinc_(Zhashlookup);
+      nextfacet= NULL; /* exit when ismatch found */
+      newfacet->visitid= qh->visit_id;
+      for (scan=hash; (facet= SETelemt_(qh->hash_table, scan, facetT));
+           scan= (++scan >= hashsize ? 0 : scan)) {
+        if (!facet->dupridge || facet->visitid == qh->visit_id)
+          continue;
+        zinc_(Zhashtests);
+        if (qh_matchvertices(qh, 1, newfacet->vertices, newskip, facet->vertices, &skip, &same)) {
+          if (SETelem_(newfacet->vertices, newskip) == SETelem_(facet->vertices, skip)) {
+            trace3((qh, qh->ferr, 3053, "qh_matchdupridge: duplicate ridge due to duplicate facets (f%d skip %d and f%d skip %d) previously reported as QH7084.  Maximize dupdist to force vertex merge\n",
+              newfacet->id, newskip, facet->id, skip));
+            isduplicate= True;
+          }
+          ismatch= (same == (boolT)(newfacet->toporient ^ facet->toporient));
+          if (SETelemt_(facet->neighbors, skip, facetT) != qh_DUPLICATEridge) {
+            if (!makematch) {  /* occurs if many merges, e.g., rbox 100 W0 C2,1e-13 D6 t1546872462 | qhull C0 Qt Tcv */
+              qh_fprintf(qh, qh->ferr, 6155, "qhull topology error (qh_matchdupridge): missing qh_DUPLICATEridge at f%d skip %d for new f%d skip %d hash %d ismatch %d.  Set by qh_matchneighbor\n",
+                facet->id, skip, newfacet->id, newskip, hash, ismatch);
+              qh_errexit2(qh, qh_ERRtopology, facet, newfacet);
+            }
+          }else if (!ismatch) {
+            nextfacet= facet;
+            nextskip= skip;
+          }else if (SETelemt_(newfacet->neighbors, newskip, facetT) == qh_DUPLICATEridge) {
+            if (makematch) {
+              if (newfacet->tricoplanar) {
+                SETelem_(facet->neighbors, skip)= newfacet;
+                SETelem_(newfacet->neighbors, newskip)= facet;
+                *hashcount -= 2; /* removed two unmatched facets */
+                trace2((qh, qh->ferr, 2075, "qh_matchdupridge: allow tricoplanar dupridge for new f%d skip %d and f%d skip %d\n",
+                    newfacet->id, newskip, facet->id, skip)); 
+              }else if (goodmatch && goodmatch2) {
+                SETelem_(goodmatch2->neighbors, goodskip2)= qh_MERGEridge;  /* undo selection of goodmatch */
+                SETelem_(facet->neighbors, skip)= newfacet;
+                SETelem_(newfacet->neighbors, newskip)= facet;
+                *hashcount -= 2; /* removed two unmatched facets */
+                trace2((qh, qh->ferr, 2105, "qh_matchdupridge: make good forced merge of dupridge f%d skip %d into f%d skip %d, keep new f%d skip %d and f%d skip %d, dist %4.4g\n",
+                  goodmatch->id, goodskip, goodmatch2->id, goodskip2, newfacet->id, newskip, facet->id, skip, gooddist)); 
+                goodmatch2= NULL;
+              }else {
+                SETelem_(facet->neighbors, skip)= newfacet;
+                SETelem_(newfacet->neighbors, newskip)= qh_MERGEridge;  /* resolved by qh_mark_dupridges */
+                *hashcount -= 2; /* removed two unmatched facets */
+                trace3((qh, qh->ferr, 3073, "qh_matchdupridge: make forced merge of dupridge for new f%d skip %d and f%d skip %d, maxdist %4.4g in qh_forcedmerges\n",
+                  newfacet->id, newskip, facet->id, skip, maxdist2));
+              }
+            }else { /* !makematch */
+              if (!facet->normal)
+                qh_setfacetplane(qh, facet); /* qh_mergecycle will ignore 'mergehorizon' facets with normals, too many cases otherwise */
+              if (!newfacet->normal) 
+                qh_setfacetplane(qh, newfacet);
+              dupdist= qh_getdistance(qh, facet, newfacet, &low, &high); /* ignore low/high */
+              dupdist2= qh_getdistance(qh, newfacet, facet, &low, &high);
+              if (isduplicate) {
+                goodmatch= NULL;
+                minimize_(dupdist, dupdist2);
+                maxdist= dupdist;
+                maxdist2= REALmax/2;
+                maxmatch= facet;
+                maxskip= skip;
+                maxmatch2= newfacet;
+                maxskip2= newskip;
+                break; /* force maxmatch */
+              }else if (facet->flipped && !newfacet->flipped && dupdist < maxgood) {
+                if (!goodmatch || !goodmatch->flipped || dupdist < gooddist) {
+                  goodmatch= facet; 
+                  goodskip= skip;
+                  goodmatch2= newfacet;
+                  goodskip2= newskip;
+                  gooddist= dupdist;
+                  trace3((qh, qh->ferr, 3070, "qh_matchdupridge: try good dupridge flipped f%d skip %d into new f%d skip %d at dist %2.2g otherdist %2.2g\n",
+                    goodmatch->id, goodskip, goodmatch2->id, goodskip2, gooddist, dupdist2));
+                }
+              }else if (newfacet->flipped && !facet->flipped && dupdist2 < maxgood) {
+                if (!goodmatch || !goodmatch->flipped || dupdist2 < gooddist) {
+                  goodmatch= newfacet;  
+                  goodskip= newskip;
+                  goodmatch2= facet;
+                  goodskip2= skip;
+                  gooddist= dupdist2;
+                  trace3((qh, qh->ferr, 3071, "qh_matchdupridge: try good dupridge flipped new f%d skip %d into f%d skip %d at dist %2.2g otherdist %2.2g\n",
+                    goodmatch->id, goodskip, goodmatch2->id, goodskip2, gooddist, dupdist));
+                }
+              }else if (dupdist < maxgood && (!newfacet->flipped || facet->flipped)) { /* disallow not-flipped->flipped */
+                if (!goodmatch || (!goodmatch->flipped && dupdist < gooddist)) {
+                  goodmatch= facet;
+                  goodskip= skip;
+                  goodmatch2= newfacet;
+                  goodskip2= newskip;
+                  gooddist= dupdist;
+                  trace3((qh, qh->ferr, 3072, "qh_matchdupridge: try good dupridge f%d skip %d into new f%d skip %d at dist %2.2g otherdist %2.2g\n",
+                    goodmatch->id, goodskip, goodmatch2->id, goodskip2, gooddist, dupdist2));
+                }
+              }else if (dupdist2 < maxgood && (!facet->flipped || newfacet->flipped)) { /* disallow not-flipped->flipped */
+                if (!goodmatch || (!goodmatch->flipped && dupdist2 < gooddist)) {
+                  goodmatch= newfacet;  
+                  goodskip= newskip;
+                  goodmatch2= facet;
+                  goodskip2= skip;
+                  gooddist= dupdist2;
+                  trace3((qh, qh->ferr, 3018, "qh_matchdupridge: try good dupridge new f%d skip %d into f%d skip %d at dist %2.2g otherdist %2.2g\n",
+                    goodmatch->id, goodskip, goodmatch2->id, goodskip2, gooddist, dupdist));
+                }
+              }else if (!goodmatch) { /* otherwise match the furthest apart facets */
+                if (!newfacet->flipped || facet->flipped) {
+                  minimize_(dupdist, dupdist2);
+                }
+                if (dupdist > maxdist) { /* could keep !flipped->flipped, but probably lost anyway */
+                  maxdist2= maxdist;
+                  maxdist= dupdist;
+                  maxmatch= facet;
+                  maxskip= skip;
+                  maxmatch2= newfacet;
+                  maxskip2= newskip;
+                  trace3((qh, qh->ferr, 3055, "qh_matchdupridge: try furthest dupridge f%d skip %d new f%d skip %d at dist %2.2g\n",
+                    maxmatch->id, maxskip, maxmatch2->id, maxskip2, maxdist));
+                }else if (dupdist > maxdist2)
+                  maxdist2= dupdist;
+              }
+            }
+          }
+        }
+      } /* end of foreach entry in qh.hash_table starting at 'hash' */
+      if (makematch && SETelemt_(newfacet->neighbors, newskip, facetT) == qh_DUPLICATEridge) {
+        qh_fprintf(qh, qh->ferr, 6156, "qhull internal error (qh_matchdupridge): no MERGEridge match for dupridge new f%d skip %d at hash %d..%d\n",
+                    newfacet->id, newskip, hash, scan);
+        qh_errexit(qh, qh_ERRqhull, newfacet, NULL);
+      }
+    } /* end of foreach newfacet at 'hash' */
+    if (!makematch) {
+      if (!maxmatch && !goodmatch) {
+        qh_fprintf(qh, qh->ferr, 6157, "qhull internal error (qh_matchdupridge): no maximum or good match for dupridge new f%d skip %d at hash %d..%d\n",
+          atfacet->id, atskip, hash, scan);
+        qh_errexit(qh, qh_ERRqhull, atfacet, NULL);
+      }
+      if (goodmatch) {
+        SETelem_(goodmatch->neighbors, goodskip)= goodmatch2;
+        SETelem_(goodmatch2->neighbors, goodskip2)= goodmatch;
+        *hashcount -= 2; /* removed two unmatched facets */
+        if (goodmatch->flipped) {
+          if (!goodmatch2->flipped) {
+            zzinc_(Zflipridge);
+          }else {
+            zzinc_(Zflipridge2);
+            /* qh_joggle_restart called by qh_matchneighbor if qh_DUPLICATEridge */
+          }
+        }
+        /* previously traced */
+      }else {
+        SETelem_(maxmatch->neighbors, maxskip)= maxmatch2; /* maxmatch!=NULL by QH6157 */
+        SETelem_(maxmatch2->neighbors, maxskip2)= maxmatch;
+        *hashcount -= 2; /* removed two unmatched facets */
+        zzinc_(Zmultiridge);
+        /* qh_joggle_restart called by qh_matchneighbor if qh_DUPLICATEridge */
+        trace0((qh, qh->ferr, 25, "qh_matchdupridge: keep dupridge f%d skip %d and f%d skip %d, dist %4.4g\n",
+          maxmatch2->id, maxskip2, maxmatch->id, maxskip, maxdist));
+      }
+    }
+  }
+  if (goodmatch)
+    return gooddist;
+  return maxdist2;
+} /* matchdupridge */
+
+#else /* qh_NOmerge */
+coordT qh_matchdupridge(qhT *qh, facetT *atfacet, int atskip, int hashsize, int *hashcount) {
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(atfacet)
+  QHULL_UNUSED(atskip)
+  QHULL_UNUSED(hashsize)
+  QHULL_UNUSED(hashcount)
+
+  return 0.0;
+}
+#endif /* qh_NOmerge */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="nearcoplanar">-</a>
+
+  qh_nearcoplanar()
+    for all facets, remove near-inside points from facet->coplanarset</li>
+    coplanar points defined by innerplane from qh_outerinner()
+
+  returns:
+    if qh->KEEPcoplanar && !qh->KEEPinside
+      facet->coplanarset only contains coplanar points
+    if qh.JOGGLEmax
+      drops inner plane by another qh.JOGGLEmax diagonal since a
+        vertex could shift out while a coplanar point shifts in
+
+  notes:
+    used for qh.PREmerge and qh.JOGGLEmax
+    must agree with computation of qh.NEARcoplanar in qh_detroundoff
+
+  design:
+    if not keeping coplanar or inside points
+      free all coplanar sets
+    else if not keeping both coplanar and inside points
+      remove !coplanar or !inside points from coplanar sets
+*/
+void qh_nearcoplanar(qhT *qh /* qh.facet_list */) {
+  facetT *facet;
+  pointT *point, **pointp;
+  int numpart;
+  realT dist, innerplane;
+
+  if (!qh->KEEPcoplanar && !qh->KEEPinside) {
+    FORALLfacets {
+      if (facet->coplanarset)
+        qh_setfree(qh, &facet->coplanarset);
+    }
+  }else if (!qh->KEEPcoplanar || !qh->KEEPinside) {
+    qh_outerinner(qh, NULL, NULL, &innerplane);
+    if (qh->JOGGLEmax < REALmax/2)
+      innerplane -= qh->JOGGLEmax * sqrt((realT)qh->hull_dim);
+    numpart= 0;
+    FORALLfacets {
+      if (facet->coplanarset) {
+        FOREACHpoint_(facet->coplanarset) {
+          numpart++;
+          qh_distplane(qh, point, facet, &dist);
+          if (dist < innerplane) {
+            if (!qh->KEEPinside)
+              SETref_(point)= NULL;
+          }else if (!qh->KEEPcoplanar)
+            SETref_(point)= NULL;
+        }
+        qh_setcompact(qh, facet->coplanarset);
+      }
+    }
+    zzadd_(Zcheckpart, numpart);
+  }
+} /* nearcoplanar */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="nearvertex">-</a>
+
+  qh_nearvertex(qh, facet, point, bestdist )
+    return nearest vertex in facet to point
+
+  returns:
+    vertex and its distance
+
+  notes:
+    if qh.DELAUNAY
+      distance is measured in the input set
+    searches neighboring tricoplanar facets (requires vertexneighbors)
+      Slow implementation.  Recomputes vertex set for each point.
+    The vertex set could be stored in the qh.keepcentrum facet.
+*/
+vertexT *qh_nearvertex(qhT *qh, facetT *facet, pointT *point, realT *bestdistp) {
+  realT bestdist= REALmax, dist;
+  vertexT *bestvertex= NULL, *vertex, **vertexp, *apex;
+  coordT *center;
+  facetT *neighbor, **neighborp;
+  setT *vertices;
+  int dim= qh->hull_dim;
+
+  if (qh->DELAUNAY)
+    dim--;
+  if (facet->tricoplanar) {
+    if (!qh->VERTEXneighbors || !facet->center) {
+      qh_fprintf(qh, qh->ferr, 6158, "qhull internal error (qh_nearvertex): qh.VERTEXneighbors and facet->center required for tricoplanar facets\n");
+      qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+    vertices= qh_settemp(qh, qh->TEMPsize);
+    apex= SETfirstt_(facet->vertices, vertexT);
+    center= facet->center;
+    FOREACHneighbor_(apex) {
+      if (neighbor->center == center) {
+        FOREACHvertex_(neighbor->vertices)
+          qh_setappend(qh, &vertices, vertex);
+      }
+    }
+  }else
+    vertices= facet->vertices;
+  FOREACHvertex_(vertices) {
+    dist= qh_pointdist(vertex->point, point, -dim);
+    if (dist < bestdist) {
+      bestdist= dist;
+      bestvertex= vertex;
+    }
+  }
+  if (facet->tricoplanar)
+    qh_settempfree(qh, &vertices);
+  *bestdistp= sqrt(bestdist);
+  if (!bestvertex) {
+      qh_fprintf(qh, qh->ferr, 6261, "qhull internal error (qh_nearvertex): did not find bestvertex for f%d p%d\n", facet->id, qh_pointid(qh, point));
+      qh_errexit(qh, qh_ERRqhull, facet, NULL);
+  }
+  trace3((qh, qh->ferr, 3019, "qh_nearvertex: v%d dist %2.2g for f%d p%d\n",
+        bestvertex->id, *bestdistp, facet->id, qh_pointid(qh, point))); /* bestvertex!=0 by QH2161 */
+  return bestvertex;
+} /* nearvertex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="newhashtable">-</a>
+
+  qh_newhashtable(qh, newsize )
+    returns size of qh.hash_table of at least newsize slots
+
+  notes:
+    assumes qh.hash_table is NULL
+    qh_HASHfactor determines the number of extra slots
+    size is not divisible by 2, 3, or 5
+*/
+int qh_newhashtable(qhT *qh, int newsize) {
+  int size;
+
+  size= ((newsize+1)*qh_HASHfactor) | 0x1;  /* odd number */
+  while (True) {
+    if (newsize<0 || size<0) {
+        qh_fprintf(qh, qh->qhmem.ferr, 6236, "qhull error (qh_newhashtable): negative request (%d) or size (%d).  Did int overflow due to high-D?\n", newsize, size); /* WARN64 */
+        qh_errexit(qh, qhmem_ERRmem, NULL, NULL);
+    }
+    if ((size%3) && (size%5))
+      break;
+    size += 2;
+    /* loop terminates because there is an infinite number of primes */
+  }
+  qh->hash_table= qh_setnew(qh, size);
+  qh_setzero(qh, qh->hash_table, 0, size);
+  return size;
+} /* newhashtable */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="newvertex">-</a>
+
+  qh_newvertex(qh, point )
+    returns a new vertex for point
+*/
+vertexT *qh_newvertex(qhT *qh, pointT *point) {
+  vertexT *vertex;
+
+  zinc_(Ztotvertices);
+  vertex= (vertexT *)qh_memalloc(qh, (int)sizeof(vertexT));
+  memset((char *) vertex, (size_t)0, sizeof(vertexT));
+  if (qh->vertex_id == UINT_MAX) {
+    qh_memfree(qh, vertex, (int)sizeof(vertexT));
+    qh_fprintf(qh, qh->ferr, 6159, "qhull error: 2^32 or more vertices.  vertexT.id field overflows.  Vertices would not be sorted correctly.\n");
+    qh_errexit(qh, qh_ERRother, NULL, NULL);
+  }
+  if (qh->vertex_id == qh->tracevertex_id)
+    qh->tracevertex= vertex;
+  vertex->id= qh->vertex_id++;
+  vertex->point= point;
+  trace4((qh, qh->ferr, 4060, "qh_newvertex: vertex p%d(v%d) created\n", qh_pointid(qh, vertex->point),
+          vertex->id));
+  return(vertex);
+} /* newvertex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="nextfacet2d">-</a>
+
+  qh_nextfacet2d( facet, &nextvertex )
+    return next facet and vertex for a 2d facet in qh_ORIENTclock order
+    returns NULL on error
+
+  notes:
+    in qh_ORIENTclock order (default counter-clockwise)
+    nextvertex is in between the two facets
+    does not use qhT or qh_errexit [QhullFacet.cpp]
+
+  design:
+    see io_r.c/qh_printextremes_2d
+*/
+facetT *qh_nextfacet2d(facetT *facet, vertexT **nextvertexp) {
+  facetT *nextfacet;
+
+  if (facet->toporient ^ qh_ORIENTclock) {
+    *nextvertexp= SETfirstt_(facet->vertices, vertexT);
+    nextfacet= SETfirstt_(facet->neighbors, facetT);
+  }else {
+    *nextvertexp= SETsecondt_(facet->vertices, vertexT);
+    nextfacet= SETsecondt_(facet->neighbors, facetT);
+  }
+  return nextfacet;
+} /* nextfacet2d */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="nextridge3d">-</a>
+
+  qh_nextridge3d( atridge, facet, &vertex )
+    return next ridge and vertex for a 3d facet
+    returns NULL on error
+    [for QhullFacet::nextRidge3d] Does not call qh_errexit nor access qhT.
+
+  notes:
+    in qh_ORIENTclock order
+    this is a O(n^2) implementation to trace all ridges
+    be sure to stop on any 2nd visit
+    same as QhullRidge::nextRidge3d
+    does not use qhT or qh_errexit [QhullFacet.cpp]
+
+  design:
+    for each ridge
+      exit if it is the ridge after atridge
+*/
+ridgeT *qh_nextridge3d(ridgeT *atridge, facetT *facet, vertexT **vertexp) {
+  vertexT *atvertex, *vertex, *othervertex;
+  ridgeT *ridge, **ridgep;
+
+  if ((atridge->top == facet) ^ qh_ORIENTclock)
+    atvertex= SETsecondt_(atridge->vertices, vertexT);
+  else
+    atvertex= SETfirstt_(atridge->vertices, vertexT);
+  FOREACHridge_(facet->ridges) {
+    if (ridge == atridge)
+      continue;
+    if ((ridge->top == facet) ^ qh_ORIENTclock) {
+      othervertex= SETsecondt_(ridge->vertices, vertexT);
+      vertex= SETfirstt_(ridge->vertices, vertexT);
+    }else {
+      vertex= SETsecondt_(ridge->vertices, vertexT);
+      othervertex= SETfirstt_(ridge->vertices, vertexT);
+    }
+    if (vertex == atvertex) {
+      if (vertexp)
+        *vertexp= othervertex;
+      return ridge;
+    }
+  }
+  return NULL;
+} /* nextridge3d */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="opposite_vertex">-</a>
+
+  qh_opposite_vertex(qh, facetA, neighbor )
+    return the opposite vertex in facetA to neighbor
+
+*/
+vertexT *qh_opposite_vertex(qhT *qh, facetT *facetA,  facetT *neighbor) {
+    vertexT *opposite= NULL;
+    facetT *facet;
+    int facet_i, facet_n;
+
+    if (facetA->simplicial) {
+      FOREACHfacet_i_(qh, facetA->neighbors) {
+        if (facet == neighbor) {
+          opposite= SETelemt_(facetA->vertices, facet_i, vertexT);
+          break;
+        }
+      }
+    }
+    if (!opposite) {
+      qh_fprintf(qh, qh->ferr, 6396, "qhull internal error (qh_opposite_vertex): opposite vertex in facet f%d to neighbor f%d is not defined.  Either is facet is not simplicial or neighbor not found\n",
+        facetA->id, neighbor->id);
+      qh_errexit2(qh, qh_ERRqhull, facetA, neighbor);
+    }
+    return opposite;
+} /* opposite_vertex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="outcoplanar">-</a>
+
+  qh_outcoplanar()
+    move points from all facets' outsidesets to their coplanarsets
+
+  notes:
+    for post-processing under qh.NARROWhull
+
+  design:
+    for each facet
+      for each outside point for facet
+        partition point into coplanar set
+*/
+void qh_outcoplanar(qhT *qh /* facet_list */) {
+  pointT *point, **pointp;
+  facetT *facet;
+  realT dist;
+
+  trace1((qh, qh->ferr, 1033, "qh_outcoplanar: move outsideset to coplanarset for qh->NARROWhull\n"));
+  FORALLfacets {
+    FOREACHpoint_(facet->outsideset) {
+      qh->num_outside--;
+      if (qh->KEEPcoplanar || qh->KEEPnearinside) {
+        qh_distplane(qh, point, facet, &dist);
+        zinc_(Zpartition);
+        qh_partitioncoplanar(qh, point, facet, &dist, qh->findbestnew);
+      }
+    }
+    qh_setfree(qh, &facet->outsideset);
+  }
+} /* outcoplanar */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="point">-</a>
+
+  qh_point(qh, id )
+    return point for a point id, or NULL if unknown
+
+  alternative code:
+    return((pointT *)((unsigned long)qh.first_point
+           + (unsigned long)((id)*qh.normal_size)));
+*/
+pointT *qh_point(qhT *qh, int id) {
+
+  if (id < 0)
+    return NULL;
+  if (id < qh->num_points)
+    return qh->first_point + id * qh->hull_dim;
+  id -= qh->num_points;
+  if (id < qh_setsize(qh, qh->other_points))
+    return SETelemt_(qh->other_points, id, pointT);
+  return NULL;
+} /* point */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="point_add">-</a>
+
+  qh_point_add(qh, set, point, elem )
+    stores elem at set[point.id]
+
+  returns:
+    access function for qh_pointfacet and qh_pointvertex
+
+  notes:
+    checks point.id
+*/
+void qh_point_add(qhT *qh, setT *set, pointT *point, void *elem) {
+  int id, size;
+
+  SETreturnsize_(set, size);
+  if ((id= qh_pointid(qh, point)) < 0)
+    qh_fprintf(qh, qh->ferr, 7067, "qhull internal warning (point_add): unknown point %p id %d\n",
+      point, id);
+  else if (id >= size) {
+    qh_fprintf(qh, qh->ferr, 6160, "qhull internal error (point_add): point p%d is out of bounds(%d)\n",
+             id, size);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }else
+    SETelem_(set, id)= elem;
+} /* point_add */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="pointfacet">-</a>
+
+  qh_pointfacet()
+    return temporary set of facet for each point
+    the set is indexed by point id
+    at most one facet per point, arbitrary selection
+
+  notes:
+    each point is assigned to at most one of vertices, coplanarset, or outsideset
+    unassigned points are interior points or 
+    vertices assigned to one of its facets
+    coplanarset assigned to the facet
+    outside set assigned to the facet
+    NULL if no facet for point (inside)
+      includes qh.GOODpointp
+
+  access:
+    FOREACHfacet_i_(qh, facets) { ... }
+    SETelem_(facets, i)
+
+  design:
+    for each facet
+      add each vertex
+      add each coplanar point
+      add each outside point
+*/
+setT *qh_pointfacet(qhT *qh /* qh.facet_list */) {
+  int numpoints= qh->num_points + qh_setsize(qh, qh->other_points);
+  setT *facets;
+  facetT *facet;
+  vertexT *vertex, **vertexp;
+  pointT *point, **pointp;
+
+  facets= qh_settemp(qh, numpoints);
+  qh_setzero(qh, facets, 0, numpoints);
+  qh->vertex_visit++;
+  FORALLfacets {
+    FOREACHvertex_(facet->vertices) {
+      if (vertex->visitid != qh->vertex_visit) {
+        vertex->visitid= qh->vertex_visit;
+        qh_point_add(qh, facets, vertex->point, facet);
+      }
+    }
+    FOREACHpoint_(facet->coplanarset)
+      qh_point_add(qh, facets, point, facet);
+    FOREACHpoint_(facet->outsideset)
+      qh_point_add(qh, facets, point, facet);
+  }
+  return facets;
+} /* pointfacet */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="pointvertex">-</a>
+
+  qh_pointvertex(qh )
+    return temporary set of vertices indexed by point id
+    entry is NULL if no vertex for a point
+      this will include qh.GOODpointp
+
+  access:
+    FOREACHvertex_i_(qh, vertices) { ... }
+    SETelem_(vertices, i)
+*/
+setT *qh_pointvertex(qhT *qh /* qh.facet_list */) {
+  int numpoints= qh->num_points + qh_setsize(qh, qh->other_points);
+  setT *vertices;
+  vertexT *vertex;
+
+  vertices= qh_settemp(qh, numpoints);
+  qh_setzero(qh, vertices, 0, numpoints);
+  FORALLvertices
+    qh_point_add(qh, vertices, vertex->point, vertex);
+  return vertices;
+} /* pointvertex */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="prependfacet">-</a>
+
+  qh_prependfacet(qh, facet, facetlist )
+    prepend facet to the start of a facetlist
+
+  returns:
+    increments qh.numfacets
+    updates facetlist, qh.facet_list, facet_next
+
+  notes:
+    be careful of prepending since it can lose a pointer.
+      e.g., can lose _next by deleting and then prepending before _next
+*/
+void qh_prependfacet(qhT *qh, facetT *facet, facetT **facetlist) {
+  facetT *prevfacet, *list;
+
+  trace4((qh, qh->ferr, 4061, "qh_prependfacet: prepend f%d before f%d\n",
+          facet->id, getid_(*facetlist)));
+  if (!*facetlist)
+    (*facetlist)= qh->facet_tail;
+  list= *facetlist;
+  prevfacet= list->previous;
+  facet->previous= prevfacet;
+  if (prevfacet)
+    prevfacet->next= facet;
+  list->previous= facet;
+  facet->next= *facetlist;
+  if (qh->facet_list == list)  /* this may change *facetlist */
+    qh->facet_list= facet;
+  if (qh->facet_next == list)
+    qh->facet_next= facet;
+  *facetlist= facet;
+  qh->num_facets++;
+} /* prependfacet */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="printhashtable">-</a>
+
+  qh_printhashtable(qh, fp )
+    print hash table to fp
+
+  notes:
+    not in I/O to avoid bringing io_r.c in
+
+  design:
+    for each hash entry
+      if defined
+        if unmatched or will merge (NULL, qh_MERGEridge, qh_DUPLICATEridge)
+          print entry and neighbors
+*/
+void qh_printhashtable(qhT *qh, FILE *fp) {
+  facetT *facet, *neighbor;
+  int id, facet_i, facet_n, neighbor_i= 0, neighbor_n= 0;
+  vertexT *vertex, **vertexp;
+
+  FOREACHfacet_i_(qh, qh->hash_table) {
+    if (facet) {
+      FOREACHneighbor_i_(qh, facet) {
+        if (!neighbor || neighbor == qh_MERGEridge || neighbor == qh_DUPLICATEridge)
+          break;
+      }
+      if (neighbor_i == neighbor_n)
+        continue;
+      qh_fprintf(qh, fp, 9283, "hash %d f%d ", facet_i, facet->id);
+      FOREACHvertex_(facet->vertices)
+        qh_fprintf(qh, fp, 9284, "v%d ", vertex->id);
+      qh_fprintf(qh, fp, 9285, "\n neighbors:");
+      FOREACHneighbor_i_(qh, facet) {
+        if (neighbor == qh_MERGEridge)
+          id= -3;
+        else if (neighbor == qh_DUPLICATEridge)
+          id= -2;
+        else
+          id= getid_(neighbor);
+        qh_fprintf(qh, fp, 9286, " %d", id);
+      }
+      qh_fprintf(qh, fp, 9287, "\n");
+    }
+  }
+} /* printhashtable */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="printlists">-</a>
+
+  qh_printlists(qh)
+    print out facet and vertex lists for debugging (without 'f/v' tags)
+
+  notes:
+    not in I/O to avoid bringing io_r.c in
+*/
+void qh_printlists(qhT *qh) {
+  facetT *facet;
+  vertexT *vertex;
+  int count= 0;
+
+  qh_fprintf(qh, qh->ferr, 3062, "qh_printlists: max_outside %2.2g all facets:", qh->max_outside);
+  FORALLfacets{
+    if (++count % 100 == 0)
+      qh_fprintf(qh, qh->ferr, 8109, "\n     ");
+    qh_fprintf(qh, qh->ferr, 8110, " %d", facet->id);
+  }
+    qh_fprintf(qh, qh->ferr, 8111, "\n  qh.visible_list f%d, newfacet_list f%d, facet_next f%d for qh_addpoint\n  qh.newvertex_list v%d all vertices:",
+      getid_(qh->visible_list), getid_(qh->newfacet_list), getid_(qh->facet_next), getid_(qh->newvertex_list));
+  count= 0;
+  FORALLvertices{
+    if (++count % 100 == 0)
+      qh_fprintf(qh, qh->ferr, 8112, "\n     ");
+    qh_fprintf(qh, qh->ferr, 8113, " %d", vertex->id);
+  }
+  qh_fprintf(qh, qh->ferr, 8114, "\n");
+} /* printlists */
+
+/*-<a                             href="qh-poly.htm#TOC"
+  >-------------------------------</a><a name="addfacetvertex">-</a>
+
+  qh_replacefacetvertex(qh, facet, oldvertex, newvertex )
+    replace oldvertex with newvertex in f.vertices
+    vertices are inverse sorted by vertex->id
+
+  returns:
+    toporient is flipped if an odd parity, position change
+
+  notes:
+    for simplicial facets in qh_rename_adjacentvertex
+    see qh_addfacetvertex
+*/
+void qh_replacefacetvertex(qhT *qh, facetT *facet, vertexT *oldvertex, vertexT *newvertex) {
+  vertexT *vertex;
+  facetT *neighbor;
+  int vertex_i, vertex_n= 0;
+  int old_i= -1, new_i= -1;
+
+  trace3((qh, qh->ferr, 3038, "qh_replacefacetvertex: replace v%d with v%d in f%d\n", oldvertex->id, newvertex->id, facet->id));
+  if (!facet->simplicial) {
+    qh_fprintf(qh, qh->ferr, 6283, "qhull internal error (qh_replacefacetvertex): f%d is not simplicial\n", facet->id);
+    qh_errexit(qh, qh_ERRqhull, facet, NULL);
+  }
+  FOREACHvertex_i_(qh, facet->vertices) {
+    if (new_i == -1 && vertex->id < newvertex->id) {
+      new_i= vertex_i;
+    }else if (vertex->id == newvertex->id) {
+      qh_fprintf(qh, qh->ferr, 6281, "qhull internal error (qh_replacefacetvertex): f%d already contains new v%d\n", facet->id, newvertex->id);
+      qh_errexit(qh, qh_ERRqhull, facet, NULL);
+    }
+    if (vertex->id == oldvertex->id) {
+      old_i= vertex_i;
+    }
+  }
+  if (old_i == -1) {
+    qh_fprintf(qh, qh->ferr, 6282, "qhull internal error (qh_replacefacetvertex): f%d does not contain old v%d\n", facet->id, oldvertex->id);
+    qh_errexit(qh, qh_ERRqhull, facet, NULL);
+  }
+  if (new_i == -1) {
+    new_i= vertex_n;
+  }
+  if (old_i < new_i)
+    new_i--;
+  if ((old_i & 0x1) != (new_i & 0x1))
+    facet->toporient ^= 1;
+  qh_setdelnthsorted(qh, facet->vertices, old_i);
+  qh_setaddnth(qh, &facet->vertices, new_i, newvertex);
+  neighbor= SETelemt_(facet->neighbors, old_i, facetT);
+  qh_setdelnthsorted(qh, facet->neighbors, old_i);
+  qh_setaddnth(qh, &facet->neighbors, new_i, neighbor);
+} /* replacefacetvertex */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="resetlists">-</a>
+
+  qh_resetlists(qh, stats, qh_RESETvisible )
+    reset newvertex_list, newfacet_list, visible_list, NEWfacets, NEWtentative
+    if stats,
+      maintains statistics
+    if resetVisible, 
+      visible_list is restored to facet_list
+      otherwise, f.visible/f.replace is retained
+
+  returns:
+    newvertex_list, newfacet_list, visible_list are NULL
+
+  notes:
+    To delete visible facets, call qh_deletevisible before qh_resetlists
+*/
+void qh_resetlists(qhT *qh, boolT stats, boolT resetVisible /* qh.newvertex_list newfacet_list visible_list */) {
+  vertexT *vertex;
+  facetT *newfacet, *visible;
+  int totnew=0, totver=0;
+
+  trace2((qh, qh->ferr, 2066, "qh_resetlists: reset newvertex_list v%d, newfacet_list f%d, visible_list f%d, facet_list f%d next f%d vertex_list v%d -- NEWfacets? %d, NEWtentative? %d, stats? %d\n",
+    getid_(qh->newvertex_list), getid_(qh->newfacet_list), getid_(qh->visible_list), getid_(qh->facet_list), getid_(qh->facet_next), getid_(qh->vertex_list), qh->NEWfacets, qh->NEWtentative, stats));
+  if (stats) {
+    FORALLvertex_(qh->newvertex_list)
+      totver++;
+    FORALLnew_facets
+      totnew++;
+    zadd_(Zvisvertextot, totver);
+    zmax_(Zvisvertexmax, totver);
+    zadd_(Znewfacettot, totnew);
+    zmax_(Znewfacetmax, totnew);
+  }
+  FORALLvertex_(qh->newvertex_list)
+    vertex->newfacet= False;
+  qh->newvertex_list= NULL;
+  qh->first_newfacet= 0;
+  FORALLnew_facets {
+    newfacet->newfacet= False;
+    newfacet->dupridge= False;
+  }
+  qh->newfacet_list= NULL;
+  if (resetVisible) {
+    FORALLvisible_facets {
+      visible->f.replace= NULL;
+      visible->visible= False;
+    }
+    qh->num_visible= 0;
+  }
+  qh->visible_list= NULL; 
+  qh->NEWfacets= False;
+  qh->NEWtentative= False;
+} /* resetlists */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="setvoronoi_all">-</a>
+
+  qh_setvoronoi_all(qh)
+    compute Voronoi centers for all facets
+    includes upperDelaunay facets if qh.UPPERdelaunay ('Qu')
+
+  returns:
+    facet->center is the Voronoi center
+
+  notes:
+    unused/untested code: please email bradb@shore.net if this works ok for you
+
+  use:
+    FORALLvertices {...} to locate the vertex for a point.
+    FOREACHneighbor_(vertex) {...} to visit the Voronoi centers for a Voronoi cell.
+*/
+void qh_setvoronoi_all(qhT *qh) {
+  facetT *facet;
+
+  qh_clearcenters(qh, qh_ASvoronoi);
+  qh_vertexneighbors(qh);
+
+  FORALLfacets {
+    if (!facet->normal || !facet->upperdelaunay || qh->UPPERdelaunay) {
+      if (!facet->center)
+        facet->center= qh_facetcenter(qh, facet->vertices);
+    }
+  }
+} /* setvoronoi_all */
+
+#ifndef qh_NOmerge
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="triangulate">-</a>
+
+  qh_triangulate()
+    triangulate non-simplicial facets on qh.facet_list,
+    if qh->VORONOI, sets Voronoi centers of non-simplicial facets
+    nop if hasTriangulation
+
+  returns:
+    all facets simplicial
+    each tricoplanar facet has ->f.triowner == owner of ->center,normal,etc.
+    resets qh.newfacet_list and visible_list
+
+  notes:
+    called by qh_prepare_output and user_eg2_r.c
+    call after qh_check_output since may switch to Voronoi centers, and qh_checkconvex skips f.tricoplanar facets
+    Output may overwrite ->f.triowner with ->f.area
+    while running, 'triangulated_facet_list' is a list of
+       one non-simplicial facet followed by its 'f.tricoplanar' triangulated facets
+    See qh_buildcone
+*/
+void qh_triangulate(qhT *qh /* qh.facet_list */) {
+  facetT *facet, *nextfacet, *owner;
+  facetT *neighbor, *visible= NULL, *facet1, *facet2, *triangulated_facet_list= NULL;
+  facetT *orig_neighbor= NULL, *otherfacet;
+  vertexT *triangulated_vertex_list= NULL;
+  mergeT *merge;
+  mergeType mergetype;
+  int neighbor_i, neighbor_n;
+  boolT onlygood= qh->ONLYgood;
+
+  if (qh->hasTriangulation)
+      return;
+  trace1((qh, qh->ferr, 1034, "qh_triangulate: triangulate non-simplicial facets\n"));
+  if (qh->hull_dim == 2)
+    return;
+  if (qh->VORONOI) {  /* otherwise lose Voronoi centers [could rebuild vertex set from tricoplanar] */
+    qh_clearcenters(qh, qh_ASvoronoi);
+    qh_vertexneighbors(qh);
+  }
+  qh->ONLYgood= False; /* for makenew_nonsimplicial */
+  qh->visit_id++;
+  qh_initmergesets(qh /* qh.facet_mergeset,degen_mergeset,vertex_mergeset */);
+  qh->newvertex_list= qh->vertex_tail;
+  for (facet=qh->facet_list; facet && facet->next; facet= nextfacet) { /* non-simplicial facets moved to end */
+    nextfacet= facet->next;
+    if (facet->visible || facet->simplicial)
+      continue;
+    /* triangulate all non-simplicial facets, otherwise merging does not work, e.g., RBOX c P-0.1 P+0.1 P+0.1 D3 | QHULL d Qt Tv */
+    if (!triangulated_facet_list)
+      triangulated_facet_list= facet;  /* will be first triangulated facet */
+    qh_triangulate_facet(qh, facet, &triangulated_vertex_list); /* qh_resetlists ! */
+  }
+  /* qh_checkpolygon invalid due to f.visible without qh.visible_list */
+  trace2((qh, qh->ferr, 2047, "qh_triangulate: delete null facets from facetlist f%d.  A null facet has the same first (apex) and second vertices\n", getid_(triangulated_facet_list)));
+  for (facet=triangulated_facet_list; facet && facet->next; facet= nextfacet) {
+    nextfacet= facet->next;
+    if (facet->visible)
+      continue;
+    if (facet->ridges) {
+      if (qh_setsize(qh, facet->ridges) > 0) {
+        qh_fprintf(qh, qh->ferr, 6161, "qhull internal error (qh_triangulate): ridges still defined for f%d\n", facet->id);
+        qh_errexit(qh, qh_ERRqhull, facet, NULL);
+      }
+      qh_setfree(qh, &facet->ridges);
+    }
+    if (SETfirst_(facet->vertices) == SETsecond_(facet->vertices)) {
+      zinc_(Ztrinull);
+      qh_triangulate_null(qh, facet); /* will delete facet */
+    }
+  }
+  trace2((qh, qh->ferr, 2048, "qh_triangulate: delete %d or more mirrored facets.  Mirrored facets have the same vertices due to a null facet\n", qh_setsize(qh, qh->degen_mergeset)));
+  qh->visible_list= qh->facet_tail;
+  while ((merge= (mergeT *)qh_setdellast(qh->degen_mergeset))) {
+    facet1= merge->facet1;
+    facet2= merge->facet2;
+    mergetype= merge->mergetype;
+    qh_memfree(qh, merge, (int)sizeof(mergeT));
+    if (mergetype == MRGmirror) {
+      zinc_(Ztrimirror);
+      qh_triangulate_mirror(qh, facet1, facet2);  /* will delete both facets */
+    }
+  }
+  qh_freemergesets(qh);
+  trace2((qh, qh->ferr, 2049, "qh_triangulate: update neighbor lists for vertices from v%d\n", getid_(triangulated_vertex_list)));
+  qh->newvertex_list= triangulated_vertex_list;  /* all vertices of triangulated facets */
+  qh->visible_list= NULL;
+  qh_update_vertexneighbors(qh /* qh.newvertex_list, empty newfacet_list and visible_list */);
+  qh_resetlists(qh, False, !qh_RESETvisible /* qh.newvertex_list, empty newfacet_list and visible_list */);
+
+  trace2((qh, qh->ferr, 2050, "qh_triangulate: identify degenerate tricoplanar facets from f%d\n", getid_(triangulated_facet_list)));
+  trace2((qh, qh->ferr, 2051, "qh_triangulate: and replace facet->f.triowner with tricoplanar facets that own center, normal, etc.\n"));
+  FORALLfacet_(triangulated_facet_list) {
+    if (facet->tricoplanar && !facet->visible) {
+      FOREACHneighbor_i_(qh, facet) {
+        if (neighbor_i == 0) {  /* first iteration */
+          if (neighbor->tricoplanar)
+            orig_neighbor= neighbor->f.triowner;
+          else
+            orig_neighbor= neighbor;
+        }else {
+          if (neighbor->tricoplanar)
+            otherfacet= neighbor->f.triowner;
+          else
+            otherfacet= neighbor;
+          if (orig_neighbor == otherfacet) {
+            zinc_(Ztridegen);
+            facet->degenerate= True;
+            break;
+          }
+        }
+      }
+    }
+  }
+  if (qh->IStracing >= 4)
+    qh_printlists(qh);
+  trace2((qh, qh->ferr, 2052, "qh_triangulate: delete visible facets -- non-simplicial, null, and mirrored facets\n"));
+  owner= NULL;
+  visible= NULL;
+  for (facet=triangulated_facet_list; facet && facet->next; facet= nextfacet) { 
+    /* deleting facets, triangulated_facet_list is no longer valid */
+    nextfacet= facet->next;
+    if (facet->visible) {
+      if (facet->tricoplanar) { /* a null or mirrored facet */
+        qh_delfacet(qh, facet);
+        qh->num_visible--;
+      }else {  /* a non-simplicial facet followed by its tricoplanars */
+        if (visible && !owner) {
+          /*  RBOX 200 s D5 t1001471447 | QHULL Qt C-0.01 Qx Qc Tv Qt -- f4483 had 6 vertices/neighbors and 8 ridges */
+          trace2((qh, qh->ferr, 2053, "qh_triangulate: delete f%d.  All tricoplanar facets degenerate for non-simplicial facet\n",
+                       visible->id));
+          qh_delfacet(qh, visible);
+          qh->num_visible--;
+        }
+        visible= facet;
+        owner= NULL;
+      }
+    }else if (facet->tricoplanar) {
+      if (facet->f.triowner != visible || visible==NULL) {
+        qh_fprintf(qh, qh->ferr, 6162, "qhull internal error (qh_triangulate): tricoplanar facet f%d not owned by its visible, non-simplicial facet f%d\n", facet->id, getid_(visible));
+        qh_errexit2(qh, qh_ERRqhull, facet, visible);
+      }
+      if (owner)
+        facet->f.triowner= owner;
+      else if (!facet->degenerate) {
+        owner= facet;
+        nextfacet= visible->next; /* rescan tricoplanar facets with owner, visible!=0 by QH6162 */
+        facet->keepcentrum= True;  /* one facet owns ->normal, etc. */
+        facet->coplanarset= visible->coplanarset;
+        facet->outsideset= visible->outsideset;
+        visible->coplanarset= NULL;
+        visible->outsideset= NULL;
+        if (!qh->TRInormals) { /* center and normal copied to tricoplanar facets */
+          visible->center= NULL;
+          visible->normal= NULL;
+        }
+        qh_delfacet(qh, visible);
+        qh->num_visible--;
+      }
+    }
+    facet->degenerate= False; /* reset f.degenerate set by qh_triangulate*/
+  }
+  if (visible && !owner) {
+    trace2((qh, qh->ferr, 2054, "qh_triangulate: all tricoplanar facets degenerate for last non-simplicial facet f%d\n",
+                 visible->id));
+    qh_delfacet(qh, visible);
+    qh->num_visible--;
+  }
+  qh->ONLYgood= onlygood; /* restore value */
+  if (qh->CHECKfrequently)
+    qh_checkpolygon(qh, qh->facet_list);
+  qh->hasTriangulation= True;
+} /* triangulate */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="triangulate_facet">-</a>
+
+  qh_triangulate_facet(qh, facetA, &firstVertex )
+    triangulate a non-simplicial facet
+      if qh.CENTERtype=qh_ASvoronoi, sets its Voronoi center
+  returns:
+    qh.newfacet_list == simplicial facets
+      facet->tricoplanar set and ->keepcentrum false
+      facet->degenerate set if duplicated apex
+      facet->f.trivisible set to facetA
+      facet->center copied from facetA (created if qh_ASvoronoi)
+        qh_eachvoronoi, qh_detvridge, qh_detvridge3 assume centers copied
+      facet->normal,offset,maxoutside copied from facetA
+
+  notes:
+      only called by qh_triangulate
+      qh_makenew_nonsimplicial uses neighbor->seen for the same
+      if qh.TRInormals, newfacet->normal will need qh_free
+        if qh.TRInormals and qh_AScentrum, newfacet->center will need qh_free
+        keepcentrum is also set on Zwidefacet in qh_mergefacet
+        freed by qh_clearcenters
+
+  see also:
+      qh_addpoint() -- add a point
+      qh_makenewfacets() -- construct a cone of facets for a new vertex
+
+  design:
+      if qh_ASvoronoi,
+         compute Voronoi center (facet->center)
+      select first vertex (highest ID to preserve ID ordering of ->vertices)
+      triangulate from vertex to ridges
+      copy facet->center, normal, offset
+      update vertex neighbors
+*/
+void qh_triangulate_facet(qhT *qh, facetT *facetA, vertexT **first_vertex) {
+  facetT *newfacet;
+  facetT *neighbor, **neighborp;
+  vertexT *apex;
+  int numnew=0;
+
+  trace3((qh, qh->ferr, 3020, "qh_triangulate_facet: triangulate facet f%d\n", facetA->id));
+
+  qh->first_newfacet= qh->facet_id;
+  if (qh->IStracing >= 4)
+    qh_printfacet(qh, qh->ferr, facetA);
+  FOREACHneighbor_(facetA) {
+    neighbor->seen= False;
+    neighbor->coplanarhorizon= False;
+  }
+  if (qh->CENTERtype == qh_ASvoronoi && !facetA->center  /* matches upperdelaunay in qh_setfacetplane() */
+  && fabs_(facetA->normal[qh->hull_dim -1]) >= qh->ANGLEround * qh_ZEROdelaunay) {
+    facetA->center= qh_facetcenter(qh, facetA->vertices);
+  }
+  qh->visible_list= qh->newfacet_list= qh->facet_tail;
+  facetA->visitid= qh->visit_id;
+  apex= SETfirstt_(facetA->vertices, vertexT);
+  qh_makenew_nonsimplicial(qh, facetA, apex, &numnew);
+  qh_willdelete(qh, facetA, NULL);
+  FORALLnew_facets {
+    newfacet->tricoplanar= True;
+    newfacet->f.trivisible= facetA;
+    newfacet->degenerate= False;
+    newfacet->upperdelaunay= facetA->upperdelaunay;
+    newfacet->good= facetA->good;
+    if (qh->TRInormals) { /* 'Q11' triangulate duplicates ->normal and ->center */
+      newfacet->keepcentrum= True;
+      if(facetA->normal){
+        newfacet->normal= (double *)qh_memalloc(qh, qh->normal_size);
+        memcpy((char *)newfacet->normal, facetA->normal, (size_t)qh->normal_size);
+      }
+      if (qh->CENTERtype == qh_AScentrum)
+        newfacet->center= qh_getcentrum(qh, newfacet);
+      else if (qh->CENTERtype == qh_ASvoronoi && facetA->center){
+        newfacet->center= (double *)qh_memalloc(qh, qh->center_size);
+        memcpy((char *)newfacet->center, facetA->center, (size_t)qh->center_size);
+      }
+    }else {
+      newfacet->keepcentrum= False;
+      /* one facet will have keepcentrum=True at end of qh_triangulate */
+      newfacet->normal= facetA->normal;
+      newfacet->center= facetA->center;
+    }
+    newfacet->offset= facetA->offset;
+#if qh_MAXoutside
+    newfacet->maxoutside= facetA->maxoutside;
+#endif
+  }
+  qh_matchnewfacets(qh /* qh.newfacet_list */); /* ignore returned value, maxdupdist */ 
+  zinc_(Ztricoplanar);
+  zadd_(Ztricoplanartot, numnew);
+  zmax_(Ztricoplanarmax, numnew);
+  if (!(*first_vertex))
+    (*first_vertex)= qh->newvertex_list;
+  qh->newvertex_list= NULL;
+  qh->visible_list= NULL;
+  /* only update v.neighbors for qh.newfacet_list.  qh.visible_list and qh.newvertex_list are NULL */
+  qh_update_vertexneighbors(qh /* qh.newfacet_list */);
+  qh_resetlists(qh, False, !qh_RESETvisible /* qh.newfacet_list */);
+} /* triangulate_facet */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="triangulate_link">-</a>
+
+  qh_triangulate_link(qh, oldfacetA, facetA, oldfacetB, facetB)
+    relink facetA to facetB via null oldfacetA or mirrored oldfacetA and oldfacetB
+  returns:
+    if neighbors are already linked, will merge as MRGmirror (qh.degen_mergeset, 4-d and up)
+*/
+void qh_triangulate_link(qhT *qh, facetT *oldfacetA, facetT *facetA, facetT *oldfacetB, facetT *facetB) {
+  int errmirror= False;
+
+  if (oldfacetA == oldfacetB) {
+    trace3((qh, qh->ferr, 3052, "qh_triangulate_link: relink neighbors f%d and f%d of null facet f%d\n",
+      facetA->id, facetB->id, oldfacetA->id));
+  }else {
+    trace3((qh, qh->ferr, 3021, "qh_triangulate_link: relink neighbors f%d and f%d of mirrored facets f%d and f%d\n",
+      facetA->id, facetB->id, oldfacetA->id, oldfacetB->id));
+  }
+  if (qh_setin(facetA->neighbors, facetB)) {
+    if (!qh_setin(facetB->neighbors, facetA))
+      errmirror= True;
+    else if (!facetA->redundant || !facetB->redundant || !qh_hasmerge(qh->degen_mergeset, MRGmirror, facetA, facetB))
+      qh_appendmergeset(qh, facetA, facetB, MRGmirror, 0.0, 1.0);
+  }else if (qh_setin(facetB->neighbors, facetA))
+    errmirror= True;
+  if (errmirror) {
+    qh_fprintf(qh, qh->ferr, 6163, "qhull internal error (qh_triangulate_link): neighbors f%d and f%d do not match for null facet or mirrored facets f%d and f%d\n",
+       facetA->id, facetB->id, oldfacetA->id, oldfacetB->id);
+    qh_errexit2(qh, qh_ERRqhull, facetA, facetB);
+  }
+  qh_setreplace(qh, facetB->neighbors, oldfacetB, facetA);
+  qh_setreplace(qh, facetA->neighbors, oldfacetA, facetB);
+} /* triangulate_link */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="triangulate_mirror">-</a>
+
+  qh_triangulate_mirror(qh, facetA, facetB)
+    delete two mirrored facets identified by qh_triangulate_null() and itself
+      a mirrored facet shares the same vertices of a logical ridge
+  design:
+    since a null facet duplicates the first two vertices, the opposing neighbors absorb the null facet
+    if they are already neighbors, the opposing neighbors become MRGmirror facets
+*/
+void qh_triangulate_mirror(qhT *qh, facetT *facetA, facetT *facetB) {
+  facetT *neighbor, *neighborB;
+  int neighbor_i, neighbor_n;
+
+  trace3((qh, qh->ferr, 3022, "qh_triangulate_mirror: delete mirrored facets f%d and f%d and link their neighbors\n",
+         facetA->id, facetB->id));
+  FOREACHneighbor_i_(qh, facetA) {
+    neighborB= SETelemt_(facetB->neighbors, neighbor_i, facetT);
+    if (neighbor == facetB && neighborB == facetA)
+      continue; /* occurs twice */
+    else if (neighbor->redundant && neighborB->redundant) { /* also mirrored facets (D5+) */
+      if (qh_hasmerge(qh->degen_mergeset, MRGmirror, neighbor, neighborB))
+        continue;
+    }
+    if (neighbor->visible && neighborB->visible) /* previously deleted as mirrored facets */
+      continue;
+    qh_triangulate_link(qh, facetA, neighbor, facetB, neighborB);
+  }
+  qh_willdelete(qh, facetA, NULL);
+  qh_willdelete(qh, facetB, NULL);
+} /* triangulate_mirror */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="triangulate_null">-</a>
+
+  qh_triangulate_null(qh, facetA)
+    remove null facetA from qh_triangulate_facet()
+      a null facet has vertex #1 (apex) == vertex #2
+  returns:
+    adds facetA to ->visible for deletion after qh_update_vertexneighbors
+    qh->degen_mergeset contains mirror facets (4-d and up only)
+  design:
+    since a null facet duplicates the first two vertices, the opposing neighbors absorb the null facet
+    if they are already neighbors, the opposing neighbors will be merged (MRGmirror)
+*/
+void qh_triangulate_null(qhT *qh, facetT *facetA) {
+  facetT *neighbor, *otherfacet;
+
+  trace3((qh, qh->ferr, 3023, "qh_triangulate_null: delete null facet f%d\n", facetA->id));
+  neighbor= SETfirstt_(facetA->neighbors, facetT);
+  otherfacet= SETsecondt_(facetA->neighbors, facetT);
+  qh_triangulate_link(qh, facetA, neighbor, facetA, otherfacet);
+  qh_willdelete(qh, facetA, NULL);
+} /* triangulate_null */
+
+#else /* qh_NOmerge */
+void qh_triangulate(qhT *qh) {
+  QHULL_UNUSED(qh)
+}
+#endif /* qh_NOmerge */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="vertexintersect">-</a>
+
+  qh_vertexintersect(qh, verticesA, verticesB )
+    intersects two vertex sets (inverse id ordered)
+    vertexsetA is a temporary set at the top of qh->qhmem.tempstack
+
+  returns:
+    replaces vertexsetA with the intersection
+
+  notes:
+    only called by qh_neighbor_intersections
+    if !qh.QHULLfinished, non-simplicial facets may have f.vertices with extraneous vertices
+      cleaned by qh_remove_extravertices in qh_reduce_vertices
+    could optimize by overwriting vertexsetA
+*/
+void qh_vertexintersect(qhT *qh, setT **vertexsetA, setT *vertexsetB) {
+  setT *intersection;
+
+  intersection= qh_vertexintersect_new(qh, *vertexsetA, vertexsetB);
+  qh_settempfree(qh, vertexsetA);
+  *vertexsetA= intersection;
+  qh_settemppush(qh, intersection);
+} /* vertexintersect */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="vertexintersect_new">-</a>
+
+  qh_vertexintersect_new(qh, verticesA, verticesB )
+    intersects two vertex sets (inverse id ordered)
+
+  returns:
+    a new set
+
+  notes:
+    called by qh_checkfacet, qh_vertexintersect, qh_rename_sharedvertex, qh_findbest_pinchedvertex, qh_neighbor_intersections
+    if !qh.QHULLfinished, non-simplicial facets may have f.vertices with extraneous vertices
+       cleaned by qh_remove_extravertices in qh_reduce_vertices
+*/
+setT *qh_vertexintersect_new(qhT *qh, setT *vertexsetA, setT *vertexsetB) {
+  setT *intersection= qh_setnew(qh, qh->hull_dim - 1);
+  vertexT **vertexA= SETaddr_(vertexsetA, vertexT);
+  vertexT **vertexB= SETaddr_(vertexsetB, vertexT);
+
+  while (*vertexA && *vertexB) {
+    if (*vertexA  == *vertexB) {
+      qh_setappend(qh, &intersection, *vertexA);
+      vertexA++; vertexB++;
+    }else {
+      if ((*vertexA)->id > (*vertexB)->id)
+        vertexA++;
+      else
+        vertexB++;
+    }
+  }
+  return intersection;
+} /* vertexintersect_new */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="vertexneighbors">-</a>
+
+  qh_vertexneighbors(qh)
+    for each vertex in qh.facet_list,
+      determine its neighboring facets
+
+  returns:
+    sets qh.VERTEXneighbors
+      nop if qh.VERTEXneighbors already set
+      qh_addpoint() will maintain them
+
+  notes:
+    assumes all vertex->neighbors are NULL
+
+  design:
+    for each facet
+      for each vertex
+        append facet to vertex->neighbors
+*/
+void qh_vertexneighbors(qhT *qh /* qh.facet_list */) {
+  facetT *facet;
+  vertexT *vertex, **vertexp;
+
+  if (qh->VERTEXneighbors)
+    return;
+  trace1((qh, qh->ferr, 1035, "qh_vertexneighbors: determining neighboring facets for each vertex\n"));
+  qh->vertex_visit++;
+  FORALLfacets {
+    if (facet->visible)
+      continue;
+    FOREACHvertex_(facet->vertices) {
+      if (vertex->visitid != qh->vertex_visit) {
+        vertex->visitid= qh->vertex_visit;
+        vertex->neighbors= qh_setnew(qh, qh->hull_dim);
+      }
+      qh_setappend(qh, &vertex->neighbors, facet);
+    }
+  }
+  qh->VERTEXneighbors= True;
+} /* vertexneighbors */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="vertexsubset">-</a>
+
+  qh_vertexsubset( vertexsetA, vertexsetB )
+    returns True if vertexsetA is a subset of vertexsetB
+    assumes vertexsets are sorted
+
+  note:
+    empty set is a subset of any other set
+*/
+boolT qh_vertexsubset(setT *vertexsetA, setT *vertexsetB) {
+  vertexT **vertexA= (vertexT **) SETaddr_(vertexsetA, vertexT);
+  vertexT **vertexB= (vertexT **) SETaddr_(vertexsetB, vertexT);
+
+  while (True) {
+    if (!*vertexA)
+      return True;
+    if (!*vertexB)
+      return False;
+    if ((*vertexA)->id > (*vertexB)->id)
+      return False;
+    if (*vertexA  == *vertexB)
+      vertexA++;
+    vertexB++;
+  }
+  return False; /* avoid warnings */
+} /* vertexsubset */
diff --git a/contrib/libs/qhull/libqhull_r/poly_r.c b/contrib/libs/qhull/libqhull_r/poly_r.c
new file mode 100644
index 0000000000..d6a5e7a3d8
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/poly_r.c
@@ -0,0 +1,1448 @@
+/*<html><pre>  -<a                             href="qh-poly_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   poly_r.c
+   implements polygons and simplices
+
+   see qh-poly_r.htm, poly_r.h and libqhull_r.h
+
+   infrequent code is in poly2_r.c
+   (all but top 50 and their callers 12/3/95)
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/poly_r.c#8 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#include "qhull_ra.h"
+
+/*======== functions in alphabetical order ==========*/
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="appendfacet">-</a>
+
+  qh_appendfacet(qh, facet )
+    appends facet to end of qh.facet_list,
+
+  returns:
+    updates qh.newfacet_list, facet_next, facet_list
+    increments qh.numfacets
+
+  notes:
+    assumes qh.facet_list/facet_tail is defined (createsimplex)
+
+  see:
+    qh_removefacet()
+
+*/
+void qh_appendfacet(qhT *qh, facetT *facet) {
+  facetT *tail= qh->facet_tail;
+
+  if (tail == qh->newfacet_list) {
+    qh->newfacet_list= facet;
+    if (tail == qh->visible_list) /* visible_list is at or before newfacet_list */
+      qh->visible_list= facet;
+  }
+  if (tail == qh->facet_next)
+    qh->facet_next= facet;
+  facet->previous= tail->previous;
+  facet->next= tail;
+  if (tail->previous)
+    tail->previous->next= facet;
+  else
+    qh->facet_list= facet;
+  tail->previous= facet;
+  qh->num_facets++;
+  trace4((qh, qh->ferr, 4044, "qh_appendfacet: append f%d to facet_list\n", facet->id));
+} /* appendfacet */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="appendvertex">-</a>
+
+  qh_appendvertex(qh, vertex )
+    appends vertex to end of qh.vertex_list,
+
+  returns:
+    sets vertex->newfacet
+    updates qh.vertex_list, newvertex_list
+    increments qh.num_vertices
+
+  notes:
+    assumes qh.vertex_list/vertex_tail is defined (createsimplex)
+
+*/
+void qh_appendvertex(qhT *qh, vertexT *vertex) {
+  vertexT *tail= qh->vertex_tail;
+
+  if (tail == qh->newvertex_list)
+    qh->newvertex_list= vertex;
+  vertex->newfacet= True;
+  vertex->previous= tail->previous;
+  vertex->next= tail;
+  if (tail->previous)
+    tail->previous->next= vertex;
+  else
+    qh->vertex_list= vertex;
+  tail->previous= vertex;
+  qh->num_vertices++;
+  trace4((qh, qh->ferr, 4045, "qh_appendvertex: append v%d to qh.newvertex_list and set v.newfacet\n", vertex->id));
+} /* appendvertex */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="attachnewfacets">-</a>
+
+  qh_attachnewfacets(qh)
+    attach horizon facets to new facets in qh.newfacet_list
+    newfacets have neighbor and ridge links to horizon but not vice versa
+
+  returns:
+    clears qh.NEWtentative
+    set qh.NEWfacets
+    horizon facets linked to new facets
+      ridges changed from visible facets to new facets
+      simplicial ridges deleted
+    qh.visible_list, no ridges valid
+    facet->f.replace is a newfacet (if any)
+
+  notes:
+    used for qh.NEWtentative, otherwise see qh_makenew_nonsimplicial and qh_makenew_simplicial
+    qh_delridge_merge not needed (as tested by qh_checkdelridge)
+
+  design:
+    delete interior ridges and neighbor sets by
+      for each visible, non-simplicial facet
+        for each ridge
+          if last visit or if neighbor is simplicial
+            if horizon neighbor
+              delete ridge for horizon's ridge set
+            delete ridge
+        erase neighbor set
+    attach horizon facets and new facets by
+      for all new facets
+        if corresponding horizon facet is simplicial
+          locate corresponding visible facet {may be more than one}
+          link visible facet to new facet
+          replace visible facet with new facet in horizon
+        else it is non-simplicial
+          for all visible neighbors of the horizon facet
+            link visible neighbor to new facet
+            delete visible neighbor from horizon facet
+          append new facet to horizon's neighbors
+          the first ridge of the new facet is the horizon ridge
+          link the new facet into the horizon ridge
+*/
+void qh_attachnewfacets(qhT *qh /* qh.visible_list, qh.newfacet_list */) {
+  facetT *newfacet= NULL, *neighbor, **neighborp, *horizon, *visible;
+  ridgeT *ridge, **ridgep;
+
+  trace3((qh, qh->ferr, 3012, "qh_attachnewfacets: delete interior ridges\n"));
+  if (qh->CHECKfrequently) {
+    qh_checkdelridge(qh);
+  }
+  qh->visit_id++;
+  FORALLvisible_facets {
+    visible->visitid= qh->visit_id;
+    if (visible->ridges) {
+      FOREACHridge_(visible->ridges) {
+        neighbor= otherfacet_(ridge, visible);
+        if (neighbor->visitid == qh->visit_id
+            || (!neighbor->visible && neighbor->simplicial)) {
+          if (!neighbor->visible)  /* delete ridge for simplicial horizon */
+            qh_setdel(neighbor->ridges, ridge);
+          qh_delridge(qh, ridge); /* delete on second visit */
+        }
+      }
+    }
+  }
+  trace1((qh, qh->ferr, 1017, "qh_attachnewfacets: attach horizon facets to new facets\n"));
+  FORALLnew_facets {
+    horizon= SETfirstt_(newfacet->neighbors, facetT);
+    if (horizon->simplicial) {
+      visible= NULL;
+      FOREACHneighbor_(horizon) {   /* may have more than one horizon ridge */
+        if (neighbor->visible) {
+          if (visible) {
+            if (qh_setequal_skip(newfacet->vertices, 0, horizon->vertices,
+                                  SETindex_(horizon->neighbors, neighbor))) {
+              visible= neighbor;
+              break;
+            }
+          }else
+            visible= neighbor;
+        }
+      }
+      if (visible) {
+        visible->f.replace= newfacet;
+        qh_setreplace(qh, horizon->neighbors, visible, newfacet);
+      }else {
+        qh_fprintf(qh, qh->ferr, 6102, "qhull internal error (qh_attachnewfacets): could not find visible facet for horizon f%d of newfacet f%d\n",
+                 horizon->id, newfacet->id);
+        qh_errexit2(qh, qh_ERRqhull, horizon, newfacet);
+      }
+    }else { /* non-simplicial, with a ridge for newfacet */
+      FOREACHneighbor_(horizon) {    /* may hold for many new facets */
+        if (neighbor->visible) {
+          neighbor->f.replace= newfacet;
+          qh_setdelnth(qh, horizon->neighbors, SETindex_(horizon->neighbors, neighbor));
+          neighborp--; /* repeat */
+        }
+      }
+      qh_setappend(qh, &horizon->neighbors, newfacet);
+      ridge= SETfirstt_(newfacet->ridges, ridgeT);
+      if (ridge->top == horizon) {
+        ridge->bottom= newfacet;
+        ridge->simplicialbot= True;
+      }else {
+        ridge->top= newfacet;
+        ridge->simplicialtop= True;
+      }
+    }
+  } /* newfacets */
+  trace4((qh, qh->ferr, 4094, "qh_attachnewfacets: clear f.ridges and f.neighbors for visible facets, may become invalid before qh_deletevisible\n"));
+  FORALLvisible_facets {
+    if (visible->ridges)
+      SETfirst_(visible->ridges)= NULL; 
+    SETfirst_(visible->neighbors)= NULL;
+  }
+  qh->NEWtentative= False;
+  qh->NEWfacets= True;
+  if (qh->PRINTstatistics) {
+    FORALLvisible_facets {
+      if (!visible->f.replace)
+        zinc_(Zinsidevisible);
+    }
+  }
+} /* attachnewfacets */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="checkflipped">-</a>
+
+  qh_checkflipped(qh, facet, dist, allerror )
+    checks facet orientation to interior point
+
+    if allerror set,
+      tests against -qh.DISTround
+    else
+      tests against 0.0 since tested against -qh.DISTround before
+
+  returns:
+    False if it flipped orientation (sets facet->flipped)
+    distance if non-NULL
+
+  notes:
+    called by qh_setfacetplane, qh_initialhull, and qh_checkflipped_all
+*/
+boolT qh_checkflipped(qhT *qh, facetT *facet, realT *distp, boolT allerror) {
+  realT dist;
+
+  if (facet->flipped && !distp)
+    return False;
+  zzinc_(Zdistcheck);
+  qh_distplane(qh, qh->interior_point, facet, &dist);
+  if (distp)
+    *distp= dist;
+  if ((allerror && dist >= -qh->DISTround) || (!allerror && dist > 0.0)) {
+    facet->flipped= True;
+    trace0((qh, qh->ferr, 19, "qh_checkflipped: facet f%d flipped, allerror? %d, distance= %6.12g during p%d\n",
+              facet->id, allerror, dist, qh->furthest_id));
+    if (qh->num_facets > qh->hull_dim+1) { /* qh_initialhull reverses orientation if !qh_checkflipped */
+      zzinc_(Zflippedfacets);
+      qh_joggle_restart(qh, "flipped facet");
+    }
+    return False;
+  }
+  return True;
+} /* checkflipped */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="delfacet">-</a>
+
+  qh_delfacet(qh, facet )
+    removes facet from facet_list and frees up its memory
+
+  notes:
+    assumes vertices and ridges already freed or referenced elsewhere
+*/
+void qh_delfacet(qhT *qh, facetT *facet) {
+  void **freelistp; /* used if !qh_NOmem by qh_memfree_() */
+
+  trace3((qh, qh->ferr, 3057, "qh_delfacet: delete f%d\n", facet->id));
+  if (qh->CHECKfrequently || qh->VERIFYoutput) { 
+    if (!qh->NOerrexit) {
+      qh_checkdelfacet(qh, facet, qh->facet_mergeset);
+      qh_checkdelfacet(qh, facet, qh->degen_mergeset);
+      qh_checkdelfacet(qh, facet, qh->vertex_mergeset);
+    }
+  }
+  if (facet == qh->tracefacet)
+    qh->tracefacet= NULL;
+  if (facet == qh->GOODclosest)
+    qh->GOODclosest= NULL;
+  qh_removefacet(qh, facet);
+  if (!facet->tricoplanar || facet->keepcentrum) {
+    qh_memfree_(qh, facet->normal, qh->normal_size, freelistp);
+    if (qh->CENTERtype == qh_ASvoronoi) {   /* braces for macro calls */
+      qh_memfree_(qh, facet->center, qh->center_size, freelistp);
+    }else /* AScentrum */ {
+      qh_memfree_(qh, facet->center, qh->normal_size, freelistp);
+    }
+  }
+  qh_setfree(qh, &(facet->neighbors));
+  if (facet->ridges)
+    qh_setfree(qh, &(facet->ridges));
+  qh_setfree(qh, &(facet->vertices));
+  if (facet->outsideset)
+    qh_setfree(qh, &(facet->outsideset));
+  if (facet->coplanarset)
+    qh_setfree(qh, &(facet->coplanarset));
+  qh_memfree_(qh, facet, (int)sizeof(facetT), freelistp);
+} /* delfacet */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="deletevisible">-</a>
+
+  qh_deletevisible()
+    delete visible facets and vertices
+
+  returns:
+    deletes each facet and removes from facetlist
+    deletes vertices on qh.del_vertices and ridges in qh.del_ridges
+    at exit, qh.visible_list empty (== qh.newfacet_list)
+
+  notes:
+    called by qh_all_vertexmerges, qh_addpoint, and qh_qhull
+    ridges already deleted or moved elsewhere
+    deleted vertices on qh.del_vertices
+    horizon facets do not reference facets on qh.visible_list
+    new facets in qh.newfacet_list
+    uses   qh.visit_id;
+*/
+void qh_deletevisible(qhT *qh /* qh.visible_list */) {
+  facetT *visible, *nextfacet;
+  vertexT *vertex, **vertexp;
+  int numvisible= 0, numdel= qh_setsize(qh, qh->del_vertices);
+
+  trace1((qh, qh->ferr, 1018, "qh_deletevisible: delete %d visible facets and %d vertices\n",
+         qh->num_visible, numdel));
+  for (visible=qh->visible_list; visible && visible->visible;
+                visible= nextfacet) { /* deleting current */
+    nextfacet= visible->next;
+    numvisible++;
+    qh_delfacet(qh, visible);  /* f.ridges deleted or moved elsewhere, deleted f.vertices on qh.del_vertices */
+  }
+  if (numvisible != qh->num_visible) {
+    qh_fprintf(qh, qh->ferr, 6103, "qhull internal error (qh_deletevisible): qh->num_visible %d is not number of visible facets %d\n",
+             qh->num_visible, numvisible);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  qh->num_visible= 0;
+  zadd_(Zvisfacettot, numvisible);
+  zmax_(Zvisfacetmax, numvisible);
+  zzadd_(Zdelvertextot, numdel);
+  zmax_(Zdelvertexmax, numdel);
+  FOREACHvertex_(qh->del_vertices)
+    qh_delvertex(qh, vertex);
+  qh_settruncate(qh, qh->del_vertices, 0);
+} /* deletevisible */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="facetintersect">-</a>
+
+  qh_facetintersect(qh, facetA, facetB, skipa, skipB, prepend )
+    return vertices for intersection of two simplicial facets
+    may include 1 prepended entry (if more, need to settemppush)
+
+  returns:
+    returns set of qh.hull_dim-1 + prepend vertices
+    returns skipped index for each test and checks for exactly one
+
+  notes:
+    does not need settemp since set in quick memory
+
+  see also:
+    qh_vertexintersect and qh_vertexintersect_new
+    use qh_setnew_delnthsorted to get nth ridge (no skip information)
+
+  design:
+    locate skipped vertex by scanning facet A's neighbors
+    locate skipped vertex by scanning facet B's neighbors
+    intersect the vertex sets
+*/
+setT *qh_facetintersect(qhT *qh, facetT *facetA, facetT *facetB,
+                         int *skipA,int *skipB, int prepend) {
+  setT *intersect;
+  int dim= qh->hull_dim, i, j;
+  facetT **neighborsA, **neighborsB;
+
+  neighborsA= SETaddr_(facetA->neighbors, facetT);
+  neighborsB= SETaddr_(facetB->neighbors, facetT);
+  i= j= 0;
+  if (facetB == *neighborsA++)
+    *skipA= 0;
+  else if (facetB == *neighborsA++)
+    *skipA= 1;
+  else if (facetB == *neighborsA++)
+    *skipA= 2;
+  else {
+    for (i=3; i < dim; i++) {
+      if (facetB == *neighborsA++) {
+        *skipA= i;
+        break;
+      }
+    }
+  }
+  if (facetA == *neighborsB++)
+    *skipB= 0;
+  else if (facetA == *neighborsB++)
+    *skipB= 1;
+  else if (facetA == *neighborsB++)
+    *skipB= 2;
+  else {
+    for (j=3; j < dim; j++) {
+      if (facetA == *neighborsB++) {
+        *skipB= j;
+        break;
+      }
+    }
+  }
+  if (i >= dim || j >= dim) {
+    qh_fprintf(qh, qh->ferr, 6104, "qhull internal error (qh_facetintersect): f%d or f%d not in other's neighbors\n",
+            facetA->id, facetB->id);
+    qh_errexit2(qh, qh_ERRqhull, facetA, facetB);
+  }
+  intersect= qh_setnew_delnthsorted(qh, facetA->vertices, qh->hull_dim, *skipA, prepend);
+  trace4((qh, qh->ferr, 4047, "qh_facetintersect: f%d skip %d matches f%d skip %d\n",
+          facetA->id, *skipA, facetB->id, *skipB));
+  return(intersect);
+} /* facetintersect */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="gethash">-</a>
+
+  qh_gethash(qh, hashsize, set, size, firstindex, skipelem )
+    return hashvalue for a set with firstindex and skipelem
+
+  notes:
+    returned hash is in [0,hashsize)
+    assumes at least firstindex+1 elements
+    assumes skipelem is NULL, in set, or part of hash
+
+    hashes memory addresses which may change over different runs of the same data
+    using sum for hash does badly in high d
+*/
+int qh_gethash(qhT *qh, int hashsize, setT *set, int size, int firstindex, void *skipelem) {
+  void **elemp= SETelemaddr_(set, firstindex, void);
+  ptr_intT hash= 0, elem;
+  unsigned int uresult;
+  int i;
+#ifdef _MSC_VER                   /* Microsoft Visual C++ -- warn about 64-bit issues */
+#pragma warning( push)            /* WARN64 -- ptr_intT holds a 64-bit pointer */
+#pragma warning( disable : 4311)  /* 'type cast': pointer truncation from 'void*' to 'ptr_intT' */
+#endif
+
+  switch (size-firstindex) {
+  case 1:
+    hash= (ptr_intT)(*elemp) - (ptr_intT) skipelem;
+    break;
+  case 2:
+    hash= (ptr_intT)(*elemp) + (ptr_intT)elemp[1] - (ptr_intT) skipelem;
+    break;
+  case 3:
+    hash= (ptr_intT)(*elemp) + (ptr_intT)elemp[1] + (ptr_intT)elemp[2]
+      - (ptr_intT) skipelem;
+    break;
+  case 4:
+    hash= (ptr_intT)(*elemp) + (ptr_intT)elemp[1] + (ptr_intT)elemp[2]
+      + (ptr_intT)elemp[3] - (ptr_intT) skipelem;
+    break;
+  case 5:
+    hash= (ptr_intT)(*elemp) + (ptr_intT)elemp[1] + (ptr_intT)elemp[2]
+      + (ptr_intT)elemp[3] + (ptr_intT)elemp[4] - (ptr_intT) skipelem;
+    break;
+  case 6:
+    hash= (ptr_intT)(*elemp) + (ptr_intT)elemp[1] + (ptr_intT)elemp[2]
+      + (ptr_intT)elemp[3] + (ptr_intT)elemp[4]+ (ptr_intT)elemp[5]
+      - (ptr_intT) skipelem;
+    break;
+  default:
+    hash= 0;
+    i= 3;
+    do {     /* this is about 10% in 10-d */
+      if ((elem= (ptr_intT)*elemp++) != (ptr_intT)skipelem) {
+        hash ^= (elem << i) + (elem >> (32-i));
+        i += 3;
+        if (i >= 32)
+          i -= 32;
+      }
+    }while (*elemp);
+    break;
+  }
+  if (hashsize<0) {
+    qh_fprintf(qh, qh->ferr, 6202, "qhull internal error: negative hashsize %d passed to qh_gethash [poly_r.c]\n", hashsize);
+    qh_errexit2(qh, qh_ERRqhull, NULL, NULL);
+  }
+  uresult= (unsigned int)hash;
+  uresult %= (unsigned int)hashsize;
+  /* result= 0; for debugging */
+  return (int)uresult;
+#ifdef _MSC_VER
+#pragma warning( pop)
+#endif
+} /* gethash */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="getreplacement">-</a>
+
+  qh_getreplacement(qh, visible )
+    get replacement for visible facet
+
+  returns:
+    valid facet from visible.replace (may be chained)
+*/
+facetT *qh_getreplacement(qhT *qh, facetT *visible) {
+  unsigned int count= 0;
+
+  facetT *result= visible;
+  while (result && result->visible) {
+    result= result->f.replace;
+    if (count++ > qh->facet_id)
+      qh_infiniteloop(qh, visible);
+  }
+  return result;
+}
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="makenewfacet">-</a>
+
+  qh_makenewfacet(qh, vertices, toporient, horizon )
+    creates a toporient? facet from vertices
+
+  returns:
+    returns newfacet
+      adds newfacet to qh.facet_list
+      newfacet->vertices= vertices
+      if horizon
+        newfacet->neighbor= horizon, but not vice versa
+    newvertex_list updated with vertices
+*/
+facetT *qh_makenewfacet(qhT *qh, setT *vertices, boolT toporient, facetT *horizon) {
+  facetT *newfacet;
+  vertexT *vertex, **vertexp;
+
+  FOREACHvertex_(vertices) {
+    if (!vertex->newfacet) {
+      qh_removevertex(qh, vertex);
+      qh_appendvertex(qh, vertex);
+    }
+  }
+  newfacet= qh_newfacet(qh);
+  newfacet->vertices= vertices;
+  if (toporient)
+    newfacet->toporient= True;
+  if (horizon)
+    qh_setappend(qh, &(newfacet->neighbors), horizon);
+  qh_appendfacet(qh, newfacet);
+  return(newfacet);
+} /* makenewfacet */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="makenewplanes">-</a>
+
+  qh_makenewplanes()
+    make new hyperplanes for facets on qh.newfacet_list
+
+  returns:
+    all facets have hyperplanes or are marked for   merging
+    doesn't create hyperplane if horizon is coplanar (will merge)
+    updates qh.min_vertex if qh.JOGGLEmax
+
+  notes:
+    facet->f.samecycle is defined for facet->mergehorizon facets
+*/
+void qh_makenewplanes(qhT *qh /* qh.newfacet_list */) {
+  facetT *newfacet;
+
+  trace4((qh, qh->ferr, 4074, "qh_makenewplanes: make new hyperplanes for facets on qh.newfacet_list f%d\n",
+    qh->newfacet_list->id));
+  FORALLnew_facets {
+    if (!newfacet->mergehorizon)
+      qh_setfacetplane(qh, newfacet); /* updates Wnewvertexmax */
+  }
+  if (qh->JOGGLEmax < REALmax/2)
+    minimize_(qh->min_vertex, -wwval_(Wnewvertexmax));
+} /* makenewplanes */
+
+#ifndef qh_NOmerge
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="makenew_nonsimplicial">-</a>
+
+  qh_makenew_nonsimplicial(qh, visible, apex, numnew )
+    make new facets for ridges of a visible facet
+
+  returns:
+    first newfacet, bumps numnew as needed
+    attaches new facets if !qh->NEWtentative
+    marks ridge neighbors for simplicial visible
+    if (qh.NEWtentative)
+      ridges on newfacet, horizon, and visible
+    else
+      ridge and neighbors between newfacet and horizon
+      visible facet's ridges are deleted
+      visible facet's f.neighbors is empty
+
+  notes:
+    called by qh_makenewfacets and qh_triangulatefacet
+    qh.visit_id if visible has already been processed
+    sets neighbor->seen for building f.samecycle
+      assumes all 'seen' flags initially false
+    qh_delridge_merge not needed (as tested by qh_checkdelridge in qh_makenewfacets)
+
+  design:
+    for each ridge of visible facet
+      get neighbor of visible facet
+      if neighbor was already processed
+        delete the ridge (will delete all visible facets later)
+      if neighbor is a horizon facet
+        create a new facet
+        if neighbor coplanar
+          adds newfacet to f.samecycle for later merging
+        else
+          updates neighbor's neighbor set
+          (checks for non-simplicial facet with multiple ridges to visible facet)
+        updates neighbor's ridge set
+        (checks for simplicial neighbor to non-simplicial visible facet)
+        (deletes ridge if neighbor is simplicial)
+
+*/
+facetT *qh_makenew_nonsimplicial(qhT *qh, facetT *visible, vertexT *apex, int *numnew) {
+  void **freelistp; /* used if !qh_NOmem by qh_memfree_() */
+  ridgeT *ridge, **ridgep;
+  facetT *neighbor, *newfacet= NULL, *samecycle;
+  setT *vertices;
+  boolT toporient;
+  unsigned int ridgeid;
+
+  FOREACHridge_(visible->ridges) {
+    ridgeid= ridge->id;
+    neighbor= otherfacet_(ridge, visible);
+    if (neighbor->visible) {
+      if (!qh->NEWtentative) {
+        if (neighbor->visitid == qh->visit_id) {
+          if (qh->traceridge == ridge)
+            qh->traceridge= NULL;
+          qh_setfree(qh, &(ridge->vertices));  /* delete on 2nd visit */
+          qh_memfree_(qh, ridge, (int)sizeof(ridgeT), freelistp);
+        }
+      }
+    }else {  /* neighbor is an horizon facet */
+      toporient= (ridge->top == visible);
+      vertices= qh_setnew(qh, qh->hull_dim); /* makes sure this is quick */
+      qh_setappend(qh, &vertices, apex);
+      qh_setappend_set(qh, &vertices, ridge->vertices);
+      newfacet= qh_makenewfacet(qh, vertices, toporient, neighbor);
+      (*numnew)++;
+      if (neighbor->coplanarhorizon) {
+        newfacet->mergehorizon= True;
+        if (!neighbor->seen) {
+          newfacet->f.samecycle= newfacet;
+          neighbor->f.newcycle= newfacet;
+        }else {
+          samecycle= neighbor->f.newcycle;
+          newfacet->f.samecycle= samecycle->f.samecycle;
+          samecycle->f.samecycle= newfacet;
+        }
+      }
+      if (qh->NEWtentative) {
+        if (!neighbor->simplicial)
+          qh_setappend(qh, &(newfacet->ridges), ridge);
+      }else {  /* qh_attachnewfacets */
+        if (neighbor->seen) {
+          if (neighbor->simplicial) {
+            qh_fprintf(qh, qh->ferr, 6105, "qhull internal error (qh_makenew_nonsimplicial): simplicial f%d sharing two ridges with f%d\n",
+                   neighbor->id, visible->id);
+            qh_errexit2(qh, qh_ERRqhull, neighbor, visible);
+          }
+          qh_setappend(qh, &(neighbor->neighbors), newfacet);
+        }else
+          qh_setreplace(qh, neighbor->neighbors, visible, newfacet);
+        if (neighbor->simplicial) {
+          qh_setdel(neighbor->ridges, ridge);
+          qh_delridge(qh, ridge);
+        }else {
+          qh_setappend(qh, &(newfacet->ridges), ridge);
+          if (toporient) {
+            ridge->top= newfacet;
+            ridge->simplicialtop= True;
+          }else {
+            ridge->bottom= newfacet;
+            ridge->simplicialbot= True;
+          }
+        }
+      }
+      trace4((qh, qh->ferr, 4048, "qh_makenew_nonsimplicial: created facet f%d from v%d and r%d of horizon f%d\n",
+          newfacet->id, apex->id, ridgeid, neighbor->id));
+    }
+    neighbor->seen= True;
+  } /* for each ridge */
+  return newfacet;
+} /* makenew_nonsimplicial */
+
+#else /* qh_NOmerge */
+facetT *qh_makenew_nonsimplicial(qhT *qh, facetT *visible, vertexT *apex, int *numnew) {
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(visible)
+  QHULL_UNUSED(apex)
+  QHULL_UNUSED(numnew)
+
+  return NULL;
+}
+#endif /* qh_NOmerge */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="makenew_simplicial">-</a>
+
+  qh_makenew_simplicial(qh, visible, apex, numnew )
+    make new facets for simplicial visible facet and apex
+
+  returns:
+    attaches new facets if !qh.NEWtentative
+      neighbors between newfacet and horizon
+
+  notes:
+    nop if neighbor->seen or neighbor->visible(see qh_makenew_nonsimplicial)
+
+  design:
+    locate neighboring horizon facet for visible facet
+    determine vertices and orientation
+    create new facet
+    if coplanar,
+      add new facet to f.samecycle
+    update horizon facet's neighbor list
+*/
+facetT *qh_makenew_simplicial(qhT *qh, facetT *visible, vertexT *apex, int *numnew) {
+  facetT *neighbor, **neighborp, *newfacet= NULL;
+  setT *vertices;
+  boolT flip, toporient;
+  int horizonskip= 0, visibleskip= 0;
+
+  FOREACHneighbor_(visible) {
+    if (!neighbor->seen && !neighbor->visible) {
+      vertices= qh_facetintersect(qh, neighbor,visible, &horizonskip, &visibleskip, 1);
+      SETfirst_(vertices)= apex;
+      flip= ((horizonskip & 0x1) ^ (visibleskip & 0x1));
+      if (neighbor->toporient)
+        toporient= horizonskip & 0x1;
+      else
+        toporient= (horizonskip & 0x1) ^ 0x1;
+      newfacet= qh_makenewfacet(qh, vertices, toporient, neighbor);
+      (*numnew)++;
+      if (neighbor->coplanarhorizon && (qh->PREmerge || qh->MERGEexact)) {
+#ifndef qh_NOmerge
+        newfacet->f.samecycle= newfacet;
+        newfacet->mergehorizon= True;
+#endif
+      }
+      if (!qh->NEWtentative)
+        SETelem_(neighbor->neighbors, horizonskip)= newfacet;
+      trace4((qh, qh->ferr, 4049, "qh_makenew_simplicial: create facet f%d top %d from v%d and horizon f%d skip %d top %d and visible f%d skip %d, flip? %d\n",
+            newfacet->id, toporient, apex->id, neighbor->id, horizonskip,
+              neighbor->toporient, visible->id, visibleskip, flip));
+    }
+  }
+  return newfacet;
+} /* makenew_simplicial */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="matchneighbor">-</a>
+
+  qh_matchneighbor(qh, newfacet, newskip, hashsize, hashcount )
+    either match subridge of newfacet with neighbor or add to hash_table
+
+  returns:
+    matched ridges of newfacet, except for duplicate ridges
+    duplicate ridges marked by qh_DUPLICATEridge for qh_matchdupridge
+
+  notes:
+    called by qh_matchnewfacets
+    assumes newfacet is simplicial
+    ridge is newfacet->vertices w/o newskip vertex
+    do not allocate memory (need to free hash_table cleanly)
+    uses linear hash chains
+    see qh_matchdupridge (poly2_r.c)
+
+  design:
+    for each possible matching facet in qh.hash_table
+      if vertices match
+        set ismatch, if facets have opposite orientation
+        if ismatch and matching facet doesn't have a match
+          match the facets by updating their neighbor sets
+        else
+          note: dupridge detected when a match 'f&d skip %d' has already been seen 
+                need to mark all of the dupridges for qh_matchdupridge
+          indicate a duplicate ridge by qh_DUPLICATEridge and f.dupridge
+          add facet to hashtable
+          unless the other facet was already a duplicate ridge
+            mark both facets with a duplicate ridge
+            add other facet (if defined) to hash table
+
+  state at "indicate a duplicate ridge":
+    newfacet@newskip= the argument
+    facet= the hashed facet@skip that has the same vertices as newfacet@newskip
+    same= true if matched vertices have the same orientation
+    matchfacet= neighbor at facet@skip
+    matchfacet=qh_DUPLICATEridge, matchfacet was previously detected as a dupridge of facet@skip
+    ismatch if 'vertex orientation (same) matches facet/newfacet orientation (toporient)
+    unknown facet will match later
+
+  details at "indicate a duplicate ridge":
+    if !ismatch and matchfacet,
+      dupridge is between hashed facet@skip/matchfacet@matchskip and arg newfacet@newskip/unknown 
+      set newfacet@newskip, facet@skip, and matchfacet@matchskip to qh_DUPLICATEridge
+      add newfacet and matchfacet to hash_table
+      if ismatch and matchfacet, 
+        same as !ismatch and matchfacet -- it matches facet instead of matchfacet
+      if !ismatch and !matchfacet
+        dupridge between hashed facet@skip/unknown and arg newfacet@newskip/unknown 
+        set newfacet@newskip and facet@skip to qh_DUPLICATEridge
+        add newfacet to hash_table
+      if ismatch and matchfacet==qh_DUPLICATEridge
+        dupridge with already duplicated hashed facet@skip and arg newfacet@newskip/unknown
+        set newfacet@newskip to qh_DUPLICATEridge
+        add newfacet to hash_table
+        facet's hyperplane already set
+*/
+void qh_matchneighbor(qhT *qh, facetT *newfacet, int newskip, int hashsize, int *hashcount) {
+  boolT newfound= False;   /* True, if new facet is already in hash chain */
+  boolT same, ismatch;
+  int hash, scan;
+  facetT *facet, *matchfacet;
+  int skip, matchskip;
+
+  hash= qh_gethash(qh, hashsize, newfacet->vertices, qh->hull_dim, 1,
+                     SETelem_(newfacet->vertices, newskip));
+  trace4((qh, qh->ferr, 4050, "qh_matchneighbor: newfacet f%d skip %d hash %d hashcount %d\n",
+          newfacet->id, newskip, hash, *hashcount));
+  zinc_(Zhashlookup);
+  for (scan=hash; (facet= SETelemt_(qh->hash_table, scan, facetT));
+       scan= (++scan >= hashsize ? 0 : scan)) {
+    if (facet == newfacet) {
+      newfound= True;
+      continue;
+    }
+    zinc_(Zhashtests);
+    if (qh_matchvertices(qh, 1, newfacet->vertices, newskip, facet->vertices, &skip, &same)) {
+      if (SETelem_(newfacet->vertices, newskip) == SETelem_(facet->vertices, skip)) {
+        qh_joggle_restart(qh, "two new facets with the same vertices");
+        /* duplicated for multiple skips, not easily avoided */
+        qh_fprintf(qh, qh->ferr, 7084, "qhull topology warning (qh_matchneighbor): will merge vertices to undo new facets -- f%d and f%d have the same vertices (skip %d, skip %d) and same horizon ridges to f%d and f%d\n",
+          facet->id, newfacet->id, skip, newskip, SETfirstt_(facet->neighbors, facetT)->id, SETfirstt_(newfacet->neighbors, facetT)->id);
+        /* will rename a vertex (QH3053).  The fault was duplicate ridges (same vertices) in different facets due to a previous rename.  Expensive to detect beforehand */
+      }
+      ismatch= (same == (boolT)((newfacet->toporient ^ facet->toporient)));
+      matchfacet= SETelemt_(facet->neighbors, skip, facetT);
+      if (ismatch && !matchfacet) {
+        SETelem_(facet->neighbors, skip)= newfacet;
+        SETelem_(newfacet->neighbors, newskip)= facet;
+        (*hashcount)--;
+        trace4((qh, qh->ferr, 4051, "qh_matchneighbor: f%d skip %d matched with new f%d skip %d\n",
+           facet->id, skip, newfacet->id, newskip));
+        return;
+      }
+      if (!qh->PREmerge && !qh->MERGEexact) {
+        qh_joggle_restart(qh, "a ridge with more than two neighbors");
+        qh_fprintf(qh, qh->ferr, 6107, "qhull topology error: facets f%d, f%d and f%d meet at a ridge with more than 2 neighbors.  Can not continue due to no qh.PREmerge and no 'Qx' (MERGEexact)\n",
+                 facet->id, newfacet->id, getid_(matchfacet));
+        qh_errexit2(qh, qh_ERRtopology, facet, newfacet);
+      }
+      SETelem_(newfacet->neighbors, newskip)= qh_DUPLICATEridge;
+      newfacet->dupridge= True;
+      qh_addhash(newfacet, qh->hash_table, hashsize, hash);
+      (*hashcount)++;
+      if (matchfacet != qh_DUPLICATEridge) {
+        SETelem_(facet->neighbors, skip)= qh_DUPLICATEridge;
+        facet->dupridge= True;
+        if (matchfacet) {
+          matchskip= qh_setindex(matchfacet->neighbors, facet);
+          if (matchskip<0) {
+              qh_fprintf(qh, qh->ferr, 6260, "qhull topology error (qh_matchneighbor): matchfacet f%d is in f%d neighbors but not vice versa.  Can not continue.\n",
+                  matchfacet->id, facet->id);
+              qh_errexit2(qh, qh_ERRtopology, matchfacet, facet);
+          }
+          SETelem_(matchfacet->neighbors, matchskip)= qh_DUPLICATEridge; /* matchskip>=0 by QH6260 */
+          matchfacet->dupridge= True;
+          qh_addhash(matchfacet, qh->hash_table, hashsize, hash);
+          *hashcount += 2;
+        }
+      }
+      trace4((qh, qh->ferr, 4052, "qh_matchneighbor: new f%d skip %d duplicates ridge for f%d skip %d matching f%d ismatch %d at hash %d\n",
+           newfacet->id, newskip, facet->id, skip,
+           (matchfacet == qh_DUPLICATEridge ? -2 : getid_(matchfacet)),
+           ismatch, hash));
+      return; /* end of duplicate ridge */
+    }
+  }
+  if (!newfound)
+    SETelem_(qh->hash_table, scan)= newfacet;  /* same as qh_addhash */
+  (*hashcount)++;
+  trace4((qh, qh->ferr, 4053, "qh_matchneighbor: no match for f%d skip %d at hash %d\n",
+           newfacet->id, newskip, hash));
+} /* matchneighbor */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="matchnewfacets">-</a>
+
+  qh_matchnewfacets(qh )
+    match new facets in qh.newfacet_list to their newfacet neighbors
+    all facets are simplicial
+
+  returns:
+    if dupridges and merging 
+      returns maxdupdist (>=0.0) from vertex to opposite facet
+      sets facet->dupridge
+      missing neighbor links identify dupridges to be merged (qh_DUPLICATEridge)
+    else  
+      qh.newfacet_list with full neighbor sets
+        vertices for the nth neighbor match all but the nth vertex
+    if not merging and qh.FORCEoutput
+      for facets with normals (i.e., with dupridges)
+      sets facet->flippped for flipped normals, also prevents point partitioning
+
+  notes:
+    called by qh_buildcone* and qh_triangulate_facet
+    neighbor[0] of new facets is the horizon facet
+    if NEWtentative, new facets not attached to the horizon
+    assumes qh.hash_table is NULL
+    vertex->neighbors has not been updated yet
+    do not allocate memory after qh.hash_table (need to free it cleanly)
+    
+  design:
+    truncate neighbor sets to horizon facet for all new facets
+    initialize a hash table
+    for all new facets
+      match facet with neighbors
+    if unmatched facets (due to duplicate ridges)
+      for each new facet with a duplicate ridge
+        try to match facets with the same coplanar horizon
+    if not all matched
+      for each new facet with a duplicate ridge
+        match it with a coplanar facet, or identify a pinched vertex
+    if not merging and qh.FORCEoutput
+      check for flipped facets
+*/
+coordT qh_matchnewfacets(qhT *qh /* qh.newfacet_list */) {
+  int numnew=0, hashcount=0, newskip;
+  facetT *newfacet, *neighbor;
+  coordT maxdupdist= 0.0, maxdist2;
+  int dim= qh->hull_dim, hashsize, neighbor_i, neighbor_n;
+  setT *neighbors;
+#ifndef qh_NOtrace
+  int facet_i, facet_n, numunused= 0;
+  facetT *facet;
+#endif
+
+  trace1((qh, qh->ferr, 1019, "qh_matchnewfacets: match neighbors for new facets.\n"));
+  FORALLnew_facets {
+    numnew++;
+    {  /* inline qh_setzero(qh, newfacet->neighbors, 1, qh->hull_dim); */
+      neighbors= newfacet->neighbors;
+      neighbors->e[neighbors->maxsize].i= dim+1; /*may be overwritten*/
+      memset((char *)SETelemaddr_(neighbors, 1, void), 0, (size_t)(dim * SETelemsize));
+    }
+  }
+
+  qh_newhashtable(qh, numnew*(qh->hull_dim-1)); /* twice what is normally needed,
+                                     but every ridge could be DUPLICATEridge */
+  hashsize= qh_setsize(qh, qh->hash_table);
+  FORALLnew_facets {
+    if (!newfacet->simplicial) {
+      qh_fprintf(qh, qh->ferr, 6377, "qhull internal error (qh_matchnewfacets): expecting simplicial facets on qh.newfacet_list f%d for qh_matchneighbors, qh_matchneighbor, and qh_matchdupridge.  Got non-simplicial f%d\n",
+        qh->newfacet_list->id, newfacet->id);
+      qh_errexit2(qh, qh_ERRqhull, newfacet, qh->newfacet_list);
+    }
+    for (newskip=1; newskip<qh->hull_dim; newskip++) /* furthest/horizon already matched */
+      /* hashsize>0 because hull_dim>1 and numnew>0 */
+      qh_matchneighbor(qh, newfacet, newskip, hashsize, &hashcount);
+#if 0   /* use the following to trap hashcount errors */
+    {
+      int count= 0, k;
+      facetT *facet, *neighbor;
+
+      count= 0;
+      FORALLfacet_(qh->newfacet_list) {  /* newfacet already in use */
+        for (k=1; k < qh->hull_dim; k++) {
+          neighbor= SETelemt_(facet->neighbors, k, facetT);
+          if (!neighbor || neighbor == qh_DUPLICATEridge)
+            count++;
+        }
+        if (facet == newfacet)
+          break;
+      }
+      if (count != hashcount) {
+        qh_fprintf(qh, qh->ferr, 6266, "qhull error (qh_matchnewfacets): after adding facet %d, hashcount %d != count %d\n",
+                 newfacet->id, hashcount, count);
+        qh_errexit(qh, qh_ERRdebug, newfacet, NULL);
+      }
+    }
+#endif  /* end of trap code */
+  } /* end FORALLnew_facets */
+  if (hashcount) { /* all neighbors matched, except for qh_DUPLICATEridge neighbors */
+    qh_joggle_restart(qh, "ridge with multiple neighbors");
+    if (hashcount) {
+      FORALLnew_facets {
+        if (newfacet->dupridge) {
+          FOREACHneighbor_i_(qh, newfacet) {
+            if (neighbor == qh_DUPLICATEridge) {
+              maxdist2= qh_matchdupridge(qh, newfacet, neighbor_i, hashsize, &hashcount);
+              maximize_(maxdupdist, maxdist2);
+            }
+          }
+        }
+      }
+    }
+  }
+  if (hashcount) {
+    qh_fprintf(qh, qh->ferr, 6108, "qhull internal error (qh_matchnewfacets): %d neighbors did not match up\n",
+        hashcount);
+    qh_printhashtable(qh, qh->ferr);
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+#ifndef qh_NOtrace
+  if (qh->IStracing >= 3) {
+    FOREACHfacet_i_(qh, qh->hash_table) {
+      if (!facet)
+        numunused++;
+    }
+    qh_fprintf(qh, qh->ferr, 3063, "qh_matchnewfacets: maxdupdist %2.2g, new facets %d, unused hash entries %d, hashsize %d\n",
+             maxdupdist, numnew, numunused, qh_setsize(qh, qh->hash_table));
+  }
+#endif /* !qh_NOtrace */
+  qh_setfree(qh, &qh->hash_table);
+  if (qh->PREmerge || qh->MERGEexact) {
+    if (qh->IStracing >= 4)
+      qh_printfacetlist(qh, qh->newfacet_list, NULL, qh_ALL);
+  }
+  return maxdupdist;
+} /* matchnewfacets */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="matchvertices">-</a>
+
+  qh_matchvertices(qh, firstindex, verticesA, skipA, verticesB, skipB, same )
+    tests whether vertices match with a single skip
+    starts match at firstindex since all new facets have a common vertex
+
+  returns:
+    true if matched vertices
+    skip index for skipB
+    sets same iff vertices have the same orientation
+
+  notes:
+    called by qh_matchneighbor and qh_matchdupridge
+    assumes skipA is in A and both sets are the same size
+
+  design:
+    set up pointers
+    scan both sets checking for a match
+    test orientation
+*/
+boolT qh_matchvertices(qhT *qh, int firstindex, setT *verticesA, int skipA,
+       setT *verticesB, int *skipB, boolT *same) {
+  vertexT **elemAp, **elemBp, **skipBp=NULL, **skipAp;
+
+  elemAp= SETelemaddr_(verticesA, firstindex, vertexT);
+  elemBp= SETelemaddr_(verticesB, firstindex, vertexT);
+  skipAp= SETelemaddr_(verticesA, skipA, vertexT);
+  do if (elemAp != skipAp) {
+    while (*elemAp != *elemBp++) {
+      if (skipBp)
+        return False;
+      skipBp= elemBp;  /* one extra like FOREACH */
+    }
+  }while (*(++elemAp));
+  if (!skipBp)
+    skipBp= ++elemBp;
+  *skipB= SETindex_(verticesB, skipB); /* i.e., skipBp - verticesB
+                                       verticesA and verticesB are the same size, otherwise trace4 may segfault */
+  *same= !((skipA & 0x1) ^ (*skipB & 0x1)); /* result is 0 or 1 */
+  trace4((qh, qh->ferr, 4054, "qh_matchvertices: matched by skip %d(v%d) and skip %d(v%d) same? %d\n",
+          skipA, (*skipAp)->id, *skipB, (*(skipBp-1))->id, *same));
+  return(True);
+} /* matchvertices */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="newfacet">-</a>
+
+  qh_newfacet(qh)
+    return a new facet
+
+  returns:
+    all fields initialized or cleared   (NULL)
+    preallocates neighbors set
+*/
+facetT *qh_newfacet(qhT *qh) {
+  facetT *facet;
+  void **freelistp; /* used if !qh_NOmem by qh_memalloc_() */
+
+  qh_memalloc_(qh, (int)sizeof(facetT), freelistp, facet, facetT);
+  memset((char *)facet, (size_t)0, sizeof(facetT));
+  if (qh->facet_id == qh->tracefacet_id)
+    qh->tracefacet= facet;
+  facet->id= qh->facet_id++;
+  facet->neighbors= qh_setnew(qh, qh->hull_dim);
+#if !qh_COMPUTEfurthest
+  facet->furthestdist= 0.0;
+#endif
+#if qh_MAXoutside
+  if (qh->FORCEoutput && qh->APPROXhull)
+    facet->maxoutside= qh->MINoutside;
+  else
+    facet->maxoutside= qh->DISTround; /* same value as test for QH7082 */
+#endif
+  facet->simplicial= True;
+  facet->good= True;
+  facet->newfacet= True;
+  trace4((qh, qh->ferr, 4055, "qh_newfacet: created facet f%d\n", facet->id));
+  return(facet);
+} /* newfacet */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="newridge">-</a>
+
+  qh_newridge()
+    return a new ridge
+  notes:
+    caller sets qh.traceridge
+*/
+ridgeT *qh_newridge(qhT *qh) {
+  ridgeT *ridge;
+  void **freelistp;   /* used if !qh_NOmem by qh_memalloc_() */
+
+  qh_memalloc_(qh, (int)sizeof(ridgeT), freelistp, ridge, ridgeT);
+  memset((char *)ridge, (size_t)0, sizeof(ridgeT));
+  zinc_(Ztotridges);
+  if (qh->ridge_id == UINT_MAX) {
+    qh_fprintf(qh, qh->ferr, 7074, "qhull warning: more than 2^32 ridges.  Qhull results are OK.  Since the ridge ID wraps around to 0, two ridges may have the same identifier.\n");
+  }
+  ridge->id= qh->ridge_id++;
+  trace4((qh, qh->ferr, 4056, "qh_newridge: created ridge r%d\n", ridge->id));
+  return(ridge);
+} /* newridge */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="pointid">-</a>
+
+  qh_pointid(qh, point )
+    return id for a point,
+    returns qh_IDnone(-3) if null, qh_IDinterior(-2) if interior, or qh_IDunknown(-1) if not known
+
+  alternative code if point is in qh.first_point...
+    unsigned long id;
+    id= ((unsigned long)point - (unsigned long)qh.first_point)/qh.normal_size;
+
+  notes:
+    Valid points are non-negative
+    WARN64 -- id truncated to 32-bits, at most 2G points
+    NOerrors returned (QhullPoint::id)
+    if point not in point array
+      the code does a comparison of unrelated pointers.
+*/
+int qh_pointid(qhT *qh, pointT *point) {
+  ptr_intT offset, id;
+
+  if (!point || !qh)
+    return qh_IDnone;
+  else if (point == qh->interior_point)
+    return qh_IDinterior;
+  else if (point >= qh->first_point
+  && point < qh->first_point + qh->num_points * qh->hull_dim) {
+    offset= (ptr_intT)(point - qh->first_point);
+    id= offset / qh->hull_dim;
+  }else if ((id= qh_setindex(qh->other_points, point)) != -1)
+    id += qh->num_points;
+  else
+    return qh_IDunknown;
+  return (int)id;
+} /* pointid */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="removefacet">-</a>
+
+  qh_removefacet(qh, facet )
+    unlinks facet from qh.facet_list,
+
+  returns:
+    updates qh.facet_list .newfacet_list .facet_next visible_list
+    decrements qh.num_facets
+
+  see:
+    qh_appendfacet
+*/
+void qh_removefacet(qhT *qh, facetT *facet) {
+  facetT *next= facet->next, *previous= facet->previous; /* next is always defined */
+
+  if (facet == qh->newfacet_list)
+    qh->newfacet_list= next;
+  if (facet == qh->facet_next)
+    qh->facet_next= next;
+  if (facet == qh->visible_list)
+    qh->visible_list= next;
+  if (previous) {
+    previous->next= next;
+    next->previous= previous;
+  }else {  /* 1st facet in qh->facet_list */
+    qh->facet_list= next;
+    qh->facet_list->previous= NULL;
+  }
+  qh->num_facets--;
+  trace4((qh, qh->ferr, 4057, "qh_removefacet: removed f%d from facet_list, newfacet_list, and visible_list\n", facet->id));
+} /* removefacet */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="removevertex">-</a>
+
+  qh_removevertex(qh, vertex )
+    unlinks vertex from qh.vertex_list,
+
+  returns:
+    updates qh.vertex_list .newvertex_list
+    decrements qh.num_vertices
+*/
+void qh_removevertex(qhT *qh, vertexT *vertex) {
+  vertexT *next= vertex->next, *previous= vertex->previous; /* next is always defined */
+
+  trace4((qh, qh->ferr, 4058, "qh_removevertex: remove v%d from qh.vertex_list\n", vertex->id));
+  if (vertex == qh->newvertex_list)
+    qh->newvertex_list= next;
+  if (previous) {
+    previous->next= next;
+    next->previous= previous;
+  }else {  /* 1st vertex in qh->vertex_list */
+    qh->vertex_list= next;
+    qh->vertex_list->previous= NULL;
+  }
+  qh->num_vertices--;
+} /* removevertex */
+
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="update_vertexneighbors">-</a>
+
+  qh_update_vertexneighbors(qh )
+    update vertex neighbors and delete interior vertices
+
+  returns:
+    if qh.VERTEXneighbors, 
+      if qh.newvertex_list,
+         removes visible neighbors from vertex neighbors
+      if qh.newfacet_list
+         adds new facets to vertex neighbors
+      if qh.visible_list
+         interior vertices added to qh.del_vertices for later partitioning as coplanar points
+    if not qh.VERTEXneighbors (not merging)
+      interior vertices of visible facets added to qh.del_vertices for later partitioning as coplanar points
+  
+  notes
+    [jan'19] split off qh_update_vertexneighbors_cone.  Optimize the remaining cases in a future release
+    called by qh_triangulate_facet after triangulating a non-simplicial facet, followed by reset_lists
+    called by qh_triangulate after triangulating null and mirror facets
+    called by qh_all_vertexmerges after calling qh_merge_pinchedvertices
+
+  design:
+    if qh.VERTEXneighbors
+      for each vertex on newvertex_list (i.e., new vertices and vertices of new facets)
+        delete visible facets from vertex neighbors
+      for each new facet on newfacet_list
+        for each vertex of facet
+          append facet to vertex neighbors
+      for each visible facet on qh.visible_list
+        for each vertex of facet
+          if the vertex is not on a new facet and not itself deleted
+            if the vertex has a not-visible neighbor (due to merging)
+               remove the visible facet from the vertex's neighbors
+            otherwise
+               add the vertex to qh.del_vertices for later deletion
+
+    if not qh.VERTEXneighbors (not merging)
+      for each vertex of a visible facet
+        if the vertex is not on a new facet and not itself deleted
+           add the vertex to qh.del_vertices for later deletion
+*/
+void qh_update_vertexneighbors(qhT *qh /* qh.newvertex_list, newfacet_list, visible_list */) {
+  facetT *newfacet= NULL, *neighbor, **neighborp, *visible;
+  vertexT *vertex, **vertexp;
+  int neighborcount= 0;
+
+  if (qh->VERTEXneighbors) {
+    trace3((qh, qh->ferr, 3013, "qh_update_vertexneighbors: update v.neighbors for qh.newvertex_list (v%d) and qh.newfacet_list (f%d)\n",
+         getid_(qh->newvertex_list), getid_(qh->newfacet_list)));
+    FORALLvertex_(qh->newvertex_list) {
+      neighborcount= 0;
+      FOREACHneighbor_(vertex) {
+        if (neighbor->visible) {
+          neighborcount++;
+          SETref_(neighbor)= NULL;
+        }
+      }
+      if (neighborcount) {
+        trace4((qh, qh->ferr, 4046, "qh_update_vertexneighbors: delete %d of %d vertex neighbors for v%d.  Removes to-be-deleted, visible facets\n",
+          neighborcount, qh_setsize(qh, vertex->neighbors), vertex->id));
+        qh_setcompact(qh, vertex->neighbors);
+      }
+    }
+    FORALLnew_facets {
+      if (qh->first_newfacet && newfacet->id >= qh->first_newfacet) {
+        FOREACHvertex_(newfacet->vertices)
+          qh_setappend(qh, &vertex->neighbors, newfacet);
+      }else {  /* called after qh_merge_pinchedvertices.  In 7-D, many more neighbors than new facets.  qh_setin is expensive */
+        FOREACHvertex_(newfacet->vertices)
+          qh_setunique(qh, &vertex->neighbors, newfacet); 
+      }
+    }
+    trace3((qh, qh->ferr, 3058, "qh_update_vertexneighbors: delete interior vertices for qh.visible_list (f%d)\n",
+        getid_(qh->visible_list)));
+    FORALLvisible_facets {
+      FOREACHvertex_(visible->vertices) {
+        if (!vertex->newfacet && !vertex->deleted) {
+          FOREACHneighbor_(vertex) { /* this can happen under merging */
+            if (!neighbor->visible)
+              break;
+          }
+          if (neighbor)
+            qh_setdel(vertex->neighbors, visible);
+          else {
+            vertex->deleted= True;
+            qh_setappend(qh, &qh->del_vertices, vertex);
+            trace2((qh, qh->ferr, 2041, "qh_update_vertexneighbors: delete interior vertex p%d(v%d) of visible f%d\n",
+                  qh_pointid(qh, vertex->point), vertex->id, visible->id));
+          }
+        }
+      }
+    }
+  }else {  /* !VERTEXneighbors */
+    trace3((qh, qh->ferr, 3058, "qh_update_vertexneighbors: delete old vertices for qh.visible_list (f%d)\n",
+      getid_(qh->visible_list)));
+    FORALLvisible_facets {
+      FOREACHvertex_(visible->vertices) {
+        if (!vertex->newfacet && !vertex->deleted) {
+          vertex->deleted= True;
+          qh_setappend(qh, &qh->del_vertices, vertex);
+          trace2((qh, qh->ferr, 2042, "qh_update_vertexneighbors: will delete interior vertex p%d(v%d) of visible f%d\n",
+                  qh_pointid(qh, vertex->point), vertex->id, visible->id));
+        }
+      }
+    }
+  }
+} /* update_vertexneighbors */
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >-------------------------------</a><a name="update_vertexneighbors_cone">-</a>
+
+  qh_update_vertexneighbors_cone(qh )
+    update vertex neighbors for a cone of new facets and delete interior vertices
+
+  returns:
+    if qh.VERTEXneighbors, 
+      if qh.newvertex_list,
+         removes visible neighbors from vertex neighbors
+      if qh.newfacet_list
+         adds new facets to vertex neighbors
+      if qh.visible_list
+         interior vertices added to qh.del_vertices for later partitioning as coplanar points
+    if not qh.VERTEXneighbors (not merging)
+      interior vertices of visible facets added to qh.del_vertices for later partitioning as coplanar points
+  
+  notes
+    called by qh_addpoint after create cone and before premerge
+
+  design:
+    if qh.VERTEXneighbors
+      for each vertex on newvertex_list (i.e., new vertices and vertices of new facets)
+        delete visible facets from vertex neighbors
+      for each new facet on newfacet_list
+        for each vertex of facet
+          append facet to vertex neighbors
+      for each visible facet on qh.visible_list
+        for each vertex of facet
+          if the vertex is not on a new facet and not itself deleted
+            if the vertex has a not-visible neighbor (due to merging)
+               remove the visible facet from the vertex's neighbors
+            otherwise
+               add the vertex to qh.del_vertices for later deletion
+
+    if not qh.VERTEXneighbors (not merging)
+      for each vertex of a visible facet
+        if the vertex is not on a new facet and not itself deleted
+           add the vertex to qh.del_vertices for later deletion
+
+*/
+void qh_update_vertexneighbors_cone(qhT *qh /* qh.newvertex_list, newfacet_list, visible_list */) {
+  facetT *newfacet= NULL, *neighbor, **neighborp, *visible;
+  vertexT *vertex, **vertexp;
+  int delcount= 0;
+
+  if (qh->VERTEXneighbors) {
+    trace3((qh, qh->ferr, 3059, "qh_update_vertexneighbors_cone: update v.neighbors for qh.newvertex_list (v%d) and qh.newfacet_list (f%d)\n",
+         getid_(qh->newvertex_list), getid_(qh->newfacet_list)));
+    FORALLvertex_(qh->newvertex_list) {
+      delcount= 0;
+      FOREACHneighbor_(vertex) {
+        if (neighbor->visible) { /* alternative design is a loop over visible facets, but needs qh_setdel() */
+          delcount++;
+          qh_setdelnth(qh, vertex->neighbors, SETindex_(vertex->neighbors, neighbor));
+          neighborp--; /* repeat */
+        }
+      }
+      if (delcount) {
+        trace4((qh, qh->ferr, 4021, "qh_update_vertexneighbors_cone: deleted %d visible vertexneighbors of v%d\n",
+          delcount, vertex->id));
+      }
+    }
+    FORALLnew_facets {
+      FOREACHvertex_(newfacet->vertices)
+        qh_setappend(qh, &vertex->neighbors, newfacet);
+    }
+    trace3((qh, qh->ferr, 3065, "qh_update_vertexneighbors_cone: delete interior vertices, if any, for qh.visible_list (f%d)\n",
+        getid_(qh->visible_list)));
+    FORALLvisible_facets {
+      FOREACHvertex_(visible->vertices) {
+        if (!vertex->newfacet && !vertex->deleted) {
+          FOREACHneighbor_(vertex) { /* this can happen under merging, qh_checkfacet QH4025 */
+            if (!neighbor->visible)
+              break;
+          }
+          if (neighbor)
+            qh_setdel(vertex->neighbors, visible);
+          else {
+            vertex->deleted= True;
+            qh_setappend(qh, &qh->del_vertices, vertex);
+            trace2((qh, qh->ferr, 2102, "qh_update_vertexneighbors_cone: will delete interior vertex p%d(v%d) of visible f%d\n",
+              qh_pointid(qh, vertex->point), vertex->id, visible->id));
+          }
+        }
+      }
+    }
+  }else {  /* !VERTEXneighbors */
+    trace3((qh, qh->ferr, 3066, "qh_update_vertexneighbors_cone: delete interior vertices for qh.visible_list (f%d)\n",
+      getid_(qh->visible_list)));
+    FORALLvisible_facets {
+      FOREACHvertex_(visible->vertices) {
+        if (!vertex->newfacet && !vertex->deleted) {
+          vertex->deleted= True;
+          qh_setappend(qh, &qh->del_vertices, vertex);
+          trace2((qh, qh->ferr, 2059, "qh_update_vertexneighbors_cone: will delete interior vertex p%d(v%d) of visible f%d\n",
+                  qh_pointid(qh, vertex->point), vertex->id, visible->id));
+        }
+      }
+    }
+  }
+} /* update_vertexneighbors_cone */
+
diff --git a/contrib/libs/qhull/libqhull_r/poly_r.h b/contrib/libs/qhull/libqhull_r/poly_r.h
new file mode 100644
index 0000000000..83c59140de
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/poly_r.h
@@ -0,0 +1,310 @@
+/*<html><pre>  -<a                             href="qh-poly_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   poly_r.h
+   header file for poly_r.c and poly2_r.c
+
+   see qh-poly_r.htm, libqhull_r.h and poly_r.c
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/poly_r.h#5 $$Change: 2963 $
+   $DateTime: 2020/06/03 19:31:01 $$Author: bbarber $
+*/
+
+#ifndef qhDEFpoly
+#define qhDEFpoly 1
+
+#include "libqhull_r.h"
+
+/*===============   constants ========================== */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >--------------------------------</a><a name="ALGORITHMfault">-</a>
+
+  qh_ALGORITHMfault
+    use as argument to checkconvex() to report errors during buildhull
+*/
+#define qh_ALGORITHMfault 0
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="DATAfault">-</a>
+
+  qh_DATAfault
+    use as argument to checkconvex() to report errors during initialhull
+*/
+#define qh_DATAfault 1
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="DUPLICATEridge">-</a>
+
+  qh_DUPLICATEridge
+    special value for facet->neighbor to indicate a duplicate ridge
+
+  notes:
+    set by qh_matchneighbor for qh_matchdupridge
+*/
+#define qh_DUPLICATEridge (facetT *)1L
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="MERGEridge">-</a>
+
+  qh_MERGEridge       flag in facet
+    special value for facet->neighbor to indicate a duplicate ridge that needs merging
+
+  notes:
+    set by qh_matchnewfacets..qh_matchdupridge from qh_DUPLICATEridge
+    used by qh_mark_dupridges to set facet->mergeridge, facet->mergeridge2 from facet->dupridge
+*/
+#define qh_MERGEridge (facetT *)2L
+
+
+/*============ -structures- ====================*/
+
+/*=========== -macros- =========================*/
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLfacet_">-</a>
+
+  FORALLfacet_( facetlist ) { ... }
+    assign 'facet' to each facet in facetlist
+
+  notes:
+    uses 'facetT *facet;'
+    assumes last facet is a sentinel
+
+  see:
+    FORALLfacets
+*/
+#define FORALLfacet_( facetlist ) if (facetlist) for ( facet=(facetlist); facet && facet->next; facet= facet->next )
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLnew_facets">-</a>
+
+  FORALLnew_facets { ... }
+    assign 'newfacet' to each facet in qh.newfacet_list
+
+  notes:
+    uses 'facetT *newfacet;'
+    at exit, newfacet==NULL
+*/
+#define FORALLnew_facets for ( newfacet=qh->newfacet_list; newfacet && newfacet->next; newfacet=newfacet->next )
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLvertex_">-</a>
+
+  FORALLvertex_( vertexlist ) { ... }
+    assign 'vertex' to each vertex in vertexlist
+
+  notes:
+    uses 'vertexT *vertex;'
+    at exit, vertex==NULL
+*/
+#define FORALLvertex_( vertexlist ) for (vertex=( vertexlist );vertex && vertex->next;vertex= vertex->next )
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLvisible_facets">-</a>
+
+  FORALLvisible_facets { ... }
+    assign 'visible' to each visible facet in qh.visible_list
+
+  notes:
+    uses 'vacetT *visible;'
+    at exit, visible==NULL
+*/
+#define FORALLvisible_facets for (visible=qh->visible_list; visible && visible->visible; visible= visible->next)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLsame_">-</a>
+
+  FORALLsame_( newfacet ) { ... }
+    assign 'same' to each facet in newfacet->f.samecycle
+
+  notes:
+    uses 'facetT *same;'
+    stops when it returns to newfacet
+*/
+#define FORALLsame_(newfacet) for (same= newfacet->f.samecycle; same != newfacet; same= same->f.samecycle)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FORALLsame_cycle_">-</a>
+
+  FORALLsame_cycle_( newfacet ) { ... }
+    assign 'same' to each facet in newfacet->f.samecycle
+
+  notes:
+    uses 'facetT *same;'
+    at exit, same == NULL
+*/
+#define FORALLsame_cycle_(newfacet) \
+     for (same= newfacet->f.samecycle; \
+         same; same= (same == newfacet ?  NULL : same->f.samecycle))
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHneighborA_">-</a>
+
+  FOREACHneighborA_( facet ) { ... }
+    assign 'neighborA' to each neighbor in facet->neighbors
+
+  FOREACHneighborA_( vertex ) { ... }
+    assign 'neighborA' to each neighbor in vertex->neighbors
+
+  declare:
+    facetT *neighborA, **neighborAp;
+
+  see:
+    <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHneighborA_(facet)  FOREACHsetelement_(facetT, facet->neighbors, neighborA)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHvisible_">-</a>
+
+  FOREACHvisible_( facets ) { ... }
+    assign 'visible' to each facet in facets
+
+  notes:
+    uses 'facetT *facet, *facetp;'
+    see <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHvisible_(facets) FOREACHsetelement_(facetT, facets, visible)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHnewfacet_">-</a>
+
+  FOREACHnewfacet_( facets ) { ... }
+    assign 'newfacet' to each facet in facets
+
+  notes:
+    uses 'facetT *newfacet, *newfacetp;'
+    see <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHnewfacet_(facets) FOREACHsetelement_(facetT, facets, newfacet)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHvertexA_">-</a>
+
+  FOREACHvertexA_( vertices ) { ... }
+    assign 'vertexA' to each vertex in vertices
+
+  notes:
+    uses 'vertexT *vertexA, *vertexAp;'
+    see <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHvertexA_(vertices) FOREACHsetelement_(vertexT, vertices, vertexA)
+
+/*-<a                             href="qh-poly_r.htm#TOC"
+  >--------------------------------</a><a name="FOREACHvertexreverse12_">-</a>
+
+  FOREACHvertexreverse12_( vertices ) { ... }
+    assign 'vertex' to each vertex in vertices
+    reverse order of first two vertices
+
+  notes:
+    uses 'vertexT *vertex, *vertexp;'
+    see <a href="qset_r.h#FOREACHsetelement_">FOREACHsetelement_</a>
+*/
+#define FOREACHvertexreverse12_(vertices) FOREACHsetelementreverse12_(vertexT, vertices, vertex)
+
+
+/*=============== prototypes poly_r.c in alphabetical order ================*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void    qh_appendfacet(qhT *qh, facetT *facet);
+void    qh_appendvertex(qhT *qh, vertexT *vertex);
+void    qh_attachnewfacets(qhT *qh /* qh.visible_list, qh.newfacet_list */);
+boolT   qh_checkflipped(qhT *qh, facetT *facet, realT *dist, boolT allerror);
+void    qh_delfacet(qhT *qh, facetT *facet);
+void    qh_deletevisible(qhT *qh /* qh.visible_list, qh.horizon_list */);
+setT   *qh_facetintersect(qhT *qh, facetT *facetA, facetT *facetB, int *skipAp,int *skipBp, int extra);
+int     qh_gethash(qhT *qh, int hashsize, setT *set, int size, int firstindex, void *skipelem);
+facetT *qh_getreplacement(qhT *qh, facetT *visible);
+facetT *qh_makenewfacet(qhT *qh, setT *vertices, boolT toporient, facetT *facet);
+void    qh_makenewplanes(qhT *qh /* qh.newfacet_list */);
+facetT *qh_makenew_nonsimplicial(qhT *qh, facetT *visible, vertexT *apex, int *numnew);
+facetT *qh_makenew_simplicial(qhT *qh, facetT *visible, vertexT *apex, int *numnew);
+void    qh_matchneighbor(qhT *qh, facetT *newfacet, int newskip, int hashsize,
+                          int *hashcount);
+coordT  qh_matchnewfacets(qhT *qh);
+boolT   qh_matchvertices(qhT *qh, int firstindex, setT *verticesA, int skipA,
+                          setT *verticesB, int *skipB, boolT *same);
+facetT *qh_newfacet(qhT *qh);
+ridgeT *qh_newridge(qhT *qh);
+int     qh_pointid(qhT *qh, pointT *point);
+void    qh_removefacet(qhT *qh, facetT *facet);
+void    qh_removevertex(qhT *qh, vertexT *vertex);
+void    qh_update_vertexneighbors(qhT *qh);
+void    qh_update_vertexneighbors_cone(qhT *qh);
+
+
+/*========== -prototypes poly2_r.c in alphabetical order ===========*/
+
+boolT   qh_addfacetvertex(qhT *qh, facetT *facet, vertexT *newvertex);
+void    qh_addhash(void *newelem, setT *hashtable, int hashsize, int hash);
+void    qh_check_bestdist(qhT *qh);
+void    qh_check_maxout(qhT *qh);
+void    qh_check_output(qhT *qh);
+void    qh_check_point(qhT *qh, pointT *point, facetT *facet, realT *maxoutside, realT *maxdist, facetT **errfacet1, facetT **errfacet2, int *errcount);
+void    qh_check_points(qhT *qh);
+void    qh_checkconvex(qhT *qh, facetT *facetlist, int fault);
+void    qh_checkfacet(qhT *qh, facetT *facet, boolT newmerge, boolT *waserrorp);
+void    qh_checkflipped_all(qhT *qh, facetT *facetlist);
+boolT   qh_checklists(qhT *qh, facetT *facetlist);
+void    qh_checkpolygon(qhT *qh, facetT *facetlist);
+void    qh_checkvertex(qhT *qh, vertexT *vertex, boolT allchecks, boolT *waserrorp);
+void    qh_clearcenters(qhT *qh, qh_CENTER type);
+void    qh_createsimplex(qhT *qh, setT *vertices);
+void    qh_delridge(qhT *qh, ridgeT *ridge);
+void    qh_delvertex(qhT *qh, vertexT *vertex);
+setT   *qh_facet3vertex(qhT *qh, facetT *facet);
+facetT *qh_findbestfacet(qhT *qh, pointT *point, boolT bestoutside,
+           realT *bestdist, boolT *isoutside);
+facetT *qh_findbestlower(qhT *qh, facetT *upperfacet, pointT *point, realT *bestdistp, int *numpart);
+facetT *qh_findfacet_all(qhT *qh, pointT *point, boolT noupper, realT *bestdist, boolT *isoutside,
+                          int *numpart);
+int     qh_findgood(qhT *qh, facetT *facetlist, int goodhorizon);
+void    qh_findgood_all(qhT *qh, facetT *facetlist);
+void    qh_furthestnext(qhT *qh /* qh.facet_list */);
+void    qh_furthestout(qhT *qh, facetT *facet);
+void    qh_infiniteloop(qhT *qh, facetT *facet);
+void    qh_initbuild(qhT *qh);
+void    qh_initialhull(qhT *qh, setT *vertices);
+setT   *qh_initialvertices(qhT *qh, int dim, setT *maxpoints, pointT *points, int numpoints);
+vertexT *qh_isvertex(pointT *point, setT *vertices);
+vertexT *qh_makenewfacets(qhT *qh, pointT *point /* qh.horizon_list, visible_list */);
+coordT  qh_matchdupridge(qhT *qh, facetT *atfacet, int atskip, int hashsize, int *hashcount);
+void    qh_nearcoplanar(qhT *qh /* qh.facet_list */);
+vertexT *qh_nearvertex(qhT *qh, facetT *facet, pointT *point, realT *bestdistp);
+int     qh_newhashtable(qhT *qh, int newsize);
+vertexT *qh_newvertex(qhT *qh, pointT *point);
+facetT *qh_nextfacet2d(facetT *facet, vertexT **nextvertexp);
+ridgeT *qh_nextridge3d(ridgeT *atridge, facetT *facet, vertexT **vertexp);
+vertexT *qh_opposite_vertex(qhT *qh, facetT *facetA,  facetT *neighbor);
+void    qh_outcoplanar(qhT *qh /* qh.facet_list */);
+pointT *qh_point(qhT *qh, int id);
+void    qh_point_add(qhT *qh, setT *set, pointT *point, void *elem);
+setT   *qh_pointfacet(qhT *qh /* qh.facet_list */);
+setT   *qh_pointvertex(qhT *qh /* qh.facet_list */);
+void    qh_prependfacet(qhT *qh, facetT *facet, facetT **facetlist);
+void    qh_printhashtable(qhT *qh, FILE *fp);
+void    qh_printlists(qhT *qh);
+void    qh_replacefacetvertex(qhT *qh, facetT *facet, vertexT *oldvertex, vertexT *newvertex);
+void    qh_resetlists(qhT *qh, boolT stats, boolT resetVisible /* qh.newvertex_list qh.newfacet_list qh.visible_list */);
+void    qh_setvoronoi_all(qhT *qh);
+void    qh_triangulate(qhT *qh /* qh.facet_list */);
+void    qh_triangulate_facet(qhT *qh, facetT *facetA, vertexT **first_vertex);
+void    qh_triangulate_link(qhT *qh, facetT *oldfacetA, facetT *facetA, facetT *oldfacetB, facetT *facetB);
+void    qh_triangulate_mirror(qhT *qh, facetT *facetA, facetT *facetB);
+void    qh_triangulate_null(qhT *qh, facetT *facetA);
+void    qh_vertexintersect(qhT *qh, setT **vertexsetA,setT *vertexsetB);
+setT   *qh_vertexintersect_new(qhT *qh, setT *vertexsetA,setT *vertexsetB);
+void    qh_vertexneighbors(qhT *qh /* qh.facet_list */);
+boolT   qh_vertexsubset(setT *vertexsetA, setT *vertexsetB);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif /* qhDEFpoly */
diff --git a/contrib/libs/qhull/libqhull_r/qhull_ra.h b/contrib/libs/qhull/libqhull_r/qhull_ra.h
new file mode 100644
index 0000000000..52ccd85a02
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/qhull_ra.h
@@ -0,0 +1,161 @@
+/*<html><pre>  -<a                             href="qh-qhull_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   qhull_ra.h
+   all header files for compiling qhull with reentrant code
+   included before C++ headers for user_r.h:QHULL_CRTDBG
+
+   see qh-qhull.htm
+
+   see libqhull_r.h for user-level definitions
+
+   see user_r.h for user-definable constants
+
+   defines internal functions for libqhull_r.c global_r.c
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/qhull_ra.h#2 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+
+   Notes:  grep for ((" and (" to catch fprintf("lkasdjf");
+           full parens around (x?y:z)
+           use '#include "libqhull_r/qhull_ra.h"' to avoid name clashes
+*/
+
+#ifndef qhDEFqhulla
+#define qhDEFqhulla 1
+
+#include "libqhull_r.h"  /* Includes user_r.h and data types */
+
+#include "stat_r.h"
+#include "random_r.h"
+#include "mem_r.h"
+#include "qset_r.h"
+#include "geom_r.h"
+#include "merge_r.h"
+#include "poly_r.h"
+#include "io_r.h"
+
+#include <setjmp.h>
+#include <string.h>
+#include <math.h>
+#include <float.h>    /* some compilers will not need float.h */
+#include <limits.h>
+#include <time.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+/*** uncomment here and qset_r.c
+     if string.h does not define memcpy()
+#include <memory.h>
+*/
+
+#if qh_CLOCKtype == 2  /* defined in user_r.h from libqhull_r.h */
+#include <sys/types.h>
+#include <sys/times.h>
+#include <unistd.h>
+#endif
+
+#ifdef _MSC_VER  /* Microsoft Visual C++ -- warning level 4 */
+#pragma warning( disable : 4100)  /* unreferenced formal parameter */
+#pragma warning( disable : 4127)  /* conditional expression is constant */
+#pragma warning( disable : 4706)  /* assignment within conditional function */
+#pragma warning( disable : 4996)  /* function was declared deprecated(strcpy, localtime, etc.) */
+#endif
+
+/* ======= -macros- =========== */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >--------------------------------</a><a name="traceN">-</a>
+
+  traceN((qh, qh->ferr, 0Nnnn, "format\n", vars));
+    calls qh_fprintf if qh.IStracing >= N
+
+    Add debugging traps to the end of qh_fprintf
+
+  notes:
+    removing tracing reduces code size but doesn't change execution speed
+*/
+#ifndef qh_NOtrace
+#define trace0(args) {if (qh->IStracing) qh_fprintf args;}
+#define trace1(args) {if (qh->IStracing >= 1) qh_fprintf args;}
+#define trace2(args) {if (qh->IStracing >= 2) qh_fprintf args;}
+#define trace3(args) {if (qh->IStracing >= 3) qh_fprintf args;}
+#define trace4(args) {if (qh->IStracing >= 4) qh_fprintf args;}
+#define trace5(args) {if (qh->IStracing >= 5) qh_fprintf args;}
+#else /* qh_NOtrace */
+#define trace0(args) {}
+#define trace1(args) {}
+#define trace2(args) {}
+#define trace3(args) {}
+#define trace4(args) {}
+#define trace5(args) {}
+#endif /* qh_NOtrace */
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >--------------------------------</a><a name="QHULL_UNUSED">-</a>
+
+  Define an unused variable to avoid compiler warnings
+
+  Derived from Qt's corelib/global/qglobal.h
+
+*/
+
+#if defined(__cplusplus) && defined(__INTEL_COMPILER) && !defined(QHULL_OS_WIN)
+template <typename T>
+inline void qhullUnused(T &x) { (void)x; }
+#  define QHULL_UNUSED(x) qhullUnused(x);
+#else
+#  define QHULL_UNUSED(x) (void)x;
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/***** -libqhull_r.c prototypes (alphabetical after qhull) ********************/
+
+void    qh_qhull(qhT *qh);
+boolT   qh_addpoint(qhT *qh, pointT *furthest, facetT *facet, boolT checkdist);
+void    qh_build_withrestart(qhT *qh);
+vertexT *qh_buildcone(qhT *qh, pointT *furthest, facetT *facet, int goodhorizon, facetT **retryfacet);
+boolT   qh_buildcone_mergepinched(qhT *qh, vertexT *apex, facetT *facet, facetT **retryfacet);
+boolT   qh_buildcone_onlygood(qhT *qh, vertexT *apex, int goodhorizon);
+void    qh_buildhull(qhT *qh);
+void    qh_buildtracing(qhT *qh, pointT *furthest, facetT *facet);
+void    qh_errexit2(qhT *qh, int exitcode, facetT *facet, facetT *otherfacet);
+void    qh_findhorizon(qhT *qh, pointT *point, facetT *facet, int *goodvisible,int *goodhorizon);
+pointT *qh_nextfurthest(qhT *qh, facetT **visible);
+void    qh_partitionall(qhT *qh, setT *vertices, pointT *points,int npoints);
+void    qh_partitioncoplanar(qhT *qh, pointT *point, facetT *facet, realT *dist, boolT allnew);
+void    qh_partitionpoint(qhT *qh, pointT *point, facetT *facet);
+void    qh_partitionvisible(qhT *qh, boolT allpoints, int *numpoints);
+void    qh_joggle_restart(qhT *qh, const char *reason);
+void    qh_printsummary(qhT *qh, FILE *fp);
+
+/***** -global_r.c internal prototypes (alphabetical) ***********************/
+
+void    qh_appendprint(qhT *qh, qh_PRINT format);
+void    qh_freebuild(qhT *qh, boolT allmem);
+void    qh_freebuffers(qhT *qh);
+void    qh_initbuffers(qhT *qh, coordT *points, int numpoints, int dim, boolT ismalloc);
+
+/***** -stat_r.c internal prototypes (alphabetical) ***********************/
+
+void    qh_allstatA(qhT *qh);
+void    qh_allstatB(qhT *qh);
+void    qh_allstatC(qhT *qh);
+void    qh_allstatD(qhT *qh);
+void    qh_allstatE(qhT *qh);
+void    qh_allstatE2(qhT *qh);
+void    qh_allstatF(qhT *qh);
+void    qh_allstatG(qhT *qh);
+void    qh_allstatH(qhT *qh);
+void    qh_freebuffers(qhT *qh);
+void    qh_initbuffers(qhT *qh, coordT *points, int numpoints, int dim, boolT ismalloc);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif /* qhDEFqhulla */
diff --git a/contrib/libs/qhull/libqhull_r/qset_r.c b/contrib/libs/qhull/libqhull_r/qset_r.c
new file mode 100644
index 0000000000..c3bec5ffa4
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/qset_r.c
@@ -0,0 +1,1383 @@
+/*<html><pre>  -<a                             href="qh-set_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   qset_r.c
+   implements set manipulations needed for quickhull
+
+   see qh-set_r.htm and qset_r.h
+
+   Be careful of strict aliasing (two pointers of different types
+   that reference the same location).  The last slot of a set is
+   either the actual size of the set plus 1, or the NULL terminator
+   of the set (i.e., setelemT).
+
+   Only reference qh for qhmem or qhstat.  Otherwise the matching code in qset.c will bring in qhT
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/qset_r.c#8 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#include "libqhull_r.h" /* for qhT and QHULL_CRTDBG */
+#include "qset_r.h"
+#include "mem_r.h"
+#include <stdio.h>
+#include <string.h>
+/*** uncomment here and qhull_ra.h
+     if string.h does not define memcpy()
+#include <memory.h>
+*/
+
+#ifndef qhDEFlibqhull
+typedef struct ridgeT ridgeT;
+typedef struct facetT facetT;
+void    qh_errexit(qhT *qh, int exitcode, facetT *, ridgeT *);
+void    qh_fprintf(qhT *qh, FILE *fp, int msgcode, const char *fmt, ... );
+#  ifdef _MSC_VER  /* Microsoft Visual C++ -- warning level 4 */
+#  pragma warning( disable : 4127)  /* conditional expression is constant */
+#  pragma warning( disable : 4706)  /* assignment within conditional function */
+#  endif
+#endif
+
+/*=============== internal macros ===========================*/
+
+/*============ functions in alphabetical order ===================*/
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >--------------------------------<a name="setaddnth">-</a>
+
+  qh_setaddnth(qh, setp, nth, newelem )
+    adds newelem as n'th element of sorted or unsorted *setp
+
+  notes:
+    *setp and newelem must be defined
+    *setp may be a temp set
+    nth=0 is first element
+    errors if nth is out of bounds
+
+  design:
+    expand *setp if empty or full
+    move tail of *setp up one
+    insert newelem
+*/
+void qh_setaddnth(qhT *qh, setT **setp, int nth, void *newelem) {
+  int oldsize, i;
+  setelemT *sizep;          /* avoid strict aliasing */
+  setelemT *oldp, *newp;
+
+  if (!*setp || (sizep= SETsizeaddr_(*setp))->i==0) {
+    qh_setlarger(qh, setp);
+    sizep= SETsizeaddr_(*setp);
+  }
+  oldsize= sizep->i - 1;
+  if (nth < 0 || nth > oldsize) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6171, "qhull internal error (qh_setaddnth): nth %d is out-of-bounds for set:\n", nth);
+    qh_setprint(qh, qh->qhmem.ferr, "", *setp);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  sizep->i++;
+  oldp= (setelemT *)SETelemaddr_(*setp, oldsize, void);   /* NULL */
+  newp= oldp+1;
+  for (i=oldsize-nth+1; i--; )  /* move at least NULL  */
+    (newp--)->p= (oldp--)->p;       /* may overwrite *sizep */
+  newp->p= newelem;
+} /* setaddnth */
+
+
+/*-<a                              href="qh-set_r.htm#TOC"
+  >--------------------------------<a name="setaddsorted">-</a>
+
+  setaddsorted( setp, newelem )
+    adds an newelem into sorted *setp
+
+  notes:
+    *setp and newelem must be defined
+    *setp may be a temp set
+    nop if newelem already in set
+
+  design:
+    find newelem's position in *setp
+    insert newelem
+*/
+void qh_setaddsorted(qhT *qh, setT **setp, void *newelem) {
+  int newindex=0;
+  void *elem, **elemp;
+
+  FOREACHelem_(*setp) {          /* could use binary search instead */
+    if (elem < newelem)
+      newindex++;
+    else if (elem == newelem)
+      return;
+    else
+      break;
+  }
+  qh_setaddnth(qh, setp, newindex, newelem);
+} /* setaddsorted */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setappend">-</a>
+
+  qh_setappend(qh, setp, newelem )
+    append newelem to *setp
+
+  notes:
+    *setp may be a temp set
+    *setp and newelem may be NULL
+
+  design:
+    expand *setp if empty or full
+    append newelem to *setp
+
+*/
+void qh_setappend(qhT *qh, setT **setp, void *newelem) {
+  setelemT *sizep;  /* Avoid strict aliasing.  Writing to *endp may overwrite *sizep */
+  setelemT *endp;
+  int count;
+
+  if (!newelem)
+    return;
+  if (!*setp || (sizep= SETsizeaddr_(*setp))->i==0) {
+    qh_setlarger(qh, setp);
+    sizep= SETsizeaddr_(*setp);
+  }
+  count= (sizep->i)++ - 1;
+  endp= (setelemT *)SETelemaddr_(*setp, count, void);
+  (endp++)->p= newelem;
+  endp->p= NULL;
+} /* setappend */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setappend_set">-</a>
+
+  qh_setappend_set(qh, setp, setA )
+    appends setA to *setp
+
+  notes:
+    *setp can not be a temp set
+    *setp and setA may be NULL
+
+  design:
+    setup for copy
+    expand *setp if it is too small
+    append all elements of setA to *setp
+*/
+void qh_setappend_set(qhT *qh, setT **setp, setT *setA) {
+  int sizeA, size;
+  setT *oldset;
+  setelemT *sizep;
+
+  if (!setA)
+    return;
+  SETreturnsize_(setA, sizeA);
+  if (!*setp)
+    *setp= qh_setnew(qh, sizeA);
+  sizep= SETsizeaddr_(*setp);
+  if (!(size= sizep->i))
+    size= (*setp)->maxsize;
+  else
+    size--;
+  if (size + sizeA > (*setp)->maxsize) {
+    oldset= *setp;
+    *setp= qh_setcopy(qh, oldset, sizeA);
+    qh_setfree(qh, &oldset);
+    sizep= SETsizeaddr_(*setp);
+  }
+  if (sizeA > 0) {
+    sizep->i= size+sizeA+1;   /* memcpy may overwrite */
+    memcpy((char *)&((*setp)->e[size].p), (char *)&(setA->e[0].p), (size_t)(sizeA+1) * SETelemsize);
+  }
+} /* setappend_set */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setappend2ndlast">-</a>
+
+  qh_setappend2ndlast(qh, setp, newelem )
+    makes newelem the next to the last element in *setp
+
+  notes:
+    *setp must have at least one element
+    newelem must be defined
+    *setp may be a temp set
+
+  design:
+    expand *setp if empty or full
+    move last element of *setp up one
+    insert newelem
+*/
+void qh_setappend2ndlast(qhT *qh, setT **setp, void *newelem) {
+    setelemT *sizep;  /* Avoid strict aliasing.  Writing to *endp may overwrite *sizep */
+    setelemT *endp, *lastp;
+    int count;
+
+    if (!*setp || (sizep= SETsizeaddr_(*setp))->i==0) {
+        qh_setlarger(qh, setp);
+        sizep= SETsizeaddr_(*setp);
+    }
+    count= (sizep->i)++ - 1;
+    endp= (setelemT *)SETelemaddr_(*setp, count, void); /* NULL */
+    lastp= endp-1;
+    *(endp++)= *lastp;
+    endp->p= NULL;    /* may overwrite *sizep */
+    lastp->p= newelem;
+} /* setappend2ndlast */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setcheck">-</a>
+
+  qh_setcheck(qh, set, typename, id )
+    check set for validity
+    report errors with typename and id
+
+  design:
+    checks that maxsize, actual size, and NULL terminator agree
+*/
+void qh_setcheck(qhT *qh, setT *set, const char *tname, unsigned int id) {
+  int maxsize, size;
+  int waserr= 0;
+
+  if (!set)
+    return;
+  SETreturnsize_(set, size);
+  maxsize= set->maxsize;
+  if (size > maxsize || !maxsize) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6172, "qhull internal error (qh_setcheck): actual size %d of %s%d is greater than max size %d\n",
+             size, tname, id, maxsize);
+    waserr= 1;
+  }else if (set->e[size].p) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6173, "qhull internal error (qh_setcheck): %s%d(size %d max %d) is not null terminated.\n",
+             tname, id, size-1, maxsize);
+    waserr= 1;
+  }
+  if (waserr) {
+    qh_setprint(qh, qh->qhmem.ferr, "ERRONEOUS", set);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+} /* setcheck */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setcompact">-</a>
+
+  qh_setcompact(qh, set )
+    remove internal NULLs from an unsorted set
+
+  returns:
+    updated set
+
+  notes:
+    set may be NULL
+    it would be faster to swap tail of set into holes, like qh_setdel
+
+  design:
+    setup pointers into set
+    skip NULLs while copying elements to start of set
+    update the actual size
+*/
+void qh_setcompact(qhT *qh, setT *set) {
+  int size;
+  void **destp, **elemp, **endp, **firstp;
+
+  if (!set)
+    return;
+  SETreturnsize_(set, size);
+  destp= elemp= firstp= SETaddr_(set, void);
+  endp= destp + size;
+  while (1) {
+    if (!(*destp++= *elemp++)) {
+      destp--;
+      if (elemp > endp)
+        break;
+    }
+  }
+  qh_settruncate(qh, set, (int)(destp-firstp));   /* WARN64 */
+} /* setcompact */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setcopy">-</a>
+
+  qh_setcopy(qh, set, extra )
+    make a copy of a sorted or unsorted set with extra slots
+
+  returns:
+    new set
+
+  design:
+    create a newset with extra slots
+    copy the elements to the newset
+
+*/
+setT *qh_setcopy(qhT *qh, setT *set, int extra) {
+  setT *newset;
+  int size;
+
+  if (extra < 0)
+    extra= 0;
+  SETreturnsize_(set, size);
+  newset= qh_setnew(qh, size+extra);
+  SETsizeaddr_(newset)->i= size+1;    /* memcpy may overwrite */
+  memcpy((char *)&(newset->e[0].p), (char *)&(set->e[0].p), (size_t)(size+1) * SETelemsize);
+  return(newset);
+} /* setcopy */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setdel">-</a>
+
+  qh_setdel(set, oldelem )
+    delete oldelem from an unsorted set
+
+  returns:
+    returns oldelem if found
+    returns NULL otherwise
+
+  notes:
+    set may be NULL
+    oldelem must not be NULL;
+    only deletes one copy of oldelem in set
+
+  design:
+    locate oldelem
+    update actual size if it was full
+    move the last element to the oldelem's location
+*/
+void *qh_setdel(setT *set, void *oldelem) {
+  setelemT *sizep;
+  setelemT *elemp;
+  setelemT *lastp;
+
+  if (!set)
+    return NULL;
+  elemp= (setelemT *)SETaddr_(set, void);
+  while (elemp->p != oldelem && elemp->p)
+    elemp++;
+  if (elemp->p) {
+    sizep= SETsizeaddr_(set);
+    if (!(sizep->i)--)         /*  if was a full set */
+      sizep->i= set->maxsize;  /*     *sizep= (maxsize-1)+ 1 */
+    lastp= (setelemT *)SETelemaddr_(set, sizep->i-1, void);
+    elemp->p= lastp->p;      /* may overwrite itself */
+    lastp->p= NULL;
+    return oldelem;
+  }
+  return NULL;
+} /* setdel */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setdellast">-</a>
+
+  qh_setdellast( set )
+    return last element of set or NULL
+
+  notes:
+    deletes element from set
+    set may be NULL
+
+  design:
+    return NULL if empty
+    if full set
+      delete last element and set actual size
+    else
+      delete last element and update actual size
+*/
+void *qh_setdellast(setT *set) {
+  int setsize;  /* actually, actual_size + 1 */
+  int maxsize;
+  setelemT *sizep;
+  void *returnvalue;
+
+  if (!set || !(set->e[0].p))
+    return NULL;
+  sizep= SETsizeaddr_(set);
+  if ((setsize= sizep->i)) {
+    returnvalue= set->e[setsize - 2].p;
+    set->e[setsize - 2].p= NULL;
+    sizep->i--;
+  }else {
+    maxsize= set->maxsize;
+    returnvalue= set->e[maxsize - 1].p;
+    set->e[maxsize - 1].p= NULL;
+    sizep->i= maxsize;
+  }
+  return returnvalue;
+} /* setdellast */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setdelnth">-</a>
+
+  qh_setdelnth(qh, set, nth )
+    deletes nth element from unsorted set
+    0 is first element
+
+  returns:
+    returns the element (needs type conversion)
+
+  notes:
+    errors if nth invalid
+
+  design:
+    setup points and check nth
+    delete nth element and overwrite with last element
+*/
+void *qh_setdelnth(qhT *qh, setT *set, int nth) {
+  void *elem;
+  setelemT *sizep;
+  setelemT *elemp, *lastp;
+
+  sizep= SETsizeaddr_(set);
+  if ((sizep->i--)==0)         /*  if was a full set */
+    sizep->i= set->maxsize;    /*    *sizep= (maxsize-1)+ 1 */
+  if (nth < 0 || nth >= sizep->i) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6174, "qhull internal error (qh_setdelnth): nth %d is out-of-bounds for set:\n", nth);
+    qh_setprint(qh, qh->qhmem.ferr, "", set);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  elemp= (setelemT *)SETelemaddr_(set, nth, void); /* nth valid by QH6174 */
+  lastp= (setelemT *)SETelemaddr_(set, sizep->i-1, void);
+  elem= elemp->p;
+  elemp->p= lastp->p;      /* may overwrite itself */
+  lastp->p= NULL;
+  return elem;
+} /* setdelnth */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setdelnthsorted">-</a>
+
+  qh_setdelnthsorted(qh, set, nth )
+    deletes nth element from sorted set
+
+  returns:
+    returns the element (use type conversion)
+
+  notes:
+    errors if nth invalid
+
+  see also:
+    setnew_delnthsorted
+
+  design:
+    setup points and check nth
+    copy remaining elements down one
+    update actual size
+*/
+void *qh_setdelnthsorted(qhT *qh, setT *set, int nth) {
+  void *elem;
+  setelemT *sizep;
+  setelemT *newp, *oldp;
+
+  sizep= SETsizeaddr_(set);
+  if (nth < 0 || (sizep->i && nth >= sizep->i-1) || nth >= set->maxsize) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6175, "qhull internal error (qh_setdelnthsorted): nth %d is out-of-bounds for set:\n", nth);
+    qh_setprint(qh, qh->qhmem.ferr, "", set);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  newp= (setelemT *)SETelemaddr_(set, nth, void);
+  elem= newp->p;
+  oldp= newp+1;
+  while (((newp++)->p= (oldp++)->p))
+    ; /* copy remaining elements and NULL */
+  if ((sizep->i--)==0)         /*  if was a full set */
+    sizep->i= set->maxsize;  /*     *sizep= (max size-1)+ 1 */
+  return elem;
+} /* setdelnthsorted */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setdelsorted">-</a>
+
+  qh_setdelsorted( set, oldelem )
+    deletes oldelem from sorted set
+
+  returns:
+    returns oldelem if it was deleted
+
+  notes:
+    set may be NULL
+
+  design:
+    locate oldelem in set
+    copy remaining elements down one
+    update actual size
+*/
+void *qh_setdelsorted(setT *set, void *oldelem) {
+  setelemT *sizep;
+  setelemT *newp, *oldp;
+
+  if (!set)
+    return NULL;
+  newp= (setelemT *)SETaddr_(set, void);
+  while(newp->p != oldelem && newp->p)
+    newp++;
+  if (newp->p) {
+    oldp= newp+1;
+    while (((newp++)->p= (oldp++)->p))
+      ; /* copy remaining elements */
+    sizep= SETsizeaddr_(set);
+    if ((sizep->i--)==0)    /*  if was a full set */
+      sizep->i= set->maxsize;  /*     *sizep= (max size-1)+ 1 */
+    return oldelem;
+  }
+  return NULL;
+} /* setdelsorted */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setduplicate">-</a>
+
+  qh_setduplicate(qh, set, elemsize )
+    duplicate a set of elemsize elements
+
+  notes:
+    use setcopy if retaining old elements
+
+  design:
+    create a new set
+    for each elem of the old set
+      create a newelem
+      append newelem to newset
+*/
+setT *qh_setduplicate(qhT *qh, setT *set, int elemsize) {
+  void          *elem, **elemp, *newElem;
+  setT          *newSet;
+  int           size;
+
+  if (!(size= qh_setsize(qh, set)))
+    return NULL;
+  newSet= qh_setnew(qh, size);
+  FOREACHelem_(set) {
+    newElem= qh_memalloc(qh, elemsize);
+    memcpy(newElem, elem, (size_t)elemsize);
+    qh_setappend(qh, &newSet, newElem);
+  }
+  return newSet;
+} /* setduplicate */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setendpointer">-</a>
+
+  qh_setendpointer( set )
+    Returns pointer to NULL terminator of a set's elements
+    set can not be NULL
+
+*/
+void **qh_setendpointer(setT *set) {
+
+  setelemT *sizep= SETsizeaddr_(set);
+  int n= sizep->i;
+  return (n ? &set->e[n-1].p : &sizep->p);
+} /* qh_setendpointer */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setequal">-</a>
+
+  qh_setequal( setA, setB )
+    returns 1 if two sorted sets are equal, otherwise returns 0
+
+  notes:
+    either set may be NULL
+
+  design:
+    check size of each set
+    setup pointers
+    compare elements of each set
+*/
+int qh_setequal(setT *setA, setT *setB) {
+  void **elemAp, **elemBp;
+  int sizeA= 0, sizeB= 0;
+
+  if (setA) {
+    SETreturnsize_(setA, sizeA);
+  }
+  if (setB) {
+    SETreturnsize_(setB, sizeB);
+  }
+  if (sizeA != sizeB)
+    return 0;
+  if (!sizeA)
+    return 1;
+  elemAp= SETaddr_(setA, void);
+  elemBp= SETaddr_(setB, void);
+  if (!memcmp((char *)elemAp, (char *)elemBp, (size_t)(sizeA * SETelemsize)))
+    return 1;
+  return 0;
+} /* setequal */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setequal_except">-</a>
+
+  qh_setequal_except( setA, skipelemA, setB, skipelemB )
+    returns 1 if sorted setA and setB are equal except for skipelemA & B
+
+  returns:
+    false if either skipelemA or skipelemB are missing
+
+  notes:
+    neither set may be NULL
+
+    if skipelemB is NULL,
+      can skip any one element of setB
+
+  design:
+    setup pointers
+    search for skipelemA, skipelemB, and mismatches
+    check results
+*/
+int qh_setequal_except(setT *setA, void *skipelemA, setT *setB, void *skipelemB) {
+  void **elemA, **elemB;
+  int skip=0;
+
+  elemA= SETaddr_(setA, void);
+  elemB= SETaddr_(setB, void);
+  while (1) {
+    if (*elemA == skipelemA) {
+      skip++;
+      elemA++;
+    }
+    if (skipelemB) {
+      if (*elemB == skipelemB) {
+        skip++;
+        elemB++;
+      }
+    }else if (*elemA != *elemB) {
+      skip++;
+      if (!(skipelemB= *elemB++))
+        return 0;
+    }
+    if (!*elemA)
+      break;
+    if (*elemA++ != *elemB++)
+      return 0;
+  }
+  if (skip != 2 || *elemB)
+    return 0;
+  return 1;
+} /* setequal_except */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setequal_skip">-</a>
+
+  qh_setequal_skip( setA, skipA, setB, skipB )
+    returns 1 if sorted setA and setB are equal except for elements skipA & B
+
+  returns:
+    false if different size
+
+  notes:
+    neither set may be NULL
+
+  design:
+    setup pointers
+    search for mismatches while skipping skipA and skipB
+*/
+int qh_setequal_skip(setT *setA, int skipA, setT *setB, int skipB) {
+  void **elemA, **elemB, **skipAp, **skipBp;
+
+  elemA= SETaddr_(setA, void);
+  elemB= SETaddr_(setB, void);
+  skipAp= SETelemaddr_(setA, skipA, void);
+  skipBp= SETelemaddr_(setB, skipB, void);
+  while (1) {
+    if (elemA == skipAp)
+      elemA++;
+    if (elemB == skipBp)
+      elemB++;
+    if (!*elemA)
+      break;
+    if (*elemA++ != *elemB++)
+      return 0;
+  }
+  if (*elemB)
+    return 0;
+  return 1;
+} /* setequal_skip */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setfree">-</a>
+
+  qh_setfree(qh, setp )
+    frees the space occupied by a sorted or unsorted set
+
+  returns:
+    sets setp to NULL
+
+  notes:
+    set may be NULL
+
+  design:
+    free array
+    free set
+*/
+void qh_setfree(qhT *qh, setT **setp) {
+  int size;
+  void **freelistp;  /* used if !qh_NOmem by qh_memfree_() */
+
+  if (*setp) {
+    size= (int)sizeof(setT) + ((*setp)->maxsize)*SETelemsize;
+    if (size <= qh->qhmem.LASTsize) {
+      qh_memfree_(qh, *setp, size, freelistp);
+    }else
+      qh_memfree(qh, *setp, size);
+    *setp= NULL;
+  }
+} /* setfree */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setfree2">-</a>
+
+  qh_setfree2(qh, setp, elemsize )
+    frees the space occupied by a set and its elements
+
+  notes:
+    set may be NULL
+
+  design:
+    free each element
+    free set
+*/
+void qh_setfree2(qhT *qh, setT **setp, int elemsize) {
+  void          *elem, **elemp;
+
+  FOREACHelem_(*setp)
+    qh_memfree(qh, elem, elemsize);
+  qh_setfree(qh, setp);
+} /* setfree2 */
+
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setfreelong">-</a>
+
+  qh_setfreelong(qh, setp )
+    frees a set only if it's in long memory
+
+  returns:
+    sets setp to NULL if it is freed
+
+  notes:
+    set may be NULL
+
+  design:
+    if set is large
+      free it
+*/
+void qh_setfreelong(qhT *qh, setT **setp) {
+  int size;
+
+  if (*setp) {
+    size= (int)sizeof(setT) + ((*setp)->maxsize)*SETelemsize;
+    if (size > qh->qhmem.LASTsize) {
+      qh_memfree(qh, *setp, size);
+      *setp= NULL;
+    }
+  }
+} /* setfreelong */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setin">-</a>
+
+  qh_setin( set, setelem )
+    returns 1 if setelem is in a set, 0 otherwise
+
+  notes:
+    set may be NULL or unsorted
+
+  design:
+    scans set for setelem
+*/
+int qh_setin(setT *set, void *setelem) {
+  void *elem, **elemp;
+
+  FOREACHelem_(set) {
+    if (elem == setelem)
+      return 1;
+  }
+  return 0;
+} /* setin */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setindex">-</a>
+
+  qh_setindex(set, atelem )
+    returns the index of atelem in set.
+    returns -1, if not in set or maxsize wrong
+
+  notes:
+    set may be NULL and may contain nulls.
+    NOerrors returned (qh_pointid, QhullPoint::id)
+
+  design:
+    checks maxsize
+    scans set for atelem
+*/
+int qh_setindex(setT *set, void *atelem) {
+  void **elem;
+  int size, i;
+
+  if (!set)
+    return -1;
+  SETreturnsize_(set, size);
+  if (size > set->maxsize)
+    return -1;
+  elem= SETaddr_(set, void);
+  for (i=0; i < size; i++) {
+    if (*elem++ == atelem)
+      return i;
+  }
+  return -1;
+} /* setindex */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setlarger">-</a>
+
+  qh_setlarger(qh, oldsetp )
+    returns a larger set that contains all elements of *oldsetp
+
+  notes:
+    if long memory,
+      the new set is 2x larger
+    if qhmem.LASTsize is between 1.5x and 2x
+      the new set is qhmem.LASTsize
+    otherwise use quick memory,
+      the new set is 2x larger, rounded up to next qh_memsize
+       
+    if temp set, updates qh->qhmem.tempstack
+
+  design:
+    creates a new set
+    copies the old set to the new set
+    updates pointers in tempstack
+    deletes the old set
+*/
+void qh_setlarger(qhT *qh, setT **oldsetp) {
+  int setsize= 1, newsize;
+  setT *newset, *set, **setp, *oldset;
+  setelemT *sizep;
+  setelemT *newp, *oldp;
+
+  if (*oldsetp) {
+    oldset= *oldsetp;
+    SETreturnsize_(oldset, setsize);
+    qh->qhmem.cntlarger++;
+    qh->qhmem.totlarger += setsize+1;
+    qh_setlarger_quick(qh, setsize, &newsize);
+    newset= qh_setnew(qh, newsize);
+    oldp= (setelemT *)SETaddr_(oldset, void);
+    newp= (setelemT *)SETaddr_(newset, void);
+    memcpy((char *)newp, (char *)oldp, (size_t)(setsize+1) * SETelemsize);
+    sizep= SETsizeaddr_(newset);
+    sizep->i= setsize+1;
+    FOREACHset_((setT *)qh->qhmem.tempstack) {
+      if (set == oldset)
+        *(setp-1)= newset;
+    }
+    qh_setfree(qh, oldsetp);
+  }else
+    newset= qh_setnew(qh, 3);
+  *oldsetp= newset;
+} /* setlarger */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setlarger_quick">-</a>
+
+  qh_setlarger_quick(qh, setsize, newsize )
+    determine newsize for setsize
+    returns True if newsize fits in quick memory
+
+  design:
+    if 2x fits into quick memory
+      return True, 2x
+    if x+4 does not fit into quick memory
+      return False, 2x
+    if x+x/3 fits into quick memory
+      return True, the last quick set
+    otherwise
+      return False, 2x
+*/
+int qh_setlarger_quick(qhT *qh, int setsize, int *newsize) {
+    int lastquickset;
+
+    *newsize= 2 * setsize;
+    lastquickset= (qh->qhmem.LASTsize - (int)sizeof(setT)) / SETelemsize; /* matches size computation in qh_setnew */
+    if (*newsize <= lastquickset)
+      return 1;
+    if (setsize + 4 > lastquickset)
+      return 0;
+    if (setsize + setsize/3 <= lastquickset) {
+      *newsize= lastquickset;
+      return 1;
+    }
+    return 0;
+} /* setlarger_quick */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setlast">-</a>
+
+  qh_setlast( set )
+    return last element of set or NULL (use type conversion)
+
+  notes:
+    set may be NULL
+
+  design:
+    return last element
+*/
+void *qh_setlast(setT *set) {
+  int size;
+
+  if (set) {
+    size= SETsizeaddr_(set)->i;
+    if (!size)
+      return SETelem_(set, set->maxsize - 1);
+    else if (size > 1)
+      return SETelem_(set, size - 2);
+  }
+  return NULL;
+} /* setlast */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setnew">-</a>
+
+  qh_setnew(qh, setsize )
+    creates and allocates space for a set
+
+  notes:
+    setsize means the number of elements (!including the NULL terminator)
+    use qh_settemp/qh_setfreetemp if set is temporary
+
+  design:
+    allocate memory for set
+    roundup memory if small set
+    initialize as empty set
+*/
+setT *qh_setnew(qhT *qh, int setsize) {
+  setT *set;
+  int sizereceived; /* used if !qh_NOmem */
+  int size;
+  void **freelistp; /* used if !qh_NOmem by qh_memalloc_() */
+
+  if (!setsize)
+    setsize++;
+  size= (int)sizeof(setT) + setsize * SETelemsize; /* setT includes NULL terminator, see qh.LASTquickset */
+  if (size>0 && size <= qh->qhmem.LASTsize) {
+    qh_memalloc_(qh, size, freelistp, set, setT);
+#ifndef qh_NOmem
+    sizereceived= qh->qhmem.sizetable[ qh->qhmem.indextable[size]];
+    if (sizereceived > size)
+      setsize += (sizereceived - size)/SETelemsize;
+#endif
+  }else
+    set= (setT *)qh_memalloc(qh, size);
+  set->maxsize= setsize;
+  set->e[setsize].i= 1;
+  set->e[0].p= NULL;
+  return(set);
+} /* setnew */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setnew_delnthsorted">-</a>
+
+  qh_setnew_delnthsorted(qh, set, size, nth, prepend )
+    creates a sorted set not containing nth element
+    if prepend, the first prepend elements are undefined
+
+  notes:
+    set must be defined
+    checks nth
+    see also: setdelnthsorted
+
+  design:
+    create new set
+    setup pointers and allocate room for prepend'ed entries
+    append head of old set to new set
+    append tail of old set to new set
+*/
+setT *qh_setnew_delnthsorted(qhT *qh, setT *set, int size, int nth, int prepend) {
+  setT *newset;
+  void **oldp, **newp;
+  int tailsize= size - nth -1, newsize;
+
+  if (tailsize < 0) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6176, "qhull internal error (qh_setnew_delnthsorted): nth %d is out-of-bounds for set:\n", nth);
+    qh_setprint(qh, qh->qhmem.ferr, "", set);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  newsize= size-1 + prepend;
+  newset= qh_setnew(qh, newsize);
+  newset->e[newset->maxsize].i= newsize+1;  /* may be overwritten */
+  oldp= SETaddr_(set, void);
+  newp= SETaddr_(newset, void) + prepend;
+  switch (nth) {
+  case 0:
+    break;
+  case 1:
+    *(newp++)= *oldp++;
+    break;
+  case 2:
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    break;
+  case 3:
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    break;
+  case 4:
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    break;
+  default:
+    memcpy((char *)newp, (char *)oldp, (size_t)nth * SETelemsize);
+    newp += nth;
+    oldp += nth;
+    break;
+  }
+  oldp++;
+  switch (tailsize) {
+  case 0:
+    break;
+  case 1:
+    *(newp++)= *oldp++;
+    break;
+  case 2:
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    break;
+  case 3:
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    break;
+  case 4:
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    *(newp++)= *oldp++;
+    break;
+  default:
+    memcpy((char *)newp, (char *)oldp, (size_t)tailsize * SETelemsize);
+    newp += tailsize;
+  }
+  *newp= NULL;
+  return(newset);
+} /* setnew_delnthsorted */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setprint">-</a>
+
+  qh_setprint(qh, fp, string, set )
+    print set elements to fp with identifying string
+
+  notes:
+    never errors
+*/
+void qh_setprint(qhT *qh, FILE *fp, const char* string, setT *set) {
+  int size, k;
+
+  if (!set)
+    qh_fprintf(qh, fp, 9346, "%s set is null\n", string);
+  else {
+    SETreturnsize_(set, size);
+    qh_fprintf(qh, fp, 9347, "%s set=%p maxsize=%d size=%d elems=",
+             string, set, set->maxsize, size);
+    if (size > set->maxsize)
+      size= set->maxsize+1;
+    for (k=0; k < size; k++)
+      qh_fprintf(qh, fp, 9348, " %p", set->e[k].p);
+    qh_fprintf(qh, fp, 9349, "\n");
+  }
+} /* setprint */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setreplace">-</a>
+
+  qh_setreplace(qh, set, oldelem, newelem )
+    replaces oldelem in set with newelem
+
+  notes:
+    errors if oldelem not in the set
+    newelem may be NULL, but it turns the set into an indexed set (no FOREACH)
+
+  design:
+    find oldelem
+    replace with newelem
+*/
+void qh_setreplace(qhT *qh, setT *set, void *oldelem, void *newelem) {
+  void **elemp;
+
+  elemp= SETaddr_(set, void);
+  while (*elemp != oldelem && *elemp)
+    elemp++;
+  if (*elemp)
+    *elemp= newelem;
+  else {
+    qh_fprintf(qh, qh->qhmem.ferr, 6177, "qhull internal error (qh_setreplace): elem %p not found in set\n",
+       oldelem);
+    qh_setprint(qh, qh->qhmem.ferr, "", set);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+} /* setreplace */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setsize">-</a>
+
+  qh_setsize(qh, set )
+    returns the size of a set
+
+  notes:
+    errors if set's maxsize is incorrect
+    same as SETreturnsize_(set)
+    same code for qh_setsize [qset_r.c] and QhullSetBase::count
+    if first element is NULL, SETempty_() is True but qh_setsize may be greater than 0
+
+  design:
+    determine actual size of set from maxsize
+*/
+int qh_setsize(qhT *qh, setT *set) {
+  int size;
+  setelemT *sizep;
+
+  if (!set)
+    return(0);
+  sizep= SETsizeaddr_(set);
+  if ((size= sizep->i)) {
+    size--;
+    if (size > set->maxsize) {
+      qh_fprintf(qh, qh->qhmem.ferr, 6178, "qhull internal error (qh_setsize): current set size %d is greater than maximum size %d\n",
+               size, set->maxsize);
+      qh_setprint(qh, qh->qhmem.ferr, "set: ", set);
+      qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+    }
+  }else
+    size= set->maxsize;
+  return size;
+} /* setsize */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="settemp">-</a>
+
+  qh_settemp(qh, setsize )
+    return a stacked, temporary set of up to setsize elements
+
+  notes:
+    use settempfree or settempfree_all to release from qh->qhmem.tempstack
+    see also qh_setnew
+
+  design:
+    allocate set
+    append to qh->qhmem.tempstack
+
+*/
+setT *qh_settemp(qhT *qh, int setsize) {
+  setT *newset;
+
+  newset= qh_setnew(qh, setsize);
+  qh_setappend(qh, &qh->qhmem.tempstack, newset);
+  if (qh->qhmem.IStracing >= 5)
+    qh_fprintf(qh, qh->qhmem.ferr, 8123, "qh_settemp: temp set %p of %d elements, depth %d\n",
+       newset, newset->maxsize, qh_setsize(qh, qh->qhmem.tempstack));
+  return newset;
+} /* settemp */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="settempfree">-</a>
+
+  qh_settempfree(qh, set )
+    free temporary set at top of qh->qhmem.tempstack
+
+  notes:
+    nop if set is NULL
+    errors if set not from previous   qh_settemp
+
+  to locate errors:
+    use 'T2' to find source and then find mis-matching qh_settemp
+
+  design:
+    check top of qh->qhmem.tempstack
+    free it
+*/
+void qh_settempfree(qhT *qh, setT **set) {
+  setT *stackedset;
+
+  if (!*set)
+    return;
+  stackedset= qh_settemppop(qh);
+  if (stackedset != *set) {
+    qh_settemppush(qh, stackedset);
+    qh_fprintf(qh, qh->qhmem.ferr, 6179, "qhull internal error (qh_settempfree): set %p(size %d) was not last temporary allocated(depth %d, set %p, size %d)\n",
+             *set, qh_setsize(qh, *set), qh_setsize(qh, qh->qhmem.tempstack)+1,
+             stackedset, qh_setsize(qh, stackedset));
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  qh_setfree(qh, set);
+} /* settempfree */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="settempfree_all">-</a>
+
+  qh_settempfree_all(qh)
+    free all temporary sets in qh->qhmem.tempstack
+
+  design:
+    for each set in tempstack
+      free set
+    free qh->qhmem.tempstack
+*/
+void qh_settempfree_all(qhT *qh) {
+  setT *set, **setp;
+
+  FOREACHset_(qh->qhmem.tempstack)
+    qh_setfree(qh, &set);
+  qh_setfree(qh, &qh->qhmem.tempstack);
+} /* settempfree_all */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="settemppop">-</a>
+
+  qh_settemppop(qh)
+    pop and return temporary set from qh->qhmem.tempstack
+
+  notes:
+    the returned set is permanent
+
+  design:
+    pop and check top of qh->qhmem.tempstack
+*/
+setT *qh_settemppop(qhT *qh) {
+  setT *stackedset;
+
+  stackedset= (setT *)qh_setdellast(qh->qhmem.tempstack);
+  if (!stackedset) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6180, "qhull internal error (qh_settemppop): pop from empty temporary stack\n");
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  if (qh->qhmem.IStracing >= 5)
+    qh_fprintf(qh, qh->qhmem.ferr, 8124, "qh_settemppop: depth %d temp set %p of %d elements\n",
+       qh_setsize(qh, qh->qhmem.tempstack)+1, stackedset, qh_setsize(qh, stackedset));
+  return stackedset;
+} /* settemppop */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="settemppush">-</a>
+
+  qh_settemppush(qh, set )
+    push temporary set unto qh->qhmem.tempstack (makes it temporary)
+
+  notes:
+    duplicates settemp() for tracing
+
+  design:
+    append set to tempstack
+*/
+void qh_settemppush(qhT *qh, setT *set) {
+  if (!set) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6267, "qhull error (qh_settemppush): can not push a NULL temp\n");
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  qh_setappend(qh, &qh->qhmem.tempstack, set);
+  if (qh->qhmem.IStracing >= 5)
+    qh_fprintf(qh, qh->qhmem.ferr, 8125, "qh_settemppush: depth %d temp set %p of %d elements\n",
+      qh_setsize(qh, qh->qhmem.tempstack), set, qh_setsize(qh, set));
+} /* settemppush */
+
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="settruncate">-</a>
+
+  qh_settruncate(qh, set, size )
+    truncate set to size elements
+
+  notes:
+    set must be defined
+
+  see:
+    SETtruncate_
+
+  design:
+    check size
+    update actual size of set
+*/
+void qh_settruncate(qhT *qh, setT *set, int size) {
+
+  if (size < 0 || size > set->maxsize) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6181, "qhull internal error (qh_settruncate): size %d out of bounds for set:\n", size);
+    qh_setprint(qh, qh->qhmem.ferr, "", set);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  set->e[set->maxsize].i= size+1;   /* maybe overwritten */
+  set->e[size].p= NULL;
+} /* settruncate */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setunique">-</a>
+
+  qh_setunique(qh, set, elem )
+    add elem to unsorted set unless it is already in set
+
+  notes:
+    returns 1 if it is appended
+
+  design:
+    if elem not in set
+      append elem to set
+*/
+int qh_setunique(qhT *qh, setT **set, void *elem) {
+
+  if (!qh_setin(*set, elem)) {
+    qh_setappend(qh, set, elem);
+    return 1;
+  }
+  return 0;
+} /* setunique */
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="setzero">-</a>
+
+  qh_setzero(qh, set, index, size )
+    zero elements from index on
+    set actual size of set to size
+
+  notes:
+    set must be defined
+    the set becomes an indexed set (can not use FOREACH...)
+
+  see also:
+    qh_settruncate
+
+  design:
+    check index and size
+    update actual size
+    zero elements starting at e[index]
+*/
+void qh_setzero(qhT *qh, setT *set, int idx, int size) {
+  int count;
+
+  if (idx < 0 || idx >= size || size > set->maxsize) {
+    qh_fprintf(qh, qh->qhmem.ferr, 6182, "qhull internal error (qh_setzero): index %d or size %d out of bounds for set:\n", idx, size);
+    qh_setprint(qh, qh->qhmem.ferr, "", set);
+    qh_errexit(qh, qhmem_ERRqhull, NULL, NULL);
+  }
+  set->e[set->maxsize].i=  size+1;  /* may be overwritten */
+  count= size - idx + 1;   /* +1 for NULL terminator */
+  memset((char *)SETelemaddr_(set, idx, void), 0, (size_t)count * SETelemsize);
+} /* setzero */
+
+
diff --git a/contrib/libs/qhull/libqhull_r/qset_r.h b/contrib/libs/qhull/libqhull_r/qset_r.h
new file mode 100644
index 0000000000..b41dac0084
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/qset_r.h
@@ -0,0 +1,506 @@
+/*<html><pre>  -<a                             href="qh-set_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   qset_r.h
+     header file for qset_r.c that implements set
+
+   see qh-set_r.htm and qset_r.c
+
+   only uses mem_r.c, malloc/free
+
+   for error handling, writes message and calls
+      qh_errexit(qhT *qh, qhmem_ERRqhull, NULL, NULL);
+
+   set operations satisfy the following properties:
+    - sets have a max size, the actual size (if different) is stored at the end
+    - every set is NULL terminated
+    - sets may be sorted or unsorted, the caller must distinguish this
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/qset_r.h#4 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#ifndef qhDEFset
+#define qhDEFset 1
+
+#include <stdio.h>
+
+/*================= -structures- ===============*/
+
+#ifndef DEFsetT
+#define DEFsetT 1
+typedef struct setT setT;   /* a set is a sorted or unsorted array of pointers */
+#endif
+
+#ifndef DEFqhT
+#define DEFqhT 1
+typedef struct qhT qhT;          /* defined in libqhull_r.h */
+#endif
+
+/* [jan'15] Decided not to use countT.  Most sets are small.  The code uses signed tests */
+
+/*-<a                                      href="qh-set_r.htm#TOC"
+>----------------------------------------</a><a name="setT">-</a>
+
+setT
+  a set or list of pointers with maximum size and actual size.
+
+variations:
+  unsorted, unique   -- a list of unique pointers with NULL terminator
+                           user guarantees uniqueness
+  sorted             -- a sorted list of unique pointers with NULL terminator
+                           qset_r.c guarantees uniqueness
+  unsorted           -- a list of pointers terminated with NULL
+  indexed            -- an array of pointers with NULL elements
+
+structure for set of n elements:
+
+        --------------
+        |  maxsize
+        --------------
+        |  e[0] - a pointer, may be NULL for indexed sets
+        --------------
+        |  e[1]
+
+        --------------
+        |  ...
+        --------------
+        |  e[n-1]
+        --------------
+        |  e[n] = NULL
+        --------------
+        |  ...
+        --------------
+        |  e[maxsize] - n+1 or NULL (determines actual size of set)
+        --------------
+
+*/
+
+/*-- setelemT -- internal type to allow both pointers and indices
+*/
+typedef union setelemT setelemT;
+union setelemT {
+  void    *p;
+  int   i;         /* integer used for e[maxSize] */
+};
+
+struct setT {
+  int maxsize;          /* maximum number of elements (except NULL) */
+  setelemT e[1];        /* array of pointers, tail is NULL */
+                        /* last slot (unless NULL) is actual size+1
+                           e[maxsize]==NULL or e[e[maxsize]-1]==NULL */
+                        /* this may generate a warning since e[] contains
+                           maxsize elements */
+};
+
+/*=========== -constants- =========================*/
+
+/*-<a                                 href="qh-set_r.htm#TOC"
+  >-----------------------------------</a><a name="SETelemsize">-</a>
+
+  SETelemsize
+    size of a set element in bytes
+*/
+#define SETelemsize ((int)sizeof(setelemT))
+
+
+/*=========== -macros- =========================*/
+
+/*-<a                                 href="qh-set_r.htm#TOC"
+  >-----------------------------------</a><a name="FOREACHsetelement_">-</a>
+
+   FOREACHsetelement_(type, set, variable)
+     define FOREACH iterator
+
+   declare:
+     assumes *variable and **variablep are declared
+     no space in "variable)" [DEC Alpha cc compiler]
+
+   each iteration:
+     variable is set element
+     variablep is one beyond variable.
+
+   to repeat an element:
+     variablep--; / *repeat* /
+
+   at exit:
+     variable is NULL at end of loop
+
+   example:
+     #define FOREACHfacet_(facets) FOREACHsetelement_(facetT, facets, facet)
+
+   notes:
+     use FOREACHsetelement_i_() if need index or include NULLs
+     assumes set is not modified
+
+   WARNING:
+     nested loops can't use the same variable (define another FOREACH)
+
+     needs braces if nested inside another FOREACH
+     this includes intervening blocks, e.g. FOREACH...{ if () FOREACH...} )
+*/
+#define FOREACHsetelement_(type, set, variable) \
+        if (((variable= NULL), set)) for (\
+          variable##p= (type **)&((set)->e[0].p); \
+          (variable= *variable##p++);)
+
+/*-<a                                      href="qh-set_r.htm#TOC"
+  >----------------------------------------</a><a name="FOREACHsetelement_i_">-</a>
+
+   FOREACHsetelement_i_(qh, type, set, variable)
+     define indexed FOREACH iterator
+
+   declare:
+     type *variable, variable_n, variable_i;
+
+   each iteration:
+     variable is set element, may be NULL
+     variable_i is index, variable_n is qh_setsize()
+
+   to repeat an element:
+     variable_i--; variable_n-- repeats for deleted element
+
+   at exit:
+     variable==NULL and variable_i==variable_n
+
+   example:
+     #define FOREACHfacet_i_(qh, facets) FOREACHsetelement_i_(qh, facetT, facets, facet)
+
+   WARNING:
+     nested loops can't use the same variable (define another FOREACH)
+
+     needs braces if nested inside another FOREACH
+     this includes intervening blocks, e.g. FOREACH...{ if () FOREACH...} )
+*/
+#define FOREACHsetelement_i_(qh, type, set, variable) \
+        if (((variable= NULL), set)) for (\
+          variable##_i= 0, variable= (type *)((set)->e[0].p), \
+                   variable##_n= qh_setsize(qh, set);\
+          variable##_i < variable##_n;\
+          variable= (type *)((set)->e[++variable##_i].p) )
+
+/*-<a                                    href="qh-set_r.htm#TOC"
+  >--------------------------------------</a><a name="FOREACHsetelementreverse_">-</a>
+
+   FOREACHsetelementreverse_(qh, type, set, variable)-
+     define FOREACH iterator in reverse order
+
+   declare:
+     assumes *variable and **variablep are declared
+     also declare 'int variabletemp'
+
+   each iteration:
+     variable is set element
+
+   to repeat an element:
+     variabletemp++; / *repeat* /
+
+   at exit:
+     variable is NULL
+
+   example:
+     #define FOREACHvertexreverse_(vertices) FOREACHsetelementreverse_(vertexT, vertices, vertex)
+
+   notes:
+     use FOREACHsetelementreverse12_() to reverse first two elements
+     WARNING: needs braces if nested inside another FOREACH
+*/
+#define FOREACHsetelementreverse_(qh, type, set, variable) \
+        if (((variable= NULL), set)) for (\
+           variable##temp= qh_setsize(qh, set)-1, variable= qh_setlast(qh, set);\
+           variable; variable= \
+           ((--variable##temp >= 0) ? SETelemt_(set, variable##temp, type) : NULL))
+
+/*-<a                                 href="qh-set_r.htm#TOC"
+  >-----------------------------------</a><a name="FOREACHsetelementreverse12_">-</a>
+
+   FOREACHsetelementreverse12_(type, set, variable)-
+     define FOREACH iterator with e[1] and e[0] reversed
+
+   declare:
+     assumes *variable and **variablep are declared
+
+   each iteration:
+     variable is set element
+     variablep is one after variable.
+
+   to repeat an element:
+     variablep--; / *repeat* /
+
+   at exit:
+     variable is NULL at end of loop
+
+   example
+     #define FOREACHvertexreverse12_(vertices) FOREACHsetelementreverse12_(vertexT, vertices, vertex)
+
+   notes:
+     WARNING: needs braces if nested inside another FOREACH
+*/
+#define FOREACHsetelementreverse12_(type, set, variable) \
+        if (((variable= NULL), set)) for (\
+          variable##p= (type **)&((set)->e[1].p); \
+          (variable= *variable##p); \
+          variable##p == ((type **)&((set)->e[0].p))?variable##p += 2: \
+              (variable##p == ((type **)&((set)->e[1].p))?variable##p--:variable##p++))
+
+/*-<a                                 href="qh-set_r.htm#TOC"
+  >-----------------------------------</a><a name="FOREACHelem_">-</a>
+
+   FOREACHelem_( set )-
+     iterate elements in a set
+
+   declare:
+     void *elem, *elemp;
+
+   each iteration:
+     elem is set element
+     elemp is one beyond
+
+   to repeat an element:
+     elemp--; / *repeat* /
+
+   at exit:
+     elem == NULL at end of loop
+
+   example:
+     FOREACHelem_(set) {
+
+   notes:
+     assumes set is not modified
+     WARNING: needs braces if nested inside another FOREACH
+*/
+#define FOREACHelem_(set) FOREACHsetelement_(void, set, elem)
+
+/*-<a                                 href="qh-set_r.htm#TOC"
+  >-----------------------------------</a><a name="FOREACHset_">-</a>
+
+   FOREACHset_( set )-
+     iterate a set of sets
+
+   declare:
+     setT *set, **setp;
+
+   each iteration:
+     set is set element
+     setp is one beyond
+
+   to repeat an element:
+     setp--; / *repeat* /
+
+   at exit:
+     set == NULL at end of loop
+
+   example
+     FOREACHset_(sets) {
+
+   notes:
+     WARNING: needs braces if nested inside another FOREACH
+*/
+#define FOREACHset_(sets) FOREACHsetelement_(setT, sets, set)
+
+/*-<a                                       href="qh-set_r.htm#TOC"
+  >-----------------------------------------</a><a name="SETindex_">-</a>
+
+   SETindex_( set, elem )
+     return index of elem in set
+
+   notes:
+     for use with FOREACH iteration
+     WARN64 -- Maximum set size is 2G
+
+   example:
+     i= SETindex_(ridges, ridge)
+*/
+#define SETindex_(set, elem) ((int)((void **)elem##p - (void **)&(set)->e[1].p))
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETref_">-</a>
+
+   SETref_( elem )
+     l.h.s. for modifying the current element in a FOREACH iteration
+
+   example:
+     SETref_(ridge)= anotherridge;
+*/
+#define SETref_(elem) (elem##p[-1])
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETelem_">-</a>
+
+   SETelem_(set, n)
+     return the n'th element of set
+
+   notes:
+      assumes that n is valid [0..size] and that set is defined
+      use SETelemt_() for type cast
+*/
+#define SETelem_(set, n)           ((set)->e[n].p)
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETelemt_">-</a>
+
+   SETelemt_(set, n, type)
+     return the n'th element of set as a type
+
+   notes:
+      assumes that n is valid [0..size] and that set is defined
+*/
+#define SETelemt_(set, n, type)    ((type *)((set)->e[n].p))
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETelemaddr_">-</a>
+
+   SETelemaddr_(set, n, type)
+     return address of the n'th element of a set
+
+   notes:
+      assumes that n is valid [0..size] and set is defined
+*/
+#define SETelemaddr_(set, n, type) ((type **)(&((set)->e[n].p)))
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETfirst_">-</a>
+
+   SETfirst_(set)
+     return first element of set
+
+*/
+#define SETfirst_(set)             ((set)->e[0].p)
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETfirstt_">-</a>
+
+   SETfirstt_(set, type)
+     return first element of set as a type
+
+*/
+#define SETfirstt_(set, type)      ((type *)((set)->e[0].p))
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETsecond_">-</a>
+
+   SETsecond_(set)
+     return second element of set
+
+*/
+#define SETsecond_(set)            ((set)->e[1].p)
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETsecondt_">-</a>
+
+   SETsecondt_(set, type)
+     return second element of set as a type
+*/
+#define SETsecondt_(set, type)     ((type *)((set)->e[1].p))
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETaddr_">-</a>
+
+   SETaddr_(set, type)
+       return address of set's elements
+*/
+#define SETaddr_(set,type)         ((type **)(&((set)->e[0].p)))
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETreturnsize_">-</a>
+
+   SETreturnsize_(set, size)
+     return size of a set
+
+   notes:
+      set must be defined
+      use qh_setsize(qhT *qh, set) unless speed is critical
+*/
+#define SETreturnsize_(set, size) (((size)= ((set)->e[(set)->maxsize].i))?(--(size)):((size)= (set)->maxsize))
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETempty_">-</a>
+
+   SETempty_(set)
+     return true(1) if set is empty (i.e., FOREACHsetelement_ is empty)
+
+   notes:
+      set may be NULL
+      qh_setsize may be non-zero if first element is NULL
+*/
+#define SETempty_(set)            (!set || (SETfirst_(set) ? 0 : 1))
+
+/*-<a                             href="qh-set_r.htm#TOC"
+  >-------------------------------<a name="SETsizeaddr_">-</a>
+
+  SETsizeaddr_(set)
+    return pointer to 'actual size+1' of set (set CANNOT be NULL!!)
+    Its type is setelemT* for strict aliasing
+    All SETelemaddr_ must be cast to setelemT
+
+
+  notes:
+    *SETsizeaddr==NULL or e[*SETsizeaddr-1].p==NULL
+*/
+#define SETsizeaddr_(set) (&((set)->e[(set)->maxsize]))
+
+/*-<a                                     href="qh-set_r.htm#TOC"
+  >---------------------------------------</a><a name="SETtruncate_">-</a>
+
+   SETtruncate_(set, size)
+     truncate set to size
+
+   see:
+     qh_settruncate()
+
+*/
+#define SETtruncate_(set, size) {set->e[set->maxsize].i= size+1; /* maybe overwritten */ \
+      set->e[size].p= NULL;}
+
+/*======= prototypes in alphabetical order ============*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void  qh_setaddsorted(qhT *qh, setT **setp, void *elem);
+void  qh_setaddnth(qhT *qh, setT **setp, int nth, void *newelem);
+void  qh_setappend(qhT *qh, setT **setp, void *elem);
+void  qh_setappend_set(qhT *qh, setT **setp, setT *setA);
+void  qh_setappend2ndlast(qhT *qh, setT **setp, void *elem);
+void  qh_setcheck(qhT *qh, setT *set, const char *tname, unsigned int id);
+void  qh_setcompact(qhT *qh, setT *set);
+setT *qh_setcopy(qhT *qh, setT *set, int extra);
+void *qh_setdel(setT *set, void *elem);
+void *qh_setdellast(setT *set);
+void *qh_setdelnth(qhT *qh, setT *set, int nth);
+void *qh_setdelnthsorted(qhT *qh, setT *set, int nth);
+void *qh_setdelsorted(setT *set, void *newelem);
+setT *qh_setduplicate(qhT *qh, setT *set, int elemsize);
+void **qh_setendpointer(setT *set);
+int   qh_setequal(setT *setA, setT *setB);
+int   qh_setequal_except(setT *setA, void *skipelemA, setT *setB, void *skipelemB);
+int   qh_setequal_skip(setT *setA, int skipA, setT *setB, int skipB);
+void  qh_setfree(qhT *qh, setT **set);
+void  qh_setfree2(qhT *qh, setT **setp, int elemsize);
+void  qh_setfreelong(qhT *qh, setT **set);
+int   qh_setin(setT *set, void *setelem);
+int   qh_setindex(setT *set, void *setelem);
+void  qh_setlarger(qhT *qh, setT **setp);
+int   qh_setlarger_quick(qhT *qh, int setsize, int *newsize);
+void *qh_setlast(setT *set);
+setT *qh_setnew(qhT *qh, int size);
+setT *qh_setnew_delnthsorted(qhT *qh, setT *set, int size, int nth, int prepend);
+void  qh_setprint(qhT *qh, FILE *fp, const char* string, setT *set);
+void  qh_setreplace(qhT *qh, setT *set, void *oldelem, void *newelem);
+int   qh_setsize(qhT *qh, setT *set);
+setT *qh_settemp(qhT *qh, int setsize);
+void  qh_settempfree(qhT *qh, setT **set);
+void  qh_settempfree_all(qhT *qh);
+setT *qh_settemppop(qhT *qh);
+void  qh_settemppush(qhT *qh, setT *set);
+void  qh_settruncate(qhT *qh, setT *set, int size);
+int   qh_setunique(qhT *qh, setT **set, void *elem);
+void  qh_setzero(qhT *qh, setT *set, int idx, int size);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif /* qhDEFset */
diff --git a/contrib/libs/qhull/libqhull_r/random_r.c b/contrib/libs/qhull/libqhull_r/random_r.c
new file mode 100644
index 0000000000..7eecd30e09
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/random_r.c
@@ -0,0 +1,249 @@
+/*<html><pre>  -<a                             href="index_r.htm#TOC"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   random_r.c and utilities
+     Park & Miller's minimimal standard random number generator
+     argc/argv conversion
+
+     Used by rbox.  Do not use 'qh' 
+*/
+
+#include "libqhull_r.h"
+#include "random_r.h"
+
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef _MSC_VER  /* Microsoft Visual C++ -- warning level 4 */
+#pragma warning( disable : 4706)  /* assignment within conditional function */
+#pragma warning( disable : 4996)  /* function was declared deprecated(strcpy, localtime, etc.) */
+#endif
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="argv_to_command">-</a>
+
+  qh_argv_to_command( argc, argv, command, max_size )
+
+    build command from argc/argv
+    max_size is at least
+
+  returns:
+    a space-delimited string of options (just as typed)
+    returns false if max_size is too short
+
+  notes:
+    silently removes
+    makes option string easy to input and output
+    matches qh_argv_to_command_size
+    argc may be 0
+*/
+int qh_argv_to_command(int argc, char *argv[], char* command, int max_size) {
+  int i, remaining;
+  char *s;
+  *command= '\0';  /* max_size > 0 */
+
+  if (argc) {
+    if ((s= strrchr( argv[0], '\\')) /* get filename w/o .exe extension */
+    || (s= strrchr( argv[0], '/')))
+        s++;
+    else
+        s= argv[0];
+    if ((int)strlen(s) < max_size)   /* WARN64 */
+        strcpy(command, s);
+    else
+        goto error_argv;
+    if ((s= strstr(command, ".EXE"))
+    ||  (s= strstr(command, ".exe")))
+        *s= '\0';
+  }
+  for (i=1; i < argc; i++) {
+    s= argv[i];
+    remaining= max_size - (int)strlen(command) - (int)strlen(s) - 2;   /* WARN64 */
+    if (!*s || strchr(s, ' ')) {
+      char *t= command + strlen(command);
+      remaining -= 2;
+      if (remaining < 0) {
+        goto error_argv;
+      }
+      *t++= ' ';
+      *t++= '"';
+      while (*s) {
+        if (*s == '"') {
+          if (--remaining < 0)
+            goto error_argv;
+          *t++= '\\';
+        }
+        *t++= *s++;
+      }
+      *t++= '"';
+      *t= '\0';
+    }else if (remaining < 0) {
+      goto error_argv;
+    }else {
+      strcat(command, " ");
+      strcat(command, s);
+    }
+  }
+  return 1;
+
+error_argv:
+  return 0;
+} /* argv_to_command */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="argv_to_command_size">-</a>
+
+  qh_argv_to_command_size( argc, argv )
+
+    return size to allocate for qh_argv_to_command()
+
+  notes:
+    only called from rbox with qh_errexit not enabled
+    caller should report error if returned size is less than 1
+    argc may be 0
+    actual size is usually shorter
+*/
+int qh_argv_to_command_size(int argc, char *argv[]) {
+    int count= 1; /* null-terminator if argc==0 */
+    int i;
+    char *s;
+
+    for (i=0; i<argc; i++){
+      count += (int)strlen(argv[i]) + 1;   /* WARN64 */
+      if (i>0 && strchr(argv[i], ' ')) {
+        count += 2;  /* quote delimiters */
+        for (s=argv[i]; *s; s++) {
+          if (*s == '"') {
+            count++;
+          }
+        }
+      }
+    }
+    return count;
+} /* argv_to_command_size */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+  >-------------------------------</a><a name="rand">-</a>
+
+  qh_rand()
+  qh_srand(qh, seed )
+    generate pseudo-random number between 1 and 2^31 -2
+
+  notes:
+    For qhull and rbox, called from qh_RANDOMint(),etc. [user_r.h]
+
+    From Park & Miller's minimal standard random number generator
+      Communications of the ACM, 31:1192-1201, 1988.
+    Does not use 0 or 2^31 -1
+      this is silently enforced by qh_srand()
+    Can make 'Rn' much faster by moving qh_rand to qh_distplane
+*/
+
+/* Global variables and constants */
+
+#define qh_rand_a 16807
+#define qh_rand_m 2147483647
+#define qh_rand_q 127773  /* m div a */
+#define qh_rand_r 2836    /* m mod a */
+
+int qh_rand(qhT *qh) {
+    int lo, hi, test;
+    int seed= qh->last_random;
+
+    hi= seed / qh_rand_q;  /* seed div q */
+    lo= seed % qh_rand_q;  /* seed mod q */
+    test= qh_rand_a * lo - qh_rand_r * hi;
+    if (test > 0)
+        seed= test;
+    else
+        seed= test + qh_rand_m;
+    qh->last_random= seed;
+    /* seed= seed < qh_RANDOMmax/2 ? 0 : qh_RANDOMmax;  for testing */
+    /* seed= qh_RANDOMmax;  for testing */
+    return seed;
+} /* rand */
+
+void qh_srand(qhT *qh, int seed) {
+    if (seed < 1)
+        qh->last_random= 1;
+    else if (seed >= qh_rand_m)
+        qh->last_random= qh_rand_m - 1;
+    else
+        qh->last_random= seed;
+} /* qh_srand */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+>-------------------------------</a><a name="randomfactor">-</a>
+
+qh_randomfactor(qh, scale, offset )
+  return a random factor r * scale + offset
+
+notes:
+  qh.RANDOMa/b are defined in global_r.c
+  qh_RANDOMint requires 'qh'
+*/
+realT qh_randomfactor(qhT *qh, realT scale, realT offset) {
+    realT randr;
+
+    randr= qh_RANDOMint;
+    return randr * scale + offset;
+} /* randomfactor */
+
+/*-<a                             href="qh-geom_r.htm#TOC"
+>-------------------------------</a><a name="randommatrix">-</a>
+
+  qh_randommatrix(qh, buffer, dim, rows )
+    generate a random dim X dim matrix in range [-1,1]
+    assumes buffer is [dim+1, dim]
+
+  returns:
+    sets buffer to random numbers
+    sets rows to rows of buffer
+    sets row[dim] as scratch row
+
+  notes:
+    qh_RANDOMint requires 'qh'
+*/
+void qh_randommatrix(qhT *qh, realT *buffer, int dim, realT **rows) {
+    int i, k;
+    realT **rowi, *coord, realr;
+
+    coord= buffer;
+    rowi= rows;
+    for (i=0; i < dim; i++) {
+        *(rowi++)= coord;
+        for (k=0; k < dim; k++) {
+            realr= qh_RANDOMint;
+            *(coord++)= 2.0 * realr/(qh_RANDOMmax+1) - 1.0;
+        }
+    }
+    *rowi= coord;
+} /* randommatrix */
+
+/*-<a                             href="qh-globa_r.htm#TOC"
+  >-------------------------------</a><a name="strtol">-</a>
+
+  qh_strtol( s, endp) qh_strtod( s, endp)
+    internal versions of strtol() and strtod()
+    does not skip trailing spaces
+  notes:
+    some implementations of strtol()/strtod() skip trailing spaces
+*/
+double qh_strtod(const char *s, char **endp) {
+  double result;
+
+  result= strtod(s, endp);
+  if (s < (*endp) && (*endp)[-1] == ' ')
+    (*endp)--;
+  return result;
+} /* strtod */
+
+int qh_strtol(const char *s, char **endp) {
+  int result;
+
+  result= (int) strtol(s, endp, 10);     /* WARN64 */
+  if (s< (*endp) && (*endp)[-1] == ' ')
+    (*endp)--;
+  return result;
+} /* strtol */
diff --git a/contrib/libs/qhull/libqhull_r/random_r.h b/contrib/libs/qhull/libqhull_r/random_r.h
new file mode 100644
index 0000000000..a17549d3b9
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/random_r.h
@@ -0,0 +1,41 @@
+/*<html><pre>  -<a                             href="qh-geom_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+  random_r.h
+    header file for random and utility routines
+
+   see qh-geom_r.htm and random_r.c
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/random_r.h#3 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+*/
+
+#ifndef qhDEFrandom
+#define qhDEFrandom 1
+
+#include "libqhull_r.h"
+
+/*============= prototypes in alphabetical order ======= */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+int     qh_argv_to_command(int argc, char *argv[], char* command, int max_size);
+int     qh_argv_to_command_size(int argc, char *argv[]);
+int     qh_rand(qhT *qh);
+void    qh_srand(qhT *qh, int seed);
+realT   qh_randomfactor(qhT *qh, realT scale, realT offset);
+void    qh_randommatrix(qhT *qh, realT *buffer, int dim, realT **row);
+int     qh_strtol(const char *s, char **endp);
+double  qh_strtod(const char *s, char **endp);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif /* qhDEFrandom */
+
+
+
diff --git a/contrib/libs/qhull/libqhull_r/rboxlib_r.c b/contrib/libs/qhull/libqhull_r/rboxlib_r.c
new file mode 100644
index 0000000000..66ceda5d64
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/rboxlib_r.c
@@ -0,0 +1,854 @@
+/*<html><pre>  -<a                             href="index_r.htm#TOC"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   rboxlib_r.c
+     Generate input points
+
+   notes:
+     For documentation, see prompt[] of rbox_r.c
+     50 points generated for 'rbox D4'
+
+   WARNING:
+     incorrect range if qh_RANDOMmax is defined wrong (user_r.h)
+*/
+
+#include "libqhull_r.h"  /* First for user_r.h */
+#include "random_r.h"
+
+#include <ctype.h>
+#include <limits.h>
+#include <math.h>
+#include <setjmp.h>
+#include <string.h>
+#include <time.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef _MSC_VER  /* Microsoft Visual C++ */
+#pragma warning( disable : 4706)  /* assignment within conditional expression. */
+#pragma warning( disable : 4996)  /* this function (strncat,sprintf,strcpy) or variable may be unsafe. */
+#endif
+
+#define MAXdim 200
+#define PI 3.1415926535897932384
+
+/* ------------------------------ prototypes ----------------*/
+int qh_roundi(qhT *qh, double a);
+void qh_out1(qhT *qh, double a);
+void qh_out2n(qhT *qh, double a, double b);
+void qh_out3n(qhT *qh, double a, double b, double c);
+void qh_outcoord(qhT *qh, int iscdd, double *coord, int dim);
+void qh_outcoincident(qhT *qh, int coincidentpoints, double radius, int iscdd, double *coord, int dim);
+void qh_rboxpoints2(qhT *qh, char* rbox_command, double **simplex);
+
+void    qh_fprintf_rbox(qhT *qh, FILE *fp, int msgcode, const char *fmt, ... );
+void    qh_free(void *mem);
+void   *qh_malloc(size_t size);
+int     qh_rand(qhT *qh);
+void    qh_srand(qhT *qh, int seed);
+
+/*-<a                             href="qh-qhull_r.htm#TOC"
+  >-------------------------------</a><a name="rboxpoints">-</a>
+
+  qh_rboxpoints(qh, rbox_command )
+    Generate points to qh.fout according to rbox options
+    Report errors on qh.ferr
+
+  returns:
+    0 (qh_ERRnone) on success
+    1 (qh_ERRinput) on input error
+    4 (qh_ERRmem) on memory error
+    5 (qh_ERRqhull) on internal error
+
+  notes:
+    To avoid using stdio, redefine qh_malloc, qh_free, and qh_fprintf_rbox (user_r.c)
+    Split out qh_rboxpoints2() to avoid -Wclobbered
+
+  design:
+    Straight line code (consider defining a struct and functions):
+
+    Parse arguments into variables
+    Determine the number of points
+    Generate the points
+*/
+int qh_rboxpoints(qhT *qh, char* rbox_command) {
+  int exitcode;
+  double *simplex;
+
+  simplex= NULL;
+  exitcode= setjmp(qh->rbox_errexit);
+  if (exitcode) {
+    /* same code for error exit and normal return.  qh.NOerrexit is set */
+    if (simplex)
+      qh_free(simplex);
+    return exitcode;
+  }
+  qh_rboxpoints2(qh, rbox_command, &simplex);
+  /* same code for error exit and normal return */
+  if (simplex)
+    qh_free(simplex);
+  return qh_ERRnone;
+} /* rboxpoints */
+
+void qh_rboxpoints2(qhT *qh, char* rbox_command, double **simplex) {
+  int i,j,k;
+  int gendim;
+  int coincidentcount=0, coincidenttotal=0, coincidentpoints=0;
+  int cubesize, diamondsize, seed=0, count, apex;
+  int dim=3, numpoints=0, totpoints, addpoints=0;
+  int issphere=0, isaxis=0,  iscdd=0, islens=0, isregular=0, iswidth=0, addcube=0;
+  int isgap=0, isspiral=0, NOcommand=0, adddiamond=0;
+  int israndom=0, istime=0;
+  int isbox=0, issimplex=0, issimplex2=0, ismesh=0;
+  double width=0.0, gap=0.0, radius=0.0, coincidentradius=0.0;
+  double coord[MAXdim], offset, meshm=3.0, meshn=4.0, meshr=5.0;
+  double *coordp, *simplexp;
+  int nthroot, mult[MAXdim];
+  double norm, factor, randr, rangap, tempr, lensangle=0, lensbase=1;
+  double anglediff, angle, x, y, cube=0.0, diamond=0.0;
+  double box= qh_DEFAULTbox; /* scale all numbers before output */
+  double randmax= qh_RANDOMmax;
+  char command[250], seedbuf[50];
+  char *s=command, *t, *first_point=NULL;
+  time_t timedata;
+
+  *command= '\0';
+  strncat(command, rbox_command, sizeof(command)-sizeof(seedbuf)-strlen(command)-1);
+
+  while (*s && !isspace(*s))  /* skip program name */
+    s++;
+  while (*s) {
+    while (*s && isspace(*s))
+      s++;
+    if (*s == '-')
+      s++;
+    if (!*s)
+      break;
+    if (isdigit(*s)) {
+      numpoints= qh_strtol(s, &s);
+      continue;
+    }
+    /* ============= read flags =============== */
+    switch (*s++) {
+    case 'c':
+      addcube= 1;
+      t= s;
+      while (isspace(*t))
+        t++;
+      if (*t == 'G')
+        cube= qh_strtod(++t, &s);
+      break;
+    case 'd':
+      adddiamond= 1;
+      t= s;
+      while (isspace(*t))
+        t++;
+      if (*t == 'G')
+        diamond= qh_strtod(++t, &s);
+      break;
+    case 'h':
+      iscdd= 1;
+      break;
+    case 'l':
+      isspiral= 1;
+      break;
+    case 'n':
+      NOcommand= 1;
+      break;
+    case 'r':
+      isregular= 1;
+      break;
+    case 's':
+      issphere= 1;
+      break;
+    case 't':
+      istime= 1;
+      if (isdigit(*s)) {
+        seed= qh_strtol(s, &s);
+        israndom= 0;
+      }else
+        israndom= 1;
+      break;
+    case 'x':
+      issimplex= 1;
+      break;
+    case 'y':
+      issimplex2= 1;
+      break;
+    case 'z':
+      qh->rbox_isinteger= 1;
+      break;
+    case 'B':
+      box= qh_strtod(s, &s);
+      isbox= 1;
+      break;
+    case 'C':
+      if (*s)
+        coincidentpoints=  qh_strtol(s, &s);
+      if (*s == ',') {
+        ++s;
+        coincidentradius=  qh_strtod(s, &s);
+      }
+      if (*s == ',') {
+        ++s;
+        coincidenttotal=  qh_strtol(s, &s);
+      }
+      if (*s && !isspace(*s)) {
+        qh_fprintf_rbox(qh, qh->ferr, 7080, "rbox error: arguments for 'Cn,r,m' are not 'int', 'float', and 'int'.  Remaining string is '%s'\n", s);
+        qh_errexit_rbox(qh, qh_ERRinput);
+      }
+      if (coincidentpoints==0){
+        qh_fprintf_rbox(qh, qh->ferr, 6268, "rbox error: missing arguments for 'Cn,r,m' where n is the number of coincident points, r is the radius (default 0.0), and m is the number of points\n");
+        qh_errexit_rbox(qh, qh_ERRinput);
+      }
+      if (coincidentpoints<0 || coincidenttotal<0 || coincidentradius<0.0){
+        qh_fprintf_rbox(qh, qh->ferr, 6269, "rbox error: negative arguments for 'Cn,m,r' where n (%d) is the number of coincident points, m (%d) is the number of points, and r (%.2g) is the radius (default 0.0)\n", coincidentpoints, coincidenttotal, coincidentradius);
+        qh_errexit_rbox(qh, qh_ERRinput);
+      }
+      break;
+    case 'D':
+      dim= qh_strtol(s, &s);
+      if (dim < 1
+      || dim > MAXdim) {
+        qh_fprintf_rbox(qh, qh->ferr, 6189, "rbox error: dimension, D%d, out of bounds (>=%d or <=0)\n", dim, MAXdim);
+        qh_errexit_rbox(qh, qh_ERRinput);
+      }
+      break;
+    case 'G':
+      if (isdigit(*s))
+        gap= qh_strtod(s, &s);
+      else
+        gap= 0.5;
+      isgap= 1;
+      break;
+    case 'L':
+      if (isdigit(*s))
+        radius= qh_strtod(s, &s);
+      else
+        radius= 10;
+      islens= 1;
+      break;
+    case 'M':
+      ismesh= 1;
+      if (*s)
+        meshn= qh_strtod(s, &s);
+      if (*s == ',') {
+        ++s;
+        meshm= qh_strtod(s, &s);
+      }else
+        meshm= 0.0;
+      if (*s == ',') {
+        ++s;
+        meshr= qh_strtod(s, &s);
+      }else
+        meshr= sqrt(meshn*meshn + meshm*meshm);
+      if (*s && !isspace(*s)) {
+        qh_fprintf_rbox(qh, qh->ferr, 7069, "rbox warning: assuming 'M3,4,5' since mesh args are not integers or reals\n");
+        meshn= 3.0, meshm=4.0, meshr=5.0;
+      }
+      break;
+    case 'O':
+      qh->rbox_out_offset= qh_strtod(s, &s);
+      break;
+    case 'P':
+      if (!first_point)
+        first_point= s - 1;
+      addpoints++;
+      while (*s && !isspace(*s))   /* read points later */
+        s++;
+      break;
+    case 'W':
+      width= qh_strtod(s, &s);
+      iswidth= 1;
+      break;
+    case 'Z':
+      if (isdigit(*s))
+        radius= qh_strtod(s, &s);
+      else
+        radius= 1.0;
+      isaxis= 1;
+      break;
+    default:
+      qh_fprintf_rbox(qh, qh->ferr, 6352, "rbox error: unknown flag at '%s'.\nExecute 'rbox' without arguments for documentation.\n", s - 1);
+      qh_errexit_rbox(qh, qh_ERRinput);
+    }
+    if (*s && !isspace(*s)) {
+      qh_fprintf_rbox(qh, qh->ferr, 6353, "rbox error: missing space between flags at %s.\n", s);
+      qh_errexit_rbox(qh, qh_ERRinput);
+    }
+  }
+
+  /* ============= defaults, constants, and sizes =============== */
+  if (qh->rbox_isinteger && !isbox)
+    box= qh_DEFAULTzbox;
+  if (addcube) {
+    tempr= floor(ldexp(1.0,dim)+0.5);
+    cubesize= (int)tempr;
+    if (cube == 0.0)
+      cube= box;
+  }else
+    cubesize= 0;
+  if (adddiamond) {
+    diamondsize= 2*dim;
+    if (diamond == 0.0)
+      diamond= box;
+  }else
+    diamondsize= 0;
+  if (islens) {
+    if (isaxis) {
+        qh_fprintf_rbox(qh, qh->ferr, 6190, "rbox error: can not combine 'Ln' with 'Zn'\n");
+        qh_errexit_rbox(qh, qh_ERRinput);
+    }
+    if (radius <= 1.0) {
+        qh_fprintf_rbox(qh, qh->ferr, 6191, "rbox error: lens radius %.2g should be greater than 1.0\n",
+               radius);
+        qh_errexit_rbox(qh, qh_ERRinput);
+    }
+    lensangle= asin(1.0/radius);
+    lensbase= radius * cos(lensangle);
+  }
+
+  if (!numpoints) {
+    if (issimplex2)
+        ; /* ok */
+    else if (isregular + issimplex + islens + issphere + isaxis + isspiral + iswidth + ismesh) {
+        qh_fprintf_rbox(qh, qh->ferr, 6192, "rbox error: missing count\n");
+        qh_errexit_rbox(qh, qh_ERRinput);
+    }else if (adddiamond + addcube + addpoints)
+        ; /* ok */
+    else {
+        numpoints= 50;  /* ./rbox D4 is the test case */
+        issphere= 1;
+    }
+  }
+  if ((issimplex + islens + isspiral + ismesh > 1)
+  || (issimplex + issphere + isspiral + ismesh > 1)) {
+    qh_fprintf_rbox(qh, qh->ferr, 6193, "rbox error: can only specify one of 'l', 's', 'x', 'Ln', or 'Mn,m,r' ('Ln s' is ok).\n");
+    qh_errexit_rbox(qh, qh_ERRinput);
+  }
+  if (coincidentpoints>0 && (numpoints == 0 || coincidenttotal > numpoints)) {
+    qh_fprintf_rbox(qh, qh->ferr, 6270, "rbox error: 'Cn,r,m' requested n coincident points for each of m points.  Either there is no points or m (%d) is greater than the number of points (%d).\n", coincidenttotal, numpoints);
+    qh_errexit_rbox(qh, qh_ERRinput);
+  }
+  if (coincidentpoints > 0 && isregular) {
+    qh_fprintf_rbox(qh, qh->ferr, 6423, "rbox error: 'Cn,r,m' is not implemented for regular points ('r')\n");
+    qh_errexit_rbox(qh, qh_ERRinput);
+  }
+
+  if (coincidenttotal == 0)
+    coincidenttotal= numpoints;
+
+  /* ============= print header with total points =============== */
+  if (issimplex || ismesh)
+    totpoints= numpoints;
+  else if (issimplex2)
+    totpoints= numpoints+dim+1;
+  else if (isregular) {
+    totpoints= numpoints;
+    if (dim == 2) {
+        if (islens)
+          totpoints += numpoints - 2;
+    }else if (dim == 3) {
+        if (islens)
+          totpoints += 2 * numpoints;
+      else if (isgap)
+        totpoints += 1 + numpoints;
+      else
+        totpoints += 2;
+    }
+  }else
+    totpoints= numpoints + isaxis;
+  totpoints += cubesize + diamondsize + addpoints;
+  totpoints += coincidentpoints*coincidenttotal;
+
+  /* ============= seed randoms =============== */
+  if (istime == 0) {
+    for (s=command; *s; s++) {
+      if (issimplex2 && *s == 'y') /* make 'y' same seed as 'x' */
+        i= 'x';
+      else
+        i= *s;
+      seed= 11*seed + i;
+    }
+  }else if (israndom) {
+    seed= (int)time(&timedata);
+    sprintf(seedbuf, " t%d", seed);  /* appends an extra t, not worth removing */
+    strncat(command, seedbuf, sizeof(command) - strlen(command) - 1);
+    t= strstr(command, " t ");
+    if (t)
+      strcpy(t+1, t+3); /* remove " t " */
+  } /* else, seed explicitly set to n */
+  qh_RANDOMseed_(qh, seed);
+
+  /* ============= print header =============== */
+
+  if (iscdd)
+      qh_fprintf_rbox(qh, qh->fout, 9391, "%s\nbegin\n        %d %d %s\n",
+      NOcommand ? "" : command,
+      totpoints, dim+1,
+      qh->rbox_isinteger ? "integer" : "real");
+  else if (NOcommand)
+      qh_fprintf_rbox(qh, qh->fout, 9392, "%d\n%d\n", dim, totpoints);
+  else
+      /* qh_fprintf_rbox special cases 9393 to append 'command' to the RboxPoints.comment() */
+      qh_fprintf_rbox(qh, qh->fout, 9393, "%d %s\n%d\n", dim, command, totpoints);
+
+  /* ============= explicit points =============== */
+  if ((s= first_point)) {
+    while (s && *s) { /* 'P' */
+      count= 0;
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      while (*++s) {
+        qh_out1(qh, qh_strtod(s, &s));
+        count++;
+        if (isspace(*s) || !*s)
+          break;
+        if (*s != ',') {
+          qh_fprintf_rbox(qh, qh->ferr, 6194, "rbox error: missing comma after coordinate in %s\n\n", s);
+          qh_errexit_rbox(qh, qh_ERRinput);
+        }
+      }
+      if (count < dim) {
+        for (k=dim-count; k--; )
+          qh_out1(qh, 0.0);
+      }else if (count > dim) {
+        qh_fprintf_rbox(qh, qh->ferr, 6195, "rbox error: %d coordinates instead of %d coordinates in %s\n\n",
+                  count, dim, s);
+        qh_errexit_rbox(qh, qh_ERRinput);
+      }
+      qh_fprintf_rbox(qh, qh->fout, 9394, "\n");
+      while ((s= strchr(s, 'P'))) {
+        if (isspace(s[-1]))
+          break;
+      }
+    }
+  }
+
+  /* ============= simplex distribution =============== */
+  if (issimplex+issimplex2) {
+    if (!(*simplex= (double *)qh_malloc( (size_t)(dim * (dim+1)) * sizeof(double)))) {
+      qh_fprintf_rbox(qh, qh->ferr, 6196, "rbox error: insufficient memory for simplex\n");
+      qh_errexit_rbox(qh, qh_ERRmem); /* qh_ERRmem */
+    }
+    simplexp= *simplex;
+    if (isregular) {
+      for (i=0; i<dim; i++) {
+        for (k=0; k<dim; k++)
+          *(simplexp++)= i==k ? 1.0 : 0.0;
+      }
+      for (k=0; k<dim; k++)
+        *(simplexp++)= -1.0;
+    }else {
+      for (i=0; i<dim+1; i++) {
+        for (k=0; k<dim; k++) {
+          randr= qh_RANDOMint;
+          *(simplexp++)= 2.0 * randr/randmax - 1.0;
+        }
+      }
+    }
+    if (issimplex2) {
+        simplexp= *simplex;
+      for (i=0; i<dim+1; i++) {
+        if (iscdd)
+          qh_out1(qh, 1.0);
+        for (k=0; k<dim; k++)
+          qh_out1(qh, *(simplexp++) * box);
+        qh_fprintf_rbox(qh, qh->fout, 9395, "\n");
+      }
+    }
+    for (j=0; j<numpoints; j++) {
+      if (iswidth)
+        apex= qh_RANDOMint % (dim+1);
+      else
+        apex= -1;
+      for (k=0; k<dim; k++)
+        coord[k]= 0.0;
+      norm= 0.0;
+      for (i=0; i<dim+1; i++) {
+        randr= qh_RANDOMint;
+        factor= randr/randmax;
+        if (i == apex)
+          factor *= width;
+        norm += factor;
+        for (k=0; k<dim; k++) {
+          simplexp= *simplex + i*dim + k;
+          coord[k] += factor * (*simplexp);
+        }
+      }
+      for (k=0; k<dim; k++)
+        coord[k] *= box/norm;
+      qh_outcoord(qh, iscdd, coord, dim);
+      if(coincidentcount++ < coincidenttotal)
+        qh_outcoincident(qh, coincidentpoints, coincidentradius, iscdd, coord, dim);
+    }
+    isregular= 0; /* continue with isbox */
+    numpoints= 0;
+  }
+
+  /* ============= mesh distribution =============== */
+  if (ismesh) {
+    nthroot= (int)(pow((double)numpoints, 1.0/dim) + 0.99999);
+    for (k=dim; k--; )
+      mult[k]= 0;
+    for (i=0; i < numpoints; i++) {
+      coordp= coord;
+      for (k=0; k < dim; k++) {
+        if (k == 0)
+          *(coordp++)= mult[0] * meshn + mult[1] * (-meshm);
+        else if (k == 1)
+          *(coordp++)= mult[0] * meshm + mult[1] * meshn;
+        else
+          *(coordp++)= mult[k] * meshr;
+      }
+      qh_outcoord(qh, iscdd, coord, dim);
+      if(coincidentcount++ < coincidenttotal)
+        qh_outcoincident(qh, coincidentpoints, coincidentradius, iscdd, coord, dim);
+      for (k=0; k < dim; k++) {
+        if (++mult[k] < nthroot)
+          break;
+        mult[k]= 0;
+      }
+    }
+  }
+  /* ============= regular points for 's' =============== */
+  else if (isregular && !islens) {
+    if (dim != 2 && dim != 3) {
+      qh_fprintf_rbox(qh, qh->ferr, 6197, "rbox error: regular points can be used only in 2-d and 3-d\n\n");
+      qh_errexit_rbox(qh, qh_ERRinput);
+    }
+    if (!isaxis || radius == 0.0) {
+      isaxis= 1;
+      radius= 1.0;
+    }
+    if (dim == 3) {
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      qh_out3n(qh, 0.0, 0.0, -box);
+      if (!isgap) {
+        if (iscdd)
+          qh_out1(qh, 1.0);
+        qh_out3n(qh, 0.0, 0.0, box);
+      }
+    }
+    angle= 0.0;
+    anglediff= 2.0 * PI/numpoints;
+    for (i=0; i < numpoints; i++) {
+      angle += anglediff;
+      x= radius * cos(angle);
+      y= radius * sin(angle);
+      if (dim == 2) {
+        if (iscdd)
+          qh_out1(qh, 1.0);
+        qh_out2n(qh, x*box, y*box);
+      }else {
+        norm= sqrt(1.0 + x*x + y*y);
+        if (iscdd)
+          qh_out1(qh, 1.0);
+        qh_out3n(qh, box*x/norm, box*y/norm, box/norm);
+        if (isgap) {
+          x *= 1-gap;
+          y *= 1-gap;
+          norm= sqrt(1.0 + x*x + y*y);
+          if (iscdd)
+            qh_out1(qh, 1.0);
+          qh_out3n(qh, box*x/norm, box*y/norm, box/norm);
+        }
+      }
+    }
+  }
+  /* ============= regular points for 'r Ln D2' =============== */
+  else if (isregular && islens && dim == 2) {
+    double cos_0;
+
+    angle= lensangle;
+    anglediff= 2 * lensangle/(numpoints - 1);
+    cos_0= cos(lensangle);
+    for (i=0; i < numpoints; i++, angle -= anglediff) {
+      x= radius * sin(angle);
+      y= radius * (cos(angle) - cos_0);
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      qh_out2n(qh, x*box, y*box);
+      if (i != 0 && i != numpoints - 1) {
+        if (iscdd)
+          qh_out1(qh, 1.0);
+        qh_out2n(qh, x*box, -y*box);
+      }
+    }
+  }
+  /* ============= regular points for 'r Ln D3' =============== */
+  else if (isregular && islens && dim != 2) {
+    if (dim != 3) {
+      qh_fprintf_rbox(qh, qh->ferr, 6198, "rbox error: regular points can be used only in 2-d and 3-d\n\n");
+      qh_errexit_rbox(qh, qh_ERRinput);
+    }
+    angle= 0.0;
+    anglediff= 2* PI/numpoints;
+    if (!isgap) {
+      isgap= 1;
+      gap= 0.5;
+    }
+    offset= sqrt(radius * radius - (1-gap)*(1-gap)) - lensbase;
+    for (i=0; i < numpoints; i++, angle += anglediff) {
+      x= cos(angle);
+      y= sin(angle);
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      qh_out3n(qh, box*x, box*y, 0.0);
+      x *= 1-gap;
+      y *= 1-gap;
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      qh_out3n(qh, box*x, box*y, box * offset);
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      qh_out3n(qh, box*x, box*y, -box * offset);
+    }
+  }
+  /* ============= apex of 'Zn' distribution + gendim =============== */
+  else {
+    if (isaxis) {
+      gendim= dim-1;
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      for (j=0; j < gendim; j++)
+        qh_out1(qh, 0.0);
+      qh_out1(qh, -box);
+      qh_fprintf_rbox(qh, qh->fout, 9398, "\n");
+    }else if (islens)
+      gendim= dim-1;
+    else
+      gendim= dim;
+    /* ============= generate random point in unit cube =============== */
+    for (i=0; i < numpoints; i++) {
+      norm= 0.0;
+      for (j=0; j < gendim; j++) {
+        randr= qh_RANDOMint;
+        coord[j]= 2.0 * randr/randmax - 1.0;
+        norm += coord[j] * coord[j];
+      }
+      norm= sqrt(norm);
+      /* ============= dim-1 point of 'Zn' distribution ========== */
+      if (isaxis) {
+        if (!isgap) {
+          isgap= 1;
+          gap= 1.0;
+        }
+        randr= qh_RANDOMint;
+        rangap= 1.0 - gap * randr/randmax;
+        factor= radius * rangap / norm;
+        for (j=0; j<gendim; j++)
+          coord[j]= factor * coord[j];
+      /* ============= dim-1 point of 'Ln s' distribution =========== */
+      }else if (islens && issphere) {
+        if (!isgap) {
+          isgap= 1;
+          gap= 1.0;
+        }
+        randr= qh_RANDOMint;
+        rangap= 1.0 - gap * randr/randmax;
+        factor= rangap / norm;
+        for (j=0; j<gendim; j++)
+          coord[j]= factor * coord[j];
+      /* ============= dim-1 point of 'Ln' distribution ========== */
+      }else if (islens && !issphere) {
+        if (!isgap) {
+          isgap= 1;
+          gap= 1.0;
+        }
+        j= qh_RANDOMint % gendim;
+        if (coord[j] < 0)
+          coord[j]= -1.0 - coord[j] * gap;
+        else
+          coord[j]= 1.0 - coord[j] * gap;
+      /* ============= point of 'l' distribution =============== */
+      }else if (isspiral) {
+        if (dim != 3) {
+          qh_fprintf_rbox(qh, qh->ferr, 6199, "rbox error: spiral distribution is available only in 3d\n\n");
+          qh_errexit_rbox(qh, qh_ERRinput);
+        }
+        coord[0]= cos(2*PI*i/(numpoints - 1));
+        coord[1]= sin(2*PI*i/(numpoints - 1));
+        coord[2]= 2.0*(double)i/(double)(numpoints - 1) - 1.0;
+      /* ============= point of 's' distribution =============== */
+      }else if (issphere) {
+        factor= 1.0/norm;
+        if (iswidth) {
+          randr= qh_RANDOMint;
+          factor *= 1.0 - width * randr/randmax;
+        }
+        for (j=0; j<dim; j++)
+          coord[j]= factor * coord[j];
+      }
+      /* ============= project 'Zn s' point in to sphere =============== */
+      if (isaxis && issphere) {
+        coord[dim-1]= 1.0;
+        norm= 1.0;
+        for (j=0; j<gendim; j++)
+          norm += coord[j] * coord[j];
+        norm= sqrt(norm);
+        for (j=0; j<dim; j++)
+          coord[j]= coord[j] / norm;
+        if (iswidth) {
+          randr= qh_RANDOMint;
+          coord[dim-1] *= 1 - width * randr/randmax;
+        }
+      /* ============= project 'Zn' point onto cube =============== */
+      }else if (isaxis && !issphere) {  /* not very interesting */
+        randr= qh_RANDOMint;
+        coord[dim-1]= 2.0 * randr/randmax - 1.0;
+      /* ============= project 'Ln' point out to sphere =============== */
+      }else if (islens) {
+        coord[dim-1]= lensbase;
+        for (j=0, norm= 0; j<dim; j++)
+          norm += coord[j] * coord[j];
+        norm= sqrt(norm);
+        for (j=0; j<dim; j++)
+          coord[j]= coord[j] * radius/ norm;
+        coord[dim-1] -= lensbase;
+        if (iswidth) {
+          randr= qh_RANDOMint;
+          coord[dim-1] *= 1 - width * randr/randmax;
+        }
+        if (qh_RANDOMint > randmax/2)
+          coord[dim-1]= -coord[dim-1];
+      /* ============= project 'Wn' point toward boundary =============== */
+      }else if (iswidth && !issphere) {
+        j= qh_RANDOMint % gendim;
+        if (coord[j] < 0)
+          coord[j]= -1.0 - coord[j] * width;
+        else
+          coord[j]= 1.0 - coord[j] * width;
+      }
+      /* ============= scale point to box =============== */
+      for (k=0; k<dim; k++)
+          coord[k]= coord[k] * box;
+
+      /* ============= write output =============== */
+      qh_outcoord(qh, iscdd, coord, dim);
+      if(coincidentcount++ < coincidenttotal)
+        qh_outcoincident(qh, coincidentpoints, coincidentradius, iscdd, coord, dim);
+    }
+  }
+
+  /* ============= write cube vertices =============== */
+  if (addcube) {
+    for (j=0; j<cubesize; j++) {
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      for (k=dim-1; k>=0; k--) {
+        if (j & ( 1 << k))
+          qh_out1(qh, cube);
+        else
+          qh_out1(qh, -cube);
+      }
+      qh_fprintf_rbox(qh, qh->fout, 9400, "\n");
+    }
+  }
+
+  /* ============= write diamond vertices =============== */
+  if (adddiamond) {
+    for (j=0; j<diamondsize; j++) {
+      if (iscdd)
+        qh_out1(qh, 1.0);
+      for (k=dim-1; k>=0; k--) {
+        if (j/2 != k)
+          qh_out1(qh, 0.0);
+        else if (j & 0x1)
+          qh_out1(qh, diamond);
+        else
+          qh_out1(qh, -diamond);
+      }
+      qh_fprintf_rbox(qh, qh->fout, 9401, "\n");
+    }
+  }
+
+  if (iscdd)
+    qh_fprintf_rbox(qh, qh->fout, 9402, "end\nhull\n");
+} /* rboxpoints2 */
+
+/*------------------------------------------------
+outxxx - output functions for qh_rboxpoints
+*/
+int qh_roundi(qhT *qh, double a) {
+  if (a < 0.0) {
+    if (a - 0.5 < INT_MIN) {
+      qh_fprintf_rbox(qh, qh->ferr, 6200, "rbox input error: negative coordinate %2.2g is too large.  Reduce 'Bn'\n", a);
+      qh_errexit_rbox(qh, qh_ERRinput);
+    }
+    return (int)(a - 0.5);
+  }else {
+    if (a + 0.5 > INT_MAX) {
+      qh_fprintf_rbox(qh, qh->ferr, 6201, "rbox input error: coordinate %2.2g is too large.  Reduce 'Bn'\n", a);
+      qh_errexit_rbox(qh, qh_ERRinput);
+    }
+    return (int)(a + 0.5);
+  }
+} /* qh_roundi */
+
+void qh_out1(qhT *qh, double a) {
+
+  if (qh->rbox_isinteger)
+    qh_fprintf_rbox(qh, qh->fout, 9403, "%d ", qh_roundi(qh, a+qh->rbox_out_offset));
+  else
+    qh_fprintf_rbox(qh, qh->fout, 9404, qh_REAL_1, a+qh->rbox_out_offset);
+} /* qh_out1 */
+
+void qh_out2n(qhT *qh, double a, double b) {
+
+  if (qh->rbox_isinteger)
+    qh_fprintf_rbox(qh, qh->fout, 9405, "%d %d\n", qh_roundi(qh, a+qh->rbox_out_offset), qh_roundi(qh, b+qh->rbox_out_offset));
+  else
+    qh_fprintf_rbox(qh, qh->fout, 9406, qh_REAL_2n, a+qh->rbox_out_offset, b+qh->rbox_out_offset);
+} /* qh_out2n */
+
+void qh_out3n(qhT *qh, double a, double b, double c) {
+
+  if (qh->rbox_isinteger)
+    qh_fprintf_rbox(qh, qh->fout, 9407, "%d %d %d\n", qh_roundi(qh, a+qh->rbox_out_offset), qh_roundi(qh, b+qh->rbox_out_offset), qh_roundi(qh, c+qh->rbox_out_offset));
+  else
+    qh_fprintf_rbox(qh, qh->fout, 9408, qh_REAL_3n, a+qh->rbox_out_offset, b+qh->rbox_out_offset, c+qh->rbox_out_offset);
+} /* qh_out3n */
+
+void qh_outcoord(qhT *qh, int iscdd, double *coord, int dim) {
+    double *p= coord;
+    int k;
+
+    if (iscdd)
+      qh_out1(qh, 1.0);
+    for (k=0; k < dim; k++)
+      qh_out1(qh, *(p++));
+    qh_fprintf_rbox(qh, qh->fout, 9396, "\n");
+} /* qh_outcoord */
+
+void qh_outcoincident(qhT *qh, int coincidentpoints, double radius, int iscdd, double *coord, int dim) {
+  double *p;
+  double randr, delta;
+  int i,k;
+  double randmax= qh_RANDOMmax;
+
+  for (i=0; i<coincidentpoints; i++) {
+    p= coord;
+    if (iscdd)
+      qh_out1(qh, 1.0);
+    for (k=0; k < dim; k++) {
+      randr= qh_RANDOMint;
+      delta= 2.0 * randr/randmax - 1.0; /* -1..+1 */
+      delta *= radius;
+      qh_out1(qh, *(p++) + delta);
+    }
+    qh_fprintf_rbox(qh, qh->fout, 9410, "\n");
+  }
+} /* qh_outcoincident */
+
+/*------------------------------------------------
+   Only called from qh_rboxpoints2 or qh_fprintf_rbox
+   qh_fprintf_rbox is only called from qh_rboxpoints2
+   The largest exitcode is '255' for compatibility with exit()
+*/
+void qh_errexit_rbox(qhT *qh, int exitcode)
+{
+    longjmp(qh->rbox_errexit, exitcode);
+} /* qh_errexit_rbox */
+
diff --git a/contrib/libs/qhull/libqhull_r/stat_r.c b/contrib/libs/qhull/libqhull_r/stat_r.c
new file mode 100644
index 0000000000..5661e010e4
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/stat_r.c
@@ -0,0 +1,727 @@
+/*<html><pre>  -<a                             href="qh-stat_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   stat_r.c
+   contains all statistics that are collected for qhull
+
+   see qh-stat_r.htm and stat_r.h
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/stat_r.c#9 $$Change: 3037 $
+   $DateTime: 2020/09/03 17:28:32 $$Author: bbarber $
+*/
+
+#include "qhull_ra.h"
+
+/*========== functions in alphabetic order ================*/
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="allstatA">-</a>
+
+  qh_allstatA()
+    define statistics in groups of 20
+
+  notes:
+    (otherwise, 'gcc -O2' uses too much memory)
+    uses qhstat.next
+*/
+void qh_allstatA(qhT *qh) {
+
+   /* zdef_(type,name,doc,average) */
+  zzdef_(zdoc, Zdoc2, "precision statistics", -1);
+  zdef_(zinc, Znewvertex, NULL, -1);
+  zdef_(wadd, Wnewvertex, "ave. distance of a new vertex to a facet", Znewvertex);
+  zzdef_(wmax, Wnewvertexmax, "max. distance of a new vertex to a facet", -1);
+  zdef_(wmax, Wvertexmax, "max. distance of an output vertex to a facet", -1);
+  zdef_(wmin, Wvertexmin, "min. distance of an output vertex to a facet", -1);
+  zdef_(wmin, Wmindenom, "min. denominator in hyperplane computation", -1);
+
+  qh->qhstat.precision= qh->qhstat.next;  /* usually call qh_joggle_restart, printed if Q0 or QJn */
+  zzdef_(zdoc, Zdoc3, "precision problems (corrected unless 'Q0' or an error)", -1);
+  zzdef_(zinc, Zcoplanarridges, "coplanar half ridges in output", -1);
+  zzdef_(zinc, Zconcaveridges, "concave half ridges in output", -1);
+  zzdef_(zinc, Zflippedfacets, "flipped facets", -1);
+  zzdef_(zinc, Zcoplanarhorizon, "coplanar horizon facets for new vertices", -1);
+  zzdef_(zinc, Zcoplanarpart, "coplanar points during partitioning", -1);
+  zzdef_(zinc, Zminnorm, "degenerate hyperplanes recomputed with gaussian elimination", -1);
+  zzdef_(zinc, Znearlysingular, "nearly singular or axis-parallel hyperplanes", -1);
+  zzdef_(zinc, Zback0, "zero divisors during back substitute", -1);
+  zzdef_(zinc, Zgauss0, "zero divisors during gaussian elimination", -1);
+  zzdef_(zinc, Zmultiridge, "dupridges with multiple neighbors", -1);
+  zzdef_(zinc, Zflipridge, "dupridges with flip facet into good neighbor", -1);
+  zzdef_(zinc, Zflipridge2, "dupridges with flip facet into good flip neighbor", -1);
+}
+void qh_allstatB(qhT *qh) {
+  zzdef_(zdoc, Zdoc1, "summary information", -1);
+  zdef_(zinc, Zvertices, "number of vertices in output", -1);
+  zdef_(zinc, Znumfacets, "number of facets in output", -1);
+  zdef_(zinc, Znonsimplicial, "number of non-simplicial facets in output", -1);
+  zdef_(zinc, Znowsimplicial, "simplicial facets that were non-simplicial", -1);
+  zdef_(zinc, Znumridges, "number of ridges in output", -1);
+  zdef_(zadd, Znumridges, "average number of ridges per facet", Znumfacets);
+  zdef_(zmax, Zmaxridges, "maximum number of ridges", -1);
+  zdef_(zadd, Znumneighbors, "average number of neighbors per facet", Znumfacets);
+  zdef_(zmax, Zmaxneighbors, "maximum number of neighbors", -1);
+  zdef_(zadd, Znumvertices, "average number of vertices per facet", Znumfacets);
+  zdef_(zmax, Zmaxvertices, "maximum number of vertices", -1);
+  zdef_(zadd, Znumvneighbors, "average number of neighbors per vertex", Zvertices);
+  zdef_(zmax, Zmaxvneighbors, "maximum number of neighbors", -1);
+  zdef_(wadd, Wcpu, "cpu seconds for qhull after input", -1);
+  zdef_(zinc, Ztotvertices, "vertices created altogether", -1);
+  zzdef_(zinc, Zsetplane, "facets created altogether", -1);
+  zdef_(zinc, Ztotridges, "ridges created altogether", -1);
+  zdef_(zinc, Zpostfacets, "facets before post merge", -1);
+  zdef_(zadd, Znummergetot, "average merges per facet (at most 511)", Znumfacets);
+  zdef_(zmax, Znummergemax, "  maximum merges for a facet (at most 511)", -1);
+  zdef_(zinc, Zangle, NULL, -1);
+  zdef_(wadd, Wangle, "average cosine (angle) of facet normals for all ridges", Zangle);
+  zdef_(wmax, Wanglemax, "  maximum cosine of facet normals (flatest) across a ridge", -1);
+  zdef_(wmin, Wanglemin, "  minimum cosine of facet normals (sharpest) across a ridge", -1);
+  zdef_(wadd, Wareatot, "total area of facets", -1);
+  zdef_(wmax, Wareamax, "  maximum facet area", -1);
+  zdef_(wmin, Wareamin, "  minimum facet area", -1);
+}
+void qh_allstatC(qhT *qh) {
+  zdef_(zdoc, Zdoc9, "build hull statistics", -1);
+  zzdef_(zinc, Zprocessed, "points processed", -1);
+  zzdef_(zinc, Zretry, "retries due to precision problems", -1);
+  zdef_(wmax, Wretrymax, "  max. random joggle", -1);
+  zdef_(zmax, Zmaxvertex, "max. vertices at any one time", -1);
+  zdef_(zinc, Ztotvisible, "ave. visible facets per iteration", Zprocessed);
+  zdef_(zinc, Zinsidevisible, "  ave. visible facets without an horizon neighbor", Zprocessed);
+  zdef_(zadd, Zvisfacettot,  "  ave. facets deleted per iteration", Zprocessed);
+  zdef_(zmax, Zvisfacetmax,  "    maximum", -1);
+  zdef_(zadd, Zvisvertextot, "ave. visible vertices per iteration", Zprocessed);
+  zdef_(zmax, Zvisvertexmax, "    maximum", -1);
+  zdef_(zinc, Ztothorizon, "ave. horizon facets per iteration", Zprocessed);
+  zdef_(zadd, Znewfacettot,  "ave. new or merged facets per iteration", Zprocessed);
+  zdef_(zmax, Znewfacetmax,  "    maximum (includes initial simplex)", -1);
+  zdef_(wadd, Wnewbalance, "average new facet balance", Zprocessed);
+  zdef_(wadd, Wnewbalance2, "  standard deviation", -1);
+  zdef_(wadd, Wpbalance, "average partition balance", Zpbalance);
+  zdef_(wadd, Wpbalance2, "  standard deviation", -1);
+  zdef_(zinc, Zpbalance,  "  count", -1);
+  zdef_(zinc, Zsearchpoints, "searches of all points for initial simplex", -1);
+  zdef_(zinc, Zdetfacetarea, "determinants for facet area", -1);
+  zdef_(zinc, Znoarea, "  determinants not computed because vertex too low", -1);
+  zdef_(zinc, Zdetsimplex, "determinants for initial hull or voronoi vertices", -1);
+  zdef_(zinc, Znotmax, "points ignored (!above max_outside)", -1);
+  zdef_(zinc, Zpinchedapex, "points ignored (pinched apex)", -1);
+  zdef_(zinc, Znotgood, "points ignored (!above a good facet)", -1);
+  zdef_(zinc, Znotgoodnew, "points ignored (didn't create a good new facet)", -1);
+  zdef_(zinc, Zgoodfacet, "good facets found", -1);
+  zzdef_(zinc, Znumvisibility, "distance tests for facet visibility", -1);
+  zdef_(zinc, Zdistvertex, "distance tests to report minimum vertex", -1);
+  zzdef_(zinc, Ztotcheck, "points checked for facets' outer planes", -1);
+  zzdef_(zinc, Zcheckpart, "  ave. distance tests per check", Ztotcheck);
+}
+void qh_allstatD(qhT *qh) {
+  zdef_(zinc, Zvisit, "resets of visit_id", -1);
+  zdef_(zinc, Zvvisit, "  resets of vertex_visit", -1);
+  zdef_(zmax, Zvisit2max, "  max visit_id/2", -1);
+  zdef_(zmax, Zvvisit2max, "  max vertex_visit/2", -1);
+
+  zdef_(zdoc, Zdoc4, "partitioning statistics (see previous for outer planes)", -1);
+  zzdef_(zadd, Zdelvertextot, "total vertices deleted", -1);
+  zdef_(zmax, Zdelvertexmax, "    maximum vertices deleted per iteration", -1);
+  zdef_(zinc, Zfindbest, "calls to findbest", -1);
+  zdef_(zadd, Zfindbesttot, " ave. facets tested", Zfindbest);
+  zdef_(zmax, Zfindbestmax, " max. facets tested", -1);
+  zdef_(zadd, Zfindcoplanar, " ave. coplanar search", Zfindbest);
+  zdef_(zinc, Zfindnew, "calls to findbestnew", -1);
+  zdef_(zadd, Zfindnewtot, " ave. facets tested", Zfindnew);
+  zdef_(zmax, Zfindnewmax, " max. facets tested", -1);
+  zdef_(zinc, Zfindnewjump, " ave. clearly better", Zfindnew);
+  zdef_(zinc, Zfindnewsharp, " calls due to qh_sharpnewfacets", -1);
+  zdef_(zinc, Zfindhorizon, "calls to findhorizon", -1);
+  zdef_(zadd, Zfindhorizontot, " ave. facets tested", Zfindhorizon);
+  zdef_(zmax, Zfindhorizonmax, " max. facets tested", -1);
+  zdef_(zinc, Zfindjump,       " ave. clearly better", Zfindhorizon);
+  zdef_(zinc, Znewbesthorizon, " new bestfacets during qh_findbesthorizon", -1);
+  zdef_(zinc, Zpartangle, "angle tests for repartitioned coplanar points", -1);
+  zdef_(zinc, Zpartcorner, "  repartitioned coplanar points above a corner facet", -1);
+  zdef_(zinc, Zparthidden, "  repartitioned coplanar points above a hidden facet", -1);
+  zdef_(zinc, Zparttwisted, "  repartitioned coplanar points above a twisted facet", -1);
+}
+void qh_allstatE(qhT *qh) {
+  zdef_(zinc, Zpartinside, "inside points", -1);
+  zdef_(zinc, Zpartnear, "  near inside points kept with a facet", -1);
+  zdef_(zinc, Zcoplanarinside, "  inside points that were coplanar with a facet", -1);
+  zdef_(zinc, Zbestlower, "calls to findbestlower", -1);
+  zdef_(zinc, Zbestlowerv, "  with search of vertex neighbors", -1);
+  zdef_(zinc, Zbestlowerall, "  with rare search of all facets", -1);
+  zdef_(zmax, Zbestloweralln, "  facets per search of all facets", -1);
+  zdef_(wadd, Wmaxout, "difference in max_outside at final check", -1);
+  zzdef_(zinc, Zpartitionall, "distance tests for initial partition", -1);
+  zdef_(zinc, Ztotpartition, "partitions of a point", -1);
+  zzdef_(zinc, Zpartition, "distance tests for partitioning", -1);
+  zzdef_(zinc, Zdistcheck, "distance tests for checking flipped facets", -1);
+  zzdef_(zinc, Zdistconvex, "distance tests for checking convexity", -1);
+  zdef_(zinc, Zdistgood, "distance tests for checking good point", -1);
+  zdef_(zinc, Zdistio, "distance tests for output", -1);
+  zdef_(zinc, Zdiststat, "distance tests for statistics", -1);
+  zzdef_(zinc, Zdistplane, "total number of distance tests", -1);
+  zdef_(zinc, Ztotpartcoplanar, "partitions of coplanar points or deleted vertices", -1);
+  zzdef_(zinc, Zpartcoplanar, "   distance tests for these partitions", -1);
+  zdef_(zinc, Zcomputefurthest, "distance tests for computing furthest", -1);
+}
+void qh_allstatE2(qhT *qh) {
+  zdef_(zdoc, Zdoc5, "statistics for matching ridges", -1);
+  zdef_(zinc, Zhashlookup, "total lookups for matching ridges of new facets", -1);
+  zdef_(zinc, Zhashtests, "average number of tests to match a ridge", Zhashlookup);
+  zdef_(zinc, Zhashridge, "total lookups of subridges (duplicates and boundary)", -1);
+  zdef_(zinc, Zhashridgetest, "average number of tests per subridge", Zhashridge);
+  zdef_(zinc, Zdupsame, "duplicated ridges in same merge cycle", -1);
+  zdef_(zinc, Zdupflip, "duplicated ridges with flipped facets", -1);
+
+  zdef_(zdoc, Zdoc6, "statistics for determining merges", -1);
+  zdef_(zinc, Zangletests, "angles computed for ridge convexity", -1);
+  zdef_(zinc, Zbestcentrum, "best merges used centrum instead of vertices",-1);
+  zzdef_(zinc, Zbestdist, "distance tests for best merge", -1);
+  zzdef_(zinc, Zcentrumtests, "distance tests for centrum convexity", -1);
+  zzdef_(zinc, Zvertextests, "distance tests for vertex convexity", -1);
+  zzdef_(zinc, Zdistzero, "distance tests for checking simplicial convexity", -1);
+  zdef_(zinc, Zcoplanarangle, "coplanar angles in getmergeset", -1);
+  zdef_(zinc, Zcoplanarcentrum, "coplanar centrums or vertices in getmergeset", -1);
+  zdef_(zinc, Zconcaveridge, "concave ridges in getmergeset", -1);
+  zdef_(zinc, Zconcavecoplanarridge, "concave-coplanar ridges in getmergeset", -1);
+  zdef_(zinc, Ztwistedridge, "twisted ridges in getmergeset", -1);
+}
+void qh_allstatF(qhT *qh) {
+  zdef_(zdoc, Zdoc7, "statistics for merging", -1);
+  zdef_(zinc, Zpremergetot, "merge iterations", -1);
+  zdef_(zadd, Zmergeinittot, "ave. initial non-convex ridges per iteration", Zpremergetot);
+  zdef_(zadd, Zmergeinitmax, "  maximum", -1);
+  zdef_(zadd, Zmergesettot, "  ave. additional non-convex ridges per iteration", Zpremergetot);
+  zdef_(zadd, Zmergesetmax, "  maximum additional in one pass", -1);
+  zdef_(zadd, Zmergeinittot2, "initial non-convex ridges for post merging", -1);
+  zdef_(zadd, Zmergesettot2, "  additional non-convex ridges", -1);
+  zdef_(wmax, Wmaxoutside, "max distance of vertex or coplanar point above facet (w/roundoff)", -1);
+  zdef_(wmin, Wminvertex, "max distance of vertex below facet (or roundoff)", -1);
+  zdef_(zinc, Zwidefacet, "centrums frozen due to a wide merge", -1);
+  zdef_(zinc, Zwidevertices, "centrums frozen due to extra vertices", -1);
+  zzdef_(zinc, Ztotmerge, "total number of facets or cycles of facets merged", -1);
+  zdef_(zinc, Zmergesimplex, "merged a simplex", -1);
+  zdef_(zinc, Zonehorizon, "simplices merged into coplanar horizon", -1);
+  zzdef_(zinc, Zcyclehorizon, "cycles of facets merged into coplanar horizon", -1);
+  zzdef_(zadd, Zcyclefacettot, "  ave. facets per cycle", Zcyclehorizon);
+  zdef_(zmax, Zcyclefacetmax, "  max. facets", -1);
+  zdef_(zinc, Zmergeintocoplanar, "new facets merged into coplanar horizon", -1);
+  zdef_(zinc, Zmergeintohorizon, "new facets merged into horizon", -1);
+  zdef_(zinc, Zmergenew, "new facets merged", -1);
+  zdef_(zinc, Zmergehorizon, "horizon facets merged into new facets", -1);
+  zdef_(zinc, Zmergevertex, "vertices deleted by merging", -1);
+  zdef_(zinc, Zcyclevertex, "vertices deleted by merging into coplanar horizon", -1);
+  zdef_(zinc, Zdegenvertex, "vertices deleted by degenerate facet", -1);
+  zdef_(zinc, Zmergeflipdup, "merges due to flipped facets in duplicated ridge", -1);
+  zdef_(zinc, Zredundant, "merges due to redundant neighbors", -1);
+  zdef_(zinc, Zredundantmerge, "  detected by qh_test_nonsimplicial_merge instead of qh_test_redundant_neighbors", -1);
+  zdef_(zadd, Ztestvneighbor, "non-convex vertex neighbors", -1);
+}
+void qh_allstatG(qhT *qh) {
+  zdef_(zinc, Zacoplanar, "merges due to angle coplanar facets", -1);
+  zdef_(wadd, Wacoplanartot, "  average merge distance", Zacoplanar);
+  zdef_(wmax, Wacoplanarmax, "  maximum merge distance", -1);
+  zdef_(zinc, Zcoplanar, "merges due to coplanar facets", -1);
+  zdef_(wadd, Wcoplanartot, "  average merge distance", Zcoplanar);
+  zdef_(wmax, Wcoplanarmax, "  maximum merge distance", -1);
+  zdef_(zinc, Zconcave, "merges due to concave facets", -1);
+  zdef_(wadd, Wconcavetot, "  average merge distance", Zconcave);
+  zdef_(wmax, Wconcavemax, "  maximum merge distance", -1);
+  zdef_(zinc, Zconcavecoplanar, "merges due to concave-coplanar facets", -1);
+  zdef_(wadd, Wconcavecoplanartot, "  average merge distance", Zconcavecoplanar);
+  zdef_(wmax, Wconcavecoplanarmax, "  maximum merge distance", -1);
+  zdef_(zinc, Zavoidold, "coplanar/concave merges due to avoiding old merge", -1);
+  zdef_(wadd, Wavoidoldtot, "  average merge distance", Zavoidold);
+  zdef_(wmax, Wavoidoldmax, "  maximum merge distance", -1);
+  zdef_(zinc, Zdegen, "merges due to degenerate facets", -1);
+  zdef_(wadd, Wdegentot, "  average merge distance", Zdegen);
+  zdef_(wmax, Wdegenmax, "  maximum merge distance", -1);
+  zdef_(zinc, Zflipped, "merges due to removing flipped facets", -1);
+  zdef_(wadd, Wflippedtot, "  average merge distance", Zflipped);
+  zdef_(wmax, Wflippedmax, "  maximum merge distance", -1);
+  zdef_(zinc, Zduplicate, "merges due to dupridges", -1);
+  zdef_(wadd, Wduplicatetot, "  average merge distance", Zduplicate);
+  zdef_(wmax, Wduplicatemax, "  maximum merge distance", -1);
+  zdef_(zinc, Ztwisted, "merges due to twisted facets", -1);
+  zdef_(wadd, Wtwistedtot, "  average merge distance", Ztwisted);
+  zdef_(wmax, Wtwistedmax, "  maximum merge distance", -1);
+}
+void qh_allstatH(qhT *qh) {
+  zdef_(zdoc, Zdoc8, "statistics for vertex merges", -1);
+  zzdef_(zinc, Zpinchduplicate, "merge pinched vertices for a duplicate ridge", -1);
+  zzdef_(zinc, Zpinchedvertex, "merge pinched vertices for a dupridge", -1);
+  zdef_(zinc, Zrenameshare, "renamed vertices shared by two facets", -1);
+  zdef_(zinc, Zrenamepinch, "renamed vertices in a pinched facet", -1);
+  zdef_(zinc, Zrenameall, "renamed vertices shared by multiple facets", -1);
+  zdef_(zinc, Zfindfail, "rename failures due to duplicated ridges", -1);
+  zdef_(zinc, Znewvertexridge, "  found new vertex in ridge", -1);
+  zdef_(zinc, Zdelridge, "deleted ridges due to renamed vertices", -1);
+  zdef_(zinc, Zdropneighbor, "dropped neighbors due to renamed vertices", -1);
+  zdef_(zinc, Zdropdegen, "merge degenerate facets due to dropped neighbors", -1);
+  zdef_(zinc, Zdelfacetdup, "  facets deleted because of no neighbors", -1);
+  zdef_(zinc, Zremvertex, "vertices removed from facets due to no ridges", -1);
+  zdef_(zinc, Zremvertexdel, "  deleted", -1);
+  zdef_(zinc, Zretryadd, "retry qh_addpoint after merge pinched vertex", -1);
+  zdef_(zadd, Zretryaddtot, "  tot. merge pinched vertex due to dupridge", -1);
+  zdef_(zmax, Zretryaddmax, "  max. merge pinched vertex for a qh_addpoint", -1);
+  zdef_(zinc, Zintersectnum, "vertex intersections for locating redundant vertices", -1);
+  zdef_(zinc, Zintersectfail, "intersections failed to find a redundant vertex", -1);
+  zdef_(zinc, Zintersect, "intersections found redundant vertices", -1);
+  zdef_(zadd, Zintersecttot, "   ave. number found per vertex", Zintersect);
+  zdef_(zmax, Zintersectmax, "   max. found for a vertex", -1);
+  zdef_(zinc, Zvertexridge, NULL, -1);
+  zdef_(zadd, Zvertexridgetot, "  ave. number of ridges per tested vertex", Zvertexridge);
+  zdef_(zmax, Zvertexridgemax, "  max. number of ridges per tested vertex", -1);
+
+  zdef_(zdoc, Zdoc10, "memory usage statistics (in bytes)", -1);
+  zdef_(zadd, Zmemfacets, "for facets and their normals, neighbor and vertex sets", -1);
+  zdef_(zadd, Zmemvertices, "for vertices and their neighbor sets", -1);
+  zdef_(zadd, Zmempoints, "for input points, outside and coplanar sets, and qhT",-1);
+  zdef_(zadd, Zmemridges, "for ridges and their vertex sets", -1);
+} /* allstat */
+
+void qh_allstatI(qhT *qh) {
+  qh->qhstat.vridges= qh->qhstat.next; /* printed in qh_produce_output2 if non-zero Zridge or Zridgemid */
+  zzdef_(zdoc, Zdoc11, "Voronoi ridge statistics", -1);
+  zzdef_(zinc, Zridge, "non-simplicial Voronoi vertices for all ridges", -1);
+  zzdef_(wadd, Wridge, "  ave. distance to ridge", Zridge);
+  zzdef_(wmax, Wridgemax, "  max. distance to ridge", -1);
+  zzdef_(zinc, Zridgemid, "bounded ridges", -1);
+  zzdef_(wadd, Wridgemid, "  ave. distance of midpoint to ridge", Zridgemid);
+  zzdef_(wmax, Wridgemidmax, "  max. distance of midpoint to ridge", -1);
+  zzdef_(zinc, Zridgeok, "bounded ridges with ok normal", -1);
+  zzdef_(wadd, Wridgeok, "  ave. angle to ridge", Zridgeok);
+  zzdef_(wmax, Wridgeokmax, "  max. angle to ridge", -1);
+  zzdef_(zinc, Zridge0, "bounded ridges with near-zero normal", -1);
+  zzdef_(wadd, Wridge0, "  ave. angle to ridge", Zridge0);
+  zzdef_(wmax, Wridge0max, "  max. angle to ridge", -1);
+
+  zdef_(zdoc, Zdoc12, "Triangulation statistics ('Qt')", -1);
+  zdef_(zinc, Ztricoplanar, "non-simplicial facets triangulated", -1);
+  zdef_(zadd, Ztricoplanartot, "  ave. new facets created (may be deleted)", Ztricoplanar);
+  zdef_(zmax, Ztricoplanarmax, "  max. new facets created", -1);
+  zdef_(zinc, Ztrinull, "null new facets deleted (duplicated vertex)", -1);
+  zdef_(zinc, Ztrimirror, "mirrored pairs of new facets deleted (same vertices)", -1);
+  zdef_(zinc, Ztridegen, "degenerate new facets in output (same ridge)", -1);
+} /* allstat */
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="allstatistics">-</a>
+
+  qh_allstatistics()
+    reset printed flag for all statistics
+*/
+void qh_allstatistics(qhT *qh) {
+  int i;
+
+  for(i=ZEND; i--; )
+    qh->qhstat.printed[i]= False;
+} /* allstatistics */
+
+#if qh_KEEPstatistics
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="collectstatistics">-</a>
+
+  qh_collectstatistics()
+    collect statistics for qh.facet_list
+
+*/
+void qh_collectstatistics(qhT *qh) {
+  facetT *facet, *neighbor, **neighborp;
+  vertexT *vertex, **vertexp;
+  realT dotproduct, dist;
+  int sizneighbors, sizridges, sizvertices, i;
+
+  qh->old_randomdist= qh->RANDOMdist;
+  qh->RANDOMdist= False;
+  zval_(Zmempoints)= qh->num_points * qh->normal_size + (int)sizeof(qhT);
+  zval_(Zmemfacets)= 0;
+  zval_(Zmemridges)= 0;
+  zval_(Zmemvertices)= 0;
+  zval_(Zangle)= 0;
+  wval_(Wangle)= 0.0;
+  zval_(Znumridges)= 0;
+  zval_(Znumfacets)= 0;
+  zval_(Znumneighbors)= 0;
+  zval_(Znumvertices)= 0;
+  zval_(Znumvneighbors)= 0;
+  zval_(Znummergetot)= 0;
+  zval_(Znummergemax)= 0;
+  zval_(Zvertices)= qh->num_vertices - qh_setsize(qh, qh->del_vertices);
+  if (qh->MERGING || qh->APPROXhull || qh->JOGGLEmax < REALmax/2)
+    wmax_(Wmaxoutside, qh->max_outside);
+  if (qh->MERGING)
+    wmin_(Wminvertex, qh->min_vertex);
+  if (!qh_checklists(qh, qh->facet_list)) {
+    qh_fprintf(qh, qh->ferr, 6373, "qhull internal error: qh_checklists failed on qh_collectstatistics\n");
+    if (!qh->ERREXITcalled)
+      qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  FORALLfacets
+    facet->seen= False;
+  if (qh->DELAUNAY) {
+    FORALLfacets {
+      if (facet->upperdelaunay != qh->UPPERdelaunay)
+        facet->seen= True; /* remove from angle statistics */
+    }
+  }
+  FORALLfacets {
+    if (facet->visible && qh->NEWfacets)
+      continue;
+    sizvertices= qh_setsize(qh, facet->vertices);
+    sizneighbors= qh_setsize(qh, facet->neighbors);
+    sizridges= qh_setsize(qh, facet->ridges);
+    zinc_(Znumfacets);
+    zadd_(Znumvertices, sizvertices);
+    zmax_(Zmaxvertices, sizvertices);
+    zadd_(Znumneighbors, sizneighbors);
+    zmax_(Zmaxneighbors, sizneighbors);
+    zadd_(Znummergetot, facet->nummerge);
+    i= facet->nummerge; /* avoid warnings */
+    zmax_(Znummergemax, i);
+    if (!facet->simplicial) {
+      if (sizvertices == qh->hull_dim) {
+        zinc_(Znowsimplicial);
+      }else {
+        zinc_(Znonsimplicial);
+      }
+    }
+    if (sizridges) {
+      zadd_(Znumridges, sizridges);
+      zmax_(Zmaxridges, sizridges);
+    }
+    zadd_(Zmemfacets, (int)sizeof(facetT) + qh->normal_size + 2*(int)sizeof(setT)
+       + SETelemsize * (sizneighbors + sizvertices));
+    if (facet->ridges) {
+      zadd_(Zmemridges,
+        (int)sizeof(setT) + SETelemsize * sizridges + sizridges *
+         ((int)sizeof(ridgeT) + (int)sizeof(setT) + SETelemsize * (qh->hull_dim-1))/2);
+    }
+    if (facet->outsideset)
+      zadd_(Zmempoints, (int)sizeof(setT) + SETelemsize * qh_setsize(qh, facet->outsideset));
+    if (facet->coplanarset)
+      zadd_(Zmempoints, (int)sizeof(setT) + SETelemsize * qh_setsize(qh, facet->coplanarset));
+    if (facet->seen) /* Delaunay upper envelope */
+      continue;
+    facet->seen= True;
+    FOREACHneighbor_(facet) {
+      if (neighbor == qh_DUPLICATEridge || neighbor == qh_MERGEridge
+          || neighbor->seen || !facet->normal || !neighbor->normal)
+        continue;
+      dotproduct= qh_getangle(qh, facet->normal, neighbor->normal);
+      zinc_(Zangle);
+      wadd_(Wangle, dotproduct);
+      wmax_(Wanglemax, dotproduct)
+      wmin_(Wanglemin, dotproduct)
+    }
+    if (facet->normal) {
+      FOREACHvertex_(facet->vertices) {
+        zinc_(Zdiststat);
+        qh_distplane(qh, vertex->point, facet, &dist);
+        wmax_(Wvertexmax, dist);
+        wmin_(Wvertexmin, dist);
+      }
+    }
+  }
+  FORALLvertices {
+    if (vertex->deleted)
+      continue;
+    zadd_(Zmemvertices, (int)sizeof(vertexT));
+    if (vertex->neighbors) {
+      sizneighbors= qh_setsize(qh, vertex->neighbors);
+      zadd_(Znumvneighbors, sizneighbors);
+      zmax_(Zmaxvneighbors, sizneighbors);
+      zadd_(Zmemvertices, (int)sizeof(vertexT) + SETelemsize * sizneighbors);
+    }
+  }
+  qh->RANDOMdist= qh->old_randomdist;
+} /* collectstatistics */
+#endif /* qh_KEEPstatistics */
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="initstatistics">-</a>
+
+  qh_initstatistics(qh)
+    initialize statistics
+
+  notes:
+    NOerrors -- qh_initstatistics can not use qh_errexit(), qh_fprintf, or qh.ferr
+    On first call, only qhmem.ferr is defined.  qh_memalloc is not setup.
+    Also invoked by QhullQh().
+*/
+void qh_initstatistics(qhT *qh) {
+  int i;
+  realT realx;
+  int intx;
+
+  qh_allstatistics(qh);
+  qh->qhstat.next= 0;
+  qh_allstatA(qh);
+  qh_allstatB(qh);
+  qh_allstatC(qh);
+  qh_allstatD(qh);
+  qh_allstatE(qh);
+  qh_allstatE2(qh);
+  qh_allstatF(qh);
+  qh_allstatG(qh);
+  qh_allstatH(qh);
+  qh_allstatI(qh);
+  if (qh->qhstat.next > (int)sizeof(qh->qhstat.id)) {
+    qh_fprintf_stderr(6184, "qhull internal error (qh_initstatistics): increase size of qhstat.id[].  qhstat.next %d should be <= sizeof(qh->qhstat.id) %d\n", 
+          qh->qhstat.next, (int)sizeof(qh->qhstat.id));
+#if 0 /* for locating error, Znumridges should be duplicated */
+    for(i=0; i < ZEND; i++) {
+      int j;
+      for(j=i+1; j < ZEND; j++) {
+        if (qh->qhstat.id[i] == qh->qhstat.id[j]) {
+          qh_fprintf_stderr(6185, "qhull error (qh_initstatistics): duplicated statistic %d at indices %d and %d\n",
+              qh->qhstat.id[i], i, j);
+        }
+      }
+    }
+#endif
+    qh_exit(qh_ERRqhull);  /* can not use qh_errexit() */
+  }
+  qh->qhstat.init[zinc].i= 0;
+  qh->qhstat.init[zadd].i= 0;
+  qh->qhstat.init[zmin].i= INT_MAX;
+  qh->qhstat.init[zmax].i= INT_MIN;
+  qh->qhstat.init[wadd].r= 0;
+  qh->qhstat.init[wmin].r= REALmax;
+  qh->qhstat.init[wmax].r= -REALmax;
+  for(i=0; i < ZEND; i++) {
+    if (qh->qhstat.type[i] > ZTYPEreal) {
+      realx= qh->qhstat.init[(unsigned char)(qh->qhstat.type[i])].r;
+      qh->qhstat.stats[i].r= realx;
+    }else if (qh->qhstat.type[i] != zdoc) {
+      intx= qh->qhstat.init[(unsigned char)(qh->qhstat.type[i])].i;
+      qh->qhstat.stats[i].i= intx;
+    }
+  }
+} /* initstatistics */
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="newstats">-</a>
+
+  qh_newstats(qh )
+    returns True if statistics for zdoc
+
+  returns:
+    next zdoc
+*/
+boolT qh_newstats(qhT *qh, int idx, int *nextindex) {
+  boolT isnew= False;
+  int start, i;
+
+  if (qh->qhstat.type[qh->qhstat.id[idx]] == zdoc)
+    start= idx+1;
+  else
+    start= idx;
+  for(i= start; i < qh->qhstat.next && qh->qhstat.type[qh->qhstat.id[i]] != zdoc; i++) {
+    if (!qh_nostatistic(qh, qh->qhstat.id[i]) && !qh->qhstat.printed[qh->qhstat.id[i]])
+        isnew= True;
+  }
+  *nextindex= i;
+  return isnew;
+} /* newstats */
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="nostatistic">-</a>
+
+  qh_nostatistic(qh, index )
+    true if no statistic to print
+*/
+boolT qh_nostatistic(qhT *qh, int i) {
+
+  if ((qh->qhstat.type[i] > ZTYPEreal
+       &&qh->qhstat.stats[i].r == qh->qhstat.init[(unsigned char)(qh->qhstat.type[i])].r)
+      || (qh->qhstat.type[i] < ZTYPEreal
+          &&qh->qhstat.stats[i].i == qh->qhstat.init[(unsigned char)(qh->qhstat.type[i])].i))
+    return True;
+  return False;
+} /* nostatistic */
+
+#if qh_KEEPstatistics
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="printallstatistics">-</a>
+
+  qh_printallstatistics(qh, fp, string )
+    print all statistics with header 'string'
+*/
+void qh_printallstatistics(qhT *qh, FILE *fp, const char *string) {
+
+  qh_allstatistics(qh);
+  qh_collectstatistics(qh);
+  qh_printstatistics(qh, fp, string);
+  qh_memstatistics(qh, fp);
+}
+
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="printstatistics">-</a>
+
+  qh_printstatistics(qh, fp, string )
+    print statistics to a file with header 'string'
+    skips statistics with qhstat.printed[] (reset with qh_allstatistics)
+
+  see:
+    qh_printallstatistics()
+*/
+void qh_printstatistics(qhT *qh, FILE *fp, const char *string) {
+  int i, k;
+  realT ave; /* ignored */
+
+  if (qh->num_points != qh->num_vertices || zval_(Zpbalance) == 0) {
+    wval_(Wpbalance)= 0.0;
+    wval_(Wpbalance2)= 0.0;
+  }else
+    wval_(Wpbalance2)= qh_stddev(qh, zval_(Zpbalance), wval_(Wpbalance),
+                                 wval_(Wpbalance2), &ave);
+  if (zval_(Zprocessed) == 0)
+    wval_(Wnewbalance2)= 0.0;
+  else
+    wval_(Wnewbalance2)= qh_stddev(qh, zval_(Zprocessed), wval_(Wnewbalance),
+                                 wval_(Wnewbalance2), &ave);
+  qh_fprintf(qh, fp, 9350, "\n\
+%s\n\
+qhull invoked by: %s | %s\n  %s with options:\n%s\n", 
+    string, qh->rbox_command, qh->qhull_command, qh_version, qh->qhull_options);
+
+  qh_fprintf(qh, fp, 9351, "\nprecision constants:\n\
+ %6.2g max. abs. coordinate in the (transformed) input ('Qbd:n')\n\
+ %6.2g max. roundoff error for distance computation ('En')\n\
+ %6.2g max. roundoff error for angle computations\n\
+ %6.2g min. distance for outside points ('Wn')\n\
+ %6.2g min. distance for visible facets ('Vn')\n\
+ %6.2g max. distance for coplanar facets ('Un')\n\
+ %6.2g max. facet width for recomputing centrum and area\n\
+",
+  qh->MAXabs_coord, qh->DISTround, qh->ANGLEround, qh->MINoutside,
+        qh->MINvisible, qh->MAXcoplanar, qh->WIDEfacet);
+  if (qh->KEEPnearinside)
+    qh_fprintf(qh, fp, 9352, "\
+ %6.2g max. distance for near-inside points\n", qh->NEARinside);
+  if (qh->premerge_cos < REALmax/2) qh_fprintf(qh, fp, 9353, "\
+ %6.2g max. cosine for pre-merge angle\n", qh->premerge_cos);
+  if (qh->PREmerge) qh_fprintf(qh, fp, 9354, "\
+ %6.2g radius of pre-merge centrum\n", qh->premerge_centrum);
+  if (qh->postmerge_cos < REALmax/2) qh_fprintf(qh, fp, 9355, "\
+ %6.2g max. cosine for post-merge angle\n", qh->postmerge_cos);
+  if (qh->POSTmerge) qh_fprintf(qh, fp, 9356, "\
+ %6.2g radius of post-merge centrum\n", qh->postmerge_centrum);
+  qh_fprintf(qh, fp, 9357, "\
+ %6.2g max. distance for merging two simplicial facets\n\
+ %6.2g max. roundoff error for arithmetic operations\n\
+ %6.2g min. denominator for division\n\
+  zero diagonal for Gauss: ", qh->ONEmerge, REALepsilon, qh->MINdenom);
+  for(k=0; k < qh->hull_dim; k++)
+    qh_fprintf(qh, fp, 9358, "%6.2e ", qh->NEARzero[k]);
+  qh_fprintf(qh, fp, 9359, "\n\n");
+  for(i=0 ; i < qh->qhstat.next; )
+    qh_printstats(qh, fp, i, &i);
+} /* printstatistics */
+#endif /* qh_KEEPstatistics */
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="printstatlevel">-</a>
+
+  qh_printstatlevel(qh, fp, id )
+    print level information for a statistic
+
+  notes:
+    nop if id >= ZEND, printed, or same as initial value
+*/
+void qh_printstatlevel(qhT *qh, FILE *fp, int id) {
+
+  if (id >= ZEND || qh->qhstat.printed[id])
+    return;
+  if (qh->qhstat.type[id] == zdoc) {
+    qh_fprintf(qh, fp, 9360, "%s\n", qh->qhstat.doc[id]);
+    return;
+  }
+  if (qh_nostatistic(qh, id) || !qh->qhstat.doc[id])
+    return;
+  qh->qhstat.printed[id]= True;
+  if (qh->qhstat.count[id] != -1
+      && qh->qhstat.stats[(unsigned char)(qh->qhstat.count[id])].i == 0)
+    qh_fprintf(qh, fp, 9361, " *0 cnt*");
+  else if (qh->qhstat.type[id] >= ZTYPEreal && qh->qhstat.count[id] == -1)
+    qh_fprintf(qh, fp, 9362, "%7.2g", qh->qhstat.stats[id].r);
+  else if (qh->qhstat.type[id] >= ZTYPEreal && qh->qhstat.count[id] != -1)
+    qh_fprintf(qh, fp, 9363, "%7.2g", qh->qhstat.stats[id].r/ qh->qhstat.stats[(unsigned char)(qh->qhstat.count[id])].i);
+  else if (qh->qhstat.type[id] < ZTYPEreal && qh->qhstat.count[id] == -1)
+    qh_fprintf(qh, fp, 9364, "%7d", qh->qhstat.stats[id].i);
+  else if (qh->qhstat.type[id] < ZTYPEreal && qh->qhstat.count[id] != -1)
+    qh_fprintf(qh, fp, 9365, "%7.3g", (realT) qh->qhstat.stats[id].i / qh->qhstat.stats[(unsigned char)(qh->qhstat.count[id])].i);
+  qh_fprintf(qh, fp, 9366, " %s\n", qh->qhstat.doc[id]);
+} /* printstatlevel */
+
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="printstats">-</a>
+
+  qh_printstats(qh, fp, index, nextindex )
+    print statistics for a zdoc group
+
+  returns:
+    next zdoc if non-null
+*/
+void qh_printstats(qhT *qh, FILE *fp, int idx, int *nextindex) {
+  int j, nexti;
+
+  if (qh_newstats(qh, idx, &nexti)) {
+    qh_fprintf(qh, fp, 9367, "\n");
+    for (j=idx; j<nexti; j++)
+      qh_printstatlevel(qh, fp, qh->qhstat.id[j]);
+  }
+  if (nextindex)
+    *nextindex= nexti;
+} /* printstats */
+
+#if qh_KEEPstatistics
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="stddev">-</a>
+
+  qh_stddev(qh, num, tot, tot2, ave )
+    compute the standard deviation and average from statistics
+
+    tot2 is the sum of the squares
+  notes:
+    computes r.m.s.:
+      (x-ave)^2
+      == x^2 - 2x tot/num +   (tot/num)^2
+      == tot2 - 2 tot tot/num + tot tot/num
+      == tot2 - tot ave
+*/
+realT qh_stddev(qhT *qh, int num, realT tot, realT tot2, realT *ave) {
+  realT stddev;
+
+  if (num <= 0) {
+    qh_fprintf(qh, qh->ferr, 7101, "qhull warning (qh_stddev): expecting num > 0.  Got num %d, tot %4.4g, tot2 %4.4g.  Returning 0.0\n",
+      num, tot, tot2);
+    return 0.0;
+  }
+  *ave= tot/num;
+  stddev= sqrt(fabs(tot2/num - *ave * *ave));
+  return stddev;
+} /* stddev */
+#else
+realT qh_stddev(qhT *qh, int num, realT tot, realT tot2, realT *ave) { /* for qhull_r-exports.def */
+  QHULL_UNUSED(qh)
+  QHULL_UNUSED(num)
+  QHULL_UNUSED(tot)
+  QHULL_UNUSED(tot2)
+  QHULL_UNUSED(ave)
+
+  return 0.0;
+}
+#endif /* qh_KEEPstatistics */
+
+#if !qh_KEEPstatistics
+void    qh_collectstatistics(qhT *qh) {}
+void    qh_printallstatistics(qhT *qh, FILE *fp, const char *string) {}
+void    qh_printstatistics(qhT *qh, FILE *fp, const char *string) {}
+#endif
+
diff --git a/contrib/libs/qhull/libqhull_r/stat_r.h b/contrib/libs/qhull/libqhull_r/stat_r.h
new file mode 100644
index 0000000000..41b6e5171d
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/stat_r.h
@@ -0,0 +1,563 @@
+/*<html><pre>  -<a                             href="qh-stat_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   stat_r.h
+     contains all statistics that are collected for qhull
+
+   see qh-stat_r.htm and stat_r.c
+
+   Copyright (c) 1993-2020 The Geometry Center.
+   $Id: //main/2019/qhull/src/libqhull_r/stat_r.h#4 $$Change: 2953 $
+   $DateTime: 2020/05/21 22:05:32 $$Author: bbarber $
+
+   recompile qhull if you change this file
+
+   Integer statistics are Z* while real statistics are W*.
+
+   define MAYdebugx to call a routine at every statistic event
+
+*/
+
+#ifndef qhDEFstat
+#define qhDEFstat 1
+
+/* Depends on realT.  Do not include "libqhull_r" to avoid circular dependency */
+
+#ifndef DEFqhT
+#define DEFqhT 1
+typedef struct qhT qhT;         /* Defined by libqhull_r.h */
+#endif
+
+#ifndef DEFqhstatT
+#define DEFqhstatT 1
+typedef struct qhstatT qhstatT; /* Defined here */
+#endif
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="KEEPstatistics">-</a>
+
+  qh_KEEPstatistics
+    0 turns off statistic reporting and gathering (except zzdef/zzinc/zzadd/zzval/wwval)
+
+  set qh_KEEPstatistics in user_r.h to 0 to turn off statistics
+*/
+#ifndef qh_KEEPstatistics
+#define qh_KEEPstatistics 1
+#endif
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="statistics">-</a>
+
+  Zxxx for integers, Wxxx for reals
+
+  notes:
+    be sure that all statistics are defined in stat_r.c
+      otherwise initialization may core dump
+    can pick up all statistics by:
+      grep '[zw].*_[(][ZW]' *.c >z.x
+    remove trailers with query">-</a>
+    remove leaders with  query-replace-regexp [ ^I]+  (
+*/
+#if qh_KEEPstatistics
+enum qh_statistics {     /* alphabetical after Z/W */
+    Zacoplanar,
+    Wacoplanarmax,
+    Wacoplanartot,
+    Zangle,
+    Wangle,
+    Wanglemax,
+    Wanglemin,
+    Zangletests,
+    Wareatot,
+    Wareamax,
+    Wareamin,
+    Zavoidold,
+    Wavoidoldmax,
+    Wavoidoldtot,
+    Zback0,
+    Zbestcentrum,
+    Zbestdist,
+    Zbestlower,
+    Zbestlowerall,
+    Zbestloweralln,
+    Zbestlowerv,
+    Zcentrumtests,
+    Zcheckpart,
+    Zcomputefurthest,
+    Zconcave,
+    Wconcavemax,
+    Wconcavetot,
+    Zconcavecoplanar,
+    Wconcavecoplanarmax,
+    Wconcavecoplanartot,
+    Zconcavecoplanarridge,
+    Zconcaveridge,
+    Zconcaveridges,
+    Zcoplanar,
+    Wcoplanarmax,
+    Wcoplanartot,
+    Zcoplanarangle,
+    Zcoplanarcentrum,
+    Zcoplanarhorizon,
+    Zcoplanarinside,
+    Zcoplanarpart,
+    Zcoplanarridges,
+    Wcpu,
+    Zcyclefacetmax,
+    Zcyclefacettot,
+    Zcyclehorizon,
+    Zcyclevertex,
+    Zdegen,
+    Wdegenmax,
+    Wdegentot,
+    Zdegenvertex,
+    Zdelfacetdup,
+    Zdelridge,
+    Zdelvertextot,
+    Zdelvertexmax,
+    Zdetfacetarea,
+    Zdetsimplex,
+    Zdistcheck,
+    Zdistconvex,
+    Zdistgood,
+    Zdistio,
+    Zdistplane,
+    Zdiststat,
+    Zdistvertex,
+    Zdistzero,
+    Zdoc1,
+    Zdoc2,
+    Zdoc3,
+    Zdoc4,
+    Zdoc5,
+    Zdoc6,
+    Zdoc7,
+    Zdoc8,
+    Zdoc9,
+    Zdoc10,
+    Zdoc11,
+    Zdoc12,
+    Zdropdegen,
+    Zdropneighbor,
+    Zdupflip,
+    Zduplicate,
+    Wduplicatemax,
+    Wduplicatetot,
+    Zdupsame,
+    Zflipped,
+    Wflippedmax,
+    Wflippedtot,
+    Zflippedfacets,
+    Zflipridge,
+    Zflipridge2,
+    Zfindbest,
+    Zfindbestmax,
+    Zfindbesttot,
+    Zfindcoplanar,
+    Zfindfail,
+    Zfindhorizon,
+    Zfindhorizonmax,
+    Zfindhorizontot,
+    Zfindjump,
+    Zfindnew,
+    Zfindnewmax,
+    Zfindnewtot,
+    Zfindnewjump,
+    Zfindnewsharp,
+    Zgauss0,
+    Zgoodfacet,
+    Zhashlookup,
+    Zhashridge,
+    Zhashridgetest,
+    Zhashtests,
+    Zinsidevisible,
+    Zintersect,
+    Zintersectfail,
+    Zintersectmax,
+    Zintersectnum,
+    Zintersecttot,
+    Zmaxneighbors,
+    Wmaxout,
+    Wmaxoutside,
+    Zmaxridges,
+    Zmaxvertex,
+    Zmaxvertices,
+    Zmaxvneighbors,
+    Zmemfacets,
+    Zmempoints,
+    Zmemridges,
+    Zmemvertices,
+    Zmergeflipdup,
+    Zmergehorizon,
+    Zmergeinittot,
+    Zmergeinitmax,
+    Zmergeinittot2,
+    Zmergeintocoplanar,
+    Zmergeintohorizon,
+    Zmergenew,
+    Zmergesettot,
+    Zmergesetmax,
+    Zmergesettot2,
+    Zmergesimplex,
+    Zmergevertex,
+    Wmindenom,
+    Wminvertex,
+    Zminnorm,
+    Zmultiridge,
+    Znearlysingular,
+    Zredundant,
+    Wnewbalance,
+    Wnewbalance2,
+    Znewbesthorizon,
+    Znewfacettot,
+    Znewfacetmax,
+    Znewvertex,
+    Wnewvertex,
+    Wnewvertexmax,
+    Znewvertexridge,
+    Znoarea,
+    Znonsimplicial,
+    Znowsimplicial,
+    Znotgood,
+    Znotgoodnew,
+    Znotmax,
+    Znumfacets,
+    Znummergemax,
+    Znummergetot,
+    Znumneighbors,
+    Znumridges,
+    Znumvertices,
+    Znumvisibility,
+    Znumvneighbors,
+    Zonehorizon,
+    Zpartangle,
+    Zpartcoplanar,
+    Zpartcorner,
+    Zparthidden,
+    Zpartinside,
+    Zpartition,
+    Zpartitionall,
+    Zpartnear,
+    Zparttwisted,
+    Zpbalance,
+    Wpbalance,
+    Wpbalance2,
+    Zpinchduplicate,
+    Zpinchedapex,
+    Zpinchedvertex,
+    Zpostfacets,
+    Zpremergetot,
+    Zprocessed,
+    Zremvertex,
+    Zremvertexdel,
+    Zredundantmerge,
+    Zrenameall,
+    Zrenamepinch,
+    Zrenameshare,
+    Zretry,
+    Wretrymax,
+    Zretryadd,
+    Zretryaddmax,
+    Zretryaddtot,
+    Zridge,
+    Wridge,
+    Wridgemax,
+    Zridge0,
+    Wridge0,
+    Wridge0max,
+    Zridgemid,
+    Wridgemid,
+    Wridgemidmax,
+    Zridgeok,
+    Wridgeok,
+    Wridgeokmax,
+    Zsearchpoints,
+    Zsetplane,
+    Ztestvneighbor,
+    Ztotcheck,
+    Ztothorizon,
+    Ztotmerge,
+    Ztotpartcoplanar,
+    Ztotpartition,
+    Ztotridges,
+    Ztotvertices,
+    Ztotvisible,
+    Ztricoplanar,
+    Ztricoplanarmax,
+    Ztricoplanartot,
+    Ztridegen,
+    Ztrimirror,
+    Ztrinull,
+    Ztwisted,
+    Wtwistedtot,
+    Wtwistedmax,
+    Ztwistedridge,
+    Zvertextests,
+    Wvertexmax,
+    Wvertexmin,
+    Zvertexridge,
+    Zvertexridgetot,
+    Zvertexridgemax,
+    Zvertices,
+    Zvisfacettot,
+    Zvisfacetmax,
+    Zvisit,
+    Zvisit2max,
+    Zvisvertextot,
+    Zvisvertexmax,
+    Zvvisit,
+    Zvvisit2max,
+    Zwidefacet,
+    Zwidevertices,
+    ZEND};
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="ZZstat">-</a>
+
+  Zxxx/Wxxx statistics that remain defined if qh_KEEPstatistics=0
+
+  notes:
+    be sure to use zzdef, zzinc, etc. with these statistics (no double checking!)
+*/
+#else
+enum qh_statistics {     /* for zzdef etc. macros */
+  Zback0,
+  Zbestdist,
+  Zcentrumtests,
+  Zcheckpart,
+  Zconcaveridges,
+  Zcoplanarhorizon,
+  Zcoplanarpart,
+  Zcoplanarridges,
+  Zcyclefacettot,
+  Zcyclehorizon,
+  Zdelvertextot,
+  Zdistcheck,
+  Zdistconvex,
+  Zdistplane,
+  Zdistzero,
+  Zdoc1,
+  Zdoc2,
+  Zdoc3,
+  Zdoc11,
+  Zflippedfacets,
+  Zflipridge,
+  Zflipridge2,
+  Zgauss0,
+  Zminnorm,
+  Zmultiridge,
+  Znearlysingular,
+  Wnewvertexmax,
+  Znumvisibility,
+  Zpartcoplanar,
+  Zpartition,
+  Zpartitionall,
+  Zpinchduplicate,
+  Zpinchedvertex,
+  Zprocessed,
+  Zretry,
+  Zridge,
+  Wridge,
+  Wridgemax,
+  Zridge0,
+  Wridge0,
+  Wridge0max,
+  Zridgemid,
+  Wridgemid,
+  Wridgemidmax,
+  Zridgeok,
+  Wridgeok,
+  Wridgeokmax,
+  Zsetplane,
+  Ztotcheck,
+  Ztotmerge,
+  Zvertextests,
+  ZEND};
+#endif
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >-------------------------------</a><a name="ztype">-</a>
+
+  ztype
+    the type of a statistic sets its initial value.
+
+  notes:
+    The type should be the same as the macro for collecting the statistic
+*/
+enum ztypes {zdoc,zinc,zadd,zmax,zmin,ZTYPEreal,wadd,wmax,wmin,ZTYPEend};
+
+/*========== macros and constants =============*/
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="MAYdebugx">-</a>
+
+  MAYdebugx
+    define as maydebug() to be called frequently for error trapping
+*/
+#define MAYdebugx
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="zdef_">-</a>
+
+  zzdef_, zdef_( type, name, doc, -1)
+    define a statistic (assumes 'qhstat.next= 0;')
+
+  zdef_( type, name, doc, count)
+    define an averaged statistic
+    printed as name/count
+*/
+#define zzdef_(stype,name,string,cnt) qh->qhstat.id[qh->qhstat.next++]=name; \
+   qh->qhstat.doc[name]= string; qh->qhstat.count[name]= cnt; qh->qhstat.type[name]= stype
+#if qh_KEEPstatistics
+#define zdef_(stype,name,string,cnt) qh->qhstat.id[qh->qhstat.next++]=name; \
+   qh->qhstat.doc[name]= string; qh->qhstat.count[name]= cnt; qh->qhstat.type[name]= stype
+#else
+#define zdef_(type,name,doc,count)
+#endif
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="zinc_">-</a>
+
+  zzinc_( name ), zinc_( name)
+    increment an integer statistic
+*/
+#define zzinc_(id) {MAYdebugx; qh->qhstat.stats[id].i++;}
+#if qh_KEEPstatistics
+#define zinc_(id) {MAYdebugx; qh->qhstat.stats[id].i++;}
+#else
+#define zinc_(id) {}
+#endif
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="zadd_">-</a>
+
+  zzadd_( name, value ), zadd_( name, value ), wadd_( name, value )
+    add value to an integer or real statistic
+*/
+#define zzadd_(id, val) {MAYdebugx; qh->qhstat.stats[id].i += (val);}
+#define wwadd_(id, val) {MAYdebugx; qh->qhstat.stats[id].r += (val);}
+#if qh_KEEPstatistics
+#define zadd_(id, val) {MAYdebugx; qh->qhstat.stats[id].i += (val);}
+#define wadd_(id, val) {MAYdebugx; qh->qhstat.stats[id].r += (val);}
+#else
+#define zadd_(id, val) {}
+#define wadd_(id, val) {}
+#endif
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="zval_">-</a>
+
+  zzval_( name ), zval_( name ), wwval_( name )
+    set or return value of a statistic
+*/
+#define zzval_(id) ((qh->qhstat.stats[id]).i)
+#define wwval_(id) ((qh->qhstat.stats[id]).r)
+#if qh_KEEPstatistics
+#define zval_(id) ((qh->qhstat.stats[id]).i)
+#define wval_(id) ((qh->qhstat.stats[id]).r)
+#else
+#define zval_(id) qh->qhstat.tempi
+#define wval_(id) qh->qhstat.tempr
+#endif
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="zmax_">-</a>
+
+  zmax_( id, val ), wmax_( id, value )
+    maximize id with val
+*/
+#define wwmax_(id, val) {MAYdebugx; maximize_(qh->qhstat.stats[id].r,(val));}
+#if qh_KEEPstatistics
+#define zmax_(id, val) {MAYdebugx; maximize_(qh->qhstat.stats[id].i,(val));}
+#define wmax_(id, val) {MAYdebugx; maximize_(qh->qhstat.stats[id].r,(val));}
+#else
+#define zmax_(id, val) {}
+#define wmax_(id, val) {}
+#endif
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="zmin_">-</a>
+
+  zmin_( id, val ), wmin_( id, value )
+    minimize id with val
+*/
+#if qh_KEEPstatistics
+#define zmin_(id, val) {MAYdebugx; minimize_(qh->qhstat.stats[id].i,(val));}
+#define wmin_(id, val) {MAYdebugx; minimize_(qh->qhstat.stats[id].r,(val));}
+#else
+#define zmin_(id, val) {}
+#define wmin_(id, val) {}
+#endif
+
+/*================== stat_r.h types ==============*/
+
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="intrealT">-</a>
+
+  intrealT
+    union of integer and real, used for statistics
+*/
+typedef union intrealT intrealT;    /* union of int and realT */
+union intrealT {
+    int i;
+    realT r;
+};
+
+/*-<a                             href="qh-stat_r.htm#TOC"
+  >--------------------------------</a><a name="qhstat">-</a>
+
+  qhstat
+    Data structure for statistics, similar to qh and qhrbox
+
+    Allocated as part of qhT (libqhull_r.h)
+*/
+
+struct qhstatT {
+  intrealT   stats[ZEND];     /* integer and real statistics */
+  unsigned char id[ZEND+10];  /* id's in print order */
+  const char *doc[ZEND];      /* array of documentation strings */
+  short int  count[ZEND];     /* -1 if none, else index of count to use */
+  char       type[ZEND];      /* type, see ztypes above */
+  char       printed[ZEND];   /* true, if statistic has been printed */
+  intrealT   init[ZTYPEend];  /* initial values by types, set initstatistics */
+
+  int        next;            /* next index for zdef_ */
+  int        precision;       /* index for precision problems, printed on qh_errexit and qh_produce_output2/Q0/QJn */
+  int        vridges;         /* index for Voronoi ridges, printed on qh_produce_output2 */
+  int        tempi;
+  realT      tempr;
+};
+
+/*========== function prototypes ===========*/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void    qh_allstatA(qhT *qh);
+void    qh_allstatB(qhT *qh);
+void    qh_allstatC(qhT *qh);
+void    qh_allstatD(qhT *qh);
+void    qh_allstatE(qhT *qh);
+void    qh_allstatE2(qhT *qh);
+void    qh_allstatF(qhT *qh);
+void    qh_allstatG(qhT *qh);
+void    qh_allstatH(qhT *qh);
+void    qh_allstatI(qhT *qh);
+void    qh_allstatistics(qhT *qh);
+void    qh_collectstatistics(qhT *qh);
+void    qh_initstatistics(qhT *qh);
+boolT   qh_newstats(qhT *qh, int idx, int *nextindex);
+boolT   qh_nostatistic(qhT *qh, int i);
+void    qh_printallstatistics(qhT *qh, FILE *fp, const char *string);
+void    qh_printstatistics(qhT *qh, FILE *fp, const char *string);
+void    qh_printstatlevel(qhT *qh, FILE *fp, int id);
+void    qh_printstats(qhT *qh, FILE *fp, int idx, int *nextindex);
+realT   qh_stddev(qhT *qh, int num, realT tot, realT tot2, realT *ave);
+
+#ifdef __cplusplus
+} /* extern "C" */
+#endif
+
+#endif   /* qhDEFstat */
diff --git a/contrib/libs/qhull/libqhull_r/user_r.c b/contrib/libs/qhull/libqhull_r/user_r.c
new file mode 100644
index 0000000000..f41b4057da
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/user_r.c
@@ -0,0 +1,640 @@
+/*<html><pre>  -<a                             href="qh-user_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   user_r.c
+   user redefinable functions
+
+   see user2_r.c for qh_fprintf, qh_malloc, qh_free
+
+   see README.txt  see COPYING.txt for copyright information.
+
+   see libqhull_r.h for data structures, macros, and user-callable functions.
+
+   see user_eg_r.c, user_eg2_r.c, and unix_r.c for examples.
+
+   see user_r.h for user-definable constants
+
+      use qh_NOmem in mem_r.h to turn off memory management
+      use qh_NOmerge in user_r.h to turn off facet merging
+      set qh_KEEPstatistics in user_r.h to 0 to turn off statistics
+
+   This is unsupported software.  You're welcome to make changes,
+   but you're on your own if something goes wrong.  Use 'Tc' to
+   check frequently.  Usually qhull will report an error if
+   a data structure becomes inconsistent.  If so, it also reports
+   the last point added to the hull, e.g., 102.  You can then trace
+   the execution of qhull with "T4P102".
+
+   Please report any errors that you fix to qhull@qhull.org
+
+   Qhull-template is a template for calling qhull from within your application
+
+   if you recompile and load this module, then user.o will not be loaded
+   from qhull.a
+
+   you can add additional quick allocation sizes in qh_user_memsizes
+
+   if the other functions here are redefined to not use qh_print...,
+   then io.o will not be loaded from qhull.a.  See user_eg_r.c for an
+   example.  We recommend keeping io.o for the extra debugging
+   information it supplies.
+*/
+
+#include "qhull_ra.h"
+
+#include <stdarg.h>
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="qhull_template">-</a>
+
+  Qhull-template
+    Template for calling qhull from inside your program
+
+  returns:
+    exit code(see qh_ERR... in libqhull_r.h)
+    all memory freed
+
+  notes:
+    This can be called any number of times.
+*/
+#if 0
+{
+  int dim;                  /* dimension of points */
+  int numpoints;            /* number of points */
+  coordT *points;           /* array of coordinates for each point */
+  boolT ismalloc;           /* True if qhull should free points in qh_freeqhull() or reallocation */
+  char flags[]= "qhull Tv"; /* option flags for qhull, see html/qh-quick.htm */
+  FILE *outfile= stdout;    /* output from qh_produce_output
+                               use NULL to skip qh_produce_output */
+  FILE *errfile= stderr;    /* error messages from qhull code */
+  int exitcode;             /* 0 if no error from qhull */
+  facetT *facet;            /* set by FORALLfacets */
+  int curlong, totlong;     /* memory remaining after qh_memfreeshort */
+
+  qhT qh_qh;                /* Qhull's data structure.  First argument of most calls */
+  qhT *qh= &qh_qh;          /* Alternatively -- qhT *qh= (qhT *)malloc(sizeof(qhT)) */
+
+  QHULL_LIB_CHECK /* Check for compatible library */
+
+  qh_zero(qh, errfile);
+
+  /* initialize dim, numpoints, points[], ismalloc here */
+  exitcode= qh_new_qhull(qh, dim, numpoints, points, ismalloc,
+                      flags, outfile, errfile);
+  if (!exitcode) {                  /* if no error */
+    /* 'qh->facet_list' contains the convex hull */
+    FORALLfacets {
+       /* ... your code ... */
+    }
+  }
+  qh_freeqhull(qh, !qh_ALL);
+  qh_memfreeshort(qh, &curlong, &totlong);
+  if (curlong || totlong)
+    qh_fprintf(qh, errfile, 7079, "qhull internal warning (main): did not free %d bytes of long memory(%d pieces)\n", totlong, curlong);
+}
+#endif
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="new_qhull">-</a>
+
+  qh_new_qhull(qh, dim, numpoints, points, ismalloc, qhull_cmd, outfile, errfile )
+    Run qhull
+    Before first call, either call qh_zero(qh, errfile), or set qh to all zero.
+
+  returns:
+    results in qh
+    exitcode (0 if no errors).
+
+  notes:
+    do not modify points until finished with results.
+      The qhull data structure contains pointers into the points array.
+    do not call qhull functions before qh_new_qhull().
+      The qhull data structure is not initialized until qh_new_qhull().
+    do not call qh_init_A (global_r.c)
+
+    Default errfile is stderr, outfile may be null
+    qhull_cmd must start with "qhull "
+    projects points to a new point array for Delaunay triangulations ('d' and 'v')
+    transforms points into a new point array for halfspace intersection ('H')
+
+  see:
+    Qhull-template at the beginning of this file.
+    An example of using qh_new_qhull is user_eg_r.c
+*/
+int qh_new_qhull(qhT *qh, int dim, int numpoints, coordT *points, boolT ismalloc,
+                char *qhull_cmd, FILE *outfile, FILE *errfile) {
+  return qh_new_qhull_feaspoint(qh, dim, numpoints, points, ismalloc,
+                                qhull_cmd, outfile, errfile, NULL);
+}
+
+int qh_new_qhull_feaspoint(qhT *qh, int dim, int numpoints, coordT *points, boolT ismalloc,
+                char *qhull_cmd, FILE *outfile, FILE *errfile, coordT* feaspoint) {
+  /* gcc may issue a "might be clobbered" warning for dim, points, and ismalloc [-Wclobbered].
+     These parameters are not referenced after a longjmp() and hence not clobbered.
+     See http://stackoverflow.com/questions/7721854/what-sense-do-these-clobbered-variable-warnings-make */
+  int exitcode, hulldim;
+  boolT new_ismalloc;
+  coordT *new_points;
+
+  if(!errfile){
+    errfile= stderr;
+  }
+  if (!qh->qhmem.ferr) {
+    qh_meminit(qh, errfile);
+  } else {
+    qh_memcheck(qh);
+  }
+  if (strncmp(qhull_cmd, "qhull ", (size_t)6) && strcmp(qhull_cmd, "qhull") != 0) {
+    qh_fprintf(qh, errfile, 6186, "qhull error (qh_new_qhull): start qhull_cmd argument with \"qhull \" or set to \"qhull\"\n");
+    return qh_ERRinput;
+  }
+  qh_initqhull_start(qh, NULL, outfile, errfile);
+  if(numpoints==0 && points==NULL){
+      trace1((qh, qh->ferr, 1047, "qh_new_qhull: initialize Qhull\n"));
+      return 0;
+  }
+  trace1((qh, qh->ferr, 1044, "qh_new_qhull: build new Qhull for %d %d-d points with %s\n", numpoints, dim, qhull_cmd));
+  exitcode= setjmp(qh->errexit);
+  if (!exitcode) {
+    qh->NOerrexit= False;
+    qh_initflags(qh, qhull_cmd);
+    if (qh->DELAUNAY)
+      qh->PROJECTdelaunay= True;
+    if (qh->HALFspace) {
+      /* points is an array of halfspaces,
+         the last coordinate of each halfspace is its offset */
+      hulldim= dim-1;
+      if(feaspoint)
+      {
+        if (!(qh->feasible_point= (pointT*)qh_malloc(hulldim * sizeof(coordT)))) {
+          qh_fprintf(qh, qh->ferr, 6079, "qhull error: insufficient memory for 'Hn,n,n'\n");
+          qh_errexit(qh, qh_ERRmem, NULL, NULL);
+        }
+        coordT* coords = qh->feasible_point;
+        coordT* value = feaspoint;
+        int i;
+        for(i = 0; i < hulldim; ++i)
+        {
+          *(coords++) = *(value++);
+        }
+      }
+      else
+      {
+        qh_setfeasible(qh, hulldim);
+      }
+      new_points= qh_sethalfspace_all(qh, dim, numpoints, points, qh->feasible_point);
+      new_ismalloc= True;
+      if (ismalloc)
+        qh_free(points);
+    }else {
+      hulldim= dim;
+      new_points= points;
+      new_ismalloc= ismalloc;
+    }
+    qh_init_B(qh, new_points, numpoints, hulldim, new_ismalloc);
+    qh_qhull(qh);
+    qh_check_output(qh);
+    if (outfile) {
+      qh_produce_output(qh);
+    }else {
+      qh_prepare_output(qh);
+    }
+    if (qh->VERIFYoutput && !qh->FORCEoutput && !qh->STOPadd && !qh->STOPcone && !qh->STOPpoint)
+      qh_check_points(qh);
+  }
+  qh->NOerrexit= True;
+  return exitcode;
+} /* new_qhull */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="errexit">-</a>
+
+  qh_errexit(qh, exitcode, facet, ridge )
+    report and exit from an error
+    report facet and ridge if non-NULL
+    reports useful information such as last point processed
+    set qh.FORCEoutput to print neighborhood of facet
+
+  see:
+    qh_errexit2() in libqhull_r.c for printing 2 facets
+
+  design:
+    check for error within error processing
+    compute qh.hulltime
+    print facet and ridge (if any)
+    report commandString, options, qh.furthest_id
+    print summary and statistics (including precision statistics)
+    if qh_ERRsingular
+      print help text for singular data set
+    exit program via long jump (if defined) or exit()
+*/
+void qh_errexit(qhT *qh, int exitcode, facetT *facet, ridgeT *ridge) {
+
+  qh->tracefacet= NULL;  /* avoid infinite recursion through qh_fprintf */
+  qh->traceridge= NULL;
+  qh->tracevertex= NULL;
+  if (qh->ERREXITcalled) {
+    qh_fprintf(qh, qh->ferr, 8126, "\nqhull error while handling previous error in qh_errexit.  Exit program\n");
+    qh_exit(qh_ERRother);
+  }
+  qh->ERREXITcalled= True;
+  if (!qh->QHULLfinished)
+    qh->hulltime= qh_CPUclock - qh->hulltime;
+  qh_errprint(qh, "ERRONEOUS", facet, NULL, ridge, NULL);
+  qh_option(qh, "_maxoutside", NULL, &qh->MAXoutside);
+  qh_fprintf(qh, qh->ferr, 8127, "\nWhile executing: %s | %s\n", qh->rbox_command, qh->qhull_command);
+  qh_fprintf(qh, qh->ferr, 8128, "Options selected for Qhull %s:\n%s\n", qh_version, qh->qhull_options);
+  if (qh->furthest_id >= 0) {
+    qh_fprintf(qh, qh->ferr, 8129, "Last point added to hull was p%d.", qh->furthest_id);
+    if (zzval_(Ztotmerge))
+      qh_fprintf(qh, qh->ferr, 8130, "  Last merge was #%d.", zzval_(Ztotmerge));
+    if (qh->QHULLfinished)
+      qh_fprintf(qh, qh->ferr, 8131, "\nQhull has finished constructing the hull.");
+    else if (qh->POSTmerging)
+      qh_fprintf(qh, qh->ferr, 8132, "\nQhull has started post-merging.");
+    qh_fprintf(qh, qh->ferr, 8133, "\n");
+  }
+  if (qh->FORCEoutput && (qh->QHULLfinished || (!facet && !ridge)))
+    qh_produce_output(qh);
+  else if (exitcode != qh_ERRinput) {
+    if (exitcode != qh_ERRsingular && zzval_(Zsetplane) > qh->hull_dim+1) {
+      qh_fprintf(qh, qh->ferr, 8134, "\nAt error exit:\n");
+      qh_printsummary(qh, qh->ferr);
+      if (qh->PRINTstatistics) {
+        qh_collectstatistics(qh);
+        qh_allstatistics(qh);
+        qh_printstatistics(qh, qh->ferr, "at error exit");
+        qh_memstatistics(qh, qh->ferr);
+      }
+    }
+    if (qh->PRINTprecision)
+      qh_printstats(qh, qh->ferr, qh->qhstat.precision, NULL);
+  }
+  if (!exitcode)
+    exitcode= qh_ERRother;
+  else if (exitcode == qh_ERRprec && !qh->PREmerge)
+    qh_printhelp_degenerate(qh, qh->ferr);
+  else if (exitcode == qh_ERRqhull)
+    qh_printhelp_internal(qh, qh->ferr);
+  else if (exitcode == qh_ERRsingular)
+    qh_printhelp_singular(qh, qh->ferr);
+  else if (exitcode == qh_ERRdebug)
+    qh_fprintf(qh, qh->ferr, 8016, "qhull exit due to qh_ERRdebug\n");
+  else if (exitcode == qh_ERRtopology || exitcode == qh_ERRwide || exitcode == qh_ERRprec) {
+    if (qh->NOpremerge && !qh->MERGING)
+      qh_printhelp_degenerate(qh, qh->ferr);
+    else if (exitcode == qh_ERRtopology)
+      qh_printhelp_topology(qh, qh->ferr);
+    else if (exitcode == qh_ERRwide)
+      qh_printhelp_wide(qh, qh->ferr);
+  }else if (exitcode > 255) {
+    qh_fprintf(qh, qh->ferr, 6426, "qhull internal error (qh_errexit): exit code %d is greater than 255.  Invalid argument for exit().  Replaced with 255\n", exitcode);
+    exitcode= 255;
+  }
+  if (qh->NOerrexit) {
+    qh_fprintf(qh, qh->ferr, 6187, "qhull internal error (qh_errexit): either error while reporting error QH%d, or qh.NOerrexit not cleared after setjmp(). Exit program with error status %d\n",
+         qh->last_errcode, exitcode);
+    qh_exit(exitcode);
+  }
+  qh->ERREXITcalled= False;
+  qh->NOerrexit= True;
+  qh->ALLOWrestart= False;  /* longjmp will undo qh_build_withrestart */
+  longjmp(qh->errexit, exitcode);
+} /* errexit */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="errprint">-</a>
+
+  qh_errprint(qh, fp, string, atfacet, otherfacet, atridge, atvertex )
+    prints out the information of facets and ridges to fp
+    also prints neighbors and geomview output
+
+  notes:
+    except for string, any parameter may be NULL
+*/
+void qh_errprint(qhT *qh, const char *string, facetT *atfacet, facetT *otherfacet, ridgeT *atridge, vertexT *atvertex) {
+  int i;
+
+  if (atvertex) {
+    qh_fprintf(qh, qh->ferr, 8138, "%s VERTEX:\n", string);
+    qh_printvertex(qh, qh->ferr, atvertex);
+  }
+  if (atridge) {
+    qh_fprintf(qh, qh->ferr, 8137, "%s RIDGE:\n", string);
+    qh_printridge(qh, qh->ferr, atridge);
+    if (!atfacet)
+      atfacet= atridge->top;
+    if (!otherfacet)
+      otherfacet= otherfacet_(atridge, atfacet);
+    if (atridge->top && atridge->top != atfacet && atridge->top != otherfacet)
+      qh_printfacet(qh, qh->ferr, atridge->top);
+    if (atridge->bottom && atridge->bottom != atfacet && atridge->bottom != otherfacet)
+      qh_printfacet(qh, qh->ferr, atridge->bottom);
+  }
+  if (atfacet) {
+    qh_fprintf(qh, qh->ferr, 8135, "%s FACET:\n", string);
+    qh_printfacet(qh, qh->ferr, atfacet);
+  }
+  if (otherfacet) {
+    qh_fprintf(qh, qh->ferr, 8136, "%s OTHER FACET:\n", string);
+    qh_printfacet(qh, qh->ferr, otherfacet);
+  }
+  if (qh->fout && qh->FORCEoutput && atfacet && !qh->QHULLfinished && !qh->IStracing) {
+    qh_fprintf(qh, qh->ferr, 8139, "ERRONEOUS and NEIGHBORING FACETS to output\n");
+    for (i=0; i < qh_PRINTEND; i++)  /* use fout for geomview output */
+      qh_printneighborhood(qh, qh->fout, qh->PRINTout[i], atfacet, otherfacet,
+                            !qh_ALL);
+  }
+} /* errprint */
+
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="printfacetlist">-</a>
+
+  qh_printfacetlist(qh, fp, facetlist, facets, printall )
+    print all fields for a facet list and/or set of facets to fp
+    if !printall,
+      only prints good facets
+
+  notes:
+    also prints all vertices
+*/
+void qh_printfacetlist(qhT *qh, facetT *facetlist, setT *facets, boolT printall) {
+  facetT *facet, **facetp;
+
+  if (facetlist)
+    qh_checklists(qh, facetlist);
+  qh_fprintf(qh, qh->ferr, 9424, "printfacetlist: vertices\n");
+  qh_printbegin(qh, qh->ferr, qh_PRINTfacets, facetlist, facets, printall);
+  if (facetlist) {
+    qh_fprintf(qh, qh->ferr, 9413, "printfacetlist: facetlist\n");
+    FORALLfacet_(facetlist)
+      qh_printafacet(qh, qh->ferr, qh_PRINTfacets, facet, printall);
+  }
+  if (facets) {
+    qh_fprintf(qh, qh->ferr, 9414, "printfacetlist: %d facets\n", qh_setsize(qh, facets));
+    FOREACHfacet_(facets)
+      qh_printafacet(qh, qh->ferr, qh_PRINTfacets, facet, printall);
+  }
+  qh_fprintf(qh, qh->ferr, 9412, "printfacetlist: end\n");
+  qh_printend(qh, qh->ferr, qh_PRINTfacets, facetlist, facets, printall);
+} /* printfacetlist */
+
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="printhelp_degenerate">-</a>
+
+  qh_printhelp_degenerate(qh, fp )
+    prints descriptive message for precision error with qh_ERRprec
+
+  notes:
+    no message if qh_QUICKhelp
+*/
+void qh_printhelp_degenerate(qhT *qh, FILE *fp) {
+
+  if (qh->MERGEexact || qh->PREmerge || qh->JOGGLEmax < REALmax/2)
+    qh_fprintf(qh, fp, 9368, "\n\
+A Qhull error has occurred.  Qhull should have corrected the above\n\
+precision error.  Please send the input and all of the output to\n\
+qhull_bug@qhull.org\n");
+  else if (!qh_QUICKhelp) {
+    qh_fprintf(qh, fp, 9369, "\n\
+Precision problems were detected during construction of the convex hull.\n\
+This occurs because convex hull algorithms assume that calculations are\n\
+exact, but floating-point arithmetic has roundoff errors.\n\
+\n\
+To correct for precision problems, do not use 'Q0'.  By default, Qhull\n\
+selects 'C-0' or 'Qx' and merges non-convex facets.  With option 'QJ',\n\
+Qhull joggles the input to prevent precision problems.  See \"Imprecision\n\
+in Qhull\" (qh-impre.htm).\n\
+\n\
+If you use 'Q0', the output may include\n\
+coplanar ridges, concave ridges, and flipped facets.  In 4-d and higher,\n\
+Qhull may produce a ridge with four neighbors or two facets with the same \n\
+vertices.  Qhull reports these events when they occur.  It stops when a\n\
+concave ridge, flipped facet, or duplicate facet occurs.\n");
+#if REALfloat
+    qh_fprintf(qh, fp, 9370, "\
+\n\
+Qhull is currently using single precision arithmetic.  The following\n\
+will probably remove the precision problems:\n\
+  - recompile qhull for realT precision(#define REALfloat 0 in user_r.h).\n");
+#endif
+    if (qh->DELAUNAY && !qh->SCALElast && qh->MAXabs_coord > 1e4)
+      qh_fprintf(qh, fp, 9371, "\
+\n\
+When computing the Delaunay triangulation of coordinates > 1.0,\n\
+  - use 'Qbb' to scale the last coordinate to [0,m] (max previous coordinate)\n");
+    if (qh->DELAUNAY && !qh->ATinfinity)
+      qh_fprintf(qh, fp, 9372, "\
+When computing the Delaunay triangulation:\n\
+  - use 'Qz' to add a point at-infinity.  This reduces precision problems.\n");
+
+    qh_fprintf(qh, fp, 9373, "\
+\n\
+If you need triangular output:\n\
+  - use option 'Qt' to triangulate the output\n\
+  - use option 'QJ' to joggle the input points and remove precision errors\n\
+  - use option 'Ft'.  It triangulates non-simplicial facets with added points.\n\
+\n\
+If you must use 'Q0',\n\
+try one or more of the following options.  They can not guarantee an output.\n\
+  - use 'QbB' to scale the input to a cube.\n\
+  - use 'Po' to produce output and prevent partitioning for flipped facets\n\
+  - use 'V0' to set min. distance to visible facet as 0 instead of roundoff\n\
+  - use 'En' to specify a maximum roundoff error less than %2.2g.\n\
+  - options 'Qf', 'Qbb', and 'QR0' may also help\n",
+               qh->DISTround);
+    qh_fprintf(qh, fp, 9374, "\
+\n\
+To guarantee simplicial output:\n\
+  - use option 'Qt' to triangulate the output\n\
+  - use option 'QJ' to joggle the input points and remove precision errors\n\
+  - use option 'Ft' to triangulate the output by adding points\n\
+  - use exact arithmetic (see \"Imprecision in Qhull\", qh-impre.htm)\n\
+");
+  }
+} /* printhelp_degenerate */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="printhelp_internal">-</a>
+
+  qh_printhelp_internal(qh, fp )
+    prints descriptive message for qhull internal error with qh_ERRqhull
+
+  notes:
+    no message if qh_QUICKhelp
+*/
+void qh_printhelp_internal(qhT *qh, FILE *fp) {
+
+  if (!qh_QUICKhelp) {
+    qh_fprintf(qh, fp, 9426, "\n\
+A Qhull internal error has occurred.  Please send the input and output to\n\
+qhull_bug@qhull.org. If you can duplicate the error with logging ('T4z'), please\n\
+include the log file.\n");
+  }
+} /* printhelp_internal */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="printhelp_narrowhull">-</a>
+
+  qh_printhelp_narrowhull(qh, minangle )
+    Warn about a narrow hull
+
+  notes:
+    Alternatively, reduce qh_WARNnarrow in user_r.h
+
+*/
+void qh_printhelp_narrowhull(qhT *qh, FILE *fp, realT minangle) {
+
+    qh_fprintf(qh, fp, 7089, "qhull precision warning: The initial hull is narrow.  Is the input lower\n\
+dimensional (e.g., a square in 3-d instead of a cube)?  Cosine of the minimum\n\
+angle is %.16f.  If so, Qhull may produce a wide facet.\n\
+Options 'Qs' (search all points), 'Qbb' (scale last coordinate), or\n\
+'QbB' (scale to unit box) may remove this warning.\n\
+See 'Limitations' in qh-impre.htm.  Use 'Pp' to skip this warning.\n",
+          -minangle);   /* convert from angle between normals to angle between facets */
+} /* printhelp_narrowhull */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="printhelp_singular">-</a>
+
+  qh_printhelp_singular(qh, fp )
+    prints descriptive message for singular input
+*/
+void qh_printhelp_singular(qhT *qh, FILE *fp) {
+  facetT *facet;
+  vertexT *vertex, **vertexp;
+  realT min, max, *coord, dist;
+  int i,k;
+
+  qh_fprintf(qh, fp, 9376, "\n\
+The input to qhull appears to be less than %d dimensional, or a\n\
+computation has overflowed.\n\n\
+Qhull could not construct a clearly convex simplex from points:\n",
+           qh->hull_dim);
+  qh_printvertexlist(qh, fp, "", qh->facet_list, NULL, qh_ALL);
+  if (!qh_QUICKhelp)
+    qh_fprintf(qh, fp, 9377, "\n\
+The center point is coplanar with a facet, or a vertex is coplanar\n\
+with a neighboring facet.  The maximum round off error for\n\
+computing distances is %2.2g.  The center point, facets and distances\n\
+to the center point are as follows:\n\n", qh->DISTround);
+  qh_printpointid(qh, fp, "center point", qh->hull_dim, qh->interior_point, qh_IDunknown);
+  qh_fprintf(qh, fp, 9378, "\n");
+  FORALLfacets {
+    qh_fprintf(qh, fp, 9379, "facet");
+    FOREACHvertex_(facet->vertices)
+      qh_fprintf(qh, fp, 9380, " p%d", qh_pointid(qh, vertex->point));
+    zinc_(Zdistio);
+    qh_distplane(qh, qh->interior_point, facet, &dist);
+    qh_fprintf(qh, fp, 9381, " distance= %4.2g\n", dist);
+  }
+  if (!qh_QUICKhelp) {
+    if (qh->HALFspace)
+      qh_fprintf(qh, fp, 9382, "\n\
+These points are the dual of the given halfspaces.  They indicate that\n\
+the intersection is degenerate.\n");
+    qh_fprintf(qh, fp, 9383,"\n\
+These points either have a maximum or minimum x-coordinate, or\n\
+they maximize the determinant for k coordinates.  Trial points\n\
+are first selected from points that maximize a coordinate.\n");
+    if (qh->hull_dim >= qh_INITIALmax)
+      qh_fprintf(qh, fp, 9384, "\n\
+Because of the high dimension, the min x-coordinate and max-coordinate\n\
+points are used if the determinant is non-zero.  Option 'Qs' will\n\
+do a better, though much slower, job.  Instead of 'Qs', you can change\n\
+the points by randomly rotating the input with 'QR0'.\n");
+  }
+  qh_fprintf(qh, fp, 9385, "\nThe min and max coordinates for each dimension are:\n");
+  for (k=0; k < qh->hull_dim; k++) {
+    min= REALmax;
+    max= -REALmin;
+    for (i=qh->num_points, coord= qh->first_point+k; i--; coord += qh->hull_dim) {
+      maximize_(max, *coord);
+      minimize_(min, *coord);
+    }
+    qh_fprintf(qh, fp, 9386, "  %d:  %8.4g  %8.4g  difference= %4.4g\n", k, min, max, max-min);
+  }
+  if (!qh_QUICKhelp) {
+    qh_fprintf(qh, fp, 9387, "\n\
+If the input should be full dimensional, you have several options that\n\
+may determine an initial simplex:\n\
+  - use 'QJ'  to joggle the input and make it full dimensional\n\
+  - use 'QbB' to scale the points to the unit cube\n\
+  - use 'QR0' to randomly rotate the input for different maximum points\n\
+  - use 'Qs'  to search all points for the initial simplex\n\
+  - use 'En'  to specify a maximum roundoff error less than %2.2g.\n\
+  - trace execution with 'T3' to see the determinant for each point.\n",
+                     qh->DISTround);
+#if REALfloat
+    qh_fprintf(qh, fp, 9388, "\
+  - recompile qhull for realT precision(#define REALfloat 0 in libqhull_r.h).\n");
+#endif
+    qh_fprintf(qh, fp, 9389, "\n\
+If the input is lower dimensional:\n\
+  - use 'QJ' to joggle the input and make it full dimensional\n\
+  - use 'Qbk:0Bk:0' to delete coordinate k from the input.  You should\n\
+    pick the coordinate with the least range.  The hull will have the\n\
+    correct topology.\n\
+  - determine the flat containing the points, rotate the points\n\
+    into a coordinate plane, and delete the other coordinates.\n\
+  - add one or more points to make the input full dimensional.\n\
+");
+  }
+} /* printhelp_singular */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="printhelp_topology">-</a>
+
+  qh_printhelp_topology(qh, fp )
+    prints descriptive message for qhull topology error with qh_ERRtopology
+
+  notes:
+    no message if qh_QUICKhelp
+*/
+void qh_printhelp_topology(qhT *qh, FILE *fp) {
+
+  if (!qh_QUICKhelp) {
+    qh_fprintf(qh, fp, 9427, "\n\
+A Qhull topology error has occurred.  Qhull did not recover from facet merges and vertex merges.\n\
+This usually occurs when the input is nearly degenerate and substantial merging has occurred.\n\
+See http://www.qhull.org/html/qh-impre.htm#limit\n");
+  }
+} /* printhelp_topology */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="printhelp_wide">-</a>
+
+  qh_printhelp_wide(qh, fp )
+    prints descriptive message for qhull wide facet with qh_ERRwide
+
+  notes:
+    no message if qh_QUICKhelp
+*/
+void qh_printhelp_wide(qhT *qh, FILE *fp) {
+
+  if (!qh_QUICKhelp) {
+    qh_fprintf(qh, fp, 9428, "\n\
+A wide merge error has occurred.  Qhull has produced a wide facet due to facet merges and vertex merges.\n\
+This usually occurs when the input is nearly degenerate and substantial merging has occurred.\n\
+See http://www.qhull.org/html/qh-impre.htm#limit\n");
+  }
+} /* printhelp_wide */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="user_memsizes">-</a>
+
+  qh_user_memsizes(qh)
+    allocate up to 10 additional, quick allocation sizes
+
+  notes:
+    increase maximum number of allocations in qh_initqhull_mem()
+*/
+void qh_user_memsizes(qhT *qh) {
+
+  QHULL_UNUSED(qh)
+  /* qh_memsize(qh, size); */
+} /* user_memsizes */
+
+
diff --git a/contrib/libs/qhull/libqhull_r/user_r.h b/contrib/libs/qhull/libqhull_r/user_r.h
new file mode 100644
index 0000000000..8c100fac09
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/user_r.h
@@ -0,0 +1,1060 @@
+/*<html><pre>  -<a                             href="qh-user_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   user_r.h
+   user redefinable constants
+
+   for each source file, user_r.h is included first
+
+   see qh-user_r.htm.  see COPYING for copyright information.
+
+   See user_r.c for sample code.
+
+   before reading any code, review libqhull_r.h for data structure definitions
+
+Sections:
+   ============= qhull library constants ======================
+   ============= data types and configuration macros ==========
+   ============= performance related constants ================
+   ============= memory constants =============================
+   ============= joggle constants =============================
+   ============= conditional compilation ======================
+   ============= merge constants ==============================
+   ============= Microsoft DevStudio ==========================
+
+Code flags --
+  NOerrors -- the code does not call qh_errexit()
+  WARN64 -- the code may be incompatible with 64-bit pointers
+
+*/
+
+#include <float.h>
+#include <limits.h>
+#include <time.h>
+
+#ifndef qhDEFuser
+#define qhDEFuser 1
+
+/* Derived from Qt's corelib/global/qglobal.h */
+#if !defined(SAG_COM) && !defined(__CYGWIN__) && (defined(WIN64) || defined(_WIN64) || defined(__WIN64__) || defined(WIN32) || defined(_WIN32) || defined(__WIN32__) || defined(__NT__))
+#   define QHULL_OS_WIN
+#elif defined(__MWERKS__) && defined(__INTEL__) /* Metrowerks discontinued before the release of Intel Macs */
+#   define QHULL_OS_WIN
+#endif
+
+/*============================================================*/
+/*============= qhull library constants ======================*/
+/*============================================================*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="filenamelen">-</a>
+
+  FILENAMElen -- max length for TI and TO filenames
+
+*/
+
+#define qh_FILENAMElen 500
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="msgcode">-</a>
+
+  msgcode -- Unique message codes for qh_fprintf
+
+  If add new messages, assign these values and increment in user.h and user_r.h
+  See QhullError.h for 10000 error codes.
+  Cannot use '0031' since it would be octal
+
+  def counters =  [31/32/33/38, 1067, 2113, 3079, 4097, 5006,
+     6429, 7027/7028/7035/7068/7070/7102, 8163, 9428, 10000, 11034]
+
+  See: qh_ERR* [libqhull_r.h]
+*/
+
+#define MSG_TRACE0     0   /* always include if logging ('Tn') */
+#define MSG_TRACE1  1000
+#define MSG_TRACE2  2000
+#define MSG_TRACE3  3000
+#define MSG_TRACE4  4000
+#define MSG_TRACE5  5000
+#define MSG_ERROR   6000   /* errors written to qh.ferr */
+#define MSG_WARNING 7000
+#define MSG_STDERR  8000   /* log messages Written to qh.ferr */
+#define MSG_OUTPUT  9000
+#define MSG_QHULL_ERROR 10000 /* errors thrown by QhullError.cpp (QHULLlastError is in QhullError.h) */
+#define MSG_FIX    11000   /* Document as 'QH11... FIX: ...' */
+#define MSG_MAXLEN  3000   /* qh_printhelp_degenerate() in user_r.c */
+
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="qh_OPTIONline">-</a>
+
+  qh_OPTIONline -- max length of an option line 'FO'
+*/
+#define qh_OPTIONline 80
+
+/*============================================================*/
+/*============= data types and configuration macros ==========*/
+/*============================================================*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="realT">-</a>
+
+  realT
+    set the size of floating point numbers
+
+  qh_REALdigits
+    maximimum number of significant digits
+
+  qh_REAL_1, qh_REAL_2n, qh_REAL_3n
+    format strings for printf
+
+  qh_REALmax, qh_REALmin
+    maximum and minimum (near zero) values
+
+  qh_REALepsilon
+    machine roundoff.  Maximum roundoff error for addition and multiplication.
+
+  notes:
+   Select whether to store floating point numbers in single precision (float)
+   or double precision (double).
+
+   Use 'float' to save about 8% in time and 25% in space.  This is particularly
+   helpful if high-d where convex hulls are space limited.  Using 'float' also
+   reduces the printed size of Qhull's output since numbers have 8 digits of
+   precision.
+
+   Use 'double' when greater arithmetic precision is needed.  This is needed
+   for Delaunay triangulations and Voronoi diagrams when you are not merging
+   facets.
+
+   If 'double' gives insufficient precision, your data probably includes
+   degeneracies.  If so you should use facet merging (done by default)
+   or exact arithmetic (see imprecision section of manual, qh-impre.htm).
+   You may also use option 'Po' to force output despite precision errors.
+
+   You may use 'long double', but many format statements need to be changed
+   and you may need a 'long double' square root routine.  S. Grundmann
+   (sg@eeiwzb.et.tu-dresden.de) has done this.  He reports that the code runs
+   much slower with little gain in precision.
+
+   WARNING: on some machines,    int f(){realT a= REALmax;return (a == REALmax);}
+      returns False.  Use (a > REALmax/2) instead of (a == REALmax).
+
+   REALfloat =   1      all numbers are 'float' type
+             =   0      all numbers are 'double' type
+*/
+#define REALfloat 0
+
+#if (REALfloat == 1)
+#define realT float
+#define REALmax FLT_MAX
+#define REALmin FLT_MIN
+#define REALepsilon FLT_EPSILON
+#define qh_REALdigits 8   /* maximum number of significant digits */
+#define qh_REAL_1 "%6.8g "
+#define qh_REAL_2n "%6.8g %6.8g\n"
+#define qh_REAL_3n "%6.8g %6.8g %6.8g\n"
+
+#elif (REALfloat == 0)
+#define realT double
+#define REALmax DBL_MAX
+#define REALmin DBL_MIN
+#define REALepsilon DBL_EPSILON
+#define qh_REALdigits 16    /* maximum number of significant digits */
+#define qh_REAL_1 "%6.16g "
+#define qh_REAL_2n "%6.16g %6.16g\n"
+#define qh_REAL_3n "%6.16g %6.16g %6.16g\n"
+
+#else
+#error unknown float option
+#endif
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="countT">-</a>
+
+  countT
+    The type for counts and identifiers (e.g., the number of points, vertex identifiers)
+    Currently used by C++ code-only.  Decided against using it for setT because most sets are small.
+
+    Defined as 'int' for C-code compatibility and QH11026
+
+    QH11026 FIX: countT may be defined as a 'unsigned int', but several code issues need to be solved first.  See countT in Changes.txt
+*/
+
+#ifndef DEFcountT
+#define DEFcountT 1
+typedef int countT;
+#endif
+#define COUNTmax INT_MAX
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="qh_POINTSmax">-</a>
+
+  qh_POINTSmax
+    Maximum number of points for qh.num_points and point allocation in qh_readpoints
+*/
+#define qh_POINTSmax (INT_MAX-16)
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="CPUclock">-</a>
+
+  qh_CPUclock
+    define the clock() function for reporting the total time spent by Qhull
+    returns CPU ticks as a 'long int'
+    qh_CPUclock is only used for reporting the total time spent by Qhull
+
+  qh_SECticks
+    the number of clock ticks per second
+
+  notes:
+    looks for CLOCKS_PER_SEC, CLOCKS_PER_SECOND, or assumes microseconds
+    to define a custom clock, set qh_CLOCKtype to 0
+
+    if your system does not use clock() to return CPU ticks, replace
+    qh_CPUclock with the corresponding function.  It is converted
+    to 'unsigned long' to prevent wrap-around during long runs.  By default,
+    <time.h> defines clock_t as 'long'
+
+   Set qh_CLOCKtype to
+
+     1          for CLOCKS_PER_SEC, CLOCKS_PER_SECOND, or microsecond
+                Note:  may fail if more than 1 hour elapsed time
+
+     2          use qh_clock() with POSIX times() (see global_r.c)
+*/
+#define qh_CLOCKtype 1  /* change to the desired number */
+
+#if (qh_CLOCKtype == 1)
+
+#if defined(CLOCKS_PER_SECOND)
+#define qh_CPUclock    ((unsigned long)clock())  /* return CPU clock, may be converted to approximate double */
+#define qh_SECticks CLOCKS_PER_SECOND
+
+#elif defined(CLOCKS_PER_SEC)
+#define qh_CPUclock    ((unsigned long)clock())  /* return CPU clock, may be converted to approximate double */
+#define qh_SECticks CLOCKS_PER_SEC
+
+#elif defined(CLK_TCK)
+#define qh_CPUclock    ((unsigned long)clock())  /* return CPU clock, may be converted to approximate double */
+#define qh_SECticks CLK_TCK
+
+#else
+#define qh_CPUclock    ((unsigned long)clock())  /* return CPU clock, may be converted to approximate double */
+#define qh_SECticks 1E6
+#endif
+
+#elif (qh_CLOCKtype == 2)
+#define qh_CPUclock    qh_clock()  /* return CPU clock, may be converted to approximate double */
+#define qh_SECticks 100
+
+#else /* qh_CLOCKtype == ? */
+#error unknown clock option
+#endif
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RANDOM">-</a>
+
+  qh_RANDOMtype, qh_RANDOMmax, qh_RANDOMseed
+    define random number generator
+
+    qh_RANDOMint generates a random integer between 0 and qh_RANDOMmax.
+    qh_RANDOMseed sets the random number seed for qh_RANDOMint
+
+  Set qh_RANDOMtype (default 5) to:
+    1       for random() with 31 bits (UCB)
+    2       for rand() with RAND_MAX or 15 bits (system 5)
+    3       for rand() with 31 bits (Sun)
+    4       for lrand48() with 31 bits (Solaris)
+    5       for qh_rand(qh) with 31 bits (included with Qhull, requires 'qh')
+
+  notes:
+    Random numbers are used by rbox to generate point sets.  Random
+    numbers are used by Qhull to rotate the input ('QRn' option),
+    simulate a randomized algorithm ('Qr' option), and to simulate
+    roundoff errors ('Rn' option).
+
+    Random number generators differ between systems.  Most systems provide
+    rand() but the period varies.  The period of rand() is not critical
+    since qhull does not normally use random numbers.
+
+    The default generator is Park & Miller's minimal standard random
+    number generator [CACM 31:1195 '88].  It is included with Qhull.
+
+    If qh_RANDOMmax is wrong, qhull will report a warning and Geomview
+    output will likely be invisible.
+*/
+#define qh_RANDOMtype 5   /* *** change to the desired number *** */
+
+#if (qh_RANDOMtype == 1)
+#define qh_RANDOMmax ((realT)0x7fffffffUL)  /* 31 bits, random()/MAX */
+#define qh_RANDOMint random()
+#define qh_RANDOMseed_(qh, seed) srandom(seed);
+
+#elif (qh_RANDOMtype == 2)
+#ifdef RAND_MAX
+#define qh_RANDOMmax ((realT)RAND_MAX)
+#else
+#define qh_RANDOMmax ((realT)32767)   /* 15 bits (System 5) */
+#endif
+#define qh_RANDOMint  rand()
+#define qh_RANDOMseed_(qh, seed) srand((unsigned int)seed);
+
+#elif (qh_RANDOMtype == 3)
+#define qh_RANDOMmax ((realT)0x7fffffffUL)  /* 31 bits, Sun */
+#define qh_RANDOMint  rand()
+#define qh_RANDOMseed_(qh, seed) srand((unsigned int)seed);
+
+#elif (qh_RANDOMtype == 4)
+#define qh_RANDOMmax ((realT)0x7fffffffUL)  /* 31 bits, lrand38()/MAX */
+#define qh_RANDOMint lrand48()
+#define qh_RANDOMseed_(qh, seed) srand48(seed);
+
+#elif (qh_RANDOMtype == 5)  /* 'qh' is an implicit parameter */
+#define qh_RANDOMmax ((realT)2147483646UL)  /* 31 bits, qh_rand/MAX */
+#define qh_RANDOMint qh_rand(qh)
+#define qh_RANDOMseed_(qh, seed) qh_srand(qh, seed);
+/* unlike rand(), never returns 0 */
+
+#else
+#error: unknown random option
+#endif
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="ORIENTclock">-</a>
+
+  qh_ORIENTclock
+    0 for inward pointing normals by Geomview convention
+*/
+#define qh_ORIENTclock 0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RANDOMdist">-</a>
+
+  qh_RANDOMdist
+    define for random perturbation of qh_distplane and qh_setfacetplane (qh.RANDOMdist, 'QRn')
+
+  For testing qh.DISTround.  Qhull should not depend on computations always producing the same roundoff error 
+
+  #define qh_RANDOMdist 1e-13
+*/
+
+/*============================================================*/
+/*============= joggle constants =============================*/
+/*============================================================*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="JOGGLEdefault">-</a>
+
+  qh_JOGGLEdefault
+    default qh.JOGGLEmax is qh.DISTround * qh_JOGGLEdefault
+
+  notes:
+    rbox s r 100 | qhull QJ1e-15 QR0 generates 90% faults at distround 7e-16
+    rbox s r 100 | qhull QJ1e-14 QR0 generates 70% faults
+    rbox s r 100 | qhull QJ1e-13 QR0 generates 35% faults
+    rbox s r 100 | qhull QJ1e-12 QR0 generates 8% faults
+    rbox s r 100 | qhull QJ1e-11 QR0 generates 1% faults
+    rbox s r 100 | qhull QJ1e-10 QR0 generates 0% faults
+    rbox 1000 W0 | qhull QJ1e-12 QR0 generates 86% faults
+    rbox 1000 W0 | qhull QJ1e-11 QR0 generates 20% faults
+    rbox 1000 W0 | qhull QJ1e-10 QR0 generates 2% faults
+    the later have about 20 points per facet, each of which may interfere
+
+    pick a value large enough to avoid retries on most inputs
+*/
+#define qh_JOGGLEdefault 30000.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="JOGGLEincrease">-</a>
+
+  qh_JOGGLEincrease
+    factor to increase qh.JOGGLEmax on qh_JOGGLEretry or qh_JOGGLEagain
+*/
+#define qh_JOGGLEincrease 10.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="JOGGLEretry">-</a>
+
+  qh_JOGGLEretry
+    if ZZretry = qh_JOGGLEretry, increase qh.JOGGLEmax
+
+notes:
+try twice at the original value in case of bad luck the first time
+*/
+#define qh_JOGGLEretry 2
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="JOGGLEagain">-</a>
+
+  qh_JOGGLEagain
+    every following qh_JOGGLEagain, increase qh.JOGGLEmax
+
+  notes:
+    1 is OK since it's already failed qh_JOGGLEretry times
+*/
+#define qh_JOGGLEagain 1
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="JOGGLEmaxincrease">-</a>
+
+  qh_JOGGLEmaxincrease
+    maximum qh.JOGGLEmax due to qh_JOGGLEincrease
+    relative to qh.MAXwidth
+
+  notes:
+    qh.joggleinput will retry at this value until qh_JOGGLEmaxretry
+*/
+#define qh_JOGGLEmaxincrease 1e-2
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="JOGGLEmaxretry">-</a>
+
+  qh_JOGGLEmaxretry
+    stop after qh_JOGGLEmaxretry attempts
+*/
+#define qh_JOGGLEmaxretry 50
+
+/*============================================================*/
+/*============= performance related constants ================*/
+/*============================================================*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="HASHfactor">-</a>
+
+  qh_HASHfactor
+    total hash slots / used hash slots.  Must be at least 1.1.
+
+  notes:
+    =2 for at worst 50% occupancy for qh.hash_table and normally 25% occupancy
+*/
+#define qh_HASHfactor 2
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="VERIFYdirect">-</a>
+
+  qh_VERIFYdirect
+    with 'Tv' verify all points against all facets if op count is smaller
+
+  notes:
+    if greater, calls qh_check_bestdist() instead
+*/
+#define qh_VERIFYdirect 1000000
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="INITIALsearch">-</a>
+
+  qh_INITIALsearch
+     if qh_INITIALmax, search points up to this dimension
+*/
+#define qh_INITIALsearch 6
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="INITIALmax">-</a>
+
+  qh_INITIALmax
+    if dim >= qh_INITIALmax, use min/max coordinate points for initial simplex
+
+  notes:
+    from points with non-zero determinants
+    use option 'Qs' to override (much slower)
+*/
+#define qh_INITIALmax 8
+
+/*============================================================*/
+/*============= memory constants =============================*/
+/*============================================================*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MEMalign">-</a>
+
+  qh_MEMalign
+    memory alignment for qh_meminitbuffers() in global_r.c
+
+  notes:
+    to avoid bus errors, memory allocation must consider alignment requirements.
+    malloc() automatically takes care of alignment.   Since mem_r.c manages
+    its own memory, we need to explicitly specify alignment in
+    qh_meminitbuffers().
+
+    A safe choice is sizeof(double).  sizeof(float) may be used if doubles
+    do not occur in data structures and pointers are the same size.  Be careful
+    of machines (e.g., DEC Alpha) with large pointers.
+
+    If using gcc, best alignment is [fmax_() is defined in geom_r.h]
+              #define qh_MEMalign fmax_(__alignof__(realT),__alignof__(void *))
+*/
+#define qh_MEMalign ((int)(fmax_(sizeof(realT), sizeof(void *))))
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MEMbufsize">-</a>
+
+  qh_MEMbufsize
+    size of additional memory buffers
+
+  notes:
+    used for qh_meminitbuffers() in global_r.c
+*/
+#define qh_MEMbufsize 0x10000       /* allocate 64K memory buffers */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MEMinitbuf">-</a>
+
+  qh_MEMinitbuf
+    size of initial memory buffer
+
+  notes:
+    use for qh_meminitbuffers() in global_r.c
+*/
+#define qh_MEMinitbuf 0x20000      /* initially allocate 128K buffer */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="INFINITE">-</a>
+
+  qh_INFINITE
+    on output, indicates Voronoi center at infinity
+*/
+#define qh_INFINITE  -10.101
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="DEFAULTbox">-</a>
+
+  qh_DEFAULTbox
+    default box size (Geomview expects 0.5)
+
+  qh_DEFAULTbox
+    default box size for integer coorindate (rbox only)
+*/
+#define qh_DEFAULTbox 0.5
+#define qh_DEFAULTzbox 1e6
+
+/*============================================================*/
+/*============= conditional compilation ======================*/
+/*============================================================*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="compiler">-</a>
+
+  __cplusplus
+    defined by C++ compilers
+
+  __MSC_VER
+    defined by Microsoft Visual C++
+
+  __MWERKS__ && __INTEL__
+    defined by Metrowerks when compiling for Windows (not Intel-based Macintosh)
+
+  __MWERKS__ && __POWERPC__
+    defined by Metrowerks when compiling for PowerPC-based Macintosh
+
+  __STDC__
+    defined for strict ANSI C
+*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="COMPUTEfurthest">-</a>
+
+  qh_COMPUTEfurthest
+    compute furthest distance to an outside point instead of storing it with the facet
+    =1 to compute furthest
+
+  notes:
+    computing furthest saves memory but costs time
+      about 40% more distance tests for partitioning
+      removes facet->furthestdist
+*/
+#define qh_COMPUTEfurthest 0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="KEEPstatistics">-</a>
+
+  qh_KEEPstatistics
+    =0 removes most of statistic gathering and reporting
+
+  notes:
+    if 0, code size is reduced by about 4%.
+*/
+#define qh_KEEPstatistics 1
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MAXoutside">-</a>
+
+  qh_MAXoutside
+    record outer plane for each facet
+    =1 to record facet->maxoutside
+
+  notes:
+    this takes a realT per facet and slightly slows down qhull
+    it produces better outer planes for geomview output
+*/
+#define qh_MAXoutside 1
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="NOmerge">-</a>
+
+  qh_NOmerge
+    disables facet merging if defined
+    For MSVC compiles, use qhull_r-exports-nomerge.def instead of qhull_r-exports.def
+
+  notes:
+    This saves about 25% space, 30% space in combination with qh_NOtrace, 
+    and 36% with qh_NOtrace and qh_KEEPstatistics 0
+
+    Unless option 'Q0' is used
+      qh_NOmerge sets 'QJ' to avoid precision errors
+
+  see:
+    <a href="mem_r.h#NOmem">qh_NOmem</a> in mem_r.h
+
+    see user_r.c/user_eg.c for removing io_r.o
+
+  #define qh_NOmerge
+*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="NOtrace">-</a>
+
+  qh_NOtrace
+    no tracing if defined
+    disables 'Tn', 'TMn', 'TPn' and 'TWn'
+    override with 'Qw' for qh_addpoint tracing and various other items
+
+  notes:
+    This saves about 15% space.
+    Removes all traceN((...)) code and substantial sections of qh.IStracing code
+
+  #define qh_NOtrace
+*/
+
+#if 0  /* sample code */
+    exitcode= qh_new_qhull(qhT *qh, dim, numpoints, points, ismalloc,
+                      flags, outfile, errfile);
+    qh_freeqhull(qhT *qh, !qh_ALL); /* frees long memory used by second call */
+    qh_memfreeshort(qhT *qh, &curlong, &totlong);  /* frees short memory and memory allocator */
+#endif
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="QUICKhelp">-</a>
+
+  qh_QUICKhelp
+    =1 to use abbreviated help messages, e.g., for degenerate inputs
+*/
+#define qh_QUICKhelp    0
+
+/*============================================================*/
+/*============= merge constants ==============================*/
+/*============================================================*/
+/*
+   These constants effect facet merging.  You probably will not need
+   to modify them.  They effect the performance of facet merging.
+*/
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="BESTcentrum">-</a>
+
+  qh_BESTcentrum
+     if > 2*dim+n vertices, qh_findbestneighbor() tests centrums (faster)
+     else, qh_findbestneighbor() tests all vertices (much better merges)
+
+  qh_BESTcentrum2
+     if qh_BESTcentrum2 * DIM3 + BESTcentrum < #vertices tests centrums
+*/
+#define qh_BESTcentrum 20
+#define qh_BESTcentrum2 2
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="BESTnonconvex">-</a>
+
+  qh_BESTnonconvex
+    if > dim+n neighbors, qh_findbestneighbor() tests nonconvex ridges.
+
+  notes:
+    It is needed because qh_findbestneighbor is slow for large facets
+*/
+#define qh_BESTnonconvex 15
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="COPLANARratio">-</a>
+
+  qh_COPLANARratio
+    for 3-d+ merging, qh.MINvisible is n*premerge_centrum
+
+  notes:
+    for non-merging, it's DISTround
+*/
+#define qh_COPLANARratio 3
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="DIMmergeVertex">-</a>
+
+  qh_DIMmergeVertex
+    max dimension for vertex merging (it is not effective in high-d)
+*/
+#define qh_DIMmergeVertex 6
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="DIMreduceBuild">-</a>
+
+  qh_DIMreduceBuild
+     max dimension for vertex reduction during build (slow in high-d)
+*/
+#define qh_DIMreduceBuild 5
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="DISToutside">-</a>
+
+  qh_DISToutside
+    When is a point clearly outside of a facet?
+    Stops search in qh_findbestnew or qh_partitionall
+    qh_findbest uses qh.MINoutside since since it is only called if no merges.
+
+  notes:
+    'Qf' always searches for best facet
+    if !qh.MERGING, same as qh.MINoutside.
+    if qh_USEfindbestnew, increase value since neighboring facets may be ill-behaved
+      [Note: Zdelvertextot occurs normally with interior points]
+            RBOX 1000 s Z1 G1e-13 t1001188774 | QHULL Tv
+    When there is a sharp edge, need to move points to a
+    clearly good facet; otherwise may be lost in another partitioning.
+    if too big then O(n^2) behavior for partitioning in cone
+    if very small then important points not processed
+    Needed in qh_partitionall for
+      RBOX 1000 s Z1 G1e-13 t1001032651 | QHULL Tv
+    Needed in qh_findbestnew for many instances of
+      RBOX 1000 s Z1 G1e-13 t | QHULL Tv
+
+  See:
+    qh_DISToutside -- when is a point clearly outside of a facet
+    qh_SEARCHdist -- when is facet coplanar with the best facet?
+    qh_USEfindbestnew -- when to use qh_findbestnew for qh_partitionpoint()
+*/
+#define qh_DISToutside ((qh_USEfindbestnew ? 2 : 1) * \
+     fmax_((qh->MERGING ? 2 : 1)*qh->MINoutside, qh->max_outside))
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MAXcheckpoint">-</a>
+
+  qh_MAXcheckpoint
+    Report up to qh_MAXcheckpoint errors per facet in qh_check_point ('Tv')
+*/
+#define qh_MAXcheckpoint 10
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MAXcoplanarcentrum">-</a>
+
+  qh_MAXcoplanarcentrum
+    if pre-merging with qh.MERGEexact ('Qx') and f.nummerge > qh_MAXcoplanarcentrum
+      use f.maxoutside instead of qh.centrum_radius for coplanarity testing
+
+  notes:
+    see qh_test_nonsimplicial_merges
+    with qh.MERGEexact, a coplanar ridge is ignored until post-merging
+    otherwise a large facet with many merges may take all the facets
+*/
+#define qh_MAXcoplanarcentrum 10
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MAXnewcentrum">-</a>
+
+  qh_MAXnewcentrum
+    if <= dim+n vertices (n approximates the number of merges),
+      reset the centrum in qh_updatetested() and qh_mergecycle_facets()
+
+  notes:
+    needed to reduce cost and because centrums may move too much if
+    many vertices in high-d
+*/
+#define qh_MAXnewcentrum 5
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MAXnewmerges">-</a>
+
+  qh_MAXnewmerges
+    if >n newmerges, qh_merge_nonconvex() calls qh_reducevertices_centrums.
+
+  notes:
+    It is needed because postmerge can merge many facets at once
+*/
+#define qh_MAXnewmerges 2
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOconcavehorizon">-</a>
+
+  qh_RATIOconcavehorizon
+    ratio of horizon vertex distance to max_outside for concave, twisted new facets in qh_test_nonsimplicial_merge
+    if too small, end up with vertices far below merged facets
+*/
+#define qh_RATIOconcavehorizon 20.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOconvexmerge">-</a>
+
+  qh_RATIOconvexmerge
+    ratio of vertex distance to qh.min_vertex for clearly convex new facets in qh_test_nonsimplicial_merge
+
+  notes:
+    must be convex for MRGtwisted
+*/
+#define qh_RATIOconvexmerge 10.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOcoplanarapex">-</a>
+
+  qh_RATIOcoplanarapex
+    ratio of best distance for coplanar apex vs. vertex merge in qh_getpinchedmerges
+
+  notes:
+    A coplanar apex always works, while a vertex merge may fail
+*/
+#define qh_RATIOcoplanarapex 3.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOcoplanaroutside">-</a>
+
+  qh_RATIOcoplanaroutside
+    qh.MAXoutside ratio to repartition a coplanar point in qh_partitioncoplanar and qh_check_maxout
+
+  notes:
+    combines several tests, see qh_partitioncoplanar
+
+*/
+#define qh_RATIOcoplanaroutside 30.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOmaxsimplex">-</a>
+
+  qh_RATIOmaxsimplex
+    ratio of max determinate to estimated determinate for searching all points in qh_maxsimplex
+
+  notes:
+    As each point is added to the simplex, the max determinate is should approximate the previous determinate * qh.MAXwidth
+    If maxdet is significantly less, the simplex may not be full-dimensional.
+    If so, all points are searched, stopping at 10 times qh_RATIOmaxsimplex
+*/
+#define qh_RATIOmaxsimplex 1.0e-3
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOnearinside">-</a>
+
+  qh_RATIOnearinside
+    ratio of qh.NEARinside to qh.ONEmerge for retaining inside points for
+    qh_check_maxout().
+
+  notes:
+    This is overkill since do not know the correct value.
+    It effects whether 'Qc' reports all coplanar points
+    Not used for 'd' since non-extreme points are coplanar, nearly incident points
+*/
+#define qh_RATIOnearinside 5
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOpinchedsubridge">-</a>
+
+  qh_RATIOpinchedsubridge
+    ratio to qh.ONEmerge to accept vertices in qh_findbest_pinchedvertex
+    skips search of neighboring vertices
+    facet width may increase by this ratio
+*/
+#define qh_RATIOpinchedsubridge 10.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOtrypinched">-</a>
+
+  qh_RATIOtrypinched
+    ratio to qh.ONEmerge to try qh_getpinchedmerges in qh_buildcone_mergepinched
+    otherwise a duplicate ridge will increase facet width by this amount
+*/
+#define qh_RATIOtrypinched 4.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="RATIOtwisted">-</a>
+
+  qh_RATIOtwisted
+    maximum ratio to qh.ONEmerge to merge twisted facets in qh_merge_twisted
+*/
+#define qh_RATIOtwisted 20.0
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="SEARCHdist">-</a>
+
+  qh_SEARCHdist
+    When is a facet coplanar with the best facet?
+    qh_findbesthorizon: all coplanar facets of the best facet need to be searched.
+        increases minsearch if ischeckmax and more than 100 neighbors (is_5x_minsearch)
+  See:
+    qh_DISToutside -- when is a point clearly outside of a facet
+    qh_SEARCHdist -- when is facet coplanar with the best facet?
+    qh_USEfindbestnew -- when to use qh_findbestnew for qh_partitionpoint()
+*/
+#define qh_SEARCHdist ((qh_USEfindbestnew ? 2 : 1) * \
+      (qh->max_outside + 2 * qh->DISTround + fmax_( qh->MINvisible, qh->MAXcoplanar)));
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="USEfindbestnew">-</a>
+
+  qh_USEfindbestnew
+     Always use qh_findbestnew for qh_partitionpoint, otherwise use
+     qh_findbestnew if merged new facet or sharpnewfacets.
+
+  See:
+    qh_DISToutside -- when is a point clearly outside of a facet
+    qh_SEARCHdist -- when is facet coplanar with the best facet?
+    qh_USEfindbestnew -- when to use qh_findbestnew for qh_partitionpoint()
+*/
+#define qh_USEfindbestnew (zzval_(Ztotmerge) > 50)
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="MAXnarrow">-</a>
+
+  qh_MAXnarrow
+    max. cosine in initial hull that sets qh.NARROWhull
+
+  notes:
+    If qh.NARROWhull, the initial partition does not make
+    coplanar points.  If narrow, a coplanar point can be
+    coplanar to two facets of opposite orientations and
+    distant from the exact convex hull.
+
+    Conservative estimate.  Don't actually see problems until it is -1.0
+*/
+#define qh_MAXnarrow -0.99999999
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="WARNnarrow">-</a>
+
+  qh_WARNnarrow
+    max. cosine in initial hull to warn about qh.NARROWhull
+
+  notes:
+    this is a conservative estimate.
+    Don't actually see problems until it is -1.0.  See qh-impre.htm
+*/
+#define qh_WARNnarrow -0.999999999999999
+
+/*-<a                             href="qh-user_r.htm#TOC"
+>--------------------------------</a><a name="WIDEcoplanar">-</a>
+
+  qh_WIDEcoplanar
+    n*MAXcoplanar or n*MINvisible for a WIDEfacet
+
+    if vertex is further than qh.WIDEfacet from the hyperplane
+    then its ridges are not counted in computing the area, and
+    the facet's centrum is frozen.
+
+  notes:
+    qh.WIDEfacet= max(qh.MAXoutside,qh_WIDEcoplanar*qh.MAXcoplanar,
+    qh_WIDEcoplanar * qh.MINvisible);
+*/
+#define qh_WIDEcoplanar 6
+
+/*-<a                             href="qh-user_r.htm#TOC"
+>--------------------------------</a><a name="WIDEduplicate">-</a>
+
+  qh_WIDEduplicate
+    merge ratio for errexit from qh_forcedmerges due to duplicate ridge
+    Override with option Q12-allow-wide
+
+  Notes:
+    Merging a duplicate ridge can lead to very wide facets.
+*/
+#define qh_WIDEduplicate 100
+
+/*-<a                             href="qh-user_r.htm#TOC"
+>--------------------------------</a><a name="WIDEdupridge">-</a>
+
+  qh_WIDEdupridge
+    Merge ratio for selecting a forced dupridge merge
+
+  Notes:
+    Merging a dupridge can lead to very wide facets.
+*/
+#define qh_WIDEdupridge 50
+
+/*-<a                             href="qh-user_r.htm#TOC"
+>--------------------------------</a><a name="WIDEmaxoutside">-</a>
+
+  qh_WIDEmaxoutside
+    Precision ratio for maximum increase for qh.max_outside in qh_check_maxout
+    Precision errors while constructing the hull, may lead to very wide facets when checked in qh_check_maxout
+    Nearly incident points in 4-d and higher is the most likely culprit
+    Skip qh_check_maxout with 'Q5' (no-check-outer)
+    Do not error with option 'Q12' (allow-wide)
+    Do not warn with options 'Q12 Pp'
+*/
+#define qh_WIDEmaxoutside 100
+
+/*-<a                             href="qh-user_r.htm#TOC"
+>--------------------------------</a><a name="WIDEmaxoutside2">-</a>
+
+  qh_WIDEmaxoutside2
+    Precision ratio for maximum qh.max_outside in qh_check_maxout
+    Skip qh_check_maxout with 'Q5' no-check-outer
+    Do not error with option 'Q12' allow-wide
+*/
+#define qh_WIDEmaxoutside2 (10*qh_WIDEmaxoutside)
+
+
+/*-<a                             href="qh-user_r.htm#TOC"
+>--------------------------------</a><a name="WIDEpinched">-</a>
+
+  qh_WIDEpinched
+    Merge ratio for distance between pinched vertices compared to current facet width for qh_getpinchedmerges and qh_next_vertexmerge
+    Reports warning and merges duplicate ridges instead
+    Enable these attempts with option Q14 merge-pinched-vertices
+
+  notes:
+    Merging pinched vertices should prevent duplicate ridges (see qh_WIDEduplicate)
+    Merging the duplicate ridges may be better than merging the pinched vertices
+    Found up to 45x ratio for qh_pointdist -- for ((i=1; i<20; i++)); do rbox 175 C1,6e-13 t | qhull d T4 2>&1 | tee x.1 | grep  -E 'QH|non-simplicial|Statis|pinched'; done
+    Actual distance to facets is a third to a tenth of the qh_pointdist (T1)
+*/
+#define qh_WIDEpinched 100
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >--------------------------------</a><a name="ZEROdelaunay">-</a>
+
+  qh_ZEROdelaunay
+    a zero Delaunay facet occurs for input sites coplanar with their convex hull
+    the last normal coefficient of a zero Delaunay facet is within
+        qh_ZEROdelaunay * qh.ANGLEround of 0
+
+  notes:
+    qh_ZEROdelaunay does not allow for joggled input ('QJ').
+
+    You can avoid zero Delaunay facets by surrounding the input with a box.
+
+    Use option 'PDk:-n' to explicitly define zero Delaunay facets
+      k= dimension of input sites (e.g., 3 for 3-d Delaunay triangulation)
+      n= the cutoff for zero Delaunay facets (e.g., 'PD3:-1e-12')
+*/
+#define qh_ZEROdelaunay 2
+
+/*============================================================*/
+/*============= Microsoft DevStudio ==========================*/
+/*============================================================*/
+
+/*
+   Finding Memory Leaks Using the CRT Library
+   https://msdn.microsoft.com/en-us/library/x98tx3cf(v=vs.100).aspx
+
+   Reports enabled in qh_lib_check for Debug window and stderr
+
+   From 2005=>msvcr80d, 2010=>msvcr100d, 2012=>msvcr110d
+
+   Watch: {,,msvcr80d.dll}_crtBreakAlloc  Value from {n} in the leak report
+   _CrtSetBreakAlloc(689); // qh_lib_check() [global_r.c]
+
+   Examples
+     http://free-cad.sourceforge.net/SrcDocu/d2/d7f/MemDebug_8cpp_source.html
+     https://github.com/illlust/Game/blob/master/library/MemoryLeak.cpp
+*/
+#if 0   /* off (0) by default for QHULL_CRTDBG */
+#define QHULL_CRTDBG
+#endif
+
+#if defined(_MSC_VER) && defined(_DEBUG) && defined(QHULL_CRTDBG)
+#define _CRTDBG_MAP_ALLOC
+#include <stdlib.h>
+#include <crtdbg.h>
+#endif
+
+#endif /* qh_DEFuser */
diff --git a/contrib/libs/qhull/libqhull_r/usermem_r.c b/contrib/libs/qhull/libqhull_r/usermem_r.c
new file mode 100644
index 0000000000..185a421416
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/usermem_r.c
@@ -0,0 +1,97 @@
+/*<html><pre>  -<a                             href="qh-user_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   usermem_r.c
+   user redefinable functions -- qh_exit, qh_free, and qh_malloc
+
+   See README.txt.
+
+   If you redefine one of these functions you must redefine all of them.
+   If you recompile and load this file, then usermem.o will not be loaded
+   from qhull.a or qhull.lib
+
+   See libqhull_r.h for data structures, macros, and user-callable functions.
+   See user_r.c for qhull-related, redefinable functions
+   see user_r.h for user-definable constants
+   See userprintf_r.c for qh_fprintf and userprintf_rbox_r.c for qh_fprintf_rbox
+
+   Please report any errors that you fix to qhull@qhull.org
+*/
+
+#include "libqhull_r.h"
+
+#include <stdarg.h>
+#include <stdlib.h>
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="qh_exit">-</a>
+
+  qh_exit( exitcode )
+    exit program
+    the exitcode must be 255 or less.  Zero indicates success.
+    Note: Exit status ('$?') in bash reports 256 as 0
+
+  notes:
+    qh_exit() is called when qh_errexit() and longjmp() are not available.
+
+    This is the only use of exit() in Qhull
+    To replace qh_exit with 'throw', see libqhullcpp/usermem_r-cpp.cpp
+*/
+void qh_exit(int exitcode) {
+    exit(exitcode);
+} /* exit */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="qh_fprintf_stderr">-</a>
+
+  qh_fprintf_stderr( msgcode, format, list of args )
+    fprintf to stderr with msgcode (non-zero)
+
+  notes:
+    qh_fprintf_stderr() is called when qh.ferr is not defined, usually due to an initialization error
+    if msgcode is a MSG_ERROR (6000), caller should set qh.last_errcode (like qh_fprintf) or variable 'last_errcode'
+    
+    It is typically followed by qh_errexit().
+
+    Redefine this function to avoid using stderr
+
+    Use qh_fprintf [userprintf_r.c] for normal printing
+*/
+void qh_fprintf_stderr(int msgcode, const char *fmt, ... ) {
+    va_list args;
+
+    va_start(args, fmt);
+    if(msgcode)
+      fprintf(stderr, "QH%.4d ", msgcode);
+    vfprintf(stderr, fmt, args);
+    va_end(args);
+} /* fprintf_stderr */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+>-------------------------------</a><a name="qh_free">-</a>
+
+  qh_free(qh, mem )
+    free memory
+
+  notes:
+    same as free()
+    No calls to qh_errexit() 
+*/
+void qh_free(void *mem) {
+    free(mem);
+} /* free */
+
+/*-<a                             href="qh-user_r.htm#TOC"
+    >-------------------------------</a><a name="qh_malloc">-</a>
+
+    qh_malloc( mem )
+      allocate memory
+
+    notes:
+      same as malloc()
+*/
+void *qh_malloc(size_t size) {
+    return malloc(size);
+} /* malloc */
+
+
diff --git a/contrib/libs/qhull/libqhull_r/userprintf_r.c b/contrib/libs/qhull/libqhull_r/userprintf_r.c
new file mode 100644
index 0000000000..6512407d92
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/userprintf_r.c
@@ -0,0 +1,95 @@
+/*<html><pre>  -<a                             href="qh-user_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+  userprintf_r.c
+  user redefinable function -- qh_fprintf
+
+  see README.txt  see COPYING.txt for copyright information.
+
+  If you recompile and load this file, then userprintf_r.o will not be loaded
+  from qhull_r.a or qhull_r.lib
+
+  See libqhull_r.h for data structures, macros, and user-callable functions.
+  See user_r.c for qhull-related, redefinable functions
+  see user_r.h for user-definable constants
+  See usermem_r.c for qh_exit(), qh_free(), and qh_malloc()
+  see Qhull.cpp and RboxPoints.cpp for examples.
+
+  qh_printf is a good location for debugging traps, checked on each log line
+
+  Please report any errors that you fix to qhull@qhull.org
+*/
+
+#include "libqhull_r.h"
+#include "poly_r.h" /* for qh.tracefacet */
+
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+/*-<a                             href="qh-user_r.htm#TOC"
+  >-------------------------------</a><a name="qh_fprintf">-</a>
+
+  qh_fprintf(qh, fp, msgcode, format, list of args )
+    print arguments to *fp according to format
+    Use qh_fprintf_rbox() for rboxlib_r.c
+
+  notes:
+    sets qh.last_errcode if msgcode is error 6000..6999
+    same as fprintf()
+    fgets() is not trapped like fprintf()
+    exit qh_fprintf via qh_errexit()
+    may be called for errors in qh_initstatistics and qh_meminit
+*/
+
+void qh_fprintf(qhT *qh, FILE *fp, int msgcode, const char *fmt, ... ) {
+  va_list args;
+  facetT *neighbor, **neighborp;
+
+  if (!fp) {
+    if(!qh){
+      qh_fprintf_stderr(6241, "qhull internal error (userprintf_r.c): fp and qh not defined for qh_fprintf '%s'\n", fmt);
+      qh->last_errcode= 6241;
+      qh_exit(qh_ERRqhull);  /* can not use qh_errexit() */
+    }
+    /* could use qh->qhmem.ferr, but probably better to be cautious */
+    qh_fprintf_stderr(6028, "qhull internal error (userprintf_r.c): fp is 0.  Wrong qh_fprintf was called.\n");
+    qh->last_errcode= 6028;
+    qh_errexit(qh, qh_ERRqhull, NULL, NULL);
+  }
+  if ((qh && qh->ANNOTATEoutput) || msgcode < MSG_TRACE4) {
+    fprintf(fp, "[QH%.4d]", msgcode);
+  }else if (msgcode >= MSG_ERROR && msgcode < MSG_STDERR ) {
+    fprintf(fp, "QH%.4d ", msgcode);
+  }
+  va_start(args, fmt);
+  vfprintf(fp, fmt, args);
+  va_end(args);
+    
+  if (qh) {
+    if (msgcode >= MSG_ERROR && msgcode < MSG_WARNING)
+      qh->last_errcode= msgcode;
+    /* Place debugging traps here. Use with trace option 'Tn' 
+       Set qh.tracefacet_id, qh.traceridge_id, and/or qh.tracevertex_id in global_r.c
+    */
+    if (False) { /* in production skip test for debugging traps */
+      if (qh->tracefacet && qh->tracefacet->tested) {
+        if (qh_setsize(qh, qh->tracefacet->neighbors) < qh->hull_dim)
+          qh_errexit(qh, qh_ERRdebug, qh->tracefacet, qh->traceridge);
+        FOREACHneighbor_(qh->tracefacet) {
+          if (neighbor != qh_DUPLICATEridge && neighbor != qh_MERGEridge && neighbor->visible)
+            qh_errexit2(qh, qh_ERRdebug, qh->tracefacet, neighbor);
+        }
+      } 
+      if (qh->traceridge && qh->traceridge->top->id == 234342223) {
+        qh_errexit(qh, qh_ERRdebug, qh->tracefacet, qh->traceridge);
+      }
+      if (qh->tracevertex && qh_setsize(qh, qh->tracevertex->neighbors)>3434334) {
+        qh_errexit(qh, qh_ERRdebug, qh->tracefacet, qh->traceridge);
+      }
+    }
+    if (qh->FLUSHprint)
+      fflush(fp);
+  }
+} /* qh_fprintf */
+
diff --git a/contrib/libs/qhull/libqhull_r/userprintf_rbox_r.c b/contrib/libs/qhull/libqhull_r/userprintf_rbox_r.c
new file mode 100644
index 0000000000..64c16cb57b
--- /dev/null
+++ b/contrib/libs/qhull/libqhull_r/userprintf_rbox_r.c
@@ -0,0 +1,53 @@
+/*<html><pre>  -<a                             href="qh-user_r.htm"
+  >-------------------------------</a><a name="TOP">-</a>
+
+   userprintf_rbox_r.c
+   user redefinable function -- qh_fprintf_rbox
+
+   see README.txt  see COPYING.txt for copyright information.
+
+   If you recompile and load this file, then userprintf_rbox_r.o will not be loaded
+   from qhull.a or qhull.lib
+
+   See libqhull_r.h for data structures, macros, and user-callable functions.
+   See user_r.c for qhull-related, redefinable functions
+   see user_r.h for user-definable constants
+   See usermem_r.c for qh_exit(), qh_free(), and qh_malloc()
+   see Qhull.cpp and RboxPoints.cpp for examples.
+
+   Please report any errors that you fix to qhull@qhull.org
+*/
+
+#include "libqhull_r.h"
+
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+/*-<a                             href="qh-user_r.htm#TOC"
+   >-------------------------------</a><a name="qh_fprintf_rbox">-</a>
+
+   qh_fprintf_rbox(qh, fp, msgcode, format, list of args )
+     print arguments to *fp according to format
+     Use qh_fprintf_rbox() for rboxlib_r.c
+
+   notes:
+     same as fprintf()
+     fgets() is not trapped like fprintf()
+     exit qh_fprintf_rbox via qh_errexit_rbox()
+*/
+
+void qh_fprintf_rbox(qhT *qh, FILE *fp, int msgcode, const char *fmt, ... ) {
+    va_list args;
+
+    if (!fp) {
+      qh_fprintf_stderr(6231, "qhull internal error (userprintf_rbox_r.c): fp is 0.  Wrong qh_fprintf_rbox called.\n");
+      qh_errexit_rbox(qh, qh_ERRqhull);
+    }
+    if (msgcode >= MSG_ERROR && msgcode < MSG_STDERR)
+      fprintf(fp, "QH%.4d ", msgcode);
+    va_start(args, fmt);
+    vfprintf(fp, fmt, args);
+    va_end(args);
+} /* qh_fprintf_rbox */
+
diff --git a/contrib/tools/f2c/README b/contrib/tools/f2c/README
new file mode 100644
index 0000000000..1416f5217d
--- /dev/null
+++ b/contrib/tools/f2c/README
@@ -0,0 +1,186 @@
+To compile f2c on Linux or Unix systems, copy makefile.u to makefile,
+edit makefile if necessary (see the comments in it and below) and
+type "make" (or maybe "nmake", depending on your system).
+
+To compile f2c.exe on MS Windows systems with Microsoft Visual C++,
+
+	copy makefile.vc makefile
+	nmake
+
+With other PC compilers, you may need to compile xsum.c with -DMSDOS
+(i.e., with MSDOS #defined).
+
+If your compiler does not understand ANSI/ISO C syntax (i.e., if
+you have a K&R C compiler), compile with -DKR_headers .
+
+On non-Unix systems where files have separate binary and text modes,
+you may need to "make xsumr.out" rather than "make xsum.out".
+
+If (in accordance with what follows) you need to any of the source
+files (excluding the makefile), first issue a "make xsum.out" (or, if
+appropriate, "make xsumr.out") to check the validity of the f2c source,
+then make your changes, then type "make f2c".
+
+The file usignal.h is for the benefit of strictly ANSI include files
+on a UNIX system -- the ANSI signal.h does not define SIGHUP or SIGQUIT.
+You may need to modify usignal.h if you are not running f2c on a UNIX
+system.
+
+Should you get the message "xsum0.out xsum1.out differ", see what lines
+are different (`diff xsum0.out xsum1.out`) and ask netlib
+(e.g., netlib@netlib.org) to send you the files in question,
+plus the current xsum0.out (which may have changed) "from f2c/src".
+For example, if exec.c and expr.c have incorrect check sums, you would
+send netlib the message
+	send exec.c expr.c xsum0.out from f2c/src
+You can also ftp these files from netlib.bell-labs.com; for more
+details, ask netlib@netlib.org to "send readme from f2c".
+
+On some systems, the malloc and free in malloc.c let f2c run faster
+than do the standard malloc and free.  Other systems may not tolerate
+redefinition of malloc and free (though changes of 8 Nov. 1994 may
+render this less of a problem than hitherto).  If your system permits
+use of a user-supplied malloc, you may wish to change the MALLOC =
+line in the makefile to "MALLOC = malloc.o", or to type
+	make MALLOC=malloc.o
+instead of
+	make
+Still other systems have a -lmalloc that provides performance
+competitive with that from malloc.c; you may wish to compare the two
+on your system.  If your system does not permit user-supplied malloc
+routines, then f2c may fault with "MALLOC=malloc.o", or may display
+other untoward behavior.
+
+On some BSD systems, you may need to create a file named "string.h"
+whose single line is
+#include <strings.h>
+you may need to add " -Dstrchr=index" to the "CFLAGS =" assignment
+in the makefile, and you may need to add " memset.o" to the "OBJECTS ="
+assignment in the makefile -- see the comments in memset.c .
+
+For non-UNIX systems, you may need to change some things in sysdep.c,
+such as the choice of intermediate file names.
+
+On some systems, you may need to modify parts of sysdep.h (which is
+included by defs.h).  In particular, for Sun 4.1 systems and perhaps
+some others, you need to comment out the typedef of size_t.  For some
+systems (e.g., IRIX 4.0.1 and AIX) it is better to add
+#define ANSI_Libraries
+to the beginning of sysdep.h (or to supply -DANSI_Libraries in the
+makefile).
+
+Alas, some systems #define __STDC__ but do not provide a true standard
+(ANSI or ISO) C environment, e.g. do not provide stdlib.h .  If yours
+is such a system, then (a) you should complain loudly to your vendor
+about __STDC__ being erroneously defined, and (b) you should insert
+#undef __STDC__
+at the beginning of sysdep.h .  You may need to make other adjustments.
+
+For some non-ANSI versions of stdio, you must change the values given
+to binread and binwrite in sysdep.c from "rb" and "wb" to "r" and "w".
+You may need to make this change if you run f2c and get an error
+message of the form
+	Compiler error ... cannot open intermediate file ...
+
+In the days of yore, two libraries, libF77 and libI77, were used with
+f77 (the Fortran compiler on which f2c is based).  Separate source for
+these libraries is still available from netlib, but it is more
+convenient to combine them into a single library, libf2c.  Source for
+this combined library is also available from netlib in f2c/libf2c.zip,
+e.g.,
+	http://netlib.bell-labs.com/netlib/f2c/libf2c.zip
+or
+	http://www.netlib.org/f2c/libf2c.zip
+
+(and similarly for other netlib mirrors).  After unzipping libf2c.zip,
+copy the relevant makefile.* to makefile, edit makefile if necessary
+(see the comments in it and in libf2c/README) and invoke "make" or
+"nmake".  The resulting library is called *f2c.lib on MS Windows
+systems and libf2c.a or libf2c.so on Linux and Unix systems;
+makefile.u just shows how to make libf2c.a.  Details on creating the
+shared-library variant, libf2c.so, are system-dependent; some that
+have worked under Linux appear below.  For some other systems, you can
+glean the details from the system-dependent makefile variants in
+directory http://www.netlib.org/ampl/solvers/funclink or
+http://netlib.bell-labs.com/netlib/ampl/solvers/funclink, etc.
+
+In general, under Linux it is necessary to compile libf2c (or libI77)
+with -DNON_UNIX_STDIO .  Under at least one variant of Linux, you can
+make and install a shared-library version of libf2c by compiling
+libI77 with -DNON_UNIX_STDIO, creating libf2c.a as above, and then
+executing
+
+	mkdir t
+	ln lib?77/*.o t
+	cd t; cc -shared -o ../libf2c.so -Wl,-soname,libf2c.so.1 *.o
+	cd ..
+	rm -r t
+	rm /usr/lib/libf2c*
+	mv libf2c.a libf2c.so /usr/lib
+	cd /usr/lib
+	ln libf2c.so libf2c.so.1
+	ln libf2c.so libf2c.so.1.0.0
+
+On some other systems, /usr/local/lib is the appropriate installation
+directory.
+
+
+Some older C compilers object to
+	typedef void (*foo)();
+or to
+	typedef void zap;
+	zap (*foo)();
+If yours is such a compiler, change the definition of VOID in
+f2c.h from void to int.
+
+For convenience with systems that use control-Z to denote end-of-file,
+f2c treats control-Z characters (ASCII 26, '\x1a') that appear at the
+beginning of a line as an end-of-file indicator.  You can disable this
+test by compiling lex.c with NO_EOF_CHAR_CHECK #defined, or can
+change control-Z to some other character by #defining EOF_CHAR to
+be the desired value.
+
+
+If your machine has IEEE, VAX, or IBM-mainframe arithmetic, but your
+printf is inaccurate (e.g., with Symantec C++ version 6.0,
+printf("%.17g",12.) prints 12.000000000000001), you can make f2c print
+correctly rounded numbers by compiling with -DUSE_DTOA and adding
+dtoa.o g_fmt.o to the makefile's OBJECTS = line, so it becomes
+
+	OBJECTS = $(OBJECTSd) malloc.o dtoa.o g_fmt.o
+
+Also add the rule
+
+	dtoa.o: dtoa.c
+		$(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c
+
+(without the initial tab) to the makefile, where IEEE... is one of
+IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's
+arithmetic.  See the comments near the start of dtoa.c.
+
+The relevant source files, dtoa.c and g_fmt.c, are available
+separately from netlib's fp directory.  For example, you could
+send the E-mail message
+
+	send dtoa.c g_fmt.c from fp
+
+to netlib@netlib.netlib.org (or use anonymous ftp from
+ftp.netlib.org and look in directory /netlib/fp).
+
+The makefile has a rule for creating tokdefs.h.  If you cannot use the
+makefile, an alternative is to extract tokdefs.h from the beginning of
+gram.c: it's the first 100 lines.
+
+File mem.c has #ifdef CRAY lines that are appropriate for machines
+with the conventional CRAY architecture, but not for "Cray" machines
+based on DEC Alpha chips, such as the T3E; on such machines, you may
+need to make a suitable adjustment, e.g., add #undef CRAY to sysdep.h.
+
+
+Please send bug reports to dmg at acm.org (with " at " changed to "@").
+The old index file (now called "readme" due to unfortunate changes in
+netlib conventions:  "send readme from f2c") will report recent
+changes in the recent-change log at its end; all changes will be shown
+in the "changes" file ("send changes from f2c").  To keep current
+source, you will need to request xsum0.out and version.c, in addition
+to the changed source files.
diff --git a/contrib/tools/f2c/src/Notice b/contrib/tools/f2c/src/Notice
new file mode 100644
index 0000000000..261b719bc5
--- /dev/null
+++ b/contrib/tools/f2c/src/Notice
@@ -0,0 +1,23 @@
+/****************************************************************
+Copyright 1990 - 1997 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
diff --git a/contrib/tools/f2c/src/README b/contrib/tools/f2c/src/README
new file mode 100644
index 0000000000..1416f5217d
--- /dev/null
+++ b/contrib/tools/f2c/src/README
@@ -0,0 +1,186 @@
+To compile f2c on Linux or Unix systems, copy makefile.u to makefile,
+edit makefile if necessary (see the comments in it and below) and
+type "make" (or maybe "nmake", depending on your system).
+
+To compile f2c.exe on MS Windows systems with Microsoft Visual C++,
+
+	copy makefile.vc makefile
+	nmake
+
+With other PC compilers, you may need to compile xsum.c with -DMSDOS
+(i.e., with MSDOS #defined).
+
+If your compiler does not understand ANSI/ISO C syntax (i.e., if
+you have a K&R C compiler), compile with -DKR_headers .
+
+On non-Unix systems where files have separate binary and text modes,
+you may need to "make xsumr.out" rather than "make xsum.out".
+
+If (in accordance with what follows) you need to any of the source
+files (excluding the makefile), first issue a "make xsum.out" (or, if
+appropriate, "make xsumr.out") to check the validity of the f2c source,
+then make your changes, then type "make f2c".
+
+The file usignal.h is for the benefit of strictly ANSI include files
+on a UNIX system -- the ANSI signal.h does not define SIGHUP or SIGQUIT.
+You may need to modify usignal.h if you are not running f2c on a UNIX
+system.
+
+Should you get the message "xsum0.out xsum1.out differ", see what lines
+are different (`diff xsum0.out xsum1.out`) and ask netlib
+(e.g., netlib@netlib.org) to send you the files in question,
+plus the current xsum0.out (which may have changed) "from f2c/src".
+For example, if exec.c and expr.c have incorrect check sums, you would
+send netlib the message
+	send exec.c expr.c xsum0.out from f2c/src
+You can also ftp these files from netlib.bell-labs.com; for more
+details, ask netlib@netlib.org to "send readme from f2c".
+
+On some systems, the malloc and free in malloc.c let f2c run faster
+than do the standard malloc and free.  Other systems may not tolerate
+redefinition of malloc and free (though changes of 8 Nov. 1994 may
+render this less of a problem than hitherto).  If your system permits
+use of a user-supplied malloc, you may wish to change the MALLOC =
+line in the makefile to "MALLOC = malloc.o", or to type
+	make MALLOC=malloc.o
+instead of
+	make
+Still other systems have a -lmalloc that provides performance
+competitive with that from malloc.c; you may wish to compare the two
+on your system.  If your system does not permit user-supplied malloc
+routines, then f2c may fault with "MALLOC=malloc.o", or may display
+other untoward behavior.
+
+On some BSD systems, you may need to create a file named "string.h"
+whose single line is
+#include <strings.h>
+you may need to add " -Dstrchr=index" to the "CFLAGS =" assignment
+in the makefile, and you may need to add " memset.o" to the "OBJECTS ="
+assignment in the makefile -- see the comments in memset.c .
+
+For non-UNIX systems, you may need to change some things in sysdep.c,
+such as the choice of intermediate file names.
+
+On some systems, you may need to modify parts of sysdep.h (which is
+included by defs.h).  In particular, for Sun 4.1 systems and perhaps
+some others, you need to comment out the typedef of size_t.  For some
+systems (e.g., IRIX 4.0.1 and AIX) it is better to add
+#define ANSI_Libraries
+to the beginning of sysdep.h (or to supply -DANSI_Libraries in the
+makefile).
+
+Alas, some systems #define __STDC__ but do not provide a true standard
+(ANSI or ISO) C environment, e.g. do not provide stdlib.h .  If yours
+is such a system, then (a) you should complain loudly to your vendor
+about __STDC__ being erroneously defined, and (b) you should insert
+#undef __STDC__
+at the beginning of sysdep.h .  You may need to make other adjustments.
+
+For some non-ANSI versions of stdio, you must change the values given
+to binread and binwrite in sysdep.c from "rb" and "wb" to "r" and "w".
+You may need to make this change if you run f2c and get an error
+message of the form
+	Compiler error ... cannot open intermediate file ...
+
+In the days of yore, two libraries, libF77 and libI77, were used with
+f77 (the Fortran compiler on which f2c is based).  Separate source for
+these libraries is still available from netlib, but it is more
+convenient to combine them into a single library, libf2c.  Source for
+this combined library is also available from netlib in f2c/libf2c.zip,
+e.g.,
+	http://netlib.bell-labs.com/netlib/f2c/libf2c.zip
+or
+	http://www.netlib.org/f2c/libf2c.zip
+
+(and similarly for other netlib mirrors).  After unzipping libf2c.zip,
+copy the relevant makefile.* to makefile, edit makefile if necessary
+(see the comments in it and in libf2c/README) and invoke "make" or
+"nmake".  The resulting library is called *f2c.lib on MS Windows
+systems and libf2c.a or libf2c.so on Linux and Unix systems;
+makefile.u just shows how to make libf2c.a.  Details on creating the
+shared-library variant, libf2c.so, are system-dependent; some that
+have worked under Linux appear below.  For some other systems, you can
+glean the details from the system-dependent makefile variants in
+directory http://www.netlib.org/ampl/solvers/funclink or
+http://netlib.bell-labs.com/netlib/ampl/solvers/funclink, etc.
+
+In general, under Linux it is necessary to compile libf2c (or libI77)
+with -DNON_UNIX_STDIO .  Under at least one variant of Linux, you can
+make and install a shared-library version of libf2c by compiling
+libI77 with -DNON_UNIX_STDIO, creating libf2c.a as above, and then
+executing
+
+	mkdir t
+	ln lib?77/*.o t
+	cd t; cc -shared -o ../libf2c.so -Wl,-soname,libf2c.so.1 *.o
+	cd ..
+	rm -r t
+	rm /usr/lib/libf2c*
+	mv libf2c.a libf2c.so /usr/lib
+	cd /usr/lib
+	ln libf2c.so libf2c.so.1
+	ln libf2c.so libf2c.so.1.0.0
+
+On some other systems, /usr/local/lib is the appropriate installation
+directory.
+
+
+Some older C compilers object to
+	typedef void (*foo)();
+or to
+	typedef void zap;
+	zap (*foo)();
+If yours is such a compiler, change the definition of VOID in
+f2c.h from void to int.
+
+For convenience with systems that use control-Z to denote end-of-file,
+f2c treats control-Z characters (ASCII 26, '\x1a') that appear at the
+beginning of a line as an end-of-file indicator.  You can disable this
+test by compiling lex.c with NO_EOF_CHAR_CHECK #defined, or can
+change control-Z to some other character by #defining EOF_CHAR to
+be the desired value.
+
+
+If your machine has IEEE, VAX, or IBM-mainframe arithmetic, but your
+printf is inaccurate (e.g., with Symantec C++ version 6.0,
+printf("%.17g",12.) prints 12.000000000000001), you can make f2c print
+correctly rounded numbers by compiling with -DUSE_DTOA and adding
+dtoa.o g_fmt.o to the makefile's OBJECTS = line, so it becomes
+
+	OBJECTS = $(OBJECTSd) malloc.o dtoa.o g_fmt.o
+
+Also add the rule
+
+	dtoa.o: dtoa.c
+		$(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c
+
+(without the initial tab) to the makefile, where IEEE... is one of
+IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's
+arithmetic.  See the comments near the start of dtoa.c.
+
+The relevant source files, dtoa.c and g_fmt.c, are available
+separately from netlib's fp directory.  For example, you could
+send the E-mail message
+
+	send dtoa.c g_fmt.c from fp
+
+to netlib@netlib.netlib.org (or use anonymous ftp from
+ftp.netlib.org and look in directory /netlib/fp).
+
+The makefile has a rule for creating tokdefs.h.  If you cannot use the
+makefile, an alternative is to extract tokdefs.h from the beginning of
+gram.c: it's the first 100 lines.
+
+File mem.c has #ifdef CRAY lines that are appropriate for machines
+with the conventional CRAY architecture, but not for "Cray" machines
+based on DEC Alpha chips, such as the T3E; on such machines, you may
+need to make a suitable adjustment, e.g., add #undef CRAY to sysdep.h.
+
+
+Please send bug reports to dmg at acm.org (with " at " changed to "@").
+The old index file (now called "readme" due to unfortunate changes in
+netlib conventions:  "send readme from f2c") will report recent
+changes in the recent-change log at its end; all changes will be shown
+in the "changes" file ("send changes from f2c").  To keep current
+source, you will need to request xsum0.out and version.c, in addition
+to the changed source files.
diff --git a/contrib/tools/f2c/src/cds.c b/contrib/tools/f2c/src/cds.c
new file mode 100644
index 0000000000..05f3d5013e
--- /dev/null
+++ b/contrib/tools/f2c/src/cds.c
@@ -0,0 +1,195 @@
+/****************************************************************
+Copyright 1990, 1993, 1994, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+/* Put strings representing decimal floating-point numbers
+ * into canonical form: always have a decimal point or
+ * exponent field; if using an exponent field, have the
+ * number before it start with a digit and decimal point
+ * (if the number has more than one digit); only have an
+ * exponent field if it saves space.
+ *
+ * Arrange that the return value, rv, satisfies rv[0] == '-' || rv[-1] == '-' .
+ */
+
+#include "defs.h"
+
+ char *
+#ifdef KR_headers
+cds(s, z0)
+	char *s;
+	char *z0;
+#else
+cds(char *s, char *z0)
+#endif
+{
+	int ea, esign, et, i, k, nd = 0, sign = 0, tz;
+	char c, *z;
+	char ebuf[24];
+	long ex = 0;
+	static char etype[Table_size], *db;
+	static int dblen = 64;
+
+	if (!db) {
+		etype['E'] = 1;
+		etype['e'] = 1;
+		etype['D'] = 1;
+		etype['d'] = 1;
+		etype['+'] = 2;
+		etype['-'] = 3;
+		db = Alloc(dblen);
+		}
+
+	while((c = *s++) == '0');
+	if (c == '-')
+		{ sign = 1; c = *s++; }
+	else if (c == '+')
+		c = *s++;
+	k = strlen(s) + 2;
+	if (k >= dblen) {
+		do dblen <<= 1;
+			while(k >= dblen);
+		free(db);
+		db = Alloc(dblen);
+		}
+	if (etype[(unsigned char)c] >= 2)
+		while(c == '0') c = *s++;
+	tz = 0;
+	while(c >= '0' && c <= '9') {
+		if (c == '0')
+			tz++;
+		else {
+			if (nd)
+				for(; tz; --tz)
+					db[nd++] = '0';
+			else
+				tz = 0;
+			db[nd++] = c;
+			}
+		c = *s++;
+		}
+	ea = -tz;
+	if (c == '.') {
+		while((c = *s++) >= '0' && c <= '9') {
+			if (c == '0')
+				tz++;
+			else {
+				if (tz) {
+					ea += tz;
+					if (nd)
+						for(; tz; --tz)
+							db[nd++] = '0';
+					else
+						tz = 0;
+					}
+				db[nd++] = c;
+				ea++;
+				}
+			}
+		}
+	if (et = etype[(unsigned char)c]) {
+		esign = et == 3;
+		c = *s++;
+		if (et == 1) {
+			if(etype[(unsigned char)c] > 1) {
+				if (c == '-')
+					esign = 1;
+				c = *s++;
+				}
+			}
+		while(c >= '0' && c <= '9') {
+			ex = 10*ex + (c - '0');
+			c = *s++;
+			}
+		if (esign)
+			ex = -ex;
+		}
+	switch(c) {
+		case 0:
+			break;
+#ifndef VAX
+		case 'i':
+		case 'I':
+			Fatal("Overflow evaluating constant expression.");
+		case 'n':
+		case 'N':
+			Fatal("Constant expression yields NaN.");
+#endif
+		default:
+			Fatal("unexpected character in cds.");
+		}
+	ex -= ea;
+	if (!nd) {
+		if (!z0)
+			z0 = mem(4,0);
+		strcpy(z0, "-0.");
+		/* sign = 0; */ /* 20010820: preserve sign of 0. */
+		}
+	else if (ex > 2 || ex + nd < -2) {
+		sprintf(ebuf, "%ld", ex + nd - 1);
+		k = strlen(ebuf) + nd + 3;
+		if (nd > 1)
+			k++;
+		if (!z0)
+			z0 = mem(k,0);
+		z = z0;
+		*z++ = '-';
+		*z++ = *db;
+		if (nd > 1) {
+			*z++ = '.';
+			for(k = 1; k < nd; k++)
+				*z++ = db[k];
+			}
+		*z++ = 'e';
+		strcpy(z, ebuf);
+		}
+	else {
+		k = (int)(ex + nd);
+		i = nd + 3;
+		if (k < 0)
+			i -= k;
+		else if (ex > 0)
+			i += (int)ex;
+		if (!z0)
+			z0 = mem(i,0);
+		z = z0;
+		*z++ = '-';
+		if (ex >= 0) {
+			for(k = 0; k < nd; k++)
+				*z++ = db[k];
+			while(--ex >= 0)
+				*z++ = '0';
+			*z++ = '.';
+			}
+		else {
+			for(i = 0; i < k;)
+				*z++ = db[i++];
+			*z++ = '.';
+			while(++k <= 0)
+				*z++ = '0';
+			while(i < nd)
+				*z++ = db[i++];
+			}
+		*z = 0;
+		}
+	return sign ? z0 : z0+1;
+	}
diff --git a/contrib/tools/f2c/src/changes b/contrib/tools/f2c/src/changes
new file mode 100644
index 0000000000..73ecd41179
--- /dev/null
+++ b/contrib/tools/f2c/src/changes
@@ -0,0 +1,3504 @@
+31 Aug. 1989:
+   1. A(min(i,j)) now is translated correctly (where A is an array).
+   2. 7 and 8 character variable names are allowed (but elicit a
+      complaint under -ext).
+   3. LOGICAL*1 is treated as LOGICAL, with just one error message
+      per LOGICAL*1 statement (rather than one per variable declared
+      in that statement).  [Note that LOGICAL*1 is not in Fortran 77.]
+      Like f77, f2c now allows the format in a read or write statement
+      to be an integer array.
+
+5 Sept. 1989:
+   Fixed botch in argument passing of substrings of equivalenced
+variables.
+
+15 Sept. 1989:
+   Warn about incorrect code generated when a character-valued
+function is not declared external and is passed as a parameter
+(in violation of the Fortran 77 standard) before it is invoked.
+Example:
+
+	subroutine foo(a,b)
+	character*10 a,b
+	call goo(a,b)
+	b = a(3)
+	end
+
+18 Sept. 1989:
+   Complain about overlapping initializations.
+
+20 Sept. 1989:
+   Warn about names declared EXTERNAL but never referenced;
+include such names as externs in the generated C (even
+though most C compilers will discard them).
+
+24 Sept. 1989:
+   New option -w8 to suppress complaint when COMMON or EQUIVALENCE
+forces word alignment of a double.
+   Under -A (for ANSI C), ensure that floating constants (terminated
+by 'f') contain either a decimal point or an exponent field.
+   Repair bugs sometimes encountered with CHAR and ICHAR intrinsic
+functions.
+   Restore f77's optimizations for copying and comparing character
+strings of length 1.
+   Always assume floating-point valued routines in libF77 return
+doubles, even under -R.
+   Repair occasional omission of arguments in routines having multiple
+entry points.
+   Repair bugs in computing offsets of character strings involved
+in EQUIVALENCE.
+   Don't omit structure qualification when COMMON variables are used
+as FORMATs or internal files.
+
+2 Oct. 1989:
+   Warn about variables that appear only in data stmts; don't emit them.
+   Fix bugs in character DATA for noncharacter variables
+involved in EQUIVALENCE.
+   Treat noncharacter variables initialized (at least partly) with
+character data as though they were equivalenced -- put out a struct
+and #define the variables.  This eliminates the hideous and nonportable
+numeric values that were used to initialize such variables.
+   Treat IMPLICIT NONE as IMPLICIT UNDEFINED(A-Z) .
+   Quit when given invalid options.
+
+8 Oct. 1989:
+  Modified naming scheme for generated intermediate variables;
+more are recycled, fewer distinct ones used.
+  New option -W nn specifies nn characters/word for Hollerith
+data initializing non-character variables.
+  Bug fix: x(i:min(i+10,j)) used to elicit "Can't handle opcode 31 yet".
+  Integer expressions of the form (i+const1) - (i+const2), where
+i is a scalar integer variable, are now simplified to (const1-const2);
+this leads to simpler translation of some substring expressions.
+  Initialize uninitialized portions of character string arrays to 0
+rather than to blanks.
+
+9 Oct. 1989:
+  New option -c to insert comments showing original Fortran source.
+  New option -g to insert line numbers of original Fortran source.
+
+10 Oct. 1989:
+  ! recognized as in-line comment delimiter (a la Fortran 88).
+
+24 Oct. 1989:
+  New options to ease coping with systems that want the structs
+that result from COMMON blocks to be defined just once:
+  -E causes uninitialized COMMON blocks to be declared Extern;
+if Extern is undefined, f2c.h #defines it to be extern.
+  -ec causes a separate .c file to be emitted for each
+uninitialized COMMON block: COMMON /ABC/ yields abc_com.c;
+thus one can compile *_com.c into a library to ensure
+precisely one definition.
+  -e1c is similar to -ec, except that everything goes into
+one file, along with comments that give a sed script for
+splitting the file into the pieces that -ec would give.
+This is for use with netlib's "execute f2c" service (for which
+-ec is coerced into -e1c, and the sed script will put everything
+but the COMMON definitions into f2c_out.c ).
+
+28 Oct. 1989:
+  Convert "i = i op ..." into "i op= ...;" even when i is a
+dummy argument.
+
+13 Nov. 1989:
+  Name integer constants (passed as arguments) c__... rather
+than c_... so
+	common /c/stuff
+	call foo(1)
+	...
+is translated correctly.
+
+19 Nov. 1989:
+  Floating-point constants are now kept as strings unless they
+are involved in constant expressions that get simplified.  The
+floating-point constants kept as strings can have arbitrarily
+many significant figures and a very large exponent field (as
+large as long int allows on the machine on which f2c runs).
+Thus, for example, the body of
+
+	subroutine zot(x)
+	double precision x(6), pi
+	parameter (pi=3.1415926535897932384626433832795028841972)
+	x(1) = pi
+	x(2) = pi+1
+	x(3) = 9287349823749272.7429874923740978492734D-298374
+	x(4) = .89
+	x(5) = 4.0005
+	x(6) = 10D7
+	end
+
+now gets translated into
+
+    x[1] = 3.1415926535897932384626433832795028841972;
+    x[2] = 4.1415926535897931;
+    x[3] = 9.2873498237492727429874923740978492734e-298359;
+    x[4] = (float).89;
+    x[5] = (float)4.0005;
+    x[6] = 1e8;
+
+rather than the former
+
+    x[1] = 3.1415926535897931;
+    x[2] = 4.1415926535897931;
+    x[3] = 0.;
+    x[4] = (float)0.89000000000000003;
+    x[5] = (float)4.0004999999999997;
+    x[6] = 100000000.;
+
+  Recognition of f77 machine-constant intrinsics deleted, i.e.,
+epbase, epprec, epemin, epemax, eptiny, ephuge, epmrsp.
+
+22 Nov. 1989:
+  Workarounds for glitches on some Sun systems...
+  libf77: libF77/makefile modified to point out possible need
+to compile libF77/main.c with -Donexit=on_exit .
+  libi77: libI77/wref.c (and libI77/README) modified so non-ANSI
+systems can compile with USE_STRLEN defined, which will cause
+	sprintf(b = buf, "%#.*f", d, x);
+	n = strlen(b) + d1;
+rather than
+	n = sprintf(b = buf, "%#.*f", d, x) + d1;
+to be compiled.
+
+26 Nov. 1989:
+  Longer names are now accepted (up to 50 characters); names may
+contain underscores (in which case they will have two underscores
+appended, to avoid clashes with library names).
+
+28 Nov. 1989:
+  libi77 updated:
+	1. Allow 3 (or, on Crays, 4) digit exponents under format Ew.d .
+	2. Try to get things right on machines where ints have 16 bits.
+
+29 Nov. 1989:
+  Supplied missing semicolon in parameterless subroutines that
+have multiple entry points (all of them parameterless).
+
+30 Nov. 1989:
+  libf77 and libi77 revised to use types from f2c.h.
+  f2c now types floating-point valued C library routines as "double"
+rather than "doublereal" (for use with nonstandard C compilers for
+which "double" is IEEE double extended).
+
+1 Dec. 1989:
+  f2c.h updated to eliminate #defines rendered unnecessary (and,
+indeed, dangerous) by change of 26 Nov. to long names possibly
+containing underscores.
+  libi77 further revised: yesterday's change omitted two tweaks to fmt.h
+(tweaks which only matter if float and real or double and doublereal are
+different types).
+
+2 Dec. 1989:
+  Better error message (than "bad tag") for NAMELIST, which no longer
+inhibits C output.
+
+4 Dec. 1989:
+  Allow capital letters in hex constants (f77 extension; e.g.,
+x'a012BCd', X'A012BCD' and x'a012bcd' are all treated as the integer
+167848909).
+  libi77 further revised: lio.c lio.h lread.c wref.c wrtfmt.c tweaked
+again to allow float and real or double and doublereal to be different.
+
+6 Dec. 1989:
+  Revised f2c.h -- required for the following...
+  Simpler looking translations for abs, min, max, using #defines in
+revised f2c.h .
+  libi77: more corrections to types; additions for NAMELIST.
+  Corrected casts in some I/O calls.
+  Translation of NAMELIST; libi77 must still be revised.  Currently
+libi77 gives you a run-time error message if you attempt NAMELIST I/O.
+
+7 Dec. 1989:
+  Fixed bug that prevented local integer variables that appear in DATA
+stmts from being ASSIGNed statement labels.
+  Fillers (for DATA statements initializing EQUIVALENCEd variables and
+variables in COMMON) typed integer rather than doublereal (for slightly
+more portability, e.g. to Crays).
+  libi77: missing return values supplied in a few places; some tests
+reordered for better working on the Cray.
+  libf77: better accuracy for complex divide, complex square root,
+real mod function (casts to double; double temporaries).
+
+9 Dec. 1989:
+  Fixed bug that caused needless (albeit harmless) empty lines to be
+inserted in the C output when a comment line contained trailing blanks.
+  Further tweak to type of fillers: allow doublereal fillers if the
+struct has doublereal data.
+
+11 Dec. 1989:
+  Alteration of rule for producing external (C) names from names that
+contain underscores.  Now the external name is always obtained by
+appending a pair of underscores.
+
+12 Dec. 1989:
+  C production inhibited after most errors.
+
+15 Dec. 1989:
+  Fixed bug in headers for subroutines having two or more character
+strings arguments:  the length arguments were reversed.
+
+19 Dec. 1989:
+  f2c.h libf77 libi77: adjusted so #undefs in f2c.h should not foil
+compilation of libF77 and libI77.
+  libf77: getenv_ adjusted to work with unsorted environments.
+  libi77: the iostat= specifier should now work right with internal I/O.
+
+20 Dec. 1989:
+  f2c bugs fixed: In the absence of an err= specifier, the iostat=
+specifier was generally set wrong.  Character strings containing
+explicit nulls (\0) were truncated at the first null.
+  Unlabeled DO loops recognized; must be terminated by ENDDO.
+(Don't ask for CYCLE, EXIT, named DO loops, or DO WHILE.)
+
+29 Dec. 1989:
+  Nested unlabeled DO loops now handled properly; new warning for
+extraneous text at end of FORMAT.
+
+30 Dec. 1989:
+  Fixed bug in translating dble(real(...)), dble(sngl(...)), and
+dble(float(...)), where ... is either of type double complex or
+is an expression requiring assignment to intermediate variables (e.g.,
+dble(real(foo(x+1))), where foo is a function and x is a variable).
+Regard nonblank label fields on continuation lines as an error.
+
+3 Jan. 1990:
+  New option -C++ yields output that should be understood
+by C++ compilers.
+
+6 Jan. 1989:
+  -a now excludes variables that appear in a namelist from those
+that it makes automatic.  (As before, it also excludes variables
+that appear in a common, data, equivalence, or save statement.)
+  The syntactically correct Fortran
+	read(*,i) x
+	end
+now yields syntactically correct C (even though both the Fortran
+and C are buggy -- no FORMAT has not been ASSIGNed to i).
+
+7 Jan. 1990:
+  libi77: routines supporting NAMELIST added.  Surrounding quotes
+made optional when no ambiguity arises in a list or namelist READ
+of a character-string value.
+
+9 Jan. 1990:
+  f2c.src made available.
+
+16 Jan. 1990:
+  New options -P to produce ANSI C or C++ prototypes for procedures
+defined.  Change to -A and -C++: f2c tries to infer prototypes for
+invoked procedures unless the new -!P option is given.  New warning
+messages for inconsistent calling sequences among procedures within
+a single file.  Most of f2c/src is affected.
+  f2c.h: typedefs for procedure arguments added; netlib's f2c service
+will insert appropriate typedefs for use with older versions of f2c.h.
+
+17 Jan. 1990:
+  f2c/src: defs.h exec.c format.c proc.c putpcc.c version.c xsum0.out
+updated.  Castargs and protofile made extern in defs.h; exec.c
+modified so superfluous else clauses are diagnosed; unused variables
+omitted from declarations in format.c proc.c putpcc.c .
+
+21 Jan. 1990:
+  No C emitted for procedures declared external but not referenced.
+  f2c.h: more new types added for use with -P.
+  New feature: f2c accepts as arguments files ending in .p or .P;
+such files are assumed to be prototype files, such as produced by
+the -P option.  All prototype files are read before any Fortran files
+and apply globally to all Fortran files.  Suitable prototypes help f2c
+warn about calling-sequence errors and can tell f2c how to type
+procedures declared external but not explicitly typed; the latter is
+mainly of interest for users of the -A and -C++ options.  (Prototype
+arguments are not available to netlib's "execute f2c" service.)
+  New option -it tells f2c to try to infer types of untyped external
+arguments from their use as parameters to prototyped or previously
+defined procedures.
+  f2c/src: many minor cleanups; most modules changed.  Individual
+files in f2c/src are now in "bundle" format.  The former f2c.1 is
+now f2c.1t; "f2c.1t from f2c" and "f2c.1t from f2c/src" are now the
+same, as are "f2c.1 from f2c" and "f2c.1 from f2c/src".  People who
+do not obtain a new copy of "all from f2c/src" should at least add
+	fclose(sortfp);
+after the call on do_init_data(outfile, sortfp) in format_data.c .
+
+22 Jan. 1990:
+  Cleaner man page wording (thanks to Doug McIlroy).
+  -it now also applies to all untyped EXTERNAL procedures, not just
+arguments.
+
+23 Jan. 01:34:00 EST 1990:
+  Bug fixes: under -A and -C++, incorrect C was generated for
+subroutines having multiple entries but no arguments.
+  Under -A -P, subroutines of no arguments were given prototype
+calling sequence () rather than (void).
+  Character-valued functions elicited erroneous warning messages
+about inconsistent calling sequences when referenced by another
+procedure in the same file.
+  f2c.1t: omit first appearance of libF77.a in FILES section;
+load order of libraries is -lF77 -lI77, not vice versa (bug
+introduced in yesterday's edits); define .F macro for those whose
+-man lacks it.  (For a while after yesterday's fixes were posted,
+f2c.1t was out of date.  Sorry!)
+
+23 Jan. 9:53:24 EST 1990:
+  Character substring expressions involving function calls having
+character arguments (including the intrinsic len function) yielded
+incorrect C.
+  Procedures defined after invocation (in the same file) with
+conflicting argument types also got an erroneous message about
+the wrong number of arguments.
+
+24 Jan. 11:44:00 EST 1990:
+  Bug fixes: -p omitted #undefs; COMMON block names containing
+underscores had their C names incorrectly computed; a COMMON block
+having the name of a previously defined procedure wreaked havoc;
+if all arguments were .P files, f2c tried reading the second as a
+Fortran file.
+  New feature: -P emits comments showing COMMON block lengths, so one
+can get warnings of incompatible COMMON block lengths by having f2c
+read .P (or .p) files.  Now by running f2c twice, first with -P -!c
+(or -P!c),  then with *.P among the arguments, you can be warned of
+inconsistent COMMON usage, and COMMON blocks having inconsistent
+lengths will be given the maximum length.  (The latter always did
+happen within each input file; now -P lets you extend this behavior
+across files.)
+
+26 Jan. 16:44:00 EST 1990:
+  Option -it made less aggressive: untyped external procedures that
+are invoked are now typed by the rules of Fortran, rather than by
+previous use of procedures to which they are passed as arguments
+before being invoked.
+  Option -P now includes information about references, i.e., called
+procedures, in the prototype files (in the form of special comments).
+This allows iterative invocations of f2c to infer more about untyped
+external names, particularly when multiple Fortran files are involved.
+  As usual, there are some obscure bug fixes:
+1.  Repair of erroneous warning messages about inconsistent number of
+arguments that arose when a character dummy parameter was discovered
+to be a function or when multiple entry points involved character
+variables appearing in a previous entry point.
+2.  Repair of memory fault after error msg about "adjustable character
+function".
+3.  Under -U, allow MAIN_ as a subroutine name (in the same file as a
+main program).
+4.  Change for consistency: a known function invoked as a subroutine,
+then as a function elicits a warning rather than an error.
+
+26 Jan. 22:32:00 EST 1990:
+  Fixed two bugs that resulted in incorrect C for substrings, within
+the body of a character-valued function, of the function's name, when
+those substrings were arguments to another function (even implicitly,
+as in character-string assignment).
+
+28 Jan. 18:32:00 EST 1990:
+  libf77, libi77: checksum files added; "make check" looks for
+transmission errors.  NAMELIST read modified to allow $ rather than &
+to precede a namelist name, to allow $ rather than / to terminate
+input where the name of another variable would otherwise be expected,
+and to regard all nonprinting ASCII characters <= ' ' as spaces.
+
+29 Jan. 02:11:00 EST 1990:
+  "fc from f2c" added.
+  -it option made the default; -!it turns it off.  Type information is
+now updated in a previously missed case.
+  -P option tweaked again; message about when rerunning f2c may change
+prototypes or declarations made more accurate.
+  New option -Ps implies -P and returns exit status 4 if rerunning
+f2c -P with prototype inputs might change prototypes or declarations.
+Now you can execute a crude script like
+
+	cat *.f >zap.F
+	rm -f zap.P
+	while :; do
+		f2c -Ps -!c zap.[FP]
+		case $? in 4) ;; *) break;; esac
+		done
+
+to get a file zap.P of the best prototypes f2c can determine for *.f .
+
+Jan. 29 07:30:21 EST 1990:
+  Forgot to check for error status when setting return code 4 under -Ps;
+error status (1, 2, 3, or, for caught signal, 126) now takes precedence.
+
+Jan 29 14:17:00 EST 1990:
+  Incorrect handling of
+	open(n,'filename')
+repaired -- now treated as
+	open(n,file='filename')
+(and, under -ext, given an error message).
+  New optional source file memset.c for people whose systems don't
+provide memset, memcmp, and memcpy; #include <string.h> in mem.c
+changed to #include "string.h" so BSD people can create a local
+string.h that simply says #include <strings.h> .
+
+Jan 30 10:34:00 EST 1990:
+  Fix erroneous warning at end of definition of a procedure with
+character arguments when the procedure had previously been called with
+a numeric argument instead of a character argument.  (There were two
+warnings, the second one incorrectly complaining of a wrong number of
+arguments.)
+
+Jan 30 16:29:41 EST 1990:
+  Fix case where -P and -Ps erroneously reported another iteration
+necessary.  (Only harm is the extra iteration.)
+
+Feb 3 01:40:00 EST 1990:
+  Supply semicolon occasionally omitted under -c .
+  Try to force correct alignment when numeric variables are initialized
+with character data (a non-standard and non-portable practice).  You
+must use the -W option if your code has such data statements and is
+meant to run on a machine with other than 4 characters/word; e.g., for
+code meant to run on a Cray, you would specify -W8 .
+  Allow parentheses around expressions in output lists (in write and
+print statements).
+  Rename source files so their names are <= 12 characters long
+(so there's room to append .Z and still have <= 14 characters);
+renamed files:  formatdata.c niceprintf.c niceprintf.h safstrncpy.c .
+  f2c material made available by anonymous ftp from research.att.com
+(look in dist/f2c ).
+
+Feb 3 03:49:00 EST 1990:
+  Repair memory fault that arose from use (in an assignment or
+call) of a non-argument variable declared CHARACTER*(*).
+
+Feb 9 01:35:43 EST 1990:
+  Fix erroneous error msg about bad types in
+	subroutine foo(a,adim)
+	dimension a(adim)
+	integer adim
+  Fix improper passing of character args (and possible memory fault)
+in the expression part of a computed goto.
+  Fix botched calling sequences in array references involving
+functions having character args.
+  Fix memory fault caused by invocation of character-valued functions
+of no arguments.
+  Fix botched calling sequence of a character*1-valued function
+assigned to a character*1 variable.
+  Fix bug in error msg for inconsistent number of args in prototypes.
+  Allow generation of C output despite inconsistencies in prototypes,
+but give exit code 8.
+  Simplify include logic (by removing some bogus logic); never
+prepend "/usr/include/" to file names.
+  Minor cleanups (that should produce no visible change in f2c's
+behavior) in intr.c parse.h main.c defs.h formatdata.c p1output.c .
+
+Feb 10 00:19:38 EST 1990:
+  Insert (integer) casts when floating-point expressions are used
+as subscripts.
+  Make SAVE stmt (with no variable list) override -a .
+  Minor cleanups: change field to Field in struct Addrblock (for the
+benefit of buggy C compilers); omit system("/bin/cp ...") in misc.c .
+
+Feb 13 00:39:00 EST 1990:
+  Error msg fix in gram.dcl: change "cannot make %s parameter"
+to "cannot make into parameter".
+
+Feb 14 14:02:00 EST 1990:
+  Various cleanups (invisible on systems with 4-byte ints), thanks
+to Dave Regan: vaxx.c eliminated; %d changed to %ld various places;
+external names adjusted for the benefit of stupid systems (that ignore
+case and recognize only 6 significant characters in external names);
+buffer shortened in xsum.c (e.g. for MS-DOS); fopen modes distinguish
+text and binary files; several unused functions eliminated; missing
+arg supplied to an unlikely fatalstr invocation.
+
+Thu Feb 15 19:15:53 EST 1990:
+  More cleanups (invisible on systems with 4 byte ints); casts inserted
+so most complaints from cyntax(1) and lint(1) go away; a few (int)
+versus (long) casts corrected.
+
+Fri Feb 16 19:55:00 EST 1990:
+  Recognize and translate unnamed Fortran 8x do while statements.
+  Fix bug that occasionally caused improper breaking of character
+strings.
+  New error message for attempts to provide DATA in a type-declaration
+statement.
+
+Sat Feb 17 11:43:00 EST 1990:
+  Fix infinite loop clf -> Fatal -> done -> clf after I/O error.
+  Change "if (addrp->vclass = CLPROC)" to "if (addrp->vclass == CLPROC)"
+in p1_addr (in p1output.c); this was probably harmless.
+  Move a misplaced } in lex.c (which slowed initkey()).
+  Thanks to Gary Word for pointing these things out.
+
+Sun Feb 18 18:07:00 EST 1990:
+  Detect overlapping initializations of arrays and scalar variables
+in previously missed cases.
+  Treat logical*2 as logical (after issuing a warning).
+  Don't pass string literals to p1_comment().
+  Correct a cast (introduced 16 Feb.) in gram.expr; this matters e.g.
+on a Cray.
+  Attempt to isolate UNIX-specific things in sysdep.c (a new source
+file).  Unless sysdep.c is compiled with SYSTEM_SORT defined, the
+intermediate files created for DATA statements are now sorted in-core
+without invoking system().
+
+Tue Feb 20 16:10:35 EST 1990:
+  Move definition of binread and binwrite from init.c to sysdep.c .
+  Recognize Fortran 8x tokens < <= == >= > <> as synonyms for
+.LT. .LE. .EQ. .GE. .GT. .NE.
+  Minor cleanup in putpcc.c:  fully remove simoffset().
+  More discussion of system dependencies added to libI77/README.
+
+Tue Feb 20 21:44:07 EST 1990:
+  Minor cleanups for the benefit of EBCDIC machines -- try to remove
+the assumption that 'a' through 'z' are contiguous.  (Thanks again to
+Gary Word.)  Also, change log2 to log_2 (shouldn't be necessary).
+
+Wed Feb 21 06:24:56 EST 1990:
+  Fix botch in init.c introduced in previous change; only matters
+to non-ASCII machines.
+
+Thu Feb 22 17:29:12 EST 1990:
+  Allow several entry points to mention the same array.  Protect
+parameter adjustments with if's (for the case that an array is not
+an argument to all entrypoints).
+  Under -u, allow
+	subroutine foo(x,n)
+	real x(n)
+	integer n
+  Compute intermediate variables used to evaluate dimension expressions
+at the right time.  Example previously mistranslated:
+	subroutine foo(x,k,m,n)
+	real x(min(k,m,n))
+	...
+	write(*,*) x
+  Detect duplicate arguments.  (The error msg points to the first
+executable stmt -- not wonderful, but not worth fixing.)
+  Minor cleanup of min/max computation (sometimes slightly simpler).
+
+Sun Feb 25 09:39:01 EST 1990:
+  Minor tweak to multiple entry points: protect parameter adjustments
+with if's only for (array) args that do not appear in all entry points.
+  Minor tweaks to format.c and io.c (invisible unless your compiler
+complained at the duplicate #defines of IOSUNIT and IOSFMT or at
+comparisons of p1gets(...) with NULL).
+
+Sun Feb 25 18:40:10 EST 1990:
+  Fix bug introduced Feb. 22: if a subprogram contained DATA and the
+first executable statement was labeled, then the label got lost.
+(Just change INEXEC to INDATA in p1output.c; it occurs just once.)
+
+Mon Feb 26 17:45:10 EST 1990:
+  Fix bug in handling of " and ' in comments.
+
+Wed Mar 28 01:43:06 EST 1990:
+libI77:
+ 1. Repair nasty I/O bug: opening two files and closing the first
+(after possibly reading or writing it), then writing the second caused
+the last buffer of the second to be lost.
+ 2. Formatted reads of logical values treated all letters other than
+t or T as f (false).
+ libI77 files changed: err.c rdfmt.c Version.c
+ (Request "libi77 from f2c" -- you can't get these files individually.)
+
+f2c itself:
+  Repair nasty bug in translation of
+	ELSE IF (condition involving complicated abs, min, or max)
+-- auxiliary statements were emitted at the wrong place.
+  Supply semicolon previously omitted from the translation of a label
+(of a CONTINUE) immediately preceding an ELSE IF or an ELSE.  This
+bug made f2c produce invalid C.
+  Correct a memory fault that occurred (on some machines) when the
+error message "adjustable dimension on non-argument" should be given.
+  Minor tweaks to remove some harmless warnings by overly chatty C
+compilers.
+  Argument arays having constant dimensions but a variable lower bound
+(e.g., x(n+1:n+3)) had a * omitted from scalar arguments involved in
+the array offset computation.
+
+Wed Mar 28 18:47:59 EST 1990:
+libf77: add exit(0) to end of main [return(0) encounters a Cray bug]
+
+Sun Apr  1 16:20:58 EDT 1990:
+  Avoid dereferencing null when processing equivalences after an error.
+
+Fri Apr  6 08:29:49 EDT 1990:
+  Calls involving alternate return specifiers omitted processing
+needed for things like min, max, abs, and // (concatenation).
+  INTEGER*2 PARAMETERs were treated as INTEGER*4.
+  Convert some O(n^2) parsing to O(n).
+
+Tue Apr 10 20:07:02 EDT 1990:
+  When inconsistent calling sequences involve differing numbers of
+arguments, report the first differing argument rather than the numbers
+of arguments.
+  Fix bug under -a: formatted I/O in which either the unit or the
+format was a local character variable sometimes resulted in invalid C
+(a static struct initialized with an automatic component).
+  Improve error message for invalid flag after elided -.
+  Complain when literal table overflows, rather than infinitely
+looping.  (The complaint mentions the new and otherwise undocumented
+-NL option for specifying a larger literal table.)
+  New option -h for forcing strings to word (or, with -hd, double-word)
+boundaries where possible.
+  Repair a bug that could cause improper splitting of strings.
+  Fix bug (cast of c to doublereal) in
+	subroutine foo(c,r)
+	double complex c
+	double precision r
+	c = cmplx(r,real(c))
+	end
+  New include file "sysdep.h" has some things from defs.h (and
+elsewhere) that one may need to modify on some systems.
+  Some large arrays that were previously statically allocated are now
+dynamically allocated when f2c starts running.
+  f2c/src files changed:
+	README cds.c defs.h f2c.1 f2c.1t format.c formatdata.c init.c
+	io.c lex.c main.c makefile mem.c misc.c names.c niceprintf.c
+	output.c parse_args.c pread.c put.c putpcc.c sysdep.h
+	version.c xsum0.out
+
+Wed Apr 11 18:27:12 EDT 1990:
+  Fix bug in argument consistency checking of character, complex, and
+double complex valued functions.  If the same source file contained a
+definition of such a function with arguments not explicitly typed,
+then subsequent references to the function might get erroneous
+warnings of inconsistent calling sequences.
+  Tweaks to sysdep.h for partially ANSI systems.
+  New options -kr and -krd cause f2c to use temporary variables to
+enforce Fortran evaluation-order rules with pernicious, old-style C
+compilers that apply the associative law to floating-point operations.
+
+Sat Apr 14 15:50:15 EDT 1990:
+  libi77: libI77 adjusted to allow list-directed and namelist I/O
+of internal files; bug in namelist I/O of logical and character arrays
+fixed; list input of complex numbers adjusted to permit d or D to
+denote the start of the exponent field of a component.
+  f2c itself: fix bug in handling complicated lower-bound
+expressions for character substrings; e.g., min and max did not work
+right, nor did function invocations involving character arguments.
+  Switch to octal notation, rather than hexadecimal, for nonprinting
+characters in character and string constants.
+  Fix bug (when neither -A nor -C++ was specified) in typing of
+external arguments of type complex, double complex, or character:
+	subroutine foo(c)
+	external c
+	complex c
+now results in
+	/* Complex */ int (*c) ();
+(as, indeed, it once did) rather than
+	complex (*c) ();
+
+Sat Apr 14 22:50:39 EDT 1990:
+  libI77/makefile: updated "make check" to omit lio.c
+  lib[FI]77/makefile: trivial change: define CC = cc, reference $(CC).
+  (Request, e.g., "libi77 from f2c" -- you can't ask for individual
+files from lib[FI]77.)
+
+Wed Apr 18 00:56:37 EDT 1990:
+  Move declaration of atof() from defs.h to sysdep.h, where it is
+now not declared if stdlib.h is included.  (NeXT's stdlib.h has a
+#define atof that otherwise wreaks havoc.)
+  Under -u, provide a more intelligible error message (than "bad tag")
+for an attempt to define a function without specifying its type.
+
+Wed Apr 18 17:26:27 EDT 1990:
+  Recognize \v (vertical tab) in Hollerith as well as quoted strings;
+add recognition of \r (carriage return).
+  New option -!bs turns off recognition of escapes in character strings
+(\0, \\, \b, \f, \n, \r, \t, \v).
+  Move to sysdep.c initialization of some arrays whose initialization
+assumed ASCII; #define Table_size in sysdep.h rather than using
+hard-coded 256 in allocating arrays of size 1 << (bits/byte).
+
+Thu Apr 19 08:13:21 EDT 1990:
+  Warn when escapes would make Hollerith extend beyond statement end.
+  Omit max() definition from misc.c (should be invisible except on
+systems that erroneously #define max in stdlib.h).
+
+Mon Apr 23 22:24:51 EDT 1990:
+  When producing default-style C (no -A or -C++), cast switch
+expressions to (int).
+  Move "-lF77 -lI77 -lm -lc" to link_msg, defined in sysdep.c .
+  Add #define scrub(x) to sysdep.h, with invocations in format.c and
+formatdata.c, so that people who have systems like VMS that would
+otherwise create multiple versions of intermediate files can
+#define scrub(x) unlink(x)
+
+Tue Apr 24 18:28:36 EDT 1990:
+  Pass string lengths once rather than twice to a function of character
+arguments involved in comparison of character strings of length 1.
+
+Fri Apr 27 13:11:52 EDT 1990:
+  Fix bug that made f2c gag on concatenations involving char(...) on
+some systems.
+
+Sat Apr 28 23:20:16 EDT 1990:
+  Fix control-stack bug in
+	if(...) then
+	else if (complicated condition)
+	else
+	endif
+(where the complicated condition causes assignment to an auxiliary
+variable, e.g., max(a*b,c)).
+
+Mon Apr 30 13:30:10 EDT 1990:
+  Change fillers for DATA with holes from substructures to arrays
+(in an attempt to make things work right with C compilers that have
+funny padding rules for substructures, e.g., Sun C compilers).
+  Minor cleanup of exec.c (should not affect generated C).
+
+Mon Apr 30 23:13:51 EDT 1990:
+  Fix bug in handling return values of functions having multiple
+entry points of differing return types.
+
+Sat May  5 01:45:18 EDT 1990:
+  Fix type inference bug in
+	subroutine foo(x)
+	call goo(x)
+	end
+	subroutine goo(i)
+	i = 3
+	end
+Instead of warning of inconsistent calling sequences for goo,
+f2c was simply making i a real variable; now i is correctly
+typed as an integer variable, and f2c issues an error message.
+  Adjust error messages issued at end of declarations so they
+don't blame the first executable statement.
+
+Sun May  6 01:29:07 EDT 1990:
+  Fix bug in -P and -Ps: warn when the definition of a subprogram adds
+information that would change prototypes or previous declarations.
+
+Thu May 10 18:09:15 EDT 1990:
+  Fix further obscure bug with (default) -it: inconsistent calling
+sequences and I/O statements could interact to cause a memory fault.
+Example:
+      SUBROUTINE FOO
+      CALL GOO(' Something') ! Forgot integer first arg
+      END
+      SUBROUTINE GOO(IUNIT,MSG)
+      CHARACTER*(*)MSG
+      WRITE(IUNIT,'(1X,A)') MSG
+      END
+
+Fri May 11 16:49:11 EDT 1990:
+  Under -!c, do not delete any .c files (when there are errors).
+  Avoid dereferencing 0 when a fatal error occurs while reading
+Fortran on stdin.
+
+Wed May 16 18:24:42 EDT 1990:
+  f2c.ps made available.
+
+Mon Jun  4 12:53:08 EDT 1990:
+  Diagnose I/O units of invalid type.
+  Add specific error msg about dummy arguments in common.
+
+Wed Jun 13 12:43:17 EDT 1990:
+  Under -A, supply a missing "[1]" for CHARACTER*1 variables that appear
+both in a DATA statement and in either COMMON or EQUIVALENCE.
+
+Mon Jun 18 16:58:31 EDT 1990:
+  Trivial updates to f2c.ps .  ("Fortran 8x" --> "Fortran 90"; omit
+"(draft)" from "(draft) ANSI C".)
+
+Tue Jun 19 07:36:32 EDT 1990:
+  Fix incorrect code generated for ELSE IF(expression involving
+function call passing non-constant substring).
+  Under -h, preserve the property that strings are null-terminated
+where possible.
+  Remove spaces between # and define in lex.c output.c parse.h .
+
+Mon Jun 25 07:22:59 EDT 1990:
+  Minor tweak to makefile to reduce unnecessary recompilations.
+
+Tue Jun 26 11:49:53 EDT 1990:
+  Fix unintended truncation of some integer constants on machines
+where casting a long to (int) may change the value.  E.g., when f2c
+ran on machines with 16-bit ints, "i = 99999" was being translated
+to "i = -31073;".
+
+Wed Jun 27 11:05:32 EDT 1990:
+  Arrange for CHARACTER-valued PARAMETERs to honor their length
+specifications.  Allow CHAR(nn) in expressions defining such PARAMETERs.
+
+Fri Jul 20 09:17:30 EDT 1990:
+  Avoid dereferencing 0 when a FORMAT statement has no label.
+
+Thu Jul 26 11:09:39 EDT 1990:
+  Remarks about VOID and binread,binwrite added to README.
+  Tweaks to parse_args: should be invisible unless your compiler
+complained at (short)*store.
+
+Thu Aug  2 02:07:58 EDT 1990:
+  f2c.ps: change the first line of page 5 from
+	include stuff
+to
+	include 'stuff'
+
+Tue Aug 14 13:21:24 EDT 1990:
+  libi77: libI77 adjusted to treat tabs as spaces in list input.
+
+Fri Aug 17 07:24:53 EDT 1990:
+  libi77: libI77 adjusted so a blank='ZERO' clause (upper case Z)
+in an open of a currently open file works right.
+
+Tue Aug 28 01:56:44 EDT 1990:
+  Fix bug in warnings of inconsistent calling sequences: if an
+argument to a subprogram was never referenced, then a previous
+invocation of the subprogram (in the same source file) that
+passed something of the wrong type for that argument did not
+elicit a warning message.
+
+Thu Aug 30 09:46:12 EDT 1990:
+  libi77: prevent embedded blanks in list output of complex values;
+omit exponent field in list output of values of magnitude between
+10 and 1e8; prevent writing stdin and reading stdout or stderr;
+don't close stdin, stdout, or stderr when reopening units 5, 6, 0.
+
+Tue Sep  4 12:30:57 EDT 1990:
+  Fix bug in C emitted under -I2 or -i2 for INTEGER*4 FUNCTION.
+  Warn of missing final END even if there are previous errors.
+
+Fri Sep  7 13:55:34 EDT 1990:
+  Remark about "make xsum.out" and "make f2c" added to README.
+
+Tue Sep 18 23:50:01 EDT 1990:
+  Fix null dereference (and, on some systems, writing of bogus *_com.c
+files) under -ec or -e1c when a prototype file (*.p or *.P) describes
+COMMON blocks that do not appear in the Fortran source.
+  libi77:
+    Add some #ifdef lines (#ifdef MSDOS, #ifndef MSDOS) to avoid
+references to stat and fstat on non-UNIX systems.
+    On UNIX systems, add component udev to unit; decide that old
+and new files are the same iff both the uinode and udev components
+of unit agree.
+    When an open stmt specifies STATUS='OLD', use stat rather than
+access (on UNIX systems) to check the existence of the file (in case
+directories leading to the file have funny permissions and this is
+a setuid or setgid program).
+
+Thu Sep 27 16:04:09 EDT 1990:
+  Supply missing entry for Impldoblock in blksize array of cpexpr
+(in expr.c).  No examples are known where this omission caused trouble.
+
+Tue Oct  2 22:58:09 EDT 1990:
+  libf77: test signal(...) == SIG_IGN rather than & 01 in main().
+  libi77: adjust rewind.c so two successive rewinds after a write
+don't clobber the file.
+
+Thu Oct 11 18:00:14 EDT 1990:
+  libi77: minor cleanups: add #include "fcntl.h" to endfile.c, err.c,
+open.c; adjust g_char in util.c for segmented memories; in f_inqu
+(inquire.c), define x appropriately when MSDOS is defined.
+
+Mon Oct 15 20:02:11 EDT 1990:
+  Add #ifdef MSDOS pointer adjustments to mem.c; treat NAME= as a
+synonym for FILE= in OPEN statements.
+
+Wed Oct 17 16:40:37 EDT 1990:
+  libf77, libi77: minor cleanups: _cleanup() and abort() invocations
+replaced by invocations of sig_die in main.c; some error messages
+previously lost in buffers will now appear.
+
+Mon Oct 22 16:11:27 EDT 1990:
+  libf77: separate sig_die from main (for folks who don't want to use
+the main in libF77).
+  libi77: minor tweak to comments in README.
+
+Fri Nov  2 13:49:35 EST 1990:
+  Use two underscores rather than one in generated temporary variable
+names to avoid conflict with COMMON names.  f2c.ps updated to reflect
+this change and the NAME= extension introduced 15 Oct.
+  Repair a rare memory fault in io.c .
+
+Mon Nov  5 16:43:55 EST 1990:
+  libi77: changes to open.c (and err.c): complain if an open stmt
+specifies new= and the file already exists (as specified by Fortrans 77
+and 90); allow file= to be omitted in open stmts and allow
+status='replace' (Fortran 90 extensions).
+
+Fri Nov 30 10:10:14 EST 1990:
+  Adjust malloc.c for unusual systems whose sbrk() can return values
+not properly aligned for doubles.
+  Arrange for slightly more helpful and less repetitive warnings for
+non-character variables initialized with character data; these warnings
+are (still) suppressed by -w66.
+
+Fri Nov 30 15:57:59 EST 1990:
+  Minor tweak to README (about changing VOID in f2c.h).
+
+Mon Dec  3 07:36:20 EST 1990:
+  Fix spelling of "character" in f2c.1t.
+
+Tue Dec  4 09:48:56 EST 1990:
+  Remark about link_msg and libf2c added to f2c/README.
+
+Thu Dec  6 08:33:24 EST 1990:
+  Under -U, render label nnn as L_nnn rather than Lnnn.
+
+Fri Dec  7 18:05:00 EST 1990:
+  Add more names from f2c.h (e.g. integer, real) to the c_keywords
+list of names to which an underscore is appended to avoid confusion.
+
+Mon Dec 10 19:11:15 EST 1990:
+  Minor tweaks to makefile (./xsum) and README (binread/binwrite).
+  libi77: a few modifications for POSIX systems; meant to be invisible
+elsewhere.
+
+Sun Dec 16 23:03:16 EST 1990:
+  Fix null dereference caused by unusual erroneous input, e.g.
+	call foo('abc')
+	end
+	subroutine foo(msg)
+	data n/3/
+	character*(*) msg
+	end
+(Subroutine foo is illegal because the character statement comes after a
+data statement.)
+  Use decimal rather than hex constants in xsum.c (to prevent
+erroneous warning messages about constant overflow).
+
+Mon Dec 17 12:26:40 EST 1990:
+  Fix rare extra underscore in character length parameters passed
+for multiple entry points.
+
+Wed Dec 19 17:19:26 EST 1990:
+  Allow generation of C despite error messages about bad alignment
+forced by equivalence.
+  Allow variable-length concatenations in I/O statements, such as
+	open(3, file=bletch(1:n) // '.xyz')
+
+Fri Dec 28 17:08:30 EST 1990:
+  Fix bug under -p with formats and internal I/O "units" in COMMON,
+as in
+      COMMON /FIGLEA/F
+      CHARACTER*20 F
+      F = '(A)'
+      WRITE (*,FMT=F) 'Hello, world!'
+      END
+
+Tue Jan 15 12:00:24 EST 1991:
+  Fix bug when two equivalence groups are merged, the second with
+nonzero offset, and the result is then merged into a common block.
+Example:
+      INTEGER W(3), X(3), Y(3), Z(3)
+      COMMON /ZOT/ Z
+      EQUIVALENCE (W(1),X(1)), (X(2),Y(1)), (Z(3),X(1))
+***** W WAS GIVEN THE WRONG OFFSET
+  Recognize Fortran 90's optional NML= in NAMELIST READs and WRITEs.
+(Currently NML= and FMT= are treated as synonyms -- there's no
+error message if, e.g., NML= specifies a format.)
+  libi77: minor adjustment to allow internal READs from character
+string constants in read-only memory.
+
+Fri Jan 18 22:56:15 EST 1991:
+  Add comment to README about needing to comment out the typedef of
+size_t in sysdep.h on some systems, e.g. Sun 4.1.
+  Fix misspelling of "statement" in an error message in lex.c
+
+Wed Jan 23 00:38:48 EST 1991:
+  Allow hex, octal, and binary constants to have the qualifying letter
+(z, x, o, or b) either before or after the quoted string containing the
+digits.  For now this change will not be reflected in f2c.ps .
+
+Tue Jan 29 16:23:45 EST 1991:
+  Arrange for character-valued statement functions to give results of
+the right length (that of the statement function's name).
+
+Wed Jan 30 07:05:32 EST 1991:
+  More tweaks for character-valued statement functions: an error
+check and an adjustment so a right-hand side of nonconstant length
+(e.g., a substring) is handled right.
+
+Wed Jan 30 09:49:36 EST 1991:
+  Fix p1_head to avoid printing (char *)0 with %s.
+
+Thu Jan 31 13:53:44 EST 1991:
+  Add a test after the cleanup call generated for I/O statements with
+ERR= or END= clauses to catch the unlikely event that the cleanup
+routine encounters an error.
+
+Mon Feb  4 08:00:58 EST 1991:
+  Minor cleanup: omit unneeded jumps and labels from code generated for
+some NAMELIST READs and WRITEs with IOSTAT=, ERR=, and/or END=.
+
+Tue Feb  5 01:39:36 EST 1991:
+  Change Mktemp to mktmp (for the benefit of systems so brain-damaged
+that they do not distinguish case in external names -- and that for
+some reason want to load mktemp).  Try to get xsum0.out right this
+time (it somehow didn't get updated on 4 Feb. 1991).
+  Add note to libi77/README about adjusting the interpretation of
+RECL= specifiers in OPENs for direct unformatted I/O.
+
+Thu Feb  7 17:24:42 EST 1991:
+  New option -r casts values of REAL functions, including intrinsics,
+to REAL.  This only matters for unportable code like
+	real r
+	r = asin(1.)
+	if (r .eq. asin(1.)) ...
+[The behavior of such code varies with the Fortran compiler used --
+and sometimes is affected by compiler options.]  For now, the man page
+at the end of f2c.ps is the only part of f2c.ps that reflects this new
+option.
+
+Fri Feb  8 18:12:51 EST 1991:
+  Cast pointer differences passed as arguments to the appropriate type.
+This matters, e.g., with MSDOS compilers that yield a long pointer
+difference but have int == short.
+  Disallow nonpositive dimensions.
+
+Fri Feb 15 12:24:15 EST 1991:
+  Change %d to %ld in sprintf call in putpower in putpcc.c.
+  Free more memory (e.g. allowing translation of larger Fortran
+files under MS-DOS).
+  Recognize READ (character expression) and WRITE (character expression)
+as formatted I/O with the format given by the character expression.
+  Update year in Notice.
+
+Sat Feb 16 00:42:32 EST 1991:
+  Recant recognizing WRITE(character expression) as formatted output
+-- Fortran 77 is not symmetric in its syntax for READ and WRITE.
+
+Mon Mar  4 15:19:42 EST 1991:
+  Fix bug in passing the real part of a complex argument to an intrinsic
+function.  Omit unneeded parentheses in nested calls to intrinsics.
+Example:
+	subroutine foo(x, y)
+	complex y
+	x = exp(sin(real(y))) + exp(imag(y))
+	end
+
+Fri Mar  8 15:05:42 EST 1991:
+  Fix a comment in expr.c; omit safstrncpy.c (which had bugs in
+cases not used by f2c).
+
+Wed Mar 13 02:27:23 EST 1991:
+  Initialize firstmemblock->next in mem_init in mem.c .  [On most
+systems it was fortuituously 0, but with System V, -lmalloc could
+trip on this missed initialization.]
+
+Wed Mar 13 11:47:42 EST 1991:
+  Fix a reference to freed memory.
+
+Wed Mar 27 00:42:19 EST 1991:
+  Fix a memory fault caused by such illegal Fortran as
+       function foo
+       x = 3
+       logical foo	! declaration among executables
+       foo=.false.	! used to suffer memory fault
+       end
+
+Fri Apr  5 08:30:31 EST 1991:
+  Fix loss of % in some format expressions, e.g.
+	write(*,'(1h%)')
+  Fix botch introduced 27 March 1991 that caused subroutines with
+multiple entry points to have extraneous declarations of ret_val.
+
+Fri Apr  5 12:44:02 EST 1991
+  Try again to omit extraneous ret_val declarations -- this morning's
+fix was sometimes wrong.
+
+Mon Apr  8 13:47:06 EDT 1991:
+  Arrange for s_rnge to have the right prototype under -A -C .
+
+Wed Apr 17 13:36:03 EDT 1991:
+  New fatal error message for apparent invocation of a recursive
+statement function.
+
+Thu Apr 25 15:13:37 EDT 1991:
+  F2c and libi77 adjusted so NAMELIST works with -i2.  (I forgot
+about -i2 when adding NAMELIST.)  This required a change to f2c.h
+(that only affects NAMELIST I/O under -i2.)  Man-page description of
+-i2 adjusted to reflect that -i2 stores array lengths in short ints.
+
+Fri Apr 26 02:54:41 EDT 1991:
+  Libi77: fix some bugs in NAMELIST reading of multi-dimensional arrays
+(file rsne.c).
+
+Thu May  9 02:13:51 EDT 1991:
+  Omit a trailing space in expr.c (could cause a false xsum value if
+a mailer drops the trailing blank).
+
+Thu May 16 13:14:59 EDT 1991:
+  Libi77: increase LEFBL in lio.h to overcome a NeXT bug.
+  Tweak for compilers that recognize "nested" comments: inside comments,
+turn /* into /+ (as well as */ into +/).
+
+Sat May 25 11:44:25 EDT 1991:
+  libf77: s_rnge: declare line long int rather than int.
+
+Fri May 31 07:51:50 EDT 1991:
+  libf77: system_: officially return status.
+
+Mon Jun 17 16:52:53 EDT 1991:
+  Minor tweaks: omit unnecessary declaration of strcmp (that caused
+trouble on a system where strcmp was a macro) from misc.c; add
+SHELL = /bin/sh to makefiles.
+  Fix a dereference of null when a CHARACTER*(*) declaration appears
+(illegally) after DATA.  Complain only once per subroutine about
+declarations appearing after DATA.
+
+Mon Jul  1 00:28:13 EDT 1991:
+  Add test and error message for illegal use of subroutine names, e.g.
+      SUBROUTINE ZAP(A)
+      ZAP = A
+      END
+
+Mon Jul  8 21:49:20 EDT 1991:
+  Issue a warning about things like
+	integer i
+	i = 'abc'
+(which is treated as i = ichar('a')).  [It might be nice to treat 'abc'
+as an integer initialized (in a DATA statement) with 'abc', but
+other matters have higher priority.]
+  Render
+	i = ichar('A')
+as
+	i = 'A';
+rather than
+	i = 65;
+(which assumes ASCII).
+
+Fri Jul 12 07:41:30 EDT 1991:
+  Note added to README about erroneous definitions of __STDC__ .
+
+Sat Jul 13 13:38:54 EDT 1991:
+  Fix bugs in double type convesions of complex values, e.g.
+sngl(real(...)) or dble(real(...)) (where ... is complex).
+
+Mon Jul 15 13:21:42 EDT 1991:
+  Fix bug introduced 8 July 1991 that caused erroneous warnings
+"ichar([first char. of] char. string) assumed for conversion to numeric"
+when a subroutine had an array of character strings as an argument.
+
+Wed Aug 28 01:12:17 EDT 1991:
+  Omit an unused function in format.c, an unused variable in proc.c .
+  Under -r8, promote complex to double complex (as the man page claims).
+
+Fri Aug 30 17:19:17 EDT 1991:
+  f2c.ps updated: slightly expand description of intrinsics and,or,xor,
+not; add mention of intrinsics lshift, rshift; add note about f2c
+accepting Fortran 90 inline comments (starting with !); update Cobalt
+Blue address.
+
+Tue Sep 17 07:17:33 EDT 1991:
+  libI77: err.c and open.c modified to use modes "rb" and "wb"
+when (f)opening unformatted files; README updated to point out
+that it may be necessary to change these modes to "r" and "w"
+on some non-ANSI systems.
+
+Tue Oct 15 10:25:49 EDT 1991:
+  Minor tweaks that make some PC compilers happier: insert some
+casts, add args to signal functions.
+  Change -g to emit uncommented #line lines -- and to emit more of them;
+update fc, f2c.1, f2c.1t, f2c.ps to reflect this.
+  Change uchar to Uchar in xsum.c .
+  Bring gram.c up to date.
+
+Thu Oct 17 09:22:05 EDT 1991:
+  libi77: README, fio.h, sue.c, uio.c changed so the length field
+in unformatted sequential records has type long rather than int
+(unless UIOLEN_int is #defined).  This is for systems where sizeof(int)
+can vary, depending on the compiler or compiler options.
+
+Thu Oct 17 13:42:59 EDT 1991:
+  libi77: inquire.c: when MSDOS is defined, don't strcmp units[i].ufnm
+when it is NULL.
+
+Fri Oct 18 15:16:00 EDT 1991:
+  Correct xsum0.out in "all from f2c/src" (somehow botched on 15 Oct.).
+
+Tue Oct 22 18:12:56 EDT 1991:
+  Fix memory fault when a character*(*) argument is used (illegally)
+as a dummy variable in the definition of a statement function.  (The
+memory fault occurred when the statement function was invoked.)
+  Complain about implicit character*(*).
+
+Thu Nov 14 08:50:42 EST 1991:
+  libi77: change uint to Uint in fmt.h, rdfmt.c, wrtfmt.c; this change
+should be invisible unless you're running a brain-damaged system.
+
+Mon Nov 25 19:04:40 EST 1991:
+  libi77: correct botches introduced 17 Oct. 1991 and 14 Nov. 1991
+(change uint to Uint in lwrite.c; other changes that only matter if
+sizeof(int) != sizeof(long)).
+  Add a more meaningful error message when bailing out due to an attempt
+to invoke a COMMON variable as a function.
+
+Sun Dec  1 19:29:24 EST 1991:
+  libi77: uio.c: add test for read failure (seq. unformatted reads);
+adjust an error return from EOF to off end of record.
+
+Tue Dec 10 17:42:28 EST 1991:
+  Add tests to prevent memory faults with bad uses of character*(*).
+
+Thu Dec 12 11:24:41 EST 1991:
+  libi77: fix bug with internal list input that caused the last
+character of each record to be ignored; adjust error message in
+internal formatted input from "end-of-file" to "off end of record"
+if the format specifies more characters than the record contains.
+
+Wed Dec 18 17:48:11 EST 1991:
+  Fix bug in translating nonsensical ichar invocations involving
+concatenations.
+  Fix bug in passing intrinsics lle, llt, lge, lgt as arguments;
+hl_le was being passed rather than l_le, etc.
+  libf77: adjust length parameters from long to ftnlen, for
+compiling with f2c_i2 defined.
+
+Sat Dec 21 15:30:57 EST 1991:
+  Allow DO nnn ... to end with an END DO statement labelled nnn.
+
+Tue Dec 31 13:53:47 EST 1991:
+  Fix bug in handling dimension a(n**3,2) -- pow_ii was called
+incorrectly.
+  Fix bug in translating
+	subroutine x(abc,n)
+	character abc(n)
+	write(abc,'(i10)') 123
+	end
+(omitted declaration and initialiation of abc_dim1).
+  Complain about dimension expressions of such invalid types
+as complex and logical.
+
+Fri Jan 17 11:54:20 EST 1992:
+  Diagnose some illegal uses of main program name (rather than
+memory faulting).
+  libi77:  (1) In list and namelist input, treat "r* ," and "r*,"
+alike (where r is a positive integer constant), and fix a bug in
+handling null values following items with repeat counts (e.g.,
+2*1,,3).  (2) For namelist reading of a numeric array, allow a new
+name-value subsequence to terminate the current one (as though the
+current one ended with the right number of null values).
+(3) [lio.h, lwrite.c]:  omit insignificant zeros in list and namelist
+output.  (Compile with -DOld_list_output to get the old behavior.)
+
+Sat Jan 18 15:58:01 EST 1992:
+  libi77:  make list output consistent with F format by printing .1
+rather than 0.1 (introduced yesterday).
+
+Wed Jan 22 08:32:43 EST 1992:
+  libi77:  add comment to README pointing out preconnection of
+Fortran units 5, 6, 0 to stdin, stdout, stderr (respectively).
+
+Mon Feb  3 11:57:53 EST 1992:
+  libi77:  fix namelist read bug that caused the character following
+a comma to be ignored.
+
+Fri Feb 28 01:04:26 EST 1992:
+  libf77:  fix buggy z_sqrt.c (double precision square root), which
+misbehaved for arguments in the southwest quadrant.
+
+Thu Mar 19 15:05:18 EST 1992:
+  Fix bug (introduced 17 Jan 1992) in handling multiple entry points
+of differing types (with implicitly typed entries appearing after
+the first executable statement).
+  Fix memory fault in the following illegal Fortran:
+        double precision foo(i)
+*	illegal: above should be "double precision function foo(i)"
+        foo = i * 3.2
+        entry moo(i)
+        end
+  Note about ANSI_Libraries (relevant, e.g., to IRIX 4.0.1 and AIX)
+added to README.
+  Abort zero divides during constant simplification.
+
+Sat Mar 21 01:27:09 EST 1992:
+  Tweak ckalloc (misc.c) for systems where malloc(0) = 0; this matters
+for subroutines with multiple entry points but no arguments.
+  Add "struct memblock;" to init.c (irrelevant to most compilers).
+
+Wed Mar 25 13:31:05 EST 1992:
+  Fix bug with IMPLICIT INTEGER*4(...): under -i2 or -I2, the *4 was
+ignored.
+
+Tue May  5 09:53:55 EDT 1992:
+  Tweaks to README; e.g., ANSI_LIbraries changed to ANSI_Libraries .
+
+Wed May  6 23:49:07 EDT 1992
+  Under -A and -C++, have subroutines return 0 (even if they have
+no * arguments).
+  Adjust libi77 (rsne.c and lread.c) for systems where ungetc is
+a macro.  Tweak lib[FI]77/makefile to use unique intermediate file
+names (for parallel makes).
+
+Tue May 19 09:03:05 EDT 1992:
+  Adjust libI77 to make err= work with internal list and formatted I/O.
+
+Sat May 23 18:17:42 EDT 1992:
+  Under -A and -C++, supply "return 0;" after the code generated for
+a STOP statement -- the C compiler doesn't know that s_stop won't
+return.
+  New (mutually exclusive) options:
+	-f	treats all input lines as free-format lines,
+		honoring text that appears after column 72
+		and not padding lines shorter than 72 characters
+		with blanks (which matters if a character string
+		is continued across 2 or more lines).
+	-72	treats text appearing after column 72 as an error.
+
+Sun May 24 09:45:37 EDT 1992:
+  Tweak description of -f in f2c.1 and f2c.1t; update f2c.ps .
+
+Fri May 29 01:17:15 EDT 1992:
+  Complain about externals used as variables.  Example
+	subroutine foo(a,b)
+	external b
+	a = a*b		! illegal use of b; perhaps should be b()
+	end
+
+Mon Jun 15 11:15:27 EDT 1992:
+  Fix bug in handling namelists with names that have underscores.
+
+Sat Jun 27 17:30:59 EDT 1992:
+  Under -A and -C++, end Main program aliases with "return 0;".
+  Under -A and -C++, use .P files and usage in previous subprograms
+in the current file to give prototypes for functions declared EXTERNAL
+but not invoked.
+  Fix memory fault under -d1 -P .
+  Under -A and -C++, cast arguments to the right types in calling
+a function that has been defined in the current file or in a .P file.
+  Fix bug in handling multi-dimensional arrays with array references
+in their leading dimensions.
+  Fix bug in the intrinsic cmplx function when the first argument
+involves an expression for which f2c generates temporary variables,
+e.g. cmplx(abs(real(a)),1.) .
+
+Sat Jul 18 07:36:58 EDT 1992:
+  Fix buglet with -e1c (invisible on most systems) temporary file
+f2c_functions was unlinked before being closed.
+  libf77: fix bugs in evaluating m**n for integer n < 0 and m an
+integer different from 1 or a real or double precision 0.
+Catch SIGTRAP (to print "Trace trap" before aborting).  Programs
+that previously erroneously computed 1 for 0**-1 may now fault.
+Relevant routines: main.c pow_di.c pow_hh.c pow_ii.c pow_ri.c .
+
+Sat Jul 18 08:40:10 EDT 1992:
+  libi77: allow namelist input to end with & (e.g. &end).
+
+Thu Jul 23 00:14:43 EDT 1992
+  Append two underscores rather than one to C keywords used as
+local variables to avoid conflicts with similarly named COMMON blocks.
+
+Thu Jul 23 11:20:55 EDT 1992:
+  libf77, libi77 updated to assume ANSI prototypes unless KR_headers
+is #defined.
+  libi77 now recognizes a Z format item as in Fortran 90;
+the implementation assumes 8-bit bytes and botches character strings
+on little-endian machines (by printing their bytes from right to
+left): expect this bug to persist; fixing it would require a
+change to the I/O calling sequences.
+
+Tue Jul 28 15:18:33 EDT 1992:
+  libi77: insert missed "#ifdef KR_headers" lines around getnum
+header in rsne.c.  Version not updated.
+
+NOTE: "index from f2c" now ends with current timestamps of files in
+"all from f2c/src", sorted by time.  To bring your source up to date,
+obtain source files with a timestamp later than the time shown in your
+version.c.
+
+Fri Aug 14 08:07:09 EDT 1992:
+  libi77: tweak wrt_E in wref.c to avoid signing NaNs.
+
+Sun Aug 23 19:05:22 EDT 1992:
+  fc: supply : after O in getopt invocation (for -O1 -O2 -O3).
+
+Mon Aug 24 18:37:59 EDT 1992:
+  Recant above tweak to fc: getopt is dumber than I thought;
+it's necessary to say -O 1 (etc.).
+  libF77/README: add comments about ABORT, ERF, DERF, ERFC, DERFC,
+GETARG, GETENV, IARGC, SIGNAL, and SYSTEM.
+
+Tue Oct 27 01:57:42 EST 1992:
+  libf77, libi77:
+    1.  Fix botched indirection in signal_.c.
+    2.  Supply missing l_eof = 0 assignment to s_rsne() in rsne.c (so
+end-of-file on other files won't confuse namelist reads of external
+files).
+    3.  Prepend f__ to external names that are only of internal
+interest to lib[FI]77.
+
+Thu Oct 29 12:37:18 EST 1992:
+  libf77: Fix botch in signal_.c when KR_headers is #defined;
+add CFLAGS to makefile.
+  libi77: trivial change to makefile for consistency with
+libF77/makefile.
+
+Wed Feb  3 02:05:16 EST 1993:
+  Recognize types INTEGER*1, LOGICAL*1, LOGICAL*2, INTEGER*8.
+INTEGER*8 is not well tested and will only work reasonably on
+systems where int = 4 bytes, long = 8 bytes; on such systems,
+you'll have to modify f2c.h appropriately, changing integer
+from long to int and adding typedef long longint.  You'll also
+have to compile libI77 with Allow_TYQUAD #defined and adjust
+libF77/makefile to compile pow_qq.c.  In the f2c source, changes
+for INTEGER*8 are delimited by #ifdef TYQUAD ... #endif.  You
+can omit the INTEGER*8 changes by compiling with NO_TYQUAD
+#defined.  Otherwise, the new command-line option -!i8
+disables recognition of INTEGER*8.
+  libf77: add pow_qq.c
+  libi77: add #ifdef Allow_TYQUAD stuff.  Changes for INTEGER*1,
+LOGICAL*1, and LOGICAL*2 came last 23 July 1992.  Fix bug in
+backspace (that only bit when the last character of the second
+or subsequent buffer read was the previous newline).  Guard
+against L_tmpnam being too small in endfile.c.  For MSDOS,
+close and reopen files when copying to truncate.  Lengthen
+LINTW (buffer size in lwrite.c).
+  Add \ to the end of #define lines that get broken.
+  Fix bug in handling NAMELIST of items in EQUIVALENCE.
+  Under -h (or -hd), convert Hollerith to integer in general expressions
+(e.g., assignments), not just when they're passed as arguments, and
+blank-pad rather than 0-pad the Hollerith to a multiple of
+sizeof(integer) or sizeof(doublereal).
+  Add command-line option -s, which instructs f2c preserve multi-
+dimensional subscripts (by emitting and using appropriate #defines).
+  Fix glitch (with default type inferences) in examples like
+	call foo('abc')
+	end
+	subroutine foo(goo)
+	end
+This gave two warning messages:
+	Warning on line 4 of y.f: inconsistent calling sequences for foo:
+	        here 1, previously 2 args and string lengths.
+	Warning on line 4 of y.f: inconsistent calling sequences for foo:
+	        here 2, previously 1 args and string lengths.
+Now the second Warning is suppressed.
+  Complain about all inconsistent arguments, not just the first.
+  Switch to automatic creation of "all from f2c/src".  For folks
+getting f2c source via ftp, this means f2c/src/all.Z is now an
+empty file rather than a bundle.
+  Separate -P and -A: -P no longer implies -A.
+
+Thu Feb  4 00:32:20 EST 1993:
+  Fix some glitches (introduced yesterday) with -h .
+
+Fri Feb  5 01:40:38 EST 1993:
+  Fix bug in types conveyed for namelists (introduced 3 Feb. 1993).
+
+Fri Feb  5 21:26:43 EST 1993:
+  libi77: tweaks to NAMELIST and open (after comments by Harold
+Youngren):
+ 1. Reading a ? instead of &name (the start of a namelist) causes
+    the namelist being sought to be written to stdout (unit 6);
+    to omit this feature, compile rsne.c with -DNo_Namelist_Questions.
+ 2. Reading the wrong namelist name now leads to an error message
+    and an attempt to skip input until the right namelist name is found;
+    to omit this feature, compile rsne.c with -DNo_Bad_Namelist_Skip.
+ 3. Namelist writes now insert newlines before each variable; to omit
+    this feature, compile xwsne.c with -DNo_Extra_Namelist_Newlines.
+ 4. For OPEN of sequential files, ACCESS='APPEND' (or
+    access='anything else starting with "A" or "a"') causes the file to
+    be positioned at end-of-file, so a write will append to the file.
+    (This is nonstandard, but does not require modifying data
+    structures.)
+
+Mon Feb  8 14:40:37 EST 1993:
+  Increase number of continuation lines allowed from 19 to 99,
+and allow changing this limit with -NC (e.g. -NC200 for 200 lines).
+  Treat control-Z (at the beginning of a line) as end-of-file: see
+the new penultimate paragraph of README.
+  Fix a rarely seen glitch that could make an error messages to say
+"line 0".
+
+Tue Feb  9 02:05:40 EST 1993
+  libi77: change some #ifdef MSDOS lines to #ifdef NON_UNIX_STDIO,
+and, in err.c under NON_UNIX_STDIO, avoid close(creat(name,0666))
+when the unit has another file descriptor for name.
+
+Tue Feb  9 17:12:49 EST 1993
+  libi77: more tweaks for NON_UNIX_STDIO: use stdio routines
+rather than open, close, creat, seek, fdopen (except for f__isdev).
+
+Fri Feb 12 15:49:33 EST 1993
+  Update src/gram.c (which was forgotten in the recent updates).
+Most folks regenerate it anyway (wity yacc or bison).
+
+Thu Mar  4 17:07:38 EST 1993
+  Increase default max labels in computed gotos and alternate returns
+to 257, and allow -Nl1234 to specify this number.
+  Tweak put.c to check p->tag == TADDR in realpart() and imagpart().
+  Adjust fc script to allow .r (RATFOR) files and -C (check subscripts).
+  Avoid declaring strchr in niceprintf.c under -DANSI_Libraries .
+  gram.c updated again.
+  libi77: err.c, open.c: take declaration of fdopen from rawio.h.
+
+Sat Mar  6 07:09:11 EST 1993
+  libi77: uio.c: adjust off-end-of-record test for sequential
+unformatted reads to respond to err= rather than end= .
+
+Sat Mar  6 16:12:47 EST 1993
+  Treat scalar arguments of the form (v) and v+0, where v is a variable,
+as expressions: assign to a temporary variable, and pass the latter.
+  gram.c updated.
+
+Mon Mar  8 09:35:38 EST 1993
+  "f2c.h from f2c" updated to add types logical1 and integer1 for
+LOGICAL*1 and INTEGER*1.  ("f2c.h from f2c" is supposed to be the
+same as "f2c.h from f2c/src", which was updated 3 Feb. 1993.)
+
+Mon Mar  8 17:57:55 EST 1993
+  Fix rarely seen bug that could cause strange casts in function
+invocations (revealed by an example with msdos/f2c.exe).
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Fri Mar 12 12:37:01 EST 1993
+  Fix bug with -s in handling subscripts involving min, max, and
+complicated expressions requiring temporaries.
+  Fix bug in handling COMMONs that need padding by a char array.
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Fri Mar 12 17:16:16 EST 1993
+  libf77, libi77: updated for compiling under C++.
+
+Mon Mar 15 16:21:37 EST 1993
+  libi77: more minor tweaks (for -DKR_headers); Version.c not changed.
+
+Thu Mar 18 12:37:30 EST 1993
+  Flag -r (for discarding carriage-returns on systems that end lines
+with carriage-return/newline pairs, e.g. PCs) added to xsum, and
+xsum.c converted to ANSI/ISO syntax (with K&R syntax available with
+-DKR_headers).  [When time permits, the f2c source will undergo a
+similar conversion.]
+  libi77: tweaks to #includes in endfile.c, err.c, open.c, rawio.h;
+Version.c not changed.
+  f2c.ps updated (to pick up revision of 2 Feb. 1993 to f2c.1).
+
+Fri Mar 19 09:19:26 EST 1993
+  libi77: add (char *) casts to malloc and realloc invocations
+in err.c, open.c; Version.c not changed.
+
+Tue Mar 30 07:17:15 EST 1993
+  Fix bug introduced 6 March 1993: possible memory corruption when
+loops in data statements involve constant subscripts, as in
+	 DATA (GUNIT(1,I),I=0,14)/15*-1/
+
+Tue Mar 30 16:17:42 EST 1993
+  Fix bug with -s: (floating-point array item)*(complex item)
+generates an _subscr() reference for the floating-point array,
+but a #define for the _subscr() was omitted.
+
+Tue Apr  6 12:11:22 EDT 1993
+  libi77: adjust error returns for formatted inputs to flush the current
+input line when err= is specified.  To restore the old behavior (input
+left mid-line), either adjust the #definition of errfl in fio.h or omit
+the invocation of f__doend in err__fl (in err.c).
+
+Tue Apr  6 13:30:04 EDT 1993
+  Fix bug revealed in
+	subroutine foo(i)
+	call goo(int(i))
+	end
+which now passes a copy of i, rather than i itself.
+
+Sat Apr 17 11:41:02 EDT 1993
+  Adjust appending of underscores to conform with f2c.ps ("A Fortran
+to C Converter"): names that conflict with C keywords or f2c type
+names now have just one underscore appended (rather than two); add
+"integer1", "logical1", "longint" to the keyword list.
+  Append underscores to names that appear in EQUIVALENCE and are
+component names in a structure declared in f2c.h, thus avoiding a
+problem caused by the #defines emitted for equivalences.  Example:
+	complex a
+	equivalence (i,j)
+	a = 1	! a.i went awry because of #define i
+	j = 2
+	write(*,*) a, i
+	end
+  Adjust line-breaking logic to avoid splitting very long constants
+(and names).  Example:
+	! The next line starts with tab and thus is a free-format line.
+	a=.012345689012345689012345689012345689012345689012345689012345689012345689
+	end
+  Omit extraneous "return 0;" from entry stubs emitted for multiple
+entry points of type character, complex, or double complex.
+
+Sat Apr 17 14:35:05 EDT 1993
+  Fix bug (introduced 4 Feb.) in separating -P from -A that kept f2c
+from re-reading a .P file written without -A or -C++ describing a
+routine with an external argument.  [See the just-added note about
+separating -P from -A in the changes above for 3 Feb. 1993.]
+  Fix bug (type UNKNOWN for V in the example below) revealed by
+	subroutine a()
+	external c
+	call b(c)
+	end
+	subroutine b(v)
+	end
+
+Sun Apr 18 19:55:26 EDT 1993
+  Fix wrong calling sequence for mem() in yesterday's addition to
+equiv.c .
+
+Wed Apr 21 17:39:46 EDT 1993
+  Fix bug revealed in
+
+      ASSIGN 10 TO L1
+      GO TO 20
+ 10   ASSIGN 30 TO L2
+      STOP 10
+
+ 20   ASSIGN 10 TO L2	! Bug here because 10 had been assigned
+			! to another label, then defined.
+      GO TO L2
+ 30   END
+
+Fri Apr 23 18:38:50 EDT 1993
+  Fix bug with -h revealed in
+	CHARACTER*9 FOO
+	WRITE(FOO,'(I6)') 1
+	WRITE(FOO,'(I6)') 2	! struct icilist io___3 botched
+	END
+
+Tue Apr 27 16:08:28 EDT 1993
+  Tweak to makefile: remove "size f2c".
+
+Tue May  4 23:48:20 EDT 1993
+  libf77: tweak signal_ line of f2ch.add .
+
+Tue Jun  1 13:47:13 EDT 1993
+  Fix bug introduced 3 Feb. 1993 in handling multiple entry
+points with differing return types -- the postfix array in proc.c
+needed a new entry for integer*8 (which resulted in wrong
+Multitype suffixes for non-integral types).
+  For (default) K&R C, generate VOID rather than int functions for
+functions of Fortran type character, complex, and double complex.
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Tue Jun  1 23:11:15 EDT 1993
+  f2c.h: add Multitype component g and commented type longint.
+  proc.c: omit "return 0;" from stubs for complex and double complex
+entries (when entries have multiple types); add test to avoid memory
+fault with illegal combinations of entry types.
+
+Mon Jun  7 12:00:47 EDT 1993
+  Fix memory fault in
+	common /c/ m
+	integer m(1)
+	data m(1)/1/, m(2)/2/	! one too many initializers
+	end
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Fri Jun 18 13:55:51 EDT 1993
+  libi77: change type of signal_ in f2ch.add; change type of il in
+union Uint from long to integer (for machines like the DEC Alpha,
+where integer should be the same as int).  Version.c not changed.
+  Tweak gram.dcl and gram.head: add semicolons after some rules that
+lacked them, and remove an extraneous semicolon.  These changes are
+completely transparent to our local yacc programs, but apparently
+matter on some VMS systems.
+
+Wed Jun 23 01:02:56 EDT 1993
+  Update "fc" shell script, and bring f2c.1 and f2c.1t up to date:
+they're meant to be linked with (i.e., the same as) src/f2c.1 and
+src/f2c.1t .  [In the last update of f2c.1* (2 Feb. 1993), only
+src/f2c.1 and src/f2c.1t got changed -- a mistake.]
+
+Wed Jun 23 09:04:31 EDT 1993
+  libi77: fix bug in format reversions for internal writes.
+Example:
+	character*60 lines(2)
+	write(lines,"('n =',i3,2(' more text',i3))") 3, 4, 5, 6
+	write(*,*) 'lines(1) = ', lines(1)
+	write(*,*) 'lines(2) = ', lines(2)
+	end
+gave an error message that began "iio: off end of record", rather
+than giving the correct output:
+
+ lines(1) = n =  3 more text  4 more text  5
+ lines(2) =  more text  6 more text
+
+Thu Aug  5 11:31:14 EDT 1993
+  libi77: lread.c: fix bug in handling repetition counts for logical
+data (during list or namelist input).  Change struct f__syl to
+struct syl (for buggy compilers).
+
+Sat Aug  7 16:05:30 EDT 1993
+  libi77: lread.c (again): fix bug in namelist reading of incomplete
+logical arrays.
+  Fix minor calling-sequence errors in format.c, output.c, putpcc.c:
+should be invisible.
+
+Mon Aug  9 09:12:38 EDT 1993
+  Fix erroneous cast under -A in translating
+	character*(*) function getc()
+	getc(2:3)=' '		!wrong cast in first arg to s_copy
+	end
+  libi77: lread.c: fix bug in namelist reading of an incomplete array
+of numeric data followed by another namelist item whose name starts
+with 'd', 'D', 'e', or 'E'.
+
+Fri Aug 20 13:22:10 EDT 1993
+  Fix bug in do while revealed by
+	subroutine skdig (line, i)
+	character line*(*), ch*1
+	integer i
+	logical isdigit
+	isdigit(ch) = ch.ge.'0' .and. ch.le.'9'
+	do while (isdigit(line(i:i)))	! ch__1[0] was set before
+					! "while(...) {...}"
+		i = i + 1
+		enddo
+	end
+
+Fri Aug 27 08:22:54 EDT 1993
+  Add #ifdefs to avoid declaring atol when it is a macro; version.c
+not updated.
+
+Wed Sep  8 12:24:26 EDT 1993
+  libi77: open.c: protect #include "sys/..." with
+#ifndef NON_UNIX_STDIO; Version date not changed.
+
+Thu Sep  9 08:51:21 EDT 1993
+  Adjust "include" to interpret file names relative to the directory
+of the file that contains the "include".
+
+Fri Sep 24 00:56:12 EDT 1993
+  Fix offset error resulting from repeating the same equivalence
+statement twice.  Example:
+	real a(2), b(2)
+	equivalence (a(2), b(2))
+	equivalence (a(2), b(2))
+	end
+  Increase MAXTOKENLEN (to roughly the largest allowed by ANSI C).
+
+Mon Sep 27 08:55:09 EDT 1993
+  libi77: endfile.c: protect #include "sys/types.h" with
+#ifndef NON_UNIX_STDIO; Version.c not changed.
+
+Fri Oct 15 15:37:26 EDT 1993
+  Fix rarely seen parsing bug illustrated by
+	subroutine foo(xabcdefghij)
+	character*(*) xabcdefghij
+               IF (xabcdefghij.NE.'##') GOTO 40
+ 40	end
+in which the spacing in the IF line is crucial.
+
+Thu Oct 21 13:55:11 EDT 1993
+  Give more meaningful error message (then "unexpected character in
+cds") when constant simplification leads to Infinity or NaN.
+
+Wed Nov 10 15:01:05 EST 1993
+  libi77: backspace.c: adjust, under -DMSDOS, to cope with MSDOS
+text files, as handled by some popular PC C compilers.  Beware:
+the (defective) libraries associated with these compilers assume lines
+end with \r\n (conventional MS-DOS text files) -- and ftell (and
+hence the current implementation of backspace) screws up if lines with
+just \n.
+
+Thu Nov 18 09:37:47 EST 1993
+  Give a better error (than "control stack empty") for an extraneous
+ENDDO.  Example:
+	enddo
+	end
+  Update comments about ftp in "readme from f2c".
+
+Sun Nov 28 17:26:50 EST 1993
+  Change format of time stamp in version.c to yyyymmdd.
+  Sort parameter adjustments (or complain of impossible dependencies)
+so that dummy arguments are referenced only after being adjusted.
+Example:
+	subroutine foo(a,b)
+	integer a(2)		! a must be adjusted before b
+	double precision b(a(1),a(2))
+	call goo(b(3,4))
+	end
+  Adjust structs for initialized common blocks and equivalence classes
+to omit the trailing struct component added to force alignment when
+padding already forces the desired alignment.  Example:
+	PROGRAM TEST
+	COMMON /Z/ A, CC
+	CHARACTER*4 CC
+	DATA cc /'a'/
+	END
+now gives
+	struct {
+	    integer fill_1[1];
+	    char e_2[4];
+	    } z_ = { {0}, {'a', ' ', ' ', ' '} };
+rather than
+struct {
+    integer fill_1[1];
+    char e_2[4];
+    real e_3;
+    } z_ = { {0}, {'a', ' ', ' ', ' '}, (float)0. };
+
+Wed Dec  8 16:24:43 EST 1993
+  Adjust lex.c to recognize # nnn "filename" lines emitted by cpp;
+this affects the file names and line numbers in error messages and
+the #line lines emitted under -g.
+  Under -g, arrange for a file that starts with an executable
+statement to have the first #line line indicate line 1, rather
+than the line number of the END statement ending the main program.
+  Adjust fc script to run files ending in .F through /lib/cpp.
+  Fix bug ("Impossible tag 2") in
+	if (t .eq. (0,2)) write(*,*) 'Bug!'
+	end
+  libi77: iio.c: adjust internal formatted reads to treat short records
+as though padded with blanks (rather than causing an "off end of record"
+error).
+
+Wed Dec 15 15:19:15 EST 1993
+  fc: adjusted for .F files to pass -D and -I options to cpp.
+
+Fri Dec 17 20:03:38 EST 1993
+  Fix botch introduced 28 Nov. 1993 in vax.c; change "version of"
+to "version".
+
+Tue Jan  4 15:39:52 EST 1994
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only).
+
+Wed Jan 19 08:55:19 EST 1994
+  Arrange to accept
+	integer	Nx, Ny, Nz
+	parameter	(Nx = 10, Ny = 20)
+	parameter	(Nz = max(Nx, Ny))
+	integer	c(Nz)
+	call foo(c)
+	end
+rather than complaining "Declaration error for c: adjustable dimension
+on non-argument".  The necessary changes cause some hitherto unfolded
+constant expressions to be folded.
+  Accept BYTE as a synonym for INTEGER*1.
+
+Thu Jan 27 08:57:40 EST 1994
+  Fix botch in changes of 19 Jan. 1994 that broke entry points with
+multi-dimensional array arguments that did not appear in the subprogram
+argument list and whose leading dimensions depend on arguments.
+
+Mon Feb  7 09:24:30 EST 1994
+  Remove artifact in "fc" script that caused -O to be ignored:
+	87c87
+	<		# lcc ignores -O...
+	---
+	>		CFLAGS="$CFLAGS $O"
+
+Sun Feb 20 17:04:58 EST 1994
+  Fix bugs reading .P files for routines with arguments of type
+INTEGER*1, INTEGER*8, LOGICAL*2.
+  Fix glitch in reporting inconsistent arguments for routines involving
+character arguments:  "arg n" had n too large by the number of
+character arguments.
+
+Tue Feb 22 20:50:08 EST 1994
+  Trivial changes to data.c format.c main.c niceprintf.c output.h and
+sysdep.h (consistency improvements).
+  libI77: lread.c: check for NULL return from realloc.
+
+Fri Feb 25 23:56:08 EST 1994
+  output.c, sysdep.h: arrange for -DUSE_DTOA to use dtoa.c and g_fmt.c
+for correctly rounded decimal values on IEEE-arithmetic machines
+(plus machines with VAX and IBM-mainframe arithmetic).  These
+routines are available from netlib's fp directory.
+  msdos/f2cx.exe.Z and msdos/f2c.exe.Z updated (ftp access only); the
+former uses -DUSE_DTOA to keep 12 from printing as 12.000000000000001.
+  vax.c: fix wrong arguments to badtag and frchain introduced
+28 Nov. 1993.
+  Source for f2c converted to ANSI/ISO format, with the K&R format
+available by compilation with -DKR_headers .
+  Arrange for (double precision expression) relop (single precision
+constant) to retain the single-precision nature of the constant.
+Example:
+	double precision t
+	if (t .eq. 0.3) ...
+
+Mon Feb 28 11:40:24 EST 1994
+  README updated to reflect a modification just made to netlib's
+"dtoa.c from fp":
+96a97,105
+> Also add the rule
+>
+> 	dtoa.o: dtoa.c
+> 		$(CC) -c $(CFLAGS) -DMALLOC=ckalloc -DIEEE... dtoa.c
+>
+> (without the initial tab) to the makefile, where IEEE... is one of
+> IEEE_MC68k, IEEE_8087, VAX, or IBM, depending on your machine's
+> arithmetic.  See the comments near the start of dtoa.c.
+>
+
+Sat Mar  5 09:41:52 EST 1994
+  Complain about functions with the name of a previously declared
+common block (which is illegal).
+  New option -d specifies the directory for output .c and .P files;
+f2c.1 and f2c.1t updated.  The former undocumented debug option -dnnn
+is now -Dnnn.
+
+Thu Mar 10 10:21:44 EST 1994
+  libf77: add #undef min and #undef max lines to s_paus.c s_stop.c
+and system_.c; Version.c not changed.
+  libi77: add -DPad_UDread lines to uio.c and explanation to README:
+    Some buggy Fortran programs use unformatted direct I/O to write
+    an incomplete record and later read more from that record than
+    they have written.  For records other than the last, the unwritten
+    portion of the record reads as binary zeros.  The last record is
+    a special case: attempting to read more from it than was written
+    gives end-of-file -- which may help one find a bug.  Some other
+    Fortran I/O libraries treat the last record no differently than
+    others and thus give no help in finding the bug of reading more
+    than was written.  If you wish to have this behavior, compile
+    uio.c with -DPad_UDread .
+Version.c not changed.
+
+Tue Mar 29 17:27:54 EST 1994
+  Adjust make_param so dimensions involving min, max, and other
+complicated constant expressions do not provoke error messages
+about adjustable dimensions on non-arguments.
+  Fix botch introduced 19 Jan 1994: "adjustable dimension on non-
+argument" messages could cause some things to be freed twice.
+
+Tue May 10 07:55:12 EDT 1994
+  Trivial changes to exec.c, p1output.c, parse_args.c, proc.c,
+and putpcc.c: change arguments from
+	type foo[]
+to
+	type *foo
+for consistency with defs.h.  For most compilers, this makes no
+difference.
+
+Thu Jun  2 12:18:18 EDT 1994
+  Fix bug in handling FORMAT statements that have adjacent character
+(or Hollerith) strings: an extraneous \002 appeared between the
+strings.
+  libf77: under -DNO_ONEXIT, arrange for f_exit to be called just
+once; previously, upon abnormal termination (including stop statements),
+it was called twice.
+
+Mon Jun  6 15:52:57 EDT 1994
+  libf77: Avoid references to SIGABRT and SIGIOT if neither is defined;
+Version.c not changed.
+  libi77: Add cast to definition of errfl() in fio.h; this only matters
+on systems with sizeof(int) < sizeof(long).  Under -DNON_UNIX_STDIO,
+use binary mode for direct formatted files (to avoid any confusion
+connected with \n characters).
+
+Fri Jun 10 16:47:31 EDT 1994
+  Fix bug under -A in handling unreferenced (and undeclared)
+external arguments in subroutines with multiple entry points.  Example:
+	subroutine m(fcn,futil)
+	external fcn,futil
+	call fcn
+	entry mintio(i1) ! (D_fp)0 rather than (U_fp)0 for futil
+	end
+
+Wed Jun 15 10:38:14 EDT 1994
+  Allow char(constant expression) function in parameter declarations.
+(This was probably broken in the changes of 29 March 1994.)
+
+Fri Jul  1 23:54:00 EDT 1994
+  Minor adjustments to makefile (rule for f2c.1 commented out) and
+sysdep.h (#undef KR_headers if __STDC__ is #defined, and base test
+for ANSI_Libraries and ANSI_Prototypes on KR_headers rather than
+__STDC__); version.c touched but not changed.
+  libi77: adjust fp.h so local.h is only needed under -DV10;
+Version.c not changed.
+
+Tue Jul  5 03:05:46 EDT 1994
+  Fix segmentation fault in
+	subroutine foo(a,b,k)
+	data i/1/
+	double precision a(k,1)	! sequence error: must precede data
+	b = a(i,1)
+	end
+  libi77: Fix bug (introduced 6 June 1994?) in reopening files under
+NON_UNIX_STDIO.
+  Fix some error messages caused by illegal Fortran.  Examples:
+* 1.
+	x(i) = 0  !Missing declaration for array x
+	call f(x) !Said Impossible storage class 8 in routine mkaddr
+	end	  !Now says invalid use of statement function x
+* 2.
+	f = g	!No declaration for g; by default it's a real variable
+	call g	!Said invalid class code 2 for function g
+	end	!Now says g cannot be called
+* 3.
+	intrinsic foo	!Invalid intrinsic name
+	a = foo(b)	!Said intrcall: bad intrgroup 0
+	end		!Now just complains about line 1
+
+Tue Jul  5 11:14:26 EDT 1994
+  Fix glitch in handling erroneous statement function declarations.
+Example:
+	a(j(i) - i) = a(j(i) - i) + 1	! bad statement function
+	call foo(a(3))	! Said Impossible type 0 in routine mktmpn
+	end		! Now warns that i and j are not used
+
+Wed Jul  6 17:31:25 EDT 1994
+  Tweak test for statement functions that (illegally) call themselves;
+f2c will now proceed to check for other errors, rather than bailing
+out at the first recursive statement function reference.
+  Warn about but retain divisions by 0 (instead of calling them
+"compiler errors" and quiting).  On IEEE machines, this permits
+	double precision nan, ninf, pinf
+	nan = 0.d0/0.d0
+	pinf = 1.d0/0.d0
+	ninf = -1.d0/0.d0
+	write(*,*) 'nan, pinf, ninf = ', nan, pinf, ninf
+	end
+to print
+	nan, pinf, ninf =   NaN  Infinity -Infinity
+  libi77: wref.c: protect with #ifdef GOOD_SPRINTF_EXPONENT an
+optimization that requires exponents to have 2 digits when 2 digits
+suffice.  lwrite.c wsfe.c (list and formatted external output):
+omit ' ' carriage-control when compiled with -DOMIT_BLANK_CC .
+Off-by-one bug fixed in character count for list output of character
+strings.  Omit '.' in list-directed printing of Nan, Infinity.
+
+Mon Jul 11 13:05:33 EDT 1994
+  src/gram.c updated.
+
+Tue Jul 12 10:24:42 EDT 1994
+  libi77: wrtfmt.c: under G11.4, write 0. as "  .0000    " rather
+than "  .0000E+00".
+
+Thu Jul 14 17:55:46 EDT 1994
+  Fix glitch in changes of 6 July 1994 that could cause erroneous
+"division by zero" warnings (or worse).  Example:
+	subroutine foo(a,b)
+	y = b
+	a = a / y	! erroneous warning of division by zero
+	end
+
+Mon Aug  1 16:45:17 EDT 1994
+  libi77: lread.c rsne.c: for benefit of systems with a buggy stdio.h,
+declare ungetc when neither KR_headers nor ungetc is #defined.
+Version.c not changed.
+
+Wed Aug  3 01:53:00 EDT 1994
+  libi77: lwrite.c (list output): do not insert a newline when
+appending an oversize item to an empty line.
+
+Mon Aug  8 00:51:01 EDT 1994
+  Fix bug (introduced 3 Feb. 1993) that, under -i2, kept LOGICAL*2
+variables from appearing in INQUIRE statements.  Under -I2, allow
+LOGICAL*4 variables to appear in INQUIRE.  Fix intrinsic function
+LEN so it returns a short value under -i2, a long value otherwise.
+  exec.c: fix obscure memory fault possible with bizarre (and highly
+erroneous) DO-loop syntax.
+
+Fri Aug 12 10:45:57 EDT 1994
+  libi77: fix glitch that kept ERR= (in list- or format-directed input)
+from working after a NAMELIST READ.
+
+Thu Aug 25 13:58:26 EDT 1994
+  Suppress -s when -C is specified.
+  Give full pathname (netlib@research.att.com) for netlib in readme and
+src/README.
+
+Wed Sep  7 22:13:20 EDT 1994
+  libi77: typesize.c: adjust to allow types LOGICAL*1, LOGICAL*2,
+INTEGER*1, and (under -DAllow_TYQUAD) INTEGER*8 in NAMELISTs.
+
+Fri Sep 16 17:50:18 EDT 1994
+  Change name adjustment for reserved words: instead of just appending
+"_" (a single underscore), append "_a_" to local variable names to avoid
+trouble when a common block is named a reserved word and the same
+reserved word is also a local variable name.  Example:
+	common /const/ a,b,c
+	real const(3)
+	equivalence (const(1),a)
+	a = 1.234
+	end
+  Arrange for ichar() to treat characters as unsigned.
+  libf77: s_cmp.c: treat characters as unsigned in comparisons.
+These changes for unsignedness only matter for strings that contain
+non-ASCII characters.  Now ichar() should always be >= 0.
+
+Sat Sep 17 11:19:32 EDT 1994
+  fc: set rc=$? before exit (to get exit code right in trap code).
+
+Mon Sep 19 17:49:43 EDT 1994
+  libf77: s_paus.c: flush stderr after PAUSE; add #ifdef MSDOS stuff.
+  libi77: README: point out general need for -DMSDOS under MS-DOS.
+
+Tue Sep 20 11:42:30 EDT 1994
+  Fix bug in comparing identically named common blocks, in which
+all components have the same names and types, but at least one is
+dimensioned (1) and the other is not dimensioned.  Example:
+	subroutine foo
+	common /ab/ a
+	a=1.	!!! translated correctly to ab_1.a = (float)1.;
+	end
+	subroutine goo
+	common /ab/ a(1)
+	a(1)=2.	!!! translated erroneously to ab_1.a[0] = (float)2.
+	end
+
+Tue Sep 27 23:47:34 EDT 1994
+  Fix bug introduced 16 Sept. 1994: don't add _a_ to C keywords
+used as external names.  In fact, return to earlier behavior of
+appending __ to C keywords unless they are used as external names,
+in which case they get just one underscore appended.
+  Adjust constant handling so integer and logical PARAMETERs retain
+type information, particularly under -I2.  Example:
+	SUBROUTINE FOO
+	INTEGER I
+	INTEGER*1 I1
+	INTEGER*2 I2
+	INTEGER*4 I4
+	LOGICAL L
+	LOGICAL*1 L1
+	LOGICAL*2 L2
+	LOGICAL*4 L4
+	PARAMETER (L=.FALSE., L1=.FALSE., L2=.FALSE., L4=.FALSE.)
+	PARAMETER (I=0,I1=0,I2=0,I4=0)
+	CALL DUMMY(I, I1, I2, I4, L, L1, L2, L4)
+	END
+  f2c.1t: Change f\^2c to f2c (omit half-narrow space) in line following
+".SH NAME" for benefit of systems that cannot cope with troff commands
+in this context.
+
+Wed Sep 28 12:45:19 EDT 1994
+  libf77: s_cmp.c fix glitch in -DKR_headers version introduced
+12 days ago.
+
+Thu Oct  6 09:46:53 EDT 1994
+  libi77: util.c: omit f__mvgbt (which is never used).
+  f2c.h: change "long" to "long int" to facilitate the adjustments
+by means of sed described above.  Comment out unused typedef of Long.
+
+Fri Oct 21 18:02:24 EDT 1994
+  libf77: add s_catow.c and adjust README to point out that changing
+"s_cat.o" to "s_catow.o" in the makefile will permit the target of a
+concatenation to appear on its right-hand side (contrary to the
+Fortran 77 Standard and at the cost of some run-time efficiency).
+
+Wed Nov  2 00:03:58 EST 1994
+  Adjust -g output to contain only one #line line per statement,
+inserting \ before the \n ending lines broken because of their
+length [this insertion was recanted 10 Dec. 1994].  This change
+accommodates an idiocy in the ANSI/ISO C standard, which leaves
+undefined the behavior of #line lines that occur within the arguments
+to a macro call.
+
+Wed Nov  2 14:44:27 EST 1994
+  libi77: under compilation with -DALWAYS_FLUSH, flush buffers at
+the end of each write statement, and test (via the return from
+fflush) for write failures, which can be caught with an ERR=
+specifier in the write statement.  This extra flushing slows
+execution, but can abort execution or alter the flow of control
+when a disk fills up.
+  f2c/src/io.c: Add ERR= test to e_wsle invocation (end of
+list-directed external output) to catch write failures when libI77
+is compiled with -DALWAYS_FLUSH.
+
+Thu Nov  3 10:59:13 EST 1994
+  Fix bug in handling dimensions involving certain intrinsic
+functions of constant expressions: the expressions, rather than
+pointers to them, were passed.  Example:
+      subroutine subtest(n,x)
+      real x(2**n,n) ! pow_ii(2,n) was called; now it's pow_ii(&c__2,n)
+      x(2,2)=3.
+      end
+
+Tue Nov  8 23:56:30 EST 1994
+  malloc.c: remove assumption that only malloc calls sbrk.  This
+appears to make malloc.c useful on RS6000 systems.
+
+Sun Nov 13 13:09:38 EST 1994
+  Turn off constant folding of integers used in floating-point
+expressions, so the assignment in
+	subroutine foo(x)
+	double precision x
+	x = x*1000000*500000
+	end
+is rendered as
+	*x = *x * 1000000 * 500000;
+rather than as
+	*x *= 1783793664;
+
+Sat Dec 10 16:31:40 EST 1994
+  Supply a better error message (than "Impossible type 14") for
+	subroutine foo
+	foo = 3
+	end
+  Under -g, convey name of included files to #line lines.
+  Recant insertion of \ introduced (under -g) 2 Nov. 1994.
+
+Thu Dec 15 14:33:55 EST 1994
+  New command-line option -Idir specifies directories in which to
+look for non-absolute include files (after looking in the directory
+of the current input file).  There can be several -Idir options, each
+specifying one directory.  All -Idir options are considered, from
+left to right, until a suitably named file is found.  The -I2 and -I4
+command-line options have precedence, so directories named 2 or 4
+must be spelled by some circumlocation, such as -I./2 .
+  f2c.ps updated to mention the new -Idir option, correct a typo,
+and bring the man page at the end up to date.
+  lex.c: fix bug in reading line numbers in #line lines.
+  fc updated to pass -Idir options to f2c.
+
+Thu Dec 29 09:48:03 EST 1994
+  Fix bug (e.g., addressing fault) in diagnosing inconsistency in
+the type of function eta in the following example:
+	function foo(c1,c2)
+	double complex foo,c1,c2
+	double precision eta
+	foo = eta(c1,c2)
+	end
+	function eta(c1,c2)
+	double complex eta,c1,c2
+	eta = c1*c2
+	end
+
+Mon Jan  2 13:27:26 EST 1995
+  Retain casts for SNGL (or FLOAT) that were erroneously optimized
+away.  Example:
+	subroutine foo(a,b)
+	double precision a,b
+	a = float(b)	! now rendered as *a = (real) (*b);
+	end
+  Use float (rather than double) temporaries in certain expressions
+of type complex.  Example: the temporary for sngl(b) in
+	complex a
+	double precision b
+	a = sngl(b) - (3.,4.)
+is now of type float.
+
+Fri Jan  6 00:00:27 EST 1995
+  Adjust intrinsic function cmplx to act as dcmplx (returning
+double complex rather than complex) if either of its args is of
+type double precision.  The double temporaries used prior to 2 Jan.
+1995 previously gave it this same behavior.
+
+Thu Jan 12 12:31:35 EST 1995
+  Adjust -krd to use double temporaries in some calculations of
+type complex.
+  libf77: pow_[dhiqrz][hiq].c: adjust x**i to work on machines
+that sign-extend right shifts when i is the most negative integer.
+
+Wed Jan 25 00:14:42 EST 1995
+  Fix memory fault in handling overlapping initializations in
+	block data
+	common /zot/ d
+	double precision d(3)
+	character*6 v(4)
+	real r(2)
+	equivalence (d(3),r(1)), (d(1),v(1))
+	data v/'abcdef', 'ghijkl', 'mnopqr', 'stuvwx'/
+	data r/4.,5./
+	end
+  names.c: add "far", "huge", "near" to c_keywords (causing them
+to have __ appended when used as local variables).
+  libf77: add s_copyow.c, an alternative to s_copy.c for handling
+(illegal) character assignments where the right- and left-hand
+sides overlap, as in a(2:4) = a(1:3).
+
+Thu Jan 26 14:21:19 EST 1995
+  libf77: roll s_catow.c and s_copyow.c into s_cat.c and s_copy.c,
+respectively, allowing the left-hand side of a character assignment
+to appear on its right-hand side unless s_cat.c and s_copy.c are
+compiled with -DNO_OVERWRITE (which is a bit more efficient).
+Fortran 77 forbids the left-hand side from participating in the
+right-hand side (of a character assignment), but Fortran 90 allows it.
+  libi77: wref.c: fix glitch in printing the exponent of 0 when
+GOOD_SPRINTF_EXPONENT is not #defined.
+
+Fri Jan 27 12:25:41 EST 1995
+  Under -C++ -ec (or -C++ -e1c), surround struct declarations with
+	#ifdef __cplusplus
+	extern "C" {
+	#endif
+and
+	#ifdef __cplusplus
+	}
+	#endif
+(This isn't needed with cfront, but apparently is necessary with
+some other C++ compilers.)
+  libf77: minor tweak to s_copy.c: copy forward whenever possible
+(for better cache behavior).
+
+Wed Feb  1 10:26:12 EST 1995
+  Complain about parameter statements that assign values to dummy
+arguments, as in
+	subroutine foo(x)
+	parameter(x = 3.4)
+	end
+
+Sat Feb  4 20:22:02 EST 1995
+  fc: omit "lib=/lib/num/lib.lo".
+
+Wed Feb  8 08:41:14 EST 1995
+  Minor changes to exec.c, putpcc.c to avoid "bad tag" or "error
+in frexpr" with certain invalid Fortran.
+
+Sat Feb 11 08:57:39 EST 1995
+  Complain about integer overflows, both in simplifying integer
+expressions, and in converting integers from decimal to binary.
+  Fix a memory fault in putcx1() associated with invalid input.
+
+Thu Feb 23 11:20:59 EST 1995
+  Omit MAXTOKENLEN; realloc token if necessary (to handle very long
+strings).
+
+Fri Feb 24 11:02:00 EST 1995
+  libi77: iio.c: z_getc: insert (unsigned char *) to allow internal
+reading of characters with high-bit set (on machines that sign-extend
+characters).
+
+Tue Mar 14 18:22:42 EST 1995
+  Fix glitch (in io.c) in handling 0-length strings in format
+statements, as in
+	write(*,10)
+ 10	format(' ab','','cd')
+  libi77: lread.c and rsfe.c: adjust s_rsle and s_rsfe to check for
+end-of-file (to prevent infinite loops with empty read statements).
+
+Wed Mar 22 10:01:46 EST 1995
+  f2c.ps: adjust discussion of -P on p. 7 to reflect a change made
+3 Feb. 1993: -P no longer implies -A.
+
+Fri Apr 21 18:35:00 EDT 1995
+  fc script: remove absolute paths (since PATH specifies only standard
+places).  On most systems, it's still necessary to adjust the PATH
+assignment at the start of fc to fit the local conventions.
+
+Fri May 26 10:03:17 EDT 1995
+  fc script: add recognition of -P and .P files.
+  libi77: iio.c: z_wnew: fix bug in handling T format items in internal
+writes whose last item is written to an earlier position than some
+previous item.
+
+Wed May 31 11:39:48 EDT 1995
+  libf77: added subroutine exit(rc) (with integer return code rc),
+which works like a stop statement but supplies rc as the program's
+return code.
+
+Fri Jun  2 11:56:50 EDT 1995
+  Fix memory fault in
+	parameter (x=2.)
+	data x /2./
+	end
+This now elicits two error messages; the second ("too many
+initializers"), though not desirable, seems hard to eliminate
+without considerable hassle.
+
+Mon Jul 17 23:24:20 EDT 1995
+  Fix botch in simplifying constants in certain complex
+expressions.  Example:
+	subroutine foo(s,z)
+	double complex z
+	double precision s, M, P
+	parameter ( M = 100.d0, P = 2.d0 )
+	z = M * M  / s  * dcmplx (1.d0, P/M)
+*** The imaginary part of z was miscomputed ***
+	end
+  Under -ext, complain about nonintegral dimensions.
+
+Fri Jul 21 11:18:36 EDT 1995
+  Fix glitch on line 159 of init.c: change
+	"(shortlogical *)0)",
+to
+	"(shortlogical *)0",
+This affects multiple entry points when some but not all have
+arguments of type logical*2.
+  libi77: adjust lwrite.c, wref.c, wrtfmt.c so compiling with
+-DWANT_LEAD_0 causes formatted writes of floating-point numbers of
+magnitude < 1 to have an explicit 0 before the decimal point (if the
+field-width permits it).  Note that the Fortran 77 Standard leaves it
+up to the implementation whether to supply these superfluous zeros.
+
+Tue Aug  1 09:25:56 EDT 1995
+  Permit real (or double precision) parameters in dimension expressions.
+
+Mon Aug  7 08:04:00 EDT 1995
+  Append "_eqv" rather than just "_" to names that that appear in
+EQUIVALENCE statements as well as structs in f2c.h (to avoid a
+conflict when these names also name common blocks).
+
+Tue Aug  8 12:49:02 EDT 1995
+  Modify yesterday's change: merge st_fields with c_keywords, to
+cope with equivalences introduced to permit initializing numeric
+variables with character data.  DATA statements causing these
+equivalences can appear after executable statements, so the only
+safe course is to rename all local variable with names in the
+former st_fields list.  This has the unfortunate side effect that
+the common local variable "i" will henceforth be renamed "i__".
+
+Wed Aug 30 00:19:32 EDT 1995
+  libf77: add F77_aloc, now used in s_cat and system_ (to allocate
+memory and check for failure in so doing).
+  libi77: improve MSDOS logic in backspace.c.
+
+Wed Sep  6 09:06:19 EDT 1995
+  libf77: Fix return type of system_ (integer) under -DKR_headers.
+  libi77: Move some f_init calls around for people who do not use
+libF77's main(); now open and namelist read statements that are the
+first I/O statements executed should work right in that context.
+Adjust namelist input to treat a subscripted name whose subscripts do
+not involve colons similarly to the name without a subscript:  accept
+several values, stored in successive elements starting at the
+indicated subscript.  Adjust namelist output to quote character
+strings (avoiding confusion with arrays of character strings).
+
+Thu Sep  7 00:36:04 EDT 1995
+  Fix glitch in integer*8 exponentiation function: it's pow_qq, not
+pow_qi.
+  libi77: fix some bugs with -DAllow_TYQUAD (for integer*8); when
+looking for the &name that starts NAMELIST input, treat lines whose
+first nonblank character is something other than &, $, or ? as
+comment lines (i.e., ignore them), unless rsne.c is compiled with
+-DNo_Namelist_Comments.
+
+Thu Sep  7 09:05:40 EDT 1995
+  libi77: rdfmt.c:  one more tweak for -DAllow_TYQUAD.
+
+Tue Sep 19 00:03:02 EDT 1995
+  Adjust handling of floating-point subscript bounds (a questionable
+f2c extension) so subscripts in the generated C are of integral type.
+  Move #define of roundup to proc.c (where its use is commented out);
+version.c left at 19950918.
+
+Wed Sep 20 17:24:19 EDT 1995
+  Fix bug in handling ichar() under -h.
+
+Thu Oct  5 07:52:56 EDT 1995
+  libi77: wrtfmt.c: fix bug with t editing (f__cursor was not always
+zeroed in mv_cur).
+
+Tue Oct 10 10:47:54 EDT 1995
+  Under -ext, warn about X**-Y and X**+Y.  Following the original f77,
+f2c treats these as X**(-Y) and X**(+Y), respectively.  (They are not
+allowed by the official Fortran 77 Standard.)  Some Fortran compilers
+give a bizarre interpretation to larger contexts, making multiplication
+noncommutative: they treat X**-Y*Z as X**(-Y*Z) rather than X**(-Y)*Z,
+which, following the rules of Fortran 77, is the same as (X**(-Y))*Z.
+
+Wed Oct 11 13:27:05 EDT 1995
+  libi77: move defs of f__hiwater, f__svic, f__icptr from wrtfmt.c
+to err.c.  This should work around a problem with buggy loaders and
+sometimes leads to smaller executable programs.
+
+Sat Oct 21 23:54:22 EDT 1995
+  Under -h, fix bug in the treatment of ichar('0') in arithmetic
+expressions.
+  Demote to -dneg (a new command-line option not mentioned in the
+man page) imitation of the original f77's treatment of unary minus
+applied to a REAL operand (yielding a DOUBLE PRECISION result).
+Previously this imitation (which was present for debugging) occurred
+under (the default) -!R.  It is still suppressed by -R.
+
+Tue Nov  7 23:52:57 EST 1995
+  Adjust assigned GOTOs to honor SAVE declarations.
+  Add comments about ranlib to lib[FI]77/README and makefile.
+
+Tue Dec 19 22:54:06 EST 1995
+  libf77: s_cat.c: fix bug when 2nd or later arg overlaps lhs.
+
+Tue Jan  2 17:54:00 EST 1996
+  libi77: rdfmt.c: move #include "ctype.h" up before "stdlib.h"; no
+change to Version.c.
+
+Sun Feb 25 22:20:20 EST 1996
+  Adjust expr.c to permit raising the integer constants 1 and -1 to
+negative constant integral powers.
+  Avoid faulting when -T and -d are not followed by a directory name
+(immediately, without intervening spaces).
+
+Wed Feb 28 12:49:01 EST 1996
+  Fix a glitch in handling complex parameters assigned a "wrong" type.
+Example:
+	complex d, z
+	parameter(z = (0d0,0d0))
+	data d/z/	! elicited "non-constant initializer"
+	call foo(d)
+	end
+
+Thu Feb 29 00:53:12 EST 1996
+  Fix bug in handling character parameters assigned a char() value.
+Example:
+	character*2 b,c
+	character*1 esc
+	parameter(esc = char(27))
+	integer i
+	data (b(i:i),i=1,2)/esc,'a'/
+	data (c(i:i),i=1,2)/esc,'b'/	! memory fault
+	call foo(b,c)
+	end
+
+Fri Mar  1 23:44:51 EST 1996
+  Fix glitch in evaluating .EQ. and .NE. when both operands are
+logical constants (.TRUE. or .FALSE.).
+
+Fri Mar 15 17:29:54 EST 1996
+  libi77: lread.c, rsfe.c: honor END= in READ stmts with empty iolist.
+
+Tue Mar 19 23:08:32 EST 1996
+  lex.c: arrange for a "statement" consisting of a single short bogus
+keyword to elicit an error message showing the whole keyword.  The
+error message formerly omitted the last letter of the bad keyword.
+  libf77: s_cat.c: supply missing break after overlap detection.
+
+Mon May 13 23:35:26 EDT 1996
+  Recognize Fortran 90's /= as a synonym for .NE..  (<> remains a
+synonym for .NE..)
+  Emit an empty int function of no arguments to supply an external
+name to named block data subprograms (so they can be called somewhere
+to force them to be loaded from a library).
+  Fix bug (memory fault) in handling the following illegal Fortran:
+	parameter(i=1)
+	equivalence(i,j)
+	end
+  Treat cdabs, cdcos, cdexp, cdlog, cdsin, and cdsqrt as synonyms for
+the double complex intrinsics zabs, zcos, zexp, zlog, zsin, and zsqrt,
+respectively, unless -cd is specified.
+  Recognize the Fortran 90 bit-manipulation intrinsics btest, iand,
+ibclr, ibits, ibset, ieor, ior, ishft, and ishftc, unless -i90 is
+specified.  Note that iand, ieor, and ior are thus now synonyms for
+"and", "xor", and "or", respectively.
+  Add three macros (bit_test, bit_clear, bit_set) to f2c.h for use
+with btest, ibclr, and ibset, respectively.  Add new functions
+[lq]bit_bits, [lq]bit_shift, and [lq]_bit_cshift to libF77 for
+use with ibits, ishft, and ishftc, respectively.
+  Add integer function ftell(unit) (returning -1 on error) and
+subroutine fseek(unit, offset, whence, *) to libI77 (with branch to
+label * on error).
+
+Tue May 14 23:21:12 EDT 1996
+  Fix glitch (possible memory fault, or worse) in handling multiple
+entry points with names over 28 characters long.
+
+Mon Jun 10 01:20:16 EDT 1996
+  Update netlib E-mail and ftp addresses in f2c/readme and
+f2c/src/readme (which are different files) -- to reflect the upcoming
+breakup of AT&T.
+  libf77: trivial tweaks to F77_aloc.c and system_.c; Version.c not
+changed.
+  libi77: Adjust rsli.c and lread.c so internal list input with too
+few items in the input string will honor end= .
+
+Mon Jun 10 22:59:57 EDT 1996
+  Add Bits_per_Byte to sysdep.h and adjust definition of Table_size
+to depend on Bits_per_Byte (forcing Table_size to be a power of 2); in
+lex.c, change "comstart[c & 0xfff]" to "comstart[c & (Table_size-1)]"
+to avoid an out-of-range subscript on end-of-file.
+
+Wed Jun 12 00:24:28 EDT 1996
+  Fix bug in output.c (dereferencing a freed pointer) revealed in
+	print *		!np in out_call in output.c clobbered by free
+	end		!during out_expr.
+
+Wed Jun 19 08:12:47 EDT 1996
+  f2c.h: add types uinteger, ulongint (for libF77); add qbit_clear
+and qbit_set macros (in a commented-out section) for integer*8.
+  For integer*8, use qbit_clear and qbit_set for ibclr and ibset.
+  libf77: add casts to unsigned in [lq]bitshft.c.
+
+Thu Jun 20 13:30:43 EDT 1996
+  Complain at character*(*) in common (rather than faulting).
+  Fix bug in recognizing hex constants that start with "16#" (e.g.,
+16#1234abcd, which is a synonym for z'1234abcd').
+  Fix bugs in constant folding of expressions involving btest, ibclr,
+and ibset.
+  Fix bug in constant folding of rshift(16#80000000, -31) (on a 32-bit
+machine; more generally, the bug was in constant folding of
+rshift(ibset(0,NBITS-1), 1-NBITS) when f2c runs on a machine with
+long ints having NBITS bits.
+
+Mon Jun 24 07:58:53 EDT 1996
+  Adjust struct Literal and newlabel() function to accommodate huge
+source files (with more than 32767 newlabel() invocations).
+  Omit .c file when the .f file has a missing final end statement.
+
+Wed Jun 26 14:00:02 EDT 1996
+  libi77: Add discussion of MXUNIT (highest allowed Fortran unit number)
+to libI77/README.
+
+Fri Jun 28 14:16:11 EDT 1996
+  Fix glitch with -onetrip: the temporary variable used for nonconstant
+initial loop variable values was recycled too soon.  Example:
+	do i = j+1, k
+		call foo(i+1)	! temp for j+1 was reused here
+		enddo
+	end
+
+Tue Jul  2 16:11:27 EDT 1996
+  formatdata.c: add a 0 to the end of the basetype array (for TYBLANK)
+(an omission that was harmless on most machines).
+  expr.c: fix a dereference of NULL that was only possible with buggy
+input, such as
+	subroutine $sub(s)	! the '$' is erroneous
+	character s*(*)
+	s(1:) = ' '
+	end
+
+Sat Jul  6 00:44:56 EDT 1996
+  Fix glitch in the intrinsic "real" function when applied to a
+complex (or double complex) variable and passed as an argument to
+some intrinsic functions.  Example:
+	complex a
+	b = sqrt(a)
+	end
+  Fix glitch (only visible if you do not use f2c's malloc and the
+malloc you do use is defective in the sense that malloc(0) returns 0)
+in handling include files that end with another include (perhaps
+followed by comments).
+  Fix glitch with character*(*) arguments named "h" and "i" when
+the body of the subroutine invokes the intrinsic LEN function.
+  Arrange that after a previous "f2c -P foo.f" has produced foo.P,
+running "f2c foo.P foo.f" will produce valid C when foo.f contains
+	call sub('1234')
+	end
+	subroutine sub(msg)
+	end
+Specifically, the length argument in "call sub" is now suppressed.
+With or without foo.P, it is also now suppressed when the order of
+subprograms in file foo.f is reversed:
+	subroutine sub(msg)
+	end
+	call sub('1234')
+	end
+  Adjust copyright notices to reflect AT&T breakup.
+
+Wed Jul 10 09:25:49 EDT 1996
+  Fix bug (possible memory fault) in handling erroneously placed
+and inconsistent declarations.  Example that faulted:
+	character*1 w(8)
+	call foo(w)
+	end
+	subroutine foo(m)
+	data h /0.5/
+	integer m(2)	! should be before data
+	end
+  Fix bug (possible fault) in handling illegal "if" constructions.
+Example (that faulted):
+	subroutine foo(i,j)
+	if (i) then		! bug: i is integer, not logical
+	else if (j) then	! bug: j is integer, not logical
+	endif
+	end
+  Fix glitch with character*(*) argument named "ret_len" to a
+character*(*) function.
+
+Wed Jul 10 23:04:16 EDT 1996
+  Fix more glitches in the intrinsic "real" function when applied to a
+complex (or double complex) variable and passed as an argument to
+some intrinsic functions.  Example:
+	complex a, b
+	r = sqrt(real(conjg(a))) + sqrt(real(a*b))
+	end
+
+Thu Jul 11 17:27:16 EDT 1996
+  Fix a memory fault associated with complicated, illegal input.
+Example:
+	subroutine goo
+	character a
+	call foo(a)	! inconsistent with subsequent def and call
+	end
+	subroutine foo(a)
+	end
+	call foo(a)
+	end
+
+Wed Jul 17 19:18:28 EDT 1996
+  Fix yet another case of intrinsic "real" applied to a complex
+argument.  Example:
+	complex a(3)
+	x = sqrt(real(a(2)))	! gave error message about bad tag
+	end
+
+Mon Aug 26 11:28:57 EDT 1996
+  Tweak sysdep.c for non-Unix systems in which process ID's can be
+over 5 digits long.
+
+Tue Aug 27 08:31:32 EDT 1996
+  Adjust the ishft intrinsic to use unsigned right shifts.  (Previously,
+a negative constant second operand resulted in a possibly signed shift.)
+
+Thu Sep 12 14:04:07 EDT 1996
+  equiv.c: fix glitch with -DKR_headers.
+  libi77: fmtlib.c: fix bug in printing the most negative integer.
+
+Fri Sep 13 08:54:40 EDT 1996
+  Diagnose some illegal appearances of substring notation.
+
+Tue Sep 17 17:48:09 EDT 1996
+  Fix fault in handling some complex parameters.  Example:
+	subroutine foo(a)
+	double complex a, b
+	parameter(b = (0,1))
+	a = b	! f2c faulted here
+	end
+
+Thu Sep 26 07:47:10 EDT 1996
+  libi77:  fmt.h:  for formatted writes of negative integer*1 values,
+make ic signed on ANSI systems.  If formatted writes of integer*1
+values trouble you when using a K&R C compiler, switch to an ANSI
+compiler or use a compiler flag that makes characters signed.
+
+Tue Oct  1 14:41:36 EDT 1996
+  Give a better error message when dummy arguments appear in data
+statements.
+
+Thu Oct 17 13:37:22 EDT 1996
+  Fix bug in typechecking arguments to character and complex (or
+double complex) functions; the bug could cause length arguments
+for character arguments to be omitted on invocations appearing
+textually after the first invocation.  For example, in
+	subroutine foo
+	character c
+	complex zot
+	call goo(zot(c), zot(c))
+	end
+the length was omitted from the second invocation of zot, and
+there was an erroneous error message about inconsistent calling
+sequences.
+
+Wed Dec  4 13:59:14 EST 1996
+  Fix bug revealed by
+	subroutine test(cdum,rdum)
+	complex cdum
+	rdum=cos(real(cdum))	! "Unexpected tag 3 in opconv_fudge"
+	end
+  Fix glitch in parsing "DO 10 D0 = 1, 10".
+  Fix glitch in parsing
+	real*8 x
+	real*8 x	! erroneous "incompatible type" message
+	call foo(x)
+	end
+
+Mon Dec  9 23:15:02 EST 1996
+  Fix glitch in parameter adjustments for arrays whose lower
+bound depends on a scalar argument.  Example:
+	subroutine bug(p,z,m,n)
+	integer z(*),m,n
+	double precision p(z(m):z(m) + n)	! p_offset botched
+	call foo(p(0), p(n))
+	end
+  libi77: complain about non-positive rec= in direct read and write
+statements.
+  libf77: trivial adjustments; Version.c not changed.
+
+Wed Feb 12 00:18:03 EST 1997
+  output.c: fix (seldom problematic) glitch in out_call: put parens
+around the ... in a test of the form "if (q->tag == TADDR && ...)".
+  vax.c: fix bug revealed in the "psi_offset =" assignment in the
+following example:
+	subroutine foo(psi,m)
+	integer z(100),m
+	common /a/ z
+	double precision psi(z(m):z(m) + 10)
+	call foo(m+1, psi(0),psi(10))
+	end
+
+Mon Feb 24 23:44:54 EST 1997
+  For consistency with f2c's current treatment of adjacent character
+strings in FORMAT statements, recognize a Hollerith string following
+a string (and merge adjacent strings in FORMAT statements).
+
+Wed Feb 26 13:41:11 EST 1997
+  New libf2c.zip, a combination of the libf77 and libi77 bundles (and
+available only by ftp).
+  libf77: adjust functions with a complex output argument to permit
+aliasing it with input arguments.  (For now, at least, this is just
+for possible benefit of g77.)
+  libi77: tweak to ftell_.c for systems with strange definitions of
+SEEK_SET, etc.
+
+Tue Apr  8 20:57:08 EDT 1997
+  libf77: [cz]_div.c: tweaks invisible on most systems (that may
+improve things slightly with optimized compilation on systems that use
+gratuitous extra precision).
+  libi77: fmt.c: adjust to complain at missing numbers in formats
+(but still treat missing ".nnn" as ".0").
+
+Fri Apr 11 14:05:57 EDT 1997
+  libi77: err.c: attempt to make stderr line buffered rather than
+fully buffered.  (Buffering is needed for format items T and TR.)
+
+Thu Apr 17 22:42:43 EDT 1997
+ libf77: add F77_aloc.o to makefile (and makefile.u in libf2c.zip).
+
+Fri Apr 25 19:32:09 EDT 1997
+ libf77: add [de]time_.c (which may give trouble on some systems).
+
+Tue May 27 09:18:52 EDT 1997
+ libi77: ftell_.c: fix typo that caused the third argument to be
+treated as 2 on some systems.
+
+Mon Jun  9 00:04:37 EDT 1997
+ libi77 (and libf2c.zip): adjust include order in err.c lread.c wref.c
+rdfmt.c to include fmt.h (etc.) after system includes.  Version.c not
+changed.
+
+Mon Jul 21 16:04:54 EDT 1997
+  proc.c: fix glitch in logic for "nonpositive dimension" message.
+  libi77: inquire.c: always include string.h (for possible use with
+-DNON_UNIX_STDIO); Version.c not changed.
+
+Thu Jul 24 17:11:23 EDT 1997
+  Tweak "Notice" to reflect the AT&T breakup -- we missed it when
+updating the copyright notices in the source files last summer.
+  Adjust src/makefile so malloc.o is not used by default, but can
+be specified with "make MALLOC=malloc.o".
+  Add comments to src/README about the "CRAY" T3E.
+
+Tue Aug  5 14:53:25 EDT 1997
+  Add definition of calloc to malloc.c; this makes f2c's malloc
+work on some systems where trouble hitherto arose because references
+to calloc brought in the system's malloc.  (On sensible systems,
+calloc is defined separately from malloc.  To avoid confusion on
+other systems, f2c/malloc.c now defines calloc.)
+  libi77: lread.c: adjust to accord with a change to the Fortran 8X
+draft (in 1990 or 1991) that rescinded permission to elide quote marks
+in namelist input of character data; to get the old behavior, compile
+with F8X_NML_ELIDE_QUOTES #defined.  wrtfmt.o: wrt_G: tweak to print
+the right number of 0's for zero under G format.
+
+Sat Aug 16 05:45:32 EDT 1997
+  libi77: iio.c: fix bug in internal writes to an array of character
+strings that sometimes caused one more array element than required by
+the format to be blank-filled.  Example: format(1x).
+
+Wed Sep 17 00:39:29 EDT 1997
+  libi77: fmt.[ch] rdfmt.c wrtfmt.c: tweak struct syl for machines
+with 64-bit pointers and 32-bit ints that did not 64-bit align
+struct syl (e.g., Linux on the DEC Alpha).  This change should be
+invisible on other machines.
+
+Sun Sep 21 22:05:19 EDT 1997
+  libf77: [de]time_.c (Unix systems only): change return type to double.
+
+Thu Dec  4 22:10:09 EST 1997
+  Fix bug with handling large blocks of comments (over 4k); parts of the
+second and subsequent blocks were likely to be lost (not copied into
+comments in the resulting C).  Allow comment lines to be longer before
+breaking them.
+
+Mon Jan 19 17:19:27 EST 1998
+  makefile: change the rule for making gram.c to one for making gram1.c;
+henceforth, asking netlib to "send all from f2c/src" will bring you a
+working gram.c.  Nowadays there are simply too many broken versions of
+yacc floating around.
+  libi77: backspace.c: for b->ufmt==0, change sizeof(int) to
+sizeof(uiolen).  On machines where this would make a difference, it is
+best for portability to compile libI77 with -DUIOLEN_int, which will
+render the change invisible.
+
+Tue Feb 24 08:35:33 EST 1998
+  makefile: remove gram.c from the "make clean" rule.
+
+Wed Feb 25 08:29:39 EST 1998
+  makefile: change CFLAGS assignment to -O; add "veryclean" rule.
+
+Wed Mar  4 13:13:21 EST 1998
+  libi77: open.c: fix glitch in comparing file names under
+-DNON_UNIX_STDIO.
+
+Mon Mar  9 23:56:56 EST 1998
+  putpcc.c: omit an unnecessary temporary variable in computing
+(expr)**3.
+  libf77, libi77: minor tweaks to make some C++ compilers happy;
+Version.c not changed.
+
+Wed Mar 18 18:08:47 EST 1998
+  libf77: minor tweaks to [ed]time_.c; Version.c not changed.
+  libi77: endfile.c, open.c: acquire temporary files from tmpfile(),
+unless compiled with -DNON_ANSI_STDIO, which uses mktemp().
+New buffering scheme independent of NON_UNIX_STDIO for handling T
+format items.  Now -DNON_UNIX_STDIO is no longer be necessary for
+Linux, and libf2c no longer causes stderr to be buffered -- the former
+setbuf or setvbuf call for stderr was to make T format items work.
+open.c: use the Posix access() function to check existence or
+nonexistence of files, except under -DNON_POSIX_STDIO, where trial
+fopen calls are used.  In open.c, fix botch in changes of 19980304.
+  libf2c.zip: the PC makefiles are now set for NT/W95, with comments
+about changes for DOS.
+
+Fri Apr  3 17:22:12 EST 1998
+  Adjust fix of 19960913 to again permit substring notation on
+character variables in data statements.
+
+Sun Apr  5 19:26:50 EDT 1998
+  libi77: wsfe.c: make $ format item work: this was lost in the changes
+of 17 March 1998.
+
+Sat May 16 19:08:51 EDT 1998
+  Adjust output of ftnlen constants: rather than appending L,
+prepend (ftnlen).  This should make the resulting C more portable,
+e.g., to systems (such as DEC Alpha Unix systems) on which long
+may be longer than ftnlen.
+  Adjust -r so it also casts REAL expressions passed to intrinsic
+functions to REAL.
+
+Wed May 27 16:02:35 EDT 1998
+  libf2c.zip: tweak description of compiling libf2c for INTEGER*8
+to accord with makefile.u rather than libF77/makefile.
+
+Thu May 28 22:45:59 EDT 1998
+  libi77: backspace.c dfe.c due.c iio.c lread.c rsfe.c sue.c wsfe.c:
+set f__curunit sooner so various error messages will correctly
+identify the I/O unit involved.
+  libf2c.zip: above, plus tweaks to PC makefiles: for some purposes,
+it's still best to compile with -DMSDOS (even for use with NT).
+
+Thu Jun 18 01:22:52 EDT 1998
+  libi77: lread.c: modified so floating-point numbers (containing
+either a decimal point or an exponent field) are treated as errors
+when they appear as list input for integer data.  Compile lread.c with
+-DALLOW_FLOAT_IN_INTEGER_LIST_INPUT to restore the old behavior.
+
+Mon Aug 31 10:38:54 EDT 1998
+  formatdata.c: if possible, and assuming doubles must be aligned on
+double boundaries, use existing holes in DATA for common blocks to
+force alignment of the block.  For example,
+	block data
+	common /abc/ a, b
+	double precision a
+	integer b(2)
+	data b(2)/1/
+	end
+used to generate
+	struct {
+	    integer fill_1[3];
+	    integer e_2;
+	    doublereal e_3;
+	    } abc_ = { {0}, 1, 0. };
+and now generates
+	struct {
+	    doublereal fill_1[1];
+	    integer fill_2[1];
+	    integer e_3;
+	    } abc_ = { {0}, {0}, 1 };
+In the old generated C, e_3 was added to force alignment; in the new C,
+fill_1 does this job.
+
+Mon Sep  7 19:48:51 EDT 1998
+  libi77: move e_wdfe from sfe.c to dfe.c, where it was originally.
+Why did it ever move to sfe.c?
+
+Tue Sep  8 10:22:50 EDT 1998
+  Treat dreal as a synonym for dble unless -cd is specified on the
+command line.
+
+Sun Sep 13 22:23:41 EDT 1998
+  format.c: fix bug in writing prototypes under f2c -A ... *.P:
+under some circumstances involving external functions with no known
+type, a null pointer was passed to printf.
+
+Tue Oct 20 23:25:54 EDT 1998
+  Comments added to libf2c/README and libF77/README, pointing out
+the need to modify signal1.h on some systems.
+
+Wed Feb 10 22:59:52 EST 1999
+  defs.h lex.c: permit long names (up to at least roughly
+MAX_SHARPLINE_LEN = 1000 characters long) in #line lines (which only
+matters under -g).
+  fc: add -U option; recognize .so files.
+
+Sat Feb 13 10:18:27 EST 1999
+ libf2c: endfile.c, lread.c, signal1.h0: minor tweaks to make some
+(C++) compilers happier; f77_aloc.c: make exit_() visible to C++
+compilers.  Version strings not changed.
+
+Thu Mar 11 23:14:02 EST 1999
+  Modify f2c (exec.c, expr.c) to diagnose incorrect mixing of types
+when (f2c extended) intrinsic functions are involved, as in
+(not(17) .and. 4).  Catching this in the first executable statement
+is a bit tricky, as some checking must be postponed until all statement
+function declarations have been parsed.  Thus there is a chance of
+today's changes introducing bugs under (let us hope) unusual conditions.
+
+Sun Mar 28 13:17:44 EST 1999
+  lex.c: tweak to get the file name right in error messages caused
+by statements just after a # nnn "filename" line emitted by the C
+preprocessor.  (The trouble is that the line following the # nnn line
+must be read to see if it is a continuation of the stuff that preceded
+the # nnn line.)  When # nnn "filename" lines appear among the lines
+for a Fortran statement, the filename reported in an error message for
+the statement should now be the file that was current when the first
+line of the statement was read.
+
+Sun May  2 22:38:25 EDT 1999
+  libf77, libi77, libf2c.zip: make getenv_() more portable (call
+getenv() rather than knowing about char **environ); adjust some
+complex intrinsics to work with overlapping arguments (caused by
+inappropriate use of equivalence); open.c: get "external" versus
+"internal" right in the error message if a file cannot be opened;
+err.c: cast a pointer difference to (int) for %d; rdfmt.c: omit
+fixed-length buffer that could be overwritten by formats Inn or Lnn
+with nn > 83.
+
+Mon May  3 13:14:07 EDT 1999
+  "Invisible" changes to omit a few compiler warnings in f2c and
+libf2c; two new casts in libf2c/open.c that matter with 64-bit longs,
+and one more tweak (libf2c/c_log.c) for pathological equivalences.
+  Minor update to "fc" script: new -L flag and comment correction.
+
+Fri Jun 18 02:33:08 EDT 1999
+  libf2c.zip: rename backspace.c backspac.c, and fix a glitch in it
+-- b->ufd may change in t_runc().  (For now, it's still backspace.c
+in the libi77 bundle.)
+
+Sun Jun 27 22:05:47 EDT 1999
+  libf2c.zip, libi77: rsne.c: fix bug in namelist input: a misplaced
+increment could cause wrong array elements to be assigned; e.g.,
+"&input k(5)=10*1 &end" assigned k(5) and k(15 .. 23).
+
+Tue Sep  7 14:10:24 EDT 1999
+  f2c.h, libf2c/f2c.h0, libf2c/README: minor tweaks so a simple
+sed command converts f2c.h == libf2c/f2c.h0 to a form suitable for
+machines with 8-byte longs and doubles, 4-byte int's and floats,
+while working with a forthcoming (ill-advised) update to the C
+standard that outlaws plain "unsigned".
+  f2c.h, libf2c/f2c.h0: change "if 0" to "#ifdef INTEGER_STAR_8".
+  libf77, libf2c.zip: [cz]_div.c and README: arrange for compilation
+under -DIEEE_COMPLEX_DIVIDE to make these routines avoid calling sig_die
+when the denominator of a complex or double complex division vanishes;
+instead, they return pairs of NaNs or Infinities, depending whether the
+numerator also vanishes or not.
+
+Tue Oct  5 23:50:14 EDT 1999
+  formatdata.c, io.c, output.c, sysdep.c: adjust to make format
+strings legal when they contain 8-bit characters with the high bit on.
+(For many C compilers, this is not necessary, but it the ANSI/ISO C
+standard does not require this to work.)
+  libf2c.zip: tweak README and correct xsum0.out.
+
+Mon Oct 25 17:30:54 EDT 1999
+  io.c: fix glitch introduced in the previous change (19991005) that
+caused format(' %') to print "%%" rather than "%".
+
+Mon Nov 15 12:10:35 EST 1999
+  libf2c.zip: fix bug with the sequence backspace(n); endfile(n);
+rewind(n); read(n).  Supply missing (long) casts in a couple of places
+where they matter when size(ftnint) == sizeof(int) < sizeof(long).
+
+Tue Jan 18 19:22:24 EST 2000
+  Arrange for parameter statements involving min(...) and max(...)
+functions of three or more arguments to work.
+  Warn about text after "end" (rather than reporting a syntax error
+with a surprising line number).
+  Accept preprocessor line numbers of the form "# 1234" (possibly
+with trailing blanks).
+  Accept a comma after write(...) and before a list of things to write.
+
+Fri Jan 21 17:26:27 EST 2000
+  Minor updates to make compiling Win32 console binaries easier.  A
+side effect is that the MSDOS restriction of only one Fortran file
+per invocation is lifted (and "f2c *.f") works.
+
+Tue Feb  1 18:38:32 EST 2000
+  f2c/src/tokdefs.h added (to help people on non-Unix systems -- the
+makefile has always had a rule for generating tokdefs.h).
+
+Fri Mar 10 18:48:17 EST 2000
+  libf77, libf2c.zip: z_log.c: the real part of the double complex log
+of numbers near, e.g., (+-1,eps) with |eps| small is now more accurate.
+For example if z = (1,1d-7), then "write(*,*) z" now writes
+"(5.E-15,1.E-07" rather than the previous "(4.88498131E-15,1.E-07)".
+
+Thu Apr 20 13:02:54 EDT 2000
+  libf77, libi77, libf2c.zip: s_cat.c, rsne.c, xwsne.c: fix type
+errors that only matter if sizeof(ftnint) != sizeof(ftnlen).
+
+Tue May 30 23:36:18 EDT 2000
+  expr.c: adjust subcheck() to use a temporary variable of type TYLONG
+rather than TYSHORT under -C -I2.
+
+Wed May 31 08:48:03 EDT 2000
+  Simplify yesterday's adjustment; today's change should be invisible.
+
+Tue Jul  4 22:52:21 EDT 2000
+  misc.c, function "addressable": fix fault with "f2c -I2 foo.f" when
+foo.f consists of the 4 lines
+	subroutine foo(c)
+	character*(*) c
+	i = min(len(c),23)
+	end
+  Sundry files: tweaks for portability, e.g., for compilation by overly
+fastidious C++ compilers; "false" and "true" now treated as C keywords
+(so they get two underscores appended).
+  libf77, libi77, libf2c.zip: "invisible" adjustments to permit
+compilation by C++ compilers; version numbers not changed.
+
+Thu Jul  6 23:46:07 EDT 2000
+  Various files: tweaks to banish more compiler warnings.
+  lib?77, libf2c.zip/makefile.u: add "|| true" to ranlib invocations.
+  Thanks to Nelson H. F. Beebe for messages leading to these changes
+(and to many of the ones two days ago).
+  xsum.c: tweak include order.
+
+Fri Jul  7 18:01:25 EDT 2000
+  fc: accept -m xxx or -mxxx, pass them to the compiler as -mxxx
+(suggestion of Nelson Beebe).  Note that fc simply appends to CFLAGS,
+so system-specific stuff can be supplied in the environment variable
+CFLAGS.  With some shells, invocations of the form
+	CFLAGS='system-specific stuff' fc ...
+are one way to do this.
+
+Thu Aug 17 21:38:36 EDT 2000
+  Fix obscure glitch: in "Error on line nnn of ...: Bad # line:...",
+get nnn right.
+
+Sat Sep 30 00:28:30 EDT 2000
+  libf77, libf2c.zip: dtime_.c, etime_.c: use floating-point divide;
+dtime_.d, erf_.c, erfc_.c, etime.c: for use with "f2c -R", compile with
+-DREAL=float.
+
+Tue Dec  5 22:55:56 EST 2000
+  lread.c: under namelist input, when reading a logical array, treat
+Tstuff= and Fstuff= as new assignments rather than as logical constants.
+
+Fri Feb 23 00:43:56 EST 2001
+  libf2c: endfile.c: adjust to use truncate() unless compiled with
+-DNO_TRUNCATE (or with -DMSDOS).  Add libf2c/mkfile.plan9.
+
+Sat Feb 24 21:14:24 EST 2001
+  Prevent malloc(0) when a subroutine of no arguments has an entry
+with no arguments, as in
+	subroutine foo
+	entry goo
+	end
+  Fix a fault that was possible when MAIN (illegally) had entry points.
+  Fix a buffer overflow connected with the error message for names more
+than MAXNAMELEN (i.e., 50) bytes long.
+  Fix a bug in command-line argument passing that caused the invocation
+"f2c -!czork foo.f" to complain about two invalid flags ('-ork' and
+'-oo.f') instead of just one ('-ork').
+  fc: add -s option (strip executable); portability tweaks.
+  Adjustments to handing of integer*8 to permit processing 8-byte hex,
+binary, octal, and decimal constants.  The adjustments are only
+available when type long long (for >= 64 bit integers) is available to
+f2c; they are assumed available unless f2c is compiled with either
+-DNO_TYQUAD or -DNO_LONGLONG.  As has long been the case, compilation
+of f2c itself with -DNO_TYQUAD eliminates recognition of integer*8
+altogether.  Compilation with just -DNO_LONGLONG permits the previous
+handling of integer*8, which could only handle 32-bit constants
+associated with integer*8 variables.
+  New command-line argument -i8const (available only when f2c itself
+is compiled with neither -DNO_TYQUAD nor -DNO_LONGLONG) suppresses
+the new automatic promotion of integer constants too long to express
+as 32-bit values to type integer*8.  There are corresponding updates
+to f2c.1 and f2c.1t.
+
+Wed Feb 28 00:50:04 EST 2001
+  Adjust misc.c for (older) systems that recognize long long but do not
+have LLONG_MAX or LONGLONG_MAX in limits.h.
+  main.c: filter out bad files before dofork loop to avoid trouble
+in Win32 "f2c.exe" binaries.
+
+Thu Mar  1 16:25:19 EST 2001
+  Cosmetic change for consistency with some other netlib directories:
+change NO_LONGLONG to NO_LONG_LONG.  (This includes adjusting the above
+entry for Feb 23 2001.)  No change (other than timestamp) to version.c.
+  libf2c:  endfile.c:  switch to ftruncate (absent -DNO_TRUNCATE),
+thus permitting truncation of scratch files on true Unix systems,
+where scratch files have no name.  Add an fflush() (surprisingly)
+needed on some Linux systems.
+
+Tue Mar 20 22:03:23 EST 2001
+  expr.c:  complain ("impossible conversion") about attempts to assign
+character expressions ... to integer variables, rather than implicitly
+assigning ichar(...).
+
+Sat Jun 23 23:08:22 EDT 2001
+  New command-line option -trapuv adds calls on _uninit_f2c() to prologs
+to dynamically initialize local variables, except those appearing in
+SAVE or DATA statements, with values that may help find references to
+uninitialized variables.  For example, with IEEE arithmetic, floating-
+point variables are initialized to signaling NaNs.
+  expr.c: new warning for out-of-bounds constant substring expressions.
+Under -C, such expressions now inhibit C output.
+  libf2c/mkfile.plan9: fix glitch with rule for "check" (or xsum.out).
+  libf2c.zip: add uninit.c (for _uninit_f2c()) in support of -trapuv.
+  fc, f2c.1, f2c.1t: adjust for -trapuv.
+
+Thu Jul  5 22:00:51 EDT 2001
+  libf2c.zip: modify uninit.c for __mc68k__ under Linux.
+
+Wed Aug 22 08:01:37 EDT 2001
+  cds.c, expr.c: in constants, preserve the sign of 0.
+  expr.c: fix some glitches in folding constants to integer*8
+(when NO_LONG_LONG is not #defined).
+  intr.c: fold constant min(...) and max(...) expressions.
+
+Fri Nov 16 02:00:03 EST 2001
+  libf2c.zip:  tweak to permit handling files over 2GB long where
+possible, with suitable -D options, provided for some systems in
+new header file sysdep1.h (copied from sysdep1.h0 by default).
+Add an fseek to endfile.c to fix a glitch on some systems.
+
+Wed Nov 28 17:58:12 EST 2001
+  libf2c.zip:  on IEEE systems, print -0 as -0 when the relevant
+libf2c/makefile.* is suitably adjusted:  see comments about
+-DSIGNED_ZEROS in libf2c/makefile.*.
+
+Fri Jan 18 16:17:44 EST 2002
+  libf2c.zip:   fix bugs (reported by Holger Helmke) in qbit_bits():
+wrong return type, missing ~ on y in return value.  This affects
+the intrinsic ibits function for first argument of type integer*8.
+
+Thu Feb  7 17:14:43 EST 2002
+  Fix bug handling leading array dimensions in common:  invalid C
+resulted.  Example (after one provided by Dmitry G. Baksheyev):
+
+	subroutine foo(a)
+	common/c/m
+	integer m, n
+	equivalence(m,n)
+	integer a(n,2)
+	a(1,2) = 3
+	end
+
+  Fix a bug, apparently introduced sometime after 19980913, in
+handling certain substring expressions that involve temporary
+assignments and the first invocation of an implicitly typed function.
+When the expressions appeared in "else if (...)"  and "do while(...)",
+the temporary assignments appeared too soon.  Examples are hard to
+find, but here is one (after an example provided by Nat Bachman):
+
+	subroutine foo(n)
+	character*8 s
+	do while (moo(s(n+1:n+2)) .ge. 2)
+		n = n + 1
+		enddo
+	end
+
+It is hard for f2c to get this sort of example correct when the
+"untyped" function is a generic intrinsic.  When incorrect code would
+otherwise result, f2c now issues an error message and declines to
+produce C.  For example,
+
+	subroutine foo(n)
+	character*8 s
+	double precision goo
+	do while (sin(goo(s(n+1:n+2))) .ge. 2)
+		n = n + 1
+		enddo
+	end
+
+gives the new error message, but both
+
+	subroutine foo(n)
+	character*8 s
+	double precision goo
+	do while (dsin(goo(s(n+1:n+2))) .ge. 2)
+		n = n + 1
+		enddo
+	end
+and
+	subroutine foo(n)
+	character*8 s
+	double precision goo
+	do while (sin(goo(min(n, (n-3)**2))) .ge. 2)
+		n = n + 1
+		enddo
+	end
+
+give correct C.
+
+Fri Feb  8 08:43:40 EST 2002
+  Make a cleaner fix of the bug fixed yesterday in handling certain
+"do while(...)" and "else if (...)" constructs involving auxiliary
+assignments.  (Yesterday's changes to expr.c are recanted; expr.c
+is now restored to that of 20010820.)  Now
+
+	subroutine foo(n)
+	character*8 s
+	double precision goo
+	do while (sin(goo(s(n+1:n+2))) .ge. 0.2)
+		n = n + 1
+		enddo
+	end
+
+is correctly translated.
+
+Thu Mar 14 12:53:08 EST 2002
+  lex.c:  adjust to avoid an error message under -72 when source files
+are in CRLF form ("text mode" on Microsoft systems), a source line is
+exactly 72 characters long, and f2c is run on a system (such as a Unix
+or Linux system) that does not distinguish text and binary modes.
+Example (in CRLF form):
+      write(*,*)"Hello world, with a source line that is 72 chars long."
+      end
+  libf2c/z_log.c:  add code to cope with buggy compilers (e.g., some
+versions of gcc under -O2 or -O3) that do floating-point comparisons
+against values computed into extended-precision registers on some
+systems (such as Intel IA32 systems).  Compile with
+-DNO_DOUBLE_EXTENDED to omit the kludge that circumvents this bug.
+
+Thu May  2 19:09:01 EDT 2002
+  src/misc.c, src/sysdep.h, src/gram.c: tweaks for KR_headers (a rare
+concern today); version.c touched but left unchanged.
+  libf2c: fix glitch in makefile.vc; KR_header tweaks in s_stop.c
+and uninit.c (which also had a misplaced #endif).
+
+Wed Jun  5 16:13:34 EDT 2002
+  libf2c: uninit.c: for Linux on an ARM processor, add some
+#ifndef _FPU... tests; f77vers.c not changed.
+
+Tue Jun 25 15:13:32 EDT 2002
+  New command-line option -K requests old-style ("K&R") C.  The
+default is changed to -A (ANSI/ISO style).
+  Under -K, cast string-length arguments to (ftnlen).  This should
+matter only in the unusual case that "readme" instructs obtaining
+f2c.h by
+	sed 's/long int /long long /' f2c.h0 >f2c.h
+  Increase defaults for some table sizes:  make -Nn802 -Nq300 -Nx400
+the default.
+
+Fri Sep  6 18:39:24 EDT 2002
+  libf2c.zip: rsne.c: fix bug with multiple repeat counts in reading
+namelists, e.g., &nl a(2) = 3*1.0, 2*2.0, 3*3.0 /
+(Bug found by Jim McDonald, reported by Toon Moene.)
+
+Fri Oct  4 10:23:51 EDT 2002
+  libf2c.zip: uninit.c: on IRIX systems, omit references to shell
+variables (a dreg).  This only matters with f2c -trapuv .
+
+Thu Dec 12 22:16:00 EST 2002
+  proc.c: tweak to omit "* 1" from "a_offset = 1 + a_dim1 * 1;".
+  libf2c.zip: uninit.c: adjust to work with HP-UX B.11.11 as well as
+HP-UX B.10.20; f77vers.c not changed.
+
+Tue Feb 11 08:19:54 EST 2003
+  Fix a fault with f2c -s on the following example of invalid Fortran
+(reported by Nickolay A. Khokhlov); "function" should appear before
+"cat" on the first line:
+	character*(*) cat(a, b)
+	character*(*) a, b
+	cat = a // b
+	end
+  Issue warnings about inappropriate uses of arrays a, b, c and pass
+a temporary for d in
+	real a(2), b(2), c(2), d
+	call foo((a), 1*b, +c, +d)
+	end
+(correcting bugs reported by Arnaud Desitter).
+
+Thu Mar  6 22:48:08 EST 2003
+  output.c: fix a bug leading to "Unexpected tag 4 in opconv_fudge"
+when f2c -s processes the real part of a complex array reference.
+Example (simplified from netlib/linpack/zchdc.f):
+
+	subroutine foo(a,work,n,k)
+	integer k, n
+	complex*16 a(n,n), work(n)
+	work(k) = dcmplx(dsqrt(dreal(a(k,k))),0.0d0)
+	end
+
+(Thanks to Nickolay A. Khokhlov for the bug report.)
+
+Thu Mar 20 13:50:12 EST 2003
+  format.c:  code around a bug (reported by Nelson H. F. Beebe) in
+some versions of FreeBSD.  Compiling with __FreeBSD__ but not
+NO_FSCANF_LL_BUG #defined or with FSCANF_LL_BUG #defined causes
+special logic to replace  fscanf(infile, "%llx", result)  with
+custom logic.  Here's an example (from Beebe) where the bug bit:
+	integer*8 m, n
+	m = 9223372036854775807
+	end
+
+Fri Mar 21 13:14:05 EST 2003
+  libf2c.zip: err.c: before writing to a file after reading from it,
+do an f_seek(file, 0, SEEK_CUR) to make writing legal in ANSI C.
+
+Fri Jun  6 14:56:44 EDT 2003
+libf2c.zip:  add comments about libf2c.so (and a rule that works under
+Linux, after an adjustment to the CFLAGS = line) to libf2c/makefile.u.
+
+Sat Oct 25 07:57:53 MDT 2003
+README, main.c, sysdep.c:  adjust comments about libf2c and expand the
+comments thereon in the C that f2c writes (since too few people read
+the README files).  Change makefile to makefile.u (with the
+expectation that people will "cp makefile.u makefile" and edit
+makefile if necessary) and add makefile.vc (for Microsoft Visual C++).
+
+Thu Oct  7 23:25:28 MDT 2004
+names.c: for convenience of MSVC++ users, map "cdecl" to "cdecl__".
+
+Fri Mar  4 18:40:48 MST 2005
+sysdep.c, makefile.u, new file sysdeptest.c:  changes in response to a
+message forwarded by Eric Grosse from Thierry Carrez <koon@gentoo.org>
+(who is apparently unaware of f2c's -T option) about an unlikely
+security issue:  that a local attacker could plant symbolic links in
+/tmp corresponding to temporary file names that f2c generates and thus
+cause overwriting of arbitrary files.  Today's change is that if
+neither -T nor the unusual debugging flag -Dn is specified and the
+system is not an MS-Windows system (which cannot have symbolic links,
+as far as I know), then f2c's temporary files will be written in a
+temporary directory that is readable and writable only by the user and
+that is removed at the end of f2c's execution.  To disable today's
+change, compile sysdep.c with -DNO_TEMPDIR (i.e., with NO_TEMPDIR
+#defined).
+
+Sun Mar 27 20:06:49 MST 2005
+sysdep.c: in set_tmp_names(), fix botched placement of
+"if (debugflag == 1) return;":  move it below declarations.
+
+Sun May  1 21:45:46 MDT 2005
+sysdep.c:  fix a possible fault under -DMSDOS and improper handling
+of a tmpnam failure under the unusual combination of both -DNO_MKDTEMP
+and -DNO_MKSTEMP (without -DNO_TEMPDIR).
+
+Tue Oct  4 23:38:54 MDT 2005
+libf2c.zip:  uninit.c:  on IA32 Linux systems, leave the rounding
+precision alone rather than forcing it to 53 bits; compile with
+-DUNINIT_F2C_PRECISION_53 to get the former behavior.  This only
+affects Fortran files translated by f2c -trapuv .
+
+Sun May  7 00:38:59 MDT 2006
+  main.c, version.c:  add options -? (or --help) that print out
+pointers to usage documentation and -v (or --version) that print
+the current version.
+  fc script:  fix botch with -O[123]; recognize --version (or -v)
+and --help (or -?).
+  Add f2c.pdf == PDF version of f2c.ps.
+
+Sun Oct  8 02:45:04 MDT 2006
+  putpcc.c: fix glitch in subscripting complex variables:  subscripts
+of type integer*8 were converted to integer*4, which causes trouble
+when 32-bit addressing does not suffice.
+
+Tue Sep 11 23:54:05 MDT 2007
+  xsum.c:  insert explicit "int" before main.
+
+Mon Dec  3 20:53:24 MST 2007
+  libf2c/main.c: insert explicit "int" before main.
+
+Sat Apr  5 21:39:57 MDT 2008
+  libf2c.zip: tweaks for political C++ and const correctness, and
+to fix ctype trouble in some recent Linux versions.  No behavior
+should change.
+
+Sun Apr  6 22:38:56 MDT 2008
+  libf2c.zip: adjust alternate makefiles to reflect yesterday's change.
+
+Wed Nov 26 23:23:27 MST 2008
+  libf2c.zip: add brief discussion of MacOSX to comments in makefile.u.
+
+Fri Jan  2 23:13:25 MST 2009
+  libf2c.zip: add  -DNO_ISATTY to CFLAGS assignment in makefile.vc.
+
+Sat Apr 11 18:06:00 MDT 2009
+  src/sysdep.c src/sysdeptest.c: tweak for MacOSX (include <unistd.h>).
+
+Wed Jul  7 10:51:12 MDT 2010
+  src/data.c, src/format.c, src/p1output.c:  "invisible" tweaks to
+silence warnings seen in compilation under Ubuntu; version.c not changed.
+
+Fri Aug 27 09:14:17 MDT 2010
+  format.c: make sizeof(buf) depend on MAXNAMELEN to fix a bug with long
+names.  Update mswin/f2c.exe.gz accordingly.
+
+Fri Sep  3 16:03:24 MDT 2010
+  fc:  have "-m ..." modify CC rather than CFLAGS (to affect linking).
+
+Mon Aug  1 13:46:40 MDT 2011
+  README, README in libf2c.zip: update some netlib pointers.
+
+Thu Sep 26 16:42:35 MDT 2013
+  arithchk.c and sysdep1.h0 updated.  The former has a new
+"#ifdef NO_SSZIZE_T" section for use elsewhere.  The latter has a
+change supplied by Gregor Richards for use with some libc variants.
+
+Fri Jul 11 16:29:03 MDT 2014
+  comptry.bat in libf2c.zip updated.
+
+NOTE:  the old libf77 and libi77 bundles are no longer being updated.
+Use libf2c.zip instead.
+
+20160102
+  malloc.c:  use memmove rather than memcpy in realloc().
+
+20181026
+  Fix an allocation glitch in proc.c:
+1149c1149
+< 	    size = sizeof(int) + (3 + 2 * nd) * sizeof (expptr);
+---
+> 	    size = sizeof(struct Dimblock) + 2*sizeof(expptr)*(nd-1);
+Thanks to Ole Streicher for pointing out the need for this change.
+
+20190311
+  main.c:  update URL's in "f2c -?" and "f2c --help" output.
diff --git a/contrib/tools/f2c/src/data.c b/contrib/tools/f2c/src/data.c
new file mode 100644
index 0000000000..7da3ecb046
--- /dev/null
+++ b/contrib/tools/f2c/src/data.c
@@ -0,0 +1,502 @@
+/****************************************************************
+Copyright 1990, 1993-1996, 1999, 2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+
+/* ROUTINES CALLED DURING DATA AND PARAMETER STATEMENT PROCESSING */
+
+static char datafmt[] = "%s\t%09ld\t%d";
+static char *cur_varname;
+
+/* another initializer, called from parser */
+ void
+#ifdef KR_headers
+dataval(repp, valp)
+	register expptr repp;
+	register expptr valp;
+#else
+dataval(register expptr repp, register expptr valp)
+#endif
+{
+	ftnint elen, i, nrep;
+	register Addrp p;
+
+	if (parstate < INDATA) {
+		frexpr(repp);
+		goto ret;
+		}
+	if(repp == NULL)
+		nrep = 1;
+	else if (ISICON(repp) && repp->constblock.Const.ci >= 0)
+		nrep = repp->constblock.Const.ci;
+	else
+	{
+		err("invalid repetition count in DATA statement");
+		frexpr(repp);
+		goto ret;
+	}
+	frexpr(repp);
+
+	if( ! ISCONST(valp) ) {
+		if (valp->tag == TADDR
+		 && valp->addrblock.uname_tag == UNAM_CONST) {
+			/* kludge */
+			frexpr(valp->addrblock.memoffset);
+			valp->tag = TCONST;
+			}
+		else {
+			err("non-constant initializer");
+			goto ret;
+			}
+		}
+
+	if(toomanyinit) goto ret;
+	for(i = 0 ; i < nrep ; ++i)
+	{
+		p = nextdata(&elen);
+		if(p == NULL)
+		{
+			if (lineno != err_lineno)
+				err("too many initializers");
+			toomanyinit = YES;
+			goto ret;
+		}
+		setdata((Addrp)p, (Constp)valp, elen);
+		frexpr((expptr)p);
+	}
+
+ret:
+	frexpr(valp);
+}
+
+
+ Addrp
+#ifdef KR_headers
+nextdata(elenp)
+	ftnint *elenp;
+#else
+nextdata(ftnint *elenp)
+#endif
+{
+	register struct Impldoblock *ip;
+	struct Primblock *pp;
+	register Namep np;
+	register struct Rplblock *rp;
+	tagptr p;
+	expptr neltp;
+	register expptr q;
+	int skip;
+	ftnint off, vlen;
+
+	while(curdtp)
+	{
+		p = (tagptr)curdtp->datap;
+		if(p->tag == TIMPLDO)
+		{
+			ip = &(p->impldoblock);
+			if(ip->implb==NULL || ip->impub==NULL || ip->varnp==NULL) {
+				char buf[100];
+				sprintf(buf, "bad impldoblock #%lx",
+					(unsigned long)ip);
+				Fatal(buf);
+				}
+			if(ip->isactive)
+				ip->varvp->Const.ci += ip->impdiff;
+			else
+			{
+				q = fixtype(cpexpr(ip->implb));
+				if( ! ISICON(q) )
+					goto doerr;
+				ip->varvp = (Constp) q;
+
+				if(ip->impstep)
+				{
+					q = fixtype(cpexpr(ip->impstep));
+					if( ! ISICON(q) )
+						goto doerr;
+					ip->impdiff = q->constblock.Const.ci;
+					frexpr(q);
+				}
+				else
+					ip->impdiff = 1;
+
+				q = fixtype(cpexpr(ip->impub));
+				if(! ISICON(q))
+					goto doerr;
+				ip->implim = q->constblock.Const.ci;
+				frexpr(q);
+
+				ip->isactive = YES;
+				rp = ALLOC(Rplblock);
+				rp->rplnextp = rpllist;
+				rpllist = rp;
+				rp->rplnp = ip->varnp;
+				rp->rplvp = (expptr) (ip->varvp);
+				rp->rpltag = TCONST;
+			}
+
+			if( (ip->impdiff>0 && (ip->varvp->Const.ci <= ip->implim))
+			    || (ip->impdiff<0 && (ip->varvp->Const.ci >= ip->implim)) )
+			{ /* start new loop */
+				curdtp = ip->datalist;
+				goto next;
+			}
+
+			/* clean up loop */
+
+			if(rpllist)
+			{
+				rp = rpllist;
+				rpllist = rpllist->rplnextp;
+				free( (charptr) rp);
+			}
+			else
+				Fatal("rpllist empty");
+
+			frexpr((expptr)ip->varvp);
+			ip->isactive = NO;
+			curdtp = curdtp->nextp;
+			goto next;
+		}
+
+		pp = (struct Primblock *) p;
+		np = pp->namep;
+		cur_varname = np->fvarname;
+		skip = YES;
+
+		if(p->primblock.argsp==NULL && np->vdim!=NULL)
+		{   /* array initialization */
+			q = (expptr) mkaddr(np);
+			off = typesize[np->vtype] * curdtelt;
+			if(np->vtype == TYCHAR)
+				off *= np->vleng->constblock.Const.ci;
+			q->addrblock.memoffset =
+			    mkexpr(OPPLUS, q->addrblock.memoffset, mkintcon(off) );
+			if( (neltp = np->vdim->nelt) && ISCONST(neltp))
+			{
+				if(++curdtelt < neltp->constblock.Const.ci)
+					skip = NO;
+			}
+			else
+				err("attempt to initialize adjustable array");
+		}
+		else
+			q = mklhs((struct Primblock *)cpexpr((expptr)pp), 0);
+		if(skip)
+		{
+			curdtp = curdtp->nextp;
+			curdtelt = 0;
+		}
+		if(q->headblock.vtype == TYCHAR)
+			if(ISICON(q->headblock.vleng))
+				*elenp = q->headblock.vleng->constblock.Const.ci;
+			else	{
+				err("initialization of string of nonconstant length");
+				continue;
+			}
+		else	*elenp = typesize[q->headblock.vtype];
+
+		if (np->vstg == STGBSS) {
+			vlen = np->vtype==TYCHAR
+				? np->vleng->constblock.Const.ci
+				: typesize[np->vtype];
+			if(vlen > 0)
+				np->vstg = STGINIT;
+			}
+		return( (Addrp) q );
+
+doerr:
+		err("nonconstant implied DO parameter");
+		frexpr(q);
+		curdtp = curdtp->nextp;
+
+next:
+		curdtelt = 0;
+	}
+
+	return(NULL);
+}
+
+
+
+LOCAL FILEP dfile;
+
+ void
+#ifdef KR_headers
+setdata(varp, valp, elen)
+	register Addrp varp;
+	register Constp valp;
+	ftnint elen;
+#else
+setdata(register Addrp varp, register Constp valp, ftnint elen)
+#endif
+{
+	struct Constblock con;
+	register int type;
+	int j, valtype;
+	ftnint i, k, offset;
+	char *varname;
+	static Addrp badvar;
+	register unsigned char *s;
+	static long last_lineno;
+	static char *last_varname;
+
+	if (varp->vstg == STGCOMMON) {
+		if (!(dfile = blkdfile))
+			dfile = blkdfile = opf(blkdfname, textwrite);
+		}
+	else {
+		if (procclass == CLBLOCK) {
+			if (varp != badvar) {
+				badvar = varp;
+				warn1("%s is not in a COMMON block",
+					varp->uname_tag == UNAM_NAME
+					? varp->user.name->fvarname
+					: "???");
+				}
+			return;
+			}
+		if (!(dfile = initfile))
+			dfile = initfile = opf(initfname, textwrite);
+		}
+	varname = dataname(varp->vstg, varp->memno);
+	offset = varp->memoffset->constblock.Const.ci;
+	type = varp->vtype;
+	valtype = valp->vtype;
+	if(type!=TYCHAR && valtype==TYCHAR)
+	{
+		if(! ftn66flag
+		&& (last_varname != cur_varname || last_lineno != lineno)) {
+			/* prevent multiple warnings */
+			last_lineno = lineno;
+			warn1(
+	"non-character datum %.42s initialized with character string",
+				last_varname = cur_varname);
+			}
+		varp->vleng = ICON(typesize[type]);
+		varp->vtype = type = TYCHAR;
+	}
+	else if( (type==TYCHAR && valtype!=TYCHAR) ||
+	    (cktype(OPASSIGN,type,valtype) == TYERROR) )
+	{
+		err("incompatible types in initialization");
+		return;
+	}
+	if(type == TYADDR)
+		con.Const.ci = valp->Const.ci;
+	else if(type != TYCHAR)
+	{
+		if(valtype == TYUNKNOWN)
+			con.Const.ci = valp->Const.ci;
+		else	consconv(type, &con, valp);
+	}
+
+	j = 1;
+
+	switch(type)
+	{
+	case TYLOGICAL:
+	case TYINT1:
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+		dataline(varname, offset, type);
+		prconi(dfile, con.Const.ci);
+		break;
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		dataline(varname, offset, type);
+		prconq(dfile, con.Const.cq);
+		break;
+#endif
+
+	case TYADDR:
+		dataline(varname, offset, type);
+		prcona(dfile, con.Const.ci);
+		break;
+
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		j = 2;
+	case TYREAL:
+	case TYDREAL:
+		dataline(varname, offset, type);
+		prconr(dfile, &con, j);
+		break;
+
+	case TYCHAR:
+		k = valp -> vleng -> constblock.Const.ci;
+		if (elen < k)
+			k = elen;
+		s = (unsigned char *)valp->Const.ccp;
+		for(i = 0 ; i < k ; ++i) {
+			dataline(varname, offset++, TYCHAR);
+			fprintf(dfile, "\t%d\n", *s++);
+			}
+		k = elen - valp->vleng->constblock.Const.ci;
+		if(k > 0) {
+			dataline(varname, offset, TYBLANK);
+			fprintf(dfile, "\t%d\n", (int)k);
+			}
+		break;
+
+	default:
+		badtype("setdata", type);
+	}
+
+}
+
+
+
+/*
+   output form of name is padded with blanks and preceded
+   with a storage class digit
+*/
+ char*
+#ifdef KR_headers
+dataname(stg, memno)
+	int stg;
+	long memno;
+#else
+dataname(int stg, long memno)
+#endif
+{
+	static char varname[64];
+	register char *s, *t;
+	char buf[16];
+
+	if (stg == STGCOMMON) {
+		varname[0] = '2';
+		sprintf(s = buf, "Q.%ld", memno);
+		}
+	else {
+		varname[0] = stg==STGEQUIV ? '1' : '0';
+		s = memname(stg, memno);
+		}
+	t = varname + 1;
+	while(*t++ = *s++);
+	*t = 0;
+	return(varname);
+}
+
+
+
+
+ void
+#ifdef KR_headers
+frdata(p0)
+	chainp p0;
+#else
+frdata(chainp p0)
+#endif
+{
+	register struct Chain *p;
+	register tagptr q;
+
+	for(p = p0 ; p ; p = p->nextp)
+	{
+		q = (tagptr)p->datap;
+		if(q->tag == TIMPLDO)
+		{
+			if(q->impldoblock.isbusy)
+				return;	/* circular chain completed */
+			q->impldoblock.isbusy = YES;
+			frdata(q->impldoblock.datalist);
+			free( (charptr) q);
+		}
+		else
+			frexpr(q);
+	}
+
+	frchain( &p0);
+}
+
+
+ void
+#ifdef KR_headers
+dataline(varname, offset, type)
+	char *varname;
+	ftnint offset;
+	int type;
+#else
+dataline(char *varname, ftnint offset, int type)
+#endif
+{
+	fprintf(dfile, datafmt, varname, offset, type);
+}
+
+ void
+#ifdef KR_headers
+make_param(p, e)
+	register struct Paramblock *p;
+	expptr e;
+#else
+make_param(register struct Paramblock *p, expptr e)
+#endif
+{
+	register expptr q;
+	Constp qc;
+
+	if (p->vstg == STGARG)
+		errstr("Dummy argument %.50s appears in a parameter statement.",
+			p->fvarname);
+	p->vclass = CLPARAM;
+	impldcl((Namep)p);
+	if (e->headblock.vtype != TYCHAR)
+		e = putx(fixtype(e));
+	p->paramval = q = mkconv(p->vtype, e);
+	if (p->vtype == TYCHAR) {
+		if (q->tag == TEXPR)
+			p->paramval = q = fixexpr((Exprp)q);
+		if (q->tag == TADDR && q->addrblock.uname_tag == UNAM_CONST) {
+			qc = mkconst(TYCHAR);
+			qc->Const = q->addrblock.user.Const;
+			qc->vleng = q->addrblock.vleng;
+			q->addrblock.vleng = 0;
+			frexpr(q);
+			p->paramval = q = (expptr)qc;
+			}
+		if (!ISCONST(q) || q->constblock.vtype != TYCHAR) {
+			errstr("invalid value for character parameter %s",
+				p->fvarname);
+			return;
+			}
+		if (!(e = p->vleng))
+			p->vleng = ICON(q->constblock.vleng->constblock.Const.ci
+					+ q->constblock.Const.ccp1.blanks);
+		else if (q->constblock.vleng->constblock.Const.ci
+				> e->constblock.Const.ci) {
+			q->constblock.vleng->constblock.Const.ci
+				= e->constblock.Const.ci;
+			q->constblock.Const.ccp1.blanks = 0;
+			}
+		else
+			q->constblock.Const.ccp1.blanks
+				= e->constblock.Const.ci
+				- q->constblock.vleng->constblock.Const.ci;
+		}
+	}
diff --git a/contrib/tools/f2c/src/defines.h b/contrib/tools/f2c/src/defines.h
new file mode 100644
index 0000000000..1ed4537eec
--- /dev/null
+++ b/contrib/tools/f2c/src/defines.h
@@ -0,0 +1,300 @@
+#define PDP11 4
+
+#define BIGGEST_CHAR	0x7f		/* Assumes 32-bit arithmetic */
+#define BIGGEST_SHORT	0x7fff		/* Assumes 32-bit arithmetic */
+#define BIGGEST_LONG	0x7fffffff	/* Assumes 32-bit arithmetic */
+
+#define M(x) (1<<x)	/* Mask (x) returns 2^x */
+
+#define ALLOC(x)	(struct x *) ckalloc((int)sizeof(struct x))
+#define ALLEXPR		(expptr) ckalloc((int)sizeof(union Expression) )
+typedef int *ptr;
+typedef char *charptr;
+typedef FILE *FILEP;
+typedef int flag;
+typedef char field;	/* actually need only 4 bits */
+typedef long int ftnint;
+#define LOCAL static
+
+#define NO 0
+#define YES 1
+
+#define CNULL (char *) 0	/* Character string null */
+#define PNULL (ptr) 0
+#define CHNULL (chainp) 0	/* Chain null */
+#define ENULL (expptr) 0
+
+
+/* BAD_MEMNO - used to distinguish between long string constants and other
+   constants in the table */
+
+#define BAD_MEMNO -32768
+
+
+/* block tag values -- syntactic stuff */
+
+#define TNAME 1
+#define TCONST 2
+#define TEXPR 3
+#define TADDR 4
+#define TPRIM 5		/* Primitive datum - should not appear in an
+			   expptr variable, it should have already been
+			   identified */
+#define TLIST 6
+#define TIMPLDO 7
+#define TERROR 8
+
+
+/* parser states - order is important, since there are several tests for
+   state < INDATA   */
+
+#define OUTSIDE 0
+#define INSIDE 1
+#define INDCL 2
+#define INDATA 3
+#define INEXEC 4
+
+/* procedure classes */
+
+#define PROCMAIN 1
+#define PROCBLOCK 2
+#define PROCSUBR 3
+#define PROCFUNCT 4
+
+
+/* storage classes -- vstg values.  BSS and INIT are used in the later
+   merge pass over identifiers; and they are entered differently into the
+   symbol table */
+
+#define STGUNKNOWN 0
+#define STGARG 1	/* adjustable dimensions */
+#define STGAUTO 2	/* for stack references */
+#define STGBSS 3	/* uninitialized storage (normal variables) */
+#define STGINIT 4	/* initialized storage */
+#define STGCONST 5
+#define STGEXT 6	/* external storage */
+#define STGINTR 7	/* intrinsic (late decision) reference.  See
+			   chapter 5 of the Fortran 77 standard */
+#define STGSTFUNCT 8
+#define STGCOMMON 9
+#define STGEQUIV 10
+#define STGREG 11	/* register - the outermost DO loop index will be
+			   in a register (because the compiler is one
+			   pass, it can't know where the innermost loop is
+			   */
+#define STGLENG 12
+#define STGNULL 13
+#define STGMEMNO 14	/* interemediate-file pointer to constant table */
+
+/* name classes -- vclass values, also   procclass   values */
+
+#define CLUNKNOWN 0
+#define CLPARAM 1	/* Parameter - macro definition */
+#define CLVAR 2		/* variable */
+#define CLENTRY 3
+#define CLMAIN 4
+#define CLBLOCK 5
+#define CLPROC 6
+#define CLNAMELIST 7	/* in data with this tag, the   vdcldone   flag should
+			   be ignored (according to vardcl()) */
+
+
+/* vprocclass values -- there is some overlap with the vclass values given
+   above */
+
+#define PUNKNOWN 0
+#define PEXTERNAL 1
+#define PINTRINSIC 2
+#define PSTFUNCT 3
+#define PTHISPROC 4	/* here to allow recursion - further distinction
+			   is given in the CL tag (those just above).
+			   This applies to the presence of the name of a
+			   function used within itself.  The function name
+			   means either call the function again, or assign
+			   some value to the storage allocated to the
+			   function's return value. */
+
+/* control stack codes - these are part of a state machine which handles
+   the nesting of blocks (i.e. what to do about the ELSE statement) */
+
+#define CTLDO 1
+#define CTLIF 2
+#define CTLELSE 3
+#define CTLIFX 4
+
+
+/* operators for both Fortran input and C output.  They are common because
+   so many are shared between the trees */
+
+#define OPPLUS 1
+#define OPMINUS 2
+#define OPSTAR 3
+#define OPSLASH 4
+#define OPPOWER 5
+#define OPNEG 6
+#define OPOR 7
+#define OPAND 8
+#define OPEQV 9
+#define OPNEQV 10
+#define OPNOT 11
+#define OPCONCAT 12
+#define OPLT 13
+#define OPEQ 14
+#define OPGT 15
+#define OPLE 16
+#define OPNE 17
+#define OPGE 18
+#define OPCALL 19
+#define OPCCALL 20
+#define OPASSIGN 21
+#define OPPLUSEQ 22
+#define OPSTAREQ 23
+#define OPCONV 24
+#define OPLSHIFT 25
+#define OPMOD 26
+#define OPCOMMA 27
+#define OPQUEST 28
+#define OPCOLON 29
+#define OPABS 30
+#define OPMIN 31
+#define OPMAX 32
+#define OPADDR 33
+#define OPCOMMA_ARG 34
+#define OPBITOR 35
+#define OPBITAND 36
+#define OPBITXOR 37
+#define OPBITNOT 38
+#define OPRSHIFT 39
+#define OPWHATSIN 40		/* dereferencing operator */
+#define OPMINUSEQ 41		/* assignment operators */
+#define OPSLASHEQ 42
+#define OPMODEQ 43
+#define OPLSHIFTEQ 44
+#define OPRSHIFTEQ 45
+#define OPBITANDEQ 46
+#define OPBITXOREQ 47
+#define OPBITOREQ 48
+#define OPPREINC 49		/* Preincrement (++x) operator */
+#define OPPREDEC 50		/* Predecrement (--x) operator */
+#define OPDOT 51		/* structure field reference */
+#define OPARROW 52		/* structure pointer field reference */
+#define OPNEG1 53		/* simple negation under forcedouble */
+#define OPDMIN 54		/* min(a,b) macro under forcedouble */
+#define OPDMAX 55		/* max(a,b) macro under forcedouble */
+#define OPASSIGNI 56		/* assignment for inquire stmt */
+#define OPIDENTITY 57		/* for turning TADDR into TEXPR */
+#define OPCHARCAST 58		/* for casting to char * (in I/O stmts) */
+#define OPDABS 59		/* abs macro under forcedouble */
+#define OPMIN2 60		/* min(a,b) macro */
+#define OPMAX2 61		/* max(a,b) macro */
+#define OPBITTEST 62		/* btest */
+#define OPBITCLR 63		/* ibclr */
+#define OPBITSET 64		/* ibset */
+#define OPQBITCLR 65		/* ibclr, integer*8 */
+#define OPQBITSET 66		/* ibset, integer*8 */
+#define OPBITBITS 67		/* ibits */
+#define OPBITSH 68		/* ishft */
+#define OPBITSHC 69		/* ishftc */
+
+/* label type codes -- used with the ASSIGN statement */
+
+#define LABUNKNOWN 0
+#define LABEXEC 1
+#define LABFORMAT 2
+#define LABOTHER 3
+
+
+/* INTRINSIC function codes*/
+
+#define INTREND 0
+#define INTRCONV 1
+#define INTRMIN 2
+#define INTRMAX 3
+#define INTRGEN 4	/* General intrinsic, e.g. cos v. dcos, zcos, ccos */
+#define INTRSPEC 5
+#define INTRBOOL 6
+#define INTRCNST 7	/* constants, e.g. bigint(1.0) v. bigint (1d0) */
+#define INTRBGEN 8	/* bit manipulation */
+
+
+/* I/O statement codes - these all form Integer Constants, and are always
+   reevaluated */
+
+#define IOSTDIN ICON(5)
+#define IOSTDOUT ICON(6)
+#define IOSTDERR ICON(0)
+
+#define IOSBAD (-1)
+#define IOSPOSITIONAL 0
+#define IOSUNIT 1
+#define IOSFMT 2
+
+#define IOINQUIRE 1
+#define IOOPEN 2
+#define IOCLOSE 3
+#define IOREWIND 4
+#define IOBACKSPACE 5
+#define IOENDFILE 6
+#define IOREAD 7
+#define IOWRITE 8
+
+
+/* User name tags -- these identify the form of the original identifier
+   stored in a   struct Addrblock   structure (in the   user   field). */
+
+#define UNAM_UNKNOWN 0		/* Not specified */
+#define UNAM_NAME 1		/* Local symbol, store in the hash table */
+#define UNAM_IDENT 2		/* Character string not stored elsewhere */
+#define UNAM_EXTERN 3		/* External reference; check symbol table
+				   using   memno   as index */
+#define UNAM_CONST 4		/* Constant value */
+#define UNAM_CHARP 5		/* pointer to string */
+#define UNAM_REF 6		/* subscript reference with -s */
+
+
+#define IDENT_LEN 31		/* Maximum length user.ident */
+#define MAXNAMELEN 50		/* Maximum Fortran name length */
+
+/* type masks - TYLOGICAL defined in   ftypes   */
+
+#define MSKLOGICAL	M(TYLOGICAL)|M(TYLOGICAL1)|M(TYLOGICAL2)
+#define MSKADDR	M(TYADDR)
+#define MSKCHAR	M(TYCHAR)
+#ifdef TYQUAD
+#define MSKINT	M(TYINT1)|M(TYSHORT)|M(TYLONG)|M(TYQUAD)
+#else
+#define MSKINT	M(TYINT1)|M(TYSHORT)|M(TYLONG)
+#endif
+#define MSKREAL	M(TYREAL)|M(TYDREAL)	/* DREAL means Double Real */
+#define MSKCOMPLEX	M(TYCOMPLEX)|M(TYDCOMPLEX)
+#define MSKSTATIC (M(STGINIT)|M(STGBSS)|M(STGCOMMON)|M(STGEQUIV)|M(STGCONST))
+
+/* miscellaneous macros */
+
+/* ONEOF (x, y) -- x is the number of one of the OR'ed masks in y (i.e., x is
+   the log of one of the OR'ed masks in y) */
+
+#define ONEOF(x,y) (M(x) & (y))
+#define ISCOMPLEX(z) ONEOF(z, MSKCOMPLEX)
+#define ISREAL(z) ONEOF(z, MSKREAL)
+#define ISNUMERIC(z) ONEOF(z, MSKINT|MSKREAL|MSKCOMPLEX)
+#define ISICON(z) (z->tag==TCONST && ISINT(z->constblock.vtype))
+#define ISLOGICAL(z) ONEOF(z, MSKLOGICAL)
+
+/* ISCHAR assumes that   z   has some kind of structure, i.e. is not null */
+
+#define ISCHAR(z) (z->headblock.vtype==TYCHAR)
+#define ISINT(z)   ONEOF(z, MSKINT)	/*   z   is a tag, i.e. a mask number */
+#define ISCONST(z) (z->tag==TCONST)
+#define ISERROR(z) (z->tag==TERROR)
+#define ISPLUSOP(z) (z->tag==TEXPR && z->exprblock.opcode==OPPLUS)
+#define ISSTAROP(z) (z->tag==TEXPR && z->exprblock.opcode==OPSTAR)
+#define ISONE(z) (ISICON(z) && z->constblock.Const.ci==1)
+#define INT(z) ONEOF(z, MSKINT|MSKCHAR)	/* has INT storage in real life */
+#define ICON(z) mkintcon( (ftnint)(z) )
+
+/* NO66 -- F77 feature is being used
+   NOEXT -- F77 extension is being used */
+
+#define NO66(s)	if(no66flag) err66(s)
+#define NOEXT(s)	if(noextflag) errext(s)
diff --git a/contrib/tools/f2c/src/defs.h b/contrib/tools/f2c/src/defs.h
new file mode 100644
index 0000000000..0f0a1c2d81
--- /dev/null
+++ b/contrib/tools/f2c/src/defs.h
@@ -0,0 +1,1073 @@
+/****************************************************************
+Copyright 1990 - 1996, 1999-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "sysdep.h"
+
+#include "ftypes.h"
+#include "defines.h"
+#include "machdefs.h"
+
+#define MAXDIM 20
+#define MAXINCLUDES 10
+#define MAXLITERALS 200		/* Max number of constants in the literal
+				   pool */
+#define MAXCTL 20
+#define MAXHASH 802
+#define MAXSTNO 801
+#define MAXEXT 400
+#define MAXEQUIV 300
+#define MAXLABLIST 258		/* Max number of labels in an alternate
+				   return CALL or computed GOTO */
+#define MAXCONTIN 99		/* Max continuation lines */
+#define MAX_SHARPLINE_LEN 1000	/* Elbow room for #line lines with long names */
+/* These are the primary pointer types used in the compiler */
+
+typedef union Expression *expptr, *tagptr;
+typedef struct Chain *chainp;
+typedef struct Addrblock *Addrp;
+typedef struct Constblock *Constp;
+typedef struct Exprblock *Exprp;
+typedef struct Nameblock *Namep;
+
+extern FILEP infile;
+extern FILEP diagfile;
+extern FILEP textfile;
+extern FILEP asmfile;
+extern FILEP c_file;		/* output file for all functions; extern
+				   declarations will have to be prepended */
+extern FILEP pass1_file;	/* Temp file to hold the function bodies
+				   read on pass 1 */
+extern FILEP expr_file;		/* Debugging file */
+extern FILEP initfile;		/* Intermediate data file pointer */
+extern FILEP blkdfile;		/* BLOCK DATA file */
+
+extern int current_ftn_file;
+extern int maxcontin;
+
+extern char *blkdfname, *initfname, *sortfname;
+extern long headoffset;		/* Since the header block requires data we
+				   don't know about until AFTER each
+				   function has been processed, we keep a
+				   pointer to the current (dummy) header
+				   block (at the top of the assembly file)
+				   here */
+
+extern char main_alias[];	/* name given to PROGRAM psuedo-op */
+extern char *token;
+extern int maxtoklen, toklen;
+extern long err_lineno, lineno;
+extern char *infname;
+extern int needkwd;
+extern struct Labelblock *thislabel;
+
+/* Used to allow runtime expansion of internal tables.  In particular,
+   these values can exceed their associated constants */
+
+extern int maxctl;
+extern int maxequiv;
+extern int maxstno;
+extern int maxhash;
+extern int maxext;
+
+extern flag nowarnflag;
+extern flag ftn66flag;		/* Generate warnings when weird f77
+				   features are used (undeclared dummy
+				   procedure, non-char initialized with
+				   string, 1-dim subscript in EQUIV) */
+extern flag no66flag;		/* Generate an error when a generic
+				   function (f77 feature) is used */
+extern flag noextflag;		/* Generate an error when an extension to
+				   Fortran 77 is used (hex/oct/bin
+				   constants, automatic, static, double
+				   complex types) */
+extern flag zflag;		/* enable double complex intrinsics */
+extern flag shiftcase;
+extern flag undeftype;
+extern flag shortsubs;		/* Use short subscripts on arrays? */
+extern flag onetripflag;	/* if true, always execute DO loop body */
+extern flag checksubs;
+extern flag debugflag;
+extern int nerr;
+extern int nwarn;
+
+extern int parstate;
+extern flag headerdone;		/* True iff the current procedure's header
+				   data has been written */
+extern int blklevel;
+extern flag saveall;
+extern flag substars;		/* True iff some formal parameter is an
+				   asterisk */
+extern int impltype[ ];
+extern ftnint implleng[ ];
+extern int implstg[ ];
+
+extern int tycomplex, tyint, tyioint, tyreal;
+extern int tylog, tylogical;	/* TY____ of the implementation of   logical.
+				   This will be LONG unless '-2' is given
+				   on the command line */
+extern int type_choice[];
+extern char *Typename[];
+
+extern int typesize[];	/* size (in bytes) of an object of each
+				   type.  Indexed by TY___ macros */
+extern int typealign[];
+extern int proctype;	/* Type of return value in this procedure */
+extern char * procname;	/* External name of the procedure, or last ENTRY name */
+extern int rtvlabel[ ];	/* Return value labels, indexed by TY___ macros */
+extern Addrp retslot;
+extern Addrp xretslot[];
+extern int cxslot;	/* Complex return argument slot (frame pointer offset)*/
+extern int chslot;	/* Character return argument slot (fp offset) */
+extern int chlgslot;	/* Argument slot for length of character buffer */
+extern int procclass;	/* Class of the current procedure:  either CLPROC,
+			   CLMAIN, CLBLOCK or CLUNKNOWN */
+extern ftnint procleng;	/* Length of function return value (e.g. char
+			   string length).  If this is -1, then the length is
+			   not known at compile time */
+extern int nentry;	/* Number of entry points (other than the original
+			   function call) into this procedure */
+extern flag multitype;	/* YES iff there is more than one return value
+			   possible */
+extern int blklevel;
+extern long lastiolabno;
+extern long lastlabno;
+extern int lastvarno;
+extern int lastargslot;	/* integer offset pointing to the next free
+			   location for an argument to the current routine */
+extern int argloc;
+extern int autonum[];		/* for numbering
+				   automatic variables, e.g. temporaries */
+extern int retlabel;
+extern int ret0label;
+extern int dorange;		/* Number of the label which terminates
+				   the innermost DO loop */
+extern int regnum[ ];		/* Numbers of DO indicies named in
+				   regnamep   (below) */
+extern Namep regnamep[ ];	/* List of DO indicies in registers */
+extern int maxregvar;		/* number of elts in   regnamep   */
+extern int highregvar;		/* keeps track of the highest register
+				   number used by DO index allocator */
+extern int nregvar;		/* count of DO indicies in registers */
+
+extern chainp templist[];
+extern int maxdim;
+extern chainp earlylabs;
+extern chainp holdtemps;
+extern struct Entrypoint *entries;
+extern struct Rplblock *rpllist;
+extern struct Chain *curdtp;
+extern ftnint curdtelt;
+extern chainp allargs;		/* union of args in entries */
+extern int nallargs;		/* total number of args */
+extern int nallchargs;		/* total number of character args */
+extern flag toomanyinit;	/* True iff too many initializers in a
+				   DATA statement */
+
+extern flag inioctl;
+extern int iostmt;
+extern Addrp ioblkp;
+extern int nioctl;
+extern int nequiv;
+extern int eqvstart;	/* offset to eqv number to guarantee uniqueness
+			   and prevent <something> from going negative */
+extern int nintnames;
+
+/* Chain of tagged blocks */
+
+struct Chain
+	{
+	chainp nextp;
+	char * datap;		/* Tagged block */
+	};
+
+extern chainp chains;
+
+/* Recall that   field   is intended to hold four-bit characters */
+
+/* This structure exists only to defeat the type checking */
+
+struct Headblock
+	{
+	field tag;
+	field vtype;
+	field vclass;
+	field vstg;
+	expptr vleng;		/* Expression for length of char string -
+				   this may be a constant, or an argument
+				   generated by mkarg() */
+	} ;
+
+/* Control construct info (for do loops, else, etc) */
+
+struct Ctlframe
+	{
+	unsigned ctltype:8;
+	unsigned dostepsign:8;	/* 0 - variable, 1 - pos, 2 - neg */
+	unsigned dowhile:1;
+	int ctlabels[4];	/* Control labels, defined below */
+	int dolabel;		/* label marking end of this DO loop */
+	Namep donamep;		/* DO index variable */
+	expptr doinit;		/* for use with -onetrip */
+	expptr domax;		/* constant or temp variable holding MAX
+				   loop value; or expr of while(expr) */
+	expptr dostep;		/* expression */
+	Namep loopname;
+	};
+#define endlabel ctlabels[0]
+#define elselabel ctlabels[1]
+#define dobodylabel ctlabels[1]
+#define doposlabel ctlabels[2]
+#define doneglabel ctlabels[3]
+extern struct Ctlframe *ctls;		/* Keeps info on DO and BLOCK IF
+					   structures - this is the stack
+					   bottom */
+extern struct Ctlframe *ctlstack;	/* Pointer to current nesting
+					   level */
+extern struct Ctlframe *lastctl;	/* Point to end of
+					   dynamically-allocated array */
+
+typedef struct {
+	int type;
+	chainp cp;
+	} Atype;
+
+typedef struct {
+	int defined, dnargs, nargs, changes;
+	Atype atypes[1];
+	} Argtypes;
+
+/* External Symbols */
+
+struct Extsym
+	{
+	char *fextname;		/* Fortran version of external name */
+	char *cextname;		/* C version of external name */
+	field extstg;		/* STG -- should be COMMON, UNKNOWN or EXT
+				   */
+	unsigned extype:4;	/* for transmitting type to output routines */
+	unsigned used_here:1;	/* Boolean - true on the second pass
+				   through a function if the block has
+				   been referenced */
+	unsigned exused:1;	/* Has been used (for help with error msgs
+				   about externals typed differently in
+				   different modules) */
+	unsigned exproto:1;	/* type specified in a .P file */
+	unsigned extinit:1;	/* Procedure has been defined,
+				   or COMMON has DATA */
+	unsigned extseen:1;	/* True if previously referenced */
+	chainp extp;		/* List of identifiers in the common
+				   block for this function, stored as
+				   Namep (hash table pointers) */
+	chainp allextp;		/* List of lists of identifiers; we keep one
+				   list for each layout of this common block */
+	int curno;		/* current number for this common block,
+				   used for constructing appending _nnn
+				   to the common block name */
+	int maxno;		/* highest curno value for this common block */
+	ftnint extleng;
+	ftnint maxleng;
+	Argtypes *arginfo;
+	};
+typedef struct Extsym Extsym;
+
+extern Extsym *extsymtab;	/* External symbol table */
+extern Extsym *nextext;
+extern Extsym *lastext;
+extern int complex_seen, dcomplex_seen;
+
+/* Statement labels */
+
+struct Labelblock
+	{
+	int labelno;		/* Internal label */
+	unsigned blklevel:8;	/* level of nesting, for branch-in-loop
+				   checking */
+	unsigned labused:1;
+	unsigned fmtlabused:1;
+	unsigned labinacc:1;	/* inaccessible? (i.e. has its scope
+				   vanished) */
+	unsigned labdefined:1;	/* YES or NO */
+	unsigned labtype:2;	/* LAB{FORMAT,EXEC,etc} */
+	ftnint stateno;		/* Original label */
+	char *fmtstring;	/* format string */
+	};
+
+extern struct Labelblock *labeltab;	/* Label table - keeps track of
+					   all labels, including undefined */
+extern struct Labelblock *labtabend;
+extern struct Labelblock *highlabtab;
+
+/* Entry point list */
+
+struct Entrypoint
+	{
+	struct Entrypoint *entnextp;
+	Extsym *entryname;	/* Name of this ENTRY */
+	chainp arglist;
+	int typelabel;			/* Label for function exit; this
+					   will return the proper type of
+					   object */
+	Namep enamep;			/* External name */
+	};
+
+/* Primitive block, or Primary block.  This is a general template returned
+   by the parser, which will be interpreted in context.  It is a template
+   for an identifier (variable name, function name), parenthesized
+   arguments (array subscripts, function parameters) and substring
+   specifications. */
+
+struct Primblock
+	{
+	field tag;
+	field vtype;
+	unsigned parenused:1;		/* distinguish (a) from a */
+	Namep namep;			/* Pointer to structure Nameblock */
+	struct Listblock *argsp;
+	expptr fcharp;			/* first-char-index-pointer (in
+					   substring) */
+	expptr lcharp;			/* last-char-index-pointer (in
+					   substring) */
+	};
+
+
+struct Hashentry
+	{
+	int hashval;
+	Namep varp;
+	};
+extern struct Hashentry *hashtab;	/* Hash table */
+extern struct Hashentry *lasthash;
+
+struct Intrpacked	/* bits for intrinsic function description */
+	{
+	unsigned f1:4;
+	unsigned f2:4;
+	unsigned f3:7;
+	unsigned f4:1;
+	};
+
+struct Nameblock
+	{
+	field tag;
+	field vtype;
+	field vclass;
+	field vstg;
+	expptr vleng;		/* length of character string, if applicable */
+	char *fvarname;		/* name in the Fortran source */
+	char *cvarname;		/* name in the resulting C */
+	chainp vlastdim;	/* datap points to new_vars entry for the */
+				/* system variable, if any, storing the final */
+				/* dimension; we zero the datap if this */
+				/* variable is needed */
+	unsigned vprocclass:3;	/* P____ macros - selects the   varxptr
+				   field below */
+	unsigned vdovar:1;	/* "is it a DO variable?" for register
+				   and multi-level loop	checking */
+	unsigned vdcldone:1;	/* "do I think I'm done?" - set when the
+				   context is sufficient to determine its
+				   status */
+	unsigned vadjdim:1;	/* "adjustable dimension?" - needed for
+				   information about copies */
+	unsigned vsave:1;
+	unsigned vimpldovar:1;	/* used to prevent erroneous error messages
+				   for variables used only in DATA stmt
+				   implicit DOs */
+	unsigned vis_assigned:1;/* True if this variable has had some
+				   label ASSIGNED to it; hence
+				   varxptr.assigned_values is valid */
+	unsigned vimplstg:1;	/* True if storage type is assigned implicitly;
+				   this allows a COMMON variable to participate
+				   in a DIMENSION before the COMMON declaration.
+				   */
+	unsigned vcommequiv:1;	/* True if EQUIVALENCEd onto STGCOMMON */
+	unsigned vfmt_asg:1;	/* True if char *var_fmt needed */
+	unsigned vpassed:1;	/* True if passed as a character-variable arg */
+	unsigned vknownarg:1;	/* True if seen in a previous entry point */
+	unsigned visused:1;	/* True if variable is referenced -- so we */
+				/* can omit variables that only appear in DATA */
+	unsigned vnamelist:1;	/* Appears in a NAMELIST */
+	unsigned vimpltype:1;	/* True if implicitly typed and not
+				   invoked as a function or subroutine
+				   (so we can consistently type procedures
+				   declared external and passed as args
+				   but never invoked).
+				   */
+	unsigned vtypewarned:1;	/* so we complain just once about
+				   changed types of external procedures */
+	unsigned vinftype:1;	/* so we can restore implicit type to a
+				   procedure if it is invoked as a function
+				   after being given a different type by -it */
+	unsigned vinfproc:1;	/* True if -it infers this to be a procedure */
+	unsigned vcalled:1;	/* has been invoked */
+	unsigned vdimfinish:1;	/* need to invoke dim_finish() */
+	unsigned vrefused:1;	/* Need to #define name_ref (for -s) */
+	unsigned vsubscrused:1;	/* Need to #define name_subscr (for -2) */
+	unsigned veqvadjust:1;	/* voffset has been adjusted for equivalence */
+
+/* The   vardesc   union below is used to store the number of an intrinsic
+   function (when vstg == STGINTR and vprocclass == PINTRINSIC), or to
+   store the index of this external symbol in   extsymtab   (when vstg ==
+   STGEXT and vprocclass == PEXTERNAL) */
+
+	union	{
+		int varno;		/* Return variable for a function.
+					   This is used when a function is
+					   assigned a return value.  Also
+					   used to point to the COMMON
+					   block, when this is a field of
+					   that block.  Also points to
+					   EQUIV block when STGEQUIV */
+		struct Intrpacked intrdesc;	/* bits for intrinsic function*/
+		} vardesc;
+	struct Dimblock *vdim;	/* points to the dimensions if they exist */
+	ftnint voffset;		/* offset in a storage block (the variable
+				   name will be "v.%d", voffset in a
+				   common blck on the vax).  Also holds
+				   pointers for automatic variables.  When
+				   STGEQUIV, this is -(offset from array
+				   base) */
+	union	{
+		chainp namelist;	/* points to names in the NAMELIST,
+					   if this is a NAMELIST name */
+		chainp vstfdesc;	/* points to (formals, expr) pair */
+		chainp assigned_values;	/* list of integers, each being a
+					   statement label assigned to
+					   this variable in the current function */
+		} varxptr;
+	int argno;		/* for multiple entries */
+	Argtypes *arginfo;
+	};
+
+
+/* PARAMETER statements */
+
+struct Paramblock
+	{
+	field tag;
+	field vtype;
+	field vclass;
+	field vstg;
+	expptr vleng;
+	char *fvarname;
+	char *cvarname;
+	expptr paramval;
+	} ;
+
+
+/* Expression block */
+
+struct Exprblock
+	{
+	field tag;
+	field vtype;
+	field vclass;
+	field vstg;
+	expptr vleng;		/* in the case of a character expression, this
+				   value is inherited from the children */
+	unsigned int opcode;
+	expptr leftp;
+	expptr rightp;
+	int typefixed;
+	};
+
+
+union Constant
+	{
+	struct {
+		char *ccp0;
+		ftnint blanks;
+		} ccp1;
+	ftnint ci;		/* Constant integer */
+#ifndef NO_LONG_LONG
+	Llong cq;		/* for TYQUAD integer */
+	ULlong ucq;
+#endif
+	double cd[2];
+	char *cds[2];
+	};
+#define ccp ccp1.ccp0
+
+struct Constblock
+	{
+	field tag;
+	field vtype;
+	field vclass;
+	field vstg;		/* vstg = 1 when using Const.cds */
+	expptr vleng;
+	union Constant Const;
+	};
+
+
+struct Listblock
+	{
+	field tag;
+	field vtype;
+	chainp listp;
+	};
+
+
+
+/* Address block - this is the FINAL form of identifiers before being
+   sent to pass 2.  We'll want to add the original identifier here so that it can
+   be preserved in the translation.
+
+   An example identifier is q.7.  The "q" refers to the storage class
+   (field vstg), the 7 to the variable number (int memno). */
+
+struct Addrblock
+	{
+	field tag;
+	field vtype;
+	field vclass;
+	field vstg;
+	expptr vleng;
+	/* put union...user here so the beginning of an Addrblock
+	 * is the same as a Constblock.
+	 */
+	union {
+	    Namep name;		/* contains a pointer into the hash table */
+	    char ident[IDENT_LEN + 1];	/* C string form of identifier */
+	    char *Charp;
+	    union Constant Const;	/* Constant value */
+	    struct {
+		double dfill[2];
+		field vstg1;
+		} kludge;	/* so we can distinguish string vs binary
+				 * floating-point constants */
+	} user;
+	long memno;		/* when vstg == STGCONST, this is the
+				   numeric part of the assembler label
+				   where the constant value is stored */
+	expptr memoffset;	/* used in subscript computations, usually */
+	unsigned istemp:1;	/* used in stack management of temporary
+				   variables */
+	unsigned isarray:1;	/* used to show that memoffset is
+				   meaningful, even if zero */
+	unsigned ntempelt:10;	/* for representing temporary arrays, as
+				   in concatenation */
+	unsigned dbl_builtin:1;	/* builtin to be declared double */
+	unsigned charleng:1;	/* so saveargtypes can get i/o calls right */
+	unsigned cmplx_sub:1;	/* used in complex arithmetic under -s */
+	unsigned skip_offset:1;	/* used in complex arithmetic under -s */
+	unsigned parenused:1;	/* distinguish (a) from a */
+	ftnint varleng;		/* holds a copy of a constant length which
+				   is stored in the   vleng   field (e.g.
+				   a double is 8 bytes) */
+	int uname_tag;		/* Tag describing which of the unions()
+				   below to use */
+	char *Field;		/* field name when dereferencing a struct */
+}; /* struct Addrblock */
+
+
+/* Errorbock - placeholder for errors, to allow the compilation to
+   continue */
+
+struct Errorblock
+	{
+	field tag;
+	field vtype;
+	};
+
+
+/* Implicit DO block, especially related to DATA statements.  This block
+   keeps track of the compiler's location in the implicit DO while it's
+   running.  In particular, the   isactive and isbusy   flags tell where
+   it is */
+
+struct Impldoblock
+	{
+	field tag;
+	unsigned isactive:1;
+	unsigned isbusy:1;
+	Namep varnp;
+	Constp varvp;
+	chainp impdospec;
+	expptr implb;
+	expptr impub;
+	expptr impstep;
+	ftnint impdiff;
+	ftnint implim;
+	struct Chain *datalist;
+	};
+
+
+/* Each of these components has a first field called   tag.   This union
+   exists just for allocation simplicity */
+
+union Expression
+	{
+	field tag;
+	struct Addrblock addrblock;
+	struct Constblock constblock;
+	struct Errorblock errorblock;
+	struct Exprblock exprblock;
+	struct Headblock headblock;
+	struct Impldoblock impldoblock;
+	struct Listblock listblock;
+	struct Nameblock nameblock;
+	struct Paramblock paramblock;
+	struct Primblock primblock;
+	} ;
+
+
+
+struct Dimblock
+	{
+	int ndim;
+	expptr nelt;		/* This is NULL if the array is unbounded */
+	expptr baseoffset;	/* a constant or local variable holding
+				   the offset in this procedure */
+	expptr basexpr;		/* expression for comuting the offset, if
+				   it's not constant.  If this is
+				   non-null, the register named in
+				   baseoffset will get initialized to this
+				   value in the procedure's prolog */
+	struct
+		{
+		expptr dimsize;	/* constant or register holding the size
+				   of this dimension */
+		expptr dimexpr;	/* as above in basexpr, this is an
+				   expression for computing a variable
+				   dimension */
+		} dims[1];	/* Dimblocks are allocated with enough
+				   space for this to become dims[ndim] */
+	};
+
+
+/* Statement function identifier stack - this holds the name and value of
+   the parameters in a statement function invocation.  For example,
+
+	f(x,y,z)=x+y+z
+		.
+		.
+	y = f(1,2,3)
+
+   generates a stack of depth 3, with <x 1>, <y 2>, <z 3> AT THE INVOCATION, NOT
+   at the definition */
+
+struct Rplblock	/* name replacement block */
+	{
+	struct Rplblock *rplnextp;
+	Namep rplnp;		/* Name of the formal parameter */
+	expptr rplvp;		/* Value of the actual parameter */
+	expptr rplxp;		/* Initialization of temporary variable,
+				   if required; else null */
+	int rpltag;		/* Tag on the value of the actual param */
+	};
+
+
+
+/* Equivalence block */
+
+struct Equivblock
+	{
+	struct Eqvchain *equivs;	/* List (Eqvchain) of primblocks
+					   holding variable identifiers */
+	flag eqvinit;
+	long eqvtop;
+	long eqvbottom;
+	int eqvtype;
+	} ;
+#define eqvleng eqvtop
+
+extern struct Equivblock *eqvclass;
+
+
+struct Eqvchain
+	{
+	struct Eqvchain *eqvnextp;
+	union
+		{
+		struct Primblock *eqvlhs;
+		Namep eqvname;
+		} eqvitem;
+	long eqvoffset;
+	} ;
+
+
+
+/* For allocation purposes only, and to keep lint quiet.  In particular,
+   don't count on the tag being able to tell you which structure is used */
+
+
+/* There is a tradition in Fortran that the compiler not generate the same
+   bit pattern more than is necessary.  This structure is used to do just
+   that; if two integer constants have the same bit pattern, just generate
+   it once.  This could be expanded to optimize without regard to type, by
+   removing the type check in   putconst()   */
+
+struct Literal
+	{
+	short littype;
+	short lituse;		/* usage count */
+	long litnum;			/* numeric part of the assembler
+					   label for this constant value */
+	union	{
+		ftnint litival;
+		double litdval[2];
+		ftnint litival2[2];	/* length, nblanks for strings */
+#ifndef NO_LONG_LONG
+		Llong litqval;
+#endif
+		} litval;
+	char *cds[2];
+	};
+
+extern struct Literal *litpool;
+extern int maxliterals, nliterals;
+extern unsigned char Letters[];
+#define letter(x) Letters[x]
+
+struct Dims { expptr lb, ub; };
+
+extern int forcedouble;		/* force real functions to double */
+extern int doin_setbound;	/* special handling for array bounds */
+extern int Ansi;
+extern unsigned char hextoi_tab[];
+#define hextoi(x) hextoi_tab[(x) & 0xff]
+extern char *casttypes[], *ftn_types[], *protorettypes[], *usedcasts[];
+extern int Castargs, infertypes;
+extern FILE *protofile;
+extern char binread[], binwrite[], textread[], textwrite[];
+extern char *ei_first, *ei_last, *ei_next;
+extern char *wh_first, *wh_last, *wh_next;
+extern char *halign, *outbuf, *outbtail;
+extern flag keepsubs;
+#ifdef TYQUAD
+extern flag use_tyquad;
+extern unsigned long ff;
+#ifndef NO_LONG_LONG
+extern flag allow_i8c;
+#endif
+#endif /*TYQUAD*/
+extern int n_keywords;
+extern char *c_keywords[];
+
+#ifdef KR_headers
+#define Argdcl(x) ()
+#define Void /* void */
+#else
+#define Argdcl(x) x
+#define Void void
+#endif
+
+char*	Alloc Argdcl((int));
+char*	Argtype Argdcl((int, char*));
+void	Fatal Argdcl((char*));
+struct	Impldoblock* mkiodo Argdcl((chainp, chainp));
+tagptr	Inline Argdcl((int, int, chainp));
+struct	Labelblock* execlab Argdcl((long));
+struct	Labelblock* mklabel Argdcl((long));
+struct	Listblock* mklist Argdcl((chainp));
+void	Un_link_all Argdcl((int));
+void	add_extern_to_list Argdcl((Addrp, chainp*));
+int	addressable Argdcl((tagptr));
+tagptr	addrof Argdcl((tagptr));
+char*	addunder Argdcl((char*));
+void	argkludge Argdcl((int*, char***));
+Addrp	autovar Argdcl((int, int, tagptr, char*));
+void	backup Argdcl((char*, char*));
+void	bad_atypes Argdcl((Argtypes*, char*, int, int, int, char*, char*));
+int	badchleng Argdcl((tagptr));
+void	badop Argdcl((char*, int));
+void	badstg Argdcl((char*, int));
+void	badtag Argdcl((char*, int));
+void	badthing Argdcl((char*, char*, int));
+void	badtype Argdcl((char*, int));
+Addrp	builtin Argdcl((int, char*, int));
+char*	c_name Argdcl((char*, int));
+tagptr	call0 Argdcl((int, char*));
+tagptr	call1 Argdcl((int, char*, tagptr));
+tagptr	call2 Argdcl((int, char*, tagptr, tagptr));
+tagptr	call3 Argdcl((int, char*, tagptr, tagptr, tagptr));
+tagptr	call4 Argdcl((int, char*, tagptr, tagptr, tagptr, tagptr));
+tagptr	callk Argdcl((int, char*, chainp));
+void	cast_args Argdcl((int, chainp));
+char*	cds Argdcl((char*, char*));
+void	changedtype Argdcl((Namep));
+ptr	ckalloc Argdcl((int));
+int	cktype Argdcl((int, int, int));
+void	clf Argdcl((FILEP*, char*, int));
+int	cmpstr Argdcl((char*, char*, long, long));
+char*	c_type_decl Argdcl((int, int));
+Extsym*	comblock Argdcl((char*));
+char*	comm_union_name Argdcl((int));
+void	consconv Argdcl((int, Constp, Constp));
+void	consnegop Argdcl((Constp));
+int	conssgn Argdcl((tagptr));
+char*	convic Argdcl((long));
+void	copy_data Argdcl((chainp));
+char*	copyn Argdcl((int, char*));
+char*	copys Argdcl((char*));
+tagptr	cpblock Argdcl((int, char*));
+tagptr	cpexpr Argdcl((tagptr));
+void	cpn Argdcl((int, char*, char*));
+char*	cpstring Argdcl((char*));
+void	dataline Argdcl((char*, long, int));
+char*	dataname Argdcl((int, long));
+void	dataval Argdcl((tagptr, tagptr));
+void	dclerr Argdcl((const char*, Namep));
+void	def_commons Argdcl((FILEP));
+void	def_start Argdcl((FILEP, char*, char*, char*));
+void	deregister Argdcl((Namep));
+void	do_uninit_equivs Argdcl((FILEP, ptr));
+void	doequiv(Void);
+int	dofork Argdcl((char*));
+void	doinclude Argdcl((char*));
+void	doio Argdcl((chainp));
+void	done Argdcl((int));
+void	donmlist(Void);
+int	dsort Argdcl((char*, char*));
+char*	dtos Argdcl((double));
+void	elif_out Argdcl((FILEP, tagptr));
+void	end_else_out Argdcl((FILEP));
+void	enddcl(Void);
+void	enddo Argdcl((int));
+void	endio(Void);
+void	endioctl(Void);
+void	endproc(Void);
+void	entrypt Argdcl((int, int, long, Extsym*, chainp));
+int	eqn Argdcl((int, char*, char*));
+char*	equiv_name Argdcl((int, char*));
+void	err Argdcl((char*));
+void	err66 Argdcl((char*));
+void	errext Argdcl((char*));
+void	erri Argdcl((char*, int));
+void	errl Argdcl((char*, long));
+tagptr	errnode(Void);
+void	errstr Argdcl((const char*, const char*));
+void	exarif Argdcl((tagptr, struct Labelblock*, struct Labelblock*, struct Labelblock*));
+void	exasgoto Argdcl((Namep));
+void	exassign Argdcl((Namep, struct Labelblock*));
+void	excall Argdcl((Namep, struct Listblock*, int, struct Labelblock**));
+void	exdo Argdcl((int, Namep, chainp));
+void	execerr Argdcl((char*, char*));
+void	exelif Argdcl((tagptr));
+void	exelse(Void);
+void	exenddo Argdcl((Namep));
+void	exendif(Void);
+void	exequals Argdcl((struct Primblock*, tagptr));
+void	exgoto Argdcl((struct Labelblock*));
+void	exif Argdcl((tagptr));
+void	exreturn Argdcl((tagptr));
+void	exstop Argdcl((int, tagptr));
+void	extern_out Argdcl((FILEP, Extsym*));
+void	fatali Argdcl((char*, int));
+void	fatalstr Argdcl((char*, char*));
+void	ffilecopy Argdcl((FILEP, FILEP));
+void	fileinit(Void);
+int	fixargs Argdcl((int, struct Listblock*));
+tagptr	fixexpr Argdcl((Exprp));
+tagptr	fixtype Argdcl((tagptr));
+char*	flconst Argdcl((char*, char*));
+void	flline(Void);
+void	fmt_init(Void);
+void	fmtname Argdcl((Namep, Addrp));
+int	fmtstmt Argdcl((struct Labelblock*));
+tagptr	fold Argdcl((tagptr));
+void	frchain Argdcl((chainp*));
+void	frdata Argdcl((chainp));
+void	freetemps(Void);
+void	freqchain Argdcl((struct Equivblock*));
+void	frexchain Argdcl((chainp*));
+void	frexpr Argdcl((tagptr));
+void	frrpl(Void);
+void	frtemp Argdcl((Addrp));
+char*	gmem Argdcl((int, int));
+void	hashclear(Void);
+chainp	hookup Argdcl((chainp, chainp));
+expptr	imagpart Argdcl((Addrp));
+void	impldcl Argdcl((Namep));
+int	in_vector Argdcl((char*, char**, int));
+void	incomm Argdcl((Extsym*, Namep));
+void	inferdcl Argdcl((Namep, int));
+int	inilex Argdcl((char*));
+void	initkey(Void);
+int	inregister Argdcl((Namep));
+long	int commlen Argdcl((chainp));
+long	int convci Argdcl((int, char*));
+long	int iarrlen Argdcl((Namep));
+long	int lencat Argdcl((expptr));
+long	int lmax Argdcl((long, long));
+long	int lmin Argdcl((long, long));
+long	int wr_char_len Argdcl((FILEP, struct Dimblock*, ftnint, int));
+Addrp	intraddr Argdcl((Namep));
+tagptr	intrcall Argdcl((Namep, struct Listblock*, int));
+int	intrfunct Argdcl((char*));
+void	ioclause Argdcl((int, expptr));
+int	iocname(Void);
+int	is_negatable Argdcl((Constp));
+int	isaddr Argdcl((tagptr));
+int	isnegative_const Argdcl((Constp));
+int	isstatic Argdcl((tagptr));
+chainp	length_comp Argdcl((struct Entrypoint*, int));
+int	lengtype Argdcl((int, long));
+char*	lexline Argdcl((ptr));
+void	list_arg_types Argdcl((FILEP, struct Entrypoint*, chainp, int, char*));
+void	list_decls Argdcl((FILEP));
+void	list_init_data Argdcl((FILE **, char *, FILE *));
+void	listargs Argdcl((FILEP, struct Entrypoint*, int, chainp));
+char*	lit_name Argdcl((struct Literal*));
+int	log_2 Argdcl((long));
+char*	lower_string Argdcl((char*, char*));
+int	main Argdcl((int, char**));
+expptr	make_int_expr Argdcl((expptr));
+void	make_param Argdcl((struct Paramblock*, tagptr));
+void	many Argdcl((char*, char, int));
+void	margin_printf Argdcl((FILEP, const char*, ...));
+int	maxtype Argdcl((int, int));
+char*	mem Argdcl((int, int));
+void	mem_init(Void);
+char*	memname Argdcl((int, long));
+Addrp	memversion Argdcl((Namep));
+tagptr	mkaddcon Argdcl((long));
+Addrp	mkaddr Argdcl((Namep));
+Addrp	mkarg Argdcl((int, int));
+tagptr	mkbitcon Argdcl((int, int, char*));
+chainp	mkchain Argdcl((char*, chainp));
+Constp	mkconst Argdcl((int));
+tagptr	mkconv Argdcl((int, tagptr));
+tagptr	mkcxcon Argdcl((tagptr, tagptr));
+tagptr	mkexpr Argdcl((int, tagptr, tagptr));
+Extsym*	mkext Argdcl((char*, char*));
+Extsym*	mkext1 Argdcl((char*, char*));
+Addrp	mkfield Argdcl((Addrp, char*, int));
+tagptr	mkfunct Argdcl((tagptr));
+tagptr	mkintcon Argdcl((long));
+tagptr	mkintqcon Argdcl((int, char*));
+tagptr	mklhs Argdcl((struct Primblock*, int));
+tagptr	mklogcon Argdcl((int));
+Namep	mkname Argdcl((char*));
+Addrp	mkplace Argdcl((Namep));
+tagptr	mkprim Argdcl((Namep, struct Listblock*, chainp));
+tagptr	mkrealcon Argdcl((int, char*));
+Addrp	mkscalar Argdcl((Namep));
+void	mkstfunct Argdcl((struct Primblock*, tagptr));
+tagptr	mkstrcon Argdcl((int, char*));
+Addrp	mktmp Argdcl((int, tagptr));
+Addrp	mktmp0 Argdcl((int, tagptr));
+Addrp	mktmpn Argdcl((int, int, tagptr));
+void	namelist Argdcl((Namep));
+int	ncat Argdcl((expptr));
+void	negate_const Argdcl((Constp));
+void	new_endif(Void);
+Extsym*	newentry Argdcl((Namep, int));
+long	newlabel(Void);
+void	newproc(Void);
+Addrp	nextdata Argdcl((long*));
+void	nice_printf Argdcl((FILEP, const char*, ...));
+void	not_both Argdcl((char*));
+void	np_init(Void);
+int	oneof_stg Argdcl((Namep, int, int));
+int	op_assign Argdcl((int));
+tagptr	opconv Argdcl((tagptr, int));
+FILEP	opf Argdcl((char*, char*));
+void	out_addr Argdcl((FILEP, Addrp));
+void	out_asgoto Argdcl((FILEP, tagptr));
+void	out_call Argdcl((FILEP, int, int, tagptr, tagptr, tagptr));
+void	out_const Argdcl((FILEP, Constp));
+void	out_else Argdcl((FILEP));
+void	out_for Argdcl((FILEP, tagptr, tagptr, tagptr));
+void	out_init(Void);
+void	outbuf_adjust(Void);
+void	p1_label Argdcl((long));
+void	paren_used Argdcl((struct Primblock*));
+void	prcona Argdcl((FILEP, long));
+void	prconi Argdcl((FILEP, long));
+#ifndef NO_LONG_LONG
+void	prconq Argdcl((FILEP, Llong));
+#endif
+void	prconr Argdcl((FILEP, Constp, int));
+void	procinit(Void);
+void	procode Argdcl((FILEP));
+void	prolog Argdcl((FILEP, chainp));
+void	protowrite Argdcl((FILEP, int, char*, struct Entrypoint*, chainp));
+expptr	prune_left_conv Argdcl((expptr));
+int	put_one_arg Argdcl((int, char*, char**, char*, char*));
+expptr	putassign Argdcl((expptr, expptr));
+Addrp	putchop Argdcl((tagptr));
+void	putcmgo Argdcl((tagptr, int, struct Labelblock**));
+Addrp	putconst Argdcl((Constp));
+tagptr	putcxop Argdcl((tagptr));
+void	puteq Argdcl((expptr, expptr));
+void	putexpr Argdcl((expptr));
+void	puthead Argdcl((char*, int));
+void	putif Argdcl((tagptr, int));
+void	putout Argdcl((tagptr));
+expptr	putsteq Argdcl((Addrp, Addrp));
+void	putwhile Argdcl((tagptr));
+tagptr	putx Argdcl((tagptr));
+void	r8fix(Void);
+int	rdlong Argdcl((FILEP, long*));
+int	rdname Argdcl((FILEP, ptr, char*));
+void	read_Pfiles Argdcl((char**));
+Addrp	realpart Argdcl((Addrp));
+chainp	revchain Argdcl((chainp));
+int	same_expr Argdcl((tagptr, tagptr));
+int	same_ident Argdcl((tagptr, tagptr));
+void	save_argtypes Argdcl((chainp, Argtypes**, Argtypes**, int, char*, int, int, int, int));
+void	saveargtypes Argdcl((Exprp));
+void	set_externs(Void);
+void	set_tmp_names(Void);
+void	setbound Argdcl((Namep, int, struct Dims*));
+void	setdata Argdcl((Addrp, Constp, long));
+void	setext Argdcl((Namep));
+void	setfmt Argdcl((struct Labelblock*));
+void	setimpl Argdcl((int, long, int, int));
+void	setintr Argdcl((Namep));
+void	settype Argdcl((Namep, int, long));
+void	sigcatch Argdcl((int));
+void	sserr Argdcl((Namep));
+void	start_formatting(Void);
+void	startioctl(Void);
+void	startproc Argdcl((Extsym*, int));
+void	startrw(Void);
+char*	string_num Argdcl((char*, long));
+int	struct_eq Argdcl((chainp, chainp));
+tagptr	subcheck Argdcl((Namep, tagptr));
+tagptr	suboffset Argdcl((struct Primblock*));
+int	type_fixup Argdcl((Argtypes*, Atype*, int));
+void	unamstring Argdcl((Addrp, char*));
+void	unclassifiable(Void);
+void	vardcl Argdcl((Namep));
+void	warn Argdcl((char*));
+void	warn1 Argdcl((const char*, const char*));
+void	warni Argdcl((char*, int));
+void	westart Argdcl((int));
+void	wr_abbrevs Argdcl((FILEP, int, chainp));
+char*	wr_ardecls Argdcl((FILE*, struct Dimblock*, long));
+void	wr_array_init Argdcl((FILEP, int, chainp));
+void	wr_common_decls Argdcl((FILEP));
+void	wr_equiv_init Argdcl((FILEP, int, chainp*, int));
+void	wr_globals Argdcl((FILEP));
+void	wr_nv_ident_help Argdcl((FILEP, Addrp));
+void	wr_struct Argdcl((FILEP, chainp));
+void	wronginf Argdcl((Namep));
+void	yyerror Argdcl((char*));
+int	yylex(Void);
+int	yyparse(Void);
+
+#ifdef USE_DTOA
+#define atof(x) strtod(x,0)
+void	g_fmt Argdcl((char*, double));
+#endif
diff --git a/contrib/tools/f2c/src/equiv.c b/contrib/tools/f2c/src/equiv.c
new file mode 100644
index 0000000000..bcf07e7211
--- /dev/null
+++ b/contrib/tools/f2c/src/equiv.c
@@ -0,0 +1,412 @@
+/****************************************************************
+Copyright 1990, 1993-6, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+
+static void eqvcommon Argdcl((struct Equivblock*, int, long int));
+static void eqveqv Argdcl((int, int, long int));
+static int nsubs Argdcl((struct Listblock*));
+
+/* ROUTINES RELATED TO EQUIVALENCE CLASS PROCESSING */
+
+/* called at end of declarations section to process chains
+   created by EQUIVALENCE statements
+ */
+ void
+doequiv(Void)
+{
+	register int i;
+	int inequiv;			/* True if one namep occurs in
+					   several EQUIV declarations */
+	int comno;		/* Index into Extsym table of the last
+				   COMMON block seen (implicitly assuming
+				   that only one will be given) */
+	int ovarno;
+	ftnint comoffset;	/* Index into the COMMON block */
+	ftnint offset;		/* Offset from array base */
+	ftnint leng;
+	register struct Equivblock *equivdecl;
+	register struct Eqvchain *q;
+	struct Primblock *primp;
+	register Namep np;
+	int k, k1, ns, pref, t;
+	chainp cp;
+	extern int type_pref[];
+
+	for(i = 0 ; i < nequiv ; ++i)
+	{
+
+/* Handle each equivalence declaration */
+
+		equivdecl = &eqvclass[i];
+		equivdecl->eqvbottom = equivdecl->eqvtop = 0;
+		comno = -1;
+
+
+
+		for(q = equivdecl->equivs ; q ; q = q->eqvnextp)
+		{
+			offset = 0;
+			if (!(primp = q->eqvitem.eqvlhs))
+				continue;
+			vardcl(np = primp->namep);
+			if(primp->argsp || primp->fcharp)
+			{
+				expptr offp;
+
+/* Pad ones onto the end of an array declaration when needed */
+
+				if(np->vdim!=NULL && np->vdim->ndim>1 &&
+				    nsubs(primp->argsp)==1 )
+				{
+					if(! ftn66flag)
+						warni
+			("1-dim subscript in EQUIVALENCE, %d-dim declared",
+						    np -> vdim -> ndim);
+					cp = NULL;
+					ns = np->vdim->ndim;
+					while(--ns > 0)
+						cp = mkchain((char *)ICON(1), cp);
+					primp->argsp->listp->nextp = cp;
+				}
+
+				offp = suboffset(primp);
+				if(ISICON(offp))
+					offset = offp->constblock.Const.ci;
+				else	{
+					dclerr
+			("nonconstant subscript in equivalence ",
+					    np);
+					np = NULL;
+				}
+				frexpr(offp);
+			}
+
+/* Free up the primblock, since we now have a hash table (Namep) entry */
+
+			frexpr((expptr)primp);
+
+			if(np && (leng = iarrlen(np))<0)
+			{
+				dclerr("adjustable in equivalence", np);
+				np = NULL;
+			}
+
+			if(np) switch(np->vstg)
+			{
+			case STGUNKNOWN:
+			case STGBSS:
+			case STGEQUIV:
+				break;
+
+			case STGCOMMON:
+
+/* The code assumes that all COMMON references in a given EQUIVALENCE will
+   be to the same COMMON block, and will all be consistent */
+
+				comno = np->vardesc.varno;
+				comoffset = np->voffset + offset;
+				break;
+
+			default:
+				dclerr("bad storage class in equivalence", np);
+				np = NULL;
+				break;
+			}
+
+			if(np)
+			{
+				q->eqvoffset = offset;
+
+/* eqvbottom   gets the largest difference between the array base address
+   and the address specified in the EQUIV declaration */
+
+				equivdecl->eqvbottom =
+				    lmin(equivdecl->eqvbottom, -offset);
+
+/* eqvtop   gets the largest difference between the end of the array and
+   the address given in the EQUIVALENCE */
+
+				equivdecl->eqvtop =
+				    lmax(equivdecl->eqvtop, leng-offset);
+			}
+			q->eqvitem.eqvname = np;
+		}
+
+/* Now all equivalenced variables are in the hash table with the proper
+   offset, and   eqvtop and eqvbottom   are set. */
+
+		if(comno >= 0)
+
+/* Get rid of all STGEQUIVS, they will be mapped onto STGCOMMON variables
+   */
+
+			eqvcommon(equivdecl, comno, comoffset);
+		else for(q = equivdecl->equivs ; q ; q = q->eqvnextp)
+		{
+			if(np = q->eqvitem.eqvname)
+			{
+				inequiv = NO;
+				if(np->vstg==STGEQUIV)
+					if( (ovarno = np->vardesc.varno) == i)
+					{
+
+/* Can't EQUIV different elements of the same array */
+
+						if(np->voffset + q->eqvoffset != 0)
+							dclerr
+			("inconsistent equivalence", np);
+					}
+					else	{
+						offset = np->voffset;
+						inequiv = YES;
+					}
+
+				np->vstg = STGEQUIV;
+				np->vardesc.varno = i;
+				np->voffset = - q->eqvoffset;
+
+				if(inequiv)
+
+/* Combine 2 equivalence declarations */
+
+					eqveqv(i, ovarno, q->eqvoffset + offset);
+			}
+		}
+	}
+
+/* Now each equivalence declaration is distinct (all connections have been
+   merged in eqveqv()), and some may be empty. */
+
+	for(i = 0 ; i < nequiv ; ++i)
+	{
+		equivdecl = & eqvclass[i];
+		if(equivdecl->eqvbottom!=0 || equivdecl->eqvtop!=0) {
+
+/* a live chain */
+
+			k = TYCHAR;
+			pref = 1;
+			for(q = equivdecl->equivs ; q; q = q->eqvnextp)
+			    if ((np = q->eqvitem.eqvname)
+			    		&& !np->veqvadjust) {
+				np->veqvadjust = 1;
+				np->voffset -= equivdecl->eqvbottom;
+				t = typealign[k1 = np->vtype];
+				if (pref < type_pref[k1]) {
+					k = k1;
+					pref = type_pref[k1];
+					}
+				if(np->voffset % t != 0) {
+					dclerr("bad alignment forced by equivalence", np);
+					--nerr; /* don't give bad return code for this */
+					}
+				}
+			equivdecl->eqvtype = k;
+		}
+		freqchain(equivdecl);
+	}
+}
+
+
+
+
+
+/* put equivalence chain p at common block comno + comoffset */
+
+ LOCAL void
+#ifdef KR_headers
+eqvcommon(p, comno, comoffset)
+	struct Equivblock *p;
+	int comno;
+	ftnint comoffset;
+#else
+eqvcommon(struct Equivblock *p, int comno, ftnint comoffset)
+#endif
+{
+	int ovarno;
+	ftnint k, offq;
+	register Namep np;
+	register struct Eqvchain *q;
+
+	if(comoffset + p->eqvbottom < 0)
+	{
+		errstr("attempt to extend common %s backward",
+		    extsymtab[comno].fextname);
+		freqchain(p);
+		return;
+	}
+
+	if( (k = comoffset + p->eqvtop) > extsymtab[comno].extleng)
+		extsymtab[comno].extleng = k;
+
+
+	for(q = p->equivs ; q ; q = q->eqvnextp)
+		if(np = q->eqvitem.eqvname)
+		{
+			switch(np->vstg)
+			{
+			case STGUNKNOWN:
+			case STGBSS:
+				np->vstg = STGCOMMON;
+				np->vcommequiv = 1;
+				np->vardesc.varno = comno;
+
+/* np -> voffset   will point to the base of the array */
+
+				np->voffset = comoffset - q->eqvoffset;
+				break;
+
+			case STGEQUIV:
+				ovarno = np->vardesc.varno;
+
+/* offq   will point to the current element, even if it's in an array */
+
+				offq = comoffset - q->eqvoffset - np->voffset;
+				np->vstg = STGCOMMON;
+				np->vcommequiv = 1;
+				np->vardesc.varno = comno;
+
+/* np -> voffset   will point to the base of the array */
+
+				np->voffset += offq;
+				if(ovarno != (p - eqvclass))
+					eqvcommon(&eqvclass[ovarno], comno, offq);
+				break;
+
+			case STGCOMMON:
+				if(comno != np->vardesc.varno ||
+				    comoffset != np->voffset+q->eqvoffset)
+					dclerr("inconsistent common usage", np);
+				break;
+
+
+			default:
+				badstg("eqvcommon", np->vstg);
+			}
+		}
+
+	freqchain(p);
+	p->eqvbottom = p->eqvtop = 0;
+}
+
+
+/* Move all items on ovarno chain to the front of   nvarno   chain.
+ * adjust offsets of ovarno elements and top and bottom of nvarno chain
+ */
+
+ LOCAL void
+#ifdef KR_headers
+eqveqv(nvarno, ovarno, delta)
+	int nvarno;
+	int ovarno;
+	ftnint delta;
+#else
+eqveqv(int nvarno, int ovarno, ftnint delta)
+#endif
+{
+	register struct Equivblock *neweqv, *oldeqv;
+	register Namep np;
+	struct Eqvchain *q, *q1;
+
+	neweqv = eqvclass + nvarno;
+	oldeqv = eqvclass + ovarno;
+	neweqv->eqvbottom = lmin(neweqv->eqvbottom, oldeqv->eqvbottom - delta);
+	neweqv->eqvtop = lmax(neweqv->eqvtop, oldeqv->eqvtop - delta);
+	oldeqv->eqvbottom = oldeqv->eqvtop = 0;
+
+	for(q = oldeqv->equivs ; q ; q = q1)
+	{
+		q1 = q->eqvnextp;
+		if( (np = q->eqvitem.eqvname) && np->vardesc.varno==ovarno)
+		{
+			q->eqvnextp = neweqv->equivs;
+			neweqv->equivs = q;
+			q->eqvoffset += delta;
+			np->vardesc.varno = nvarno;
+			np->voffset -= delta;
+		}
+		else	free( (charptr) q);
+	}
+	oldeqv->equivs = NULL;
+}
+
+
+
+ void
+#ifdef KR_headers
+freqchain(p)
+	register struct Equivblock *p;
+#else
+freqchain(register struct Equivblock *p)
+#endif
+{
+	register struct Eqvchain *q, *oq;
+
+	for(q = p->equivs ; q ; q = oq)
+	{
+		oq = q->eqvnextp;
+		free( (charptr) q);
+	}
+	p->equivs = NULL;
+}
+
+
+
+
+
+/* nsubs -- number of subscripts in this arglist (just the length of the
+   list) */
+
+ LOCAL int
+#ifdef KR_headers
+nsubs(p)
+	register struct Listblock *p;
+#else
+nsubs(register struct Listblock *p)
+#endif
+{
+	register int n;
+	register chainp q;
+
+	n = 0;
+	if(p)
+		for(q = p->listp ; q ; q = q->nextp)
+			++n;
+
+	return(n);
+}
+
+ struct Primblock *
+#ifdef KR_headers
+primchk(e) expptr e;
+#else
+primchk(expptr e)
+#endif
+{
+	if (e->headblock.tag != TPRIM) {
+		err("Invalid name in EQUIVALENCE.");
+		return 0;
+		}
+	return &e->primblock;
+	}
diff --git a/contrib/tools/f2c/src/error.c b/contrib/tools/f2c/src/error.c
new file mode 100644
index 0000000000..d0064f0302
--- /dev/null
+++ b/contrib/tools/f2c/src/error.c
@@ -0,0 +1,347 @@
+/****************************************************************
+Copyright 1990, 1993, 1994, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+
+ void
+#ifdef KR_headers
+warni(s, t)
+	char *s;
+	int t;
+#else
+warni(char *s, int t)
+#endif
+{
+	char buf[100];
+	sprintf(buf,s,t);
+	warn(buf);
+	}
+
+ void
+#ifdef KR_headers
+warn1(s, t)
+	char *s;
+	char *t;
+#else
+warn1(const char *s, const char *t)
+#endif
+{
+	char buff[100];
+	sprintf(buff, s, t);
+	warn(buff);
+}
+
+ void
+#ifdef KR_headers
+warn(s)
+	char *s;
+#else
+warn(char *s)
+#endif
+{
+	if(nowarnflag)
+		return;
+	if (infname && *infname)
+		fprintf(diagfile, "Warning on line %ld of %s: %s\n",
+			lineno, infname, s);
+	else
+		fprintf(diagfile, "Warning on line %ld: %s\n", lineno, s);
+	fflush(diagfile);
+	++nwarn;
+}
+
+ void
+#ifdef KR_headers
+errstr(s, t)
+	char *s;
+	char *t;
+#else
+errstr(const char *s, const char *t)
+#endif
+{
+	char buff[100];
+	sprintf(buff, s, t);
+	err(buff);
+}
+
+
+ void
+#ifdef KR_headers
+erri(s, t)
+	char *s;
+	int t;
+#else
+erri(char *s, int t)
+#endif
+{
+	char buff[100];
+	sprintf(buff, s, t);
+	err(buff);
+}
+
+ void
+#ifdef KR_headers
+errl(s, t)
+	char *s;
+	long t;
+#else
+errl(char *s, long t)
+#endif
+{
+	char buff[100];
+	sprintf(buff, s, t);
+	err(buff);
+}
+
+ char *err_proc = 0;
+
+ void
+#ifdef KR_headers
+err(s)
+	char *s;
+#else
+err(char *s)
+#endif
+{
+	if (err_proc)
+		fprintf(diagfile,
+			"Error processing %s before line %ld",
+			err_proc, lineno);
+	else
+		fprintf(diagfile, "Error on line %ld", lineno);
+	if (infname && *infname)
+		fprintf(diagfile, " of %s", infname);
+	fprintf(diagfile, ": %s\n", s);
+	fflush(diagfile);
+	++nerr;
+}
+
+ void
+#ifdef KR_headers
+yyerror(s)
+	char *s;
+#else
+yyerror(char *s)
+#endif
+{
+	err(s);
+}
+
+
+ void
+#ifdef KR_headers
+dclerr(s, v)
+	char *s;
+	Namep v;
+#else
+dclerr(const char *s, Namep v)
+#endif
+{
+	char buff[100];
+
+	if(v)
+	{
+		sprintf(buff, "Declaration error for %s: %s", v->fvarname, s);
+		err(buff);
+	}
+	else
+		errstr("Declaration error %s", s);
+}
+
+
+ void
+#ifdef KR_headers
+execerr(s, n)
+	char *s;
+	char *n;
+#else
+execerr(char *s, char *n)
+#endif
+{
+	char buf1[100], buf2[100];
+
+	sprintf(buf1, "Execution error %s", s);
+	sprintf(buf2, buf1, n);
+	err(buf2);
+}
+
+
+ void
+#ifdef KR_headers
+Fatal(t)
+	char *t;
+#else
+Fatal(char *t)
+#endif
+{
+	fprintf(diagfile, "Compiler error line %ld", lineno);
+	if (infname)
+		fprintf(diagfile, " of %s", infname);
+	fprintf(diagfile, ": %s\n", t);
+	done(3);
+}
+
+
+
+ void
+#ifdef KR_headers
+fatalstr(t, s)
+	char *t;
+	char *s;
+#else
+fatalstr(char *t, char *s)
+#endif
+{
+	char buff[100];
+	sprintf(buff, t, s);
+	Fatal(buff);
+}
+
+
+ void
+#ifdef KR_headers
+fatali(t, d)
+	char *t;
+	int d;
+#else
+fatali(char *t, int d)
+#endif
+{
+	char buff[100];
+	sprintf(buff, t, d);
+	Fatal(buff);
+}
+
+
+ void
+#ifdef KR_headers
+badthing(thing, r, t)
+	char *thing;
+	char *r;
+	int t;
+#else
+badthing(char *thing, char *r, int t)
+#endif
+{
+	char buff[50];
+	sprintf(buff, "Impossible %s %d in routine %s", thing, t, r);
+	Fatal(buff);
+}
+
+
+ void
+#ifdef KR_headers
+badop(r, t)
+	char *r;
+	int t;
+#else
+badop(char *r, int t)
+#endif
+{
+	badthing("opcode", r, t);
+}
+
+
+ void
+#ifdef KR_headers
+badtag(r, t)
+	char *r;
+	int t;
+#else
+badtag(char *r, int t)
+#endif
+{
+	badthing("tag", r, t);
+}
+
+
+
+
+ void
+#ifdef KR_headers
+badstg(r, t)
+	char *r;
+	int t;
+#else
+badstg(char *r, int t)
+#endif
+{
+	badthing("storage class", r, t);
+}
+
+
+
+ void
+#ifdef KR_headers
+badtype(r, t)
+	char *r;
+	int t;
+#else
+badtype(char *r, int t)
+#endif
+{
+	badthing("type", r, t);
+}
+
+ void
+#ifdef KR_headers
+many(s, c, n)
+	char *s;
+	char c;
+	int n;
+#else
+many(char *s, char c, int n)
+#endif
+{
+	char buff[250];
+
+	sprintf(buff,
+	    "Too many %s.\nTable limit now %d.\nTry rerunning with the -N%c%d option.\n",
+	    s, n, c, 2*n);
+	Fatal(buff);
+}
+
+ void
+#ifdef KR_headers
+err66(s)
+	char *s;
+#else
+err66(char *s)
+#endif
+{
+	errstr("Fortran 77 feature used: %s", s);
+	--nerr;
+}
+
+
+ void
+#ifdef KR_headers
+errext(s)
+	char *s;
+#else
+errext(char *s)
+#endif
+{
+	errstr("f2c extension used: %s", s);
+	--nerr;
+}
diff --git a/contrib/tools/f2c/src/exec.c b/contrib/tools/f2c/src/exec.c
new file mode 100644
index 0000000000..88932222fe
--- /dev/null
+++ b/contrib/tools/f2c/src/exec.c
@@ -0,0 +1,984 @@
+/****************************************************************
+Copyright 1990, 1993 - 1996, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "p1defs.h"
+#include "names.h"
+
+static void exar2 Argdcl((int, tagptr, struct Labelblock*, struct Labelblock*));
+static void popctl Argdcl((void));
+static void pushctl Argdcl((int));
+
+/*   Logical IF codes
+*/
+
+ void
+#ifdef KR_headers
+exif(p)
+	expptr p;
+#else
+exif(expptr p)
+#endif
+{
+    pushctl(CTLIF);
+    putif(p, 0);	/* 0 => if, not elseif */
+}
+
+
+ void
+#ifdef KR_headers
+exelif(p)
+	expptr p;
+#else
+exelif(expptr p)
+#endif
+{
+    if (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLIFX)
+	putif(p, 1);	/* 1 ==> elseif */
+    else
+	execerr("elseif out of place", CNULL);
+}
+
+
+
+
+ void
+exelse(Void)
+{
+	register struct Ctlframe *c;
+
+	for(c = ctlstack; c->ctltype == CTLIFX; --c);
+	if(c->ctltype == CTLIF) {
+		p1_else ();
+		c->ctltype = CTLELSE;
+		}
+	else
+		execerr("else out of place", CNULL);
+	}
+
+ void
+#ifdef KR_headers
+exendif()
+#else
+exendif()
+#endif
+{
+	while(ctlstack->ctltype == CTLIFX) {
+		popctl();
+		p1else_end();
+		}
+	if(ctlstack->ctltype == CTLIF) {
+		popctl();
+		p1_endif ();
+		}
+	else if(ctlstack->ctltype == CTLELSE) {
+		popctl();
+		p1else_end ();
+		}
+	else
+		execerr("endif out of place", CNULL);
+	}
+
+
+ void
+#ifdef KR_headers
+new_endif()
+#else
+new_endif()
+#endif
+{
+	if (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLIFX)
+		pushctl(CTLIFX);
+	else
+		err("new_endif bug");
+	}
+
+/* pushctl -- Start a new control construct, initialize the labels (to
+   zero) */
+
+ LOCAL void
+#ifdef KR_headers
+pushctl(code)
+	int code;
+#else
+pushctl(int code)
+#endif
+{
+	register int i;
+
+	if(++ctlstack >= lastctl)
+		many("loops or if-then-elses", 'c', maxctl);
+	ctlstack->ctltype = code;
+	for(i = 0 ; i < 4 ; ++i)
+		ctlstack->ctlabels[i] = 0;
+	ctlstack->dowhile = 0;
+	ctlstack->domax = ctlstack->dostep = 0;	/* in case of errors */
+	++blklevel;
+}
+
+
+ LOCAL void
+popctl(Void)
+{
+	if( ctlstack-- < ctls )
+		Fatal("control stack empty");
+	--blklevel;
+}
+
+
+
+/* poplab -- update the flags in   labeltab   */
+
+ LOCAL void
+poplab(Void)
+{
+	register struct Labelblock  *lp;
+
+	for(lp = labeltab ; lp < highlabtab ; ++lp)
+		if(lp->labdefined)
+		{
+			/* mark all labels in inner blocks unreachable */
+			if(lp->blklevel > blklevel)
+				lp->labinacc = YES;
+		}
+		else if(lp->blklevel > blklevel)
+		{
+			/* move all labels referred to in inner blocks out a level */
+			lp->blklevel = blklevel;
+		}
+}
+
+
+/*  BRANCHING CODE
+*/
+ void
+#ifdef KR_headers
+exgoto(lab)
+	struct Labelblock *lab;
+#else
+exgoto(struct Labelblock *lab)
+#endif
+{
+	lab->labused = 1;
+	p1_goto (lab -> stateno);
+}
+
+
+ static expptr
+#ifdef KR_headers
+cktype1(p) expptr p;
+#else
+cktype1(expptr p)
+#endif
+{
+	/* Do things omitted because we might have been parsing a */
+	/* statement function...  Check types and fold constants. */
+
+	chainp c;
+	tagptr t;
+
+	if(p == 0)
+		return(0);
+
+	switch(p->tag) {
+	  case TCONST:
+	  case TADDR:
+	  case TERROR:
+		break;
+
+/* This case means that   fixexpr   can't call   fixtype   with any expr,
+   only a subexpr of its parameter. */
+
+	  case TEXPR:
+		t = mkexpr(p->exprblock.opcode, cktype1(p->exprblock.leftp),
+				cktype1(p->exprblock.rightp));
+		free((charptr)p);
+		p = (expptr) t;
+		break;
+
+	  case TLIST:
+		for(c = p->listblock.listp; c; c = c->nextp)
+			c->datap = (char*)cktype1((expptr)c->datap);
+		break;
+
+	  case TPRIM:
+		p->primblock.argsp = (struct Listblock*)
+			cktype1((expptr)p->primblock.argsp);
+		p->primblock.fcharp = cktype1(p->primblock.fcharp);
+		p->primblock.lcharp = cktype1(p->primblock.lcharp);
+		break;
+
+	  default:
+		badtag("cktype1", p->tag);
+	  }
+	return p;
+	}
+
+
+ void
+#ifdef KR_headers
+exequals(lp, rp)
+	register struct Primblock *lp;
+	register expptr rp;
+#else
+exequals(register struct Primblock *lp, register expptr rp)
+#endif
+{
+	if(lp->tag != TPRIM)
+	{
+		err("assignment to a non-variable");
+		frexpr((expptr)lp);
+		frexpr(rp);
+	}
+	else if(lp->namep->vclass!=CLVAR && lp->argsp)
+	{
+		if(parstate >= INEXEC)
+			errstr("statement function %.62s amid executables.",
+				lp->namep->fvarname);
+		mkstfunct(lp, rp);
+	}
+	else if (lp->vtype == TYSUBR)
+		err("illegal use of subroutine name");
+	else
+	{
+		expptr new_lp, new_rp;
+
+		if(parstate < INDATA) {
+			enddcl();
+			lp = (struct Primblock *)cktype1((expptr)lp);
+			rp = cktype1(rp);
+			}
+		new_lp = mklhs (lp, keepsubs);
+		new_rp = fixtype (rp);
+		puteq(new_lp, new_rp);
+	}
+}
+
+
+
+/* Make Statement Function */
+
+long laststfcn = -1, thisstno;
+int doing_stmtfcn;
+
+ void
+#ifdef KR_headers
+mkstfunct(lp, rp)
+	struct Primblock *lp;
+	expptr rp;
+#else
+mkstfunct(struct Primblock *lp, expptr rp)
+#endif
+{
+	register struct Primblock *p;
+	register Namep np;
+	chainp args;
+
+	laststfcn = thisstno;
+	np = lp->namep;
+	if(np->vclass == CLUNKNOWN)
+		np->vclass = CLPROC;
+	else
+	{
+		dclerr("redeclaration of statement function", np);
+		return;
+	}
+	np->vprocclass = PSTFUNCT;
+	np->vstg = STGSTFUNCT;
+
+/* Set the type of the function */
+
+	impldcl(np);
+	if (np->vtype == TYCHAR && !np->vleng)
+		err("character statement function with length (*)");
+	args = (lp->argsp ? lp->argsp->listp : CHNULL);
+	np->varxptr.vstfdesc = mkchain((char *)args, (chainp)rp);
+
+	for(doing_stmtfcn = 1 ; args ; args = args->nextp)
+
+/* It is an error for the formal parameters to have arguments or
+   subscripts */
+
+		if( ((tagptr)(args->datap))->tag!=TPRIM ||
+		    (p = (struct Primblock *)(args->datap) )->argsp ||
+		    p->fcharp || p->lcharp ) {
+			err("non-variable argument in statement function definition");
+			args->datap = 0;
+			}
+		else
+		{
+
+/* Replace the name on the left-hand side */
+
+			args->datap = (char *)p->namep;
+			vardcl(p -> namep);
+			free((char *)p);
+		}
+	doing_stmtfcn = 0;
+}
+
+ static void
+#ifdef KR_headers
+mixed_type(np)
+	Namep np;
+#else
+mixed_type(Namep np)
+#endif
+{
+	char buf[128];
+	sprintf(buf, "%s function %.90s invoked as subroutine",
+		ftn_types[np->vtype], np->fvarname);
+	warn(buf);
+	}
+
+ void
+#ifdef KR_headers
+excall(name, args, nstars, labels)
+	Namep name;
+	struct Listblock *args;
+	int nstars;
+	struct Labelblock **labels;
+#else
+excall(Namep name, struct Listblock *args, int nstars, struct Labelblock **labels)
+#endif
+{
+	register expptr p;
+
+	if (name->vtype != TYSUBR) {
+		if (name->vinfproc && !name->vcalled) {
+			name->vtype = TYSUBR;
+			frexpr(name->vleng);
+			name->vleng = 0;
+			}
+		else if (!name->vimpltype && name->vtype != TYUNKNOWN)
+			mixed_type(name);
+		else
+			settype(name, TYSUBR, (ftnint)0);
+		}
+	p = mkfunct( mkprim(name, args, CHNULL) );
+	if (p->tag == TERROR)
+		return;
+
+/* Subroutines and their identifiers acquire the type INT */
+
+	p->exprblock.vtype = p->exprblock.leftp->headblock.vtype = TYINT;
+
+/* Handle the alternate return mechanism */
+
+	if(nstars > 0)
+		putcmgo(putx(fixtype(p)), nstars, labels);
+	else
+		putexpr(p);
+}
+
+
+ void
+#ifdef KR_headers
+exstop(stop, p)
+	int stop;
+	register expptr p;
+#else
+exstop(int stop, register expptr p)
+#endif
+{
+	char *str;
+	int n;
+
+	if(p)
+	{
+		if( ! ISCONST(p) )
+		{
+			execerr("pause/stop argument must be constant", CNULL);
+			frexpr(p);
+			p = mkstrcon(0, CNULL);
+		}
+		else if( ISINT(p->constblock.vtype) )
+		{
+			str = convic(p->constblock.Const.ci);
+			n = strlen(str);
+			if(n > 0)
+			{
+				p->constblock.Const.ccp = copyn(n, str);
+				p->constblock.Const.ccp1.blanks = 0;
+				p->constblock.vtype = TYCHAR;
+				p->constblock.vleng = (expptr) ICON(n);
+			}
+			else
+				p = (expptr) mkstrcon(0, CNULL);
+		}
+		else if(p->constblock.vtype != TYCHAR)
+		{
+			execerr("pause/stop argument must be integer or string", CNULL);
+			p = (expptr) mkstrcon(0, CNULL);
+		}
+	}
+	else	p = (expptr) mkstrcon(0, CNULL);
+
+    {
+	expptr subr_call;
+
+	subr_call = call1(TYSUBR, (char*)(stop ? "s_stop" : "s_paus"), p);
+	putexpr( subr_call );
+    }
+}
+
+/* DO LOOP CODE */
+
+#define DOINIT	par[0]
+#define DOLIMIT	par[1]
+#define DOINCR	par[2]
+
+
+/* Macros for   ctlstack -> dostepsign   */
+
+#define VARSTEP	0
+#define POSSTEP	1
+#define NEGSTEP	2
+
+
+/* exdo -- generate DO loop code.  In the case of a variable increment,
+   positive increment tests are placed above the body, negative increment
+   tests are placed below (see   enddo()   ) */
+
+ void
+#ifdef KR_headers
+exdo(range, loopname, spec)
+	int range;
+	Namep loopname;
+	chainp spec;
+#else
+exdo(int range, Namep loopname, chainp spec)
+#endif
+			/* range = end label */
+			/* input spec must have at least 2 exprs */
+{
+	register expptr p;
+	register Namep np;
+	chainp cp;		/* loops over the fields in   spec */
+	register int i;
+	int dotype;		/* type of the index variable */
+	int incsign;		/* sign of the increment, if it's constant
+				   */
+	Addrp dovarp;		/* loop index variable */
+	expptr doinit;		/* constant or register for init param */
+	expptr par[3];		/* local specification parameters */
+
+	expptr init, test, inc;	/* Expressions in the resulting FOR loop */
+
+
+	test = ENULL;
+
+	pushctl(CTLDO);
+	dorange = ctlstack->dolabel = range;
+	ctlstack->loopname = loopname;
+
+/* Declare the loop index */
+
+	np = (Namep)spec->datap;
+	ctlstack->donamep = NULL;
+	if (!np) { /* do while */
+		ctlstack->dowhile = 1;
+#if 0
+		if (loopname) {
+			if (loopname->vtype == TYUNKNOWN) {
+				loopname->vdcldone = 1;
+				loopname->vclass = CLLABEL;
+				loopname->vprocclass = PLABEL;
+				loopname->vtype = TYLABEL;
+				}
+			if (loopname->vtype == TYLABEL)
+				if (loopname->vdovar)
+					dclerr("already in use as a loop name",
+						loopname);
+				else
+					loopname->vdovar = 1;
+			else
+				dclerr("already declared; cannot be a loop name",
+					loopname);
+			}
+#endif
+		putwhile((expptr)spec->nextp);
+		NOEXT("do while");
+		spec->nextp = 0;
+		frchain(&spec);
+		return;
+		}
+	if(np->vdovar)
+	{
+		errstr("nested loops with variable %s", np->fvarname);
+		ctlstack->donamep = NULL;
+		return;
+	}
+
+/* Create a memory-resident version of the index variable */
+
+	dovarp = mkplace(np);
+	if( ! ONEOF(dovarp->vtype, MSKINT|MSKREAL) )
+	{
+		err("bad type on do variable");
+		return;
+	}
+	ctlstack->donamep = np;
+
+	np->vdovar = YES;
+
+/* Now   dovarp   points to the index to be used within the loop,   dostgp
+   points to the one which may need to be stored */
+
+	dotype = dovarp->vtype;
+
+/* Count the input specifications and type-check each one independently;
+   this just eliminates non-numeric values from the specification */
+
+	for(i=0 , cp = spec->nextp ; cp!=NULL && i<3 ; cp = cp->nextp)
+	{
+		p = par[i++] = fixtype((tagptr)cp->datap);
+		if( ! ONEOF(p->headblock.vtype, MSKINT|MSKREAL) )
+		{
+			err("bad type on DO parameter");
+			return;
+		}
+	}
+
+	frchain(&spec);
+	switch(i)
+	{
+	case 0:
+	case 1:
+		err("too few DO parameters");
+		return;
+
+	default:
+		err("too many DO parameters");
+		return;
+
+	case 2:
+		DOINCR = (expptr) ICON(1);
+
+	case 3:
+		break;
+	}
+
+
+/* Now all of the local specification fields are set, but their types are
+   not yet consistent */
+
+/* Declare the loop initialization value, casting it properly and declaring a
+   register if need be */
+
+	ctlstack->doinit = 0;
+	if (ISCONST (DOINIT) || !onetripflag)
+/* putx added 6-29-89 (mwm), not sure if fixtype is required, but I doubt it
+   since mkconv is called just before */
+		doinit = putx (mkconv (dotype, DOINIT));
+	else  {
+	    if (onetripflag)
+	   	ctlstack->doinit = doinit = (expptr) mktmp0(dotype, ENULL);
+	    else
+		doinit = (expptr) mktmp(dotype, ENULL);
+	    puteq (cpexpr (doinit), DOINIT);
+	} /* else */
+
+/* Declare the loop ending value, casting it to the type of the index
+   variable */
+
+	if( ISCONST(DOLIMIT) )
+		ctlstack->domax = mkconv(dotype, DOLIMIT);
+	else {
+		ctlstack->domax = (expptr) mktmp0(dotype, ENULL);
+		puteq (cpexpr (ctlstack -> domax), DOLIMIT);
+	} /* else */
+
+/* Declare the loop increment value, casting it to the type of the index
+   variable */
+
+	if( ISCONST(DOINCR) )
+	{
+		ctlstack->dostep = mkconv(dotype, DOINCR);
+		if( (incsign = conssgn(ctlstack->dostep)) == 0)
+			err("zero DO increment");
+		ctlstack->dostepsign = (incsign > 0 ? POSSTEP : NEGSTEP);
+	}
+	else
+	{
+		ctlstack->dostep = (expptr) mktmp0(dotype, ENULL);
+		ctlstack->dostepsign = VARSTEP;
+		puteq (cpexpr (ctlstack -> dostep), DOINCR);
+	}
+
+/* All data is now properly typed and in the   ctlstack,   except for the
+   initial value.  Assignments of temps have been generated already */
+
+	switch (ctlstack -> dostepsign) {
+	    case VARSTEP:
+		test = mkexpr (OPQUEST, mkexpr (OPLT,
+			cpexpr (ctlstack -> dostep), ICON(0)),
+			mkexpr (OPCOLON,
+			    mkexpr (OPGE, cpexpr((expptr)dovarp),
+				    cpexpr (ctlstack -> domax)),
+			    mkexpr (OPLE, cpexpr((expptr)dovarp),
+				    cpexpr (ctlstack -> domax))));
+		break;
+	    case POSSTEP:
+	        test = mkexpr (OPLE, cpexpr((expptr)dovarp),
+			cpexpr (ctlstack -> domax));
+	        break;
+	    case NEGSTEP:
+	        test = mkexpr (OPGE, cpexpr((expptr)dovarp),
+			cpexpr (ctlstack -> domax));
+	        break;
+	    default:
+	        erri ("exdo:  bad dostepsign '%d'", ctlstack -> dostepsign);
+	        break;
+	} /* switch (ctlstack -> dostepsign) */
+
+	if (onetripflag)
+	    test = mkexpr (OPOR, test,
+		    mkexpr (OPEQ, cpexpr((expptr)dovarp), cpexpr (doinit)));
+	init = mkexpr (OPASSIGN, cpexpr((expptr)dovarp),
+			ctlstack->doinit ? cpexpr(doinit) : doinit);
+	inc = mkexpr (OPPLUSEQ, (expptr)dovarp, cpexpr (ctlstack -> dostep));
+
+	if (!onetripflag && ISCONST (ctlstack -> domax) && ISCONST (doinit)
+		&& ctlstack -> dostepsign != VARSTEP) {
+	    expptr tester;
+
+	    tester = mkexpr (OPMINUS, cpexpr (doinit),
+		    cpexpr (ctlstack -> domax));
+	    if (incsign == conssgn (tester))
+		warn ("DO range never executed");
+	    frexpr (tester);
+	} /* if !onetripflag && */
+
+	p1_for (init, test, inc);
+}
+
+ void
+#ifdef KR_headers
+exenddo(np)
+	Namep np;
+#else
+exenddo(Namep np)
+#endif
+{
+	Namep np1;
+	int here;
+	struct Ctlframe *cf;
+
+	if( ctlstack < ctls )
+		goto misplaced;
+	here = ctlstack->dolabel;
+	if (ctlstack->ctltype != CTLDO
+	|| here >= 0 && (!thislabel || thislabel->labelno != here)) {
+ misplaced:
+		err("misplaced ENDDO");
+		return;
+		}
+	if (np != ctlstack->loopname) {
+		if (np1 = ctlstack->loopname)
+			errstr("expected \"enddo %s\"", np1->fvarname);
+		else
+			err("expected unnamed ENDDO");
+		for(cf = ctls; cf < ctlstack; cf++)
+			if (cf->ctltype == CTLDO && cf->loopname == np) {
+				here = cf->dolabel;
+				break;
+				}
+		}
+	enddo(here);
+	}
+
+ void
+#ifdef KR_headers
+enddo(here)
+	int here;
+#else
+enddo(int here)
+#endif
+{
+	register struct Ctlframe *q;
+	Namep np;			/* name of the current DO index */
+	Addrp ap;
+	register int i;
+	register expptr e;
+
+/* Many DO's can end at the same statement, so keep looping over all
+   nested indicies */
+
+	while(here == dorange)
+	{
+		if(np = ctlstack->donamep)
+			{
+			p1for_end ();
+
+/* Now we're done with all of the tests, and the loop has terminated.
+   Store the index value back in long-term memory */
+
+			if(ap = memversion(np))
+				puteq((expptr)ap, (expptr)mkplace(np));
+			for(i = 0 ; i < 4 ; ++i)
+				ctlstack->ctlabels[i] = 0;
+			deregister(ctlstack->donamep);
+			ctlstack->donamep->vdovar = NO;
+			/* ctlstack->dostep and ctlstack->domax can be zero */
+			/* with sufficiently bizarre (erroneous) syntax */
+			if (e = ctlstack->dostep)
+				if (e->tag == TADDR && e->addrblock.istemp)
+					frtemp((Addrp)e);
+				else
+					frexpr(e);
+			if (e = ctlstack->domax)
+				if (e->tag == TADDR && e->addrblock.istemp)
+					frtemp((Addrp)e);
+				else
+					frexpr(e);
+			if (e = ctlstack->doinit)
+				frtemp((Addrp)e);
+			}
+		else if (ctlstack->dowhile)
+			p1for_end ();
+
+/* Set   dorange   to the closing label of the next most enclosing DO loop
+   */
+
+		popctl();
+		poplab();
+		dorange = 0;
+		for(q = ctlstack ; q>=ctls ; --q)
+			if(q->ctltype == CTLDO)
+			{
+				dorange = q->dolabel;
+				break;
+			}
+	}
+}
+
+ void
+#ifdef KR_headers
+exassign(vname, labelval)
+	register Namep vname;
+	struct Labelblock *labelval;
+#else
+exassign(register Namep vname, struct Labelblock *labelval)
+#endif
+{
+	Addrp p;
+	register Addrp q;
+	char *fs;
+	register chainp cp, cpprev;
+	register ftnint k, stno;
+
+	p = mkplace(vname);
+	if( ! ONEOF(p->vtype, MSKINT|MSKADDR) ) {
+		err("noninteger assign variable");
+		return;
+		}
+
+	/* If the label hasn't been defined, then we do things twice:
+	 * once for an executable stmt label, once for a format
+	 */
+
+	/* code for executable label... */
+
+/* Now store the assigned value in a list associated with this variable.
+   This will be used later to generate a switch() statement in the C output */
+
+	fs = labelval->fmtstring;
+	if (!labelval->labdefined || !fs) {
+
+		if (vname -> vis_assigned == 0) {
+			vname -> varxptr.assigned_values = CHNULL;
+			vname -> vis_assigned = 1;
+			}
+
+		/* don't duplicate labels... */
+
+		stno = labelval->stateno;
+		cpprev = 0;
+		for(k = 0, cp = vname->varxptr.assigned_values;
+				cp; cpprev = cp, cp = cp->nextp, k++)
+			if ((ftnint)cp->datap == stno)
+				break;
+		if (!cp) {
+			cp = mkchain((char *)stno, CHNULL);
+			if (cpprev)
+				cpprev->nextp = cp;
+			else
+				vname->varxptr.assigned_values = cp;
+			labelval->labused = 1;
+			}
+		putout(mkexpr(OPASSIGN, (expptr)p, mkintcon(k)));
+		}
+
+	/* Code for FORMAT label... */
+
+	if (!labelval->labdefined || fs) {
+
+		labelval->fmtlabused = 1;
+		p = ALLOC(Addrblock);
+		p->tag = TADDR;
+		p->vtype = TYCHAR;
+		p->vstg = STGAUTO;
+		p->memoffset = ICON(0);
+		fmtname(vname, p);
+		q = ALLOC(Addrblock);
+		q->tag = TADDR;
+		q->vtype = TYCHAR;
+		q->vstg = STGAUTO;
+		q->ntempelt = 1;
+		q->memoffset = ICON(0);
+		q->uname_tag = UNAM_IDENT;
+		sprintf(q->user.ident, "fmt_%ld", labelval->stateno);
+		putout(mkexpr(OPASSIGN, (expptr)p, (expptr)q));
+		}
+
+} /* exassign */
+
+
+ void
+#ifdef KR_headers
+exarif(expr, neglab, zerlab, poslab)
+	expptr expr;
+	struct Labelblock *neglab;
+	struct Labelblock *zerlab;
+	struct Labelblock *poslab;
+#else
+exarif(expptr expr, struct Labelblock *neglab, struct Labelblock *zerlab, struct Labelblock *poslab)
+#endif
+{
+    ftnint lm, lz, lp;
+
+    lm = neglab->stateno;
+    lz = zerlab->stateno;
+    lp = poslab->stateno;
+    expr = fixtype(expr);
+
+    if( ! ONEOF(expr->headblock.vtype, MSKINT|MSKREAL) )
+    {
+        err("invalid type of arithmetic if expression");
+        frexpr(expr);
+    }
+    else
+    {
+        if (lm == lz && lz == lp)
+            exgoto (neglab);
+        else if(lm == lz)
+            exar2(OPLE, expr, neglab, poslab);
+        else if(lm == lp)
+            exar2(OPNE, expr, neglab, zerlab);
+        else if(lz == lp)
+            exar2(OPGE, expr, zerlab, neglab);
+        else {
+            expptr t;
+
+	    if (!addressable (expr)) {
+		t = (expptr) mktmp(expr -> headblock.vtype, ENULL);
+		expr = mkexpr (OPASSIGN, cpexpr (t), expr);
+	    } else
+		t = (expptr) cpexpr (expr);
+
+	    p1_if(putx(fixtype(mkexpr (OPLT, expr, ICON (0)))));
+	    exgoto(neglab);
+	    p1_elif (mkexpr (OPEQ, t, ICON (0)));
+	    exgoto(zerlab);
+	    p1_else ();
+	    exgoto(poslab);
+	    p1else_end ();
+        } /* else */
+    }
+}
+
+
+
+/* exar2 -- Do arithmetic IF for only 2 distinct labels;   if !(e.op.0)
+   goto l2 else goto l1.  If this seems backwards, that's because it is,
+   in order to make the 1 pass algorithm work. */
+
+ LOCAL void
+#ifdef KR_headers
+exar2(op, e, l1, l2)
+	int op;
+	expptr e;
+	struct Labelblock *l1;
+	struct Labelblock *l2;
+#else
+exar2(int op, expptr e, struct Labelblock *l1, struct Labelblock *l2)
+#endif
+{
+	expptr comp;
+
+	comp = mkexpr (op, e, ICON (0));
+	p1_if(putx(fixtype(comp)));
+	exgoto(l1);
+	p1_else ();
+	exgoto(l2);
+	p1else_end ();
+}
+
+
+/* exreturn -- return the value in   p  from a SUBROUTINE call -- used to
+   implement the alternate return mechanism */
+
+ void
+#ifdef KR_headers
+exreturn(p)
+	register expptr p;
+#else
+exreturn(register expptr p)
+#endif
+{
+	if(procclass != CLPROC)
+		warn("RETURN statement in main or block data");
+	if(p && (proctype!=TYSUBR || procclass!=CLPROC) )
+	{
+		err("alternate return in nonsubroutine");
+		p = 0;
+	}
+
+	if (p || proctype == TYSUBR) {
+		if (p == ENULL) p = ICON (0);
+		p = mkconv (TYLONG, fixtype (p));
+		p1_subr_ret (p);
+	} /* if p || proctype == TYSUBR */
+	else
+	    p1_subr_ret((expptr)retslot);
+}
+
+
+ void
+#ifdef KR_headers
+exasgoto(labvar)
+	Namep labvar;
+#else
+exasgoto(Namep labvar)
+#endif
+{
+	register Addrp p;
+
+	p = mkplace(labvar);
+	if( ! ISINT(p->vtype) )
+		err("assigned goto variable must be integer");
+	else {
+		p1_asgoto (p);
+	} /* else */
+}
diff --git a/contrib/tools/f2c/src/expr.c b/contrib/tools/f2c/src/expr.c
new file mode 100644
index 0000000000..d9f86c0f17
--- /dev/null
+++ b/contrib/tools/f2c/src/expr.c
@@ -0,0 +1,3738 @@
+/****************************************************************
+Copyright 1990 - 1996, 2000-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "output.h"
+#include "names.h"
+
+typedef struct { double dreal, dimag; } dcomplex;
+
+static void consbinop Argdcl((int, int, Constp, Constp, Constp));
+static void conspower Argdcl((Constp, Constp, long int));
+static void zdiv Argdcl((dcomplex*, dcomplex*, dcomplex*));
+static tagptr mkpower Argdcl((tagptr));
+static tagptr stfcall Argdcl((Namep, struct Listblock*));
+
+extern char dflttype[26];
+extern int htype;
+
+/* little routines to create constant blocks */
+
+ Constp
+#ifdef KR_headers
+mkconst(t)
+	int t;
+#else
+mkconst(int t)
+#endif
+{
+	Constp p;
+
+	p = ALLOC(Constblock);
+	p->tag = TCONST;
+	p->vtype = t;
+	return(p);
+}
+
+
+/* mklogcon -- Make Logical Constant */
+
+ expptr
+#ifdef KR_headers
+mklogcon(l)
+	int l;
+#else
+mklogcon(int l)
+#endif
+{
+	Constp  p;
+
+	p = mkconst(tylog);
+	p->Const.ci = l;
+	return( (expptr) p );
+}
+
+
+
+/* mkintcon -- Make Integer Constant */
+
+ expptr
+#ifdef KR_headers
+mkintcon(l)
+	ftnint l;
+#else
+mkintcon(ftnint l)
+#endif
+{
+	Constp p;
+
+	p = mkconst(tyint);
+	p->Const.ci = l;
+	return( (expptr) p );
+}
+
+
+
+
+/* mkaddcon -- Make Address Constant, given integer value */
+
+ expptr
+#ifdef KR_headers
+mkaddcon(l)
+	long l;
+#else
+mkaddcon(long l)
+#endif
+{
+	Constp p;
+
+	p = mkconst(TYADDR);
+	p->Const.ci = l;
+	return( (expptr) p );
+}
+
+
+
+/* mkrealcon -- Make Real Constant.  The type t is assumed
+   to be TYREAL or TYDREAL */
+
+ expptr
+#ifdef KR_headers
+mkrealcon(t, d)
+	int t;
+	char *d;
+#else
+mkrealcon(int t, char *d)
+#endif
+{
+	Constp p;
+
+	p = mkconst(t);
+	p->Const.cds[0] = cds(d,CNULL);
+	p->vstg = 1;
+	return( (expptr) p );
+}
+
+
+/* mkbitcon -- Make bit constant.  Reads the input string, which is
+   assumed to correctly specify a number in base 2^shift (where   shift
+   is the input parameter).   shift   may not exceed 4, i.e. only binary,
+   quad, octal and hex bases may be input. */
+
+ expptr
+#ifdef KR_headers
+mkbitcon(shift, leng, s)
+	int shift;
+	int leng;
+	char *s;
+#else
+mkbitcon(int shift, int leng, char *s)
+#endif
+{
+	Constp p;
+	unsigned long m, ovfl, x, y, z;
+	int L32, len;
+	char buff[100], *s0 = s;
+#ifndef NO_LONG_LONG
+	ULlong u;
+#endif
+	static char *kind[3] = { "Binary", "Hex", "Octal" };
+
+	p = mkconst(TYLONG);
+	/* Song and dance to convert to TYQUAD only if ftnint is too small. */
+	m = x = y = ovfl = 0;
+	/* Older C compilers may not know about */
+	/* UL suffixes on hex constants... */
+	while(--leng >= 0)
+		if(*s != ' ') {
+			if (!m) {
+				z = x;
+				x = ((x << shift) | hextoi(*s++)) & ff;
+				if (!((x >> shift) - z))
+					continue;
+				m = (ff << (L32 = 32 - shift)) & ff;
+				--s;
+				x = z;
+				}
+			ovfl |= y & m;
+			y = y << shift | (x >> L32);
+			x = ((x << shift) | hextoi(*s++)) & ff;
+			}
+	/* Don't change the type to short for short constants, as
+	 * that is dangerous -- there is no syntax for long constants
+	 * with small values.
+	 */
+	p->Const.ci = (ftnint)x;
+#ifndef NO_LONG_LONG
+	if (m) {
+		if (allow_i8c) {
+			u = y;
+			p->Const.ucq = (u << 32) | x;
+			p->vtype = TYQUAD;
+			}
+		else
+			ovfl = 1;
+		}
+#else
+	ovfl |= m;
+#endif
+	if (ovfl) {
+		if (--shift == 3)
+			shift = 1;
+		if ((len = (int)leng) > 60)
+			sprintf(buff, "%s constant '%.60s' truncated.",
+				kind[shift], s0);
+		else
+			sprintf(buff, "%s constant '%.*s' truncated.",
+				kind[shift], len, s0);
+		err(buff);
+		}
+	return( (expptr) p );
+}
+
+
+
+
+
+/* mkstrcon -- Make string constant.  Allocates storage and initializes
+   the memory for a copy of the input Fortran-string. */
+
+ expptr
+#ifdef KR_headers
+mkstrcon(l, v)
+	int l;
+	char *v;
+#else
+mkstrcon(int l, char *v)
+#endif
+{
+	Constp p;
+	char *s;
+
+	p = mkconst(TYCHAR);
+	p->vleng = ICON(l);
+	p->Const.ccp = s = (char *) ckalloc(l+1);
+	p->Const.ccp1.blanks = 0;
+	while(--l >= 0)
+		*s++ = *v++;
+	*s = '\0';
+	return( (expptr) p );
+}
+
+
+
+/* mkcxcon -- Make complex contsant.  A complex number is a pair of
+   values, each of which may be integer, real or double. */
+
+ expptr
+#ifdef KR_headers
+mkcxcon(realp, imagp)
+	expptr realp;
+	expptr imagp;
+#else
+mkcxcon(expptr realp, expptr imagp)
+#endif
+{
+	int rtype, itype;
+	Constp p;
+
+	rtype = realp->headblock.vtype;
+	itype = imagp->headblock.vtype;
+
+	if( ISCONST(realp) && ISNUMERIC(rtype) && ISCONST(imagp) && ISNUMERIC(itype) )
+	{
+		p = mkconst( (rtype==TYDREAL||itype==TYDREAL)
+				? TYDCOMPLEX : tycomplex);
+		if (realp->constblock.vstg || imagp->constblock.vstg) {
+			p->vstg = 1;
+			p->Const.cds[0] = ISINT(rtype)
+				? string_num("", realp->constblock.Const.ci)
+				: realp->constblock.vstg
+					? realp->constblock.Const.cds[0]
+					: dtos(realp->constblock.Const.cd[0]);
+			p->Const.cds[1] = ISINT(itype)
+				? string_num("", imagp->constblock.Const.ci)
+				: imagp->constblock.vstg
+					? imagp->constblock.Const.cds[0]
+					: dtos(imagp->constblock.Const.cd[0]);
+			}
+		else {
+			p->Const.cd[0] = ISINT(rtype)
+				? realp->constblock.Const.ci
+				: realp->constblock.Const.cd[0];
+			p->Const.cd[1] = ISINT(itype)
+				? imagp->constblock.Const.ci
+				: imagp->constblock.Const.cd[0];
+			}
+	}
+	else
+	{
+		err("invalid complex constant");
+		p = (Constp)errnode();
+	}
+
+	frexpr(realp);
+	frexpr(imagp);
+	return( (expptr) p );
+}
+
+
+/* errnode -- Allocate a new error block */
+
+ expptr
+errnode(Void)
+{
+	struct Errorblock *p;
+	p = ALLOC(Errorblock);
+	p->tag = TERROR;
+	p->vtype = TYERROR;
+	return( (expptr) p );
+}
+
+
+
+
+
+/* mkconv -- Make type conversion.  Cast expression   p   into type   t.
+   Note that casting to a character copies only the first sizeof(char)
+   bytes. */
+
+ expptr
+#ifdef KR_headers
+mkconv(t, p)
+	int t;
+	expptr p;
+#else
+mkconv(int t, expptr p)
+#endif
+{
+	expptr q;
+	int pt, charwarn = 1;
+
+	if (t >= 100) {
+		t -= 100;
+		charwarn = 0;
+		}
+	if(t==TYUNKNOWN || t==TYERROR)
+		badtype("mkconv", t);
+	pt = p->headblock.vtype;
+
+/* Casting to the same type is a no-op */
+
+	if(t == pt)
+		return(p);
+
+/* If we're casting a constant which is not in the literal table ... */
+
+	else if( ISCONST(p) && pt!=TYADDR && pt != TYCHAR
+		|| p->tag == TADDR && p->addrblock.uname_tag == UNAM_CONST)
+	{
+#ifndef NO_LONG_LONG
+		if (t != TYQUAD && pt != TYQUAD)	/*20010820*/
+#endif
+		if (ISINT(t) && ISINT(pt) || ISREAL(t) && ISREAL(pt)) {
+			/* avoid trouble with -i2 */
+			p->headblock.vtype = t;
+			return p;
+			}
+		q = (expptr) mkconst(t);
+		consconv(t, &q->constblock, &p->constblock );
+		if (p->tag == TADDR)
+			q->constblock.vstg = p->addrblock.user.kludge.vstg1;
+		frexpr(p);
+	}
+	else {
+		if (pt == TYCHAR && t != TYADDR && charwarn
+				&& (!halign || p->tag != TADDR
+				|| p->addrblock.uname_tag != UNAM_CONST))
+			warn(
+		 "ichar([first char. of] char. string) assumed for conversion to numeric");
+		q = opconv(p, t);
+		}
+
+	if(t == TYCHAR)
+		q->constblock.vleng = ICON(1);
+	return(q);
+}
+
+
+
+/* opconv -- Convert expression   p   to type   t   using the main
+   expression evaluator; returns an OPCONV expression, I think  14-jun-88 mwm */
+
+ expptr
+#ifdef KR_headers
+opconv(p, t)
+	expptr p;
+	int t;
+#else
+opconv(expptr p, int t)
+#endif
+{
+	expptr q;
+
+	if (t == TYSUBR)
+		err("illegal use of subroutine name");
+	q = mkexpr(OPCONV, p, ENULL);
+	q->headblock.vtype = t;
+	return(q);
+}
+
+
+
+/* addrof -- Create an ADDR expression operation */
+
+ expptr
+#ifdef KR_headers
+addrof(p)
+	expptr p;
+#else
+addrof(expptr p)
+#endif
+{
+	return( mkexpr(OPADDR, p, ENULL) );
+}
+
+
+
+/* cpexpr - Returns a new copy of input expression   p   */
+
+ tagptr
+#ifdef KR_headers
+cpexpr(p)
+	tagptr p;
+#else
+cpexpr(tagptr p)
+#endif
+{
+	tagptr e;
+	int tag;
+	chainp ep, pp;
+
+/* This table depends on the ordering of the T macros, e.g. TNAME */
+
+	static int blksize[ ] =
+	{
+		0,
+		sizeof(struct Nameblock),
+		sizeof(struct Constblock),
+		sizeof(struct Exprblock),
+		sizeof(struct Addrblock),
+		sizeof(struct Primblock),
+		sizeof(struct Listblock),
+		sizeof(struct Impldoblock),
+		sizeof(struct Errorblock)
+	};
+
+	if(p == NULL)
+		return(NULL);
+
+/* TNAMEs are special, and don't get copied.  Each name in the current
+   symbol table has a unique TNAME structure. */
+
+	if( (tag = p->tag) == TNAME)
+		return(p);
+
+	e = cpblock(blksize[p->tag], (char *)p);
+
+	switch(tag)
+	{
+	case TCONST:
+		if(e->constblock.vtype == TYCHAR)
+		{
+			e->constblock.Const.ccp =
+			    copyn((int)e->constblock.vleng->constblock.Const.ci+1,
+				e->constblock.Const.ccp);
+			e->constblock.vleng =
+			    (expptr) cpexpr(e->constblock.vleng);
+		}
+	case TERROR:
+		break;
+
+	case TEXPR:
+		e->exprblock.leftp =  (expptr) cpexpr(p->exprblock.leftp);
+		e->exprblock.rightp = (expptr) cpexpr(p->exprblock.rightp);
+		break;
+
+	case TLIST:
+		if(pp = p->listblock.listp)
+		{
+			ep = e->listblock.listp =
+			    mkchain((char *)cpexpr((tagptr)pp->datap), CHNULL);
+			for(pp = pp->nextp ; pp ; pp = pp->nextp)
+				ep = ep->nextp =
+				    mkchain((char *)cpexpr((tagptr)pp->datap),
+						CHNULL);
+		}
+		break;
+
+	case TADDR:
+		e->addrblock.vleng = (expptr)  cpexpr(e->addrblock.vleng);
+		e->addrblock.memoffset = (expptr)cpexpr(e->addrblock.memoffset);
+		e->addrblock.istemp = NO;
+		break;
+
+	case TPRIM:
+		e->primblock.argsp = (struct Listblock *)
+		    cpexpr((expptr)e->primblock.argsp);
+		e->primblock.fcharp = (expptr) cpexpr(e->primblock.fcharp);
+		e->primblock.lcharp = (expptr) cpexpr(e->primblock.lcharp);
+		break;
+
+	default:
+		badtag("cpexpr", tag);
+	}
+
+	return(e);
+}
+
+/* frexpr -- Free expression -- frees up memory used by expression   p   */
+
+ void
+#ifdef KR_headers
+frexpr(p)
+	tagptr p;
+#else
+frexpr(tagptr p)
+#endif
+{
+	chainp q;
+
+	if(p == NULL)
+		return;
+
+	switch(p->tag)
+	{
+	case TCONST:
+		if( ISCHAR(p) )
+		{
+			free( (charptr) (p->constblock.Const.ccp) );
+			frexpr(p->constblock.vleng);
+		}
+		break;
+
+	case TADDR:
+		if (p->addrblock.vtype > TYERROR)	/* i/o block */
+			break;
+		frexpr(p->addrblock.vleng);
+		frexpr(p->addrblock.memoffset);
+		break;
+
+	case TERROR:
+		break;
+
+/* TNAME blocks don't get free'd - probably because they're pointed to in
+   the hash table. 14-Jun-88 -- mwm */
+
+	case TNAME:
+		return;
+
+	case TPRIM:
+		frexpr((expptr)p->primblock.argsp);
+		frexpr(p->primblock.fcharp);
+		frexpr(p->primblock.lcharp);
+		break;
+
+	case TEXPR:
+		frexpr(p->exprblock.leftp);
+		if(p->exprblock.rightp)
+			frexpr(p->exprblock.rightp);
+		break;
+
+	case TLIST:
+		for(q = p->listblock.listp ; q ; q = q->nextp)
+			frexpr((tagptr)q->datap);
+		frchain( &(p->listblock.listp) );
+		break;
+
+	default:
+		badtag("frexpr", p->tag);
+	}
+
+	free( (charptr) p );
+}
+
+ void
+#ifdef KR_headers
+wronginf(np)
+	Namep np;
+#else
+wronginf(Namep np)
+#endif
+{
+	int c;
+	ftnint k;
+	warn1("fixing wrong type inferred for %.65s", np->fvarname);
+	np->vinftype = 0;
+	c = letter(np->fvarname[0]);
+	if ((np->vtype = impltype[c]) == TYCHAR
+	&& (k = implleng[c]))
+		np->vleng = ICON(k);
+	}
+
+/* fix up types in expression; replace subtrees and convert
+   names to address blocks */
+
+ expptr
+#ifdef KR_headers
+fixtype(p)
+	tagptr p;
+#else
+fixtype(tagptr p)
+#endif
+{
+
+	if(p == 0)
+		return(0);
+
+	switch(p->tag)
+	{
+	case TCONST:
+		if(ONEOF(p->constblock.vtype,MSKINT|MSKLOGICAL|MSKADDR|
+		    MSKREAL) )
+			return( (expptr) p);
+
+		return( (expptr) putconst((Constp)p) );
+
+	case TADDR:
+		p->addrblock.memoffset = fixtype(p->addrblock.memoffset);
+		return( (expptr) p);
+
+	case TERROR:
+		return( (expptr) p);
+
+	default:
+		badtag("fixtype", p->tag);
+
+/* This case means that   fixexpr   can't call   fixtype   with any expr,
+   only a subexpr of its parameter. */
+
+	case TEXPR:
+		if (((Exprp)p)->typefixed)
+			return (expptr)p;
+		return( fixexpr((Exprp)p) );
+
+	case TLIST:
+		return( (expptr) p );
+
+	case TPRIM:
+		if(p->primblock.argsp && p->primblock.namep->vclass!=CLVAR)
+		{
+			if(p->primblock.namep->vtype == TYSUBR)
+			{
+				err("function invocation of subroutine");
+				return( errnode() );
+			}
+			else {
+				if (p->primblock.namep->vinftype)
+					wronginf(p->primblock.namep);
+				return( mkfunct(p) );
+				}
+		}
+
+/* The lack of args makes   p   a function name, substring reference
+   or variable name. */
+
+		else	return mklhs((struct Primblock *) p, keepsubs);
+	}
+}
+
+
+ int
+#ifdef KR_headers
+badchleng(p)
+	expptr p;
+#else
+badchleng(expptr p)
+#endif
+{
+	if (!p->headblock.vleng) {
+		if (p->headblock.tag == TADDR
+		&& p->addrblock.uname_tag == UNAM_NAME)
+			errstr("bad use of character*(*) variable %.60s",
+				p->addrblock.user.name->fvarname);
+		else
+			err("Bad use of character*(*)");
+		return 1;
+		}
+	return 0;
+	}
+
+
+ static expptr
+#ifdef KR_headers
+cplenexpr(p)
+	expptr p;
+#else
+cplenexpr(expptr p)
+#endif
+{
+	expptr rv;
+
+	if (badchleng(p))
+		return ICON(1);
+	rv = cpexpr(p->headblock.vleng);
+	if (ISCONST(p) && p->constblock.vtype == TYCHAR)
+		rv->constblock.Const.ci += p->constblock.Const.ccp1.blanks;
+	return rv;
+	}
+
+
+/* special case tree transformations and cleanups of expression trees.
+   Parameter   p   should have a TEXPR tag at its root, else an error is
+   returned */
+
+ expptr
+#ifdef KR_headers
+fixexpr(p)
+	Exprp p;
+#else
+fixexpr(Exprp p)
+#endif
+{
+	expptr lp, rp, q;
+	char *hsave;
+	int opcode, ltype, rtype, ptype, mtype;
+
+	if( ISERROR(p) || p->typefixed )
+		return( (expptr) p );
+	else if(p->tag != TEXPR)
+		badtag("fixexpr", p->tag);
+	opcode = p->opcode;
+
+/* First set the types of the left and right subexpressions */
+
+	lp = p->leftp;
+	if (!ISCONST(lp) || lp->constblock.vtype != TYCHAR)
+		lp = p->leftp = fixtype(lp);
+	ltype = lp->headblock.vtype;
+
+	if(opcode==OPASSIGN && lp->tag!=TADDR)
+	{
+		err("left side of assignment must be variable");
+ eret:
+		frexpr((expptr)p);
+		return( errnode() );
+	}
+
+	if(rp = p->rightp)
+	{
+		if (!ISCONST(rp) || rp->constblock.vtype != TYCHAR)
+			rp = p->rightp = fixtype(rp);
+		rtype = rp->headblock.vtype;
+	}
+	else
+		rtype = 0;
+
+	if(ltype==TYERROR || rtype==TYERROR)
+		goto eret;
+
+/* Now work on the whole expression */
+
+	/* force folding if possible */
+
+	if( ISCONST(lp) && (rp==NULL || ISCONST(rp)) )
+	{
+		q = opcode == OPCONV && lp->constblock.vtype == p->vtype
+			? lp : mkexpr(opcode, lp, rp);
+
+/* mkexpr is expected to reduce constant expressions */
+
+		if( ISCONST(q) ) {
+			p->leftp = p->rightp = 0;
+			frexpr((expptr)p);
+			return(q);
+			}
+		free( (charptr) q );	/* constants did not fold */
+	}
+
+	if( (ptype = cktype(opcode, ltype, rtype)) == TYERROR)
+		goto eret;
+
+	if (ltype == TYCHAR && ISCONST(lp)) {
+		if (opcode == OPCONV) {
+			hsave = halign;
+			halign = 0;
+			lp = (expptr)putconst((Constp)lp);
+			halign = hsave;
+			}
+		else
+			lp = (expptr)putconst((Constp)lp);
+		p->leftp = lp;
+		}
+	if (rtype == TYCHAR && ISCONST(rp))
+		p->rightp = rp = (expptr)putconst((Constp)rp);
+
+	switch(opcode)
+	{
+	case OPCONCAT:
+		if(p->vleng == NULL)
+			p->vleng = mkexpr(OPPLUS, cplenexpr(lp),
+					cplenexpr(rp) );
+		break;
+
+	case OPASSIGN:
+		if (rtype == TYREAL || ISLOGICAL(ptype)
+		 || rtype == TYDREAL && ltype == TYREAL && !ISCONST(rp))
+			break;
+	case OPPLUSEQ:
+	case OPSTAREQ:
+		if(ltype == rtype)
+			break;
+		if( ! ISCONST(rp) && ISREAL(ltype) && ISREAL(rtype) )
+			break;
+		if( ISCOMPLEX(ltype) || ISCOMPLEX(rtype) )
+			break;
+		if( ONEOF(ltype, MSKADDR|MSKINT) && ONEOF(rtype, MSKADDR|MSKINT)
+		    && typesize[ltype]>=typesize[rtype] )
+			    break;
+
+/* Cast the right hand side to match the type of the expression */
+
+		p->rightp = fixtype( mkconv(ptype, rp) );
+		break;
+
+	case OPSLASH:
+		if( ISCOMPLEX(rtype) )
+		{
+			p = (Exprp) call2(ptype,
+
+/* Handle double precision complex variables */
+
+			    (char*)(ptype == TYCOMPLEX ? "c_div" : "z_div"),
+			    mkconv(ptype, lp), mkconv(ptype, rp) );
+			break;
+		}
+	case OPPLUS:
+	case OPMINUS:
+	case OPSTAR:
+	case OPMOD:
+		if(ptype==TYDREAL && ( (ltype==TYREAL && ! ISCONST(lp) ) ||
+		    (rtype==TYREAL && ! ISCONST(rp) ) ))
+			break;
+		if( ISCOMPLEX(ptype) )
+			break;
+
+/* Cast both sides of the expression to match the type of the whole
+   expression.  */
+
+		if(ltype != ptype && (ltype < TYINT1 || ptype > TYDREAL))
+			p->leftp = fixtype(mkconv(ptype,lp));
+		if(rtype != ptype && (rtype < TYINT1 || ptype > TYDREAL))
+			p->rightp = fixtype(mkconv(ptype,rp));
+		break;
+
+	case OPPOWER:
+		rp = mkpower((expptr)p);
+		if (rp->tag == TEXPR)
+			rp->exprblock.typefixed = 1;
+		return rp;
+
+	case OPLT:
+	case OPLE:
+	case OPGT:
+	case OPGE:
+	case OPEQ:
+	case OPNE:
+		if(ltype == rtype)
+			break;
+		if (htype) {
+			if (ltype == TYCHAR) {
+				p->leftp = fixtype(mkconv(rtype,lp));
+				break;
+				}
+			if (rtype == TYCHAR) {
+				p->rightp = fixtype(mkconv(ltype,rp));
+				break;
+				}
+			}
+		mtype = cktype(OPMINUS, ltype, rtype);
+		if(mtype==TYDREAL && (ltype==TYREAL || rtype==TYREAL))
+			break;
+		if( ISCOMPLEX(mtype) )
+			break;
+		if(ltype != mtype)
+			p->leftp = fixtype(mkconv(mtype,lp));
+		if(rtype != mtype)
+			p->rightp = fixtype(mkconv(mtype,rp));
+		break;
+
+	case OPCONV:
+		ptype = cktype(OPCONV, p->vtype, ltype);
+		if(lp->tag==TEXPR && lp->exprblock.opcode==OPCOMMA
+		 && !ISCOMPLEX(ptype))
+		{
+			lp->exprblock.rightp =
+			    fixtype( mkconv(ptype, lp->exprblock.rightp) );
+			free( (charptr) p );
+			p = (Exprp) lp;
+		}
+		break;
+
+	case OPADDR:
+		if(lp->tag==TEXPR && lp->exprblock.opcode==OPADDR)
+			Fatal("addr of addr");
+		break;
+
+	case OPCOMMA:
+	case OPQUEST:
+	case OPCOLON:
+		break;
+
+	case OPMIN:
+	case OPMAX:
+	case OPMIN2:
+	case OPMAX2:
+	case OPDMIN:
+	case OPDMAX:
+	case OPABS:
+	case OPDABS:
+		ptype = p->vtype;
+		break;
+
+	default:
+		break;
+	}
+
+	p->vtype = ptype;
+	p->typefixed = 1;
+	return((expptr) p);
+}
+
+
+/* fix an argument list, taking due care for special first level cases */
+
+ int
+#ifdef KR_headers
+fixargs(doput, p0)
+	int doput;
+	struct Listblock *p0;
+#else
+fixargs(int doput, struct Listblock *p0)
+#endif
+	/* doput is true if constants need to be passed by reference */
+{
+	chainp p;
+	tagptr q, t;
+	int qtag, nargs;
+
+	nargs = 0;
+	if(p0)
+		for(p = p0->listp ; p ; p = p->nextp)
+		{
+			++nargs;
+			q = (tagptr)p->datap;
+			qtag = q->tag;
+			if(qtag == TCONST)
+			{
+
+/* Call putconst() to store values in a constant table.  Since even
+   constants must be passed by reference, this can optimize on the storage
+   required */
+
+				p->datap = doput ? (char *)putconst((Constp)q)
+						 : (char *)q;
+				continue;
+			}
+
+/* Take a function name and turn it into an Addr.  This only happens when
+   nothing else has figured out the function beforehand */
+
+			if (qtag == TPRIM && q->primblock.argsp == 0) {
+			    if (q->primblock.namep->vclass==CLPROC
+			     && q->primblock.namep->vprocclass != PTHISPROC) {
+				p->datap = (char *)mkaddr(q->primblock.namep);
+				continue;
+				}
+
+			    if (q->primblock.namep->vdim != NULL) {
+				p->datap = (char *)mkscalar(q->primblock.namep);
+				if ((q->primblock.fcharp||q->primblock.lcharp)
+				 && (q->primblock.namep->vtype != TYCHAR
+				  || q->primblock.namep->vdim))
+					sserr(q->primblock.namep);
+				continue;
+				}
+
+			    if (q->primblock.namep->vdovar
+			     && (t = (tagptr) memversion(q->primblock.namep))) {
+				p->datap = (char *)fixtype(t);
+				continue;
+				}
+			    }
+			p->datap = (char *)fixtype(q);
+		}
+	return(nargs);
+}
+
+
+
+/* mkscalar -- only called by   fixargs   above, and by some routines in
+   io.c */
+
+ Addrp
+#ifdef KR_headers
+mkscalar(np)
+	Namep np;
+#else
+mkscalar(Namep np)
+#endif
+{
+	Addrp ap;
+
+	vardcl(np);
+	ap = mkaddr(np);
+
+	/* The prolog causes array arguments to point to the
+	 * (0,...,0) element, unless subscript checking is on.
+	 */
+	if( !checksubs && np->vstg==STGARG)
+	{
+		struct Dimblock *dp;
+		dp = np->vdim;
+		frexpr(ap->memoffset);
+		ap->memoffset = mkexpr(OPSTAR,
+		    (np->vtype==TYCHAR ?
+		    cpexpr(np->vleng) :
+		    (tagptr)ICON(typesize[np->vtype]) ),
+		    cpexpr(dp->baseoffset) );
+	}
+	return(ap);
+}
+
+
+ static void
+#ifdef KR_headers
+adjust_arginfo(np)
+	Namep np;
+#else
+adjust_arginfo(Namep np)
+#endif
+			/* adjust arginfo to omit the length arg for the
+			   arg that we now know to be a character-valued
+			   function */
+{
+	struct Entrypoint *ep;
+	chainp args;
+	Argtypes *at;
+
+	for(ep = entries; ep; ep = ep->entnextp)
+		for(args = ep->arglist; args; args = args->nextp)
+			if (np == (Namep)args->datap
+			&& (at = ep->entryname->arginfo))
+				--at->nargs;
+	}
+
+
+ expptr
+#ifdef KR_headers
+mkfunct(p0)
+	expptr p0;
+#else
+mkfunct(expptr p0)
+#endif
+{
+	struct Primblock *p = (struct Primblock *)p0;
+	struct Entrypoint *ep;
+	Addrp ap;
+	Extsym *extp;
+	Namep np;
+	expptr q;
+	extern chainp new_procs;
+	int k, nargs;
+	int vclass;
+
+	if(p->tag != TPRIM)
+		return( errnode() );
+
+	np = p->namep;
+	vclass = np->vclass;
+
+
+	if(vclass == CLUNKNOWN)
+	{
+		np->vclass = vclass = CLPROC;
+		if(np->vstg == STGUNKNOWN)
+		{
+			if(np->vtype!=TYSUBR && (k = intrfunct(np->fvarname))
+				&& (zflag || !(*(struct Intrpacked *)&k).f4
+					|| dcomplex_seen))
+			{
+				np->vstg = STGINTR;
+				np->vardesc.varno = k;
+				np->vprocclass = PINTRINSIC;
+			}
+			else
+			{
+				extp = mkext(np->fvarname,
+					addunder(np->cvarname));
+				extp->extstg = STGEXT;
+				np->vstg = STGEXT;
+				np->vardesc.varno = extp - extsymtab;
+				np->vprocclass = PEXTERNAL;
+			}
+		}
+		else if(np->vstg==STGARG)
+		{
+		    if(np->vtype == TYCHAR) {
+			adjust_arginfo(np);
+			if (np->vpassed) {
+				char wbuf[160], *who;
+				who = np->fvarname;
+				sprintf(wbuf, "%s%s%s\n\t%s%s%s",
+					"Character-valued dummy procedure ",
+					who, " not declared EXTERNAL.",
+			"Code may be wrong for previous function calls having ",
+					who, " as a parameter.");
+				warn(wbuf);
+				}
+			}
+		    np->vprocclass = PEXTERNAL;
+		}
+	}
+
+	if(vclass != CLPROC) {
+		if (np->vstg == STGCOMMON)
+			fatalstr(
+			 "Cannot invoke common variable %.50s as a function.",
+				np->fvarname);
+		errstr("%.80s cannot be called.", np->fvarname);
+		goto error;
+		}
+
+/* F77 doesn't allow subscripting of function calls */
+
+	if(p->fcharp || p->lcharp)
+	{
+		err("no substring of function call");
+		goto error;
+	}
+	impldcl(np);
+	np->vimpltype = 0;	/* invoking as function ==> inferred type */
+	np->vcalled = 1;
+	nargs = fixargs( np->vprocclass!=PINTRINSIC,  p->argsp);
+
+	switch(np->vprocclass)
+	{
+	case PEXTERNAL:
+		if(np->vtype == TYUNKNOWN)
+		{
+			dclerr("attempt to use untyped function", np);
+			np->vtype = dflttype[letter(np->fvarname[0])];
+		}
+		ap = mkaddr(np);
+		if (!extsymtab[np->vardesc.varno].extseen) {
+			new_procs = mkchain((char *)np, new_procs);
+			extsymtab[np->vardesc.varno].extseen = 1;
+			}
+call:
+		q = mkexpr(OPCALL, (expptr)ap, (expptr)p->argsp);
+		q->exprblock.vtype = np->vtype;
+		if(np->vleng)
+			q->exprblock.vleng = (expptr) cpexpr(np->vleng);
+		break;
+
+	case PINTRINSIC:
+		q = intrcall(np, p->argsp, nargs);
+		break;
+
+	case PSTFUNCT:
+		q = stfcall(np, p->argsp);
+		break;
+
+	case PTHISPROC:
+		warn("recursive call");
+
+/* entries   is the list of multiple entry points */
+
+		for(ep = entries ; ep ; ep = ep->entnextp)
+			if(ep->enamep == np)
+				break;
+		if(ep == NULL)
+			Fatal("mkfunct: impossible recursion");
+
+		ap = builtin(np->vtype, ep->entryname->cextname, -2);
+		/* the negative last arg prevents adding */
+		/* this name to the list of used builtins */
+		goto call;
+
+	default:
+		fatali("mkfunct: impossible vprocclass %d",
+		    (int) (np->vprocclass) );
+	}
+	free( (charptr) p );
+	return(q);
+
+error:
+	frexpr((expptr)p);
+	return( errnode() );
+}
+
+
+
+ static expptr
+#ifdef KR_headers
+stfcall(np, actlist)
+	Namep np;
+	struct Listblock *actlist;
+#else
+stfcall(Namep np, struct Listblock *actlist)
+#endif
+{
+	chainp actuals;
+	int nargs;
+	chainp oactp, formals;
+	int type;
+	expptr Ln, Lq, q, q1, rhs, ap;
+	Namep tnp;
+	struct Rplblock *rp;
+	struct Rplblock *tlist;
+
+	if (np->arginfo) {
+		errstr("statement function %.66s calls itself.",
+			np->fvarname);
+		return ICON(0);
+		}
+	np->arginfo = (Argtypes *)np;	/* arbitrary nonzero value */
+	if(actlist)
+	{
+		actuals = actlist->listp;
+		free( (charptr) actlist);
+	}
+	else
+		actuals = NULL;
+	oactp = actuals;
+
+	nargs = 0;
+	tlist = NULL;
+	if( (type = np->vtype) == TYUNKNOWN)
+	{
+		dclerr("attempt to use untyped statement function", np);
+		type = np->vtype = dflttype[letter(np->fvarname[0])];
+	}
+	formals = (chainp) np->varxptr.vstfdesc->datap;
+	rhs = (expptr) (np->varxptr.vstfdesc->nextp);
+
+	/* copy actual arguments into temporaries */
+	while(actuals!=NULL && formals!=NULL)
+	{
+		if (!(tnp = (Namep) formals->datap)) {
+			/* buggy statement function declaration */
+			q = ICON(1);
+			goto done;
+			}
+		rp = ALLOC(Rplblock);
+		rp->rplnp = tnp;
+		ap = fixtype((tagptr)actuals->datap);
+		if(tnp->vtype==ap->headblock.vtype && tnp->vtype!=TYCHAR
+		    && (ap->tag==TCONST || ap->tag==TADDR) )
+		{
+
+/* If actuals are constants or variable names, no temporaries are required */
+			rp->rplvp = (expptr) ap;
+			rp->rplxp = NULL;
+			rp->rpltag = ap->tag;
+		}
+		else	{
+			rp->rplvp = (expptr) mktmp(tnp->vtype, tnp->vleng);
+			rp -> rplxp = NULL;
+			putexpr ( mkexpr(OPASSIGN, cpexpr(rp->rplvp), ap));
+			if((rp->rpltag = rp->rplvp->tag) == TERROR)
+				err("disagreement of argument types in statement function call");
+		}
+		rp->rplnextp = tlist;
+		tlist = rp;
+		actuals = actuals->nextp;
+		formals = formals->nextp;
+		++nargs;
+	}
+
+	if(actuals!=NULL || formals!=NULL)
+		err("statement function definition and argument list differ");
+
+	/*
+   now push down names involved in formal argument list, then
+   evaluate rhs of statement function definition in this environment
+*/
+
+	if(tlist)	/* put tlist in front of the rpllist */
+	{
+		for(rp = tlist; rp->rplnextp; rp = rp->rplnextp)
+			;
+		rp->rplnextp = rpllist;
+		rpllist = tlist;
+	}
+
+/* So when the expression finally gets evaled, that evaluator must read
+   from the globl   rpllist   14-jun-88 mwm */
+
+	q = (expptr) mkconv(type, fixtype(cpexpr(rhs)) );
+
+	/* get length right of character-valued statement functions... */
+	if (type == TYCHAR
+	 && (Ln = np->vleng)
+	 && q->tag != TERROR
+	 && (Lq = q->exprblock.vleng)
+	 && (Lq->tag != TCONST
+		|| Ln->constblock.Const.ci != Lq->constblock.Const.ci)) {
+		q1 = (expptr) mktmp(type, Ln);
+		putexpr ( mkexpr(OPASSIGN, cpexpr(q1), q));
+		q = q1;
+		}
+
+	/* now generate the tree ( t1=a1, (t2=a2,... , f))))) */
+	while(--nargs >= 0)
+	{
+		if(rpllist->rplxp)
+			q = mkexpr(OPCOMMA, rpllist->rplxp, q);
+		rp = rpllist->rplnextp;
+		frexpr(rpllist->rplvp);
+		free((char *)rpllist);
+		rpllist = rp;
+	}
+ done:
+	frchain( &oactp );
+	np->arginfo = 0;
+	return(q);
+}
+
+
+static int replaced;
+
+/* mkplace -- Figure out the proper storage class for the input name and
+   return an addrp with the appropriate stuff */
+
+ Addrp
+#ifdef KR_headers
+mkplace(np)
+	Namep np;
+#else
+mkplace(Namep np)
+#endif
+{
+	Addrp s;
+	struct Rplblock *rp;
+	int regn;
+
+	/* is name on the replace list? */
+
+	for(rp = rpllist ; rp ; rp = rp->rplnextp)
+	{
+		if(np == rp->rplnp)
+		{
+			replaced = 1;
+			if(rp->rpltag == TNAME)
+			{
+				np = (Namep) (rp->rplvp);
+				break;
+			}
+			else	return( (Addrp) cpexpr(rp->rplvp) );
+		}
+	}
+
+	/* is variable a DO index in a register ? */
+
+	if(np->vdovar && ( (regn = inregister(np)) >= 0) )
+		if(np->vtype == TYERROR)
+			return((Addrp) errnode() );
+		else
+		{
+			s = ALLOC(Addrblock);
+			s->tag = TADDR;
+			s->vstg = STGREG;
+			s->vtype = TYIREG;
+			s->memno = regn;
+			s->memoffset = ICON(0);
+			s -> uname_tag = UNAM_NAME;
+			s -> user.name = np;
+			return(s);
+		}
+
+	if (np->vclass == CLPROC && np->vprocclass != PTHISPROC)
+		errstr("external %.60s used as a variable", np->fvarname);
+	vardcl(np);
+	return(mkaddr(np));
+}
+
+ static expptr
+#ifdef KR_headers
+subskept(p, a)
+	struct Primblock *p;
+	Addrp a;
+#else
+subskept(struct Primblock *p, Addrp a)
+#endif
+{
+	expptr ep;
+	struct Listblock *Lb;
+	chainp cp;
+
+	if (a->uname_tag != UNAM_NAME)
+		erri("subskept: uname_tag %d", a->uname_tag);
+	a->user.name->vrefused = 1;
+	a->user.name->visused = 1;
+	a->uname_tag = UNAM_REF;
+	Lb = (struct Listblock *)cpexpr((tagptr)p->argsp);
+	for(cp = Lb->listp; cp; cp = cp->nextp)
+		cp->datap = (char *)putx(fixtype((tagptr)cp->datap));
+	if (a->vtype == TYCHAR) {
+		ep = p->fcharp	? mkexpr(OPMINUS, cpexpr(p->fcharp), ICON(1))
+				: ICON(0);
+		Lb->listp = mkchain((char *)ep, Lb->listp);
+		}
+	return (expptr)Lb;
+	}
+
+ static void
+#ifdef KR_headers
+substrerr(np) Namep np;
+#else
+substrerr(Namep np)
+#endif
+{
+	void (*f) Argdcl((const char*, const char*));
+	f = checksubs ? errstr : warn1;
+	(*f)("substring of %.65s is out of bounds.", np->fvarname);
+	}
+
+ static int doing_vleng;
+
+/* mklhs -- Compute the actual address of the given expression; account
+   for array subscripts, stack offset, and substring offsets.  The f -> C
+   translator will need this only to worry about the subscript stuff */
+
+ expptr
+#ifdef KR_headers
+mklhs(p, subkeep)
+	struct Primblock *p;
+	int subkeep;
+#else
+mklhs(struct Primblock *p, int subkeep)
+#endif
+{
+	Addrp s;
+	Namep np;
+
+	if(p->tag != TPRIM)
+		return( (expptr) p );
+	np = p->namep;
+
+	replaced = 0;
+	s = mkplace(np);
+	if(s->tag!=TADDR || s->vstg==STGREG)
+	{
+		free( (charptr) p );
+		return( (expptr) s );
+	}
+	s->parenused = p->parenused;
+
+	/* compute the address modified by subscripts */
+
+	if (!replaced)
+		s->memoffset = (subkeep && np->vdim && p->argsp
+				&& (np->vdim->ndim > 1 || np->vtype == TYCHAR
+				&& (!ISCONST(np->vleng)
+				  || np->vleng->constblock.Const.ci != 1)))
+				? subskept(p,s)
+				: mkexpr(OPPLUS, s->memoffset, suboffset(p) );
+	frexpr((expptr)p->argsp);
+	p->argsp = NULL;
+
+	/* now do substring part */
+
+	if(p->fcharp || p->lcharp)
+	{
+		if(np->vtype != TYCHAR)
+			sserr(np);
+		else	{
+			if(p->lcharp == NULL)
+				p->lcharp = (expptr)(
+					/* s->vleng == 0 only with errors */
+					s->vleng ? cpexpr(s->vleng) : ICON(1));
+			else if (ISCONST(p->lcharp)
+				 && ISCONST(np->vleng)
+				 && p->lcharp->constblock.Const.ci
+					> np->vleng->constblock.Const.ci)
+						substrerr(np);
+			if(p->fcharp) {
+				doing_vleng = 1;
+				s->vleng = fixtype(mkexpr(OPMINUS,
+						p->lcharp,
+					mkexpr(OPMINUS, p->fcharp, ICON(1) )));
+				doing_vleng = 0;
+				}
+			else	{
+				frexpr(s->vleng);
+				s->vleng = p->lcharp;
+				}
+			if (s->memoffset
+			 && ISCONST(s->memoffset)
+			 && s->memoffset->constblock.Const.ci < 0)
+				substrerr(np);
+		}
+	}
+
+	s->vleng = fixtype( s->vleng );
+	s->memoffset = fixtype( s->memoffset );
+	free( (charptr) p );
+	return( (expptr) s );
+}
+
+
+
+
+
+/* deregister -- remove a register allocation from the list; assumes that
+   names are deregistered in stack order (LIFO order - Last In First Out) */
+
+ void
+#ifdef KR_headers
+deregister(np)
+	Namep np;
+#else
+deregister(Namep np)
+#endif
+{
+	if(nregvar>0 && regnamep[nregvar-1]==np)
+	{
+		--nregvar;
+	}
+}
+
+
+
+
+/* memversion -- moves a DO index REGISTER into a memory location; other
+   objects are passed through untouched */
+
+ Addrp
+#ifdef KR_headers
+memversion(np)
+	Namep np;
+#else
+memversion(Namep np)
+#endif
+{
+	Addrp s;
+
+	if(np->vdovar==NO || (inregister(np)<0) )
+		return(NULL);
+	np->vdovar = NO;
+	s = mkplace(np);
+	np->vdovar = YES;
+	return(s);
+}
+
+
+
+/* inregister -- looks for the input name in the global list   regnamep */
+
+ int
+#ifdef KR_headers
+inregister(np)
+	Namep np;
+#else
+inregister(Namep np)
+#endif
+{
+	int i;
+
+	for(i = 0 ; i < nregvar ; ++i)
+		if(regnamep[i] == np)
+			return( regnum[i] );
+	return(-1);
+}
+
+
+
+/* suboffset -- Compute the offset from the start of the array, given the
+   subscripts as arguments */
+
+ expptr
+#ifdef KR_headers
+suboffset(p)
+	struct Primblock *p;
+#else
+suboffset(struct Primblock *p)
+#endif
+{
+	int n;
+	expptr si, size;
+	chainp cp;
+	expptr e, e1, offp, prod;
+	struct Dimblock *dimp;
+	expptr sub[MAXDIM+1];
+	Namep np;
+
+	np = p->namep;
+	offp = ICON(0);
+	n = 0;
+	if(p->argsp)
+		for(cp = p->argsp->listp ; cp ; cp = cp->nextp)
+		{
+			si = fixtype(cpexpr((tagptr)cp->datap));
+			if (!ISINT(si->headblock.vtype)) {
+				NOEXT("non-integer subscript");
+				si = mkconv(TYLONG, si);
+				}
+			sub[n++] = si;
+			if(n > maxdim)
+			{
+				erri("more than %d subscripts", maxdim);
+				break;
+			}
+		}
+
+	dimp = np->vdim;
+	if(n>0 && dimp==NULL)
+		errstr("subscripts on scalar variable %.68s", np->fvarname);
+	else if(dimp && dimp->ndim!=n)
+		errstr("wrong number of subscripts on %.68s", np->fvarname);
+	else if(n > 0)
+	{
+		prod = sub[--n];
+		while( --n >= 0)
+			prod = mkexpr(OPPLUS, sub[n],
+			    mkexpr(OPSTAR, prod, cpexpr(dimp->dims[n].dimsize)) );
+		if(checksubs || np->vstg!=STGARG)
+			prod = mkexpr(OPMINUS, prod, cpexpr(dimp->baseoffset));
+
+/* Add in the run-time bounds check */
+
+		if(checksubs)
+			prod = subcheck(np, prod);
+		size = np->vtype == TYCHAR ?
+		    (expptr) cpexpr(np->vleng) : ICON(typesize[np->vtype]);
+		prod = mkexpr(OPSTAR, prod, size);
+		offp = mkexpr(OPPLUS, offp, prod);
+	}
+
+/* Check for substring indicator */
+
+	if(p->fcharp && np->vtype==TYCHAR) {
+		e = p->fcharp;
+		e1 = mkexpr(OPMINUS, cpexpr(e), ICON(1));
+		if (!ISCONST(e) && (e->tag != TPRIM || e->primblock.argsp)) {
+			e = (expptr)mktmp(TYLONG, ENULL);
+			putout(putassign(cpexpr(e), e1));
+			p->fcharp = mkexpr(OPPLUS, cpexpr(e), ICON(1));
+			e1 = e;
+			}
+		offp = mkexpr(OPPLUS, offp, e1);
+		}
+	return(offp);
+}
+
+
+
+
+ expptr
+#ifdef KR_headers
+subcheck(np, p)
+	Namep np;
+	expptr p;
+#else
+subcheck(Namep np, expptr p)
+#endif
+{
+	struct Dimblock *dimp;
+	expptr t, checkvar, checkcond, badcall;
+
+	dimp = np->vdim;
+	if(dimp->nelt == NULL)
+		return(p);	/* don't check arrays with * bounds */
+	np->vlastdim = 0;
+	if( ISICON(p) )
+	{
+
+/* check for negative (constant) offset */
+
+		if(p->constblock.Const.ci < 0)
+			goto badsub;
+		if( ISICON(dimp->nelt) )
+
+/* see if constant offset exceeds the array declaration */
+
+			if(p->constblock.Const.ci < dimp->nelt->constblock.Const.ci)
+				return(p);
+			else
+				goto badsub;
+	}
+
+/* We know that the subscript offset   p   or   dimp -> nelt   is not a constant.
+   Now find a register to use for run-time bounds checking */
+
+	if(p->tag==TADDR && p->addrblock.vstg==STGREG)
+	{
+		checkvar = (expptr) cpexpr(p);
+		t = p;
+	}
+	else	{
+		checkvar = (expptr) mktmp(TYLONG, ENULL);
+		t = mkexpr(OPASSIGN, cpexpr(checkvar), p);
+	}
+	checkcond = mkexpr(OPLT, t, cpexpr(dimp->nelt) );
+	if( ! ISICON(p) )
+		checkcond = mkexpr(OPAND, checkcond,
+		    mkexpr(OPLE, ICON(0), cpexpr(checkvar)) );
+
+/* Construct the actual test */
+
+	badcall = call4(p->headblock.vtype, "s_rnge",
+	    mkstrcon(strlen(np->fvarname), np->fvarname),
+	    mkconv(TYLONG,  cpexpr(checkvar)),
+	    mkstrcon(strlen(procname), procname),
+	    ICON(lineno) );
+	badcall->exprblock.opcode = OPCCALL;
+	p = mkexpr(OPQUEST, checkcond,
+	    mkexpr(OPCOLON, checkvar, badcall));
+
+	return(p);
+
+badsub:
+	frexpr(p);
+	errstr("subscript on variable %s out of range", np->fvarname);
+	return ( ICON(0) );
+}
+
+
+
+
+ Addrp
+#ifdef KR_headers
+mkaddr(p)
+	Namep p;
+#else
+mkaddr(Namep p)
+#endif
+{
+	Extsym *extp;
+	Addrp t;
+	int k;
+
+	switch( p->vstg)
+	{
+	case STGAUTO:
+		if(p->vclass == CLPROC && p->vprocclass == PTHISPROC)
+			return (Addrp) cpexpr((expptr)xretslot[p->vtype]);
+		goto other;
+
+	case STGUNKNOWN:
+		if(p->vclass != CLPROC)
+			break;	/* Error */
+		extp = mkext(p->fvarname, addunder(p->cvarname));
+		extp->extstg = STGEXT;
+		p->vstg = STGEXT;
+		p->vardesc.varno = extp - extsymtab;
+		p->vprocclass = PEXTERNAL;
+		if ((extp->exproto || infertypes)
+		&& (p->vtype == TYUNKNOWN || p->vimpltype)
+		&& (k = extp->extype))
+			inferdcl(p, k);
+
+
+	case STGCOMMON:
+	case STGEXT:
+	case STGBSS:
+	case STGINIT:
+	case STGEQUIV:
+	case STGARG:
+	case STGLENG:
+ other:
+		t = ALLOC(Addrblock);
+		t->tag = TADDR;
+
+		t->vclass = p->vclass;
+		t->vtype = p->vtype;
+		t->vstg = p->vstg;
+		t->memno = p->vardesc.varno;
+		t->memoffset = ICON(p->voffset);
+		if (p->vdim)
+		    t->isarray = 1;
+		if(p->vleng)
+		{
+			t->vleng = (expptr) cpexpr(p->vleng);
+			if( ISICON(t->vleng) )
+				t->varleng = t->vleng->constblock.Const.ci;
+		}
+
+/* Keep the original name around for the C code generation */
+
+		t -> uname_tag = UNAM_NAME;
+		t -> user.name = p;
+		return(t);
+
+	case STGINTR:
+
+		return ( intraddr (p));
+
+	case STGSTFUNCT:
+
+		errstr("invalid use of statement function %.64s.", p->fvarname);
+		return putconst((Constp)ICON(0));
+	}
+	badstg("mkaddr", p->vstg);
+	/* NOT REACHED */ return 0;
+}
+
+
+
+
+/* mkarg -- create storage for a new parameter.  This is called when a
+   function returns a string (for the return value, which is the first
+   parameter), or when a variable-length string is passed to a function. */
+
+ Addrp
+#ifdef KR_headers
+mkarg(type, argno)
+	int type;
+	int argno;
+#else
+mkarg(int type, int argno)
+#endif
+{
+	Addrp p;
+
+	p = ALLOC(Addrblock);
+	p->tag = TADDR;
+	p->vtype = type;
+	p->vclass = CLVAR;
+
+/* TYLENG is the type of the field holding the length of a character string */
+
+	p->vstg = (type==TYLENG ? STGLENG : STGARG);
+	p->memno = argno;
+	return(p);
+}
+
+
+
+
+/* mkprim -- Create a PRIM (primary/primitive) block consisting of a
+   Nameblock (or Paramblock), arguments (actual params or array
+   subscripts) and substring bounds.  Requires that   v   have lots of
+   extra (uninitialized) storage, since it could be a paramblock or
+   nameblock */
+
+ expptr
+#ifdef KR_headers
+mkprim(v0, args, substr)
+	Namep v0;
+	struct Listblock *args;
+	chainp substr;
+#else
+mkprim(Namep v0, struct Listblock *args, chainp substr)
+#endif
+{
+	typedef union {
+		struct Paramblock paramblock;
+		struct Nameblock nameblock;
+		struct Headblock headblock;
+		} *Primu;
+	Primu v = (Primu)v0;
+	struct Primblock *p;
+
+	if(v->headblock.vclass == CLPARAM)
+	{
+
+/* v   is to be a Paramblock */
+
+		if(args || substr)
+		{
+			errstr("no qualifiers on parameter name %s",
+			    v->paramblock.fvarname);
+			frexpr((expptr)args);
+			if(substr)
+			{
+				frexpr((tagptr)substr->datap);
+				frexpr((tagptr)substr->nextp->datap);
+				frchain(&substr);
+			}
+			frexpr((expptr)v);
+			return( errnode() );
+		}
+		return( (expptr) cpexpr(v->paramblock.paramval) );
+	}
+
+	p = ALLOC(Primblock);
+	p->tag = TPRIM;
+	p->vtype = v->nameblock.vtype;
+
+/* v   is to be a Nameblock */
+
+	p->namep = (Namep) v;
+	p->argsp = args;
+	if(substr)
+	{
+		p->fcharp = (expptr) substr->datap;
+		p->lcharp = (expptr) substr->nextp->datap;
+		frchain(&substr);
+	}
+	return( (expptr) p);
+}
+
+
+
+/* vardcl -- attempt to fill out the Name template for variable   v.
+   This function is called on identifiers known to be variables or
+   recursive references to the same function */
+
+ void
+#ifdef KR_headers
+vardcl(v)
+	Namep v;
+#else
+vardcl(Namep v)
+#endif
+{
+	struct Dimblock *t;
+	expptr neltp;
+	extern int doing_stmtfcn;
+
+	if(v->vclass == CLUNKNOWN) {
+		v->vclass = CLVAR;
+		if (v->vinftype) {
+			v->vtype = TYUNKNOWN;
+			if (v->vdcldone) {
+				v->vdcldone = 0;
+				impldcl(v);
+				}
+			}
+		}
+	if(v->vdcldone)
+		return;
+	if(v->vclass == CLNAMELIST)
+		return;
+
+	if(v->vtype == TYUNKNOWN)
+		impldcl(v);
+	else if(v->vclass!=CLVAR && v->vprocclass!=PTHISPROC)
+	{
+		dclerr("used as variable", v);
+		return;
+	}
+	if(v->vstg==STGUNKNOWN) {
+		if (doing_stmtfcn) {
+			/* neither declare this variable if its only use */
+			/* is in defining a stmt function, nor complain  */
+			/* that it is never used */
+			v->vimpldovar = 1;
+			return;
+			}
+		v->vstg = implstg[ letter(v->fvarname[0]) ];
+		v->vimplstg = 1;
+		}
+
+/* Compute the actual storage location, i.e. offsets from base addresses,
+   possibly the stack pointer */
+
+	switch(v->vstg)
+	{
+	case STGBSS:
+		v->vardesc.varno = ++lastvarno;
+		break;
+	case STGAUTO:
+		if(v->vclass==CLPROC && v->vprocclass==PTHISPROC)
+			break;
+		if(t = v->vdim)
+			if( (neltp = t->nelt) && ISCONST(neltp) ) ;
+			else
+				dclerr("adjustable automatic array", v);
+		break;
+
+	default:
+		break;
+	}
+	v->vdcldone = YES;
+}
+
+
+
+/* Set the implicit type declaration of parameter   p   based on its first
+   letter */
+
+ void
+#ifdef KR_headers
+impldcl(p)
+	Namep p;
+#else
+impldcl(Namep p)
+#endif
+{
+	int k;
+	int type;
+	ftnint leng;
+
+	if(p->vdcldone || (p->vclass==CLPROC && p->vprocclass==PINTRINSIC) )
+		return;
+	if(p->vtype == TYUNKNOWN)
+	{
+		k = letter(p->fvarname[0]);
+		type = impltype[ k ];
+		leng = implleng[ k ];
+		if(type == TYUNKNOWN)
+		{
+			if(p->vclass == CLPROC)
+				return;
+			dclerr("attempt to use undefined variable", p);
+			type = dflttype[k];
+			leng = 0;
+		}
+		settype(p, type, leng);
+		p->vimpltype = 1;
+	}
+}
+
+ void
+#ifdef KR_headers
+inferdcl(np, type)
+	Namep np;
+	int type;
+#else
+inferdcl(Namep np, int type)
+#endif
+{
+	int k = impltype[letter(np->fvarname[0])];
+	if (k != type) {
+		np->vinftype = 1;
+		np->vtype = type;
+		frexpr(np->vleng);
+		np->vleng = 0;
+		}
+	np->vimpltype = 0;
+	np->vinfproc = 1;
+	}
+
+ LOCAL int
+#ifdef KR_headers
+zeroconst(e)
+	expptr e;
+#else
+zeroconst(expptr e)
+#endif
+{
+	Constp c = (Constp) e;
+	if (c->tag == TCONST)
+		switch(c->vtype) {
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifdef TYQUAD0
+		case TYQUAD:
+#endif
+			return c->Const.ci == 0;
+#ifndef NO_LONG_LONG
+		case TYQUAD:
+			return c->Const.cq == 0;
+#endif
+
+		case TYREAL:
+		case TYDREAL:
+			if (c->vstg == 1)
+				return !strcmp(c->Const.cds[0],"0.");
+			return c->Const.cd[0] == 0.;
+
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			if (c->vstg == 1)
+				return !strcmp(c->Const.cds[0],"0.")
+				    && !strcmp(c->Const.cds[1],"0.");
+			return c->Const.cd[0] == 0. && c->Const.cd[1] == 0.;
+		}
+	return 0;
+	}
+
+ void
+#ifdef KR_headers
+paren_used(p) struct Primblock *p;
+#else
+paren_used(struct Primblock *p)
+#endif
+{
+	Namep np;
+
+	p->parenused = 1;
+	if (!p->argsp && (np = p->namep) && np->vdim)
+		warn1("inappropriate operation on unsubscripted array %.50s",
+			np->fvarname);
+	}
+
+#define ICONEQ(z, c)  (ISICON(z) && z->constblock.Const.ci==c)
+#define COMMUTE	{ e = lp;  lp = rp;  rp = e; }
+
+/* mkexpr -- Make expression, and simplify constant subcomponents (tree
+   order is not preserved).  Assumes that   lp   is nonempty, and uses
+   fold()   to simplify adjacent constants */
+
+ expptr
+#ifdef KR_headers
+mkexpr(opcode, lp, rp)
+	int opcode;
+	expptr lp;
+	expptr rp;
+#else
+mkexpr(int opcode, expptr lp, expptr rp)
+#endif
+{
+	expptr e, e1;
+	int etype;
+	int ltype, rtype;
+	int ltag, rtag;
+	long L;
+	static long divlineno;
+
+	if (parstate < INEXEC) {
+
+		/* Song and dance to get statement functions right */
+		/* while catching incorrect type combinations in the */
+		/* first executable statement. */
+
+		ltype = lp->headblock.vtype;
+		ltag = lp->tag;
+		if(rp && opcode!=OPCALL && opcode!=OPCCALL)
+		{
+			rtype = rp->headblock.vtype;
+			rtag = rp->tag;
+		}
+		else rtype = 0;
+
+		etype = cktype(opcode, ltype, rtype);
+		if(etype == TYERROR)
+			goto error;
+		goto no_fold;
+		}
+
+	ltype = lp->headblock.vtype;
+	if (ltype == TYUNKNOWN) {
+		lp = fixtype(lp);
+		ltype = lp->headblock.vtype;
+		}
+	ltag = lp->tag;
+	if(rp && opcode!=OPCALL && opcode!=OPCCALL)
+	{
+		rtype = rp->headblock.vtype;
+		if (rtype == TYUNKNOWN) {
+			rp = fixtype(rp);
+			rtype = rp->headblock.vtype;
+			}
+		rtag = rp->tag;
+	}
+	else rtype = 0;
+
+	etype = cktype(opcode, ltype, rtype);
+	if(etype == TYERROR)
+		goto error;
+
+	switch(opcode)
+	{
+		/* check for multiplication by 0 and 1 and addition to 0 */
+
+	case OPSTAR:
+		if( ISCONST(lp) )
+			COMMUTE
+
+		if( ISICON(rp) )
+			{
+				if(rp->constblock.Const.ci == 0)
+					goto retright;
+				goto mulop;
+			}
+		break;
+
+	case OPSLASH:
+	case OPMOD:
+		if( zeroconst(rp) && lineno != divlineno ) {
+			warn("attempted division by zero");
+			divlineno = lineno;
+			}
+		if(opcode == OPMOD)
+			break;
+
+/* Handle multiplying or dividing by 1, -1 */
+
+mulop:
+		if( ISICON(rp) )
+		{
+			if(rp->constblock.Const.ci == 1)
+				goto retleft;
+
+			if(rp->constblock.Const.ci == -1)
+			{
+				frexpr(rp);
+				return( mkexpr(OPNEG, lp, ENULL) );
+			}
+		}
+
+/* Group all constants together.  In particular,
+
+	(x * CONST1) * CONST2 ==> x * (CONST1 * CONST2)
+	(x * CONST1) / CONST2 ==> x * (CONST1 / CONST2)
+*/
+
+		if (!ISINT(etype) || lp->tag != TEXPR || !lp->exprblock.rightp
+				|| !ISICON(lp->exprblock.rightp))
+			break;
+
+		if (lp->exprblock.opcode == OPLSHIFT) {
+			L = 1 << lp->exprblock.rightp->constblock.Const.ci;
+			if (opcode == OPSTAR || ISICON(rp) &&
+					!(L % rp->constblock.Const.ci)) {
+				lp->exprblock.opcode = OPSTAR;
+				lp->exprblock.rightp->constblock.Const.ci = L;
+				}
+			}
+
+		if (lp->exprblock.opcode == OPSTAR) {
+			if(opcode == OPSTAR)
+				e = mkexpr(OPSTAR, lp->exprblock.rightp, rp);
+			else if(ISICON(rp) &&
+			    (lp->exprblock.rightp->constblock.Const.ci %
+			    rp->constblock.Const.ci) == 0)
+				e = mkexpr(OPSLASH, lp->exprblock.rightp, rp);
+			else	break;
+
+			e1 = lp->exprblock.leftp;
+			free( (charptr) lp );
+			return( mkexpr(OPSTAR, e1, e) );
+			}
+		break;
+
+
+	case OPPLUS:
+		if( ISCONST(lp) )
+			COMMUTE
+			    goto addop;
+
+	case OPMINUS:
+		if( ICONEQ(lp, 0) )
+		{
+			frexpr(lp);
+			return( mkexpr(OPNEG, rp, ENULL) );
+		}
+
+		if( ISCONST(rp) && is_negatable((Constp)rp))
+		{
+			opcode = OPPLUS;
+			consnegop((Constp)rp);
+		}
+
+/* Group constants in an addition expression (also subtraction, since the
+   subtracted value was negated above).  In particular,
+
+	(x + CONST1) + CONST2 ==> x + (CONST1 + CONST2)
+*/
+
+addop:
+		if( ISICON(rp) )
+		{
+			if(rp->constblock.Const.ci == 0)
+				goto retleft;
+			if( ISPLUSOP(lp) && ISICON(lp->exprblock.rightp) )
+			{
+				e = mkexpr(OPPLUS, lp->exprblock.rightp, rp);
+				e1 = lp->exprblock.leftp;
+				free( (charptr) lp );
+				return( mkexpr(OPPLUS, e1, e) );
+			}
+		}
+		if (opcode == OPMINUS && (ISINT(etype) || doing_vleng)) {
+			/* check for (i [+const]) - (i [+const]) */
+			if (lp->tag == TPRIM)
+				e = lp;
+			else if (lp->tag == TEXPR && lp->exprblock.opcode == OPPLUS
+					&& lp->exprblock.rightp->tag == TCONST) {
+				e = lp->exprblock.leftp;
+				if (e->tag != TPRIM)
+					break;
+				}
+			else
+				break;
+			if (e->primblock.argsp)
+				break;
+			if (rp->tag == TPRIM)
+				e1 = rp;
+			else if (rp->tag == TEXPR && rp->exprblock.opcode == OPPLUS
+					&& rp->exprblock.rightp->tag == TCONST) {
+				e1 = rp->exprblock.leftp;
+				if (e1->tag != TPRIM)
+					break;
+				}
+			else
+				break;
+			if (e->primblock.namep != e1->primblock.namep
+					|| e1->primblock.argsp)
+				break;
+			L = e == lp ? 0 : lp->exprblock.rightp->constblock.Const.ci;
+			if (e1 != rp)
+				L -= rp->exprblock.rightp->constblock.Const.ci;
+			frexpr(lp);
+			frexpr(rp);
+			return ICON(L);
+			}
+
+		break;
+
+
+	case OPPOWER:
+		break;
+
+/* Eliminate outermost double negations */
+
+	case OPNEG:
+	case OPNEG1:
+		if(ltag==TEXPR && lp->exprblock.opcode==OPNEG)
+		{
+			e = lp->exprblock.leftp;
+			free( (charptr) lp );
+			return(e);
+		}
+		break;
+
+/* Eliminate outermost double NOTs */
+
+	case OPNOT:
+		if(ltag==TEXPR && lp->exprblock.opcode==OPNOT)
+		{
+			e = lp->exprblock.leftp;
+			free( (charptr) lp );
+			return(e);
+		}
+		break;
+
+	case OPCALL:
+	case OPCCALL:
+		etype = ltype;
+		if(rp!=NULL && rp->listblock.listp==NULL)
+		{
+			free( (charptr) rp );
+			rp = NULL;
+		}
+		break;
+
+	case OPAND:
+	case OPOR:
+		if( ISCONST(lp) )
+			COMMUTE
+
+			    if( ISCONST(rp) )
+			{
+				if(rp->constblock.Const.ci == 0)
+					if(opcode == OPOR)
+						goto retleft;
+					else
+						goto retright;
+				else if(opcode == OPOR)
+					goto retright;
+				else
+					goto retleft;
+			}
+	case OPEQV:
+	case OPNEQV:
+
+	case OPBITAND:
+	case OPBITOR:
+	case OPBITXOR:
+	case OPBITNOT:
+	case OPLSHIFT:
+	case OPRSHIFT:
+	case OPBITTEST:
+	case OPBITCLR:
+	case OPBITSET:
+#ifdef TYQUAD
+	case OPQBITCLR:
+	case OPQBITSET:
+#endif
+
+	case OPLT:
+	case OPGT:
+	case OPLE:
+	case OPGE:
+	case OPEQ:
+	case OPNE:
+
+	case OPCONCAT:
+		break;
+	case OPMIN:
+	case OPMAX:
+	case OPMIN2:
+	case OPMAX2:
+	case OPDMIN:
+	case OPDMAX:
+
+	case OPASSIGN:
+	case OPASSIGNI:
+	case OPPLUSEQ:
+	case OPSTAREQ:
+	case OPMINUSEQ:
+	case OPSLASHEQ:
+	case OPMODEQ:
+	case OPLSHIFTEQ:
+	case OPRSHIFTEQ:
+	case OPBITANDEQ:
+	case OPBITXOREQ:
+	case OPBITOREQ:
+
+	case OPCONV:
+	case OPADDR:
+	case OPWHATSIN:
+
+	case OPCOMMA:
+	case OPCOMMA_ARG:
+	case OPQUEST:
+	case OPCOLON:
+	case OPDOT:
+	case OPARROW:
+	case OPIDENTITY:
+	case OPCHARCAST:
+	case OPABS:
+	case OPDABS:
+		break;
+
+	default:
+		badop("mkexpr", opcode);
+	}
+
+ no_fold:
+	e = (expptr) ALLOC(Exprblock);
+	e->exprblock.tag = TEXPR;
+	e->exprblock.opcode = opcode;
+	e->exprblock.vtype = etype;
+	e->exprblock.leftp = lp;
+	e->exprblock.rightp = rp;
+	if(ltag==TCONST && (rp==0 || rtag==TCONST) )
+		e = fold(e);
+	return(e);
+
+retleft:
+	frexpr(rp);
+	if (lp->tag == TPRIM)
+		paren_used(&lp->primblock);
+	return(lp);
+
+retright:
+	frexpr(lp);
+	if (rp->tag == TPRIM)
+		paren_used(&rp->primblock);
+	return(rp);
+
+error:
+	frexpr(lp);
+	if(rp && opcode!=OPCALL && opcode!=OPCCALL)
+		frexpr(rp);
+	return( errnode() );
+}
+
+#define ERR(s)   { errs = s; goto error; }
+
+/* cktype -- Check and return the type of the expression */
+
+ int
+#ifdef KR_headers
+cktype(op, lt, rt)
+	int op;
+	int lt;
+	int rt;
+#else
+cktype(int op, int lt, int rt)
+#endif
+{
+	char *errs;
+
+	if(lt==TYERROR || rt==TYERROR)
+		goto error1;
+
+	if(lt==TYUNKNOWN)
+		return(TYUNKNOWN);
+	if(rt==TYUNKNOWN)
+
+/* If not unary operation, return UNKNOWN */
+
+		if(!is_unary_op (op) && op != OPCALL && op != OPCCALL)
+			return(TYUNKNOWN);
+
+	switch(op)
+	{
+	case OPPLUS:
+	case OPMINUS:
+	case OPSTAR:
+	case OPSLASH:
+	case OPPOWER:
+	case OPMOD:
+		if( ISNUMERIC(lt) && ISNUMERIC(rt) )
+			return( maxtype(lt, rt) );
+		ERR("nonarithmetic operand of arithmetic operator")
+
+	case OPNEG:
+	case OPNEG1:
+		if( ISNUMERIC(lt) )
+			return(lt);
+		ERR("nonarithmetic operand of negation")
+
+	case OPNOT:
+		if(ISLOGICAL(lt))
+			return(lt);
+		ERR("NOT of nonlogical")
+
+	case OPAND:
+	case OPOR:
+	case OPEQV:
+	case OPNEQV:
+		if(ISLOGICAL(lt) && ISLOGICAL(rt))
+			return( maxtype(lt, rt) );
+		ERR("nonlogical operand of logical operator")
+
+	case OPLT:
+	case OPGT:
+	case OPLE:
+	case OPGE:
+	case OPEQ:
+	case OPNE:
+		if(lt==TYCHAR || rt==TYCHAR || ISLOGICAL(lt) || ISLOGICAL(rt))
+		{
+			if(lt != rt){
+				if (htype
+					&& (lt == TYCHAR && ISNUMERIC(rt)
+					 || rt == TYCHAR && ISNUMERIC(lt)))
+						return TYLOGICAL;
+				ERR("illegal comparison")
+				}
+		}
+
+		else if( ISCOMPLEX(lt) || ISCOMPLEX(rt) )
+		{
+			if(op!=OPEQ && op!=OPNE)
+				ERR("order comparison of complex data")
+		}
+
+		else if( ! ISNUMERIC(lt) || ! ISNUMERIC(rt) )
+			ERR("comparison of nonarithmetic data")
+	case OPBITTEST:
+		return(TYLOGICAL);
+
+	case OPCONCAT:
+		if(lt==TYCHAR && rt==TYCHAR)
+			return(TYCHAR);
+		ERR("concatenation of nonchar data")
+
+	case OPCALL:
+	case OPCCALL:
+	case OPIDENTITY:
+		return(lt);
+
+	case OPADDR:
+	case OPCHARCAST:
+		return(TYADDR);
+
+	case OPCONV:
+		if(rt == 0)
+			return(0);
+		if(lt==TYCHAR && ISINT(rt) )
+			return(TYCHAR);
+		if (ISLOGICAL(lt) && ISLOGICAL(rt)
+		||  ISINT(lt) && rt == TYCHAR)
+			return lt;
+	case OPASSIGN:
+	case OPASSIGNI:
+	case OPMINUSEQ:
+	case OPPLUSEQ:
+	case OPSTAREQ:
+	case OPSLASHEQ:
+	case OPMODEQ:
+	case OPLSHIFTEQ:
+	case OPRSHIFTEQ:
+	case OPBITANDEQ:
+	case OPBITXOREQ:
+	case OPBITOREQ:
+		if (ISLOGICAL(lt) && ISLOGICAL(rt) && op == OPASSIGN)
+			return lt;
+		if(lt==TYCHAR || rt==TYCHAR || ISLOGICAL(lt) || ISLOGICAL(rt))
+			if((op!=OPASSIGN && op != OPPLUSEQ && op != OPMINUSEQ)
+			    || (lt!=rt))
+			{
+				ERR("impossible conversion")
+			}
+		return(lt);
+
+	case OPMIN:
+	case OPMAX:
+	case OPDMIN:
+	case OPDMAX:
+	case OPMIN2:
+	case OPMAX2:
+	case OPBITOR:
+	case OPBITAND:
+	case OPBITXOR:
+	case OPBITNOT:
+	case OPLSHIFT:
+	case OPRSHIFT:
+	case OPWHATSIN:
+	case OPABS:
+	case OPDABS:
+		return(lt);
+
+	case OPBITCLR:
+	case OPBITSET:
+#ifdef TYQUAD0
+	case OPQBITCLR:
+	case OPQBITSET:
+#endif
+		if (lt < TYLONG)
+			lt = TYLONG;
+		return(lt);
+#ifndef NO_LONG_LONG
+	case OPQBITCLR:
+	case OPQBITSET:
+		return TYQUAD;
+#endif
+
+	case OPCOMMA:
+	case OPCOMMA_ARG:
+	case OPQUEST:
+	case OPCOLON:		/* Only checks the rightmost type because
+				   of C language definition (rightmost
+				   comma-expr is the value of the expr) */
+		return(rt);
+
+	case OPDOT:
+	case OPARROW:
+	    return (lt);
+	default:
+		badop("cktype", op);
+	}
+error:
+	err(errs);
+error1:
+	return(TYERROR);
+}
+
+ static void
+intovfl(Void)
+{ err("overflow simplifying integer constants."); }
+
+#ifndef NO_LONG_LONG
+ static void
+#ifdef KR_headers
+LRget(Lp, Rp, lp, rp) Llong *Lp, *Rp; expptr lp, rp;
+#else
+LRget(Llong *Lp, Llong *Rp, expptr lp, expptr rp)
+#endif
+{
+	if (lp->headblock.vtype == TYQUAD)
+		*Lp = lp->constblock.Const.cq;
+	else
+		*Lp = lp->constblock.Const.ci;
+	if (rp->headblock.vtype == TYQUAD)
+		*Rp = rp->constblock.Const.cq;
+	else
+		*Rp = rp->constblock.Const.ci;
+	}
+#endif /*NO_LONG_LONG*/
+
+/* fold -- simplifies constant expressions; it assumes that e -> leftp and
+   e -> rightp are TCONST or NULL */
+
+ expptr
+#ifdef KR_headers
+fold(e)
+	expptr e;
+#else
+fold(expptr e)
+#endif
+{
+	Constp p;
+	expptr lp, rp;
+	int etype, mtype, ltype, rtype, opcode;
+	ftnint i, bl, ll, lr;
+	char *q, *s;
+	struct Constblock lcon, rcon;
+	ftnint L;
+	double d;
+#ifndef NO_LONG_LONG
+	Llong LL, LR;
+#endif
+
+	opcode = e->exprblock.opcode;
+	etype = e->exprblock.vtype;
+
+	lp = e->exprblock.leftp;
+	ltype = lp->headblock.vtype;
+	rp = e->exprblock.rightp;
+
+	if(rp == 0)
+		switch(opcode)
+		{
+		case OPNOT:
+#ifndef NO_LONG_LONG
+			if (ltype == TYQUAD)
+			 lp->constblock.Const.cq = ! lp->constblock.Const.cq;
+			else
+#endif
+			 lp->constblock.Const.ci = ! lp->constblock.Const.ci;
+ retlp:
+			e->exprblock.leftp = 0;
+			frexpr(e);
+			return(lp);
+
+		case OPBITNOT:
+#ifndef NO_LONG_LONG
+			if (ltype == TYQUAD)
+			 lp->constblock.Const.cq = ~ lp->constblock.Const.cq;
+			else
+#endif
+			lp->constblock.Const.ci = ~ lp->constblock.Const.ci;
+			goto retlp;
+
+		case OPNEG:
+		case OPNEG1:
+			consnegop((Constp)lp);
+			goto retlp;
+
+		case OPCONV:
+		case OPADDR:
+			return(e);
+
+		case OPABS:
+		case OPDABS:
+			switch(ltype) {
+			    case TYINT1:
+			    case TYSHORT:
+			    case TYLONG:
+				if ((L = lp->constblock.Const.ci) < 0) {
+					lp->constblock.Const.ci = -L;
+					if (L != -lp->constblock.Const.ci)
+						intovfl();
+					}
+				goto retlp;
+#ifndef NO_LONG_LONG
+			    case TYQUAD:
+				if ((LL = lp->constblock.Const.cq) < 0) {
+					lp->constblock.Const.cq = -LL;
+					if (LL != -lp->constblock.Const.cq)
+						intovfl();
+					}
+				goto retlp;
+#endif
+			    case TYREAL:
+			    case TYDREAL:
+				if (lp->constblock.vstg) {
+				    s = lp->constblock.Const.cds[0];
+				    if (*s == '-')
+					lp->constblock.Const.cds[0] = s + 1;
+				    goto retlp;
+				}
+				if ((d = lp->constblock.Const.cd[0]) < 0.)
+					lp->constblock.Const.cd[0] = -d;
+			    case TYCOMPLEX:
+			    case TYDCOMPLEX:
+				return e;	/* lazy way out */
+			    }
+		default:
+			badop("fold", opcode);
+		}
+
+	rtype = rp->headblock.vtype;
+
+	p = ALLOC(Constblock);
+	p->tag = TCONST;
+	p->vtype = etype;
+	p->vleng = e->exprblock.vleng;
+
+	switch(opcode)
+	{
+	case OPCOMMA:
+	case OPCOMMA_ARG:
+	case OPQUEST:
+	case OPCOLON:
+		goto ereturn;
+
+	case OPAND:
+		p->Const.ci = lp->constblock.Const.ci &&
+		    rp->constblock.Const.ci;
+		break;
+
+	case OPOR:
+		p->Const.ci = lp->constblock.Const.ci ||
+		    rp->constblock.Const.ci;
+		break;
+
+	case OPEQV:
+		p->Const.ci = lp->constblock.Const.ci ==
+		    rp->constblock.Const.ci;
+		break;
+
+	case OPNEQV:
+		p->Const.ci = lp->constblock.Const.ci !=
+		    rp->constblock.Const.ci;
+		break;
+
+	case OPBITAND:
+#ifndef NO_LONG_LONG
+		if (etype == TYQUAD) {
+			LRget(&LL, &LR, lp, rp);
+			p->Const.cq = LL & LR;
+			}
+		else
+#endif
+		p->Const.ci = lp->constblock.Const.ci &
+		    rp->constblock.Const.ci;
+		break;
+
+	case OPBITOR:
+#ifndef NO_LONG_LONG
+		if (etype == TYQUAD) {
+			LRget(&LL, &LR, lp, rp);
+			p->Const.cq = LL | LR;
+			}
+		else
+#endif
+		p->Const.ci = lp->constblock.Const.ci |
+		    rp->constblock.Const.ci;
+		break;
+
+	case OPBITXOR:
+#ifndef NO_LONG_LONG
+		if (etype == TYQUAD) {
+			LRget(&LL, &LR, lp, rp);
+			p->Const.cq = LL ^ LR;
+			}
+		else
+#endif
+		p->Const.ci = lp->constblock.Const.ci ^
+		    rp->constblock.Const.ci;
+		break;
+
+	case OPLSHIFT:
+#ifndef NO_LONG_LONG
+		if (etype == TYQUAD) {
+			LRget(&LL, &LR, lp, rp);
+			p->Const.cq = LL << (int)LR;
+			if (p->Const.cq >> (int)LR != LL)
+				intovfl();
+			break;
+			}
+#endif
+		p->Const.ci = lp->constblock.Const.ci <<
+		    rp->constblock.Const.ci;
+		if ((((unsigned long)p->Const.ci) >> rp->constblock.Const.ci)
+				!= lp->constblock.Const.ci)
+			intovfl();
+		break;
+
+	case OPRSHIFT:
+#ifndef NO_LONG_LONG
+		if (etype == TYQUAD) {
+			LRget(&LL, &LR, lp, rp);
+			p->Const.cq = LL >> (int)LR;
+			}
+		else
+#endif
+		p->Const.ci = (unsigned long)lp->constblock.Const.ci >>
+		    rp->constblock.Const.ci;
+		break;
+
+	case OPBITTEST:
+#ifndef NO_LONG_LONG
+		if (ltype == TYQUAD)
+			p->Const.ci = (lp->constblock.Const.cq &
+				1LL << rp->constblock.Const.ci) != 0;
+		else
+#endif
+		p->Const.ci = (lp->constblock.Const.ci &
+				1L << rp->constblock.Const.ci) != 0;
+		break;
+
+	case OPBITCLR:
+#ifndef NO_LONG_LONG
+		if (etype == TYQUAD) {
+			LRget(&LL, &LR, lp, rp);
+			p->Const.cq = LL & ~(1LL << (int)LR);
+			}
+		else
+#endif
+		p->Const.ci = lp->constblock.Const.ci &
+				~(1L << rp->constblock.Const.ci);
+		break;
+
+	case OPBITSET:
+#ifndef NO_LONG_LONG
+		if (etype == TYQUAD) {
+			LRget(&LL, &LR, lp, rp);
+			p->Const.cq = LL | (1LL << (int)LR);
+			}
+		else
+#endif
+		p->Const.ci = lp->constblock.Const.ci |
+				1L << rp->constblock.Const.ci;
+		break;
+
+	case OPCONCAT:
+		ll = lp->constblock.vleng->constblock.Const.ci;
+		lr = rp->constblock.vleng->constblock.Const.ci;
+		bl = lp->constblock.Const.ccp1.blanks;
+		p->Const.ccp = q = (char *) ckalloc(ll+lr+bl);
+		p->Const.ccp1.blanks = rp->constblock.Const.ccp1.blanks;
+		p->vleng = ICON(ll+lr+bl);
+		s = lp->constblock.Const.ccp;
+		for(i = 0 ; i < ll ; ++i)
+			*q++ = *s++;
+		for(i = 0 ; i < bl ; i++)
+			*q++ = ' ';
+		s = rp->constblock.Const.ccp;
+		for(i = 0; i < lr; ++i)
+			*q++ = *s++;
+		break;
+
+
+	case OPPOWER:
+		if( !ISINT(rtype)
+		 || rp->constblock.Const.ci < 0 && zeroconst(lp))
+			goto ereturn;
+		conspower(p, (Constp)lp, rp->constblock.Const.ci);
+		break;
+
+	case OPSLASH:
+		if (zeroconst(rp))
+			goto ereturn;
+		/* no break */
+
+	default:
+		if(ltype == TYCHAR)
+		{
+			lcon.Const.ci = cmpstr(lp->constblock.Const.ccp,
+			    rp->constblock.Const.ccp,
+			    lp->constblock.vleng->constblock.Const.ci,
+			    rp->constblock.vleng->constblock.Const.ci);
+			rcon.Const.ci = 0;
+			mtype = tyint;
+		}
+		else	{
+			mtype = maxtype(ltype, rtype);
+			consconv(mtype, &lcon, &lp->constblock);
+			consconv(mtype, &rcon, &rp->constblock);
+		}
+		consbinop(opcode, mtype, p, &lcon, &rcon);
+		break;
+	}
+
+	frexpr(e);
+	return( (expptr) p );
+ ereturn:
+	free((char *)p);
+	return e;
+}
+
+
+
+/* assign constant l = r , doing coercion */
+
+ void
+#ifdef KR_headers
+consconv(lt, lc, rc)
+	int lt;
+	Constp lc;
+	Constp rc;
+#else
+consconv(int lt, Constp lc, Constp rc)
+#endif
+{
+	int rt = rc->vtype;
+	union Constant *lv = &lc->Const, *rv = &rc->Const;
+
+	lc->vtype = lt;
+	if (ONEOF(lt, MSKREAL|MSKCOMPLEX) && ONEOF(rt, MSKREAL|MSKCOMPLEX)) {
+		memcpy((char *)lv, (char *)rv, sizeof(union Constant));
+		lc->vstg = rc->vstg;
+		if (ISCOMPLEX(lt) && ISREAL(rt)) {
+			if (rc->vstg)
+				lv->cds[1] = cds("0",CNULL);
+			else
+				lv->cd[1] = 0.;
+			}
+		return;
+		}
+	lc->vstg = 0;
+
+	switch(lt)
+	{
+
+/* Casting to character means just copying the first sizeof (character)
+   bytes into a new 1 character string.  This is weird. */
+
+	case TYCHAR:
+		*(lv->ccp = (char *) ckalloc(1)) = (char)rv->ci;
+		lv->ccp1.blanks = 0;
+		break;
+
+	case TYINT1:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+		if(rt == TYCHAR)
+			lv->ci = rv->ccp[0];
+		else if( ISINT(rt) ) {
+#ifndef NO_LONG_LONG
+			if (rt == TYQUAD)
+				lv->ci = rv->cq;
+			else
+#endif
+			lv->ci = rv->ci;
+			}
+		else	lv->ci = (ftnint)(rc->vstg
+					? atof(rv->cds[0]) : rv->cd[0]);
+
+		break;
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		if(rt == TYCHAR)
+			lv->cq = rv->ccp[0];
+		else if( ISINT(rt) ) {
+			if (rt == TYQUAD)
+				lv->cq = rv->cq;
+			else
+				lv->cq = rv->ci;
+			}
+		else	lv->cq = (ftnint)(rc->vstg
+					? atof(rv->cds[0]) : rv->cd[0]);
+
+		break;
+#endif
+
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		lv->cd[1] = 0.;
+
+	case TYREAL:
+	case TYDREAL:
+#ifndef NO_LONG_LONG
+		if (rt == TYQUAD)
+			lv->cd[0] = rv->cq;
+		else
+#endif
+		lv->cd[0] = rv->ci;
+		break;
+
+	case TYLOGICAL:
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+		lv->ci = rv->ci;
+		break;
+	}
+}
+
+
+
+/* Negate constant value -- changes the input node's value */
+
+ void
+#ifdef KR_headers
+consnegop(p)
+	Constp p;
+#else
+consnegop(Constp p)
+#endif
+{
+	char *s;
+	ftnint L;
+#ifndef NO_LONG_LONG
+	Llong LL;
+#endif
+
+	if (p->vstg) {
+		/* 20010820: comment out "*s == '0' ? s :" to preserve */
+		/* the sign of zero */
+		if (ISCOMPLEX(p->vtype)) {
+			s = p->Const.cds[1];
+			p->Const.cds[1] = *s == '-' ? s+1
+					: /* *s == '0' ? s : */ s-1;
+			}
+		s = p->Const.cds[0];
+		p->Const.cds[0] = *s == '-' ? s+1
+				: /* *s == '0' ? s : */ s-1;
+		return;
+		}
+	switch(p->vtype)
+	{
+	case TYINT1:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+		p->Const.ci = -(L = p->Const.ci);
+		if (L != -p->Const.ci)
+			intovfl();
+		break;
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		p->Const.cq = -(LL = p->Const.cq);
+		if (LL != -p->Const.cq)
+			intovfl();
+		break;
+#endif
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		p->Const.cd[1] = - p->Const.cd[1];
+		/* fall through and do the real parts */
+	case TYREAL:
+	case TYDREAL:
+		p->Const.cd[0] = - p->Const.cd[0];
+		break;
+	default:
+		badtype("consnegop", p->vtype);
+	}
+}
+
+
+
+/* conspower -- Expand out an exponentiation */
+
+ LOCAL void
+#ifdef KR_headers
+conspower(p, ap, n)
+	Constp p;
+	Constp ap;
+	ftnint n;
+#else
+conspower(Constp p, Constp ap, ftnint n)
+#endif
+{
+	union Constant *powp = &p->Const;
+	int type;
+	struct Constblock x, x0;
+
+	if (n == 1) {
+		memcpy((char *)powp, (char *)&ap->Const, sizeof(ap->Const));
+		return;
+		}
+
+	switch(type = ap->vtype)	/* pow = 1 */
+	{
+	case TYINT1:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+		powp->ci = 1;
+		break;
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		powp->cq = 1;
+		break;
+#endif
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		powp->cd[1] = 0;
+	case TYREAL:
+	case TYDREAL:
+		powp->cd[0] = 1;
+		break;
+	default:
+		badtype("conspower", type);
+	}
+
+	if(n == 0)
+		return;
+	switch(type)	/* x0 = ap */
+	{
+	case TYINT1:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+		x0.Const.ci = ap->Const.ci;
+		break;
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		x0.Const.cq = ap->Const.cq;
+		break;
+#endif
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		x0.Const.cd[1] =
+			ap->vstg ? atof(ap->Const.cds[1]) : ap->Const.cd[1];
+	case TYREAL:
+	case TYDREAL:
+		x0.Const.cd[0] =
+			ap->vstg ? atof(ap->Const.cds[0]) : ap->Const.cd[0];
+		break;
+	}
+	x0.vtype = type;
+	x0.vstg = 0;
+	if(n < 0)
+	{
+		n = -n;
+		if( ISINT(type) )
+		{
+			switch(ap->Const.ci) {
+				case 0:
+					err("0 ** negative number");
+					return;
+				case 1:
+				case -1:
+					goto mult;
+				}
+			err("integer ** negative number");
+			return;
+		}
+		else if (!x0.Const.cd[0]
+				&& (!ISCOMPLEX(type) || !x0.Const.cd[1])) {
+			err("0.0 ** negative number");
+			return;
+			}
+		consbinop(OPSLASH, type, &x, p, &x0);
+	}
+	else
+ mult:		consbinop(OPSTAR, type, &x, p, &x0);
+
+	for( ; ; )
+	{
+		if(n & 01)
+			consbinop(OPSTAR, type, p, p, &x);
+		if(n >>= 1)
+			consbinop(OPSTAR, type, &x, &x, &x);
+		else
+			break;
+	}
+}
+
+
+
+/* do constant operation cp = a op b -- assumes that   ap and bp   have data
+   matching the input   type */
+
+ LOCAL void
+#ifdef KR_headers
+consbinop(opcode, type, cpp, app, bpp)
+	int opcode;
+	int type;
+	Constp cpp;
+	Constp app;
+	Constp bpp;
+#else
+consbinop(int opcode, int type, Constp cpp, Constp app, Constp bpp)
+#endif
+{
+	union Constant *ap = &app->Const,
+				*bp = &bpp->Const,
+				*cp = &cpp->Const;
+	ftnint k;
+	double ad[2], bd[2], temp;
+	ftnint a, b;
+#ifndef NO_LONG_LONG
+	Llong aL, bL;
+#endif
+
+	cpp->vstg = 0;
+
+	if (ONEOF(type, MSKREAL|MSKCOMPLEX)) {
+		ad[0] = app->vstg ? atof(ap->cds[0]) : ap->cd[0];
+		bd[0] = bpp->vstg ? atof(bp->cds[0]) : bp->cd[0];
+		if (ISCOMPLEX(type)) {
+			ad[1] = app->vstg ? atof(ap->cds[1]) : ap->cd[1];
+			bd[1] = bpp->vstg ? atof(bp->cds[1]) : bp->cd[1];
+			}
+		}
+	switch(opcode)
+	{
+	case OPPLUS:
+		switch(type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifdef TYQUAD0
+		case TYQUAD:
+#endif
+			cp->ci = ap->ci + bp->ci;
+			if (ap->ci != cp->ci - bp->ci)
+				intovfl();
+			break;
+#ifndef NO_LONG_LONG
+		case TYQUAD:
+			cp->cq = ap->cq + bp->cq;
+			if (ap->cq != cp->cq - bp->cq)
+				intovfl();
+			break;
+#endif
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			cp->cd[1] = ad[1] + bd[1];
+		case TYREAL:
+		case TYDREAL:
+			cp->cd[0] = ad[0] + bd[0];
+			break;
+		}
+		break;
+
+	case OPMINUS:
+		switch(type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifdef TYQUAD0
+		case TYQUAD:
+#endif
+			cp->ci = ap->ci - bp->ci;
+			if (ap->ci != bp->ci + cp->ci)
+				intovfl();
+			break;
+#ifndef NO_LONG_LONG
+		case TYQUAD:
+			cp->cq = ap->cq - bp->cq;
+			if (ap->cq != bp->cq + cp->cq)
+				intovfl();
+			break;
+#endif
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			cp->cd[1] = ad[1] - bd[1];
+		case TYREAL:
+		case TYDREAL:
+			cp->cd[0] = ad[0] - bd[0];
+			break;
+		}
+		break;
+
+	case OPSTAR:
+		switch(type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifdef TYQUAD0
+		case TYQUAD:
+#endif
+			cp->ci = (a = ap->ci) * (b = bp->ci);
+			if (a && cp->ci / a != b)
+				intovfl();
+			break;
+#ifndef NO_LONG_LONG
+		case TYQUAD:
+			cp->cq = (aL = ap->cq) * (bL = bp->cq);
+			if (aL && cp->cq / aL != bL)
+				intovfl();
+			break;
+#endif
+		case TYREAL:
+		case TYDREAL:
+			cp->cd[0] = ad[0] * bd[0];
+			break;
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			temp = ad[0] * bd[0]  -  ad[1] * bd[1] ;
+			cp->cd[1] = ad[0] * bd[1]  +  ad[1] * bd[0] ;
+			cp->cd[0] = temp;
+			break;
+		}
+		break;
+	case OPSLASH:
+		switch(type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifdef TYQUAD0
+		case TYQUAD:
+#endif
+			cp->ci = ap->ci / bp->ci;
+			break;
+#ifndef NO_LONG_LONG
+		case TYQUAD:
+			cp->cq = ap->cq / bp->cq;
+			break;
+#endif
+		case TYREAL:
+		case TYDREAL:
+			cp->cd[0] = ad[0] / bd[0];
+			break;
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			zdiv((dcomplex*)cp, (dcomplex*)ad, (dcomplex*)bd);
+			break;
+		}
+		break;
+
+	case OPMOD:
+		if( ISINT(type) )
+		{
+#ifndef NO_LONG_LONG
+			if (type == TYQUAD)
+				cp->cq = ap->cq % bp->cq;
+			else
+#endif
+				cp->ci = ap->ci % bp->ci;
+			break;
+		}
+		else
+			Fatal("inline mod of noninteger");
+
+	case OPMIN2:
+	case OPDMIN:
+		switch(type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifdef TYQUAD0
+		case TYQUAD:
+#endif
+			cp->ci = ap->ci <= bp->ci ? ap->ci : bp->ci;
+			break;
+#ifndef NO_LONG_LONG
+		case TYQUAD:
+			cp->cq = ap->cq <= bp->cq ? ap->cq : bp->cq;
+			break;
+#endif
+		case TYREAL:
+		case TYDREAL:
+			cp->cd[0] = ad[0] <= bd[0] ? ad[0] : bd[0];
+			break;
+		default:
+			Fatal("inline min of exected type");
+		}
+		break;
+
+	case OPMAX2:
+	case OPDMAX:
+		switch(type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifdef TYQUAD0
+		case TYQUAD:
+#endif
+			cp->ci = ap->ci >= bp->ci ? ap->ci : bp->ci;
+			break;
+#ifndef NO_LONG_LONG
+		case TYQUAD:
+			cp->cq = ap->cq >= bp->cq ? ap->cq : bp->cq;
+			break;
+#endif
+		case TYREAL:
+		case TYDREAL:
+			cp->cd[0] = ad[0] >= bd[0] ? ad[0] : bd[0];
+			break;
+		default:
+			Fatal("inline max of exected type");
+		}
+		break;
+
+	default:	  /* relational ops */
+		switch(type)
+		{
+		case TYINT1:
+		case TYSHORT:
+		case TYLONG:
+#ifdef TYQUAD0
+		case TYQUAD:
+#endif
+			if(ap->ci < bp->ci)
+				k = -1;
+			else if(ap->ci == bp->ci)
+				k = 0;
+			else	k = 1;
+			break;
+#ifndef NO_LONG_LONG
+		case TYQUAD:
+			if(ap->cq < bp->cq)
+				k = -1;
+			else if(ap->cq == bp->cq)
+				k = 0;
+			else	k = 1;
+			break;
+#endif
+		case TYREAL:
+		case TYDREAL:
+			if(ad[0] < bd[0])
+				k = -1;
+			else if(ad[0] == bd[0])
+				k = 0;
+			else	k = 1;
+			break;
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			if(ad[0] == bd[0] &&
+			    ad[1] == bd[1] )
+				k = 0;
+			else	k = 1;
+			break;
+		case TYLOGICAL:
+			k = ap->ci - bp->ci;
+		}
+
+		switch(opcode)
+		{
+		case OPEQ:
+			cp->ci = (k == 0);
+			break;
+		case OPNE:
+			cp->ci = (k != 0);
+			break;
+		case OPGT:
+			cp->ci = (k == 1);
+			break;
+		case OPLT:
+			cp->ci = (k == -1);
+			break;
+		case OPGE:
+			cp->ci = (k >= 0);
+			break;
+		case OPLE:
+			cp->ci = (k <= 0);
+			break;
+		}
+		break;
+	}
+}
+
+
+
+/* conssgn - returns the sign of a Fortran constant */
+
+ int
+#ifdef KR_headers
+conssgn(p)
+	expptr p;
+#else
+conssgn(expptr p)
+#endif
+{
+	char *s;
+
+	if( ! ISCONST(p) )
+		Fatal( "sgn(nonconstant)" );
+
+	switch(p->headblock.vtype)
+	{
+	case TYINT1:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+		if(p->constblock.Const.ci > 0) return(1);
+		if(p->constblock.Const.ci < 0) return(-1);
+		return(0);
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		if(p->constblock.Const.cq > 0) return(1);
+		if(p->constblock.Const.cq < 0) return(-1);
+		return(0);
+#endif
+
+	case TYREAL:
+	case TYDREAL:
+		if (p->constblock.vstg) {
+			s = p->constblock.Const.cds[0];
+			if (*s == '-')
+				return -1;
+			if (*s == '0')
+				return 0;
+			return 1;
+			}
+		if(p->constblock.Const.cd[0] > 0) return(1);
+		if(p->constblock.Const.cd[0] < 0) return(-1);
+		return(0);
+
+
+/* The sign of a complex number is 0 iff the number is 0 + 0i, else it's 1 */
+
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		if (p->constblock.vstg)
+			return *p->constblock.Const.cds[0] != '0'
+			    && *p->constblock.Const.cds[1] != '0';
+		return(p->constblock.Const.cd[0]!=0 || p->constblock.Const.cd[1]!=0);
+
+	default:
+		badtype( "conssgn", p->constblock.vtype);
+	}
+	/* NOT REACHED */ return 0;
+}
+
+char *powint[ ] = {
+	"pow_ii",
+#ifdef TYQUAD
+		  "pow_qq",
+#endif
+		  "pow_ri", "pow_di", "pow_ci", "pow_zi" };
+
+ LOCAL expptr
+#ifdef KR_headers
+mkpower(p)
+	expptr p;
+#else
+mkpower(expptr p)
+#endif
+{
+	expptr q, lp, rp;
+	int ltype, rtype, mtype, tyi;
+
+	lp = p->exprblock.leftp;
+	rp = p->exprblock.rightp;
+	ltype = lp->headblock.vtype;
+	rtype = rp->headblock.vtype;
+
+	if (lp->tag == TADDR)
+		lp->addrblock.parenused = 0;
+
+	if (rp->tag == TADDR)
+		rp->addrblock.parenused = 0;
+
+	if(ISICON(rp))
+	{
+		if(rp->constblock.Const.ci == 0)
+		{
+			frexpr(p);
+			if( ISINT(ltype) )
+				return( ICON(1) );
+			else if (ISREAL (ltype))
+				return mkconv (ltype, ICON (1));
+			else
+				return( (expptr) putconst((Constp)
+					mkconv(ltype, ICON(1))) );
+		}
+		if(rp->constblock.Const.ci < 0)
+		{
+			if( ISINT(ltype) )
+			{
+				frexpr(p);
+				err("integer**negative");
+				return( errnode() );
+			}
+			rp->constblock.Const.ci = - rp->constblock.Const.ci;
+			p->exprblock.leftp = lp
+				= fixexpr((Exprp)mkexpr(OPSLASH, ICON(1), lp));
+		}
+		if(rp->constblock.Const.ci == 1)
+		{
+			frexpr(rp);
+			free( (charptr) p );
+			return(lp);
+		}
+
+		if( ONEOF(ltype, MSKINT|MSKREAL) ) {
+			p->exprblock.vtype = ltype;
+			return(p);
+		}
+	}
+	if( ISINT(rtype) )
+	{
+		if(ltype==TYSHORT && rtype==TYSHORT && (!ISCONST(lp) || tyint==TYSHORT) )
+			q = call2(TYSHORT, "pow_hh", lp, rp);
+		else	{
+			if(ONEOF(ltype,M(TYINT1)|M(TYSHORT)))
+			{
+				ltype = TYLONG;
+				lp = mkconv(TYLONG,lp);
+			}
+#ifdef TYQUAD
+			if (ltype == TYQUAD)
+				rp = mkconv(TYQUAD,rp);
+			else
+#endif
+			rp = mkconv(TYLONG,rp);
+			if (ISCONST(rp)) {
+				tyi = tyint;
+				tyint = TYLONG;
+				rp = (expptr)putconst((Constp)rp);
+				tyint = tyi;
+				}
+			q = call2(ltype, powint[ltype-TYLONG], lp, rp);
+		}
+	}
+	else if( ISREAL( (mtype = maxtype(ltype,rtype)) )) {
+		extern int callk_kludge;
+		callk_kludge = TYDREAL;
+		q = call2(mtype, "pow_dd", mkconv(TYDREAL,lp), mkconv(TYDREAL,rp));
+		callk_kludge = 0;
+		}
+	else	{
+		q  = call2(TYDCOMPLEX, "pow_zz",
+		    mkconv(TYDCOMPLEX,lp), mkconv(TYDCOMPLEX,rp));
+		if(mtype == TYCOMPLEX)
+			q = mkconv(TYCOMPLEX, q);
+	}
+	free( (charptr) p );
+	return(q);
+}
+
+
+/* Complex Division.  Same code as in Runtime Library
+*/
+
+
+ LOCAL void
+#ifdef KR_headers
+zdiv(c, a, b)
+	dcomplex *c;
+	dcomplex *a;
+	dcomplex *b;
+#else
+zdiv(dcomplex *c, dcomplex *a, dcomplex *b)
+#endif
+{
+	double ratio, den;
+	double abr, abi;
+
+	if( (abr = b->dreal) < 0.)
+		abr = - abr;
+	if( (abi = b->dimag) < 0.)
+		abi = - abi;
+	if( abr <= abi )
+	{
+		if(abi == 0)
+			Fatal("complex division by zero");
+		ratio = b->dreal / b->dimag ;
+		den = b->dimag * (1 + ratio*ratio);
+		c->dreal = (a->dreal*ratio + a->dimag) / den;
+		c->dimag = (a->dimag*ratio - a->dreal) / den;
+	}
+
+	else
+	{
+		ratio = b->dimag / b->dreal ;
+		den = b->dreal * (1 + ratio*ratio);
+		c->dreal = (a->dreal + a->dimag*ratio) / den;
+		c->dimag = (a->dimag - a->dreal*ratio) / den;
+	}
+}
+
+
+ void
+#ifdef KR_headers
+sserr(np) Namep np;
+#else
+sserr(Namep np)
+#endif
+{
+	errstr(np->vtype == TYCHAR
+		? "substring of character array %.70s"
+		: "substring of noncharacter %.73s", np->fvarname);
+	}
diff --git a/contrib/tools/f2c/src/format.c b/contrib/tools/f2c/src/format.c
new file mode 100644
index 0000000000..96f2acf995
--- /dev/null
+++ b/contrib/tools/f2c/src/format.c
@@ -0,0 +1,2613 @@
+/****************************************************************
+Copyright 1990-1996, 1999-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+/* Format.c -- this file takes an intermediate file (generated by pass 1
+   of the translator) and some state information about the contents of that
+   file, and generates C program text. */
+
+#include "defs.h"
+#include "p1defs.h"
+#include "format.h"
+#include "output.h"
+#include "names.h"
+#include "iob.h"
+
+int c_output_line_length = DEF_C_LINE_LENGTH;
+
+int last_was_label;	/* Boolean used to generate semicolons
+				   when a label terminates a block */
+static char this_proc_name[52];	/* Name of the current procedure.  This is
+				   probably too simplistic to handle
+				   multiple entry points */
+
+static tagptr do_format Argdcl((FILEP, FILEP));
+static void do_p1_1while Argdcl((FILEP));
+static void do_p1_2while Argdcl((FILEP, FILEP));
+static tagptr do_p1_addr Argdcl((FILEP, FILEP));
+static void do_p1_asgoto Argdcl((FILEP, FILEP));
+static tagptr do_p1_charp Argdcl((FILEP));
+static void do_p1_comment Argdcl((FILEP, FILEP));
+static void do_p1_comp_goto Argdcl((FILEP, FILEP));
+static tagptr do_p1_const Argdcl((FILEP));
+static void do_p1_elif Argdcl((FILEP, FILEP));
+static void do_p1_else Argdcl((FILEP));
+static void do_p1_elseifstart Argdcl((FILEP));
+static void do_p1_end_for Argdcl((FILEP));
+static void do_p1_endelse Argdcl((FILEP));
+static void do_p1_endif Argdcl((FILEP));
+static tagptr do_p1_expr Argdcl((FILEP, FILEP));
+static tagptr do_p1_extern Argdcl((FILEP));
+static void do_p1_for Argdcl((FILEP, FILEP));
+static void do_p1_fortran Argdcl((FILEP, FILEP));
+static void do_p1_goto Argdcl((FILEP, FILEP));
+static tagptr do_p1_head Argdcl((FILEP, FILEP));
+static tagptr do_p1_ident Argdcl((FILEP));
+static void do_p1_if Argdcl((FILEP, FILEP));
+static void do_p1_label Argdcl((FILEP, FILEP));
+static tagptr do_p1_list Argdcl((FILEP, FILEP));
+static tagptr do_p1_literal Argdcl((FILEP));
+static tagptr do_p1_name_pointer Argdcl((FILEP));
+static void do_p1_set_line Argdcl((FILEP));
+static void do_p1_subr_ret Argdcl((FILEP, FILEP));
+static int get_p1_token Argdcl((FILEP));
+static int p1get_const Argdcl((FILEP, int, Constp*));
+static int p1getd Argdcl((FILEP, long int*));
+static int p1getf Argdcl((FILEP, char**));
+static int p1getn Argdcl((FILEP, int, char**));
+static int p1gets Argdcl((FILEP, char*, int));
+static void proto Argdcl((FILEP, Argtypes*, char*));
+
+extern chainp assigned_fmts;
+char filename[P1_FILENAME_MAX];
+extern int gflag, sharp_line, trapuv;
+extern int typeconv[];
+int gflag1;
+extern char *parens;
+
+ void
+start_formatting(Void)
+{
+    FILE *infile;
+    static int wrote_one = 0;
+    extern int usedefsforcommon;
+    extern char *p1_file, *p1_bakfile;
+
+    this_proc_name[0] = '\0';
+    last_was_label = 0;
+    ei_next = ei_first;
+    wh_next = wh_first;
+
+    (void) fclose (pass1_file);
+    if ((infile = fopen (p1_file, binread)) == NULL)
+	Fatal("start_formatting:  couldn't open the intermediate file\n");
+
+    if (wrote_one)
+	nice_printf (c_file, "\n");
+
+    while (!feof (infile)) {
+	expptr this_expr;
+
+	this_expr = do_format (infile, c_file);
+	if (this_expr) {
+	    out_and_free_statement (c_file, this_expr);
+	} /* if this_expr */
+    } /* while !feof infile */
+
+    (void) fclose (infile);
+
+    if (last_was_label)
+	nice_printf (c_file, ";\n");
+
+    prev_tab (c_file);
+    gflag1 = sharp_line = 0;
+    if (this_proc_name[0])
+	nice_printf (c_file, "} /* %s */\n", this_proc_name);
+
+
+/* Write the #undefs for common variable reference */
+
+    if (usedefsforcommon) {
+	Extsym *ext;
+	int did_one = 0;
+
+	for (ext = extsymtab; ext < nextext; ext++)
+	    if (ext -> extstg == STGCOMMON && ext -> used_here) {
+		ext -> used_here = 0;
+		if (!did_one)
+		    nice_printf (c_file, "\n");
+		wr_abbrevs(c_file, 0, ext->extp);
+		did_one = 1;
+		ext -> extp = CHNULL;
+	    } /* if */
+
+	if (did_one)
+	    nice_printf (c_file, "\n");
+    } /* if usedefsforcommon */
+
+    other_undefs(c_file);
+
+    wrote_one = 1;
+
+/* For debugging only */
+
+    if (debugflag && (pass1_file = fopen (p1_bakfile, binwrite)))
+	if (infile = fopen (p1_file, binread)) {
+	    ffilecopy (infile, pass1_file);
+	    fclose (infile);
+	    fclose (pass1_file);
+	} /* if infile */
+
+/* End of "debugging only" */
+
+    scrub(p1_file);	/* optionally unlink */
+
+    if ((pass1_file = fopen (p1_file, binwrite)) == NULL)
+	err ("start_formatting:  couldn't reopen the pass1 file");
+
+} /* start_formatting */
+
+
+ static void
+#ifdef KR_headers
+put_semi(outfile)
+	FILE *outfile;
+#else
+put_semi(FILE *outfile)
+#endif
+{
+	nice_printf (outfile, ";\n");
+	last_was_label = 0;
+	}
+
+#define SEM_CHECK(x) if (last_was_label) put_semi(x)
+
+/* do_format -- takes an input stream (a file in pass1 format) and writes
+   the appropriate C code to   outfile   when possible.  When reading an
+   expression, the expression tree is returned instead. */
+
+ static expptr
+#ifdef KR_headers
+do_format(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_format(FILE *infile, FILE *outfile)
+#endif
+{
+    int token_type, was_c_token;
+    expptr retval = ENULL;
+
+    token_type = get_p1_token (infile);
+    was_c_token = 1;
+    switch (token_type) {
+	case P1_COMMENT:
+	    do_p1_comment (infile, outfile);
+	    was_c_token = 0;
+	    break;
+	case P1_SET_LINE:
+	    do_p1_set_line (infile);
+	    was_c_token = 0;
+	    break;
+	case P1_FILENAME:
+	    p1gets(infile, filename, P1_FILENAME_MAX);
+	    was_c_token = 0;
+	    break;
+	case P1_NAME_POINTER:
+	    retval = do_p1_name_pointer (infile);
+	    break;
+	case P1_CONST:
+	    retval = do_p1_const (infile);
+	    break;
+	case P1_EXPR:
+	    retval = do_p1_expr (infile, outfile);
+	    break;
+	case P1_IDENT:
+	    retval = do_p1_ident(infile);
+	    break;
+	case P1_CHARP:
+		retval = do_p1_charp(infile);
+		break;
+	case P1_EXTERN:
+	    retval = do_p1_extern (infile);
+	    break;
+	case P1_HEAD:
+	    gflag1 = sharp_line = 0;
+	    retval = do_p1_head (infile, outfile);
+	    gflag1 = sharp_line = gflag;
+	    break;
+	case P1_LIST:
+	    retval = do_p1_list (infile, outfile);
+	    break;
+	case P1_LITERAL:
+	    retval = do_p1_literal (infile);
+	    break;
+	case P1_LABEL:
+	    do_p1_label (infile, outfile);
+	    /* last_was_label = 1; -- now set in do_p1_label */
+	    was_c_token = 0;
+	    break;
+	case P1_ASGOTO:
+	    do_p1_asgoto (infile, outfile);
+	    break;
+	case P1_GOTO:
+	    do_p1_goto (infile, outfile);
+	    break;
+	case P1_IF:
+	    do_p1_if (infile, outfile);
+	    break;
+	case P1_ELSE:
+	    SEM_CHECK(outfile);
+	    do_p1_else (outfile);
+	    break;
+	case P1_ELIF:
+	    SEM_CHECK(outfile);
+	    do_p1_elif (infile, outfile);
+	    break;
+	case P1_ENDIF:
+	    SEM_CHECK(outfile);
+	    do_p1_endif (outfile);
+	    break;
+	case P1_ENDELSE:
+	    SEM_CHECK(outfile);
+	    do_p1_endelse (outfile);
+	    break;
+	case P1_ADDR:
+	    retval = do_p1_addr (infile, outfile);
+	    break;
+	case P1_SUBR_RET:
+	    do_p1_subr_ret (infile, outfile);
+	    break;
+	case P1_COMP_GOTO:
+	    do_p1_comp_goto (infile, outfile);
+	    break;
+	case P1_FOR:
+	    do_p1_for (infile, outfile);
+	    break;
+	case P1_ENDFOR:
+	    SEM_CHECK(outfile);
+	    do_p1_end_for (outfile);
+	    break;
+	case P1_WHILE1START:
+		do_p1_1while(outfile);
+		break;
+	case P1_WHILE2START:
+		do_p1_2while(infile, outfile);
+		break;
+	case P1_PROCODE:
+		procode(outfile);
+		break;
+	case P1_ELSEIFSTART:
+		SEM_CHECK(outfile);
+		do_p1_elseifstart(outfile);
+		break;
+	case P1_FORTRAN:
+		do_p1_fortran(infile, outfile);
+		/* no break; */
+	case P1_EOF:
+	    was_c_token = 0;
+	    break;
+	case P1_UNKNOWN:
+	    Fatal("do_format:  Unknown token type in intermediate file");
+	    break;
+	default:
+	    Fatal("do_format:  Bad token type in intermediate file");
+	    break;
+   } /* switch */
+
+    if (was_c_token)
+	last_was_label = 0;
+    return retval;
+} /* do_format */
+
+
+ static void
+#ifdef KR_headers
+do_p1_comment(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_comment(FILE *infile, FILE *outfile)
+#endif
+{
+    extern int in_comment;
+
+    char storage[COMMENT_BUFFER_SIZE + 1];
+    int length;
+
+    if (!p1gets(infile, storage, COMMENT_BUFFER_SIZE + 1))
+	return;
+
+    length = strlen (storage);
+
+    gflag1 = sharp_line = 0;
+    in_comment = 1;
+    margin_printf(outfile, length ? "/* %s */\n" : "\n", storage);
+    in_comment = 0;
+    gflag1 = sharp_line = gflag;
+} /* do_p1_comment */
+
+ static void
+#ifdef KR_headers
+do_p1_set_line(infile)
+	FILE *infile;
+#else
+do_p1_set_line(FILE *infile)
+#endif
+{
+    int status;
+    long new_line_number = -1;
+
+    status = p1getd (infile, &new_line_number);
+
+    if (status == EOF)
+	err ("do_p1_set_line:  Missing line number at end of file\n");
+    else if (status == 0 || new_line_number == -1)
+	errl("do_p1_set_line:  Illegal line number in intermediate file: %ld\n",
+		new_line_number);
+    else {
+	lineno = new_line_number;
+	}
+} /* do_p1_set_line */
+
+
+ static expptr
+#ifdef KR_headers
+do_p1_name_pointer(infile)
+	FILE *infile;
+#else
+do_p1_name_pointer(FILE *infile)
+#endif
+{
+    Namep namep = (Namep) NULL;
+    int status;
+
+    status = p1getd (infile, (long *) &namep);
+
+    if (status == EOF)
+	err ("do_p1_name_pointer:  Missing pointer at end of file\n");
+    else if (status == 0 || namep == (Namep) NULL)
+	erri ("do_p1_name_pointer:  Illegal name pointer in p1 file: '#%lx'\n",
+		(unsigned long) namep);
+
+    return (expptr) namep;
+} /* do_p1_name_pointer */
+
+
+
+ static expptr
+#ifdef KR_headers
+do_p1_const(infile)
+	FILE *infile;
+#else
+do_p1_const(FILE *infile)
+#endif
+{
+    struct Constblock *c = (struct Constblock *) NULL;
+    long type = -1;
+    int status;
+
+    status = p1getd (infile, &type);
+
+    if (status == EOF)
+	err ("do_p1_const:  Missing constant type at end of file\n");
+    else if (status == 0)
+	errl("do_p1_const:  Illegal constant type in p1 file: %ld\n", type);
+    else {
+	status = p1get_const (infile, (int)type, &c);
+
+	if (status == EOF) {
+	    err ("do_p1_const:  Missing constant value at end of file\n");
+	    c = (struct Constblock *) NULL;
+	} else if (status == 0) {
+	    err ("do_p1_const:  Illegal constant value in p1 file\n");
+	    c = (struct Constblock *) NULL;
+	} /* else */
+    } /* else */
+    return (expptr) c;
+} /* do_p1_const */
+
+ void
+#ifdef KR_headers
+addrlit(addrp)
+	Addrp addrp;
+#else
+addrlit(Addrp addrp)
+#endif
+{
+	long memno = addrp->memno;
+	struct Literal *litp, *lastlit;
+
+	lastlit = litpool + nliterals;
+	for (litp = litpool; litp < lastlit; litp++)
+	    if (litp->litnum == memno) {
+		addrp->vtype = litp->littype;
+		*((union Constant *) &(addrp->user)) =
+			*((union Constant *) &(litp->litval));
+		addrp->vstg = STGMEMNO;
+		return;
+		}
+	err("addrlit failure!");
+	}
+
+ static expptr
+#ifdef KR_headers
+do_p1_literal(infile)
+	FILE *infile;
+#else
+do_p1_literal(FILE *infile)
+#endif
+{
+    int status;
+    long memno;
+    Addrp addrp;
+
+    status = p1getd (infile, &memno);
+
+    if (status == EOF)
+	err ("do_p1_literal:  Missing memno at end of file");
+    else if (status == 0)
+	err ("do_p1_literal:  Missing memno in p1 file");
+    else {
+	addrp = ALLOC (Addrblock);
+	addrp -> tag = TADDR;
+	addrp -> vtype = TYUNKNOWN;
+	addrp -> Field = NULL;
+	addrp -> memno = memno;
+	addrlit(addrp);
+	addrp -> uname_tag = UNAM_CONST;
+    } /* else */
+
+    return (expptr) addrp;
+} /* do_p1_literal */
+
+
+ static void
+#ifdef KR_headers
+do_p1_label(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_label(FILE *infile, FILE *outfile)
+#endif
+{
+    int status;
+    ftnint stateno;
+    struct Labelblock *L;
+    char *fmt;
+
+    status = p1getd (infile, &stateno);
+
+    if (status == EOF)
+	err ("do_p1_label:  Missing label at end of file");
+    else if (status == 0)
+	err ("do_p1_label:  Missing label in p1 file ");
+    else if (stateno < 0) {	/* entry */
+	margin_printf(outfile, "\n%s:\n", user_label(stateno));
+	last_was_label = 1;
+	}
+    else {
+	L = labeltab + stateno;
+	if (L->labused) {
+		fmt = "%s:\n";
+		last_was_label = 1;
+		}
+	else
+		fmt = "/* %s: */\n";
+	margin_printf(outfile, fmt, user_label(L->stateno));
+    } /* else */
+} /* do_p1_label */
+
+
+
+ static void
+#ifdef KR_headers
+do_p1_asgoto(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_asgoto(FILE *infile, FILE *outfile)
+#endif
+{
+    expptr expr;
+
+    expr = do_format (infile, outfile);
+    out_asgoto (outfile, expr);
+
+} /* do_p1_asgoto */
+
+
+ static void
+#ifdef KR_headers
+do_p1_goto(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_goto(FILE *infile, FILE *outfile)
+#endif
+{
+    int status;
+    long stateno;
+
+    status = p1getd (infile, &stateno);
+
+    if (status == EOF)
+	err ("do_p1_goto:  Missing goto label at end of file");
+    else if (status == 0)
+	err ("do_p1_goto:  Missing goto label in p1 file");
+    else {
+	nice_printf (outfile, "goto %s;\n", user_label (stateno));
+    } /* else */
+} /* do_p1_goto */
+
+
+ static void
+#ifdef KR_headers
+do_p1_if(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_if(FILE *infile, FILE *outfile)
+#endif
+{
+    expptr cond;
+
+    do {
+        cond = do_format (infile, outfile);
+    } while (cond == ENULL);
+
+    out_if (outfile, cond);
+} /* do_p1_if */
+
+
+ static void
+#ifdef KR_headers
+do_p1_else(outfile)
+	FILE *outfile;
+#else
+do_p1_else(FILE *outfile)
+#endif
+{
+    out_else (outfile);
+} /* do_p1_else */
+
+
+ static void
+#ifdef KR_headers
+do_p1_elif(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_elif(FILE *infile, FILE *outfile)
+#endif
+{
+    expptr cond;
+
+    do {
+        cond = do_format (infile, outfile);
+    } while (cond == ENULL);
+
+    elif_out (outfile, cond);
+} /* do_p1_elif */
+
+ static void
+#ifdef KR_headers
+do_p1_endif(outfile)
+	FILE *outfile;
+#else
+do_p1_endif(FILE *outfile)
+#endif
+{
+    endif_out (outfile);
+} /* do_p1_endif */
+
+
+ static void
+#ifdef KR_headers
+do_p1_endelse(outfile)
+	FILE *outfile;
+#else
+do_p1_endelse(FILE *outfile)
+#endif
+{
+    end_else_out (outfile);
+} /* do_p1_endelse */
+
+
+ static expptr
+#ifdef KR_headers
+do_p1_addr(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_addr(FILE *infile, FILE *outfile)
+#endif
+{
+    Addrp addrp = (Addrp) NULL;
+    int status;
+
+    status = p1getn (infile, (int)sizeof(struct Addrblock), (char **) &addrp);
+
+    if (status == EOF)
+	err ("do_p1_addr:  Missing Addrp at end of file");
+    else if (status == 0)
+	err ("do_p1_addr:  Missing Addrp in p1 file");
+    else if (addrp == (Addrp) NULL)
+	err ("do_p1_addr:  Null addrp in p1 file");
+    else if (addrp -> tag != TADDR)
+	erri ("do_p1_addr: bad tag in p1 file '%d'", addrp -> tag);
+    else {
+	addrp -> vleng = do_format (infile, outfile);
+	addrp -> memoffset = do_format (infile, outfile);
+    }
+
+    return (expptr) addrp;
+} /* do_p1_addr */
+
+
+
+ static void
+#ifdef KR_headers
+do_p1_subr_ret(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_subr_ret(FILE *infile, FILE *outfile)
+#endif
+{
+    expptr retval;
+
+    nice_printf (outfile, "return ");
+    retval = do_format (infile, outfile);
+    if (!multitype)
+	if (retval)
+		expr_out (outfile, retval);
+
+    nice_printf (outfile, ";\n");
+} /* do_p1_subr_ret */
+
+
+
+ static void
+#ifdef KR_headers
+do_p1_comp_goto(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_comp_goto(FILE *infile, FILE *outfile)
+#endif
+{
+    expptr index;
+    expptr labels;
+
+    index = do_format (infile, outfile);
+
+    if (index == ENULL) {
+	err ("do_p1_comp_goto:  no expression for computed goto");
+	return;
+    } /* if index == ENULL */
+
+    labels = do_format (infile, outfile);
+
+    if (labels && labels -> tag != TLIST)
+	erri ("do_p1_comp_goto:  expected list, got tag '%d'", labels -> tag);
+    else
+	compgoto_out (outfile, index, labels);
+} /* do_p1_comp_goto */
+
+
+ static void
+#ifdef KR_headers
+do_p1_for(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_for(FILE *infile, FILE *outfile)
+#endif
+{
+    expptr init, test, inc;
+
+    init = do_format (infile, outfile);
+    test = do_format (infile, outfile);
+    inc = do_format (infile, outfile);
+
+    out_for (outfile, init, test, inc);
+} /* do_p1_for */
+
+ static void
+#ifdef KR_headers
+do_p1_end_for(outfile)
+	FILE *outfile;
+#else
+do_p1_end_for(FILE *outfile)
+#endif
+{
+    out_end_for (outfile);
+} /* do_p1_end_for */
+
+
+ static void
+#ifdef KR_headers
+do_p1_fortran(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_fortran(FILE *infile, FILE *outfile)
+#endif
+{
+	char buf[P1_STMTBUFSIZE];
+	if (!p1gets(infile, buf, P1_STMTBUFSIZE))
+		return;
+	/* bypass nice_printf nonsense */
+	fprintf(outfile, "/*< %s >*/\n", buf+1);	/* + 1 to skip by '$' */
+	}
+
+
+ static expptr
+#ifdef KR_headers
+do_p1_expr(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_expr(FILE *infile, FILE *outfile)
+#endif
+{
+    int status;
+    long opcode, type;
+    struct Exprblock *result = (struct Exprblock *) NULL;
+
+    status = p1getd (infile, &opcode);
+
+    if (status == EOF)
+	err ("do_p1_expr:  Missing expr opcode at end of file");
+    else if (status == 0)
+	err ("do_p1_expr:  Missing expr opcode in p1 file");
+    else {
+
+	status = p1getd (infile, &type);
+
+	if (status == EOF)
+	    err ("do_p1_expr:  Missing expr type at end of file");
+	else if (status == 0)
+	    err ("do_p1_expr:  Missing expr type in p1 file");
+	else if (opcode == 0)
+	    return ENULL;
+	else {
+	    result = ALLOC (Exprblock);
+
+	    result -> tag = TEXPR;
+	    result -> vtype = (field)type;
+	    result -> opcode = (unsigned int)opcode;
+	    result -> vleng = do_format (infile, outfile);
+
+	    if (is_unary_op (opcode))
+		result -> leftp = do_format (infile, outfile);
+	    else if (is_binary_op (opcode)) {
+		result -> leftp = do_format (infile, outfile);
+		result -> rightp = do_format (infile, outfile);
+	    } else
+		errl("do_p1_expr:  Illegal opcode %ld", opcode);
+	} /* else */
+    } /* else */
+
+    return (expptr) result;
+} /* do_p1_expr */
+
+
+ static expptr
+#ifdef KR_headers
+do_p1_ident(infile)
+	FILE *infile;
+#else
+do_p1_ident(FILE *infile)
+#endif
+{
+	Addrp addrp;
+	int status;
+	long vtype, vstg;
+
+	addrp = ALLOC (Addrblock);
+	addrp -> tag = TADDR;
+
+	status = p1getd (infile, &vtype);
+	if (status == EOF)
+	    err ("do_p1_ident:  Missing identifier type at end of file\n");
+	else if (status == 0 || vtype < 0 || vtype >= NTYPES)
+	    errl("do_p1_ident:  Bad type in intermediate file: %ld\n", vtype);
+	else
+	    addrp -> vtype = (field)vtype;
+
+	status = p1getd (infile, &vstg);
+	if (status == EOF)
+	    err ("do_p1_ident:  Missing identifier storage at end of file\n");
+	else if (status == 0 || vstg < 0 || vstg > STGNULL)
+	    errl("do_p1_ident:  Bad storage in intermediate file: %ld\n", vtype);
+	else
+	    addrp -> vstg = (field)vstg;
+
+	status = p1gets(infile, addrp->user.ident, IDENT_LEN);
+
+	if (status == EOF)
+	    err ("do_p1_ident:  Missing ident string at end of file");
+	else if (status == 0)
+	    err ("do_p1_ident:  Missing ident string in intermediate file");
+	addrp->uname_tag = UNAM_IDENT;
+	return (expptr) addrp;
+} /* do_p1_ident */
+
+ static expptr
+#ifdef KR_headers
+do_p1_charp(infile)
+	FILE *infile;
+#else
+do_p1_charp(FILE *infile)
+#endif
+{
+	Addrp addrp;
+	int status;
+	long vtype, vstg;
+	char buf[64];
+
+	addrp = ALLOC (Addrblock);
+	addrp -> tag = TADDR;
+
+	status = p1getd (infile, &vtype);
+	if (status == EOF)
+	    err ("do_p1_ident:  Missing identifier type at end of file\n");
+	else if (status == 0 || vtype < 0 || vtype >= NTYPES)
+	    errl("do_p1_ident:  Bad type in intermediate file: %ld\n", vtype);
+	else
+	    addrp -> vtype = (field)vtype;
+
+	status = p1getd (infile, &vstg);
+	if (status == EOF)
+	    err ("do_p1_ident:  Missing identifier storage at end of file\n");
+	else if (status == 0 || vstg < 0 || vstg > STGNULL)
+	    errl("do_p1_ident:  Bad storage in intermediate file: %ld\n", vtype);
+	else
+	    addrp -> vstg = (field)vstg;
+
+	status = p1gets(infile, buf, (int)sizeof(buf));
+
+	if (status == EOF)
+	    err ("do_p1_ident:  Missing charp ident string at end of file");
+	else if (status == 0)
+	    err ("do_p1_ident:  Missing charp ident string in intermediate file");
+	addrp->uname_tag = UNAM_CHARP;
+	addrp->user.Charp = strcpy(mem(strlen(buf)+1,0), buf);
+	return (expptr) addrp;
+}
+
+
+ static expptr
+#ifdef KR_headers
+do_p1_extern(infile)
+	FILE *infile;
+#else
+do_p1_extern(FILE *infile)
+#endif
+{
+    Addrp addrp;
+
+    addrp = ALLOC (Addrblock);
+    if (addrp) {
+	int status;
+
+	addrp->tag = TADDR;
+	addrp->vstg = STGEXT;
+	addrp->uname_tag = UNAM_EXTERN;
+	status = p1getd (infile, &(addrp -> memno));
+	if (status == EOF)
+	    err ("do_p1_extern:  Missing memno at end of file");
+	else if (status == 0)
+	    err ("do_p1_extern:  Missing memno in intermediate file");
+	if (addrp->vtype = extsymtab[addrp->memno].extype)
+		addrp->vclass = CLPROC;
+    } /* if addrp */
+
+    return (expptr) addrp;
+} /* do_p1_extern */
+
+
+
+ static expptr
+#ifdef KR_headers
+do_p1_head(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_head(FILE *infile, FILE *outfile)
+#endif
+{
+    int status;
+    int add_n_;
+    long Class;
+    char storage[256];
+
+    status = p1getd (infile, &Class);
+    if (status == EOF)
+	err ("do_p1_head:  missing header class at end of file");
+    else if (status == 0)
+	err ("do_p1_head:  missing header class in p1 file");
+    else {
+	status = p1gets (infile, storage, (int)sizeof(storage));
+	if (status == EOF || status == 0)
+	    storage[0] = '\0';
+    } /* else */
+
+    if (Class == CLPROC || Class == CLMAIN) {
+	chainp lengths;
+
+	add_n_ = nentry > 1;
+	lengths = length_comp(entries, add_n_);
+
+	if (!add_n_ && protofile && Class != CLMAIN)
+		protowrite(protofile, proctype, storage, entries, lengths);
+
+	if (Class == CLMAIN)
+	    nice_printf (outfile, "/* Main program */ int ");
+	else
+	    nice_printf(outfile, "%s ", multitype ? "VOID"
+			: c_type_decl(proctype, 1));
+
+	nice_printf(outfile, add_n_ ? "%s0_" : "%s", storage);
+	if (!Ansi) {
+		listargs(outfile, entries, add_n_, lengths);
+		nice_printf (outfile, "\n");
+		}
+	list_arg_types (outfile, entries, lengths, add_n_, "\n");
+	nice_printf (outfile, "{\n");
+	frchain(&lengths);
+	next_tab (outfile);
+	strcpy(this_proc_name, storage);
+	list_decls (outfile);
+
+    } else if (Class == CLBLOCK)
+        next_tab (outfile);
+    else
+	errl("do_p1_head: got class %ld", Class);
+
+    return NULL;
+} /* do_p1_head */
+
+
+ static expptr
+#ifdef KR_headers
+do_p1_list(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_list(FILE *infile, FILE *outfile)
+#endif
+{
+    long tag, type, count;
+    int status;
+    expptr result;
+
+    status = p1getd (infile, &tag);
+    if (status == EOF)
+	err ("do_p1_list:  missing list tag at end of file");
+    else if (status == 0)
+	err ("do_p1_list:  missing list tag in p1 file");
+    else {
+	status = p1getd (infile, &type);
+	if (status == EOF)
+	    err ("do_p1_list:  missing list type at end of file");
+	else if (status == 0)
+	    err ("do_p1_list:  missing list type in p1 file");
+	else {
+	    status = p1getd (infile, &count);
+	    if (status == EOF)
+		err ("do_p1_list:  missing count at end of file");
+	    else if (status == 0)
+		err ("do_p1_list:  missing count in p1 file");
+	} /* else */
+    } /* else */
+
+    result = (expptr) ALLOC (Listblock);
+    if (result) {
+	chainp pointer;
+
+	result -> tag = (field)tag;
+	result -> listblock.vtype = (field)type;
+
+/* Assume there will be enough data */
+
+	if (count--) {
+	    pointer = result->listblock.listp =
+		mkchain((char *)do_format(infile, outfile), CHNULL);
+	    while (count--) {
+		pointer -> nextp =
+			mkchain((char *)do_format(infile, outfile), CHNULL);
+		pointer = pointer -> nextp;
+	    } /* while (count--) */
+	} /* if (count) */
+    } /* if (result) */
+
+    return result;
+} /* do_p1_list */
+
+
+ chainp
+#ifdef KR_headers
+length_comp(e, add_n)
+	struct Entrypoint *e;
+	int add_n;
+#else
+length_comp(struct Entrypoint *e, int add_n)
+#endif
+		/* get lengths of characters args */
+{
+	chainp lengths;
+	chainp args, args1;
+	Namep arg, np;
+	int nchargs;
+	Argtypes *at;
+	Atype *a;
+	extern int init_ac[TYSUBR+1];
+
+	if (!e)
+		return 0;	/* possible only with errors */
+	args = args1 = add_n ? allargs : e->arglist;
+	nchargs = 0;
+	for (lengths = NULL; args; args = args -> nextp)
+		if (arg = (Namep)args->datap) {
+			if (arg->vclass == CLUNKNOWN)
+				arg->vclass = CLVAR;
+			if (arg->vtype == TYCHAR && arg->vclass != CLPROC) {
+				lengths = mkchain((char *)arg, lengths);
+				nchargs++;
+				}
+			}
+	if (!add_n && (np = e->enamep)) {
+		/* one last check -- by now we know all we ever will
+		 * about external args...
+		 */
+		save_argtypes(e->arglist, &e->entryname->arginfo,
+			&np->arginfo, 0, np->fvarname, STGEXT, nchargs,
+			np->vtype, 1);
+		at = e->entryname->arginfo;
+		a = at->atypes + init_ac[np->vtype];
+		for(; args1; a++, args1 = args1->nextp) {
+			frchain(&a->cp);
+			if (arg = (Namep)args1->datap)
+			    switch(arg->vclass) {
+				case CLPROC:
+					if (arg->vimpltype
+					&& a->type >= 300)
+						a->type = TYUNKNOWN + 200;
+					break;
+				case CLUNKNOWN:
+					a->type %= 100;
+				}
+			}
+		}
+	return revchain(lengths);
+	}
+
+ void
+#ifdef KR_headers
+listargs(outfile, entryp, add_n_, lengths)
+	FILE *outfile;
+	struct Entrypoint *entryp;
+	int add_n_;
+	chainp lengths;
+#else
+listargs(FILE *outfile, struct Entrypoint *entryp, int add_n_, chainp lengths)
+#endif
+{
+	chainp args;
+	char *s;
+	Namep arg;
+	int did_one = 0;
+
+	nice_printf (outfile, "(");
+
+	if (add_n_) {
+		nice_printf(outfile, "n__");
+		did_one = 1;
+		args = allargs;
+		}
+	else {
+		if (!entryp)
+			return;	/* possible only with errors */
+		args = entryp->arglist;
+		}
+
+	if (multitype)
+		{
+		nice_printf(outfile, ", ret_val");
+		did_one = 1;
+		args = allargs;
+		}
+	else if (ONEOF(proctype, MSKCOMPLEX|MSKCHAR))
+		{
+		s = xretslot[proctype]->user.ident;
+		nice_printf(outfile, did_one ? ", %s" : "%s",
+			*s == '(' /*)*/ ? "r_v" : s);
+		did_one = 1;
+		if (proctype == TYCHAR)
+			nice_printf (outfile, ", ret_val_len");
+		}
+	for (; args; args = args -> nextp)
+		if (arg = (Namep)args->datap) {
+			nice_printf (outfile, "%s", did_one ? ", " : "");
+			out_name (outfile, arg);
+			did_one = 1;
+			}
+
+	for (args = lengths; args; args = args -> nextp)
+		nice_printf(outfile, ", %s",
+			new_arg_length((Namep)args->datap));
+	nice_printf (outfile, ")");
+} /* listargs */
+
+
+ void
+#ifdef KR_headers
+list_arg_types(outfile, entryp, lengths, add_n_, finalnl)
+	FILE *outfile;
+	struct Entrypoint *entryp;
+	chainp lengths;
+	int add_n_;
+	char *finalnl;
+#else
+list_arg_types(FILE *outfile, struct Entrypoint *entryp, chainp lengths, int add_n_, char *finalnl)
+#endif
+{
+    chainp args;
+    int last_type = -1, last_class = -1;
+    int did_one = 0, done_one, is_ext;
+    char *s, *sep = "", *sep1;
+
+    if (outfile == (FILE *) NULL) {
+	err ("list_arg_types:  null output file");
+	return;
+    } else if (entryp == (struct Entrypoint *) NULL) {
+	err ("list_arg_types:  null procedure entry pointer");
+	return;
+    } /* else */
+
+    if (Ansi) {
+	done_one = 0;
+	sep1 = ", ";
+	nice_printf(outfile, "(" /*)*/);
+	}
+    else {
+	done_one = 1;
+	sep1 = ";\n";
+	}
+    args = entryp->arglist;
+    if (add_n_) {
+	nice_printf(outfile, "int n__");
+	did_one = done_one;
+	sep = sep1;
+	args = allargs;
+	}
+    if (multitype) {
+	nice_printf(outfile, "%sMultitype *ret_val", sep);
+	did_one = done_one;
+	sep = sep1;
+	}
+    else if (ONEOF (proctype, MSKCOMPLEX|MSKCHAR)) {
+	s = xretslot[proctype]->user.ident;
+	nice_printf(outfile, "%s%s *%s", sep, c_type_decl(proctype, 0),
+			*s == '(' /*)*/ ? "r_v" : s);
+	did_one = done_one;
+	sep = sep1;
+	if (proctype == TYCHAR)
+	    nice_printf (outfile, "%sftnlen ret_val_len", sep);
+    } /* if ONEOF proctype */
+    for (; args; args = args -> nextp) {
+	Namep arg = (Namep) args->datap;
+
+/* Scalars are passed by reference, and arrays will have their lower bound
+   adjusted, so nearly everything is printed with a star in front.  The
+   exception is character lengths, which are passed by value. */
+
+	if (arg) {
+	    int type = arg -> vtype, vclass = arg -> vclass;
+
+	    if (vclass == CLPROC)
+		if (arg->vimpltype)
+			type = Castargs ? TYUNKNOWN : TYSUBR;
+		else if (type == TYREAL && forcedouble && !Castargs)
+			type = TYDREAL;
+
+	    if (type == last_type && vclass == last_class && did_one)
+		nice_printf (outfile, ", ");
+	    else
+		if ((is_ext = vclass == CLPROC) && Castargs)
+			nice_printf(outfile, "%s%s ", sep,
+				usedcasts[type] = casttypes[type]);
+		else
+			nice_printf(outfile, "%s%s ", sep,
+				c_type_decl(type, is_ext));
+	    if (vclass == CLPROC)
+		if (Castargs)
+			out_name(outfile, arg);
+		else {
+			nice_printf(outfile, "(*");
+			out_name(outfile, arg);
+			nice_printf(outfile, ") %s", parens);
+			}
+	    else {
+		nice_printf (outfile, "*");
+		out_name (outfile, arg);
+		}
+
+	    last_type = type;
+	    last_class = vclass;
+	    did_one = done_one;
+	    sep = sep1;
+	} /* if (arg) */
+    } /* for args = entryp -> arglist */
+
+    for (args = lengths; args; args = args -> nextp)
+	nice_printf(outfile, "%sftnlen %s", sep,
+			new_arg_length((Namep)args->datap));
+    if (did_one)
+	nice_printf (outfile, ";\n");
+    else if (Ansi)
+	nice_printf(outfile,
+		/*((*/ sep != sep1 && Ansi == 1 ? "void)%s" : ")%s",
+		finalnl);
+} /* list_arg_types */
+
+ static void
+#ifdef KR_headers
+write_formats(outfile)
+	FILE *outfile;
+#else
+write_formats(FILE *outfile)
+#endif
+{
+	register struct Labelblock *lp;
+	int first = 1;
+	char *fs;
+
+	for(lp = labeltab ; lp < highlabtab ; ++lp)
+		if (lp->fmtlabused) {
+			if (first) {
+				first = 0;
+				nice_printf(outfile, "/* Format strings */\n");
+				}
+			nice_printf(outfile, "static char fmt_%ld[] = \"",
+				lp->stateno);
+			if (!(fs = lp->fmtstring))
+				fs = "";
+			nice_printf(outfile, "%s\";\n", fs);
+			}
+	if (!first)
+		nice_printf(outfile, "\n");
+	}
+
+ static void
+#ifdef KR_headers
+write_ioblocks(outfile)
+	FILE *outfile;
+#else
+write_ioblocks(FILE *outfile)
+#endif
+{
+	register iob_data *L;
+	register char *f, **s, *sep;
+
+	nice_printf(outfile, "/* Fortran I/O blocks */\n");
+	L = iob_list = (iob_data *)revchain((chainp)iob_list);
+	do {
+		nice_printf(outfile, "static %s %s = { ",
+			L->type, L->name);
+		sep = 0;
+		for(s = L->fields; f = *s; s++) {
+			if (sep)
+				nice_printf(outfile, sep);
+			sep = ", ";
+			if (*f == '"') {	/* kludge */
+				nice_printf(outfile, "\"");
+				nice_printf(outfile, "%s\"", f+1);
+				}
+			else
+				nice_printf(outfile, "%s", f);
+			}
+		nice_printf(outfile, " };\n");
+		}
+		while(L = L->next);
+	nice_printf(outfile, "\n\n");
+	}
+
+ static void
+#ifdef KR_headers
+write_assigned_fmts(outfile)
+	FILE *outfile;
+#else
+write_assigned_fmts(FILE *outfile)
+#endif
+{
+	register chainp cp;
+	Namep np;
+	char *comma, *type;
+	int did_one = 0;
+
+	cp = assigned_fmts = revchain(assigned_fmts);
+	nice_printf(outfile, "/* Assigned format variables */\n");
+	do {
+		np = (Namep)cp->datap;
+		if (did_one == np->vstg) {
+			comma = ", ";
+			type = "";
+			}
+		else {
+			comma = (char*)(did_one ? ";\n" : "");
+			type = (char*)(np->vstg == STGAUTO
+						? "char " : "static char ");
+			did_one = np->vstg;
+			}
+		nice_printf(outfile, "%s%s*%s_fmt", comma, type, np->fvarname);
+		}
+		while(cp = cp->nextp);
+	nice_printf(outfile, ";\n\n");
+	}
+
+ static char *
+#ifdef KR_headers
+to_upper(s)
+	register char *s;
+#else
+to_upper(register char *s)
+#endif
+{
+	static char buf[64];
+	register char *t = buf;
+	register int c;
+	while(*t++ = (c = *s++) >= 'a' && c <= 'z' ? c + 'A' - 'a' : c);
+	return buf;
+	}
+
+
+/* This routine creates static structures representing a namelist.
+   Declarations of the namelist and related structures are:
+
+	struct Vardesc {
+		char *name;
+		char *addr;
+		ftnlen *dims;	*//* laid out as struct dimensions below *//*
+		int  type;
+		};
+	typedef struct Vardesc Vardesc;
+
+	struct Namelist {
+		char *name;
+		Vardesc **vars;
+		int nvars;
+		};
+
+	struct dimensions
+		{
+		ftnlen numberofdimensions;
+		ftnlen numberofelements
+		ftnlen baseoffset;
+		ftnlen span[numberofdimensions-1];
+		};
+
+   If dims is not null, then the corner element of the array is at
+   addr.  However,  the element with subscripts (i1,...,in) is at
+   addr + sizeoftype * (i1+span[0]*(i2+span[1]*...) - dimp->baseoffset)
+*/
+
+ static void
+#ifdef KR_headers
+write_namelists(nmch, outfile)
+	chainp nmch;
+	FILE *outfile;
+#else
+write_namelists(chainp nmch, FILE *outfile)
+#endif
+{
+	Namep var;
+	struct Hashentry *entry;
+	struct Dimblock *dimp;
+	int i, nd, type;
+	char *comma, *name;
+	register chainp q;
+	register Namep v;
+
+	nice_printf(outfile, "/* Namelist stuff */\n\n");
+	for (entry = hashtab; entry < lasthash; ++entry) {
+		if (!(v = entry->varp) || !v->vnamelist)
+			continue;
+		type = v->vtype;
+		name = v->cvarname;
+		if (dimp = v->vdim) {
+			nd = dimp->ndim;
+			nice_printf(outfile,
+				"static ftnlen %s_dims[] = { %d, %ld, %ld",
+				name, nd,
+				dimp->nelt->constblock.Const.ci,
+				dimp->baseoffset->constblock.Const.ci);
+			for(i = 0, --nd; i < nd; i++)
+				nice_printf(outfile, ", %ld",
+				  dimp->dims[i].dimsize->constblock.Const.ci);
+			nice_printf(outfile, " };\n");
+			}
+		nice_printf(outfile, "static Vardesc %s_dv = { \"%s\", %s",
+			name, to_upper(v->fvarname),
+			type == TYCHAR ? ""
+				: (dimp || oneof_stg(v,v->vstg,
+					M(STGEQUIV)|M(STGCOMMON)))
+				? "(char *)" : "(char *)&");
+		out_name(outfile, v);
+		nice_printf(outfile, dimp ? ", %s_dims" : ", (ftnlen *)0", name);
+		nice_printf(outfile, ", %ld };\n",
+			type != TYCHAR  ? (long)typeconv[type]
+					: -v->vleng->constblock.Const.ci);
+		}
+
+	do {
+		var = (Namep)nmch->datap;
+		name = var->cvarname;
+		nice_printf(outfile, "\nstatic Vardesc *%s_vl[] = ", name);
+		comma = "{";
+		i = 0;
+		for(q = var->varxptr.namelist ; q ; q = q->nextp) {
+			v = (Namep)q->datap;
+			if (!v->vnamelist)
+				continue;
+			i++;
+			nice_printf(outfile, "%s &%s_dv", comma, v->cvarname);
+			comma = ",";
+			}
+		nice_printf(outfile, " };\n");
+		nice_printf(outfile,
+			"static Namelist %s = { \"%s\", %s_vl, %d };\n",
+			name, to_upper(var->fvarname), name, i);
+		}
+		while(nmch = nmch->nextp);
+	nice_printf(outfile, "\n");
+	}
+
+/* fixextype tries to infer from usage in previous procedures
+   the type of an external procedure declared
+   external and passed as an argument but never typed or invoked.
+ */
+
+ static int
+#ifdef KR_headers
+fixexttype(var)
+	Namep var;
+#else
+fixexttype(Namep var)
+#endif
+{
+	Extsym *e;
+	int type, type1;
+
+	type = var->vtype;
+	e = &extsymtab[var->vardesc.varno];
+	if ((type1 = e->extype) && type == TYUNKNOWN)
+		return var->vtype = type1;
+	if (var->visused) {
+		if (e->exused && type != type1)
+			changedtype(var);
+		e->exused = 1;
+		e->extype = type;
+		}
+	return type;
+	}
+
+ static void
+#ifdef KR_headers
+ref_defs(outfile, refdefs)
+	FILE *outfile;
+	chainp refdefs;
+#else
+ref_defs(FILE *outfile, chainp refdefs)
+#endif
+{
+	chainp cp;
+	int eb, i, j, n;
+	struct Dimblock *dimp;
+	expptr b, vl;
+	Namep var;
+	char *amp, *comma;
+
+	margin_printf(outfile, "\n");
+	for(cp = refdefs = revchain(refdefs); cp; cp = cp->nextp) {
+		var = (Namep)cp->datap;
+		cp->datap = 0;
+		amp = "_subscr";
+		if (!(eb = var->vsubscrused)) {
+			var->vrefused = 0;
+			if (!ISCOMPLEX(var->vtype))
+				amp = "_ref";
+			}
+		def_start(outfile, var->cvarname, amp, CNULL);
+		dimp = var->vdim;
+		vl = 0;
+		comma = "(";
+		amp = "";
+		if (var->vtype == TYCHAR) {
+			amp = "&";
+			vl = var->vleng;
+			if (ISCONST(vl) && vl->constblock.Const.ci == 1)
+				vl = 0;
+			nice_printf(outfile, "%sa_0", comma);
+			comma = ",";
+			}
+		n = dimp->ndim;
+		for(i = 1; i <= n; i++, comma = ",")
+			nice_printf(outfile, "%sa_%d", comma, i);
+		nice_printf(outfile, ") %s", amp);
+		if (var->vsubscrused)
+			var->vsubscrused = 0;
+		else if (!ISCOMPLEX(var->vtype)) {
+			out_name(outfile, var);
+			nice_printf(outfile, "[%s", vl ? "(" : "");
+			}
+		for(j = 2; j < n; j++)
+			nice_printf(outfile, "(");
+		while(--i > 1) {
+			nice_printf(outfile, "(a_%d)%s*", i, i == n ? "" : ")");
+			expr_out(outfile, cpexpr(dimp->dims[i-2].dimsize));
+			nice_printf(outfile, " + ");
+			}
+		nice_printf(outfile, "a_1");
+		if (var->vtype == TYCHAR) {
+			if (vl) {
+				nice_printf(outfile, ")*");
+				expr_out(outfile, cpexpr(vl));
+				}
+			nice_printf(outfile, " + a_0");
+			}
+		if ((var->vstg != STGARG /* || checksubs */ )
+		 && (b = dimp->baseoffset)) {
+			b = cpexpr(b);
+			if (var->vtype == TYCHAR)
+				b = mkexpr(OPSTAR, cpexpr(var->vleng), b);
+			nice_printf(outfile, " - ");
+			expr_out(outfile, b);
+			}
+		if (ISCOMPLEX(var->vtype)) {
+			margin_printf(outfile, "\n");
+			def_start(outfile, var->cvarname, "_ref", CNULL);
+			comma = "(";
+			for(i = 1; i <= n; i++, comma = ",")
+				nice_printf(outfile, "%sa_%d", comma, i);
+			nice_printf(outfile, ") %s[%s_subscr",
+				var->cvarname, var->cvarname);
+			comma = "(";
+			for(i = 1; i <= n; i++, comma = ",")
+				nice_printf(outfile, "%sa_%d", comma, i);
+			nice_printf(outfile, ")");
+			}
+		margin_printf(outfile, "]\n" + eb);
+		}
+	nice_printf(outfile, "\n");
+	frchain(&refdefs);
+	}
+
+ static long
+#ifdef KR_headers
+n_elt(vd) struct Dimblock *vd;
+#else
+n_elt(struct Dimblock *vd)
+#endif
+{
+	expptr ne;
+	long nv = 1;
+	if (vd) {
+		if (!(ne = vd->nelt))
+			Fatal("Null nelt in n_elt");
+		if (ne->tag != TCONST)
+			fatali("Unexpected nelt tag %d in n_elt", ne->tag);
+		if (!ISINT(ne->constblock.vtype))
+			fatali("Unexpected vtype %d in n_elt",
+				ne->constblock.vtype);
+		nv = ne->constblock.Const.ci;
+		}
+	return nv;
+	}
+
+ void
+#ifdef KR_headers
+list_decls(outfile)
+	FILE *outfile;
+#else
+list_decls(FILE *outfile)
+#endif
+{
+    extern chainp used_builtins;
+    extern struct Hashentry *hashtab;
+    struct Hashentry *entry;
+    int write_header = 1;
+    int last_class = -1, last_stg = -1;
+    Namep var;
+    int Alias, Define, did_one, last_type, stg, type;
+    extern int def_equivs, useauto;
+    extern chainp new_vars;	/* Compiler-generated locals */
+    chainp namelists = 0, refdefs = 0;
+    char *ctype;
+    int useauto1 = useauto && !saveall;
+    long x;
+    extern int hsize;
+
+/* First write out the statically initialized data */
+
+    if (initfile)
+	list_init_data(&initfile, initfname, outfile);
+
+/* Next come formats */
+    write_formats(outfile);
+
+/* Now write out the system-generated identifiers */
+
+    if (new_vars || nequiv) {
+	chainp args, next_var, this_var;
+	chainp nv[TYVOID], nv1[TYVOID];
+	int i, j;
+	ftnint k;
+	Addrp Var;
+	Namep arg;
+
+	/* zap unused dimension variables */
+
+	for(args = allargs; args; args = args->nextp) {
+		arg = (Namep)args->datap;
+		if (this_var = arg->vlastdim) {
+			frexpr((tagptr)this_var->datap);
+			this_var->datap = 0;
+			}
+		}
+
+	/* sort new_vars by type, skipping entries just zapped */
+
+	for(i = TYADDR; i < TYVOID; i++)
+		nv[i] = 0;
+	for(this_var = new_vars; this_var; this_var = next_var) {
+		next_var = this_var->nextp;
+		if (Var = (Addrp)this_var->datap) {
+			if (!(this_var->nextp = nv[j = Var->vtype]))
+				nv1[j] = this_var;
+			nv[j] = this_var;
+			}
+		else {
+			this_var->nextp = 0;
+			frchain(&this_var);
+			}
+		}
+	new_vars = 0;
+	for(i = TYVOID; --i >= TYADDR;)
+		if (this_var = nv[i]) {
+			nv1[i]->nextp = new_vars;
+			new_vars = this_var;
+			}
+
+	/* write the declarations */
+
+	did_one = 0;
+	last_type = -1;
+
+	for (this_var = new_vars; this_var; this_var = this_var -> nextp) {
+	    Var = (Addrp) this_var->datap;
+
+	    if (Var == (Addrp) NULL)
+		err ("list_decls:  null variable");
+	    else if (Var -> tag != TADDR)
+		erri ("list_decls:  bad tag on new variable '%d'",
+			Var -> tag);
+
+	    type = nv_type (Var);
+	    if (Var->vstg == STGINIT
+	    ||  Var->uname_tag == UNAM_IDENT
+			&& *Var->user.ident == ' '
+			&& multitype)
+		continue;
+	    if (!did_one)
+		nice_printf (outfile, "/* System generated locals */\n");
+
+	    if (last_type == type && did_one)
+		nice_printf (outfile, ", ");
+	    else {
+		if (did_one)
+		    nice_printf (outfile, ";\n");
+		nice_printf (outfile, "%s ",
+			c_type_decl (type, Var -> vclass == CLPROC));
+	    } /* else */
+
+/* Character type is really a string type.  Put out a '*' for parameters
+   with unknown length and functions returning character */
+
+	    if (Var -> vtype == TYCHAR && (!ISICON ((Var -> vleng))
+		    || Var -> vclass == CLPROC))
+		nice_printf (outfile, "*");
+
+	    write_nv_ident(outfile, (Addrp)this_var->datap);
+	    if (Var -> vtype == TYCHAR && Var->vclass != CLPROC &&
+		    ISICON((Var -> vleng))
+			&& (k = Var->vleng->constblock.Const.ci) > 0)
+		nice_printf (outfile, "[%ld]", (long)k);
+
+	    did_one = 1;
+	    last_type = nv_type (Var);
+	} /* for this_var */
+
+/* Handle the uninitialized equivalences */
+
+	do_uninit_equivs (outfile, &did_one);
+
+	if (did_one)
+	    nice_printf (outfile, ";\n\n");
+    } /* if new_vars */
+
+/* Write out builtin declarations */
+
+    if (used_builtins) {
+	chainp cp;
+	Extsym *es;
+
+	last_type = -1;
+	did_one = 0;
+
+	nice_printf (outfile, "/* Builtin functions */");
+
+	for (cp = used_builtins; cp; cp = cp -> nextp) {
+	    Addrp e = (Addrp)cp->datap;
+
+	    switch(type = e->vtype) {
+		case TYDREAL:
+		case TYREAL:
+			/* if (forcedouble || e->dbl_builtin) */
+			/* libF77 currently assumes everything double */
+			type = TYDREAL;
+			ctype = "double";
+			break;
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			type = TYVOID;
+			/* no break */
+		default:
+			ctype = c_type_decl(type, 0);
+		}
+
+	    if (did_one && last_type == type)
+		nice_printf(outfile, ", ");
+	    else
+		nice_printf(outfile, "%s\n%s ", did_one ? ";" : "", ctype);
+
+	    extern_out(outfile, es = &extsymtab[e -> memno]);
+	    proto(outfile, es->arginfo, es->fextname);
+	    last_type = type;
+	    did_one = 1;
+	} /* for cp = used_builtins */
+
+	nice_printf (outfile, ";\n\n");
+    } /* if used_builtins */
+
+    last_type = -1;
+    for (entry = hashtab; entry < lasthash; ++entry) {
+	var = entry -> varp;
+
+	if (var) {
+	    int procclass = var -> vprocclass;
+	    char *comment = NULL;
+	    int vclass = var -> vclass;
+	    stg = var -> vstg;
+	    type = var -> vtype;
+
+	    if (var->vrefused)
+		refdefs = mkchain((char *)var, refdefs);
+	    if (var->vsubscrused)
+		if (ISCOMPLEX(var->vtype))
+			var->vsubscrused = 0;
+		else
+			refdefs = mkchain((char *)var, refdefs);
+	    if (ONEOF(stg, M(STGARG)|M(STGLENG)|M(STGINIT)))
+		continue;
+
+	    if (useauto1 && stg == STGBSS && !var->vsave)
+		stg = STGAUTO;
+
+	    switch (vclass) {
+	        case CLVAR:
+		    break;
+		case CLPROC:
+		    switch(procclass) {
+			case PTHISPROC:
+				extsymtab[var->vardesc.varno].extype = type;
+				continue;
+			case PSTFUNCT:
+			case PINTRINSIC:
+				continue;
+			case PUNKNOWN:
+				err ("list_decls:  unknown procedure class");
+				continue;
+			case PEXTERNAL:
+				if (stg == STGUNKNOWN) {
+					warn1(
+					"%.64s declared EXTERNAL but never used.",
+						var->fvarname);
+					/* to retain names declared EXTERNAL */
+					/* but not referenced, change	*/
+					/* "continue" to "stg = STGEXT" */
+					continue;
+					}
+				else
+					type = fixexttype(var);
+			}
+		    break;
+		case CLUNKNOWN:
+			/* declared but never used */
+			continue;
+		case CLPARAM:
+			continue;
+		case CLNAMELIST:
+			if (var->visused)
+				namelists = mkchain((char *)var, namelists);
+			continue;
+		default:
+		    erri("list_decls:  can't handle class '%d' yet",
+			    vclass);
+		    Fatal(var->fvarname);
+		    continue;
+	    } /* switch */
+
+	    /* Might be equivalenced to a common.  If not, don't process */
+	    if (stg == STGCOMMON && !var->vcommequiv)
+		continue;
+
+/* Only write the header if system-generated locals, builtins, or
+   uninitialized equivs were already output */
+
+	    if (write_header == 1 && (new_vars || nequiv || used_builtins)
+		    && oneof_stg ( var, stg,
+		    M(STGBSS)|M(STGEXT)|M(STGAUTO)|M(STGCOMMON)|M(STGEQUIV))) {
+		nice_printf (outfile, "/* Local variables */\n");
+		write_header = 2;
+		}
+
+
+	    Alias = oneof_stg(var, stg, M(STGEQUIV)|M(STGCOMMON));
+	    if (Define = (Alias && def_equivs)) {
+		if (!write_header)
+			nice_printf(outfile, ";\n");
+		def_start(outfile, var->cvarname, CNULL, "(");
+		goto Alias1;
+		}
+	    else if (type == last_type && vclass == last_class &&
+		    stg == last_stg && !write_header)
+		nice_printf (outfile, ", ");
+	    else {
+		if (!write_header && ONEOF(stg, M(STGBSS)|
+		    M(STGEXT)|M(STGAUTO)|M(STGEQUIV)|M(STGCOMMON)))
+		    nice_printf (outfile, ";\n");
+
+		switch (stg) {
+		    case STGARG:
+		    case STGLENG:
+			/* Part of the argument list, don't write them out
+			   again */
+			continue;	    /* Go back to top of the loop */
+		    case STGBSS:
+		    case STGEQUIV:
+		    case STGCOMMON:
+			nice_printf (outfile, "static ");
+			break;
+		    case STGEXT:
+			nice_printf (outfile, "extern ");
+			break;
+		    case STGAUTO:
+			break;
+		    case STGINIT:
+		    case STGUNKNOWN:
+			/* Don't want to touch the initialized data, that will
+			   be handled elsewhere.  Unknown data have
+			   already been complained about, so skip them */
+			continue;
+		    default:
+			erri("list_decls:  can't handle storage class %d",
+				stg);
+			continue;
+		} /* switch */
+
+		if (type == TYCHAR && halign && vclass != CLPROC
+		&& ISICON(var->vleng)) {
+			nice_printf(outfile, "struct { %s fill; char val",
+				halign);
+			x = wr_char_len(outfile, var->vdim,
+				var->vleng->constblock.Const.ci, 1);
+			if (x %= hsize)
+				nice_printf(outfile, "; char fill2[%ld]",
+					hsize - x);
+			nice_printf(outfile, "; } %s_st;\n", var->cvarname);
+			def_start(outfile, var->cvarname, CNULL, var->cvarname);
+			margin_printf(outfile, "_st.val\n");
+			last_type = -1;
+			write_header = 2;
+			continue;
+			}
+		nice_printf(outfile, "%s ",
+			c_type_decl(type, vclass == CLPROC));
+	    } /* else */
+
+/* Character type is really a string type.  Put out a '*' for variable
+   length strings, and also for equivalences */
+
+	    if (type == TYCHAR && vclass != CLPROC
+		    && (!var->vleng || !ISICON (var -> vleng))
+	    || oneof_stg(var, stg, M(STGEQUIV)|M(STGCOMMON)))
+		nice_printf (outfile, "*%s", var->cvarname);
+	    else {
+		nice_printf (outfile, "%s", var->cvarname);
+		if (vclass == CLPROC) {
+			Argtypes *at;
+			if (!(at = var->arginfo)
+			 && var->vprocclass == PEXTERNAL)
+				at = extsymtab[var->vardesc.varno].arginfo;
+			proto(outfile, at, var->fvarname);
+			}
+		else if (type == TYCHAR && ISICON ((var -> vleng)))
+			wr_char_len(outfile, var->vdim,
+				var->vleng->constblock.Const.ci, 0);
+		else if (var -> vdim &&
+		    !oneof_stg (var, stg, M(STGEQUIV)|M(STGCOMMON)))
+			comment = wr_ardecls(outfile, var->vdim, 1L);
+		}
+
+	    if (comment)
+		nice_printf (outfile, "%s", comment);
+ Alias1:
+	    if (Alias) {
+		char *amp, *lp, *name, *rp;
+		ftnint voff = var -> voffset;
+		int et0, expr_type, k;
+		Extsym *E;
+		struct Equivblock *eb;
+		char buf[MAXNAMELEN+30]; /*30 should be overkill*/
+
+/* We DON'T want to use oneof_stg here, because we need to distinguish
+   between them */
+
+		if (stg == STGEQUIV) {
+			name = equiv_name(k = var->vardesc.varno, CNULL);
+			eb = eqvclass + k;
+			if (eb->eqvinit) {
+				amp = "&";
+				et0 = TYERROR;
+				}
+			else {
+				amp = "";
+				et0 = eb->eqvtype;
+				}
+			expr_type = et0;
+		    }
+		else {
+			E = &extsymtab[var->vardesc.varno];
+			sprintf(name = buf, "%s%d", E->cextname, E->curno);
+			expr_type = type;
+			et0 = -1;
+			amp = "&";
+		} /* else */
+
+		if (!Define)
+			nice_printf (outfile, " = ");
+		if (voff) {
+			k = typesize[type];
+			switch((int)(voff % k)) {
+				case 0:
+					voff /= k;
+					expr_type = type;
+					break;
+				case SZSHORT:
+				case SZSHORT+SZLONG:
+					expr_type = TYSHORT;
+					voff /= SZSHORT;
+					break;
+				case SZLONG:
+					expr_type = TYLONG;
+					voff /= SZLONG;
+					break;
+				default:
+					expr_type = TYCHAR;
+				}
+			}
+
+		if (expr_type == type) {
+			lp = rp = "";
+			if (et0 == -1 && !voff)
+				goto cast;
+			}
+		else {
+			lp = "(";
+			rp = ")";
+ cast:
+			nice_printf(outfile, "(%s *)", c_type_decl(type, 0));
+			}
+
+/* Now worry about computing the offset */
+
+		if (voff) {
+		    if (expr_type == et0)
+			nice_printf (outfile, "%s%s + %ld%s",
+				lp, name, voff, rp);
+		    else
+			nice_printf(outfile, "%s(%s *)%s%s + %ld%s", lp,
+				c_type_decl (expr_type, 0), amp,
+				name, voff, rp);
+		} else
+		    nice_printf(outfile, "%s%s", amp, name);
+/* Always put these at the end of the line */
+		last_type = last_class = last_stg = -1;
+		write_header = 0;
+		if (Define) {
+			margin_printf(outfile, ")\n");
+			write_header = 2;
+			}
+		continue;
+		}
+	    write_header = 0;
+	    last_type = type;
+	    last_class = vclass;
+	    last_stg = stg;
+	} /* if (var) */
+    } /* for (entry = hashtab */
+
+    if (!write_header)
+	nice_printf (outfile, ";\n\n");
+    else if (write_header == 2)
+	nice_printf(outfile, "\n");
+
+/* Next, namelists, which may reference equivs */
+
+    if (namelists) {
+	write_namelists(namelists = revchain(namelists), outfile);
+	frchain(&namelists);
+	}
+
+/* Finally, ioblocks (which may reference equivs and namelists) */
+    if (iob_list)
+	write_ioblocks(outfile);
+    if (assigned_fmts)
+	write_assigned_fmts(outfile);
+
+    if (refdefs)
+	ref_defs(outfile, refdefs);
+
+    if (trapuv) {
+	for (entry = hashtab; entry < lasthash; ++entry)
+	    if ((var = entry->varp)
+		&& ONEOF(var->vstg, M(STGAUTO)|M(STGBSS))
+		&& ISNUMERIC(var->vtype)
+		&& var->vclass == CLVAR
+		&& !var->vsave)
+			nice_printf(outfile, "_uninit_f2c(&%s,%d,%ldL);\n",
+				var->cvarname, typeconv[var->vtype],
+				n_elt(var->vdim));
+	}
+
+} /* list_decls */
+
+ void
+#ifdef KR_headers
+do_uninit_equivs(outfile, did_one)
+	FILE *outfile;
+	int *did_one;
+#else
+do_uninit_equivs(FILE *outfile, int *did_one)
+#endif
+{
+    extern int nequiv;
+    struct Equivblock *eqv, *lasteqv = eqvclass + nequiv;
+    int k, last_type = -1, t;
+
+    for (eqv = eqvclass; eqv < lasteqv; eqv++)
+	if (!eqv -> eqvinit && eqv -> eqvtop != eqv -> eqvbottom) {
+	    if (!*did_one)
+		nice_printf (outfile, "/* System generated locals */\n");
+	    t = eqv->eqvtype;
+	    if (last_type == t)
+		nice_printf (outfile, ", ");
+	    else {
+		if (*did_one)
+		    nice_printf (outfile, ";\n");
+		nice_printf (outfile, "static %s ", c_type_decl(t, 0));
+		k = typesize[t];
+	    } /* else */
+	    nice_printf(outfile, "%s", equiv_name((int)(eqv - eqvclass), CNULL));
+	    nice_printf(outfile, "[%ld]",
+		(eqv->eqvtop - eqv->eqvbottom + k - 1) / k);
+	    last_type = t;
+	    *did_one = 1;
+	} /* if !eqv -> eqvinit */
+} /* do_uninit_equivs */
+
+
+/* wr_ardecls -- Writes the brackets and size for an array
+   declaration.  Because of the inner workings of the compiler,
+   multi-dimensional arrays get mapped directly into a one-dimensional
+   array, so we have to compute the size of the array here.  When the
+   dimension is greater than 1, a string comment about the original size
+   is returned */
+
+ char *
+#ifdef KR_headers
+wr_ardecls(outfile, dimp, size)
+	FILE *outfile;
+	struct Dimblock *dimp;
+	long size;
+#else
+wr_ardecls(FILE *outfile, struct Dimblock *dimp, long size)
+#endif
+{
+    int i, k;
+    ftnint j;
+    static char buf[1000];
+
+    if (dimp == (struct Dimblock *) NULL)
+	return NULL;
+
+    sprintf(buf, "\t/* was ");	/* would like to say  k = sprintf(...), but */
+    k = strlen(buf);		/* BSD doesn't return char transmitted count */
+
+    for (i = 0; i < dimp -> ndim; i++) {
+	expptr this_size = dimp -> dims[i].dimsize;
+
+	if (ISCONST(this_size)) {
+		if (ISINT(this_size->constblock.vtype))
+			j = this_size -> constblock.Const.ci;
+		else if (ISREAL(this_size->constblock.vtype))
+			j = (ftnint)this_size -> constblock.Const.cd[0];
+		else
+			goto non_const;
+		size *= j;
+	   	sprintf(buf+k, "[%ld]", j);
+	    	k += strlen(buf+k);
+		/* BSD prevents getting strlen from sprintf */
+		}
+	else {
+ non_const:
+	    err ("wr_ardecls:  nonconstant array size");
+		}
+    } /* for i = 0 */
+
+    nice_printf (outfile, "[%ld]", size);
+    strcat(buf+k, " */");
+
+    return (i > 1) ? buf : NULL;
+} /* wr_ardecls */
+
+
+
+/* ----------------------------------------------------------------------
+
+	The following routines read from the p1 intermediate file.  If
+   that format changes, only these routines need be changed
+
+   ---------------------------------------------------------------------- */
+
+ static int
+#ifdef KR_headers
+get_p1_token(infile)
+	FILE *infile;
+#else
+get_p1_token(FILE *infile)
+#endif
+{
+    int token = P1_UNKNOWN;
+
+/* NOT PORTABLE!! */
+
+    if (fscanf (infile, "%d", &token) == EOF)
+	return P1_EOF;
+
+/* Skip over the ": " */
+
+    if (getc (infile) != '\n')
+	getc (infile);
+
+    return token;
+} /* get_p1_token */
+
+
+
+/* Returns a (null terminated) string from the input file */
+
+ static int
+#ifdef KR_headers
+p1gets(fp, str, size)
+	FILE *fp;
+	char *str;
+	int size;
+#else
+p1gets(FILE *fp, char *str, int size)
+#endif
+{
+    char c;
+
+    if (str == NULL)
+	return 0;
+
+    if ((c = getc (fp)) != ' ')
+	ungetc (c, fp);
+
+    if (fgets (str, size, fp)) {
+	int length;
+
+	str[size - 1] = '\0';
+	length = strlen (str);
+
+/* Get rid of the newline */
+
+	if (str[length - 1] == '\n')
+	    str[length - 1] = '\0';
+	return 1;
+
+    } else if (feof (fp))
+	return EOF;
+    else
+	return 0;
+} /* p1gets */
+
+
+#ifndef NO_LONG_LONG
+ static int
+#ifdef KR_headers
+p1getq(infile, result) FILE *infile; Llong *result;
+#else
+p1getq(FILE *infile, Llong *result)
+#endif
+{
+#ifdef __FreeBSD__
+#ifndef NO_FSCANF_LL_BUG
+#define FSCANF_LL_BUG
+#endif
+#endif
+#ifdef FSCANF_LL_BUG
+	ULlong x = 0;
+	int c, have_c = 0;
+	for(;;) {
+		c = getc(infile);
+		if (c == EOF)
+			break;
+		if (c <= ' ') {
+			if (!have_c)
+				continue;
+			goto done;
+			}
+		if (c >= '0' && c <= '9')
+			c -= '0';
+		else if (c >= 'a' && c <= 'f')
+			c += 10 - 'a';
+		else if (c >= 'A' && c <= 'F')
+			c += 10 - 'A';
+		else {
+ done:
+			ungetc(c, infile);
+			break;
+			}
+		x = x << 4 | c;
+		have_c = 1;
+		}
+	if (have_c) {
+		*result = (Llong)x;
+		return 1;
+		}
+	return 0;
+#else
+	return fscanf(infile, "%llx", result);
+#endif
+	}
+#endif
+
+ static int
+#ifdef KR_headers
+p1get_const(infile, type, resultp)
+	FILE *infile;
+	int type;
+	struct Constblock **resultp;
+#else
+p1get_const(FILE *infile, int type, struct Constblock **resultp)
+#endif
+{
+    int status;
+    unsigned long a;
+    struct Constblock *result;
+
+	if (type != TYCHAR) {
+		*resultp = result = ALLOC(Constblock);
+		result -> tag = TCONST;
+		result -> vtype = type;
+		}
+
+    switch (type) {
+	case TYINT1:
+        case TYSHORT:
+	case TYLONG:
+	case TYLOGICAL:
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+	    status = p1getd (infile, &(result -> Const.ci));
+	    break;
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		status = p1getq(infile, &result->Const.cq);
+		break;
+#endif
+	case TYREAL:
+	case TYDREAL:
+	    status = p1getf(infile, &result->Const.cds[0]);
+	    result->vstg = 1;
+	    break;
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+	    status = p1getf(infile, &result->Const.cds[0]);
+	    if (status && status != EOF)
+		status = p1getf(infile, &result->Const.cds[1]);
+	    result->vstg = 1;
+	    break;
+	case TYCHAR:
+	    status = fscanf(infile, "%lx", &a);
+	    *resultp = (struct Constblock *) a;
+	    break;
+	default:
+	    erri ("p1get_const:  bad constant type '%d'", type);
+	    status = 0;
+	    break;
+    } /* switch */
+
+    return status;
+} /* p1get_const */
+
+ static int
+#ifdef KR_headers
+p1getd(infile, result)
+	FILE *infile;
+	long *result;
+#else
+p1getd(FILE *infile, long *result)
+#endif
+{
+    return fscanf (infile, "%ld", result);
+} /* p1getd */
+
+ static int
+#ifdef KR_headers
+p1getf(infile, result)
+	FILE *infile;
+	char **result;
+#else
+p1getf(FILE *infile, char **result)
+#endif
+{
+
+	char buf[1324];
+	register int k;
+
+	k = fscanf (infile, "%s", buf);
+	if (k < 1)
+		k = EOF;
+	else
+		strcpy(*result = mem(strlen(buf)+1,0), buf);
+	return k;
+}
+
+ static int
+#ifdef KR_headers
+p1getn(infile, count, result)
+	FILE *infile;
+	int count;
+	char **result;
+#else
+p1getn(FILE *infile, int count, char **result)
+#endif
+{
+
+    char *bufptr;
+
+    bufptr = (char *) ckalloc (count);
+
+    if (result)
+	*result = bufptr;
+
+    for (; !feof (infile) && count > 0; count--)
+	*bufptr++ = getc (infile);
+
+    return feof (infile) ? EOF : 1;
+} /* p1getn */
+
+ static void
+#ifdef KR_headers
+proto(outfile, at, fname)
+	FILE *outfile;
+	Argtypes *at;
+	char *fname;
+#else
+proto(FILE *outfile,  Argtypes *at,  char *fname)
+#endif
+{
+	int i, j, k, n;
+	char *comma;
+	Atype *atypes;
+	Namep np;
+	chainp cp;
+
+	if (at) {
+		/* Correct types that we learn on the fly, e.g.
+			subroutine gotcha(foo)
+			external foo
+			call zap(...,foo,...)
+			call foo(...)
+		*/
+		atypes = at->atypes;
+		n = at->defined ? at->dnargs : at->nargs;
+		for(i = 0; i++ < n; atypes++) {
+			if (!(cp = atypes->cp))
+				continue;
+			j = atypes->type;
+			do {
+				np = (Namep)cp->datap;
+				k = np->vtype;
+				if (np->vclass == CLPROC) {
+					if (!np->vimpltype && k)
+						k += 200;
+					else {
+						if (j >= 300)
+							j = TYUNKNOWN + 200;
+						continue;
+						}
+					}
+				if (j == k)
+					continue;
+				if (j >= 300
+				||  j == 200 && k >= 200)
+					j = k;
+				else {
+					if (at->nargs >= 0)
+					   bad_atypes(at,fname,i,j,k,""," and");
+					goto break2;
+					}
+				}
+				while(cp = cp->nextp);
+			atypes->type = j;
+			frchain(&atypes->cp);
+			}
+		}
+ break2:
+	if (parens) {
+		nice_printf(outfile, parens);
+		return;
+		}
+
+	if (!at || (n = at-> defined ? at->dnargs : at->nargs) < 0) {
+		nice_printf(outfile, Ansi == 1 ? "()" : "(...)");
+		return;
+		}
+
+	if (n == 0) {
+		nice_printf(outfile, Ansi == 1 ? "(void)" : "()");
+		return;
+		}
+
+	atypes = at->atypes;
+	nice_printf(outfile, "(");
+	comma = "";
+	for(; --n >= 0; atypes++) {
+		k = atypes->type;
+		if (k == TYADDR)
+			nice_printf(outfile, "%schar **", comma);
+		else if (k >= 200) {
+			k -= 200;
+			if (k >= 100)
+				k -= 100;
+			nice_printf(outfile, "%s%s", comma,
+				usedcasts[k] = casttypes[k]);
+			}
+		else if (k >= 100)
+			nice_printf(outfile,
+					k == TYCHAR + 100 ? "%s%s *" : "%s%s",
+					comma, c_type_decl(k-100, 0));
+		else
+			nice_printf(outfile, "%s%s *", comma,
+					c_type_decl(k, 0));
+		comma = ", ";
+		}
+	nice_printf(outfile, ")");
+	}
+
+ void
+#ifdef KR_headers
+protowrite(protofile, type, name, e, lengths)
+	FILE *protofile;
+	int type;
+	char *name;
+	struct Entrypoint *e;
+	chainp lengths;
+#else
+protowrite(FILE *protofile, int type, char *name, struct Entrypoint *e, chainp lengths)
+#endif
+{
+	extern char used_rets[];
+	int asave;
+
+	if (!(asave = Ansi))
+		Castargs = Ansi = 1;
+	nice_printf(protofile, "extern %s %s", protorettypes[type], name);
+	list_arg_types(protofile, e, lengths, 0, ";\n");
+	used_rets[type] = 1;
+	if (!(Ansi = asave))
+		Castargs = 0;
+	}
+
+ static void
+#ifdef KR_headers
+do_p1_1while(outfile)
+	FILE *outfile;
+#else
+do_p1_1while(FILE *outfile)
+#endif
+{
+	if (*wh_next) {
+		nice_printf(outfile,
+			"for(;;) { /* while(complicated condition) */\n" /*}*/ );
+		next_tab(outfile);
+		}
+	else
+		nice_printf(outfile, "while(" /*)*/ );
+	}
+
+ static void
+#ifdef KR_headers
+do_p1_2while(infile, outfile)
+	FILE *infile;
+	FILE *outfile;
+#else
+do_p1_2while(FILE *infile, FILE *outfile)
+#endif
+{
+	expptr test;
+
+	test = do_format(infile, outfile);
+	if (*wh_next)
+		nice_printf(outfile, "if (!(");
+	expr_out(outfile, test);
+	if (*wh_next++)
+		nice_printf(outfile, "))\n\tbreak;\n");
+	else {
+		nice_printf(outfile, /*(*/ ") {\n");
+		next_tab(outfile);
+		}
+	}
+
+ static void
+#ifdef KR_headers
+do_p1_elseifstart(outfile)
+	FILE *outfile;
+#else
+do_p1_elseifstart(FILE *outfile)
+#endif
+{ /* with sufficiently illegal input, ei_next == ei_last == 0 is possible */
+	if (ei_next < ei_last && *ei_next++) {
+		prev_tab(outfile);
+		nice_printf(outfile, /*{*/
+			"} else /* if(complicated condition) */ {\n" /*}*/ );
+		next_tab(outfile);
+		}
+	}
diff --git a/contrib/tools/f2c/src/format.h b/contrib/tools/f2c/src/format.h
new file mode 100644
index 0000000000..3de97f6f89
--- /dev/null
+++ b/contrib/tools/f2c/src/format.h
@@ -0,0 +1,12 @@
+#define DEF_C_LINE_LENGTH 77
+/* actual max will be 79 */
+
+extern int c_output_line_length;	/* max # chars per line in C source
+					   code */
+
+chainp	data_value Argdcl((FILEP, long int, int));
+int	do_init_data Argdcl((FILEP, FILEP));
+void	list_init_data Argdcl((FILEP*, char*, FILEP));
+char*	wr_ardecls Argdcl((FILEP, struct Dimblock*, long int));
+void	wr_one_init Argdcl((FILEP, char*, chainp*, int));
+void	wr_output_values Argdcl((FILEP, Namep, chainp));
diff --git a/contrib/tools/f2c/src/formatdata.c b/contrib/tools/f2c/src/formatdata.c
new file mode 100644
index 0000000000..c399c61869
--- /dev/null
+++ b/contrib/tools/f2c/src/formatdata.c
@@ -0,0 +1,1263 @@
+/****************************************************************
+Copyright 1990-1, 1993-6, 1999-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "output.h"
+#include "names.h"
+#include "format.h"
+
+#define MAX_INIT_LINE 100
+#define VNAME_MAX 64
+
+static int memno2info Argdcl((int, Namep*));
+
+typedef unsigned long Ulong;
+
+ extern char *initbname;
+
+ void
+#ifdef KR_headers
+list_init_data(Infile, Inname, outfile)
+	FILE **Infile;
+	char *Inname;
+	FILE *outfile;
+#else
+list_init_data(FILE **Infile, char *Inname, FILE *outfile)
+#endif
+{
+    FILE *sortfp;
+    int status;
+
+    fclose(*Infile);
+    *Infile = 0;
+
+    if (status = dsort(Inname, sortfname))
+	fatali ("sort failed, status %d", status);
+
+    scrub(Inname); /* optionally unlink Inname */
+
+    if ((sortfp = fopen(sortfname, textread)) == NULL)
+	Fatal("Couldn't open sorted initialization data");
+
+    do_init_data(outfile, sortfp);
+    fclose(sortfp);
+    scrub(sortfname);
+
+/* Insert a blank line after any initialized data */
+
+	nice_printf (outfile, "\n");
+
+    if (debugflag && infname)
+	 /* don't back block data file up -- it won't be overwritten */
+	backup(initfname, initbname);
+} /* list_init_data */
+
+
+
+/* do_init_data -- returns YES when at least one declaration has been
+   written */
+
+ int
+#ifdef KR_headers
+do_init_data(outfile, infile)
+	FILE *outfile;
+	FILE *infile;
+#else
+do_init_data(FILE *outfile, FILE *infile)
+#endif
+{
+    char varname[VNAME_MAX], ovarname[VNAME_MAX];
+    ftnint offset;
+    ftnint type;
+    int vargroup;	/* 0 --> init, 1 --> equiv, 2 --> common */
+    int did_one = 0;		/* True when one has been output */
+    chainp values = CHNULL;	/* Actual data values */
+    int keepit = 0;
+    Namep np;
+
+    ovarname[0] = '\0';
+
+    while (rdname (infile, &vargroup, varname) && rdlong (infile, &offset)
+	    && rdlong (infile, &type)) {
+	if (strcmp (varname, ovarname)) {
+
+	/* If this is a new variable name, the old initialization has been
+	   completed */
+
+		wr_one_init(outfile, ovarname, &values, keepit);
+
+		strcpy (ovarname, varname);
+		values = CHNULL;
+		if (vargroup == 0) {
+			if (memno2info(atoi(varname+2), &np)) {
+				if (((Addrp)np)->uname_tag != UNAM_NAME) {
+					err("do_init_data: expected NAME");
+					goto Keep;
+					}
+				np = ((Addrp)np)->user.name;
+				}
+			if (!(keepit = np->visused) && !np->vimpldovar)
+				warn1("local variable %s never used",
+					np->fvarname);
+			}
+		else {
+ Keep:
+			keepit = 1;
+			}
+		if (keepit && !did_one) {
+			nice_printf (outfile, "/* Initialized data */\n\n");
+			did_one = YES;
+			}
+	} /* if strcmp */
+
+	values = mkchain((char *)data_value(infile, offset, (int)type), values);
+    } /* while */
+
+/* Write out the last declaration */
+
+    wr_one_init (outfile, ovarname, &values, keepit);
+
+    return did_one;
+} /* do_init_data */
+
+
+ ftnint
+#ifdef KR_headers
+wr_char_len(outfile, dimp, n, extra1)
+	FILE *outfile;
+	struct Dimblock *dimp;
+	ftnint n;
+	int extra1;
+#else
+wr_char_len(FILE *outfile, struct Dimblock *dimp, ftnint n, int extra1)
+#endif
+{
+	int i, nd;
+	expptr e;
+	ftnint j, rv;
+
+	if (!dimp) {
+		nice_printf (outfile, extra1 ? "[%ld+1]" : "[%ld]", (long)n);
+		return n + extra1;
+		}
+	nice_printf(outfile, "[%ld", (long)n);
+	nd = dimp->ndim;
+	rv = n;
+	for(i = 0; i < nd; i++) {
+		e = dimp->dims[i].dimsize;
+		if (ISCONST(e)) {
+			if (ISINT(e->constblock.vtype))
+				j = e->constblock.Const.ci;
+			else if (ISREAL(e->constblock.vtype))
+				j = (ftnint)e->constblock.Const.cd[0];
+			else
+				goto non_const;
+			nice_printf(outfile, "*%ld", j);
+			rv *= j;
+			}
+		else {
+ non_const:
+			err ("wr_char_len:  nonconstant array size");
+			}
+		}
+	/* extra1 allows for stupid C compilers that complain about
+	 * too many initializers in
+	 *	char x[2] = "ab";
+	 */
+	nice_printf(outfile, extra1 ? "+1]" : "]");
+	return extra1 ? rv+1 : rv;
+	}
+
+ static int ch_ar_dim = -1; /* length of each element of char string array */
+ static int eqvmemno;	/* kludge */
+
+ static void
+#ifdef KR_headers
+write_char_init(outfile, Values, namep)
+	FILE *outfile;
+	chainp *Values;
+	Namep namep;
+#else
+write_char_init(FILE *outfile, chainp *Values, Namep namep)
+#endif
+{
+	struct Equivblock *eqv;
+	long size;
+	struct Dimblock *dimp;
+	int i, nd, type;
+	ftnint j;
+	expptr ds;
+
+	if (!namep)
+		return;
+	if(nequiv >= maxequiv)
+		many("equivalences", 'q', maxequiv);
+	eqv = &eqvclass[nequiv];
+	eqv->eqvbottom = 0;
+	type = namep->vtype;
+	size = type == TYCHAR
+		? namep->vleng->constblock.Const.ci
+		: typesize[type];
+	if (dimp = namep->vdim)
+		for(i = 0, nd = dimp->ndim; i < nd; i++) {
+			ds = dimp->dims[i].dimsize;
+			if (ISCONST(ds)) {
+				if (ISINT(ds->constblock.vtype))
+					j = ds->constblock.Const.ci;
+				else if (ISREAL(ds->constblock.vtype))
+					j = (ftnint)ds->constblock.Const.cd[0];
+				else
+					goto non_const;
+				size *= j;
+				}
+			else {
+ non_const:
+				err("write_char_values: nonconstant array size");
+				}
+			}
+	*Values = revchain(*Values);
+	eqv->eqvtop = size;
+	eqvmemno = ++lastvarno;
+	eqv->eqvtype = type;
+	wr_equiv_init(outfile, nequiv, Values, 0);
+	def_start(outfile, namep->cvarname, CNULL, "");
+	if (type == TYCHAR)
+		margin_printf(outfile, "((char *)&equiv_%d)\n\n", eqvmemno);
+	else
+		margin_printf(outfile, dimp
+			? "((%s *)&equiv_%d)\n\n" : "(*(%s *)&equiv_%d)\n\n",
+			c_type_decl(type,0), eqvmemno);
+	}
+
+/* wr_one_init -- outputs the initialization of the variable pointed to
+   by   info.   When   is_addr   is true,   info   is an Addrp; otherwise,
+   treat it as a Namep */
+
+ void
+#ifdef KR_headers
+wr_one_init(outfile, varname, Values, keepit)
+	FILE *outfile;
+	char *varname;
+	chainp *Values;
+	int keepit;
+#else
+wr_one_init(FILE *outfile, char *varname, chainp *Values, int keepit)
+#endif
+{
+    static int memno;
+    static union {
+	Namep name;
+	Addrp addr;
+    } info;
+    Namep namep;
+    int is_addr, size, type;
+    ftnint last, loc;
+    int is_scalar = 0;
+    char *array_comment = NULL, *name;
+    chainp cp, values;
+    extern char datachar[];
+    static int e1[3] = {1, 0, 1};
+    ftnint x;
+    extern int hsize;
+
+    if (!keepit)
+	goto done;
+    if (varname == NULL || varname[1] != '.')
+	goto badvar;
+
+/* Get back to a meaningful representation; find the given   memno in one
+   of the appropriate tables (user-generated variables in the hash table,
+   system-generated variables in a separate list */
+
+    memno = atoi(varname + 2);
+    switch(varname[0]) {
+	case 'q':
+		/* Must subtract eqvstart when the source file
+		 * contains more than one procedure.
+		 */
+		wr_equiv_init(outfile, eqvmemno = memno - eqvstart, Values, 0);
+		goto done;
+	case 'Q':
+		/* COMMON initialization (BLOCK DATA) */
+		wr_equiv_init(outfile, memno, Values, 1);
+		goto done;
+	case 'v':
+		break;
+	default:
+ badvar:
+		errstr("wr_one_init:  unknown variable name '%s'", varname);
+		goto done;
+	}
+
+    is_addr = memno2info (memno, &info.name);
+    if (info.name == (Namep) NULL) {
+	err ("wr_one_init -- unknown variable");
+	return;
+	}
+    if (is_addr) {
+	if (info.addr -> uname_tag != UNAM_NAME) {
+	    erri ("wr_one_init -- couldn't get name pointer; tag is %d",
+		    info.addr -> uname_tag);
+	    namep = (Namep) NULL;
+	    nice_printf (outfile, " /* bad init data */");
+	} else
+	    namep = info.addr -> user.name;
+    } else
+	namep = info.name;
+
+	/* check for character initialization */
+
+    *Values = values = revchain(*Values);
+    type = info.name->vtype;
+    if (type == TYCHAR) {
+	for(last = 0; values; values = values->nextp) {
+		cp = (chainp)values->datap;
+		loc = (ftnint)cp->datap;
+		if (loc > last) {
+			write_char_init(outfile, Values, namep);
+			goto done;
+			}
+		last = (Ulong)cp->nextp->datap == TYBLANK
+			? loc + (Ulong)cp->nextp->nextp->datap
+			: loc + 1;
+		}
+	if (halign && info.name->tag == TNAME) {
+		nice_printf(outfile, "static struct { %s fill; char val",
+			halign);
+		x = wr_char_len(outfile, namep->vdim, ch_ar_dim =
+			info.name -> vleng -> constblock.Const.ci, 1);
+		if (x %= hsize)
+			nice_printf(outfile, "; char fill2[%ld]", hsize - x);
+		name = info.name->cvarname;
+		nice_printf(outfile, "; } %s_st = { 0,", name);
+		wr_output_values(outfile, namep, *Values);
+		nice_printf(outfile, " };\n");
+		ch_ar_dim = -1;
+		def_start(outfile, name, CNULL, name);
+		margin_printf(outfile, "_st.val\n");
+		goto done;
+		}
+	}
+    else {
+	size = typesize[type];
+	loc = 0;
+	for(; values; values = values->nextp) {
+		if ((Ulong)((chainp)values->datap)->nextp->datap == TYCHAR) {
+			write_char_init(outfile, Values, namep);
+			goto done;
+			}
+		last = ((long) ((chainp) values->datap)->datap) / size;
+		if (last - loc > 4) {
+			write_char_init(outfile, Values, namep);
+			goto done;
+			}
+		loc = last;
+		}
+	}
+    values = *Values;
+
+    nice_printf (outfile, "static %s ", c_type_decl (type, 0));
+
+    if (is_addr)
+	write_nv_ident (outfile, info.addr);
+    else
+	out_name (outfile, info.name);
+
+    if (namep)
+	is_scalar = namep -> vdim == (struct Dimblock *) NULL;
+
+    if (namep && !is_scalar)
+	array_comment = type == TYCHAR
+		? 0 : wr_ardecls(outfile, namep->vdim, 1L);
+
+    if (type == TYCHAR)
+	if (ISICON (info.name -> vleng))
+
+/* We'll make single strings one character longer, so that we can use the
+   standard C initialization.  All this does is pad an extra zero onto the
+   end of the string */
+		wr_char_len(outfile, namep->vdim, ch_ar_dim =
+			info.name -> vleng -> constblock.Const.ci, e1[Ansi]);
+	else
+		err ("variable length character initialization");
+
+    if (array_comment)
+	nice_printf (outfile, "%s", array_comment);
+
+    nice_printf (outfile, " = ");
+    wr_output_values (outfile, namep, values);
+    ch_ar_dim = -1;
+    nice_printf (outfile, ";\n");
+ done:
+    frchain(Values);
+} /* wr_one_init */
+
+
+
+
+ chainp
+#ifdef KR_headers
+data_value(infile, offset, type)
+	FILE *infile;
+	ftnint offset;
+	int type;
+#else
+data_value(FILE *infile, ftnint offset, int type)
+#endif
+{
+    char line[MAX_INIT_LINE + 1], *pointer;
+    chainp vals, prev_val;
+    char *newval;
+
+    if (fgets (line, MAX_INIT_LINE, infile) == NULL) {
+	err ("data_value:  error reading from intermediate file");
+	return CHNULL;
+    } /* if fgets */
+
+/* Get rid of the trailing newline */
+
+    if (line[0])
+	line[strlen (line) - 1] = '\0';
+
+#define iswhite(x) (isspace (x) || (x) == ',')
+
+    pointer = line;
+    prev_val = vals = CHNULL;
+
+    while (*pointer) {
+	register char *end_ptr, old_val;
+
+/* Move   pointer   to the start of the next word */
+
+	while (*pointer && iswhite (*pointer))
+	    pointer++;
+	if (*pointer == '\0')
+	    break;
+
+/* Move   end_ptr   to the end of the current word */
+
+	for (end_ptr = pointer + 1; *end_ptr && !iswhite (*end_ptr);
+		end_ptr++)
+	    ;
+
+	old_val = *end_ptr;
+	*end_ptr = '\0';
+
+/* Add this value to the end of the list */
+
+#ifdef NO_LONG_LONG
+	if (ONEOF(type, MSKREAL|MSKCOMPLEX))
+#else
+	if (ONEOF(type, MSKREAL|MSKCOMPLEX|M(TYQUAD)))
+#endif
+		newval = cpstring(pointer);
+	else
+		newval = (char *)atol(pointer);
+	if (vals) {
+	    prev_val->nextp = mkchain(newval, CHNULL);
+	    prev_val = prev_val -> nextp;
+	} else
+	    prev_val = vals = mkchain(newval, CHNULL);
+	*end_ptr = old_val;
+	pointer = end_ptr;
+    } /* while *pointer */
+
+    return mkchain((char *)offset, mkchain((char *)(Ulong)type, vals));
+} /* data_value */
+
+ static void
+overlapping(Void)
+{
+	extern char *filename0;
+	static int warned = 0;
+
+	if (warned)
+		return;
+	warned = 1;
+
+	fprintf(stderr, "Error");
+	if (filename0)
+		fprintf(stderr, " in file %s", filename0);
+	fprintf(stderr, ": overlapping initializations\n");
+	nerr++;
+	}
+
+ static void make_one_const Argdcl((int, union Constant*, chainp));
+ static long charlen;
+
+ void
+#ifdef KR_headers
+wr_output_values(outfile, namep, values)
+	FILE *outfile;
+	Namep namep;
+	chainp values;
+#else
+wr_output_values(FILE *outfile, Namep namep, chainp values)
+#endif
+{
+	int type = TYUNKNOWN;
+	struct Constblock Const;
+	static expptr Vlen;
+
+	if (namep)
+		type = namep -> vtype;
+
+/* Handle array initializations away from scalars */
+
+	if (namep && namep -> vdim)
+		wr_array_init (outfile, type, values);
+
+	else if (values->nextp && type != TYCHAR)
+		overlapping();
+
+	else {
+		make_one_const(type, &Const.Const, values);
+		Const.vtype = type;
+		Const.vstg = ONEOF(type, MSKREAL|MSKCOMPLEX) != 0;
+		if (type== TYCHAR) {
+			if (!Vlen)
+				Vlen = ICON(0);
+			Const.vleng = Vlen;
+			Vlen->constblock.Const.ci = charlen;
+			out_const (outfile, &Const);
+			free (Const.Const.ccp);
+			}
+		else {
+#ifndef NO_LONG_LONG
+			if (type == TYQUAD)
+				Const.Const.cd[1] = 123.456; /* kludge */
+				/* kludge assumes max(sizeof(char*), */
+				/* sizeof(long long)) <= sizeof(double) */
+#endif
+			out_const (outfile, &Const);
+			}
+		}
+	}
+
+
+ void
+#ifdef KR_headers
+wr_array_init(outfile, type, values)
+	FILE *outfile;
+	int type;
+	chainp values;
+#else
+wr_array_init(FILE *outfile, int type, chainp values)
+#endif
+{
+    int size = typesize[type];
+    long index, main_index = 0;
+    int k;
+
+    if (type == TYCHAR) {
+	nice_printf(outfile, "\"");
+	k = 0;
+	if (Ansi != 1)
+		ch_ar_dim = -1;
+	}
+    else
+	nice_printf (outfile, "{ ");
+    while (values) {
+	struct Constblock Const;
+
+	index = ((long) ((chainp) values->datap)->datap) / size;
+	while (index > main_index) {
+
+/* Fill with zeros.  The structure shorthand works because the compiler
+   will expand the "0" in braces to fill the size of the entire structure
+   */
+
+	    switch (type) {
+	        case TYREAL:
+		case TYDREAL:
+		    nice_printf (outfile, "0.0,");
+		    break;
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+		    nice_printf (outfile, "{0},");
+		    break;
+		case TYCHAR:
+			nice_printf(outfile, " ");
+			break;
+		default:
+		    nice_printf (outfile, "0,");
+		    break;
+	    } /* switch */
+	    main_index++;
+	} /* while index > main_index */
+
+	if (index < main_index)
+		overlapping();
+	else switch (type) {
+	    case TYCHAR:
+		{ int this_char;
+
+		if (k == ch_ar_dim) {
+			nice_printf(outfile, "\" \"");
+			k = 0;
+			}
+		this_char = (int)(Ulong) ((chainp) values->datap)->
+				nextp->nextp->datap;
+		if ((Ulong)((chainp)values->datap)->nextp->datap == TYBLANK) {
+			main_index += this_char;
+			k += this_char;
+			while(--this_char >= 0)
+				nice_printf(outfile, " ");
+			values = values -> nextp;
+			continue;
+			}
+		nice_printf(outfile, str_fmt[this_char]);
+		k++;
+		} /* case TYCHAR */
+	        break;
+
+#ifdef TYQUAD
+	    case TYQUAD:
+#ifndef NO_LONG_LONG
+		Const.Const.cd[1] = 123.456;
+#endif
+#endif
+	    case TYINT1:
+	    case TYSHORT:
+	    case TYLONG:
+	    case TYREAL:
+	    case TYDREAL:
+	    case TYLOGICAL:
+	    case TYLOGICAL1:
+	    case TYLOGICAL2:
+	    case TYCOMPLEX:
+	    case TYDCOMPLEX:
+		make_one_const(type, &Const.Const, values);
+		Const.vtype = type;
+		Const.vstg = ONEOF(type, MSKREAL|MSKCOMPLEX) != 0;
+		out_const(outfile, &Const);
+	        break;
+	    default:
+	        erri("wr_array_init: bad type '%d'", type);
+	        break;
+	} /* switch */
+	values = values->nextp;
+
+	main_index++;
+	if (values && type != TYCHAR)
+	    nice_printf (outfile, ",");
+    } /* while values */
+
+    if (type == TYCHAR) {
+	nice_printf(outfile, "\"");
+	}
+    else
+	nice_printf (outfile, " }");
+} /* wr_array_init */
+
+
+ static void
+#ifdef KR_headers
+make_one_const(type, storage, values)
+	int type;
+	union Constant *storage;
+	chainp values;
+#else
+make_one_const(int type, union Constant *storage, chainp values)
+#endif
+{
+    union Constant *Const;
+    register char **L;
+
+    if (type == TYCHAR) {
+	char *str, *str_ptr;
+	chainp v, prev;
+	int b = 0, k, main_index = 0;
+
+/* Find the max length of init string, by finding the highest offset
+   value stored in the list of initial values */
+
+	for(k = 1, prev = CHNULL, v = values; v; prev = v, v = v->nextp)
+	    ;
+	if (prev != CHNULL)
+	    k = ((int)(Ulong) (((chainp) prev->datap)->datap)) + 2;
+		/* + 2 above for null char at end */
+	str = Alloc (k);
+	for (str_ptr = str; values; str_ptr++) {
+	    int index = (int)(Ulong) (((chainp) values->datap)->datap);
+
+	    if (index < main_index)
+		overlapping();
+	    while (index > main_index++)
+		*str_ptr++ = ' ';
+
+		k = (int)(Ulong)(((chainp)values->datap)->nextp->nextp->datap);
+		if ((Ulong)((chainp)values->datap)->nextp->datap == TYBLANK) {
+			b = k;
+			break;
+			}
+		*str_ptr = (char)k;
+		values = values -> nextp;
+	} /* for str_ptr */
+	*str_ptr = '\0';
+	Const = storage;
+	Const -> ccp = str;
+	Const -> ccp1.blanks = b;
+	charlen = str_ptr - str;
+    } else {
+	int i = 0;
+	chainp vals;
+
+	vals = ((chainp)values->datap)->nextp->nextp;
+	if (vals) {
+		L = (char **)storage;
+		do L[i++] = vals->datap;
+			while(vals = vals->nextp);
+		}
+
+    } /* else */
+
+} /* make_one_const */
+
+
+ int
+#ifdef KR_headers
+rdname(infile, vargroupp, name)
+	FILE *infile;
+	int *vargroupp;
+	char *name;
+#else
+rdname(FILE *infile, int *vargroupp, char *name)
+#endif
+{
+    register int i, c;
+
+    c = getc (infile);
+
+    if (feof (infile))
+	return NO;
+
+    *vargroupp = c - '0';
+    for (i = 1;; i++) {
+	if (i >= VNAME_MAX)
+		Fatal("rdname: oversize name");
+	c = getc (infile);
+	if (feof (infile))
+	    return NO;
+	if (c == '\t')
+		break;
+	*name++ = c;
+    }
+    *name = 0;
+    return YES;
+} /* rdname */
+
+ int
+#ifdef KR_headers
+rdlong(infile, n)
+	FILE *infile;
+	ftnint *n;
+#else
+rdlong(FILE *infile, ftnint *n)
+#endif
+{
+    register int c;
+
+    for (c = getc (infile); !feof (infile) && isspace (c); c = getc (infile))
+	;
+
+    if (feof (infile))
+	return NO;
+
+    for (*n = 0; isdigit (c); c = getc (infile))
+	*n = 10 * (*n) + c - '0';
+    return YES;
+} /* rdlong */
+
+
+ static int
+#ifdef KR_headers
+memno2info(memno, info)
+	int memno;
+	Namep *info;
+#else
+memno2info(int memno, Namep *info)
+#endif
+{
+    chainp this_var;
+    extern chainp new_vars;
+    extern struct Hashentry *hashtab, *lasthash;
+    struct Hashentry *entry;
+
+    for (this_var = new_vars; this_var; this_var = this_var -> nextp) {
+	Addrp var = (Addrp) this_var->datap;
+
+	if (var == (Addrp) NULL)
+	    Fatal("memno2info:  null variable");
+	else if (var -> tag != TADDR)
+	    Fatal("memno2info:  bad tag");
+	if (memno == var -> memno) {
+	    *info = (Namep) var;
+	    return 1;
+	} /* if memno == var -> memno */
+    } /* for this_var = new_vars */
+
+    for (entry = hashtab; entry < lasthash; ++entry) {
+	Namep var = entry -> varp;
+
+	if (var && var -> vardesc.varno == memno && var -> vstg == STGINIT) {
+	    *info = (Namep) var;
+	    return 0;
+	} /* if entry -> vardesc.varno == memno */
+    } /* for entry = hashtab */
+
+    Fatal("memno2info:  couldn't find memno");
+    return 0;
+} /* memno2info */
+
+ static chainp
+#ifdef KR_headers
+do_string(outfile, v, nloc)
+	FILE *outfile;
+	register chainp v;
+	ftnint *nloc;
+#else
+do_string(FILE *outfile, register chainp v, ftnint *nloc)
+#endif
+{
+	register chainp cp, v0;
+	ftnint dloc, k, loc;
+	unsigned long uk;
+	char buf[8], *comma;
+
+	nice_printf(outfile, "{");
+	cp = (chainp)v->datap;
+	loc = (ftnint)cp->datap;
+	comma = "";
+	for(v0 = v;;) {
+		switch((Ulong)cp->nextp->datap) {
+			case TYBLANK:
+				k = (ftnint)cp->nextp->nextp->datap;
+				loc += k;
+				while(--k >= 0) {
+					nice_printf(outfile, "%s' '", comma);
+					comma = ", ";
+					}
+				break;
+			case TYCHAR:
+				uk = (ftnint)cp->nextp->nextp->datap;
+				sprintf(buf, chr_fmt[uk], uk);
+				nice_printf(outfile, "%s'%s'", comma, buf);
+				comma = ", ";
+				loc++;
+				break;
+			default:
+				goto done;
+			}
+		v0 = v;
+		if (!(v = v->nextp) || !(cp = (chainp)v->datap))
+			break;
+		dloc = (ftnint)cp->datap;
+		if (loc != dloc)
+			break;
+		}
+ done:
+	nice_printf(outfile, "}");
+	*nloc = loc;
+	return v0;
+	}
+
+ static chainp
+#ifdef KR_headers
+Ado_string(outfile, v, nloc)
+	FILE *outfile;
+	register chainp v;
+	ftnint *nloc;
+#else
+Ado_string(FILE *outfile, register chainp v, ftnint *nloc)
+#endif
+{
+	register chainp cp, v0;
+	ftnint dloc, k, loc;
+
+	nice_printf(outfile, "\"");
+	cp = (chainp)v->datap;
+	loc = (ftnint)cp->datap;
+	for(v0 = v;;) {
+		switch((Ulong)cp->nextp->datap) {
+			case TYBLANK:
+				k = (ftnint)cp->nextp->nextp->datap;
+				loc += k;
+				while(--k >= 0)
+					nice_printf(outfile, " ");
+				break;
+			case TYCHAR:
+				k = (ftnint)cp->nextp->nextp->datap;
+				nice_printf(outfile, str_fmt[k]);
+				loc++;
+				break;
+			default:
+				goto done;
+			}
+		v0 = v;
+		if (!(v = v->nextp) || !(cp = (chainp)v->datap))
+			break;
+		dloc = (ftnint)cp->datap;
+		if (loc != dloc)
+			break;
+		}
+ done:
+	nice_printf(outfile, "\"");
+	*nloc = loc;
+	return v0;
+	}
+
+ static char *
+#ifdef KR_headers
+Len(L, type)
+	long L;
+	int type;
+#else
+Len(long L, int type)
+#endif
+{
+	static char buf[24];
+	if (L == 1 && type != TYCHAR)
+		return "";
+	sprintf(buf, "[%ld]", L);
+	return buf;
+	}
+
+ static void
+#ifdef KR_headers
+fill_dcl(outfile, t, k, L) FILE *outfile; int t; int k; ftnint L;
+#else
+fill_dcl(FILE *outfile, int t, int k, ftnint L)
+#endif
+{
+	nice_printf(outfile, "%s fill_%d[%ld];\n", Typename[t], k, L);
+	}
+
+ static int
+#ifdef KR_headers
+fill_type(L, loc, xtype) ftnint L; ftnint loc; int xtype;
+#else
+fill_type(ftnint L, ftnint loc, int xtype)
+#endif
+{
+	int ft, ft1, szshort;
+
+	if (xtype == TYCHAR)
+		return xtype;
+	szshort = typesize[TYSHORT];
+	ft = L % szshort ? TYCHAR : type_choice[L/szshort % 4];
+	ft1 = loc % szshort ? TYCHAR : type_choice[loc/szshort % 4];
+	if (typesize[ft] > typesize[ft1])
+		ft = ft1;
+	return ft;
+	}
+
+ static ftnint
+#ifdef KR_headers
+get_fill(dloc, loc, t0, t1, L0, L1, xtype) ftnint dloc; ftnint loc; int *t0; int *t1; ftnint *L0; ftnint *L1; int xtype;
+#else
+get_fill(ftnint dloc, ftnint loc, int *t0, int *t1, ftnint *L0, ftnint *L1, int xtype)
+#endif
+{
+	ftnint L, L2, loc0;
+
+	if (L = loc % typesize[xtype]) {
+		loc0 = loc;
+		loc += L = typesize[xtype] - L;
+		if (L % typesize[TYSHORT])
+			*t0 = TYCHAR;
+		else
+			L /= typesize[*t0 = fill_type(L, loc0, xtype)];
+		}
+	if (dloc < loc + typesize[xtype])
+		return 0;
+	*L0 = L;
+	L2 = (dloc - loc) / typesize[xtype];
+	loc += L2*typesize[xtype];
+	if (dloc -= loc)
+		dloc /= typesize[*t1 = fill_type(dloc, loc, xtype)];
+	*L1 = dloc;
+	return L2;
+	}
+
+ void
+#ifdef KR_headers
+wr_equiv_init(outfile, memno, Values, iscomm)
+	FILE *outfile;
+	int memno;
+	chainp *Values;
+	int iscomm;
+#else
+wr_equiv_init(FILE *outfile, int memno, chainp *Values, int iscomm)
+#endif
+{
+	struct Equivblock *eqv;
+	int btype, curtype, dtype, filltype, j, k, n, t0, t1;
+	int wasblank, xfilled, xtype;
+	static char Blank[] = "";
+	register char *comma = Blank;
+	register chainp cp, v;
+	chainp sentinel, values, v1, vlast;
+	ftnint L, L0, L1, L2, dL, dloc, loc, loc0;
+	union Constant Const;
+	char imag_buf[50], real_buf[50];
+	int szshort = typesize[TYSHORT];
+	static char typepref[] = {0, 0, TYINT1, TYSHORT, TYLONG,
+#ifdef TYQUAD
+				  TYQUAD,
+#endif
+				  TYREAL, TYDREAL, TYREAL, TYDREAL,
+				  TYLOGICAL1, TYLOGICAL2,
+				  TYLOGICAL, TYCHAR};
+	static char basetype[] = {0, 0, TYCHAR, TYSHORT, TYLONG,
+#ifdef TYQUAD
+				  TYDREAL,
+#endif
+				  TYLONG, TYDREAL, TYLONG, TYDREAL,
+				  TYCHAR, TYSHORT,
+				  TYLONG, TYCHAR, 0 /* for TYBLANK */ };
+	extern int htype;
+	char *z;
+
+	/* add sentinel */
+	if (iscomm) {
+		L = extsymtab[memno].maxleng;
+		xtype = extsymtab[memno].extype;
+		}
+	else {
+		eqv = &eqvclass[memno];
+		L = eqv->eqvtop - eqv->eqvbottom;
+		xtype = eqv->eqvtype;
+		}
+
+	if (halign && typealign[typepref[xtype]] < typealign[htype])
+		xtype = htype;
+	xtype = typepref[xtype];
+	*Values = values = revchain(vlast = *Values);
+
+	xfilled = 2;
+	if (xtype != TYCHAR) {
+
+		/* unless the data include a value of the appropriate
+		 * type, we add an extra element in an attempt
+		 * to force correct alignment */
+
+		btype = basetype[xtype];
+		loc = 0;
+		for(v = *Values;;v = v->nextp) {
+			if (!v) {
+				dtype = typepref[xtype];
+				z = ISREAL(dtype) ? cpstring("0.") : (char *)0;
+				k = typesize[dtype];
+				if (j = (int)(L % k))
+					L += k - j;
+				v = mkchain((char *)L,
+					mkchain((char *)(Ulong)dtype,
+						mkchain(z, CHNULL)));
+				vlast = vlast->nextp =
+					mkchain((char *)v, CHNULL);
+				L += k;
+				break;
+				}
+			cp = (chainp)v->datap;
+			if (basetype[(Ulong)cp->nextp->datap] == btype)
+				break;
+			dloc = (ftnint)cp->datap;
+			if (get_fill(dloc, loc, &t0, &t1, &L0, &L1, xtype)) {
+				xfilled = 0;
+				break;
+				}
+			L1 = dloc - loc;
+			if (L1 > 0
+			 && !(L1 % szshort)
+			 && !(loc % szshort)
+			 && btype <= type_choice[L1/szshort % 4]
+			 && btype <= type_choice[loc/szshort % 4])
+				break;
+			dtype = (int)(Ulong)cp->nextp->datap;
+			loc = dloc + (dtype == TYBLANK
+					? (ftnint)cp->nextp->nextp->datap
+					: typesize[dtype]);
+			}
+		}
+	sentinel = mkchain((char *)L, mkchain((char *)TYERROR,CHNULL));
+	vlast->nextp = mkchain((char *)sentinel, CHNULL);
+
+	/* use doublereal fillers only if there are doublereal values */
+
+	k = TYLONG;
+	for(v = values; v; v = v->nextp)
+		if (ONEOF((Ulong)((chainp)v->datap)->nextp->datap,
+				M(TYDREAL)|M(TYDCOMPLEX))) {
+			k = TYDREAL;
+			break;
+			}
+	type_choice[0] = k;
+
+	nice_printf(outfile, "%sstruct {\n", iscomm ? "" : "static ");
+	next_tab(outfile);
+	loc = loc0 = k = 0;
+	curtype = -1;
+	for(v = values; v; v = v->nextp) {
+		cp = (chainp)v->datap;
+		dloc = (ftnint)cp->datap;
+		L = dloc - loc;
+		if (L < 0) {
+			overlapping();
+			if ((Ulong)cp->nextp->datap != TYERROR) {
+				v1 = cp;
+				frchain(&v1);
+				v->datap = 0;
+				}
+			continue;
+			}
+		dtype = (int)(Ulong)cp->nextp->datap;
+		if (dtype == TYBLANK) {
+			dtype = TYCHAR;
+			wasblank = 1;
+			}
+		else
+			wasblank = 0;
+		if (curtype != dtype || L > 0) {
+			if (curtype != -1) {
+				L1 = (loc - loc0)/dL;
+				nice_printf(outfile, "%s e_%d%s;\n",
+					Typename[curtype], ++k,
+					Len(L1,curtype));
+				}
+			curtype = dtype;
+			loc0 = dloc;
+			}
+		if (L > 0) {
+			filltype = fill_type(L, loc, xtype);
+			L1 = L / typesize[filltype];
+			if (!xfilled && (L2 = get_fill(dloc, loc, &t0, &t1,
+							&L0, &L1, xtype))) {
+				xfilled = 1;
+				if (L0)
+					fill_dcl(outfile, t0, ++k, L0);
+				fill_dcl(outfile, xtype, ++k, L2);
+				if (L1)
+					fill_dcl(outfile, t1, ++k, L1);
+				}
+			else
+				fill_dcl(outfile, filltype, ++k, L1);
+			loc = dloc;
+			}
+		if (wasblank) {
+			loc += (ftnint)cp->nextp->nextp->datap;
+			dL = 1;
+			}
+		else {
+			dL = typesize[dtype];
+			loc += dL;
+			}
+		}
+	nice_printf(outfile, "} %s = { ", iscomm
+		? extsymtab[memno].cextname
+		: equiv_name(eqvmemno, CNULL));
+	loc = 0;
+	xfilled &= 2;
+	for(v = values; ; v = v->nextp) {
+		cp = (chainp)v->datap;
+		if (!cp)
+			continue;
+		dtype = (int)(Ulong)cp->nextp->datap;
+		if (dtype == TYERROR)
+			break;
+		dloc = (ftnint)cp->datap;
+		if (dloc > loc) {
+			n = 1;
+			if (!xfilled && (L2 = get_fill(dloc, loc, &t0, &t1,
+							&L0, &L1, xtype))) {
+				xfilled = 1;
+				if (L0)
+					n = 2;
+				if (L1)
+					n++;
+				}
+			while(n--) {
+				nice_printf(outfile, "%s{0}", comma);
+				comma = ", ";
+				}
+			loc = dloc;
+			}
+		if (comma != Blank)
+			nice_printf(outfile, ", ");
+		comma = ", ";
+		if (dtype == TYCHAR || dtype == TYBLANK) {
+			v =  Ansi == 1  ? Ado_string(outfile, v, &loc)
+					:  do_string(outfile, v, &loc);
+			continue;
+			}
+		make_one_const(dtype, &Const, v);
+		switch(dtype) {
+			case TYLOGICAL:
+			case TYLOGICAL2:
+			case TYLOGICAL1:
+				if (Const.ci < 0 || Const.ci > 1)
+					errl(
+			  "wr_equiv_init: unexpected logical value %ld",
+						Const.ci);
+				nice_printf(outfile,
+					Const.ci ? "TRUE_" : "FALSE_");
+				break;
+			case TYINT1:
+			case TYSHORT:
+			case TYLONG:
+#ifdef TYQUAD0
+			case TYQUAD:
+#endif
+				nice_printf(outfile, "%ld", Const.ci);
+				break;
+#ifndef NO_LONG_LONG
+			case TYQUAD:
+				nice_printf(outfile, "%s", Const.cds[0]);
+				break;
+#endif
+			case TYREAL:
+				nice_printf(outfile, "%s",
+					flconst(real_buf, Const.cds[0]));
+				break;
+			case TYDREAL:
+				nice_printf(outfile, "%s", Const.cds[0]);
+				break;
+			case TYCOMPLEX:
+				nice_printf(outfile, "%s, %s",
+					flconst(real_buf, Const.cds[0]),
+					flconst(imag_buf, Const.cds[1]));
+				break;
+			case TYDCOMPLEX:
+				nice_printf(outfile, "%s, %s",
+					Const.cds[0], Const.cds[1]);
+				break;
+			default:
+				erri("unexpected type %d in wr_equiv_init",
+					dtype);
+			}
+		loc += typesize[dtype];
+		}
+	nice_printf(outfile, " };\n\n");
+	prev_tab(outfile);
+	frchain(&sentinel);
+	}
diff --git a/contrib/tools/f2c/src/ftypes.h b/contrib/tools/f2c/src/ftypes.h
new file mode 100644
index 0000000000..8181d87602
--- /dev/null
+++ b/contrib/tools/f2c/src/ftypes.h
@@ -0,0 +1,64 @@
+
+/* variable types (stored in the   vtype  field of   expptr)
+ * numeric assumptions:
+ *	int < reals < complexes
+ *	TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX
+ */
+
+#undef TYQUAD0
+#ifdef NO_TYQUAD
+#undef TYQUAD
+#define TYQUAD_inc 0
+#undef NO_LONG_LONG
+#define NO_LONG_LONG
+#else
+#define TYQUAD 5
+#define TYQUAD_inc 1
+#ifdef NO_LONG_LONG
+#define TYQUAD0
+#else
+#ifndef Llong
+typedef long long Llong;
+#endif
+#ifndef ULlong
+typedef unsigned long long ULlong;
+#endif
+#endif /*NO_LONG_LONG*/
+#endif /*NO_TYQUAD*/
+
+#define TYUNKNOWN 0
+#define TYADDR 1
+#define TYINT1 2
+#define TYSHORT 3
+#define TYLONG 4
+/* #define TYQUAD 5 */
+#define TYREAL (5+TYQUAD_inc)
+#define TYDREAL (6+TYQUAD_inc)
+#define TYCOMPLEX (7+TYQUAD_inc)
+#define TYDCOMPLEX (8+TYQUAD_inc)
+#define TYLOGICAL1 (9+TYQUAD_inc)
+#define TYLOGICAL2 (10+TYQUAD_inc)
+#define TYLOGICAL (11+TYQUAD_inc)
+#define TYCHAR (12+TYQUAD_inc)
+#define TYSUBR (13+TYQUAD_inc)
+#define TYERROR (14+TYQUAD_inc)
+#define TYCILIST (15+TYQUAD_inc)
+#define TYICILIST (16+TYQUAD_inc)
+#define TYOLIST (17+TYQUAD_inc)
+#define TYCLLIST (18+TYQUAD_inc)
+#define TYALIST (19+TYQUAD_inc)
+#define TYINLIST (20+TYQUAD_inc)
+#define TYVOID (21+TYQUAD_inc)
+#define TYLABEL (22+TYQUAD_inc)
+#define TYFTNLEN (23+TYQUAD_inc)
+/* TYVOID is not in any tables. */
+
+/* NTYPES, NTYPES0 -- Total number of types, used to allocate tables indexed by
+   type.  Such tables can include the size (in bytes) of objects of a given
+   type, or labels for returning objects of different types from procedures
+   (see array   rtvlabels)   */
+
+#define NTYPES TYVOID
+#define NTYPES0 TYCILIST
+#define TYBLANK TYSUBR		/* Huh? */
+
diff --git a/contrib/tools/f2c/src/gram.c b/contrib/tools/f2c/src/gram.c
new file mode 100644
index 0000000000..0a60fc6f0a
--- /dev/null
+++ b/contrib/tools/f2c/src/gram.c
@@ -0,0 +1,1957 @@
+#define	SEOS	1
+#define	SCOMMENT	2
+#define	SLABEL	3
+#define	SUNKNOWN	4
+#define	SHOLLERITH	5
+#define	SICON	6
+#define	SRCON	7
+#define	SDCON	8
+#define	SBITCON	9
+#define	SOCTCON	10
+#define	SHEXCON	11
+#define	STRUE	12
+#define	SFALSE	13
+#define	SNAME	14
+#define	SNAMEEQ	15
+#define	SFIELD	16
+#define	SSCALE	17
+#define	SINCLUDE	18
+#define	SLET	19
+#define	SASSIGN	20
+#define	SAUTOMATIC	21
+#define	SBACKSPACE	22
+#define	SBLOCK	23
+#define	SCALL	24
+#define	SCHARACTER	25
+#define	SCLOSE	26
+#define	SCOMMON	27
+#define	SCOMPLEX	28
+#define	SCONTINUE	29
+#define	SDATA	30
+#define	SDCOMPLEX	31
+#define	SDIMENSION	32
+#define	SDO	33
+#define	SDOUBLE	34
+#define	SELSE	35
+#define	SELSEIF	36
+#define	SEND	37
+#define	SENDFILE	38
+#define	SENDIF	39
+#define	SENTRY	40
+#define	SEQUIV	41
+#define	SEXTERNAL	42
+#define	SFORMAT	43
+#define	SFUNCTION	44
+#define	SGOTO	45
+#define	SASGOTO	46
+#define	SCOMPGOTO	47
+#define	SARITHIF	48
+#define	SLOGIF	49
+#define	SIMPLICIT	50
+#define	SINQUIRE	51
+#define	SINTEGER	52
+#define	SINTRINSIC	53
+#define	SLOGICAL	54
+#define	SNAMELIST	55
+#define	SOPEN	56
+#define	SPARAM	57
+#define	SPAUSE	58
+#define	SPRINT	59
+#define	SPROGRAM	60
+#define	SPUNCH	61
+#define	SREAD	62
+#define	SREAL	63
+#define	SRETURN	64
+#define	SREWIND	65
+#define	SSAVE	66
+#define	SSTATIC	67
+#define	SSTOP	68
+#define	SSUBROUTINE	69
+#define	STHEN	70
+#define	STO	71
+#define	SUNDEFINED	72
+#define	SWRITE	73
+#define	SLPAR	74
+#define	SRPAR	75
+#define	SEQUALS	76
+#define	SCOLON	77
+#define	SCOMMA	78
+#define	SCURRENCY	79
+#define	SPLUS	80
+#define	SMINUS	81
+#define	SSTAR	82
+#define	SSLASH	83
+#define	SPOWER	84
+#define	SCONCAT	85
+#define	SAND	86
+#define	SOR	87
+#define	SNEQV	88
+#define	SEQV	89
+#define	SNOT	90
+#define	SEQ	91
+#define	SLT	92
+#define	SGT	93
+#define	SLE	94
+#define	SGE	95
+#define	SNE	96
+#define	SENDDO	97
+#define	SWHILE	98
+#define	SSLASHD	99
+#define	SBYTE	100
+
+/* #line	125	"/n/bopp/v5/dmg/f2c/gram.in" */
+#include "defs.h"
+#include "p1defs.h"
+
+static int nstars;			/* Number of labels in an
+					   alternate return CALL */
+static int datagripe;
+static int ndim;
+static int vartype;
+int new_dcl;
+static ftnint varleng;
+static struct Dims dims[MAXDIM+1];
+extern struct Labelblock **labarray;	/* Labels in an alternate
+						   return CALL */
+extern int maxlablist;
+
+/* The next two variables are used to verify that each statement might be reached
+   during runtime.   lastwasbranch   is tested only in the defintion of the
+   stat:   nonterminal. */
+
+int lastwasbranch = NO;
+static int thiswasbranch = NO;
+extern ftnint yystno;
+extern flag intonly;
+static chainp datastack;
+extern long laststfcn, thisstno;
+extern int can_include;	/* for netlib */
+extern void endcheck Argdcl((void));
+extern struct Primblock *primchk Argdcl((expptr));
+
+#define ESNULL (Extsym *)0
+#define NPNULL (Namep)0
+#define LBNULL (struct Listblock *)0
+
+ static void
+pop_datastack(Void) {
+	chainp d0 = datastack;
+	if (d0->datap)
+		curdtp = (chainp)d0->datap;
+	datastack = d0->nextp;
+	d0->nextp = 0;
+	frchain(&d0);
+	}
+
+
+/* #line	172	"/n/bopp/v5/dmg/f2c/gram.in" */
+typedef union 	{
+	int ival;
+	ftnint lval;
+	char *charpval;
+	chainp chval;
+	tagptr tagval;
+	expptr expval;
+	struct Labelblock *labval;
+	struct Nameblock *namval;
+	struct Eqvchain *eqvval;
+	Extsym *extval;
+	} YYSTYPE;
+extern	int	yyerrflag;
+#ifndef	YYMAXDEPTH
+#define	YYMAXDEPTH	150
+#endif
+YYSTYPE	yylval;
+YYSTYPE	yyval;
+#define YYEOFCODE 1
+#define YYERRCODE 2
+short	yyexca[] =
+{-1, 1,
+	1, -1,
+	-2, 0,
+-1, 20,
+	4, 38,
+	-2, 231,
+-1, 24,
+	4, 42,
+	-2, 231,
+-1, 151,
+	4, 247,
+	-2, 189,
+-1, 175,
+	4, 269,
+	81, 269,
+	-2, 189,
+-1, 225,
+	80, 174,
+	-2, 140,
+-1, 246,
+	77, 231,
+	-2, 228,
+-1, 273,
+	4, 290,
+	-2, 144,
+-1, 277,
+	4, 299,
+	81, 299,
+	-2, 146,
+-1, 330,
+	80, 175,
+	-2, 142,
+-1, 360,
+	4, 271,
+	17, 271,
+	77, 271,
+	81, 271,
+	-2, 190,
+-1, 439,
+	94, 0,
+	95, 0,
+	96, 0,
+	97, 0,
+	98, 0,
+	99, 0,
+	-2, 154,
+-1, 456,
+	4, 293,
+	81, 293,
+	-2, 144,
+-1, 458,
+	4, 295,
+	81, 295,
+	-2, 144,
+-1, 460,
+	4, 297,
+	81, 297,
+	-2, 144,
+-1, 462,
+	4, 300,
+	81, 300,
+	-2, 145,
+-1, 506,
+	81, 293,
+	-2, 144,
+};
+#define	YYNPROD	305
+#define	YYPRIVATE 57344
+#define	YYLAST	1455
+short	yyact[] =
+{
+ 239, 359, 474, 306, 416, 427, 299, 389, 473, 267,
+ 315, 231, 400, 358, 318, 415, 328, 253, 319, 100,
+ 224, 297, 294, 280, 402, 401, 305, 117, 185, 265,
+  17, 122, 204, 275, 196, 191, 202, 203, 119, 129,
+ 107, 271, 200, 184, 112, 104, 338, 102, 166, 167,
+ 336, 337, 338, 344, 343, 342, 121, 157, 120, 345,
+ 347, 346, 349, 348, 350, 261, 276, 336, 337, 338,
+ 131, 132, 133, 134, 104, 136, 539, 158, 399, 158,
+ 313, 166, 167, 336, 337, 338, 344, 343, 342, 341,
+ 340, 311, 345, 347, 346, 349, 348, 350, 399, 398,
+ 105, 514, 115, 537, 166, 167, 336, 337, 338, 344,
+ 343, 342, 341, 340, 238, 345, 347, 346, 349, 348,
+ 350, 106, 130, 104, 478, 211, 187, 188, 412, 320,
+ 259, 260, 261, 411,  95, 166, 167, 336, 337, 338,
+ 186, 213, 296, 212, 194, 486, 195, 542, 245,  96,
+  97,  98, 527, 104, 529, 158, 523, 449, 258, 158,
+ 241, 243, 484, 101, 487, 485, 216, 274, 471, 222,
+ 217, 472, 221, 158, 483, 465, 430, 220, 166, 167,
+ 259, 260, 261, 262, 158, 166, 167, 336, 337, 338,
+ 344, 156, 121, 156, 120, 464, 345, 347, 346, 349,
+ 348, 350, 463, 373, 281, 282, 283, 236, 104, 232,
+ 242, 242, 249, 101, 292, 301, 263, 468, 290, 302,
+ 279, 296, 291, 288, 289, 166, 167, 259, 260, 261,
+ 264, 317, 455, 335, 189, 351, 312, 310, 446, 453,
+ 431, 284, 425, 335, 166, 167, 259, 260, 261, 262,
+ 258, 466, 325, 158, 467, 450, 380,  99, 449, 158,
+ 158, 158, 158, 158, 258, 258, 357, 379, 269, 156,
+ 234, 420, 266, 156, 421, 409, 393, 335, 410, 394,
+ 361, 333, 323, 362, 334, 258, 378, 156, 270, 208,
+ 326, 101, 330, 178, 113, 332, 374, 111, 156, 375,
+ 376, 403, 352, 110, 109, 108, 354, 355, 385, 386,
+ 363, 356, 384, 225, 377, 425, 367, 368, 369, 370,
+ 371, 422, 223, 364, 335, 538, 391, 335, 534, 533,
+ 532, 335, 423, 335, 372, 413, 408, 395, 390, 166,
+ 167, 259, 260, 261, 262, 381, 434, 528, 531, 526,
+ 494, 429, 237, 335, 496, 335, 335, 335, 104, 104,
+ 490, 298, 138, 158, 258, 335, 448, 156, 258, 258,
+ 258, 258, 258, 156, 156, 156, 156, 156, 251, 192,
+ 451, 103, 335, 454, 309, 277, 277, 360, 287, 426,
+ 118, 352, 166, 167, 259, 260, 261, 262, 137, 387,
+ 403, 232, 435, 436, 437, 438, 439, 440, 441, 442,
+ 443, 444, 477, 247, 469, 406, 482, 470, 308, 269,
+ 452, 166, 167, 336, 337, 338, 344, 335, 479, 155,
+ 244, 155, 488, 228, 225, 499, 335, 335, 335, 335,
+ 335, 335, 335, 335, 335, 335, 383, 497, 273, 273,
+ 495, 502, 201, 258, 150, 151, 214, 175, 103, 103,
+ 103, 103, 501, 190, 475, 454, 210, 172, 193, 142,
+ 503, 197, 198, 199, 504, 510, 335, 156, 207, 403,
+ 277, 513, 507, 508, 509, 331, 277, 482, 517, 489,
+ 335, 520, 492, 335, 197, 218, 219, 242, 498, 335,
+ 525, 519, 518, 516, 515, 524, 353, 155, 404, 512,
+ 246, 155, 248, 104, 406, 417,  30, 535, 406, 511,
+ 390, 209, 213, 335, 227, 155, 268,  93,   6, 541,
+ 250, 335, 171, 173, 177,  82, 155, 335,   4, 475,
+  81, 335,   5, 273, 543,  80, 457, 459, 461, 382,
+ 124,  79, 103, 174, 304, 295, 307, 522,  78,  77,
+  76,  60,  49, 242,  48,  45, 424, 322,  33, 114,
+ 530, 118, 206, 316, 414, 321, 205, 397, 396, 300,
+ 197, 536, 481, 135, 215, 392, 277, 277, 277, 314,
+ 540, 116,  26, 406,  25, 353,  24,  23,  22,  21,
+ 388, 286,   9,   8,   7, 155,   2, 404, 303,  20,
+ 165, 155, 155, 155, 155, 155,  51, 491, 293, 268,
+ 230, 329, 268, 268, 166, 167, 336, 337, 338, 344,
+ 343, 457, 459, 461, 327, 345, 347, 346, 349, 348,
+ 350, 418,  92, 256,  53, 339,  19,  55,  37, 456,
+ 458, 460, 226,   3,   1,   0,   0,   0,   0,   0,
+   0, 307,   0, 405, 197,   0,   0,   0,   0,   0,
+   0, 277, 277, 277, 419,   0,   0,   0, 353,   0,
+ 321,   0,   0,   0,   0,   0, 404,   0,   0,   0,
+ 493,   0,   0,   0, 432, 166, 167, 336, 337, 338,
+ 344, 343, 342, 341, 340,   0, 345, 347, 346, 349,
+ 348, 350,   0,   0,   0, 155,   0, 500,   0,   0,
+   0,   0,   0,   0,   0,   0, 268,   0,   0,   0,
+   0,   0, 462,   0, 506, 458, 460, 166, 167, 336,
+ 337, 338, 344, 343, 342, 341, 340,   0, 345, 347,
+ 346, 349, 348, 350,   0,   0,   0, 295,   0,   0,
+   0,   0, 405, 480,   0, 307, 405,   0,   0, 447,
+   0,   0,   0,   0, 166, 167, 336, 337, 338, 344,
+ 343, 342, 341, 340, 316, 345, 347, 346, 349, 348,
+ 350,   0,   0, 445,   0,   0,   0,   0, 166, 167,
+ 336, 337, 338, 344, 343, 342, 341, 340, 268, 345,
+ 347, 346, 349, 348, 350,   0,   0,   0, 505,   0,
+   0,   0,   0,   0,   0,   0, 505, 505, 505,   0,
+   0,   0,   0,   0,   0,   0, 307,  12,   0,   0,
+   0, 405,   0,   0,   0,   0, 505,   0,   0,   0,
+ 521,  10,  56,  46,  73,  86,  14,  61,  70,  91,
+  38,  66,  47,  42,  68,  72,  31,  67,  35,  34,
+  11,  88,  36,  18,  41,  39,  28,  16,  57,  58,
+  59,  50,  54,  43,  89,  64,  40,  69,  44,  90,
+  29,  62,  85,  13,   0,  83,  65,  52,  87,  27,
+  74,  63,  15, 433,   0,  71,  84,   0, 166, 167,
+ 336, 337, 338, 344, 343, 342, 341, 340,   0, 345,
+ 347, 346, 349, 348, 350,   0,   0,   0,   0,   0,
+  32,   0,   0,  75, 166, 167, 336, 337, 338, 344,
+ 343, 342, 341, 340,   0, 345, 347, 346, 349, 348,
+ 350,  73,   0,   0,   0,  70,   0,   0,  66,   0,
+   0,  68,  72,   0,  67, 161, 162, 163, 164, 170,
+ 169, 168, 159, 160, 104,   0,   0,   0,   0,   0,
+   0,   0,  64,   0,  69,   0,   0,   0,   0,   0,
+   0,   0,   0,  65,   0,   0,   0,  74,   0,   0,
+   0,   0,  71, 161, 162, 163, 164, 170, 169, 168,
+ 159, 160, 104,   0, 161, 162, 163, 164, 170, 169,
+ 168, 159, 160, 104,   0,   0,   0,   0,   0,   0,
+  75,   0,   0,   0, 235,   0,   0,   0,   0,   0,
+ 166, 167, 365,   0, 366,   0,   0,   0,   0,   0,
+ 240, 161, 162, 163, 164, 170, 169, 168, 159, 160,
+ 104,   0, 161, 162, 163, 164, 170, 169, 168, 159,
+ 160, 104, 235, 229,   0,   0,   0,   0, 166, 167,
+ 233,   0,   0, 235,   0,   0,   0,   0, 240, 166,
+ 167, 476,   0,   0,   0,   0,   0,   0,   0, 240,
+ 161, 162, 163, 164, 170, 169, 168, 159, 160, 104,
+ 161, 162, 163, 164, 170, 169, 168, 159, 160, 104,
+ 235,   0,   0,   0,   0,   0, 166, 167, 233,   0,
+   0, 235,   0,   0,   0,   0, 240, 166, 167, 428,
+   0,   0,   0,   0,   0,   0,   0, 240, 161, 162,
+ 163, 164, 170, 169, 168, 159, 160, 104,   0, 161,
+ 162, 163, 164, 170, 169, 168, 159, 160, 104, 278,
+   0,   0,   0, 272,   0, 166, 167,   0,   0,   0,
+   0,   0,   0,   0,   0, 240, 161, 162, 163, 164,
+ 170, 169, 168, 159, 160, 104,   0,   0,   0,   0,
+   0,   0,   0,   0,   0,  94, 161, 162, 163, 164,
+ 170, 169, 168, 159, 160, 104, 257, 235,   0,   0,
+   0,   0,   0, 166, 167,   0,   0,   0, 278,   0,
+   0,   0,   0, 240, 166, 167,   0, 123,   0,   0,
+ 126, 127, 128,   0, 240,   0,   0,   0,   0,   0,
+   0,   0, 139, 140,   0, 324, 141,   0, 143, 144,
+ 145, 166, 167, 146, 147, 148,   0, 149,   0,   0,
+   0, 240,   0,   0,   0, 252,   0,   0,   0,   0,
+   0, 166, 167, 254,   0, 255,   0, 179, 180, 181,
+ 182, 183, 161, 162, 163, 164, 170, 169, 168, 159,
+ 160, 104,   0, 161, 162, 163, 164, 170, 169, 168,
+ 159, 160, 104, 161, 162, 163, 164, 170, 169, 168,
+ 159, 160, 104, 161, 162, 163, 164, 170, 169, 168,
+ 159, 160, 104, 161, 162, 163, 164, 170, 169, 168,
+ 159, 160, 104,   0,   0,   0,   0,   0,   0,   0,
+   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,
+   0, 154,   0,   0,   0,   0,   0, 166, 167, 152,
+   0, 153, 252,   0,   0,   0,   0,   0, 166, 167,
+ 285,   0, 154,   0,   0,   0,   0,   0, 166, 167,
+ 176,   0, 407,   0,   0,   0,   0,   0, 166, 167,
+  56,  46, 252,  86,   0,  61,   0,  91, 166, 167,
+  47,   0,   0,   0,   0,   0,   0,   0,   0,  88,
+   0,   0,   0,   0,   0,   0,  57,  58,  59,  50,
+   0,   0,  89,   0,   0,   0,   0,  90,   0,  62,
+  85,   0,   0,  83,   0,  52,  87,   0,   0,  63,
+   0, 125,   0,   0,  84
+};
+short	yypact[] =
+{
+-1000, 536, 524, 830,-1000,-1000,-1000,-1000,-1000,-1000,
+ 519,-1000,-1000,-1000,-1000,-1000,-1000, 210, 496,  19,
+ 224, 223, 222, 216,  82, 213,  16, 106,-1000,-1000,
+-1000,-1000,-1000,1378,-1000,-1000,-1000,  37,-1000,-1000,
+-1000,-1000,-1000,-1000,-1000, 496,-1000,-1000,-1000,-1000,
+-1000, 392,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,
+-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,
+-1000,-1000,-1000,-1000,-1000,-1000,1284, 390,1305, 390,
+ 212,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,
+-1000,-1000,-1000,-1000,-1000, 496, 496, 496, 496,-1000,
+ 496,-1000, 302,-1000,-1000, 496,-1000, -30, 496, 496,
+ 496, 375,-1000,-1000,-1000, 496, 208,-1000,-1000,-1000,
+-1000, 504, 389, 132,-1000,-1000, 379,-1000,-1000,-1000,
+-1000, 106, 496, 496, 375,-1000,-1000, 243, 357, 515,
+-1000, 356, 995,1140,1140, 353, 513, 496, 336, 496,
+-1000,-1000,-1000,-1000,1198,-1000,-1000,  95,1325,-1000,
+-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,
+-1000,-1000,1198, 191, 207,-1000,-1000,1092,1151,-1000,
+-1000,-1000,-1000,1295, 311,-1000,-1000, 302, 302, 496,
+-1000,-1000, 136, 284,-1000,  82,-1000, 284,-1000,-1000,
+-1000, 496,-1000, 341,-1000, 307, 927,   5, 106,  -6,
+ 496,  82,  28,-1000,-1000,1178,-1000, 496,-1000,-1000,
+-1000,-1000,-1000,1140,-1000,1140, 411,-1000,1140,-1000,
+ 203,-1000, 851, 513,-1000,1140,-1000,-1000,-1000,1140,
+1140,-1000, 851,-1000,1140,-1000,  82, 513,-1000, 309,
+ 202,-1000,1325,-1000,-1000,-1000, 957,-1000,1325,1325,
+1325,1325,1325, -22, 256, 122, 342,-1000,-1000, 342,
+ 342,-1000,1151, 205, 186, 175, 851,-1000,1151,-1000,
+-1000,-1000,-1000,-1000,  95,-1000,-1000, 321,-1000,-1000,
+ 302,-1000,-1000, 198,-1000,-1000,-1000,  37,-1000,  -3,
+1315, 496,-1000, 197,-1000,  47,-1000,-1000, 341, 498,
+-1000, 496,-1000,-1000, 193,-1000, 242,  28,-1000,-1000,
+-1000, 163,1140, 851,1054,-1000, 851, 273,  96, 159,
+ 851, 496, 825,-1000,1043,1140,1140,1140,1140,1140,
+1140,1140,1140,1140,1140,-1000,-1000,-1000,-1000,-1000,
+-1000,-1000, 715, 157, -41, 102, 691, 289, 177,-1000,
+-1000,-1000,1198, 161, 851,-1000,-1000,  45, -22, -22,
+ -22, 142,-1000, 342, 122, 151, 122,-1000,1151,1151,
+1151, 654, 121, 114,  94,-1000,-1000,-1000, 173,-1000,
+ 138,-1000, 284,-1000,  57,-1000,  90,1006,-1000,1315,
+-1000,-1000,  39,1102,-1000,-1000,-1000,1140,-1000,-1000,
+ 496,-1000, 341,  93,  84,-1000,  61,-1000,  83,-1000,
+-1000, 496,1140,-1000, 283,1140, 612,-1000, 272, 277,
+1140,1140,-1000, 513,-1000, -18, -41, -41, -41, 338,
+ -35, -35, 541, 102,  52,-1000,1140,-1000, 513, 513,
+  82,-1000,  95,-1000,-1000, 342,-1000,-1000,-1000,-1000,
+-1000,-1000,-1000,1151,1151,1151,-1000, 503, 502,  37,
+-1000,-1000,1006,-1000,-1000,  21,-1000,-1000,1315,-1000,
+-1000,-1000,-1000, 341,-1000, 498, 498, 496,-1000, 851,
+1140,  75, 851, 432,-1000,-1000,1140, 271, 851,  71,
+ 269,  76,-1000,1140, 270, 236, 269, 252, 251, 250,
+-1000,-1000,-1000,-1000,1006,-1000,-1000,  17, 247,-1000,
+-1000,-1000,  -2,1140,-1000,-1000,-1000, 513,-1000,-1000,
+ 851,-1000,-1000,-1000,-1000,-1000, 851,-1000,-1000,-1000,
+ 851,  66, 513,-1000
+};
+short	yypgo[] =
+{
+   0, 654, 653,   1, 652, 167,   9,  30, 648, 647,
+ 646,   4,   0, 645, 644, 643,  39, 642,   3,  26,
+ 641, 634, 621,  18,  14, 620,  35, 618, 617,  29,
+  41,  33,  20, 362,  22, 616,  34, 352,  66, 270,
+  16,  57, 378,   2,  24,  25,  11, 207, 114, 610,
+ 609,  38,  28,  43, 608, 606, 604, 603, 602,1205,
+ 134, 601, 600,   7, 599, 598, 597, 596, 594, 592,
+ 591,  31, 589,  19, 585,  21,  37,   6, 584,   5,
+  42, 583,  36, 582, 579,  12,  27,  10, 578, 577,
+   8,  13,  32, 576, 574, 572,  15, 569, 516, 568,
+ 567, 566, 565, 564, 562, 561, 560, 454, 559, 558,
+ 553, 551, 545, 540,  23, 535, 530,  17
+};
+short	yyr1[] =
+{
+   0,   1,   1,  55,  55,  55,  55,  55,  55,  55,
+   2,  56,  56,  56,  56,  56,  56,  56,  60,  52,
+  33,  53,  53,  61,  61,  62,  62,  63,  63,  26,
+  26,  26,  27,  27,  34,  34,  17,  57,  57,  57,
+  57,  57,  57,  57,  57,  57,  57,  57,  57,  10,
+  10,  10,  74,   7,   8,   9,   9,   9,   9,   9,
+   9,   9,   9,   9,   9,   9,   9,  16,  16,  16,
+  50,  50,  50,  50,  51,  51,  64,  64,  65,  65,
+  66,  66,  80,  54,  54,  67,  67,  81,  82,  76,
+  83,  84,  77,  77,  85,  85,  45,  45,  45,  70,
+  70,  86,  86,  72,  72,  87,  36,  18,  18,  19,
+  19,  75,  75,  89,  88,  88,  90,  90,  43,  43,
+  91,  91,   3,  68,  68,  92,  92,  95,  93,  94,
+  94,  96,  96,  11,  69,  69,  97,  20,  20,  71,
+  21,  21,  22,  22,  38,  38,  38,  39,  39,  39,
+  39,  39,  39,  39,  39,  39,  39,  39,  39,  39,
+  39,  12,  12,  13,  13,  13,  13,  13,  13,  37,
+  37,  37,  37,  32,  40,  40,  44,  44,  48,  48,
+  48,  48,  48,  48,  48,  47,  49,  49,  49,  41,
+  41,  42,  42,  42,  42,  42,  42,  42,  42,  58,
+  58,  58,  58,  58,  58, 100,  58,  58,  58,  99,
+  23,  24, 101,  24,  98,  98,  98,  98,  98,  98,
+  98,  98,  98,  98,  98,   4, 102, 103, 103, 103,
+ 103,  73,  73,  35,  25,  25,  46,  46,  14,  14,
+  28,  28,  59,  78,  79, 104, 105, 105, 105, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 106, 113, 113, 113, 108, 115, 115, 115, 110,
+ 110, 107, 107, 116, 116, 117, 117, 117, 117, 117,
+ 117,  15, 109, 111, 112, 112,  29,  29,   6,   6,
+  30,  30,  30,  31,  31,  31,  31,  31,  31,   5,
+   5,   5,   5,   5, 114
+};
+short	yyr2[] =
+{
+   0,   0,   3,   2,   2,   2,   3,   3,   2,   1,
+   1,   3,   4,   3,   4,   4,   5,   3,   0,   1,
+   1,   0,   1,   2,   3,   1,   3,   1,   3,   0,
+   2,   3,   1,   3,   1,   1,   1,   1,   1,   1,
+   1,   1,   1,   1,   1,   1,   2,   1,   5,   7,
+   5,   5,   0,   2,   1,   1,   1,   1,   1,   1,
+   1,   1,   1,   1,   1,   1,   1,   0,   4,   6,
+   3,   4,   5,   3,   1,   3,   3,   3,   3,   3,
+   3,   3,   3,   1,   3,   3,   3,   0,   6,   0,
+   0,   0,   2,   3,   1,   3,   1,   2,   1,   1,
+   3,   1,   1,   1,   3,   3,   2,   1,   5,   1,
+   3,   0,   3,   0,   2,   3,   1,   3,   1,   1,
+   1,   3,   1,   3,   3,   4,   1,   0,   2,   1,
+   3,   1,   3,   1,   1,   2,   4,   1,   3,   0,
+   0,   1,   1,   3,   1,   3,   1,   1,   1,   3,
+   3,   3,   3,   2,   3,   3,   3,   3,   3,   2,
+   3,   1,   1,   1,   1,   1,   1,   1,   1,   1,
+   2,   4,   5,   5,   0,   1,   1,   1,   1,   1,
+   1,   1,   1,   1,   1,   5,   1,   1,   1,   1,
+   3,   1,   1,   3,   3,   3,   3,   2,   3,   1,
+   5,   4,   1,   2,   2,   0,   7,   2,   2,   5,
+   3,   1,   0,   5,   4,   5,   2,   1,   1,  10,
+   1,   3,   4,   3,   3,   1,   1,   3,   3,   7,
+   7,   0,   1,   3,   1,   3,   1,   2,   1,   1,
+   1,   3,   0,   0,   0,   1,   2,   2,   2,   2,
+   2,   2,   2,   3,   4,   4,   2,   3,   4,   1,
+   3,   3,   1,   1,   1,   3,   1,   1,   1,   1,
+   1,   3,   3,   1,   3,   1,   1,   1,   2,   2,
+   2,   1,   3,   3,   4,   4,   1,   3,   1,   5,
+   1,   1,   1,   3,   3,   3,   3,   3,   3,   1,
+   3,   5,   5,   5,   0
+};
+short	yychk[] =
+{
+-1000,  -1, -55,  -2,   2,   6,   4, -56, -57, -58,
+  21,  40,   7,  63,  26,  72,  47,  -7,  43, -10,
+ -50, -64, -65, -66, -67, -68, -69,  69,  46,  60,
+ -98,  36, 100, -99,  39,  38,  42,  -8,  30,  45,
+  56,  44,  33,  53,  58,-102,  23,  32,-103,-104,
+  51, -35,  67, -14,  52,  -9,  22,  48,  49,  50,
+-105,  27,  61,  71,  55,  66,  31,  37,  34,  57,
+  28,  75,  35,  24,  70, 103,-106,-108,-109,-111,
+-112,-113,-115,  65,  76,  62,  25,  68,  41,  54,
+  59,  29, -17,   8, -59, -60, -60, -60, -60,  47,
+ -73,  81, -52, -33,  17,  81, 102, -73,  81,  81,
+  81,  81, -73,  81, -97,  86, -70, -86, -33, -51,
+  88,  86, -71, -59, -98,  73, -59, -59, -59, -16,
+  85, -71, -71, -71, -71, -81, -71, -37, -33, -59,
+ -59, -59,  77, -59, -59, -59, -59, -59, -59, -59,
+-107, -42,  85,  87,  77, -37, -48, -41, -12,  15,
+  16,   8,   9,  10,  11, -49,  83,  84,  14,  13,
+  12,-107,  77,-107,-110, -42,  85,-107,  81, -59,
+ -59, -59, -59, -59, -53, -52, -53, -52, -52, -60,
+ -33, -26,  77, -33, -76, -51, -36, -33, -33, -33,
+ -80,  77, -82, -76, -92, -93, -95, -33,  81,  17,
+  77,  -3, -73,   9,  77, -78, -36, -51, -33, -33,
+ -80, -82, -92,  79, -32,  77,  -4,   9,  77,  78,
+ -25, -46, -38,  85, -39,  77, -47, -37, -48, -12,
+  93, -40, -38, -40,  77,  -3, -33,  77, -33, -41,
+-116, -42,  77,-117,  85,  87, -15,  18, -12,  85,
+  86,  87,  88, -41, -41, -29,  81,  -6, -37,  77,
+  81, -30,  81, -39,  -5, -31, -38, -47,  77, -30,
+-114,-114,-114,-114, -41,  85, -61,  77, -26, -26,
+ -52, -71,  78, -27, -34, -33,  85, -75,  77, -77,
+ -84, -73, -75, -54, -37, -19, -18, -37,  77,  77,
+  -7,  86, -86,  86, -72, -87, -33, -73, -24, -23,
+ 101, -33,-100, -38,  77, -36, -38, -21, -40, -22,
+ -38,  74, -38,  78,  81, -12,  85,  86,  87, -13,
+  92,  91,  90,  89,  88,  94,  96,  95,  98,  97,
+  99,  -3, -38, -39, -38, -38, -38, -73, -91,  -3,
+  78,  78,  81, -41, -38,  85,  87, -41, -41, -41,
+ -41, -41,  78,  81, -29, -29, -29, -30,  81,  81,
+  81, -38, -39,  -5, -31,-114,-114,  78, -62, -63,
+  17, -26, -74,  78,  81, -16, -88, -89, 102,  81,
+ -85, -45, -44, -12, -47, -33, -48,  77, -36,  78,
+  81,  86,  81, -19, -94, -96, -11,  17, -20, -33,
+  78,  81,  79, -24,-101,  79, -38, -79,  85,  78,
+  80,  81, -33,  78, -46, -38, -38, -38, -38, -38,
+ -38, -38, -38, -38, -38,  78,  81,  78,  77,  81,
+  78,-117, -41,  78,  -6,  81, -39,  -5, -39,  -5,
+ -39,  -5,  78,  81,  81,  81,  78,  81,  79, -75,
+ -34,  78,  81, -90, -43, -38,  85, -85,  85, -44,
+ -37, -83, -18,  81,  78,  81,  84,  81, -87, -38,
+  77, -28, -38,  78,  78, -32,  77, -40, -38,  -3,
+ -39, -91,  -3, -73, -23, -33, -39, -23, -23, -23,
+ -63,  17, -16, -90,  80, -45, -44, -77, -23, -96,
+ -11, -33, -38,  81,  73, -79,  78,  81,  78,  78,
+ -38,  78,  78,  78,  78, -43, -38,  86,  78,  78,
+ -38,  -3,  81,  -3
+};
+short	yydef[] =
+{
+   1,  -2,   0,   0,   9,  10,   2,   3,   4,   5,
+   0, 242,   8,  18,  18,  18,  18, 231,   0,  37,
+  -2,  39,  40,  41,  -2,  43,  44,  45,  47, 139,
+ 199, 242, 202,   0, 242, 242, 242,  67, 139, 139,
+ 139, 139,  87, 139, 134,   0, 242, 242, 217, 218,
+ 242, 220, 242, 242, 242,  54, 226, 242, 242, 242,
+ 245, 242, 238, 239,  55,  56,  57,  58,  59,  60,
+  61,  62,  63,  64,  65,  66,   0,   0,   0,   0,
+ 259, 242, 242, 242, 242, 242, 262, 263, 264, 266,
+ 267, 268,   6,  36,   7,  21,  21,   0,   0,  18,
+   0, 232,  29,  19,  20,   0,  89,   0, 232,   0,
+   0,   0,  89, 127, 135,   0,  46,  99, 101, 102,
+  74,   0,   0, 231, 203, 204,   0, 207, 208,  53,
+ 243,   0,   0,   0,   0,  89, 127,   0, 169,   0,
+ 216,   0,   0, 174, 174,   0,   0,   0,   0,   0,
+ 246,  -2, 248, 249,   0, 191, 192,   0,   0, 178,
+ 179, 180, 181, 182, 183, 184, 161, 162, 186, 187,
+ 188, 250,   0, 251, 252,  -2, 270, 256,   0, 304,
+ 304, 304, 304,   0,  11,  22,  13,  29,  29,   0,
+ 139,  17,   0, 111,  91, 231,  73, 111,  77,  79,
+  81,   0,  86,   0, 124, 126,   0,   0,   0,   0,
+   0, 231,   0, 122, 205,   0,  70,   0,  76,  78,
+  80,  85, 123,   0, 170,  -2,   0, 225,   0, 221,
+   0, 234, 236,   0, 144,   0, 146, 147, 148,   0,
+   0, 223, 175, 224,   0, 227,  -2,   0, 233, 275,
+   0, 189,   0, 273, 276, 277,   0, 281,   0,   0,
+   0,   0,   0, 197, 275, 253,   0, 286, 288,   0,
+   0, 257,   0,  -2, 291, 292,   0,  -2,   0, 260,
+ 261, 265, 282, 283, 304, 304,  12,   0,  14,  15,
+  29,  52,  30,   0,  32,  34,  35,  67, 113,   0,
+   0,   0, 106,   0,  83,   0, 109, 107,   0,   0,
+ 128,   0, 100,  75,   0, 103,   0,   0, 201, 211,
+ 212,   0,   0, 244,   0,  71, 214,   0,   0, 141,
+  -2,   0,   0, 222,   0,   0,   0,   0,   0,   0,
+   0,   0,   0,   0,   0, 163, 164, 165, 166, 167,
+ 168, 237,   0, 144, 153, 159,   0,   0,   0, 120,
+  -2, 272,   0,   0, 278, 279, 280, 193, 194, 195,
+ 196, 198, 271,   0, 255,   0, 254, 258,   0,   0,
+   0,   0, 144,   0,   0, 284, 285,  23,   0,  25,
+  27,  16, 111,  31,   0,  50,   0,   0,  51,   0,
+  92,  94,  96,   0,  98, 176, 177,   0,  72,  82,
+   0,  90,   0,   0,   0, 129, 131, 133, 136, 137,
+  48,   0,   0, 200,   0,   0,   0,  68,   0, 171,
+ 174,   0, 215,   0, 235, 149, 150, 151, 152,  -2,
+ 155, 156, 157, 158, 160, 145,   0, 209,   0,   0,
+ 231, 274, 275, 190, 287,   0,  -2, 294,  -2, 296,
+  -2, 298,  -2,   0,   0,   0,  24,   0,   0,  67,
+  33, 112,   0, 114, 116, 119, 118,  93,   0,  97,
+  84,  91, 110,   0, 125,   0,   0,   0, 104, 105,
+   0, 210, 240,   0, 244, 172, 174,   0, 143,   0,
+ 144,   0, 121,   0,   0, 169,  -2,   0,   0,   0,
+  26,  28,  49, 115,   0,  95,  96,   0,   0, 130,
+ 132, 138,   0,   0, 206,  69, 173,   0, 185, 229,
+ 230, 289, 301, 302, 303, 117, 119,  88, 108, 213,
+ 241,   0,   0, 219
+};
+short	yytok1[] =
+{
+   1,   4,   5,   6,   7,   8,   9,  10,  11,  12,
+  13,  14,  15,  16,  17,  18,  19,  20,  21,  22,
+  23,  24,  25,  26,  27,  28,  29,  30,  31,  32,
+  33,  34,  35,  36,  37,  38,  39,  40,  41,  42,
+  43,  44,  45,  46,  47,  48,  49,  50,  51,  52,
+  53,  54,  55,  56,  57,  58,  59,  60,  61,  62,
+  63,  64,  65,  66,  67,  68,  69,  70,  71,  72,
+  73,  74,  75,  76,  77,  78,  79,  80,  81,  82,
+  83,  84,  85,  86,  87,  88,  89,  90,  91,  92,
+  93,  94,  95,  96,  97,  98,  99, 100, 101, 102,
+ 103
+};
+short	yytok2[] =
+{
+   2,   3
+};
+long	yytok3[] =
+{
+   0
+};
+#define YYFLAG 		-1000
+#define YYERROR		goto yyerrlab
+#define YYACCEPT	return(0)
+#define YYABORT		return(1)
+#define	yyclearin	yychar = -1
+#define	yyerrok		yyerrflag = 0
+
+#ifdef	yydebug
+//#include	"y.debug"
+#else
+#define	yydebug		0
+char*	yytoknames[1];		/* for debugging */
+char*	yystates[1];		/* for debugging */
+#endif
+
+/*	parser for yacc output	*/
+
+int	yynerrs = 0;		/* number of errors */
+int	yyerrflag = 0;		/* error recovery flag */
+
+extern	int	fprint(int, char*, ...);
+extern	int	sprint(char*, char*, ...);
+
+char*
+yytokname(int yyc)
+{
+	static char x[10];
+
+	if(yyc > 0 && yyc <= sizeof(yytoknames)/sizeof(yytoknames[0]))
+	if(yytoknames[yyc-1])
+		return yytoknames[yyc-1];
+	sprintf(x, "<%d>", yyc);
+	return x;
+}
+
+char*
+yystatname(int yys)
+{
+	static char x[10];
+
+	if(yys >= 0 && yys < sizeof(yystates)/sizeof(yystates[0]))
+	if(yystates[yys])
+		return yystates[yys];
+	sprintf(x, "<%d>\n", yys);
+	return x;
+}
+
+long
+yylex1(void)
+{
+	long yychar;
+	long *t3p;
+	int c;
+
+	yychar = yylex();
+	if(yychar <= 0) {
+		c = yytok1[0];
+		goto out;
+	}
+	if(yychar < sizeof(yytok1)/sizeof(yytok1[0])) {
+		c = yytok1[yychar];
+		goto out;
+	}
+	if(yychar >= YYPRIVATE)
+		if(yychar < YYPRIVATE+sizeof(yytok2)/sizeof(yytok2[0])) {
+			c = yytok2[yychar-YYPRIVATE];
+			goto out;
+		}
+	for(t3p=yytok3;; t3p+=2) {
+		c = t3p[0];
+		if(c == yychar) {
+			c = t3p[1];
+			goto out;
+		}
+		if(c == 0)
+			break;
+	}
+	c = 0;
+
+out:
+	if(c == 0)
+		c = yytok2[1];	/* unknown char */
+	if(yydebug >= 3)
+		printf("lex %.4lX %s\n", yychar, yytokname(c));
+	return c;
+}
+
+int
+yyparse(void)
+{
+	struct
+	{
+		YYSTYPE	yyv;
+		int	yys;
+	} yys[YYMAXDEPTH], *yyp, *yypt;
+	short *yyxi;
+	int yyj, yym, yystate, yyn, yyg;
+	YYSTYPE save1, save2;
+	int save3, save4;
+	long yychar;
+
+	save1 = yylval;
+	save2 = yyval;
+	save3 = yynerrs;
+	save4 = yyerrflag;
+
+	yystate = 0;
+	yychar = -1;
+	yynerrs = 0;
+	yyerrflag = 0;
+	yyp = &yys[-1];
+	goto yystack;
+
+ret0:
+	yyn = 0;
+	goto ret;
+
+ret1:
+	yyn = 1;
+	goto ret;
+
+ret:
+	yylval = save1;
+	yyval = save2;
+	yynerrs = save3;
+	yyerrflag = save4;
+	return yyn;
+
+yystack:
+	/* put a state and value onto the stack */
+	if(yydebug >= 4)
+		printf("char %s in %s", yytokname(yychar), yystatname(yystate));
+
+	yyp++;
+	if(yyp >= &yys[YYMAXDEPTH]) {
+		yyerror("yacc stack overflow");
+		goto ret1;
+	}
+	yyp->yys = yystate;
+	yyp->yyv = yyval;
+
+yynewstate:
+	yyn = yypact[yystate];
+	if(yyn <= YYFLAG)
+		goto yydefault; /* simple state */
+	if(yychar < 0)
+		yychar = yylex1();
+	yyn += yychar;
+	if(yyn < 0 || yyn >= YYLAST)
+		goto yydefault;
+	yyn = yyact[yyn];
+	if(yychk[yyn] == yychar) { /* valid shift */
+		yychar = -1;
+		yyval = yylval;
+		yystate = yyn;
+		if(yyerrflag > 0)
+			yyerrflag--;
+		goto yystack;
+	}
+
+yydefault:
+	/* default state action */
+	yyn = yydef[yystate];
+	if(yyn == -2) {
+		if(yychar < 0)
+			yychar = yylex1();
+
+		/* look through exception table */
+		for(yyxi=yyexca;; yyxi+=2)
+			if(yyxi[0] == -1 && yyxi[1] == yystate)
+				break;
+		for(yyxi += 2;; yyxi += 2) {
+			yyn = yyxi[0];
+			if(yyn < 0 || yyn == yychar)
+				break;
+		}
+		yyn = yyxi[1];
+		if(yyn < 0)
+			goto ret0;
+	}
+	if(yyn == 0) {
+		/* error ... attempt to resume parsing */
+		switch(yyerrflag) {
+		case 0:   /* brand new error */
+			yyerror("syntax error");
+			if(yydebug >= 1) {
+				printf("%s", yystatname(yystate));
+				printf("saw %s\n", yytokname(yychar));
+			}
+yyerrlab:
+			yynerrs++;
+
+		case 1:
+		case 2: /* incompletely recovered error ... try again */
+			yyerrflag = 3;
+
+			/* find a state where "error" is a legal shift action */
+			while(yyp >= yys) {
+				yyn = yypact[yyp->yys] + YYERRCODE;
+				if(yyn >= 0 && yyn < YYLAST) {
+					yystate = yyact[yyn];  /* simulate a shift of "error" */
+					if(yychk[yystate] == YYERRCODE)
+						goto yystack;
+				}
+
+				/* the current yyp has no shift onn "error", pop stack */
+				if(yydebug >= 2)
+					printf("error recovery pops state %d, uncovers %d\n",
+						yyp->yys, (yyp-1)->yys );
+				yyp--;
+			}
+			/* there is no state on the stack with an error shift ... abort */
+			goto ret1;
+
+		case 3:  /* no shift yet; clobber input char */
+			if(yydebug >= YYEOFCODE)
+				printf("error recovery discards %s\n", yytokname(yychar));
+			if(yychar == YYEOFCODE)
+				goto ret1;
+			yychar = -1;
+			goto yynewstate;   /* try again in the same state */
+		}
+	}
+
+	/* reduction by production yyn */
+	if(yydebug >= 2)
+		printf("reduce %d in:\n\t%s", yyn, yystatname(yystate));
+
+	yypt = yyp;
+	yyp -= yyr2[yyn];
+	yyval = (yyp+1)->yyv;
+	yym = yyn;
+
+	/* consult goto table to find next state */
+	yyn = yyr1[yyn];
+	yyg = yypgo[yyn];
+	yyj = yyg + yyp->yys + 1;
+
+	if(yyj >= YYLAST || yychk[yystate=yyact[yyj]] != -yyn)
+		yystate = yyact[yyg];
+	switch(yym) {
+
+case 3:
+/* #line	220	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+/* stat:   is the nonterminal for Fortran statements */
+
+		  lastwasbranch = NO; } break;
+case 5:
+/* #line	226	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ /* forbid further statement function definitions... */
+		  if (parstate == INDATA && laststfcn != thisstno)
+			parstate = INEXEC;
+		  thisstno++;
+		  if(yypt[-1].yyv.labval && (yypt[-1].yyv.labval->labelno==dorange))
+			enddo(yypt[-1].yyv.labval->labelno);
+		  if(lastwasbranch && thislabel==NULL)
+			warn("statement cannot be reached");
+		  lastwasbranch = thiswasbranch;
+		  thiswasbranch = NO;
+		  if(yypt[-1].yyv.labval)
+			{
+			if(yypt[-1].yyv.labval->labtype == LABFORMAT)
+				err("label already that of a format");
+			else
+				yypt[-1].yyv.labval->labtype = LABEXEC;
+			}
+		  freetemps();
+		} break;
+case 6:
+/* #line	246	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if (can_include)
+			doinclude( yypt[-0].yyv.charpval );
+		  else {
+			fprintf(diagfile, "Cannot open file %s\n", yypt[-0].yyv.charpval);
+			done(1);
+			}
+		} break;
+case 7:
+/* #line	254	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if (yypt[-2].yyv.labval)
+			lastwasbranch = NO;
+		  endcheck();
+		  endproc(); /* lastwasbranch = NO; -- set in endproc() */
+		} break;
+case 8:
+/* #line	260	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ unclassifiable();
+
+/* flline flushes the current line, ignoring the rest of the text there */
+
+		  flline(); } break;
+case 9:
+/* #line	266	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ flline();  needkwd = NO;  inioctl = NO;
+		  yyerrok; yyclearin; } break;
+case 10:
+/* #line	271	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		if(yystno != 0)
+			{
+			yyval.labval = thislabel =  mklabel(yystno);
+			if( ! headerdone ) {
+				if (procclass == CLUNKNOWN)
+					procclass = CLMAIN;
+				puthead(CNULL, procclass);
+				}
+			if(thislabel->labdefined)
+				execerr("label %s already defined",
+					convic(thislabel->stateno) );
+			else	{
+				if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
+				    && thislabel->labtype!=LABFORMAT)
+					warn1("there is a branch to label %s from outside block",
+					      convic( (ftnint) (thislabel->stateno) ) );
+				thislabel->blklevel = blklevel;
+				thislabel->labdefined = YES;
+				if(thislabel->labtype != LABFORMAT)
+					p1_label((long)(thislabel - labeltab));
+				}
+			}
+		else    yyval.labval = thislabel = NULL;
+		} break;
+case 11:
+/* #line	299	"/n/bopp/v5/dmg/f2c/gram.in" */
+{startproc(yypt[-0].yyv.extval, CLMAIN); } break;
+case 12:
+/* #line	301	"/n/bopp/v5/dmg/f2c/gram.in" */
+{	warn("ignoring arguments to main program");
+			/* hashclear(); */
+			startproc(yypt[-1].yyv.extval, CLMAIN); } break;
+case 13:
+/* #line	305	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(yypt[-0].yyv.extval) NO66("named BLOCKDATA");
+		  startproc(yypt[-0].yyv.extval, CLBLOCK); } break;
+case 14:
+/* #line	308	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ entrypt(CLPROC, TYSUBR, (ftnint) 0,  yypt[-1].yyv.extval, yypt[-0].yyv.chval); } break;
+case 15:
+/* #line	310	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, yypt[-1].yyv.extval, yypt[-0].yyv.chval); } break;
+case 16:
+/* #line	312	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ entrypt(CLPROC, yypt[-4].yyv.ival, varleng, yypt[-1].yyv.extval, yypt[-0].yyv.chval); } break;
+case 17:
+/* #line	314	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(parstate==OUTSIDE || procclass==CLMAIN
+			|| procclass==CLBLOCK)
+				execerr("misplaced entry statement", CNULL);
+		  entrypt(CLENTRY, 0, (ftnint) 0, yypt[-1].yyv.extval, yypt[-0].yyv.chval);
+		} break;
+case 18:
+/* #line	322	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ newproc(); } break;
+case 19:
+/* #line	326	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.extval = newentry(yypt[-0].yyv.namval, 1); } break;
+case 20:
+/* #line	330	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.namval = mkname(token); } break;
+case 21:
+/* #line	333	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.extval = NULL; } break;
+case 29:
+/* #line	351	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = 0; } break;
+case 30:
+/* #line	353	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66(" () argument list");
+		  yyval.chval = 0; } break;
+case 31:
+/* #line	356	"/n/bopp/v5/dmg/f2c/gram.in" */
+{yyval.chval = yypt[-1].yyv.chval; } break;
+case 32:
+/* #line	360	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = (yypt[-0].yyv.namval ? mkchain((char *)yypt[-0].yyv.namval,CHNULL) : CHNULL ); } break;
+case 33:
+/* #line	362	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(yypt[-0].yyv.namval) yypt[-2].yyv.chval = yyval.chval = mkchain((char *)yypt[-0].yyv.namval, yypt[-2].yyv.chval); } break;
+case 34:
+/* #line	366	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(yypt[-0].yyv.namval->vstg!=STGUNKNOWN && yypt[-0].yyv.namval->vstg!=STGARG)
+			dclerr("name declared as argument after use", yypt[-0].yyv.namval);
+		  yypt[-0].yyv.namval->vstg = STGARG;
+		} break;
+case 35:
+/* #line	371	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("altenate return argument");
+
+/* substars   means that '*'ed formal parameters should be replaced.
+   This is used to specify alternate return labels; in theory, only
+   parameter slots which have '*' should accept the statement labels.
+   This compiler chooses to ignore the '*'s in the formal declaration, and
+   always return the proper value anyway.
+
+   This variable is only referred to in   proc.c   */
+
+		  yyval.namval = 0;  substars = YES; } break;
+case 36:
+/* #line	387	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		char *s;
+		s = copyn(toklen+1, token);
+		s[toklen] = '\0';
+		yyval.charpval = s;
+		} break;
+case 45:
+/* #line	403	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("SAVE statement");
+		  saveall = YES; } break;
+case 46:
+/* #line	406	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("SAVE statement"); } break;
+case 47:
+/* #line	408	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ fmtstmt(thislabel); setfmt(thislabel); } break;
+case 48:
+/* #line	410	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("PARAMETER statement"); } break;
+case 49:
+/* #line	414	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ settype(yypt[-4].yyv.namval, yypt[-6].yyv.ival, yypt[-0].yyv.lval);
+		  if(ndim>0) setbound(yypt[-4].yyv.namval,ndim,dims);
+		} break;
+case 50:
+/* #line	418	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ settype(yypt[-2].yyv.namval, yypt[-4].yyv.ival, yypt[-0].yyv.lval);
+		  if(ndim>0) setbound(yypt[-2].yyv.namval,ndim,dims);
+		} break;
+case 51:
+/* #line	422	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if (new_dcl == 2) {
+			err("attempt to give DATA in type-declaration");
+			new_dcl = 1;
+			}
+		} break;
+case 52:
+/* #line	429	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ new_dcl = 2; } break;
+case 53:
+/* #line	432	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ varleng = yypt[-0].yyv.lval; } break;
+case 54:
+/* #line	436	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ varleng = (yypt[-0].yyv.ival<0 || ONEOF(yypt[-0].yyv.ival,M(TYLOGICAL)|M(TYLONG))
+				? 0 : typesize[yypt[-0].yyv.ival]);
+		  vartype = yypt[-0].yyv.ival; } break;
+case 55:
+/* #line	441	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = TYLONG; } break;
+case 56:
+/* #line	442	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = tyreal; } break;
+case 57:
+/* #line	443	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ++complex_seen; yyval.ival = tycomplex; } break;
+case 58:
+/* #line	444	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = TYDREAL; } break;
+case 59:
+/* #line	445	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); yyval.ival = TYDCOMPLEX; } break;
+case 60:
+/* #line	446	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = TYLOGICAL; } break;
+case 61:
+/* #line	447	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("CHARACTER statement"); yyval.ival = TYCHAR; } break;
+case 62:
+/* #line	448	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = TYUNKNOWN; } break;
+case 63:
+/* #line	449	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = TYUNKNOWN; } break;
+case 64:
+/* #line	450	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NOEXT("AUTOMATIC statement"); yyval.ival = - STGAUTO; } break;
+case 65:
+/* #line	451	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NOEXT("STATIC statement"); yyval.ival = - STGBSS; } break;
+case 66:
+/* #line	452	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = TYINT1; } break;
+case 67:
+/* #line	456	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.lval = varleng; } break;
+case 68:
+/* #line	458	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		expptr p;
+		p = yypt[-1].yyv.expval;
+		NO66("length specification *n");
+		if( ! ISICON(p) || p->constblock.Const.ci <= 0 )
+			{
+			yyval.lval = 0;
+			dclerr("length must be a positive integer constant",
+				NPNULL);
+			}
+		else {
+			if (vartype == TYCHAR)
+				yyval.lval = p->constblock.Const.ci;
+			else switch((int)p->constblock.Const.ci) {
+				case 1:	yyval.lval = 1; break;
+				case 2: yyval.lval = typesize[TYSHORT];	break;
+				case 4: yyval.lval = typesize[TYLONG];	break;
+				case 8: yyval.lval = typesize[TYDREAL];	break;
+				case 16: yyval.lval = typesize[TYDCOMPLEX]; break;
+				default:
+					dclerr("invalid length",NPNULL);
+					yyval.lval = varleng;
+				}
+			}
+		} break;
+case 69:
+/* #line	484	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("length specification *(*)"); yyval.lval = -1; } break;
+case 70:
+/* #line	488	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ incomm( yyval.extval = comblock("") , yypt[-0].yyv.namval ); } break;
+case 71:
+/* #line	490	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.extval = yypt[-1].yyv.extval;  incomm(yypt[-1].yyv.extval, yypt[-0].yyv.namval); } break;
+case 72:
+/* #line	492	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.extval = yypt[-2].yyv.extval;  incomm(yypt[-2].yyv.extval, yypt[-0].yyv.namval); } break;
+case 73:
+/* #line	494	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ incomm(yypt[-2].yyv.extval, yypt[-0].yyv.namval); } break;
+case 74:
+/* #line	498	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.extval = comblock(""); } break;
+case 75:
+/* #line	500	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.extval = comblock(token); } break;
+case 76:
+/* #line	504	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ setext(yypt[-0].yyv.namval); } break;
+case 77:
+/* #line	506	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ setext(yypt[-0].yyv.namval); } break;
+case 78:
+/* #line	510	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("INTRINSIC statement"); setintr(yypt[-0].yyv.namval); } break;
+case 79:
+/* #line	512	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ setintr(yypt[-0].yyv.namval); } break;
+case 82:
+/* #line	520	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		struct Equivblock *p;
+		if(nequiv >= maxequiv)
+			many("equivalences", 'q', maxequiv);
+		p  =  & eqvclass[nequiv++];
+		p->eqvinit = NO;
+		p->eqvbottom = 0;
+		p->eqvtop = 0;
+		p->equivs = yypt[-1].yyv.eqvval;
+		} break;
+case 83:
+/* #line	533	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.eqvval=ALLOC(Eqvchain);
+		  yyval.eqvval->eqvitem.eqvlhs = primchk(yypt[-0].yyv.expval);
+		} break;
+case 84:
+/* #line	537	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.eqvval=ALLOC(Eqvchain);
+		  yyval.eqvval->eqvitem.eqvlhs = primchk(yypt[-0].yyv.expval);
+		  yyval.eqvval->eqvnextp = yypt[-2].yyv.eqvval;
+		} break;
+case 87:
+/* #line	548	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(parstate == OUTSIDE)
+			{
+			newproc();
+			startproc(ESNULL, CLMAIN);
+			}
+		  if(parstate < INDATA)
+			{
+			enddcl();
+			parstate = INDATA;
+			datagripe = 1;
+			}
+		} break;
+case 88:
+/* #line	563	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ftnint junk;
+		  if(nextdata(&junk) != NULL)
+			err("too few initializers");
+		  frdata(yypt[-4].yyv.chval);
+		  frrpl();
+		} break;
+case 89:
+/* #line	571	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ frchain(&datastack); curdtp = 0; } break;
+case 90:
+/* #line	573	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ pop_datastack(); } break;
+case 91:
+/* #line	575	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ toomanyinit = NO; } break;
+case 94:
+/* #line	580	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ dataval(ENULL, yypt[-0].yyv.expval); } break;
+case 95:
+/* #line	582	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ dataval(yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 97:
+/* #line	587	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if( yypt[-1].yyv.ival==OPMINUS && ISCONST(yypt[-0].yyv.expval) )
+			consnegop((Constp)yypt[-0].yyv.expval);
+		  yyval.expval = yypt[-0].yyv.expval;
+		} break;
+case 101:
+/* #line	599	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ int k;
+		  yypt[-0].yyv.namval->vsave = YES;
+		  k = yypt[-0].yyv.namval->vstg;
+		if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
+			dclerr("can only save static variables", yypt[-0].yyv.namval);
+		} break;
+case 105:
+/* #line	613	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(yypt[-2].yyv.namval->vclass == CLUNKNOWN)
+			make_param((struct Paramblock *)yypt[-2].yyv.namval, yypt[-0].yyv.expval);
+		  else dclerr("cannot make into parameter", yypt[-2].yyv.namval);
+		} break;
+case 106:
+/* #line	620	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(ndim>0) setbound(yypt[-1].yyv.namval, ndim, dims); } break;
+case 107:
+/* #line	624	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ Namep np;
+		  struct Primblock *pp = (struct Primblock *)yypt[-0].yyv.expval;
+		  int tt = yypt[-0].yyv.expval->tag;
+		  if (tt != TPRIM) {
+			if (tt == TCONST)
+				err("parameter in data statement");
+			else
+				erri("tag %d in data statement",tt);
+			yyval.chval = 0;
+			err_lineno = lineno;
+			break;
+			}
+		  np = pp -> namep;
+		  vardcl(np);
+		  if ((pp->fcharp || pp->lcharp)
+		   && (np->vtype != TYCHAR || np->vdim && !pp->argsp))
+			sserr(np);
+		  if(np->vstg == STGCOMMON)
+			extsymtab[np->vardesc.varno].extinit = YES;
+		  else if(np->vstg==STGEQUIV)
+			eqvclass[np->vardesc.varno].eqvinit = YES;
+		  else if(np->vstg!=STGINIT && np->vstg!=STGBSS) {
+			errstr(np->vstg == STGARG
+				? "Dummy argument \"%.60s\" in data statement."
+				: "Cannot give data to \"%.75s\"",
+				np->fvarname);
+			yyval.chval = 0;
+			err_lineno = lineno;
+			break;
+			}
+		  yyval.chval = mkchain((char *)yypt[-0].yyv.expval, CHNULL);
+		} break;
+case 108:
+/* #line	657	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ chainp p; struct Impldoblock *q;
+		pop_datastack();
+		q = ALLOC(Impldoblock);
+		q->tag = TIMPLDO;
+		(q->varnp = (Namep) (yypt[-1].yyv.chval->datap))->vimpldovar = 1;
+		p = yypt[-1].yyv.chval->nextp;
+		if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
+		if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
+		if(p)  { q->impstep = (expptr)(p->datap); }
+		frchain( & (yypt[-1].yyv.chval) );
+		yyval.chval = mkchain((char *)q, CHNULL);
+		q->datalist = hookup(yypt[-3].yyv.chval, yyval.chval);
+		} break;
+case 109:
+/* #line	673	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if (!datastack)
+			curdtp = 0;
+		  datastack = mkchain((char *)curdtp, datastack);
+		  curdtp = yypt[-0].yyv.chval; curdtelt = 0;
+		  } break;
+case 110:
+/* #line	679	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = hookup(yypt[-2].yyv.chval, yypt[-0].yyv.chval); } break;
+case 111:
+/* #line	683	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ndim = 0; } break;
+case 113:
+/* #line	687	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ndim = 0; } break;
+case 116:
+/* #line	692	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		  if(ndim == maxdim)
+			err("too many dimensions");
+		  else if(ndim < maxdim)
+			{ dims[ndim].lb = 0;
+			  dims[ndim].ub = yypt[-0].yyv.expval;
+			}
+		  ++ndim;
+		} break;
+case 117:
+/* #line	702	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		  if(ndim == maxdim)
+			err("too many dimensions");
+		  else if(ndim < maxdim)
+			{ dims[ndim].lb = yypt[-2].yyv.expval;
+			  dims[ndim].ub = yypt[-0].yyv.expval;
+			}
+		  ++ndim;
+		} break;
+case 118:
+/* #line	714	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = 0; } break;
+case 120:
+/* #line	719	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ nstars = 1; labarray[0] = yypt[-0].yyv.labval; } break;
+case 121:
+/* #line	721	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(nstars < maxlablist)  labarray[nstars++] = yypt[-0].yyv.labval; } break;
+case 122:
+/* #line	725	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.labval = execlab( convci(toklen, token) ); } break;
+case 123:
+/* #line	729	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("IMPLICIT statement"); } break;
+case 126:
+/* #line	735	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if (vartype != TYUNKNOWN)
+			dclerr("-- expected letter range",NPNULL);
+		  setimpl(vartype, varleng, 'a', 'z'); } break;
+case 127:
+/* #line	740	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ needkwd = 1; } break;
+case 131:
+/* #line	749	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ setimpl(vartype, varleng, yypt[-0].yyv.ival, yypt[-0].yyv.ival); } break;
+case 132:
+/* #line	751	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ setimpl(vartype, varleng, yypt[-2].yyv.ival, yypt[-0].yyv.ival); } break;
+case 133:
+/* #line	755	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(toklen!=1 || token[0]<'a' || token[0]>'z')
+			{
+			dclerr("implicit item must be single letter", NPNULL);
+			yyval.ival = 0;
+			}
+		  else yyval.ival = token[0];
+		} break;
+case 136:
+/* #line	769	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		if(yypt[-2].yyv.namval->vclass == CLUNKNOWN)
+			{
+			yypt[-2].yyv.namval->vclass = CLNAMELIST;
+			yypt[-2].yyv.namval->vtype = TYINT;
+			yypt[-2].yyv.namval->vstg = STGBSS;
+			yypt[-2].yyv.namval->varxptr.namelist = yypt[-0].yyv.chval;
+			yypt[-2].yyv.namval->vardesc.varno = ++lastvarno;
+			}
+		else dclerr("cannot be a namelist name", yypt[-2].yyv.namval);
+		} break;
+case 137:
+/* #line	783	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.namval, CHNULL); } break;
+case 138:
+/* #line	785	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = hookup(yypt[-2].yyv.chval, mkchain((char *)yypt[-0].yyv.namval, CHNULL)); } break;
+case 139:
+/* #line	789	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ switch(parstate)
+			{
+			case OUTSIDE:	newproc();
+					startproc(ESNULL, CLMAIN);
+			case INSIDE:	parstate = INDCL;
+			case INDCL:	break;
+
+			case INDATA:
+				if (datagripe) {
+					errstr(
+				"Statement order error: declaration after DATA",
+						CNULL);
+					datagripe = 0;
+					}
+				break;
+
+			default:
+				dclerr("declaration among executables", NPNULL);
+			}
+		} break;
+case 140:
+/* #line	811	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = 0; } break;
+case 141:
+/* #line	813	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = revchain(yypt[-0].yyv.chval); } break;
+case 142:
+/* #line	817	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.expval, CHNULL); } break;
+case 143:
+/* #line	819	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.expval, yypt[-2].yyv.chval); } break;
+case 145:
+/* #line	824	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = yypt[-1].yyv.expval; if (yyval.expval->tag == TPRIM)
+					paren_used(&yyval.expval->primblock); } break;
+case 149:
+/* #line	832	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(yypt[-1].yyv.ival, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 150:
+/* #line	834	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPSTAR, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 151:
+/* #line	836	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPSLASH, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 152:
+/* #line	838	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPPOWER, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 153:
+/* #line	840	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(yypt[-1].yyv.ival == OPMINUS)
+			yyval.expval = mkexpr(OPNEG, yypt[-0].yyv.expval, ENULL);
+		  else {
+			yyval.expval = yypt[-0].yyv.expval;
+			if (yyval.expval->tag == TPRIM)
+				paren_used(&yyval.expval->primblock);
+			}
+		} break;
+case 154:
+/* #line	849	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(yypt[-1].yyv.ival, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 155:
+/* #line	851	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66(".EQV. operator");
+		  yyval.expval = mkexpr(OPEQV, yypt[-2].yyv.expval,yypt[-0].yyv.expval); } break;
+case 156:
+/* #line	854	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66(".NEQV. operator");
+		  yyval.expval = mkexpr(OPNEQV, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 157:
+/* #line	857	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPOR, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 158:
+/* #line	859	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPAND, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 159:
+/* #line	861	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPNOT, yypt[-0].yyv.expval, ENULL); } break;
+case 160:
+/* #line	863	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("concatenation operator //");
+		  yyval.expval = mkexpr(OPCONCAT, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 161:
+/* #line	867	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = OPPLUS; } break;
+case 162:
+/* #line	868	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = OPMINUS; } break;
+case 163:
+/* #line	871	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = OPEQ; } break;
+case 164:
+/* #line	872	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = OPGT; } break;
+case 165:
+/* #line	873	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = OPLT; } break;
+case 166:
+/* #line	874	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = OPGE; } break;
+case 167:
+/* #line	875	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = OPLE; } break;
+case 168:
+/* #line	876	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = OPNE; } break;
+case 169:
+/* #line	880	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkprim(yypt[-0].yyv.namval, LBNULL, CHNULL); } break;
+case 170:
+/* #line	882	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("substring operator :");
+		  yyval.expval = mkprim(yypt[-1].yyv.namval, LBNULL, yypt[-0].yyv.chval); } break;
+case 171:
+/* #line	885	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkprim(yypt[-3].yyv.namval, mklist(yypt[-1].yyv.chval), CHNULL); } break;
+case 172:
+/* #line	887	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("substring operator :");
+		  yyval.expval = mkprim(yypt[-4].yyv.namval, mklist(yypt[-2].yyv.chval), yypt[-0].yyv.chval); } break;
+case 173:
+/* #line	892	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-3].yyv.expval, mkchain((char *)yypt[-1].yyv.expval,CHNULL)); } break;
+case 174:
+/* #line	896	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = 0; } break;
+case 176:
+/* #line	901	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(yypt[-0].yyv.namval->vclass == CLPARAM)
+			yyval.expval = (expptr) cpexpr(
+				( (struct Paramblock *) (yypt[-0].yyv.namval) ) -> paramval);
+		} break;
+case 178:
+/* #line	908	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mklogcon(1); } break;
+case 179:
+/* #line	909	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mklogcon(0); } break;
+case 180:
+/* #line	910	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkstrcon(toklen, token); } break;
+case 181:
+/* #line	911	"/n/bopp/v5/dmg/f2c/gram.in" */
+ { yyval.expval = mkintqcon(toklen, token); } break;
+case 182:
+/* #line	912	"/n/bopp/v5/dmg/f2c/gram.in" */
+ { yyval.expval = mkrealcon(tyreal, token); } break;
+case 183:
+/* #line	913	"/n/bopp/v5/dmg/f2c/gram.in" */
+ { yyval.expval = mkrealcon(TYDREAL, token); } break;
+case 185:
+/* #line	918	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkcxcon(yypt[-3].yyv.expval,yypt[-1].yyv.expval); } break;
+case 186:
+/* #line	922	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NOEXT("hex constant");
+		  yyval.expval = mkbitcon(4, toklen, token); } break;
+case 187:
+/* #line	925	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NOEXT("octal constant");
+		  yyval.expval = mkbitcon(3, toklen, token); } break;
+case 188:
+/* #line	928	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NOEXT("binary constant");
+		  yyval.expval = mkbitcon(1, toklen, token); } break;
+case 190:
+/* #line	934	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = yypt[-1].yyv.expval; } break;
+case 193:
+/* #line	940	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(yypt[-1].yyv.ival, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 194:
+/* #line	942	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPSTAR, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 195:
+/* #line	944	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPSLASH, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 196:
+/* #line	946	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.expval = mkexpr(OPPOWER, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 197:
+/* #line	948	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(yypt[-1].yyv.ival == OPMINUS)
+			yyval.expval = mkexpr(OPNEG, yypt[-0].yyv.expval, ENULL);
+		  else yyval.expval = yypt[-0].yyv.expval;
+		} break;
+case 198:
+/* #line	953	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ NO66("concatenation operator //");
+		  yyval.expval = mkexpr(OPCONCAT, yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 200:
+/* #line	958	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		if(yypt[-2].yyv.labval->labdefined)
+			execerr("no backward DO loops", CNULL);
+		yypt[-2].yyv.labval->blklevel = blklevel+1;
+		exdo(yypt[-2].yyv.labval->labelno, NPNULL, yypt[-0].yyv.chval);
+		} break;
+case 201:
+/* #line	965	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		exdo((int)(ctls - ctlstack - 2), NPNULL, yypt[-0].yyv.chval);
+		NOEXT("DO without label");
+		} break;
+case 202:
+/* #line	970	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exenddo(NPNULL); } break;
+case 203:
+/* #line	972	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exendif();  thiswasbranch = NO; } break;
+case 205:
+/* #line	974	"/n/bopp/v5/dmg/f2c/gram.in" */
+{westart(1);} break;
+case 206:
+/* #line	975	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exelif(yypt[-2].yyv.expval); lastwasbranch = NO; } break;
+case 207:
+/* #line	977	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exelse(); lastwasbranch = NO; } break;
+case 208:
+/* #line	979	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exendif(); lastwasbranch = NO; } break;
+case 209:
+/* #line	983	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exif(yypt[-1].yyv.expval); } break;
+case 210:
+/* #line	987	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-2].yyv.namval, yypt[-0].yyv.chval); } break;
+case 212:
+/* #line	991	"/n/bopp/v5/dmg/f2c/gram.in" */
+{westart(0);} break;
+case 213:
+/* #line	992	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain(CNULL, (chainp)yypt[-1].yyv.expval); } break;
+case 214:
+/* #line	996	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exequals((struct Primblock *)yypt[-2].yyv.expval, yypt[-0].yyv.expval); } break;
+case 215:
+/* #line	998	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exassign(yypt[-0].yyv.namval, yypt[-2].yyv.labval); } break;
+case 218:
+/* #line	1002	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ inioctl = NO; } break;
+case 219:
+/* #line	1004	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exarif(yypt[-6].yyv.expval, yypt[-4].yyv.labval, yypt[-2].yyv.labval, yypt[-0].yyv.labval);  thiswasbranch = YES; } break;
+case 220:
+/* #line	1006	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ excall(yypt[-0].yyv.namval, LBNULL, 0, labarray); } break;
+case 221:
+/* #line	1008	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ excall(yypt[-2].yyv.namval, LBNULL, 0, labarray); } break;
+case 222:
+/* #line	1010	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(nstars < maxlablist)
+			excall(yypt[-3].yyv.namval, mklist(revchain(yypt[-1].yyv.chval)), nstars, labarray);
+		  else
+			many("alternate returns", 'l', maxlablist);
+		} break;
+case 223:
+/* #line	1016	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exreturn(yypt[-0].yyv.expval);  thiswasbranch = YES; } break;
+case 224:
+/* #line	1018	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exstop(yypt[-2].yyv.ival, yypt[-0].yyv.expval);  thiswasbranch = yypt[-2].yyv.ival; } break;
+case 225:
+/* #line	1022	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.labval = mklabel( convci(toklen, token) ); } break;
+case 226:
+/* #line	1026	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(parstate == OUTSIDE)
+			{
+			newproc();
+			startproc(ESNULL, CLMAIN);
+			}
+		} break;
+case 227:
+/* #line	1035	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exgoto(yypt[-0].yyv.labval);  thiswasbranch = YES; } break;
+case 228:
+/* #line	1037	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exasgoto(yypt[-0].yyv.namval);  thiswasbranch = YES; } break;
+case 229:
+/* #line	1039	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ exasgoto(yypt[-4].yyv.namval);  thiswasbranch = YES; } break;
+case 230:
+/* #line	1041	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(nstars < maxlablist)
+			putcmgo(putx(fixtype(yypt[-0].yyv.expval)), nstars, labarray);
+		  else
+			many("labels in computed GOTO list", 'l', maxlablist);
+		} break;
+case 233:
+/* #line	1053	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ nstars = 0; yyval.namval = yypt[-0].yyv.namval; } break;
+case 234:
+/* #line	1057	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = yypt[-0].yyv.expval ? mkchain((char *)yypt[-0].yyv.expval,CHNULL) : CHNULL; } break;
+case 235:
+/* #line	1059	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = yypt[-0].yyv.expval ? mkchain((char *)yypt[-0].yyv.expval, yypt[-2].yyv.chval) : yypt[-2].yyv.chval; } break;
+case 237:
+/* #line	1064	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(nstars < maxlablist) labarray[nstars++] = yypt[-0].yyv.labval; yyval.expval = 0; } break;
+case 238:
+/* #line	1068	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = 0; } break;
+case 239:
+/* #line	1070	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = 2; } break;
+case 240:
+/* #line	1074	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.expval, CHNULL); } break;
+case 241:
+/* #line	1076	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = hookup(yypt[-2].yyv.chval, mkchain((char *)yypt[-0].yyv.expval,CHNULL) ); } break;
+case 242:
+/* #line	1080	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ if(parstate == OUTSIDE)
+			{
+			newproc();
+			startproc(ESNULL, CLMAIN);
+			}
+
+/* This next statement depends on the ordering of the state table encoding */
+
+		  if(parstate < INDATA) enddcl();
+		} break;
+case 243:
+/* #line	1093	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ intonly = YES; } break;
+case 244:
+/* #line	1097	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ intonly = NO; } break;
+case 245:
+/* #line	1102	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ endio(); } break;
+case 247:
+/* #line	1107	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(IOSUNIT, yypt[-0].yyv.expval); endioctl(); } break;
+case 248:
+/* #line	1109	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(IOSUNIT, ENULL); endioctl(); } break;
+case 249:
+/* #line	1111	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(IOSUNIT, IOSTDERR); endioctl(); } break;
+case 251:
+/* #line	1114	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(CHNULL); } break;
+case 252:
+/* #line	1116	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(CHNULL); } break;
+case 253:
+/* #line	1118	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(revchain(yypt[-0].yyv.chval)); } break;
+case 254:
+/* #line	1120	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(revchain(yypt[-0].yyv.chval)); } break;
+case 255:
+/* #line	1122	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(revchain(yypt[-0].yyv.chval)); } break;
+case 256:
+/* #line	1124	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(CHNULL); } break;
+case 257:
+/* #line	1126	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(revchain(yypt[-0].yyv.chval)); } break;
+case 258:
+/* #line	1128	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(revchain(yypt[-0].yyv.chval)); } break;
+case 259:
+/* #line	1130	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(CHNULL); } break;
+case 260:
+/* #line	1132	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ doio(revchain(yypt[-0].yyv.chval)); } break;
+case 262:
+/* #line	1139	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ iostmt = IOBACKSPACE; } break;
+case 263:
+/* #line	1141	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ iostmt = IOREWIND; } break;
+case 264:
+/* #line	1143	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ iostmt = IOENDFILE; } break;
+case 266:
+/* #line	1150	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ iostmt = IOINQUIRE; } break;
+case 267:
+/* #line	1152	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ iostmt = IOOPEN; } break;
+case 268:
+/* #line	1154	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ iostmt = IOCLOSE; } break;
+case 269:
+/* #line	1158	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		ioclause(IOSUNIT, ENULL);
+		ioclause(IOSFMT, yypt[-0].yyv.expval);
+		endioctl();
+		} break;
+case 270:
+/* #line	1164	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		ioclause(IOSUNIT, ENULL);
+		ioclause(IOSFMT, ENULL);
+		endioctl();
+		} break;
+case 271:
+/* #line	1172	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		  ioclause(IOSUNIT, yypt[-1].yyv.expval);
+		  endioctl();
+		} break;
+case 272:
+/* #line	1177	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ endioctl(); } break;
+case 275:
+/* #line	1185	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(IOSPOSITIONAL, yypt[-0].yyv.expval); } break;
+case 276:
+/* #line	1187	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(IOSPOSITIONAL, ENULL); } break;
+case 277:
+/* #line	1189	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(IOSPOSITIONAL, IOSTDERR); } break;
+case 278:
+/* #line	1191	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(yypt[-1].yyv.ival, yypt[-0].yyv.expval); } break;
+case 279:
+/* #line	1193	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(yypt[-1].yyv.ival, ENULL); } break;
+case 280:
+/* #line	1195	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ ioclause(yypt[-1].yyv.ival, IOSTDERR); } break;
+case 281:
+/* #line	1199	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.ival = iocname(); } break;
+case 282:
+/* #line	1203	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ iostmt = IOREAD; } break;
+case 283:
+/* #line	1207	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ iostmt = IOWRITE; } break;
+case 284:
+/* #line	1211	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		iostmt = IOWRITE;
+		ioclause(IOSUNIT, ENULL);
+		ioclause(IOSFMT, yypt[-1].yyv.expval);
+		endioctl();
+		} break;
+case 285:
+/* #line	1218	"/n/bopp/v5/dmg/f2c/gram.in" */
+{
+		iostmt = IOWRITE;
+		ioclause(IOSUNIT, ENULL);
+		ioclause(IOSFMT, ENULL);
+		endioctl();
+		} break;
+case 286:
+/* #line	1227	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.tagval, CHNULL); } break;
+case 287:
+/* #line	1229	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.tagval, yypt[-2].yyv.chval); } break;
+case 288:
+/* #line	1233	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.tagval = (tagptr) yypt[-0].yyv.expval; } break;
+case 289:
+/* #line	1235	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.tagval = (tagptr) mkiodo(yypt[-1].yyv.chval,revchain(yypt[-3].yyv.chval)); } break;
+case 290:
+/* #line	1239	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.expval, CHNULL); } break;
+case 291:
+/* #line	1241	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.tagval, CHNULL); } break;
+case 293:
+/* #line	1246	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.expval, mkchain((char *)yypt[-2].yyv.expval, CHNULL) ); } break;
+case 294:
+/* #line	1248	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.tagval, mkchain((char *)yypt[-2].yyv.expval, CHNULL) ); } break;
+case 295:
+/* #line	1250	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.expval, mkchain((char *)yypt[-2].yyv.tagval, CHNULL) ); } break;
+case 296:
+/* #line	1252	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.tagval, mkchain((char *)yypt[-2].yyv.tagval, CHNULL) ); } break;
+case 297:
+/* #line	1254	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.expval, yypt[-2].yyv.chval); } break;
+case 298:
+/* #line	1256	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.chval = mkchain((char *)yypt[-0].yyv.tagval, yypt[-2].yyv.chval); } break;
+case 299:
+/* #line	1260	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.tagval = (tagptr) yypt[-0].yyv.expval; } break;
+case 300:
+/* #line	1262	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.tagval = (tagptr) yypt[-1].yyv.expval; } break;
+case 301:
+/* #line	1264	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.tagval = (tagptr) mkiodo(yypt[-1].yyv.chval, mkchain((char *)yypt[-3].yyv.expval, CHNULL) ); } break;
+case 302:
+/* #line	1266	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.tagval = (tagptr) mkiodo(yypt[-1].yyv.chval, mkchain((char *)yypt[-3].yyv.tagval, CHNULL) ); } break;
+case 303:
+/* #line	1268	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ yyval.tagval = (tagptr) mkiodo(yypt[-1].yyv.chval, revchain(yypt[-3].yyv.chval)); } break;
+case 304:
+/* #line	1272	"/n/bopp/v5/dmg/f2c/gram.in" */
+{ startioctl(); } break;
+	}
+	goto yystack;  /* stack new state and value */
+}
diff --git a/contrib/tools/f2c/src/init.c b/contrib/tools/f2c/src/init.c
new file mode 100644
index 0000000000..752c99a893
--- /dev/null
+++ b/contrib/tools/f2c/src/init.c
@@ -0,0 +1,526 @@
+/****************************************************************
+Copyright 1990, 1992-1996, 2000-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "output.h"
+#include "iob.h"
+
+/* State required for the C output */
+char *fl_fmt_string;		/* Float format string */
+char *db_fmt_string;	    	/* Double format string */
+char *cm_fmt_string;		/* Complex format string */
+char *dcm_fmt_string;		/* Double complex format string */
+
+chainp new_vars = CHNULL;	/* List of newly created locals in this
+				   function.  These may have identifiers
+				   which have underscores and more than VL
+				   characters */
+chainp used_builtins = CHNULL;	/* List of builtins used by this function.
+				   These are all Addrps with UNAM_EXTERN
+				   */
+chainp assigned_fmts = CHNULL;	/* assigned formats */
+chainp allargs;			/* union of args in all entry points */
+chainp earlylabs;		/* labels seen before enddcl() */
+char main_alias[52];		/* PROGRAM name, if any is given */
+int tab_size = 4;
+
+
+FILEP infile;
+FILEP diagfile;
+
+FILEP c_file;
+FILEP pass1_file;
+FILEP initfile;
+FILEP blkdfile;
+
+
+char *token;
+int maxtoklen, toklen;
+long err_lineno;
+long lineno;			/* Current line in the input file, NOT the
+				   Fortran statement label number */
+char *infname;
+int needkwd;
+struct Labelblock *thislabel	= NULL;
+int nerr;
+int nwarn;
+
+flag saveall;
+flag substars;
+int parstate	= OUTSIDE;
+flag headerdone	= NO;
+int blklevel;
+int doin_setbound;
+int impltype[26];
+ftnint implleng[26];
+int implstg[26];
+
+int tyint	= TYLONG ;
+int tylogical	= TYLONG;
+int tylog	= TYLOGICAL;
+int typesize[NTYPES] = {
+	1, SZADDR, 1, SZSHORT, SZLONG,
+#ifdef TYQUAD
+		2*SZLONG,
+#endif
+		SZLONG, 2*SZLONG,
+		2*SZLONG, 4*SZLONG, 1, SZSHORT, SZLONG, 1, 1, 0,
+		4*SZLONG + SZADDR,	/* sizeof(cilist) */
+		4*SZLONG + 2*SZADDR,	/* sizeof(icilist) */
+		4*SZLONG + 5*SZADDR,	/* sizeof(olist) */
+		2*SZLONG + SZADDR,	/* sizeof(cllist) */
+		2*SZLONG,		/* sizeof(alist) */
+		11*SZLONG + 15*SZADDR	/* sizeof(inlist) */
+		};
+
+int typealign[NTYPES] = {
+	1, ALIADDR, 1, ALISHORT, ALILONG,
+#ifdef TYQUAD
+	ALIDOUBLE,
+#endif
+	ALILONG, ALIDOUBLE,
+	ALILONG, ALIDOUBLE, 1, ALISHORT, ALILONG, 1, 1, 1,
+	ALILONG, ALILONG, ALILONG, ALILONG, ALILONG, ALILONG};
+
+int type_choice[4] = { TYDREAL, TYSHORT, TYLONG,  TYSHORT };
+
+char *Typename[] = {
+	"<<unknown>>",
+	"address",
+	"integer1",
+	"shortint",
+	"integer",
+#ifdef TYQUAD
+	"longint",
+#endif
+	"real",
+	"doublereal",
+	"complex",
+	"doublecomplex",
+	"logical1",
+	"shortlogical",
+	"logical",
+	"char"	/* character */
+	};
+
+int type_pref[NTYPES] = { 0, 0, 3, 5, 7,
+#ifdef TYQUAD
+			 10,
+#endif
+				8, 11, 9, 12, 1, 4, 6, 2 };
+
+char *protorettypes[] = {
+	"?", "??", "integer1", "shortint", "integer",
+#ifdef TYQUAD
+	"longint",
+#endif
+	"real", "doublereal",
+	"C_f", "Z_f", "logical1", "shortlogical", "logical", "H_f", "int"
+	};
+
+char *casttypes[TYSUBR+1] = {
+	"U_fp", "??bug??", "I1_fp",
+	"J_fp", "I_fp",
+#ifdef TYQUAD
+	"Q_fp",
+#endif
+	"R_fp", "D_fp", "C_fp", "Z_fp",
+	"L1_fp", "L2_fp", "L_fp", "H_fp", "S_fp"
+	};
+char *usedcasts[TYSUBR+1];
+
+char *dfltarg[] = {
+	0, 0, "(integer1 *)0",
+	"(shortint *)0", "(integer *)0",
+#ifdef TYQUAD
+	"(longint *)0",
+#endif
+	"(real *)0",
+	"(doublereal *)0", "(complex *)0", "(doublecomplex *)0",
+	"(logical1 *)0","(shortlogical *)0", "(logical *)0", "(char *)0"
+	};
+
+static char *dflt0proc[] = {
+	0, 0, "(integer1 (*)())0",
+	"(shortint (*)())0", "(integer (*)())0",
+#ifdef TYQUAD
+	"(longint (*)())0",
+#endif
+	"(real (*)())0",
+	"(doublereal (*)())0", "(complex (*)())0", "(doublecomplex (*)())0",
+	"(logical1 (*)())0", "(shortlogical (*)())0",
+	"(logical (*)())0", "(char (*)())0", "(int (*)())0"
+	};
+
+char *dflt1proc[] = { "(U_fp)0", "( ??bug?? )0", "(I1_fp)0",
+	"(J_fp)0", "(I_fp)0",
+#ifdef TYQUAD
+	"(Q_fp)0",
+#endif
+	"(R_fp)0", "(D_fp)0", "(C_fp)0", "(Z_fp)0",
+	"(L1_fp)0","(L2_fp)0",
+	"(L_fp)0", "(H_fp)0", "(S_fp)0"
+	};
+
+char **dfltproc = dflt0proc;
+
+static char Bug[] = "bug";
+
+char *ftn_types[] = { "external", "??", "integer*1",
+	"integer*2", "integer",
+#ifdef TYQUAD
+	"integer*8",
+#endif
+	"real",
+	"double precision", "complex", "double complex",
+	"logical*1", "logical*2",
+	"logical", "character", "subroutine",
+	Bug,Bug,Bug,Bug,Bug,Bug,Bug,Bug,Bug, "ftnlen"
+	};
+
+int init_ac[TYSUBR+1] = { 0,0,0,0,0,0,0,
+#ifdef TYQUAD
+			  0,
+#endif
+			  1, 1, 0, 0, 0, 2};
+
+int proctype	= TYUNKNOWN;
+char *procname;
+int rtvlabel[NTYPES0];
+Addrp retslot;			/* Holds automatic variable which was
+				   allocated the function return value
+				   */
+Addrp xretslot[NTYPES0];	/* for multiple entry points */
+int cxslot	= -1;
+int chslot	= -1;
+int chlgslot	= -1;
+int procclass	= CLUNKNOWN;
+int nentry;
+int nallargs;
+int nallchargs;
+flag multitype;
+ftnint procleng;
+long lastiolabno;
+long lastlabno;
+int lastvarno;
+int lastargslot;
+int autonum[TYVOID];
+char *av_pfix[TYVOID] = {"??TYUNKNOWN??", "a","i1","s","i",
+#ifdef TYQUAD
+			 "i8",
+#endif
+			"r","d","q","z","L1","L2","L","ch",
+			 "??TYSUBR??", "??TYERROR??","ci", "ici",
+			 "o", "cl", "al", "ioin" };
+
+extern int maxctl;
+struct Ctlframe *ctls;
+struct Ctlframe *ctlstack;
+struct Ctlframe *lastctl;
+
+Namep regnamep[MAXREGVAR];
+int highregvar;
+int nregvar;
+
+extern int maxext;
+Extsym *extsymtab;
+Extsym *nextext;
+Extsym *lastext;
+
+extern int maxequiv;
+struct Equivblock *eqvclass;
+
+extern int maxhash;
+struct Hashentry *hashtab;
+struct Hashentry *lasthash;
+
+extern int maxstno;		/* Maximum number of statement labels */
+struct Labelblock *labeltab;
+struct Labelblock *labtabend;
+struct Labelblock *highlabtab;
+
+int maxdim	= MAXDIM;
+struct Rplblock *rpllist	= NULL;
+struct Chain *curdtp	= NULL;
+flag toomanyinit;
+ftnint curdtelt;
+chainp templist[TYVOID];
+chainp holdtemps;
+int dorange	= 0;
+struct Entrypoint *entries	= NULL;
+
+chainp chains	= NULL;
+
+flag inioctl;
+int iostmt;
+int nioctl;
+int nequiv	= 0;
+int eqvstart	= 0;
+int nintnames	= 0;
+extern int maxlablist;
+struct Labelblock **labarray;
+
+struct Literal *litpool;
+int nliterals;
+
+char dflttype[26];
+unsigned char hextoi_tab[Table_size], Letters[Table_size];
+char *ei_first, *ei_next, *ei_last;
+char *wh_first, *wh_next, *wh_last;
+#ifdef TYQUAD
+unsigned long ff;
+#endif
+
+#define ALLOCN(n,x)	(struct x *) ckalloc((n)*sizeof(struct x))
+
+ void
+fileinit(Void)
+{
+	register char *s;
+	register int i, j;
+
+	lastiolabno = 100000;
+	lastlabno = 0;
+	lastvarno = 0;
+	nliterals = 0;
+	nerr = 0;
+
+	infile = stdin;
+
+	maxtoklen = 502;
+	token = (char *)ckalloc(maxtoklen+2);
+	memset(dflttype, tyreal, 26);
+	memset(dflttype + ('i' - 'a'), tyint, 6);
+	memset(hextoi_tab, 16, sizeof(hextoi_tab));
+	for(i = 0, s = "0123456789abcdef"; *s; i++, s++)
+		hextoi(*s) = i;
+	for(i = 10, s = "ABCDEF"; *s; i++, s++)
+		hextoi(*s) = i;
+	for(j = 0, s = "abcdefghijklmnopqrstuvwxyz"; i = *s++; j++)
+		Letters[i] = Letters[i+'A'-'a'] = j;
+#ifdef TYQUAD
+	/* Older C compilers may not understand UL suffixes. */
+	/* It would be much simpler to use 0xffffffffUL some places... */
+	ff = 0xffff;
+	ff = (ff << 16) | ff;
+#endif
+	ctls = ALLOCN(maxctl+1, Ctlframe);
+	extsymtab = ALLOCN(maxext, Extsym);
+	eqvclass = ALLOCN(maxequiv, Equivblock);
+	hashtab = ALLOCN(maxhash, Hashentry);
+	labeltab = ALLOCN(maxstno, Labelblock);
+	litpool = ALLOCN(maxliterals, Literal);
+	labarray = (struct Labelblock **)ckalloc(maxlablist*
+					sizeof(struct Labelblock *));
+	fmt_init();
+	mem_init();
+	np_init();
+
+	ctlstack = ctls++;
+	lastctl = ctls + maxctl;
+	nextext = extsymtab;
+	lastext = extsymtab + maxext;
+	lasthash = hashtab + maxhash;
+	labtabend = labeltab + maxstno;
+	highlabtab = labeltab;
+	main_alias[0] = '\0';
+	if (forcedouble)
+		dfltproc[TYREAL] = dfltproc[TYDREAL];
+
+/* Initialize the routines for providing C output */
+
+	out_init ();
+}
+
+ void
+hashclear(Void)	/* clear hash table */
+{
+	register struct Hashentry *hp;
+	register Namep p;
+	register struct Dimblock *q;
+	register int i;
+
+	for(hp = hashtab ; hp < lasthash ; ++hp)
+		if(p = hp->varp)
+		{
+			frexpr(p->vleng);
+			if(q = p->vdim)
+			{
+				for(i = 0 ; i < q->ndim ; ++i)
+				{
+					frexpr(q->dims[i].dimsize);
+					frexpr(q->dims[i].dimexpr);
+				}
+				frexpr(q->nelt);
+				frexpr(q->baseoffset);
+				frexpr(q->basexpr);
+				free( (charptr) q);
+			}
+			if(p->vclass == CLNAMELIST)
+				frchain( &(p->varxptr.namelist) );
+			free( (charptr) p);
+			hp->varp = NULL;
+		}
+	}
+
+ extern struct memblock *curmemblock, *firstmemblock;
+ extern char *mem_first, *mem_next, *mem_last, *mem0_last;
+
+ void
+procinit(Void)
+{
+	register struct Labelblock *lp;
+	struct Chain *cp;
+	int i;
+	struct memblock;
+
+	curmemblock = firstmemblock;
+	mem_next = mem_first;
+	mem_last = mem0_last;
+	ei_next = ei_first = ei_last = 0;
+	wh_next = wh_first = wh_last = 0;
+	iob_list = 0;
+	for(i = 0; i < 9; i++)
+		io_structs[i] = 0;
+
+	parstate = OUTSIDE;
+	headerdone = NO;
+	blklevel = 1;
+	saveall = NO;
+	substars = NO;
+	nwarn = 0;
+	thislabel = NULL;
+	needkwd = 0;
+
+	proctype = TYUNKNOWN;
+	procname = "MAIN_";
+	procclass = CLUNKNOWN;
+	nentry = 0;
+	nallargs = nallchargs = 0;
+	multitype = NO;
+	retslot = NULL;
+	for(i = 0; i < NTYPES0; i++) {
+		frexpr((expptr)xretslot[i]);
+		xretslot[i] = 0;
+		}
+	cxslot = -1;
+	chslot = -1;
+	chlgslot = -1;
+	procleng = 0;
+	blklevel = 1;
+	lastargslot = 0;
+
+	for(lp = labeltab ; lp < labtabend ; ++lp)
+		lp->stateno = 0;
+
+	hashclear();
+
+/* Clear the list of newly generated identifiers from the previous
+   function */
+
+	frexchain(&new_vars);
+	frexchain(&used_builtins);
+	frchain(&assigned_fmts);
+	frchain(&allargs);
+	frchain(&earlylabs);
+
+	nintnames = 0;
+	highlabtab = labeltab;
+
+	ctlstack = ctls - 1;
+	for(i = TYADDR; i < TYVOID; i++) {
+		for(cp = templist[i]; cp ; cp = cp->nextp)
+			free( (charptr) (cp->datap) );
+		frchain(templist + i);
+		autonum[i] = 0;
+		}
+	holdtemps = NULL;
+	dorange = 0;
+	nregvar = 0;
+	highregvar = 0;
+	entries = NULL;
+	rpllist = NULL;
+	inioctl = NO;
+	eqvstart += nequiv;
+	nequiv = 0;
+	dcomplex_seen = 0;
+
+	for(i = 0 ; i<NTYPES0 ; ++i)
+		rtvlabel[i] = 0;
+
+	if(undeftype)
+		setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
+	else
+	{
+		setimpl(tyreal, (ftnint) 0, 'a', 'z');
+		setimpl(tyint,  (ftnint) 0, 'i', 'n');
+	}
+	setimpl(-STGBSS, (ftnint) 0, 'a', 'z');	/* set class */
+}
+
+
+
+ void
+#ifdef KR_headers
+setimpl(type, length, c1, c2)
+	int type;
+	ftnint length;
+	int c1;
+	int c2;
+#else
+setimpl(int type, ftnint length, int c1, int c2)
+#endif
+{
+	int i;
+	char buff[100];
+
+	if(c1==0 || c2==0)
+		return;
+
+	if(c1 > c2) {
+		sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2);
+		err(buff);
+		}
+	else {
+		c1 = letter(c1);
+		c2 = letter(c2);
+		if(type < 0)
+			for(i = c1 ; i<=c2 ; ++i)
+				implstg[i] = - type;
+		else {
+			type = lengtype(type, length);
+			if(type == TYCHAR) {
+				if (length < 0) {
+					err("length (*) in implicit");
+					length = 1;
+					}
+				}
+			else if (type != TYLONG)
+				length = 0;
+			for(i = c1 ; i<=c2 ; ++i) {
+				impltype[i] = type;
+				implleng[i] = length;
+				}
+			}
+		}
+	}
diff --git a/contrib/tools/f2c/src/intr.c b/contrib/tools/f2c/src/intr.c
new file mode 100644
index 0000000000..9da6757320
--- /dev/null
+++ b/contrib/tools/f2c/src/intr.c
@@ -0,0 +1,1087 @@
+/****************************************************************
+Copyright 1990, 1992, 1994-6, 1998 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "names.h"
+
+union
+	{
+	int ijunk;
+	struct Intrpacked bits;
+	} packed;
+
+struct Intrbits
+	{
+	char intrgroup /* :3 */;
+	char intrstuff /* result type or number of generics */;
+	char intrno /* :7 */;
+	char dblcmplx;
+	char dblintrno;	/* for -r8 */
+	char extflag;	/* for -cd, -i90 */
+	};
+
+/* List of all intrinsic functions.  */
+
+LOCAL struct Intrblock
+	{
+	char intrfname[8];
+	struct Intrbits intrval;
+	} intrtab[ ] =
+{
+{"int", 		{ INTRCONV, TYLONG }},
+{"real", 	{ INTRCONV, TYREAL, 1 }},
+		/* 1 ==> real(TYDCOMPLEX) yields TYDREAL */
+{"dble", 	{ INTRCONV, TYDREAL }},
+{"dreal",	{ INTRCONV, TYDREAL, 0, 0, 0, 1 }},
+{"cmplx", 	{ INTRCONV, TYCOMPLEX }},
+{"dcmplx", 	{ INTRCONV, TYDCOMPLEX, 0, 1 }},
+{"ifix", 	{ INTRCONV, TYLONG }},
+{"idint", 	{ INTRCONV, TYLONG }},
+{"float", 	{ INTRCONV, TYREAL }},
+{"dfloat",	{ INTRCONV, TYDREAL }},
+{"sngl", 	{ INTRCONV, TYREAL }},
+{"ichar", 	{ INTRCONV, TYLONG }},
+{"iachar", 	{ INTRCONV, TYLONG }},
+{"char", 	{ INTRCONV, TYCHAR }},
+{"achar", 	{ INTRCONV, TYCHAR }},
+
+/* any MAX or MIN can be used with any types; the compiler will cast them
+   correctly.  So rules against bad syntax in these expressions are not
+   enforced */
+
+{"max", 		{ INTRMAX, TYUNKNOWN }},
+{"max0", 	{ INTRMAX, TYLONG }},
+{"amax0", 	{ INTRMAX, TYREAL }},
+{"max1", 	{ INTRMAX, TYLONG }},
+{"amax1", 	{ INTRMAX, TYREAL }},
+{"dmax1", 	{ INTRMAX, TYDREAL }},
+
+{"and",		{ INTRBOOL, TYUNKNOWN, OPBITAND }},
+{"or",		{ INTRBOOL, TYUNKNOWN, OPBITOR }},
+{"xor",		{ INTRBOOL, TYUNKNOWN, OPBITXOR }},
+{"not",		{ INTRBOOL, TYUNKNOWN, OPBITNOT }},
+{"lshift",	{ INTRBOOL, TYUNKNOWN, OPLSHIFT }},
+{"rshift",	{ INTRBOOL, TYUNKNOWN, OPRSHIFT }},
+
+{"min", 		{ INTRMIN, TYUNKNOWN }},
+{"min0", 	{ INTRMIN, TYLONG }},
+{"amin0", 	{ INTRMIN, TYREAL }},
+{"min1", 	{ INTRMIN, TYLONG }},
+{"amin1", 	{ INTRMIN, TYREAL }},
+{"dmin1", 	{ INTRMIN, TYDREAL }},
+
+{"aint", 	{ INTRGEN, 2, 0 }},
+{"dint", 	{ INTRSPEC, TYDREAL, 1 }},
+
+{"anint", 	{ INTRGEN, 2, 2 }},
+{"dnint", 	{ INTRSPEC, TYDREAL, 3 }},
+
+{"nint", 	{ INTRGEN, 4, 4 }},
+{"idnint", 	{ INTRGEN, 2, 6 }},
+
+{"abs", 		{ INTRGEN, 6, 8 }},
+{"iabs", 	{ INTRGEN, 2, 9 }},
+{"dabs", 	{ INTRSPEC, TYDREAL, 11 }},
+{"cabs", 	{ INTRSPEC, TYREAL, 12, 0, 13 }},
+{"zabs", 	{ INTRSPEC, TYDREAL, 13, 1 }},
+
+{"mod", 		{ INTRGEN, 4, 14 }},
+{"amod", 	{ INTRSPEC, TYREAL, 16, 0, 17 }},
+{"dmod", 	{ INTRSPEC, TYDREAL, 17 }},
+
+{"sign", 	{ INTRGEN, 4, 18 }},
+{"isign", 	{ INTRGEN, 2, 19 }},
+{"dsign", 	{ INTRSPEC, TYDREAL, 21 }},
+
+{"dim", 		{ INTRGEN, 4, 22 }},
+{"idim", 	{ INTRGEN, 2, 23 }},
+{"ddim", 	{ INTRSPEC, TYDREAL, 25 }},
+
+{"dprod", 	{ INTRSPEC, TYDREAL, 26 }},
+
+{"len", 		{ INTRSPEC, TYLONG, 27 }},
+{"index", 	{ INTRSPEC, TYLONG, 29 }},
+
+{"imag", 	{ INTRGEN, 2, 31 }},
+{"aimag", 	{ INTRSPEC, TYREAL, 31, 0, 32 }},
+{"dimag", 	{ INTRSPEC, TYDREAL, 32 }},
+
+{"conjg", 	{ INTRGEN, 2, 33 }},
+{"dconjg", 	{ INTRSPEC, TYDCOMPLEX, 34, 1 }},
+
+{"sqrt", 	{ INTRGEN, 4, 35 }},
+{"dsqrt", 	{ INTRSPEC, TYDREAL, 36 }},
+{"csqrt", 	{ INTRSPEC, TYCOMPLEX, 37, 0, 38 }},
+{"zsqrt", 	{ INTRSPEC, TYDCOMPLEX, 38, 1 }},
+
+{"exp", 		{ INTRGEN, 4, 39 }},
+{"dexp", 	{ INTRSPEC, TYDREAL, 40 }},
+{"cexp", 	{ INTRSPEC, TYCOMPLEX, 41, 0, 42 }},
+{"zexp", 	{ INTRSPEC, TYDCOMPLEX, 42, 1 }},
+
+{"log", 		{ INTRGEN, 4, 43 }},
+{"alog", 	{ INTRSPEC, TYREAL, 43, 0, 44 }},
+{"dlog", 	{ INTRSPEC, TYDREAL, 44 }},
+{"clog", 	{ INTRSPEC, TYCOMPLEX, 45, 0, 46 }},
+{"zlog", 	{ INTRSPEC, TYDCOMPLEX, 46, 1 }},
+
+{"log10", 	{ INTRGEN, 2, 47 }},
+{"alog10", 	{ INTRSPEC, TYREAL, 47, 0, 48 }},
+{"dlog10", 	{ INTRSPEC, TYDREAL, 48 }},
+
+{"sin", 		{ INTRGEN, 4, 49 }},
+{"dsin", 	{ INTRSPEC, TYDREAL, 50 }},
+{"csin", 	{ INTRSPEC, TYCOMPLEX, 51, 0, 52 }},
+{"zsin", 	{ INTRSPEC, TYDCOMPLEX, 52, 1 }},
+
+{"cos", 		{ INTRGEN, 4, 53 }},
+{"dcos", 	{ INTRSPEC, TYDREAL, 54 }},
+{"ccos", 	{ INTRSPEC, TYCOMPLEX, 55, 0, 56 }},
+{"zcos", 	{ INTRSPEC, TYDCOMPLEX, 56, 1 }},
+
+{"tan", 		{ INTRGEN, 2, 57 }},
+{"dtan", 	{ INTRSPEC, TYDREAL, 58 }},
+
+{"asin", 	{ INTRGEN, 2, 59 }},
+{"dasin", 	{ INTRSPEC, TYDREAL, 60 }},
+
+{"acos", 	{ INTRGEN, 2, 61 }},
+{"dacos", 	{ INTRSPEC, TYDREAL, 62 }},
+
+{"atan", 	{ INTRGEN, 2, 63 }},
+{"datan", 	{ INTRSPEC, TYDREAL, 64 }},
+
+{"atan2", 	{ INTRGEN, 2, 65 }},
+{"datan2", 	{ INTRSPEC, TYDREAL, 66 }},
+
+{"sinh", 	{ INTRGEN, 2, 67 }},
+{"dsinh", 	{ INTRSPEC, TYDREAL, 68 }},
+
+{"cosh", 	{ INTRGEN, 2, 69 }},
+{"dcosh", 	{ INTRSPEC, TYDREAL, 70 }},
+
+{"tanh", 	{ INTRGEN, 2, 71 }},
+{"dtanh", 	{ INTRSPEC, TYDREAL, 72 }},
+
+{"lge",		{ INTRSPEC, TYLOGICAL, 73}},
+{"lgt",		{ INTRSPEC, TYLOGICAL, 75}},
+{"lle",		{ INTRSPEC, TYLOGICAL, 77}},
+{"llt",		{ INTRSPEC, TYLOGICAL, 79}},
+
+#if 0
+{"epbase",	{ INTRCNST, 4, 0 }},
+{"epprec",	{ INTRCNST, 4, 4 }},
+{"epemin",	{ INTRCNST, 2, 8 }},
+{"epemax",	{ INTRCNST, 2, 10 }},
+{"eptiny",	{ INTRCNST, 2, 12 }},
+{"ephuge",	{ INTRCNST, 4, 14 }},
+{"epmrsp",	{ INTRCNST, 2, 18 }},
+#endif
+
+{"fpexpn",	{ INTRGEN, 4, 81 }},
+{"fpabsp",	{ INTRGEN, 2, 85 }},
+{"fprrsp",	{ INTRGEN, 2, 87 }},
+{"fpfrac",	{ INTRGEN, 2, 89 }},
+{"fpmake",	{ INTRGEN, 2, 91 }},
+{"fpscal",	{ INTRGEN, 2, 93 }},
+
+{"cdabs", 	{ INTRSPEC, TYDREAL,	13, 1, 0, 1 }},
+{"cdsqrt", 	{ INTRSPEC, TYDCOMPLEX, 38, 1, 0, 1 }},
+{"cdexp", 	{ INTRSPEC, TYDCOMPLEX, 42, 1, 0, 1 }},
+{"cdlog", 	{ INTRSPEC, TYDCOMPLEX, 46, 1, 0, 1 }},
+{"cdsin", 	{ INTRSPEC, TYDCOMPLEX, 52, 1, 0, 1 }},
+{"cdcos", 	{ INTRSPEC, TYDCOMPLEX, 56, 1, 0, 1 }},
+
+{"iand",		{ INTRBOOL, TYUNKNOWN, OPBITAND, 0, 0, 2 }},
+{"ior",		{ INTRBOOL, TYUNKNOWN, OPBITOR,  0, 0, 2 }},
+{"ieor",		{ INTRBOOL, TYUNKNOWN, OPBITXOR, 0, 0, 2 }},
+
+{"btest",	{ INTRBGEN, TYLOGICAL, OPBITTEST,0, 0, 2 }},
+{"ibclr",	{ INTRBGEN, TYUNKNOWN, OPBITCLR, 0, 0, 2 }},
+{"ibset",	{ INTRBGEN, TYUNKNOWN, OPBITSET, 0, 0, 2 }},
+{"ibits",	{ INTRBGEN, TYUNKNOWN, OPBITBITS,0, 0, 2 }},
+{"ishft",	{ INTRBGEN, TYUNKNOWN, OPBITSH,  0, 0, 2 }},
+{"ishftc",	{ INTRBGEN, TYUNKNOWN, OPBITSHC, 0, 0, 2 }},
+
+{"" }};
+
+
+LOCAL struct Specblock
+	{
+	char atype;		/* Argument type; every arg must have
+				   this type */
+	char rtype;		/* Result type */
+	char nargs;		/* Number of arguments */
+	char spxname[8];	/* Name of the function in Fortran */
+	char othername;		/* index into callbyvalue table */
+	} spectab[ ] =
+{
+	{ TYREAL,TYREAL,1,"r_int" },
+	{ TYDREAL,TYDREAL,1,"d_int" },
+
+	{ TYREAL,TYREAL,1,"r_nint" },
+	{ TYDREAL,TYDREAL,1,"d_nint" },
+
+	{ TYREAL,TYSHORT,1,"h_nint" },
+	{ TYREAL,TYLONG,1,"i_nint" },
+
+	{ TYDREAL,TYSHORT,1,"h_dnnt" },
+	{ TYDREAL,TYLONG,1,"i_dnnt" },
+
+	{ TYREAL,TYREAL,1,"r_abs" },
+	{ TYSHORT,TYSHORT,1,"h_abs" },
+	{ TYLONG,TYLONG,1,"i_abs" },
+	{ TYDREAL,TYDREAL,1,"d_abs" },
+	{ TYCOMPLEX,TYREAL,1,"c_abs" },
+	{ TYDCOMPLEX,TYDREAL,1,"z_abs" },
+
+	{ TYSHORT,TYSHORT,2,"h_mod" },
+	{ TYLONG,TYLONG,2,"i_mod" },
+	{ TYREAL,TYREAL,2,"r_mod" },
+	{ TYDREAL,TYDREAL,2,"d_mod" },
+
+	{ TYREAL,TYREAL,2,"r_sign" },
+	{ TYSHORT,TYSHORT,2,"h_sign" },
+	{ TYLONG,TYLONG,2,"i_sign" },
+	{ TYDREAL,TYDREAL,2,"d_sign" },
+
+	{ TYREAL,TYREAL,2,"r_dim" },
+	{ TYSHORT,TYSHORT,2,"h_dim" },
+	{ TYLONG,TYLONG,2,"i_dim" },
+	{ TYDREAL,TYDREAL,2,"d_dim" },
+
+	{ TYREAL,TYDREAL,2,"d_prod" },
+
+	{ TYCHAR,TYSHORT,1,"h_len" },
+	{ TYCHAR,TYLONG,1,"i_len" },
+
+	{ TYCHAR,TYSHORT,2,"h_indx" },
+	{ TYCHAR,TYLONG,2,"i_indx" },
+
+	{ TYCOMPLEX,TYREAL,1,"r_imag" },
+	{ TYDCOMPLEX,TYDREAL,1,"d_imag" },
+	{ TYCOMPLEX,TYCOMPLEX,1,"r_cnjg" },
+	{ TYDCOMPLEX,TYDCOMPLEX,1,"d_cnjg" },
+
+	{ TYREAL,TYREAL,1,"r_sqrt", 1 },
+	{ TYDREAL,TYDREAL,1,"d_sqrt", 1 },
+	{ TYCOMPLEX,TYCOMPLEX,1,"c_sqrt" },
+	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_sqrt" },
+
+	{ TYREAL,TYREAL,1,"r_exp", 2 },
+	{ TYDREAL,TYDREAL,1,"d_exp", 2 },
+	{ TYCOMPLEX,TYCOMPLEX,1,"c_exp" },
+	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_exp" },
+
+	{ TYREAL,TYREAL,1,"r_log", 3 },
+	{ TYDREAL,TYDREAL,1,"d_log", 3 },
+	{ TYCOMPLEX,TYCOMPLEX,1,"c_log" },
+	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_log" },
+
+	{ TYREAL,TYREAL,1,"r_lg10" },
+	{ TYDREAL,TYDREAL,1,"d_lg10" },
+
+	{ TYREAL,TYREAL,1,"r_sin", 4 },
+	{ TYDREAL,TYDREAL,1,"d_sin", 4 },
+	{ TYCOMPLEX,TYCOMPLEX,1,"c_sin" },
+	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_sin" },
+
+	{ TYREAL,TYREAL,1,"r_cos", 5 },
+	{ TYDREAL,TYDREAL,1,"d_cos", 5 },
+	{ TYCOMPLEX,TYCOMPLEX,1,"c_cos" },
+	{ TYDCOMPLEX,TYDCOMPLEX,1,"z_cos" },
+
+	{ TYREAL,TYREAL,1,"r_tan", 6 },
+	{ TYDREAL,TYDREAL,1,"d_tan", 6 },
+
+	{ TYREAL,TYREAL,1,"r_asin", 7 },
+	{ TYDREAL,TYDREAL,1,"d_asin", 7 },
+
+	{ TYREAL,TYREAL,1,"r_acos", 8 },
+	{ TYDREAL,TYDREAL,1,"d_acos", 8 },
+
+	{ TYREAL,TYREAL,1,"r_atan", 9 },
+	{ TYDREAL,TYDREAL,1,"d_atan", 9 },
+
+	{ TYREAL,TYREAL,2,"r_atn2", 10 },
+	{ TYDREAL,TYDREAL,2,"d_atn2", 10 },
+
+	{ TYREAL,TYREAL,1,"r_sinh", 11 },
+	{ TYDREAL,TYDREAL,1,"d_sinh", 11 },
+
+	{ TYREAL,TYREAL,1,"r_cosh", 12 },
+	{ TYDREAL,TYDREAL,1,"d_cosh", 12 },
+
+	{ TYREAL,TYREAL,1,"r_tanh", 13 },
+	{ TYDREAL,TYDREAL,1,"d_tanh", 13 },
+
+	{ TYCHAR,TYLOGICAL,2,"hl_ge" },
+	{ TYCHAR,TYLOGICAL,2,"l_ge" },
+
+	{ TYCHAR,TYLOGICAL,2,"hl_gt" },
+	{ TYCHAR,TYLOGICAL,2,"l_gt" },
+
+	{ TYCHAR,TYLOGICAL,2,"hl_le" },
+	{ TYCHAR,TYLOGICAL,2,"l_le" },
+
+	{ TYCHAR,TYLOGICAL,2,"hl_lt" },
+	{ TYCHAR,TYLOGICAL,2,"l_lt" },
+
+	{ TYREAL,TYSHORT,1,"hr_expn" },
+	{ TYREAL,TYLONG,1,"ir_expn" },
+	{ TYDREAL,TYSHORT,1,"hd_expn" },
+	{ TYDREAL,TYLONG,1,"id_expn" },
+
+	{ TYREAL,TYREAL,1,"r_absp" },
+	{ TYDREAL,TYDREAL,1,"d_absp" },
+
+	{ TYREAL,TYDREAL,1,"r_rrsp" },
+	{ TYDREAL,TYDREAL,1,"d_rrsp" },
+
+	{ TYREAL,TYREAL,1,"r_frac" },
+	{ TYDREAL,TYDREAL,1,"d_frac" },
+
+	{ TYREAL,TYREAL,2,"r_make" },
+	{ TYDREAL,TYDREAL,2,"d_make" },
+
+	{ TYREAL,TYREAL,2,"r_scal" },
+	{ TYDREAL,TYDREAL,2,"d_scal" },
+
+	{ 0 }
+} ;
+
+#if 0
+LOCAL struct Incstblock
+	{
+	char atype;
+	char rtype;
+	char constno;
+	} consttab[ ] =
+{
+	{ TYSHORT, TYLONG, 0 },
+	{ TYLONG, TYLONG, 1 },
+	{ TYREAL, TYLONG, 2 },
+	{ TYDREAL, TYLONG, 3 },
+
+	{ TYSHORT, TYLONG, 4 },
+	{ TYLONG, TYLONG, 5 },
+	{ TYREAL, TYLONG, 6 },
+	{ TYDREAL, TYLONG, 7 },
+
+	{ TYREAL, TYLONG, 8 },
+	{ TYDREAL, TYLONG, 9 },
+
+	{ TYREAL, TYLONG, 10 },
+	{ TYDREAL, TYLONG, 11 },
+
+	{ TYREAL, TYREAL, 0 },
+	{ TYDREAL, TYDREAL, 1 },
+
+	{ TYSHORT, TYLONG, 12 },
+	{ TYLONG, TYLONG, 13 },
+	{ TYREAL, TYREAL, 2 },
+	{ TYDREAL, TYDREAL, 3 },
+
+	{ TYREAL, TYREAL, 4 },
+	{ TYDREAL, TYDREAL, 5 }
+};
+#endif
+
+char *callbyvalue[ ] =
+	{0,
+	"sqrt",
+	"exp",
+	"log",
+	"sin",
+	"cos",
+	"tan",
+	"asin",
+	"acos",
+	"atan",
+	"atan2",
+	"sinh",
+	"cosh",
+	"tanh"
+	};
+
+ void
+r8fix(Void)	/* adjust tables for -r8 */
+{
+	register struct Intrblock *I;
+	register struct Specblock *S;
+
+	for(I = intrtab; I->intrfname[0]; I++)
+		if (I->intrval.intrgroup != INTRGEN)
+		    switch(I->intrval.intrstuff) {
+			case TYREAL:
+				I->intrval.intrstuff = TYDREAL;
+				I->intrval.intrno = I->intrval.dblintrno;
+				break;
+			case TYCOMPLEX:
+				I->intrval.intrstuff = TYDCOMPLEX;
+				I->intrval.intrno = I->intrval.dblintrno;
+				I->intrval.dblcmplx = 1;
+			}
+
+	for(S = spectab; S->atype; S++)
+	    switch(S->atype) {
+		case TYCOMPLEX:
+			S->atype = TYDCOMPLEX;
+			if (S->rtype == TYREAL)
+				S->rtype = TYDREAL;
+			else if (S->rtype == TYCOMPLEX)
+				S->rtype = TYDCOMPLEX;
+			switch(S->spxname[0]) {
+				case 'r':
+					S->spxname[0] = 'd';
+					break;
+				case 'c':
+					S->spxname[0] = 'z';
+					break;
+				default:
+					Fatal("r8fix bug");
+				}
+			break;
+		case TYREAL:
+			S->atype = TYDREAL;
+			switch(S->rtype) {
+			    case TYREAL:
+				S->rtype = TYDREAL;
+				if (S->spxname[0] != 'r')
+					Fatal("r8fix bug");
+				S->spxname[0] = 'd';
+			    case TYDREAL:	/* d_prod */
+				break;
+
+			    case TYSHORT:
+				if (!strcmp(S->spxname, "hr_expn"))
+					S->spxname[1] = 'd';
+				else if (!strcmp(S->spxname, "h_nint"))
+					strcpy(S->spxname, "h_dnnt");
+				else Fatal("r8fix bug");
+				break;
+
+			    case TYLONG:
+				if (!strcmp(S->spxname, "ir_expn"))
+					S->spxname[1] = 'd';
+				else if (!strcmp(S->spxname, "i_nint"))
+					strcpy(S->spxname, "i_dnnt");
+				else Fatal("r8fix bug");
+				break;
+
+			    default:
+				Fatal("r8fix bug");
+			    }
+		}
+	}
+
+ static expptr
+#ifdef KR_headers
+foldminmax(ismin, argsp) int ismin; struct Listblock *argsp;
+#else
+foldminmax(int ismin, struct Listblock *argsp)
+#endif
+{
+#ifndef NO_LONG_LONG
+	Llong cq, cq1;
+#endif
+	Constp h;
+	double cd, cd1;
+	ftnint ci;
+	int mtype;
+	struct Chain *cp, *cpx;
+
+	mtype = argsp->vtype;
+	cp = cpx = argsp->listp;
+	h = &((expptr)cp->datap)->constblock;
+#ifndef NO_LONG_LONG
+	if (mtype == TYQUAD) {
+		cq = h->vtype == TYQUAD ? h->Const.cq : h->Const.ci;
+		while(cp = cp->nextp) {
+			h = &((expptr)cp->datap)->constblock;
+			cq1 = h->vtype == TYQUAD ? h->Const.cq : h->Const.ci;
+			if (ismin) {
+				if (cq > cq1) {
+					cq = cq1;
+					cpx = cp;
+					}
+				}
+			else {
+				if (cq < cq1) {
+					cq = cq1;
+					cpx = cp;
+					}
+				}
+			}
+		}
+	else
+#endif
+	if (ISINT(mtype)) {
+		ci = h->Const.ci;
+		if (ismin)
+			while(cp = cp->nextp) {
+				h = &((expptr)cp->datap)->constblock;
+				if (ci > h->Const.ci) {
+					ci = h->Const.ci;
+					cpx = cp;
+					}
+				}
+		else
+			while(cp = cp->nextp) {
+				h = &((expptr)cp->datap)->constblock;
+				if (ci < h->Const.ci) {
+					ci = h->Const.ci;
+					cpx = cp;
+					}
+				}
+		}
+	else {
+		if (ISREAL(h->vtype))
+			cd = h->vstg ? atof(h->Const.cds[0]) : h->Const.cd[0];
+#ifndef NO_LONG_LONG
+		else if (h->vtype == TYQUAD)
+			cd = h->Const.cq;
+#endif
+		else
+			cd = h->Const.ci;
+		while(cp = cp->nextp) {
+			h = &((expptr)cp->datap)->constblock;
+			if (ISREAL(h->vtype))
+				cd1 = h->vstg	? atof(h->Const.cds[0])
+						: h->Const.cd[0];
+#ifndef NO_LONG_LONG
+			else if (h->vtype == TYQUAD)
+				cd1 = h->Const.cq;
+#endif
+			else
+				cd1 = h->Const.ci;
+			if (ismin) {
+				if (cd > cd1) {
+					cd = cd1;
+					cpx = cp;
+					}
+				}
+			else {
+				if (cd < cd1) {
+					cd = cd1;
+					cpx = cp;
+					}
+				}
+			}
+		}
+	h = &((expptr)cpx->datap)->constblock;
+	cpx->datap = 0;
+	frexpr((tagptr)argsp);
+	if (h->vtype != mtype)
+		return mkconv(mtype, (expptr)h);
+	return (expptr)h;
+	}
+
+
+ expptr
+#ifdef KR_headers
+intrcall(np, argsp, nargs)
+	Namep np;
+	struct Listblock *argsp;
+	int nargs;
+#else
+intrcall(Namep np, struct Listblock *argsp, int nargs)
+#endif
+{
+	int i, rettype;
+	ftnint k;
+	Addrp ap;
+	register struct Specblock *sp;
+	register struct Chain *cp;
+	expptr q, ep;
+	int constargs, mtype, op;
+	int f1field, f2field, f3field;
+	char *s;
+	static char	bit_bits[] =	"?bit_bits",
+			bit_shift[] =	"?bit_shift",
+			bit_cshift[] = 	"?bit_cshift";
+	static char *bitop[3] = { bit_bits, bit_shift, bit_cshift };
+	static int t_pref[2] = { 'l', 'q' };
+
+	packed.ijunk = np->vardesc.varno;
+	f1field = packed.bits.f1;
+	f2field = packed.bits.f2;
+	f3field = packed.bits.f3;
+	if(nargs == 0)
+		goto badnargs;
+
+	mtype = 0;
+	constargs = 1;
+	for(cp = argsp->listp ; cp ; cp = cp->nextp)
+	{
+		ep = (expptr)cp->datap;
+		if (!ISCONST(ep))
+			constargs = 0;
+		else if( ep->headblock.vtype==TYSHORT )
+			cp->datap = (char *) mkconv(tyint, ep);
+		mtype = maxtype(mtype, ep->headblock.vtype);
+	}
+
+	switch(f1field)
+	{
+	case INTRBGEN:
+		op = f3field;
+		if( ! ONEOF(mtype, MSKINT) )
+			goto badtype;
+		if (op < OPBITBITS) {
+			if(nargs != 2)
+				goto badnargs;
+			if (op != OPBITTEST) {
+#ifdef TYQUAD
+				if (mtype == TYQUAD)
+					op += 2;
+#endif
+				goto intrbool2;
+				}
+			q = mkexpr(op, (expptr)argsp->listp->datap,
+			    		(expptr)argsp->listp->nextp->datap);
+			q->exprblock.vtype = TYLOGICAL;
+			goto intrbool2a;
+			}
+		if (nargs != 2 && (nargs != 3 || op == OPBITSH))
+			goto badnargs;
+		cp = argsp->listp;
+		ep = (expptr)cp->datap;
+		if (ep->headblock.vtype < TYLONG)
+			cp->datap = (char *)mkconv(TYLONG, ep);
+		while(cp->nextp) {
+			cp = cp->nextp;
+			ep = (expptr)cp->datap;
+			if (ep->headblock.vtype != TYLONG)
+				cp->datap = (char *)mkconv(TYLONG, ep);
+			}
+		if (op == OPBITSH) {
+			ep = (expptr)argsp->listp->nextp->datap;
+			if (ISCONST(ep)) {
+				if ((k = ep->constblock.Const.ci) < 0) {
+					q = (expptr)argsp->listp->datap;
+					if (ISCONST(q)) {
+						ep->constblock.Const.ci = -k;
+						op = OPRSHIFT;
+						goto intrbool2;
+						}
+					}
+				else {
+					op = OPLSHIFT;
+					goto intrbool2;
+					}
+				}
+			}
+		else if (nargs == 2) {
+			if (op == OPBITBITS)
+				goto badnargs;
+			cp->nextp = mkchain((char*)ICON(-1), 0);
+			}
+		ep = (expptr)argsp->listp->datap;
+		i = ep->headblock.vtype;
+		s = bitop[op - OPBITBITS];
+		*s = t_pref[i - TYLONG];
+		ap = builtin(i, s, 1);
+		return fixexpr((Exprp)
+				mkexpr(OPCCALL, (expptr)ap, (expptr)argsp) );
+
+	case INTRBOOL:
+		op = f3field;
+		if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) )
+			goto badtype;
+		if(op == OPBITNOT)
+		{
+			if(nargs != 1)
+				goto badnargs;
+			q = mkexpr(OPBITNOT, (expptr)argsp->listp->datap, ENULL);
+		}
+		else
+		{
+			if(nargs != 2)
+				goto badnargs;
+ intrbool2:
+			q = mkexpr(op, (expptr)argsp->listp->datap,
+			    		(expptr)argsp->listp->nextp->datap);
+		}
+ intrbool2a:
+		frchain( &(argsp->listp) );
+		free( (charptr) argsp);
+		return(q);
+
+	case INTRCONV:
+		rettype = f2field;
+		switch(rettype) {
+		  case TYLONG:
+			rettype = tyint;
+			break;
+		  case TYLOGICAL:
+			rettype = tylog;
+		  }
+		if( ISCOMPLEX(rettype) && nargs==2)
+		{
+			expptr qr, qi;
+			qr = (expptr) argsp->listp->datap;
+			qi = (expptr) argsp->listp->nextp->datap;
+			if (qr->headblock.vtype == TYDREAL
+			 || qi->headblock.vtype == TYDREAL)
+				rettype = TYDCOMPLEX;
+			if(ISCONST(qr) && ISCONST(qi))
+				q = mkcxcon(qr,qi);
+			else	q = mkexpr(OPCONV,mkconv(rettype-2,qr),
+			    mkconv(rettype-2,qi));
+		}
+		else if(nargs == 1) {
+			if (f3field && ((Exprp)argsp->listp->datap)->vtype
+					== TYDCOMPLEX)
+				rettype = TYDREAL;
+			q = mkconv(rettype+100, (expptr)argsp->listp->datap);
+			if (q->tag == TADDR)
+				q->addrblock.parenused = 1;
+			}
+		else goto badnargs;
+
+		q->headblock.vtype = rettype;
+		frchain(&(argsp->listp));
+		free( (charptr) argsp);
+		return(q);
+
+
+#if 0
+	case INTRCNST:
+
+/* Machine-dependent f77 stuff that f2c omits:
+
+intcon contains
+	radix for short int
+	radix for long int
+	radix for single precision
+	radix for double precision
+	precision for short int
+	precision for long int
+	precision for single precision
+	precision for double precision
+	emin for single precision
+	emin for double precision
+	emax for single precision
+	emax for double prcision
+	largest short int
+	largest long int
+
+realcon contains
+	tiny for single precision
+	tiny for double precision
+	huge for single precision
+	huge for double precision
+	mrsp (epsilon) for single precision
+	mrsp (epsilon) for double precision
+*/
+	{	register struct Incstblock *cstp;
+		extern ftnint intcon[14];
+		extern double realcon[6];
+
+		cstp = consttab + f3field;
+		for(i=0 ; i<f2field ; ++i)
+			if(cstp->atype == mtype)
+				goto foundconst;
+			else
+				++cstp;
+		goto badtype;
+
+foundconst:
+		switch(cstp->rtype)
+		{
+		case TYLONG:
+			return(mkintcon(intcon[cstp->constno]));
+
+		case TYREAL:
+		case TYDREAL:
+			return(mkrealcon(cstp->rtype,
+			    realcon[cstp->constno]) );
+
+		default:
+			Fatal("impossible intrinsic constant");
+		}
+	}
+#endif
+
+	case INTRGEN:
+		sp = spectab + f3field;
+		if(no66flag)
+			if(sp->atype == mtype)
+				goto specfunct;
+			else err66("generic function");
+
+		for(i=0; i<f2field ; ++i)
+			if(sp->atype == mtype)
+				goto specfunct;
+			else
+				++sp;
+		warn1 ("bad argument type to intrinsic %s", np->fvarname);
+
+/* Made this a warning rather than an error so things like "log (5) ==>
+   log (5.0)" can be accommodated.  When none of these cases matches, the
+   argument is cast up to the first type in the spectab list; this first
+   type is assumed to be the "smallest" type, e.g. REAL before DREAL
+   before COMPLEX, before DCOMPLEX */
+
+		sp = spectab + f3field;
+		mtype = sp -> atype;
+		goto specfunct;
+
+	case INTRSPEC:
+		sp = spectab + f3field;
+specfunct:
+		if(tyint==TYLONG && ONEOF(sp->rtype,M(TYSHORT)|M(TYLOGICAL))
+		    && (sp+1)->atype==sp->atype)
+			++sp;
+
+		if(nargs != sp->nargs)
+			goto badnargs;
+		if(mtype != sp->atype)
+			goto badtype;
+
+/* NOTE!!  I moved fixargs (YES) into the ELSE branch so that constants in
+   the inline expression wouldn't get put into the constant table */
+
+		fixargs (NO, argsp);
+		cast_args (mtype, argsp -> listp);
+
+		if(q = Inline((int)(sp-spectab), mtype, argsp->listp))
+		{
+			frchain( &(argsp->listp) );
+			free( (charptr) argsp);
+		} else {
+
+		    if(sp->othername) {
+			/* C library routines that return double... */
+			/* sp->rtype might be TYREAL */
+			ap = builtin(sp->rtype,
+				callbyvalue[sp->othername], 1);
+			q = fixexpr((Exprp)
+				mkexpr(OPCCALL, (expptr)ap, (expptr)argsp) );
+		    } else {
+			fixargs(YES, argsp);
+			ap = builtin(sp->rtype, sp->spxname, 0);
+			q = fixexpr((Exprp)
+				mkexpr(OPCALL, (expptr)ap, (expptr)argsp) );
+		    } /* else */
+		} /* else */
+		return(q);
+
+	case INTRMIN:
+	case INTRMAX:
+		if(nargs < 2)
+			goto badnargs;
+		if( ! ONEOF(mtype, MSKINT|MSKREAL) )
+			goto badtype;
+		argsp->vtype = mtype;
+		if (constargs)
+			q = foldminmax(f1field==INTRMIN, argsp);
+		else
+			q = mkexpr(f1field==INTRMIN ? OPMIN : OPMAX,
+					(expptr)argsp, ENULL);
+
+		q->headblock.vtype = mtype;
+		rettype = f2field;
+		if(rettype == TYLONG)
+			rettype = tyint;
+		else if(rettype == TYUNKNOWN)
+			rettype = mtype;
+		return( mkconv(rettype, q) );
+
+	default:
+		fatali("intrcall: bad intrgroup %d", f1field);
+	}
+badnargs:
+	errstr("bad number of arguments to intrinsic %s", np->fvarname);
+	goto bad;
+
+badtype:
+	errstr("bad argument type to intrinsic %s", np->fvarname);
+
+bad:
+	return( errnode() );
+}
+
+
+
+ int
+#ifdef KR_headers
+intrfunct(s)
+	char *s;
+#else
+intrfunct(char *s)
+#endif
+{
+	register struct Intrblock *p;
+	int i;
+	extern int intr_omit;
+
+	for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p)
+	{
+		if( !strcmp(s, p->intrfname) )
+		{
+			if (i = p->intrval.extflag) {
+				if (i & intr_omit)
+					return 0;
+				if (noextflag)
+					errext(s);
+				}
+			packed.bits.f1 = p->intrval.intrgroup;
+			packed.bits.f2 = p->intrval.intrstuff;
+			packed.bits.f3 = p->intrval.intrno;
+			packed.bits.f4 = p->intrval.dblcmplx;
+			return(packed.ijunk);
+		}
+	}
+
+	return(0);
+}
+
+
+
+
+
+ Addrp
+#ifdef KR_headers
+intraddr(np)
+	Namep np;
+#else
+intraddr(Namep np)
+#endif
+{
+	Addrp q;
+	register struct Specblock *sp;
+	int f3field;
+
+	if(np->vclass!=CLPROC || np->vprocclass!=PINTRINSIC)
+		fatalstr("intraddr: %s is not intrinsic", np->fvarname);
+	packed.ijunk = np->vardesc.varno;
+	f3field = packed.bits.f3;
+
+	switch(packed.bits.f1)
+	{
+	case INTRGEN:
+		/* imag, log, and log10 arent specific functions */
+		if(f3field==31 || f3field==43 || f3field==47)
+			goto bad;
+
+	case INTRSPEC:
+		sp = spectab + f3field;
+		if (tyint == TYLONG
+		&& (sp->rtype == TYSHORT || sp->rtype == TYLOGICAL))
+			++sp;
+		q = builtin(sp->rtype, sp->spxname,
+			sp->othername ? 1 : 0);
+		return(q);
+
+	case INTRCONV:
+	case INTRMIN:
+	case INTRMAX:
+	case INTRBOOL:
+	case INTRCNST:
+	case INTRBGEN:
+bad:
+		errstr("cannot pass %s as actual", np->fvarname);
+		return((Addrp)errnode());
+	}
+	fatali("intraddr: impossible f1=%d\n", (int) packed.bits.f1);
+	/* NOT REACHED */ return 0;
+}
+
+
+
+ void
+#ifdef KR_headers
+cast_args(maxtype, args)
+	int maxtype;
+	chainp args;
+#else
+cast_args(int maxtype, chainp args)
+#endif
+{
+    for (; args; args = args -> nextp) {
+	expptr e = (expptr) args->datap;
+	if (e -> headblock.vtype != maxtype)
+	    if (e -> tag == TCONST)
+		args->datap = (char *) mkconv(maxtype, e);
+	    else {
+		Addrp temp = mktmp(maxtype, ENULL);
+
+		puteq(cpexpr((expptr)temp), e);
+		args->datap = (char *)temp;
+	    } /* else */
+    } /* for */
+} /* cast_args */
+
+
+
+ expptr
+#ifdef KR_headers
+Inline(fno, type, args)
+	int fno;
+	int type;
+	struct Chain *args;
+#else
+Inline(int fno, int type, struct Chain *args)
+#endif
+{
+	register expptr q, t, t1;
+
+	switch(fno)
+	{
+	case 8:	/* real abs */
+	case 9:	/* short int abs */
+	case 10:	/* long int abs */
+	case 11:	/* double precision abs */
+		if( addressable(q = (expptr) args->datap) )
+		{
+			t = q;
+			q = NULL;
+		}
+		else
+			t = (expptr) mktmp(type,ENULL);
+		t1 = mkexpr(type == TYREAL && forcedouble ? OPDABS : OPABS,
+			cpexpr(t), ENULL);
+		if(q)
+			t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1);
+		frexpr(t);
+		return(t1);
+
+	case 26:	/* dprod */
+		q = mkexpr(OPSTAR, mkconv(TYDREAL,(expptr)args->datap),
+			(expptr)args->nextp->datap);
+		return(q);
+
+	case 27:	/* len of character string */
+		q = (expptr) cpexpr(((tagptr)args->datap)->headblock.vleng);
+		frexpr((expptr)args->datap);
+		return mkconv(tyioint, q);
+
+	case 14:	/* half-integer mod */
+	case 15:	/* mod */
+		return mkexpr(OPMOD, (expptr) args->datap,
+		    		(expptr) args->nextp->datap);
+	}
+	return(NULL);
+}
diff --git a/contrib/tools/f2c/src/io.c b/contrib/tools/f2c/src/io.c
new file mode 100644
index 0000000000..b35a0f627a
--- /dev/null
+++ b/contrib/tools/f2c/src/io.c
@@ -0,0 +1,1509 @@
+/****************************************************************
+Copyright 1990, 1991, 1993, 1994, 1996, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+/* Routines to generate code for I/O statements.
+   Some corrections and improvements due to David Wasley, U. C. Berkeley
+*/
+
+/* TEMPORARY */
+#define TYIOINT TYLONG
+#define SZIOINT SZLONG
+
+#include "defs.h"
+#include "names.h"
+#include "iob.h"
+
+extern int byterev, inqmask;
+
+static void dofclose Argdcl((void));
+static void dofinquire Argdcl((void));
+static void dofmove Argdcl((char*));
+static void dofopen Argdcl((void));
+static void doiolist Argdcl((chainp));
+static void ioset Argdcl((int, int, expptr));
+static void ioseta Argdcl((int, Addrp));
+static void iosetc Argdcl((int, expptr));
+static void iosetip Argdcl((int, int));
+static void iosetlc Argdcl((int, int, int));
+static void putio Argdcl((expptr, expptr));
+static void putiocall Argdcl((expptr));
+
+iob_data *iob_list;
+Addrp io_structs[9];
+
+LOCAL char ioroutine[12];
+
+LOCAL long ioendlab;
+LOCAL long ioerrlab;
+LOCAL int endbit;
+LOCAL int errbit;
+LOCAL long jumplab;
+LOCAL long skiplab;
+LOCAL int ioformatted;
+LOCAL int statstruct = NO;
+LOCAL struct Labelblock *skiplabel;
+Addrp ioblkp;
+
+#define UNFORMATTED 0
+#define FORMATTED 1
+#define LISTDIRECTED 2
+#define NAMEDIRECTED 3
+
+#define V(z)	ioc[z].iocval
+
+#define IOALL 07777
+
+LOCAL struct Ioclist
+{
+	char *iocname;
+	int iotype;
+	expptr iocval;
+}
+ioc[ ] =
+{
+	{ "", 0 },
+	{ "unit", IOALL },
+	{ "fmt", M(IOREAD) | M(IOWRITE) },
+	{ "err", IOALL },
+	{ "end", M(IOREAD) },
+	{ "iostat", IOALL },
+	{ "rec", M(IOREAD) | M(IOWRITE) },
+	{ "recl", M(IOOPEN) | M(IOINQUIRE) },
+	{ "file", M(IOOPEN) | M(IOINQUIRE) },
+	{ "status", M(IOOPEN) | M(IOCLOSE) },
+	{ "access", M(IOOPEN) | M(IOINQUIRE) },
+	{ "form", M(IOOPEN) | M(IOINQUIRE) },
+	{ "blank", M(IOOPEN) | M(IOINQUIRE) },
+	{ "exist", M(IOINQUIRE) },
+	{ "opened", M(IOINQUIRE) },
+	{ "number", M(IOINQUIRE) },
+	{ "named", M(IOINQUIRE) },
+	{ "name", M(IOINQUIRE) },
+	{ "sequential", M(IOINQUIRE) },
+	{ "direct", M(IOINQUIRE) },
+	{ "formatted", M(IOINQUIRE) },
+	{ "unformatted", M(IOINQUIRE) },
+	{ "nextrec", M(IOINQUIRE) },
+	{ "nml", M(IOREAD) | M(IOWRITE) }
+};
+
+#define NIOS (sizeof(ioc)/sizeof(struct Ioclist) - 1)
+
+/* #define IOSUNIT 1 */
+/* #define IOSFMT 2 */
+#define IOSERR 3
+#define IOSEND 4
+#define IOSIOSTAT 5
+#define IOSREC 6
+#define IOSRECL 7
+#define IOSFILE 8
+#define IOSSTATUS 9
+#define IOSACCESS 10
+#define IOSFORM 11
+#define IOSBLANK 12
+#define IOSEXISTS 13
+#define IOSOPENED 14
+#define IOSNUMBER 15
+#define IOSNAMED 16
+#define IOSNAME 17
+#define IOSSEQUENTIAL 18
+#define IOSDIRECT 19
+#define IOSFORMATTED 20
+#define IOSUNFORMATTED 21
+#define IOSNEXTREC 22
+#define IOSNML 23
+
+#define IOSTP V(IOSIOSTAT)
+
+
+/* offsets in generated structures */
+
+#define SZFLAG SZIOINT
+
+/* offsets for external READ and WRITE statements */
+
+#define XERR 0
+#define XUNIT	SZFLAG
+#define XEND	SZFLAG + SZIOINT
+#define XFMT	2*SZFLAG + SZIOINT
+#define XREC	2*SZFLAG + SZIOINT + SZADDR
+
+/* offsets for internal READ and WRITE statements */
+
+#define XIUNIT	SZFLAG
+#define XIEND	SZFLAG + SZADDR
+#define XIFMT	2*SZFLAG + SZADDR
+#define XIRLEN	2*SZFLAG + 2*SZADDR
+#define XIRNUM	2*SZFLAG + 2*SZADDR + SZIOINT
+#define XIREC	2*SZFLAG + 2*SZADDR + 2*SZIOINT
+
+/* offsets for OPEN statements */
+
+#define XFNAME	SZFLAG + SZIOINT
+#define XFNAMELEN	SZFLAG + SZIOINT + SZADDR
+#define XSTATUS	SZFLAG + 2*SZIOINT + SZADDR
+#define XACCESS	SZFLAG + 2*SZIOINT + 2*SZADDR
+#define XFORMATTED	SZFLAG + 2*SZIOINT + 3*SZADDR
+#define XRECLEN	SZFLAG + 2*SZIOINT + 4*SZADDR
+#define XBLANK	SZFLAG + 3*SZIOINT + 4*SZADDR
+
+/* offset for CLOSE statement */
+
+#define XCLSTATUS	SZFLAG + SZIOINT
+
+/* offsets for INQUIRE statement */
+
+#define XFILE	SZFLAG + SZIOINT
+#define XFILELEN	SZFLAG + SZIOINT + SZADDR
+#define XEXISTS	SZFLAG + 2*SZIOINT + SZADDR
+#define XOPEN	SZFLAG + 2*SZIOINT + 2*SZADDR
+#define XNUMBER	SZFLAG + 2*SZIOINT + 3*SZADDR
+#define XNAMED	SZFLAG + 2*SZIOINT + 4*SZADDR
+#define XNAME	SZFLAG + 2*SZIOINT + 5*SZADDR
+#define XNAMELEN	SZFLAG + 2*SZIOINT + 6*SZADDR
+#define XQACCESS	SZFLAG + 3*SZIOINT + 6*SZADDR
+#define XQACCLEN	SZFLAG + 3*SZIOINT + 7*SZADDR
+#define XSEQ	SZFLAG + 4*SZIOINT + 7*SZADDR
+#define XSEQLEN	SZFLAG + 4*SZIOINT + 8*SZADDR
+#define XDIRECT	SZFLAG + 5*SZIOINT + 8*SZADDR
+#define XDIRLEN	SZFLAG + 5*SZIOINT + 9*SZADDR
+#define XFORM	SZFLAG + 6*SZIOINT + 9*SZADDR
+#define XFORMLEN	SZFLAG + 6*SZIOINT + 10*SZADDR
+#define XFMTED	SZFLAG + 7*SZIOINT + 10*SZADDR
+#define XFMTEDLEN	SZFLAG + 7*SZIOINT + 11*SZADDR
+#define XUNFMT	SZFLAG + 8*SZIOINT + 11*SZADDR
+#define XUNFMTLEN	SZFLAG + 8*SZIOINT + 12*SZADDR
+#define XQRECL	SZFLAG + 9*SZIOINT + 12*SZADDR
+#define XNEXTREC	SZFLAG + 9*SZIOINT + 13*SZADDR
+#define XQBLANK	SZFLAG + 9*SZIOINT + 14*SZADDR
+#define XQBLANKLEN	SZFLAG + 9*SZIOINT + 15*SZADDR
+
+LOCAL char *cilist_names[] = {
+	"cilist",
+	"cierr",
+	"ciunit",
+	"ciend",
+	"cifmt",
+	"cirec"
+	};
+LOCAL char *icilist_names[] = {
+	"icilist",
+	"icierr",
+	"iciunit",
+	"iciend",
+	"icifmt",
+	"icirlen",
+	"icirnum"
+	};
+LOCAL char *olist_names[] = {
+	"olist",
+	"oerr",
+	"ounit",
+	"ofnm",
+	"ofnmlen",
+	"osta",
+	"oacc",
+	"ofm",
+	"orl",
+	"oblnk"
+	};
+LOCAL char *cllist_names[] = {
+	"cllist",
+	"cerr",
+	"cunit",
+	"csta"
+	};
+LOCAL char *alist_names[] = {
+	"alist",
+	"aerr",
+	"aunit"
+	};
+LOCAL char *inlist_names[] = {
+	"inlist",
+	"inerr",
+	"inunit",
+	"infile",
+	"infilen",
+	"inex",
+	"inopen",
+	"innum",
+	"innamed",
+	"inname",
+	"innamlen",
+	"inacc",
+	"inacclen",
+	"inseq",
+	"inseqlen",
+	"indir",
+	"indirlen",
+	"infmt",
+	"infmtlen",
+	"inform",
+	"informlen",
+	"inunf",
+	"inunflen",
+	"inrecl",
+	"innrec",
+	"inblank",
+	"inblanklen"
+	};
+
+LOCAL char **io_fields;
+
+#define zork(n,t) n, sizeof(n)/sizeof(char *) - 1, t
+
+LOCAL io_setup io_stuff[] = {
+	{zork(cilist_names, TYCILIST)},	/* external read/write */
+	{zork(inlist_names, TYINLIST)},	/* inquire */
+	{zork(olist_names,  TYOLIST)},	/* open */
+	{zork(cllist_names, TYCLLIST)},	/* close */
+	{zork(alist_names,  TYALIST)},	/* rewind */
+	{zork(alist_names,  TYALIST)},	/* backspace */
+	{zork(alist_names,  TYALIST)},	/* endfile */
+	{zork(icilist_names,TYICILIST)},	/* internal read */
+	{zork(icilist_names,TYICILIST)}	/* internal write */
+	};
+
+#undef zork
+
+ int
+#ifdef KR_headers
+fmtstmt(lp)
+	register struct Labelblock *lp;
+#else
+fmtstmt(register struct Labelblock *lp)
+#endif
+{
+	if(lp == NULL)
+	{
+		execerr("unlabeled format statement" , CNULL);
+		return(-1);
+	}
+	if(lp->labtype == LABUNKNOWN)
+	{
+		lp->labtype = LABFORMAT;
+		lp->labelno = (int)newlabel();
+	}
+	else if(lp->labtype != LABFORMAT)
+	{
+		execerr("bad format number", CNULL);
+		return(-1);
+	}
+	return(lp->labelno);
+}
+
+
+ void
+#ifdef KR_headers
+setfmt(lp)
+	struct Labelblock *lp;
+#else
+setfmt(struct Labelblock *lp)
+#endif
+{
+	char *s, *s0, *sc, *se, *t;
+	int k, n, parity;
+
+	s0 = s = lexline(&n);
+	se = t = s + n;
+
+	/* warn of trivial errors, e.g. "  11 CONTINUE" (one too few spaces) */
+	/* following FORMAT... */
+
+	if (n <= 0)
+		warn("No (...) after FORMAT");
+	else if (*s != '(')
+		warni("%c rather than ( after FORMAT", *s);
+	else if (se[-1] != ')') {
+		*se = 0;
+		while(--t > s && *t != ')') ;
+		if (t <= s)
+			warn("No ) at end of FORMAT statement");
+		else if (se - t > 30)
+			warn1("Extraneous text at end of FORMAT: ...%s", se-12);
+		else
+			warn1("Extraneous text at end of FORMAT: %s", t+1);
+		t = se;
+		}
+
+	/* fix MYQUOTES (\002's) and \\'s */
+
+	parity = 1;
+	str_fmt['%'] = "%";
+	while(s < se) {
+		k = *(unsigned char *)s++;
+		if (k == 2) {
+			if ((parity ^= 1) && *s == 2) {
+				t -= 2;
+				++s;
+				}
+			else
+				t += 3;
+			}
+		else {
+			sc = str_fmt[k];
+			while(*++sc)
+				t++;
+			}
+		}
+	s = s0;
+	parity = 1;
+	if (lp) {
+		lp->fmtstring = t = mem((int)(t - s + 1), 0);
+		while(s < se) {
+			k = *(unsigned char *)s++;
+			if (k == 2) {
+				if ((parity ^= 1) && *s == 2)
+					s++;
+				else {
+					t[0] = '\\';
+					t[1] = '0';
+					t[2] = '0';
+					t[3] = '2';
+					t += 4;
+					}
+				}
+			else {
+				sc = str_fmt[k];
+				do *t++ = *sc++;
+				   while(*sc);
+				}
+			}
+		*t = 0;
+		}
+	str_fmt['%'] = "%%";
+	flline();
+}
+
+
+ void
+#ifdef KR_headers
+startioctl()
+#else
+startioctl()
+#endif
+{
+	register int i;
+
+	inioctl = YES;
+	nioctl = 0;
+	ioformatted = UNFORMATTED;
+	for(i = 1 ; i<=NIOS ; ++i)
+		V(i) = NULL;
+}
+
+ static long
+newiolabel(Void) {
+	long rv;
+	rv = ++lastiolabno;
+	skiplabel = mklabel(rv);
+	skiplabel->labdefined = 1;
+	return rv;
+	}
+
+ void
+endioctl(Void)
+{
+	int i;
+	expptr p;
+	struct io_setup *ios;
+
+	inioctl = NO;
+
+	/* set up for error recovery */
+
+	ioerrlab = ioendlab = skiplab = jumplab = 0;
+
+	if(p = V(IOSEND))
+		if(ISICON(p))
+			execlab(ioendlab = p->constblock.Const.ci);
+		else
+			err("bad end= clause");
+
+	if(p = V(IOSERR))
+		if(ISICON(p))
+			execlab(ioerrlab = p->constblock.Const.ci);
+		else
+			err("bad err= clause");
+
+	if(IOSTP)
+		if(IOSTP->tag!=TADDR || ! ISINT(IOSTP->addrblock.vtype) )
+		{
+			err("iostat must be an integer variable");
+			frexpr(IOSTP);
+			IOSTP = NULL;
+		}
+
+	if(iostmt == IOREAD)
+	{
+		if(IOSTP)
+		{
+			if(ioerrlab && ioendlab && ioerrlab==ioendlab)
+				jumplab = ioerrlab;
+			else
+				skiplab = jumplab = newiolabel();
+		}
+		else	{
+			if(ioerrlab && ioendlab && ioerrlab!=ioendlab)
+			{
+				IOSTP = (expptr) mktmp(TYINT, ENULL);
+				skiplab = jumplab = newiolabel();
+			}
+			else
+				jumplab = (ioerrlab ? ioerrlab : ioendlab);
+		}
+	}
+	else if(iostmt == IOWRITE)
+	{
+		if(IOSTP && !ioerrlab)
+			skiplab = jumplab = newiolabel();
+		else
+			jumplab = ioerrlab;
+	}
+	else
+		jumplab = ioerrlab;
+
+	endbit = IOSTP!=NULL || ioendlab!=0;	/* for use in startrw() */
+	errbit = IOSTP!=NULL || ioerrlab!=0;
+	if (jumplab && !IOSTP)
+		IOSTP = (expptr) mktmp(TYINT, ENULL);
+
+	if(iostmt!=IOREAD && iostmt!=IOWRITE)
+	{
+		ios = io_stuff + iostmt;
+		io_fields = ios->fields;
+		ioblkp = io_structs[iostmt];
+		if(ioblkp == NULL)
+			io_structs[iostmt] = ioblkp =
+				autovar(1, ios->type, ENULL, "");
+		ioset(TYIOINT, XERR, ICON(errbit));
+	}
+
+	switch(iostmt)
+	{
+	case IOOPEN:
+		dofopen();
+		break;
+
+	case IOCLOSE:
+		dofclose();
+		break;
+
+	case IOINQUIRE:
+		dofinquire();
+		break;
+
+	case IOBACKSPACE:
+		dofmove("f_back");
+		break;
+
+	case IOREWIND:
+		dofmove("f_rew");
+		break;
+
+	case IOENDFILE:
+		dofmove("f_end");
+		break;
+
+	case IOREAD:
+	case IOWRITE:
+		startrw();
+		break;
+
+	default:
+		fatali("impossible iostmt %d", iostmt);
+	}
+	for(i = 1 ; i<=NIOS ; ++i)
+		if(i!=IOSIOSTAT && V(i)!=NULL)
+			frexpr(V(i));
+}
+
+
+ int
+iocname(Void)
+{
+	register int i;
+	int found, mask;
+
+	found = 0;
+	mask = M(iostmt);
+	for(i = 1 ; i <= NIOS ; ++i)
+		if(!strcmp(ioc[i].iocname, token))
+			if(ioc[i].iotype & mask)
+				return(i);
+			else {
+				found = i;
+				break;
+				}
+	if(found) {
+		if (iostmt == IOOPEN && !strcmp(ioc[i].iocname, "name")) {
+			NOEXT("open with \"name=\" treated as \"file=\"");
+			for(i = 1; strcmp(ioc[i].iocname, "file"); i++);
+			return i;
+			}
+		errstr("invalid control %s for statement", ioc[found].iocname);
+		}
+	else
+		errstr("unknown iocontrol %s", token);
+	return(IOSBAD);
+}
+
+
+ void
+#ifdef KR_headers
+ioclause(n, p)
+	register int n;
+	register expptr p;
+#else
+ioclause(register int n, register expptr p)
+#endif
+{
+	struct Ioclist *iocp;
+
+	++nioctl;
+	if(n == IOSBAD)
+		return;
+	if(n == IOSPOSITIONAL)
+		{
+		n = nioctl;
+		if (n == IOSFMT) {
+			if (iostmt == IOOPEN) {
+				n = IOSFILE;
+				NOEXT("file= specifier omitted from open");
+				}
+			else if (iostmt < IOREAD)
+				goto illegal;
+			}
+		else if(n > IOSFMT)
+			{
+ illegal:
+			err("illegal positional iocontrol");
+			return;
+			}
+		}
+	else if (n == IOSNML)
+		n = IOSFMT;
+
+	if(p == NULL)
+	{
+		if(n == IOSUNIT)
+			p = (expptr) (iostmt==IOREAD ? IOSTDIN : IOSTDOUT);
+		else if(n != IOSFMT)
+		{
+			err("illegal * iocontrol");
+			return;
+		}
+	}
+	if(n == IOSFMT)
+		ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED);
+
+	iocp = & ioc[n];
+	if(iocp->iocval == NULL)
+	{
+		if(n!=IOSFMT && ( n!=IOSUNIT || (p && p->headblock.vtype!=TYCHAR) ) )
+			p = fixtype(p);
+		else if (p && p->tag == TPRIM
+			   && p->primblock.namep->vclass == CLUNKNOWN) {
+			/* kludge made necessary by attempt to infer types
+			 * for untyped external parameters: given an error
+			 * in calling sequences, an integer argument might
+			 * tentatively be assumed TYCHAR; this would otherwise
+			 * be corrected too late in startrw after startrw
+			 * had decided this to be an internal file.
+			 */
+			vardcl(p->primblock.namep);
+			p->primblock.vtype = p->primblock.namep->vtype;
+			}
+		iocp->iocval = p;
+	}
+	else
+		errstr("iocontrol %s repeated", iocp->iocname);
+}
+
+/* io list item */
+
+ void
+#ifdef KR_headers
+doio(list)
+	chainp list;
+#else
+doio(chainp list)
+#endif
+{
+	if(ioformatted == NAMEDIRECTED)
+	{
+		if(list)
+			err("no I/O list allowed in NAMELIST read/write");
+	}
+	else
+	{
+		doiolist(list);
+		ioroutine[0] = 'e';
+		if (skiplab)
+			jumplab = 0;
+		putiocall( call0(TYINT, ioroutine) );
+	}
+}
+
+
+
+
+
+ LOCAL void
+#ifdef KR_headers
+doiolist(p0)
+	chainp p0;
+#else
+doiolist(chainp p0)
+#endif
+{
+	chainp p;
+	register tagptr q;
+	register expptr qe;
+	register Namep qn;
+	Addrp tp;
+	int range;
+	extern char *ohalign;
+
+	for (p = p0 ; p ; p = p->nextp)
+	{
+		q = (tagptr)p->datap;
+		if(q->tag == TIMPLDO)
+		{
+			exdo(range = (int)newlabel(), (Namep)0,
+				q->impldoblock.impdospec);
+			doiolist(q->impldoblock.datalist);
+			enddo(range);
+			free( (charptr) q);
+		}
+		else	{
+			if(q->tag==TPRIM && q->primblock.argsp==NULL
+			    && q->primblock.namep->vdim!=NULL)
+			{
+				vardcl(qn = q->primblock.namep);
+				if(qn->vdim->nelt) {
+					putio( fixtype(cpexpr(qn->vdim->nelt)),
+					    (expptr)mkscalar(qn) );
+					qn->vlastdim = 0;
+					}
+				else
+					err("attempt to i/o array of unknown size");
+			}
+			else if(q->tag==TPRIM && q->primblock.argsp==NULL &&
+			    (qe = (expptr) memversion(q->primblock.namep)) )
+				putio(ICON(1),qe);
+			else if (ISCONST(q) && q->constblock.vtype == TYCHAR) {
+				halign = 0;
+				putio(ICON(1), qe = fixtype(cpexpr(q)));
+				halign = ohalign;
+				}
+			else if(((qe = fixtype(cpexpr(q)))->tag==TADDR &&
+			    (qe->addrblock.uname_tag != UNAM_CONST ||
+			    !ISCOMPLEX(qe -> addrblock.vtype))) ||
+			    (qe -> tag == TCONST && !ISCOMPLEX(qe ->
+			    headblock.vtype))) {
+				if (qe -> tag == TCONST)
+					qe = (expptr) putconst((Constp)qe);
+				putio(ICON(1), qe);
+			}
+			else if(qe->headblock.vtype != TYERROR)
+			{
+				if(iostmt == IOWRITE)
+				{
+					expptr qvl;
+					qvl = NULL;
+					if( ISCHAR(qe) )
+					{
+						qvl = (expptr)
+						    cpexpr(qe->headblock.vleng);
+						tp = mktmp(qe->headblock.vtype,
+						    ICON(lencat(qe)));
+					}
+					else
+						tp = mktmp(qe->headblock.vtype,
+						    qe->headblock.vleng);
+					puteq( cpexpr((expptr)tp), qe);
+					if(qvl)	/* put right length on block */
+					{
+						frexpr(tp->vleng);
+						tp->vleng = qvl;
+					}
+					putio(ICON(1), (expptr)tp);
+				}
+				else
+					err("non-left side in READ list");
+			}
+			frexpr(q);
+		}
+	}
+	frchain( &p0 );
+}
+
+ int iocalladdr = TYADDR;	/* for fixing TYADDR in saveargtypes */
+ int typeconv[TYERROR+1] = {
+#ifdef TYQUAD
+		0, 1, 11, 2, 3, 14, 4, 5, 6, 7, 12, 13, 8, 9, 10, 15
+#else
+		0, 1, 11, 2, 3,     4, 5, 6, 7, 12, 13, 8, 9, 10, 14
+#endif
+		};
+
+ LOCAL void
+#ifdef KR_headers
+putio(nelt, addr)
+	expptr nelt;
+	register expptr addr;
+#else
+putio(expptr nelt, register expptr addr)
+#endif
+{
+	int type;
+	register expptr q;
+	register Addrp c = 0;
+
+	type = addr->headblock.vtype;
+	if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) )
+	{
+		nelt = mkexpr(OPSTAR, ICON(2), nelt);
+		type -= (TYCOMPLEX-TYREAL);
+	}
+
+	/* pass a length with every item.  for noncharacter data, fake one */
+	if(type != TYCHAR)
+	{
+
+		if( ISCONST(addr) )
+			addr = (expptr) putconst((Constp)addr);
+		c = ALLOC(Addrblock);
+		c->tag = TADDR;
+		c->vtype = TYLENG;
+		c->vstg = STGAUTO;
+		c->ntempelt = 1;
+		c->isarray = 1;
+		c->memoffset = ICON(0);
+		c->uname_tag = UNAM_IDENT;
+		c->charleng = 1;
+		sprintf(c->user.ident, "(ftnlen)sizeof(%s)", Typename[type]);
+		addr = mkexpr(OPCHARCAST, addr, ENULL);
+		}
+
+	nelt = fixtype( mkconv(tyioint,nelt) );
+	if(ioformatted == LISTDIRECTED) {
+		expptr mc = mkconv(tyioint, ICON(typeconv[type]));
+		q = c	? call4(TYINT, "do_lio", mc, nelt, addr, (expptr)c)
+			: call3(TYINT, "do_lio", mc, nelt, addr);
+		}
+	else {
+		char *s = (char*)(ioformatted==FORMATTED ? "do_fio"
+			: !byterev ? "do_uio"
+			: ONEOF(type, M(TYCHAR)|M(TYINT1)|M(TYLOGICAL1))
+			? "do_ucio" : "do_unio");
+		q = c	? call3(TYINT, s, nelt, addr, (expptr)c)
+			: call2(TYINT, s, nelt, addr);
+		}
+	iocalladdr = TYCHAR;
+	putiocall(q);
+	iocalladdr = TYADDR;
+}
+
+
+
+ void
+endio(Void)
+{
+	if(skiplab)
+	{
+		if (ioformatted != NAMEDIRECTED)
+			p1_label((long)(skiplabel - labeltab));
+		if(ioendlab) {
+			exif( mkexpr(OPLT, cpexpr(IOSTP), ICON(0)));
+			exgoto(execlab(ioendlab));
+			exendif();
+			}
+		if(ioerrlab) {
+			exif( mkexpr(iostmt==IOREAD||iostmt==IOWRITE
+					? OPGT : OPNE,
+				cpexpr(IOSTP), ICON(0)));
+			exgoto(execlab(ioerrlab));
+			exendif();
+			}
+	}
+
+	if(IOSTP)
+		frexpr(IOSTP);
+}
+
+
+
+ LOCAL void
+#ifdef KR_headers
+putiocall(q)
+	register expptr q;
+#else
+putiocall(register expptr q)
+#endif
+{
+	int tyintsave;
+
+	tyintsave = tyint;
+	tyint = tyioint;	/* for -I2 and -i2 */
+
+	if(IOSTP)
+	{
+		q->headblock.vtype = TYINT;
+		q = fixexpr((Exprp)mkexpr(OPASSIGN, cpexpr(IOSTP), q));
+	}
+	putexpr(q);
+	if(jumplab) {
+		exif(mkexpr(OPNE, cpexpr(IOSTP), ICON(0)));
+		exgoto(execlab(jumplab));
+		exendif();
+		}
+	tyint = tyintsave;
+}
+
+ void
+#ifdef KR_headers
+fmtname(np, q)
+	Namep np;
+	register Addrp q;
+#else
+fmtname(Namep np, register Addrp q)
+#endif
+{
+	register int k;
+	register char *s, *t;
+	extern chainp assigned_fmts;
+
+	if (!np->vfmt_asg) {
+		np->vfmt_asg = 1;
+		assigned_fmts = mkchain((char *)np, assigned_fmts);
+		}
+	k = strlen(s = np->fvarname);
+	if (k < IDENT_LEN - 4) {
+		q->uname_tag = UNAM_IDENT;
+		t = q->user.ident;
+		}
+	else {
+		q->uname_tag = UNAM_CHARP;
+		q->user.Charp = t = mem(k + 5,0);
+		}
+	sprintf(t, "%s_fmt", s);
+	}
+
+ LOCAL Addrp
+#ifdef KR_headers
+asg_addr(p)
+	union Expression *p;
+#else
+asg_addr(union Expression *p)
+#endif
+{
+	register Addrp q;
+
+	if (p->tag != TPRIM)
+		badtag("asg_addr", p->tag);
+	q = ALLOC(Addrblock);
+	q->tag = TADDR;
+	q->vtype = TYCHAR;
+	q->vstg = STGAUTO;
+	q->ntempelt = 1;
+	q->isarray = 0;
+	q->memoffset = ICON(0);
+	fmtname(p->primblock.namep, q);
+	return q;
+	}
+
+ void
+startrw(Void)
+{
+	register expptr p;
+	register Namep np;
+	register Addrp unitp, fmtp, recp;
+	register expptr nump;
+	int iostmt1;
+	flag intfile, sequential, ok, varfmt;
+	struct io_setup *ios;
+
+	/* First look at all the parameters and determine what is to be done */
+
+	ok = YES;
+	statstruct = YES;
+
+	intfile = NO;
+	if(p = V(IOSUNIT))
+	{
+		if( ISINT(p->headblock.vtype) ) {
+ int_unit:
+			unitp = (Addrp) cpexpr(p);
+			}
+		else if(p->headblock.vtype == TYCHAR)
+		{
+			if (nioctl == 1 && iostmt == IOREAD) {
+				/* kludge to recognize READ(format expr) */
+				V(IOSFMT) = p;
+				V(IOSUNIT) = p = (expptr) IOSTDIN;
+				ioformatted = FORMATTED;
+				goto int_unit;
+				}
+			intfile = YES;
+			if(p->tag==TPRIM && p->primblock.argsp==NULL &&
+			    (np = p->primblock.namep)->vdim!=NULL)
+			{
+				vardcl(np);
+				if(nump = np->vdim->nelt)
+				{
+					nump = fixtype(cpexpr(nump));
+					if( ! ISCONST(nump) ) {
+						statstruct = NO;
+						np->vlastdim = 0;
+						}
+				}
+				else
+				{
+					err("attempt to use internal unit array of unknown size");
+					ok = NO;
+					nump = ICON(1);
+				}
+				unitp = mkscalar(np);
+			}
+			else	{
+				nump = ICON(1);
+				unitp = (Addrp /*pjw */) fixtype(cpexpr(p));
+			}
+			if(! isstatic((expptr)unitp) )
+				statstruct = NO;
+		}
+		else {
+			err("unit specifier not of type integer or character");
+			ok = NO;
+			}
+	}
+	else
+	{
+		err("bad unit specifier");
+		ok = NO;
+	}
+
+	sequential = YES;
+	if(p = V(IOSREC))
+		if( ISINT(p->headblock.vtype) )
+		{
+			recp = (Addrp) cpexpr(p);
+			sequential = NO;
+		}
+		else	{
+			err("bad REC= clause");
+			ok = NO;
+		}
+	else
+		recp = NULL;
+
+
+	varfmt = YES;
+	fmtp = NULL;
+	if(p = V(IOSFMT))
+	{
+		if(p->tag==TPRIM && p->primblock.argsp==NULL)
+		{
+			np = p->primblock.namep;
+			if(np->vclass == CLNAMELIST)
+			{
+				ioformatted = NAMEDIRECTED;
+				fmtp = (Addrp) fixtype(p);
+				V(IOSFMT) = (expptr)fmtp;
+				if (skiplab)
+					jumplab = 0;
+				goto endfmt;
+			}
+			vardcl(np);
+			if(np->vdim)
+			{
+				if( ! ONEOF(np->vstg, MSKSTATIC) )
+					statstruct = NO;
+				fmtp = mkscalar(np);
+				goto endfmt;
+			}
+			if( ISINT(np->vtype) )	/* ASSIGNed label */
+			{
+				statstruct = NO;
+				varfmt = YES;
+				fmtp = asg_addr(p);
+				goto endfmt;
+			}
+		}
+		p = V(IOSFMT) = fixtype(p);
+		if(p->headblock.vtype == TYCHAR
+			/* Since we allow write(6,n)		*/
+			/* we may as well allow write(6,n(2))	*/
+		|| p->tag == TADDR && ISINT(p->addrblock.vtype))
+		{
+			if( ! isstatic(p) )
+				statstruct = NO;
+			fmtp = (Addrp) cpexpr(p);
+		}
+		else if( ISICON(p) )
+		{
+			struct Labelblock *lp;
+			lp = mklabel(p->constblock.Const.ci);
+			if (fmtstmt(lp) > 0)
+			{
+				fmtp = (Addrp)mkaddcon(lp->stateno);
+				/* lp->stateno for names fmt_nnn */
+				lp->fmtlabused = 1;
+				varfmt = NO;
+			}
+			else
+				ioformatted = UNFORMATTED;
+		}
+		else	{
+			err("bad format descriptor");
+			ioformatted = UNFORMATTED;
+			ok = NO;
+		}
+	}
+	else
+		fmtp = NULL;
+
+endfmt:
+	if(intfile) {
+		if (ioformatted==UNFORMATTED) {
+			err("unformatted internal I/O not allowed");
+			ok = NO;
+			}
+		if (recp) {
+			err("direct internal I/O not allowed");
+			ok = NO;
+			}
+		}
+	if(!sequential && ioformatted==LISTDIRECTED)
+	{
+		err("direct list-directed I/O not allowed");
+		ok = NO;
+	}
+	if(!sequential && ioformatted==NAMEDIRECTED)
+	{
+		err("direct namelist I/O not allowed");
+		ok = NO;
+	}
+
+	if( ! ok ) {
+		statstruct = NO;
+		return;
+		}
+
+	/*
+   Now put out the I/O structure, statically if all the clauses
+   are constants, dynamically otherwise
+*/
+
+	if (intfile) {
+		ios = io_stuff + iostmt;
+		iostmt1 = IOREAD;
+		}
+	else {
+		ios = io_stuff;
+		iostmt1 = 0;
+		}
+	io_fields = ios->fields;
+	if(statstruct)
+	{
+		ioblkp = ALLOC(Addrblock);
+		ioblkp->tag = TADDR;
+		ioblkp->vtype = ios->type;
+		ioblkp->vclass = CLVAR;
+		ioblkp->vstg = STGINIT;
+		ioblkp->memno = ++lastvarno;
+		ioblkp->memoffset = ICON(0);
+		ioblkp -> uname_tag = UNAM_IDENT;
+		new_iob_data(ios,
+			temp_name("io_", lastvarno, ioblkp->user.ident));			}
+	else if(!(ioblkp = io_structs[iostmt1]))
+		io_structs[iostmt1] = ioblkp =
+			autovar(1, ios->type, ENULL, "");
+
+	ioset(TYIOINT, XERR, ICON(errbit));
+	if(iostmt == IOREAD)
+		ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(endbit) );
+
+	if(intfile)
+	{
+		ioset(TYIOINT, XIRNUM, nump);
+		ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
+		ioseta(XIUNIT, unitp);
+	}
+	else
+		ioset(TYIOINT, XUNIT, (expptr) unitp);
+
+	if(recp)
+		ioset(TYIOINT, /* intfile ? XIREC : */ XREC, (expptr) recp);
+
+	if(varfmt)
+		ioseta( intfile ? XIFMT : XFMT , fmtp);
+	else
+		ioset(TYADDR, intfile ? XIFMT : XFMT, (expptr) fmtp);
+
+	ioroutine[0] = 's';
+	ioroutine[1] = '_';
+	ioroutine[2] = iostmt==IOREAD ? 'r' : 'w';
+	ioroutine[3] = "ds"[sequential];
+	ioroutine[4] = "ufln"[ioformatted];
+	ioroutine[5] = "ei"[intfile];
+	ioroutine[6] = '\0';
+
+	putiocall( call1(TYINT, ioroutine, cpexpr((expptr)ioblkp) ));
+
+	if(statstruct)
+	{
+		frexpr((expptr)ioblkp);
+		statstruct = NO;
+		ioblkp = 0;	/* unnecessary */
+	}
+}
+
+
+
+ LOCAL void
+dofopen(Void)
+{
+	register expptr p;
+
+	if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
+		ioset(TYIOINT, XUNIT, cpexpr(p) );
+	else
+		err("bad unit in open");
+	if( (p = V(IOSFILE)) )
+		if(p->headblock.vtype == TYCHAR)
+			ioset(TYIOINT, XFNAMELEN, cpexpr(p->headblock.vleng) );
+		else
+			err("bad file in open");
+
+	iosetc(XFNAME, p);
+
+	if(p = V(IOSRECL))
+		if( ISINT(p->headblock.vtype) )
+			ioset(TYIOINT, XRECLEN, cpexpr(p) );
+		else
+			err("bad recl");
+	else
+		ioset(TYIOINT, XRECLEN, ICON(0) );
+
+	iosetc(XSTATUS, V(IOSSTATUS));
+	iosetc(XACCESS, V(IOSACCESS));
+	iosetc(XFORMATTED, V(IOSFORM));
+	iosetc(XBLANK, V(IOSBLANK));
+
+	putiocall( call1(TYINT, "f_open", cpexpr((expptr)ioblkp) ));
+}
+
+
+ LOCAL void
+dofclose(Void)
+{
+	register expptr p;
+
+	if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
+	{
+		ioset(TYIOINT, XUNIT, cpexpr(p) );
+		iosetc(XCLSTATUS, V(IOSSTATUS));
+		putiocall( call1(TYINT, "f_clos", cpexpr((expptr)ioblkp)) );
+	}
+	else
+		err("bad unit in close statement");
+}
+
+
+ LOCAL void
+dofinquire(Void)
+{
+	register expptr p;
+	if(p = V(IOSUNIT))
+	{
+		if( V(IOSFILE) )
+			err("inquire by unit or by file, not both");
+		ioset(TYIOINT, XUNIT, cpexpr(p) );
+	}
+	else if( ! V(IOSFILE) )
+		err("must inquire by unit or by file");
+	iosetlc(IOSFILE, XFILE, XFILELEN);
+	iosetip(IOSEXISTS, XEXISTS);
+	iosetip(IOSOPENED, XOPEN);
+	iosetip(IOSNUMBER, XNUMBER);
+	iosetip(IOSNAMED, XNAMED);
+	iosetlc(IOSNAME, XNAME, XNAMELEN);
+	iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
+	iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
+	iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
+	iosetlc(IOSFORM, XFORM, XFORMLEN);
+	iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
+	iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
+	iosetip(IOSRECL, XQRECL);
+	iosetip(IOSNEXTREC, XNEXTREC);
+	iosetlc(IOSBLANK, XQBLANK, XQBLANKLEN);
+
+	putiocall( call1(TYINT,  "f_inqu", cpexpr((expptr)ioblkp) ));
+}
+
+
+
+ LOCAL void
+#ifdef KR_headers
+dofmove(subname)
+	char *subname;
+#else
+dofmove(char *subname)
+#endif
+{
+	register expptr p;
+
+	if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
+	{
+		ioset(TYIOINT, XUNIT, cpexpr(p) );
+		putiocall( call1(TYINT, subname, cpexpr((expptr)ioblkp) ));
+	}
+	else
+		err("bad unit in I/O motion statement");
+}
+
+static int ioset_assign = OPASSIGN;
+
+ LOCAL void
+#ifdef KR_headers
+ioset(type, offset, p)
+	int type;
+	int offset;
+	register expptr p;
+#else
+ioset(int type, int offset, register expptr p)
+#endif
+{
+	offset /= SZLONG;
+	if(statstruct && ISCONST(p)) {
+		register char *s;
+		switch(type) {
+			case TYADDR:	/* stmt label */
+				s = "fmt_";
+				break;
+			case TYIOINT:
+				s = "";
+				break;
+			default:
+				badtype("ioset", type);
+			}
+		iob_list->fields[offset] =
+			string_num(s, p->constblock.Const.ci);
+		frexpr(p);
+		}
+	else {
+		register Addrp q;
+
+		q = ALLOC(Addrblock);
+		q->tag = TADDR;
+		q->vtype = type;
+		q->vstg = STGAUTO;
+		q->ntempelt = 1;
+		q->isarray = 0;
+		q->memoffset = ICON(0);
+		q->uname_tag = UNAM_IDENT;
+		sprintf(q->user.ident, "%s.%s",
+			statstruct ? iob_list->name : ioblkp->user.ident,
+			io_fields[offset + 1]);
+		if (type == TYADDR && p->tag == TCONST
+				   && p->constblock.vtype == TYADDR) {
+			/* kludge */
+			register Addrp p1;
+			p1 = ALLOC(Addrblock);
+			p1->tag = TADDR;
+			p1->vtype = type;
+			p1->vstg = STGAUTO;	/* wrong, but who cares? */
+			p1->ntempelt = 1;
+			p1->isarray = 0;
+			p1->memoffset = ICON(0);
+			p1->uname_tag = UNAM_IDENT;
+			sprintf(p1->user.ident, "fmt_%ld",
+				p->constblock.Const.ci);
+			frexpr(p);
+			p = (expptr)p1;
+			}
+		if (type == TYADDR && p->headblock.vtype == TYCHAR)
+			q->vtype = TYCHAR;
+		putexpr(mkexpr(ioset_assign, (expptr)q, p));
+		}
+}
+
+
+
+
+ LOCAL void
+#ifdef KR_headers
+iosetc(offset, p)
+	int offset;
+	register expptr p;
+#else
+iosetc(int offset, register expptr p)
+#endif
+{
+	if(p == NULL)
+		ioset(TYADDR, offset, ICON(0) );
+	else if(p->headblock.vtype == TYCHAR) {
+		p = putx(fixtype((expptr)putchop(cpexpr(p))));
+		ioset(TYADDR, offset, addrof(p));
+		}
+	else
+		err("non-character control clause");
+}
+
+
+
+ LOCAL void
+#ifdef KR_headers
+ioseta(offset, p)
+	int offset;
+	register Addrp p;
+#else
+ioseta(int offset, register Addrp p)
+#endif
+{
+	char *s, *s1;
+	static char who[] = "ioseta";
+	expptr e, mo;
+	Namep np;
+	ftnint ci;
+	int k;
+	char buf[24], buf1[24];
+	Extsym *comm;
+	extern int usedefsforcommon;
+
+	if(statstruct)
+	{
+		if (!p)
+			return;
+		if (p->tag != TADDR)
+			badtag(who, p->tag);
+		offset /= SZLONG;
+		switch(p->uname_tag) {
+		    case UNAM_NAME:
+			mo = p->memoffset;
+			if (mo->tag != TCONST)
+				badtag("ioseta/memoffset", mo->tag);
+			np = p->user.name;
+			np->visused = 1;
+			ci = mo->constblock.Const.ci - np->voffset;
+			if (np->vstg == STGCOMMON
+			&& !np->vcommequiv
+			&& !usedefsforcommon) {
+				comm = &extsymtab[np->vardesc.varno];
+				sprintf(buf, "%d.", comm->curno);
+				k = strlen(buf) + strlen(comm->cextname)
+					+ strlen(np->cvarname);
+				if (ci) {
+					sprintf(buf1, "+%ld", ci);
+					k += strlen(buf1);
+					}
+				else
+					buf1[0] = 0;
+				s = mem(k + 1, 0);
+				sprintf(s, "%s%s%s%s", comm->cextname, buf,
+					np->cvarname, buf1);
+				}
+			else if (ci) {
+				sprintf(buf,"%ld", ci);
+				s1 = p->user.name->cvarname;
+				k = strlen(buf) + strlen(s1);
+				sprintf(s = mem(k+2,0), "%s+%s", s1, buf);
+				}
+			else
+				s = cpstring(np->cvarname);
+			break;
+		    case UNAM_CONST:
+			s = tostring(p->user.Const.ccp1.ccp0,
+				(int)p->vleng->constblock.Const.ci);
+			break;
+		    default:
+			badthing("uname_tag", who, p->uname_tag);
+		    }
+		/* kludge for Hollerith */
+		if (p->vtype != TYCHAR) {
+			s1 = mem(strlen(s)+10,0);
+			sprintf(s1, "(char *)%s%s", p->isarray ? "" : "&", s);
+			s = s1;
+			}
+		iob_list->fields[offset] = s;
+	}
+	else {
+		if (!p)
+			e = ICON(0);
+		else if (p->vtype != TYCHAR) {
+			NOEXT("non-character variable as format or internal unit");
+			e = mkexpr(OPCHARCAST, (expptr)p, ENULL);
+			}
+		else
+			e = addrof((expptr)p);
+		ioset(TYADDR, offset, e);
+		}
+}
+
+
+
+
+ LOCAL void
+#ifdef KR_headers
+iosetip(i, offset)
+	int i;
+	int offset;
+#else
+iosetip(int i, int offset)
+#endif
+{
+	register expptr p;
+
+	if(p = V(i))
+		if(p->tag==TADDR &&
+		    ONEOF(p->addrblock.vtype, inqmask) ) {
+			ioset_assign = OPASSIGNI;
+			ioset(TYADDR, offset, addrof(cpexpr(p)) );
+			ioset_assign = OPASSIGN;
+			}
+		else
+			errstr("impossible inquire parameter %s", ioc[i].iocname);
+	else
+		ioset(TYADDR, offset, ICON(0) );
+}
+
+
+
+ LOCAL void
+#ifdef KR_headers
+iosetlc(i, offp, offl)
+	int i;
+	int offp;
+	int offl;
+#else
+iosetlc(int i, int offp, int offl)
+#endif
+{
+	register expptr p;
+	if( (p = V(i)) && p->headblock.vtype==TYCHAR)
+		ioset(TYIOINT, offl, cpexpr(p->headblock.vleng) );
+	iosetc(offp, p);
+}
diff --git a/contrib/tools/f2c/src/iob.h b/contrib/tools/f2c/src/iob.h
new file mode 100644
index 0000000000..065d813aae
--- /dev/null
+++ b/contrib/tools/f2c/src/iob.h
@@ -0,0 +1,26 @@
+struct iob_data {
+	struct iob_data *next;
+	char *type;
+	char *name;
+	char *fields[1];
+	};
+struct io_setup {
+	char **fields;
+	int nelt, type;
+	};
+
+struct defines {
+	struct defines *next;
+	char defname[1];
+	};
+
+typedef struct iob_data iob_data;
+typedef struct io_setup io_setup;
+typedef struct defines defines;
+
+extern iob_data *iob_list;
+extern struct Addrblock *io_structs[9];
+void	def_start Argdcl((FILEP, char*, char*, char*));
+void	new_iob_data Argdcl((io_setup*, char*));
+void	other_undefs Argdcl((FILEP));
+char*	tostring Argdcl((char*, int));
diff --git a/contrib/tools/f2c/src/lex.c b/contrib/tools/f2c/src/lex.c
new file mode 100644
index 0000000000..b593113709
--- /dev/null
+++ b/contrib/tools/f2c/src/lex.c
@@ -0,0 +1,1749 @@
+/****************************************************************
+Copyright 1990, 1992 - 1997, 1999, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "tokdefs.h"
+#include "p1defs.h"
+
+#ifdef _WIN32
+#undef MSDOS
+#define MSDOS
+#endif
+
+#ifdef NO_EOF_CHAR_CHECK
+#undef EOF_CHAR
+#else
+#ifndef EOF_CHAR
+#define EOF_CHAR 26	/* ASCII control-Z */
+#endif
+#endif
+
+#define BLANK	' '
+#define MYQUOTE (2)
+#define SEOF 0
+
+/* card types */
+
+#define STEOF 1
+#define STINITIAL 2
+#define STCONTINUE 3
+
+/* lex states */
+
+#define NEWSTMT	1
+#define FIRSTTOKEN	2
+#define OTHERTOKEN	3
+#define RETEOS	4
+
+
+LOCAL int stkey;	/* Type of the current statement (DO, END, IF, etc) */
+static int needwkey;
+ftnint yystno;
+flag intonly;
+extern int new_dcl;
+LOCAL long int stno;
+LOCAL long int nxtstno;	/* Statement label */
+LOCAL int parlev;	/* Parentheses level */
+LOCAL int parseen;
+LOCAL int expcom;
+LOCAL int expeql;
+LOCAL char *nextch;
+LOCAL char *lastch;
+LOCAL char *nextcd 	= NULL;
+LOCAL char *endcd;
+LOCAL long prevlin;
+LOCAL long thislin;
+LOCAL int code;		/* Card type; INITIAL, CONTINUE or EOF */
+LOCAL int lexstate	= NEWSTMT;
+LOCAL char *sbuf;	/* Main buffer for Fortran source input. */
+LOCAL char *send;	/* Was = sbuf+20*66 with sbuf[1390]. */
+LOCAL char *shend;	/* reflects elbow room for #line lines */
+LOCAL int maxcont;
+LOCAL int nincl	= 0;	/* Current number of include files */
+LOCAL long firstline;
+LOCAL char *infname1, *infname2, *laststb, *stb0;
+extern int addftnsrc;
+static char **linestart;
+LOCAL int ncont;
+LOCAL char comstart[Table_size];
+#define USC (unsigned char *)
+
+static char anum_buf[Table_size];
+#define isalnum_(x) anum_buf[x]
+#define isalpha_(x) (anum_buf[x] == 1)
+
+#define COMMENT_BUF_STORE 4088
+
+typedef struct comment_buf {
+	struct comment_buf *next;
+	char *last;
+	char buf[COMMENT_BUF_STORE];
+	} comment_buf;
+static comment_buf *cbfirst, *cbcur;
+static char *cbinit, *cbnext, *cblast;
+static void flush_comments Argdcl((void));
+extern flag use_bs;
+static char *lastfile = "??", *lastfile0 = "?";
+static char fbuf[P1_FILENAME_MAX];
+static long lastline;
+static void putlineno(Void);
+
+
+/* Comment buffering data
+
+	Comments are kept in a list until the statement before them has
+   been parsed.  This list is implemented with the above comment_buf
+   structure and the pointers cbnext and cblast.
+
+	The comments are stored with terminating NULL, and no other
+   intervening space.  The last few bytes of each block are likely to
+   remain unused.
+*/
+
+/* struct Inclfile   holds the state information for each include file */
+struct Inclfile
+{
+	struct Inclfile *inclnext;
+	FILEP inclfp;
+	char *inclname;
+	int incllno;
+	char *incllinp;
+	int incllen;
+	int inclcode;
+	ftnint inclstno;
+};
+
+LOCAL struct Inclfile *inclp	=  NULL;
+struct Keylist {
+	char *keyname;
+	int keyval;
+	char notinf66;
+};
+struct Punctlist {
+	char punchar;
+	int punval;
+};
+struct Fmtlist {
+	char fmtchar;
+	int fmtval;
+};
+struct Dotlist {
+	char *dotname;
+	int dotval;
+	};
+LOCAL struct Keylist *keystart[26], *keyend[26];
+
+/* KEYWORD AND SPECIAL CHARACTER TABLES
+*/
+
+static struct Punctlist puncts[ ] =
+{
+	{'(', SLPAR},
+	{')', SRPAR},
+	{'=', SEQUALS},
+	{',', SCOMMA},
+	{'+', SPLUS},
+	{'-', SMINUS},
+	{'*', SSTAR},
+	{'/', SSLASH},
+	{'$', SCURRENCY},
+	{':', SCOLON},
+	{'<', SLT},
+	{'>', SGT},
+	{0, 0}};
+
+LOCAL struct Dotlist  dots[ ] =
+{
+	{"and.", SAND},
+	    {"or.", SOR},
+	    {"not.", SNOT},
+	    {"true.", STRUE},
+	    {"false.", SFALSE},
+	    {"eq.", SEQ},
+	    {"ne.", SNE},
+	    {"lt.", SLT},
+	    {"le.", SLE},
+	    {"gt.", SGT},
+	    {"ge.", SGE},
+	    {"neqv.", SNEQV},
+	    {"eqv.", SEQV},
+	    {0, 0}};
+
+LOCAL struct Keylist  keys[ ] =
+{
+	{ "assign",  SASSIGN  },
+	{ "automatic",  SAUTOMATIC, YES  },
+	{ "backspace",  SBACKSPACE  },
+	{ "blockdata",  SBLOCK  },
+	{ "byte",	SBYTE	},
+	{ "call",  SCALL  },
+	{ "character",  SCHARACTER, YES  },
+	{ "close",  SCLOSE, YES  },
+	{ "common",  SCOMMON  },
+	{ "complex",  SCOMPLEX  },
+	{ "continue",  SCONTINUE  },
+	{ "data",  SDATA  },
+	{ "dimension",  SDIMENSION  },
+	{ "doubleprecision",  SDOUBLE  },
+	{ "doublecomplex", SDCOMPLEX, YES  },
+	{ "elseif",  SELSEIF, YES  },
+	{ "else",  SELSE, YES  },
+	{ "endfile",  SENDFILE  },
+	{ "endif",  SENDIF, YES  },
+	{ "enddo", SENDDO, YES },
+	{ "end",  SEND  },
+	{ "entry",  SENTRY, YES  },
+	{ "equivalence",  SEQUIV  },
+	{ "external",  SEXTERNAL  },
+	{ "format",  SFORMAT  },
+	{ "function",  SFUNCTION  },
+	{ "goto",  SGOTO  },
+	{ "implicit",  SIMPLICIT, YES  },
+	{ "include",  SINCLUDE, YES  },
+	{ "inquire",  SINQUIRE, YES  },
+	{ "intrinsic",  SINTRINSIC, YES  },
+	{ "integer",  SINTEGER  },
+	{ "logical",  SLOGICAL  },
+	{ "namelist", SNAMELIST, YES },
+	{ "none", SUNDEFINED, YES },
+	{ "open",  SOPEN, YES  },
+	{ "parameter",  SPARAM, YES  },
+	{ "pause",  SPAUSE  },
+	{ "print",  SPRINT  },
+	{ "program",  SPROGRAM, YES  },
+	{ "punch",  SPUNCH, YES  },
+	{ "read",  SREAD  },
+	{ "real",  SREAL  },
+	{ "return",  SRETURN  },
+	{ "rewind",  SREWIND  },
+	{ "save",  SSAVE, YES  },
+	{ "static",  SSTATIC, YES  },
+	{ "stop",  SSTOP  },
+	{ "subroutine",  SSUBROUTINE  },
+	{ "then",  STHEN, YES  },
+	{ "undefined", SUNDEFINED, YES  },
+	{ "while", SWHILE, YES  },
+	{ "write",  SWRITE  },
+	{ 0, 0 }
+};
+
+static void analyz Argdcl((void));
+static void crunch Argdcl((void));
+static int getcd Argdcl((char*, int));
+static int getcds Argdcl((void));
+static int getkwd Argdcl((void));
+static int gettok Argdcl((void));
+static void store_comment Argdcl((char*));
+LOCAL char *stbuf[3];
+
+ int
+#ifdef KR_headers
+inilex(name)
+	char *name;
+#else
+inilex(char *name)
+#endif
+{
+	stbuf[0] = Alloc(3*P1_STMTBUFSIZE);
+	stbuf[1] = stbuf[0] + P1_STMTBUFSIZE;
+	stbuf[2] = stbuf[1] + P1_STMTBUFSIZE;
+	nincl = 0;
+	inclp = NULL;
+	doinclude(name);
+	lexstate = NEWSTMT;
+	return(NO);
+}
+
+
+
+/* throw away the rest of the current line */
+ void
+flline(Void)
+{
+	lexstate = RETEOS;
+}
+
+
+
+ char *
+#ifdef KR_headers
+lexline(n)
+	int *n;
+#else
+lexline(int *n)
+#endif
+{
+	*n = (lastch - nextch) + 1;
+	return(nextch);
+}
+
+
+
+
+ void
+#ifdef KR_headers
+doinclude(name)
+	char *name;
+#else
+doinclude(char *name)
+#endif
+{
+	FILEP fp;
+	struct Inclfile *t;
+	char *name0, *lastslash, *s, *s0, *temp;
+	int j, k;
+	chainp I;
+	extern chainp Iargs;
+
+	err_lineno = -1;
+	if(inclp)
+	{
+		inclp->incllno = thislin;
+		inclp->inclcode = code;
+		inclp->inclstno = nxtstno;
+		if(nextcd && (j = endcd - nextcd) > 0)
+			inclp->incllinp = copyn(inclp->incllen = j, nextcd);
+		else
+			inclp->incllinp = 0;
+	}
+	nextcd = NULL;
+
+	if(++nincl >= MAXINCLUDES)
+		Fatal("includes nested too deep");
+	if(name[0] == '\0')
+		fp = stdin;
+	else if(name[0] == '/' || inclp == NULL
+#ifdef MSDOS
+		|| name[0] == '\\'
+		|| name[1] == ':'
+#endif
+		)
+		fp = fopen(name, textread);
+	else {
+		lastslash = NULL;
+		s = s0 = inclp->inclname;
+#ifdef MSDOS
+		if (s[1] == ':')
+			lastslash = s + 1;
+#endif
+		for(; *s ; ++s)
+			if(*s == '/'
+#ifdef MSDOS
+			|| *s == '\\'
+#endif
+			)
+				lastslash = s;
+		name0 = name;
+		if(lastslash) {
+			k = lastslash - s0 + 1;
+			temp = Alloc(k + strlen(name) + 1);
+			strncpy(temp, s0, k);
+			strcpy(temp+k, name);
+			name = temp;
+			}
+		fp = fopen(name, textread);
+		if (!fp && (I = Iargs)) {
+			k = strlen(name0) + 2;
+			for(; I; I = I->nextp) {
+				j = strlen(s = I->datap);
+				name = Alloc(j + k);
+				strcpy(name, s);
+				switch(s[j-1]) {
+					case '/':
+#ifdef MSDOS
+					case ':':
+					case '\\':
+#endif
+						break;
+					default:
+						name[j++] = '/';
+					}
+				strcpy(name+j, name0);
+				if (fp = fopen(name, textread)) {
+					free(name0);
+					goto havefp;
+					}
+				free(name);
+				name = name0;
+				}
+			}
+		}
+	if (fp)
+	{
+ havefp:
+		t = inclp;
+		inclp = ALLOC(Inclfile);
+		inclp->inclnext = t;
+		prevlin = thislin = lineno = 0;
+		infname = inclp->inclname = name;
+		infile = inclp->inclfp = fp;
+		lastline = 0;
+		putlineno();
+		lastline = 0;
+	}
+	else
+	{
+		fprintf(diagfile, "Cannot open file %s\n", name);
+		done(1);
+	}
+}
+
+
+
+
+ LOCAL int
+popinclude(Void)
+{
+	struct Inclfile *t;
+	register char *p;
+	register int k;
+
+	if(infile != stdin)
+		clf(&infile, infname, 1);	/* Close the input file */
+	free(infname);
+
+	--nincl;
+	err_lineno = -1;
+	t = inclp->inclnext;
+	free( (charptr) inclp);
+	inclp = t;
+	if(inclp == NULL) {
+		infname = 0;
+		return(NO);
+		}
+
+	infile = inclp->inclfp;
+	infname = inclp->inclname;
+	lineno = prevlin = thislin = inclp->incllno;
+	code = inclp->inclcode;
+	stno = nxtstno = inclp->inclstno;
+	if(inclp->incllinp)
+	{
+		lastline = 0;
+		putlineno();
+		lastline = lineno;
+		endcd = nextcd = sbuf;
+		k = inclp->incllen;
+		p = inclp->incllinp;
+		while(--k >= 0)
+			*endcd++ = *p++;
+		free( (charptr) (inclp->incllinp) );
+	}
+	else
+		nextcd = NULL;
+	return(YES);
+}
+
+
+ void
+#ifdef KR_headers
+p1_line_number(line_number)
+	long line_number;
+#else
+p1_line_number(long line_number)
+#endif
+{
+	if (lastfile != lastfile0) {
+		p1puts(P1_FILENAME, fbuf);
+		lastfile0 = lastfile;
+		}
+	fprintf(pass1_file, "%d: %ld\n", P1_SET_LINE, line_number);
+	}
+
+ static void
+putlineno(Void)
+{
+	extern int gflag;
+	register char *s0, *s1;
+
+	if (gflag) {
+		if (lastline)
+			p1_line_number(lastline);
+		lastline = firstline;
+		if (lastfile != infname)
+			if (lastfile = infname) {
+				strncpy(fbuf, lastfile, sizeof(fbuf));
+				fbuf[sizeof(fbuf)-1] = 0;
+				}
+			else
+				fbuf[0] = 0;
+		}
+	if (addftnsrc) {
+		if (laststb && *laststb) {
+			for(s1 = laststb; *s1; s1++) {
+				for(s0 = s1; *s1 != '\n'; s1++)
+					if (*s1 == '*' && s1[1] == '/')
+						*s1 = '+';
+				*s1 = 0;
+				p1puts(P1_FORTRAN, s0);
+				}
+			*laststb = 0;	/* prevent trouble after EOF */
+			}
+		laststb = stb0;
+		}
+	}
+
+ int
+yylex(Void)
+{
+	static int  tokno;
+	int retval;
+
+	switch(lexstate)
+	{
+	case NEWSTMT :	/* need a new statement */
+		retval = getcds();
+		putlineno();
+		if(retval == STEOF) {
+			retval = SEOF;
+			break;
+		} /* if getcds() == STEOF */
+		crunch();
+		tokno = 0;
+		lexstate = FIRSTTOKEN;
+		yystno = stno;
+		stno = nxtstno;
+		toklen = 0;
+		retval = SLABEL;
+		break;
+
+first:
+	case FIRSTTOKEN :	/* first step on a statement */
+		analyz();
+		lexstate = OTHERTOKEN;
+		tokno = 1;
+		retval = stkey;
+		break;
+
+	case OTHERTOKEN :	/* return next token */
+		if(nextch > lastch)
+			goto reteos;
+		++tokno;
+		if( (stkey==SLOGIF || stkey==SELSEIF) && parlev==0 && tokno>3)
+			goto first;
+
+		if(stkey==SASSIGN && tokno==3 && nextch<lastch &&
+		    nextch[0]=='t' && nextch[1]=='o')
+		{
+			nextch+=2;
+			retval = STO;
+			break;
+		}
+		if (tokno == 2 && stkey == SDO) {
+			intonly = 1;
+			retval = gettok();
+			intonly = 0;
+			}
+		else
+			retval = gettok();
+		break;
+
+reteos:
+	case RETEOS:
+		lexstate = NEWSTMT;
+		retval = SEOS;
+		break;
+	default:
+		fatali("impossible lexstate %d", lexstate);
+		break;
+	}
+
+	if (retval == SEOF)
+	    flush_comments ();
+
+	return retval;
+}
+
+ LOCAL void
+contmax(Void)
+{
+	lineno = thislin;
+	many("continuation lines", 'C', maxcontin);
+	}
+
+/* Get Cards.
+
+   Returns STEOF or STINITIAL, never STCONTINUE.  Any continuation cards get
+merged into one long card (hence the size of the buffer named   sbuf)   */
+
+ LOCAL int
+getcds(Void)
+{
+	register char *p, *q;
+
+	flush_comments ();
+top:
+	if(nextcd == NULL)
+	{
+		code = getcd( nextcd = sbuf, 1 );
+		stno = nxtstno;
+		prevlin = thislin;
+	}
+	if(code == STEOF)
+		if( popinclude() )
+			goto top;
+		else
+			return(STEOF);
+
+	if(code == STCONTINUE)
+	{
+		lineno = thislin;
+		nextcd = NULL;
+		goto top;
+	}
+
+/* Get rid of unused space at the head of the buffer */
+
+	if(nextcd > sbuf)
+	{
+		q = nextcd;
+		p = sbuf;
+		while(q < endcd)
+			*p++ = *q++;
+		endcd = p;
+	}
+
+/* Be aware that the input (i.e. the string at the address   nextcd)   is NOT
+   NULL-terminated */
+
+/* This loop merges all continuations into one long statement, AND puts the next
+   card to be read at the end of the buffer (i.e. it stores the look-ahead card
+   when there's room) */
+
+	ncont = 0;
+	for(;;) {
+		nextcd = endcd;
+		if (ncont >= maxcont || nextcd+66 > send)
+			contmax();
+		linestart[ncont++] = nextcd;
+		if ((code = getcd(nextcd,0)) != STCONTINUE)
+			break;
+		if (ncont == 20 && noextflag) {
+			lineno = thislin;
+			errext("more than 19 continuation lines");
+			}
+		}
+	nextch = sbuf;
+	lastch = nextcd - 1;
+
+	lineno = prevlin;
+	prevlin = thislin;
+	if (infname2) {
+		free(infname);
+		infname = infname2;
+		if (inclp)
+			inclp->inclname = infname;
+		}
+	infname2 = infname1;
+	infname1 = 0;
+	return(STINITIAL);
+}
+
+ static void
+#ifdef KR_headers
+bang(a, b, c, d, e)
+	char *a;
+	char *b;
+	char *c;
+	register char *d;
+	register char *e;
+#else
+bang(char *a, char *b, char *c, register char *d, register char *e)
+#endif
+		/* save ! comments */
+{
+	char buf[COMMENT_BUFFER_SIZE + 1];
+	register char *p, *pe;
+
+	p = buf;
+	pe = buf + COMMENT_BUFFER_SIZE;
+	*pe = 0;
+	while(a < b)
+		if (!(*p++ = *a++))
+			p[-1] = 0;
+	if (b < c)
+		*p++ = '\t';
+	while(d < e) {
+		if (!(*p++ = *d++))
+			p[-1] = ' ';
+		if (p == pe) {
+			store_comment(buf);
+			p = buf;
+			}
+		}
+	if (p > buf) {
+		while(--p >= buf && *p == ' ');
+		p[1] = 0;
+		store_comment(buf);
+		}
+	}
+
+
+/* getcd - Get next input card
+
+	This function reads the next input card from global file pointer   infile.
+It assumes that   b   points to currently empty storage somewhere in  sbuf  */
+
+ LOCAL int
+#ifdef KR_headers
+getcd(b, nocont)
+	register char *b;
+	int nocont;
+#else
+getcd(register char *b, int nocont)
+#endif
+{
+	register int c;
+	register char *p, *bend;
+	int speclin;		/* Special line - true when the line is allowed
+				   to have more than 66 characters (e.g. the
+				   "&" shorthand for continuation, use of a "\t"
+				   to skip part of the label columns) */
+	static char a[6];	/* Statement label buffer */
+	static char *aend	= a+6;
+	static char *stb, *stbend;
+	static int nst;
+	char *atend, *endcd0;
+	extern int warn72;
+	char buf72[24];
+	int amp, i;
+	char storage[COMMENT_BUFFER_SIZE + 1];
+	char *pointer;
+	long L;
+
+top:
+	endcd = b;
+	bend = b+66;
+	amp = speclin = NO;
+	atend = aend;
+
+/* Handle the continuation shorthand of "&" in the first column, which stands
+   for "     x" */
+
+	if( (c = getc(infile)) == '&')
+	{
+		a[0] = c;
+		a[1] = 0;
+		a[5] = 'x';
+		amp = speclin = YES;
+		bend = send;
+		p = aend;
+	}
+
+/* Handle the Comment cards (a 'C', 'c', '*', or '!' in the first column). */
+
+	else if(comstart[c & (Table_size-1)])
+	{
+		if (feof (infile)
+#ifdef EOF_CHAR
+			 || c == EOF_CHAR
+#endif
+					)
+		    return STEOF;
+
+		if (c == '#') {
+			*endcd++ = c;
+			while((c = getc(infile)) != '\n')
+				if (c == EOF)
+					return STEOF;
+				else if (endcd < shend)
+					*endcd++ = c;
+			++thislin;
+			*endcd = 0;
+			if (b[1] == ' ')
+				p = b + 2;
+			else if (!strncmp(b,"#line ",6))
+				p = b + 6;
+			else {
+ bad_cpp:
+				lineno = thislin;
+				errstr("Bad # line: \"%s\"", b);
+				goto top;
+				}
+			if (*p < '1' || *p > '9')
+				goto bad_cpp;
+			L = *p - '0';
+			while((c = *++p) >= '0' && c <= '9')
+				L = 10*L + c - '0';
+			while(c == ' ')
+				c = *++p;
+			if (!c) {
+				/* accept "# 1234" */
+				thislin = L - 1;
+				goto top;
+				}
+			if (c != '"')
+				goto bad_cpp;
+			bend = p;
+			while(*++p != '"')
+				if (!*p)
+					goto bad_cpp;
+			*p = 0;
+			i = p - bend++;
+			thislin = L - 1;
+			if (!infname1 || strcmp(infname1, bend)) {
+				if (infname1)
+					free(infname1);
+				if (infname && !strcmp(infname, bend)) {
+					infname1 = 0;
+					goto top;
+					}
+				lastfile = 0;
+				infname1 = Alloc(i);
+				strcpy(infname1, bend);
+				if (!infname) {
+					infname = infname1;
+					infname1 = 0;
+					}
+				}
+			goto top;
+			}
+
+		storage[COMMENT_BUFFER_SIZE] = c = '\0';
+		pointer = storage;
+		while( !feof (infile) && (*pointer++ = c = getc(infile)) != '\n') {
+
+/* Handle obscure end of file conditions on many machines */
+
+			if (feof (infile) && (c == '\377' || c == EOF)) {
+			    pointer--;
+			    break;
+			} /* if (feof (infile)) */
+
+			if (c == '\0')
+				*(pointer - 1) = ' ';
+
+			if (pointer == &storage[COMMENT_BUFFER_SIZE]) {
+				store_comment (storage);
+				pointer = storage;
+			} /* if (pointer == BUFFER_SIZE) */
+		} /* while */
+
+		if (pointer > storage) {
+		    if (c == '\n')
+
+/* Get rid of the newline */
+
+			pointer[-1] = 0;
+		    else
+			*pointer = 0;
+
+		    store_comment (storage);
+		} /* if */
+
+		if (feof (infile))
+		    if (c != '\n')	/* To allow the line index to
+					   increment correctly */
+			return STEOF;
+
+		++thislin;
+		goto top;
+	}
+
+	else if(c != EOF)
+	{
+
+/* Load buffer   a   with the statement label */
+
+		/* a tab in columns 1-6 skips to column 7 */
+		ungetc(c, infile);
+		for(p=a; p<aend && (c=getc(infile)) != '\n' && c!=EOF; )
+			if(c == '\t')
+
+/* The tab character translates into blank characters in the statement label */
+
+			{
+				atend = p;
+				while(p < aend)
+					*p++ = BLANK;
+				speclin = YES;
+				bend = send;
+			}
+			else
+				*p++ = c;
+	}
+
+/* By now we've read either a continuation character or the statement label
+   field */
+
+	if(c == EOF)
+		return(STEOF);
+
+/* The next 'if' block handles lines that have fewer than 7 characters */
+
+	if(c == '\n')
+	{
+		while(p < aend)
+			*p++ = BLANK;
+
+/* Blank out the buffer on lines which are not longer than 66 characters */
+
+		endcd0 = endcd;
+		if( ! speclin )
+			while(endcd < bend)
+				*endcd++ = BLANK;
+	}
+	else	{	/* read body of line */
+		if (warn72 & 2) {
+			speclin = YES;
+			bend = send;
+			}
+		while( endcd<bend && (c=getc(infile)) != '\n' && c!=EOF )
+			*endcd++ = c;
+		if(c == EOF)
+			return(STEOF);
+
+/* Drop any extra characters on the input card; this usually means those after
+   column 72 */
+
+		if(c != '\n')
+		{
+			i = 0;
+			while( (c=getc(infile)) != '\n' && c != EOF)
+				if (i < 23 && c != '\r')
+					buf72[i++] = c;
+			if (warn72 && i && !speclin) {
+				buf72[i] = 0;
+				if (i >= 23)
+					strcpy(buf72+20, "...");
+				lineno = thislin + 1;
+				errstr("text after column 72: %s", buf72);
+				}
+			if(c == EOF)
+				return(STEOF);
+		}
+
+		endcd0 = endcd;
+		if( ! speclin )
+			while(endcd < bend)
+				*endcd++ = BLANK;
+	}
+
+/* The flow of control usually gets to this line (unless an earlier RETURN has
+   been taken) */
+
+	++thislin;
+
+	/* Fortran 77 specifies that a 0 in column 6 */
+	/* does not signify continuation */
+
+	if( !isspace(a[5]) && a[5]!='0') {
+		if (!amp)
+			for(p = a; p < aend;)
+				if (*p++ == '!' && p != aend)
+					goto initcheck;
+		if (addftnsrc && stb) {
+			if (stbend > stb + 7) { /* otherwise forget col 1-6 */
+				/* kludge around funny p1gets behavior */
+				*stb++ = '$';
+				if (amp)
+					*stb++ = '&';
+				else
+					for(p = a; p < atend;)
+						*stb++ = *p++;
+				}
+			if (endcd0 - b > stbend - stb) {
+				if (stb > stbend)
+					stb = stbend;
+				endcd0 = b + (stbend - stb);
+				}
+			for(p = b; p < endcd0;)
+				*stb++ = *p++;
+			*stb++ = '\n';
+			*stb = 0;
+			}
+		if (nocont) {
+			lineno = thislin;
+			errstr("illegal continuation card (starts \"%.6s\")",a);
+			}
+		else if (!amp && strncmp(a,"     ",5)) {
+			lineno = thislin;
+			errstr("labeled continuation line (starts \"%.6s\")",a);
+			}
+		return(STCONTINUE);
+		}
+initcheck:
+	for(p=a; p<atend; ++p)
+		if( !isspace(*p) ) {
+			if (*p++ != '!')
+				goto initline;
+			bang(p, atend, aend, b, endcd);
+			goto top;
+			}
+	for(p = b ; p<endcd ; ++p)
+		if( !isspace(*p) ) {
+			if (*p++ != '!')
+				goto initline;
+			bang(a, a, a, p, endcd);
+			goto top;
+			}
+
+/* Skip over blank cards by reading the next one right away */
+
+	goto top;
+
+initline:
+	if (!lastline)
+		lastline = thislin;
+	if (addftnsrc) {
+		nst = (nst+1)%3;
+		if (!laststb && stb0)
+			laststb = stb0;
+		stb0 = stb = stbuf[nst];
+		*stb++ = '$';	/* kludge around funny p1gets behavior */
+		stbend = stb + sizeof(stbuf[0])-2;
+		for(p = a; p < atend;)
+			*stb++ = *p++;
+		if (atend < aend)
+			*stb++ = '\t';
+		for(p = b; p < endcd0;)
+			*stb++ = *p++;
+		*stb++ = '\n';
+		*stb = 0;
+		}
+
+/* Set   nxtstno   equal to the integer value of the statement label */
+
+	nxtstno = 0;
+	bend = a + 5;
+	for(p = a ; p < bend ; ++p)
+		if( !isspace(*p) )
+			if(isdigit(*p))
+				nxtstno = 10*nxtstno + (*p - '0');
+			else if (*p == '!') {
+				if (!addftnsrc)
+					bang(p+1,atend,aend,b,endcd);
+				endcd = b;
+				break;
+				}
+			else	{
+				lineno = thislin;
+				errstr(
+				"nondigit in statement label field \"%.5s\"", a);
+				nxtstno = 0;
+				break;
+			}
+	firstline = thislin;
+	return(STINITIAL);
+}
+
+ LOCAL void
+#ifdef KR_headers
+adjtoklen(newlen)
+	int newlen;
+#else
+adjtoklen(int newlen)
+#endif
+{
+	while(maxtoklen < newlen)
+		maxtoklen = 2*maxtoklen + 2;
+	if (token = (char *)realloc(token, maxtoklen))
+		return;
+	fprintf(stderr, "adjtoklen: realloc(%d) failure!\n", maxtoklen);
+	exit(2);
+	}
+
+/* crunch -- deletes all space characters, folds the backslash chars and
+   Hollerith strings, quotes the Fortran strings */
+
+ LOCAL void
+crunch(Void)
+{
+	register char *i, *j, *j0, *j1, *prvstr;
+	int k, ten, nh, nh0, quote;
+
+	/* i is the next input character to be looked at
+	   j is the next output character */
+
+	new_dcl = needwkey = parlev = parseen = 0;
+	expcom = 0;	/* exposed ','s */
+	expeql = 0;	/* exposed equal signs */
+	j = sbuf;
+	prvstr = sbuf;
+	k = 0;
+	for(i=sbuf ; i<=lastch ; ++i)
+	{
+		if(isspace(*i) )
+			continue;
+		if (*i == '!') {
+			while(i >= linestart[k])
+				if (++k >= maxcont)
+					contmax();
+			j0 = linestart[k];
+			if (!addftnsrc)
+				bang(sbuf,sbuf,sbuf,i+1,j0);
+			i = j0-1;
+			continue;
+			}
+
+/* Keep everything in a quoted string */
+
+		if(*i=='\'' ||  *i=='"')
+		{
+			int len = 0;
+
+			quote = *i;
+			*j = MYQUOTE; /* special marker */
+			for(;;)
+			{
+				if(++i > lastch)
+				{
+					err("unbalanced quotes; closing quote supplied");
+					if (j >= lastch)
+						j = lastch - 1;
+					break;
+				}
+				if(*i == quote)
+					if(i<lastch && i[1]==quote) ++i;
+					else break;
+				else if(*i=='\\' && i<lastch && use_bs) {
+					++i;
+					*i = escapes[*(unsigned char *)i];
+					}
+				*++j = *i;
+				len++;
+			} /* for (;;) */
+
+			if ((len = j - sbuf) > maxtoklen)
+				adjtoklen(len);
+			j[1] = MYQUOTE;
+			j += 2;
+			prvstr = j;
+		}
+		else if( (*i=='h' || *i=='H')  && j>prvstr)	/* test for Hollerith strings */
+		{
+			j0 = j - 1;
+			if( ! isdigit(*j0)) goto copychar;
+			nh = *j0 - '0';
+			ten = 10;
+			j1 = prvstr;
+			if (j1 > sbuf && j1[-1] == MYQUOTE)
+				--j1;
+			if (j1+4 < j)
+				j1 = j-4;
+			for(;;) {
+				if (j0-- <= j1)
+					goto copychar;
+				if( ! isdigit(*j0 ) ) break;
+				nh += ten * (*j0-'0');
+				ten*=10;
+				}
+/* A Hollerith string must be preceded by a punctuation mark.
+   '*' is possible only as repetition factor in a data statement
+   not, in particular, in character*2h .
+   To avoid some confusion with missing commas in FORMAT statements,
+   treat a preceding string as a punctuation mark.
+ */
+
+			if( !(*j0=='*'&&sbuf[0]=='d') && *j0!='/'
+			&& *j0!='(' && *j0!=',' && *j0!='=' && *j0!='.'
+			&& *j0 != MYQUOTE)
+				goto copychar;
+			nh0 = nh;
+			if(i+nh > lastch)
+			{
+				erri("%dH too big", nh);
+				nh = lastch - i;
+				nh0 = -1;
+			}
+			if (nh > maxtoklen)
+				adjtoklen(nh);
+			j0[1] = MYQUOTE; /* special marker */
+			j = j0 + 1;
+			while(nh-- > 0)
+			{
+				if (++i > lastch) {
+ hol_overflow:
+					if (nh0 >= 0)
+					  erri("escapes make %dH too big",
+						nh0);
+					break;
+					}
+				if(*i == '\\' && use_bs) {
+					if (++i > lastch)
+						goto hol_overflow;
+					*i = escapes[*(unsigned char *)i];
+					}
+				*++j = *i;
+			}
+			j[1] = MYQUOTE;
+			j+=2;
+			prvstr = j;
+		}
+		else	{
+			if(*i == '(') parseen = ++parlev;
+			else if(*i == ')') --parlev;
+			else if(parlev == 0)
+				if(*i == '=') expeql = 1;
+				else if(*i == ',') expcom = 1;
+copychar:		/*not a string or space -- copy, shifting case if necessary */
+			if(shiftcase && isupper(*i))
+				*j++ = tolower(*i);
+			else	*j++ = *i;
+		}
+	}
+	lastch = j - 1;
+	nextch = sbuf;
+}
+
+ LOCAL void
+analyz(Void)
+{
+	register char *i;
+
+	if(parlev != 0)
+	{
+		err("unbalanced parentheses, statement skipped");
+		stkey = SUNKNOWN;
+		lastch = sbuf - 1; /* prevent double error msg */
+		return;
+	}
+	if(nextch+2<=lastch && nextch[0]=='i' && nextch[1]=='f' && nextch[2]=='(')
+	{
+		/* assignment or if statement -- look at character after balancing paren */
+		parlev = 1;
+		for(i=nextch+3 ; i<=lastch; ++i)
+			if(*i == (MYQUOTE))
+			{
+				while(*++i != MYQUOTE)
+					;
+			}
+			else if(*i == '(')
+				++parlev;
+			else if(*i == ')')
+			{
+				if(--parlev == 0)
+					break;
+			}
+		if(i >= lastch)
+			stkey = SLOGIF;
+		else if(i[1] == '=')
+			stkey = SLET;
+		else if( isdigit(i[1]) )
+			stkey = SARITHIF;
+		else	stkey = SLOGIF;
+		if(stkey != SLET)
+			nextch += 2;
+	}
+	else if(expeql) /* may be an assignment */
+	{
+		if(expcom && nextch<lastch &&
+		    nextch[0]=='d' && nextch[1]=='o')
+		{
+			stkey = SDO;
+			nextch += 2;
+		}
+		else	stkey = SLET;
+	}
+	else if (parseen && nextch + 7 < lastch
+			&& nextch[2] != 'u' /* screen out "double..." early */
+			&& nextch[0] == 'd' && nextch[1] == 'o'
+			&& ((nextch[2] >= '0' && nextch[2] <= '9')
+				|| nextch[2] == ','
+				|| nextch[2] == 'w'))
+		{
+		stkey = SDO;
+		nextch += 2;
+		needwkey = 1;
+		}
+	/* otherwise search for keyword */
+	else	{
+		stkey = getkwd();
+		if(stkey==SGOTO && lastch>=nextch)
+			if(nextch[0]=='(')
+				stkey = SCOMPGOTO;
+			else if(isalpha_(* USC nextch))
+				stkey = SASGOTO;
+	}
+	parlev = 0;
+}
+
+
+
+ LOCAL int
+getkwd(Void)
+{
+	register char *i, *j;
+	register struct Keylist *pk, *pend;
+	int k;
+
+	if(! isalpha_(* USC nextch) )
+		return(SUNKNOWN);
+	k = letter(nextch[0]);
+	if(pk = keystart[k])
+		for(pend = keyend[k] ; pk<=pend ; ++pk )
+		{
+			i = pk->keyname;
+			j = nextch;
+			while(*++i==*++j && *i!='\0')
+				;
+			if(*i=='\0' && j<=lastch+1)
+			{
+				nextch = j;
+				if(no66flag && pk->notinf66)
+					errstr("Not a Fortran 66 keyword: %s",
+					    pk->keyname);
+				return(pk->keyval);
+			}
+		}
+	return(SUNKNOWN);
+}
+
+ void
+initkey(Void)
+{
+	register struct Keylist *p;
+	register int i,j;
+	register char *s;
+
+	for(i = 0 ; i<26 ; ++i)
+		keystart[i] = NULL;
+
+	for(p = keys ; p->keyname ; ++p) {
+		j = letter(p->keyname[0]);
+		if(keystart[j] == NULL)
+			keystart[j] = p;
+		keyend[j] = p;
+		}
+	i = (maxcontin + 2) * 66;
+	sbuf = (char *)ckalloc(i + 70 + MAX_SHARPLINE_LEN);
+	send = sbuf + i;
+	shend = send + MAX_SHARPLINE_LEN;
+	maxcont = maxcontin + 1;
+	linestart = (char **)ckalloc(maxcont*sizeof(char*));
+	comstart['c'] = comstart['C'] = comstart['*'] = comstart['!'] =
+	comstart['#'] = 1;
+#ifdef EOF_CHAR
+	comstart[EOF_CHAR] = 1;
+#endif
+	s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_";
+	while(i = *s++)
+		anum_buf[i] = 1;
+	s = "0123456789";
+	while(i = *s++)
+		anum_buf[i] = 2;
+	}
+
+ LOCAL int
+#ifdef KR_headers
+hexcheck(key)
+	int key;
+#else
+hexcheck(int key)
+#endif
+{
+	register int radix;
+	register char *p;
+	char *kind;
+
+	switch(key) {
+		case 'z':
+		case 'Z':
+		case 'x':
+		case 'X':
+			radix = 16;
+			key = SHEXCON;
+			kind = "hexadecimal";
+			break;
+		case 'o':
+		case 'O':
+			radix = 8;
+			key = SOCTCON;
+			kind = "octal";
+			break;
+		case 'b':
+		case 'B':
+			radix = 2;
+			key = SBITCON;
+			kind = "binary";
+			break;
+		default:
+			err("bad bit identifier");
+			return(SNAME);
+		}
+	for(p = token; *p; p++)
+		if (hextoi(*p) >= radix) {
+			errstr("invalid %s character", kind);
+			break;
+			}
+	return key;
+	}
+
+/* gettok -- moves the right amount of text from   nextch   into the   token
+   buffer.   token   initially contains garbage (leftovers from the prev token) */
+
+ LOCAL int
+gettok(Void)
+{
+	int havdot, havexp, havdbl;
+	int radix, val;
+	struct Punctlist *pp;
+	struct Dotlist *pd;
+	register int ch;
+	static char	Exp_mi[] = "X**-Y treated as X**(-Y)",
+			Exp_pl[] = "X**+Y treated as X**(+Y)";
+
+	char *i, *j, *n1, *p;
+
+	ch = * USC nextch;
+	if(ch == (MYQUOTE))
+	{
+		++nextch;
+		p = token;
+		while(*nextch != MYQUOTE)
+			*p++ = *nextch++;
+		toklen = p - token;
+		*p = 0;
+		/* allow octal, binary, hex constants of the form 'abc'x (etc.) */
+		if (++nextch <= lastch && isalpha_(val = * USC nextch)) {
+			++nextch;
+			return hexcheck(val);
+			}
+		return (SHOLLERITH);
+	}
+
+	if(needkwd)
+	{
+		needkwd = 0;
+		return( getkwd() );
+	}
+
+	for(pp=puncts; pp->punchar; ++pp)
+		if(ch == pp->punchar) {
+			val = pp->punval;
+			if (++nextch <= lastch)
+			    switch(ch) {
+				case '/':
+					switch(*nextch) {
+					  case '/':
+						nextch++;
+						val = SCONCAT;
+						break;
+					  case '=':
+						goto sne;
+					  default:
+						if (new_dcl && parlev == 0)
+							val = SSLASHD;
+					  }
+					return val;
+				case '*':
+					if (*nextch == '*') {
+						nextch++;
+						if (noextflag
+						 && nextch <= lastch)
+						 	switch(*nextch) {
+							  case '-':
+								errext(Exp_mi);
+								break;
+							  case '+':
+								errext(Exp_pl);
+								}
+						return SPOWER;
+						}
+					break;
+				case '<':
+					switch(*nextch) {
+					  case '=':
+						nextch++;
+						val = SLE;
+						break;
+					  case '>':
+ sne:
+						nextch++;
+						val = SNE;
+					  }
+					goto extchk;
+				case '=':
+					if (*nextch == '=') {
+						nextch++;
+						val = SEQ;
+						goto extchk;
+						}
+					break;
+				case '>':
+					if (*nextch == '=') {
+						nextch++;
+						val = SGE;
+						}
+ extchk:
+					NOEXT("Fortran 8x comparison operator");
+					return val;
+				}
+			else if (ch == '/' && new_dcl && parlev == 0)
+				return SSLASHD;
+			switch(val) {
+				case SLPAR:
+					++parlev;
+					break;
+				case SRPAR:
+					--parlev;
+				}
+			return(val);
+			}
+	if(ch == '.')
+		if(nextch >= lastch) goto badchar;
+		else if(isdigit(nextch[1])) goto numconst;
+		else	{
+			for(pd=dots ; (j=pd->dotname) ; ++pd)
+			{
+				for(i=nextch+1 ; i<=lastch ; ++i)
+					if(*i != *j) break;
+					else if(*i != '.') ++j;
+					else	{
+						nextch = i+1;
+						return(pd->dotval);
+					}
+			}
+			goto badchar;
+		}
+	if( isalpha_(ch) )
+	{
+		p = token;
+		*p++ = *nextch++;
+		while(nextch<=lastch)
+			if( isalnum_(* USC nextch) )
+				*p++ = *nextch++;
+			else break;
+		toklen = p - token;
+		*p = 0;
+		if (needwkey) {
+			needwkey = 0;
+			if (toklen == 5
+				&& nextch <= lastch && *nextch == '(' /*)*/
+				&& !strcmp(token,"while"))
+			return(SWHILE);
+			}
+		if(inioctl && nextch<=lastch && *nextch=='=')
+		{
+			++nextch;
+			return(SNAMEEQ);
+		}
+		if(toklen>8 && eqn(8,token,"function")
+		&& isalpha_(* USC (token+8)) &&
+		    nextch<lastch && nextch[0]=='(' &&
+		    (nextch[1]==')' || isalpha_(* USC (nextch+1))) )
+		{
+			nextch -= (toklen - 8);
+			return(SFUNCTION);
+		}
+
+		if(toklen > MAXNAMELEN)
+		{
+			char buff[2*MAXNAMELEN+50];
+			if (toklen >= MAXNAMELEN+10)
+			    sprintf(buff,
+				"name %.*s... too long, truncated to %.*s",
+				MAXNAMELEN+6, token, MAXNAMELEN, token);
+			else
+			    sprintf(buff,
+				"name %s too long, truncated to %.*s",
+				token, MAXNAMELEN, token);
+			err(buff);
+			toklen = MAXNAMELEN;
+			token[MAXNAMELEN] = '\0';
+		}
+		if(toklen==1 && *nextch==MYQUOTE) {
+			val = token[0];
+			++nextch;
+			for(p = token ; *nextch!=MYQUOTE ; )
+				*p++ = *nextch++;
+			++nextch;
+			toklen = p - token;
+			*p = 0;
+			return hexcheck(val);
+		}
+		return(SNAME);
+	}
+
+	if (isdigit(ch)) {
+
+		/* Check for NAG's special hex constant */
+
+		if (nextch[1] == '#' && nextch < lastch
+		||  nextch[2] == '#' && isdigit(nextch[1])
+				     && lastch - nextch >= 2) {
+
+		    radix = atoi (nextch);
+		    if (*++nextch != '#')
+			nextch++;
+		    if (radix != 2 && radix != 8 && radix != 16) {
+		        erri("invalid base %d for constant, defaulting to hex",
+				radix);
+			radix = 16;
+		    } /* if */
+		    if (++nextch > lastch)
+			goto badchar;
+		    for (p = token; hextoi(*nextch) < radix;) {
+			*p++ = *nextch++;
+			if (nextch > lastch)
+				break;
+			}
+		    toklen = p - token;
+		    *p = 0;
+		    return (radix == 16) ? SHEXCON : ((radix == 8) ? SOCTCON :
+			    SBITCON);
+		    }
+		}
+	else
+		goto badchar;
+numconst:
+	havdot = NO;
+	havexp = NO;
+	havdbl = NO;
+	for(n1 = nextch ; nextch<=lastch ; ++nextch)
+	{
+		if(*nextch == '.')
+			if(havdot) break;
+			else if(nextch+2<=lastch && isalpha_(* USC (nextch+1))
+			    && isalpha_(* USC (nextch+2)))
+				break;
+			else	havdot = YES;
+		else if( ! isdigit(* USC nextch) ) {
+			if( !intonly && (*nextch=='d' || *nextch=='e') ) {
+				p = nextch;
+				havexp = YES;
+				if(*nextch == 'd')
+					havdbl = YES;
+				if(nextch<lastch)
+					if(nextch[1]=='+' || nextch[1]=='-')
+						++nextch;
+				if( ! isdigit(*++nextch) ) {
+					nextch = p;
+					havdbl = havexp = NO;
+					break;
+					}
+				for(++nextch ;
+				    nextch<=lastch && isdigit(* USC nextch);
+				    ++nextch);
+				}
+			break;
+			}
+	}
+	p = token;
+	i = n1;
+	while(i < nextch)
+		*p++ = *i++;
+	toklen = p - token;
+	*p = 0;
+	if(havdbl) return(SDCON);
+	if(havdot || havexp) return(SRCON);
+	return(SICON);
+badchar:
+	sbuf[0] = *nextch++;
+	return(SUNKNOWN);
+}
+
+/* Comment buffering code */
+
+ static void
+#ifdef KR_headers
+store_comment(str)
+	char *str;
+#else
+store_comment(char *str)
+#endif
+{
+	int len;
+	comment_buf *ncb;
+
+	if (nextcd == sbuf) {
+		flush_comments();
+		p1_comment(str);
+		return;
+		}
+	len = strlen(str) + 1;
+	if (cbnext + len > cblast) {
+		ncb = 0;
+		if (cbcur) {
+			cbcur->last = cbnext;
+			ncb = cbcur->next;
+			}
+		if (!ncb) {
+			ncb = (comment_buf *) Alloc(sizeof(comment_buf));
+			if (cbcur)
+				cbcur->next = ncb;
+			else {
+				cbfirst = ncb;
+				cbinit = ncb->buf;
+				}
+			ncb->next = 0;
+			}
+		cbcur = ncb;
+		cbnext = ncb->buf;
+		cblast = cbnext + COMMENT_BUF_STORE;
+		}
+	strcpy(cbnext, str);
+	cbnext += len;
+	}
+
+ static void
+flush_comments(Void)
+{
+	register char *s, *s1;
+	register comment_buf *cb;
+	if (cbnext == cbinit)
+		return;
+	cbcur->last = cbnext;
+	for(cb = cbfirst;; cb = cb->next) {
+		for(s = cb->buf; s < cb->last; s = s1) {
+			/* compute s1 = new s value first, since */
+			/* p1_comment may insert nulls into s */
+			s1 = s + strlen(s) + 1;
+			p1_comment(s);
+			}
+		if (cb == cbcur)
+			break;
+		}
+	cbcur = cbfirst;
+	cbnext = cbinit;
+	cblast = cbnext + COMMENT_BUF_STORE;
+	}
+
+ void
+unclassifiable(Void)
+{
+	register char *s, *se;
+
+	s = sbuf;
+	se = lastch;
+	if (se < sbuf)
+		return;
+	lastch = s - 1;
+	if (++se - s > 10)
+		se = s + 10;
+	for(; s < se; s++)
+		if (*s == MYQUOTE) {
+			se = s;
+			break;
+			}
+	*se = 0;
+	errstr("unclassifiable statement (starts \"%s\")", sbuf);
+	}
+
+ void
+endcheck(Void)
+{
+	if (nextch <= lastch)
+		warn("ignoring text after \"end\".");
+	lexstate = RETEOS;
+	}
diff --git a/contrib/tools/f2c/src/machdefs.h b/contrib/tools/f2c/src/machdefs.h
new file mode 100644
index 0000000000..3ab8961f0a
--- /dev/null
+++ b/contrib/tools/f2c/src/machdefs.h
@@ -0,0 +1,31 @@
+#define TYLENG	TYLONG		/* char string length field */
+
+#define TYINT	TYLONG
+#define SZADDR	4
+#define SZSHORT	2
+#define SZINT	4
+
+#define SZLONG	4
+#define SZLENG	SZLONG
+
+#define SZDREAL 8
+
+/* Alignment restrictions */
+
+#define ALIADDR SZADDR
+#define ALISHORT SZSHORT
+#define ALILONG 4
+#define ALIDOUBLE 8
+#define ALIINT	ALILONG
+#define ALILENG	ALILONG
+
+#define BLANKCOMMON "_BLNK__"		/* Name for the unnamed
+					   common block; this is unique
+					   because of underscores */
+
+#define LABELFMT "%s:\n"
+
+#define MAXREGVAR 4
+#define TYIREG TYLONG
+#define MSKIREG  (M(TYSHORT)|M(TYLONG))	/* allowed types of DO indicies
+					   which can be put in registers */
diff --git a/contrib/tools/f2c/src/main.c b/contrib/tools/f2c/src/main.c
new file mode 100644
index 0000000000..977113dc30
--- /dev/null
+++ b/contrib/tools/f2c/src/main.c
@@ -0,0 +1,792 @@
+/****************************************************************
+Copyright 1990-1996, 2000-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+extern char F2C_version[];
+
+#include "defs.h"
+#include "parse.h"
+
+int complex_seen, dcomplex_seen;
+
+LOCAL int Max_ftn_files;
+
+int badargs;
+char **ftn_files;
+int current_ftn_file = 0;
+
+flag ftn66flag = NO;
+flag nowarnflag = NO;
+flag noextflag = NO;
+flag  no66flag = NO;		/* Must also set noextflag to this
+					   same value */
+flag zflag = YES;		/* recognize double complex intrinsics */
+flag debugflag = NO;
+flag onetripflag = NO;
+flag shiftcase = YES;
+flag undeftype = NO;
+flag checksubs = NO;
+flag r8flag = NO;
+flag use_bs = YES;
+flag keepsubs = NO;
+flag byterev = NO;
+int intr_omit;
+static int no_cd, no_i90;
+#ifdef TYQUAD
+flag use_tyquad = YES;
+#ifndef NO_LONG_LONG
+flag allow_i8c = YES;
+#endif
+#endif
+int tyreal = TYREAL;
+int tycomplex = TYCOMPLEX;
+
+int maxregvar = MAXREGVAR;	/* if maxregvar > MAXREGVAR, error */
+int maxequiv = MAXEQUIV;
+int maxext = MAXEXT;
+int maxstno = MAXSTNO;
+int maxctl = MAXCTL;
+int maxhash = MAXHASH;
+int maxliterals = MAXLITERALS;
+int maxcontin = MAXCONTIN;
+int maxlablist = MAXLABLIST;
+int extcomm, ext1comm, useauto;
+int can_include = YES;	/* so we can disable includes for netlib */
+
+static char *def_i2 = "";
+
+static int useshortints = NO;	/* YES => tyint = TYSHORT */
+static int uselongints = NO;	/* YES => tyint = TYLONG */
+int addftnsrc = NO;		/* Include ftn source in output */
+int usedefsforcommon = NO;	/* Use #defines for common reference */
+int forcedouble = YES;		/* force real functions to double */
+int dneg = NO;			/* f77 treatment of unary minus */
+int Ansi = YES;
+int def_equivs = YES;
+int tyioint = TYLONG;
+int szleng = SZLENG;
+int inqmask = M(TYLONG)|M(TYLOGICAL);
+int wordalign = NO;
+int forcereal = NO;
+int warn72 = NO;
+static int help, showver, skipC, skipversion;
+char *file_name, *filename0, *parens;
+int Castargs = 1;
+static int Castargs1;
+static int typedefs = 0;
+int chars_per_wd, gflag, protostatus;
+int infertypes = 1;
+char used_rets[TYSUBR+1];
+extern char *tmpdir;
+static int h0align = 0;
+char *halign, *ohalign;
+int krparens = NO;
+int hsize;	/* for padding under -h */
+int htype;	/* for wr_equiv_init under -h */
+int trapuv;
+chainp Iargs;
+
+#define f2c_entry(swit,count,type,store,size) \
+	p_entry ("-", swit, 0, count, type, store, size)
+
+static arg_info table[] = {
+    f2c_entry ("w66", P_NO_ARGS, P_INT, &ftn66flag, YES),
+    f2c_entry ("w", P_NO_ARGS, P_INT, &nowarnflag, YES),
+    f2c_entry ("66", P_NO_ARGS, P_INT, &no66flag, YES),
+    f2c_entry ("1", P_NO_ARGS, P_INT, &onetripflag, YES),
+    f2c_entry ("onetrip", P_NO_ARGS, P_INT, &onetripflag, YES),
+    f2c_entry ("I2", P_NO_ARGS, P_INT, &useshortints, YES),
+    f2c_entry ("I4", P_NO_ARGS, P_INT, &uselongints, YES),
+    f2c_entry ("U", P_NO_ARGS, P_INT, &shiftcase, NO),
+    f2c_entry ("u", P_NO_ARGS, P_INT, &undeftype, YES),
+    f2c_entry ("O", P_ONE_ARG, P_INT, &maxregvar, 0),
+    f2c_entry ("C", P_NO_ARGS, P_INT, &checksubs, YES),
+    f2c_entry ("Nq", P_ONE_ARG, P_INT, &maxequiv, 0),
+    f2c_entry ("Nx", P_ONE_ARG, P_INT, &maxext, 0),
+    f2c_entry ("Ns", P_ONE_ARG, P_INT, &maxstno, 0),
+    f2c_entry ("Nc", P_ONE_ARG, P_INT, &maxctl, 0),
+    f2c_entry ("Nn", P_ONE_ARG, P_INT, &maxhash, 0),
+    f2c_entry ("NL", P_ONE_ARG, P_INT, &maxliterals, 0),
+    f2c_entry ("NC", P_ONE_ARG, P_INT, &maxcontin, 0),
+    f2c_entry ("Nl", P_ONE_ARG, P_INT, &maxlablist, 0),
+    f2c_entry ("c", P_NO_ARGS, P_INT, &addftnsrc, YES),
+    f2c_entry ("p", P_NO_ARGS, P_INT, &usedefsforcommon, YES),
+    f2c_entry ("R", P_NO_ARGS, P_INT, &forcedouble, NO),
+    f2c_entry ("!R", P_NO_ARGS, P_INT, &forcedouble, YES),
+    f2c_entry ("A", P_NO_ARGS, P_INT, &Ansi, YES),
+    f2c_entry ("K", P_NO_ARGS, P_INT, &Ansi, NO),
+    f2c_entry ("ext", P_NO_ARGS, P_INT, &noextflag, YES),
+    f2c_entry ("z", P_NO_ARGS, P_INT, &zflag, NO),
+    f2c_entry ("a", P_NO_ARGS, P_INT, &useauto, YES),
+    f2c_entry ("r8", P_NO_ARGS, P_INT, &r8flag, YES),
+    f2c_entry ("i2", P_NO_ARGS, P_INT, &tyioint, NO),
+    f2c_entry ("w8", P_NO_ARGS, P_INT, &wordalign, YES),
+    f2c_entry ("!I", P_NO_ARGS, P_INT, &can_include, NO),
+    f2c_entry ("W", P_ONE_ARG, P_INT, &chars_per_wd, 0),
+    f2c_entry ("g", P_NO_ARGS, P_INT, &gflag, YES),
+    f2c_entry ("T", P_ONE_ARG, P_STRING, &tmpdir, 0),
+    f2c_entry ("E", P_NO_ARGS, P_INT, &extcomm, 1),
+    f2c_entry ("e1c", P_NO_ARGS, P_INT, &ext1comm, 1),
+    f2c_entry ("ec", P_NO_ARGS, P_INT, &ext1comm, 2),
+    f2c_entry ("C++", P_NO_ARGS, P_INT, &Ansi, 2),
+    f2c_entry ("P", P_NO_ARGS, P_INT, &Castargs, 3),
+    f2c_entry ("Ps", P_NO_ARGS, P_INT, &protostatus, 1),
+    f2c_entry ("!P", P_NO_ARGS, P_INT, &Castargs, 0),
+    f2c_entry ("!c", P_NO_ARGS, P_INT, &skipC, 1),
+    f2c_entry ("!it", P_NO_ARGS, P_INT, &infertypes, 0),
+    f2c_entry ("h", P_NO_ARGS, P_INT, &h0align, 1),
+    f2c_entry ("hd", P_NO_ARGS, P_INT, &h0align, 2),
+    f2c_entry ("kr", P_NO_ARGS, P_INT, &krparens, 1),
+    f2c_entry ("krd", P_NO_ARGS, P_INT, &krparens, 2),
+    f2c_entry ("!bs", P_NO_ARGS, P_INT, &use_bs, NO),
+    f2c_entry ("r", P_NO_ARGS, P_INT, &forcereal, YES),
+    f2c_entry ("72", P_NO_ARGS, P_INT, &warn72, 1),
+    f2c_entry ("f", P_NO_ARGS, P_INT, &warn72, 2),
+    f2c_entry ("s", P_NO_ARGS, P_INT, &keepsubs, 1),
+    f2c_entry ("d", P_ONE_ARG, P_STRING, &outbuf, 0),
+    f2c_entry ("cd", P_NO_ARGS, P_INT, &no_cd, 1),
+    f2c_entry ("i90", P_NO_ARGS, P_INT, &no_i90, 2),
+    f2c_entry ("trapuv", P_NO_ARGS, P_INT, &trapuv, 1),
+#ifdef TYQUAD
+#ifndef NO_LONG_LONG
+    f2c_entry ("!i8const", P_NO_ARGS, P_INT, &allow_i8c, NO),
+#endif
+    f2c_entry ("!i8", P_NO_ARGS, P_INT, &use_tyquad, NO),
+#endif
+
+	/* options omitted from man pages */
+
+	/* -b ==> for unformatted I/O, call do_unio (for noncharacter  */
+	/* data of length > 1 byte) and do_ucio (for the rest) rather  */
+	/* than do_uio.  This permits modifying libI77 to byte-reverse */
+	/* numeric data. */
+
+    f2c_entry ("b", P_NO_ARGS, P_INT, &byterev, YES),
+
+	/* -ev ==> implement equivalence with initialized pointers */
+    f2c_entry ("ev", P_NO_ARGS, P_INT, &def_equivs, NO),
+
+	/* -!it used to be the default when -it was more agressive */
+
+    f2c_entry ("it", P_NO_ARGS, P_INT, &infertypes, 1),
+
+	/* -Pd is similar to -P, but omits :ref: lines */
+    f2c_entry ("Pd", P_NO_ARGS, P_INT, &Castargs, 2),
+
+	/* -t ==> emit typedefs (under -A or -C++) for procedure
+		argument types used.  This is meant for netlib's
+		f2c service, so -A and -C++ will work with older
+		versions of f2c.h
+		*/
+    f2c_entry ("t", P_NO_ARGS, P_INT, &typedefs, 1),
+
+	/* -!V ==> omit version msg (to facilitate using diff in
+		regression testing)
+		*/
+    f2c_entry ("!V", P_NO_ARGS, P_INT, &skipversion, 1),
+
+	/* -Dnnn = debug level nnn */
+
+    f2c_entry ("D", P_ONE_ARG, P_INT, &debugflag, YES),
+
+	/* -dneg ==> under (default) -!R, imitate f77's bizarre	*/
+	/* treatment of unary minus of REAL expressions by	*/
+	/* promoting them to DOUBLE PRECISION . */
+
+    f2c_entry ("dneg", P_NO_ARGS, P_INT, &dneg, YES),
+
+	/* -?, --help, -v, --version */
+
+    f2c_entry ("?", P_NO_ARGS, P_INT, &help, YES),
+    f2c_entry ("-help", P_NO_ARGS, P_INT, &help, YES),
+
+    f2c_entry ("v", P_NO_ARGS, P_INT, &showver, YES),
+    f2c_entry ("-version", P_NO_ARGS, P_INT, &showver, YES)
+
+}; /* table */
+
+extern char *c_functions;	/* "c_functions"	*/
+extern char *coutput;		/* "c_output"		*/
+extern char *initfname;		/* "raw_data"		*/
+extern char *blkdfname;		/* "block_data"		*/
+extern char *p1_file;		/* "p1_file"		*/
+extern char *p1_bakfile;	/* "p1_file.BAK"	*/
+extern char *sortfname;		/* "init_file"		*/
+extern char *proto_fname;	/* "proto_file"		*/
+FILE *protofile;
+
+ void
+set_externs(Void)
+{
+    static char *hset[3] = { 0, "integer", "doublereal" };
+
+/* Adjust the global flags according to the command line parameters */
+
+    if (chars_per_wd > 0) {
+	typesize[TYADDR] = typesize[TYLONG] = typesize[TYREAL] =
+		typesize[TYLOGICAL] = chars_per_wd;
+	typesize[TYINT1] = typesize[TYLOGICAL1] = 1;
+	typesize[TYDREAL] = typesize[TYCOMPLEX] = chars_per_wd << 1;
+	typesize[TYDCOMPLEX] = chars_per_wd << 2;
+	typesize[TYSHORT] = typesize[TYLOGICAL2] = chars_per_wd >> 1;
+	typesize[TYCILIST] = 5*chars_per_wd;
+	typesize[TYICILIST] = 6*chars_per_wd;
+	typesize[TYOLIST] = 9*chars_per_wd;
+	typesize[TYCLLIST] = 3*chars_per_wd;
+	typesize[TYALIST] = 2*chars_per_wd;
+	typesize[TYINLIST] = 26*chars_per_wd;
+	}
+
+    if (wordalign)
+	typealign[TYDREAL] = typealign[TYDCOMPLEX] = typealign[TYREAL];
+    if (!tyioint) {
+	tyioint = TYSHORT;
+	szleng = typesize[TYSHORT];
+	def_i2 = "#define f2c_i2 1\n";
+	inqmask = M(TYSHORT)|M(TYLOGICAL2);
+	goto checklong;
+	}
+    else
+	szleng = typesize[TYLONG];
+    if (useshortints) {
+	/* inqmask = M(TYLONG); */
+	/* used to disallow LOGICAL in INQUIRE under -I2 */
+ checklong:
+	protorettypes[TYLOGICAL] = "shortlogical";
+	casttypes[TYLOGICAL] = "K_fp";
+	if (uselongints)
+		err ("Can't use both long and short ints");
+	else {
+		tyint = tylogical = TYSHORT;
+		tylog = TYLOGICAL2;
+		}
+	}
+    else if (uselongints)
+	tyint = TYLONG;
+
+    if (h0align) {
+	if (tyint == TYLONG && wordalign)
+		h0align = 1;
+    	ohalign = halign = hset[h0align];
+	htype = h0align == 1 ? tyint : TYDREAL;
+	hsize = typesize[htype];
+	}
+
+    if (no66flag)
+	noextflag = no66flag;
+    if (noextflag)
+	zflag = 0;
+
+    if (r8flag) {
+	tyreal = TYDREAL;
+	tycomplex = TYDCOMPLEX;
+	r8fix();
+	}
+    if (forcedouble) {
+	protorettypes[TYREAL] = "E_f";
+	casttypes[TYREAL] = "E_fp";
+	}
+    else
+	dneg = 0;
+
+#ifndef NO_LONG_LONG
+    if (!use_tyquad)
+	allow_i8c = 0;
+#endif
+
+    if (maxregvar > MAXREGVAR) {
+	warni("-O%d: too many register variables", maxregvar);
+	maxregvar = MAXREGVAR;
+    } /* if maxregvar > MAXREGVAR */
+
+/* Check the list of input files */
+
+    {
+	int bad, i, cur_max = Max_ftn_files;
+
+	for (i = bad = 0; i < cur_max && ftn_files[i]; i++)
+	    if (ftn_files[i][0] == '-') {
+		errstr ("Invalid flag '%s'", ftn_files[i]);
+		bad++;
+		}
+	if (bad)
+		exit(1);
+
+    } /* block */
+} /* set_externs */
+
+
+ static int
+comm2dcl(Void)
+{
+	Extsym *ext;
+	if (ext1comm)
+		for(ext = extsymtab; ext < nextext; ext++)
+			if (ext->extstg == STGCOMMON && !ext->extinit)
+				return ext1comm;
+	return 0;
+	}
+
+ static void
+#ifdef KR_headers
+write_typedefs(outfile)
+	FILE *outfile;
+#else
+write_typedefs(FILE *outfile)
+#endif
+{
+	register int i;
+	register char *s, *p = 0;
+	static char st[4] = { TYREAL, TYCOMPLEX, TYDCOMPLEX, TYCHAR };
+	static char stl[4] = { 'E', 'C', 'Z', 'H' };
+
+	for(i = 0; i <= TYSUBR; i++)
+		if (s = usedcasts[i]) {
+			if (!p) {
+				p = (char*)(Ansi == 1 ? "()" : "(...)");
+				nice_printf(outfile,
+				"/* Types for casting procedure arguments: */\
+\n\n#ifndef F2C_proc_par_types\n");
+				if (i == 0) {
+					nice_printf(outfile,
+			"typedef int /* Unknown procedure type */ (*%s)%s;\n",
+						 s, p);
+					continue;
+					}
+				}
+			nice_printf(outfile, "typedef %s (*%s)%s;\n",
+					c_type_decl(i,1), s, p);
+			}
+	for(i = !forcedouble; i < 4; i++)
+		if (used_rets[st[i]])
+			nice_printf(outfile,
+				"typedef %s %c_f; /* %s function */\n",
+				p = (char*)(i ? "VOID" : "doublereal"),
+				stl[i], ftn_types[st[i]]);
+	if (p)
+		nice_printf(outfile, "#endif\n\n");
+	}
+
+ static void
+#ifdef KR_headers
+commonprotos(outfile)
+	register FILE *outfile;
+#else
+commonprotos(register FILE *outfile)
+#endif
+{
+	register Extsym *e, *ee;
+	register Argtypes *at;
+	Atype *a, *ae;
+	int k;
+	extern int proc_protochanges;
+
+	if (!outfile)
+		return;
+	for (e = extsymtab, ee = nextext; e < ee; e++)
+		if (e->extstg == STGCOMMON && e->allextp)
+			nice_printf(outfile, "/* comlen %s %ld */\n",
+				e->cextname, e->maxleng);
+	if (Castargs1 < 3)
+		return;
+
+	/* -Pr: special comments conveying current knowledge
+	    of external references */
+
+	k = proc_protochanges;
+	for (e = extsymtab, ee = nextext; e < ee; e++)
+		if (e->extstg == STGEXT
+		&& e->cextname != e->fextname)	/* not a library function */
+		    if (at = e->arginfo) {
+			if ((!e->extinit || at->changes & 1)
+				/* not defined here or
+					changed since definition */
+			&& at->nargs >= 0) {
+				nice_printf(outfile, "/*:ref: %s %d %d",
+					e->cextname, e->extype, at->nargs);
+				a = at->atypes;
+				for(ae = a + at->nargs; a < ae; a++)
+					nice_printf(outfile, " %d", a->type);
+				nice_printf(outfile, " */\n");
+				if (at->changes & 1)
+					k++;
+				}
+			}
+		    else if (e->extype)
+			/* typed external, never invoked */
+			nice_printf(outfile, "/*:ref: %s %d :*/\n",
+				e->cextname, e->extype);
+	if (k) {
+		nice_printf(outfile,
+	"/* Rerunning f2c -P may change prototypes or declarations. */\n");
+		if (nerr)
+			return;
+		if (protostatus)
+			done(4);
+		if (protofile != stdout) {
+			fprintf(diagfile,
+	"Rerunning \"f2c -P ... %s %s\" may change prototypes or declarations.\n",
+				filename0, proto_fname);
+			fflush(diagfile);
+			}
+		}
+	}
+
+ static int
+#ifdef KR_headers
+I_args(argc, a)
+	int argc;
+	char **a;
+#else
+I_args(int argc, char **a)
+#endif
+{
+	char **a0, **a1, **ae, *s;
+
+	ae = a + argc;
+	a0 = a;
+	for(a1 = ++a; a < ae; a++) {
+		if (!(s = *a))
+			break;
+		if (*s == '-' && s[1] == 'I' && s[2]
+		  && (s[3] || s[2] != '2' && s[2] != '4'))
+			Iargs = mkchain(s+2, Iargs);
+		else
+			*a1++ = s;
+		}
+	Iargs = revchain(Iargs);
+	*a1 = 0;
+	return a1 - a0;
+	}
+
+ static void
+omit_non_f(Void)
+{
+	/* complain about ftn_files that do not end in .f or .F */
+
+	char *s, *s1;
+	int i, k;
+
+	for(i = k = 0; s = ftn_files[k]; k++) {
+		s1 = s + strlen(s);
+		if (s1 - s >= 3) {
+			s1 -= 2;
+			if (*s1 == '.') switch(s1[1]) {
+			  case 'f':
+			  case 'F':
+				ftn_files[i++] = s;
+				continue;
+			  }
+			}
+		fprintf(diagfile, "\"%s\" does not end in .f or .F\n", s);
+		}
+	if (i != k) {
+		fflush(diagfile);
+		if (!i)
+			exit(1);
+		ftn_files[i] = 0;
+		}
+	}
+
+ static void
+show_version(Void)
+{
+	printf("f2c (Fortran to C Translator) version %s.\n", F2C_version);
+	}
+
+ static void
+#ifdef KR_headers
+show_help(progname) char *progname;
+#else
+show_help(char *progname)
+#endif
+{
+	show_version();
+	if (!progname)
+		progname = "f2c";
+	printf("Usage: %s [ option ... ] [file ...]\n%s%s%s%s%s%s%s",
+	progname,
+	"For usage details, see the man page, f2c.1.\n",
+	"For technical details, see the f2c report.\n",
+	"Both are available from netlib, e.g.,\n",
+	"\thttps://www.netlib.org/f2c/f2c.1\n",
+	"\thttps://www.netlib.org/f2c/f2c.pdf\nor\n",
+	"\thttps://ampl.com/netlib/f2c/f2c.1\n",
+	"\thttps://ampl.com/netlib/f2c/f2c.pdf\n");
+	}
+
+ int retcode = 0;
+
+ int
+#ifdef KR_headers
+main(argc, argv)
+	int argc;
+	char **argv;
+#else
+main(int argc, char **argv)
+#endif
+{
+	int c2d, k;
+	FILE *c_output;
+	char *cdfilename;
+	static char stderrbuf[BUFSIZ];
+	extern char **dfltproc, *dflt1proc[];
+	extern char link_msg[];
+
+	diagfile = stderr;
+	setbuf(stderr, stderrbuf);	/* arrange for fast error msgs */
+
+	argkludge(&argc, &argv);		/* for _WIN32 */
+	argc = I_args(argc, argv);	/* extract -I args */
+	Max_ftn_files = argc - 1;
+	ftn_files = (char **)ckalloc((argc+1)*sizeof(char *));
+
+	parse_args (argc, argv, table, sizeof(table)/sizeof(arg_info),
+		ftn_files, Max_ftn_files);
+	if (badargs)
+		return 1;
+	if (help) {
+		show_help(argv[0]);
+		return 0;
+		}
+	if (showver && !ftn_files[0]) {
+		show_version();
+		return 0;
+		}
+	intr_omit = no_cd | no_i90;
+	if (keepsubs && checksubs) {
+		warn("-C suppresses -s\n");
+		keepsubs = 0;
+		}
+	if (!can_include && ext1comm == 2)
+		ext1comm = 1;
+	if (ext1comm && !extcomm)
+		extcomm = 2;
+	if (protostatus)
+		Castargs = 3;
+	Castargs1 = Castargs;
+	if (!Ansi) {
+		Castargs = 0;
+		parens = "()";
+		}
+	else if (!Castargs)
+		parens = (char*)(Ansi == 1 ? "()" : "(...)");
+	else
+		dfltproc = dflt1proc;
+
+	outbuf_adjust();
+	set_externs();
+	fileinit();
+	read_Pfiles(ftn_files);
+	omit_non_f();
+
+	for(k = 0; ftn_files[k+1]; k++)
+		if (dofork(ftn_files[k]))
+			break;
+	filename0 = file_name = ftn_files[current_ftn_file = k];
+
+	set_tmp_names();
+	sigcatch(0);
+
+	c_file   = opf(c_functions, textwrite);
+	pass1_file=opf(p1_file, binwrite);
+	initkey();
+	if (file_name && *file_name) {
+		cdfilename = coutput;
+		if (debugflag != 1) {
+			coutput = c_name(file_name,'c');
+			cdfilename = copys(outbtail);
+			if (Castargs1 >= 2)
+				proto_fname = c_name(file_name,'P');
+			}
+		if (skipC)
+			coutput = 0;
+		else if (!(c_output = fopen(coutput, textwrite))) {
+			file_name = coutput;
+			coutput = 0;	/* don't delete read-only .c file */
+			fatalstr("can't open %.86s", file_name);
+			}
+
+		if (Castargs1 >= 2
+		&& !(protofile = fopen(proto_fname, textwrite)))
+			fatalstr("Can't open %.84s\n", proto_fname);
+		}
+	else {
+		file_name = "";
+		cdfilename = "f2c_out.c";
+		c_output = stdout;
+		coutput = 0;
+		if (Castargs1 >= 2) {
+			protofile = stdout;
+			if (!skipC)
+				printf("#ifdef P_R_O_T_O_T_Y_P_E_S\n");
+			}
+		}
+
+	if(inilex( copys(file_name) ))
+		done(1);
+	if (filename0) {
+		fprintf(diagfile, "%s:\n", file_name);
+		fflush(diagfile);
+		}
+
+	procinit();
+	if(k = yyparse())
+	{
+		fprintf(diagfile, "Bad parse, return code %d\n", k);
+		done(1);
+	}
+
+	commonprotos(protofile);
+	if (protofile == stdout && !skipC)
+		printf("#endif\n\n");
+
+	if (nerr || skipC)
+		goto C_skipped;
+
+
+/* Write out the declarations which are global to this file */
+
+	if ((c2d = comm2dcl()) == 1)
+		nice_printf(c_output, "/*>>>'/dev/null'<<<*/\n\n\
+/* Split this into several files by piping it through\n\n\
+sed \"s/^\\/\\*>>>'\\(.*\\)'<<<\\*\\/\\$/cat >'\\1' <<'\\/*<<<\\1>>>*\\/'/\" | /bin/sh\n\
+ */\n\
+/*<<</dev/null>>>*/\n\
+/*>>>'%s'<<<*/\n", cdfilename);
+	if (gflag)
+		nice_printf (c_output, "#line 1 \"%s\"\n", file_name);
+	if (!skipversion) {
+		nice_printf (c_output, "/* %s -- translated by f2c ", file_name);
+		nice_printf (c_output, "(version %s).\n", F2C_version);
+		nice_printf (c_output,
+	"   You must link the resulting object file with libf2c:\n\
+	%s\n*/\n\n", link_msg);
+		}
+	if (Ansi == 2)
+		nice_printf(c_output,
+			"#ifdef __cplusplus\nextern \"C\" {\n#endif\n");
+	nice_printf (c_output, "%s#include \"f2c.h\"\n\n", def_i2);
+	if (trapuv)
+		nice_printf(c_output, "extern void _uninit_f2c(%s);\n%s\n\n",
+			Ansi ? "void*,int,long" : "", "extern double _0;");
+	if (gflag)
+		nice_printf (c_output, "#line 1 \"%s\"\n", file_name);
+	if (Castargs && typedefs)
+		write_typedefs(c_output);
+	nice_printf (c_file, "\n");
+	fclose (c_file);
+	c_file = c_output;		/* HACK to get the next indenting
+					   to work */
+	wr_common_decls (c_output);
+	if (blkdfile)
+		list_init_data(&blkdfile, blkdfname, c_output);
+	wr_globals (c_output);
+	if ((c_file = fopen (c_functions, textread)) == (FILE *) NULL)
+	    Fatal("main - couldn't reopen c_functions");
+	ffilecopy (c_file, c_output);
+	if (*main_alias) {
+	    nice_printf (c_output, "/* Main program alias */ ");
+	    nice_printf (c_output, "int %s () { MAIN__ ();%s }\n",
+		    main_alias, Ansi ? " return 0;" : "");
+	    }
+	if (Ansi == 2)
+		nice_printf(c_output,
+			"#ifdef __cplusplus\n\t}\n#endif\n");
+	if (c2d) {
+		if (c2d == 1)
+			fprintf(c_output, "/*<<<%s>>>*/\n", cdfilename);
+		else
+			fclose(c_output);
+		def_commons(c_output);
+		}
+	if (c2d != 2)
+		fclose (c_output);
+
+ C_skipped:
+	if(parstate != OUTSIDE)
+		{
+		warn("missing final end statement");
+		endproc();
+		nerr = 1;
+		}
+	done(nerr ? 1 : 0);
+	/* NOT REACHED */ return 0;
+}
+
+
+ FILEP
+#ifdef KR_headers
+opf(fn, mode)
+	char *fn;
+	char *mode;
+#else
+opf(char *fn, char *mode)
+#endif
+{
+	FILEP fp;
+	if( fp = fopen(fn, mode) )
+		return(fp);
+
+	fatalstr("cannot open intermediate file %s", fn);
+	/* NOT REACHED */ return 0;
+}
+
+
+ void
+#ifdef KR_headers
+clf(p, what, quit)
+	FILEP *p;
+	char *what;
+	int quit;
+#else
+clf(FILEP *p, char *what, int quit)
+#endif
+{
+	if(p!=NULL && *p!=NULL && *p!=stdout)
+	{
+		if(ferror(*p)) {
+			fprintf(stderr, "I/O error on %s\n", what);
+			if (quit)
+				done(3);
+			retcode = 3;
+			}
+		fclose(*p);
+	}
+	*p = NULL;
+}
+
+
+ void
+#ifdef KR_headers
+done(k)
+	int k;
+#else
+done(int k)
+#endif
+{
+	clf(&initfile, "initfile", 0);
+	clf(&c_file, "c_file", 0);
+	clf(&pass1_file, "pass1_file", 0);
+	Un_link_all(k);
+	exit(k|retcode);
+}
diff --git a/contrib/tools/f2c/src/mem.c b/contrib/tools/f2c/src/mem.c
new file mode 100644
index 0000000000..2f0aed327c
--- /dev/null
+++ b/contrib/tools/f2c/src/mem.c
@@ -0,0 +1,272 @@
+/****************************************************************
+Copyright 1990, 1991, 1994, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "iob.h"
+
+#define MEMBSIZE	32000
+#define GMEMBSIZE	16000
+
+#ifdef _WIN32
+#undef MSDOS
+#endif
+
+ char *
+#ifdef KR_headers
+gmem(n, round)
+	int n;
+	int round;
+#else
+gmem(int n, int round)
+#endif
+{
+	static char *last, *next;
+	char *rv;
+	if (round)
+#ifdef CRAY
+		if ((long)next & 0xe000000000000000)
+			next = (char *)(((long)next & 0x1fffffffffffffff) + 1);
+#else
+#ifdef MSDOS
+		if ((int)next & 1)
+			next++;
+#else
+		next = (char *)(((long)next + sizeof(char *)-1)
+				& ~((long)sizeof(char *)-1));
+#endif
+#endif
+	rv = next;
+	if ((next += n) > last) {
+		rv = Alloc(n + GMEMBSIZE);
+
+		next = rv + n;
+		last = next + GMEMBSIZE;
+		}
+	return rv;
+	}
+
+ struct memblock {
+	struct memblock *next;
+	char buf[MEMBSIZE];
+	};
+ typedef struct memblock memblock;
+
+ static memblock *mem0;
+ memblock *curmemblock, *firstmemblock;
+
+ char *mem_first, *mem_next, *mem_last, *mem0_last;
+
+ void
+mem_init(Void)
+{
+	curmemblock = firstmemblock = mem0
+		= (memblock *)Alloc(sizeof(memblock));
+	mem_first = mem0->buf;
+	mem_next  = mem0->buf;
+	mem_last  = mem0->buf + MEMBSIZE;
+	mem0_last = mem0->buf + MEMBSIZE;
+	mem0->next = 0;
+	}
+
+ char *
+#ifdef KR_headers
+mem(n, round)
+	int n;
+	int round;
+#else
+mem(int n, int round)
+#endif
+{
+	memblock *b;
+	register char *rv, *s;
+
+	if (round)
+#ifdef CRAY
+		if ((long)mem_next & 0xe000000000000000)
+			mem_next = (char *)(((long)mem_next & 0x1fffffffffffffff) + 1);
+#else
+#ifdef MSDOS
+		if ((int)mem_next & 1)
+			mem_next++;
+#else
+		mem_next = (char *)(((long)mem_next + sizeof(char *)-1)
+				& ~((long)sizeof(char *)-1));
+#endif
+#endif
+	rv = mem_next;
+	s = rv + n;
+	if (s >= mem_last) {
+		if (n > MEMBSIZE)  {
+			fprintf(stderr, "mem(%d) failure!\n", n);
+			exit(1);
+			}
+		if (!(b = curmemblock->next)) {
+			b = (memblock *)Alloc(sizeof(memblock));
+			curmemblock->next = b;
+			b->next = 0;
+			}
+		curmemblock = b;
+		rv = b->buf;
+		mem_last = rv + sizeof(b->buf);
+		s = rv + n;
+		}
+	mem_next = s;
+	return rv;
+	}
+
+ char *
+#ifdef KR_headers
+tostring(s, n)
+	register char *s;
+	int n;
+#else
+tostring(register char *s, int n)
+#endif
+{
+	register char *s1, *se, **sf;
+	char *rv, *s0;
+	register int k = n + 2, t;
+
+	sf = str_fmt;
+	sf['%'] = "%";
+	s0 = s;
+	se = s + n;
+	for(; s < se; s++) {
+		t = *(unsigned char *)s;
+		s1 = sf[t];
+		while(*++s1)
+			k++;
+		}
+	sf['%'] = "%%";
+	rv = s1 = mem(k,0);
+	*s1++ = '"';
+	for(s = s0; s < se; s++) {
+		t = *(unsigned char *)s;
+		sprintf(s1, sf[t], t);
+		s1 += strlen(s1);
+		}
+	*s1 = 0;
+	return rv;
+	}
+
+ char *
+#ifdef KR_headers
+cpstring(s)
+	register char *s;
+#else
+cpstring(register char *s)
+#endif
+{
+	return strcpy(mem(strlen(s)+1,0), s);
+	}
+
+ void
+#ifdef KR_headers
+new_iob_data(ios, name)
+	register io_setup *ios;
+	char *name;
+#else
+new_iob_data(register io_setup *ios, char *name)
+#endif
+{
+	register iob_data *iod;
+	register char **s, **se;
+
+	iod = (iob_data *)
+		mem(sizeof(iob_data) + ios->nelt*sizeof(char *), 1);
+	iod->next = iob_list;
+	iob_list = iod;
+	iod->type = ios->fields[0];
+	iod->name = cpstring(name);
+	s = iod->fields;
+	se = s + ios->nelt;
+	while(s < se)
+		*s++ = "0";
+	*s = 0;
+	}
+
+ char *
+#ifdef KR_headers
+string_num(pfx, n)
+	char *pfx;
+	long n;
+#else
+string_num(char *pfx, long n)
+#endif
+{
+	char buf[32];
+	sprintf(buf, "%s%ld", pfx, n);
+	/* can't trust return type of sprintf -- BSD gets it wrong */
+	return strcpy(mem(strlen(buf)+1,0), buf);
+	}
+
+static defines *define_list;
+
+ void
+#ifdef KR_headers
+def_start(outfile, s1, s2, post)
+	FILE *outfile;
+	char *s1;
+	char *s2;
+	char *post;
+#else
+def_start(FILE *outfile, char *s1, char *s2, char *post)
+#endif
+{
+	defines *d;
+	int n, n1;
+	extern int in_define;
+
+	n = n1 = strlen(s1);
+	if (s2)
+		n += strlen(s2);
+	d = (defines *)mem(sizeof(defines)+n, 1);
+	d->next = define_list;
+	define_list = d;
+	strcpy(d->defname, s1);
+	if (s2)
+		strcpy(d->defname + n1, s2);
+	in_define = 1;
+	nice_printf(outfile, "#define %s", d->defname);
+	if (post)
+		nice_printf(outfile, " %s", post);
+	}
+
+ void
+#ifdef KR_headers
+other_undefs(outfile)
+	FILE *outfile;
+#else
+other_undefs(FILE *outfile)
+#endif
+{
+	defines *d;
+	if (d = define_list) {
+		define_list = 0;
+		nice_printf(outfile, "\n");
+		do
+			nice_printf(outfile, "#undef %s\n", d->defname);
+			while(d = d->next);
+		nice_printf(outfile, "\n");
+		}
+	}
diff --git a/contrib/tools/f2c/src/misc.c b/contrib/tools/f2c/src/misc.c
new file mode 100644
index 0000000000..bdb9bcb3e3
--- /dev/null
+++ b/contrib/tools/f2c/src/misc.c
@@ -0,0 +1,1398 @@
+/****************************************************************
+Copyright 1990, 1992-1995, 2000-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "limits.h"
+
+ int
+#ifdef KR_headers
+oneof_stg(name, stg, mask)
+	Namep name;
+	int stg;
+	int mask;
+#else
+oneof_stg(Namep name, int stg, int mask)
+#endif
+{
+	if (stg == STGCOMMON && name) {
+		if ((mask & M(STGEQUIV)))
+			return name->vcommequiv;
+		if ((mask & M(STGCOMMON)))
+			return !name->vcommequiv;
+		}
+	return ONEOF(stg, mask);
+	}
+
+
+/* op_assign -- given a binary opcode, return the associated assignment
+   operator */
+
+ int
+#ifdef KR_headers
+op_assign(opcode)
+	int opcode;
+#else
+op_assign(int opcode)
+#endif
+{
+    int retval = -1;
+
+    switch (opcode) {
+        case OPPLUS: retval = OPPLUSEQ; break;
+	case OPMINUS: retval = OPMINUSEQ; break;
+	case OPSTAR: retval = OPSTAREQ; break;
+	case OPSLASH: retval = OPSLASHEQ; break;
+	case OPMOD: retval = OPMODEQ; break;
+	case OPLSHIFT: retval = OPLSHIFTEQ; break;
+	case OPRSHIFT: retval = OPRSHIFTEQ; break;
+	case OPBITAND: retval = OPBITANDEQ; break;
+	case OPBITXOR: retval = OPBITXOREQ; break;
+	case OPBITOR: retval = OPBITOREQ; break;
+	default:
+	    erri ("op_assign:  bad opcode '%d'", opcode);
+	    break;
+    } /* switch */
+
+    return retval;
+} /* op_assign */
+
+
+ char *
+#ifdef KR_headers
+Alloc(n)
+	int n;
+#else
+Alloc(int n)
+#endif
+		/* error-checking version of malloc */
+		/* ckalloc initializes memory to 0; Alloc does not */
+{
+	char errbuf[32];
+	register char *rv;
+
+	rv = (char*)malloc(n);
+	if (!rv) {
+		sprintf(errbuf, "malloc(%d) failure!", n);
+		Fatal(errbuf);
+		}
+	return rv;
+	}
+
+ void
+#ifdef KR_headers
+cpn(n, a, b)
+	register int n;
+	register char *a;
+	register char *b;
+#else
+cpn(register int n, register char *a, register char *b)
+#endif
+{
+	while(--n >= 0)
+		*b++ = *a++;
+}
+
+
+ int
+#ifdef KR_headers
+eqn(n, a, b)
+	register int n;
+	register char *a;
+	register char *b;
+#else
+eqn(register int n, register char *a, register char *b)
+#endif
+{
+	while(--n >= 0)
+		if(*a++ != *b++)
+			return(NO);
+	return(YES);
+}
+
+
+
+
+
+
+ int
+#ifdef KR_headers
+cmpstr(a, b, la, lb)
+	register char *a;
+	register char *b;
+	ftnint la;
+	ftnint lb;
+#else
+cmpstr(register char *a, register char *b, ftnint la, ftnint lb)
+#endif
+	/* compare two strings */
+{
+	register char *aend, *bend;
+	aend = a + la;
+	bend = b + lb;
+
+
+	if(la <= lb)
+	{
+		while(a < aend)
+			if(*a != *b)
+				return( *a - *b );
+			else
+			{
+				++a;
+				++b;
+			}
+
+		while(b < bend)
+			if(*b != ' ')
+				return(' ' - *b);
+			else
+				++b;
+	}
+
+	else
+	{
+		while(b < bend)
+			if(*a != *b)
+				return( *a - *b );
+			else
+			{
+				++a;
+				++b;
+			}
+		while(a < aend)
+			if(*a != ' ')
+				return(*a - ' ');
+			else
+				++a;
+	}
+	return(0);
+}
+
+
+/* hookup -- Same as LISP NCONC, that is a destructive append of two lists */
+
+ chainp
+#ifdef KR_headers
+hookup(x, y)
+	register chainp x;
+	register chainp y;
+#else
+hookup(register chainp x, register chainp y)
+#endif
+{
+	register chainp p;
+
+	if(x == NULL)
+		return(y);
+
+	for(p = x ; p->nextp ; p = p->nextp)
+		;
+	p->nextp = y;
+	return(x);
+}
+
+
+
+ struct Listblock *
+#ifdef KR_headers
+mklist(p)
+	chainp p;
+#else
+mklist(chainp p)
+#endif
+{
+	register struct Listblock *q;
+
+	q = ALLOC(Listblock);
+	q->tag = TLIST;
+	q->listp = p;
+	return(q);
+}
+
+
+ chainp
+#ifdef KR_headers
+mkchain(p, q)
+	register char * p;
+	register chainp q;
+#else
+mkchain(register char * p, register chainp q)
+#endif
+{
+	register chainp r;
+
+	if(chains)
+	{
+		r = chains;
+		chains = chains->nextp;
+	}
+	else
+		r = ALLOC(Chain);
+
+	r->datap = p;
+	r->nextp = q;
+	return(r);
+}
+
+ chainp
+#ifdef KR_headers
+revchain(next)
+	register chainp next;
+#else
+revchain(register chainp next)
+#endif
+{
+	register chainp p, prev = 0;
+
+	while(p = next) {
+		next = p->nextp;
+		p->nextp = prev;
+		prev = p;
+		}
+	return prev;
+	}
+
+
+/* addunder -- turn a cvarname into an external name */
+/* The cvarname may already end in _ (to avoid C keywords); */
+/* if not, it has room for appending an _. */
+
+ char *
+#ifdef KR_headers
+addunder(s)
+	register char *s;
+#else
+addunder(register char *s)
+#endif
+{
+	register int c, i, j;
+	char *s0 = s;
+
+	i = j = 0;
+	while(c = *s++)
+		if (c == '_')
+			i++, j++;
+		else
+			i = 0;
+	if (!i) {
+		*s-- = 0;
+		*s = '_';
+		}
+	else if (j == 2)
+		s[-2] = 0;
+	return( s0 );
+	}
+
+
+/* copyn -- return a new copy of the input Fortran-string */
+
+ char *
+#ifdef KR_headers
+copyn(n, s)
+	register int n;
+	register char *s;
+#else
+copyn(register int n, register char *s)
+#endif
+{
+	register char *p, *q;
+
+	p = q = (char *) Alloc(n);
+	while(--n >= 0)
+		*q++ = *s++;
+	return(p);
+}
+
+
+
+/* copys -- return a new copy of the input C-string */
+
+ char *
+#ifdef KR_headers
+copys(s)
+	char *s;
+#else
+copys(char *s)
+#endif
+{
+	return( copyn( strlen(s)+1 , s) );
+}
+
+
+
+/* convci -- Convert Fortran-string to integer; assumes that input is a
+   legal number, with no trailing blanks */
+
+ ftnint
+#ifdef KR_headers
+convci(n, s)
+	register int n;
+	register char *s;
+#else
+convci(register int n, register char *s)
+#endif
+{
+	ftnint sum, t;
+	char buff[100], *s0;
+	int n0;
+
+	s0 = s;
+	n0 = n;
+	sum = 0;
+	while(n-- > 0) {
+		/* sum = 10*sum + (*s++ - '0'); */
+		t = *s++ - '0';
+		if (sum > LONG_MAX/10) {
+ ovfl:
+			if (n0 > 60)
+				n0 = 60;
+			sprintf(buff, "integer constant %.*s truncated.",
+				n0, s0);
+			err(buff);
+			return LONG_MAX;
+			}
+		sum *= 10;
+		if (sum > LONG_MAX - t)
+			goto ovfl;
+		sum += t;
+		}
+	return(sum);
+	}
+
+/* convic - Convert Integer constant to string */
+
+ char *
+#ifdef KR_headers
+convic(n)
+	ftnint n;
+#else
+convic(ftnint n)
+#endif
+{
+	static char s[20];
+	register char *t;
+
+	s[19] = '\0';
+	t = s+19;
+
+	do	{
+		*--t = '0' + n%10;
+		n /= 10;
+	} while(n > 0);
+
+	return(t);
+}
+
+
+
+/* mkname -- add a new identifier to the environment, including the closed
+   hash table. */
+
+ Namep
+#ifdef KR_headers
+mkname(s)
+	register char *s;
+#else
+mkname(register char *s)
+#endif
+{
+	struct Hashentry *hp;
+	register Namep q;
+	register int c, hash, i;
+	register char *t;
+	char *s0;
+	char errbuf[64];
+
+	hash = i = 0;
+	s0 = s;
+	while(c = *s++) {
+		hash += c;
+		if (c == '_')
+			i = 2;
+		}
+	if (!i && in_vector(s0,c_keywords,n_keywords) >= 0)
+		i = 2;
+	hash %= maxhash;
+
+/* Add the name to the closed hash table */
+
+	hp = hashtab + hash;
+
+	while(q = hp->varp)
+		if( hash == hp->hashval && !strcmp(s0,q->fvarname) )
+			return(q);
+		else if(++hp >= lasthash)
+			hp = hashtab;
+
+	if(++nintnames >= maxhash-1)
+		many("names", 'n', maxhash);	/* Fatal error */
+	hp->varp = q = ALLOC(Nameblock);
+	hp->hashval = hash;
+	q->tag = TNAME;	/* TNAME means the tag type is NAME */
+	c = s - s0;
+	if (c > 7 && noextflag) {
+		sprintf(errbuf, "\"%.35s%s\" over 6 characters long", s0,
+			c > 36 ? "..." : "");
+		errext(errbuf);
+		}
+	q->fvarname = strcpy(mem(c,0), s0);
+	t = q->cvarname = mem(c + i + 1, 0);
+	s = s0;
+	/* add __ to the end of any name containing _ and to any C keyword */
+	while(*t = *s++)
+		t++;
+	if (i) {
+		do *t++ = '_';
+			while(--i > 0);
+		*t = 0;
+		}
+	return(q);
+}
+
+
+ struct Labelblock *
+#ifdef KR_headers
+mklabel(l)
+	ftnint l;
+#else
+mklabel(ftnint l)
+#endif
+{
+	register struct Labelblock *lp;
+
+	if(l <= 0)
+		return(NULL);
+
+	for(lp = labeltab ; lp < highlabtab ; ++lp)
+		if(lp->stateno == l)
+			return(lp);
+
+	if(++highlabtab > labtabend)
+		many("statement labels", 's', maxstno);
+
+	lp->stateno = l;
+	lp->labelno = (int)newlabel();
+	lp->blklevel = 0;
+	lp->labused = NO;
+	lp->fmtlabused = NO;
+	lp->labdefined = NO;
+	lp->labinacc = NO;
+	lp->labtype = LABUNKNOWN;
+	lp->fmtstring = 0;
+	return(lp);
+}
+
+ long
+newlabel(Void)
+{
+	return ++lastlabno;
+}
+
+
+/* this label appears in a branch context */
+
+ struct Labelblock *
+#ifdef KR_headers
+execlab(stateno)
+	ftnint stateno;
+#else
+execlab(ftnint stateno)
+#endif
+{
+	register struct Labelblock *lp;
+
+	if(lp = mklabel(stateno))
+	{
+		if(lp->labinacc)
+			warn1("illegal branch to inner block, statement label %s",
+			    convic(stateno) );
+		else if(lp->labdefined == NO)
+			lp->blklevel = blklevel;
+		if(lp->labtype == LABFORMAT)
+			err("may not branch to a format");
+		else
+			lp->labtype = LABEXEC;
+	}
+	else
+		execerr("illegal label %s", convic(stateno));
+
+	return(lp);
+}
+
+
+/* find or put a name in the external symbol table */
+
+ Extsym *
+#ifdef KR_headers
+mkext1(f, s)
+	char *f;
+	char *s;
+#else
+mkext1(char *f, char *s)
+#endif
+{
+	Extsym *p;
+
+	for(p = extsymtab ; p<nextext ; ++p)
+		if(!strcmp(s,p->cextname))
+			return( p );
+
+	if(nextext >= lastext)
+		many("external symbols", 'x', maxext);
+
+	nextext->fextname = strcpy(gmem(strlen(f)+1,0), f);
+	nextext->cextname = f == s
+				? nextext->fextname
+				: strcpy(gmem(strlen(s)+1,0), s);
+	nextext->extstg = STGUNKNOWN;
+	nextext->extp = 0;
+	nextext->allextp = 0;
+	nextext->extleng = 0;
+	nextext->maxleng = 0;
+	nextext->extinit = 0;
+	nextext->curno = nextext->maxno = 0;
+	return( nextext++ );
+}
+
+
+ Extsym *
+#ifdef KR_headers
+mkext(f, s)
+	char *f;
+	char *s;
+#else
+mkext(char *f, char *s)
+#endif
+{
+	Extsym *e = mkext1(f, s);
+	if (e->extstg == STGCOMMON)
+		errstr("%.52s cannot be a subprogram: it is a common block.",f);
+	return e;
+	}
+
+ Addrp
+#ifdef KR_headers
+builtin(t, s, dbi)
+	int t;
+	char *s;
+	int dbi;
+#else
+builtin(int t, char *s, int dbi)
+#endif
+{
+	register Extsym *p;
+	register Addrp q;
+	extern chainp used_builtins;
+
+	p = mkext(s,s);
+	if(p->extstg == STGUNKNOWN)
+		p->extstg = STGEXT;
+	else if(p->extstg != STGEXT)
+	{
+		errstr("improper use of builtin %s", s);
+		return(0);
+	}
+
+	q = ALLOC(Addrblock);
+	q->tag = TADDR;
+	q->vtype = t;
+	q->vclass = CLPROC;
+	q->vstg = STGEXT;
+	q->memno = p - extsymtab;
+	q->dbl_builtin = dbi;
+
+/* A NULL pointer here tells you to use   memno   to check the external
+   symbol table */
+
+	q -> uname_tag = UNAM_EXTERN;
+
+/* Add to the list of used builtins */
+
+	if (dbi >= 0)
+		add_extern_to_list (q, &used_builtins);
+	return(q);
+}
+
+
+ void
+#ifdef KR_headers
+add_extern_to_list(addr, list_store)
+	Addrp addr;
+	chainp *list_store;
+#else
+add_extern_to_list(Addrp addr, chainp *list_store)
+#endif
+{
+    chainp last = CHNULL;
+    chainp list;
+    int memno;
+
+    if (list_store == (chainp *) NULL || addr == (Addrp) NULL)
+	return;
+
+    list = *list_store;
+    memno = addr -> memno;
+
+    for (;list; last = list, list = list -> nextp) {
+	Addrp This = (Addrp) (list -> datap);
+
+	if (This -> tag == TADDR && This -> uname_tag == UNAM_EXTERN &&
+		This -> memno == memno)
+	    return;
+    } /* for */
+
+    if (*list_store == CHNULL)
+	*list_store = mkchain((char *)cpexpr((expptr)addr), CHNULL);
+    else
+	last->nextp = mkchain((char *)cpexpr((expptr)addr), CHNULL);
+
+} /* add_extern_to_list */
+
+
+ void
+#ifdef KR_headers
+frchain(p)
+	register chainp *p;
+#else
+frchain(register chainp *p)
+#endif
+{
+	register chainp q;
+
+	if(p==0 || *p==0)
+		return;
+
+	for(q = *p; q->nextp ; q = q->nextp)
+		;
+	q->nextp = chains;
+	chains = *p;
+	*p = 0;
+}
+
+ void
+#ifdef KR_headers
+frexchain(p)
+	register chainp *p;
+#else
+frexchain(register chainp *p)
+#endif
+{
+	register chainp q, r;
+
+	if (q = *p) {
+		for(;;q = r) {
+			frexpr((expptr)q->datap);
+			if (!(r = q->nextp))
+				break;
+			}
+		q->nextp = chains;
+		chains = *p;
+		*p = 0;
+		}
+	}
+
+
+ tagptr
+#ifdef KR_headers
+cpblock(n, p)
+	register int n;
+	register char *p;
+#else
+cpblock(register int n, register char *p)
+#endif
+{
+	register ptr q;
+
+	memcpy((char *)(q = ckalloc(n)), (char *)p, n);
+	return( (tagptr) q);
+}
+
+
+
+ ftnint
+#ifdef KR_headers
+lmax(a, b)
+	ftnint a;
+	ftnint b;
+#else
+lmax(ftnint a, ftnint b)
+#endif
+{
+	return( a>b ? a : b);
+}
+
+ ftnint
+#ifdef KR_headers
+lmin(a, b)
+	ftnint a;
+	ftnint b;
+#else
+lmin(ftnint a, ftnint b)
+#endif
+{
+	return(a < b ? a : b);
+}
+
+
+
+ int
+#ifdef KR_headers
+maxtype(t1, t2)
+	int t1;
+	int t2;
+#else
+maxtype(int t1, int t2)
+#endif
+{
+	int t;
+
+	t = t1 >= t2 ? t1 : t2;
+	if(t==TYCOMPLEX && (t1==TYDREAL || t2==TYDREAL) )
+		t = TYDCOMPLEX;
+	return(t);
+}
+
+
+
+/* return log base 2 of n if n a power of 2; otherwise -1 */
+ int
+#ifdef KR_headers
+log_2(n)
+	ftnint n;
+#else
+log_2(ftnint n)
+#endif
+{
+	int k;
+
+	/* trick based on binary representation */
+
+	if(n<=0 || (n & (n-1))!=0)
+		return(-1);
+
+	for(k = 0 ;  n >>= 1  ; ++k)
+		;
+	return(k);
+}
+
+
+ void
+frrpl(Void)
+{
+	struct Rplblock *rp;
+
+	while(rpllist)
+	{
+		rp = rpllist->rplnextp;
+		free( (charptr) rpllist);
+		rpllist = rp;
+	}
+}
+
+
+
+/* Call a Fortran function with an arbitrary list of arguments */
+
+int callk_kludge;
+
+ expptr
+#ifdef KR_headers
+callk(type, name, args)
+	int type;
+	char *name;
+	chainp args;
+#else
+callk(int type, char *name, chainp args)
+#endif
+{
+	register expptr p;
+
+	p = mkexpr(OPCALL,
+		(expptr)builtin(callk_kludge ? callk_kludge : type, name, 0),
+		(expptr)args);
+	p->exprblock.vtype = type;
+	return(p);
+}
+
+
+
+ expptr
+#ifdef KR_headers
+call4(type, name, arg1, arg2, arg3, arg4)
+	int type;
+	char *name;
+	expptr arg1;
+	expptr arg2;
+	expptr arg3;
+	expptr arg4;
+#else
+call4(int type, char *name, expptr arg1, expptr arg2, expptr arg3, expptr arg4)
+#endif
+{
+	struct Listblock *args;
+	args = mklist( mkchain((char *)arg1,
+			mkchain((char *)arg2,
+				mkchain((char *)arg3,
+	    				mkchain((char *)arg4, CHNULL)) ) ) );
+	return( callk(type, name, (chainp)args) );
+}
+
+
+
+
+ expptr
+#ifdef KR_headers
+call3(type, name, arg1, arg2, arg3)
+	int type;
+	char *name;
+	expptr arg1;
+	expptr arg2;
+	expptr arg3;
+#else
+call3(int type, char *name, expptr arg1, expptr arg2, expptr arg3)
+#endif
+{
+	struct Listblock *args;
+	args = mklist( mkchain((char *)arg1,
+			mkchain((char *)arg2,
+				mkchain((char *)arg3, CHNULL) ) ) );
+	return( callk(type, name, (chainp)args) );
+}
+
+
+
+
+
+ expptr
+#ifdef KR_headers
+call2(type, name, arg1, arg2)
+	int type;
+	char *name;
+	expptr arg1;
+	expptr arg2;
+#else
+call2(int type, char *name, expptr arg1, expptr arg2)
+#endif
+{
+	struct Listblock *args;
+
+	args = mklist( mkchain((char *)arg1, mkchain((char *)arg2, CHNULL) ) );
+	return( callk(type,name, (chainp)args) );
+}
+
+
+
+
+ expptr
+#ifdef KR_headers
+call1(type, name, arg)
+	int type;
+	char *name;
+	expptr arg;
+#else
+call1(int type, char *name, expptr arg)
+#endif
+{
+	return( callk(type,name, (chainp)mklist(mkchain((char *)arg,CHNULL)) ));
+}
+
+
+ expptr
+#ifdef KR_headers
+call0(type, name)
+	int type;
+	char *name;
+#else
+call0(int type, char *name)
+#endif
+{
+	return( callk(type, name, CHNULL) );
+}
+
+
+
+ struct Impldoblock *
+#ifdef KR_headers
+mkiodo(dospec, list)
+	chainp dospec;
+	chainp list;
+#else
+mkiodo(chainp dospec, chainp list)
+#endif
+{
+	register struct Impldoblock *q;
+
+	q = ALLOC(Impldoblock);
+	q->tag = TIMPLDO;
+	q->impdospec = dospec;
+	q->datalist = list;
+	return(q);
+}
+
+
+
+
+/* ckalloc -- Allocate 1 memory unit of size   n,   checking for out of
+   memory error */
+
+ ptr
+#ifdef KR_headers
+ckalloc(n)
+	register int n;
+#else
+ckalloc(register int n)
+#endif
+{
+	register ptr p;
+	p = (ptr)calloc(1, (unsigned) n);
+	if (p || !n)
+		return(p);
+	fprintf(stderr, "failing to get %d bytes\n",n);
+	Fatal("out of memory");
+	/* NOT REACHED */ return 0;
+}
+
+
+ int
+#ifdef KR_headers
+isaddr(p)
+	register expptr p;
+#else
+isaddr(register expptr p)
+#endif
+{
+	if(p->tag == TADDR)
+		return(YES);
+	if(p->tag == TEXPR)
+		switch(p->exprblock.opcode)
+		{
+		case OPCOMMA:
+			return( isaddr(p->exprblock.rightp) );
+
+		case OPASSIGN:
+		case OPASSIGNI:
+		case OPPLUSEQ:
+		case OPMINUSEQ:
+		case OPSLASHEQ:
+		case OPMODEQ:
+		case OPLSHIFTEQ:
+		case OPRSHIFTEQ:
+		case OPBITANDEQ:
+		case OPBITXOREQ:
+		case OPBITOREQ:
+			return( isaddr(p->exprblock.leftp) );
+		}
+	return(NO);
+}
+
+
+
+ int
+#ifdef KR_headers
+isstatic(p)
+	register expptr p;
+#else
+isstatic(register expptr p)
+#endif
+{
+	extern int useauto;
+	if(p->headblock.vleng && !ISCONST(p->headblock.vleng))
+		return(NO);
+
+	switch(p->tag)
+	{
+	case TCONST:
+		return(YES);
+
+	case TADDR:
+		if(ONEOF(p->addrblock.vstg,MSKSTATIC) &&
+		    ISCONST(p->addrblock.memoffset) && !useauto)
+			return(YES);
+
+	default:
+		return(NO);
+	}
+}
+
+
+
+/* addressable -- return True iff it is a constant value, or can be
+   referenced by constant values */
+
+ int
+#ifdef KR_headers
+addressable(p) expptr p;
+#else
+addressable(expptr p)
+#endif
+{
+	if (p)
+		switch(p->tag) {
+		 case TCONST:
+			return(YES);
+
+		 case TADDR:
+			return( addressable(p->addrblock.memoffset) );
+		 }
+	return(NO);
+	}
+
+
+/* isnegative_const -- returns true if the constant is negative.  Returns
+   false for imaginary and nonnumeric constants */
+
+ int
+#ifdef KR_headers
+isnegative_const(cp)
+	struct Constblock *cp;
+#else
+isnegative_const(struct Constblock *cp)
+#endif
+{
+    int retval;
+
+    if (cp == NULL)
+	return 0;
+
+    switch (cp -> vtype) {
+	case TYINT1:
+        case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD
+	case TYQUAD:
+#endif
+	    retval = cp -> Const.ci < 0;
+	    break;
+	case TYREAL:
+	case TYDREAL:
+		retval = cp->vstg ? *cp->Const.cds[0] == '-'
+				  :  cp->Const.cd[0] < 0.0;
+	    break;
+	default:
+
+	    retval = 0;
+	    break;
+    } /* switch */
+
+    return retval;
+} /* isnegative_const */
+
+ void
+#ifdef KR_headers
+negate_const(cp)
+	Constp cp;
+#else
+negate_const(Constp cp)
+#endif
+{
+    if (cp == (struct Constblock *) NULL)
+	return;
+
+    switch (cp -> vtype) {
+	case TYINT1:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD
+	case TYQUAD:
+#endif
+	    cp -> Const.ci = - cp -> Const.ci;
+	    break;
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		if (cp->vstg)
+		    switch(*cp->Const.cds[1]) {
+			case '-':
+				++cp->Const.cds[1];
+				break;
+			case '0':
+				break;
+			default:
+				--cp->Const.cds[1];
+			}
+		else
+	    		cp->Const.cd[1] = -cp->Const.cd[1];
+		/* no break */
+	case TYREAL:
+	case TYDREAL:
+		if (cp->vstg)
+		    switch(*cp->Const.cds[0]) {
+			case '-':
+				++cp->Const.cds[0];
+				break;
+			case '0':
+				break;
+			default:
+				--cp->Const.cds[0];
+			}
+		else
+	    		cp->Const.cd[0] = -cp->Const.cd[0];
+	    break;
+	case TYCHAR:
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+	case TYLOGICAL:
+	    erri ("negate_const:  can't negate type '%d'", cp -> vtype);
+	    break;
+	default:
+	    erri ("negate_const:  bad type '%d'",
+		    cp -> vtype);
+	    break;
+    } /* switch */
+} /* negate_const */
+
+ void
+#ifdef KR_headers
+ffilecopy(infp, outfp) FILE *infp, *outfp;
+#else
+ffilecopy(FILE *infp, FILE *outfp)
+#endif
+{
+	int c;
+	while (!feof(infp)) {
+		c = getc(infp);
+		if (!feof(infp))
+			putc(c, outfp);
+		}
+	}
+
+
+/* in_vector -- verifies whether   str   is in c_keywords.
+   If so, the index is returned else  -1  is returned.
+   c_keywords must be in alphabetical order (as defined by strcmp).
+*/
+
+ int
+#ifdef KR_headers
+in_vector(str, keywds, n)
+	char *str;
+	char **keywds;
+	register int n;
+#else
+in_vector(char *str, char **keywds, register int n)
+#endif
+{
+	register char **K = keywds;
+	register int n1, t;
+
+	do {
+		n1 = n >> 1;
+		if (!(t = strcmp(str, K[n1])))
+			return K - keywds + n1;
+		if (t < 0)
+			n = n1;
+		else {
+			n -= ++n1;
+			K += n1;
+			}
+		}
+		while(n > 0);
+
+	return -1;
+	} /* in_vector */
+
+
+ int
+#ifdef KR_headers
+is_negatable(Const)
+	Constp Const;
+#else
+is_negatable(Constp Const)
+#endif
+{
+    int retval = 0;
+    if (Const != (Constp) NULL)
+	switch (Const -> vtype) {
+	    case TYINT1:
+		retval = Const -> Const.ci >= -BIGGEST_CHAR;
+		break;
+	    case TYSHORT:
+	        retval = Const -> Const.ci >= -BIGGEST_SHORT;
+	        break;
+	    case TYLONG:
+#ifdef TYQUAD
+	    case TYQUAD:
+#endif
+	        retval = Const -> Const.ci >= -BIGGEST_LONG;
+	        break;
+	    case TYREAL:
+	    case TYDREAL:
+	    case TYCOMPLEX:
+	    case TYDCOMPLEX:
+	        retval = 1;
+	        break;
+	    case TYLOGICAL1:
+	    case TYLOGICAL2:
+	    case TYLOGICAL:
+	    case TYCHAR:
+	    case TYSUBR:
+	    default:
+	        retval = 0;
+	        break;
+	} /* switch */
+
+    return retval;
+} /* is_negatable */
+
+ void
+#ifdef KR_headers
+backup(fname, bname)
+	char *fname;
+	char *bname;
+#else
+backup(char *fname, char *bname)
+#endif
+{
+	FILE *b, *f;
+	static char couldnt[] = "Couldn't open %.80s";
+
+	if (!(f = fopen(fname, binread))) {
+		warn1(couldnt, fname);
+		return;
+		}
+	if (!(b = fopen(bname, binwrite))) {
+		warn1(couldnt, bname);
+		return;
+		}
+	ffilecopy(f, b);
+	fclose(f);
+	fclose(b);
+	}
+
+
+/* struct_eq -- returns YES if structures have the same field names and
+   types, NO otherwise */
+
+ int
+#ifdef KR_headers
+struct_eq(s1, s2)
+	chainp s1;
+	chainp s2;
+#else
+struct_eq(chainp s1, chainp s2)
+#endif
+{
+    struct Dimblock *d1, *d2;
+    Constp cp1, cp2;
+
+    if (s1 == CHNULL && s2 == CHNULL)
+	return YES;
+    for(; s1 && s2; s1 = s1->nextp, s2 = s2->nextp) {
+	register Namep v1 = (Namep) s1 -> datap;
+	register Namep v2 = (Namep) s2 -> datap;
+
+	if (v1 == (Namep) NULL || v1 -> tag != TNAME ||
+		v2 == (Namep) NULL || v2 -> tag != TNAME)
+	    return NO;
+
+	if (v1->vtype != v2->vtype || v1->vclass != v2->vclass
+		|| strcmp(v1->fvarname, v2->fvarname))
+	    return NO;
+
+	/* compare dimensions (needed for comparing COMMON blocks) */
+
+	if (d1 = v1->vdim) {
+		if (!(cp1 = (Constp)d1->nelt) || cp1->tag != TCONST
+		||  !(d2 = v2->vdim)
+		||  !(cp2 = (Constp)d2->nelt) || cp2->tag != TCONST
+		||  cp1->Const.ci != cp2->Const.ci)
+			return NO;
+		}
+	else if (v2->vdim)
+		return NO;
+    } /* while s1 != CHNULL && s2 != CHNULL */
+
+    return s1 == CHNULL && s2 == CHNULL;
+} /* struct_eq */
+
+ static int
+#ifdef KR_headers
+int_trunc(n0, s0) int n0; char *s0;
+#else
+int_trunc(int n0, char *s0)
+#endif
+{
+	char buff[100];
+
+	if (n0 > 60)
+		n0 = 60;
+	sprintf(buff, "integer constant %.*s truncated.", n0, s0);
+	err(buff);
+	return 1;
+	}
+
+ tagptr
+#ifdef KR_headers
+mkintqcon(n, s) int n; char *s;
+#else
+mkintqcon(int n, char *s)
+#endif
+{
+#ifdef NO_LONG_LONG
+	return mkintcon(convci(n, s));
+#else
+#ifndef LLONG_MAX
+#ifdef LONGLONG_MAX
+#define LLONG_MAX LONGLONG_MAX
+#else
+#define LLONG_MAX 0x7fffffffffffffffLL
+#endif
+#endif
+	Constp p;
+	Llong sum, t;
+	char *s0;
+	int n0, warned = 0;
+
+	s0 = s;
+	n0 = n;
+	sum = 0;
+	while(n-- > 0) {
+		/* sum = 10*sum + (*s++ - '0'); */
+		t = *s++ - '0';
+		if (sum > LLONG_MAX/10) {
+ ovfl:
+			warned = int_trunc(n0,s0);
+			sum = LLONG_MAX;
+			break;
+			}
+		sum *= 10;
+		if (sum > LLONG_MAX - t)
+			goto ovfl;
+		sum += t;
+		}
+	p = mkconst(tyint);
+	if (sum > LONG_MAX) {
+		if (allow_i8c) {
+			p->vtype = TYQUAD;
+			p->Const.cq = sum;
+			}
+		else {
+			p->Const.ci = LONG_MAX;
+			if (!warned)
+				int_trunc(n0,s0);
+			}
+		}
+	else
+		p->Const.ci = (ftnint) sum;
+	return (tagptr)p;
+#endif
+	}
diff --git a/contrib/tools/f2c/src/names.c b/contrib/tools/f2c/src/names.c
new file mode 100644
index 0000000000..373f656cb7
--- /dev/null
+++ b/contrib/tools/f2c/src/names.c
@@ -0,0 +1,835 @@
+/****************************************************************
+Copyright 1990, 1992 - 1996, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "output.h"
+#include "names.h"
+#include "iob.h"
+
+
+/* Names generated by the translator are guaranteed to be unique from the
+   Fortan names because Fortran does not allow underscores in identifiers,
+   and all of the system generated names do have underscores.  The various
+   naming conventions are outlined below:
+
+	FORMAT		APPLICATION
+   ----------------------------------------------------------------------
+	io_#		temporaries generated by IO calls; these will
+			contain the device number (e.g. 5, 6, 0)
+	ret_val		function return value, required for complex and
+			character functions.
+	ret_val_len	length of the return value in character functions
+
+	ssss_len	length of character argument "ssss"
+
+	c_#		member of the literal pool, where # is an
+			arbitrary label assigned by the system
+	cs_#		short integer constant in the literal pool
+	t_#		expression temporary, # is the depth of arguments
+			on the stack.
+	L#		label "#", given by user in the Fortran program.
+			This is unique because Fortran labels are numeric
+	pad_#		label on an init field required for alignment
+	xxx_init	label on a common block union, if a block data
+			requires a separate declaration
+*/
+
+/* generate variable references */
+
+ char *
+#ifdef KR_headers
+c_type_decl(type, is_extern)
+	int type;
+	int is_extern;
+#else
+c_type_decl(int type, int is_extern)
+#endif
+{
+    static char buff[100];
+
+    switch (type) {
+	case TYREAL:	if (!is_extern || !forcedouble)
+				{ strcpy (buff, "real");break; }
+	case TYDREAL:	strcpy (buff, "doublereal");	break;
+	case TYCOMPLEX:	if (is_extern)
+			    strcpy (buff, "/* Complex */ VOID");
+			else
+			    strcpy (buff, "complex");
+			break;
+	case TYDCOMPLEX:if (is_extern)
+			    strcpy (buff, "/* Double Complex */ VOID");
+			else
+			    strcpy (buff, "doublecomplex");
+			break;
+	case TYADDR:
+	case TYINT1:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD
+	case TYQUAD:
+#endif
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+	case TYLOGICAL:	strcpy(buff, Typename[type]);
+			break;
+	case TYCHAR:	if (is_extern)
+			    strcpy (buff, "/* Character */ VOID");
+			else
+			    strcpy (buff, "char");
+			break;
+
+        case TYUNKNOWN:	strcpy (buff, "UNKNOWN");
+
+/* If a procedure's type is unknown, assume it's a subroutine */
+
+			if (!is_extern)
+			    break;
+
+/* Subroutines must return an INT, because they might return a label
+   value.  Even if one doesn't, the caller will EXPECT it to. */
+
+	case TYSUBR:	strcpy (buff, "/* Subroutine */ int");
+							break;
+	case TYERROR:	strcpy (buff, "ERROR");		break;
+	case TYVOID:	strcpy (buff, "void");		break;
+	case TYCILIST:	strcpy (buff, "cilist");	break;
+	case TYICILIST:	strcpy (buff, "icilist");	break;
+	case TYOLIST:	strcpy (buff, "olist");		break;
+	case TYCLLIST:	strcpy (buff, "cllist");	break;
+	case TYALIST:	strcpy (buff, "alist");		break;
+	case TYINLIST:	strcpy (buff, "inlist");	break;
+	case TYFTNLEN:	strcpy (buff, "ftnlen");	break;
+	default:	sprintf (buff, "BAD DECL '%d'", type);
+							break;
+    } /* switch */
+
+    return buff;
+} /* c_type_decl */
+
+
+ char *
+new_func_length(Void)
+{ return "ret_val_len"; }
+
+ char *
+#ifdef KR_headers
+new_arg_length(arg)
+	Namep arg;
+#else
+new_arg_length(Namep arg)
+#endif
+{
+	static char buf[64];
+	char *fmt = "%s_len", *s = arg->fvarname;
+	switch(*s) {
+	  case 'r':
+		if (!strcmp(s+1, "et_val"))
+			goto adjust_fmt;
+		break;
+	  case 'h':
+	  case 'i':
+		if (!s[1]) {
+ adjust_fmt:
+			fmt = "%s_length"; /* avoid conflict with libF77 */
+			}
+	  }
+	sprintf (buf, fmt, s);
+	return buf;
+} /* new_arg_length */
+
+
+/* declare_new_addr -- Add a new local variable to the function, given a
+   pointer to an Addrblock structure (which must have the uname_tag set)
+   This list of idents will be printed in reverse (i.e., chronological)
+   order */
+
+ void
+#ifdef KR_headers
+declare_new_addr(addrp)
+	struct Addrblock *addrp;
+#else
+declare_new_addr(struct Addrblock *addrp)
+#endif
+{
+    extern chainp new_vars;
+
+    new_vars = mkchain((char *)cpexpr((expptr)addrp), new_vars);
+} /* declare_new_addr */
+
+
+ void
+#ifdef KR_headers
+wr_nv_ident_help(outfile, addrp)
+	FILE *outfile;
+	struct Addrblock *addrp;
+#else
+wr_nv_ident_help(FILE *outfile, struct Addrblock *addrp)
+#endif
+{
+    int eltcount = 0;
+
+    if (addrp == (struct Addrblock *) NULL)
+	return;
+
+    if (addrp -> isarray) {
+	frexpr (addrp -> memoffset);
+	addrp -> memoffset = ICON(0);
+	eltcount = addrp -> ntempelt;
+	addrp -> ntempelt = 0;
+	addrp -> isarray = 0;
+    } /* if */
+    out_addr (outfile, addrp);
+    if (eltcount)
+	nice_printf (outfile, "[%d]", eltcount);
+} /* wr_nv_ident_help */
+
+ int
+#ifdef KR_headers
+nv_type_help(addrp)
+	struct Addrblock *addrp;
+#else
+nv_type_help(struct Addrblock *addrp)
+#endif
+{
+    if (addrp == (struct Addrblock *) NULL)
+	return -1;
+
+    return addrp -> vtype;
+} /* nv_type_help */
+
+
+/* lit_name -- returns a unique identifier for the given literal.  Make
+   the label useful, when possible.  For example:
+
+	1 -> c_1		(constant 1)
+	2 -> c_2		(constant 2)
+	1000 -> c_1000		(constant 1000)
+	1000000 -> c_b<memno>	(big constant number)
+	1.2 -> c_1_2		(constant 1.2)
+	1.234345 -> c_b<memno>	(big constant number)
+	-1 -> c_n1		(constant -1)
+	-1.0 -> c_n1_0		(constant -1.0)
+	.true. -> c_true	(constant true)
+	.false. -> c_false	(constant false)
+	default -> c_b<memno>	(default label)
+*/
+
+ char *
+#ifdef KR_headers
+lit_name(litp)
+	struct Literal *litp;
+#else
+lit_name(struct Literal *litp)
+#endif
+{
+	static char buf[CONST_IDENT_MAX];
+	ftnint val;
+	char *fmt;
+
+	if (litp == (struct Literal *) NULL)
+		return NULL;
+
+	switch (litp -> littype) {
+	case TYINT1:
+		val = litp -> litval.litival;
+		if (val >= 256 || val < -255)
+			sprintf (buf, "ci1_b%ld", litp -> litnum);
+		else if (val < 0)
+			sprintf (buf, "ci1_n%ld", -val);
+		else
+			sprintf(buf, "ci1__%ld", val);
+		break;
+        case TYSHORT:
+		val = litp -> litval.litival;
+		if (val >= 32768 || val <= -32769)
+			sprintf (buf, "cs_b%ld", litp -> litnum);
+		else if (val < 0)
+			sprintf (buf, "cs_n%ld", -val);
+		else
+			sprintf (buf, "cs__%ld", val);
+		break;
+	case TYLONG:
+#ifdef TYQUAD
+	case TYQUAD:
+#endif
+		val = litp -> litval.litival;
+		if (val >= 100000 || val <= -10000)
+			sprintf (buf, "c_b%ld", litp -> litnum);
+		else if (val < 0)
+			sprintf (buf, "c_n%ld", -val);
+		else
+			sprintf (buf, "c__%ld", val);
+		break;
+	case TYLOGICAL1:
+		fmt = "cl1_%s";
+		goto spr_logical;
+	case TYLOGICAL2:
+		fmt = "cl2_%s";
+		goto spr_logical;
+	case TYLOGICAL:
+		fmt = "c_%s";
+	spr_logical:
+		sprintf (buf, fmt, (litp -> litval.litival
+					? "true" : "false"));
+		break;
+	case TYREAL:
+	case TYDREAL:
+		/* Given a limit of 6 or 8 character on external names,	*/
+		/* few f.p. values can be meaningfully encoded in the	*/
+		/* constant name.  Just going with the default cb_#	*/
+		/* seems to be the best course for floating-point	*/
+		/* constants.	*/
+	case TYCHAR:
+		/* Shouldn't be any of these */
+	case TYADDR:
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+	case TYSUBR:
+	default:
+		sprintf (buf, "c_b%ld", litp -> litnum);
+    } /* switch */
+    return buf;
+} /* lit_name */
+
+
+
+ char *
+#ifdef KR_headers
+comm_union_name(count)
+	int count;
+#else
+comm_union_name(int count)
+#endif
+{
+	static char buf[12];
+
+	sprintf(buf, "%d", count);
+	return buf;
+	}
+
+
+
+
+/* wr_globals -- after every function has been translated, we need to
+   output the global declarations, such as the static table of constant
+   values */
+
+ void
+#ifdef KR_headers
+wr_globals(outfile)
+	FILE *outfile;
+#else
+wr_globals(FILE *outfile)
+#endif
+{
+    struct Literal *litp, *lastlit;
+    extern int hsize;
+    char *litname;
+    int did_one, t;
+    struct Constblock cb;
+    ftnint x, y;
+
+    if (nliterals == 0)
+	return;
+
+    lastlit = litpool + nliterals;
+    did_one = 0;
+    for (litp = litpool; litp < lastlit; litp++) {
+	if (!litp->lituse)
+		continue;
+	litname = lit_name(litp);
+	if (!did_one) {
+		margin_printf(outfile, "/* Table of constant values */\n\n");
+		did_one = 1;
+		}
+	cb.vtype = litp->littype;
+	if (litp->littype == TYCHAR) {
+		x = litp->litval.litival2[0] + litp->litval.litival2[1];
+		if (y = x % hsize)
+			x += y = hsize - y;
+		nice_printf(outfile,
+			"static struct { %s fill; char val[%ld+1];", halign, x);
+		nice_printf(outfile, " char fill2[%ld];", hsize - 1);
+		nice_printf(outfile, " } %s_st = { 0,", litname);
+		cb.vleng = ICON(litp->litval.litival2[0]);
+		cb.Const.ccp = litp->cds[0];
+		cb.Const.ccp1.blanks = litp->litval.litival2[1] + y;
+		cb.vtype = TYCHAR;
+		out_const(outfile, &cb);
+		frexpr(cb.vleng);
+		nice_printf(outfile, " };\n");
+		nice_printf(outfile, "#define %s %s_st.val\n", litname, litname);
+		continue;
+		}
+	nice_printf(outfile, "static %s %s = ",
+		c_type_decl(litp->littype,0), litname);
+
+	t = litp->littype;
+	if (ONEOF(t, MSKREAL|MSKCOMPLEX)) {
+		cb.vstg = 1;
+		cb.Const.cds[0] = litp->cds[0];
+		cb.Const.cds[1] = litp->cds[1];
+		}
+	else {
+		memcpy((char *)&cb.Const, (char *)&litp->litval,
+			sizeof(cb.Const));
+		cb.vstg = 0;
+		}
+	out_const(outfile, &cb);
+
+	nice_printf (outfile, ";\n");
+    } /* for */
+    if (did_one)
+    	nice_printf (outfile, "\n");
+} /* wr_globals */
+
+ ftnint
+#ifdef KR_headers
+commlen(vl)
+	register chainp vl;
+#else
+commlen(register chainp vl)
+#endif
+{
+	ftnint size;
+	int type;
+	struct Dimblock *t;
+	Namep v;
+
+	while(vl->nextp)
+		vl = vl->nextp;
+	v = (Namep)vl->datap;
+	type = v->vtype;
+	if (type == TYCHAR)
+		size = v->vleng->constblock.Const.ci;
+	else
+		size = typesize[type];
+	if ((t = v->vdim) && ISCONST(t->nelt))
+		size *= t->nelt->constblock.Const.ci;
+	return size + v->voffset;
+	}
+
+ static void	/* Pad common block if an EQUIVALENCE extended it. */
+#ifdef KR_headers
+pad_common(c)
+	Extsym *c;
+#else
+pad_common(Extsym *c)
+#endif
+{
+	register chainp cvl;
+	register Namep v;
+	long L = c->maxleng;
+	int type;
+	struct Dimblock *t;
+	int szshort = typesize[TYSHORT];
+
+	for(cvl = c->allextp; cvl; cvl = cvl->nextp)
+		if (commlen((chainp)cvl->datap) >= L)
+			return;
+	v = ALLOC(Nameblock);
+	v->vtype = type = L % szshort ? TYCHAR
+				      : type_choice[L/szshort % 4];
+	v->vstg = STGCOMMON;
+	v->vclass = CLVAR;
+	v->tag = TNAME;
+	v->vdim = t = ALLOC(Dimblock);
+	t->ndim = 1;
+	t->dims[0].dimsize = ICON(L / typesize[type]);
+	v->fvarname = v->cvarname = "eqv_pad";
+	if (type == TYCHAR)
+		v->vleng = ICON(1);
+	c->allextp = mkchain((char *)mkchain((char *)v, CHNULL), c->allextp);
+	}
+
+
+/* wr_common_decls -- outputs the common declarations in one of three
+   formats.  If all references to a common block look the same (field
+   names and types agree), only one actual declaration will appear.
+   Otherwise, the same block will require many structs.  If there is no
+   block data, these structs will be union'ed together (so the linker
+   knows the size of the largest one).  If there IS a block data, only
+   that version will be associated with the variable, others will only be
+   defined as types, so the pointer can be cast to it.  e.g.
+
+	FORTRAN				C
+----------------------------------------------------------------------
+	common /com1/ a, b, c		struct { real a, b, c; } com1_;
+
+	common /com1/ a, b, c		union {
+	common /com1/ i, j, k		    struct { real a, b, c; } _1;
+					    struct { integer i, j, k; } _2;
+					} com1_;
+
+	common /com1/ a, b, c		struct com1_1_ { real a, b, c; };
+	block data			struct { integer i, j, k; } com1_ =
+	common /com1/ i, j, k		  { 1, 2, 3 };
+	data i/1/, j/2/, k/3/
+
+
+   All of these versions will be followed by #defines, since the code in
+   the function bodies can't know ahead of time which of these options
+   will be taken */
+
+/* Macros for deciding the output type */
+
+#define ONE_STRUCT 1
+#define UNION_STRUCT 2
+#define INIT_STRUCT 3
+
+ void
+#ifdef KR_headers
+wr_common_decls(outfile)
+	FILE *outfile;
+#else
+wr_common_decls(FILE *outfile)
+#endif
+{
+    Extsym *ext;
+    extern int extcomm;
+    static char *Extern[4] = {"", "Extern ", "extern "};
+    char *E, *E0 = Extern[extcomm];
+    int did_one = 0;
+
+    for (ext = extsymtab; ext < nextext; ext++) {
+	if (ext -> extstg == STGCOMMON && ext->allextp) {
+	    chainp comm;
+	    int count = 1;
+	    int which;			/* which display to use;
+					   ONE_STRUCT, UNION or INIT */
+
+	    if (!did_one)
+		nice_printf (outfile, "/* Common Block Declarations */\n\n");
+
+	    pad_common(ext);
+
+/* Construct the proper, condensed list of structs; eliminate duplicates
+   from the initial list   ext -> allextp   */
+
+	    comm = ext->allextp = revchain(ext->allextp);
+
+	    if (ext -> extinit)
+		which = INIT_STRUCT;
+	    else if (comm->nextp) {
+		which = UNION_STRUCT;
+		nice_printf (outfile, "%sunion {\n", E0);
+		next_tab (outfile);
+		E = "";
+		}
+	    else {
+		which = ONE_STRUCT;
+		E = E0;
+		}
+
+	    for (; comm; comm = comm -> nextp, count++) {
+
+		if (which == INIT_STRUCT)
+		    nice_printf (outfile, "struct %s%d_ {\n",
+			    ext->cextname, count);
+		else
+		    nice_printf (outfile, "%sstruct {\n", E);
+
+		next_tab (c_file);
+
+		wr_struct (outfile, (chainp) comm -> datap);
+
+		prev_tab (c_file);
+		if (which == UNION_STRUCT)
+		    nice_printf (outfile, "} _%d;\n", count);
+		else if (which == ONE_STRUCT)
+		    nice_printf (outfile, "} %s;\n", ext->cextname);
+		else
+		    nice_printf (outfile, "};\n");
+	    } /* for */
+
+	    if (which == UNION_STRUCT) {
+		prev_tab (c_file);
+		nice_printf (outfile, "} %s;\n", ext->cextname);
+	    } /* if */
+	    did_one = 1;
+	    nice_printf (outfile, "\n");
+
+	    for (count = 1, comm = ext -> allextp; comm;
+		    comm = comm -> nextp, count++) {
+		def_start(outfile, ext->cextname,
+			comm_union_name(count), "");
+		switch (which) {
+		    case ONE_STRUCT:
+		        extern_out (outfile, ext);
+		        break;
+		    case UNION_STRUCT:
+		        nice_printf (outfile, "(");
+			extern_out (outfile, ext);
+			nice_printf(outfile, "._%d)", count);
+		        break;
+		    case INIT_STRUCT:
+			nice_printf (outfile, "(*(struct ");
+			extern_out (outfile, ext);
+			nice_printf (outfile, "%d_ *) &", count);
+			extern_out (outfile, ext);
+			nice_printf (outfile, ")");
+		        break;
+		} /* switch */
+		nice_printf (outfile, "\n");
+	    } /* for count = 1, comm = ext -> allextp */
+	    nice_printf (outfile, "\n");
+	} /* if ext -> extstg == STGCOMMON */
+    } /* for ext = extsymtab */
+} /* wr_common_decls */
+
+ void
+#ifdef KR_headers
+wr_struct(outfile, var_list)
+	FILE *outfile;
+	chainp var_list;
+#else
+wr_struct(FILE *outfile, chainp var_list)
+#endif
+{
+    int last_type = -1;
+    int did_one = 0;
+    chainp this_var;
+
+    for (this_var = var_list; this_var; this_var = this_var -> nextp) {
+	Namep var = (Namep) this_var -> datap;
+	int type;
+	char *comment = NULL;
+
+	if (var == (Namep) NULL)
+	    err ("wr_struct:  null variable");
+	else if (var -> tag != TNAME)
+	    erri ("wr_struct:  bad tag on variable '%d'",
+		    var -> tag);
+
+	type = var -> vtype;
+
+	if (last_type == type && did_one)
+	    nice_printf (outfile, ", ");
+	else {
+	    if (did_one)
+		nice_printf (outfile, ";\n");
+	    nice_printf (outfile, "%s ",
+		    c_type_decl (type, var -> vclass == CLPROC));
+	} /* else */
+
+/* Character type is really a string type.  Put out a '*' for parameters
+   with unknown length and functions returning character */
+
+	if (var -> vtype == TYCHAR && (!ISICON ((var -> vleng))
+		|| var -> vclass == CLPROC))
+	    nice_printf (outfile, "*");
+
+	var -> vstg = STGAUTO;
+	out_name (outfile, var);
+	if (var -> vclass == CLPROC)
+	    nice_printf (outfile, "()");
+	else if (var -> vdim)
+	    comment = wr_ardecls(outfile, var->vdim,
+				var->vtype == TYCHAR && ISICON(var->vleng)
+				? var->vleng->constblock.Const.ci : 1L);
+	else if (var -> vtype == TYCHAR && var -> vclass != CLPROC &&
+	    ISICON ((var -> vleng)))
+	    nice_printf (outfile, "[%ld]",
+		    var -> vleng -> constblock.Const.ci);
+
+	if (comment)
+	    nice_printf (outfile, "%s", comment);
+	did_one = 1;
+	last_type = type;
+    } /* for this_var */
+
+    if (did_one)
+	nice_printf (outfile, ";\n");
+} /* wr_struct */
+
+
+ char *
+#ifdef KR_headers
+user_label(stateno)
+	ftnint stateno;
+#else
+user_label(ftnint stateno)
+#endif
+{
+	static char buf[USER_LABEL_MAX + 1];
+	static char *Lfmt[2] = { "L_%ld", "L%ld" };
+
+	if (stateno >= 0)
+		sprintf(buf, Lfmt[shiftcase], stateno);
+	else
+		sprintf(buf, "L_%s", extsymtab[-1-stateno].fextname);
+	return buf;
+} /* user_label */
+
+
+ char *
+#ifdef KR_headers
+temp_name(starter, num, storage)
+	char *starter;
+	int num;
+	char *storage;
+#else
+temp_name(char *starter, int num, char *storage)
+#endif
+{
+    static char buf[IDENT_LEN];
+    char *pointer = buf;
+    char *prefix = "t";
+
+    if (storage)
+	pointer = storage;
+
+    if (starter && *starter)
+	prefix = starter;
+
+    sprintf (pointer, "%s__%d", prefix, num);
+    return pointer;
+} /* temp_name */
+
+
+ char *
+#ifdef KR_headers
+equiv_name(memno, store)
+	int memno;
+	char *store;
+#else
+equiv_name(int memno, char *store)
+#endif
+{
+    static char buf[IDENT_LEN];
+    char *pointer = buf;
+
+    if (store)
+	pointer = store;
+
+    sprintf (pointer, "%s_%d", EQUIV_INIT_NAME, memno);
+    return pointer;
+} /* equiv_name */
+
+ void
+#ifdef KR_headers
+def_commons(of)
+	FILE *of;
+#else
+def_commons(FILE *of)
+#endif
+{
+	Extsym *ext;
+	int c, onefile, Union;
+	chainp comm;
+	extern int ext1comm;
+	FILE *c_filesave = c_file;
+
+	if (ext1comm == 1) {
+		onefile = 1;
+		c_file = of;
+		fprintf(of, "/*>>>'/dev/null'<<<*/\n\
+#ifdef Define_COMMONs\n\
+/*<<</dev/null>>>*/\n");
+		}
+	else
+		onefile = 0;
+	for(ext = extsymtab; ext < nextext; ext++)
+		if (ext->extstg == STGCOMMON
+		&& !ext->extinit && (comm = ext->allextp)) {
+			sprintf(outbtail, "%scom.c", ext->cextname);
+			if (onefile)
+				fprintf(of, "/*>>>'%s'<<<*/\n",
+					outbtail);
+			else {
+				c_file = of = fopen(outbuf,textwrite);
+				if (!of)
+					fatalstr("can't open %s", outbuf);
+				}
+			fprintf(of, "#include \"f2c.h\"\n");
+			if (Ansi == 2)
+				fprintf(of,
+			 "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n");
+			if (comm->nextp) {
+				Union = 1;
+				nice_printf(of, "union {\n");
+				next_tab(of);
+				}
+			else
+				Union = 0;
+			for(c = 1; comm; comm = comm->nextp) {
+				nice_printf(of, "struct {\n");
+				next_tab(of);
+				wr_struct(of, (chainp)comm->datap);
+				prev_tab(of);
+				if (Union)
+					nice_printf(of, "} _%d;\n", c++);
+				}
+			if (Union)
+				prev_tab(of);
+			nice_printf(of, "} %s;\n", ext->cextname);
+			if (Ansi == 2)
+				fprintf(of,
+			 "\n#ifdef __cplusplus\n}\n#endif\n");
+			if (onefile)
+				fprintf(of, "/*<<<%s>>>*/\n", outbtail);
+			else
+				fclose(of);
+			}
+	if (onefile)
+		fprintf(of, "/*>>>'/dev/null'<<<*/\n#endif\n\
+/*<<</dev/null>>>*/\n");
+	c_file = c_filesave;
+	}
+
+/* C Language keywords.  Needed to filter unwanted fortran identifiers like
+ * "int", etc.  Source:  Kernighan & Ritchie, eds. 1 and 2; Stroustrup.
+ * Also includes C++ keywords and types used for I/O in f2c.h .
+ * These keywords must be in alphabetical order (as defined by strcmp()).
+ */
+
+char *c_keywords[] = {
+	"Long", "Multitype", "Namelist", "Vardesc", "abs", "acos",
+	"addr", "address", "aerr", "alist", "asin", "asm", "atan",
+	"atan2", "aunit", "auto", "break", "c", "case", "catch", "cdecl",
+	"cerr", "char", "ciend", "cierr", "cifmt", "cilist", "cirec",
+	"ciunit", "class", "cllist", "complex", "const", "continue", "cos",
+	"cosh", "csta", "cunit", "d", "dabs", "default", "defined",
+	"delete", "dims", "dmax", "dmin", "do", "double",
+	"doublecomplex", "doublereal", "else", "entry", "enum", "exp",
+	"extern", "false", "far", "flag", "float", "for", "friend",
+	"ftnint", "ftnlen", "goto", "h", "huge", "i", "iciend", "icierr",
+	"icifmt", "icilist", "icirlen", "icirnum", "iciunit", "if",
+	"inacc", "inacclen", "inblank", "inblanklen", "include",
+	"indir", "indirlen", "inerr", "inex", "infile", "infilen",
+	"infmt", "infmtlen", "inform", "informlen", "inline", "inlist",
+	"inname", "innamed", "innamlen", "innrec", "innum", "inopen",
+	"inrecl", "inseq", "inseqlen", "int", "integer", "integer1",
+	"inunf", "inunflen", "inunit", "log", "logical", "logical1",
+	"long", "longint", "max", "min", "name", "near", "new", "nvars",
+	"oacc", "oblnk", "oerr", "ofm", "ofnm", "ofnmlen", "olist",
+	"operator", "orl", "osta", "ounit", "overload", "private",
+	"protected", "public", "r", "real", "register", "return",
+	"short", "shortint", "shortlogical", "signed", "sin", "sinh",
+	"sizeof", "sqrt", "static", "struct", "switch", "tan", "tanh",
+	"template", "this", "true", "try", "type", "typedef", "uinteger",
+	"ulongint", "union", "unsigned", "vars", "virtual", "void",
+	"volatile", "while", "z"
+	}; /* c_keywords */
+
+int n_keywords = sizeof(c_keywords)/sizeof(char *);
diff --git a/contrib/tools/f2c/src/names.h b/contrib/tools/f2c/src/names.h
new file mode 100644
index 0000000000..16bcc0b4ba
--- /dev/null
+++ b/contrib/tools/f2c/src/names.h
@@ -0,0 +1,19 @@
+#define CONST_IDENT_MAX 30
+#define IO_IDENT_MAX 30
+#define ARGUMENT_MAX 30
+#define USER_LABEL_MAX 30
+
+#define EQUIV_INIT_NAME "equiv"
+
+#define write_nv_ident(fp,a) wr_nv_ident_help ((fp), (struct Addrblock *) (a))
+#define nv_type(x) nv_type_help ((struct Addrblock *) x)
+
+extern char *c_keywords[];
+
+char*	c_type_decl Argdcl((int, int));
+void	declare_new_addr Argdcl((Addrp));
+char*	new_arg_length Argdcl((Namep));
+char*	new_func_length Argdcl((void));
+int	nv_type_help Argdcl((Addrp));
+char*	temp_name Argdcl((char*, int, char*));
+char*	user_label Argdcl((long int));
diff --git a/contrib/tools/f2c/src/niceprintf.c b/contrib/tools/f2c/src/niceprintf.c
new file mode 100644
index 0000000000..a32411c4e3
--- /dev/null
+++ b/contrib/tools/f2c/src/niceprintf.c
@@ -0,0 +1,445 @@
+/****************************************************************
+Copyright 1990, 1991, 1993, 1994, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "names.h"
+#include "output.h"
+#ifndef KR_headers
+#include "stdarg.h"
+#endif
+
+#define TOO_LONG_INDENT (2 * tab_size)
+#define MAX_INDENT 44
+#define MIN_INDENT 22
+static int last_was_newline = 0;
+int sharp_line = 0;
+int indent = 0;
+int in_comment = 0;
+int in_define = 0;
+ extern int gflag1;
+ extern char filename[];
+
+ static void ind_printf Argdcl((int, FILE*, const char*, va_list));
+
+ static void
+#ifdef KR_headers
+write_indent(fp, use_indent, extra_indent, start, end)
+	FILE *fp;
+	int use_indent;
+	int extra_indent;
+	char *start;
+	char *end;
+#else
+write_indent(FILE *fp, int use_indent, int extra_indent, char *start, char *end)
+#endif
+{
+    int ind, tab;
+
+    if (sharp_line) {
+	fprintf(fp, "#line %ld \"%s\"\n", lineno, filename);
+	sharp_line = 0;
+	}
+    if (in_define == 1) {
+	in_define = 2;
+	use_indent = 0;
+	}
+    if (last_was_newline && use_indent) {
+	if (*start == '\n') do {
+		putc('\n', fp);
+		if (++start > end)
+			return;
+		}
+		while(*start == '\n');
+
+	ind = indent <= MAX_INDENT
+		? indent
+		: MIN_INDENT + indent % (MAX_INDENT - MIN_INDENT);
+
+	tab = ind + extra_indent;
+
+	while (tab > 7) {
+	    putc ('\t', fp);
+	    tab -= 8;
+	} /* while */
+
+	while (tab-- > 0)
+	    putc (' ', fp);
+    } /* if last_was_newline */
+
+    while (start <= end)
+	putc (*start++, fp);
+} /* write_indent */
+
+#ifdef KR_headers
+/*VARARGS2*/
+  void
+ margin_printf (fp, a, b, c, d, e, f, g)
+  FILE *fp;
+  char *a;
+  long b, c, d, e, f, g;
+{
+    ind_printf (0, fp, a, b, c, d, e, f, g);
+} /* margin_printf */
+
+/*VARARGS2*/
+  void
+ nice_printf (fp, a, b, c, d, e, f, g)
+  FILE *fp;
+  char *a;
+  long b, c, d, e, f, g;
+{
+    ind_printf (1, fp, a, b, c, d, e, f, g);
+} /* nice_printf */
+#define SPRINTF(x,a,b,c,d,e,f,g) sprintf(x,a,b,c,d,e,f,g)
+
+#else /* if (!defined(KR_HEADERS)) */
+
+#define SPRINTF(x,a,b,c,d,e,f,g) vsprintf(x,a,ap)
+
+  void
+ margin_printf(FILE *fp, const char *fmt, ...)
+{
+	va_list ap;
+	va_start(ap,fmt);
+	ind_printf(0, fp, fmt, ap);
+	va_end(ap);
+	}
+
+  void
+ nice_printf(FILE *fp, const char *fmt, ...)
+{
+	va_list ap;
+	va_start(ap,fmt);
+	ind_printf(1, fp, fmt, ap);
+	va_end(ap);
+	}
+#endif
+
+#define  max_line_len c_output_line_length
+ 		/* 74Number of characters allowed on an output
+			           line.  This assumes newlines are handled
+			           nicely, i.e. a newline after a full text
+			           line on a terminal is ignored */
+
+/* output_buf   holds the text of the next line to be printed.  It gets
+   flushed when a newline is printed.   next_slot   points to the next
+   available location in the output buffer, i.e. where the next call to
+   nice_printf will have its output stored */
+
+static char *output_buf;
+static char *next_slot;
+static char *string_start;
+
+static char *word_start = NULL;
+static int cursor_pos = 0;
+static int In_string = 0;
+
+ void
+np_init(Void)
+{
+	next_slot = output_buf = Alloc(MAX_OUTPUT_SIZE);
+	memset(output_buf, 0, MAX_OUTPUT_SIZE);
+	}
+
+ static char *
+#ifdef KR_headers
+adjust_pointer_in_string(pointer)
+	register char *pointer;
+#else
+adjust_pointer_in_string(register char *pointer)
+#endif
+{
+	register char *s, *s1, *se, *s0;
+
+	/* arrange not to break \002 */
+	s1 = string_start ? string_start : output_buf;
+	for(s = s1; s < pointer; s++) {
+		s0 = s1;
+		s1 = s;
+		if (*s == '\\') {
+			se = s++ + 4;
+			if (se > pointer)
+				break;
+			if (*s < '0' || *s > '7')
+				continue;
+			while(++s < se)
+				if (*s < '0' || *s > '7')
+					break;
+			--s;
+			}
+		}
+	return s0 - 1;
+	}
+
+/* ANSI says strcpy's behavior is undefined for overlapping args,
+ * so we roll our own fwd_strcpy: */
+
+ static void
+#ifdef KR_headers
+fwd_strcpy(t, s)
+	register char *t;
+	register char *s;
+#else
+fwd_strcpy(register char *t, register char *s)
+#endif
+{ while(*t++ = *s++); }
+
+/* isident -- true iff character could belong to a unit.  C allows
+   letters, numbers and underscores in identifiers.  This also doubles as
+   a check for numeric constants, since we include the decimal point and
+   minus sign.  The minus has to be here, since the constant "10e-2"
+   cannot be broken up.  The '.' also prevents structure references from
+   being broken, which is a quite acceptable side effect */
+
+#define isident(x) (Tr[x] & 1)
+#define isntident(x) (!Tr[x])
+
+  static void
+#ifdef KR_headers
+ ind_printf (use_indent, fp, a, b, c, d, e, f, g)
+  int use_indent;
+  FILE *fp;
+  char *a;
+  long b, c, d, e, f, g;
+#else
+ ind_printf (int use_indent, FILE *fp, const char *a, va_list ap)
+#endif
+{
+    extern int max_line_len;
+    extern FILEP c_file;
+    extern char tr_tab[];	/* in output.c */
+    register char *Tr = tr_tab;
+    int ch, cmax, inc, ind;
+    static int extra_indent, last_indent, set_cursor = 1;
+
+    cursor_pos += indent - last_indent;
+    last_indent = indent;
+    SPRINTF (next_slot, a, b, c, d, e, f, g);
+
+    if (fp != c_file) {
+	fprintf (fp,"%s", next_slot);
+	return;
+    } /* if fp != c_file */
+
+    do {
+	char *pointer;
+
+/* The   for   loop will parse one output line */
+
+	if (set_cursor) {
+		ind = indent <= MAX_INDENT
+			? indent
+			: MIN_INDENT + indent % (MAX_INDENT - MIN_INDENT);
+		cursor_pos = extra_indent;
+		if (use_indent)
+			cursor_pos += ind;
+		set_cursor = 0;
+		}
+	if (in_comment) {
+		cmax = max_line_len + 32;	/* let comments be wider */
+        	for (pointer = next_slot; *pointer && *pointer != '\n' &&
+				cursor_pos <= cmax; pointer++)
+			cursor_pos++;
+		}
+	else
+          for (pointer = next_slot; *pointer && *pointer != '\n' &&
+		cursor_pos <= max_line_len; pointer++) {
+
+	    /* Update state variables here */
+
+	    if (In_string) {
+		switch(*pointer) {
+			case '\\':
+				if (++cursor_pos > max_line_len) {
+					cursor_pos -= 2;
+					--pointer;
+					goto overflow;
+					}
+				++pointer;
+				break;
+			case '"':
+				In_string = 0;
+				word_start = 0;
+			}
+		}
+	    else switch (*pointer) {
+	        case '"':
+			if (cursor_pos + 5 > max_line_len) {
+				word_start = 0;
+				--pointer;
+				goto overflow;
+				}
+			In_string = 1;
+			string_start = word_start = pointer;
+		    	break;
+	        case '\'':
+			if (pointer[1] == '\\')
+				if ((ch = pointer[2]) >= '0' && ch <= '7')
+					for(inc = 3; pointer[inc] != '\''
+						&& ++inc < 5;);
+				else
+					inc = 3;
+			else
+				inc = 2;
+			/*debug*/ if (pointer[inc] != '\'')
+			/*debug*/  fatalstr("Bad character constant %.10s",
+					pointer);
+			if ((cursor_pos += inc) > max_line_len) {
+				cursor_pos -= inc;
+				word_start = 0;
+				--pointer;
+				goto overflow;
+				}
+			word_start = pointer;
+			pointer += inc;
+			break;
+		case '\t':
+		    cursor_pos = 8 * ((cursor_pos + 8) / 8) - 1;
+		    break;
+		default: {
+
+/* HACK  Assumes that all characters in an atomic C token will be written
+   at the same time.  Must check for tokens first, since '-' is considered
+   part of an identifier; checking isident first would mean breaking up "->" */
+
+		    if (word_start) {
+			if (isntident(*(unsigned char *)pointer))
+				word_start = NULL;
+			}
+		    else if (isident(*(unsigned char *)pointer))
+			word_start = pointer;
+		    break;
+		} /* default */
+	    } /* switch */
+	    cursor_pos++;
+	} /* for pointer = next_slot */
+ overflow:
+	if (*pointer == '\0') {
+
+/* The output line is not complete, so break out and don't output
+   anything.  The current line fragment will be stored in the buffer */
+
+	    next_slot = pointer;
+	    break;
+	} else {
+	    char last_char;
+	    int in_string0 = In_string;
+
+/* If the line was too long, move   pointer   back to the character before
+   the current word.  This allows line breaking on word boundaries.  Make
+   sure that 80 character comment lines get broken up somehow.  We assume
+   that any non-string 80 character identifier must be in a comment.
+*/
+
+	    if (*pointer == '\n')
+		in_define = 0;
+	    else if (word_start && word_start > output_buf)
+		if (In_string)
+			if (string_start && pointer - string_start < 5)
+				pointer = string_start - 1;
+			else {
+				pointer = adjust_pointer_in_string(pointer);
+				string_start = 0;
+				}
+		else if (word_start == string_start
+				&& pointer - string_start >= 5) {
+			pointer = adjust_pointer_in_string(next_slot);
+			In_string = 1;
+			string_start = 0;
+			}
+		else
+			pointer = word_start - 1;
+	    else if (cursor_pos > max_line_len) {
+#ifndef ANSI_Libraries
+		extern char *strchr();
+#endif
+		if (In_string) {
+			pointer = adjust_pointer_in_string(pointer);
+			if (string_start && pointer > string_start)
+				string_start = 0;
+			}
+		else if (strchr("&*+-/<=>|", *pointer)
+			&& strchr("!%&*+-/<=>^|", pointer[-1])) {
+			pointer -= 2;
+			if (strchr("<>", *pointer)) /* <<=, >>= */
+				pointer--;
+			}
+		else {
+			if (word_start)
+				while(isident(*(unsigned char *)pointer))
+					pointer++;
+			pointer--;
+			}
+		}
+	    last_char = *pointer;
+	    write_indent(fp, use_indent, extra_indent, output_buf, pointer);
+	    next_slot = output_buf;
+	    if (In_string && !string_start && Ansi == 1 && last_char != '\n')
+		*next_slot++ = '"';
+	    fwd_strcpy(next_slot, pointer + 1);
+
+/* insert a line break */
+
+	    if (last_char == '\n') {
+		if (In_string)
+			last_was_newline = 0;
+		else {
+			last_was_newline = 1;
+			extra_indent = 0;
+			sharp_line = gflag1;
+			}
+		}
+	    else {
+		extra_indent = TOO_LONG_INDENT;
+		if (In_string && !string_start) {
+			if (Ansi == 1) {
+				fprintf(fp, gflag1 ? "\"\\\n" : "\"\n");
+				use_indent = 1;
+				last_was_newline = 1;
+				}
+			else {
+				fprintf(fp, "\\\n");
+				last_was_newline = 0;
+				}
+			In_string = in_string0;
+			}
+		else {
+			if (in_define/* | gflag1*/)
+				putc('\\', fp);
+			putc ('\n', fp);
+			last_was_newline = 1;
+			}
+	    } /* if *pointer != '\n' */
+
+	    if (In_string && Ansi != 1 && !string_start)
+		cursor_pos = 0;
+	    else
+		set_cursor = 1;
+
+	    string_start = word_start = NULL;
+
+	} /* else */
+
+    } while (*next_slot);
+
+} /* ind_printf */
diff --git a/contrib/tools/f2c/src/niceprintf.h b/contrib/tools/f2c/src/niceprintf.h
new file mode 100644
index 0000000000..24c65d4db0
--- /dev/null
+++ b/contrib/tools/f2c/src/niceprintf.h
@@ -0,0 +1,16 @@
+/* niceprintf.h -- contains constants and macros from the output filter
+   for the generated C code.  We use macros for increased speed, less
+   function overhead.  */
+
+#define MAX_OUTPUT_SIZE 6000	/* Number of chars on one output line PLUS
+				   the length of the longest string
+				   printed using   nice_printf   */
+
+
+
+#define next_tab(fp) (indent += tab_size)
+
+#define prev_tab(fp) (indent -= tab_size)
+
+
+
diff --git a/contrib/tools/f2c/src/output.c b/contrib/tools/f2c/src/output.c
new file mode 100644
index 0000000000..c734ca94bc
--- /dev/null
+++ b/contrib/tools/f2c/src/output.c
@@ -0,0 +1,1753 @@
+/****************************************************************
+Copyright 1990-1996, 2000-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "names.h"
+#include "output.h"
+
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef FALSE
+#define FALSE 0
+#endif
+
+char _assoc_table[] = { 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 };
+
+/* Opcode table -- This array is indexed by the OP_____ macros defined in
+   defines.h; these macros are expected to be adjacent integers, so that
+   this table is as small as possible. */
+
+table_entry opcode_table[] = {
+				{ 0, 0, NULL },
+	/* OPPLUS 1 */		{ BINARY_OP, 12, "%l + %r" },
+	/* OPMINUS 2 */		{ BINARY_OP, 12, "%l - %r" },
+	/* OPSTAR 3 */		{ BINARY_OP, 13, "%l * %r" },
+	/* OPSLASH 4 */		{ BINARY_OP, 13, "%l / %r" },
+	/* OPPOWER 5 */		{ BINARY_OP,  0, "power (%l, %r)" },
+	/* OPNEG 6 */		{ UNARY_OP,  14, "-%l" },
+	/* OPOR 7 */		{ BINARY_OP,  4, "%l || %r" },
+	/* OPAND 8 */		{ BINARY_OP,  5, "%l && %r" },
+	/* OPEQV 9 */		{ BINARY_OP,  9, "%l == %r" },
+	/* OPNEQV 10 */		{ BINARY_OP,  9, "%l != %r" },
+	/* OPNOT 11 */		{ UNARY_OP,  14, "! %l" },
+	/* OPCONCAT 12 */	{ BINARY_OP,  0, "concat (%l, %r)" },
+	/* OPLT 13 */		{ BINARY_OP, 10, "%l < %r" },
+	/* OPEQ 14 */		{ BINARY_OP,  9, "%l == %r" },
+	/* OPGT 15 */		{ BINARY_OP, 10, "%l > %r" },
+	/* OPLE 16 */		{ BINARY_OP, 10, "%l <= %r" },
+	/* OPNE 17 */		{ BINARY_OP,  9, "%l != %r" },
+	/* OPGE 18 */		{ BINARY_OP, 10, "%l >= %r" },
+	/* OPCALL 19 */		{ BINARY_OP, 15, SPECIAL_FMT },
+	/* OPCCALL 20 */	{ BINARY_OP, 15, SPECIAL_FMT },
+
+/* Left hand side of an assignment cannot have outermost parens */
+
+	/* OPASSIGN 21 */	{ BINARY_OP,  2, "%l = %r" },
+	/* OPPLUSEQ 22 */	{ BINARY_OP,  2, "%l += %r" },
+	/* OPSTAREQ 23 */	{ BINARY_OP,  2, "%l *= %r" },
+	/* OPCONV 24 */		{ BINARY_OP, 14, "%l" },
+	/* OPLSHIFT 25 */	{ BINARY_OP, 11, "%l << %r" },
+	/* OPMOD 26 */		{ BINARY_OP, 13, "%l %% %r" },
+	/* OPCOMMA 27 */	{ BINARY_OP,  1, "%l, %r" },
+
+/* Don't want to nest the colon operator in parens */
+
+	/* OPQUEST 28 */	{ BINARY_OP, 3, "%l ? %r" },
+	/* OPCOLON 29 */	{ BINARY_OP, 3, "%l : %r" },
+	/* OPABS 30 */		{ UNARY_OP,  0, "abs(%l)" },
+	/* OPMIN 31 */		{ BINARY_OP,   0, SPECIAL_FMT },
+	/* OPMAX 32 */		{ BINARY_OP,   0, SPECIAL_FMT },
+	/* OPADDR 33 */		{ UNARY_OP, 14, "&%l" },
+
+	/* OPCOMMA_ARG 34 */	{ BINARY_OP, 15, SPECIAL_FMT },
+	/* OPBITOR 35 */	{ BINARY_OP,  6, "%l | %r" },
+	/* OPBITAND 36 */	{ BINARY_OP,  8, "%l & %r" },
+	/* OPBITXOR 37 */	{ BINARY_OP,  7, "%l ^ %r" },
+	/* OPBITNOT 38 */	{ UNARY_OP,  14, "~ %l" },
+	/* OPRSHIFT 39 */	{ BINARY_OP, 11, "%l >> %r" },
+
+/* This isn't quite right -- it doesn't handle arrays, for instance */
+
+	/* OPWHATSIN 40 */	{ UNARY_OP,  14, "*%l" },
+	/* OPMINUSEQ 41 */	{ BINARY_OP,  2, "%l -= %r" },
+	/* OPSLASHEQ 42 */	{ BINARY_OP,  2, "%l /= %r" },
+	/* OPMODEQ 43 */	{ BINARY_OP,  2, "%l %%= %r" },
+	/* OPLSHIFTEQ 44 */	{ BINARY_OP,  2, "%l <<= %r" },
+	/* OPRSHIFTEQ 45 */	{ BINARY_OP,  2, "%l >>= %r" },
+	/* OPBITANDEQ 46 */	{ BINARY_OP,  2, "%l &= %r" },
+	/* OPBITXOREQ 47 */	{ BINARY_OP,  2, "%l ^= %r" },
+	/* OPBITOREQ 48 */	{ BINARY_OP,  2, "%l |= %r" },
+	/* OPPREINC 49 */	{ UNARY_OP,  14, "++%l" },
+	/* OPPREDEC 50 */	{ UNARY_OP,  14, "--%l" },
+	/* OPDOT 51 */		{ BINARY_OP, 15, "%l.%r" },
+	/* OPARROW 52 */	{ BINARY_OP, 15, "%l -> %r"},
+	/* OPNEG1 53 */		{ UNARY_OP,  14, "-%l" },
+	/* OPDMIN 54 */		{ BINARY_OP, 0, "dmin(%l,%r)" },
+	/* OPDMAX 55 */		{ BINARY_OP, 0, "dmax(%l,%r)" },
+	/* OPASSIGNI 56 */	{ BINARY_OP,  2, "%l = &%r" },
+	/* OPIDENTITY 57 */	{ UNARY_OP, 15, "%l" },
+	/* OPCHARCAST 58 */	{ UNARY_OP, 14, "(char *)&%l" },
+	/* OPDABS 59 */		{ UNARY_OP, 0, "dabs(%l)" },
+	/* OPMIN2 60 */		{ BINARY_OP,   0, "min(%l,%r)" },
+	/* OPMAX2 61 */		{ BINARY_OP,   0, "max(%l,%r)" },
+	/* OPBITTEST 62 */	{ BINARY_OP,   0, "bit_test(%l,%r)" },
+	/* OPBITCLR 63 */	{ BINARY_OP,   0, "bit_clear(%l,%r)" },
+	/* OPBITSET 64 */	{ BINARY_OP,   0, "bit_set(%l,%r)" },
+#ifdef TYQUAD
+	/* OPQBITCLR 65 */	{ BINARY_OP,   0, "qbit_clear(%l,%r)" },
+	/* OPQBITSET 66 */	{ BINARY_OP,   0, "qbit_set(%l,%r)" },
+#endif
+
+/* kludge to imitate (under forcedouble) f77's bizarre treatement of OPNEG... */
+
+	/* OPNEG KLUDGE */	{ UNARY_OP,  14, "-(doublereal)%l" }
+}; /* opcode_table */
+
+#define OPNEG_KLUDGE (sizeof(opcode_table)/sizeof(table_entry) - 1)
+
+extern int dneg, trapuv;
+static char opeqable[sizeof(opcode_table)/sizeof(table_entry)];
+
+
+static void output_arg_list Argdcl((FILEP, struct Listblock*));
+static void output_binary Argdcl((FILEP, Exprp));
+static void output_list Argdcl((FILEP, struct Listblock*));
+static void output_literal Argdcl((FILEP, long, Constp));
+static void output_prim Argdcl((FILEP, struct Primblock*));
+static void output_unary Argdcl((FILEP, Exprp));
+
+
+ void
+#ifdef KR_headers
+expr_out(fp, e)
+	FILE *fp;
+	expptr e;
+#else
+expr_out(FILE *fp, expptr e)
+#endif
+{
+	Namep var;
+	expptr leftp, rightp;
+	int opcode;
+
+    if (e == (expptr) NULL)
+	return;
+
+    switch (e -> tag) {
+	case TNAME:	out_name (fp, (struct Nameblock *) e);
+			return;
+
+	case TCONST:	out_const(fp, &e->constblock);
+			goto end_out;
+	case TEXPR:
+	    		break;
+
+	case TADDR:	out_addr (fp, &(e -> addrblock));
+			goto end_out;
+
+	case TPRIM:	if (!nerr)
+				warn ("expr_out: got TPRIM");
+			output_prim (fp, &(e -> primblock));
+			return;
+
+	case TLIST:	output_list (fp, &(e -> listblock));
+ end_out:		frexpr(e);
+			return;
+
+	case TIMPLDO:	err ("expr_out: got TIMPLDO");
+			return;
+
+	case TERROR:
+	default:
+			erri ("expr_out: bad tag '%d'", e -> tag);
+    } /* switch */
+
+/* Now we know that the tag is TEXPR */
+
+/* Optimize on simple expressions, such as "a = a + b" ==> "a += b" */
+
+    if (e -> exprblock.opcode == OPASSIGN && e -> exprblock.rightp)
+      switch(e->exprblock.rightp->tag) {
+	case TEXPR:
+	opcode = e -> exprblock.rightp -> exprblock.opcode;
+
+	if (opeqable[opcode]) {
+	    if ((leftp = e -> exprblock.leftp) &&
+		(rightp = e -> exprblock.rightp -> exprblock.leftp)) {
+
+		if (same_ident (leftp, rightp)) {
+		    expptr temp = e -> exprblock.rightp;
+
+		    e -> exprblock.opcode = op_assign(opcode);
+
+		    e -> exprblock.rightp = temp -> exprblock.rightp;
+		    temp->exprblock.rightp = 0;
+		    frexpr(temp);
+		} /* if same_ident (leftp, rightp) */
+	    } /* if leftp && rightp */
+	} /* if opcode == OPPLUS || */
+	break;
+
+	case TNAME:
+	  if (trapuv) {
+		var = &e->exprblock.rightp->nameblock;
+		if (ISREAL(var->vtype)
+		 && var->vclass == CLVAR
+		 && ONEOF(var->vstg, M(STGAUTO)|M(STGBSS))
+		 && !var->vsave) {
+			expr_out(fp, e -> exprblock.leftp);
+			nice_printf(fp, " = _0 + ");
+			expr_out(fp, e->exprblock.rightp);
+			goto done;
+			}
+		}
+      } /* if e -> exprblock.opcode == OPASSIGN */
+
+
+/* Optimize on increment or decrement by 1 */
+
+    {
+	opcode = e -> exprblock.opcode;
+	leftp = e -> exprblock.leftp;
+	rightp = e -> exprblock.rightp;
+
+	if (leftp && rightp && (leftp -> headblock.vstg == STGARG ||
+		ISINT (leftp -> headblock.vtype)) &&
+		(opcode == OPPLUSEQ || opcode == OPMINUSEQ) &&
+		ISINT (rightp -> headblock.vtype) &&
+		ISICON (e -> exprblock.rightp) &&
+		(ISONE (e -> exprblock.rightp) ||
+		e -> exprblock.rightp -> constblock.Const.ci == -1)) {
+
+/* Allow for the '-1' constant value */
+
+	    if (!ISONE (e -> exprblock.rightp))
+		opcode = (opcode == OPPLUSEQ) ? OPMINUSEQ : OPPLUSEQ;
+
+/* replace the existing opcode */
+
+	    if (opcode == OPPLUSEQ)
+		e -> exprblock.opcode = OPPREINC;
+	    else
+		e -> exprblock.opcode = OPPREDEC;
+
+/* Free up storage used by the right hand side */
+
+	    frexpr (e -> exprblock.rightp);
+	    e->exprblock.rightp = 0;
+	} /* if opcode == OPPLUS */
+    } /* block */
+
+
+    if (is_unary_op (e -> exprblock.opcode))
+	output_unary (fp, &(e -> exprblock));
+    else if (is_binary_op (e -> exprblock.opcode))
+	output_binary (fp, &(e -> exprblock));
+    else
+	erri ("expr_out: bad opcode '%d'", (int) e -> exprblock.opcode);
+
+ done:
+    free((char *)e);
+
+} /* expr_out */
+
+
+ void
+#ifdef KR_headers
+out_and_free_statement(outfile, expr)
+	FILE *outfile;
+	expptr expr;
+#else
+out_and_free_statement(FILE *outfile, expptr expr)
+#endif
+{
+    if (expr)
+	expr_out (outfile, expr);
+
+    nice_printf (outfile, ";\n");
+} /* out_and_free_statement */
+
+
+
+ int
+#ifdef KR_headers
+same_ident(left, right)
+	expptr left;
+	expptr right;
+#else
+same_ident(expptr left, expptr right)
+#endif
+{
+    if (!left || !right)
+	return 0;
+
+    if (left -> tag == TNAME && right -> tag == TNAME && left == right)
+	return 1;
+
+    if (left -> tag == TADDR && right -> tag == TADDR &&
+	    left -> addrblock.uname_tag == right -> addrblock.uname_tag)
+	switch (left -> addrblock.uname_tag) {
+	    case UNAM_REF:
+	    case UNAM_NAME:
+
+/* Check for array subscripts */
+
+		if (left -> addrblock.user.name -> vdim ||
+			right -> addrblock.user.name -> vdim)
+		    if (left -> addrblock.user.name !=
+			    right -> addrblock.user.name ||
+			    !same_expr (left -> addrblock.memoffset,
+			    right -> addrblock.memoffset))
+			return 0;
+
+		return same_ident ((expptr) (left -> addrblock.user.name),
+			(expptr) right -> addrblock.user.name);
+	    case UNAM_IDENT:
+		return strcmp(left->addrblock.user.ident,
+				right->addrblock.user.ident) == 0;
+	    case UNAM_CHARP:
+		return strcmp(left->addrblock.user.Charp,
+				right->addrblock.user.Charp) == 0;
+	    default:
+	        return 0;
+	} /* switch */
+
+    if (left->tag == TEXPR && left->exprblock.opcode == OPWHATSIN
+	&& right->tag == TEXPR && right->exprblock.opcode == OPWHATSIN)
+		return same_ident(left->exprblock.leftp,
+				 right->exprblock.leftp);
+
+    return 0;
+} /* same_ident */
+
+ static int
+#ifdef KR_headers
+samefpconst(c1, c2, n)
+	register Constp c1;
+	register Constp c2;
+	register int n;
+#else
+samefpconst(register Constp c1, register Constp c2, register int n)
+#endif
+{
+	char *s1, *s2;
+	if (!c1->vstg && !c2->vstg)
+		return c1->Const.cd[n] == c2->Const.cd[n];
+	s1 = c1->vstg ? c1->Const.cds[n] : dtos(c1->Const.cd[n]);
+	s2 = c2->vstg ? c2->Const.cds[n] : dtos(c2->Const.cd[n]);
+	return !strcmp(s1, s2);
+	}
+
+ static int
+#ifdef KR_headers
+sameconst(c1, c2)
+	register Constp c1;
+	register Constp c2;
+#else
+sameconst(register Constp c1, register Constp c2)
+#endif
+{
+	switch(c1->vtype) {
+		case TYCOMPLEX:
+		case TYDCOMPLEX:
+			if (!samefpconst(c1,c2,1))
+				return 0;
+		case TYREAL:
+		case TYDREAL:
+			return samefpconst(c1,c2,0);
+		case TYCHAR:
+			return c1->Const.ccp1.blanks == c2->Const.ccp1.blanks
+			    &&	   c1->vleng->constblock.Const.ci
+				== c2->vleng->constblock.Const.ci
+			    && !memcmp(c1->Const.ccp, c2->Const.ccp,
+					(int)c1->vleng->constblock.Const.ci);
+		case TYSHORT:
+		case TYINT:
+		case TYLOGICAL:
+			return c1->Const.ci == c2->Const.ci;
+		}
+	err("unexpected type in sameconst");
+	return 0;
+	}
+
+/* same_expr -- Returns true only if   e1 and e2   match.  This is
+   somewhat pessimistic, but can afford to be because it's just used to
+   optimize on the assignment operators (+=, -=, etc). */
+
+ int
+#ifdef KR_headers
+same_expr(e1, e2)
+	expptr e1;
+	expptr e2;
+#else
+same_expr(expptr e1, expptr e2)
+#endif
+{
+    if (!e1 || !e2)
+	return !e1 && !e2;
+
+    if (e1 -> tag != e2 -> tag || e1 -> headblock.vtype != e2 -> headblock.vtype)
+	return 0;
+
+    switch (e1 -> tag) {
+        case TEXPR:
+	    if (e1 -> exprblock.opcode != e2 -> exprblock.opcode)
+		return 0;
+
+	    return same_expr (e1 -> exprblock.leftp, e2 -> exprblock.leftp) &&
+		   same_expr (e1 -> exprblock.rightp, e2 -> exprblock.rightp);
+	case TNAME:
+	case TADDR:
+	    return same_ident (e1, e2);
+	case TCONST:
+	    return sameconst(&e1->constblock, &e2->constblock);
+	default:
+	    return 0;
+    } /* switch */
+} /* same_expr */
+
+
+
+ void
+#ifdef KR_headers
+out_name(fp, namep)
+	FILE *fp;
+	Namep namep;
+#else
+out_name(FILE *fp, Namep namep)
+#endif
+{
+    extern int usedefsforcommon;
+    Extsym *comm;
+
+    if (namep == NULL)
+	return;
+
+/* DON'T want to use oneof_stg() here; need to find the right common name
+   */
+
+    if (namep->vstg == STGCOMMON && !namep->vcommequiv && !usedefsforcommon) {
+	comm = &extsymtab[namep->vardesc.varno];
+	extern_out(fp, comm);
+	nice_printf(fp, "%d.", comm->curno);
+    } /* if namep -> vstg == STGCOMMON */
+
+    if (namep->vprocclass == PTHISPROC && namep->vtype != TYSUBR)
+	nice_printf(fp, xretslot[namep->vtype]->user.ident);
+    else
+	nice_printf (fp, "%s", namep->cvarname);
+} /* out_name */
+
+
+#define cpd(n) cp->vstg ? cp->Const.cds[n] : dtos(cp->Const.cd[n])
+
+ void
+#ifdef KR_headers
+out_const(fp, cp)
+	FILE *fp;
+	register Constp cp;
+#else
+out_const(FILE *fp, register Constp cp)
+#endif
+{
+    static char real_buf[50], imag_buf[50];
+    ftnint j;
+    unsigned int k;
+    int type = cp->vtype;
+
+    switch (type) {
+	case TYINT1:
+        case TYSHORT:
+	    nice_printf (fp, "%ld", cp->Const.ci);	/* don't cast ci! */
+	    break;
+	case TYLONG:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+	    nice_printf (fp, "%ld", cp->Const.ci);	/* don't cast ci! */
+	    break;
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		if (cp->Const.cd[1] == 123.456)
+			nice_printf (fp, "%s", cp->Const.cds[0]);
+		else
+			nice_printf (fp, "%lld", cp->Const.cq);
+		break;
+#endif
+	case TYREAL:
+	    nice_printf(fp, "%s", flconst(real_buf, cpd(0)));
+	    break;
+	case TYDREAL:
+	    nice_printf(fp, "%s", cpd(0));
+	    break;
+	case TYCOMPLEX:
+	    nice_printf(fp, cm_fmt_string, flconst(real_buf, cpd(0)),
+			flconst(imag_buf, cpd(1)));
+	    break;
+	case TYDCOMPLEX:
+	    nice_printf(fp, dcm_fmt_string, cpd(0), cpd(1));
+	    break;
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+	case TYLOGICAL:
+	    nice_printf (fp, "%s", cp->Const.ci ? "TRUE_" : "FALSE_");
+	    break;
+	case TYCHAR: {
+	    char *c = cp->Const.ccp, *ce;
+
+	    if (c == NULL) {
+		nice_printf (fp, "\"\"");
+		break;
+	    } /* if c == NULL */
+
+	    nice_printf (fp, "\"");
+	    ce = c + cp->vleng->constblock.Const.ci;
+	    while(c < ce) {
+		k = *(unsigned char *)c++;
+		nice_printf(fp, str_fmt[k]);
+		}
+	    for(j = cp->Const.ccp1.blanks; j > 0; j--)
+		nice_printf(fp, " ");
+	    nice_printf (fp, "\"");
+	    break;
+	} /* case TYCHAR */
+	default:
+	    erri ("out_const:  bad type '%d'", (int) type);
+	    break;
+    } /* switch */
+
+} /* out_const */
+#undef cpd
+
+ static void
+#ifdef KR_headers
+out_args(fp, ep)
+	FILE *fp;
+	expptr ep;
+#else
+out_args(FILE *fp, expptr ep)
+#endif
+{
+	chainp arglist;
+
+	if(ep->tag != TLIST)
+		badtag("out_args", ep->tag);
+	for(arglist = ep->listblock.listp;;) {
+		expr_out(fp, (expptr)arglist->datap);
+		arglist->datap = 0;
+		if (!(arglist = arglist->nextp))
+			break;
+		nice_printf(fp, ", ");
+		}
+	}
+
+
+/* out_addr -- this routine isn't local because it is called by the
+   system-generated identifier printing routines */
+
+ void
+#ifdef KR_headers
+out_addr(fp, addrp)
+	FILE *fp;
+	struct Addrblock *addrp;
+#else
+out_addr(FILE *fp, struct Addrblock *addrp)
+#endif
+{
+	extern Extsym *extsymtab;
+	int was_array = 0;
+	char *s;
+
+
+	if (addrp == NULL)
+		return;
+	if (doin_setbound
+			&& addrp->vstg == STGARG
+			&& addrp->vtype != TYCHAR
+			&& ISICON(addrp->memoffset)
+			&& !addrp->memoffset->constblock.Const.ci)
+		nice_printf(fp, "*");
+
+	switch (addrp -> uname_tag) {
+	    case UNAM_REF:
+		nice_printf(fp, "%s_%s(", addrp->user.name->cvarname,
+			addrp->cmplx_sub ? "subscr" : "ref");
+		out_args(fp, addrp->memoffset);
+		nice_printf(fp, ")");
+		return;
+	    case UNAM_NAME:
+		out_name (fp, addrp -> user.name);
+		break;
+	    case UNAM_IDENT:
+		if (*(s = addrp->user.ident) == ' ') {
+			if (multitype)
+				nice_printf(fp, "%s",
+					xretslot[addrp->vtype]->user.ident);
+			else
+				nice_printf(fp, "%s", s+1);
+			}
+		else {
+			nice_printf(fp, "%s", s);
+			}
+		break;
+	    case UNAM_CHARP:
+		nice_printf(fp, "%s", addrp->user.Charp);
+		break;
+	    case UNAM_EXTERN:
+		extern_out (fp, &extsymtab[addrp -> memno]);
+		break;
+	    case UNAM_CONST:
+		switch(addrp->vstg) {
+			case STGCONST:
+				out_const(fp, (Constp)addrp);
+				break;
+			case STGMEMNO:
+				output_literal (fp, addrp->memno,
+					(Constp)addrp);
+				break;
+			default:
+			Fatal("unexpected vstg in out_addr");
+			}
+		break;
+	    case UNAM_UNKNOWN:
+	    default:
+		nice_printf (fp, "Unknown Addrp");
+		break;
+	} /* switch */
+
+/* It's okay to just throw in the brackets here because they have a
+   precedence level of 15, the highest value.  */
+
+    if ((addrp->uname_tag == UNAM_NAME && addrp->user.name->vdim
+			|| addrp->ntempelt > 1 || addrp->isarray)
+	&& addrp->vtype != TYCHAR) {
+	expptr offset;
+
+	was_array = 1;
+
+	offset = addrp -> memoffset;
+	addrp->memoffset = 0;
+	if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
+		&& addrp -> uname_tag == UNAM_NAME
+		&& !addrp->skip_offset)
+	    offset = mkexpr (OPMINUS, offset, mkintcon (
+		    addrp -> user.name -> voffset));
+
+	nice_printf (fp, "[");
+
+	offset = mkexpr (OPSLASH, offset,
+		ICON (typesize[addrp -> vtype] * (addrp -> Field ? 2 : 1)));
+	expr_out (fp, offset);
+	nice_printf (fp, "]");
+	}
+
+/* Check for structure field reference */
+
+    if (addrp -> Field && addrp -> uname_tag != UNAM_CONST &&
+	    addrp -> uname_tag != UNAM_UNKNOWN) {
+	if (oneof_stg((addrp -> uname_tag == UNAM_NAME ? addrp -> user.name :
+		(Namep) NULL), addrp -> vstg, M(STGARG)|M(STGEQUIV))
+		&& !was_array && (addrp->vclass != CLPROC || !multitype))
+	    nice_printf (fp, "->%s", addrp -> Field);
+	else
+	    nice_printf (fp, ".%s", addrp -> Field);
+    } /* if */
+
+/* Check for character subscripting */
+
+    if (addrp->vtype == TYCHAR &&
+	    (addrp->vclass != CLPROC || addrp->uname_tag == UNAM_NAME
+			&& addrp->user.name->vprocclass == PTHISPROC) &&
+	    addrp -> memoffset &&
+	    (addrp -> uname_tag != UNAM_NAME ||
+	     addrp -> user.name -> vtype == TYCHAR) &&
+	    (!ISICON (addrp -> memoffset) ||
+	     (addrp -> memoffset -> constblock.Const.ci))) {
+
+	int use_paren = 0;
+	expptr e = addrp -> memoffset;
+
+	if (!e)
+		return;
+	addrp->memoffset = 0;
+
+	if (ONEOF(addrp->vstg, M(STGCOMMON)|M(STGEQUIV))
+	 && addrp -> uname_tag == UNAM_NAME) {
+	    e = mkexpr (OPMINUS, e, mkintcon (addrp -> user.name -> voffset));
+
+/* mkexpr will simplify it to zero if possible */
+	    if (e->tag == TCONST && e->constblock.Const.ci == 0)
+		return;
+	} /* if addrp -> vstg == STGCOMMON */
+
+/* In the worst case, parentheses might be needed OUTSIDE the expression,
+   too.  But since I think this subscripting can only appear as a
+   parameter in a procedure call, I don't think outside parens will ever
+   be needed.  INSIDE parens are handled below */
+
+	nice_printf (fp, " + ");
+	if (e -> tag == TEXPR) {
+	    int arg_prec = op_precedence (e -> exprblock.opcode);
+	    int prec = op_precedence (OPPLUS);
+	    use_paren = arg_prec && (arg_prec < prec || (arg_prec == prec &&
+		    is_left_assoc (OPPLUS)));
+	} /* if e -> tag == TEXPR */
+	if (use_paren) nice_printf (fp, "(");
+	expr_out (fp, e);
+	if (use_paren) nice_printf (fp, ")");
+    } /* if */
+} /* out_addr */
+
+
+ static void
+#ifdef KR_headers
+output_literal(fp, memno, cp)
+	FILE *fp;
+	long memno;
+	Constp cp;
+#else
+output_literal(FILE *fp, long memno, Constp cp)
+#endif
+{
+    struct Literal *litp, *lastlit;
+
+    lastlit = litpool + nliterals;
+
+    for (litp = litpool; litp < lastlit; litp++) {
+	if (litp -> litnum == memno)
+	    break;
+    } /* for litp */
+
+    if (litp >= lastlit)
+	out_const (fp, cp);
+    else {
+	nice_printf (fp, "%s", lit_name (litp));
+	litp->lituse++;
+	}
+} /* output_literal */
+
+
+ static void
+#ifdef KR_headers
+output_prim(fp, primp)
+	FILE *fp;
+	struct Primblock *primp;
+#else
+output_prim(FILE *fp, struct Primblock *primp)
+#endif
+{
+    if (primp == NULL)
+	return;
+
+    out_name (fp, primp -> namep);
+    if (primp -> argsp)
+	output_arg_list (fp, primp -> argsp);
+
+    if (primp -> fcharp != (expptr) NULL || primp -> lcharp != (expptr) NULL)
+	nice_printf (fp, "Sorry, no substrings yet");
+}
+
+
+
+ static void
+#ifdef KR_headers
+output_arg_list(fp, listp)
+	FILE *fp;
+	struct Listblock *listp;
+#else
+output_arg_list(FILE *fp, struct Listblock *listp)
+#endif
+{
+    chainp arg_list;
+
+    if (listp == (struct Listblock *) NULL || listp -> listp == (chainp) NULL)
+	return;
+
+    nice_printf (fp, "(");
+
+    for (arg_list = listp -> listp; arg_list; arg_list = arg_list -> nextp) {
+	expr_out (fp, (expptr) arg_list -> datap);
+	if (arg_list -> nextp != (chainp) NULL)
+
+/* Might want to add a hook in here to accomodate the style setting which
+   wants spaces after commas */
+
+	    nice_printf (fp, ",");
+    } /* for arg_list */
+
+    nice_printf (fp, ")");
+} /* output_arg_list */
+
+
+
+ static void
+#ifdef KR_headers
+output_unary(fp, e)
+	FILE *fp;
+	struct Exprblock *e;
+#else
+output_unary(FILE *fp, struct Exprblock *e)
+#endif
+{
+    if (e == NULL)
+	return;
+
+    switch (e -> opcode) {
+        case OPNEG:
+		if (e->vtype == TYREAL && dneg) {
+			e->opcode = OPNEG_KLUDGE;
+			output_binary(fp,e);
+			e->opcode = OPNEG;
+			break;
+			}
+	case OPNEG1:
+	case OPNOT:
+	case OPABS:
+	case OPBITNOT:
+	case OPWHATSIN:
+	case OPPREINC:
+	case OPPREDEC:
+	case OPADDR:
+	case OPIDENTITY:
+	case OPCHARCAST:
+	case OPDABS:
+	    output_binary (fp, e);
+	    break;
+	case OPCALL:
+	case OPCCALL:
+	    nice_printf (fp, "Sorry, no OPCALL yet");
+	    break;
+	default:
+	    erri ("output_unary: bad opcode", (int) e -> opcode);
+	    break;
+    } /* switch */
+} /* output_unary */
+
+
+ static char *
+#ifdef KR_headers
+findconst(m)
+	register long m;
+#else
+findconst(register long m)
+#endif
+{
+	register struct Literal *litp, *litpe;
+
+	litp = litpool;
+	for(litpe = litp + nliterals; litp < litpe; litp++)
+		if (litp->litnum ==  m)
+			return litp->cds[0];
+	Fatal("findconst failure!");
+	return 0;
+	}
+
+ static int
+#ifdef KR_headers
+opconv_fudge(fp, e)
+	FILE *fp;
+	struct Exprblock *e;
+#else
+opconv_fudge(FILE *fp, struct Exprblock *e)
+#endif
+{
+	/* special handling for conversions, ichar and character*1 */
+	register expptr lp;
+	register union Expression *Offset;
+	register char *cp;
+	int lt;
+	char buf[8], *s;
+	unsigned int k;
+	Namep np;
+	Addrp ap;
+
+	if (!(lp = e->leftp))	/* possible with erroneous Fortran */
+		return 1;
+	lt = lp->headblock.vtype;
+	if (lt == TYCHAR) {
+		switch(lp->tag) {
+			case TNAME:
+				nice_printf(fp, "*(unsigned char *)");
+				out_name(fp, (Namep)lp);
+				return 1;
+			case TCONST:
+ tconst:
+				cp = lp->constblock.Const.ccp;
+ tconst1:
+				k = *(unsigned char *)cp;
+				if (k < 128) { /* ASCII character */
+					sprintf(buf, chr_fmt[k], k);
+					nice_printf(fp, "'%s'", buf);
+					}
+				else
+					nice_printf(fp, "%d", k);
+				return 1;
+			case TADDR:
+				switch(lp->addrblock.vstg) {
+				    case STGMEMNO:
+					if (halign && e->vtype != TYCHAR) {
+						nice_printf(fp, "*(%s *)",
+						    c_type_decl(e->vtype,0));
+						expr_out(fp, lp);
+						return 1;
+						}
+					cp = findconst(lp->addrblock.memno);
+					goto tconst1;
+				    case STGCONST:
+					goto tconst;
+				    }
+				lp->addrblock.vtype = tyint;
+				Offset = lp->addrblock.memoffset;
+				switch(lp->addrblock.uname_tag) {
+				  case UNAM_REF:
+					nice_printf(fp, "*(unsigned char *)");
+					return 0;
+				  case UNAM_NAME:
+					np = lp->addrblock.user.name;
+					if (ONEOF(np->vstg,
+					    M(STGCOMMON)|M(STGEQUIV)))
+						Offset = mkexpr(OPMINUS, Offset,
+							ICON(np->voffset));
+					}
+				lp->addrblock.memoffset = Offset ?
+					mkexpr(OPSTAR, Offset,
+						ICON(typesize[tyint]))
+					: ICON(0);
+				lp->addrblock.isarray = 1;
+				/* STGCOMMON or STGEQUIV would cause */
+				/* voffset to be added in a second time */
+				lp->addrblock.vstg = STGUNKNOWN;
+				nice_printf(fp, "*(unsigned char *)&");
+				return 0;
+			default:
+				badtag("opconv_fudge", lp->tag);
+			}
+		}
+	if (lt != e->vtype) {
+		s = c_type_decl(e->vtype, 0);
+		if (ISCOMPLEX(lt)) {
+ tryagain:
+			np = (Namep)e->leftp;
+			switch(np->tag) {
+			  case TNAME:
+				nice_printf(fp, "(%s) %s%sr", s,
+					np->cvarname,
+					np->vstg == STGARG ? "->" : ".");
+				return 1;
+			  case TADDR:
+				ap = (Addrp)np;
+				switch(ap->uname_tag) {
+				  case UNAM_IDENT:
+					nice_printf(fp, "(%s) %s.r", s,
+						ap->user.ident);
+					return 1;
+				  case UNAM_NAME:
+					nice_printf(fp, "(%s) ", s);
+					out_addr(fp, ap);
+					nice_printf(fp, ".r");
+					return 1;
+				  case UNAM_REF:
+					nice_printf(fp, "(%s) %s_%s(",
+					 s, ap->user.name->cvarname,
+					 ap->cmplx_sub ? "subscr" : "ref");
+					out_args(fp, ap->memoffset);
+					nice_printf(fp, ").r");
+					return 1;
+				  default:
+					fatali(
+					 "Bad uname_tag %d in opconv_fudge",
+						ap->uname_tag);
+				  }
+			  case TEXPR:
+				e = (Exprp)np;
+				if (e->opcode == OPWHATSIN)
+					goto tryagain;
+			  default:
+				fatali("Unexpected tag %d in opconv_fudge",
+					np->tag);
+			  }
+			}
+		nice_printf(fp, "(%s) ", s);
+		}
+	return 0;
+	}
+
+
+ static void
+#ifdef KR_headers
+output_binary(fp, e)
+	FILE *fp;
+	struct Exprblock *e;
+#else
+output_binary(FILE *fp, struct Exprblock *e)
+#endif
+{
+    char *format;
+    int prec;
+
+    if (e == NULL || e -> tag != TEXPR)
+	return;
+
+/* Instead of writing a huge switch, I've incorporated the output format
+   into a table.  Things like "%l" and "%r" stand for the left and
+   right subexpressions.  This should allow both prefix and infix
+   functions to be specified (e.g. "(%l * %r", "z_div (%l, %r").  Of
+   course, I should REALLY think out the ramifications of writing out
+   straight text, as opposed to some intermediate format, which could
+   figure out and optimize on the the number of required blanks (we don't
+   want "x - (-y)" to become "x --y", for example).  Special cases (such as
+   incomplete implementations) could still be implemented as part of the
+   switch, they will just have some dummy value instead of the string
+   pattern.  Another difficulty is the fact that the complex functions
+   will differ from the integer and real ones */
+
+/* Handle a special case.  We don't want to output "x + - 4", or "y - - 3"
+*/
+    if ((e -> opcode == OPPLUS || e -> opcode == OPMINUS) &&
+	    e -> rightp && e -> rightp -> tag == TCONST &&
+	    isnegative_const (&(e -> rightp -> constblock)) &&
+	    is_negatable (&(e -> rightp -> constblock))) {
+
+	e -> opcode = (e -> opcode == OPPLUS) ? OPMINUS : OPPLUS;
+	negate_const (&(e -> rightp -> constblock));
+    } /* if e -> opcode == PLUS or MINUS */
+
+    prec = op_precedence (e -> opcode);
+    format = op_format (e -> opcode);
+
+    if (format != SPECIAL_FMT) {
+	while (*format) {
+	    if (*format == '%') {
+		int arg_prec, use_paren = 0;
+		expptr lp, rp;
+
+		switch (*(format + 1)) {
+		    case 'l':
+			lp = e->leftp;
+			if (lp && lp->tag == TEXPR) {
+			    arg_prec = op_precedence(lp->exprblock.opcode);
+
+			    use_paren = arg_prec &&
+			        (arg_prec < prec || (arg_prec == prec &&
+				    is_right_assoc (prec)));
+			} /* if e -> leftp */
+			if (e->opcode == OPCONV && opconv_fudge(fp,e))
+				break;
+			if (use_paren)
+			    nice_printf (fp, "(");
+		        expr_out(fp, lp);
+			if (use_paren)
+			    nice_printf (fp, ")");
+		        break;
+		    case 'r':
+			rp = e->rightp;
+			if (rp && rp->tag == TEXPR) {
+			    arg_prec = op_precedence(rp->exprblock.opcode);
+
+			    use_paren = arg_prec &&
+			        (arg_prec < prec || (arg_prec == prec &&
+				    is_left_assoc (prec)));
+			    use_paren = use_paren ||
+				(rp->exprblock.opcode == OPNEG
+				&& prec >= op_precedence(OPMINUS));
+			} /* if e -> rightp */
+			if (use_paren)
+			    nice_printf (fp, "(");
+		        expr_out(fp, rp);
+			if (use_paren)
+			    nice_printf (fp, ")");
+		        break;
+		    case '\0':
+		    case '%':
+		        nice_printf (fp, "%%");
+		        break;
+		    default:
+		        erri ("output_binary: format err: '%%%c' illegal",
+				(int) *(format + 1));
+		        break;
+		} /* switch */
+		format += 2;
+	    } else
+		nice_printf (fp, "%c", *format++);
+	} /* while *format */
+    } else {
+
+/* Handle Special cases of formatting */
+
+	switch (e -> opcode) {
+		case OPCCALL:
+		case OPCALL:
+			out_call (fp, (int) e -> opcode, e -> vtype,
+					e -> vleng, e -> leftp, e -> rightp);
+			break;
+
+		case OPCOMMA_ARG:
+			doin_setbound = 1;
+			nice_printf(fp, "(");
+			expr_out(fp, e->leftp);
+			nice_printf(fp, ", &");
+			doin_setbound = 0;
+			expr_out(fp, e->rightp);
+			nice_printf(fp, ")");
+			break;
+
+		case OPADDR:
+		default:
+	        	nice_printf (fp, "Sorry, can't format OPCODE '%d'",
+				e -> opcode);
+	        	break;
+		}
+
+    } /* else */
+} /* output_binary */
+
+ void
+#ifdef KR_headers
+out_call(outfile, op, ftype, len, name, args)
+	FILE *outfile;
+	int op;
+	int ftype;
+	expptr len;
+	expptr name;
+	expptr args;
+#else
+out_call(FILE *outfile, int op, int ftype, expptr len, expptr name, expptr args)
+#endif
+{
+    chainp arglist;		/* Pointer to any actual arguments */
+    chainp cp;			/* Iterator over argument lists */
+    Addrp ret_val = (Addrp) NULL;
+				/* Function return value buffer, if any is
+				   required */
+    int byvalue;		/* True iff we're calling a C library
+				   routine */
+    int done_once;		/* Used for writing commas to   outfile   */
+    int narg, t;
+    register expptr q;
+    long L;
+    Argtypes *at;
+    Atype *A, *Ac;
+    Namep np;
+    extern int forcereal;
+
+/* Don't use addresses if we're calling a C function */
+
+    byvalue = op == OPCCALL;
+
+    if (args)
+	arglist = args -> listblock.listp;
+    else
+	arglist = CHNULL;
+
+/* If this is a CHARACTER function, the first argument is the result */
+
+    if (ftype == TYCHAR)
+	if (ISICON (len)) {
+	    ret_val = (Addrp) (arglist -> datap);
+	    arglist = arglist -> nextp;
+	} else {
+	    err ("adjustable character function");
+	    return;
+	} /* else */
+
+/* If this is a COMPLEX function, the first argument is the result */
+
+    else if (ISCOMPLEX (ftype)) {
+	ret_val = (Addrp) (arglist -> datap);
+	arglist = arglist -> nextp;
+    } /* if ISCOMPLEX */
+
+    /* prepare to cast procedure parameters -- set A if we know how */
+    np = name->tag == TEXPR && name->exprblock.opcode == OPWHATSIN
+	? (Namep)name->exprblock.leftp : (Namep)name;
+
+    A = Ac = 0;
+    if (np->tag == TNAME && (at = np->arginfo)) {
+	if (at->nargs > 0)
+		A = at->atypes;
+	if (Ansi && (at->defined || at->nargs > 0))
+		Ac = at->atypes;
+    	}
+
+/* Now we can actually start to write out the function invocation */
+
+    if (ftype == TYREAL && forcereal)
+	nice_printf(outfile, "(real)");
+    if (name -> tag == TEXPR && name -> exprblock.opcode == OPWHATSIN) {
+	nice_printf (outfile, "(");
+	expr_out (outfile, name);
+	nice_printf (outfile, ")");
+	}
+    else
+	expr_out(outfile, name);
+
+    nice_printf(outfile, "(");
+
+    if (ret_val) {
+	if (ISCOMPLEX (ftype))
+	    nice_printf (outfile, "&");
+	expr_out (outfile, (expptr) ret_val);
+	if (Ac)
+		Ac++;
+
+/* The length of the result of a character function is the second argument */
+/* It should be in place from putcall(), so we won't touch it explicitly */
+
+    } /* if ret_val */
+    done_once = ret_val ? TRUE : FALSE;
+
+/* Now run through the named arguments */
+
+    narg = -1;
+    for (cp = arglist; cp; cp = cp -> nextp, done_once = TRUE) {
+
+	if (done_once)
+	    nice_printf (outfile, ", ");
+	narg++;
+
+	if (!( q = (expptr)cp->datap) )
+		continue;
+
+	if (q->tag == TADDR) {
+		if (q->addrblock.vtype > TYERROR) {
+			/* I/O block */
+			nice_printf(outfile, "&%s", q->addrblock.user.ident);
+			continue;
+			}
+		if (!byvalue && q->addrblock.isarray
+		&& q->addrblock.vtype != TYCHAR
+		&& q->addrblock.memoffset->tag == TCONST) {
+
+			/* check for 0 offset -- after */
+			/* correcting for equivalence. */
+			L = q->addrblock.memoffset->constblock.Const.ci;
+			if (ONEOF(q->addrblock.vstg, M(STGCOMMON)|M(STGEQUIV))
+					&& q->addrblock.uname_tag == UNAM_NAME)
+				L -= q->addrblock.user.name->voffset;
+			if (L)
+				goto skip_deref;
+
+			if (Ac && narg < at->dnargs
+			 && q->headblock.vtype != (t = Ac[narg].type)
+			 && t > TYADDR && t < TYSUBR)
+				nice_printf(outfile, "(%s*)", Typename[t]);
+
+			/* &x[0] == x */
+			/* This also prevents &sizeof(doublereal)[0] */
+
+			switch(q->addrblock.uname_tag) {
+			    case UNAM_NAME:
+				out_name(outfile, q->addrblock.user.name);
+				continue;
+			    case UNAM_IDENT:
+				nice_printf(outfile, "%s",
+					q->addrblock.user.ident);
+				continue;
+			    case UNAM_CHARP:
+				nice_printf(outfile, "%s",
+					q->addrblock.user.Charp);
+				continue;
+			    case UNAM_EXTERN:
+				extern_out(outfile,
+					&extsymtab[q->addrblock.memno]);
+				continue;
+			    }
+			}
+		}
+
+/* Skip over the dereferencing operator generated only for the
+   intermediate file */
+ skip_deref:
+	if (q -> tag == TEXPR && q -> exprblock.opcode == OPWHATSIN)
+	    q = q -> exprblock.leftp;
+
+	if (q->headblock.vclass == CLPROC) {
+	    if (Castargs && (q->tag != TNAME
+				|| q->nameblock.vprocclass != PTHISPROC)
+			 && (q->tag != TADDR
+				|| q->addrblock.uname_tag != UNAM_NAME
+				|| q->addrblock.user.name->vprocclass
+								!= PTHISPROC))
+		{
+		if (A && (t = A[narg].type) >= 200)
+			t %= 100;
+		else {
+			t = q->headblock.vtype;
+			if (q->tag == TNAME && q->nameblock.vimpltype)
+				t = TYUNKNOWN;
+			}
+		nice_printf(outfile, "(%s)", usedcasts[t] = casttypes[t]);
+		}
+	    }
+	else if (Ac && narg < at->dnargs
+		&& q->headblock.vtype != (t = Ac[narg].type)
+		&& t > TYADDR && t < TYSUBR)
+		nice_printf(outfile, "(%s*)", Typename[t]);
+
+	if ((q -> tag == TADDR || q-> tag == TNAME) &&
+		(byvalue || q -> headblock.vstg != STGREG)) {
+	    if (q -> headblock.vtype != TYCHAR)
+	      if (byvalue) {
+
+		if (q -> tag == TADDR &&
+			q -> addrblock.uname_tag == UNAM_NAME &&
+			! q -> addrblock.user.name -> vdim &&
+			oneof_stg(q -> addrblock.user.name, q -> addrblock.vstg,
+					M(STGARG)|M(STGEQUIV)) &&
+			! ISCOMPLEX(q->addrblock.user.name->vtype))
+		    nice_printf (outfile, "*");
+		else if (q -> tag == TNAME
+			&& oneof_stg(&q->nameblock, q -> nameblock.vstg,
+				M(STGARG)|M(STGEQUIV))
+			&& !(q -> nameblock.vdim))
+		    nice_printf (outfile, "*");
+
+	      } else {
+		expptr memoffset;
+
+		if (q->tag == TADDR && (
+			!ONEOF (q -> addrblock.vstg, M(STGEXT)|M(STGLENG))
+			&& (ONEOF(q->addrblock.vstg,
+				M(STGCOMMON)|M(STGEQUIV)|M(STGMEMNO))
+			    || ((memoffset = q->addrblock.memoffset)
+				&& (!ISICON(memoffset)
+				|| memoffset->constblock.Const.ci)))
+			|| ONEOF(q->addrblock.vstg,
+					M(STGINIT)|M(STGAUTO)|M(STGBSS))
+				&& !q->addrblock.isarray))
+		    nice_printf (outfile, "&");
+		else if (q -> tag == TNAME
+			&& !oneof_stg(&q->nameblock, q -> nameblock.vstg,
+				M(STGARG)|M(STGEXT)|M(STGEQUIV)))
+		    nice_printf (outfile, "&");
+	    } /* else */
+
+	    expr_out (outfile, q);
+	} /* if q -> tag == TADDR || q -> tag == TNAME */
+
+/* Might be a Constant expression, e.g. string length, character constants */
+
+	else if (q -> tag == TCONST) {
+		if (q->constblock.vtype == TYLONG)
+			nice_printf(outfile, "(ftnlen)%ld",
+				q->constblock.Const.ci);
+		else
+			out_const(outfile, &q->constblock);
+	    }
+
+/* Must be some other kind of expression, or register var, or constant.
+   In particular, this is likely to be a temporary variable assignment
+   which was generated in p1put_call */
+
+	else if (!ISCOMPLEX (q -> headblock.vtype) && !ISCHAR (q)){
+	    int use_paren = q -> tag == TEXPR &&
+		    op_precedence (q -> exprblock.opcode) <=
+		    op_precedence (OPCOMMA);
+	    if (q->headblock.vtype == TYREAL) {
+		if (forcereal) {
+			nice_printf(outfile, "(real)");
+			use_paren = 1;
+			}
+		}
+	    else if (!Ansi && ISINT(q->headblock.vtype)) {
+		nice_printf(outfile, "(ftnlen)");
+		use_paren = 1;
+		}
+	    if (use_paren) nice_printf (outfile, "(");
+	    expr_out (outfile, q);
+	    if (use_paren) nice_printf (outfile, ")");
+	} /* if !ISCOMPLEX */
+	else
+	    err ("out_call:  unknown parameter");
+
+    } /* for (cp = arglist */
+
+    if (arglist)
+	frchain (&arglist);
+
+    nice_printf (outfile, ")");
+
+} /* out_call */
+
+
+ char *
+#ifdef KR_headers
+flconst(buf, x)
+	char *buf;
+	char *x;
+#else
+flconst(char *buf, char *x)
+#endif
+{
+	sprintf(buf, fl_fmt_string, x);
+	return buf;
+	}
+
+ char *
+#ifdef KR_headers
+dtos(x)
+	double x;
+#else
+dtos(double x)
+#endif
+{
+	static char buf[64];
+#ifdef USE_DTOA
+	g_fmt(buf, x);
+#else
+	sprintf(buf, db_fmt_string, x);
+#endif
+	return strcpy(mem(strlen(buf)+1,0), buf);
+	}
+
+char tr_tab[Table_size];
+
+/* out_init -- Initialize the data structures used by the routines in
+   output.c.  These structures include the output format to be used for
+   Float, Double, Complex, and Double Complex constants. */
+
+ void
+out_init(Void)
+{
+    extern int tab_size;
+    register char *s;
+
+    s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-.";
+    while(*s)
+	tr_tab[*s++] = 3;
+    tr_tab['>'] = 1;
+
+	opeqable[OPPLUS] = 1;
+	opeqable[OPMINUS] = 1;
+	opeqable[OPSTAR] = 1;
+	opeqable[OPSLASH] = 1;
+	opeqable[OPMOD] = 1;
+	opeqable[OPLSHIFT] = 1;
+	opeqable[OPBITAND] = 1;
+	opeqable[OPBITXOR] = 1;
+	opeqable[OPBITOR ] = 1;
+
+
+/* Set the output format for both types of floating point constants */
+
+    if (fl_fmt_string == NULL || *fl_fmt_string == '\0')
+	fl_fmt_string = (char*)(Ansi == 1 ? "%sf" : "(float)%s");
+
+    if (db_fmt_string == NULL || *db_fmt_string == '\0')
+	db_fmt_string = "%.17g";
+
+/* Set the output format for both types of complex constants.  They will
+   have string parameters rather than float or double so that the decimal
+   point may be added to the strings generated by the {db,fl}_fmt_string
+   formats above */
+
+    if (cm_fmt_string == NULL || *cm_fmt_string == '\0') {
+	cm_fmt_string = "{%s,%s}";
+    } /* if cm_fmt_string == NULL */
+
+    if (dcm_fmt_string == NULL || *dcm_fmt_string == '\0') {
+	dcm_fmt_string = "{%s,%s}";
+    } /* if dcm_fmt_string == NULL */
+
+    tab_size = 4;
+} /* out_init */
+
+
+ void
+#ifdef KR_headers
+extern_out(fp, extsym)
+	FILE *fp;
+	Extsym *extsym;
+#else
+extern_out(FILE *fp, Extsym *extsym)
+#endif
+{
+    if (extsym == (Extsym *) NULL)
+	return;
+
+    nice_printf (fp, "%s", extsym->cextname);
+
+} /* extern_out */
+
+
+
+ static void
+#ifdef KR_headers
+output_list(fp, listp)
+	FILE *fp;
+	struct Listblock *listp;
+#else
+output_list(FILE *fp, struct Listblock *listp)
+#endif
+{
+    int did_one = 0;
+    chainp elts;
+
+    nice_printf (fp, "(");
+    if (listp)
+	for (elts = listp -> listp; elts; elts = elts -> nextp) {
+	    if (elts -> datap) {
+		if (did_one)
+		    nice_printf (fp, ", ");
+		expr_out (fp, (expptr) elts -> datap);
+		did_one = 1;
+	    } /* if elts -> datap */
+	} /* for elts */
+    nice_printf (fp, ")");
+} /* output_list */
+
+
+ void
+#ifdef KR_headers
+out_asgoto(outfile, expr)
+	FILE *outfile;
+	expptr expr;
+#else
+out_asgoto(FILE *outfile, expptr expr)
+#endif
+{
+    chainp value;
+    Namep namep;
+    int k;
+
+    if (expr == (expptr) NULL) {
+	err ("out_asgoto:  NULL variable expr");
+	return;
+    } /* if expr */
+
+    nice_printf (outfile, Ansi ? "switch (" : "switch ((int)"); /*)*/
+    expr_out (outfile, expr);
+    nice_printf (outfile, ") {\n");
+    next_tab (outfile);
+
+/* The initial addrp value will be stored as a namep pointer */
+
+    switch(expr->tag) {
+	case TNAME:
+		/* local variable */
+		namep = &expr->nameblock;
+		break;
+	case TEXPR:
+		if (expr->exprblock.opcode == OPWHATSIN
+		 && expr->exprblock.leftp->tag == TNAME)
+			/* argument */
+			namep = &expr->exprblock.leftp->nameblock;
+		else
+			goto bad;
+		break;
+	case TADDR:
+		if (expr->addrblock.uname_tag == UNAM_NAME) {
+			/* initialized local variable */
+			namep = expr->addrblock.user.name;
+			break;
+			}
+	default:
+ bad:
+		err("out_asgoto:  bad expr");
+		return;
+	}
+
+    for(k = 0, value = namep -> varxptr.assigned_values; value;
+	    value = value->nextp, k++) {
+	nice_printf (outfile, "case %d: goto %s;\n", k,
+		user_label((long)value->datap));
+    } /* for value */
+    prev_tab (outfile);
+
+    nice_printf (outfile, "}\n");
+} /* out_asgoto */
+
+ void
+#ifdef KR_headers
+out_if(outfile, expr)
+	FILE *outfile;
+	expptr expr;
+#else
+out_if(FILE *outfile, expptr expr)
+#endif
+{
+    nice_printf (outfile, "if (");
+    expr_out (outfile, expr);
+    nice_printf (outfile, ") {\n");
+    next_tab (outfile);
+} /* out_if */
+
+ static void
+#ifdef KR_headers
+output_rbrace(outfile, s)
+	FILE *outfile;
+	char *s;
+#else
+output_rbrace(FILE *outfile, char *s)
+#endif
+{
+	extern int last_was_label;
+	register char *fmt;
+
+	if (last_was_label) {
+		last_was_label = 0;
+		fmt = ";%s";
+		}
+	else
+		fmt = "%s";
+	nice_printf(outfile, fmt, s);
+	}
+
+ void
+#ifdef KR_headers
+out_else(outfile)
+	FILE *outfile;
+#else
+out_else(FILE *outfile)
+#endif
+{
+    prev_tab (outfile);
+    output_rbrace(outfile, "} else {\n");
+    next_tab (outfile);
+} /* out_else */
+
+ void
+#ifdef KR_headers
+elif_out(outfile, expr)
+	FILE *outfile;
+	expptr expr;
+#else
+elif_out(FILE *outfile, expptr expr)
+#endif
+{
+    prev_tab (outfile);
+    output_rbrace(outfile, "} else ");
+    out_if (outfile, expr);
+} /* elif_out */
+
+ void
+#ifdef KR_headers
+endif_out(outfile)
+	FILE *outfile;
+#else
+endif_out(FILE *outfile)
+#endif
+{
+    prev_tab (outfile);
+    output_rbrace(outfile, "}\n");
+} /* endif_out */
+
+ void
+#ifdef KR_headers
+end_else_out(outfile)
+	FILE *outfile;
+#else
+end_else_out(FILE *outfile)
+#endif
+{
+    prev_tab (outfile);
+    output_rbrace(outfile, "}\n");
+} /* end_else_out */
+
+
+
+ void
+#ifdef KR_headers
+compgoto_out(outfile, index, labels)
+	FILE *outfile;
+	expptr index;
+	expptr labels;
+#else
+compgoto_out(FILE *outfile, expptr index, expptr labels)
+#endif
+{
+    char *s1, *s2;
+
+    if (index == ENULL)
+	err ("compgoto_out:  null index for computed goto");
+    else if (labels && labels -> tag != TLIST)
+	erri ("compgoto_out:  expected label list, got tag '%d'",
+		labels -> tag);
+    else {
+	chainp elts;
+	int i = 1;
+
+	s2 = /*(*/ ") {\n"; /*}*/
+	if (Ansi)
+		s1 = "switch ("; /*)*/
+	else if (index->tag == TNAME || index->tag == TEXPR
+				&& index->exprblock.opcode == OPWHATSIN)
+		s1 = "switch ((int)"; /*)*/
+	else {
+		s1 = "switch ((int)(";
+		s2 = ")) {\n"; /*}*/
+		}
+	nice_printf(outfile, s1);
+	expr_out (outfile, index);
+	nice_printf (outfile, s2);
+	next_tab (outfile);
+
+	for (elts = labels -> listblock.listp; elts; elts = elts -> nextp, i++) {
+	    if (elts -> datap) {
+		if (ISICON(((expptr) (elts -> datap))))
+		    nice_printf (outfile, "case %d:  goto %s;\n", i,
+			user_label(((expptr)(elts->datap))->constblock.Const.ci));
+		else
+		    err ("compgoto_out:  bad label in label list");
+	    } /* if (elts -> datap) */
+	} /* for elts */
+	prev_tab (outfile);
+	nice_printf (outfile, /*{*/ "}\n");
+    } /* else */
+} /* compgoto_out */
+
+
+ void
+#ifdef KR_headers
+out_for(outfile, init, test, inc)
+	FILE *outfile;
+	expptr init;
+	expptr test;
+	expptr inc;
+#else
+out_for(FILE *outfile, expptr init, expptr test, expptr inc)
+#endif
+{
+    nice_printf (outfile, "for (");
+    expr_out (outfile, init);
+    nice_printf (outfile, "; ");
+    expr_out (outfile, test);
+    nice_printf (outfile, "; ");
+    expr_out (outfile, inc);
+    nice_printf (outfile, ") {\n");
+    next_tab (outfile);
+} /* out_for */
+
+
+ void
+#ifdef KR_headers
+out_end_for(outfile)
+	FILE *outfile;
+#else
+out_end_for(FILE *outfile)
+#endif
+{
+    prev_tab (outfile);
+    nice_printf (outfile, "}\n");
+} /* out_end_for */
diff --git a/contrib/tools/f2c/src/output.h b/contrib/tools/f2c/src/output.h
new file mode 100644
index 0000000000..97e3a0ad09
--- /dev/null
+++ b/contrib/tools/f2c/src/output.h
@@ -0,0 +1,64 @@
+/* nice_printf -- same arguments as fprintf.
+
+	All output which is to become C code must be directed through this
+   function.  For now, no buffering is done.  Later on, every line of
+   output will be filtered to accomodate the style definitions (e.g. one
+   statement per line, spaces between function names and argument lists,
+   etc.)
+*/
+#include "niceprintf.h"
+
+
+/* Definitions for the opcode table.  The table is indexed by the macros
+   which are #defined in   defines.h   */
+
+#define UNARY_OP 01
+#define BINARY_OP 02
+
+#define SPECIAL_FMT NULL
+
+#define is_unary_op(x) (opcode_table[x].type == UNARY_OP)
+#define is_binary_op(x) (opcode_table[x].type == BINARY_OP)
+#define op_precedence(x) (opcode_table[x].prec)
+#define op_format(x) (opcode_table[x].format)
+
+/* _assoc_table -- encodes left-associativity and right-associativity
+   information; indexed by precedence level.  Only 2, 3, 14 are
+   right-associative.  Source:  Kernighan & Ritchie, p. 49 */
+
+extern char _assoc_table[];
+
+#define is_right_assoc(x) (_assoc_table [x])
+#define is_left_assoc(x) (! _assoc_table [x])
+
+
+typedef struct {
+    int type;			/* UNARY_OP or BINARY_OP */
+    int prec;			/* Precedence level, useful for adjusting
+				   number of parens to insert.  Zero is a
+				   special level, and 2, 3, 14 are
+				   right-associative */
+    char *format;
+} table_entry;
+
+
+extern char *fl_fmt_string;	/* Float constant format string */
+extern char *db_fmt_string;	/* Double constant format string */
+extern char *cm_fmt_string;	/* Complex constant format string */
+extern char *dcm_fmt_string;	/* Double Complex constant format string */
+
+extern int indent;		/* Number of spaces to indent; this is a
+				   temporary fix */
+extern int tab_size;		/* Number of spaces in each tab */
+extern int in_string;
+
+extern table_entry opcode_table[];
+
+
+void	compgoto_out Argdcl((FILEP, tagptr, tagptr));
+void	endif_out Argdcl((FILEP));
+void	expr_out Argdcl((FILEP, tagptr));
+void	out_and_free_statement Argdcl((FILEP, tagptr));
+void	out_end_for Argdcl((FILEP));
+void	out_if Argdcl((FILEP, tagptr));
+void	out_name Argdcl((FILEP, Namep));
diff --git a/contrib/tools/f2c/src/p1defs.h b/contrib/tools/f2c/src/p1defs.h
new file mode 100644
index 0000000000..c76af22957
--- /dev/null
+++ b/contrib/tools/f2c/src/p1defs.h
@@ -0,0 +1,158 @@
+#define P1_UNKNOWN 0
+#define P1_COMMENT 1		/* Fortan comment string */
+#define P1_EOF 2		/* End of file dummy token */
+#define P1_SET_LINE 3		/* Reset the line counter */
+#define P1_FILENAME 4		/* Name of current input file */
+#define P1_NAME_POINTER 5	/* Pointer to hash table entry */
+#define P1_CONST 6		/* Some constant value */
+#define P1_EXPR 7		/* Followed by opcode */
+
+/* The next two tokens could be grouped together, since they always come
+   from an Addr structure */
+
+#define P1_IDENT 8		/* Char string identifier in addrp->user
+				   field */
+#define P1_EXTERN 9		/* Pointer to external symbol entry */
+
+#define P1_HEAD 10		/* Function header info */
+#define P1_LIST 11		/* A list of data (e.g. arguments) will
+				   follow the tag, type, and count */
+#define P1_LITERAL 12		/* Hold the index into the literal pool */
+#define P1_LABEL 13		/* label value */
+#define P1_ASGOTO 14		/* Store the hash table pointer of
+				   variable used in assigned goto */
+#define P1_GOTO 15		/* Store the statement number */
+#define P1_IF 16		/* store the condition as an expression */
+#define P1_ELSE 17		/* No data */
+#define P1_ELIF 18		/* store the condition as an expression */
+#define P1_ENDIF 19		/* Marks the end of a block IF */
+#define P1_ENDELSE 20		/* Marks the end of a block ELSE */
+#define P1_ADDR 21		/* Addr data; used for arrays, common and
+				   equiv addressing, NOT for names, idents
+				   or externs */
+#define P1_SUBR_RET 22		/* Subroutine return; the return expression
+				   follows */
+#define P1_COMP_GOTO 23		/* Computed goto; has expr, label list */
+#define P1_FOR 24		/* C FOR loop; three expressions follow */
+#define P1_ENDFOR 25		/* End of C FOR loop */
+#define P1_FORTRAN 26		/* original Fortran source */
+#define P1_CHARP 27		/* user.Charp field -- for long names */
+#define P1_WHILE1START 28	/* start of DO WHILE */
+#define P1_WHILE2START 29	/* rest of DO WHILE */
+#define P1_PROCODE 30		/* invoke procode() -- to adjust params */
+#define P1_ELSEIFSTART 31	/* handle extra code for abs, min, max
+				   in else if() */
+
+#define P1_FILENAME_MAX	256	/* max filename length to retain (for -g) */
+#define P1_STMTBUFSIZE 1400
+
+
+
+#define COMMENT_BUFFER_SIZE 255	/* max number of chars in each comment */
+#define CONSTANT_STR_MAX 1000	/* max number of chars in string constant */
+
+void	p1_asgoto Argdcl((Addrp));
+void	p1_comment Argdcl((char*));
+void	p1_elif Argdcl((tagptr));
+void	p1_else Argdcl((void));
+void	p1_endif Argdcl((void));
+void	p1_expr Argdcl((tagptr));
+void	p1_for Argdcl((tagptr, tagptr, tagptr));
+void	p1_goto Argdcl((long int));
+void	p1_head Argdcl((int, char*));
+void	p1_if Argdcl((tagptr));
+void	p1_label Argdcl((long int));
+void	p1_line_number Argdcl((long int));
+void	p1_subr_ret Argdcl((tagptr));
+void	p1comp_goto Argdcl((tagptr, int, struct Labelblock**));
+void	p1else_end Argdcl((void));
+void	p1for_end Argdcl((void));
+void	p1put Argdcl((int));
+void	p1puts Argdcl((int, char*));
+
+/* The pass 1 intermediate file has the following format:
+
+	<ascii-integer-rep> [ : [ <sp> [ <data> ]]] \n
+
+   e.g.   1: This is a comment
+
+   This format is destined to change in the future, but for now a readable
+   form is more desirable than a compact form.
+
+   NOTES ABOUT THE P1 FORMAT
+   ----------------------------------------------------------------------
+
+	P1_COMMENT:  The comment string (in   <data>)   may be at most
+		COMMENT_BUFFER_SIZE bytes long.  It must contain no newlines
+		or null characters.  A side effect of the way comments are
+		read in   lex.c   is that no '\377' chars may be in a
+		comment either.
+
+	P1_SET_LINE:  <data>  holds the line number in the current source file.
+
+	P1_INC_LINE:  Increment the source line number;   <data>   is empty.
+
+	P1_NAME_POINTER:  <data>   holds the integer representation of a
+			  pointer into a hash table entry.
+
+	P1_CONST:  the first field in   <data>   is a type tag (one of the
+		   TYxxxx   macros), the next field holds the constant
+		   value
+
+	P1_EXPR:  <data>   holds the opcode number of the expression,
+		  followed by the type of the expression (required for
+		  OPCONV).  Next is the value of   vleng.
+		  The type of operation represented by the
+		  opcode determines how many of the following data items
+		  are part of this expression.
+
+	P1_IDENT:  <data>   holds the type, then storage, then the
+		   char string identifier in the   addrp->user   field.
+
+	P1_EXTERN:  <data>   holds an offset into the external symbol
+		    table entry
+
+	P1_HEAD:  the first field in   <data>  is the procedure class, the
+		  second is the name of the procedure
+
+	P1_LIST:  the first field in   <data>   is the tag, the second the
+		  type of the list, the third the number of elements in
+		  the list
+
+	P1_LITERAL:  <data>   holds the   litnum   of a value in the
+		     literal pool.
+
+	P1_LABEL:  <data>   holds the statement number of the current
+		   line
+
+	P1_ASGOTO:  <data>   holds the hash table pointer of the variable
+
+	P1_GOTO:  <data>   holds the statement number to jump to
+
+	P1_IF:  <data>   is empty, the following expression is the IF
+	        condition.
+
+	P1_ELSE:  <data>   is empty.
+
+	P1_ELIF:  <data>   is empty, the following expression is the IF
+		  condition.
+
+	P1_ENDIF:  <data>   is empty.
+
+	P1_ENDELSE:  <data>   is empty.
+
+	P1_ADDR:   <data>   holds a direct copy of the structure.  The
+		  next expression is a copy of    vleng,   and the next a
+		  copy of    memoffset.
+
+	P1_SUBR_RET:  The next token is an expression for the return value.
+
+	P1_COMP_GOTO:  The next token is an integer expression, the
+		       following one a list of labels.
+
+	P1_FOR:  The next three expressions are the Init, Test, and
+	         Increment expressions of a C FOR loop.
+
+	P1_ENDFOR:  Marks the end of the body of a FOR loop
+
+*/
diff --git a/contrib/tools/f2c/src/p1output.c b/contrib/tools/f2c/src/p1output.c
new file mode 100644
index 0000000000..5afc747383
--- /dev/null
+++ b/contrib/tools/f2c/src/p1output.c
@@ -0,0 +1,728 @@
+/****************************************************************
+Copyright 1990, 1991, 1993, 1994, 1999-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "p1defs.h"
+#include "output.h"
+#include "names.h"
+
+
+static void p1_addr Argdcl((Addrp));
+static void p1_big_addr Argdcl((Addrp));
+static void p1_binary Argdcl((Exprp));
+static void p1_const Argdcl((Constp));
+static void p1_list Argdcl((struct Listblock*));
+static void p1_literal Argdcl((long int));
+static void p1_name Argdcl((Namep));
+static void p1_unary Argdcl((Exprp));
+static void p1putd Argdcl((int, long int));
+static void p1putdd Argdcl((int, int, int));
+static void p1putddd Argdcl((int, int, int, int));
+static void p1putdds Argdcl((int, int, int, char*));
+static void p1putds Argdcl((int, int, char*));
+static void p1putn Argdcl((int, int, char*));
+
+
+/* p1_comment -- save the text of a Fortran comment in the intermediate
+   file.  Make sure that there are no spurious "/ *" or "* /" characters by
+   mapping them onto "/+" and "+/".   str   is assumed to hold no newlines and be
+   null terminated; it may be modified by this function. */
+
+ void
+#ifdef KR_headers
+p1_comment(str)
+	char *str;
+#else
+p1_comment(char *str)
+#endif
+{
+    register unsigned char *pointer, *ustr;
+
+    if (!str)
+	return;
+
+/* Get rid of any open or close comment combinations that may be in the
+   Fortran input */
+
+	ustr = (unsigned char *)str;
+	for(pointer = ustr; *pointer; pointer++)
+		if (*pointer == '*' && (pointer[1] == '/'
+					|| pointer > ustr && pointer[-1] == '/'))
+			*pointer = '+';
+	/* trim trailing white space */
+#ifdef isascii
+	while(--pointer >= ustr && (!isascii(*pointer) || isspace(*pointer)));
+#else
+	while(--pointer >= ustr && isspace(*pointer));
+#endif
+	pointer[1] = 0;
+	p1puts (P1_COMMENT, str);
+} /* p1_comment */
+
+/* p1_name -- Writes the address of a hash table entry into the
+   intermediate file */
+
+ static void
+#ifdef KR_headers
+p1_name(namep)
+	Namep namep;
+#else
+p1_name(Namep namep)
+#endif
+{
+	p1putd (P1_NAME_POINTER, (long) namep);
+	namep->visused = 1;
+} /* p1_name */
+
+
+
+ void
+#ifdef KR_headers
+p1_expr(expr)
+	expptr expr;
+#else
+p1_expr(expptr expr)
+#endif
+{
+/* An opcode of 0 means a null entry */
+
+    if (expr == ENULL) {
+	p1putdd (P1_EXPR, 0, TYUNKNOWN);	/* Should this be TYERROR? */
+	return;
+    } /* if (expr == ENULL) */
+
+    switch (expr -> tag) {
+        case TNAME:
+		p1_name ((Namep) expr);
+		return;
+	case TCONST:
+		p1_const(&expr->constblock);
+		return;
+	case TEXPR:
+		/* Fall through the switch */
+		break;
+	case TADDR:
+		p1_addr (&(expr -> addrblock));
+		goto freeup;
+	case TPRIM:
+		warn ("p1_expr:  got TPRIM");
+		return;
+	case TLIST:
+		p1_list (&(expr->listblock));
+		frchain( &(expr->listblock.listp) );
+		return;
+	case TERROR:
+		return;
+	default:
+		erri ("p1_expr: bad tag '%d'", (int) (expr -> tag));
+		return;
+	}
+
+/* Now we know that the tag is TEXPR */
+
+    if (is_unary_op (expr -> exprblock.opcode))
+	p1_unary (&(expr -> exprblock));
+    else if (is_binary_op (expr -> exprblock.opcode))
+	p1_binary (&(expr -> exprblock));
+    else
+	erri ("p1_expr:  bad opcode '%d'", (int) expr -> exprblock.opcode);
+ freeup:
+    free((char *)expr);
+
+} /* p1_expr */
+
+
+
+ static void
+#ifdef KR_headers
+p1_const(cp)
+	register Constp cp;
+#else
+p1_const(register Constp cp)
+#endif
+{
+	int type = cp->vtype;
+	expptr vleng = cp->vleng;
+	union Constant *c = &cp->Const;
+	char cdsbuf0[64], cdsbuf1[64];
+	char *cds0, *cds1;
+
+    switch (type) {
+	case TYINT1:
+        case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+	case TYLOGICAL:
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+	    fprintf(pass1_file, "%d: %d %ld\n", P1_CONST, type, c->ci);
+	    break;
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+	    fprintf(pass1_file, "%d: %d %llx\n", P1_CONST, type, c->cq);
+	    break;
+#endif
+	case TYREAL:
+	case TYDREAL:
+		fprintf(pass1_file, "%d: %d %s\n", P1_CONST, type,
+			cp->vstg ? c->cds[0] : cds(dtos(c->cd[0]), cdsbuf0));
+	    break;
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		if (cp->vstg) {
+			cds0 = c->cds[0];
+			cds1 = c->cds[1];
+			}
+		else {
+			cds0 = cds(dtos(c->cd[0]), cdsbuf0);
+			cds1 = cds(dtos(c->cd[1]), cdsbuf1);
+			}
+		fprintf(pass1_file, "%d: %d %s %s\n", P1_CONST, type,
+			cds0, cds1);
+	    break;
+	case TYCHAR:
+	    if (vleng && !ISICON (vleng))
+		err("p1_const:  bad vleng\n");
+	    else
+		fprintf(pass1_file, "%d: %d %lx\n", P1_CONST, type,
+			(unsigned long)cpexpr((expptr)cp));
+	    break;
+	default:
+	    erri ("p1_const:  bad constant type '%d'", type);
+	    break;
+    } /* switch */
+} /* p1_const */
+
+
+ void
+#ifdef KR_headers
+p1_asgoto(addrp)
+	Addrp addrp;
+#else
+p1_asgoto(Addrp addrp)
+#endif
+{
+    p1put (P1_ASGOTO);
+    p1_addr (addrp);
+} /* p1_asgoto */
+
+
+ void
+#ifdef KR_headers
+p1_goto(stateno)
+	ftnint stateno;
+#else
+p1_goto(ftnint stateno)
+#endif
+{
+    p1putd (P1_GOTO, stateno);
+} /* p1_goto */
+
+
+ static void
+#ifdef KR_headers
+p1_addr(addrp)
+	register struct Addrblock *addrp;
+#else
+p1_addr(register struct Addrblock *addrp)
+#endif
+{
+    int stg;
+
+    if (addrp == (struct Addrblock *) NULL)
+	return;
+
+    stg = addrp -> vstg;
+
+    if (ONEOF(stg, M(STGINIT)|M(STGREG))
+	|| ONEOF(stg, M(STGCOMMON)|M(STGEQUIV)) &&
+		(!ISICON(addrp->memoffset)
+		|| (addrp->uname_tag == UNAM_NAME
+			? addrp->memoffset->constblock.Const.ci
+				!= addrp->user.name->voffset
+			: addrp->memoffset->constblock.Const.ci))
+	|| ONEOF(stg, M(STGBSS)|M(STGINIT)|M(STGAUTO)|M(STGARG)) &&
+		(!ISICON(addrp->memoffset)
+			|| addrp->memoffset->constblock.Const.ci)
+	|| addrp->Field || addrp->isarray || addrp->vstg == STGLENG)
+	{
+		p1_big_addr (addrp);
+		return;
+	}
+
+/* Write out a level of indirection for non-array arguments, which have
+   addrp -> memoffset   set and are handled by   p1_big_addr().
+   Lengths are passed by value, so don't check STGLENG
+   28-Jun-89 (dmg)  Added the check for != TYCHAR
+ */
+
+    if (oneof_stg ( addrp -> uname_tag == UNAM_NAME ? addrp -> user.name : NULL,
+	    stg, M(STGARG)|M(STGEQUIV)) && addrp->vtype != TYCHAR) {
+	p1putdd (P1_EXPR, OPWHATSIN, addrp -> vtype);
+	p1_expr (ENULL);	/* Put dummy   vleng   */
+    } /* if stg == STGARG */
+
+    switch (addrp -> uname_tag) {
+        case UNAM_NAME:
+	    p1_name (addrp -> user.name);
+	    break;
+	case UNAM_IDENT:
+	    p1putdds(P1_IDENT, addrp->vtype, addrp->vstg,
+				addrp->user.ident);
+	    break;
+	case UNAM_CHARP:
+		p1putdds(P1_CHARP, addrp->vtype, addrp->vstg,
+				addrp->user.Charp);
+		break;
+	case UNAM_EXTERN:
+	    p1putd (P1_EXTERN, (long) addrp -> memno);
+	    if (addrp->vclass == CLPROC)
+		extsymtab[addrp->memno].extype = addrp->vtype;
+	    break;
+	case UNAM_CONST:
+	    if (addrp -> memno != BAD_MEMNO)
+		p1_literal (addrp -> memno);
+	    else
+		p1_const((struct Constblock *)addrp);
+	    break;
+	case UNAM_UNKNOWN:
+	default:
+	    erri ("p1_addr:  unknown uname_tag '%d'", addrp -> uname_tag);
+	    break;
+    } /* switch */
+} /* p1_addr */
+
+
+ static void
+#ifdef KR_headers
+p1_list(listp)
+	struct Listblock *listp;
+#else
+p1_list(struct Listblock *listp)
+#endif
+{
+    chainp lis;
+    int count = 0;
+
+    if (listp == (struct Listblock *) NULL)
+	return;
+
+/* Count the number of parameters in the list */
+
+    for (lis = listp -> listp; lis; lis = lis -> nextp)
+	count++;
+
+    p1putddd (P1_LIST, listp -> tag, listp -> vtype, count);
+
+    for (lis = listp -> listp; lis; lis = lis -> nextp)
+	p1_expr ((expptr) lis -> datap);
+
+} /* p1_list */
+
+
+ void
+#ifdef KR_headers
+p1_label(lab)
+	long lab;
+#else
+p1_label(long lab)
+#endif
+{
+	if (parstate < INDATA)
+		earlylabs = mkchain((char *)lab, earlylabs);
+	else
+		p1putd (P1_LABEL, lab);
+	}
+
+
+
+ static void
+#ifdef KR_headers
+p1_literal(memno)
+	long memno;
+#else
+p1_literal(long memno)
+#endif
+{
+    p1putd (P1_LITERAL, memno);
+} /* p1_literal */
+
+
+ void
+#ifdef KR_headers
+p1_if(expr)
+	expptr expr;
+#else
+p1_if(expptr expr)
+#endif
+{
+    p1put (P1_IF);
+    p1_expr (expr);
+} /* p1_if */
+
+
+
+
+ void
+#ifdef KR_headers
+p1_elif(expr)
+	expptr expr;
+#else
+p1_elif(expptr expr)
+#endif
+{
+    p1put (P1_ELIF);
+    p1_expr (expr);
+} /* p1_elif */
+
+
+
+
+ void
+p1_else(Void)
+{
+    p1put (P1_ELSE);
+} /* p1_else */
+
+
+
+
+ void
+p1_endif(Void)
+{
+    p1put (P1_ENDIF);
+} /* p1_endif */
+
+
+
+
+ void
+p1else_end(Void)
+{
+    p1put (P1_ENDELSE);
+} /* p1else_end */
+
+
+ static void
+#ifdef KR_headers
+p1_big_addr(addrp)
+	Addrp addrp;
+#else
+p1_big_addr(Addrp addrp)
+#endif
+{
+    if (addrp == (Addrp) NULL)
+	return;
+
+    p1putn (P1_ADDR, (int)sizeof(struct Addrblock), (char *) addrp);
+    p1_expr (addrp -> vleng);
+    p1_expr (addrp -> memoffset);
+    if (addrp->uname_tag == UNAM_NAME)
+	addrp->user.name->visused = 1;
+} /* p1_big_addr */
+
+
+
+ static void
+#ifdef KR_headers
+p1_unary(e)
+	struct Exprblock *e;
+#else
+p1_unary(struct Exprblock *e)
+#endif
+{
+    if (e == (struct Exprblock *) NULL)
+	return;
+
+    p1putdd (P1_EXPR, (int) e -> opcode, e -> vtype);
+    p1_expr (e -> vleng);
+
+    switch (e -> opcode) {
+        case OPNEG:
+	case OPNEG1:
+	case OPNOT:
+	case OPABS:
+	case OPBITNOT:
+	case OPPREINC:
+	case OPPREDEC:
+	case OPADDR:
+	case OPIDENTITY:
+	case OPCHARCAST:
+	case OPDABS:
+	    p1_expr(e -> leftp);
+	    break;
+	default:
+	    erri ("p1_unary: bad opcode '%d'", (int) e -> opcode);
+	    break;
+    } /* switch */
+
+} /* p1_unary */
+
+
+ static void
+#ifdef KR_headers
+p1_binary(e)
+	struct Exprblock *e;
+#else
+p1_binary(struct Exprblock *e)
+#endif
+{
+    if (e == (struct Exprblock *) NULL)
+	return;
+
+    p1putdd (P1_EXPR, e -> opcode, e -> vtype);
+    p1_expr (e -> vleng);
+    p1_expr (e -> leftp);
+    p1_expr (e -> rightp);
+} /* p1_binary */
+
+
+ void
+#ifdef KR_headers
+p1_head(Class, name)
+	int Class;
+	char *name;
+#else
+p1_head(int Class, char *name)
+#endif
+{
+    p1putds (P1_HEAD, Class, (char*)(name ? name : ""));
+} /* p1_head */
+
+
+ void
+#ifdef KR_headers
+p1_subr_ret(retexp)
+	expptr retexp;
+#else
+p1_subr_ret(expptr retexp)
+#endif
+{
+
+    p1put (P1_SUBR_RET);
+    p1_expr (cpexpr(retexp));
+} /* p1_subr_ret */
+
+
+
+ void
+#ifdef KR_headers
+p1comp_goto(index, count, labels)
+	expptr index;
+	int count;
+	struct Labelblock **labels;
+#else
+p1comp_goto(expptr index, int count, struct Labelblock **labels)
+#endif
+{
+    struct Constblock c;
+    int i;
+    register struct Labelblock *L;
+
+    p1put (P1_COMP_GOTO);
+    p1_expr (index);
+
+/* Write out a P1_LIST directly, to avoid the overhead of allocating a
+   list before it's needed HACK HACK HACK */
+
+    p1putddd (P1_LIST, TLIST, TYUNKNOWN, count);
+    c.vtype = TYLONG;
+    c.vleng = 0;
+
+    for (i = 0; i < count; i++) {
+	L = labels[i];
+	L->labused = 1;
+	c.Const.ci = L->stateno;
+	p1_const(&c);
+    } /* for i = 0 */
+} /* p1comp_goto */
+
+
+
+ void
+#ifdef KR_headers
+p1_for(init, test, inc)
+	expptr init;
+	expptr test;
+	expptr inc;
+#else
+p1_for(expptr init, expptr test, expptr inc)
+#endif
+{
+    p1put (P1_FOR);
+    p1_expr (init);
+    p1_expr (test);
+    p1_expr (inc);
+} /* p1_for */
+
+
+ void
+p1for_end(Void)
+{
+    p1put (P1_ENDFOR);
+} /* p1for_end */
+
+
+
+
+/* ----------------------------------------------------------------------
+   The intermediate file actually gets written ONLY by the routines below.
+   To change the format of the file, you need only change these routines.
+   ----------------------------------------------------------------------
+*/
+
+
+/* p1puts -- Put a typed string into the Pass 1 intermediate file.  Assumes that
+   str   contains no newlines and is null-terminated. */
+
+ void
+#ifdef KR_headers
+p1puts(type, str)
+	int type;
+	char *str;
+#else
+p1puts(int type, char *str)
+#endif
+{
+    fprintf (pass1_file, "%d: %s\n", type, str);
+} /* p1puts */
+
+
+/* p1putd -- Put a typed integer into the Pass 1 intermediate file. */
+
+ static void
+#ifdef KR_headers
+p1putd(type, value)
+	int type;
+	long value;
+#else
+p1putd(int type, long value)
+#endif
+{
+    fprintf (pass1_file, "%d: %ld\n", type, value);
+} /* p1_putd */
+
+
+/* p1putdd -- Put a typed pair of integers into the intermediate file. */
+
+ static void
+#ifdef KR_headers
+p1putdd(type, v1, v2)
+	int type;
+	int v1;
+	int v2;
+#else
+p1putdd(int type, int v1, int v2)
+#endif
+{
+    fprintf (pass1_file, "%d: %d %d\n", type, v1, v2);
+} /* p1putdd */
+
+
+/* p1putddd -- Put a typed triple of integers into the intermediate file. */
+
+ static void
+#ifdef KR_headers
+p1putddd(type, v1, v2, v3)
+	int type;
+	int v1;
+	int v2;
+	int v3;
+#else
+p1putddd(int type, int v1, int v2, int v3)
+#endif
+{
+    fprintf (pass1_file, "%d: %d %d %d\n", type, v1, v2, v3);
+} /* p1putddd */
+
+ union dL {
+	double d;
+	long L[2];
+	};
+
+ static void
+#ifdef KR_headers
+p1putn(type, count, str)
+	int type;
+	int count;
+	char *str;
+#else
+p1putn(int type, int count, char *str)
+#endif
+{
+    int i;
+
+    fprintf (pass1_file, "%d: ", type);
+
+    for (i = 0; i < count; i++)
+	putc (str[i], pass1_file);
+
+    putc ('\n', pass1_file);
+} /* p1putn */
+
+
+
+/* p1put -- Put a type marker into the intermediate file. */
+
+ void
+#ifdef KR_headers
+p1put(type)
+	int type;
+#else
+p1put(int type)
+#endif
+{
+    fprintf (pass1_file, "%d:\n", type);
+} /* p1put */
+
+
+
+ static void
+#ifdef KR_headers
+p1putds(type, i, str)
+	int type;
+	int i;
+	char *str;
+#else
+p1putds(int type, int i, char *str)
+#endif
+{
+    fprintf (pass1_file, "%d: %d %s\n", type, i, str);
+} /* p1putds */
+
+
+ static void
+#ifdef KR_headers
+p1putdds(token, type, stg, str)
+	int token;
+	int type;
+	int stg;
+	char *str;
+#else
+p1putdds(int token, int type, int stg, char *str)
+#endif
+{
+    fprintf (pass1_file, "%d: %d %d %s\n", token, type, stg, str);
+} /* p1putdds */
diff --git a/contrib/tools/f2c/src/parse.h b/contrib/tools/f2c/src/parse.h
new file mode 100644
index 0000000000..6de239944a
--- /dev/null
+++ b/contrib/tools/f2c/src/parse.h
@@ -0,0 +1,47 @@
+#ifndef PARSE_INCLUDE
+#define PARSE_INCLUDE
+
+/* macros for the   parse_args   routine */
+
+#define P_STRING 1		/* Macros for the result_type attribute */
+#define P_CHAR 2
+#define P_SHORT 3
+#define P_INT 4
+#define P_LONG 5
+#define P_FILE 6
+#define P_OLD_FILE 7
+#define P_NEW_FILE 8
+#define P_FLOAT 9
+#define P_DOUBLE 10
+
+#define P_CASE_INSENSITIVE 01	/* Macros for the   flags   attribute */
+#define P_REQUIRED_PREFIX 02
+
+#define P_NO_ARGS 0		/* Macros for the   arg_count   attribute */
+#define P_ONE_ARG 1
+#define P_INFINITE_ARGS 2
+
+#define p_entry(pref,swit,flag,count,type,store,size) \
+    { (pref), (swit), (flag), (count), (type), (int *) (store), (size) }
+
+typedef struct {
+    char *prefix;
+    char *string;
+    int flags;
+    int count;
+    int result_type;
+    int *result_ptr;
+    int table_size;
+} arg_info;
+
+#ifdef KR_headers
+#define Argdcl(x) ()
+#else
+#define Argdcl(x) x
+#endif
+int	arg_verify Argdcl((char**, arg_info*, int));
+void	init_store Argdcl((arg_info*, int));
+int	match_table Argdcl((char*, arg_info*, int, int, int*));
+int	parse_args Argdcl((int, char**, arg_info*, int, char**, int));
+
+#endif
diff --git a/contrib/tools/f2c/src/parse_args.c b/contrib/tools/f2c/src/parse_args.c
new file mode 100644
index 0000000000..dd7b78102a
--- /dev/null
+++ b/contrib/tools/f2c/src/parse_args.c
@@ -0,0 +1,558 @@
+/****************************************************************
+Copyright 1990, 1994-5, 2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+/* parse_args
+
+	This function will parse command line input into appropriate data
+   structures, output error messages when appropriate and provide some
+   minimal type conversion.
+
+	Input to the function consists of the standard   argc,argv
+   values, and a table which directs the parser.  Each table entry has the
+   following components:
+
+	prefix -- the (optional) switch character string, e.g. "-" "/" "="
+	switch -- the command string, e.g. "o" "data" "file" "F"
+	flags -- control flags, e.g.   CASE_INSENSITIVE, REQUIRED_PREFIX
+	arg_count -- number of arguments this command requires, e.g. 0 for
+		     booleans, 1 for filenames, INFINITY for input files
+	result_type -- how to interpret the switch arguments, e.g. STRING,
+		       CHAR, FILE, OLD_FILE, NEW_FILE
+	result_ptr -- pointer to storage for the result, be it a table or
+		      a string or whatever
+	table_size -- if the arguments fill a table, the maximum number of
+		      entries; if there are no arguments, the value to
+		      load into the result storage
+
+	Although the table can be used to hold a list of filenames, only
+   scalar values (e.g. pointers) can be stored in the table.  No vector
+   processing will be done, only pointers to string storage will be moved.
+
+	An example entry, which could be used to parse input filenames, is:
+
+	"-", "o", 0, oo, OLD_FILE, infilenames, INFILE_TABLE_SIZE
+
+*/
+
+#include <stdio.h>
+#ifndef NULL
+/* ANSI C */
+#include <stddef.h>
+#endif
+#ifdef KR_headers
+extern double atof();
+#else
+#include "stdlib.h"
+#include "string.h"
+#endif
+#include "parse.h"
+#include <math.h>	     /* For atof */
+#include <ctype.h>
+
+#define MAX_INPUT_SIZE 1000
+
+#define arg_prefix(x) ((x).prefix)
+#define arg_string(x) ((x).string)
+#define arg_flags(x) ((x).flags)
+#define arg_count(x) ((x).count)
+#define arg_result_type(x) ((x).result_type)
+#define arg_result_ptr(x) ((x).result_ptr)
+#define arg_table_size(x) ((x).table_size)
+
+#ifndef TRUE
+#define TRUE 1
+#endif
+#ifndef FALSE
+#define FALSE 0
+#endif
+typedef int boolean;
+
+
+static char *this_program = "";
+
+static int arg_parse Argdcl((char*, arg_info*));
+static char *lower_string Argdcl((char*, char*));
+static int match Argdcl((char*, char*, arg_info*, boolean));
+static int put_one_arg Argdcl((int, char*, char**, char*, char*));
+extern int badargs;
+
+
+ boolean
+#ifdef KR_headers
+parse_args(argc, argv, table, entries, others, other_count)
+	int argc;
+	char **argv;
+	arg_info *table;
+	int entries;
+	char **others;
+	int other_count;
+#else
+parse_args(int argc, char **argv, arg_info *table, int entries, char **others, int other_count)
+#endif
+{
+    boolean result;
+
+    if (argv)
+	this_program = argv[0];
+
+/* Check the validity of the table and its parameters */
+
+    result = arg_verify (argv, table, entries);
+
+/* Initialize the storage values */
+
+    init_store (table, entries);
+
+    if (result) {
+	boolean use_prefix = TRUE;
+	char *argv0;
+
+	argc--;
+	argv0 = *++argv;
+	while (argc) {
+	    int index, length;
+
+	    index = match_table (*argv, table, entries, use_prefix, &length);
+	    if (index < 0) {
+
+/* The argument doesn't match anything in the table */
+
+		if (others) {
+
+		    if (*argv > argv0)
+			*--*argv = '-';	/* complain at invalid flag */
+
+		    if (other_count > 0) {
+			*others++ = *argv;
+			other_count--;
+		    } else {
+			fprintf (stderr, "%s:  too many parameters: ",
+				this_program);
+			fprintf (stderr, "'%s' ignored\n", *argv);
+			badargs++;
+		    } /* else */
+		} /* if (others) */
+		argv0 = *++argv;
+		argc--;
+		use_prefix = TRUE;
+	    } else {
+
+/* A match was found */
+
+		if (length >= strlen (*argv)) {
+		    argc--;
+		    argv0 = *++argv;
+		    use_prefix = TRUE;
+		} else {
+		    (*argv) += length;
+		    use_prefix = FALSE;
+		} /* else */
+
+/* Parse any necessary arguments */
+
+		if (arg_count (table[index]) != P_NO_ARGS) {
+
+/* Now   length   will be used to store the number of parsed characters */
+
+		    length = arg_parse(*argv, &table[index]);
+		    if (*argv == NULL)
+			argc = 0;
+		    else if (length >= strlen (*argv)) {
+			argc--;
+			argv0 = *++argv;
+			use_prefix = TRUE;
+		    } else {
+			(*argv) += length;
+			use_prefix = FALSE;
+		    } /* else */
+		} /* if (argv_count != P_NO_ARGS) */
+		  else
+		    *arg_result_ptr(table[index]) =
+			    arg_table_size(table[index]);
+	    } /* else */
+	} /* while (argc) */
+    } /* if (result) */
+
+    return result;
+} /* parse_args */
+
+
+ boolean
+#ifdef KR_headers
+arg_verify(argv, table, entries)
+	char **argv;
+	arg_info *table;
+	int entries;
+#else
+arg_verify(char **argv, arg_info *table, int entries)
+#endif
+{
+    int i;
+    char *this_program = "";
+
+    if (argv)
+	this_program = argv[0];
+
+    for (i = 0; i < entries; i++) {
+	arg_info *arg = &table[i];
+
+/* Check the argument flags */
+
+	if (arg_flags (*arg) & ~(P_CASE_INSENSITIVE | P_REQUIRED_PREFIX)) {
+	    fprintf (stderr, "%s [arg_verify]:  too many ", this_program);
+	    fprintf (stderr, "flags in entry %d:  '%x' (hex)\n", i,
+		    arg_flags (*arg));
+	    badargs++;
+	} /* if */
+
+/* Check the argument count */
+
+	{ int count = arg_count (*arg);
+
+	    if (count != P_NO_ARGS && count != P_ONE_ARG && count !=
+		    P_INFINITE_ARGS) {
+		fprintf (stderr, "%s [arg_verify]:  invalid ", this_program);
+		fprintf (stderr, "argument count in entry %d:  '%d'\n", i,
+			count);
+		badargs++;
+	    } /* if count != P_NO_ARGS ... */
+
+/* Check the result field; want to be able to store results */
+
+	      else
+		if (arg_result_ptr (*arg) == (int *) NULL) {
+		    fprintf (stderr, "%s [arg_verify]:  ", this_program);
+		    fprintf (stderr, "no argument storage given for ");
+		    fprintf (stderr, "entry %d\n", i);
+		    badargs++;
+		} /* if arg_result_ptr */
+	}
+
+/* Check the argument type */
+
+	{ int type = arg_result_type (*arg);
+
+	    if (type < P_STRING || type > P_DOUBLE) {
+		    fprintf(stderr,
+			"%s [arg_verify]:  bad arg type in entry %d:  '%d'\n",
+			this_program, i, type);
+		    badargs++;
+		    }
+	}
+
+/* Check table size */
+
+	{ int size = arg_table_size (*arg);
+
+	    if (arg_count (*arg) == P_INFINITE_ARGS && size < 1) {
+		fprintf (stderr, "%s [arg_verify]:  bad ", this_program);
+		fprintf (stderr, "table size in entry %d:  '%d'\n", i,
+			size);
+		badargs++;
+	    } /* if (arg_count == P_INFINITE_ARGS && size < 1) */
+	}
+
+    } /* for i = 0 */
+
+    return TRUE;
+} /* arg_verify */
+
+
+/* match_table -- returns the index of the best entry matching the input,
+   -1 if no match.  The best match is the one of longest length which
+   appears lowest in the table.  The length of the match will be returned
+   in   length   ONLY IF a match was found.   */
+
+ int
+#ifdef KR_headers
+match_table(norm_input, table, entries, use_prefix, length)
+	register char *norm_input;
+	arg_info *table;
+	int entries;
+	boolean use_prefix;
+	int *length;
+#else
+match_table(register char *norm_input, arg_info *table, int entries, boolean use_prefix, int *length)
+#endif
+{
+    char low_input[MAX_INPUT_SIZE];
+    register int i;
+    int best_index = -1, best_length = 0;
+
+/* FUNCTION BODY */
+
+    (void) lower_string (low_input, norm_input);
+
+    for (i = 0; i < entries; i++) {
+	int this_length = match(norm_input, low_input, &table[i], use_prefix);
+
+	if (this_length > best_length) {
+	    best_index = i;
+	    best_length = this_length;
+	} /* if (this_length > best_length) */
+    } /* for (i = 0) */
+
+    if (best_index > -1 && length != (int *) NULL)
+	*length = best_length;
+
+    return best_index;
+} /* match_table */
+
+
+/* match -- takes an input string and table entry, and returns the length
+   of the longer match.
+
+	0 ==> input doesn't match
+
+   For example:
+
+	INPUT	PREFIX	STRING	RESULT
+----------------------------------------------------------------------
+	"abcd"	"-"	"d"	0
+	"-d"	"-"	"d"	2    (i.e. "-d")
+	"dout"	"-"	"d"	1    (i.e. "d")
+	"-d"	""	"-d"	2    (i.e. "-d")
+	"dd"	"d"	"d"	2	<= here's the weird one
+*/
+
+ static int
+#ifdef KR_headers
+match(norm_input, low_input, entry, use_prefix)
+	char *norm_input;
+	char *low_input;
+	arg_info *entry;
+	boolean use_prefix;
+#else
+match(char *norm_input, char *low_input, arg_info *entry, boolean use_prefix)
+#endif
+{
+    char *norm_prefix = arg_prefix (*entry);
+    char *norm_string = arg_string (*entry);
+    boolean prefix_match = FALSE, string_match = FALSE;
+    int result = 0;
+
+/* Buffers for the lowercased versions of the strings being compared.
+   These are used when the switch is to be case insensitive */
+
+    static char low_prefix[MAX_INPUT_SIZE];
+    static char low_string[MAX_INPUT_SIZE];
+    int prefix_length = strlen (norm_prefix);
+    int string_length = strlen (norm_string);
+
+/* Pointers for the required strings (lowered or nonlowered) */
+
+    register char *input, *prefix, *string;
+
+/* FUNCTION BODY */
+
+/* Use the appropriate strings to handle case sensitivity */
+
+    if (arg_flags (*entry) & P_CASE_INSENSITIVE) {
+	input = low_input;
+	prefix = lower_string (low_prefix, norm_prefix);
+	string = lower_string (low_string, norm_string);
+    } else {
+	input = norm_input;
+	prefix = norm_prefix;
+	string = norm_string;
+    } /* else */
+
+/* First, check the string formed by concatenating the prefix onto the
+   switch string, but only when the prefix is not being ignored */
+
+    if (use_prefix && prefix != NULL && *prefix != '\0')
+	 prefix_match = (strncmp (input, prefix, prefix_length) == 0) &&
+		(strncmp (input + prefix_length, string, string_length) == 0);
+
+/* Next, check just the switch string, if that's allowed */
+
+    if (!use_prefix && (arg_flags (*entry) & P_REQUIRED_PREFIX) == 0)
+	string_match = strncmp (input, string, string_length) == 0;
+
+    if (prefix_match)
+	result = prefix_length + string_length;
+    else if (string_match)
+	result = string_length;
+
+    return result;
+} /* match */
+
+
+ static char *
+#ifdef KR_headers
+lower_string(dest, src)
+	char *dest;
+	char *src;
+#else
+lower_string(char *dest, char *src)
+#endif
+{
+    char *result = dest;
+    register int c;
+
+    if (dest == NULL || src == NULL)
+	result = NULL;
+    else
+	while (*dest++ = (c = *src++) >= 'A' && c <= 'Z' ? tolower(c) : c);
+
+    return result;
+} /* lower_string */
+
+
+/* arg_parse -- returns the number of characters parsed for this entry */
+
+ static int
+#ifdef KR_headers
+arg_parse(str, entry)
+	char *str;
+	arg_info *entry;
+#else
+arg_parse(char *str, arg_info *entry)
+#endif
+{
+    int length = 0;
+
+    if (arg_count (*entry) == P_ONE_ARG) {
+	char **store = (char **) arg_result_ptr (*entry);
+
+	length = put_one_arg (arg_result_type (*entry), str, store,
+		arg_prefix (*entry), arg_string (*entry));
+
+    } /* if (arg_count == P_ONE_ARG) */
+      else { /* Must be a table of arguments */
+	char **store = (char **) arg_result_ptr (*entry);
+
+	if (store) {
+	    while (*store)
+		store++;
+
+	    length = put_one_arg(arg_result_type (*entry), str, store++,
+		    arg_prefix (*entry), arg_string (*entry));
+
+	    *store = (char *) NULL;
+	} /* if (store) */
+    } /* else */
+
+    return length;
+} /* arg_parse */
+
+
+ static int
+#ifdef KR_headers
+put_one_arg(type, str, store, prefix, string)
+	int type;
+	char *str;
+	char **store;
+	char *prefix;
+	char *string;
+#else
+put_one_arg(int type, char *str, char **store, char *prefix, char *string)
+#endif
+{
+    int length = 0;
+    long L;
+
+    if (store) {
+	switch (type) {
+	    case P_STRING:
+	    case P_FILE:
+	    case P_OLD_FILE:
+	    case P_NEW_FILE:
+		if (str == NULL) {
+			fprintf(stderr, "%s: Missing argument after '%s%s'\n",
+				this_program, prefix, string);
+			length = 0;
+			badargs++;
+			}
+		else
+			length = strlen(*store = str);
+		break;
+	    case P_CHAR:
+		*((char *) store) = *str;
+		length = 1;
+		break;
+	    case P_SHORT:
+		L = atol(str);
+		*(short *)store = (short) L;
+		if (L != *(short *)store) {
+		    fprintf(stderr,
+	"%s%s parameter '%ld' is not a SHORT INT (truncating to %d)\n",
+			    prefix, string, L, *(short *)store);
+		    badargs++;
+		    }
+		length = strlen (str);
+		break;
+	    case P_INT:
+		L = atol(str);
+		*(int *)store = (int)L;
+		if (L != *(int *)store) {
+		    fprintf(stderr,
+	"%s%s parameter '%ld' is not an INT (truncating to %d)\n",
+			    prefix, string, L, *(int *)store);
+		    badargs++;
+		    }
+		length = strlen (str);
+		break;
+	    case P_LONG:
+		*(long *)store = atol(str);
+		length = strlen (str);
+		break;
+	    case P_FLOAT:
+		*((float *) store) = (float) atof(str);
+		length = strlen (str);
+		break;
+	    case P_DOUBLE:
+		*((double *) store) = (double) atof(str);
+		length = strlen (str);
+		break;
+	    default:
+		fprintf (stderr, "put_one_arg:  bad type '%d'\n", type);
+		badargs++;
+		break;
+	} /* switch */
+    } /* if (store) */
+
+    return length;
+} /* put_one_arg */
+
+
+ void
+#ifdef KR_headers
+init_store(table, entries)
+	arg_info *table;
+	int entries;
+#else
+init_store(arg_info *table, int entries)
+#endif
+{
+    int index;
+
+    for (index = 0; index < entries; index++)
+	if (arg_count (table[index]) == P_INFINITE_ARGS) {
+	    char **place = (char **) arg_result_ptr (table[index]);
+
+	    if (place)
+		*place = (char *) NULL;
+	} /* if arg_count == P_INFINITE_ARGS */
+
+} /* init_store */
diff --git a/contrib/tools/f2c/src/pccdefs.h b/contrib/tools/f2c/src/pccdefs.h
new file mode 100644
index 0000000000..bde81177a7
--- /dev/null
+++ b/contrib/tools/f2c/src/pccdefs.h
@@ -0,0 +1,64 @@
+/* The following numbers are strange, and implementation-dependent */
+
+#define P2BAD -1
+#define P2NAME 2
+#define P2ICON 4		/* Integer constant */
+#define P2PLUS 6
+#define P2PLUSEQ 7
+#define P2MINUS 8
+#define P2NEG 10
+#define P2STAR 11
+#define P2STAREQ 12
+#define P2INDIRECT 13
+#define P2BITAND 14
+#define P2BITOR 17
+#define P2BITXOR 19
+#define P2QUEST 21
+#define P2COLON 22
+#define P2ANDAND 23
+#define P2OROR 24
+#define P2GOTO 37
+#define P2LISTOP 56
+#define P2ASSIGN 58
+#define P2COMOP 59
+#define P2SLASH 60
+#define P2MOD 62
+#define P2LSHIFT 64
+#define P2RSHIFT 66
+#define P2CALL 70
+#define P2CALL0 72
+
+#define P2NOT 76
+#define P2BITNOT 77
+#define P2EQ 80
+#define P2NE 81
+#define P2LE 82
+#define P2LT 83
+#define P2GE 84
+#define P2GT 85
+#define P2REG 94
+#define P2OREG 95
+#define P2CONV 104
+#define P2FORCE 108
+#define P2CBRANCH 109
+
+/* special operators included only for fortran's use */
+
+#define P2PASS 200
+#define P2STMT 201
+#define P2SWITCH 202
+#define P2LBRACKET 203
+#define P2RBRACKET 204
+#define P2EOF 205
+#define P2ARIF 206
+#define P2LABEL 207
+
+#define P2SHORT 3
+#define P2INT 4
+#define P2LONG 4
+
+#define P2CHAR 2
+#define P2REAL 6
+#define P2DREAL 7
+#define P2PTR 020
+#define P2FUNCT 040
diff --git a/contrib/tools/f2c/src/pread.c b/contrib/tools/f2c/src/pread.c
new file mode 100644
index 0000000000..fc290779cb
--- /dev/null
+++ b/contrib/tools/f2c/src/pread.c
@@ -0,0 +1,990 @@
+/****************************************************************
+Copyright 1990, 1992, 1993, 1994, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+
+ static char Ptok[128], Pct[Table_size];
+ static char *Pfname;
+ static long Plineno;
+ static int Pbad;
+ static int *tfirst, *tlast, *tnext, tmax;
+
+#define P_space	1
+#define P_anum	2
+#define P_delim	3
+#define P_slash	4
+
+#define TGULP	100
+
+ static void
+trealloc(Void)
+{
+	int k = tmax;
+	tfirst = (int *)realloc((char *)tfirst,
+		(tmax += TGULP)*sizeof(int));
+	if (!tfirst) {
+		fprintf(stderr,
+		"Pfile: realloc failure!\n");
+		exit(2);
+		}
+	tlast = tfirst + tmax;
+	tnext = tfirst + k;
+	}
+
+ static void
+#ifdef KR_headers
+badchar(c)
+	int c;
+#else
+badchar(int c)
+#endif
+{
+	fprintf(stderr,
+		"unexpected character 0x%.2x = '%c' on line %ld of %s\n",
+		c, c, Plineno, Pfname);
+	exit(2);
+	}
+
+ static void
+bad_type(Void)
+{
+	fprintf(stderr,
+		"unexpected type \"%s\" on line %ld of %s\n",
+		Ptok, Plineno, Pfname);
+	exit(2);
+	}
+
+ static void
+#ifdef KR_headers
+badflag(tname, option)
+	char *tname;
+	char *option;
+#else
+badflag(char *tname, char *option)
+#endif
+{
+	fprintf(stderr, "%s type from `f2c -%s` on line %ld of %s\n",
+		tname, option, Plineno, Pfname);
+	Pbad++;
+	}
+
+ static void
+#ifdef KR_headers
+detected(msg)
+	char *msg;
+#else
+detected(char *msg)
+#endif
+{
+	fprintf(stderr,
+	"%sdetected on line %ld of %s\n", msg, Plineno, Pfname);
+	Pbad++;
+	}
+
+#if 0
+ static void
+#ifdef KR_headers
+checklogical(k)
+	int k;
+#else
+checklogical(int k)
+#endif
+{
+	static int lastmsg = 0;
+	static int seen[2] = {0,0};
+
+	seen[k] = 1;
+	if (seen[1-k]) {
+		if (lastmsg < 3) {
+			lastmsg = 3;
+			detected(
+	"Illegal combination of LOGICAL types -- mixing -I4 with -I2 or -i2\n\t");
+			}
+		return;
+		}
+	if (k) {
+		if (tylogical == TYLONG || lastmsg >= 2)
+			return;
+		if (!lastmsg) {
+			lastmsg = 2;
+			badflag("LOGICAL", "I4");
+			}
+		}
+	else {
+		if (tylogical == TYSHORT || lastmsg & 1)
+			return;
+		if (!lastmsg) {
+			lastmsg = 1;
+			badflag("LOGICAL", "i2` or `f2c -I2");
+			}
+		}
+	}
+#else
+#define checklogical(n) /* */
+#endif
+
+ static void
+#ifdef KR_headers
+checkreal(k)
+	int k;
+#else
+checkreal(int k)
+#endif
+{
+	static int warned = 0;
+	static int seen[2] = {0,0};
+
+	seen[k] = 1;
+	if (seen[1-k]) {
+		if (warned < 2)
+			detected("Illegal mixture of -R and -!R ");
+		warned = 2;
+		return;
+		}
+	if (k == forcedouble || warned)
+		return;
+	warned = 1;
+	badflag("REAL return", (char*)(k ? "!R" : "R"));
+	}
+
+ static void
+#ifdef KR_headers
+Pnotboth(e)
+	Extsym *e;
+#else
+Pnotboth(Extsym *e)
+#endif
+{
+	if (e->curno)
+		return;
+	Pbad++;
+	e->curno = 1;
+	fprintf(stderr,
+	"%s cannot be both a procedure and a common block (line %ld of %s)\n",
+		e->fextname, Plineno, Pfname);
+	}
+
+ static int
+#ifdef KR_headers
+numread(pf, n)
+	register FILE *pf;
+	int *n;
+#else
+numread(register FILE *pf, int *n)
+#endif
+{
+	register int c, k;
+
+	if ((c = getc(pf)) < '0' || c > '9')
+		return c;
+	k = c - '0';
+	for(;;) {
+		if ((c = getc(pf)) == ' ') {
+			*n = k;
+			return c;
+			}
+		if (c < '0' || c > '9')
+			break;
+		k = 10*k + c - '0';
+		}
+	return c;
+	}
+
+ static void argverify Argdcl((int, Extsym*));
+ static void Pbadret Argdcl((int ftype, Extsym *p));
+
+ static int
+#ifdef KR_headers
+readref(pf, e, ftype)
+	register FILE *pf;
+	Extsym *e;
+	int ftype;
+#else
+readref(register FILE *pf, Extsym *e, int ftype)
+#endif
+{
+	register int c, *t;
+	int i, nargs, type;
+	Argtypes *at;
+	Atype *a, *ae;
+
+	if (ftype > TYSUBR)
+		return 0;
+	if ((c = numread(pf, &nargs)) != ' ') {
+		if (c != ':')
+			return c == EOF;
+		/* just a typed external */
+		if (e->extstg == STGUNKNOWN) {
+			at = 0;
+			goto justsym;
+			}
+		if (e->extstg == STGEXT) {
+			if (e->extype != ftype)
+				Pbadret(ftype, e);
+			}
+		else
+			Pnotboth(e);
+		return 0;
+		}
+
+	tnext = tfirst;
+	for(i = 0; i < nargs; i++) {
+		if ((c = numread(pf, &type)) != ' '
+		|| type >= 500
+		|| type != TYFTNLEN + 100 && type % 100 > TYSUBR)
+			return c == EOF;
+		if (tnext >= tlast)
+			trealloc();
+		*tnext++ = type;
+		}
+
+	if (e->extstg == STGUNKNOWN) {
+ save_at:
+		at = (Argtypes *)
+			gmem(sizeof(Argtypes) + (nargs-1)*sizeof(Atype), 1);
+		at->dnargs = at->nargs = nargs;
+		at->changes = 0;
+		t = tfirst;
+		a = at->atypes;
+		for(ae = a + nargs; a < ae; a++) {
+			a->type = *t++;
+			a->cp = 0;
+			}
+ justsym:
+		e->extstg = STGEXT;
+		e->extype = ftype;
+		e->arginfo = at;
+		}
+	else if (e->extstg != STGEXT) {
+		Pnotboth(e);
+		}
+	else if (!e->arginfo) {
+		if (e->extype != ftype)
+			Pbadret(ftype, e);
+		else
+			goto save_at;
+		}
+	else
+		argverify(ftype, e);
+	return 0;
+	}
+
+ static int
+#ifdef KR_headers
+comlen(pf)
+	register FILE *pf;
+#else
+comlen(register FILE *pf)
+#endif
+{
+	register int c;
+	register char *s, *se;
+	char buf[128], cbuf[128];
+	int refread;
+	long L;
+	Extsym *e;
+
+	if ((c = getc(pf)) == EOF)
+		return 1;
+	if (c == ' ') {
+		refread = 0;
+		s = "comlen ";
+		}
+	else if (c == ':') {
+		refread = 1;
+		s = "ref: ";
+		}
+	else {
+ ret0:
+		if (c == '*')
+			ungetc(c,pf);
+		return 0;
+		}
+	while(*s) {
+		if ((c = getc(pf)) == EOF)
+			return 1;
+		if (c != *s++)
+			goto ret0;
+		}
+	s = buf;
+	se = buf + sizeof(buf) - 1;
+	for(;;) {
+		if ((c = getc(pf)) == EOF)
+			return 1;
+		if (c == ' ')
+			break;
+		if (s >= se || Pct[c] != P_anum)
+			goto ret0;
+		*s++ = c;
+		}
+	*s-- = 0;
+	if (s <= buf || *s != '_')
+		return 0;
+	strcpy(cbuf,buf);
+	*s-- = 0;
+	if (*s == '_') {
+		*s-- = 0;
+		if (s <= buf)
+			return 0;
+		}
+	for(L = 0;;) {
+		if ((c = getc(pf)) == EOF)
+			return 1;
+		if (c == ' ')
+			break;
+		if (c < '0' && c > '9')
+			goto ret0;
+		L = 10*L + c - '0';
+		}
+	if (!L && !refread)
+		return 0;
+	e = mkext1(buf, cbuf);
+	if (refread)
+		return readref(pf, e, (int)L);
+	if (e->extstg == STGUNKNOWN) {
+		e->extstg = STGCOMMON;
+		e->maxleng = L;
+		}
+	else if (e->extstg != STGCOMMON)
+		Pnotboth(e);
+	else if (e->maxleng != L) {
+		fprintf(stderr,
+	"incompatible lengths for common block %s (line %ld of %s)\n",
+				    buf, Plineno, Pfname);
+		if (e->maxleng < L)
+			e->maxleng = L;
+		}
+	return 0;
+	}
+
+ static int
+#ifdef KR_headers
+Ptoken(pf, canend)
+	FILE *pf;
+	int canend;
+#else
+Ptoken(FILE *pf, int canend)
+#endif
+{
+	register int c;
+	register char *s, *se;
+
+ top:
+	for(;;) {
+		c = getc(pf);
+		if (c == EOF) {
+			if (canend)
+				return 0;
+			goto badeof;
+			}
+		if (Pct[c] != P_space)
+			break;
+		if (c == '\n')
+			Plineno++;
+		}
+	switch(Pct[c]) {
+		case P_anum:
+			if (c == '_')
+				badchar(c);
+			s = Ptok;
+			se = s + sizeof(Ptok) - 1;
+			do {
+				if (s < se)
+					*s++ = c;
+				if ((c = getc(pf)) == EOF) {
+ badeof:
+					fprintf(stderr,
+					"unexpected end of file in %s\n",
+						Pfname);
+					exit(2);
+					}
+				}
+				while(Pct[c] == P_anum);
+			ungetc(c,pf);
+			*s = 0;
+			return P_anum;
+
+		case P_delim:
+			return c;
+
+		case P_slash:
+			if ((c = getc(pf)) != '*') {
+				if (c == EOF)
+					goto badeof;
+				badchar('/');
+				}
+			if (canend && comlen(pf))
+				goto badeof;
+			for(;;) {
+				while((c = getc(pf)) != '*') {
+					if (c == EOF)
+						goto badeof;
+					if (c == '\n')
+						Plineno++;
+					}
+ slashseek:
+				switch(getc(pf)) {
+					case '/':
+						goto top;
+					case EOF:
+						goto badeof;
+					case '*':
+						goto slashseek;
+					}
+				}
+		default:
+			badchar(c);
+		}
+	/* NOT REACHED */
+	return 0;
+	}
+
+ static int
+Pftype(Void)
+{
+	switch(Ptok[0]) {
+		case 'C':
+			if (!strcmp(Ptok+1, "_f"))
+				return TYCOMPLEX;
+			break;
+		case 'E':
+			if (!strcmp(Ptok+1, "_f")) {
+				/* TYREAL under forcedouble */
+				checkreal(1);
+				return TYREAL;
+				}
+			break;
+		case 'H':
+			if (!strcmp(Ptok+1, "_f"))
+				return TYCHAR;
+			break;
+		case 'Z':
+			if (!strcmp(Ptok+1, "_f"))
+				return TYDCOMPLEX;
+			break;
+		case 'd':
+			if (!strcmp(Ptok+1, "oublereal"))
+				return TYDREAL;
+			break;
+		case 'i':
+			if (!strcmp(Ptok+1, "nt"))
+				return TYSUBR;
+			if (!strcmp(Ptok+1, "nteger"))
+				return TYLONG;
+			if (!strcmp(Ptok+1, "nteger1"))
+				return TYINT1;
+			break;
+		case 'l':
+			if (!strcmp(Ptok+1, "ogical")) {
+				checklogical(1);
+				return TYLOGICAL;
+				}
+			if (!strcmp(Ptok+1, "ogical1"))
+				return TYLOGICAL1;
+#ifdef TYQUAD
+			if (!strcmp(Ptok+1, "ongint"))
+				return TYQUAD;
+#endif
+			break;
+		case 'r':
+			if (!strcmp(Ptok+1, "eal")) {
+				checkreal(0);
+				return TYREAL;
+				}
+			break;
+		case 's':
+			if (!strcmp(Ptok+1, "hortint"))
+				return TYSHORT;
+			if (!strcmp(Ptok+1, "hortlogical")) {
+				checklogical(0);
+				return TYLOGICAL2;
+				}
+			break;
+		}
+	bad_type();
+	/* NOT REACHED */
+	return 0;
+	}
+
+ static void
+#ifdef KR_headers
+wanted(i, what)
+	int i;
+	char *what;
+#else
+wanted(int i, char *what)
+#endif
+{
+	if (i != P_anum) {
+		Ptok[0] = i;
+		Ptok[1] = 0;
+		}
+	fprintf(stderr,"Error: expected %s, not \"%s\" (line %ld of %s)\n",
+		what, Ptok, Plineno, Pfname);
+	exit(2);
+	}
+
+ static int
+#ifdef KR_headers
+Ptype(pf)
+	FILE *pf;
+#else
+Ptype(FILE *pf)
+#endif
+{
+	int i, rv;
+
+	i = Ptoken(pf,0);
+	if (i == ')')
+		return 0;
+	if (i != P_anum)
+		badchar(i);
+
+	rv = 0;
+	switch(Ptok[0]) {
+		case 'C':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYCOMPLEX+200;
+			break;
+		case 'D':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYDREAL+200;
+			break;
+		case 'E':
+		case 'R':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYREAL+200;
+			break;
+		case 'H':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYCHAR+200;
+			break;
+		case 'I':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYLONG+200;
+			else if (!strcmp(Ptok+1, "1_fp"))
+				rv = TYINT1+200;
+#ifdef TYQUAD
+			else if (!strcmp(Ptok+1, "8_fp"))
+				rv = TYQUAD+200;
+#endif
+			break;
+		case 'J':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYSHORT+200;
+			break;
+		case 'K':
+			checklogical(0);
+			goto Logical;
+		case 'L':
+			checklogical(1);
+ Logical:
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYLOGICAL+200;
+			else if (!strcmp(Ptok+1, "1_fp"))
+				rv = TYLOGICAL1+200;
+			else if (!strcmp(Ptok+1, "2_fp"))
+				rv = TYLOGICAL2+200;
+			break;
+		case 'S':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYSUBR+200;
+			break;
+		case 'U':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYUNKNOWN+300;
+			break;
+		case 'Z':
+			if (!strcmp(Ptok+1, "_fp"))
+				rv = TYDCOMPLEX+200;
+			break;
+		case 'c':
+			if (!strcmp(Ptok+1, "har"))
+				rv = TYCHAR;
+			else if (!strcmp(Ptok+1, "omplex"))
+				rv = TYCOMPLEX;
+			break;
+		case 'd':
+			if (!strcmp(Ptok+1, "oublereal"))
+				rv = TYDREAL;
+			else if (!strcmp(Ptok+1, "oublecomplex"))
+				rv = TYDCOMPLEX;
+			break;
+		case 'f':
+			if (!strcmp(Ptok+1, "tnlen"))
+				rv = TYFTNLEN+100;
+			break;
+		case 'i':
+			if (!strncmp(Ptok+1, "nteger", 6)) {
+				if (!Ptok[7])
+					rv = TYLONG;
+				else if (Ptok[7] == '1' && !Ptok[8])
+					rv = TYINT1;
+				}
+			break;
+		case 'l':
+			if (!strncmp(Ptok+1, "ogical", 6)) {
+				if (!Ptok[7]) {
+					checklogical(1);
+					rv = TYLOGICAL;
+					}
+				else if (Ptok[7] == '1' && !Ptok[8])
+					rv = TYLOGICAL1;
+				}
+#ifdef TYQUAD
+			else if (!strcmp(Ptok+1,"ongint"))
+				rv = TYQUAD;
+#endif
+			break;
+		case 'r':
+			if (!strcmp(Ptok+1, "eal"))
+				rv = TYREAL;
+			break;
+		case 's':
+			if (!strcmp(Ptok+1, "hortint"))
+				rv = TYSHORT;
+			else if (!strcmp(Ptok+1, "hortlogical")) {
+				checklogical(0);
+				rv = TYLOGICAL2;
+				}
+			break;
+		case 'v':
+			if (tnext == tfirst && !strcmp(Ptok+1, "oid")) {
+				if ((i = Ptoken(pf,0)) != /*(*/ ')')
+					wanted(i, /*(*/ "\")\"");
+				return 0;
+				}
+		}
+	if (!rv)
+		bad_type();
+	if (rv < 100 && (i = Ptoken(pf,0)) != '*')
+			wanted(i, "\"*\"");
+	if ((i = Ptoken(pf,0)) == P_anum)
+		i = Ptoken(pf,0);	/* skip variable name */
+	switch(i) {
+		case ')':
+			ungetc(i,pf);
+			break;
+		case ',':
+			break;
+		default:
+			wanted(i, "\",\" or \")\"");
+		}
+	return rv;
+	}
+
+ static char *
+trimunder(Void)
+{
+	register char *s;
+	register int n;
+	static char buf[128];
+
+	s = Ptok + strlen(Ptok) - 1;
+	if (*s != '_') {
+		fprintf(stderr,
+			"warning: %s does not end in _ (line %ld of %s)\n",
+			Ptok, Plineno, Pfname);
+		return Ptok;
+		}
+	if (s[-1] == '_')
+		s--;
+	strncpy(buf, Ptok, n = s - Ptok);
+	buf[n] = 0;
+	return buf;
+	}
+
+ static void
+#ifdef KR_headers
+Pbadmsg(msg, p)
+	char *msg;
+	Extsym *p;
+#else
+Pbadmsg(char *msg, Extsym *p)
+#endif
+{
+	Pbad++;
+	fprintf(stderr, "%s for %s (line %ld of %s):\n\t", msg,
+		p->fextname, Plineno, Pfname);
+	p->arginfo->nargs = -1;
+	}
+
+ static void
+#ifdef KR_headers
+Pbadret(ftype, p)
+	int ftype;
+	Extsym *p;
+#else
+Pbadret(int ftype, Extsym *p)
+#endif
+{
+	char buf1[32], buf2[32];
+
+	Pbadmsg("inconsistent types",p);
+	fprintf(stderr, "here %s, previously %s\n",
+		Argtype(ftype+200,buf1),
+		Argtype(p->extype+200,buf2));
+	}
+
+ static void
+#ifdef KR_headers
+argverify(ftype, p)
+	int ftype;
+	Extsym *p;
+#else
+argverify(int ftype, Extsym *p)
+#endif
+{
+	Argtypes *at;
+	register Atype *aty;
+	int i, j, k;
+	register int *t, *te;
+	char buf1[32], buf2[32];
+
+	at = p->arginfo;
+	if (at->nargs < 0)
+		return;
+	if (p->extype != ftype) {
+		Pbadret(ftype, p);
+		return;
+		}
+	t = tfirst;
+	te = tnext;
+	i = te - t;
+	if (at->nargs != i) {
+		j = at->nargs;
+		Pbadmsg("differing numbers of arguments",p);
+		fprintf(stderr, "here %d, previously %d\n",
+			i, j);
+		return;
+		}
+	for(aty = at->atypes; t < te; t++, aty++) {
+		if (*t == aty->type)
+			continue;
+		j = aty->type;
+		k = *t;
+		if (k >= 300 || k == j)
+			continue;
+		if (j >= 300) {
+			if (k >= 200) {
+				if (k == TYUNKNOWN + 200)
+					continue;
+				if (j % 100 != k - 200
+				 && k != TYSUBR + 200
+				 && j != TYUNKNOWN + 300
+				 && !type_fixup(at,aty,k))
+					goto badtypes;
+				}
+			else if (j % 100 % TYSUBR != k % TYSUBR
+					&& !type_fixup(at,aty,k))
+				goto badtypes;
+			}
+		else if (k < 200 || j < 200)
+			goto badtypes;
+		else if (k == TYUNKNOWN+200)
+			continue;
+		else if (j != TYUNKNOWN+200)
+			{
+ badtypes:
+			Pbadmsg("differing calling sequences",p);
+			i = t - tfirst + 1;
+			fprintf(stderr,
+				"arg %d: here %s, previously %s\n",
+				i, Argtype(k,buf1), Argtype(j,buf2));
+			return;
+			}
+		/* We've subsequently learned the right type,
+		   as in the call on zoo below...
+
+			subroutine foo(x, zap)
+			external zap
+			call goo(zap)
+			x = zap(3)
+			call zoo(zap)
+			end
+		 */
+		aty->type = k;
+		at->changes = 1;
+		}
+	}
+
+ static void
+#ifdef KR_headers
+newarg(ftype, p)
+	int ftype;
+	Extsym *p;
+#else
+newarg(int ftype, Extsym *p)
+#endif
+{
+	Argtypes *at;
+	register Atype *aty;
+	register int *t, *te;
+	int i, k;
+
+	if (p->extstg == STGCOMMON) {
+		Pnotboth(p);
+		return;
+		}
+	p->extstg = STGEXT;
+	p->extype = ftype;
+	p->exproto = 1;
+	t = tfirst;
+	te = tnext;
+	i = te - t;
+	k = sizeof(Argtypes) + (i-1)*sizeof(Atype);
+	at = p->arginfo = (Argtypes *)gmem(k,1);
+	at->dnargs = at->nargs = i;
+	at->defined = at->changes = 0;
+	for(aty = at->atypes; t < te; aty++) {
+		aty->type = *t++;
+		aty->cp = 0;
+		}
+	}
+
+ static int
+#ifdef KR_headers
+Pfile(fname)
+	char *fname;
+#else
+Pfile(char *fname)
+#endif
+{
+	char *s;
+	int ftype, i;
+	FILE *pf;
+	Extsym *p;
+
+	for(s = fname; *s; s++);
+	if (s - fname < 2
+	|| s[-2] != '.'
+	|| (s[-1] != 'P' && s[-1] != 'p'))
+		return 0;
+
+	if (!(pf = fopen(fname, textread))) {
+		fprintf(stderr, "can't open %s\n", fname);
+		exit(2);
+		}
+	Pfname = fname;
+	Plineno = 1;
+	if (!Pct[' ']) {
+		for(s = " \t\n\r\v\f"; *s; s++)
+			Pct[*s] = P_space;
+		for(s = "*,();"; *s; s++)
+			Pct[*s] = P_delim;
+		for(i = '0'; i <= '9'; i++)
+			Pct[i] = P_anum;
+		for(s = "abcdefghijklmnopqrstuvwxyz"; i = *s; s++)
+			Pct[i] = Pct[i+'A'-'a'] = P_anum;
+		Pct['_'] = P_anum;
+		Pct['/'] = P_slash;
+		}
+
+	for(;;) {
+		if (!(i = Ptoken(pf,1)))
+			break;
+		if (i != P_anum
+		|| !strcmp(Ptok, "extern") && (i = Ptoken(pf,0)) != P_anum)
+			badchar(i);
+		ftype = Pftype();
+ getname:
+		if ((i = Ptoken(pf,0)) != P_anum)
+			badchar(i);
+		p = mkext1(trimunder(), Ptok);
+
+		if ((i = Ptoken(pf,0)) != '(')
+			badchar(i);
+		tnext = tfirst;
+		while(i = Ptype(pf)) {
+			if (tnext >= tlast)
+				trealloc();
+			*tnext++ = i;
+			}
+		if (p->arginfo) {
+			argverify(ftype, p);
+			if (p->arginfo->nargs < 0)
+				newarg(ftype, p);
+			}
+		else
+			newarg(ftype, p);
+		p->arginfo->defined = 1;
+		i = Ptoken(pf,0);
+		switch(i) {
+			case ';':
+				break;
+			case ',':
+				goto getname;
+			default:
+				wanted(i, "\";\" or \",\"");
+			}
+		}
+	fclose(pf);
+	return 1;
+	}
+
+ void
+#ifdef KR_headers
+read_Pfiles(ffiles)
+	char **ffiles;
+#else
+read_Pfiles(char **ffiles)
+#endif
+{
+	char **f1files, **f1files0, *s;
+	int k;
+	register Extsym *e, *ee;
+	register Argtypes *at;
+	extern int retcode;
+
+	f1files0 = f1files = ffiles;
+	while(s = *ffiles++)
+		if (!Pfile(s))
+			*f1files++ = s;
+	if (Pbad)
+		retcode = 8;
+	if (tfirst) {
+		free((char *)tfirst);
+		/* following should be unnecessary, as we won't be back here */
+		tfirst = tnext = tlast = 0;
+		tmax = 0;
+		}
+	*f1files = 0;
+	if (f1files == f1files0)
+		f1files[1] = 0;
+
+	k = 0;
+	ee = nextext;
+	for (e = extsymtab; e < ee; e++)
+		if (e->extstg == STGEXT
+		&& (at = e->arginfo)) {
+			if (at->nargs < 0 || at->changes)
+				k++;
+			at->changes = 2;
+			}
+	if (k) {
+		fprintf(diagfile,
+		"%d prototype%s updated while reading prototypes.\n", k,
+			k > 1 ? "s" : "");
+		}
+	fflush(diagfile);
+	}
diff --git a/contrib/tools/f2c/src/proc.c b/contrib/tools/f2c/src/proc.c
new file mode 100644
index 0000000000..4d85be1e90
--- /dev/null
+++ b/contrib/tools/f2c/src/proc.c
@@ -0,0 +1,1834 @@
+/****************************************************************
+Copyright 1990, 1994-6, 2000-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "names.h"
+#include "output.h"
+#include "p1defs.h"
+
+/* round a up to the nearest multiple of b:
+
+   a = b * floor ( (a + (b - 1)) / b )*/
+
+#undef roundup
+#define roundup(a,b)    ( b * ( (a+b-1)/b) )
+
+#define EXNULL (union Expression *)0
+
+static void dobss Argdcl((void));
+static void docomleng Argdcl((void));
+static void docommon Argdcl((void));
+static void doentry Argdcl((struct Entrypoint*));
+static void epicode Argdcl((void));
+static int nextarg Argdcl((int));
+static void retval Argdcl((int));
+
+static char Blank[] = BLANKCOMMON;
+
+ static char *postfix[] = { "g", "h", "i",
+#ifdef TYQUAD
+					"j",
+#endif
+					"r", "d", "c", "z", "g", "h", "i" };
+
+ chainp new_procs;
+ int prev_proc, proc_argchanges, proc_protochanges;
+
+ void
+#ifdef KR_headers
+changedtype(q)
+	Namep q;
+#else
+changedtype(Namep q)
+#endif
+{
+	char buf[200];
+	int qtype, type1;
+	register Extsym *e;
+	Argtypes *at;
+
+	if (q->vtypewarned)
+		return;
+	q->vtypewarned = 1;
+	qtype = q->vtype;
+	e = &extsymtab[q->vardesc.varno];
+	if (!(at = e->arginfo)) {
+		if (!e->exused)
+			return;
+		}
+	else if (at->changes & 2 && qtype != TYUNKNOWN && !at->defined)
+		proc_protochanges++;
+	type1 = e->extype;
+	if (type1 == TYUNKNOWN)
+		return;
+	if (qtype == TYUNKNOWN)
+		/* e.g.,
+			subroutine foo
+			end
+			external foo
+			call goo(foo)
+			end
+		*/
+		return;
+	sprintf(buf, "%.90s: inconsistent declarations:\n\
+	here %s%s, previously %s%s.", q->fvarname, ftn_types[qtype],
+		qtype == TYSUBR ? "" : " function",
+		ftn_types[type1], type1 == TYSUBR ? "" : " function");
+	warn(buf);
+	}
+
+ void
+#ifdef KR_headers
+unamstring(q, s)
+	register Addrp q;
+	register char *s;
+#else
+unamstring(register Addrp q, register char *s)
+#endif
+{
+	register int k;
+	register char *t;
+
+	k = strlen(s);
+	if (k < IDENT_LEN) {
+		q->uname_tag = UNAM_IDENT;
+		t = q->user.ident;
+		}
+	else {
+		q->uname_tag = UNAM_CHARP;
+		q->user.Charp = t = mem(k+1, 0);
+		}
+	strcpy(t, s);
+	}
+
+ static void
+fix_entry_returns(Void)	/* for multiple entry points */
+{
+	Addrp a;
+	int i;
+	struct Entrypoint *e;
+	Namep np;
+
+	e = entries = (struct Entrypoint *)revchain((chainp)entries);
+	allargs = revchain(allargs);
+	if (!multitype)
+		return;
+
+	/* TYLOGICAL should have been turned into TYLONG or TYSHORT by now */
+
+	for(i = TYINT1; i <= TYLOGICAL; i++)
+		if (a = xretslot[i])
+			sprintf(a->user.ident, "(*ret_val).%s",
+				postfix[i-TYINT1]);
+
+	do {
+		np = e->enamep;
+		switch(np->vtype) {
+			case TYINT1:
+			case TYSHORT:
+			case TYLONG:
+#ifdef TYQUAD
+			case TYQUAD:
+#endif
+			case TYREAL:
+			case TYDREAL:
+			case TYCOMPLEX:
+			case TYDCOMPLEX:
+			case TYLOGICAL1:
+			case TYLOGICAL2:
+			case TYLOGICAL:
+				np->vstg = STGARG;
+			}
+		}
+		while(e = e->entnextp);
+	}
+
+ static void
+#ifdef KR_headers
+putentries(outfile)
+	FILE *outfile;
+#else
+putentries(FILE *outfile)
+#endif
+	/* put out wrappers for multiple entries */
+{
+	char base[MAXNAMELEN+4];
+	struct Entrypoint *e;
+	Namep *A, *Ae, *Ae1, **Alp, *a, **a1, np;
+	chainp args, lengths;
+	int i, k, mt, nL, t, type;
+	extern char *dfltarg[], **dfltproc;
+
+	e = entries;
+	if (!e->enamep) /* only possible with erroneous input */
+		return;
+	nL = (nallargs + nallchargs) * sizeof(Namep *);
+	if (!nL)
+		nL = 8;
+	A = (Namep *)ckalloc(nL + nallargs*sizeof(Namep **));
+	Ae = A + nallargs;
+	Alp = (Namep **)(Ae1 = Ae + nallchargs);
+	i = k = 0;
+	for(a1 = Alp, args = allargs; args; a1++, args = args->nextp) {
+		np = (Namep)args->datap;
+		if (np->vtype == TYCHAR && np->vclass != CLPROC)
+			*a1 = &Ae[i++];
+		}
+
+	mt = multitype;
+	multitype = 0;
+	sprintf(base, "%s0_", e->enamep->cvarname);
+	do {
+		np = e->enamep;
+		lengths = length_comp(e, 0);
+		proctype = type = np->vtype;
+		if (protofile)
+			protowrite(protofile, type, np->cvarname, e, lengths);
+		nice_printf(outfile, "\n%s ", c_type_decl(type, 1));
+		nice_printf(outfile, "%s", np->cvarname);
+		if (!Ansi) {
+			listargs(outfile, e, 0, lengths);
+			nice_printf(outfile, "\n");
+			}
+	    	list_arg_types(outfile, e, lengths, 0, "\n");
+		nice_printf(outfile, "{\n");
+		frchain(&lengths);
+		next_tab(outfile);
+		if (mt)
+			nice_printf(outfile,
+				"Multitype ret_val;\n%s(%d, &ret_val",
+				base, k); /*)*/
+		else if (ISCOMPLEX(type))
+			nice_printf(outfile, "%s(%d,%s", base, k,
+				xretslot[type]->user.ident); /*)*/
+		else if (type == TYCHAR)
+			nice_printf(outfile,
+				"%s(%d, ret_val, ret_val_len", base, k); /*)*/
+		else
+			nice_printf(outfile, "return %s(%d", base, k); /*)*/
+		k++;
+		memset((char *)A, 0, nL);
+		for(args = e->arglist; args; args = args->nextp) {
+			np = (Namep)args->datap;
+			A[np->argno] = np;
+			if (np->vtype == TYCHAR && np->vclass != CLPROC)
+				*Alp[np->argno] = np;
+			}
+		args = allargs;
+		for(a = A; a < Ae; a++, args = args->nextp) {
+			t = ((Namep)args->datap)->vtype;
+			nice_printf(outfile, ", %s", (np = *a)
+				? np->cvarname
+				: ((Namep)args->datap)->vclass == CLPROC
+				? dfltproc[((Namep)args->datap)->vimpltype
+					? (Castargs ? TYUNKNOWN : TYSUBR)
+					: t == TYREAL && forcedouble && !Castargs
+					? TYDREAL : t]
+				: dfltarg[((Namep)args->datap)->vtype]);
+			}
+		for(; a < Ae1; a++)
+			if (np = *a)
+				nice_printf(outfile, ", %s",
+					new_arg_length(np));
+			else
+				nice_printf(outfile, ", (ftnint)0");
+		nice_printf(outfile, /*(*/ ");\n");
+		if (mt) {
+			if (type == TYCOMPLEX)
+				nice_printf(outfile,
+		    "r_v->r = ret_val.c.r; r_v->i = ret_val.c.i;\n");
+			else if (type == TYDCOMPLEX)
+				nice_printf(outfile,
+		    "r_v->r = ret_val.z.r; r_v->i = ret_val.z.i;\n");
+			else if (type <= TYLOGICAL)
+				nice_printf(outfile, "return ret_val.%s;\n",
+					postfix[type-TYINT1]);
+			}
+		nice_printf(outfile, "}\n");
+		prev_tab(outfile);
+		}
+		while(e = e->entnextp);
+	free((char *)A);
+	}
+
+ static void
+#ifdef KR_headers
+entry_goto(outfile)
+	FILE *outfile;
+#else
+entry_goto(FILE *outfile)
+#endif
+{
+	struct Entrypoint *e = entries;
+	int k = 0;
+
+	nice_printf(outfile, "switch(n__) {\n");
+	next_tab(outfile);
+	while(e = e->entnextp)
+		nice_printf(outfile, "case %d: goto %s;\n", ++k,
+			user_label((long)(extsymtab - e->entryname - 1)));
+	nice_printf(outfile, "}\n\n");
+	prev_tab(outfile);
+	}
+
+/* start a new procedure */
+
+ void
+newproc(Void)
+{
+	if(parstate != OUTSIDE)
+	{
+		execerr("missing end statement", CNULL);
+		endproc();
+	}
+
+	parstate = INSIDE;
+	procclass = CLMAIN;	/* default */
+}
+
+ static void
+zap_changes(Void)
+{
+	register chainp cp;
+	register Argtypes *at;
+
+	/* arrange to get correct count of prototypes that would
+	   change by running f2c again */
+
+	if (prev_proc && proc_argchanges)
+		proc_protochanges++;
+	prev_proc = proc_argchanges = 0;
+	for(cp = new_procs; cp; cp = cp->nextp)
+		if (at = ((Namep)cp->datap)->arginfo)
+			at->changes &= ~1;
+	frchain(&new_procs);
+	}
+
+/* end of procedure. generate variables, epilogs, and prologs */
+
+ void
+endproc(Void)
+{
+	struct Labelblock *lp;
+	Extsym *ext;
+
+	if(parstate < INDATA)
+		enddcl();
+	if(ctlstack >= ctls)
+		err("DO loop or BLOCK IF not closed");
+	for(lp = labeltab ; lp < labtabend ; ++lp)
+		if(lp->stateno!=0 && lp->labdefined==NO)
+			errstr("missing statement label %s",
+				convic(lp->stateno) );
+
+/* Save copies of the common variables in extptr -> allextp */
+
+	for (ext = extsymtab; ext < nextext; ext++)
+		if (ext -> extstg == STGCOMMON && ext -> extp) {
+			extern int usedefsforcommon;
+
+/* Write out the abbreviations for common block reference */
+
+			copy_data (ext -> extp);
+			if (usedefsforcommon) {
+				wr_abbrevs (c_file, 1, ext -> extp);
+				ext -> used_here = 1;
+				}
+			else
+				ext -> extp = CHNULL;
+
+			}
+
+	if (nentry > 1)
+		fix_entry_returns();
+	epicode();
+	donmlist();
+	dobss();
+	start_formatting ();
+	if (nentry > 1)
+		putentries(c_file);
+
+	zap_changes();
+	procinit();	/* clean up for next procedure */
+}
+
+
+
+/* End of declaration section of procedure.  Allocate storage. */
+
+ void
+enddcl(Void)
+{
+	register struct Entrypoint *ep;
+	struct Entrypoint *ep0;
+	chainp cp;
+	extern char *err_proc;
+	static char comblks[] = "common blocks";
+
+	err_proc = comblks;
+	docommon();
+
+/* Now the hash table entries for fields of common blocks have STGCOMMON,
+   vdcldone, voffset, and varno.  And the common blocks themselves have
+   their full sizes in extleng. */
+
+	err_proc = "equivalences";
+	doequiv();
+
+	err_proc = comblks;
+	docomleng();
+
+/* This implies that entry points in the declarations are buffered in
+   entries   but not written out */
+
+	err_proc = "entries";
+	if (ep = ep0 = (struct Entrypoint *)revchain((chainp)entries)) {
+		/* entries could be 0 in case of an error */
+		do doentry(ep);
+			while(ep = ep->entnextp);
+		entries = (struct Entrypoint *)revchain((chainp)ep0);
+		}
+
+	err_proc = 0;
+	parstate = INEXEC;
+	p1put(P1_PROCODE);
+	freetemps();
+	if (earlylabs) {
+		for(cp = earlylabs = revchain(earlylabs); cp; cp = cp->nextp)
+			p1_label((long)cp->datap);
+		frchain(&earlylabs);
+		}
+	p1_line_number(lineno); /* for files that start with a MAIN program */
+				/* that starts with an executable statement */
+}
+
+/* ROUTINES CALLED WHEN ENCOUNTERING ENTRY POINTS */
+
+/* Main program or Block data */
+
+ void
+#ifdef KR_headers
+startproc(progname, Class)
+	Extsym *progname;
+	int Class;
+#else
+startproc(Extsym *progname, int Class)
+#endif
+{
+	register struct Entrypoint *p;
+
+	p = ALLOC(Entrypoint);
+	if(Class == CLMAIN) {
+		puthead(CNULL, CLMAIN);
+		if (progname)
+		    strcpy (main_alias, progname->cextname);
+	} else {
+		if (progname) {
+			/* Construct an empty subroutine with this name */
+			/* in case the name is needed to force loading */
+			/* of this block-data subprogram: the name can */
+			/* appear elsewhere in an external statement. */
+			entrypt(CLPROC, TYSUBR, (ftnint)0, progname, (chainp)0);
+			endproc();
+			newproc();
+			}
+		puthead(CNULL, CLBLOCK);
+		}
+	if(Class == CLMAIN)
+		newentry( mkname(" MAIN"), 0 )->extinit = 1;
+	p->entryname = progname;
+	entries = p;
+
+	procclass = Class;
+	fprintf(diagfile, "   %s", (Class==CLMAIN ? "MAIN" : "BLOCK DATA") );
+	if(progname) {
+		fprintf(diagfile, " %s", progname->fextname);
+		procname = progname->cextname;
+		}
+	fprintf(diagfile, ":\n");
+	fflush(diagfile);
+}
+
+/* subroutine or function statement */
+
+ Extsym *
+#ifdef KR_headers
+newentry(v, substmsg)
+	register Namep v;
+	int substmsg;
+#else
+newentry(register Namep v, int substmsg)
+#endif
+{
+	register Extsym *p;
+	char buf[128], badname[64];
+	static int nbad = 0;
+	static char already[] = "external name already used";
+
+	p = mkext(v->fvarname, addunder(v->cvarname));
+
+	if(p->extinit || ! ONEOF(p->extstg, M(STGUNKNOWN)|M(STGEXT)) )
+	{
+		sprintf(badname, "%s_bad%d", v->fvarname, ++nbad);
+		if (substmsg) {
+			sprintf(buf,"%s\n\tsubstituting \"%s\"",
+				already, badname);
+			dclerr(buf, v);
+			}
+		else
+			dclerr(already, v);
+		p = mkext(v->fvarname, badname);
+	}
+	v->vstg = STGAUTO;
+	v->vprocclass = PTHISPROC;
+	v->vclass = CLPROC;
+	if (p->extstg == STGEXT)
+		prev_proc = 1;
+	else
+		p->extstg = STGEXT;
+	p->extinit = YES;
+	v->vardesc.varno = p - extsymtab;
+	return(p);
+}
+
+ void
+#ifdef KR_headers
+entrypt(Class, type, length, entry, args)
+	int Class;
+	int type;
+	ftnint length;
+	Extsym *entry;
+	chainp args;
+#else
+entrypt(int Class, int type, ftnint length, Extsym *entry, chainp args)
+#endif
+{
+	register Namep q;
+	register struct Entrypoint *p;
+
+	if(Class != CLENTRY)
+		puthead( procname = entry->cextname, Class);
+	else
+		fprintf(diagfile, "       entry ");
+	fprintf(diagfile, "   %s:\n", entry->fextname);
+	fflush(diagfile);
+	q = mkname(entry->fextname);
+	if (type == TYSUBR)
+		q->vstg = STGEXT;
+
+	type = lengtype(type, length);
+	if(Class == CLPROC)
+	{
+		procclass = CLPROC;
+		proctype = type;
+		procleng = type == TYCHAR ? length : 0;
+	}
+
+	p = ALLOC(Entrypoint);
+
+	p->entnextp = entries;
+	entries = p;
+
+	p->entryname = entry;
+	p->arglist = revchain(args);
+	p->enamep = q;
+
+	if(Class == CLENTRY)
+	{
+		Class = CLPROC;
+		if(proctype == TYSUBR)
+			type = TYSUBR;
+	}
+
+	q->vclass = Class;
+	q->vprocclass = 0;
+	settype(q, type, length);
+	q->vprocclass = PTHISPROC;
+	/* hold all initial entry points till end of declarations */
+	if(parstate >= INDATA)
+		doentry(p);
+}
+
+/* generate epilogs */
+
+/* epicode -- write out the proper function return mechanism at the end of
+   the procedure declaration.  Handles multiple return value types, as
+   well as cooercion into the proper value */
+
+ LOCAL void
+epicode(Void)
+{
+	extern int lastwasbranch;
+
+	if(procclass==CLPROC)
+	{
+		if(proctype==TYSUBR)
+		{
+
+/* Return a zero only when the alternate return mechanism has been
+   specified in the function header */
+
+			if ((substars || Ansi) && lastwasbranch != YES)
+			    p1_subr_ret (ICON(0));
+		}
+		else if (!multitype && lastwasbranch != YES)
+			retval(proctype);
+	}
+	else if (procclass == CLMAIN && Ansi && lastwasbranch != YES)
+		p1_subr_ret (ICON(0));
+	lastwasbranch = NO;
+}
+
+
+/* generate code to return value of type  t */
+
+ LOCAL void
+#ifdef KR_headers
+retval(t)
+	register int t;
+#else
+retval(register int t)
+#endif
+{
+	register Addrp p;
+
+	switch(t)
+	{
+	case TYCHAR:
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		break;
+
+	case TYLOGICAL:
+		t = tylogical;
+	case TYINT1:
+	case TYADDR:
+	case TYSHORT:
+	case TYLONG:
+#ifdef TYQUAD
+	case TYQUAD:
+#endif
+	case TYREAL:
+	case TYDREAL:
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+		p = (Addrp) cpexpr((expptr)retslot);
+		p->vtype = t;
+		p1_subr_ret (mkconv (t, fixtype((expptr)p)));
+		break;
+
+	default:
+		badtype("retval", t);
+	}
+}
+
+
+/* Do parameter adjustments */
+
+ void
+#ifdef KR_headers
+procode(outfile)
+	FILE *outfile;
+#else
+procode(FILE *outfile)
+#endif
+{
+	prolog(outfile, allargs);
+
+	if (nentry > 1)
+		entry_goto(outfile);
+	}
+
+ static void
+#ifdef KR_headers
+bad_dimtype(q) Namep q;
+#else
+bad_dimtype(Namep q)
+#endif
+{
+	errstr("bad dimension type for %.70s", q->fvarname);
+	}
+
+/* Finish bound computations now that all variables are declared.
+ * This used to be in setbound(), but under -u the following incurred
+ * an erroneous error message:
+ *	subroutine foo(x,n)
+ *	real x(n)
+ *	integer n
+ */
+
+ static void
+#ifdef KR_headers
+dim_finish(v)
+	Namep v;
+#else
+dim_finish(Namep v)
+#endif
+{
+	register struct Dimblock *p;
+	register expptr q;
+	register int i, nd;
+
+	p = v->vdim;
+	v->vdimfinish = 0;
+	nd = p->ndim;
+	doin_setbound = 1;
+	for(i = 0; i < nd; i++)
+		if (q = p->dims[i].dimexpr) {
+			q = p->dims[i].dimexpr = make_int_expr(putx(fixtype(q)));
+			if (!ONEOF(q->headblock.vtype, MSKINT|MSKREAL))
+				bad_dimtype(v);
+			}
+	if (q = p->basexpr)
+		p->basexpr = make_int_expr(putx(fixtype(q)));
+	doin_setbound = 0;
+	}
+
+ static void
+#ifdef KR_headers
+duparg(q)
+	Namep q;
+#else
+duparg(Namep q)
+#endif
+{ errstr("duplicate argument %.80s", q->fvarname); }
+
+/*
+   manipulate argument lists (allocate argument slot positions)
+ * keep track of return types and labels
+ */
+
+ LOCAL void
+#ifdef KR_headers
+doentry(ep)
+	struct Entrypoint *ep;
+#else
+doentry(struct Entrypoint *ep)
+#endif
+{
+	register int type;
+	register Namep np;
+	chainp p, p1;
+	register Namep q;
+	Addrp rs;
+	int it, k;
+	extern char dflttype[26];
+	Extsym *entryname = ep->entryname;
+
+	if (++nentry > 1)
+		p1_label((long)(extsymtab - entryname - 1));
+
+/* The main program isn't allowed to have parameters, so any given
+   parameters are ignored */
+
+	if(procclass == CLMAIN && !ep->arglist || procclass == CLBLOCK)
+		return;
+
+	/* Entry points in MAIN are an error, but we process them here */
+	/* to prevent faults elsewhere. */
+
+/* So now we're working with something other than CLMAIN or CLBLOCK.
+   Determine the type of its return value. */
+
+	impldcl( np = mkname(entryname->fextname) );
+	type = np->vtype;
+	proc_argchanges = prev_proc && type != entryname->extype;
+	entryname->extseen = 1;
+	if(proctype == TYUNKNOWN)
+		if( (proctype = type) == TYCHAR)
+			procleng = np->vleng ? np->vleng->constblock.Const.ci
+					     : (ftnint) (-1);
+
+	if(proctype == TYCHAR)
+	{
+		if(type != TYCHAR)
+			err("noncharacter entry of character function");
+
+/* Functions returning type   char   can only have multiple entries if all
+   entries return the same length */
+
+		else if( (np->vleng ? np->vleng->constblock.Const.ci :
+		    (ftnint) (-1)) != procleng)
+			err("mismatched character entry lengths");
+	}
+	else if(type == TYCHAR)
+		err("character entry of noncharacter function");
+	else if(type != proctype)
+		multitype = YES;
+	if(rtvlabel[type] == 0)
+		rtvlabel[type] = (int)newlabel();
+	ep->typelabel = rtvlabel[type];
+
+	if(type == TYCHAR)
+	{
+		if(chslot < 0)
+		{
+			chslot = nextarg(TYADDR);
+			chlgslot = nextarg(TYLENG);
+		}
+		np->vstg = STGARG;
+
+/* Put a new argument in the function, one which will hold the result of
+   a character function.  This will have to be named sometime, probably in
+   mkarg(). */
+
+		if(procleng < 0) {
+			np->vleng = (expptr) mkarg(TYLENG, chlgslot);
+			np->vleng->addrblock.uname_tag = UNAM_IDENT;
+			strcpy (np -> vleng -> addrblock.user.ident,
+				new_func_length());
+			}
+		if (!xretslot[TYCHAR]) {
+			xretslot[TYCHAR] = rs =
+				autovar(0, type, ISCONST(np->vleng)
+					? np->vleng : ICON(0), "");
+			strcpy(rs->user.ident, "ret_val");
+			}
+	}
+
+/* Handle a   complex   return type -- declare a new parameter (pointer to
+   a complex value) */
+
+	else if( ISCOMPLEX(type) ) {
+		if (!xretslot[type])
+			xretslot[type] =
+				autovar(0, type, EXNULL, " ret_val");
+				/* the blank is for use in out_addr */
+		np->vstg = STGARG;
+		if(cxslot < 0)
+			cxslot = nextarg(TYADDR);
+		}
+	else if (type != TYSUBR) {
+		if (type == TYUNKNOWN) {
+			dclerr("untyped function", np);
+			proctype = type = np->vtype =
+				dflttype[letter(np->fvarname[0])];
+			}
+		if (!xretslot[type])
+			xretslot[type] = retslot =
+				autovar(1, type, EXNULL, " ret_val");
+				/* the blank is for use in out_addr */
+		np->vstg = STGAUTO;
+		}
+
+	for(p = ep->arglist ; p ; p = p->nextp)
+		if(! (( q = (Namep) (p->datap) )->vknownarg) ) {
+			q->vknownarg = 1;
+			q->vardesc.varno = nextarg(TYADDR);
+			allargs = mkchain((char *)q, allargs);
+			q->argno = nallargs++;
+			}
+		else if (nentry == 1)
+			duparg(q);
+		else for(p1 = ep->arglist ; p1 != p; p1 = p1->nextp)
+			if ((Namep)p1->datap == q)
+				duparg(q);
+
+	k = 0;
+	for(p = ep->arglist ; p ; p = p->nextp) {
+		if(! (( q = (Namep) (p->datap) )->vdcldone) )
+			{
+			impldcl(q);
+			q->vdcldone = YES;
+			if(q->vtype == TYCHAR)
+				{
+
+/* If we don't know the length of a char*(*) (i.e. a string), we must add
+   in this additional length argument. */
+
+				++nallchargs;
+				if (q->vclass == CLPROC)
+					nallchargs--;
+				else if (q->vleng == NULL) {
+					/* character*(*) */
+					q->vleng = (expptr)
+					    mkarg(TYLENG, nextarg(TYLENG) );
+					unamstring((Addrp)q->vleng,
+						new_arg_length(q));
+					}
+				}
+			}
+		if (q->vdimfinish)
+			dim_finish(q);
+		if (q->vtype == TYCHAR && q->vclass != CLPROC)
+			k++;
+		}
+
+	if (entryname->extype != type)
+		changedtype(np);
+
+	/* save information for checking consistency of arg lists */
+
+	it = infertypes;
+	if (entryname->exproto)
+		infertypes = 1;
+	save_argtypes(ep->arglist, &entryname->arginfo, &np->arginfo,
+			0, np->fvarname, STGEXT, k, np->vtype, 2);
+	infertypes = it;
+}
+
+
+
+ LOCAL int
+#ifdef KR_headers
+nextarg(type)
+	int type;
+#else
+nextarg(int type)
+#endif
+{
+	type = type;	/* shut up warning */
+	return(lastargslot++);
+	}
+
+ LOCAL void
+#ifdef KR_headers
+dim_check(q)
+	Namep q;
+#else
+dim_check(Namep q)
+#endif
+{
+	register struct Dimblock *vdim = q->vdim;
+	register expptr nelt;
+
+	if(!(nelt = vdim->nelt) || !ISCONST(nelt))
+		dclerr("adjustable dimension on non-argument", q);
+	else if (!ONEOF(nelt->headblock.vtype, MSKINT|MSKREAL))
+		bad_dimtype(q);
+	else if (ISINT(nelt->headblock.vtype)
+			? nelt->constblock.Const.ci <= 0
+			: nelt->constblock.Const.cd[0] <= 0.)
+		dclerr("nonpositive dimension", q);
+	}
+
+ LOCAL void
+dobss(Void)
+{
+	register struct Hashentry *p;
+	register Namep q;
+	int qstg, qclass, qtype;
+	Extsym *e;
+
+	for(p = hashtab ; p<lasthash ; ++p)
+		if(q = p->varp)
+		{
+			qstg = q->vstg;
+			qtype = q->vtype;
+			qclass = q->vclass;
+
+			if( (qclass==CLUNKNOWN && qstg!=STGARG) ||
+			    (qclass==CLVAR && qstg==STGUNKNOWN) ) {
+				if (!(q->vis_assigned | q->vimpldovar))
+					warn1("local variable %s never used",
+						q->fvarname);
+				}
+			else if(qclass==CLVAR && qstg==STGBSS)
+			{ ; }
+
+/* Give external procedures the proper storage class */
+
+			else if(qclass==CLPROC && q->vprocclass==PEXTERNAL
+					&& qstg!=STGARG) {
+				e = mkext(q->fvarname,addunder(q->cvarname));
+				e->extstg = STGEXT;
+				q->vardesc.varno = e - extsymtab;
+				if (e->extype != qtype)
+					changedtype(q);
+				}
+			if(qclass==CLVAR) {
+			    if (qstg != STGARG && q->vdim)
+				dim_check(q);
+			} /* if qclass == CLVAR */
+		}
+
+}
+
+
+ void
+donmlist(Void)
+{
+	register struct Hashentry *p;
+	register Namep q;
+
+	for(p=hashtab; p<lasthash; ++p)
+		if( (q = p->varp) && q->vclass==CLNAMELIST)
+			namelist(q);
+}
+
+
+/* iarrlen -- Returns the size of the array in bytes, or -1 */
+
+ ftnint
+#ifdef KR_headers
+iarrlen(q)
+	register Namep q;
+#else
+iarrlen(register Namep q)
+#endif
+{
+	ftnint leng;
+
+	leng = typesize[q->vtype];
+	if(leng <= 0)
+		return(-1);
+	if(q->vdim)
+		if( ISICON(q->vdim->nelt) )
+			leng *= q->vdim->nelt->constblock.Const.ci;
+		else	return(-1);
+	if(q->vleng)
+		if( ISICON(q->vleng) )
+			leng *= q->vleng->constblock.Const.ci;
+		else return(-1);
+	return(leng);
+}
+
+ void
+#ifdef KR_headers
+namelist(np)
+	Namep np;
+#else
+namelist(Namep np)
+#endif
+{
+	register chainp q;
+	register Namep v;
+	int y;
+
+	if (!np->visused)
+		return;
+	y = 0;
+
+	for(q = np->varxptr.namelist ; q ; q = q->nextp)
+	{
+		vardcl( v = (Namep) (q->datap) );
+		if( !ONEOF(v->vstg, MSKSTATIC) )
+			dclerr("may not appear in namelist", v);
+		else {
+			v->vnamelist = 1;
+			v->visused = 1;
+			v->vsave = 1;
+			y = 1;
+			}
+	np->visused = y;
+	}
+}
+
+/* docommon -- called at the end of procedure declarations, before
+   equivalences and the procedure body */
+
+ LOCAL void
+docommon(Void)
+{
+    register Extsym *extptr;
+    register chainp q, q1;
+    struct Dimblock *t;
+    expptr neltp;
+    register Namep comvar;
+    ftnint size;
+    int i, k, pref, type;
+    extern int type_pref[];
+
+    for(extptr = extsymtab ; extptr<nextext ; ++extptr)
+	if (extptr->extstg == STGCOMMON && (q = extptr->extp)) {
+
+/* If a common declaration also had a list of variables ... */
+
+	    q = extptr->extp = revchain(q);
+	    pref = 1;
+	    for(k = TYCHAR; q ; q = q->nextp)
+	    {
+		comvar = (Namep) (q->datap);
+
+		if(comvar->vdcldone == NO)
+		    vardcl(comvar);
+		type = comvar->vtype;
+		if (pref < type_pref[type])
+			pref = type_pref[k = type];
+		if(extptr->extleng % typealign[type] != 0) {
+		    dclerr("common alignment", comvar);
+		    --nerr; /* don't give bad return code for this */
+#if 0
+		    extptr->extleng = roundup(extptr->extleng, typealign[type]);
+#endif
+		} /* if extptr -> extleng % */
+
+/* Set the offset into the common block */
+
+		comvar->voffset = extptr->extleng;
+		comvar->vardesc.varno = extptr - extsymtab;
+		if(type == TYCHAR)
+			if (comvar->vleng)
+				size = comvar->vleng->constblock.Const.ci;
+			else  {
+				dclerr("character*(*) in common", comvar);
+				size = 1;
+				}
+		else
+			size = typesize[type];
+		if(t = comvar->vdim)
+		    if( (neltp = t->nelt) && ISCONST(neltp) )
+			size *= neltp->constblock.Const.ci;
+		    else
+			dclerr("adjustable array in common", comvar);
+
+/* Adjust the length of the common block so far */
+
+		extptr->extleng += size;
+	    } /* for */
+
+	    extptr->extype = k;
+
+/* Determine curno and, if new, save this identifier chain */
+
+	    q1 = extptr->extp;
+	    for (q = extptr->allextp, i = 0; q; i++, q = q->nextp)
+		if (struct_eq((chainp)q->datap, q1))
+			break;
+	    if (q)
+		extptr->curno = extptr->maxno - i;
+	    else {
+		extptr->curno = ++extptr->maxno;
+		extptr->allextp = mkchain((char *)extptr->extp,
+						extptr->allextp);
+		}
+	} /* if extptr -> extstg == STGCOMMON */
+
+/* Now the hash table entries have STGCOMMON, vdcldone, voffset, and
+   varno.  And the common block itself has its full size in extleng. */
+
+} /* docommon */
+
+
+/* copy_data -- copy the Namep entries so they are available even after
+   the hash table is empty */
+
+ void
+#ifdef KR_headers
+copy_data(list)
+	chainp list;
+#else
+copy_data(chainp list)
+#endif
+{
+    for (; list; list = list -> nextp) {
+	Namep namep = ALLOC (Nameblock);
+	int size, nd, i;
+	struct Dimblock *dp;
+
+	cpn(sizeof(struct Nameblock), list->datap, (char *)namep);
+	namep->fvarname = strcpy(gmem(strlen(namep->fvarname)+1,0),
+		namep->fvarname);
+	namep->cvarname = strcmp(namep->fvarname, namep->cvarname)
+		? strcpy(gmem(strlen(namep->cvarname)+1,0), namep->cvarname)
+		: namep->fvarname;
+	if (namep -> vleng)
+	    namep -> vleng = (expptr) cpexpr (namep -> vleng);
+	if (namep -> vdim) {
+	    nd = namep -> vdim -> ndim;
+	    size = sizeof(struct Dimblock) + 2*sizeof(expptr)*(nd-1);
+	    dp = (struct Dimblock *) ckalloc (size);
+	    cpn(size, (char *)namep->vdim, (char *)dp);
+	    namep -> vdim = dp;
+	    dp->nelt = (expptr)cpexpr(dp->nelt);
+	    for (i = 0; i < nd; i++) {
+		dp -> dims[i].dimsize = (expptr) cpexpr (dp -> dims[i].dimsize);
+	    } /* for */
+	} /* if */
+	list -> datap = (char *) namep;
+    } /* for */
+} /* copy_data */
+
+
+
+ LOCAL void
+docomleng(Void)
+{
+	register Extsym *p;
+
+	for(p = extsymtab ; p < nextext ; ++p)
+		if(p->extstg == STGCOMMON)
+		{
+			if(p->maxleng!=0 && p->extleng!=0 && p->maxleng!=p->extleng
+			    && strcmp(Blank, p->cextname) )
+				warn1("incompatible lengths for common block %.60s",
+				    p->fextname);
+			if(p->maxleng < p->extleng)
+				p->maxleng = p->extleng;
+			p->extleng = 0;
+		}
+}
+
+
+/* ROUTINES DEALING WITH AUTOMATIC AND TEMPORARY STORAGE */
+
+ void
+#ifdef KR_headers
+frtemp(p)
+	Addrp p;
+#else
+frtemp(Addrp p)
+#endif
+{
+	/* put block on chain of temps to be reclaimed */
+	holdtemps = mkchain((char *)p, holdtemps);
+}
+
+ void
+freetemps(Void)
+{
+	register chainp p, p1;
+	register Addrp q;
+	register int t;
+
+	p1 = holdtemps;
+	while(p = p1) {
+		q = (Addrp)p->datap;
+		t = q->vtype;
+		if (t == TYCHAR && q->varleng != 0) {
+			/* restore clobbered character string lengths */
+			frexpr(q->vleng);
+			q->vleng = ICON(q->varleng);
+			}
+		p1 = p->nextp;
+		p->nextp = templist[t];
+		templist[t] = p;
+		}
+	holdtemps = 0;
+	}
+
+/* allocate an automatic variable slot for each of   nelt   variables */
+
+ Addrp
+#ifdef KR_headers
+autovar(nelt0, t, lengp, name)
+	register int nelt0;
+	register int t;
+	expptr lengp;
+	char *name;
+#else
+autovar(register int nelt0, register int t, expptr lengp, char *name)
+#endif
+{
+	ftnint leng;
+	register Addrp q;
+	register int nelt = nelt0 > 0 ? nelt0 : 1;
+	extern char *av_pfix[];
+
+	if(t == TYCHAR)
+		if( ISICON(lengp) )
+			leng = lengp->constblock.Const.ci;
+		else	{
+			Fatal("automatic variable of nonconstant length");
+		}
+	else
+		leng = typesize[t];
+
+	q = ALLOC(Addrblock);
+	q->tag = TADDR;
+	q->vtype = t;
+	if(t == TYCHAR)
+	{
+		q->vleng = ICON(leng);
+		q->varleng = leng;
+	}
+	q->vstg = STGAUTO;
+	q->ntempelt = nelt;
+	q->isarray = (nelt > 1);
+	q->memoffset = ICON(0);
+
+	/* kludge for nls so we can have ret_val rather than ret_val_4 */
+	if (*name == ' ')
+		unamstring(q, name);
+	else {
+		q->uname_tag = UNAM_IDENT;
+		temp_name(av_pfix[t], ++autonum[t], q->user.ident);
+		}
+	if (nelt0 > 0)
+		declare_new_addr (q);
+	return(q);
+}
+
+
+/* Returns a temporary of the appropriate type.  Will reuse existing
+   temporaries when possible */
+
+ Addrp
+#ifdef KR_headers
+mktmpn(nelt, type, lengp)
+	int nelt;
+	register int type;
+	expptr lengp;
+#else
+mktmpn(int nelt, register int type, expptr lengp)
+#endif
+{
+	ftnint leng;
+	chainp p, oldp;
+	register Addrp q;
+	extern int krparens;
+
+	if(type==TYUNKNOWN || type==TYERROR)
+		badtype("mktmpn", type);
+
+	if(type==TYCHAR)
+		if(lengp && ISICON(lengp) )
+			leng = lengp->constblock.Const.ci;
+		else	{
+			err("adjustable length");
+			return( (Addrp) errnode() );
+		}
+	else if (type > TYCHAR || type < TYADDR) {
+		erri("mktmpn: unexpected type %d", type);
+		exit(1);
+		}
+/*
+ * if a temporary of appropriate shape is on the templist,
+ * remove it from the list and return it
+ */
+	if (krparens == 2 && ONEOF(type,M(TYREAL)|M(TYCOMPLEX)))
+		type++;
+	for(oldp=CHNULL, p=templist[type];  p  ;  oldp=p, p=p->nextp)
+	{
+		q = (Addrp) (p->datap);
+		if(q->ntempelt==nelt &&
+		    (type!=TYCHAR || q->vleng->constblock.Const.ci==leng) )
+		{
+			if(oldp)
+				oldp->nextp = p->nextp;
+			else
+				templist[type] = p->nextp;
+			free( (charptr) p);
+			return(q);
+		}
+	}
+	q = autovar(nelt, type, lengp, "");
+	return(q);
+}
+
+
+
+
+/* mktmp -- create new local variable; call it something like   name
+   lengp   is taken directly, not copied */
+
+ Addrp
+#ifdef KR_headers
+mktmp(type, lengp)
+	int type;
+	expptr lengp;
+#else
+mktmp(int type, expptr lengp)
+#endif
+{
+	Addrp rv;
+	/* arrange for temporaries to be recycled */
+	/* at the end of this statement... */
+	rv = mktmpn(1,type,lengp);
+	frtemp((Addrp)cpexpr((expptr)rv));
+	return rv;
+}
+
+/* mktmp0 omits frtemp() */
+ Addrp
+#ifdef KR_headers
+mktmp0(type, lengp)
+	int type;
+	expptr lengp;
+#else
+mktmp0(int type, expptr lengp)
+#endif
+{
+	Addrp rv;
+	/* arrange for temporaries to be recycled */
+	/* when this Addrp is freed */
+	rv = mktmpn(1,type,lengp);
+	rv->istemp = YES;
+	return rv;
+}
+
+/* VARIOUS ROUTINES FOR PROCESSING DECLARATIONS */
+
+/* comblock -- Declare a new common block.  Input parameters name the block;
+   s   will be NULL if the block is unnamed */
+
+ Extsym *
+#ifdef KR_headers
+comblock(s)
+	register char *s;
+#else
+comblock(register char *s)
+#endif
+{
+	Extsym *p;
+	register char *t;
+	register int c, i;
+	char cbuf[256], *s0;
+
+/* Give the unnamed common block a unique name */
+
+	if(*s == 0)
+		p = mkext1(s0 = Blank, Blank);
+	else {
+		s0 = s;
+		t = cbuf;
+		for(i = 0; c = *t = *s++; t++)
+			if (c == '_')
+				i = 1;
+		if (i)
+			*t++ = '_';
+		t[0] = '_';
+		t[1] = 0;
+		p = mkext1(s0,cbuf);
+		}
+	if(p->extstg == STGUNKNOWN)
+		p->extstg = STGCOMMON;
+	else if(p->extstg != STGCOMMON)
+	{
+		errstr("%.52s cannot be a common block: it is a subprogram.",
+			s0);
+		return(0);
+	}
+
+	return( p );
+}
+
+
+/* incomm -- add a new variable to a common declaration */
+
+ void
+#ifdef KR_headers
+incomm(c, v)
+	Extsym *c;
+	Namep v;
+#else
+incomm(Extsym *c, Namep v)
+#endif
+{
+	if (!c)
+		return;
+	if(v->vstg != STGUNKNOWN && !v->vimplstg)
+		dclerr(v->vstg == STGARG
+			? "dummy arguments cannot be in common"
+			: "incompatible common declaration", v);
+	else
+	{
+		v->vstg = STGCOMMON;
+		c->extp = mkchain((char *)v, c->extp);
+	}
+}
+
+
+
+
+/* settype -- set the type or storage class of a Namep object.  If
+   v -> vstg == STGUNKNOWN && type < 0,   attempt to reset vstg to be
+   -type.  This function will not change any earlier definitions in   v,
+   in will only attempt to fill out more information give the other params */
+
+ void
+#ifdef KR_headers
+settype(v, type, length)
+	register Namep v;
+	register int type;
+	register ftnint length;
+#else
+settype(register Namep v, register int type, register ftnint length)
+#endif
+{
+	int type1;
+
+	if(type == TYUNKNOWN)
+		return;
+
+	if(type==TYSUBR && v->vtype!=TYUNKNOWN && v->vstg==STGARG)
+	{
+		v->vtype = TYSUBR;
+		frexpr(v->vleng);
+		v->vleng = 0;
+		v->vimpltype = 0;
+	}
+	else if(type < 0)	/* storage class set */
+	{
+		if(v->vstg == STGUNKNOWN)
+			v->vstg = - type;
+		else if(v->vstg != -type)
+			dclerr("incompatible storage declarations", v);
+	}
+	else if(v->vtype == TYUNKNOWN
+		|| v->vtype != type
+			&& (v->vimpltype || v->vinftype || v->vinfproc))
+	{
+		if( (v->vtype = lengtype(type, length))==TYCHAR )
+			if (length>=0)
+				v->vleng = ICON(length);
+			else if (parstate >= INDATA)
+				v->vleng = ICON(1);	/* avoid a memory fault */
+		v->vimpltype = 0;
+		v->vinftype = 0; /* 19960709 */
+		v->vinfproc = 0; /* 19960709 */
+
+		if (v->vclass == CLPROC) {
+			if (v->vstg == STGEXT
+			 && (type1 = extsymtab[v->vardesc.varno].extype)
+			 &&  type1 != v->vtype)
+				changedtype(v);
+			else if (v->vprocclass == PTHISPROC
+					&& (parstate >= INDATA
+						|| procclass == CLMAIN)
+					&& !xretslot[type]) {
+				xretslot[type] = autovar(ONEOF(type,
+					MSKCOMPLEX|MSKCHAR) ? 0 : 1, type,
+					v->vleng, " ret_val");
+				if (procclass == CLMAIN)
+					errstr(
+				"illegal use of %.60s (main program name)",
+					v->fvarname);
+				/* not completely right, but enough to */
+				/* avoid memory faults; we won't */
+				/* emit any C as we have illegal Fortran */
+				}
+			}
+	}
+	else if(v->vtype != type && v->vtype != lengtype(type, length)) {
+ incompat:
+		dclerr("incompatible type declarations", v);
+		}
+	else if (type==TYCHAR)
+		if (v->vleng && v->vleng->constblock.Const.ci != length)
+			goto incompat;
+		else if (parstate >= INDATA)
+			v->vleng = ICON(1);	/* avoid a memory fault */
+}
+
+
+
+
+
+/* lengtype -- returns the proper compiler type, given input of Fortran
+   type and length specifier */
+
+ int
+#ifdef KR_headers
+lengtype(type, len)
+	register int type;
+	ftnint len;
+#else
+lengtype(register int type, ftnint len)
+#endif
+{
+	register int length = (int)len;
+	switch(type)
+	{
+	case TYREAL:
+		if(length == typesize[TYDREAL])
+			return(TYDREAL);
+		if(length == typesize[TYREAL])
+			goto ret;
+		break;
+
+	case TYCOMPLEX:
+		if(length == typesize[TYDCOMPLEX])
+			return(TYDCOMPLEX);
+		if(length == typesize[TYCOMPLEX])
+			goto ret;
+		break;
+
+	case TYINT1:
+	case TYSHORT:
+	case TYDREAL:
+	case TYDCOMPLEX:
+	case TYCHAR:
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+	case TYUNKNOWN:
+	case TYSUBR:
+	case TYERROR:
+#ifdef TYQUAD
+	case TYQUAD:
+#endif
+		goto ret;
+
+	case TYLOGICAL:
+		switch(length) {
+			case 0: return tylog;
+			case 1:	return TYLOGICAL1;
+			case 2: return TYLOGICAL2;
+			case 4: goto ret;
+			}
+		break;
+
+	case TYLONG:
+		if(length == 0)
+			return(tyint);
+		if (length == 1)
+			return TYINT1;
+		if(length == typesize[TYSHORT])
+			return(TYSHORT);
+#ifdef TYQUAD
+		if(length == typesize[TYQUAD] && use_tyquad)
+			return(TYQUAD);
+#endif
+		if(length == typesize[TYLONG])
+			goto ret;
+		break;
+	default:
+		badtype("lengtype", type);
+	}
+
+	if(len != 0)
+		err("incompatible type-length combination");
+
+ret:
+	return(type);
+}
+
+
+
+
+
+/* setintr -- Set Intrinsic function */
+
+ void
+#ifdef KR_headers
+setintr(v)
+	register Namep v;
+#else
+setintr(register Namep v)
+#endif
+{
+	int k;
+
+	if(k = intrfunct(v->fvarname)) {
+		if ((*(struct Intrpacked *)&k).f4)
+			if (noextflag)
+				goto unknown;
+			else
+				dcomplex_seen++;
+		v->vardesc.varno = k;
+		}
+	else {
+ unknown:
+		dclerr("unknown intrinsic function", v);
+		return;
+		}
+	if(v->vstg == STGUNKNOWN)
+		v->vstg = STGINTR;
+	else if(v->vstg!=STGINTR)
+		dclerr("incompatible use of intrinsic function", v);
+	if(v->vclass==CLUNKNOWN)
+		v->vclass = CLPROC;
+	if(v->vprocclass == PUNKNOWN)
+		v->vprocclass = PINTRINSIC;
+	else if(v->vprocclass != PINTRINSIC)
+		dclerr("invalid intrinsic declaration", v);
+}
+
+
+
+/* setext -- Set External declaration -- assume that unknowns will become
+   procedures */
+
+ void
+#ifdef KR_headers
+setext(v)
+	register Namep v;
+#else
+setext(register Namep v)
+#endif
+{
+	if(v->vclass == CLUNKNOWN)
+		v->vclass = CLPROC;
+	else if(v->vclass != CLPROC)
+		dclerr("invalid external declaration", v);
+
+	if(v->vprocclass == PUNKNOWN)
+		v->vprocclass = PEXTERNAL;
+	else if(v->vprocclass != PEXTERNAL)
+		dclerr("invalid external declaration", v);
+} /* setext */
+
+
+
+
+/* create dimensions block for array variable */
+
+ void
+#ifdef KR_headers
+setbound(v, nd, dims)
+	register Namep v;
+	int nd;
+	struct Dims *dims;
+#else
+setbound(Namep v, int nd, struct Dims *dims)
+#endif
+{
+	expptr q, q0, t;
+	struct Dimblock *p;
+	int i;
+	extern chainp new_vars;
+	char buf[256];
+
+	if(v->vclass == CLUNKNOWN)
+		v->vclass = CLVAR;
+	else if(v->vclass != CLVAR)
+	{
+		dclerr("only variables may be arrays", v);
+		return;
+	}
+
+	v->vdim = p = (struct Dimblock *)
+	    ckalloc( sizeof(int) + (3+2*nd)*sizeof(expptr) );
+	p->ndim = nd--;
+	p->nelt = ICON(1);
+	doin_setbound = 1;
+
+	if (noextflag)
+		for(i = 0; i <= nd; i++)
+			if (((q = dims[i].lb) && !ISINT(q->headblock.vtype))
+			 || ((q = dims[i].ub) && !ISINT(q->headblock.vtype))) {
+				sprintf(buf, "dimension %d of %s is not an integer.",
+					i+1, v->fvarname);
+				errext(buf);
+				break;
+				}
+
+	for(i = 0; i <= nd; i++) {
+		if (((q = dims[i].lb) && !ISINT(q->headblock.vtype)))
+			dims[i].lb = mkconv(TYINT, q);
+		if (((q = dims[i].ub) && !ISINT(q->headblock.vtype)))
+			dims[i].ub = mkconv(TYINT, q);
+		}
+
+	for(i = 0; i <= nd; ++i)
+	{
+		if( (q = dims[i].ub) == NULL)
+		{
+			if(i == nd)
+			{
+				frexpr(p->nelt);
+				p->nelt = NULL;
+			}
+			else
+				err("only last bound may be asterisk");
+			p->dims[i].dimsize = ICON(1);
+			p->dims[i].dimexpr = NULL;
+		}
+		else
+		{
+
+			if(dims[i].lb)
+			{
+				q = mkexpr(OPMINUS, q, cpexpr(dims[i].lb));
+				q = mkexpr(OPPLUS, q, ICON(1) );
+			}
+			if( ISCONST(q) )
+			{
+				p->dims[i].dimsize = q;
+				p->dims[i].dimexpr = (expptr) PNULL;
+			}
+			else {
+				sprintf(buf, " %s_dim%d", v->fvarname, i+1);
+				p->dims[i].dimsize = (expptr)
+					autovar(1, tyint, EXNULL, buf);
+				p->dims[i].dimexpr = q;
+				if (i == nd)
+					v->vlastdim = new_vars;
+				v->vdimfinish = 1;
+			}
+			if(p->nelt)
+				p->nelt = mkexpr(OPSTAR, p->nelt,
+				    cpexpr(p->dims[i].dimsize) );
+		}
+	}
+
+	q = dims[nd].lb;
+	q0 = 0;
+	if(q == NULL)
+		q = q0 = ICON(1);
+
+	for(i = nd-1 ; i>=0 ; --i)
+	{
+		t = dims[i].lb;
+		if(t == NULL)
+			t = ICON(1);
+		if(p->dims[i].dimsize) {
+			if (q == q0) {
+				q0 = 0;
+				frexpr(q);
+				q = cpexpr(p->dims[i].dimsize);
+				}
+			else
+				q = mkexpr(OPSTAR, cpexpr(p->dims[i].dimsize), q);
+			q = mkexpr(OPPLUS, t, q);
+			}
+	}
+
+	if( ISCONST(q) )
+	{
+		p->baseoffset = q;
+		p->basexpr = NULL;
+	}
+	else
+	{
+		sprintf(buf, " %s_offset", v->fvarname);
+		p->baseoffset = (expptr) autovar(1, tyint, EXNULL, buf);
+		p->basexpr = q;
+		v->vdimfinish = 1;
+	}
+	doin_setbound = 0;
+}
+
+
+ void
+#ifdef KR_headers
+wr_abbrevs(outfile, function_head, vars)
+	FILE *outfile;
+	int function_head;
+	chainp vars;
+#else
+wr_abbrevs(FILE *outfile, int function_head, chainp vars)
+#endif
+{
+    for (; vars; vars = vars -> nextp) {
+	Namep name = (Namep) vars -> datap;
+	if (!name->visused)
+		continue;
+
+	if (function_head)
+	    nice_printf (outfile, "#define ");
+	else
+	    nice_printf (outfile, "#undef ");
+	out_name (outfile, name);
+
+	if (function_head) {
+	    Extsym *comm = &extsymtab[name -> vardesc.varno];
+
+	    nice_printf (outfile, " (");
+	    extern_out (outfile, comm);
+	    nice_printf (outfile, "%d.", comm->curno);
+	    nice_printf (outfile, "%s)", name->cvarname);
+	} /* if function_head */
+	nice_printf (outfile, "\n");
+    } /* for */
+} /* wr_abbrevs */
diff --git a/contrib/tools/f2c/src/put.c b/contrib/tools/f2c/src/put.c
new file mode 100644
index 0000000000..15c70cd8b3
--- /dev/null
+++ b/contrib/tools/f2c/src/put.c
@@ -0,0 +1,458 @@
+/****************************************************************
+Copyright 1990-1991, 1993-1994, 1996, 2000-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+/*
+ * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
+ * JOHNSON (PORTABLE) AND RITCHIE FAMILIES OF SECOND PASSES
+*/
+
+#include "defs.h"
+#include "names.h"		/* For LOCAL_CONST_NAME */
+#include "pccdefs.h"
+#include "p1defs.h"
+
+/* Definitions for   putconst()   */
+
+#define LIT_CHAR 1
+#define LIT_FLOAT 2
+#define LIT_INT 3
+#define LIT_INTQ 4
+
+
+/*
+char *ops [ ] =
+	{
+	"??", "+", "-", "*", "/", "**", "-",
+	"OR", "AND", "EQV", "NEQV", "NOT",
+	"CONCAT",
+	"<", "==", ">", "<=", "!=", ">=",
+	" of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
+	" , ", " ? ", " : "
+	" abs ", " min ", " max ", " addr ", " indirect ",
+	" bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
+	};
+*/
+
+/* Each of these values is defined in   pccdefs   */
+
+int ops2 [ ] =
+{
+	P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
+	P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
+	P2BAD,
+	P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
+	P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
+	P2COMOP, P2QUEST, P2COLON,
+	1, P2BAD, P2BAD, P2BAD, P2BAD,
+	P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT,
+	P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
+	P2BAD, P2BAD, P2BAD, P2BAD,
+	1,1,1,1,1, /* OPNEG1, OPDMIN, OPDMAX, OPASSIGNI, OPIDENTITY */
+	1,1,1,1,   /* OPCHARCAST, OPDABS, OPMIN2, OPMAX2 */
+	1,1,1,1,1  /* OPBITTEST, OPBITCLR, OPBITSET, OPQBIT{CLR,SET} */
+};
+
+
+ void
+#ifdef KR_headers
+putexpr(p)
+	expptr p;
+#else
+putexpr(expptr p)
+#endif
+{
+/* Write the expression to the p1 file */
+
+	p = (expptr) putx (fixtype (p));
+	p1_expr (p);
+}
+
+
+
+
+
+ expptr
+#ifdef KR_headers
+putassign(lp, rp)
+	expptr lp;
+	expptr rp;
+#else
+putassign(expptr lp, expptr rp)
+#endif
+{
+	return putx(fixexpr((Exprp)mkexpr(OPASSIGN, lp, rp)));
+}
+
+
+
+
+ void
+#ifdef KR_headers
+puteq(lp, rp)
+	expptr lp;
+	expptr rp;
+#else
+puteq(expptr lp, expptr rp)
+#endif
+{
+	putexpr(mkexpr(OPASSIGN, lp, rp) );
+}
+
+
+
+
+/* put code for  a *= b */
+
+ expptr
+#ifdef KR_headers
+putsteq(a, b)
+	Addrp a;
+	Addrp b;
+#else
+putsteq(Addrp a, Addrp b)
+#endif
+{
+	return putx( fixexpr((Exprp)
+		mkexpr(OPSTAREQ, cpexpr((expptr)a), cpexpr((expptr)b))));
+}
+
+
+
+
+ Addrp
+#ifdef KR_headers
+mkfield(res, f, ty)
+	register Addrp res;
+	char *f;
+	int ty;
+#else
+mkfield(register Addrp res, char *f, int ty)
+#endif
+{
+    res -> vtype = ty;
+    res -> Field = f;
+    return res;
+} /* mkfield */
+
+
+ Addrp
+#ifdef KR_headers
+realpart(p)
+	register Addrp p;
+#else
+realpart(register Addrp p)
+#endif
+{
+	register Addrp q;
+
+	if (p->tag == TADDR
+	 && p->uname_tag == UNAM_CONST
+	 && ISCOMPLEX (p->vtype))
+		return (Addrp)mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
+			p->user.kludge.vstg1 ? p->user.Const.cds[0]
+				: cds(dtos(p->user.Const.cd[0]),CNULL));
+
+	q = (Addrp) cpexpr((expptr) p);
+	if( ISCOMPLEX(p->vtype) )
+		q = mkfield (q, "r", p -> vtype + TYREAL - TYCOMPLEX);
+
+	return(q);
+}
+
+
+
+
+ expptr
+#ifdef KR_headers
+imagpart(p)
+	register Addrp p;
+#else
+imagpart(register Addrp p)
+#endif
+{
+	register Addrp q;
+
+	if( ISCOMPLEX(p->vtype) )
+	{
+		if (p->tag == TADDR && p->uname_tag == UNAM_CONST)
+			return mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
+				p->user.kludge.vstg1 ? p->user.Const.cds[1]
+				: cds(dtos(p->user.Const.cd[1]),CNULL));
+		q = (Addrp) cpexpr((expptr) p);
+		q = mkfield (q, "i", p -> vtype + TYREAL - TYCOMPLEX);
+		return( (expptr) q );
+	}
+	else
+
+/* Cast an integer type onto a Double Real type */
+
+		return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , "0"));
+}
+
+
+
+
+
+/* ncat -- computes the number of adjacent concatenation operations */
+
+ int
+#ifdef KR_headers
+ncat(p)
+	register expptr p;
+#else
+ncat(register expptr p)
+#endif
+{
+	if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
+		return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
+	else	return(1);
+}
+
+
+
+
+/* lencat -- returns the length of the concatenated string.  Each
+   substring must have a static (i.e. compile-time) fixed length */
+
+ ftnint
+#ifdef KR_headers
+lencat(p)
+	register expptr p;
+#else
+lencat(register expptr p)
+#endif
+{
+	if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
+		return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
+	else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
+		return(p->headblock.vleng->constblock.Const.ci);
+	else if(p->tag==TADDR && p->addrblock.varleng!=0)
+		return(p->addrblock.varleng);
+	else
+	{
+		err("impossible element in concatenation");
+		return(0);
+	}
+}
+
+/* putconst -- Creates a new Addrp value which maps onto the input
+   constant value.  The Addrp doesn't retain the value of the constant,
+   instead that value is copied into a table of constants (called
+   litpool,   for pool of literal values).  The only way to retrieve the
+   actual value of the constant is to look at the   memno   field of the
+   Addrp result.  You know that the associated literal is the one referred
+   to by   q   when   (q -> memno == litp -> litnum).
+*/
+
+ Addrp
+#ifdef KR_headers
+putconst(p)
+	register Constp p;
+#else
+putconst(register Constp p)
+#endif
+{
+	register Addrp q;
+	struct Literal *litp, *lastlit;
+	int k, len, type;
+	int litflavor;
+	double cd[2];
+	ftnint nblanks;
+	char *strp;
+	char cdsbuf0[64], cdsbuf1[64], *ds[2];
+
+	if (p->tag != TCONST)
+		badtag("putconst", p->tag);
+
+	q = ALLOC(Addrblock);
+	q->tag = TADDR;
+	type = p->vtype;
+	q->vtype = ( type==TYADDR ? tyint : type );
+	q->vleng = (expptr) cpexpr(p->vleng);
+	q->vstg = STGCONST;
+
+/* Create the new label for the constant.  This is wasteful of labels
+   because when the constant value already exists in the literal pool,
+   this label gets thrown away and is never reclaimed.  It might be
+   cleaner to move this down past the first   switch()   statement below */
+
+	q->memno = newlabel();
+	q->memoffset = ICON(0);
+	q -> uname_tag = UNAM_CONST;
+
+/* Copy the constant info into the Addrblock; do this by copying the
+   largest storage elts */
+
+	q -> user.Const = p -> Const;
+	q->user.kludge.vstg1 = p->vstg;	/* distinguish string from binary fp */
+
+	/* check for value in literal pool, and update pool if necessary */
+
+	k = 1;
+	switch(type)
+	{
+	case TYCHAR:
+		if (halign) {
+			strp = p->Const.ccp;
+			nblanks = p->Const.ccp1.blanks;
+			len = (int)p->vleng->constblock.Const.ci;
+			litflavor = LIT_CHAR;
+			goto loop;
+			}
+		else
+			q->memno = BAD_MEMNO;
+		break;
+	case TYCOMPLEX:
+	case TYDCOMPLEX:
+		k = 2;
+		if (p->vstg)
+			cd[1] = atof(ds[1] = p->Const.cds[1]);
+		else
+			ds[1] = cds(dtos(cd[1] = p->Const.cd[1]), cdsbuf1);
+	case TYREAL:
+	case TYDREAL:
+		litflavor = LIT_FLOAT;
+		if (p->vstg)
+			cd[0] = atof(ds[0] = p->Const.cds[0]);
+		else
+			ds[0] = cds(dtos(cd[0] = p->Const.cd[0]), cdsbuf0);
+		goto loop;
+
+#ifndef NO_LONG_LONG
+	case TYQUAD:
+		litflavor = LIT_INTQ;
+		goto loop;
+#endif
+
+	case TYLOGICAL1:
+	case TYLOGICAL2:
+	case TYLOGICAL:
+	case TYLONG:
+	case TYSHORT:
+	case TYINT1:
+#ifdef TYQUAD0
+	case TYQUAD:
+#endif
+		litflavor = LIT_INT;
+
+/* Scan the literal pool for this constant value.  If this same constant
+   has been assigned before, use the same label.  Note that this routine
+   does NOT consider two differently-typed constants with the same bit
+   pattern to be the same constant */
+
+ loop:
+		lastlit = litpool + nliterals;
+		for(litp = litpool ; litp<lastlit ; ++litp)
+
+/* Remove this type checking to ensure that all bit patterns are reused */
+
+			if(type == litp->littype) switch(litflavor)
+			{
+			case LIT_CHAR:
+				if (len == (int)litp->litval.litival2[0]
+				&& nblanks == litp->litval.litival2[1]
+				&& !memcmp(strp, litp->cds[0], len)) {
+					q->memno = litp->litnum;
+					frexpr((expptr)p);
+					q->user.Const.ccp1.ccp0 = litp->cds[0];
+					return(q);
+					}
+				break;
+			case LIT_FLOAT:
+				if(cd[0] == litp->litval.litdval[0]
+				&& !strcmp(ds[0], litp->cds[0])
+				&& (k == 1 ||
+				    cd[1] == litp->litval.litdval[1]
+				    && !strcmp(ds[1], litp->cds[1]))) {
+ret:
+					q->memno = litp->litnum;
+					frexpr((expptr)p);
+					return(q);
+					}
+				break;
+
+			case LIT_INT:
+				if(p->Const.ci == litp->litval.litival)
+					goto ret;
+				break;
+#ifndef NO_LONG_LONG
+			case LIT_INTQ:
+				if(p->Const.cq == litp->litval.litqval)
+					goto ret;
+				break;
+#endif
+			}
+
+/* If there's room in the literal pool, add this new value to the pool */
+
+		if(nliterals < maxliterals)
+		{
+			++nliterals;
+
+			/* litp   now points to the next free elt */
+
+			litp->littype = type;
+			litp->litnum = q->memno;
+			switch(litflavor)
+			{
+			case LIT_CHAR:
+				litp->litval.litival2[0] = len;
+				litp->litval.litival2[1] = nblanks;
+				q->user.Const.ccp = litp->cds[0] = (char*)
+					memcpy(gmem(len,0), strp, len);
+				break;
+
+			case LIT_FLOAT:
+				litp->litval.litdval[0] = cd[0];
+				litp->cds[0] = copys(ds[0]);
+				if (k == 2) {
+					litp->litval.litdval[1] = cd[1];
+					litp->cds[1] = copys(ds[1]);
+					}
+				break;
+
+			case LIT_INT:
+				litp->litval.litival = p->Const.ci;
+				break;
+#ifndef NO_LONG_LONG
+			case LIT_INTQ:
+				litp->litval.litqval = p->Const.cq;
+				break;
+#endif
+			} /* switch (litflavor) */
+		}
+		else
+			many("literal constants", 'L', maxliterals);
+
+		break;
+	case TYADDR:
+	    break;
+	default:
+		badtype ("putconst", p -> vtype);
+		break;
+	} /* switch */
+
+	if (type != TYCHAR || halign)
+	    frexpr((expptr)p);
+	return( q );
+}
diff --git a/contrib/tools/f2c/src/putpcc.c b/contrib/tools/f2c/src/putpcc.c
new file mode 100644
index 0000000000..18a9df661b
--- /dev/null
+++ b/contrib/tools/f2c/src/putpcc.c
@@ -0,0 +1,2169 @@
+/****************************************************************
+Copyright 1990-1996, 2000-2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+/* INTERMEDIATE CODE GENERATION FOR S. C. JOHNSON C COMPILERS */
+/* NEW VERSION USING BINARY POLISH POSTFIX INTERMEDIATE */
+
+#include "defs.h"
+#include "pccdefs.h"
+#include "output.h"		/* for nice_printf */
+#include "names.h"
+#include "p1defs.h"
+
+static Addrp intdouble Argdcl((Addrp));
+static Addrp putcx1 Argdcl((tagptr));
+static tagptr putaddr Argdcl((tagptr));
+static tagptr putcall Argdcl((tagptr, Addrp*));
+static tagptr putcat Argdcl((tagptr, tagptr));
+static Addrp putch1 Argdcl((tagptr));
+static tagptr putchcmp Argdcl((tagptr));
+static tagptr putcheq Argdcl((tagptr));
+static void putct1 Argdcl((tagptr, Addrp, Addrp, ptr));
+static tagptr putcxcmp Argdcl((tagptr));
+static Addrp putcxeq Argdcl((tagptr));
+static tagptr putmnmx Argdcl((tagptr));
+static tagptr putop Argdcl((tagptr));
+static tagptr putpower Argdcl((tagptr));
+static long p1_where;
+
+extern int init_ac[TYSUBR+1];
+extern int ops2[];
+extern int proc_argchanges, proc_protochanges;
+extern int krparens;
+
+#define P2BUFFMAX 128
+
+/* Puthead -- output the header information about subroutines, functions
+   and entry points */
+
+ void
+#ifdef KR_headers
+puthead(s, Class)
+	char *s;
+	int Class;
+#else
+puthead(char *s, int Class)
+#endif
+{
+	if (headerdone == NO) {
+		if (Class == CLMAIN)
+			s = "MAIN__";
+		p1_head (Class, s);
+		headerdone = YES;
+		}
+}
+
+ void
+#ifdef KR_headers
+putif(p, else_if_p)
+	register expptr p;
+	int else_if_p;
+#else
+putif(register expptr p, int else_if_p)
+#endif
+{
+	int k, n;
+
+	if( !ISLOGICAL((k = (p = fixtype(p))->headblock.vtype )) )
+	{
+		if(k != TYERROR)
+			err("non-logical expression in IF statement");
+		}
+	else {
+		if (else_if_p) {
+			if (ei_next >= ei_last)
+				{
+				k = ei_last - ei_first;
+				n = k + 100;
+				ei_next = mem(n,0);
+				ei_last = ei_first + n;
+				if (k)
+					memcpy(ei_next, ei_first, k);
+				ei_first =  ei_next;
+				ei_next += k;
+				ei_last = ei_first + n;
+				}
+			p = putx(p);
+			if (*ei_next++ = ftell(pass1_file) > p1_where) {
+				p1_if(p);
+				new_endif();
+				}
+			else
+				p1_elif(p);
+			}
+		else {
+			p = putx(p);
+			p1_if(p);
+			}
+		}
+	}
+
+ void
+#ifdef KR_headers
+putout(p)
+	expptr p;
+#else
+putout(expptr p)
+#endif
+{
+	p1_expr (p);
+
+/* Used to make temporaries in holdtemps available here, but they */
+/* may be reused too soon (e.g. when multiple **'s are involved). */
+}
+
+
+ void
+#ifdef KR_headers
+putcmgo(index, nlab, labs)
+	expptr index;
+	int nlab;
+	struct Labelblock **labs;
+#else
+putcmgo(expptr index, int nlab, struct Labelblock **labs)
+#endif
+{
+	if(! ISINT(index->headblock.vtype) )
+	{
+		execerr("computed goto index must be integer", CNULL);
+		return;
+	}
+
+	p1comp_goto (index, nlab, labs);
+}
+
+ static expptr
+#ifdef KR_headers
+krput(p)
+	register expptr p;
+#else
+krput(register expptr p)
+#endif
+{
+	register expptr e, e1;
+	register unsigned op;
+	int t = krparens == 2 ? TYDREAL : p->exprblock.vtype;
+
+	op = p->exprblock.opcode;
+	e = p->exprblock.leftp;
+	if (e->tag == TEXPR && e->exprblock.opcode == op) {
+		e1 = (expptr)mktmp(t, ENULL);
+		putout(putassign(cpexpr(e1), e));
+		p->exprblock.leftp = e1;
+		}
+	else
+		p->exprblock.leftp = putx(e);
+
+	e = p->exprblock.rightp;
+	if (e->tag == TEXPR && e->exprblock.opcode == op) {
+		e1 = (expptr)mktmp(t, ENULL);
+		putout(putassign(cpexpr(e1), e));
+		p->exprblock.rightp = e1;
+		}
+	else
+		p->exprblock.rightp = putx(e);
+	return p;
+	}
+
+ expptr
+#ifdef KR_headers
+putx(p)
+	register expptr p;
+#else
+putx(register expptr p)
+#endif
+{
+	int opc;
+	int k;
+
+	if (p)
+	  switch(p->tag)
+	{
+	case TERROR:
+		break;
+
+	case TCONST:
+		switch(p->constblock.vtype)
+		{
+		case TYLOGICAL1:
+		case TYLOGICAL2:
+		case TYLOGICAL:
+#ifdef TYQUAD
+		case TYQUAD:
+#endif
+		case TYLONG:
+		case TYSHORT:
+		case TYINT1:
+			break;
+
+		case TYADDR:
+			break;
+		case TYREAL:
+		case TYDREAL:
+
+/* Don't write it out to the p2 file, since you'd need to call putconst,
+   which is just what we need to avoid in the translator */
+
+			break;
+		default:
+			p = putx( (expptr)putconst((Constp)p) );
+			break;
+		}
+		break;
+
+	case TEXPR:
+		switch(opc = p->exprblock.opcode)
+		{
+		case OPCALL:
+		case OPCCALL:
+			if( ISCOMPLEX(p->exprblock.vtype) )
+				p = putcxop(p);
+			else	p = putcall(p, (Addrp *)NULL);
+			break;
+
+		case OPMIN:
+		case OPMAX:
+			p = putmnmx(p);
+			break;
+
+
+		case OPASSIGN:
+			if(ISCOMPLEX(p->exprblock.leftp->headblock.vtype)
+			    || ISCOMPLEX(p->exprblock.rightp->headblock.vtype)) {
+				(void) putcxeq(p);
+				p = ENULL;
+			} else if( ISCHAR(p) )
+				p = putcheq(p);
+			else
+				goto putopp;
+			break;
+
+		case OPEQ:
+		case OPNE:
+			if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ||
+			    ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
+			{
+				p = putcxcmp(p);
+				break;
+			}
+		case OPLT:
+		case OPLE:
+		case OPGT:
+		case OPGE:
+			if(ISCHAR(p->exprblock.leftp))
+			{
+				p = putchcmp(p);
+				break;
+			}
+			goto putopp;
+
+		case OPPOWER:
+			p = putpower(p);
+			break;
+
+		case OPSTAR:
+			/*   m * (2**k) -> m<<k   */
+			if(INT(p->exprblock.leftp->headblock.vtype) &&
+			    ISICON(p->exprblock.rightp) &&
+			    ( (k = log_2(p->exprblock.rightp->constblock.Const.ci))>0) )
+			{
+				p->exprblock.opcode = OPLSHIFT;
+				frexpr(p->exprblock.rightp);
+				p->exprblock.rightp = ICON(k);
+				goto putopp;
+			}
+			if (krparens && ISREAL(p->exprblock.vtype))
+				return krput(p);
+
+		case OPMOD:
+			goto putopp;
+		case OPPLUS:
+			if (krparens && ISREAL(p->exprblock.vtype))
+				return krput(p);
+		case OPMINUS:
+		case OPSLASH:
+		case OPNEG:
+		case OPNEG1:
+		case OPABS:
+		case OPDABS:
+			if( ISCOMPLEX(p->exprblock.vtype) )
+				p = putcxop(p);
+			else	goto putopp;
+			break;
+
+		case OPCONV:
+			if( ISCOMPLEX(p->exprblock.vtype) )
+				p = putcxop(p);
+			else if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) )
+			{
+				p = putx( mkconv(p->exprblock.vtype,
+				    (expptr)realpart(putcx1(p->exprblock.leftp))));
+			}
+			else	goto putopp;
+			break;
+
+		case OPNOT:
+		case OPOR:
+		case OPAND:
+		case OPEQV:
+		case OPNEQV:
+		case OPADDR:
+		case OPPLUSEQ:
+		case OPSTAREQ:
+		case OPCOMMA:
+		case OPQUEST:
+		case OPCOLON:
+		case OPBITOR:
+		case OPBITAND:
+		case OPBITXOR:
+		case OPBITNOT:
+		case OPLSHIFT:
+		case OPRSHIFT:
+		case OPASSIGNI:
+		case OPIDENTITY:
+		case OPCHARCAST:
+		case OPMIN2:
+		case OPMAX2:
+		case OPDMIN:
+		case OPDMAX:
+		case OPBITTEST:
+		case OPBITCLR:
+		case OPBITSET:
+#ifdef TYQUAD
+		case OPQBITSET:
+		case OPQBITCLR:
+#endif
+putopp:
+			p = putop(p);
+			break;
+
+		case OPCONCAT:
+			/* weird things like ichar(a//a) */
+			p = (expptr)putch1(p);
+			break;
+
+		default:
+			badop("putx", opc);
+			p = errnode ();
+		}
+		break;
+
+	case TADDR:
+		p = putaddr(p);
+		break;
+
+	default:
+		badtag("putx", p->tag);
+		p = errnode ();
+	}
+
+	return p;
+}
+
+
+
+ LOCAL expptr
+#ifdef KR_headers
+putop(p)
+	expptr p;
+#else
+putop(expptr p)
+#endif
+{
+	expptr lp, tp;
+	int pt, lt, lt1;
+	int comma;
+	char *hsave;
+
+	switch(p->exprblock.opcode)	/* check for special cases and rewrite */
+	{
+	case OPCONV:
+		pt = p->exprblock.vtype;
+		lp = p->exprblock.leftp;
+		lt = lp->headblock.vtype;
+
+/* Simplify nested type casts */
+
+		while(p->tag==TEXPR && p->exprblock.opcode==OPCONV &&
+		    ( (ISREAL(pt)&&ONEOF(lt,MSKREAL|MSKCOMPLEX)) ||
+		    (INT(pt)&&(ONEOF(lt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
+		{
+			if(pt==TYDREAL && lt==TYREAL)
+			{
+				if(lp->tag==TEXPR
+				&& lp->exprblock.opcode == OPCONV) {
+				    lt1 = lp->exprblock.leftp->headblock.vtype;
+				    if (lt1 == TYDREAL) {
+					lp->exprblock.leftp =
+						putx(lp->exprblock.leftp);
+					return p;
+					}
+				    if (lt1 == TYDCOMPLEX) {
+					lp->exprblock.leftp = putx(
+						(expptr)realpart(
+						putcx1(lp->exprblock.leftp)));
+					return p;
+					}
+				    }
+				break;
+			}
+			else if (ISREAL(pt) && ISCOMPLEX(lt)) {
+				p->exprblock.leftp = putx(mkconv(pt,
+					(expptr)realpart(
+						putcx1(p->exprblock.leftp))));
+				break;
+				}
+			if(lt==TYCHAR && lp->tag==TEXPR &&
+			    lp->exprblock.opcode==OPCALL)
+			{
+
+/* May want to make a comma expression here instead.  I had one, but took
+   it out for my convenience, not for the convenience of the end user */
+
+				putout (putcall (lp, (Addrp *) &(p ->
+				    exprblock.leftp)));
+				return putop (p);
+			}
+			if (lt == TYCHAR) {
+				if (ISCONST(p->exprblock.leftp)
+				 && ISNUMERIC(p->exprblock.vtype)) {
+					hsave = halign;
+					halign = 0;
+					p->exprblock.leftp = putx((expptr)
+						putconst((Constp)
+							p->exprblock.leftp));
+					halign = hsave;
+					}
+				else
+					p->exprblock.leftp =
+						putx(p->exprblock.leftp);
+				return p;
+				}
+			if (pt < lt && ONEOF(lt,MSKINT|MSKREAL))
+				break;
+			frexpr(p->exprblock.vleng);
+			free( (charptr) p );
+			p = lp;
+			if (p->tag != TEXPR)
+				goto retputx;
+			pt = lt;
+			lp = p->exprblock.leftp;
+			lt = lp->headblock.vtype;
+		} /* while */
+		if(p->tag==TEXPR && p->exprblock.opcode==OPCONV)
+			break;
+ retputx:
+		return putx(p);
+
+	case OPADDR:
+		comma = NO;
+		lp = p->exprblock.leftp;
+		free( (charptr) p );
+		if(lp->tag != TADDR)
+		{
+			tp = (expptr)
+			    mktmp(lp->headblock.vtype,lp->headblock.vleng);
+			p = putx( mkexpr(OPASSIGN, cpexpr(tp), lp) );
+			lp = tp;
+			comma = YES;
+		}
+		if(comma)
+			p = mkexpr(OPCOMMA, p, putaddr(lp));
+		else
+			p = (expptr)putaddr(lp);
+		return p;
+
+	case OPASSIGN:
+	case OPASSIGNI:
+	case OPLT:
+	case OPLE:
+	case OPGT:
+	case OPGE:
+	case OPEQ:
+	case OPNE:
+	    ;
+	}
+
+	if( ops2[p->exprblock.opcode] <= 0)
+		badop("putop", p->exprblock.opcode);
+	lp = p->exprblock.leftp = putx(p->exprblock.leftp);
+	if (p -> exprblock.rightp) {
+		tp = p->exprblock.rightp = putx(p->exprblock.rightp);
+		if (tp && ISCONST(tp) && ISCONST(lp))
+			p = fold(p);
+		}
+	return p;
+}
+
+ LOCAL expptr
+#ifdef KR_headers
+putpower(p)
+	expptr p;
+#else
+putpower(expptr p)
+#endif
+{
+	expptr base;
+	Addrp t1, t2;
+	ftnint k;
+	int type;
+	char buf[80];			/* buffer for text of comment */
+
+	if(!ISICON(p->exprblock.rightp) ||
+	    (k = p->exprblock.rightp->constblock.Const.ci)<2)
+		Fatal("putpower: bad call");
+	base = p->exprblock.leftp;
+	type = base->headblock.vtype;
+	t1 = mktmp(type, ENULL);
+	t2 = NULL;
+
+	free ((charptr) p);
+	p = putassign (cpexpr((expptr) t1), base);
+
+	sprintf (buf, "Computing %ld%s power", k,
+		k == 2 ? "nd" : k == 3 ? "rd" : "th");
+	p1_comment (buf);
+
+	for( ; (k&1)==0 && k>2 ; k>>=1 )
+	{
+		p = mkexpr (OPCOMMA, p, putsteq(t1, t1));
+	}
+
+	if(k == 2) {
+
+/* Write the power computation out immediately */
+		putout (p);
+		p = putx( mkexpr(OPSTAR, cpexpr((expptr)t1), cpexpr((expptr)t1)));
+	} else if (k == 3) {
+		putout(p);
+		p = putx( mkexpr(OPSTAR, cpexpr((expptr)t1),
+		    mkexpr(OPSTAR, cpexpr((expptr)t1), cpexpr((expptr)t1))));
+	} else {
+		t2 = mktmp(type, ENULL);
+		p = mkexpr (OPCOMMA, p, putassign(cpexpr((expptr)t2),
+						cpexpr((expptr)t1)));
+
+		for(k>>=1 ; k>1 ; k>>=1)
+		{
+			p = mkexpr (OPCOMMA, p, putsteq(t1, t1));
+			if(k & 1)
+			{
+				p = mkexpr (OPCOMMA, p, putsteq(t2, t1));
+			}
+		}
+/* Write the power computation out immediately */
+		putout (p);
+		p = putx( mkexpr(OPSTAR, cpexpr((expptr)t2),
+		    mkexpr(OPSTAR, cpexpr((expptr)t1), cpexpr((expptr)t1))));
+	}
+	frexpr((expptr)t1);
+	if(t2)
+		frexpr((expptr)t2);
+	return p;
+}
+
+
+
+
+ LOCAL Addrp
+#ifdef KR_headers
+intdouble(p)
+	Addrp p;
+#else
+intdouble(Addrp p)
+#endif
+{
+	register Addrp t;
+
+	t = mktmp(TYDREAL, ENULL);
+	putout (putassign(cpexpr((expptr)t), (expptr)p));
+	return(t);
+}
+
+
+
+
+
+/* Complex-type variable assignment */
+
+ LOCAL Addrp
+#ifdef KR_headers
+putcxeq(p)
+	register expptr p;
+#else
+putcxeq(register expptr p)
+#endif
+{
+	register Addrp lp, rp;
+	expptr code;
+
+	if(p->tag != TEXPR)
+		badtag("putcxeq", p->tag);
+
+	lp = putcx1(p->exprblock.leftp);
+	rp = putcx1(p->exprblock.rightp);
+	code = putassign ( (expptr)realpart(lp), (expptr)realpart(rp));
+
+	if( ISCOMPLEX(p->exprblock.vtype) )
+	{
+		code = mkexpr (OPCOMMA, code, putassign
+			(imagpart(lp), imagpart(rp)));
+	}
+	putout (code);
+	frexpr((expptr)rp);
+	free ((charptr) p);
+	return lp;
+}
+
+
+
+/* putcxop -- used to write out embedded calls to complex functions, and
+   complex arguments to procedures */
+
+ expptr
+#ifdef KR_headers
+putcxop(p)
+	expptr p;
+#else
+putcxop(expptr p)
+#endif
+{
+	return (expptr)putaddr((expptr)putcx1(p));
+}
+
+#define PAIR(x,y) mkexpr (OPCOMMA, (x), (y))
+
+ LOCAL Addrp
+#ifdef KR_headers
+putcx1(p)
+	register expptr p;
+#else
+putcx1(register expptr p)
+#endif
+{
+	expptr q;
+	Addrp lp, rp;
+	register Addrp resp;
+	int opcode;
+	int ltype, rtype;
+	long ts, tskludge;
+
+	if(p == NULL)
+		return(NULL);
+
+	switch(p->tag)
+	{
+	case TCONST:
+		if( ISCOMPLEX(p->constblock.vtype) )
+			p = (expptr) putconst((Constp)p);
+		return( (Addrp) p );
+
+	case TADDR:
+		resp = &p->addrblock;
+		if (addressable(p))
+			return (Addrp) p;
+		ts = tskludge = 0;
+		if (q = resp->memoffset) {
+			if (resp->uname_tag == UNAM_REF) {
+				q = cpexpr((tagptr)resp);
+				q->addrblock.vtype = tyint;
+				q->addrblock.cmplx_sub = 1;
+				p->addrblock.skip_offset = 1;
+				resp->user.name->vsubscrused = 1;
+				resp->uname_tag = UNAM_NAME;
+				tskludge = typesize[resp->vtype]
+					* (resp->Field ? 2 : 1);
+				}
+			else if (resp->isarray
+					&& resp->vtype != TYCHAR) {
+				if (ONEOF(resp->vstg, M(STGCOMMON)|M(STGEQUIV))
+					  && resp->uname_tag == UNAM_NAME)
+					q = mkexpr(OPMINUS, q,
+					  mkintcon(resp->user.name->voffset));
+				ts = typesize[resp->vtype]
+					* (resp->Field ? 2 : 1);
+				q = resp->memoffset = mkexpr(OPSLASH, q,
+								ICON(ts));
+				}
+			}
+#ifdef TYQUAD
+		resp = mktmp(q->headblock.vtype == TYQUAD ? TYQUAD : tyint, ENULL);
+#else
+		resp = mktmp(tyint, ENULL);
+#endif
+		putout(putassign(cpexpr((expptr)resp), q));
+		p->addrblock.memoffset = tskludge
+			? mkexpr(OPSTAR, (expptr)resp, ICON(tskludge))
+			: (expptr)resp;
+		if (ts) {
+			resp = &p->addrblock;
+			q = mkexpr(OPSTAR, resp->memoffset, ICON(ts));
+			if (ONEOF(resp->vstg, M(STGCOMMON)|M(STGEQUIV))
+				&& resp->uname_tag == UNAM_NAME)
+				q = mkexpr(OPPLUS, q,
+				    mkintcon(resp->user.name->voffset));
+			resp->memoffset = q;
+			}
+		return (Addrp) p;
+
+	case TEXPR:
+		if( ISCOMPLEX(p->exprblock.vtype) )
+			break;
+		resp = mktmp(p->exprblock.vtype, ENULL);
+		/*first arg of above mktmp call was TYDREAL before 19950102 */
+		putout (putassign( cpexpr((expptr)resp), p));
+		return(resp);
+
+	case TERROR:
+		return NULL;
+
+	default:
+		badtag("putcx1", p->tag);
+	}
+
+	opcode = p->exprblock.opcode;
+	if(opcode==OPCALL || opcode==OPCCALL)
+	{
+		Addrp t;
+		p = putcall(p, &t);
+		putout(p);
+		return t;
+	}
+	else if(opcode == OPASSIGN)
+	{
+		return putcxeq (p);
+	}
+
+/* BUG  (inefficient)  Generates too many temporary variables */
+
+	resp = mktmp(p->exprblock.vtype, ENULL);
+	if(lp = putcx1(p->exprblock.leftp) )
+		ltype = lp->vtype;
+	if(rp = putcx1(p->exprblock.rightp) )
+		rtype = rp->vtype;
+
+	switch(opcode)
+	{
+	case OPCOMMA:
+		frexpr((expptr)resp);
+		resp = rp;
+		rp = NULL;
+		break;
+
+	case OPNEG:
+	case OPNEG1:
+		putout (PAIR (
+			putassign( (expptr)realpart(resp),
+				mkexpr(OPNEG, (expptr)realpart(lp), ENULL)),
+			putassign( imagpart(resp),
+				mkexpr(OPNEG, imagpart(lp), ENULL))));
+		break;
+
+	case OPPLUS:
+	case OPMINUS: { expptr r;
+		r = putassign( (expptr)realpart(resp),
+		    mkexpr(opcode, (expptr)realpart(lp), (expptr)realpart(rp) ));
+		if(rtype < TYCOMPLEX)
+			q = putassign( imagpart(resp), imagpart(lp) );
+		else if(ltype < TYCOMPLEX)
+		{
+			if(opcode == OPPLUS)
+				q = putassign( imagpart(resp), imagpart(rp) );
+			else
+				q = putassign( imagpart(resp),
+				    mkexpr(OPNEG, imagpart(rp), ENULL) );
+		}
+		else
+			q = putassign( imagpart(resp),
+			    mkexpr(opcode, imagpart(lp), imagpart(rp) ));
+		r = PAIR (r, q);
+		putout (r);
+		break;
+	    } /* case OPPLUS, OPMINUS: */
+	case OPSTAR:
+		if(ltype < TYCOMPLEX)
+		{
+			if( ISINT(ltype) )
+				lp = intdouble(lp);
+			putout (PAIR (
+				putassign( (expptr)realpart(resp),
+				    mkexpr(OPSTAR, cpexpr((expptr)lp),
+					(expptr)realpart(rp))),
+				putassign( imagpart(resp),
+				    mkexpr(OPSTAR, cpexpr((expptr)lp), imagpart(rp)))));
+		}
+		else if(rtype < TYCOMPLEX)
+		{
+			if( ISINT(rtype) )
+				rp = intdouble(rp);
+			putout (PAIR (
+				putassign( (expptr)realpart(resp),
+				    mkexpr(OPSTAR, cpexpr((expptr)rp),
+					(expptr)realpart(lp))),
+				putassign( imagpart(resp),
+				    mkexpr(OPSTAR, cpexpr((expptr)rp), imagpart(lp)))));
+		}
+		else	{
+			putout (PAIR (
+				putassign( (expptr)realpart(resp), mkexpr(OPMINUS,
+				    mkexpr(OPSTAR, (expptr)realpart(lp),
+					(expptr)realpart(rp)),
+				    mkexpr(OPSTAR, imagpart(lp), imagpart(rp)))),
+				putassign( imagpart(resp), mkexpr(OPPLUS,
+				    mkexpr(OPSTAR, (expptr)realpart(lp), imagpart(rp)),
+				    mkexpr(OPSTAR, imagpart(lp),
+					(expptr)realpart(rp))))));
+		}
+		break;
+
+	case OPSLASH:
+		/* fixexpr has already replaced all divisions
+		 * by a complex by a function call
+		 */
+		if( ISINT(rtype) )
+			rp = intdouble(rp);
+		putout (PAIR (
+			putassign( (expptr)realpart(resp),
+			    mkexpr(OPSLASH, (expptr)realpart(lp), cpexpr((expptr)rp))),
+			putassign( imagpart(resp),
+			    mkexpr(OPSLASH, imagpart(lp), cpexpr((expptr)rp)))));
+		break;
+
+	case OPCONV:
+		if (!lp)
+			break;
+		if(ISCOMPLEX(lp->vtype) )
+			q = imagpart(lp);
+		else if(rp != NULL)
+			q = (expptr) realpart(rp);
+		else
+			q = mkrealcon(TYDREAL, "0");
+		putout (PAIR (
+			putassign( (expptr)realpart(resp), (expptr)realpart(lp)),
+			putassign( imagpart(resp), q)));
+		break;
+
+	default:
+		badop("putcx1", opcode);
+	}
+
+	frexpr((expptr)lp);
+	frexpr((expptr)rp);
+	free( (charptr) p );
+	return(resp);
+}
+
+
+
+
+/* Only .EQ. and .NE. may be performed on COMPLEX data, other relations
+   are not defined */
+
+ LOCAL expptr
+#ifdef KR_headers
+putcxcmp(p)
+	register expptr p;
+#else
+putcxcmp(register expptr p)
+#endif
+{
+	int opcode;
+	register Addrp lp, rp;
+	expptr q;
+
+	if(p->tag != TEXPR)
+		badtag("putcxcmp", p->tag);
+
+	opcode = p->exprblock.opcode;
+	lp = putcx1(p->exprblock.leftp);
+	rp = putcx1(p->exprblock.rightp);
+
+	q = mkexpr( opcode==OPEQ ? OPAND : OPOR ,
+	    mkexpr(opcode, (expptr)realpart(lp), (expptr)realpart(rp)),
+	    mkexpr(opcode, imagpart(lp), imagpart(rp)) );
+
+	free( (charptr) lp);
+	free( (charptr) rp);
+	free( (charptr) p );
+	if (ISCONST(q))
+		return q;
+	return 	putx( fixexpr((Exprp)q) );
+}
+
+/* putch1 -- Forces constants into the literal pool, among other things */
+
+ LOCAL Addrp
+#ifdef KR_headers
+putch1(p)
+	register expptr p;
+#else
+putch1(register expptr p)
+#endif
+{
+	Addrp t;
+	expptr e;
+
+	switch(p->tag)
+	{
+	case TCONST:
+		return( putconst((Constp)p) );
+
+	case TADDR:
+		return( (Addrp) p );
+
+	case TEXPR:
+		switch(p->exprblock.opcode)
+		{
+			expptr q;
+
+		case OPCALL:
+		case OPCCALL:
+
+			p = putcall(p, &t);
+			putout (p);
+			break;
+
+		case OPCONCAT:
+			t = mktmp(TYCHAR, ICON(lencat(p)));
+			q = (expptr) cpexpr(p->headblock.vleng);
+			p = putcat( cpexpr((expptr)t), p );
+			/* put the correct length on the block */
+			frexpr(t->vleng);
+			t->vleng = q;
+			putout (p);
+			break;
+
+		case OPCONV:
+			if(!ISICON(p->exprblock.vleng)
+			    || p->exprblock.vleng->constblock.Const.ci!=1
+			    || ! INT(p->exprblock.leftp->headblock.vtype) )
+				Fatal("putch1: bad character conversion");
+			t = mktmp(TYCHAR, ICON(1));
+			e = mkexpr(OPCONV, (expptr)t, ENULL);
+			e->headblock.vtype = TYCHAR;
+			p = putop( mkexpr(OPASSIGN, cpexpr(e), p));
+			putout (p);
+			break;
+		default:
+			badop("putch1", p->exprblock.opcode);
+		}
+		return(t);
+
+	default:
+		badtag("putch1", p->tag);
+	}
+	/* NOT REACHED */ return 0;
+}
+
+
+/* putchop -- Write out a character actual parameter; that is, this is
+   part of a procedure invocation */
+
+ Addrp
+#ifdef KR_headers
+putchop(p)
+	expptr p;
+#else
+putchop(expptr p)
+#endif
+{
+	p = putaddr((expptr)putch1(p));
+	return (Addrp)p;
+}
+
+
+
+
+ LOCAL expptr
+#ifdef KR_headers
+putcheq(p)
+	register expptr p;
+#else
+putcheq(register expptr p)
+#endif
+{
+	expptr lp, rp;
+	int nbad;
+
+	if(p->tag != TEXPR)
+		badtag("putcheq", p->tag);
+
+	lp = p->exprblock.leftp;
+	rp = p->exprblock.rightp;
+	frexpr(p->exprblock.vleng);
+	free( (charptr) p );
+
+/* If s = t // u, don't bother copying the result, write it directly into
+   this buffer */
+
+	nbad = badchleng(lp) + badchleng(rp);
+	if( rp->tag==TEXPR && rp->exprblock.opcode==OPCONCAT )
+		p = putcat(lp, rp);
+	else if( !nbad
+		&& ISONE(lp->headblock.vleng)
+		&& ISONE(rp->headblock.vleng) ) {
+		lp = mkexpr(OPCONV, lp, ENULL);
+		rp = mkexpr(OPCONV, rp, ENULL);
+		lp->headblock.vtype = rp->headblock.vtype = TYCHAR;
+		p = putop(mkexpr(OPASSIGN, lp, rp));
+		}
+	else
+		p = putx( call2(TYSUBR, "s_copy", lp, rp) );
+	return p;
+}
+
+
+
+
+ LOCAL expptr
+#ifdef KR_headers
+putchcmp(p)
+	register expptr p;
+#else
+putchcmp(register expptr p)
+#endif
+{
+	expptr lp, rp;
+
+	if(p->tag != TEXPR)
+		badtag("putchcmp", p->tag);
+
+	lp = p->exprblock.leftp;
+	rp = p->exprblock.rightp;
+
+	if(ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) ) {
+		lp = mkexpr(OPCONV, lp, ENULL);
+		rp = mkexpr(OPCONV, rp, ENULL);
+		lp->headblock.vtype = rp->headblock.vtype = TYCHAR;
+		}
+	else {
+		lp = call2(TYINT,"s_cmp", lp, rp);
+		rp = ICON(0);
+		}
+	p->exprblock.leftp = lp;
+	p->exprblock.rightp = rp;
+	p = putop(p);
+	return p;
+}
+
+
+
+
+
+/* putcat -- Writes out a concatenation operation.  Two temporary arrays
+   are allocated,   putct1()   is called to initialize them, and then a
+   call to runtime library routine   s_cat()   is inserted.
+
+	This routine generates code which will perform an  (nconc lhs rhs)
+   at runtime.  The runtime funciton does not return a value, the routine
+   that calls this   putcat   must remember the name of   lhs.
+*/
+
+
+ LOCAL expptr
+#ifdef KR_headers
+putcat(lhs0, rhs)
+	expptr lhs0;
+	register expptr rhs;
+#else
+putcat(expptr lhs0, register expptr rhs)
+#endif
+{
+	register Addrp lhs = (Addrp)lhs0;
+	int n, tyi;
+	Addrp length_var, string_var;
+	expptr p;
+	static char Writing_concatenation[] = "Writing concatenation";
+
+/* Create the temporary arrays */
+
+	n = ncat(rhs);
+	length_var = mktmpn(n, tyioint, ENULL);
+	string_var = mktmpn(n, TYADDR, ENULL);
+	frtemp((Addrp)cpexpr((expptr)length_var));
+	frtemp((Addrp)cpexpr((expptr)string_var));
+
+/* Initialize the arrays */
+
+	n = 0;
+	/* p1_comment scribbles on its argument, so we
+	 * cannot safely pass a string literal here. */
+	p1_comment(Writing_concatenation);
+	putct1(rhs, length_var, string_var, &n);
+
+/* Create the invocation */
+
+	tyi = tyint;
+	tyint = tyioint;	/* for -I2 */
+	p = putx (call4 (TYSUBR, "s_cat",
+				(expptr)lhs,
+				(expptr)string_var,
+				(expptr)length_var,
+				(expptr)putconst((Constp)ICON(n))));
+	tyint = tyi;
+
+	return p;
+}
+
+
+
+
+
+ LOCAL void
+#ifdef KR_headers
+putct1(q, length_var, string_var, ip)
+	register expptr q;
+	register Addrp length_var;
+	register Addrp string_var;
+	int *ip;
+#else
+putct1(register expptr q, register Addrp length_var, register Addrp string_var, int *ip)
+#endif
+{
+	int i;
+	Addrp length_copy, string_copy;
+	expptr e;
+	extern int szleng;
+
+	if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT)
+	{
+		putct1(q->exprblock.leftp, length_var, string_var,
+		    ip);
+		putct1(q->exprblock.rightp, length_var, string_var,
+		    ip);
+		frexpr (q -> exprblock.vleng);
+		free ((charptr) q);
+	}
+	else
+	{
+		i = (*ip)++;
+		e = cpexpr(q->headblock.vleng);
+		if (!e)
+			return; /* error -- character*(*) */
+		length_copy = (Addrp) cpexpr((expptr)length_var);
+		length_copy->memoffset =
+		    mkexpr(OPPLUS,length_copy->memoffset, ICON(i*szleng));
+		string_copy = (Addrp) cpexpr((expptr)string_var);
+		string_copy->memoffset =
+		    mkexpr(OPPLUS, string_copy->memoffset,
+			ICON(i*typesize[TYADDR]));
+		putout (PAIR (putassign((expptr)length_copy, e),
+			putassign((expptr)string_copy, addrof((expptr)putch1(q)))));
+	}
+}
+
+/* putaddr -- seems to write out function invocation actual parameters */
+
+	LOCAL expptr
+#ifdef KR_headers
+putaddr(p0)
+	expptr p0;
+#else
+putaddr(expptr p0)
+#endif
+{
+	register Addrp p;
+	chainp cp;
+
+	if (!(p = (Addrp)p0))
+		return ENULL;
+
+	if( p->tag==TERROR || (p->memoffset!=NULL && ISERROR(p->memoffset)) )
+	{
+		frexpr((expptr)p);
+		return ENULL;
+	}
+	if (p->isarray && p->memoffset)
+		if (p->uname_tag == UNAM_REF) {
+			cp = p->memoffset->listblock.listp;
+			for(; cp; cp = cp->nextp)
+				cp->datap = (char *)fixtype((tagptr)cp->datap);
+			}
+		else
+			p->memoffset = putx(p->memoffset);
+	return (expptr) p;
+}
+
+ LOCAL expptr
+#ifdef KR_headers
+addrfix(e)
+	expptr e;
+#else
+addrfix(expptr e)
+#endif
+		/* fudge character string length if it's a TADDR */
+{
+	return e->tag == TADDR ? mkexpr(OPIDENTITY, e, ENULL) : e;
+	}
+
+ LOCAL int
+#ifdef KR_headers
+typekludge(ccall, q, at, j)
+	int ccall;
+	register expptr q;
+	Atype *at;
+	int j;
+#else
+typekludge(int ccall, register expptr q, Atype *at, int j)
+#endif
+ /* j = alternate type */
+{
+	register int i, k;
+	extern int iocalladdr;
+	register Namep np;
+
+	/* Return value classes:
+	 *	< 100 ==> Fortran arg (pointer to type)
+	 *	< 200 ==> C arg
+	 *	< 300 ==> procedure arg
+	 *	< 400 ==> external, no explicit type
+	 *	< 500 ==> arg that may turn out to be
+	 *		  either a variable or a procedure
+	 */
+
+	k = q->headblock.vtype;
+	if (ccall) {
+		if (k == TYREAL)
+			k = TYDREAL;	/* force double for library routines */
+		return k + 100;
+		}
+	if (k == TYADDR)
+		return iocalladdr;
+	i = q->tag;
+	if ((i == TEXPR && q->exprblock.opcode != OPCOMMA_ARG)
+	||  (i == TADDR && q->addrblock.charleng)
+	||   i == TCONST)
+		k = TYFTNLEN + 100;
+	else if (i == TADDR)
+	    switch(q->addrblock.vclass) {
+		case CLPROC:
+			if (q->addrblock.uname_tag != UNAM_NAME)
+				k += 200;
+			else if ((np = q->addrblock.user.name)->vprocclass
+					!= PTHISPROC) {
+				if (k && !np->vimpltype)
+					k += 200;
+				else {
+					if (j > 200 && infertypes && j < 300) {
+						k = j;
+						inferdcl(np, j-200);
+						}
+					else k = (np->vstg == STGEXT
+						? extsymtab[np->vardesc.varno].extype
+						: 0) + 200;
+					at->cp = mkchain((char *)np, at->cp);
+					}
+				}
+			else if (k == TYSUBR)
+				k += 200;
+			break;
+
+		case CLUNKNOWN:
+			if (q->addrblock.vstg == STGARG
+			 && q->addrblock.uname_tag == UNAM_NAME) {
+				k += 400;
+				at->cp = mkchain((char *)q->addrblock.user.name,
+						at->cp);
+				}
+		}
+	else if (i == TNAME && q->nameblock.vstg == STGARG) {
+		np = &q->nameblock;
+		switch(np->vclass) {
+		    case CLPROC:
+			if (!np->vimpltype)
+				k += 200;
+			else if (j <= 200 || !infertypes || j >= 300)
+				k += 300;
+			else {
+				k = j;
+				inferdcl(np, j-200);
+				}
+			goto add2chain;
+
+		    case CLUNKNOWN:
+			/* argument may be a scalar variable or a function */
+			if (np->vimpltype && j && infertypes
+			&& j < 300) {
+				inferdcl(np, j % 100);
+				k = j;
+				}
+			else
+				k += 400;
+
+			/* to handle procedure args only so far known to be
+			 * external, save a pointer to the symbol table entry...
+		 	 */
+ add2chain:
+			at->cp = mkchain((char *)np, at->cp);
+		    }
+		}
+	return k;
+	}
+
+ char *
+#ifdef KR_headers
+Argtype(k, buf)
+	int k;
+	char *buf;
+#else
+Argtype(int k, char *buf)
+#endif
+{
+	if (k < 100) {
+		sprintf(buf, "%s variable", ftn_types[k]);
+		return buf;
+		}
+	if (k < 200) {
+		k -= 100;
+		return ftn_types[k];
+		}
+	if (k < 300) {
+		k -= 200;
+		if (k == TYSUBR)
+			return ftn_types[TYSUBR];
+		sprintf(buf, "%s function", ftn_types[k]);
+		return buf;
+		}
+	if (k < 400)
+		return "external argument";
+	k -= 400;
+	sprintf(buf, "%s argument", ftn_types[k]);
+	return buf;
+	}
+
+ static void
+#ifdef KR_headers
+atype_squawk(at, msg)
+	Argtypes *at;
+	char *msg;
+#else
+atype_squawk(Argtypes *at, char *msg)
+#endif
+{
+	register Atype *a, *ae;
+	warn(msg);
+	for(a = at->atypes, ae = a + at->nargs; a < ae; a++)
+		frchain(&a->cp);
+	at->nargs = -1;
+	if (at->changes & 2 && !at->defined)
+		proc_protochanges++;
+	}
+
+ static char inconsist[] = "inconsistent calling sequences for ";
+
+ void
+#ifdef KR_headers
+bad_atypes(at, fname, i, j, k, here, prev)
+	Argtypes *at;
+	char *fname;
+	int i;
+	int j;
+	int k;
+	char *here;
+	char *prev;
+#else
+bad_atypes(Argtypes *at, char *fname, int i, int j, int k, char *here, char *prev)
+#endif
+{
+	char buf[208], buf1[32], buf2[32];
+
+	sprintf(buf, "%s%.90s,\n\targ %d: %s%s%s %s.",
+		inconsist, fname, i, here, Argtype(k, buf1),
+		prev, Argtype(j, buf2));
+	atype_squawk(at, buf);
+	}
+
+ int
+#ifdef KR_headers
+type_fixup(at, a, k)
+	Argtypes *at;
+	Atype *a;
+	int k;
+#else
+type_fixup(Argtypes *at,  Atype *a,  int k)
+#endif
+{
+	register struct Entrypoint *ep;
+	if (!infertypes)
+		return 0;
+	for(ep = entries; ep; ep = ep->entnextp)
+		if (ep->entryname && at == ep->entryname->arginfo) {
+			a->type = k % 100;
+			return proc_argchanges = 1;
+			}
+	return 0;
+	}
+
+
+ void
+#ifdef KR_headers
+save_argtypes(arglist, at0, at1, ccall, fname, stg, nchargs, type, zap)
+	chainp arglist;
+	Argtypes **at0;
+	Argtypes **at1;
+	int ccall;
+	char *fname;
+	int stg;
+	int nchargs;
+	int type;
+	int zap;
+#else
+save_argtypes(chainp arglist, Argtypes **at0, Argtypes **at1, int ccall, char *fname, int stg, int nchargs, int type, int zap)
+#endif
+{
+	Argtypes *at;
+	chainp cp;
+	int i, i0, j, k, nargs, nbad, *t, *te;
+	Atype *atypes;
+	expptr q;
+	char buf[208], buf1[32], buf2[32];
+	static int initargs[4] = {TYCOMPLEX, TYDCOMPLEX, TYCHAR, TYFTNLEN+100};
+	static int *init_ap[TYSUBR+1] = {0,0,0,0,0,0,0,
+#ifdef TYQUAD
+							0,
+#endif
+				initargs, initargs+1,0,0,0,initargs+2};
+
+	i0 = init_ac[type];
+	t = init_ap[type];
+	te = t + i0;
+	if (at = *at0) {
+		*at1 = at;
+		nargs = at->nargs;
+		if (nargs < 0 && type && at->changes & 2 && !at->defined)
+			--proc_protochanges;
+		if (at->dnargs >= 0 && zap != 2)
+			type = 0;
+		if (nargs < 0) { /* inconsistent usage seen */
+			if (type)
+				goto newlist;
+			return;
+			}
+		atypes = at->atypes;
+		i = nchargs;
+		for(nbad = 0; t < te; atypes++) {
+			if (++i > nargs) {
+ toomany:
+				i = nchargs + i0;
+				for(cp = arglist; cp; cp = cp->nextp)
+					i++;
+ toofew:
+				switch(zap) {
+					case 2:	zap = 6; break;
+					case 1:	if (at->defined & 4)
+							return;
+					}
+				sprintf(buf,
+		"%s%.90s:\n\there %d, previously %d args and string lengths.",
+					inconsist, fname, i, nargs);
+				atype_squawk(at, buf);
+				if (type) {
+					t = init_ap[type];
+					goto newlist;
+					}
+				return;
+				}
+			j = atypes->type;
+			k = *t++;
+			if (j != k && j-400 != k) {
+				cp = 0;
+				goto badtypes;
+				}
+			}
+		for(cp = arglist; cp; atypes++, cp = cp->nextp) {
+			if (++i > nargs)
+				goto toomany;
+			j = atypes->type;
+			if (!(q = (expptr)cp->datap))
+				continue;
+			k = typekludge(ccall, q, atypes, j);
+			if (k >= 300 || k == j)
+				continue;
+			if (j >= 300) {
+				if (k >= 200) {
+					if (k == TYUNKNOWN + 200)
+						continue;
+					if (j % 100 != k - 200
+					 && k != TYSUBR + 200
+					 && j != TYUNKNOWN + 300
+					 && !type_fixup(at,atypes,k))
+						goto badtypes;
+					}
+				else if (j % 100 % TYSUBR != k % TYSUBR
+						&& !type_fixup(at,atypes,k))
+					goto badtypes;
+				}
+			else if (k < 200 || j < 200)
+				if (j) {
+					if (k == TYUNKNOWN
+					 && q->tag == TNAME
+					 && q->nameblock.vinfproc) {
+						q->nameblock.vdcldone = 0;
+						impldcl((Namep)q);
+						}
+					goto badtypes;
+					}
+				else ; /* fall through to update */
+			else if (k == TYUNKNOWN+200)
+				continue;
+			else if (j != TYUNKNOWN+200)
+				{
+ badtypes:
+				if (++nbad == 1)
+					bad_atypes(at, fname, i - nchargs,
+						j, k, "here ", ", previously");
+				else
+					fprintf(stderr,
+					 "\targ %d: here %s, previously %s.\n",
+						i - nchargs, Argtype(k,buf1),
+						Argtype(j,buf2));
+				if (!cp)
+					break;
+				continue;
+				}
+			/* We've subsequently learned the right type,
+			   as in the call on zoo below...
+
+				subroutine foo(x, zap)
+				external zap
+				call goo(zap)
+				x = zap(3)
+				call zoo(zap)
+				end
+			 */
+			if (!nbad) {
+				atypes->type = k;
+				at->changes |= 1;
+				}
+			}
+		if (i < nargs)
+			goto toofew;
+		if (nbad) {
+			if (type) {
+				/* we're defining the procedure */
+				t = init_ap[type];
+				te = t + i0;
+				proc_argchanges = 1;
+				goto newlist;
+				}
+			return;
+			}
+		if (zap == 1 && (at->changes & 5) != 5)
+			at->changes = 0;
+		return;
+		}
+ newlist:
+	i = i0 + nchargs;
+	for(cp = arglist; cp; cp = cp->nextp)
+		i++;
+	k = sizeof(Argtypes) + (i-1)*sizeof(Atype);
+	*at0 = *at1 = at = stg == STGEXT ? (Argtypes *)gmem(k,1)
+					 : (Argtypes *) mem(k,1);
+	at->dnargs = at->nargs = i;
+	at->defined = zap & 6;
+	at->changes = type ? 0 : 4;
+	atypes = at->atypes;
+	for(; t < te; atypes++) {
+		atypes->type = *t++;
+		atypes->cp = 0;
+		}
+	for(cp = arglist; cp; atypes++, cp = cp->nextp) {
+		atypes->cp = 0;
+		atypes->type = (q = (expptr)cp->datap)
+			? typekludge(ccall, q, atypes, 0)
+			: 0;
+		}
+	for(; --nchargs >= 0; atypes++) {
+		atypes->type = TYFTNLEN + 100;
+		atypes->cp = 0;
+		}
+	}
+
+ static char*
+#ifdef KR_headers
+get_argtypes(p, pat0, pat1) Exprp p; Argtypes ***pat0, ***pat1;
+#else
+get_argtypes(Exprp p, Argtypes ***pat0, Argtypes ***pat1)
+#endif
+{
+	Addrp a;
+	Argtypes **at0, **at1;
+	Namep np;
+	Extsym *e;
+	char *fname;
+
+	a = (Addrp)p->leftp;
+	switch(a->vstg) {
+		case STGEXT:
+			switch(a->uname_tag) {
+				case UNAM_EXTERN:	/* e.g., sqrt() */
+					e = extsymtab + a->memno;
+					at0 = at1 = &e->arginfo;
+					fname = e->fextname;
+					break;
+				case UNAM_NAME:
+					np = a->user.name;
+					at0 = &extsymtab[np->vardesc.varno].arginfo;
+					at1 = &np->arginfo;
+					fname = np->fvarname;
+					break;
+				default:
+					goto bug;
+				}
+			break;
+		case STGARG:
+			if (a->uname_tag != UNAM_NAME)
+				goto bug;
+			np = a->user.name;
+			at0 = at1 = &np->arginfo;
+			fname = np->fvarname;
+			break;
+		default:
+	 bug:
+			Fatal("Confusion in saveargtypes");
+		}
+	*pat0 = at0;
+	*pat1 = at1;
+	return fname;
+	}
+
+ void
+#ifdef KR_headers
+saveargtypes(p)
+	register Exprp p;
+#else
+saveargtypes(register Exprp p)
+#endif
+				/* for writing prototypes */
+{
+	Argtypes **at0, **at1;
+	chainp arglist;
+	expptr rp;
+	char *fname;
+
+	fname = get_argtypes(p, &at0, &at1);
+	rp = p->rightp;
+	arglist = rp && rp->tag == TLIST ? rp->listblock.listp : 0;
+	save_argtypes(arglist, at0, at1, p->opcode == OPCCALL,
+		fname, p->leftp->addrblock.vstg, 0, 0, 0);
+	}
+
+/* putcall - fix up the argument list, and write out the invocation.   p
+   is expected to be initialized and point to an OPCALL or OPCCALL
+   expression.  The return value is a pointer to a temporary holding the
+   result of a COMPLEX or CHARACTER operation, or NULL. */
+
+ LOCAL expptr
+#ifdef KR_headers
+putcall(p0, temp)
+	expptr p0;
+	Addrp *temp;
+#else
+putcall(expptr p0, Addrp *temp)
+#endif
+{
+    register Exprp p = (Exprp)p0;
+    chainp arglist;		/* Pointer to actual arguments, if any */
+    chainp charsp;		/* List of copies of the variables which
+				   hold the lengths of character
+				   parameters (other than procedure
+				   parameters) */
+    chainp cp;			/* Iterator over argument lists */
+    register expptr q;		/* Pointer to the current argument */
+    Addrp fval;			/* Function return value */
+    int type;			/* type of the call - presumably this was
+				   set elsewhere */
+    int byvalue;		/* True iff we don't want to massage the
+				   parameter list, since we're calling a C
+				   library routine */
+    char *s;
+    Argtypes *at, **at0, **at1;
+    Atype *At, *Ate;
+
+    type = p -> vtype;
+    charsp = NULL;
+    byvalue =  (p->opcode == OPCCALL);
+
+/* Verify the actual parameters */
+
+    if (p == (Exprp) NULL)
+	err ("putcall:  NULL call expression");
+    else if (p -> tag != TEXPR)
+	erri ("putcall:  expected TEXPR, got '%d'", p -> tag);
+
+/* Find the argument list */
+
+    if(p->rightp && p -> rightp -> tag == TLIST)
+	arglist = p->rightp->listblock.listp;
+    else
+	arglist = NULL;
+
+/* Count the number of explicit arguments, including lengths of character
+   variables */
+
+    if (!byvalue) {
+	get_argtypes(p, &at0, &at1);
+	At = Ate = 0;
+	if ((at = *at0) && at->nargs >= 0) {
+		At = at->atypes;
+		Ate = At + at->nargs;
+		At += init_ac[type];
+		}
+        for(cp = arglist ; cp ; cp = cp->nextp) {
+	    q = (expptr) cp->datap;
+	    if( ISCONST(q) ) {
+
+/* Even constants are passed by reference, so we need to put them in the
+   literal table */
+
+		q = (expptr) putconst((Constp)q);
+		cp->datap = (char *) q;
+		}
+
+/* Save the length expression of character variables (NOT character
+   procedures) for the end of the argument list */
+
+	    if( ISCHAR(q) &&
+		(q->headblock.vclass != CLPROC
+		|| q->headblock.vstg == STGARG
+			&& q->tag == TADDR
+			&& q->addrblock.uname_tag == UNAM_NAME
+			&& q->addrblock.user.name->vprocclass == PTHISPROC)
+		&& (!At || At->type % 100 % TYSUBR == TYCHAR))
+		{
+		p0 = cpexpr(q->headblock.vleng);
+		charsp = mkchain((char *)p0, charsp);
+		if (q->headblock.vclass == CLUNKNOWN
+		 && q->headblock.vstg == STGARG)
+			q->addrblock.user.name->vpassed = 1;
+		else if (q->tag == TADDR
+				&& q->addrblock.uname_tag == UNAM_CONST)
+			p0->constblock.Const.ci
+				+= q->addrblock.user.Const.ccp1.blanks;
+		}
+	    if (At && ++At == Ate)
+		At = 0;
+	    }
+	}
+    charsp = revchain(charsp);
+
+/* If the routine is a CHARACTER function ... */
+
+    if(type == TYCHAR)
+    {
+	if( ISICON(p->vleng) )
+	{
+
+/* Allocate a temporary to hold the return value of the function */
+
+	    fval = mktmp(TYCHAR, p->vleng);
+	}
+	else    {
+		err("adjustable character function");
+		if (temp)
+			*temp = 0;
+		return 0;
+		}
+    }
+
+/* If the routine is a COMPLEX function ... */
+
+    else if( ISCOMPLEX(type) )
+	fval = mktmp(type, ENULL);
+    else
+	fval = NULL;
+
+/* Write the function name, without taking its address */
+
+    p -> leftp = putx(fixtype(putaddr(p->leftp)));
+
+    if(fval)
+    {
+	chainp prepend;
+
+/* Prepend a copy of the function return value buffer out as the first
+   argument. */
+
+	prepend = mkchain((char *)putx(putaddr(cpexpr((expptr)fval))), arglist);
+
+/* If it's a character function, also prepend the length of the result */
+
+	if(type==TYCHAR)
+	{
+
+	    prepend->nextp = mkchain((char *)putx(mkconv(TYLENG,
+					p->vleng)), arglist);
+	}
+	if (!(q = p->rightp))
+		p->rightp = q = (expptr)mklist(CHNULL);
+	q->listblock.listp = prepend;
+    }
+
+/* Scan through the fortran argument list */
+
+    for(cp = arglist ; cp ; cp = cp->nextp)
+    {
+	q = (expptr) (cp->datap);
+	if (q == ENULL)
+	    err ("putcall:  NULL argument");
+
+/* call putaddr only when we've got a parameter for a C routine or a
+   memory resident parameter */
+
+	if (q -> tag == TCONST && !byvalue)
+	    q = (expptr) putconst ((Constp)q);
+
+	if(q->tag==TADDR && (byvalue || q->addrblock.vstg!=STGREG) ) {
+		if (q->addrblock.parenused
+		 && !byvalue && q->headblock.vtype != TYCHAR)
+			goto make_copy;
+		cp->datap = (char *)putaddr(q);
+		}
+	else if( ISCOMPLEX(q->headblock.vtype) )
+	    cp -> datap = (char *) putx (fixtype(putcxop(q)));
+	else if (ISCHAR(q) )
+	    cp -> datap = (char *) putx (fixtype((expptr)putchop(q)));
+	else if( ! ISERROR(q) )
+	{
+	    if(byvalue) {
+		if (q->tag == TEXPR && q->exprblock.opcode == OPCONV) {
+			if (ISCOMPLEX(q->exprblock.leftp->headblock.vtype)
+			 && q->exprblock.leftp->tag == TEXPR)
+				q->exprblock.leftp = putcxop(q->exprblock.leftp);
+			else
+				q->exprblock.leftp = putx(q->exprblock.leftp);
+			}
+		else
+			cp -> datap = (char *) putx(q);
+		}
+	    else if (q->tag == TEXPR && q->exprblock.opcode == OPCHARCAST)
+		cp -> datap = (char *) putx(q);
+	    else {
+		expptr t, t1;
+
+/* If we've got a register parameter, or (maybe?) a constant, save it in a
+   temporary first */
+ make_copy:
+		t = (expptr) mktmp(q->headblock.vtype, q->headblock.vleng);
+
+/* Assign to temporary variables before invoking the subroutine or
+   function */
+
+		t1 = putassign( cpexpr(t), q );
+		if (doin_setbound)
+			t = mkexpr(OPCOMMA_ARG, t1, t);
+		else
+			putout(t1);
+		cp -> datap = (char *) t;
+	    } /* else */
+	} /* if !ISERROR(q) */
+    }
+
+/* Now adjust the lengths of the CHARACTER parameters */
+
+    for(cp = charsp ; cp ; cp = cp->nextp)
+	cp->datap = (char *)addrfix(putx(
+			/* in case MAIN has a character*(*)... */
+			(s = cp->datap) ? mkconv(TYLENG,(expptr)s)
+					 : ICON(0)));
+
+/* ... and add them to the end of the argument list */
+
+    hookup (arglist, charsp);
+
+/* Return the name of the temporary used to hold the results, if any was
+   necessary. */
+
+    if (temp) *temp = fval;
+    else frexpr ((expptr)fval);
+
+    saveargtypes(p);
+
+    return (expptr) p;
+}
+
+ static expptr
+#ifdef KR_headers
+foldminmax(op, type, p) int op; int type; chainp p;
+#else
+foldminmax(int op, int type, chainp p)
+#endif
+{
+	Constp c, c1;
+	ftnint i, i1;
+	double d, d1;
+	int dstg, d1stg;
+	char *s, *s1;
+
+	c = ALLOC(Constblock);
+	c->tag = TCONST;
+	c->vtype = type;
+	s = s1 = 0;
+
+	switch(type) {
+	  case TYREAL:
+	  case TYDREAL:
+		c1 = (Constp)p->datap;
+		d = ISINT(c1->vtype) ? (double)c1->Const.ci
+			: c1->vstg ? atof(c1->Const.cds[0]) : c1->Const.cd[0];
+		dstg = 0;
+		if (ISINT(c1->vtype))
+			d = (double)c1->Const.ci;
+		else if (dstg = c1->vstg)
+			d = atof(s = c1->Const.cds[0]);
+		else
+			d = c1->Const.cd[0];
+		while(p = p->nextp) {
+			c1 = (Constp)p->datap;
+			d1stg = 0;
+			if (ISINT(c1->vtype))
+				d1 = (double)c1->Const.ci;
+			else if (d1stg = c1->vstg)
+				d1 = atof(s1 = c1->Const.cds[0]);
+			else
+				d1 = c1->Const.cd[0];
+			if (op == OPMIN) {
+				if (d > d1)
+					goto d1copy;
+				}
+			else if (d < d1) {
+ d1copy:
+				d = d1;
+				dstg = d1stg;
+				s = s1;
+				}
+			}
+		if (c->vstg = dstg)
+			c->Const.cds[0] = s;
+		else
+			c->Const.cd[0] = d;
+		break;
+	  default:
+		i = ((Constp)p->datap)->Const.ci;
+		while(p = p->nextp) {
+			i1 = ((Constp)p->datap)->Const.ci;
+			if (op == OPMIN) {
+				if (i > i1)
+					i = i1;
+				}
+			else if (i < i1)
+				i = i1;
+			}
+		c->Const.ci = i;
+		}
+	return (expptr)c;
+	}
+
+/* putmnmx -- Put min or max.   p   must point to an EXPR, not just a
+   CONST */
+
+ LOCAL expptr
+#ifdef KR_headers
+putmnmx(p)
+	register expptr p;
+#else
+putmnmx(register expptr p)
+#endif
+{
+	int op, op2, type;
+	expptr arg, qp, temp;
+	chainp p0, p1;
+	Addrp sp, tp;
+	char comment_buf[80];
+	char *what;
+
+	if(p->tag != TEXPR)
+		badtag("putmnmx", p->tag);
+
+	type = p->exprblock.vtype;
+	op = p->exprblock.opcode;
+	op2 = op == OPMIN ? OPMIN2 : OPMAX2;
+	p0 = p->exprblock.leftp->listblock.listp;
+	free( (charptr) (p->exprblock.leftp) );
+	free( (charptr) p );
+
+	/* for param statements, deal with constant expressions now */
+
+	for(p1 = p0;; p1 = p1->nextp) {
+		if (!p1) {
+			/* all constants */
+			p = foldminmax(op, type, p0);
+			frchain(&p0);
+			return p;
+			}
+		else if (!ISCONST(((expptr)p1->datap)))
+			break;
+		}
+
+	/* special case for two addressable operands */
+
+	if (addressable((expptr)p0->datap)
+	 && (p1 = p0->nextp)
+	 && addressable((expptr)p1->datap)
+	 && !p1->nextp) {
+		if (type == TYREAL && forcedouble)
+			op2 = op == OPMIN ? OPDMIN : OPDMAX;
+		p = mkexpr(op2, mkconv(type, cpexpr((expptr)p0->datap)),
+				mkconv(type, cpexpr((expptr)p1->datap)));
+		frchain(&p0);
+		return p;
+		}
+
+	/* general case */
+
+	sp = mktmp(type, ENULL);
+
+/* We only need a second temporary if the arg list has an unaddressable
+   value */
+
+	tp = (Addrp) NULL;
+	qp = ENULL;
+	for (p1 = p0 -> nextp; p1; p1 = p1 -> nextp)
+		if (!addressable ((expptr) p1 -> datap)) {
+			tp = mktmp(type, ENULL);
+			qp = mkexpr(op2, cpexpr((expptr)sp), cpexpr((expptr)tp));
+			qp = fixexpr((Exprp)qp);
+			break;
+		} /* if */
+
+/* Now output the appropriate number of assignments and comparisons.  Min
+   and max are implemented by the simple O(n) algorithm:
+
+	min (a, b, c, d) ==>
+	{ <type> t1, t2;
+
+	    t1 = a;
+	    t2 = b; t1 = (t1 < t2) ? t1 : t2;
+	    t2 = c; t1 = (t1 < t2) ? t1 : t2;
+	    t2 = d; t1 = (t1 < t2) ? t1 : t2;
+	}
+*/
+
+	if (!doin_setbound) {
+		switch(op) {
+			case OPLT:
+			case OPMIN:
+			case OPDMIN:
+			case OPMIN2:
+				what = "IN";
+				break;
+			default:
+				what = "AX";
+			}
+		sprintf (comment_buf, "Computing M%s", what);
+		p1_comment (comment_buf);
+		}
+
+	p1 = p0->nextp;
+	temp = (expptr)p0->datap;
+	if (addressable(temp) && addressable((expptr)p1->datap)) {
+		p = mkconv(type, cpexpr(temp));
+		arg = mkconv(type, cpexpr((expptr)p1->datap));
+		temp = mkexpr(op2, p, arg);
+		if (!ISCONST(temp))
+			temp = fixexpr((Exprp)temp);
+		p1 = p1->nextp;
+		}
+	p = putassign (cpexpr((expptr)sp), temp);
+
+	for(; p1 ; p1 = p1->nextp)
+	{
+		if (addressable ((expptr) p1 -> datap)) {
+			arg = mkconv(type, cpexpr((expptr)p1->datap));
+			temp = mkexpr(op2, cpexpr((expptr)sp), arg);
+			temp = fixexpr((Exprp)temp);
+		} else {
+			temp = (expptr) cpexpr (qp);
+			p = mkexpr(OPCOMMA, p,
+				putassign(cpexpr((expptr)tp), (expptr)p1->datap));
+		} /* else */
+
+		if(p1->nextp)
+			p = mkexpr(OPCOMMA, p,
+				putassign(cpexpr((expptr)sp), temp));
+		else {
+			if (type == TYREAL && forcedouble)
+				temp->exprblock.opcode =
+					op == OPMIN ? OPDMIN : OPDMAX;
+			if (doin_setbound)
+				p = mkexpr(OPCOMMA, p, temp);
+			else {
+				putout (p);
+				p = putx(temp);
+				}
+			if (qp)
+				frexpr (qp);
+		} /* else */
+	} /* for */
+
+	frchain( &p0 );
+	return p;
+}
+
+
+ void
+#ifdef KR_headers
+putwhile(p)
+	expptr p;
+#else
+putwhile(expptr p)
+#endif
+{
+	int k, n;
+
+	if (wh_next >= wh_last)
+		{
+		k = wh_last - wh_first;
+		n = k + 100;
+		wh_next = mem(n,0);
+		wh_last = wh_first + n;
+		if (k)
+			memcpy(wh_next, wh_first, k);
+		wh_first =  wh_next;
+		wh_next += k;
+		wh_last = wh_first + n;
+		}
+	if( !ISLOGICAL((k = (p = fixtype(p))->headblock.vtype)))
+		{
+		if(k != TYERROR)
+			err("non-logical expression in DO WHILE statement");
+		}
+	else	{
+		p = putx(p);
+		*wh_next++ = ftell(pass1_file) > p1_where;
+		p1put(P1_WHILE2START);
+		p1_expr(p);
+		}
+	}
+
+ void
+#ifdef KR_headers
+westart(elseif) int elseif;
+#else
+westart(int elseif)
+#endif
+{
+	static int we[2] = { P1_WHILE1START, P1_ELSEIFSTART };
+	p1put(we[elseif]);
+	p1_where = ftell(pass1_file);
+	}
diff --git a/contrib/tools/f2c/src/sysdep.c b/contrib/tools/f2c/src/sysdep.c
new file mode 100644
index 0000000000..3d7478d2f3
--- /dev/null
+++ b/contrib/tools/f2c/src/sysdep.c
@@ -0,0 +1,705 @@
+/****************************************************************
+Copyright 1990 - 1994, 2000 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+#include "defs.h"
+#include "usignal.h"
+#include <stdlib.h>
+
+char binread[] = "rb", textread[] = "r";
+char binwrite[] = "wb", textwrite[] = "w";
+char *c_functions	= "c_functions";
+char *coutput		= "c_output";
+char *initfname		= "raw_data";
+char *initbname		= "raw_data.b";
+char *blkdfname		= "block_data";
+char *p1_file		= "p1_file";
+char *p1_bakfile	= "p1_file.BAK";
+char *sortfname		= "init_file";
+char *proto_fname	= "proto_file";
+
+char link_msg[]	= "on Microsoft Windows system, link with libf2c.lib;\n\
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm\n\
+	or, if you install libf2c.a in a standard place, with -lf2c -lm\n\
+	-- in that order, at the end of the command line, as in\n\
+		cc *.o -lf2c -lm\n\
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,\n\n\
+		http://www.netlib.org/f2c/libf2c.zip";
+
+char *outbuf = "", *outbtail;
+
+#undef WANT_spawnvp
+#ifdef MSDOS
+#ifndef NO_spawnvp
+#define WANT_spawnvp
+#endif
+#endif
+
+#ifdef _WIN32
+#include <windows.h>	/* for GetVolumeInformation */
+#undef WANT_spawnvp
+#define WANT_spawnvp
+#undef  MSDOS
+#define MSDOS
+#endif
+
+#ifdef WANT_spawnvp
+#include <process.h>
+#ifndef _P_WAIT
+#define _P_WAIT P_WAIT	/* Symantec C/C++ */
+#endif
+static char **spargv, **pfname;
+#endif
+
+char *tmpdir = "";
+
+#ifdef __cplusplus
+#define Cextern extern "C"
+extern "C" {
+ static void flovflo(int), killed(int);
+ static int compare(const void *a, const void *b);
+}
+#else
+#define Cextern extern
+#endif
+
+Cextern int unlink Argdcl((const char *));
+Cextern int fork Argdcl((void)), getpid Argdcl((void)), wait Argdcl((int*));
+
+ void
+#ifdef KR_headers
+Un_link_all(cdelete)
+	int cdelete;
+#else
+Un_link_all(int cdelete)
+#endif
+{
+	if (!debugflag) {
+		unlink(c_functions);
+		unlink(initfname);
+                unlink(initbname);
+		unlink(p1_file);
+                unlink(p1_bakfile);
+		unlink(sortfname);
+		unlink(blkdfname);
+		if (cdelete && coutput)
+			unlink(coutput);
+		}
+	}
+
+#ifndef NO_TEMPDIR
+ static void
+rmtdir(Void)
+{
+	char *s;
+	if (*(s = tmpdir)) {
+		tmpdir = "";
+		rmdir(s);
+		}
+	}
+#endif /*NO_TEMPDIR*/
+
+#ifndef MSDOS
+#include "sysdep.hd"
+#ifndef NO_MKDTEMP
+#include <unistd.h> /* for mkdtemp */
+#endif
+#endif
+
+ static void
+alloc_names(Void)
+{
+	int k = strlen(tmpdir) + 24;
+	c_functions = (char *)ckalloc(7*k);
+	initfname = c_functions + k;
+	initbname = initfname + k;
+	blkdfname = initbname + k;
+	p1_file = blkdfname + k;
+	p1_bakfile = p1_file + k;
+	sortfname = p1_bakfile + k;
+	}
+
+ void
+set_tmp_names(Void)
+{
+#ifdef MSDOS
+	char buf[64], *s, *t;
+#ifdef _WIN32
+	DWORD flags, maxlen, volser;
+	char volname[512], f2c[24], fsname[512], *name1;
+	int i;
+
+	if (debugflag == 1)
+		return;
+	i = sprintf(f2c, "%x", _getpid());
+	if (!GetVolumeInformation(NULL, volname, sizeof(volname), &volser, &maxlen,
+			&flags, fsname, sizeof(fsname))
+	 || maxlen < i+8) /* FAT16 */
+		strcpy(f2c, "f2c_");
+#else
+	static char f2c[] = "f2c_";
+	if (debugflag == 1)
+		return;
+#endif
+
+	if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
+		t = "";
+	else {
+		/* substitute \ for / to avoid confusion with a
+		 * switch indicator in the system("sort ...")
+		 * call in formatdata.c
+		 */
+		for(s = tmpdir, t = buf; *s; s++, t++)
+			if ((*t = *s) == '/')
+				*t = '\\';
+		if (t[-1] != '\\')
+			*t++ = '\\';
+		*t = 0;
+		t = buf;
+		}
+	alloc_names();
+	sprintf(c_functions, "%s%sfunc", t, f2c);
+	sprintf(initfname, "%s%srd", t, f2c);
+	sprintf(blkdfname, "%s%sblkd", t, f2c);
+	sprintf(p1_file, "%s%sp1f", t, f2c);
+	sprintf(p1_bakfile, "%s%sp1fb", t, f2c);
+	sprintf(sortfname, "%s%ssort", t, f2c);
+#else /*!MSDOS*/
+	long pid;
+
+#define L_TDNAME 20
+#ifdef NO_MKDTEMP
+#ifdef NO_MKSTEMP
+#undef  L_TDNAME
+#define L_TDNAME L_tmpnam
+#endif
+#endif
+	static char tdbuf[L_TDNAME];
+
+	if (debugflag == 1)
+		return;
+	pid = getpid();
+	if (!*tmpdir) {
+#ifdef NO_TEMPDIR
+		tmpdir = "/tmp";
+#else
+#ifdef NO_MKDTEMP
+#ifdef NO_MKSTEMP
+		if (!(tmpdir = tmpnam(tdbuf))) {
+			fprintf(stderr, "tmpnam failed (for -T)\n");
+			exit(1);
+			}
+#else
+		int f;
+		strcpy(tdbuf, "/tmp/f2ctd_XXXXXX");
+		f = mkstemp(tdbuf);
+		if (f >= 0) {
+			close(f);
+			remove(tmpdir = tdbuf);
+			}
+		else {
+			fprintf(stderr, "mkstemp failed (for -T)\n");
+			exit(1);
+			}
+#endif /*NO_MKSTEMP*/
+		if (mkdir(tdbuf,0700)) {
+			fprintf(stderr, "mkdir failed (for -T)\n");
+			exit(1);
+			}
+#else /*!NO_MKDTEMP*/
+		strcpy(tdbuf, "/tmp/f2ctd_XXXXXX");
+		if (!(tmpdir = mkdtemp(tdbuf))) {
+			fprintf(stderr, "mkdtemp failed (for -T)\n");
+			exit(1);
+			}
+#endif /*NO_MKDTEMP*/
+		if (!debugflag)
+			atexit(rmtdir);
+#endif /*NO_TEMPDIR*/
+		}
+	alloc_names();
+        /* What follows is safe if tmpdir is really
+        a private diectory created by us -- otherwise
+        the file could be a sym link somewhere else....*/
+	sprintf(c_functions, "%s/f2c%ld_func", tmpdir, pid);
+	sprintf(initfname, "%s/f2c%ld_rd", tmpdir, pid);
+	sprintf(blkdfname, "%s/f2c%ld_blkd", tmpdir, pid);
+	sprintf(p1_file, "%s/f2c%ld_p1f", tmpdir, pid);
+	sprintf(p1_bakfile, "%s/f2c%ld_p1fb", tmpdir, pid);
+	sprintf(sortfname, "%s/f2c%ld_sort", tmpdir, pid);
+#endif /*MSDOS*/
+	sprintf(initbname, "%s.b", initfname);
+	if (debugflag)
+		fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
+			initfname, blkdfname, p1_file, p1_bakfile, sortfname);
+	}
+
+ char *
+#ifdef KR_headers
+c_name(s, ft)
+	char *s;
+	int ft;
+#else
+c_name(char *s, int ft)
+#endif
+{
+	char *b, *s0;
+	int c;
+
+	b = s0 = s;
+	while(c = *s++)
+		if (c == '/')
+			b = s;
+	if (--s < s0 + 3 || s[-2] != '.'
+			 || ((c = *--s) != 'f' && c != 'F')) {
+		infname = s0;
+		Fatal("file name must end in .f or .F");
+		}
+	strcpy(outbtail, b);
+	outbtail[s-b] = ft;
+	b = copys(outbuf);
+	return b;
+	}
+
+ static void
+#ifdef KR_headers
+killed(sig)
+	int sig;
+#else
+killed(int sig)
+#endif
+{
+	sig = sig;	/* shut up warning */
+	signal(SIGINT, SIG_IGN);
+#ifdef SIGQUIT
+	signal(SIGQUIT, SIG_IGN);
+#endif
+#ifdef SIGHUP
+	signal(SIGHUP, SIG_IGN);
+#endif
+	signal(SIGTERM, SIG_IGN);
+	Un_link_all(1);
+	exit(126);
+	}
+
+ static void
+#ifdef KR_headers
+sig1catch(sig)
+	int sig;
+#else
+sig1catch(int sig)
+#endif
+{
+	sig = sig;	/* shut up warning */
+	if (signal(sig, SIG_IGN) != SIG_IGN)
+		signal(sig, killed);
+	}
+
+ static void
+#ifdef KR_headers
+flovflo(sig)
+	int sig;
+#else
+flovflo(int sig)
+#endif
+{
+	sig = sig;	/* shut up warning */
+	Fatal("floating exception during constant evaluation; cannot recover");
+	/* vax returns a reserved operand that generates
+	   an illegal operand fault on next instruction,
+	   which if ignored causes an infinite loop.
+	*/
+	signal(SIGFPE, flovflo);
+}
+
+ void
+#ifdef KR_headers
+sigcatch(sig)
+	int sig;
+#else
+sigcatch(int sig)
+#endif
+{
+	sig = sig;	/* shut up warning */
+	sig1catch(SIGINT);
+#ifdef SIGQUIT
+	sig1catch(SIGQUIT);
+#endif
+#ifdef SIGHUP
+	sig1catch(SIGHUP);
+#endif
+	sig1catch(SIGTERM);
+	signal(SIGFPE, flovflo);  /* catch overflows */
+	}
+
+/* argkludge permits wild-card expansion and caching of the original or expanded */
+/* argv to kludge around the lack of fork() and exec() when necessary. */
+
+ void
+#ifdef KR_headers
+argkludge(pargc, pargv) int *pargc; char ***pargv;
+#else
+argkludge(int *pargc, char ***pargv)
+#endif
+{
+#ifdef WANT_spawnvp
+	size_t L, L1;
+	int argc, i, nf;
+	char **a, **argv, *s, *t, *t0;
+
+	/* Assume wild-card expansion has been done by Microsoft's setargv.obj */
+
+	/* Count Fortran input files. */
+
+	L = argc = *pargc;
+	argv = *pargv;
+	for(i = nf = 0; i < argc; i++) {
+		L += L1 = strlen(s = argv[i]);
+		if (L1 > 2 && s[L1-2] == '.')
+			switch(s[L1-1]) {
+			  case 'f':
+			  case 'F':
+				nf++;
+			  }
+		}
+	if (nf <= 1)
+		return;
+
+	/* Cache inputs */
+
+	i = argc - nf + 2;
+	a = spargv = (char**)Alloc(i*sizeof(char*) + L);
+	t = (char*)(a + i);
+	for(i = 0; i < argc; i++) {
+		*a++ = t0 = t;
+		for(s = argv[i]; *t++ = *s; s++);
+		if (t-t0 > 3 && s[-2] == '.')
+			switch(s[-1]) {
+			  case 'f':
+			  case 'F':
+				--a;
+				t = t0;
+			  }
+		}
+	pfname = a++;
+	*a = 0;
+#endif
+	}
+
+ int
+#ifdef KR_headers
+dofork(fname) char *fname;
+#else
+dofork(char *fname)
+#endif
+{
+	extern int retcode;
+#ifdef MSDOS
+#ifdef WANT_spawnvp
+	*pfname = fname;
+	retcode |= _spawnvp(_P_WAIT, spargv[0], (char const*const*)spargv);
+#else /*_WIN32*/
+	Fatal("Only one Fortran input file allowed under MS-DOS");
+#endif /*_WIN32*/
+#else
+	int pid, status, w;
+
+	if (!(pid = fork()))
+		return 1;
+	if (pid == -1)
+		Fatal("bad fork");
+	while((w = wait(&status)) != pid)
+		if (w == -1)
+			Fatal("bad wait code");
+	retcode |= status >> 8;
+#endif
+	return 0;
+	}
+
+/* Initialization of tables that change with the character set... */
+
+char escapes[Table_size];
+
+#ifdef non_ASCII
+char *str_fmt[Table_size];
+static char *str0fmt[127] = { /*}*/
+#else
+char *str_fmt[Table_size] = {
+#endif
+ "\\000", "\\001", "\\002", "\\003", "\\004", "\\005", "\\006", "\\007",
+   "\\b",   "\\t",   "\\n", "\\013",   "\\f",   "\\r", "\\016", "\\017",
+ "\\020", "\\021", "\\022", "\\023", "\\024", "\\025", "\\026", "\\027",
+ "\\030", "\\031", "\\032", "\\033", "\\034", "\\035", "\\036", "\\037",
+     " ",     "!",  "\\\"",     "#",     "$",     "%%",    "&",     "'",
+     "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
+     "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",     "[",  "\\\\",     "]",     "^",     "_",
+     "`",     "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",     "{",     "|",     "}",     "~"
+     };
+
+#ifdef non_ASCII
+char *chr_fmt[Table_size];
+static char *chr0fmt[127] = {	/*}*/
+#else
+char *chr_fmt[Table_size] = {
+#endif
+   "\\0",   "\\1",   "\\2",   "\\3",   "\\4",   "\\5",   "\\6",   "\\7",
+   "\\b",   "\\t",   "\\n",  "\\13",   "\\f",   "\\r",  "\\16",  "\\17",
+  "\\20",  "\\21",  "\\22",  "\\23",  "\\24",  "\\25",  "\\26",  "\\27",
+  "\\30",  "\\31",  "\\32",  "\\33",  "\\34",  "\\35",  "\\36",  "\\37",
+     " ",     "!",    "\"",     "#",     "$",     "%%",    "&",   "\\'",
+     "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
+     "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",     "[",  "\\\\",     "]",     "^",     "_",
+     "`",     "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",     "{",     "|",     "}",     "~"
+     };
+
+ void
+fmt_init(Void)
+{
+	static char *str1fmt[6] =
+		{ "\\b", "\\t", "\\n", "\\f", "\\r", "\\013" };
+	register int i, j;
+	register char *s;
+
+	/* str_fmt */
+
+#ifdef non_ASCII
+	i = 0;
+#else
+	i = 127;
+#endif
+	s = Alloc(5*(Table_size - i));
+	for(; i < Table_size; i++) {
+		sprintf(str_fmt[i] = s, "\\%03o", i);
+		s += 5;
+		}
+#ifdef non_ASCII
+	for(i = 32; i < 127; i++) {
+		s = str0fmt[i];
+		str_fmt[*(unsigned char *)s] = s;
+		}
+	str_fmt['"'] = "\\\"";
+#else
+	if (Ansi == 1)
+		str_fmt[7] = chr_fmt[7] = "\\a";
+#endif
+
+	/* chr_fmt */
+
+#ifdef non_ASCII
+	for(i = 0; i < 32; i++)
+		chr_fmt[i] = chr0fmt[i];
+#else
+	i = 127;
+#endif
+	for(; i < Table_size; i++)
+		chr_fmt[i] = "\\%o";
+#ifdef non_ASCII
+	for(i = 32; i < 127; i++) {
+		s = chr0fmt[i];
+		j = *(unsigned char *)s;
+		if (j == '\\')
+			j = *(unsigned char *)(s+1);
+		chr_fmt[j] = s;
+		}
+#endif
+
+	/* escapes (used in lex.c) */
+
+	for(i = 0; i < Table_size; i++)
+		escapes[i] = i;
+	for(s = "btnfr0", i = 0; i < 6; i++)
+		escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
+	/* finish str_fmt and chr_fmt */
+
+	if (Ansi)
+		str1fmt[5] = "\\v";
+	if ('\v' == 'v') { /* ancient C compiler */
+		str1fmt[5] = "v";
+#ifndef non_ASCII
+		escapes['v'] = 11;
+#endif
+		}
+	else
+		escapes['v'] = '\v';
+	for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
+		str_fmt[j] = chr_fmt[j] = str1fmt[i++];
+	/* '\v' = 11 for both EBCDIC and ASCII... */
+	chr_fmt[11] = (char*)(Ansi ? "\\v" : "\\13");
+	}
+
+ void
+outbuf_adjust(Void)
+{
+	int n, n1;
+	char *s;
+
+	n = n1 = strlen(outbuf);
+	if (*outbuf && outbuf[n-1] != '/')
+		n1++;
+	s = Alloc(n+64);
+	outbtail = s + n1;
+	strcpy(s, outbuf);
+	if (n != n1)
+		strcpy(s+n, "/");
+	outbuf = s;
+	}
+
+
+/* Unless SYSTEM_SORT is defined, the following gives a simple
+ * in-core version of dsort().  On Fortran source with huge DATA
+ * statements, the in-core version may exhaust the available memory,
+ * in which case you might either recompile this source file with
+ * SYSTEM_SORT defined (if that's reasonable on your system), or
+ * replace the dsort below with a more elaborate version that
+ * does a merging sort with the help of auxiliary files.
+ */
+
+#ifdef SYSTEM_SORT
+
+ int
+#ifdef KR_headers
+dsort(from, to)
+	char *from;
+	char *to;
+#else
+dsort(char *from, char *to)
+#endif
+{
+	char buf[200];
+	sprintf(buf, "sort <%s >%s", from, to);
+	return system(buf) >> 8;
+	}
+#else
+
+ static int
+#ifdef KR_headers
+ compare(a,b)
+  char *a, *b;
+#else
+ compare(const void *a, const void *b)
+#endif
+{ return strcmp(*(char **)a, *(char **)b); }
+
+ int
+#ifdef KR_headers
+dsort(from, to)
+	char *from;
+	char *to;
+#else
+dsort(char *from, char *to)
+#endif
+{
+	struct Memb {
+		struct Memb *next;
+		int n;
+		char buf[32000];
+		};
+	typedef struct Memb memb;
+	memb *mb, *mb1;
+	register char *x, *x0, *xe;
+	register int c, n;
+	FILE *f;
+	char **z, **z0;
+	int nn = 0;
+
+	f = opf(from, textread);
+	mb = (memb *)Alloc(sizeof(memb));
+	mb->next = 0;
+	x0 = x = mb->buf;
+	xe = x + sizeof(mb->buf);
+	n = 0;
+	for(;;) {
+		c = getc(f);
+		if (x >= xe && (c != EOF || x != x0)) {
+			if (!n)
+				return 126;
+			nn += n;
+			mb->n = n;
+			mb1 = (memb *)Alloc(sizeof(memb));
+			mb1->next = mb;
+			mb = mb1;
+			memcpy(mb->buf, x0, n = x-x0);
+			x0 = mb->buf;
+			x = x0 + n;
+			xe = x0 + sizeof(mb->buf);
+			n = 0;
+			}
+		if (c == EOF)
+			break;
+		if (c == '\n') {
+			++n;
+			*x++ = 0;
+			x0 = x;
+			}
+		else
+			*x++ = c;
+		}
+	clf(&f, from, 1);
+	f = opf(to, textwrite);
+	if (x > x0) { /* shouldn't happen */
+		*x = 0;
+		++n;
+		}
+	mb->n = n;
+	nn += n;
+	if (!nn) /* shouldn't happen */
+		goto done;
+	z = z0 = (char **)Alloc(nn*sizeof(char *));
+	for(mb1 = mb; mb1; mb1 = mb1->next) {
+		x = mb1->buf;
+		n = mb1->n;
+		for(;;) {
+			*z++ = x;
+			if (--n <= 0)
+				break;
+			while(*x++);
+			}
+		}
+	qsort((char *)z0, nn, sizeof(char *), compare);
+	for(n = nn, z = z0; n > 0; n--)
+		fprintf(f, "%s\n", *z++);
+	free((char *)z0);
+ done:
+	clf(&f, to, 1);
+	do {
+		mb1 = mb->next;
+		free((char *)mb);
+		}
+		while(mb = mb1);
+	return 0;
+	}
+#endif
diff --git a/contrib/tools/f2c/src/sysdep.h b/contrib/tools/f2c/src/sysdep.h
new file mode 100644
index 0000000000..f9b7cbcee4
--- /dev/null
+++ b/contrib/tools/f2c/src/sysdep.h
@@ -0,0 +1,101 @@
+/****************************************************************
+Copyright 1990, 1991, 1994 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+/* This file is included at the start of defs.h; this file
+ * is an initial attempt to gather in one place some declarations
+ * that may need to be tweaked on some systems.
+ */
+
+#ifdef __STDC__
+#undef KR_headers
+#endif
+
+#ifndef KR_headers
+#ifndef ANSI_Libraries
+#define ANSI_Libraries
+#endif
+#ifndef ANSI_Prototypes
+#define ANSI_Prototypes
+#endif
+#endif
+
+#ifdef __BORLANDC__
+#define MSDOS
+#endif
+
+#ifdef __ZTC__	/* Zortech */
+#define MSDOS
+#endif
+
+#ifdef MSDOS
+#define ANSI_Libraries
+#define ANSI_Prototypes
+#define LONG_CAST (long)
+#else
+#define LONG_CAST
+#endif
+
+#include <stdio.h>
+
+#ifdef ANSI_Libraries
+#include <stddef.h>
+#include <stdlib.h>
+#else
+char *calloc(), *malloc(), *realloc();
+void *memcpy(), *memset();
+#ifndef _SIZE_T
+typedef unsigned int size_t;
+#endif
+#ifndef atol
+    long atol();
+#endif
+
+#ifdef ANSI_Prototypes
+extern double atof(const char *);
+extern double strtod(const char*, char**);
+#else
+extern double atof(), strtod();
+#endif
+#endif
+
+/* On systems like VMS where fopen might otherwise create
+ * multiple versions of intermediate files, you may wish to
+ * #define scrub(x) unlink(x)
+ */
+#ifndef scrub
+#define scrub(x) /* do nothing */
+#endif
+
+/* On systems that severely limit the total size of statically
+ * allocated arrays, you may need to change the following to
+ *	extern char **chr_fmt, *escapes, **str_fmt;
+ * and to modify sysdep.c appropriately
+ */
+extern char *chr_fmt[], escapes[], *str_fmt[];
+
+#include <string.h>
+
+#include "ctype.h"
+
+#define Bits_per_Byte 8
+#define Table_size (1 << Bits_per_Byte)
diff --git a/contrib/tools/f2c/src/sysdep.hd b/contrib/tools/f2c/src/sysdep.hd
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/contrib/tools/f2c/src/sysdep.hd
diff --git a/contrib/tools/f2c/src/tokdefs.h b/contrib/tools/f2c/src/tokdefs.h
new file mode 100644
index 0000000000..35e3d72bd7
--- /dev/null
+++ b/contrib/tools/f2c/src/tokdefs.h
@@ -0,0 +1,100 @@
+#define SEOS 1
+#define SCOMMENT 2
+#define SLABEL 3
+#define SUNKNOWN 4
+#define SHOLLERITH 5
+#define SICON 6
+#define SRCON 7
+#define SDCON 8
+#define SBITCON 9
+#define SOCTCON 10
+#define SHEXCON 11
+#define STRUE 12
+#define SFALSE 13
+#define SNAME 14
+#define SNAMEEQ 15
+#define SFIELD 16
+#define SSCALE 17
+#define SINCLUDE 18
+#define SLET 19
+#define SASSIGN 20
+#define SAUTOMATIC 21
+#define SBACKSPACE 22
+#define SBLOCK 23
+#define SCALL 24
+#define SCHARACTER 25
+#define SCLOSE 26
+#define SCOMMON 27
+#define SCOMPLEX 28
+#define SCONTINUE 29
+#define SDATA 30
+#define SDCOMPLEX 31
+#define SDIMENSION 32
+#define SDO 33
+#define SDOUBLE 34
+#define SELSE 35
+#define SELSEIF 36
+#define SEND 37
+#define SENDFILE 38
+#define SENDIF 39
+#define SENTRY 40
+#define SEQUIV 41
+#define SEXTERNAL 42
+#define SFORMAT 43
+#define SFUNCTION 44
+#define SGOTO 45
+#define SASGOTO 46
+#define SCOMPGOTO 47
+#define SARITHIF 48
+#define SLOGIF 49
+#define SIMPLICIT 50
+#define SINQUIRE 51
+#define SINTEGER 52
+#define SINTRINSIC 53
+#define SLOGICAL 54
+#define SNAMELIST 55
+#define SOPEN 56
+#define SPARAM 57
+#define SPAUSE 58
+#define SPRINT 59
+#define SPROGRAM 60
+#define SPUNCH 61
+#define SREAD 62
+#define SREAL 63
+#define SRETURN 64
+#define SREWIND 65
+#define SSAVE 66
+#define SSTATIC 67
+#define SSTOP 68
+#define SSUBROUTINE 69
+#define STHEN 70
+#define STO 71
+#define SUNDEFINED 72
+#define SWRITE 73
+#define SLPAR 74
+#define SRPAR 75
+#define SEQUALS 76
+#define SCOLON 77
+#define SCOMMA 78
+#define SCURRENCY 79
+#define SPLUS 80
+#define SMINUS 81
+#define SSTAR 82
+#define SSLASH 83
+#define SPOWER 84
+#define SCONCAT 85
+#define SAND 86
+#define SOR 87
+#define SNEQV 88
+#define SEQV 89
+#define SNOT 90
+#define SEQ 91
+#define SLT 92
+#define SGT 93
+#define SLE 94
+#define SGE 95
+#define SNE 96
+#define SENDDO 97
+#define SWHILE 98
+#define SSLASHD 99
+#define SBYTE 100
diff --git a/contrib/tools/f2c/src/usignal.h b/contrib/tools/f2c/src/usignal.h
new file mode 100644
index 0000000000..ba4ee6ad44
--- /dev/null
+++ b/contrib/tools/f2c/src/usignal.h
@@ -0,0 +1,7 @@
+#include <signal.h>
+#ifndef SIGHUP
+#define	SIGHUP	1	/* hangup */
+#endif
+#ifndef SIGQUIT
+#define	SIGQUIT	3	/* quit */
+#endif
diff --git a/contrib/tools/f2c/src/vax.c b/contrib/tools/f2c/src/vax.c
new file mode 100644
index 0000000000..63a7d8c88a
--- /dev/null
+++ b/contrib/tools/f2c/src/vax.c
@@ -0,0 +1,585 @@
+/****************************************************************
+Copyright 1990, 1992-1994, 2001 by AT&T, Lucent Technologies and Bellcore.
+
+Permission to use, copy, modify, and distribute this software
+and its documentation for any purpose and without fee is hereby
+granted, provided that the above copyright notice appear in all
+copies and that both that the copyright notice and this
+permission notice and warranty disclaimer appear in supporting
+documentation, and that the names of AT&T, Bell Laboratories,
+Lucent or Bellcore or any of their entities not be used in
+advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+AT&T, Lucent and Bellcore disclaim all warranties with regard to
+this software, including all implied warranties of
+merchantability and fitness.  In no event shall AT&T, Lucent or
+Bellcore be liable for any special, indirect or consequential
+damages or any damages whatsoever resulting from loss of use,
+data or profits, whether in an action of contract, negligence or
+other tortious action, arising out of or in connection with the
+use or performance of this software.
+****************************************************************/
+
+#include "defs.h"
+#include "pccdefs.h"
+#include "output.h"
+
+int regnum[] =  {
+	11, 10, 9, 8, 7, 6 };
+
+/* Put out a constant integer */
+
+ void
+#ifdef KR_headers
+prconi(fp, n)
+	FILEP fp;
+	ftnint n;
+#else
+prconi(FILEP fp, ftnint n)
+#endif
+{
+	fprintf(fp, "\t%ld\n", n);
+}
+
+#ifndef NO_LONG_LONG
+ void
+#ifdef KR_headers
+prconq(fp, n) FILEP fp; Llong n;
+#else
+prconq(FILEP fp, Llong n)
+#endif
+{
+	fprintf(fp, "\t%lld\n", n);
+	}
+#endif
+
+
+/* Put out a constant address */
+
+ void
+#ifdef KR_headers
+prcona(fp, a)
+	FILEP fp;
+	ftnint a;
+#else
+prcona(FILEP fp, ftnint a)
+#endif
+{
+	fprintf(fp, "\tL%ld\n", a);
+}
+
+
+ void
+#ifdef KR_headers
+prconr(fp, x, k)
+	FILEP fp;
+	Constp x;
+	int k;
+#else
+prconr(FILEP fp, Constp x, int k)
+#endif
+{
+	char *x0, *x1;
+	char cdsbuf0[64], cdsbuf1[64];
+
+	if (k > 1) {
+		if (x->vstg) {
+			x0 = x->Const.cds[0];
+			x1 = x->Const.cds[1];
+			}
+		else {
+			x0 = cds(dtos(x->Const.cd[0]), cdsbuf0);
+			x1 = cds(dtos(x->Const.cd[1]), cdsbuf1);
+			}
+		fprintf(fp, "\t%s %s\n", x0, x1);
+		}
+	else
+		fprintf(fp, "\t%s\n", x->vstg ? x->Const.cds[0]
+				: cds(dtos(x->Const.cd[0]), cdsbuf0));
+}
+
+
+ char *
+#ifdef KR_headers
+memname(stg, mem)
+	int stg;
+	long mem;
+#else
+memname(int stg, long mem)
+#endif
+{
+	static char s[20];
+
+	switch(stg)
+	{
+	case STGCOMMON:
+	case STGEXT:
+		sprintf(s, "_%s", extsymtab[mem].cextname);
+		break;
+
+	case STGBSS:
+	case STGINIT:
+		sprintf(s, "v.%ld", mem);
+		break;
+
+	case STGCONST:
+		sprintf(s, "L%ld", mem);
+		break;
+
+	case STGEQUIV:
+		sprintf(s, "q.%ld", mem+eqvstart);
+		break;
+
+	default:
+		badstg("memname", stg);
+	}
+	return(s);
+}
+
+extern void addrlit Argdcl((Addrp));
+
+/* make_int_expr -- takes an arbitrary expression, and replaces all
+   occurrences of arguments with indirection */
+
+ expptr
+#ifdef KR_headers
+make_int_expr(e)
+	expptr e;
+#else
+make_int_expr(expptr e)
+#endif
+{
+    chainp listp;
+    Addrp ap;
+    expptr e1;
+
+    if (e != ENULL)
+	switch (e -> tag) {
+	    case TADDR:
+		if (e->addrblock.isarray) {
+			if (e1 = e->addrblock.memoffset)
+				e->addrblock.memoffset = make_int_expr(e1);
+			}
+		else if (e->addrblock.vstg == STGARG
+			|| e->addrblock.vstg == STGCOMMON
+				&& e->addrblock.uname_tag == UNAM_NAME
+				&& e->addrblock.user.name->vcommequiv)
+			e = mkexpr(OPWHATSIN, e, ENULL);
+	        break;
+	    case TEXPR:
+	        e -> exprblock.leftp = make_int_expr (e -> exprblock.leftp);
+	        e -> exprblock.rightp = make_int_expr (e -> exprblock.rightp);
+	        break;
+	    case TLIST:
+		for(listp = e->listblock.listp; listp; listp = listp->nextp)
+			if ((ap = (Addrp)listp->datap)
+			 && ap->tag == TADDR
+			 && ap->uname_tag == UNAM_CONST)
+				addrlit(ap);
+		break;
+	    default:
+	        break;
+	} /* switch */
+
+    return e;
+} /* make_int_expr */
+
+
+
+/* prune_left_conv -- used in prolog() to strip type cast away from
+   left-hand side of parameter adjustments.  This is necessary to avoid
+   error messages from cktype() */
+
+ expptr
+#ifdef KR_headers
+prune_left_conv(e)
+	expptr e;
+#else
+prune_left_conv(expptr e)
+#endif
+{
+    struct Exprblock *leftp;
+
+    if (e && e -> tag == TEXPR && e -> exprblock.leftp &&
+	    e -> exprblock.leftp -> tag == TEXPR) {
+	leftp = &(e -> exprblock.leftp -> exprblock);
+	if (leftp -> opcode == OPCONV) {
+	    e -> exprblock.leftp = leftp -> leftp;
+	    free ((charptr) leftp);
+	}
+    }
+
+    return e;
+} /* prune_left_conv */
+
+
+ static int wrote_comment;
+ static FILE *comment_file;
+
+ static void
+write_comment(Void)
+{
+	if (!wrote_comment) {
+		wrote_comment = 1;
+		nice_printf (comment_file, "/* Parameter adjustments */\n");
+		}
+	}
+
+ static int *
+count_args(Void)
+{
+	register int *ac;
+	register chainp cp;
+	register struct Entrypoint *ep;
+	register Namep q;
+
+	ac = (int *)ckalloc(nallargs*sizeof(int));
+
+	for(ep = entries; ep; ep = ep->entnextp)
+		for(cp = ep->arglist; cp; cp = cp->nextp)
+			if (q = (Namep)cp->datap)
+				ac[q->argno]++;
+	return ac;
+	}
+
+ static int nu, *refs, *used;
+ static void awalk Argdcl((expptr));
+
+ static void
+#ifdef KR_headers
+aawalk(P)
+	struct Primblock *P;
+#else
+aawalk(struct Primblock *P)
+#endif
+{
+	chainp p;
+	expptr q;
+
+	if (P->argsp)
+		for(p = P->argsp->listp; p; p = p->nextp) {
+			q = (expptr)p->datap;
+			if (q->tag != TCONST)
+				awalk(q);
+			}
+	if (P->namep->vtype == TYCHAR) {
+		if (q = P->fcharp)
+			awalk(q);
+		if (q = P->lcharp)
+			awalk(q);
+		}
+	}
+
+ static void
+#ifdef KR_headers
+afwalk(P)
+	struct Primblock *P;
+#else
+afwalk(struct Primblock *P)
+#endif
+{
+	chainp p;
+	expptr q;
+	Namep np;
+
+	for(p = P->argsp->listp; p; p = p->nextp) {
+		q = (expptr)p->datap;
+		switch(q->tag) {
+		  case TPRIM:
+			np = q->primblock.namep;
+			if (np->vknownarg)
+				if (!refs[np->argno]++)
+					used[nu++] = np->argno;
+			if (q->primblock.argsp == 0) {
+				if (q->primblock.namep->vclass == CLPROC
+				 && q->primblock.namep->vprocclass
+						!= PTHISPROC
+				 || q->primblock.namep->vdim != NULL)
+					continue;
+				}
+		  default:
+			awalk(q);
+			/* no break */
+		  case TCONST:
+			continue;
+		  }
+		}
+	}
+
+ static void
+#ifdef KR_headers
+awalk(e)
+	expptr e;
+#else
+awalk(expptr e)
+#endif
+{
+	Namep np;
+ top:
+	if (!e)
+		return;
+	switch(e->tag) {
+	  default:
+		badtag("awalk", e->tag);
+	  case TCONST:
+	  case TERROR:
+	  case TLIST:
+		return;
+	  case TADDR:
+		if (e->addrblock.uname_tag == UNAM_NAME) {
+			np = e->addrblock.user.name;
+			if (np->vknownarg && !refs[np->argno]++)
+				used[nu++] = np->argno;
+			}
+		e = e->addrblock.memoffset;
+		goto top;
+	  case TPRIM:
+		np = e->primblock.namep;
+		if (np->vknownarg && !refs[np->argno]++)
+			used[nu++] = np->argno;
+		if (e->primblock.argsp && np->vclass != CLVAR)
+			afwalk((struct Primblock *)e);
+		else
+			aawalk((struct Primblock *)e);
+		return;
+	  case TEXPR:
+		awalk(e->exprblock.rightp);
+		e = e->exprblock.leftp;
+		goto top;
+	  }
+	}
+
+ static chainp
+#ifdef KR_headers
+argsort(p0)
+	chainp p0;
+#else
+argsort(chainp p0)
+#endif
+{
+	Namep *args, q, *stack;
+	int i, nargs, nout, nst;
+	chainp *d, *da, p, rv, *rvp;
+	struct Dimblock *dp;
+
+	if (!p0)
+		return p0;
+	for(nargs = 0, p = p0; p; p = p->nextp)
+		nargs++;
+	args = (Namep *)ckalloc(i = nargs*(sizeof(Namep) + 2*sizeof(chainp)
+			+ 2*sizeof(int)));
+	memset((char *)args, 0, i);
+	stack = args + nargs;
+	d = (chainp *)(stack + nargs);
+	refs = (int *)(d + nargs);
+	used = refs + nargs;
+
+	for(p = p0; p; p = p->nextp) {
+		q = (Namep) p->datap;
+		args[q->argno] = q;
+		}
+	for(p = p0; p; p = p->nextp) {
+		q = (Namep) p->datap;
+		if (!(dp = q->vdim))
+			continue;
+		i = dp->ndim;
+		while(--i >= 0)
+			awalk(dp->dims[i].dimexpr);
+		awalk(dp->basexpr);
+		while(nu > 0) {
+			refs[i = used[--nu]] = 0;
+			d[i] = mkchain((char *)q, d[i]);
+			}
+		}
+	for(i = nst = 0; i < nargs; i++)
+		for(p = d[i]; p; p = p->nextp)
+			refs[((Namep)p->datap)->argno]++;
+	while(--i >= 0)
+		if (!refs[i])
+			stack[nst++] = args[i];
+	if (nst == nargs) {
+		rv = p0;
+		goto done;
+		}
+	nout = 0;
+	rv = 0;
+	rvp = &rv;
+	while(nst > 0) {
+		nout++;
+		q = stack[--nst];
+		*rvp = p = mkchain((char *)q, CHNULL);
+		rvp = &p->nextp;
+		da = d + q->argno;
+		for(p = *da; p; p = p->nextp)
+			if (!--refs[(q = (Namep)p->datap)->argno])
+				stack[nst++] = q;
+		frchain(da);
+		}
+	if (nout < nargs)
+		for(i = 0; i < nargs; i++)
+			if (refs[i]) {
+				q = args[i];
+				errstr("Can't adjust %.38s correctly\n\
+	due to dependencies among arguments.",
+					q->fvarname);
+				*rvp = p = mkchain((char *)q, CHNULL);
+				rvp = &p->nextp;
+				frchain(d+i);
+				}
+ done:
+	free((char *)args);
+	return rv;
+	}
+
+ void
+#ifdef KR_headers
+prolog(outfile, p)
+	FILE *outfile;
+	register chainp p;
+#else
+prolog(FILE *outfile, register chainp p)
+#endif
+{
+	int addif, addif0, i, nd;
+	ftnint size;
+	int *ac;
+	register Namep q;
+	register struct Dimblock *dp;
+	chainp p0, p1;
+
+	if(procclass == CLBLOCK)
+		return;
+	p0 = p;
+	p1 = p = argsort(p);
+	wrote_comment = 0;
+	comment_file = outfile;
+	ac = 0;
+
+/* Compute the base addresses and offsets for the array parameters, and
+   assign these values to local variables */
+
+	addif = addif0 = nentry > 1;
+	for(; p ; p = p->nextp)
+	{
+	    q = (Namep) p->datap;
+	    if(dp = q->vdim)	/* if this param is an array ... */
+	    {
+		expptr Q, expr;
+
+		/* See whether to protect the following with an if. */
+		/* This only happens when there are multiple entries. */
+
+		nd = dp->ndim - 1;
+		if (addif0) {
+			if (!ac)
+				ac = count_args();
+			if (ac[q->argno] == nentry)
+				addif = 0;
+			else if (dp->basexpr
+				    || dp->baseoffset->constblock.Const.ci)
+				addif = 1;
+			else for(addif = i = 0; i <= nd; i++)
+				if (dp->dims[i].dimexpr
+				&& (i < nd || !q->vlastdim)) {
+					addif = 1;
+					break;
+					}
+			if (addif) {
+				write_comment();
+				nice_printf(outfile, "if (%s) {\n", /*}*/
+						q->cvarname);
+				next_tab(outfile);
+				}
+			}
+		for(i = 0 ; i <= nd; ++i)
+
+/* Store the variable length of each dimension (which is fixed upon
+   runtime procedure entry) into a local variable */
+
+		    if ((Q = dp->dims[i].dimexpr)
+			&& (i < nd || !q->vlastdim)) {
+			expr = (expptr)cpexpr(Q);
+			write_comment();
+			out_and_free_statement (outfile, mkexpr (OPASSIGN,
+				fixtype(cpexpr(dp->dims[i].dimsize)), expr));
+		    } /* if dp -> dims[i].dimexpr */
+
+/* size   will equal the size of a single element, or -1 if the type is
+   variable length character type */
+
+		size = typesize[ q->vtype ];
+		if(q->vtype == TYCHAR)
+		    if( ISICON(q->vleng) )
+			size *= q->vleng->constblock.Const.ci;
+		    else
+			size = -1;
+
+		/* Fudge the argument pointers for arrays so subscripts
+		 * are 0-based. Not done if array bounds are being checked.
+		 */
+		if(dp->basexpr) {
+
+/* Compute the base offset for this procedure */
+
+		    write_comment();
+		    out_and_free_statement (outfile, mkexpr (OPASSIGN,
+			    cpexpr(fixtype(dp->baseoffset)),
+			    cpexpr(fixtype(dp->basexpr))));
+		} /* if dp -> basexpr */
+
+		if(! checksubs) {
+		    if(dp->basexpr) {
+			expptr tp;
+
+/* If the base of this array has a variable adjustment ... */
+
+			tp = (expptr) cpexpr (dp -> baseoffset);
+			if(size < 0 || q -> vtype == TYCHAR)
+			    tp = mkexpr (OPSTAR, tp, cpexpr (q -> vleng));
+
+			write_comment();
+			tp = mkexpr (OPMINUSEQ,
+				mkconv (TYADDR, (expptr)p->datap),
+				mkconv(TYINT, fixtype
+				(fixtype (tp))));
+/* Avoid type clash by removing the type conversion */
+			tp = prune_left_conv (tp);
+			out_and_free_statement (outfile, tp);
+		    } else if(dp->baseoffset->constblock.Const.ci != 0) {
+
+/* if the base of this array has a nonzero constant adjustment ... */
+
+			expptr tp;
+
+			write_comment();
+			if(size > 0 && q -> vtype != TYCHAR) {
+			    tp = prune_left_conv (mkexpr (OPMINUSEQ,
+				    mkconv (TYADDR, (expptr)p->datap),
+				    mkconv (TYINT, fixtype
+				    (cpexpr (dp->baseoffset)))));
+			    out_and_free_statement (outfile, tp);
+			} else {
+			    tp = prune_left_conv (mkexpr (OPMINUSEQ,
+				    mkconv (TYADDR, (expptr)p->datap),
+				    mkconv (TYINT, fixtype
+				    (mkexpr (OPSTAR, cpexpr (dp -> baseoffset),
+				    cpexpr (q -> vleng))))));
+			    out_and_free_statement (outfile, tp);
+			} /* else */
+		    } /* if dp -> baseoffset -> const */
+		} /* if !checksubs */
+
+		if (addif) {
+			nice_printf(outfile, /*{*/ "}\n");
+			prev_tab(outfile);
+			}
+	    }
+	}
+	if (wrote_comment)
+	    nice_printf (outfile, "\n/* Function Body */\n");
+	if (ac)
+		free((char *)ac);
+	if (p0 != p1)
+		frchain(&p1);
+} /* prolog */
diff --git a/contrib/tools/f2c/src/version.c b/contrib/tools/f2c/src/version.c
new file mode 100644
index 0000000000..f736fc7b4a
--- /dev/null
+++ b/contrib/tools/f2c/src/version.c
@@ -0,0 +1,2 @@
+char F2C_version[] = "20190311";
+char xxxvers[] = "\n@(#) FORTRAN 77 to C Translator, VERSION 20190311\n";