Advanced User Experience
Go to the next, previous, or main
section.
Advanced Control Files
Many more things can be accomplished in a control file besides simply
specifying the parameters of a computation, and even that can be done
in a more sophisticated way than we have already described. The key
to this functionality is the fact that the ctl file is actually
written in a full programming language, called Scheme. This language
is interpreted and executed at run-time using an interpreter named
Guile. The fact that it is a full programming language means that you
can do practically anything--the only limitations are in the degree of
interaction supported by the simulation program.
In a later section, we provide links
to more information on Scheme and Guile.
The easiest way to learn Scheme is to experiment. Guile supports an
interactive mode where you can type in commands and have them executed
immediately. To get into this mode, you can just type
guile at the command-line.
If you run your libctl program without passing any arguments, or
pass a ctl file that never invokes (run), this will also
drop you into a Guile interactive mode. What's more, all the special
features supported by libctl and your program are available from this
interactive mode. So, you can set parameters of your program, invoke
it with (run), get help with (help), and do
anything else you might otherwise do in a ctl file. It is possible
that your program supports other calls than just (run),
in which case you could control it on an even more detailed level.
There is a boolean variable called interactive? that
controls whether interactive mode will be entered. This variable is
true initially, but is typically set to
false by (run). You can force interactive
mode to be entered or not by set!-ing this variable to
true or false, respectively.
Command-line Parameters
It is often useful to be able to set parameters of your ctl file from
the command-line when you run the program. For example, you might
want to vary the radius of some object with each run. To do this,
you would define a parameter R in your ctl file:
(define-param R 0.2)
You would then use R instead of a numeric value
whenever you wanted this radius. If nothing is specified on the
command-line, R will take on a default value of
0.2. However, you can change the value of R
on a particular run by specifying R=value on the
command-line. For instance, to set R to
0.3, you would use:
program R=0.3 ctl-file
You can have as many command-line parameters as you want. In fact,
all of the predefined input variables for a program are defined via
define-param already, so you can set them via the command
line too.
Programmatic Parameter Setting
A simple use of the programmatic features of Scheme is to give you
more power in assigning the variables in the control file. You can
use arithmetic expressions, loops and functions, or define your own
variables and functions.
For example, consider the following case where we set the
k-points of a band-structure computation. We define the
corners of the Brillouin zone, and then call a libctl-provided
function, interpolate, to linearly interpolate between them.
The interpolate function is provided as a convenience
by libctl, but you could have written it yourself if it weren't. With
past programs, it has often been necessary to write a program to
generate control files--now, the program can be in the control file
itself.
Interacting with the Simulation
So far, the communication with the simulation program has been
one-way, with us passing information to the simulation. It is
possible, however, to get information back. The (help)
command lists not only input variables, but also output
variables--these variables are set by the simulation and are available
for the ctl program to examine after (run) returns.
For example, a band-structure computation might return a list of
the band-gaps. Using this, the ctl file could vary, say, the radius
of a sphere and loop until a band-gap is maximized.
Go to the next, previous, or main
section.
libctl-3.2.2/doc/user-ref.html 0000644 0001754 0000144 00000040606 12315325230 013075 0000000 0000000
User Reference
Go to the next, previous, or main
section.
User Reference
In this section, we list all of the special functions provided for
users by libctl. We do not attempt to document standard Scheme
functions, with a couple of exceptions below, since there are plenty
of good Scheme references elsewhere.
Of course, the most important function is:
(help)
Outputs a listing of all the available classes, their properties,
default values, and types. Also lists the input and output variables.
Remember, Guile lets you enter expressions and see their values
interactively. This is the best way to learn how to use anything that
confuses you--just try it and see how it works!
Basic Scheme functions
(set! variable value)
Change the value of variable to value.
(define variable value)
Define new variable with initial value.
(list [ element1 element2 ... ])
Returns a list consisting of zero or more elements.
(append [ list1 list2 ... ])
Concatenates zero or more lists into a single list.
(function [ arg1 arg2 ... ])
This is how you call a Scheme function in general.
(define (function [ arg1 arg2 ... ]) body)
Define a new function with zero or more
arguments that returns the result of given body
when it is invoked.
Command-line parameters
(define-param namedefault-value)
Define a variable name whose value can be set
from the command line, and which assumes a value
default-value if it is not set. To set the value
on the command-line, include name=value on
the command-line when the program is executed. In all other respects,
name is an ordinary Scheme variable.
(set-param! namenew-default-value)
Like set!, but does nothing if
name was set on the command line.
Complex numbers
Scheme includes full support for complex numbers and arithmetic;
all of the ordinary operations (+, *,
sqrt, etcetera) just work. For the same reason, you can
freely use complex numbers in libctl's vector and matrix functions,
below.
To specify a complex number a+bi, you simply use the
syntax a+bi if a and b are
constants, and (make-rectangular ab)
otherwise. (You can also specify numbers in "polar" format
a*eib by the syntax
a@b or (make-polar ab).)
There are a few special functions provided by Scheme to manipulate
complex numbers. (real-part z) and
(imag-part z) return the real and imaginary parts
of z, respectively. (magnitude
z) returns the absolute value and (angle
z) returns the phase angle. libctl also provides a
(conj z) function, below, to return the complex
conjugate.
3-vector functions
(vector3 x [y z])
Create a new 3-vector with the given components. If the y or z value is omitted, it is set to zero.
(vector3-x v)
(vector3-y v)
(vector3-z v)
Return the corresponding component of the vector v.
(vector3+ v1 v2)
(vector3- v1 v2)
(vector3-cross v1 v2)
Return the sum, difference, or cross product of the two vectors.
(vector3* a b)
If a and b are both
vectors, returns their dot product. If one of them is a number and
the other is a vector, then scales the vector by the number.
(vector3-dot v1 v2)
Returns the dot product of v1 and v2.
(vector3-cross v1 v2)
Returns the cross product of v1 and v2.
(vector3-cdot v1 v2)
Returns the conjugated dot product: v1* dot v2.
(vector3-norm v)
Returns the length (sqrt (vector3-cdot v v)) of the
given vector.
(unit-vector3 x [y z])
(unit-vector3 v)
Given a vector or, alternatively, one or more components, returns a
unit vector in that direction.
(vector3-close? v1 v2 tolerance)
Returns whether or not the corresponding components of the two
vectors are within tolerance of each other.
(vector3= v1 v2)
Returns whether or not the two vectors are numerically equal.
Beware of using this function after operations that may have some
error due to the finite precision of floating-point numbers; use
vector3-close? instead.
(rotate-vector3 axis theta v)
Returns the vector v rotated by an angle
theta (in radians) in the right-hand direction
around the axis vector (whose length is ignored).
You may find the functions (deg->rad theta-deg)
and (rad->deg theta-rad) useful to convert angles
between degrees and radians.
3x3 matrix functions
(matrix3x3 c1 c2 c3)
Creates a 3x3 matrix with the given 3-vectors as its columns.
(matrix3x3-transpose m)
(matrix3x3-adjoint m)
(matrix3x3-determinant m)
(matrix3x3-inverse m)
Return the transpose, adjoint (conjugate transpose), determinant,
or inverse of the given matrix.
(matrix3x3+ m1 m2)
(matrix3x3- m1 m2)
(matrix3x3* m1 m2)
Return the sum, difference, or product of the given matrices.
(matrix3x3* v m)
(matrix3x3* m v)
Returns the (3-vector) product of the matrix m
by the vector v, with the vector multiplied on the
left or the right respectively.
(matrix3x3* s m)
(matrix3x3* m s)
Scales the matrix m by the number
s.
(rotation-matrix3x3 axis theta)
Like rotate-vector3, except returns the (unitary)
rotation matrix that performs the given rotation. i.e.,
(matrix3x3* (rotation-matrix3x3 axis theta) v) produces
the same result as (rotate-vector3 axis theta v).
Objects (members of classes)
(make class [ properties ... ])
Make an object of the given class. Each
property is of the form (property-name
property-value). A property need not be specified if it
has a default value, and properties may be given in any order.
(object-property-value object property-name)
Return the value of the property whose name (symbol) is
property-name in object. For
example, (object-property-value a-circle-object 'radius).
(Returns false if property-name is
not a property of object.)
Miscellaneous utilities
(conj x)
Return the complex conjugate of a number x
(for some reason, Scheme doesn't provide such a function).
(interpolate n list)
Given a list of numbers or 3-vectors, linearly
interpolates between them to add n new
evenly-spaced values between each pair of consecutive values in the
original list.
(print expressions...)
Calls the Scheme display function on each of its
arguments from left to right (printing them to standard output). Note
that, like display, it does not append a newline
to the end of the outputs; you have to do this yourself by including
the "\n" string at the end of the expression list. In
addition, there is a global variable print-ok?,
defaulting to true, that controls whether
print does anything; by setting print-ok? to
false, you can disable all output.
(begin-time message-string statements...)
Like the Scheme (begin ...) construct, this executes
the given sequence of statements one by one. In addition, however, it
measures the elapsed time for the statements and outputs it as
message-string, followed by the time, followed by
a newline. The return value of begin-time is the elapsed
time in seconds.
(minimize function tolerance)
Given a function of one (number) argument,
finds its minimum within the specified fractional
tolerance. If the return value of
minimize is assigned to a variable result,
then (min-arg result) and (min-val result)
give the argument and value of the function at its minimum. If you
can, you should use one of the variant forms of minimize,
described below.
(minimize function tolerance guess)
The same as above, but you supply an initial
guess for where the minimum is located.
(minimize function tolerance arg-min arg-max)
The same as above, but you supply the minimum and maximum function
argument values within which to search for the minimum. This is the
most preferred form of minimize, and is faster and more
robust than the other two variants.
(minimize-multiple function tolerance arg1 .. argN)
Minimize a function of N numeric arguments within the
specified fractional tolerance.
arg1 .. argN are an initial
guess for the function arguments. Returns both the arguments and
value of the function at its minimum. A list of the arguments at the
minimum are retrieved via min-arg, and the value via
min-val.
maximize, maximize-multiple
These are the same as the minimize functions
except that they maximizes the function instead of minimizing it. The
functions max-arg and max-val are provided
instead of min-arg and min-val.
(find-root function tolerance arg-min arg-max)
Find a root of the given function to within
the specified fractional tolerance.
arg-min and arg-maxbracket the
desired root; the function must have opposite signs at these two
points!
(find-root-deriv function tolerance arg-min arg-max [arg-guess])
As find-root, but function should
return a cons pair of (function-value
. function-derivative); the derivative information is exploited to
achieve faster convergence via Newton's method, compared to
find-root. The optional argument
arg-guess should be an initial guess for the root
location.
(derivative function x [dx tolerance])
(deriv function x [dx tolerance])
(derivative2 function x [dx tolerance])
(deriv2 function x [dx tolerance])
Compute the numerical derivative of the given
function at x to within at
best the specified fractional tolerance
(defaulting to the maximum achievable tolerance), using Ridder's
method of polynomial extrapolation. dx should be
a maximum displacement in x for derivative
evaluation; the function should change by a
significant amount (much larger than the numerical precision) over
dx. dx defaults to 1% of
x or 0.01, whichever is larger.
If the return value of derivative is assigned to a
variable result, then (derivative-df result)
and (derivative-df-err result) give the derivative of the
function and an estimate of the numerical error in the derivative,
respectively.
The derivative2 function computes both the first and
second derivatives, using minimal extra function evaluations; the
second derivative and its error are then obtained by
(derivative-d2f result) and (derivative-d2f-err
result).
deriv and deriv2 are identical to
derivative and derivative2, except that they
directly return the value of the first and second derivatives,
respectively (no need to call derivative-df or
derivative-d2f). (They don't provide the error estimate,
however, or the ability to compute first and second derivatives
simulataneously.)
(integrate f a b tolerance)
Return the definite integral of the function f from
a to b, to within the specified
fractional tolerance, using an adaptive
trapezoidal rule.
This function can compute multi-dimensional integrals, in which
case f is a function of N variables and
a and b are either lists or
vectors of length N, giving the (constant) integration bounds
in each dimension. (Non-constant integration bounds,
i.e. non-rectilinear integration domains, can be handled by an
appropriate mapping of the function f.)
(fold-left op init list)
Combine the elements of list using the binary
"operator" function (op x y), with initial value
init, associating from the left of the list. That
is, if list consist of the elements (a b
c d), then (fold-left op init list)
computes (op (op (op (op init a) b) c) d). For example,
if list contains numbers, then (fold-left +
0 list) returns the sum of the elements of
list.
(fold-right op init list)
As fold-left, but associate from the right. For
example, (op a (op b (op c (op d init)))).
(memoize func)
Return a function wrapping around the function
func that "memoizes" its arguments and return
values. That is, it returns the same thing as
func, but if passed the same arguments as a
previous call it returns a cached return value from the previous call
instead of recomputing it.
Go to the next, previous, or main
section.
libctl-3.2.2/doc/basic-user.html 0000644 0001754 0000144 00000017456 12315324747 013425 0000000 0000000
Basic User Experience
Go to the next, previous, or main
section.
Basic Control Files
At their most basic level, ctl files are simply a collection of
values for parameters required by the simulation.
For example, suppose that the simulation solves a one-dimensional
differential equation and requires an input called "grid-size"
specifying the number of grid points used in the discretization of the
problem. We might specify this in a ctl file by the statement:
(set! grid-size 128)
All input variable settings follow the format (set!
variablevalue). The parentheses are important,
but white space is ignored.
Settings of input variables can appear in any order at all in the
file. They can even be omitted completely in many cases, and a
reasonable default will be used. Variables can be of many different
types, including integers, real numbers, boolean values
(true and false), strings, 3-vectors, and
lists. Here is how we might set some parameters of various types:
(set! time-step-dt 0.01) ; a real number
(set! output-file-name
"data.hdf") ; a string
(set! propagation-direction (vector3 0 0.2 7)) ; a 3-vector
(set! output-on-time-steps ; a list of integers...
(list 25 1000
257 128 4096))
Everything appearing on a line after a semicolon (";") is a
comment and is ignored. Note also that we are free to split
inputs over several lines--as we mentioned earlier, white space is
ignored.
3-vectors are constructed using (vector3 x [y
[z]]). If the y or z components are omitted,
they are set to zero. Lists may contain any number of items
(including zero items), and are constructed with (list [item1
item2 ...]).
A typical control file is terminated with a single statement:
(run) ; run the computation
This tells the program to run its computation with whatever parameter
values have been specified up to the point of the (run).
This command can actually appear multiple times in the ctl file,
causing multiple runs, or not at all, which drops the user into an
interactive mode that we will discuss later.
Running a simulation
The user runs the simulation program simply by:
programctl-files
Here, program is the name of the simulation
program executable and ctl-files are any ctl files that you
want to use for the run. The result is as if all the ctl-files
were concatenated, in sequence, into a single file.
Structured Data Types
For many programs, it is useful to structure the input into more
complicated data types than simple numbers, vectors, and lists. For
example, an electromagnetic simulation might take as input a list of
geometric objects specifying the dielectric structure. Each object
might have several parameters--for example, a sphere might have a
radius, a center, and a dielectric constant.
libctl allows programs to specify structured datatypes, called
classes, that have various properties which may be set. Here
is what a list of geometric objects for a dielectric structure might
look like:
In this case, the list consists of two objects of classes called
sphere and block. The general format for
constructing an object (instance of a class) is (make
classproperties). Properties is a
sequence of (propertyvalue) items setting
the properties of the object.
Properties may have default values that they assume if nothing is
specified. For example, the block class might have
properties e1, e2, and e3 that
specify the directions of the block edges, but which default to the
coordinate axes if they are not specified. Typically, each class will
have some properties that have defaults, and some that you are
required to specify.
Property values can be any of the primitive types mentioned
earlier, but they can also be other objects. For example, instead of
specifying a dielectric constant, you might instead supply an object
describing the material type:
We have snuck in another feature here: (define
new-variablevalue) is a way of defining new
variables for our own use in the control file. (This and other
features of the Scheme language are discussed in the next section.)
What Do I Enter?
Every program will have a different set of variables that it expects
you to set, and a different set of classes with different properties.
Whatever program you are using should come with documentation saying
what it expects.
You can also get the program to print out help by inserting the
(help) command in your ctl file, or by entering it in interactive mode. You can
also simply enter the following command in your shell:
echo "(help)" | program
For example, the output of (help) in the
electromagnetic simulation we have been using in our examples might
look like:
Class block:
Class geometric-object:
material-type material
vector3 center
vector3 e1 = #(1 0 0)
vector3 e2 = #(0 1 0)
vector3 e3 = #(0 0 1)
vector3 size
Class sphere:
Class geometric-object:
material-type material
vector3 center
number radius
Class geometric-object:
material-type material
vector3 center
Class material-type:
number epsilon
number conductivity = 0.0
Input variables:
vector3 list k-points = ()
geometric-object list geometry = ()
integer dimensions = 3
Output variables:
number list gaps = ()
number mean-dielectric = 0.0
As can be seen from above, the help output lists all of the classes
and their properties, along with the input and output variables (the
latter will be described later). Any default values for properties
are also given. Along with each variable or property is given its
type.
You should also notice that the class geometric-object
is listed as a part of the classes block and
sphere. These two classes are subclasses of
geometric-object. A subclass inherits the property list
of its superclass and can be used any place its superclass is allowed.
So, for example, both spheres and blocks can be used in the
geometry list, which is formally a list of
geometric-objects. (The astute reader will notice the
object-oriented-programming origins of our class concept; our classes,
however, differ from OOP in that they have no methods.)
Go to the next, previous, or main
section.
libctl-3.2.2/doc/index.html 0000644 0001754 0000144 00000005473 12315325015 012460 0000000 0000000
libctl Documentation
libctl
Welcome to the manual for libctl, a Guile-based library
implementing flexible control files for scientific simulations!
This documentation is divided into the following sections, which you
should read roughly in order if you are new to libctl:
The advanced user can take advantage of the fact that the ctl file is
actually a Scheme program running in a full interpreter (called
Guile). Literally anything is possible, especially since the
simulation program can support dynamic passing of information back and
forth with the control file.
libctl is powerful for the developer, too. One merely specifies an
abstract specification file that describes the information that
is exchanged with the ctl file, and nearly everything else is
automatic.
Guile is a standard GNU program for adding scripting and extensibility
to software. It implements an embeddable interpreter for the Scheme
language. There are many places that you can go to learn more about
Guile and Scheme, and we link to a few of them here.
If you have comments or questions regarding libctl, you can contact Steven G. Johnson at stevenj@alum.mit.edu.
libctl-3.2.2/doc/introduction.html 0000644 0001754 0000144 00000007120 12315325021 014056 0000000 0000000
Scientific software for performing large computations is typically
managed using textual control files that specify the parameters of the
computation. Historically, these control files have typically
consisted of long, inflexible collections of numbers whose meaning and
format is hard-coded into the program. With libctl, we make it
easy for programmers to support a greatly superior control file
structure, and with less effort than was required for traditional
input formats.
The "ctl" in "libctl" stands for Control Language (by
convention, libctl control files end with ".ctl" and are referred to
as ctl files). Thus, libctl is the Control Language Library
(where the "lib" prefix follows the Unix idiom).
Design Principles
The libctl design has the following goals:
Input readability: The control file should be
self-annotating and human-readable (as opposed to an inscrutable
sequence of numbers). Of course, it should allow comments.
Input flexibility: The control file should not be sensitive
to the ordering or spacing of the inputs.
Input intelligence: The user should never have to enter any
information that the program could reasonably infer. For example,
reasonable defaults should be available wherever possible for
unspecified parameters.
Flexibility: It should be easy to add new parameters and
features to the control file without breaking older control files or
increasing complexity.
Scriptability: Simple things should be simple, but complex
things should be possible. The control file should be more than just
a file format. It must be a programming language, able to script the
computation and add new functionality without modifying the simulation
source code.
Programmer Convenience: All of this power should not come
at the expense of the programmer. Rather, it should be easier to
program than ever before--the programmer need only specify the
interaction with the control file in an abstract form, and everything
else should be taken care of automatically.
All of these goals are achieved by libctl with the help of Guile, the
GNU scripting and extensibility language. Guile does all of the hard
work for us, and allows us to embed a complete interpreter in a
program with minimal effort.
Despite its power, libctl is designed to be easy to use. A basic
user only sees a convenient file format...with a programming language
to back it up if her needs become more complex. For the programmer,
all headaches associated with reading input files are lifted--once an
abstract specification is supplied, all interaction with the user is
handled automatically.
In the subsequent sections of this manual, we will discuss in more
detail the interaction of the user and the programmer with libctl.
Go to the next, previous, or main
section.
libctl-3.2.2/doc/developer.html 0000644 0001754 0000144 00000042420 12315325237 013335 0000000 0000000
Developer Information
Go to the next, previous, or main
section.
Developing a Program Using libctl
If you are thinking of using libctl in a program that you are writing,
you might be rolling your eyes at this point, thinking of all the work
that it will be. A full programming language? Complicated data
structures? Information passing back and forth? Surely, it will be a
headache to support all of these things.
In fact, however, using libctl is much easier than writing your
program for a traditional, fixed-format input file. You simply
describe in an abstract specifications file the variables and data
types that your program expects to exchange with the ctl file, and the
functions by which it is called. From these specifications, code is
automatically generated to export and import the information to and
from Guile.
The specifications file is written in Scheme, and consists of
definitions for the classes and input/output variables the program
expects. It may also contain any predefined functions or variables
that might be useful in ctl files for the program, and says which
functions in your program are callable from the ctl script.
Defining input variables
To define an input variable (a variable specified by the ctl file and
input into the program), use the following construction:
(define-input-var name value type [ constraints ... ])
Here, name is the name of the variable, and
value is its initial value--so far, this is just
like a normal define statement. However, input variables
have constraints on them, the simplest of which is that they have a
specific type. The type parameter can be one of:
'number - a real number
'cnumber - a complex number
'integer - an integer
'vector3 - a real 3-vector
'matrix3x3 - a real 3x3 matrix
'cvector3 - a complex 3-vector
'cmatrix3x3 - a complex 3x3 matrix
'boolean - a boolean value, true or
false
'string - a string
'function - a function (in C, a Guile SCM function pointer)
'class - an member of class
(make-list-type el-type) - a list of elements
of type el-type
'SCM - a generic Scheme object
Note that the quote before a type name is Scheme's way of
constructing a symbol, which is somewhat similar to a C
enumerated constant.
The final argument is an optional sequence of constraints. Each
constraint is a function that, given a value, returns
true or false depending on whether that
value is valid. For example, if an input variable is required to be
positive, one of the constraints would be the positive?
function (predefined by Guile). More complicated functions can, of
course, be constructed.
Notice that all input variables have initial values, meaning that a
user need not specify a value in the ctl file if the default value is
acceptable. If you want to force the user to explicitly give a value
to a variable, set the initial value to 'no-value. (This
way, if the variable is not set by the user, it will fail the
type-constraint and an error will be flagged.) Such behavior is
deprecated, however.
Defining output variables
Output variables, which are passed from the simulation to the ctl
script, are defined in a manner similar to input variables:
(define-output-var name type)
Notice that output variables have no initial value and no
constraints. Your C program is responsible for assigning the output
variables when it is called (as is discussed below).
A variable can be both an input variable and an output variable at
the same time. Such input-output variables are defined with the same
parameters as an input variable:
(define-input-output-var name value type [constraints])
Defining classes
To define a class, one has to supply the parent class and the properties:
(define-class name parent [ properties... ])
name is the name of the new class and
parent is the name of the parent class, or
no-parent if there is none.
The properties of the class are zero or more of
the following definitions, which give the name, type, default value,
and (optional) constraints for a property:
(define-property name default-value type [ constraints... ])
name is the name of the property. It is okay
for different classes to have properties with the same name (for
example, both a sphere and a cylinder class might have
radius properties)--however, it is important that
properties with the same name have the same type. The
type and optional constraints
are the same as for define-input-var, described earlier.
If default-value is no-default,
then the property has no default value and users are required to
specify it. To give a property a default value,
default-value should simply be that default value.
For example, this is how we might define classes for materials and
dielectric objects in an electromagnetic simulation:
Sometimes, it is convenient to store other properties with an object
that are not input by the user, but which instead are computed based
on the other user inputs. A mechanism is provided for this called
"derived" properties, which are created by:
(define-derived-property name type derive-func)
Here, derive-func is a function that takes an
object of the class the property is in, and returns the value of the
property. (See below for an example.) derive-func is called after all
of the non-derived properties of the object have been assigned their
values.
Post-processed properties
It is often useful to store a function of the user input into a
property, instead of just storing the input itself. (For example, you
might want to scale an input vector so that it is stored as a unit
vector.) The syntax for defining such a property is the same as
define-property except that it has one extra argument:
(define-post-processed-property name default-value type
process-func [ constraints... ])
process-func is a function that takes one
argument and returns a value, both of the same type as the property.
Any user-specified value for the property is passed to
process-func, and the result is assigned to the
property.
Here is an example that defines a new type of geometric object, a
block. Blocks have a size property that
specifies their dimensions along three unit vectors, which are
post-processed properties (with default values of the coordinate
axes). When computing whether a point falls within a block, it is
necessary to know the projection matrix, which is the inverse of the
matrix whose columns are the basis vectors. We make this projection
matrix a derived property, computed via the libctl-provided matrix
routines, freeing us from the necessity of constantly recomputing it.
(define-class block geometric-object
(define-property size no-default 'vector3)
; the basis vectors, which are forced to be unit-vectors
; by the unit-vector3 post-processing function:
(define-post-processed-property e1 (vector3 1 0 0) 'vector3 unit-vector3)
(define-post-processed-property e2 (vector3 0 1 0) 'vector3 unit-vector3)
(define-post-processed-property e3 (vector3 0 0 1) 'vector3 unit-vector3)
; the projection matrix, which is computed from the basis vectors
(define-derived-property projection-matrix 'matrix3x3
(lambda (object)
(matrix3x3-inverse
(matrix3x3
(object-property-value object 'e1)
(object-property-value object 'e2)
(object-property-value object 'e3))))))
Exporting your subroutines
In order for the ctl script to do anything, one of your C routines
will eventually have to be called.
To export a C routine, you write the C routine as you would
normally, using the data types defined in ctl.h and ctl-io.h (see
below) for parameters and return value. All parameters must be passed
by value (with the exception of strings, which are of type char
*).
Then, in your specifications file, you must add a declaration of the following form:
(define-external-function name read-inputs? write-outputs?
return-type
[ arg0-type arg1-type ... ])
name is the name of the function, and is the
name by which it will be called in a ctl script. This should be
identical to the name of the C subroutine, with the exception that
underscores are turned into hyphens (this is not required, but is the
convention we adopt everywhere else).
If read-inputs? is true, then the
input variables will be automatically imported into C global variables
before the subroutine is called each time. If you don't want this to
happen, this argument should be false. Similarly,
write-outputs? says whether or not the output
variables will be automaticaly exported from the C globals after the
subroutine is called. All of this code, including the declarations of
the C input/output globals, is generated automatically (see below).
So, when your function is called, the input variables will already
contain all of their values, and you need only assign/allocate data to
the output variables to send data back to Guile. If
write-outputs? is true, the output
variables must have valid contents when your routine exits.
return-type is the return type of the
subroutine, or no-return-value if there is no return
value (i.e. the function is of type void). The remaining
arguments are the types of the parameters of the C subroutine.
Usually, your program will export a run subroutine
that performs the simulation given the input variables, and returns
data to the ctl script through the output variables. Such a
subroutine would be declared in C as:
void run(void);
and in the specifications file by:
(define-external-function run true true no-return-value)
As another example, imagine a subroutine that takes a geometric
object and returns the fraction of electromagnetic energy in the
object. It does not use the input/output global variables, and would
be declared in C and in the specifications file by:
/* C declaration: */
number energy_in_object(geometric_object obj);
; Specifications file:
(define-external-function energy-in-object false false
'number 'geometric-object)
Data structures and types
The data structures for holding classes and other variable types are
defined automatically in the generated file ctl-io.h (see
below). They are fairly self-explanatory, but it should be noted that
they use some data types defined in src/ctl.h, mostly
mirrors of the corresponding Scheme types. (e.g. number
is a synonym for double, and vector3 is a
structure with x, y, and z
fields.) (ctl.h also declares several functions for
manipulating vectors and matrices, e.g. vector3_plus.)
Allocating and deallocating data
The input variables are allocated and deallocated automatically, as
necessary, but you are responsible for allocating and deallocating the
output data. As a convenience, the function
destroy_output_vars() is defined, which deallocates all
of the output data pointed to by the output variables. You are
responsible for calling this when you want to deallocate the output.
Often, after each run, you will simply want to (re)allocate and
assign the output variables. To avoid memory leaks, however, you
should first deallocate the old output variables on runs after the
first. To do this, use the following code:
if (num_write_output_vars > 0)
destroy_output_vars();
/* ... allocate & assign the output variables ... */
The global variable num_write_output_vars is
automatically set to the number of times the output variables have
been written.
Remember, you are required to assign all of the output
variables to legal values, or the resulting behavior will be
undefined.
Other useful things to put in a specifications file
The specifications file is loaded before any user ctl file, making it
a good place to put definitions of variables and functions that will
be useful for your users. For example, the electromagnetic simulation
might define a default material, air:
(define air (make material-type (epsilon 1.0)))
You can also define functions (or do anything else that Scheme
allows), e.g. a function to duplicate geometric objects on a grid.
(See the examples/ directory of libctl for an example of
this.)
Writing your program
Once the specifications have been written, you have to do very little
to support them in your program.
First, you need to generate C code to import/export the
input/output variables from/to Guile. This is done automatically by
the gen-ctl-io script in the utils/
directory (installed into a bin directory by make
install):
The gen-ctl-io commands above generate two files,
ctl-io.h and ctl-io.c. The former defines
global variables and data structures for the input/output variables
and classes, and the latter contains code to exchange this data with
Guile.
Second, you should use the main.c file from the
base/ directory; if you use the example
Makefile (see below), this is done automatically for you.
This file defines a main program that starts up Guile, declares the
routines that you are exporting, and loads control files from the
command line. You should not need to modify this file, but you should
define preprocessor symbols telling it where libctl and your
specification file are (again, this is done for you automatically by
the example Makefile).
For maximum convenience, if you are wisely using GNU autoconf, you
should also copy the Makefile.in from
examples/; you can use the Makefile
otherwise. At the top of this file, there are places to specify your
object files, specification file, and other information. The
Makefile will then generate the ctl-io files
and do everything else needed to compile your program.
You then merely need to write the functions that you are exporting
(see above for how to export functions). This will usually include,
at least, a run function (see above).
The default main.c handles a couple of additional
command-line options, including --verbose (or
-v), which sets a global variable verbose to
1 (it is otherwise 0). You can access this
variable (it is intended to enable verbose output in programs) by
declaring the global "extern int verbose;" in your
program.
Have fun!
Go to the next, previous, or main
section.
libctl-3.2.2/doc/license.html 0000644 0001754 0000144 00000003554 12315325302 012770 0000000 0000000
License and Copyright
Go to the previous or main sections.
libctl is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
USA. You can also find it on the GNU web page:
There are a few files in libctl that we place in the public domain,
which are not restricted by the terms of the GPL. These files
explicitly indicate this fact at the top of the file. All files
fall under the GPL unless they expressly say otherwise.
Go to the previous or main sections.
libctl-3.2.2/doc/guile-links.html 0000644 0001754 0000144 00000006600 12315325227 013572 0000000 0000000
Guile and Scheme Links
Go to the next, previous, or main
section.
Guile and Scheme Links
There are many places you can go to on the Web to find out more
regarding Guile and the Scheme programming language. We list a few of
them here:
Scheme:
Scheme is a simplified derivative of Lisp, a small and beautiful
dynamically typed, lexically scoped, functional language.
The GLUG (Guile Lovers Use
Guile) Guile user's site.
See parts IV and V of the Guile
Reference Manual for additional Scheme functions and types defined
within the Guile environment.
Go to the next, previous, or main
section.
libctl-3.2.2/ltmain.sh 0000644 0001754 0000144 00001051522 12235234705 011541 0000000 0000000
# libtool (GNU libtool) 2.4.2
# Written by Gordon Matzigkeit , 1996
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005, 2006,
# 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
# This is free software; see the source for copying conditions. There is NO
# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# GNU Libtool is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# As a special exception to the GNU General Public License,
# if you distribute this file as part of a program or library that
# is built using GNU Libtool, you may include this file under the
# same distribution terms that you use for the rest of that program.
#
# GNU Libtool is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GNU Libtool; see the file COPYING. If not, a copy
# can be downloaded from http://www.gnu.org/licenses/gpl.html,
# or obtained by writing to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
# Usage: $progname [OPTION]... [MODE-ARG]...
#
# Provide generalized library-building support services.
#
# --config show all configuration variables
# --debug enable verbose shell tracing
# -n, --dry-run display commands without modifying any files
# --features display basic configuration information and exit
# --mode=MODE use operation mode MODE
# --preserve-dup-deps don't remove duplicate dependency libraries
# --quiet, --silent don't print informational messages
# --no-quiet, --no-silent
# print informational messages (default)
# --no-warn don't display warning messages
# --tag=TAG use configuration variables from tag TAG
# -v, --verbose print more informational messages than default
# --no-verbose don't print the extra informational messages
# --version print version information
# -h, --help, --help-all print short, long, or detailed help message
#
# MODE must be one of the following:
#
# clean remove files from the build directory
# compile compile a source file into a libtool object
# execute automatically set library path, then run a program
# finish complete the installation of libtool libraries
# install install libraries or executables
# link create a library or an executable
# uninstall remove libraries from an installed directory
#
# MODE-ARGS vary depending on the MODE. When passed as first option,
# `--mode=MODE' may be abbreviated as `MODE' or a unique abbreviation of that.
# Try `$progname --help --mode=MODE' for a more detailed description of MODE.
#
# When reporting a bug, please describe a test case to reproduce it and
# include the following information:
#
# host-triplet: $host
# shell: $SHELL
# compiler: $LTCC
# compiler flags: $LTCFLAGS
# linker: $LD (gnu? $with_gnu_ld)
# $progname: (GNU libtool) 2.4.2
# automake: $automake_version
# autoconf: $autoconf_version
#
# Report bugs to .
# GNU libtool home page: .
# General help using GNU software: .
PROGRAM=libtool
PACKAGE=libtool
VERSION=2.4.2
TIMESTAMP=""
package_revision=1.3337
# Be Bourne compatible
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
emulate sh
NULLCMD=:
# Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
setopt NO_GLOB_SUBST
else
case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac
fi
BIN_SH=xpg4; export BIN_SH # for Tru64
DUALCASE=1; export DUALCASE # for MKS sh
# A function that is used when there is no print builtin or printf.
func_fallback_echo ()
{
eval 'cat <<_LTECHO_EOF
$1
_LTECHO_EOF'
}
# NLS nuisances: We save the old values to restore during execute mode.
lt_user_locale=
lt_safe_locale=
for lt_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES
do
eval "if test \"\${$lt_var+set}\" = set; then
save_$lt_var=\$$lt_var
$lt_var=C
export $lt_var
lt_user_locale=\"$lt_var=\\\$save_\$lt_var; \$lt_user_locale\"
lt_safe_locale=\"$lt_var=C; \$lt_safe_locale\"
fi"
done
LC_ALL=C
LANGUAGE=C
export LANGUAGE LC_ALL
$lt_unset CDPATH
# Work around backward compatibility issue on IRIX 6.5. On IRIX 6.4+, sh
# is ksh but when the shell is invoked as "sh" and the current value of
# the _XPG environment variable is not equal to 1 (one), the special
# positional parameter $0, within a function call, is the name of the
# function.
progpath="$0"
: ${CP="cp -f"}
test "${ECHO+set}" = set || ECHO=${as_echo-'printf %s\n'}
: ${MAKE="make"}
: ${MKDIR="mkdir"}
: ${MV="mv -f"}
: ${RM="rm -f"}
: ${SHELL="${CONFIG_SHELL-/bin/sh}"}
: ${Xsed="$SED -e 1s/^X//"}
# Global variables:
EXIT_SUCCESS=0
EXIT_FAILURE=1
EXIT_MISMATCH=63 # $? = 63 is used to indicate version mismatch to missing.
EXIT_SKIP=77 # $? = 77 is used to indicate a skipped test to automake.
exit_status=$EXIT_SUCCESS
# Make sure IFS has a sensible default
lt_nl='
'
IFS=" $lt_nl"
dirname="s,/[^/]*$,,"
basename="s,^.*/,,"
# func_dirname file append nondir_replacement
# Compute the dirname of FILE. If nonempty, add APPEND to the result,
# otherwise set result to NONDIR_REPLACEMENT.
func_dirname ()
{
func_dirname_result=`$ECHO "${1}" | $SED "$dirname"`
if test "X$func_dirname_result" = "X${1}"; then
func_dirname_result="${3}"
else
func_dirname_result="$func_dirname_result${2}"
fi
} # func_dirname may be replaced by extended shell implementation
# func_basename file
func_basename ()
{
func_basename_result=`$ECHO "${1}" | $SED "$basename"`
} # func_basename may be replaced by extended shell implementation
# func_dirname_and_basename file append nondir_replacement
# perform func_basename and func_dirname in a single function
# call:
# dirname: Compute the dirname of FILE. If nonempty,
# add APPEND to the result, otherwise set result
# to NONDIR_REPLACEMENT.
# value returned in "$func_dirname_result"
# basename: Compute filename of FILE.
# value retuned in "$func_basename_result"
# Implementation must be kept synchronized with func_dirname
# and func_basename. For efficiency, we do not delegate to
# those functions but instead duplicate the functionality here.
func_dirname_and_basename ()
{
# Extract subdirectory from the argument.
func_dirname_result=`$ECHO "${1}" | $SED -e "$dirname"`
if test "X$func_dirname_result" = "X${1}"; then
func_dirname_result="${3}"
else
func_dirname_result="$func_dirname_result${2}"
fi
func_basename_result=`$ECHO "${1}" | $SED -e "$basename"`
} # func_dirname_and_basename may be replaced by extended shell implementation
# func_stripname prefix suffix name
# strip PREFIX and SUFFIX off of NAME.
# PREFIX and SUFFIX must not contain globbing or regex special
# characters, hashes, percent signs, but SUFFIX may contain a leading
# dot (in which case that matches only a dot).
# func_strip_suffix prefix name
func_stripname ()
{
case ${2} in
.*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%\\\\${2}\$%%"`;;
*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%${2}\$%%"`;;
esac
} # func_stripname may be replaced by extended shell implementation
# These SED scripts presuppose an absolute path with a trailing slash.
pathcar='s,^/\([^/]*\).*$,\1,'
pathcdr='s,^/[^/]*,,'
removedotparts=':dotsl
s@/\./@/@g
t dotsl
s,/\.$,/,'
collapseslashes='s@/\{1,\}@/@g'
finalslash='s,/*$,/,'
# func_normal_abspath PATH
# Remove doubled-up and trailing slashes, "." path components,
# and cancel out any ".." path components in PATH after making
# it an absolute path.
# value returned in "$func_normal_abspath_result"
func_normal_abspath ()
{
# Start from root dir and reassemble the path.
func_normal_abspath_result=
func_normal_abspath_tpath=$1
func_normal_abspath_altnamespace=
case $func_normal_abspath_tpath in
"")
# Empty path, that just means $cwd.
func_stripname '' '/' "`pwd`"
func_normal_abspath_result=$func_stripname_result
return
;;
# The next three entries are used to spot a run of precisely
# two leading slashes without using negated character classes;
# we take advantage of case's first-match behaviour.
///*)
# Unusual form of absolute path, do nothing.
;;
//*)
# Not necessarily an ordinary path; POSIX reserves leading '//'
# and for example Cygwin uses it to access remote file shares
# over CIFS/SMB, so we conserve a leading double slash if found.
func_normal_abspath_altnamespace=/
;;
/*)
# Absolute path, do nothing.
;;
*)
# Relative path, prepend $cwd.
func_normal_abspath_tpath=`pwd`/$func_normal_abspath_tpath
;;
esac
# Cancel out all the simple stuff to save iterations. We also want
# the path to end with a slash for ease of parsing, so make sure
# there is one (and only one) here.
func_normal_abspath_tpath=`$ECHO "$func_normal_abspath_tpath" | $SED \
-e "$removedotparts" -e "$collapseslashes" -e "$finalslash"`
while :; do
# Processed it all yet?
if test "$func_normal_abspath_tpath" = / ; then
# If we ascended to the root using ".." the result may be empty now.
if test -z "$func_normal_abspath_result" ; then
func_normal_abspath_result=/
fi
break
fi
func_normal_abspath_tcomponent=`$ECHO "$func_normal_abspath_tpath" | $SED \
-e "$pathcar"`
func_normal_abspath_tpath=`$ECHO "$func_normal_abspath_tpath" | $SED \
-e "$pathcdr"`
# Figure out what to do with it
case $func_normal_abspath_tcomponent in
"")
# Trailing empty path component, ignore it.
;;
..)
# Parent dir; strip last assembled component from result.
func_dirname "$func_normal_abspath_result"
func_normal_abspath_result=$func_dirname_result
;;
*)
# Actual path component, append it.
func_normal_abspath_result=$func_normal_abspath_result/$func_normal_abspath_tcomponent
;;
esac
done
# Restore leading double-slash if one was found on entry.
func_normal_abspath_result=$func_normal_abspath_altnamespace$func_normal_abspath_result
}
# func_relative_path SRCDIR DSTDIR
# generates a relative path from SRCDIR to DSTDIR, with a trailing
# slash if non-empty, suitable for immediately appending a filename
# without needing to append a separator.
# value returned in "$func_relative_path_result"
func_relative_path ()
{
func_relative_path_result=
func_normal_abspath "$1"
func_relative_path_tlibdir=$func_normal_abspath_result
func_normal_abspath "$2"
func_relative_path_tbindir=$func_normal_abspath_result
# Ascend the tree starting from libdir
while :; do
# check if we have found a prefix of bindir
case $func_relative_path_tbindir in
$func_relative_path_tlibdir)
# found an exact match
func_relative_path_tcancelled=
break
;;
$func_relative_path_tlibdir*)
# found a matching prefix
func_stripname "$func_relative_path_tlibdir" '' "$func_relative_path_tbindir"
func_relative_path_tcancelled=$func_stripname_result
if test -z "$func_relative_path_result"; then
func_relative_path_result=.
fi
break
;;
*)
func_dirname $func_relative_path_tlibdir
func_relative_path_tlibdir=${func_dirname_result}
if test "x$func_relative_path_tlibdir" = x ; then
# Have to descend all the way to the root!
func_relative_path_result=../$func_relative_path_result
func_relative_path_tcancelled=$func_relative_path_tbindir
break
fi
func_relative_path_result=../$func_relative_path_result
;;
esac
done
# Now calculate path; take care to avoid doubling-up slashes.
func_stripname '' '/' "$func_relative_path_result"
func_relative_path_result=$func_stripname_result
func_stripname '/' '/' "$func_relative_path_tcancelled"
if test "x$func_stripname_result" != x ; then
func_relative_path_result=${func_relative_path_result}/${func_stripname_result}
fi
# Normalisation. If bindir is libdir, return empty string,
# else relative path ending with a slash; either way, target
# file name can be directly appended.
if test ! -z "$func_relative_path_result"; then
func_stripname './' '' "$func_relative_path_result/"
func_relative_path_result=$func_stripname_result
fi
}
# The name of this program:
func_dirname_and_basename "$progpath"
progname=$func_basename_result
# Make sure we have an absolute path for reexecution:
case $progpath in
[\\/]*|[A-Za-z]:\\*) ;;
*[\\/]*)
progdir=$func_dirname_result
progdir=`cd "$progdir" && pwd`
progpath="$progdir/$progname"
;;
*)
save_IFS="$IFS"
IFS=${PATH_SEPARATOR-:}
for progdir in $PATH; do
IFS="$save_IFS"
test -x "$progdir/$progname" && break
done
IFS="$save_IFS"
test -n "$progdir" || progdir=`pwd`
progpath="$progdir/$progname"
;;
esac
# Sed substitution that helps us do robust quoting. It backslashifies
# metacharacters that are still active within double-quoted strings.
Xsed="${SED}"' -e 1s/^X//'
sed_quote_subst='s/\([`"$\\]\)/\\\1/g'
# Same as above, but do not quote variable references.
double_quote_subst='s/\(["`\\]\)/\\\1/g'
# Sed substitution that turns a string into a regex matching for the
# string literally.
sed_make_literal_regex='s,[].[^$\\*\/],\\&,g'
# Sed substitution that converts a w32 file name or path
# which contains forward slashes, into one that contains
# (escaped) backslashes. A very naive implementation.
lt_sed_naive_backslashify='s|\\\\*|\\|g;s|/|\\|g;s|\\|\\\\|g'
# Re-`\' parameter expansions in output of double_quote_subst that were
# `\'-ed in input to the same. If an odd number of `\' preceded a '$'
# in input to double_quote_subst, that '$' was protected from expansion.
# Since each input `\' is now two `\'s, look for any number of runs of
# four `\'s followed by two `\'s and then a '$'. `\' that '$'.
bs='\\'
bs2='\\\\'
bs4='\\\\\\\\'
dollar='\$'
sed_double_backslash="\
s/$bs4/&\\
/g
s/^$bs2$dollar/$bs&/
s/\\([^$bs]\\)$bs2$dollar/\\1$bs2$bs$dollar/g
s/\n//g"
# Standard options:
opt_dry_run=false
opt_help=false
opt_quiet=false
opt_verbose=false
opt_warning=:
# func_echo arg...
# Echo program name prefixed message, along with the current mode
# name if it has been set yet.
func_echo ()
{
$ECHO "$progname: ${opt_mode+$opt_mode: }$*"
}
# func_verbose arg...
# Echo program name prefixed message in verbose mode only.
func_verbose ()
{
$opt_verbose && func_echo ${1+"$@"}
# A bug in bash halts the script if the last line of a function
# fails when set -e is in force, so we need another command to
# work around that:
:
}
# func_echo_all arg...
# Invoke $ECHO with all args, space-separated.
func_echo_all ()
{
$ECHO "$*"
}
# func_error arg...
# Echo program name prefixed message to standard error.
func_error ()
{
$ECHO "$progname: ${opt_mode+$opt_mode: }"${1+"$@"} 1>&2
}
# func_warning arg...
# Echo program name prefixed warning message to standard error.
func_warning ()
{
$opt_warning && $ECHO "$progname: ${opt_mode+$opt_mode: }warning: "${1+"$@"} 1>&2
# bash bug again:
:
}
# func_fatal_error arg...
# Echo program name prefixed message to standard error, and exit.
func_fatal_error ()
{
func_error ${1+"$@"}
exit $EXIT_FAILURE
}
# func_fatal_help arg...
# Echo program name prefixed message to standard error, followed by
# a help hint, and exit.
func_fatal_help ()
{
func_error ${1+"$@"}
func_fatal_error "$help"
}
help="Try \`$progname --help' for more information." ## default
# func_grep expression filename
# Check whether EXPRESSION matches any line of FILENAME, without output.
func_grep ()
{
$GREP "$1" "$2" >/dev/null 2>&1
}
# func_mkdir_p directory-path
# Make sure the entire path to DIRECTORY-PATH is available.
func_mkdir_p ()
{
my_directory_path="$1"
my_dir_list=
if test -n "$my_directory_path" && test "$opt_dry_run" != ":"; then
# Protect directory names starting with `-'
case $my_directory_path in
-*) my_directory_path="./$my_directory_path" ;;
esac
# While some portion of DIR does not yet exist...
while test ! -d "$my_directory_path"; do
# ...make a list in topmost first order. Use a colon delimited
# list incase some portion of path contains whitespace.
my_dir_list="$my_directory_path:$my_dir_list"
# If the last portion added has no slash in it, the list is done
case $my_directory_path in */*) ;; *) break ;; esac
# ...otherwise throw away the child directory and loop
my_directory_path=`$ECHO "$my_directory_path" | $SED -e "$dirname"`
done
my_dir_list=`$ECHO "$my_dir_list" | $SED 's,:*$,,'`
save_mkdir_p_IFS="$IFS"; IFS=':'
for my_dir in $my_dir_list; do
IFS="$save_mkdir_p_IFS"
# mkdir can fail with a `File exist' error if two processes
# try to create one of the directories concurrently. Don't
# stop in that case!
$MKDIR "$my_dir" 2>/dev/null || :
done
IFS="$save_mkdir_p_IFS"
# Bail out if we (or some other process) failed to create a directory.
test -d "$my_directory_path" || \
func_fatal_error "Failed to create \`$1'"
fi
}
# func_mktempdir [string]
# Make a temporary directory that won't clash with other running
# libtool processes, and avoids race conditions if possible. If
# given, STRING is the basename for that directory.
func_mktempdir ()
{
my_template="${TMPDIR-/tmp}/${1-$progname}"
if test "$opt_dry_run" = ":"; then
# Return a directory name, but don't create it in dry-run mode
my_tmpdir="${my_template}-$$"
else
# If mktemp works, use that first and foremost
my_tmpdir=`mktemp -d "${my_template}-XXXXXXXX" 2>/dev/null`
if test ! -d "$my_tmpdir"; then
# Failing that, at least try and use $RANDOM to avoid a race
my_tmpdir="${my_template}-${RANDOM-0}$$"
save_mktempdir_umask=`umask`
umask 0077
$MKDIR "$my_tmpdir"
umask $save_mktempdir_umask
fi
# If we're not in dry-run mode, bomb out on failure
test -d "$my_tmpdir" || \
func_fatal_error "cannot create temporary directory \`$my_tmpdir'"
fi
$ECHO "$my_tmpdir"
}
# func_quote_for_eval arg
# Aesthetically quote ARG to be evaled later.
# This function returns two values: FUNC_QUOTE_FOR_EVAL_RESULT
# is double-quoted, suitable for a subsequent eval, whereas
# FUNC_QUOTE_FOR_EVAL_UNQUOTED_RESULT has merely all characters
# which are still active within double quotes backslashified.
func_quote_for_eval ()
{
case $1 in
*[\\\`\"\$]*)
func_quote_for_eval_unquoted_result=`$ECHO "$1" | $SED "$sed_quote_subst"` ;;
*)
func_quote_for_eval_unquoted_result="$1" ;;
esac
case $func_quote_for_eval_unquoted_result in
# Double-quote args containing shell metacharacters to delay
# word splitting, command substitution and and variable
# expansion for a subsequent eval.
# Many Bourne shells cannot handle close brackets correctly
# in scan sets, so we specify it separately.
*[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
func_quote_for_eval_result="\"$func_quote_for_eval_unquoted_result\""
;;
*)
func_quote_for_eval_result="$func_quote_for_eval_unquoted_result"
esac
}
# func_quote_for_expand arg
# Aesthetically quote ARG to be evaled later; same as above,
# but do not quote variable references.
func_quote_for_expand ()
{
case $1 in
*[\\\`\"]*)
my_arg=`$ECHO "$1" | $SED \
-e "$double_quote_subst" -e "$sed_double_backslash"` ;;
*)
my_arg="$1" ;;
esac
case $my_arg in
# Double-quote args containing shell metacharacters to delay
# word splitting and command substitution for a subsequent eval.
# Many Bourne shells cannot handle close brackets correctly
# in scan sets, so we specify it separately.
*[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
my_arg="\"$my_arg\""
;;
esac
func_quote_for_expand_result="$my_arg"
}
# func_show_eval cmd [fail_exp]
# Unless opt_silent is true, then output CMD. Then, if opt_dryrun is
# not true, evaluate CMD. If the evaluation of CMD fails, and FAIL_EXP
# is given, then evaluate it.
func_show_eval ()
{
my_cmd="$1"
my_fail_exp="${2-:}"
${opt_silent-false} || {
func_quote_for_expand "$my_cmd"
eval "func_echo $func_quote_for_expand_result"
}
if ${opt_dry_run-false}; then :; else
eval "$my_cmd"
my_status=$?
if test "$my_status" -eq 0; then :; else
eval "(exit $my_status); $my_fail_exp"
fi
fi
}
# func_show_eval_locale cmd [fail_exp]
# Unless opt_silent is true, then output CMD. Then, if opt_dryrun is
# not true, evaluate CMD. If the evaluation of CMD fails, and FAIL_EXP
# is given, then evaluate it. Use the saved locale for evaluation.
func_show_eval_locale ()
{
my_cmd="$1"
my_fail_exp="${2-:}"
${opt_silent-false} || {
func_quote_for_expand "$my_cmd"
eval "func_echo $func_quote_for_expand_result"
}
if ${opt_dry_run-false}; then :; else
eval "$lt_user_locale
$my_cmd"
my_status=$?
eval "$lt_safe_locale"
if test "$my_status" -eq 0; then :; else
eval "(exit $my_status); $my_fail_exp"
fi
fi
}
# func_tr_sh
# Turn $1 into a string suitable for a shell variable name.
# Result is stored in $func_tr_sh_result. All characters
# not in the set a-zA-Z0-9_ are replaced with '_'. Further,
# if $1 begins with a digit, a '_' is prepended as well.
func_tr_sh ()
{
case $1 in
[0-9]* | *[!a-zA-Z0-9_]*)
func_tr_sh_result=`$ECHO "$1" | $SED 's/^\([0-9]\)/_\1/; s/[^a-zA-Z0-9_]/_/g'`
;;
* )
func_tr_sh_result=$1
;;
esac
}
# func_version
# Echo version message to standard output and exit.
func_version ()
{
$opt_debug
$SED -n '/(C)/!b go
:more
/\./!{
N
s/\n# / /
b more
}
:go
/^# '$PROGRAM' (GNU /,/# warranty; / {
s/^# //
s/^# *$//
s/\((C)\)[ 0-9,-]*\( [1-9][0-9]*\)/\1\2/
p
}' < "$progpath"
exit $?
}
# func_usage
# Echo short help message to standard output and exit.
func_usage ()
{
$opt_debug
$SED -n '/^# Usage:/,/^# *.*--help/ {
s/^# //
s/^# *$//
s/\$progname/'$progname'/
p
}' < "$progpath"
echo
$ECHO "run \`$progname --help | more' for full usage"
exit $?
}
# func_help [NOEXIT]
# Echo long help message to standard output and exit,
# unless 'noexit' is passed as argument.
func_help ()
{
$opt_debug
$SED -n '/^# Usage:/,/# Report bugs to/ {
:print
s/^# //
s/^# *$//
s*\$progname*'$progname'*
s*\$host*'"$host"'*
s*\$SHELL*'"$SHELL"'*
s*\$LTCC*'"$LTCC"'*
s*\$LTCFLAGS*'"$LTCFLAGS"'*
s*\$LD*'"$LD"'*
s/\$with_gnu_ld/'"$with_gnu_ld"'/
s/\$automake_version/'"`(${AUTOMAKE-automake} --version) 2>/dev/null |$SED 1q`"'/
s/\$autoconf_version/'"`(${AUTOCONF-autoconf} --version) 2>/dev/null |$SED 1q`"'/
p
d
}
/^# .* home page:/b print
/^# General help using/b print
' < "$progpath"
ret=$?
if test -z "$1"; then
exit $ret
fi
}
# func_missing_arg argname
# Echo program name prefixed message to standard error and set global
# exit_cmd.
func_missing_arg ()
{
$opt_debug
func_error "missing argument for $1."
exit_cmd=exit
}
# func_split_short_opt shortopt
# Set func_split_short_opt_name and func_split_short_opt_arg shell
# variables after splitting SHORTOPT after the 2nd character.
func_split_short_opt ()
{
my_sed_short_opt='1s/^\(..\).*$/\1/;q'
my_sed_short_rest='1s/^..\(.*\)$/\1/;q'
func_split_short_opt_name=`$ECHO "$1" | $SED "$my_sed_short_opt"`
func_split_short_opt_arg=`$ECHO "$1" | $SED "$my_sed_short_rest"`
} # func_split_short_opt may be replaced by extended shell implementation
# func_split_long_opt longopt
# Set func_split_long_opt_name and func_split_long_opt_arg shell
# variables after splitting LONGOPT at the `=' sign.
func_split_long_opt ()
{
my_sed_long_opt='1s/^\(--[^=]*\)=.*/\1/;q'
my_sed_long_arg='1s/^--[^=]*=//'
func_split_long_opt_name=`$ECHO "$1" | $SED "$my_sed_long_opt"`
func_split_long_opt_arg=`$ECHO "$1" | $SED "$my_sed_long_arg"`
} # func_split_long_opt may be replaced by extended shell implementation
exit_cmd=:
magic="%%%MAGIC variable%%%"
magic_exe="%%%MAGIC EXE variable%%%"
# Global variables.
nonopt=
preserve_args=
lo2o="s/\\.lo\$/.${objext}/"
o2lo="s/\\.${objext}\$/.lo/"
extracted_archives=
extracted_serial=0
# If this variable is set in any of the actions, the command in it
# will be execed at the end. This prevents here-documents from being
# left over by shells.
exec_cmd=
# func_append var value
# Append VALUE to the end of shell variable VAR.
func_append ()
{
eval "${1}=\$${1}\${2}"
} # func_append may be replaced by extended shell implementation
# func_append_quoted var value
# Quote VALUE and append to the end of shell variable VAR, separated
# by a space.
func_append_quoted ()
{
func_quote_for_eval "${2}"
eval "${1}=\$${1}\\ \$func_quote_for_eval_result"
} # func_append_quoted may be replaced by extended shell implementation
# func_arith arithmetic-term...
func_arith ()
{
func_arith_result=`expr "${@}"`
} # func_arith may be replaced by extended shell implementation
# func_len string
# STRING may not start with a hyphen.
func_len ()
{
func_len_result=`expr "${1}" : ".*" 2>/dev/null || echo $max_cmd_len`
} # func_len may be replaced by extended shell implementation
# func_lo2o object
func_lo2o ()
{
func_lo2o_result=`$ECHO "${1}" | $SED "$lo2o"`
} # func_lo2o may be replaced by extended shell implementation
# func_xform libobj-or-source
func_xform ()
{
func_xform_result=`$ECHO "${1}" | $SED 's/\.[^.]*$/.lo/'`
} # func_xform may be replaced by extended shell implementation
# func_fatal_configuration arg...
# Echo program name prefixed message to standard error, followed by
# a configuration failure hint, and exit.
func_fatal_configuration ()
{
func_error ${1+"$@"}
func_error "See the $PACKAGE documentation for more information."
func_fatal_error "Fatal configuration error."
}
# func_config
# Display the configuration for all the tags in this script.
func_config ()
{
re_begincf='^# ### BEGIN LIBTOOL'
re_endcf='^# ### END LIBTOOL'
# Default configuration.
$SED "1,/$re_begincf CONFIG/d;/$re_endcf CONFIG/,\$d" < "$progpath"
# Now print the configurations for the tags.
for tagname in $taglist; do
$SED -n "/$re_begincf TAG CONFIG: $tagname\$/,/$re_endcf TAG CONFIG: $tagname\$/p" < "$progpath"
done
exit $?
}
# func_features
# Display the features supported by this script.
func_features ()
{
echo "host: $host"
if test "$build_libtool_libs" = yes; then
echo "enable shared libraries"
else
echo "disable shared libraries"
fi
if test "$build_old_libs" = yes; then
echo "enable static libraries"
else
echo "disable static libraries"
fi
exit $?
}
# func_enable_tag tagname
# Verify that TAGNAME is valid, and either flag an error and exit, or
# enable the TAGNAME tag. We also add TAGNAME to the global $taglist
# variable here.
func_enable_tag ()
{
# Global variable:
tagname="$1"
re_begincf="^# ### BEGIN LIBTOOL TAG CONFIG: $tagname\$"
re_endcf="^# ### END LIBTOOL TAG CONFIG: $tagname\$"
sed_extractcf="/$re_begincf/,/$re_endcf/p"
# Validate tagname.
case $tagname in
*[!-_A-Za-z0-9,/]*)
func_fatal_error "invalid tag name: $tagname"
;;
esac
# Don't test for the "default" C tag, as we know it's
# there but not specially marked.
case $tagname in
CC) ;;
*)
if $GREP "$re_begincf" "$progpath" >/dev/null 2>&1; then
taglist="$taglist $tagname"
# Evaluate the configuration. Be careful to quote the path
# and the sed script, to avoid splitting on whitespace, but
# also don't use non-portable quotes within backquotes within
# quotes we have to do it in 2 steps:
extractedcf=`$SED -n -e "$sed_extractcf" < "$progpath"`
eval "$extractedcf"
else
func_error "ignoring unknown tag $tagname"
fi
;;
esac
}
# func_check_version_match
# Ensure that we are using m4 macros, and libtool script from the same
# release of libtool.
func_check_version_match ()
{
if test "$package_revision" != "$macro_revision"; then
if test "$VERSION" != "$macro_version"; then
if test -z "$macro_version"; then
cat >&2 <<_LT_EOF
$progname: Version mismatch error. This is $PACKAGE $VERSION, but the
$progname: definition of this LT_INIT comes from an older release.
$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION
$progname: and run autoconf again.
_LT_EOF
else
cat >&2 <<_LT_EOF
$progname: Version mismatch error. This is $PACKAGE $VERSION, but the
$progname: definition of this LT_INIT comes from $PACKAGE $macro_version.
$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION
$progname: and run autoconf again.
_LT_EOF
fi
else
cat >&2 <<_LT_EOF
$progname: Version mismatch error. This is $PACKAGE $VERSION, revision $package_revision,
$progname: but the definition of this LT_INIT comes from revision $macro_revision.
$progname: You should recreate aclocal.m4 with macros from revision $package_revision
$progname: of $PACKAGE $VERSION and run autoconf again.
_LT_EOF
fi
exit $EXIT_MISMATCH
fi
}
# Shorthand for --mode=foo, only valid as the first argument
case $1 in
clean|clea|cle|cl)
shift; set dummy --mode clean ${1+"$@"}; shift
;;
compile|compil|compi|comp|com|co|c)
shift; set dummy --mode compile ${1+"$@"}; shift
;;
execute|execut|execu|exec|exe|ex|e)
shift; set dummy --mode execute ${1+"$@"}; shift
;;
finish|finis|fini|fin|fi|f)
shift; set dummy --mode finish ${1+"$@"}; shift
;;
install|instal|insta|inst|ins|in|i)
shift; set dummy --mode install ${1+"$@"}; shift
;;
link|lin|li|l)
shift; set dummy --mode link ${1+"$@"}; shift
;;
uninstall|uninstal|uninsta|uninst|unins|unin|uni|un|u)
shift; set dummy --mode uninstall ${1+"$@"}; shift
;;
esac
# Option defaults:
opt_debug=:
opt_dry_run=false
opt_config=false
opt_preserve_dup_deps=false
opt_features=false
opt_finish=false
opt_help=false
opt_help_all=false
opt_silent=:
opt_warning=:
opt_verbose=:
opt_silent=false
opt_verbose=false
# Parse options once, thoroughly. This comes as soon as possible in the
# script to make things like `--version' happen as quickly as we can.
{
# this just eases exit handling
while test $# -gt 0; do
opt="$1"
shift
case $opt in
--debug|-x) opt_debug='set -x'
func_echo "enabling shell trace mode"
$opt_debug
;;
--dry-run|--dryrun|-n)
opt_dry_run=:
;;
--config)
opt_config=:
func_config
;;
--dlopen|-dlopen)
optarg="$1"
opt_dlopen="${opt_dlopen+$opt_dlopen
}$optarg"
shift
;;
--preserve-dup-deps)
opt_preserve_dup_deps=:
;;
--features)
opt_features=:
func_features
;;
--finish)
opt_finish=:
set dummy --mode finish ${1+"$@"}; shift
;;
--help)
opt_help=:
;;
--help-all)
opt_help_all=:
opt_help=': help-all'
;;
--mode)
test $# = 0 && func_missing_arg $opt && break
optarg="$1"
opt_mode="$optarg"
case $optarg in
# Valid mode arguments:
clean|compile|execute|finish|install|link|relink|uninstall) ;;
# Catch anything else as an error
*) func_error "invalid argument for $opt"
exit_cmd=exit
break
;;
esac
shift
;;
--no-silent|--no-quiet)
opt_silent=false
func_append preserve_args " $opt"
;;
--no-warning|--no-warn)
opt_warning=false
func_append preserve_args " $opt"
;;
--no-verbose)
opt_verbose=false
func_append preserve_args " $opt"
;;
--silent|--quiet)
opt_silent=:
func_append preserve_args " $opt"
opt_verbose=false
;;
--verbose|-v)
opt_verbose=:
func_append preserve_args " $opt"
opt_silent=false
;;
--tag)
test $# = 0 && func_missing_arg $opt && break
optarg="$1"
opt_tag="$optarg"
func_append preserve_args " $opt $optarg"
func_enable_tag "$optarg"
shift
;;
-\?|-h) func_usage ;;
--help) func_help ;;
--version) func_version ;;
# Separate optargs to long options:
--*=*)
func_split_long_opt "$opt"
set dummy "$func_split_long_opt_name" "$func_split_long_opt_arg" ${1+"$@"}
shift
;;
# Separate non-argument short options:
-\?*|-h*|-n*|-v*)
func_split_short_opt "$opt"
set dummy "$func_split_short_opt_name" "-$func_split_short_opt_arg" ${1+"$@"}
shift
;;
--) break ;;
-*) func_fatal_help "unrecognized option \`$opt'" ;;
*) set dummy "$opt" ${1+"$@"}; shift; break ;;
esac
done
# Validate options:
# save first non-option argument
if test "$#" -gt 0; then
nonopt="$opt"
shift
fi
# preserve --debug
test "$opt_debug" = : || func_append preserve_args " --debug"
case $host in
*cygwin* | *mingw* | *pw32* | *cegcc*)
# don't eliminate duplications in $postdeps and $predeps
opt_duplicate_compiler_generated_deps=:
;;
*)
opt_duplicate_compiler_generated_deps=$opt_preserve_dup_deps
;;
esac
$opt_help || {
# Sanity checks first:
func_check_version_match
if test "$build_libtool_libs" != yes && test "$build_old_libs" != yes; then
func_fatal_configuration "not configured to build any kind of library"
fi
# Darwin sucks
eval std_shrext=\"$shrext_cmds\"
# Only execute mode is allowed to have -dlopen flags.
if test -n "$opt_dlopen" && test "$opt_mode" != execute; then
func_error "unrecognized option \`-dlopen'"
$ECHO "$help" 1>&2
exit $EXIT_FAILURE
fi
# Change the help message to a mode-specific one.
generic_help="$help"
help="Try \`$progname --help --mode=$opt_mode' for more information."
}
# Bail if the options were screwed
$exit_cmd $EXIT_FAILURE
}
## ----------- ##
## Main. ##
## ----------- ##
# func_lalib_p file
# True iff FILE is a libtool `.la' library or `.lo' object file.
# This function is only a basic sanity check; it will hardly flush out
# determined imposters.
func_lalib_p ()
{
test -f "$1" &&
$SED -e 4q "$1" 2>/dev/null \
| $GREP "^# Generated by .*$PACKAGE" > /dev/null 2>&1
}
# func_lalib_unsafe_p file
# True iff FILE is a libtool `.la' library or `.lo' object file.
# This function implements the same check as func_lalib_p without
# resorting to external programs. To this end, it redirects stdin and
# closes it afterwards, without saving the original file descriptor.
# As a safety measure, use it only where a negative result would be
# fatal anyway. Works if `file' does not exist.
func_lalib_unsafe_p ()
{
lalib_p=no
if test -f "$1" && test -r "$1" && exec 5<&0 <"$1"; then
for lalib_p_l in 1 2 3 4
do
read lalib_p_line
case "$lalib_p_line" in
\#\ Generated\ by\ *$PACKAGE* ) lalib_p=yes; break;;
esac
done
exec 0<&5 5<&-
fi
test "$lalib_p" = yes
}
# func_ltwrapper_script_p file
# True iff FILE is a libtool wrapper script
# This function is only a basic sanity check; it will hardly flush out
# determined imposters.
func_ltwrapper_script_p ()
{
func_lalib_p "$1"
}
# func_ltwrapper_executable_p file
# True iff FILE is a libtool wrapper executable
# This function is only a basic sanity check; it will hardly flush out
# determined imposters.
func_ltwrapper_executable_p ()
{
func_ltwrapper_exec_suffix=
case $1 in
*.exe) ;;
*) func_ltwrapper_exec_suffix=.exe ;;
esac
$GREP "$magic_exe" "$1$func_ltwrapper_exec_suffix" >/dev/null 2>&1
}
# func_ltwrapper_scriptname file
# Assumes file is an ltwrapper_executable
# uses $file to determine the appropriate filename for a
# temporary ltwrapper_script.
func_ltwrapper_scriptname ()
{
func_dirname_and_basename "$1" "" "."
func_stripname '' '.exe' "$func_basename_result"
func_ltwrapper_scriptname_result="$func_dirname_result/$objdir/${func_stripname_result}_ltshwrapper"
}
# func_ltwrapper_p file
# True iff FILE is a libtool wrapper script or wrapper executable
# This function is only a basic sanity check; it will hardly flush out
# determined imposters.
func_ltwrapper_p ()
{
func_ltwrapper_script_p "$1" || func_ltwrapper_executable_p "$1"
}
# func_execute_cmds commands fail_cmd
# Execute tilde-delimited COMMANDS.
# If FAIL_CMD is given, eval that upon failure.
# FAIL_CMD may read-access the current command in variable CMD!
func_execute_cmds ()
{
$opt_debug
save_ifs=$IFS; IFS='~'
for cmd in $1; do
IFS=$save_ifs
eval cmd=\"$cmd\"
func_show_eval "$cmd" "${2-:}"
done
IFS=$save_ifs
}
# func_source file
# Source FILE, adding directory component if necessary.
# Note that it is not necessary on cygwin/mingw to append a dot to
# FILE even if both FILE and FILE.exe exist: automatic-append-.exe
# behavior happens only for exec(3), not for open(2)! Also, sourcing
# `FILE.' does not work on cygwin managed mounts.
func_source ()
{
$opt_debug
case $1 in
*/* | *\\*) . "$1" ;;
*) . "./$1" ;;
esac
}
# func_resolve_sysroot PATH
# Replace a leading = in PATH with a sysroot. Store the result into
# func_resolve_sysroot_result
func_resolve_sysroot ()
{
func_resolve_sysroot_result=$1
case $func_resolve_sysroot_result in
=*)
func_stripname '=' '' "$func_resolve_sysroot_result"
func_resolve_sysroot_result=$lt_sysroot$func_stripname_result
;;
esac
}
# func_replace_sysroot PATH
# If PATH begins with the sysroot, replace it with = and
# store the result into func_replace_sysroot_result.
func_replace_sysroot ()
{
case "$lt_sysroot:$1" in
?*:"$lt_sysroot"*)
func_stripname "$lt_sysroot" '' "$1"
func_replace_sysroot_result="=$func_stripname_result"
;;
*)
# Including no sysroot.
func_replace_sysroot_result=$1
;;
esac
}
# func_infer_tag arg
# Infer tagged configuration to use if any are available and
# if one wasn't chosen via the "--tag" command line option.
# Only attempt this if the compiler in the base compile
# command doesn't match the default compiler.
# arg is usually of the form 'gcc ...'
func_infer_tag ()
{
$opt_debug
if test -n "$available_tags" && test -z "$tagname"; then
CC_quoted=
for arg in $CC; do
func_append_quoted CC_quoted "$arg"
done
CC_expanded=`func_echo_all $CC`
CC_quoted_expanded=`func_echo_all $CC_quoted`
case $@ in
# Blanks in the command may have been stripped by the calling shell,
# but not from the CC environment variable when configure was run.
" $CC "* | "$CC "* | " $CC_expanded "* | "$CC_expanded "* | \
" $CC_quoted"* | "$CC_quoted "* | " $CC_quoted_expanded "* | "$CC_quoted_expanded "*) ;;
# Blanks at the start of $base_compile will cause this to fail
# if we don't check for them as well.
*)
for z in $available_tags; do
if $GREP "^# ### BEGIN LIBTOOL TAG CONFIG: $z$" < "$progpath" > /dev/null; then
# Evaluate the configuration.
eval "`${SED} -n -e '/^# ### BEGIN LIBTOOL TAG CONFIG: '$z'$/,/^# ### END LIBTOOL TAG CONFIG: '$z'$/p' < $progpath`"
CC_quoted=
for arg in $CC; do
# Double-quote args containing other shell metacharacters.
func_append_quoted CC_quoted "$arg"
done
CC_expanded=`func_echo_all $CC`
CC_quoted_expanded=`func_echo_all $CC_quoted`
case "$@ " in
" $CC "* | "$CC "* | " $CC_expanded "* | "$CC_expanded "* | \
" $CC_quoted"* | "$CC_quoted "* | " $CC_quoted_expanded "* | "$CC_quoted_expanded "*)
# The compiler in the base compile command matches
# the one in the tagged configuration.
# Assume this is the tagged configuration we want.
tagname=$z
break
;;
esac
fi
done
# If $tagname still isn't set, then no tagged configuration
# was found and let the user know that the "--tag" command
# line option must be used.
if test -z "$tagname"; then
func_echo "unable to infer tagged configuration"
func_fatal_error "specify a tag with \`--tag'"
# else
# func_verbose "using $tagname tagged configuration"
fi
;;
esac
fi
}
# func_write_libtool_object output_name pic_name nonpic_name
# Create a libtool object file (analogous to a ".la" file),
# but don't create it if we're doing a dry run.
func_write_libtool_object ()
{
write_libobj=${1}
if test "$build_libtool_libs" = yes; then
write_lobj=\'${2}\'
else
write_lobj=none
fi
if test "$build_old_libs" = yes; then
write_oldobj=\'${3}\'
else
write_oldobj=none
fi
$opt_dry_run || {
cat >${write_libobj}T </dev/null`
if test "$?" -eq 0 && test -n "${func_convert_core_file_wine_to_w32_tmp}"; then
func_convert_core_file_wine_to_w32_result=`$ECHO "$func_convert_core_file_wine_to_w32_tmp" |
$SED -e "$lt_sed_naive_backslashify"`
else
func_convert_core_file_wine_to_w32_result=
fi
fi
}
# end: func_convert_core_file_wine_to_w32
# func_convert_core_path_wine_to_w32 ARG
# Helper function used by path conversion functions when $build is *nix, and
# $host is mingw, cygwin, or some other w32 environment. Relies on a correctly
# configured wine environment available, with the winepath program in $build's
# $PATH. Assumes ARG has no leading or trailing path separator characters.
#
# ARG is path to be converted from $build format to win32.
# Result is available in $func_convert_core_path_wine_to_w32_result.
# Unconvertible file (directory) names in ARG are skipped; if no directory names
# are convertible, then the result may be empty.
func_convert_core_path_wine_to_w32 ()
{
$opt_debug
# unfortunately, winepath doesn't convert paths, only file names
func_convert_core_path_wine_to_w32_result=""
if test -n "$1"; then
oldIFS=$IFS
IFS=:
for func_convert_core_path_wine_to_w32_f in $1; do
IFS=$oldIFS
func_convert_core_file_wine_to_w32 "$func_convert_core_path_wine_to_w32_f"
if test -n "$func_convert_core_file_wine_to_w32_result" ; then
if test -z "$func_convert_core_path_wine_to_w32_result"; then
func_convert_core_path_wine_to_w32_result="$func_convert_core_file_wine_to_w32_result"
else
func_append func_convert_core_path_wine_to_w32_result ";$func_convert_core_file_wine_to_w32_result"
fi
fi
done
IFS=$oldIFS
fi
}
# end: func_convert_core_path_wine_to_w32
# func_cygpath ARGS...
# Wrapper around calling the cygpath program via LT_CYGPATH. This is used when
# when (1) $build is *nix and Cygwin is hosted via a wine environment; or (2)
# $build is MSYS and $host is Cygwin, or (3) $build is Cygwin. In case (1) or
# (2), returns the Cygwin file name or path in func_cygpath_result (input
# file name or path is assumed to be in w32 format, as previously converted
# from $build's *nix or MSYS format). In case (3), returns the w32 file name
# or path in func_cygpath_result (input file name or path is assumed to be in
# Cygwin format). Returns an empty string on error.
#
# ARGS are passed to cygpath, with the last one being the file name or path to
# be converted.
#
# Specify the absolute *nix (or w32) name to cygpath in the LT_CYGPATH
# environment variable; do not put it in $PATH.
func_cygpath ()
{
$opt_debug
if test -n "$LT_CYGPATH" && test -f "$LT_CYGPATH"; then
func_cygpath_result=`$LT_CYGPATH "$@" 2>/dev/null`
if test "$?" -ne 0; then
# on failure, ensure result is empty
func_cygpath_result=
fi
else
func_cygpath_result=
func_error "LT_CYGPATH is empty or specifies non-existent file: \`$LT_CYGPATH'"
fi
}
#end: func_cygpath
# func_convert_core_msys_to_w32 ARG
# Convert file name or path ARG from MSYS format to w32 format. Return
# result in func_convert_core_msys_to_w32_result.
func_convert_core_msys_to_w32 ()
{
$opt_debug
# awkward: cmd appends spaces to result
func_convert_core_msys_to_w32_result=`( cmd //c echo "$1" ) 2>/dev/null |
$SED -e 's/[ ]*$//' -e "$lt_sed_naive_backslashify"`
}
#end: func_convert_core_msys_to_w32
# func_convert_file_check ARG1 ARG2
# Verify that ARG1 (a file name in $build format) was converted to $host
# format in ARG2. Otherwise, emit an error message, but continue (resetting
# func_to_host_file_result to ARG1).
func_convert_file_check ()
{
$opt_debug
if test -z "$2" && test -n "$1" ; then
func_error "Could not determine host file name corresponding to"
func_error " \`$1'"
func_error "Continuing, but uninstalled executables may not work."
# Fallback:
func_to_host_file_result="$1"
fi
}
# end func_convert_file_check
# func_convert_path_check FROM_PATHSEP TO_PATHSEP FROM_PATH TO_PATH
# Verify that FROM_PATH (a path in $build format) was converted to $host
# format in TO_PATH. Otherwise, emit an error message, but continue, resetting
# func_to_host_file_result to a simplistic fallback value (see below).
func_convert_path_check ()
{
$opt_debug
if test -z "$4" && test -n "$3"; then
func_error "Could not determine the host path corresponding to"
func_error " \`$3'"
func_error "Continuing, but uninstalled executables may not work."
# Fallback. This is a deliberately simplistic "conversion" and
# should not be "improved". See libtool.info.
if test "x$1" != "x$2"; then
lt_replace_pathsep_chars="s|$1|$2|g"
func_to_host_path_result=`echo "$3" |
$SED -e "$lt_replace_pathsep_chars"`
else
func_to_host_path_result="$3"
fi
fi
}
# end func_convert_path_check
# func_convert_path_front_back_pathsep FRONTPAT BACKPAT REPL ORIG
# Modifies func_to_host_path_result by prepending REPL if ORIG matches FRONTPAT
# and appending REPL if ORIG matches BACKPAT.
func_convert_path_front_back_pathsep ()
{
$opt_debug
case $4 in
$1 ) func_to_host_path_result="$3$func_to_host_path_result"
;;
esac
case $4 in
$2 ) func_append func_to_host_path_result "$3"
;;
esac
}
# end func_convert_path_front_back_pathsep
##################################################
# $build to $host FILE NAME CONVERSION FUNCTIONS #
##################################################
# invoked via `$to_host_file_cmd ARG'
#
# In each case, ARG is the path to be converted from $build to $host format.
# Result will be available in $func_to_host_file_result.
# func_to_host_file ARG
# Converts the file name ARG from $build format to $host format. Return result
# in func_to_host_file_result.
func_to_host_file ()
{
$opt_debug
$to_host_file_cmd "$1"
}
# end func_to_host_file
# func_to_tool_file ARG LAZY
# converts the file name ARG from $build format to toolchain format. Return
# result in func_to_tool_file_result. If the conversion in use is listed
# in (the comma separated) LAZY, no conversion takes place.
func_to_tool_file ()
{
$opt_debug
case ,$2, in
*,"$to_tool_file_cmd",*)
func_to_tool_file_result=$1
;;
*)
$to_tool_file_cmd "$1"
func_to_tool_file_result=$func_to_host_file_result
;;
esac
}
# end func_to_tool_file
# func_convert_file_noop ARG
# Copy ARG to func_to_host_file_result.
func_convert_file_noop ()
{
func_to_host_file_result="$1"
}
# end func_convert_file_noop
# func_convert_file_msys_to_w32 ARG
# Convert file name ARG from (mingw) MSYS to (mingw) w32 format; automatic
# conversion to w32 is not available inside the cwrapper. Returns result in
# func_to_host_file_result.
func_convert_file_msys_to_w32 ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
func_convert_core_msys_to_w32 "$1"
func_to_host_file_result="$func_convert_core_msys_to_w32_result"
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_msys_to_w32
# func_convert_file_cygwin_to_w32 ARG
# Convert file name ARG from Cygwin to w32 format. Returns result in
# func_to_host_file_result.
func_convert_file_cygwin_to_w32 ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
# because $build is cygwin, we call "the" cygpath in $PATH; no need to use
# LT_CYGPATH in this case.
func_to_host_file_result=`cygpath -m "$1"`
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_cygwin_to_w32
# func_convert_file_nix_to_w32 ARG
# Convert file name ARG from *nix to w32 format. Requires a wine environment
# and a working winepath. Returns result in func_to_host_file_result.
func_convert_file_nix_to_w32 ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
func_convert_core_file_wine_to_w32 "$1"
func_to_host_file_result="$func_convert_core_file_wine_to_w32_result"
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_nix_to_w32
# func_convert_file_msys_to_cygwin ARG
# Convert file name ARG from MSYS to Cygwin format. Requires LT_CYGPATH set.
# Returns result in func_to_host_file_result.
func_convert_file_msys_to_cygwin ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
func_convert_core_msys_to_w32 "$1"
func_cygpath -u "$func_convert_core_msys_to_w32_result"
func_to_host_file_result="$func_cygpath_result"
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_msys_to_cygwin
# func_convert_file_nix_to_cygwin ARG
# Convert file name ARG from *nix to Cygwin format. Requires Cygwin installed
# in a wine environment, working winepath, and LT_CYGPATH set. Returns result
# in func_to_host_file_result.
func_convert_file_nix_to_cygwin ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
# convert from *nix to w32, then use cygpath to convert from w32 to cygwin.
func_convert_core_file_wine_to_w32 "$1"
func_cygpath -u "$func_convert_core_file_wine_to_w32_result"
func_to_host_file_result="$func_cygpath_result"
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_nix_to_cygwin
#############################################
# $build to $host PATH CONVERSION FUNCTIONS #
#############################################
# invoked via `$to_host_path_cmd ARG'
#
# In each case, ARG is the path to be converted from $build to $host format.
# The result will be available in $func_to_host_path_result.
#
# Path separators are also converted from $build format to $host format. If
# ARG begins or ends with a path separator character, it is preserved (but
# converted to $host format) on output.
#
# All path conversion functions are named using the following convention:
# file name conversion function : func_convert_file_X_to_Y ()
# path conversion function : func_convert_path_X_to_Y ()
# where, for any given $build/$host combination the 'X_to_Y' value is the
# same. If conversion functions are added for new $build/$host combinations,
# the two new functions must follow this pattern, or func_init_to_host_path_cmd
# will break.
# func_init_to_host_path_cmd
# Ensures that function "pointer" variable $to_host_path_cmd is set to the
# appropriate value, based on the value of $to_host_file_cmd.
to_host_path_cmd=
func_init_to_host_path_cmd ()
{
$opt_debug
if test -z "$to_host_path_cmd"; then
func_stripname 'func_convert_file_' '' "$to_host_file_cmd"
to_host_path_cmd="func_convert_path_${func_stripname_result}"
fi
}
# func_to_host_path ARG
# Converts the path ARG from $build format to $host format. Return result
# in func_to_host_path_result.
func_to_host_path ()
{
$opt_debug
func_init_to_host_path_cmd
$to_host_path_cmd "$1"
}
# end func_to_host_path
# func_convert_path_noop ARG
# Copy ARG to func_to_host_path_result.
func_convert_path_noop ()
{
func_to_host_path_result="$1"
}
# end func_convert_path_noop
# func_convert_path_msys_to_w32 ARG
# Convert path ARG from (mingw) MSYS to (mingw) w32 format; automatic
# conversion to w32 is not available inside the cwrapper. Returns result in
# func_to_host_path_result.
func_convert_path_msys_to_w32 ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# Remove leading and trailing path separator characters from ARG. MSYS
# behavior is inconsistent here; cygpath turns them into '.;' and ';.';
# and winepath ignores them completely.
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_convert_core_msys_to_w32 "$func_to_host_path_tmp1"
func_to_host_path_result="$func_convert_core_msys_to_w32_result"
func_convert_path_check : ";" \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
fi
}
# end func_convert_path_msys_to_w32
# func_convert_path_cygwin_to_w32 ARG
# Convert path ARG from Cygwin to w32 format. Returns result in
# func_to_host_file_result.
func_convert_path_cygwin_to_w32 ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# See func_convert_path_msys_to_w32:
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_to_host_path_result=`cygpath -m -p "$func_to_host_path_tmp1"`
func_convert_path_check : ";" \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
fi
}
# end func_convert_path_cygwin_to_w32
# func_convert_path_nix_to_w32 ARG
# Convert path ARG from *nix to w32 format. Requires a wine environment and
# a working winepath. Returns result in func_to_host_file_result.
func_convert_path_nix_to_w32 ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# See func_convert_path_msys_to_w32:
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_convert_core_path_wine_to_w32 "$func_to_host_path_tmp1"
func_to_host_path_result="$func_convert_core_path_wine_to_w32_result"
func_convert_path_check : ";" \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
fi
}
# end func_convert_path_nix_to_w32
# func_convert_path_msys_to_cygwin ARG
# Convert path ARG from MSYS to Cygwin format. Requires LT_CYGPATH set.
# Returns result in func_to_host_file_result.
func_convert_path_msys_to_cygwin ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# See func_convert_path_msys_to_w32:
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_convert_core_msys_to_w32 "$func_to_host_path_tmp1"
func_cygpath -u -p "$func_convert_core_msys_to_w32_result"
func_to_host_path_result="$func_cygpath_result"
func_convert_path_check : : \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" : "$1"
fi
}
# end func_convert_path_msys_to_cygwin
# func_convert_path_nix_to_cygwin ARG
# Convert path ARG from *nix to Cygwin format. Requires Cygwin installed in a
# a wine environment, working winepath, and LT_CYGPATH set. Returns result in
# func_to_host_file_result.
func_convert_path_nix_to_cygwin ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# Remove leading and trailing path separator characters from
# ARG. msys behavior is inconsistent here, cygpath turns them
# into '.;' and ';.', and winepath ignores them completely.
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_convert_core_path_wine_to_w32 "$func_to_host_path_tmp1"
func_cygpath -u -p "$func_convert_core_path_wine_to_w32_result"
func_to_host_path_result="$func_cygpath_result"
func_convert_path_check : : \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" : "$1"
fi
}
# end func_convert_path_nix_to_cygwin
# func_mode_compile arg...
func_mode_compile ()
{
$opt_debug
# Get the compilation command and the source file.
base_compile=
srcfile="$nonopt" # always keep a non-empty value in "srcfile"
suppress_opt=yes
suppress_output=
arg_mode=normal
libobj=
later=
pie_flag=
for arg
do
case $arg_mode in
arg )
# do not "continue". Instead, add this to base_compile
lastarg="$arg"
arg_mode=normal
;;
target )
libobj="$arg"
arg_mode=normal
continue
;;
normal )
# Accept any command-line options.
case $arg in
-o)
test -n "$libobj" && \
func_fatal_error "you cannot specify \`-o' more than once"
arg_mode=target
continue
;;
-pie | -fpie | -fPIE)
func_append pie_flag " $arg"
continue
;;
-shared | -static | -prefer-pic | -prefer-non-pic)
func_append later " $arg"
continue
;;
-no-suppress)
suppress_opt=no
continue
;;
-Xcompiler)
arg_mode=arg # the next one goes into the "base_compile" arg list
continue # The current "srcfile" will either be retained or
;; # replaced later. I would guess that would be a bug.
-Wc,*)
func_stripname '-Wc,' '' "$arg"
args=$func_stripname_result
lastarg=
save_ifs="$IFS"; IFS=','
for arg in $args; do
IFS="$save_ifs"
func_append_quoted lastarg "$arg"
done
IFS="$save_ifs"
func_stripname ' ' '' "$lastarg"
lastarg=$func_stripname_result
# Add the arguments to base_compile.
func_append base_compile " $lastarg"
continue
;;
*)
# Accept the current argument as the source file.
# The previous "srcfile" becomes the current argument.
#
lastarg="$srcfile"
srcfile="$arg"
;;
esac # case $arg
;;
esac # case $arg_mode
# Aesthetically quote the previous argument.
func_append_quoted base_compile "$lastarg"
done # for arg
case $arg_mode in
arg)
func_fatal_error "you must specify an argument for -Xcompile"
;;
target)
func_fatal_error "you must specify a target with \`-o'"
;;
*)
# Get the name of the library object.
test -z "$libobj" && {
func_basename "$srcfile"
libobj="$func_basename_result"
}
;;
esac
# Recognize several different file suffixes.
# If the user specifies -o file.o, it is replaced with file.lo
case $libobj in
*.[cCFSifmso] | \
*.ada | *.adb | *.ads | *.asm | \
*.c++ | *.cc | *.ii | *.class | *.cpp | *.cxx | \
*.[fF][09]? | *.for | *.java | *.go | *.obj | *.sx | *.cu | *.cup)
func_xform "$libobj"
libobj=$func_xform_result
;;
esac
case $libobj in
*.lo) func_lo2o "$libobj"; obj=$func_lo2o_result ;;
*)
func_fatal_error "cannot determine name of library object from \`$libobj'"
;;
esac
func_infer_tag $base_compile
for arg in $later; do
case $arg in
-shared)
test "$build_libtool_libs" != yes && \
func_fatal_configuration "can not build a shared library"
build_old_libs=no
continue
;;
-static)
build_libtool_libs=no
build_old_libs=yes
continue
;;
-prefer-pic)
pic_mode=yes
continue
;;
-prefer-non-pic)
pic_mode=no
continue
;;
esac
done
func_quote_for_eval "$libobj"
test "X$libobj" != "X$func_quote_for_eval_result" \
&& $ECHO "X$libobj" | $GREP '[]~#^*{};<>?"'"'"' &()|`$[]' \
&& func_warning "libobj name \`$libobj' may not contain shell special characters."
func_dirname_and_basename "$obj" "/" ""
objname="$func_basename_result"
xdir="$func_dirname_result"
lobj=${xdir}$objdir/$objname
test -z "$base_compile" && \
func_fatal_help "you must specify a compilation command"
# Delete any leftover library objects.
if test "$build_old_libs" = yes; then
removelist="$obj $lobj $libobj ${libobj}T"
else
removelist="$lobj $libobj ${libobj}T"
fi
# On Cygwin there's no "real" PIC flag so we must build both object types
case $host_os in
cygwin* | mingw* | pw32* | os2* | cegcc*)
pic_mode=default
;;
esac
if test "$pic_mode" = no && test "$deplibs_check_method" != pass_all; then
# non-PIC code in shared libraries is not supported
pic_mode=default
fi
# Calculate the filename of the output object if compiler does
# not support -o with -c
if test "$compiler_c_o" = no; then
output_obj=`$ECHO "$srcfile" | $SED 's%^.*/%%; s%\.[^.]*$%%'`.${objext}
lockfile="$output_obj.lock"
else
output_obj=
need_locks=no
lockfile=
fi
# Lock this critical section if it is needed
# We use this script file to make the link, it avoids creating a new file
if test "$need_locks" = yes; then
until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do
func_echo "Waiting for $lockfile to be removed"
sleep 2
done
elif test "$need_locks" = warn; then
if test -f "$lockfile"; then
$ECHO "\
*** ERROR, $lockfile exists and contains:
`cat $lockfile 2>/dev/null`
This indicates that another process is trying to use the same
temporary object file, and libtool could not work around it because
your compiler does not support \`-c' and \`-o' together. If you
repeat this compilation, it may succeed, by chance, but you had better
avoid parallel builds (make -j) in this platform, or get a better
compiler."
$opt_dry_run || $RM $removelist
exit $EXIT_FAILURE
fi
func_append removelist " $output_obj"
$ECHO "$srcfile" > "$lockfile"
fi
$opt_dry_run || $RM $removelist
func_append removelist " $lockfile"
trap '$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE' 1 2 15
func_to_tool_file "$srcfile" func_convert_file_msys_to_w32
srcfile=$func_to_tool_file_result
func_quote_for_eval "$srcfile"
qsrcfile=$func_quote_for_eval_result
# Only build a PIC object if we are building libtool libraries.
if test "$build_libtool_libs" = yes; then
# Without this assignment, base_compile gets emptied.
fbsd_hideous_sh_bug=$base_compile
if test "$pic_mode" != no; then
command="$base_compile $qsrcfile $pic_flag"
else
# Don't build PIC code
command="$base_compile $qsrcfile"
fi
func_mkdir_p "$xdir$objdir"
if test -z "$output_obj"; then
# Place PIC objects in $objdir
func_append command " -o $lobj"
fi
func_show_eval_locale "$command" \
'test -n "$output_obj" && $RM $removelist; exit $EXIT_FAILURE'
if test "$need_locks" = warn &&
test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then
$ECHO "\
*** ERROR, $lockfile contains:
`cat $lockfile 2>/dev/null`
but it should contain:
$srcfile
This indicates that another process is trying to use the same
temporary object file, and libtool could not work around it because
your compiler does not support \`-c' and \`-o' together. If you
repeat this compilation, it may succeed, by chance, but you had better
avoid parallel builds (make -j) in this platform, or get a better
compiler."
$opt_dry_run || $RM $removelist
exit $EXIT_FAILURE
fi
# Just move the object if needed, then go on to compile the next one
if test -n "$output_obj" && test "X$output_obj" != "X$lobj"; then
func_show_eval '$MV "$output_obj" "$lobj"' \
'error=$?; $opt_dry_run || $RM $removelist; exit $error'
fi
# Allow error messages only from the first compilation.
if test "$suppress_opt" = yes; then
suppress_output=' >/dev/null 2>&1'
fi
fi
# Only build a position-dependent object if we build old libraries.
if test "$build_old_libs" = yes; then
if test "$pic_mode" != yes; then
# Don't build PIC code
command="$base_compile $qsrcfile$pie_flag"
else
command="$base_compile $qsrcfile $pic_flag"
fi
if test "$compiler_c_o" = yes; then
func_append command " -o $obj"
fi
# Suppress compiler output if we already did a PIC compilation.
func_append command "$suppress_output"
func_show_eval_locale "$command" \
'$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE'
if test "$need_locks" = warn &&
test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then
$ECHO "\
*** ERROR, $lockfile contains:
`cat $lockfile 2>/dev/null`
but it should contain:
$srcfile
This indicates that another process is trying to use the same
temporary object file, and libtool could not work around it because
your compiler does not support \`-c' and \`-o' together. If you
repeat this compilation, it may succeed, by chance, but you had better
avoid parallel builds (make -j) in this platform, or get a better
compiler."
$opt_dry_run || $RM $removelist
exit $EXIT_FAILURE
fi
# Just move the object if needed
if test -n "$output_obj" && test "X$output_obj" != "X$obj"; then
func_show_eval '$MV "$output_obj" "$obj"' \
'error=$?; $opt_dry_run || $RM $removelist; exit $error'
fi
fi
$opt_dry_run || {
func_write_libtool_object "$libobj" "$objdir/$objname" "$objname"
# Unlock the critical section if it was locked
if test "$need_locks" != no; then
removelist=$lockfile
$RM "$lockfile"
fi
}
exit $EXIT_SUCCESS
}
$opt_help || {
test "$opt_mode" = compile && func_mode_compile ${1+"$@"}
}
func_mode_help ()
{
# We need to display help for each of the modes.
case $opt_mode in
"")
# Generic help is extracted from the usage comments
# at the start of this file.
func_help
;;
clean)
$ECHO \
"Usage: $progname [OPTION]... --mode=clean RM [RM-OPTION]... FILE...
Remove files from the build directory.
RM is the name of the program to use to delete files associated with each FILE
(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
to RM.
If FILE is a libtool library, object or program, all the files associated
with it are deleted. Otherwise, only FILE itself is deleted using RM."
;;
compile)
$ECHO \
"Usage: $progname [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE
Compile a source file into a libtool library object.
This mode accepts the following additional options:
-o OUTPUT-FILE set the output file name to OUTPUT-FILE
-no-suppress do not suppress compiler output for multiple passes
-prefer-pic try to build PIC objects only
-prefer-non-pic try to build non-PIC objects only
-shared do not build a \`.o' file suitable for static linking
-static only build a \`.o' file suitable for static linking
-Wc,FLAG pass FLAG directly to the compiler
COMPILE-COMMAND is a command to be used in creating a \`standard' object file
from the given SOURCEFILE.
The output file name is determined by removing the directory component from
SOURCEFILE, then substituting the C source code suffix \`.c' with the
library object suffix, \`.lo'."
;;
execute)
$ECHO \
"Usage: $progname [OPTION]... --mode=execute COMMAND [ARGS]...
Automatically set library path, then run a program.
This mode accepts the following additional options:
-dlopen FILE add the directory containing FILE to the library path
This mode sets the library path environment variable according to \`-dlopen'
flags.
If any of the ARGS are libtool executable wrappers, then they are translated
into their corresponding uninstalled binary, and any of their required library
directories are added to the library path.
Then, COMMAND is executed, with ARGS as arguments."
;;
finish)
$ECHO \
"Usage: $progname [OPTION]... --mode=finish [LIBDIR]...
Complete the installation of libtool libraries.
Each LIBDIR is a directory that contains libtool libraries.
The commands that this mode executes may require superuser privileges. Use
the \`--dry-run' option if you just want to see what would be executed."
;;
install)
$ECHO \
"Usage: $progname [OPTION]... --mode=install INSTALL-COMMAND...
Install executables or libraries.
INSTALL-COMMAND is the installation command. The first component should be
either the \`install' or \`cp' program.
The following components of INSTALL-COMMAND are treated specially:
-inst-prefix-dir PREFIX-DIR Use PREFIX-DIR as a staging area for installation
The rest of the components are interpreted as arguments to that command (only
BSD-compatible install options are recognized)."
;;
link)
$ECHO \
"Usage: $progname [OPTION]... --mode=link LINK-COMMAND...
Link object files or libraries together to form another library, or to
create an executable program.
LINK-COMMAND is a command using the C compiler that you would use to create
a program from several object files.
The following components of LINK-COMMAND are treated specially:
-all-static do not do any dynamic linking at all
-avoid-version do not add a version suffix if possible
-bindir BINDIR specify path to binaries directory (for systems where
libraries must be found in the PATH setting at runtime)
-dlopen FILE \`-dlpreopen' FILE if it cannot be dlopened at runtime
-dlpreopen FILE link in FILE and add its symbols to lt_preloaded_symbols
-export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3)
-export-symbols SYMFILE
try to export only the symbols listed in SYMFILE
-export-symbols-regex REGEX
try to export only the symbols matching REGEX
-LLIBDIR search LIBDIR for required installed libraries
-lNAME OUTPUT-FILE requires the installed library libNAME
-module build a library that can dlopened
-no-fast-install disable the fast-install mode
-no-install link a not-installable executable
-no-undefined declare that a library does not refer to external symbols
-o OUTPUT-FILE create OUTPUT-FILE from the specified objects
-objectlist FILE Use a list of object files found in FILE to specify objects
-precious-files-regex REGEX
don't remove output files matching REGEX
-release RELEASE specify package release information
-rpath LIBDIR the created library will eventually be installed in LIBDIR
-R[ ]LIBDIR add LIBDIR to the runtime path of programs and libraries
-shared only do dynamic linking of libtool libraries
-shrext SUFFIX override the standard shared library file extension
-static do not do any dynamic linking of uninstalled libtool libraries
-static-libtool-libs
do not do any dynamic linking of libtool libraries
-version-info CURRENT[:REVISION[:AGE]]
specify library version info [each variable defaults to 0]
-weak LIBNAME declare that the target provides the LIBNAME interface
-Wc,FLAG
-Xcompiler FLAG pass linker-specific FLAG directly to the compiler
-Wl,FLAG
-Xlinker FLAG pass linker-specific FLAG directly to the linker
-XCClinker FLAG pass link-specific FLAG to the compiler driver (CC)
All other options (arguments beginning with \`-') are ignored.
Every other argument is treated as a filename. Files ending in \`.la' are
treated as uninstalled libtool libraries, other files are standard or library
object files.
If the OUTPUT-FILE ends in \`.la', then a libtool library is created,
only library objects (\`.lo' files) may be specified, and \`-rpath' is
required, except when creating a convenience library.
If OUTPUT-FILE ends in \`.a' or \`.lib', then a standard library is created
using \`ar' and \`ranlib', or on Windows using \`lib'.
If OUTPUT-FILE ends in \`.lo' or \`.${objext}', then a reloadable object file
is created, otherwise an executable program is created."
;;
uninstall)
$ECHO \
"Usage: $progname [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE...
Remove libraries from an installation directory.
RM is the name of the program to use to delete files associated with each FILE
(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
to RM.
If FILE is a libtool library, all the files associated with it are deleted.
Otherwise, only FILE itself is deleted using RM."
;;
*)
func_fatal_help "invalid operation mode \`$opt_mode'"
;;
esac
echo
$ECHO "Try \`$progname --help' for more information about other modes."
}
# Now that we've collected a possible --mode arg, show help if necessary
if $opt_help; then
if test "$opt_help" = :; then
func_mode_help
else
{
func_help noexit
for opt_mode in compile link execute install finish uninstall clean; do
func_mode_help
done
} | sed -n '1p; 2,$s/^Usage:/ or: /p'
{
func_help noexit
for opt_mode in compile link execute install finish uninstall clean; do
echo
func_mode_help
done
} |
sed '1d
/^When reporting/,/^Report/{
H
d
}
$x
/information about other modes/d
/more detailed .*MODE/d
s/^Usage:.*--mode=\([^ ]*\) .*/Description of \1 mode:/'
fi
exit $?
fi
# func_mode_execute arg...
func_mode_execute ()
{
$opt_debug
# The first argument is the command name.
cmd="$nonopt"
test -z "$cmd" && \
func_fatal_help "you must specify a COMMAND"
# Handle -dlopen flags immediately.
for file in $opt_dlopen; do
test -f "$file" \
|| func_fatal_help "\`$file' is not a file"
dir=
case $file in
*.la)
func_resolve_sysroot "$file"
file=$func_resolve_sysroot_result
# Check to see that this really is a libtool archive.
func_lalib_unsafe_p "$file" \
|| func_fatal_help "\`$lib' is not a valid libtool archive"
# Read the libtool library.
dlname=
library_names=
func_source "$file"
# Skip this library if it cannot be dlopened.
if test -z "$dlname"; then
# Warn if it was a shared library.
test -n "$library_names" && \
func_warning "\`$file' was not linked with \`-export-dynamic'"
continue
fi
func_dirname "$file" "" "."
dir="$func_dirname_result"
if test -f "$dir/$objdir/$dlname"; then
func_append dir "/$objdir"
else
if test ! -f "$dir/$dlname"; then
func_fatal_error "cannot find \`$dlname' in \`$dir' or \`$dir/$objdir'"
fi
fi
;;
*.lo)
# Just add the directory containing the .lo file.
func_dirname "$file" "" "."
dir="$func_dirname_result"
;;
*)
func_warning "\`-dlopen' is ignored for non-libtool libraries and objects"
continue
;;
esac
# Get the absolute pathname.
absdir=`cd "$dir" && pwd`
test -n "$absdir" && dir="$absdir"
# Now add the directory to shlibpath_var.
if eval "test -z \"\$$shlibpath_var\""; then
eval "$shlibpath_var=\"\$dir\""
else
eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\""
fi
done
# This variable tells wrapper scripts just to set shlibpath_var
# rather than running their programs.
libtool_execute_magic="$magic"
# Check if any of the arguments is a wrapper script.
args=
for file
do
case $file in
-* | *.la | *.lo ) ;;
*)
# Do a test to see if this is really a libtool program.
if func_ltwrapper_script_p "$file"; then
func_source "$file"
# Transform arg to wrapped name.
file="$progdir/$program"
elif func_ltwrapper_executable_p "$file"; then
func_ltwrapper_scriptname "$file"
func_source "$func_ltwrapper_scriptname_result"
# Transform arg to wrapped name.
file="$progdir/$program"
fi
;;
esac
# Quote arguments (to preserve shell metacharacters).
func_append_quoted args "$file"
done
if test "X$opt_dry_run" = Xfalse; then
if test -n "$shlibpath_var"; then
# Export the shlibpath_var.
eval "export $shlibpath_var"
fi
# Restore saved environment variables
for lt_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES
do
eval "if test \"\${save_$lt_var+set}\" = set; then
$lt_var=\$save_$lt_var; export $lt_var
else
$lt_unset $lt_var
fi"
done
# Now prepare to actually exec the command.
exec_cmd="\$cmd$args"
else
# Display what would be done.
if test -n "$shlibpath_var"; then
eval "\$ECHO \"\$shlibpath_var=\$$shlibpath_var\""
echo "export $shlibpath_var"
fi
$ECHO "$cmd$args"
exit $EXIT_SUCCESS
fi
}
test "$opt_mode" = execute && func_mode_execute ${1+"$@"}
# func_mode_finish arg...
func_mode_finish ()
{
$opt_debug
libs=
libdirs=
admincmds=
for opt in "$nonopt" ${1+"$@"}
do
if test -d "$opt"; then
func_append libdirs " $opt"
elif test -f "$opt"; then
if func_lalib_unsafe_p "$opt"; then
func_append libs " $opt"
else
func_warning "\`$opt' is not a valid libtool archive"
fi
else
func_fatal_error "invalid argument \`$opt'"
fi
done
if test -n "$libs"; then
if test -n "$lt_sysroot"; then
sysroot_regex=`$ECHO "$lt_sysroot" | $SED "$sed_make_literal_regex"`
sysroot_cmd="s/\([ ']\)$sysroot_regex/\1/g;"
else
sysroot_cmd=
fi
# Remove sysroot references
if $opt_dry_run; then
for lib in $libs; do
echo "removing references to $lt_sysroot and \`=' prefixes from $lib"
done
else
tmpdir=`func_mktempdir`
for lib in $libs; do
sed -e "${sysroot_cmd} s/\([ ']-[LR]\)=/\1/g; s/\([ ']\)=/\1/g" $lib \
> $tmpdir/tmp-la
mv -f $tmpdir/tmp-la $lib
done
${RM}r "$tmpdir"
fi
fi
if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
for libdir in $libdirs; do
if test -n "$finish_cmds"; then
# Do each command in the finish commands.
func_execute_cmds "$finish_cmds" 'admincmds="$admincmds
'"$cmd"'"'
fi
if test -n "$finish_eval"; then
# Do the single finish_eval.
eval cmds=\"$finish_eval\"
$opt_dry_run || eval "$cmds" || func_append admincmds "
$cmds"
fi
done
fi
# Exit here if they wanted silent mode.
$opt_silent && exit $EXIT_SUCCESS
if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
echo "----------------------------------------------------------------------"
echo "Libraries have been installed in:"
for libdir in $libdirs; do
$ECHO " $libdir"
done
echo
echo "If you ever happen to want to link against installed libraries"
echo "in a given directory, LIBDIR, you must either use libtool, and"
echo "specify the full pathname of the library, or use the \`-LLIBDIR'"
echo "flag during linking and do at least one of the following:"
if test -n "$shlibpath_var"; then
echo " - add LIBDIR to the \`$shlibpath_var' environment variable"
echo " during execution"
fi
if test -n "$runpath_var"; then
echo " - add LIBDIR to the \`$runpath_var' environment variable"
echo " during linking"
fi
if test -n "$hardcode_libdir_flag_spec"; then
libdir=LIBDIR
eval flag=\"$hardcode_libdir_flag_spec\"
$ECHO " - use the \`$flag' linker flag"
fi
if test -n "$admincmds"; then
$ECHO " - have your system administrator run these commands:$admincmds"
fi
if test -f /etc/ld.so.conf; then
echo " - have your system administrator add LIBDIR to \`/etc/ld.so.conf'"
fi
echo
echo "See any operating system documentation about shared libraries for"
case $host in
solaris2.[6789]|solaris2.1[0-9])
echo "more information, such as the ld(1), crle(1) and ld.so(8) manual"
echo "pages."
;;
*)
echo "more information, such as the ld(1) and ld.so(8) manual pages."
;;
esac
echo "----------------------------------------------------------------------"
fi
exit $EXIT_SUCCESS
}
test "$opt_mode" = finish && func_mode_finish ${1+"$@"}
# func_mode_install arg...
func_mode_install ()
{
$opt_debug
# There may be an optional sh(1) argument at the beginning of
# install_prog (especially on Windows NT).
if test "$nonopt" = "$SHELL" || test "$nonopt" = /bin/sh ||
# Allow the use of GNU shtool's install command.
case $nonopt in *shtool*) :;; *) false;; esac; then
# Aesthetically quote it.
func_quote_for_eval "$nonopt"
install_prog="$func_quote_for_eval_result "
arg=$1
shift
else
install_prog=
arg=$nonopt
fi
# The real first argument should be the name of the installation program.
# Aesthetically quote it.
func_quote_for_eval "$arg"
func_append install_prog "$func_quote_for_eval_result"
install_shared_prog=$install_prog
case " $install_prog " in
*[\\\ /]cp\ *) install_cp=: ;;
*) install_cp=false ;;
esac
# We need to accept at least all the BSD install flags.
dest=
files=
opts=
prev=
install_type=
isdir=no
stripme=
no_mode=:
for arg
do
arg2=
if test -n "$dest"; then
func_append files " $dest"
dest=$arg
continue
fi
case $arg in
-d) isdir=yes ;;
-f)
if $install_cp; then :; else
prev=$arg
fi
;;
-g | -m | -o)
prev=$arg
;;
-s)
stripme=" -s"
continue
;;
-*)
;;
*)
# If the previous option needed an argument, then skip it.
if test -n "$prev"; then
if test "x$prev" = x-m && test -n "$install_override_mode"; then
arg2=$install_override_mode
no_mode=false
fi
prev=
else
dest=$arg
continue
fi
;;
esac
# Aesthetically quote the argument.
func_quote_for_eval "$arg"
func_append install_prog " $func_quote_for_eval_result"
if test -n "$arg2"; then
func_quote_for_eval "$arg2"
fi
func_append install_shared_prog " $func_quote_for_eval_result"
done
test -z "$install_prog" && \
func_fatal_help "you must specify an install program"
test -n "$prev" && \
func_fatal_help "the \`$prev' option requires an argument"
if test -n "$install_override_mode" && $no_mode; then
if $install_cp; then :; else
func_quote_for_eval "$install_override_mode"
func_append install_shared_prog " -m $func_quote_for_eval_result"
fi
fi
if test -z "$files"; then
if test -z "$dest"; then
func_fatal_help "no file or destination specified"
else
func_fatal_help "you must specify a destination"
fi
fi
# Strip any trailing slash from the destination.
func_stripname '' '/' "$dest"
dest=$func_stripname_result
# Check to see that the destination is a directory.
test -d "$dest" && isdir=yes
if test "$isdir" = yes; then
destdir="$dest"
destname=
else
func_dirname_and_basename "$dest" "" "."
destdir="$func_dirname_result"
destname="$func_basename_result"
# Not a directory, so check to see that there is only one file specified.
set dummy $files; shift
test "$#" -gt 1 && \
func_fatal_help "\`$dest' is not a directory"
fi
case $destdir in
[\\/]* | [A-Za-z]:[\\/]*) ;;
*)
for file in $files; do
case $file in
*.lo) ;;
*)
func_fatal_help "\`$destdir' must be an absolute directory name"
;;
esac
done
;;
esac
# This variable tells wrapper scripts just to set variables rather
# than running their programs.
libtool_install_magic="$magic"
staticlibs=
future_libdirs=
current_libdirs=
for file in $files; do
# Do each installation.
case $file in
*.$libext)
# Do the static libraries later.
func_append staticlibs " $file"
;;
*.la)
func_resolve_sysroot "$file"
file=$func_resolve_sysroot_result
# Check to see that this really is a libtool archive.
func_lalib_unsafe_p "$file" \
|| func_fatal_help "\`$file' is not a valid libtool archive"
library_names=
old_library=
relink_command=
func_source "$file"
# Add the libdir to current_libdirs if it is the destination.
if test "X$destdir" = "X$libdir"; then
case "$current_libdirs " in
*" $libdir "*) ;;
*) func_append current_libdirs " $libdir" ;;
esac
else
# Note the libdir as a future libdir.
case "$future_libdirs " in
*" $libdir "*) ;;
*) func_append future_libdirs " $libdir" ;;
esac
fi
func_dirname "$file" "/" ""
dir="$func_dirname_result"
func_append dir "$objdir"
if test -n "$relink_command"; then
# Determine the prefix the user has applied to our future dir.
inst_prefix_dir=`$ECHO "$destdir" | $SED -e "s%$libdir\$%%"`
# Don't allow the user to place us outside of our expected
# location b/c this prevents finding dependent libraries that
# are installed to the same prefix.
# At present, this check doesn't affect windows .dll's that
# are installed into $libdir/../bin (currently, that works fine)
# but it's something to keep an eye on.
test "$inst_prefix_dir" = "$destdir" && \
func_fatal_error "error: cannot install \`$file' to a directory not ending in $libdir"
if test -n "$inst_prefix_dir"; then
# Stick the inst_prefix_dir data into the link command.
relink_command=`$ECHO "$relink_command" | $SED "s%@inst_prefix_dir@%-inst-prefix-dir $inst_prefix_dir%"`
else
relink_command=`$ECHO "$relink_command" | $SED "s%@inst_prefix_dir@%%"`
fi
func_warning "relinking \`$file'"
func_show_eval "$relink_command" \
'func_fatal_error "error: relink \`$file'\'' with the above command before installing it"'
fi
# See the names of the shared library.
set dummy $library_names; shift
if test -n "$1"; then
realname="$1"
shift
srcname="$realname"
test -n "$relink_command" && srcname="$realname"T
# Install the shared library and build the symlinks.
func_show_eval "$install_shared_prog $dir/$srcname $destdir/$realname" \
'exit $?'
tstripme="$stripme"
case $host_os in
cygwin* | mingw* | pw32* | cegcc*)
case $realname in
*.dll.a)
tstripme=""
;;
esac
;;
esac
if test -n "$tstripme" && test -n "$striplib"; then
func_show_eval "$striplib $destdir/$realname" 'exit $?'
fi
if test "$#" -gt 0; then
# Delete the old symlinks, and create new ones.
# Try `ln -sf' first, because the `ln' binary might depend on
# the symlink we replace! Solaris /bin/ln does not understand -f,
# so we also need to try rm && ln -s.
for linkname
do
test "$linkname" != "$realname" \
&& func_show_eval "(cd $destdir && { $LN_S -f $realname $linkname || { $RM $linkname && $LN_S $realname $linkname; }; })"
done
fi
# Do each command in the postinstall commands.
lib="$destdir/$realname"
func_execute_cmds "$postinstall_cmds" 'exit $?'
fi
# Install the pseudo-library for information purposes.
func_basename "$file"
name="$func_basename_result"
instname="$dir/$name"i
func_show_eval "$install_prog $instname $destdir/$name" 'exit $?'
# Maybe install the static library, too.
test -n "$old_library" && func_append staticlibs " $dir/$old_library"
;;
*.lo)
# Install (i.e. copy) a libtool object.
# Figure out destination file name, if it wasn't already specified.
if test -n "$destname"; then
destfile="$destdir/$destname"
else
func_basename "$file"
destfile="$func_basename_result"
destfile="$destdir/$destfile"
fi
# Deduce the name of the destination old-style object file.
case $destfile in
*.lo)
func_lo2o "$destfile"
staticdest=$func_lo2o_result
;;
*.$objext)
staticdest="$destfile"
destfile=
;;
*)
func_fatal_help "cannot copy a libtool object to \`$destfile'"
;;
esac
# Install the libtool object if requested.
test -n "$destfile" && \
func_show_eval "$install_prog $file $destfile" 'exit $?'
# Install the old object if enabled.
if test "$build_old_libs" = yes; then
# Deduce the name of the old-style object file.
func_lo2o "$file"
staticobj=$func_lo2o_result
func_show_eval "$install_prog \$staticobj \$staticdest" 'exit $?'
fi
exit $EXIT_SUCCESS
;;
*)
# Figure out destination file name, if it wasn't already specified.
if test -n "$destname"; then
destfile="$destdir/$destname"
else
func_basename "$file"
destfile="$func_basename_result"
destfile="$destdir/$destfile"
fi
# If the file is missing, and there is a .exe on the end, strip it
# because it is most likely a libtool script we actually want to
# install
stripped_ext=""
case $file in
*.exe)
if test ! -f "$file"; then
func_stripname '' '.exe' "$file"
file=$func_stripname_result
stripped_ext=".exe"
fi
;;
esac
# Do a test to see if this is really a libtool program.
case $host in
*cygwin* | *mingw*)
if func_ltwrapper_executable_p "$file"; then
func_ltwrapper_scriptname "$file"
wrapper=$func_ltwrapper_scriptname_result
else
func_stripname '' '.exe' "$file"
wrapper=$func_stripname_result
fi
;;
*)
wrapper=$file
;;
esac
if func_ltwrapper_script_p "$wrapper"; then
notinst_deplibs=
relink_command=
func_source "$wrapper"
# Check the variables that should have been set.
test -z "$generated_by_libtool_version" && \
func_fatal_error "invalid libtool wrapper script \`$wrapper'"
finalize=yes
for lib in $notinst_deplibs; do
# Check to see that each library is installed.
libdir=
if test -f "$lib"; then
func_source "$lib"
fi
libfile="$libdir/"`$ECHO "$lib" | $SED 's%^.*/%%g'` ### testsuite: skip nested quoting test
if test -n "$libdir" && test ! -f "$libfile"; then
func_warning "\`$lib' has not been installed in \`$libdir'"
finalize=no
fi
done
relink_command=
func_source "$wrapper"
outputname=
if test "$fast_install" = no && test -n "$relink_command"; then
$opt_dry_run || {
if test "$finalize" = yes; then
tmpdir=`func_mktempdir`
func_basename "$file$stripped_ext"
file="$func_basename_result"
outputname="$tmpdir/$file"
# Replace the output file specification.
relink_command=`$ECHO "$relink_command" | $SED 's%@OUTPUT@%'"$outputname"'%g'`
$opt_silent || {
func_quote_for_expand "$relink_command"
eval "func_echo $func_quote_for_expand_result"
}
if eval "$relink_command"; then :
else
func_error "error: relink \`$file' with the above command before installing it"
$opt_dry_run || ${RM}r "$tmpdir"
continue
fi
file="$outputname"
else
func_warning "cannot relink \`$file'"
fi
}
else
# Install the binary that we compiled earlier.
file=`$ECHO "$file$stripped_ext" | $SED "s%\([^/]*\)$%$objdir/\1%"`
fi
fi
# remove .exe since cygwin /usr/bin/install will append another
# one anyway
case $install_prog,$host in
*/usr/bin/install*,*cygwin*)
case $file:$destfile in
*.exe:*.exe)
# this is ok
;;
*.exe:*)
destfile=$destfile.exe
;;
*:*.exe)
func_stripname '' '.exe' "$destfile"
destfile=$func_stripname_result
;;
esac
;;
esac
func_show_eval "$install_prog\$stripme \$file \$destfile" 'exit $?'
$opt_dry_run || if test -n "$outputname"; then
${RM}r "$tmpdir"
fi
;;
esac
done
for file in $staticlibs; do
func_basename "$file"
name="$func_basename_result"
# Set up the ranlib parameters.
oldlib="$destdir/$name"
func_to_tool_file "$oldlib" func_convert_file_msys_to_w32
tool_oldlib=$func_to_tool_file_result
func_show_eval "$install_prog \$file \$oldlib" 'exit $?'
if test -n "$stripme" && test -n "$old_striplib"; then
func_show_eval "$old_striplib $tool_oldlib" 'exit $?'
fi
# Do each command in the postinstall commands.
func_execute_cmds "$old_postinstall_cmds" 'exit $?'
done
test -n "$future_libdirs" && \
func_warning "remember to run \`$progname --finish$future_libdirs'"
if test -n "$current_libdirs"; then
# Maybe just do a dry run.
$opt_dry_run && current_libdirs=" -n$current_libdirs"
exec_cmd='$SHELL $progpath $preserve_args --finish$current_libdirs'
else
exit $EXIT_SUCCESS
fi
}
test "$opt_mode" = install && func_mode_install ${1+"$@"}
# func_generate_dlsyms outputname originator pic_p
# Extract symbols from dlprefiles and create ${outputname}S.o with
# a dlpreopen symbol table.
func_generate_dlsyms ()
{
$opt_debug
my_outputname="$1"
my_originator="$2"
my_pic_p="${3-no}"
my_prefix=`$ECHO "$my_originator" | sed 's%[^a-zA-Z0-9]%_%g'`
my_dlsyms=
if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
if test -n "$NM" && test -n "$global_symbol_pipe"; then
my_dlsyms="${my_outputname}S.c"
else
func_error "not configured to extract global symbols from dlpreopened files"
fi
fi
if test -n "$my_dlsyms"; then
case $my_dlsyms in
"") ;;
*.c)
# Discover the nlist of each of the dlfiles.
nlist="$output_objdir/${my_outputname}.nm"
func_show_eval "$RM $nlist ${nlist}S ${nlist}T"
# Parse the name list into a source file.
func_verbose "creating $output_objdir/$my_dlsyms"
$opt_dry_run || $ECHO > "$output_objdir/$my_dlsyms" "\
/* $my_dlsyms - symbol resolution table for \`$my_outputname' dlsym emulation. */
/* Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION */
#ifdef __cplusplus
extern \"C\" {
#endif
#if defined(__GNUC__) && (((__GNUC__ == 4) && (__GNUC_MINOR__ >= 4)) || (__GNUC__ > 4))
#pragma GCC diagnostic ignored \"-Wstrict-prototypes\"
#endif
/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */
#if defined(_WIN32) || defined(__CYGWIN__) || defined(_WIN32_WCE)
/* DATA imports from DLLs on WIN32 con't be const, because runtime
relocations are performed -- see ld's documentation on pseudo-relocs. */
# define LT_DLSYM_CONST
#elif defined(__osf__)
/* This system does not cope well with relocations in const data. */
# define LT_DLSYM_CONST
#else
# define LT_DLSYM_CONST const
#endif
/* External symbol declarations for the compiler. */\
"
if test "$dlself" = yes; then
func_verbose "generating symbol list for \`$output'"
$opt_dry_run || echo ': @PROGRAM@ ' > "$nlist"
# Add our own program objects to the symbol list.
progfiles=`$ECHO "$objs$old_deplibs" | $SP2NL | $SED "$lo2o" | $NL2SP`
for progfile in $progfiles; do
func_to_tool_file "$progfile" func_convert_file_msys_to_w32
func_verbose "extracting global C symbols from \`$func_to_tool_file_result'"
$opt_dry_run || eval "$NM $func_to_tool_file_result | $global_symbol_pipe >> '$nlist'"
done
if test -n "$exclude_expsyms"; then
$opt_dry_run || {
eval '$EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T'
eval '$MV "$nlist"T "$nlist"'
}
fi
if test -n "$export_symbols_regex"; then
$opt_dry_run || {
eval '$EGREP -e "$export_symbols_regex" "$nlist" > "$nlist"T'
eval '$MV "$nlist"T "$nlist"'
}
fi
# Prepare the list of exported symbols
if test -z "$export_symbols"; then
export_symbols="$output_objdir/$outputname.exp"
$opt_dry_run || {
$RM $export_symbols
eval "${SED} -n -e '/^: @PROGRAM@ $/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"'
case $host in
*cygwin* | *mingw* | *cegcc* )
eval "echo EXPORTS "'> "$output_objdir/$outputname.def"'
eval 'cat "$export_symbols" >> "$output_objdir/$outputname.def"'
;;
esac
}
else
$opt_dry_run || {
eval "${SED} -e 's/\([].[*^$]\)/\\\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$outputname.exp"'
eval '$GREP -f "$output_objdir/$outputname.exp" < "$nlist" > "$nlist"T'
eval '$MV "$nlist"T "$nlist"'
case $host in
*cygwin* | *mingw* | *cegcc* )
eval "echo EXPORTS "'> "$output_objdir/$outputname.def"'
eval 'cat "$nlist" >> "$output_objdir/$outputname.def"'
;;
esac
}
fi
fi
for dlprefile in $dlprefiles; do
func_verbose "extracting global C symbols from \`$dlprefile'"
func_basename "$dlprefile"
name="$func_basename_result"
case $host in
*cygwin* | *mingw* | *cegcc* )
# if an import library, we need to obtain dlname
if func_win32_import_lib_p "$dlprefile"; then
func_tr_sh "$dlprefile"
eval "curr_lafile=\$libfile_$func_tr_sh_result"
dlprefile_dlbasename=""
if test -n "$curr_lafile" && func_lalib_p "$curr_lafile"; then
# Use subshell, to avoid clobbering current variable values
dlprefile_dlname=`source "$curr_lafile" && echo "$dlname"`
if test -n "$dlprefile_dlname" ; then
func_basename "$dlprefile_dlname"
dlprefile_dlbasename="$func_basename_result"
else
# no lafile. user explicitly requested -dlpreopen .
$sharedlib_from_linklib_cmd "$dlprefile"
dlprefile_dlbasename=$sharedlib_from_linklib_result
fi
fi
$opt_dry_run || {
if test -n "$dlprefile_dlbasename" ; then
eval '$ECHO ": $dlprefile_dlbasename" >> "$nlist"'
else
func_warning "Could not compute DLL name from $name"
eval '$ECHO ": $name " >> "$nlist"'
fi
func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe |
$SED -e '/I __imp/d' -e 's/I __nm_/D /;s/_nm__//' >> '$nlist'"
}
else # not an import lib
$opt_dry_run || {
eval '$ECHO ": $name " >> "$nlist"'
func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe >> '$nlist'"
}
fi
;;
*)
$opt_dry_run || {
eval '$ECHO ": $name " >> "$nlist"'
func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe >> '$nlist'"
}
;;
esac
done
$opt_dry_run || {
# Make sure we have at least an empty file.
test -f "$nlist" || : > "$nlist"
if test -n "$exclude_expsyms"; then
$EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T
$MV "$nlist"T "$nlist"
fi
# Try sorting and uniquifying the output.
if $GREP -v "^: " < "$nlist" |
if sort -k 3 /dev/null 2>&1; then
sort -k 3
else
sort +2
fi |
uniq > "$nlist"S; then
:
else
$GREP -v "^: " < "$nlist" > "$nlist"S
fi
if test -f "$nlist"S; then
eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$my_dlsyms"'
else
echo '/* NONE */' >> "$output_objdir/$my_dlsyms"
fi
echo >> "$output_objdir/$my_dlsyms" "\
/* The mapping between symbol names and symbols. */
typedef struct {
const char *name;
void *address;
} lt_dlsymlist;
extern LT_DLSYM_CONST lt_dlsymlist
lt_${my_prefix}_LTX_preloaded_symbols[];
LT_DLSYM_CONST lt_dlsymlist
lt_${my_prefix}_LTX_preloaded_symbols[] =
{\
{ \"$my_originator\", (void *) 0 },"
case $need_lib_prefix in
no)
eval "$global_symbol_to_c_name_address" < "$nlist" >> "$output_objdir/$my_dlsyms"
;;
*)
eval "$global_symbol_to_c_name_address_lib_prefix" < "$nlist" >> "$output_objdir/$my_dlsyms"
;;
esac
echo >> "$output_objdir/$my_dlsyms" "\
{0, (void *) 0}
};
/* This works around a problem in FreeBSD linker */
#ifdef FREEBSD_WORKAROUND
static const void *lt_preloaded_setup() {
return lt_${my_prefix}_LTX_preloaded_symbols;
}
#endif
#ifdef __cplusplus
}
#endif\
"
} # !$opt_dry_run
pic_flag_for_symtable=
case "$compile_command " in
*" -static "*) ;;
*)
case $host in
# compiling the symbol table file with pic_flag works around
# a FreeBSD bug that causes programs to crash when -lm is
# linked before any other PIC object. But we must not use
# pic_flag when linking with -static. The problem exists in
# FreeBSD 2.2.6 and is fixed in FreeBSD 3.1.
*-*-freebsd2.*|*-*-freebsd3.0*|*-*-freebsdelf3.0*)
pic_flag_for_symtable=" $pic_flag -DFREEBSD_WORKAROUND" ;;
*-*-hpux*)
pic_flag_for_symtable=" $pic_flag" ;;
*)
if test "X$my_pic_p" != Xno; then
pic_flag_for_symtable=" $pic_flag"
fi
;;
esac
;;
esac
symtab_cflags=
for arg in $LTCFLAGS; do
case $arg in
-pie | -fpie | -fPIE) ;;
*) func_append symtab_cflags " $arg" ;;
esac
done
# Now compile the dynamic symbol file.
func_show_eval '(cd $output_objdir && $LTCC$symtab_cflags -c$no_builtin_flag$pic_flag_for_symtable "$my_dlsyms")' 'exit $?'
# Clean up the generated files.
func_show_eval '$RM "$output_objdir/$my_dlsyms" "$nlist" "${nlist}S" "${nlist}T"'
# Transform the symbol file into the correct name.
symfileobj="$output_objdir/${my_outputname}S.$objext"
case $host in
*cygwin* | *mingw* | *cegcc* )
if test -f "$output_objdir/$my_outputname.def"; then
compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"`
finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"`
else
compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$symfileobj%"`
finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$symfileobj%"`
fi
;;
*)
compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$symfileobj%"`
finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$symfileobj%"`
;;
esac
;;
*)
func_fatal_error "unknown suffix for \`$my_dlsyms'"
;;
esac
else
# We keep going just in case the user didn't refer to
# lt_preloaded_symbols. The linker will fail if global_symbol_pipe
# really was required.
# Nullify the symbol file.
compile_command=`$ECHO "$compile_command" | $SED "s% @SYMFILE@%%"`
finalize_command=`$ECHO "$finalize_command" | $SED "s% @SYMFILE@%%"`
fi
}
# func_win32_libid arg
# return the library type of file 'arg'
#
# Need a lot of goo to handle *both* DLLs and import libs
# Has to be a shell function in order to 'eat' the argument
# that is supplied when $file_magic_command is called.
# Despite the name, also deal with 64 bit binaries.
func_win32_libid ()
{
$opt_debug
win32_libid_type="unknown"
win32_fileres=`file -L $1 2>/dev/null`
case $win32_fileres in
*ar\ archive\ import\ library*) # definitely import
win32_libid_type="x86 archive import"
;;
*ar\ archive*) # could be an import, or static
# Keep the egrep pattern in sync with the one in _LT_CHECK_MAGIC_METHOD.
if eval $OBJDUMP -f $1 | $SED -e '10q' 2>/dev/null |
$EGREP 'file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)' >/dev/null; then
func_to_tool_file "$1" func_convert_file_msys_to_w32
win32_nmres=`eval $NM -f posix -A \"$func_to_tool_file_result\" |
$SED -n -e '
1,100{
/ I /{
s,.*,import,
p
q
}
}'`
case $win32_nmres in
import*) win32_libid_type="x86 archive import";;
*) win32_libid_type="x86 archive static";;
esac
fi
;;
*DLL*)
win32_libid_type="x86 DLL"
;;
*executable*) # but shell scripts are "executable" too...
case $win32_fileres in
*MS\ Windows\ PE\ Intel*)
win32_libid_type="x86 DLL"
;;
esac
;;
esac
$ECHO "$win32_libid_type"
}
# func_cygming_dll_for_implib ARG
#
# Platform-specific function to extract the
# name of the DLL associated with the specified
# import library ARG.
# Invoked by eval'ing the libtool variable
# $sharedlib_from_linklib_cmd
# Result is available in the variable
# $sharedlib_from_linklib_result
func_cygming_dll_for_implib ()
{
$opt_debug
sharedlib_from_linklib_result=`$DLLTOOL --identify-strict --identify "$1"`
}
# func_cygming_dll_for_implib_fallback_core SECTION_NAME LIBNAMEs
#
# The is the core of a fallback implementation of a
# platform-specific function to extract the name of the
# DLL associated with the specified import library LIBNAME.
#
# SECTION_NAME is either .idata$6 or .idata$7, depending
# on the platform and compiler that created the implib.
#
# Echos the name of the DLL associated with the
# specified import library.
func_cygming_dll_for_implib_fallback_core ()
{
$opt_debug
match_literal=`$ECHO "$1" | $SED "$sed_make_literal_regex"`
$OBJDUMP -s --section "$1" "$2" 2>/dev/null |
$SED '/^Contents of section '"$match_literal"':/{
# Place marker at beginning of archive member dllname section
s/.*/====MARK====/
p
d
}
# These lines can sometimes be longer than 43 characters, but
# are always uninteresting
/:[ ]*file format pe[i]\{,1\}-/d
/^In archive [^:]*:/d
# Ensure marker is printed
/^====MARK====/p
# Remove all lines with less than 43 characters
/^.\{43\}/!d
# From remaining lines, remove first 43 characters
s/^.\{43\}//' |
$SED -n '
# Join marker and all lines until next marker into a single line
/^====MARK====/ b para
H
$ b para
b
:para
x
s/\n//g
# Remove the marker
s/^====MARK====//
# Remove trailing dots and whitespace
s/[\. \t]*$//
# Print
/./p' |
# we now have a list, one entry per line, of the stringified
# contents of the appropriate section of all members of the
# archive which possess that section. Heuristic: eliminate
# all those which have a first or second character that is
# a '.' (that is, objdump's representation of an unprintable
# character.) This should work for all archives with less than
# 0x302f exports -- but will fail for DLLs whose name actually
# begins with a literal '.' or a single character followed by
# a '.'.
#
# Of those that remain, print the first one.
$SED -e '/^\./d;/^.\./d;q'
}
# func_cygming_gnu_implib_p ARG
# This predicate returns with zero status (TRUE) if
# ARG is a GNU/binutils-style import library. Returns
# with nonzero status (FALSE) otherwise.
func_cygming_gnu_implib_p ()
{
$opt_debug
func_to_tool_file "$1" func_convert_file_msys_to_w32
func_cygming_gnu_implib_tmp=`$NM "$func_to_tool_file_result" | eval "$global_symbol_pipe" | $EGREP ' (_head_[A-Za-z0-9_]+_[ad]l*|[A-Za-z0-9_]+_[ad]l*_iname)$'`
test -n "$func_cygming_gnu_implib_tmp"
}
# func_cygming_ms_implib_p ARG
# This predicate returns with zero status (TRUE) if
# ARG is an MS-style import library. Returns
# with nonzero status (FALSE) otherwise.
func_cygming_ms_implib_p ()
{
$opt_debug
func_to_tool_file "$1" func_convert_file_msys_to_w32
func_cygming_ms_implib_tmp=`$NM "$func_to_tool_file_result" | eval "$global_symbol_pipe" | $GREP '_NULL_IMPORT_DESCRIPTOR'`
test -n "$func_cygming_ms_implib_tmp"
}
# func_cygming_dll_for_implib_fallback ARG
# Platform-specific function to extract the
# name of the DLL associated with the specified
# import library ARG.
#
# This fallback implementation is for use when $DLLTOOL
# does not support the --identify-strict option.
# Invoked by eval'ing the libtool variable
# $sharedlib_from_linklib_cmd
# Result is available in the variable
# $sharedlib_from_linklib_result
func_cygming_dll_for_implib_fallback ()
{
$opt_debug
if func_cygming_gnu_implib_p "$1" ; then
# binutils import library
sharedlib_from_linklib_result=`func_cygming_dll_for_implib_fallback_core '.idata$7' "$1"`
elif func_cygming_ms_implib_p "$1" ; then
# ms-generated import library
sharedlib_from_linklib_result=`func_cygming_dll_for_implib_fallback_core '.idata$6' "$1"`
else
# unknown
sharedlib_from_linklib_result=""
fi
}
# func_extract_an_archive dir oldlib
func_extract_an_archive ()
{
$opt_debug
f_ex_an_ar_dir="$1"; shift
f_ex_an_ar_oldlib="$1"
if test "$lock_old_archive_extraction" = yes; then
lockfile=$f_ex_an_ar_oldlib.lock
until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do
func_echo "Waiting for $lockfile to be removed"
sleep 2
done
fi
func_show_eval "(cd \$f_ex_an_ar_dir && $AR x \"\$f_ex_an_ar_oldlib\")" \
'stat=$?; rm -f "$lockfile"; exit $stat'
if test "$lock_old_archive_extraction" = yes; then
$opt_dry_run || rm -f "$lockfile"
fi
if ($AR t "$f_ex_an_ar_oldlib" | sort | sort -uc >/dev/null 2>&1); then
:
else
func_fatal_error "object name conflicts in archive: $f_ex_an_ar_dir/$f_ex_an_ar_oldlib"
fi
}
# func_extract_archives gentop oldlib ...
func_extract_archives ()
{
$opt_debug
my_gentop="$1"; shift
my_oldlibs=${1+"$@"}
my_oldobjs=""
my_xlib=""
my_xabs=""
my_xdir=""
for my_xlib in $my_oldlibs; do
# Extract the objects.
case $my_xlib in
[\\/]* | [A-Za-z]:[\\/]*) my_xabs="$my_xlib" ;;
*) my_xabs=`pwd`"/$my_xlib" ;;
esac
func_basename "$my_xlib"
my_xlib="$func_basename_result"
my_xlib_u=$my_xlib
while :; do
case " $extracted_archives " in
*" $my_xlib_u "*)
func_arith $extracted_serial + 1
extracted_serial=$func_arith_result
my_xlib_u=lt$extracted_serial-$my_xlib ;;
*) break ;;
esac
done
extracted_archives="$extracted_archives $my_xlib_u"
my_xdir="$my_gentop/$my_xlib_u"
func_mkdir_p "$my_xdir"
case $host in
*-darwin*)
func_verbose "Extracting $my_xabs"
# Do not bother doing anything if just a dry run
$opt_dry_run || {
darwin_orig_dir=`pwd`
cd $my_xdir || exit $?
darwin_archive=$my_xabs
darwin_curdir=`pwd`
darwin_base_archive=`basename "$darwin_archive"`
darwin_arches=`$LIPO -info "$darwin_archive" 2>/dev/null | $GREP Architectures 2>/dev/null || true`
if test -n "$darwin_arches"; then
darwin_arches=`$ECHO "$darwin_arches" | $SED -e 's/.*are://'`
darwin_arch=
func_verbose "$darwin_base_archive has multiple architectures $darwin_arches"
for darwin_arch in $darwin_arches ; do
func_mkdir_p "unfat-$$/${darwin_base_archive}-${darwin_arch}"
$LIPO -thin $darwin_arch -output "unfat-$$/${darwin_base_archive}-${darwin_arch}/${darwin_base_archive}" "${darwin_archive}"
cd "unfat-$$/${darwin_base_archive}-${darwin_arch}"
func_extract_an_archive "`pwd`" "${darwin_base_archive}"
cd "$darwin_curdir"
$RM "unfat-$$/${darwin_base_archive}-${darwin_arch}/${darwin_base_archive}"
done # $darwin_arches
## Okay now we've a bunch of thin objects, gotta fatten them up :)
darwin_filelist=`find unfat-$$ -type f -name \*.o -print -o -name \*.lo -print | $SED -e "$basename" | sort -u`
darwin_file=
darwin_files=
for darwin_file in $darwin_filelist; do
darwin_files=`find unfat-$$ -name $darwin_file -print | sort | $NL2SP`
$LIPO -create -output "$darwin_file" $darwin_files
done # $darwin_filelist
$RM -rf unfat-$$
cd "$darwin_orig_dir"
else
cd $darwin_orig_dir
func_extract_an_archive "$my_xdir" "$my_xabs"
fi # $darwin_arches
} # !$opt_dry_run
;;
*)
func_extract_an_archive "$my_xdir" "$my_xabs"
;;
esac
my_oldobjs="$my_oldobjs "`find $my_xdir -name \*.$objext -print -o -name \*.lo -print | sort | $NL2SP`
done
func_extract_archives_result="$my_oldobjs"
}
# func_emit_wrapper [arg=no]
#
# Emit a libtool wrapper script on stdout.
# Don't directly open a file because we may want to
# incorporate the script contents within a cygwin/mingw
# wrapper executable. Must ONLY be called from within
# func_mode_link because it depends on a number of variables
# set therein.
#
# ARG is the value that the WRAPPER_SCRIPT_BELONGS_IN_OBJDIR
# variable will take. If 'yes', then the emitted script
# will assume that the directory in which it is stored is
# the $objdir directory. This is a cygwin/mingw-specific
# behavior.
func_emit_wrapper ()
{
func_emit_wrapper_arg1=${1-no}
$ECHO "\
#! $SHELL
# $output - temporary wrapper script for $objdir/$outputname
# Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION
#
# The $output program cannot be directly executed until all the libtool
# libraries that it depends on are installed.
#
# This wrapper script should never be moved out of the build directory.
# If it is, it will not operate correctly.
# Sed substitution that helps us do robust quoting. It backslashifies
# metacharacters that are still active within double-quoted strings.
sed_quote_subst='$sed_quote_subst'
# Be Bourne compatible
if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then
emulate sh
NULLCMD=:
# Zsh 3.x and 4.x performs word splitting on \${1+\"\$@\"}, which
# is contrary to our usage. Disable this feature.
alias -g '\${1+\"\$@\"}'='\"\$@\"'
setopt NO_GLOB_SUBST
else
case \`(set -o) 2>/dev/null\` in *posix*) set -o posix;; esac
fi
BIN_SH=xpg4; export BIN_SH # for Tru64
DUALCASE=1; export DUALCASE # for MKS sh
# The HP-UX ksh and POSIX shell print the target directory to stdout
# if CDPATH is set.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
relink_command=\"$relink_command\"
# This environment variable determines our operation mode.
if test \"\$libtool_install_magic\" = \"$magic\"; then
# install mode needs the following variables:
generated_by_libtool_version='$macro_version'
notinst_deplibs='$notinst_deplibs'
else
# When we are sourced in execute mode, \$file and \$ECHO are already set.
if test \"\$libtool_execute_magic\" != \"$magic\"; then
file=\"\$0\""
qECHO=`$ECHO "$ECHO" | $SED "$sed_quote_subst"`
$ECHO "\
# A function that is used when there is no print builtin or printf.
func_fallback_echo ()
{
eval 'cat <<_LTECHO_EOF
\$1
_LTECHO_EOF'
}
ECHO=\"$qECHO\"
fi
# Very basic option parsing. These options are (a) specific to
# the libtool wrapper, (b) are identical between the wrapper
# /script/ and the wrapper /executable/ which is used only on
# windows platforms, and (c) all begin with the string "--lt-"
# (application programs are unlikely to have options which match
# this pattern).
#
# There are only two supported options: --lt-debug and
# --lt-dump-script. There is, deliberately, no --lt-help.
#
# The first argument to this parsing function should be the
# script's $0 value, followed by "$@".
lt_option_debug=
func_parse_lt_options ()
{
lt_script_arg0=\$0
shift
for lt_opt
do
case \"\$lt_opt\" in
--lt-debug) lt_option_debug=1 ;;
--lt-dump-script)
lt_dump_D=\`\$ECHO \"X\$lt_script_arg0\" | $SED -e 's/^X//' -e 's%/[^/]*$%%'\`
test \"X\$lt_dump_D\" = \"X\$lt_script_arg0\" && lt_dump_D=.
lt_dump_F=\`\$ECHO \"X\$lt_script_arg0\" | $SED -e 's/^X//' -e 's%^.*/%%'\`
cat \"\$lt_dump_D/\$lt_dump_F\"
exit 0
;;
--lt-*)
\$ECHO \"Unrecognized --lt- option: '\$lt_opt'\" 1>&2
exit 1
;;
esac
done
# Print the debug banner immediately:
if test -n \"\$lt_option_debug\"; then
echo \"${outputname}:${output}:\${LINENO}: libtool wrapper (GNU $PACKAGE$TIMESTAMP) $VERSION\" 1>&2
fi
}
# Used when --lt-debug. Prints its arguments to stdout
# (redirection is the responsibility of the caller)
func_lt_dump_args ()
{
lt_dump_args_N=1;
for lt_arg
do
\$ECHO \"${outputname}:${output}:\${LINENO}: newargv[\$lt_dump_args_N]: \$lt_arg\"
lt_dump_args_N=\`expr \$lt_dump_args_N + 1\`
done
}
# Core function for launching the target application
func_exec_program_core ()
{
"
case $host in
# Backslashes separate directories on plain windows
*-*-mingw | *-*-os2* | *-cegcc*)
$ECHO "\
if test -n \"\$lt_option_debug\"; then
\$ECHO \"${outputname}:${output}:\${LINENO}: newargv[0]: \$progdir\\\\\$program\" 1>&2
func_lt_dump_args \${1+\"\$@\"} 1>&2
fi
exec \"\$progdir\\\\\$program\" \${1+\"\$@\"}
"
;;
*)
$ECHO "\
if test -n \"\$lt_option_debug\"; then
\$ECHO \"${outputname}:${output}:\${LINENO}: newargv[0]: \$progdir/\$program\" 1>&2
func_lt_dump_args \${1+\"\$@\"} 1>&2
fi
exec \"\$progdir/\$program\" \${1+\"\$@\"}
"
;;
esac
$ECHO "\
\$ECHO \"\$0: cannot exec \$program \$*\" 1>&2
exit 1
}
# A function to encapsulate launching the target application
# Strips options in the --lt-* namespace from \$@ and
# launches target application with the remaining arguments.
func_exec_program ()
{
case \" \$* \" in
*\\ --lt-*)
for lt_wr_arg
do
case \$lt_wr_arg in
--lt-*) ;;
*) set x \"\$@\" \"\$lt_wr_arg\"; shift;;
esac
shift
done ;;
esac
func_exec_program_core \${1+\"\$@\"}
}
# Parse options
func_parse_lt_options \"\$0\" \${1+\"\$@\"}
# Find the directory that this script lives in.
thisdir=\`\$ECHO \"\$file\" | $SED 's%/[^/]*$%%'\`
test \"x\$thisdir\" = \"x\$file\" && thisdir=.
# Follow symbolic links until we get to the real thisdir.
file=\`ls -ld \"\$file\" | $SED -n 's/.*-> //p'\`
while test -n \"\$file\"; do
destdir=\`\$ECHO \"\$file\" | $SED 's%/[^/]*\$%%'\`
# If there was a directory component, then change thisdir.
if test \"x\$destdir\" != \"x\$file\"; then
case \"\$destdir\" in
[\\\\/]* | [A-Za-z]:[\\\\/]*) thisdir=\"\$destdir\" ;;
*) thisdir=\"\$thisdir/\$destdir\" ;;
esac
fi
file=\`\$ECHO \"\$file\" | $SED 's%^.*/%%'\`
file=\`ls -ld \"\$thisdir/\$file\" | $SED -n 's/.*-> //p'\`
done
# Usually 'no', except on cygwin/mingw when embedded into
# the cwrapper.
WRAPPER_SCRIPT_BELONGS_IN_OBJDIR=$func_emit_wrapper_arg1
if test \"\$WRAPPER_SCRIPT_BELONGS_IN_OBJDIR\" = \"yes\"; then
# special case for '.'
if test \"\$thisdir\" = \".\"; then
thisdir=\`pwd\`
fi
# remove .libs from thisdir
case \"\$thisdir\" in
*[\\\\/]$objdir ) thisdir=\`\$ECHO \"\$thisdir\" | $SED 's%[\\\\/][^\\\\/]*$%%'\` ;;
$objdir ) thisdir=. ;;
esac
fi
# Try to get the absolute directory name.
absdir=\`cd \"\$thisdir\" && pwd\`
test -n \"\$absdir\" && thisdir=\"\$absdir\"
"
if test "$fast_install" = yes; then
$ECHO "\
program=lt-'$outputname'$exeext
progdir=\"\$thisdir/$objdir\"
if test ! -f \"\$progdir/\$program\" ||
{ file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | ${SED} 1q\`; \\
test \"X\$file\" != \"X\$progdir/\$program\"; }; then
file=\"\$\$-\$program\"
if test ! -d \"\$progdir\"; then
$MKDIR \"\$progdir\"
else
$RM \"\$progdir/\$file\"
fi"
$ECHO "\
# relink executable if necessary
if test -n \"\$relink_command\"; then
if relink_command_output=\`eval \$relink_command 2>&1\`; then :
else
$ECHO \"\$relink_command_output\" >&2
$RM \"\$progdir/\$file\"
exit 1
fi
fi
$MV \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null ||
{ $RM \"\$progdir/\$program\";
$MV \"\$progdir/\$file\" \"\$progdir/\$program\"; }
$RM \"\$progdir/\$file\"
fi"
else
$ECHO "\
program='$outputname'
progdir=\"\$thisdir/$objdir\"
"
fi
$ECHO "\
if test -f \"\$progdir/\$program\"; then"
# fixup the dll searchpath if we need to.
#
# Fix the DLL searchpath if we need to. Do this before prepending
# to shlibpath, because on Windows, both are PATH and uninstalled
# libraries must come first.
if test -n "$dllsearchpath"; then
$ECHO "\
# Add the dll search path components to the executable PATH
PATH=$dllsearchpath:\$PATH
"
fi
# Export our shlibpath_var if we have one.
if test "$shlibpath_overrides_runpath" = yes && test -n "$shlibpath_var" && test -n "$temp_rpath"; then
$ECHO "\
# Add our own library path to $shlibpath_var
$shlibpath_var=\"$temp_rpath\$$shlibpath_var\"
# Some systems cannot cope with colon-terminated $shlibpath_var
# The second colon is a workaround for a bug in BeOS R4 sed
$shlibpath_var=\`\$ECHO \"\$$shlibpath_var\" | $SED 's/::*\$//'\`
export $shlibpath_var
"
fi
$ECHO "\
if test \"\$libtool_execute_magic\" != \"$magic\"; then
# Run the actual program with our arguments.
func_exec_program \${1+\"\$@\"}
fi
else
# The program doesn't exist.
\$ECHO \"\$0: error: \\\`\$progdir/\$program' does not exist\" 1>&2
\$ECHO \"This script is just a wrapper for \$program.\" 1>&2
\$ECHO \"See the $PACKAGE documentation for more information.\" 1>&2
exit 1
fi
fi\
"
}
# func_emit_cwrapperexe_src
# emit the source code for a wrapper executable on stdout
# Must ONLY be called from within func_mode_link because
# it depends on a number of variable set therein.
func_emit_cwrapperexe_src ()
{
cat <
#include
#ifdef _MSC_VER
# include
# include
# include
#else
# include
# include
# ifdef __CYGWIN__
# include
# endif
#endif
#include
#include
#include
#include
#include
#include
#include
#include
/* declarations of non-ANSI functions */
#if defined(__MINGW32__)
# ifdef __STRICT_ANSI__
int _putenv (const char *);
# endif
#elif defined(__CYGWIN__)
# ifdef __STRICT_ANSI__
char *realpath (const char *, char *);
int putenv (char *);
int setenv (const char *, const char *, int);
# endif
/* #elif defined (other platforms) ... */
#endif
/* portability defines, excluding path handling macros */
#if defined(_MSC_VER)
# define setmode _setmode
# define stat _stat
# define chmod _chmod
# define getcwd _getcwd
# define putenv _putenv
# define S_IXUSR _S_IEXEC
# ifndef _INTPTR_T_DEFINED
# define _INTPTR_T_DEFINED
# define intptr_t int
# endif
#elif defined(__MINGW32__)
# define setmode _setmode
# define stat _stat
# define chmod _chmod
# define getcwd _getcwd
# define putenv _putenv
#elif defined(__CYGWIN__)
# define HAVE_SETENV
# define FOPEN_WB "wb"
/* #elif defined (other platforms) ... */
#endif
#if defined(PATH_MAX)
# define LT_PATHMAX PATH_MAX
#elif defined(MAXPATHLEN)
# define LT_PATHMAX MAXPATHLEN
#else
# define LT_PATHMAX 1024
#endif
#ifndef S_IXOTH
# define S_IXOTH 0
#endif
#ifndef S_IXGRP
# define S_IXGRP 0
#endif
/* path handling portability macros */
#ifndef DIR_SEPARATOR
# define DIR_SEPARATOR '/'
# define PATH_SEPARATOR ':'
#endif
#if defined (_WIN32) || defined (__MSDOS__) || defined (__DJGPP__) || \
defined (__OS2__)
# define HAVE_DOS_BASED_FILE_SYSTEM
# define FOPEN_WB "wb"
# ifndef DIR_SEPARATOR_2
# define DIR_SEPARATOR_2 '\\'
# endif
# ifndef PATH_SEPARATOR_2
# define PATH_SEPARATOR_2 ';'
# endif
#endif
#ifndef DIR_SEPARATOR_2
# define IS_DIR_SEPARATOR(ch) ((ch) == DIR_SEPARATOR)
#else /* DIR_SEPARATOR_2 */
# define IS_DIR_SEPARATOR(ch) \
(((ch) == DIR_SEPARATOR) || ((ch) == DIR_SEPARATOR_2))
#endif /* DIR_SEPARATOR_2 */
#ifndef PATH_SEPARATOR_2
# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR)
#else /* PATH_SEPARATOR_2 */
# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR_2)
#endif /* PATH_SEPARATOR_2 */
#ifndef FOPEN_WB
# define FOPEN_WB "w"
#endif
#ifndef _O_BINARY
# define _O_BINARY 0
#endif
#define XMALLOC(type, num) ((type *) xmalloc ((num) * sizeof(type)))
#define XFREE(stale) do { \
if (stale) { free ((void *) stale); stale = 0; } \
} while (0)
#if defined(LT_DEBUGWRAPPER)
static int lt_debug = 1;
#else
static int lt_debug = 0;
#endif
const char *program_name = "libtool-wrapper"; /* in case xstrdup fails */
void *xmalloc (size_t num);
char *xstrdup (const char *string);
const char *base_name (const char *name);
char *find_executable (const char *wrapper);
char *chase_symlinks (const char *pathspec);
int make_executable (const char *path);
int check_executable (const char *path);
char *strendzap (char *str, const char *pat);
void lt_debugprintf (const char *file, int line, const char *fmt, ...);
void lt_fatal (const char *file, int line, const char *message, ...);
static const char *nonnull (const char *s);
static const char *nonempty (const char *s);
void lt_setenv (const char *name, const char *value);
char *lt_extend_str (const char *orig_value, const char *add, int to_end);
void lt_update_exe_path (const char *name, const char *value);
void lt_update_lib_path (const char *name, const char *value);
char **prepare_spawn (char **argv);
void lt_dump_script (FILE *f);
EOF
cat <= 0)
&& (st.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH)))
return 1;
else
return 0;
}
int
make_executable (const char *path)
{
int rval = 0;
struct stat st;
lt_debugprintf (__FILE__, __LINE__, "(make_executable): %s\n",
nonempty (path));
if ((!path) || (!*path))
return 0;
if (stat (path, &st) >= 0)
{
rval = chmod (path, st.st_mode | S_IXOTH | S_IXGRP | S_IXUSR);
}
return rval;
}
/* Searches for the full path of the wrapper. Returns
newly allocated full path name if found, NULL otherwise
Does not chase symlinks, even on platforms that support them.
*/
char *
find_executable (const char *wrapper)
{
int has_slash = 0;
const char *p;
const char *p_next;
/* static buffer for getcwd */
char tmp[LT_PATHMAX + 1];
int tmp_len;
char *concat_name;
lt_debugprintf (__FILE__, __LINE__, "(find_executable): %s\n",
nonempty (wrapper));
if ((wrapper == NULL) || (*wrapper == '\0'))
return NULL;
/* Absolute path? */
#if defined (HAVE_DOS_BASED_FILE_SYSTEM)
if (isalpha ((unsigned char) wrapper[0]) && wrapper[1] == ':')
{
concat_name = xstrdup (wrapper);
if (check_executable (concat_name))
return concat_name;
XFREE (concat_name);
}
else
{
#endif
if (IS_DIR_SEPARATOR (wrapper[0]))
{
concat_name = xstrdup (wrapper);
if (check_executable (concat_name))
return concat_name;
XFREE (concat_name);
}
#if defined (HAVE_DOS_BASED_FILE_SYSTEM)
}
#endif
for (p = wrapper; *p; p++)
if (*p == '/')
{
has_slash = 1;
break;
}
if (!has_slash)
{
/* no slashes; search PATH */
const char *path = getenv ("PATH");
if (path != NULL)
{
for (p = path; *p; p = p_next)
{
const char *q;
size_t p_len;
for (q = p; *q; q++)
if (IS_PATH_SEPARATOR (*q))
break;
p_len = q - p;
p_next = (*q == '\0' ? q : q + 1);
if (p_len == 0)
{
/* empty path: current directory */
if (getcwd (tmp, LT_PATHMAX) == NULL)
lt_fatal (__FILE__, __LINE__, "getcwd failed: %s",
nonnull (strerror (errno)));
tmp_len = strlen (tmp);
concat_name =
XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1);
memcpy (concat_name, tmp, tmp_len);
concat_name[tmp_len] = '/';
strcpy (concat_name + tmp_len + 1, wrapper);
}
else
{
concat_name =
XMALLOC (char, p_len + 1 + strlen (wrapper) + 1);
memcpy (concat_name, p, p_len);
concat_name[p_len] = '/';
strcpy (concat_name + p_len + 1, wrapper);
}
if (check_executable (concat_name))
return concat_name;
XFREE (concat_name);
}
}
/* not found in PATH; assume curdir */
}
/* Relative path | not found in path: prepend cwd */
if (getcwd (tmp, LT_PATHMAX) == NULL)
lt_fatal (__FILE__, __LINE__, "getcwd failed: %s",
nonnull (strerror (errno)));
tmp_len = strlen (tmp);
concat_name = XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1);
memcpy (concat_name, tmp, tmp_len);
concat_name[tmp_len] = '/';
strcpy (concat_name + tmp_len + 1, wrapper);
if (check_executable (concat_name))
return concat_name;
XFREE (concat_name);
return NULL;
}
char *
chase_symlinks (const char *pathspec)
{
#ifndef S_ISLNK
return xstrdup (pathspec);
#else
char buf[LT_PATHMAX];
struct stat s;
char *tmp_pathspec = xstrdup (pathspec);
char *p;
int has_symlinks = 0;
while (strlen (tmp_pathspec) && !has_symlinks)
{
lt_debugprintf (__FILE__, __LINE__,
"checking path component for symlinks: %s\n",
tmp_pathspec);
if (lstat (tmp_pathspec, &s) == 0)
{
if (S_ISLNK (s.st_mode) != 0)
{
has_symlinks = 1;
break;
}
/* search backwards for last DIR_SEPARATOR */
p = tmp_pathspec + strlen (tmp_pathspec) - 1;
while ((p > tmp_pathspec) && (!IS_DIR_SEPARATOR (*p)))
p--;
if ((p == tmp_pathspec) && (!IS_DIR_SEPARATOR (*p)))
{
/* no more DIR_SEPARATORS left */
break;
}
*p = '\0';
}
else
{
lt_fatal (__FILE__, __LINE__,
"error accessing file \"%s\": %s",
tmp_pathspec, nonnull (strerror (errno)));
}
}
XFREE (tmp_pathspec);
if (!has_symlinks)
{
return xstrdup (pathspec);
}
tmp_pathspec = realpath (pathspec, buf);
if (tmp_pathspec == 0)
{
lt_fatal (__FILE__, __LINE__,
"could not follow symlinks for %s", pathspec);
}
return xstrdup (tmp_pathspec);
#endif
}
char *
strendzap (char *str, const char *pat)
{
size_t len, patlen;
assert (str != NULL);
assert (pat != NULL);
len = strlen (str);
patlen = strlen (pat);
if (patlen <= len)
{
str += len - patlen;
if (strcmp (str, pat) == 0)
*str = '\0';
}
return str;
}
void
lt_debugprintf (const char *file, int line, const char *fmt, ...)
{
va_list args;
if (lt_debug)
{
(void) fprintf (stderr, "%s:%s:%d: ", program_name, file, line);
va_start (args, fmt);
(void) vfprintf (stderr, fmt, args);
va_end (args);
}
}
static void
lt_error_core (int exit_status, const char *file,
int line, const char *mode,
const char *message, va_list ap)
{
fprintf (stderr, "%s:%s:%d: %s: ", program_name, file, line, mode);
vfprintf (stderr, message, ap);
fprintf (stderr, ".\n");
if (exit_status >= 0)
exit (exit_status);
}
void
lt_fatal (const char *file, int line, const char *message, ...)
{
va_list ap;
va_start (ap, message);
lt_error_core (EXIT_FAILURE, file, line, "FATAL", message, ap);
va_end (ap);
}
static const char *
nonnull (const char *s)
{
return s ? s : "(null)";
}
static const char *
nonempty (const char *s)
{
return (s && !*s) ? "(empty)" : nonnull (s);
}
void
lt_setenv (const char *name, const char *value)
{
lt_debugprintf (__FILE__, __LINE__,
"(lt_setenv) setting '%s' to '%s'\n",
nonnull (name), nonnull (value));
{
#ifdef HAVE_SETENV
/* always make a copy, for consistency with !HAVE_SETENV */
char *str = xstrdup (value);
setenv (name, str, 1);
#else
int len = strlen (name) + 1 + strlen (value) + 1;
char *str = XMALLOC (char, len);
sprintf (str, "%s=%s", name, value);
if (putenv (str) != EXIT_SUCCESS)
{
XFREE (str);
}
#endif
}
}
char *
lt_extend_str (const char *orig_value, const char *add, int to_end)
{
char *new_value;
if (orig_value && *orig_value)
{
int orig_value_len = strlen (orig_value);
int add_len = strlen (add);
new_value = XMALLOC (char, add_len + orig_value_len + 1);
if (to_end)
{
strcpy (new_value, orig_value);
strcpy (new_value + orig_value_len, add);
}
else
{
strcpy (new_value, add);
strcpy (new_value + add_len, orig_value);
}
}
else
{
new_value = xstrdup (add);
}
return new_value;
}
void
lt_update_exe_path (const char *name, const char *value)
{
lt_debugprintf (__FILE__, __LINE__,
"(lt_update_exe_path) modifying '%s' by prepending '%s'\n",
nonnull (name), nonnull (value));
if (name && *name && value && *value)
{
char *new_value = lt_extend_str (getenv (name), value, 0);
/* some systems can't cope with a ':'-terminated path #' */
int len = strlen (new_value);
while (((len = strlen (new_value)) > 0) && IS_PATH_SEPARATOR (new_value[len-1]))
{
new_value[len-1] = '\0';
}
lt_setenv (name, new_value);
XFREE (new_value);
}
}
void
lt_update_lib_path (const char *name, const char *value)
{
lt_debugprintf (__FILE__, __LINE__,
"(lt_update_lib_path) modifying '%s' by prepending '%s'\n",
nonnull (name), nonnull (value));
if (name && *name && value && *value)
{
char *new_value = lt_extend_str (getenv (name), value, 0);
lt_setenv (name, new_value);
XFREE (new_value);
}
}
EOF
case $host_os in
mingw*)
cat <<"EOF"
/* Prepares an argument vector before calling spawn().
Note that spawn() does not by itself call the command interpreter
(getenv ("COMSPEC") != NULL ? getenv ("COMSPEC") :
({ OSVERSIONINFO v; v.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&v);
v.dwPlatformId == VER_PLATFORM_WIN32_NT;
}) ? "cmd.exe" : "command.com").
Instead it simply concatenates the arguments, separated by ' ', and calls
CreateProcess(). We must quote the arguments since Win32 CreateProcess()
interprets characters like ' ', '\t', '\\', '"' (but not '<' and '>') in a
special way:
- Space and tab are interpreted as delimiters. They are not treated as
delimiters if they are surrounded by double quotes: "...".
- Unescaped double quotes are removed from the input. Their only effect is
that within double quotes, space and tab are treated like normal
characters.
- Backslashes not followed by double quotes are not special.
- But 2*n+1 backslashes followed by a double quote become
n backslashes followed by a double quote (n >= 0):
\" -> "
\\\" -> \"
\\\\\" -> \\"
*/
#define SHELL_SPECIAL_CHARS "\"\\ \001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037"
#define SHELL_SPACE_CHARS " \001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037"
char **
prepare_spawn (char **argv)
{
size_t argc;
char **new_argv;
size_t i;
/* Count number of arguments. */
for (argc = 0; argv[argc] != NULL; argc++)
;
/* Allocate new argument vector. */
new_argv = XMALLOC (char *, argc + 1);
/* Put quoted arguments into the new argument vector. */
for (i = 0; i < argc; i++)
{
const char *string = argv[i];
if (string[0] == '\0')
new_argv[i] = xstrdup ("\"\"");
else if (strpbrk (string, SHELL_SPECIAL_CHARS) != NULL)
{
int quote_around = (strpbrk (string, SHELL_SPACE_CHARS) != NULL);
size_t length;
unsigned int backslashes;
const char *s;
char *quoted_string;
char *p;
length = 0;
backslashes = 0;
if (quote_around)
length++;
for (s = string; *s != '\0'; s++)
{
char c = *s;
if (c == '"')
length += backslashes + 1;
length++;
if (c == '\\')
backslashes++;
else
backslashes = 0;
}
if (quote_around)
length += backslashes + 1;
quoted_string = XMALLOC (char, length + 1);
p = quoted_string;
backslashes = 0;
if (quote_around)
*p++ = '"';
for (s = string; *s != '\0'; s++)
{
char c = *s;
if (c == '"')
{
unsigned int j;
for (j = backslashes + 1; j > 0; j--)
*p++ = '\\';
}
*p++ = c;
if (c == '\\')
backslashes++;
else
backslashes = 0;
}
if (quote_around)
{
unsigned int j;
for (j = backslashes; j > 0; j--)
*p++ = '\\';
*p++ = '"';
}
*p = '\0';
new_argv[i] = quoted_string;
}
else
new_argv[i] = (char *) string;
}
new_argv[argc] = NULL;
return new_argv;
}
EOF
;;
esac
cat <<"EOF"
void lt_dump_script (FILE* f)
{
EOF
func_emit_wrapper yes |
$SED -n -e '
s/^\(.\{79\}\)\(..*\)/\1\
\2/
h
s/\([\\"]\)/\\\1/g
s/$/\\n/
s/\([^\n]*\).*/ fputs ("\1", f);/p
g
D'
cat <<"EOF"
}
EOF
}
# end: func_emit_cwrapperexe_src
# func_win32_import_lib_p ARG
# True if ARG is an import lib, as indicated by $file_magic_cmd
func_win32_import_lib_p ()
{
$opt_debug
case `eval $file_magic_cmd \"\$1\" 2>/dev/null | $SED -e 10q` in
*import*) : ;;
*) false ;;
esac
}
# func_mode_link arg...
func_mode_link ()
{
$opt_debug
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
# It is impossible to link a dll without this setting, and
# we shouldn't force the makefile maintainer to figure out
# which system we are compiling for in order to pass an extra
# flag for every libtool invocation.
# allow_undefined=no
# FIXME: Unfortunately, there are problems with the above when trying
# to make a dll which has undefined symbols, in which case not
# even a static library is built. For now, we need to specify
# -no-undefined on the libtool link line when we can be certain
# that all symbols are satisfied, otherwise we get a static library.
allow_undefined=yes
;;
*)
allow_undefined=yes
;;
esac
libtool_args=$nonopt
base_compile="$nonopt $@"
compile_command=$nonopt
finalize_command=$nonopt
compile_rpath=
finalize_rpath=
compile_shlibpath=
finalize_shlibpath=
convenience=
old_convenience=
deplibs=
old_deplibs=
compiler_flags=
linker_flags=
dllsearchpath=
lib_search_path=`pwd`
inst_prefix_dir=
new_inherited_linker_flags=
avoid_version=no
bindir=
dlfiles=
dlprefiles=
dlself=no
export_dynamic=no
export_symbols=
export_symbols_regex=
generated=
libobjs=
ltlibs=
module=no
no_install=no
objs=
non_pic_objects=
precious_files_regex=
prefer_static_libs=no
preload=no
prev=
prevarg=
release=
rpath=
xrpath=
perm_rpath=
temp_rpath=
thread_safe=no
vinfo=
vinfo_number=no
weak_libs=
single_module="${wl}-single_module"
func_infer_tag $base_compile
# We need to know -static, to get the right output filenames.
for arg
do
case $arg in
-shared)
test "$build_libtool_libs" != yes && \
func_fatal_configuration "can not build a shared library"
build_old_libs=no
break
;;
-all-static | -static | -static-libtool-libs)
case $arg in
-all-static)
if test "$build_libtool_libs" = yes && test -z "$link_static_flag"; then
func_warning "complete static linking is impossible in this configuration"
fi
if test -n "$link_static_flag"; then
dlopen_self=$dlopen_self_static
fi
prefer_static_libs=yes
;;
-static)
if test -z "$pic_flag" && test -n "$link_static_flag"; then
dlopen_self=$dlopen_self_static
fi
prefer_static_libs=built
;;
-static-libtool-libs)
if test -z "$pic_flag" && test -n "$link_static_flag"; then
dlopen_self=$dlopen_self_static
fi
prefer_static_libs=yes
;;
esac
build_libtool_libs=no
build_old_libs=yes
break
;;
esac
done
# See if our shared archives depend on static archives.
test -n "$old_archive_from_new_cmds" && build_old_libs=yes
# Go through the arguments, transforming them on the way.
while test "$#" -gt 0; do
arg="$1"
shift
func_quote_for_eval "$arg"
qarg=$func_quote_for_eval_unquoted_result
func_append libtool_args " $func_quote_for_eval_result"
# If the previous option needs an argument, assign it.
if test -n "$prev"; then
case $prev in
output)
func_append compile_command " @OUTPUT@"
func_append finalize_command " @OUTPUT@"
;;
esac
case $prev in
bindir)
bindir="$arg"
prev=
continue
;;
dlfiles|dlprefiles)
if test "$preload" = no; then
# Add the symbol object into the linking commands.
func_append compile_command " @SYMFILE@"
func_append finalize_command " @SYMFILE@"
preload=yes
fi
case $arg in
*.la | *.lo) ;; # We handle these cases below.
force)
if test "$dlself" = no; then
dlself=needless
export_dynamic=yes
fi
prev=
continue
;;
self)
if test "$prev" = dlprefiles; then
dlself=yes
elif test "$prev" = dlfiles && test "$dlopen_self" != yes; then
dlself=yes
else
dlself=needless
export_dynamic=yes
fi
prev=
continue
;;
*)
if test "$prev" = dlfiles; then
func_append dlfiles " $arg"
else
func_append dlprefiles " $arg"
fi
prev=
continue
;;
esac
;;
expsyms)
export_symbols="$arg"
test -f "$arg" \
|| func_fatal_error "symbol file \`$arg' does not exist"
prev=
continue
;;
expsyms_regex)
export_symbols_regex="$arg"
prev=
continue
;;
framework)
case $host in
*-*-darwin*)
case "$deplibs " in
*" $qarg.ltframework "*) ;;
*) func_append deplibs " $qarg.ltframework" # this is fixed later
;;
esac
;;
esac
prev=
continue
;;
inst_prefix)
inst_prefix_dir="$arg"
prev=
continue
;;
objectlist)
if test -f "$arg"; then
save_arg=$arg
moreargs=
for fil in `cat "$save_arg"`
do
# func_append moreargs " $fil"
arg=$fil
# A libtool-controlled object.
# Check to see that this really is a libtool object.
if func_lalib_unsafe_p "$arg"; then
pic_object=
non_pic_object=
# Read the .lo file
func_source "$arg"
if test -z "$pic_object" ||
test -z "$non_pic_object" ||
test "$pic_object" = none &&
test "$non_pic_object" = none; then
func_fatal_error "cannot find name of object for \`$arg'"
fi
# Extract subdirectory from the argument.
func_dirname "$arg" "/" ""
xdir="$func_dirname_result"
if test "$pic_object" != none; then
# Prepend the subdirectory the object is found in.
pic_object="$xdir$pic_object"
if test "$prev" = dlfiles; then
if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
func_append dlfiles " $pic_object"
prev=
continue
else
# If libtool objects are unsupported, then we need to preload.
prev=dlprefiles
fi
fi
# CHECK ME: I think I busted this. -Ossama
if test "$prev" = dlprefiles; then
# Preload the old-style object.
func_append dlprefiles " $pic_object"
prev=
fi
# A PIC object.
func_append libobjs " $pic_object"
arg="$pic_object"
fi
# Non-PIC object.
if test "$non_pic_object" != none; then
# Prepend the subdirectory the object is found in.
non_pic_object="$xdir$non_pic_object"
# A standard non-PIC object
func_append non_pic_objects " $non_pic_object"
if test -z "$pic_object" || test "$pic_object" = none ; then
arg="$non_pic_object"
fi
else
# If the PIC object exists, use it instead.
# $xdir was prepended to $pic_object above.
non_pic_object="$pic_object"
func_append non_pic_objects " $non_pic_object"
fi
else
# Only an error if not doing a dry-run.
if $opt_dry_run; then
# Extract subdirectory from the argument.
func_dirname "$arg" "/" ""
xdir="$func_dirname_result"
func_lo2o "$arg"
pic_object=$xdir$objdir/$func_lo2o_result
non_pic_object=$xdir$func_lo2o_result
func_append libobjs " $pic_object"
func_append non_pic_objects " $non_pic_object"
else
func_fatal_error "\`$arg' is not a valid libtool object"
fi
fi
done
else
func_fatal_error "link input file \`$arg' does not exist"
fi
arg=$save_arg
prev=
continue
;;
precious_regex)
precious_files_regex="$arg"
prev=
continue
;;
release)
release="-$arg"
prev=
continue
;;
rpath | xrpath)
# We need an absolute path.
case $arg in
[\\/]* | [A-Za-z]:[\\/]*) ;;
*)
func_fatal_error "only absolute run-paths are allowed"
;;
esac
if test "$prev" = rpath; then
case "$rpath " in
*" $arg "*) ;;
*) func_append rpath " $arg" ;;
esac
else
case "$xrpath " in
*" $arg "*) ;;
*) func_append xrpath " $arg" ;;
esac
fi
prev=
continue
;;
shrext)
shrext_cmds="$arg"
prev=
continue
;;
weak)
func_append weak_libs " $arg"
prev=
continue
;;
xcclinker)
func_append linker_flags " $qarg"
func_append compiler_flags " $qarg"
prev=
func_append compile_command " $qarg"
func_append finalize_command " $qarg"
continue
;;
xcompiler)
func_append compiler_flags " $qarg"
prev=
func_append compile_command " $qarg"
func_append finalize_command " $qarg"
continue
;;
xlinker)
func_append linker_flags " $qarg"
func_append compiler_flags " $wl$qarg"
prev=
func_append compile_command " $wl$qarg"
func_append finalize_command " $wl$qarg"
continue
;;
*)
eval "$prev=\"\$arg\""
prev=
continue
;;
esac
fi # test -n "$prev"
prevarg="$arg"
case $arg in
-all-static)
if test -n "$link_static_flag"; then
# See comment for -static flag below, for more details.
func_append compile_command " $link_static_flag"
func_append finalize_command " $link_static_flag"
fi
continue
;;
-allow-undefined)
# FIXME: remove this flag sometime in the future.
func_fatal_error "\`-allow-undefined' must not be used because it is the default"
;;
-avoid-version)
avoid_version=yes
continue
;;
-bindir)
prev=bindir
continue
;;
-dlopen)
prev=dlfiles
continue
;;
-dlpreopen)
prev=dlprefiles
continue
;;
-export-dynamic)
export_dynamic=yes
continue
;;
-export-symbols | -export-symbols-regex)
if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
func_fatal_error "more than one -exported-symbols argument is not allowed"
fi
if test "X$arg" = "X-export-symbols"; then
prev=expsyms
else
prev=expsyms_regex
fi
continue
;;
-framework)
prev=framework
continue
;;
-inst-prefix-dir)
prev=inst_prefix
continue
;;
# The native IRIX linker understands -LANG:*, -LIST:* and -LNO:*
# so, if we see these flags be careful not to treat them like -L
-L[A-Z][A-Z]*:*)
case $with_gcc/$host in
no/*-*-irix* | /*-*-irix*)
func_append compile_command " $arg"
func_append finalize_command " $arg"
;;
esac
continue
;;
-L*)
func_stripname "-L" '' "$arg"
if test -z "$func_stripname_result"; then
if test "$#" -gt 0; then
func_fatal_error "require no space between \`-L' and \`$1'"
else
func_fatal_error "need path for \`-L' option"
fi
fi
func_resolve_sysroot "$func_stripname_result"
dir=$func_resolve_sysroot_result
# We need an absolute path.
case $dir in
[\\/]* | [A-Za-z]:[\\/]*) ;;
*)
absdir=`cd "$dir" && pwd`
test -z "$absdir" && \
func_fatal_error "cannot determine absolute directory name of \`$dir'"
dir="$absdir"
;;
esac
case "$deplibs " in
*" -L$dir "* | *" $arg "*)
# Will only happen for absolute or sysroot arguments
;;
*)
# Preserve sysroot, but never include relative directories
case $dir in
[\\/]* | [A-Za-z]:[\\/]* | =*) func_append deplibs " $arg" ;;
*) func_append deplibs " -L$dir" ;;
esac
func_append lib_search_path " $dir"
;;
esac
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
testbindir=`$ECHO "$dir" | $SED 's*/lib$*/bin*'`
case :$dllsearchpath: in
*":$dir:"*) ;;
::) dllsearchpath=$dir;;
*) func_append dllsearchpath ":$dir";;
esac
case :$dllsearchpath: in
*":$testbindir:"*) ;;
::) dllsearchpath=$testbindir;;
*) func_append dllsearchpath ":$testbindir";;
esac
;;
esac
continue
;;
-l*)
if test "X$arg" = "X-lc" || test "X$arg" = "X-lm"; then
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-beos* | *-cegcc* | *-*-haiku*)
# These systems don't actually have a C or math library (as such)
continue
;;
*-*-os2*)
# These systems don't actually have a C library (as such)
test "X$arg" = "X-lc" && continue
;;
*-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
# Do not include libc due to us having libc/libc_r.
test "X$arg" = "X-lc" && continue
;;
*-*-rhapsody* | *-*-darwin1.[012])
# Rhapsody C and math libraries are in the System framework
func_append deplibs " System.ltframework"
continue
;;
*-*-sco3.2v5* | *-*-sco5v6*)
# Causes problems with __ctype
test "X$arg" = "X-lc" && continue
;;
*-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*)
# Compiler inserts libc in the correct place for threads to work
test "X$arg" = "X-lc" && continue
;;
esac
elif test "X$arg" = "X-lc_r"; then
case $host in
*-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
# Do not include libc_r directly, use -pthread flag.
continue
;;
esac
fi
func_append deplibs " $arg"
continue
;;
-module)
module=yes
continue
;;
# Tru64 UNIX uses -model [arg] to determine the layout of C++
# classes, name mangling, and exception handling.
# Darwin uses the -arch flag to determine output architecture.
-model|-arch|-isysroot|--sysroot)
func_append compiler_flags " $arg"
func_append compile_command " $arg"
func_append finalize_command " $arg"
prev=xcompiler
continue
;;
-mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe \
|-threads|-fopenmp|-openmp|-mp|-xopenmp|-omp|-qsmp=*)
func_append compiler_flags " $arg"
func_append compile_command " $arg"
func_append finalize_command " $arg"
case "$new_inherited_linker_flags " in
*" $arg "*) ;;
* ) func_append new_inherited_linker_flags " $arg" ;;
esac
continue
;;
-multi_module)
single_module="${wl}-multi_module"
continue
;;
-no-fast-install)
fast_install=no
continue
;;
-no-install)
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-darwin* | *-cegcc*)
# The PATH hackery in wrapper scripts is required on Windows
# and Darwin in order for the loader to find any dlls it needs.
func_warning "\`-no-install' is ignored for $host"
func_warning "assuming \`-no-fast-install' instead"
fast_install=no
;;
*) no_install=yes ;;
esac
continue
;;
-no-undefined)
allow_undefined=no
continue
;;
-objectlist)
prev=objectlist
continue
;;
-o) prev=output ;;
-precious-files-regex)
prev=precious_regex
continue
;;
-release)
prev=release
continue
;;
-rpath)
prev=rpath
continue
;;
-R)
prev=xrpath
continue
;;
-R*)
func_stripname '-R' '' "$arg"
dir=$func_stripname_result
# We need an absolute path.
case $dir in
[\\/]* | [A-Za-z]:[\\/]*) ;;
=*)
func_stripname '=' '' "$dir"
dir=$lt_sysroot$func_stripname_result
;;
*)
func_fatal_error "only absolute run-paths are allowed"
;;
esac
case "$xrpath " in
*" $dir "*) ;;
*) func_append xrpath " $dir" ;;
esac
continue
;;
-shared)
# The effects of -shared are defined in a previous loop.
continue
;;
-shrext)
prev=shrext
continue
;;
-static | -static-libtool-libs)
# The effects of -static are defined in a previous loop.
# We used to do the same as -all-static on platforms that
# didn't have a PIC flag, but the assumption that the effects
# would be equivalent was wrong. It would break on at least
# Digital Unix and AIX.
continue
;;
-thread-safe)
thread_safe=yes
continue
;;
-version-info)
prev=vinfo
continue
;;
-version-number)
prev=vinfo
vinfo_number=yes
continue
;;
-weak)
prev=weak
continue
;;
-Wc,*)
func_stripname '-Wc,' '' "$arg"
args=$func_stripname_result
arg=
save_ifs="$IFS"; IFS=','
for flag in $args; do
IFS="$save_ifs"
func_quote_for_eval "$flag"
func_append arg " $func_quote_for_eval_result"
func_append compiler_flags " $func_quote_for_eval_result"
done
IFS="$save_ifs"
func_stripname ' ' '' "$arg"
arg=$func_stripname_result
;;
-Wl,*)
func_stripname '-Wl,' '' "$arg"
args=$func_stripname_result
arg=
save_ifs="$IFS"; IFS=','
for flag in $args; do
IFS="$save_ifs"
func_quote_for_eval "$flag"
func_append arg " $wl$func_quote_for_eval_result"
func_append compiler_flags " $wl$func_quote_for_eval_result"
func_append linker_flags " $func_quote_for_eval_result"
done
IFS="$save_ifs"
func_stripname ' ' '' "$arg"
arg=$func_stripname_result
;;
-Xcompiler)
prev=xcompiler
continue
;;
-Xlinker)
prev=xlinker
continue
;;
-XCClinker)
prev=xcclinker
continue
;;
# -msg_* for osf cc
-msg_*)
func_quote_for_eval "$arg"
arg="$func_quote_for_eval_result"
;;
# Flags to be passed through unchanged, with rationale:
# -64, -mips[0-9] enable 64-bit mode for the SGI compiler
# -r[0-9][0-9]* specify processor for the SGI compiler
# -xarch=*, -xtarget=* enable 64-bit mode for the Sun compiler
# +DA*, +DD* enable 64-bit mode for the HP compiler
# -q* compiler args for the IBM compiler
# -m*, -t[45]*, -txscale* architecture-specific flags for GCC
# -F/path path to uninstalled frameworks, gcc on darwin
# -p, -pg, --coverage, -fprofile-* profiling flags for GCC
# @file GCC response files
# -tp=* Portland pgcc target processor selection
# --sysroot=* for sysroot support
# -O*, -flto*, -fwhopr*, -fuse-linker-plugin GCC link-time optimization
-64|-mips[0-9]|-r[0-9][0-9]*|-xarch=*|-xtarget=*|+DA*|+DD*|-q*|-m*| \
-t[45]*|-txscale*|-p|-pg|--coverage|-fprofile-*|-F*|@*|-tp=*|--sysroot=*| \
-O*|-flto*|-fwhopr*|-fuse-linker-plugin)
func_quote_for_eval "$arg"
arg="$func_quote_for_eval_result"
func_append compile_command " $arg"
func_append finalize_command " $arg"
func_append compiler_flags " $arg"
continue
;;
# Some other compiler flag.
-* | +*)
func_quote_for_eval "$arg"
arg="$func_quote_for_eval_result"
;;
*.$objext)
# A standard object.
func_append objs " $arg"
;;
*.lo)
# A libtool-controlled object.
# Check to see that this really is a libtool object.
if func_lalib_unsafe_p "$arg"; then
pic_object=
non_pic_object=
# Read the .lo file
func_source "$arg"
if test -z "$pic_object" ||
test -z "$non_pic_object" ||
test "$pic_object" = none &&
test "$non_pic_object" = none; then
func_fatal_error "cannot find name of object for \`$arg'"
fi
# Extract subdirectory from the argument.
func_dirname "$arg" "/" ""
xdir="$func_dirname_result"
if test "$pic_object" != none; then
# Prepend the subdirectory the object is found in.
pic_object="$xdir$pic_object"
if test "$prev" = dlfiles; then
if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
func_append dlfiles " $pic_object"
prev=
continue
else
# If libtool objects are unsupported, then we need to preload.
prev=dlprefiles
fi
fi
# CHECK ME: I think I busted this. -Ossama
if test "$prev" = dlprefiles; then
# Preload the old-style object.
func_append dlprefiles " $pic_object"
prev=
fi
# A PIC object.
func_append libobjs " $pic_object"
arg="$pic_object"
fi
# Non-PIC object.
if test "$non_pic_object" != none; then
# Prepend the subdirectory the object is found in.
non_pic_object="$xdir$non_pic_object"
# A standard non-PIC object
func_append non_pic_objects " $non_pic_object"
if test -z "$pic_object" || test "$pic_object" = none ; then
arg="$non_pic_object"
fi
else
# If the PIC object exists, use it instead.
# $xdir was prepended to $pic_object above.
non_pic_object="$pic_object"
func_append non_pic_objects " $non_pic_object"
fi
else
# Only an error if not doing a dry-run.
if $opt_dry_run; then
# Extract subdirectory from the argument.
func_dirname "$arg" "/" ""
xdir="$func_dirname_result"
func_lo2o "$arg"
pic_object=$xdir$objdir/$func_lo2o_result
non_pic_object=$xdir$func_lo2o_result
func_append libobjs " $pic_object"
func_append non_pic_objects " $non_pic_object"
else
func_fatal_error "\`$arg' is not a valid libtool object"
fi
fi
;;
*.$libext)
# An archive.
func_append deplibs " $arg"
func_append old_deplibs " $arg"
continue
;;
*.la)
# A libtool-controlled library.
func_resolve_sysroot "$arg"
if test "$prev" = dlfiles; then
# This library was specified with -dlopen.
func_append dlfiles " $func_resolve_sysroot_result"
prev=
elif test "$prev" = dlprefiles; then
# The library was specified with -dlpreopen.
func_append dlprefiles " $func_resolve_sysroot_result"
prev=
else
func_append deplibs " $func_resolve_sysroot_result"
fi
continue
;;
# Some other compiler argument.
*)
# Unknown arguments in both finalize_command and compile_command need
# to be aesthetically quoted because they are evaled later.
func_quote_for_eval "$arg"
arg="$func_quote_for_eval_result"
;;
esac # arg
# Now actually substitute the argument into the commands.
if test -n "$arg"; then
func_append compile_command " $arg"
func_append finalize_command " $arg"
fi
done # argument parsing loop
test -n "$prev" && \
func_fatal_help "the \`$prevarg' option requires an argument"
if test "$export_dynamic" = yes && test -n "$export_dynamic_flag_spec"; then
eval arg=\"$export_dynamic_flag_spec\"
func_append compile_command " $arg"
func_append finalize_command " $arg"
fi
oldlibs=
# calculate the name of the file, without its directory
func_basename "$output"
outputname="$func_basename_result"
libobjs_save="$libobjs"
if test -n "$shlibpath_var"; then
# get the directories listed in $shlibpath_var
eval shlib_search_path=\`\$ECHO \"\${$shlibpath_var}\" \| \$SED \'s/:/ /g\'\`
else
shlib_search_path=
fi
eval sys_lib_search_path=\"$sys_lib_search_path_spec\"
eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\"
func_dirname "$output" "/" ""
output_objdir="$func_dirname_result$objdir"
func_to_tool_file "$output_objdir/"
tool_output_objdir=$func_to_tool_file_result
# Create the object directory.
func_mkdir_p "$output_objdir"
# Determine the type of output
case $output in
"")
func_fatal_help "you must specify an output file"
;;
*.$libext) linkmode=oldlib ;;
*.lo | *.$objext) linkmode=obj ;;
*.la) linkmode=lib ;;
*) linkmode=prog ;; # Anything else should be a program.
esac
specialdeplibs=
libs=
# Find all interdependent deplibs by searching for libraries
# that are linked more than once (e.g. -la -lb -la)
for deplib in $deplibs; do
if $opt_preserve_dup_deps ; then
case "$libs " in
*" $deplib "*) func_append specialdeplibs " $deplib" ;;
esac
fi
func_append libs " $deplib"
done
if test "$linkmode" = lib; then
libs="$predeps $libs $compiler_lib_search_path $postdeps"
# Compute libraries that are listed more than once in $predeps
# $postdeps and mark them as special (i.e., whose duplicates are
# not to be eliminated).
pre_post_deps=
if $opt_duplicate_compiler_generated_deps; then
for pre_post_dep in $predeps $postdeps; do
case "$pre_post_deps " in
*" $pre_post_dep "*) func_append specialdeplibs " $pre_post_deps" ;;
esac
func_append pre_post_deps " $pre_post_dep"
done
fi
pre_post_deps=
fi
deplibs=
newdependency_libs=
newlib_search_path=
need_relink=no # whether we're linking any uninstalled libtool libraries
notinst_deplibs= # not-installed libtool libraries
notinst_path= # paths that contain not-installed libtool libraries
case $linkmode in
lib)
passes="conv dlpreopen link"
for file in $dlfiles $dlprefiles; do
case $file in
*.la) ;;
*)
func_fatal_help "libraries can \`-dlopen' only libtool libraries: $file"
;;
esac
done
;;
prog)
compile_deplibs=
finalize_deplibs=
alldeplibs=no
newdlfiles=
newdlprefiles=
passes="conv scan dlopen dlpreopen link"
;;
*) passes="conv"
;;
esac
for pass in $passes; do
# The preopen pass in lib mode reverses $deplibs; put it back here
# so that -L comes before libs that need it for instance...
if test "$linkmode,$pass" = "lib,link"; then
## FIXME: Find the place where the list is rebuilt in the wrong
## order, and fix it there properly
tmp_deplibs=
for deplib in $deplibs; do
tmp_deplibs="$deplib $tmp_deplibs"
done
deplibs="$tmp_deplibs"
fi
if test "$linkmode,$pass" = "lib,link" ||
test "$linkmode,$pass" = "prog,scan"; then
libs="$deplibs"
deplibs=
fi
if test "$linkmode" = prog; then
case $pass in
dlopen) libs="$dlfiles" ;;
dlpreopen) libs="$dlprefiles" ;;
link) libs="$deplibs %DEPLIBS% $dependency_libs" ;;
esac
fi
if test "$linkmode,$pass" = "lib,dlpreopen"; then
# Collect and forward deplibs of preopened libtool libs
for lib in $dlprefiles; do
# Ignore non-libtool-libs
dependency_libs=
func_resolve_sysroot "$lib"
case $lib in
*.la) func_source "$func_resolve_sysroot_result" ;;
esac
# Collect preopened libtool deplibs, except any this library
# has declared as weak libs
for deplib in $dependency_libs; do
func_basename "$deplib"
deplib_base=$func_basename_result
case " $weak_libs " in
*" $deplib_base "*) ;;
*) func_append deplibs " $deplib" ;;
esac
done
done
libs="$dlprefiles"
fi
if test "$pass" = dlopen; then
# Collect dlpreopened libraries
save_deplibs="$deplibs"
deplibs=
fi
for deplib in $libs; do
lib=
found=no
case $deplib in
-mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe \
|-threads|-fopenmp|-openmp|-mp|-xopenmp|-omp|-qsmp=*)
if test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
func_append compiler_flags " $deplib"
if test "$linkmode" = lib ; then
case "$new_inherited_linker_flags " in
*" $deplib "*) ;;
* ) func_append new_inherited_linker_flags " $deplib" ;;
esac
fi
fi
continue
;;
-l*)
if test "$linkmode" != lib && test "$linkmode" != prog; then
func_warning "\`-l' is ignored for archives/objects"
continue
fi
func_stripname '-l' '' "$deplib"
name=$func_stripname_result
if test "$linkmode" = lib; then
searchdirs="$newlib_search_path $lib_search_path $compiler_lib_search_dirs $sys_lib_search_path $shlib_search_path"
else
searchdirs="$newlib_search_path $lib_search_path $sys_lib_search_path $shlib_search_path"
fi
for searchdir in $searchdirs; do
for search_ext in .la $std_shrext .so .a; do
# Search the libtool library
lib="$searchdir/lib${name}${search_ext}"
if test -f "$lib"; then
if test "$search_ext" = ".la"; then
found=yes
else
found=no
fi
break 2
fi
done
done
if test "$found" != yes; then
# deplib doesn't seem to be a libtool library
if test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
deplibs="$deplib $deplibs"
test "$linkmode" = lib && newdependency_libs="$deplib $newdependency_libs"
fi
continue
else # deplib is a libtool library
# If $allow_libtool_libs_with_static_runtimes && $deplib is a stdlib,
# We need to do some special things here, and not later.
if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
case " $predeps $postdeps " in
*" $deplib "*)
if func_lalib_p "$lib"; then
library_names=
old_library=
func_source "$lib"
for l in $old_library $library_names; do
ll="$l"
done
if test "X$ll" = "X$old_library" ; then # only static version available
found=no
func_dirname "$lib" "" "."
ladir="$func_dirname_result"
lib=$ladir/$old_library
if test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
deplibs="$deplib $deplibs"
test "$linkmode" = lib && newdependency_libs="$deplib $newdependency_libs"
fi
continue
fi
fi
;;
*) ;;
esac
fi
fi
;; # -l
*.ltframework)
if test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
deplibs="$deplib $deplibs"
if test "$linkmode" = lib ; then
case "$new_inherited_linker_flags " in
*" $deplib "*) ;;
* ) func_append new_inherited_linker_flags " $deplib" ;;
esac
fi
fi
continue
;;
-L*)
case $linkmode in
lib)
deplibs="$deplib $deplibs"
test "$pass" = conv && continue
newdependency_libs="$deplib $newdependency_libs"
func_stripname '-L' '' "$deplib"
func_resolve_sysroot "$func_stripname_result"
func_append newlib_search_path " $func_resolve_sysroot_result"
;;
prog)
if test "$pass" = conv; then
deplibs="$deplib $deplibs"
continue
fi
if test "$pass" = scan; then
deplibs="$deplib $deplibs"
else
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
fi
func_stripname '-L' '' "$deplib"
func_resolve_sysroot "$func_stripname_result"
func_append newlib_search_path " $func_resolve_sysroot_result"
;;
*)
func_warning "\`-L' is ignored for archives/objects"
;;
esac # linkmode
continue
;; # -L
-R*)
if test "$pass" = link; then
func_stripname '-R' '' "$deplib"
func_resolve_sysroot "$func_stripname_result"
dir=$func_resolve_sysroot_result
# Make sure the xrpath contains only unique directories.
case "$xrpath " in
*" $dir "*) ;;
*) func_append xrpath " $dir" ;;
esac
fi
deplibs="$deplib $deplibs"
continue
;;
*.la)
func_resolve_sysroot "$deplib"
lib=$func_resolve_sysroot_result
;;
*.$libext)
if test "$pass" = conv; then
deplibs="$deplib $deplibs"
continue
fi
case $linkmode in
lib)
# Linking convenience modules into shared libraries is allowed,
# but linking other static libraries is non-portable.
case " $dlpreconveniencelibs " in
*" $deplib "*) ;;
*)
valid_a_lib=no
case $deplibs_check_method in
match_pattern*)
set dummy $deplibs_check_method; shift
match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
if eval "\$ECHO \"$deplib\"" 2>/dev/null | $SED 10q \
| $EGREP "$match_pattern_regex" > /dev/null; then
valid_a_lib=yes
fi
;;
pass_all)
valid_a_lib=yes
;;
esac
if test "$valid_a_lib" != yes; then
echo
$ECHO "*** Warning: Trying to link with static lib archive $deplib."
echo "*** I have the capability to make that library automatically link in when"
echo "*** you link to this library. But I can only do this if you have a"
echo "*** shared version of the library, which you do not appear to have"
echo "*** because the file extensions .$libext of this argument makes me believe"
echo "*** that it is just a static archive that I should not use here."
else
echo
$ECHO "*** Warning: Linking the shared library $output against the"
$ECHO "*** static library $deplib is not portable!"
deplibs="$deplib $deplibs"
fi
;;
esac
continue
;;
prog)
if test "$pass" != link; then
deplibs="$deplib $deplibs"
else
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
fi
continue
;;
esac # linkmode
;; # *.$libext
*.lo | *.$objext)
if test "$pass" = conv; then
deplibs="$deplib $deplibs"
elif test "$linkmode" = prog; then
if test "$pass" = dlpreopen || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
# If there is no dlopen support or we're linking statically,
# we need to preload.
func_append newdlprefiles " $deplib"
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
func_append newdlfiles " $deplib"
fi
fi
continue
;;
%DEPLIBS%)
alldeplibs=yes
continue
;;
esac # case $deplib
if test "$found" = yes || test -f "$lib"; then :
else
func_fatal_error "cannot find the library \`$lib' or unhandled argument \`$deplib'"
fi
# Check to see that this really is a libtool archive.
func_lalib_unsafe_p "$lib" \
|| func_fatal_error "\`$lib' is not a valid libtool archive"
func_dirname "$lib" "" "."
ladir="$func_dirname_result"
dlname=
dlopen=
dlpreopen=
libdir=
library_names=
old_library=
inherited_linker_flags=
# If the library was installed with an old release of libtool,
# it will not redefine variables installed, or shouldnotlink
installed=yes
shouldnotlink=no
avoidtemprpath=
# Read the .la file
func_source "$lib"
# Convert "-framework foo" to "foo.ltframework"
if test -n "$inherited_linker_flags"; then
tmp_inherited_linker_flags=`$ECHO "$inherited_linker_flags" | $SED 's/-framework \([^ $]*\)/\1.ltframework/g'`
for tmp_inherited_linker_flag in $tmp_inherited_linker_flags; do
case " $new_inherited_linker_flags " in
*" $tmp_inherited_linker_flag "*) ;;
*) func_append new_inherited_linker_flags " $tmp_inherited_linker_flag";;
esac
done
fi
dependency_libs=`$ECHO " $dependency_libs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
if test "$linkmode,$pass" = "lib,link" ||
test "$linkmode,$pass" = "prog,scan" ||
{ test "$linkmode" != prog && test "$linkmode" != lib; }; then
test -n "$dlopen" && func_append dlfiles " $dlopen"
test -n "$dlpreopen" && func_append dlprefiles " $dlpreopen"
fi
if test "$pass" = conv; then
# Only check for convenience libraries
deplibs="$lib $deplibs"
if test -z "$libdir"; then
if test -z "$old_library"; then
func_fatal_error "cannot find name of link library for \`$lib'"
fi
# It is a libtool convenience library, so add in its objects.
func_append convenience " $ladir/$objdir/$old_library"
func_append old_convenience " $ladir/$objdir/$old_library"
elif test "$linkmode" != prog && test "$linkmode" != lib; then
func_fatal_error "\`$lib' is not a convenience library"
fi
tmp_libs=
for deplib in $dependency_libs; do
deplibs="$deplib $deplibs"
if $opt_preserve_dup_deps ; then
case "$tmp_libs " in
*" $deplib "*) func_append specialdeplibs " $deplib" ;;
esac
fi
func_append tmp_libs " $deplib"
done
continue
fi # $pass = conv
# Get the name of the library we link against.
linklib=
if test -n "$old_library" &&
{ test "$prefer_static_libs" = yes ||
test "$prefer_static_libs,$installed" = "built,no"; }; then
linklib=$old_library
else
for l in $old_library $library_names; do
linklib="$l"
done
fi
if test -z "$linklib"; then
func_fatal_error "cannot find name of link library for \`$lib'"
fi
# This library was specified with -dlopen.
if test "$pass" = dlopen; then
if test -z "$libdir"; then
func_fatal_error "cannot -dlopen a convenience library: \`$lib'"
fi
if test -z "$dlname" ||
test "$dlopen_support" != yes ||
test "$build_libtool_libs" = no; then
# If there is no dlname, no dlopen support or we're linking
# statically, we need to preload. We also need to preload any
# dependent libraries so libltdl's deplib preloader doesn't
# bomb out in the load deplibs phase.
func_append dlprefiles " $lib $dependency_libs"
else
func_append newdlfiles " $lib"
fi
continue
fi # $pass = dlopen
# We need an absolute path.
case $ladir in
[\\/]* | [A-Za-z]:[\\/]*) abs_ladir="$ladir" ;;
*)
abs_ladir=`cd "$ladir" && pwd`
if test -z "$abs_ladir"; then
func_warning "cannot determine absolute directory name of \`$ladir'"
func_warning "passing it literally to the linker, although it might fail"
abs_ladir="$ladir"
fi
;;
esac
func_basename "$lib"
laname="$func_basename_result"
# Find the relevant object directory and library name.
if test "X$installed" = Xyes; then
if test ! -f "$lt_sysroot$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then
func_warning "library \`$lib' was moved."
dir="$ladir"
absdir="$abs_ladir"
libdir="$abs_ladir"
else
dir="$lt_sysroot$libdir"
absdir="$lt_sysroot$libdir"
fi
test "X$hardcode_automatic" = Xyes && avoidtemprpath=yes
else
if test ! -f "$ladir/$objdir/$linklib" && test -f "$abs_ladir/$linklib"; then
dir="$ladir"
absdir="$abs_ladir"
# Remove this search path later
func_append notinst_path " $abs_ladir"
else
dir="$ladir/$objdir"
absdir="$abs_ladir/$objdir"
# Remove this search path later
func_append notinst_path " $abs_ladir"
fi
fi # $installed = yes
func_stripname 'lib' '.la' "$laname"
name=$func_stripname_result
# This library was specified with -dlpreopen.
if test "$pass" = dlpreopen; then
if test -z "$libdir" && test "$linkmode" = prog; then
func_fatal_error "only libraries may -dlpreopen a convenience library: \`$lib'"
fi
case "$host" in
# special handling for platforms with PE-DLLs.
*cygwin* | *mingw* | *cegcc* )
# Linker will automatically link against shared library if both
# static and shared are present. Therefore, ensure we extract
# symbols from the import library if a shared library is present
# (otherwise, the dlopen module name will be incorrect). We do
# this by putting the import library name into $newdlprefiles.
# We recover the dlopen module name by 'saving' the la file
# name in a special purpose variable, and (later) extracting the
# dlname from the la file.
if test -n "$dlname"; then
func_tr_sh "$dir/$linklib"
eval "libfile_$func_tr_sh_result=\$abs_ladir/\$laname"
func_append newdlprefiles " $dir/$linklib"
else
func_append newdlprefiles " $dir/$old_library"
# Keep a list of preopened convenience libraries to check
# that they are being used correctly in the link pass.
test -z "$libdir" && \
func_append dlpreconveniencelibs " $dir/$old_library"
fi
;;
* )
# Prefer using a static library (so that no silly _DYNAMIC symbols
# are required to link).
if test -n "$old_library"; then
func_append newdlprefiles " $dir/$old_library"
# Keep a list of preopened convenience libraries to check
# that they are being used correctly in the link pass.
test -z "$libdir" && \
func_append dlpreconveniencelibs " $dir/$old_library"
# Otherwise, use the dlname, so that lt_dlopen finds it.
elif test -n "$dlname"; then
func_append newdlprefiles " $dir/$dlname"
else
func_append newdlprefiles " $dir/$linklib"
fi
;;
esac
fi # $pass = dlpreopen
if test -z "$libdir"; then
# Link the convenience library
if test "$linkmode" = lib; then
deplibs="$dir/$old_library $deplibs"
elif test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$dir/$old_library $compile_deplibs"
finalize_deplibs="$dir/$old_library $finalize_deplibs"
else
deplibs="$lib $deplibs" # used for prog,scan pass
fi
continue
fi
if test "$linkmode" = prog && test "$pass" != link; then
func_append newlib_search_path " $ladir"
deplibs="$lib $deplibs"
linkalldeplibs=no
if test "$link_all_deplibs" != no || test -z "$library_names" ||
test "$build_libtool_libs" = no; then
linkalldeplibs=yes
fi
tmp_libs=
for deplib in $dependency_libs; do
case $deplib in
-L*) func_stripname '-L' '' "$deplib"
func_resolve_sysroot "$func_stripname_result"
func_append newlib_search_path " $func_resolve_sysroot_result"
;;
esac
# Need to link against all dependency_libs?
if test "$linkalldeplibs" = yes; then
deplibs="$deplib $deplibs"
else
# Need to hardcode shared library paths
# or/and link against static libraries
newdependency_libs="$deplib $newdependency_libs"
fi
if $opt_preserve_dup_deps ; then
case "$tmp_libs " in
*" $deplib "*) func_append specialdeplibs " $deplib" ;;
esac
fi
func_append tmp_libs " $deplib"
done # for deplib
continue
fi # $linkmode = prog...
if test "$linkmode,$pass" = "prog,link"; then
if test -n "$library_names" &&
{ { test "$prefer_static_libs" = no ||
test "$prefer_static_libs,$installed" = "built,yes"; } ||
test -z "$old_library"; }; then
# We need to hardcode the library path
if test -n "$shlibpath_var" && test -z "$avoidtemprpath" ; then
# Make sure the rpath contains only unique directories.
case "$temp_rpath:" in
*"$absdir:"*) ;;
*) func_append temp_rpath "$absdir:" ;;
esac
fi
# Hardcode the library path.
# Skip directories that are in the system default run-time
# search path.
case " $sys_lib_dlsearch_path " in
*" $absdir "*) ;;
*)
case "$compile_rpath " in
*" $absdir "*) ;;
*) func_append compile_rpath " $absdir" ;;
esac
;;
esac
case " $sys_lib_dlsearch_path " in
*" $libdir "*) ;;
*)
case "$finalize_rpath " in
*" $libdir "*) ;;
*) func_append finalize_rpath " $libdir" ;;
esac
;;
esac
fi # $linkmode,$pass = prog,link...
if test "$alldeplibs" = yes &&
{ test "$deplibs_check_method" = pass_all ||
{ test "$build_libtool_libs" = yes &&
test -n "$library_names"; }; }; then
# We only need to search for static libraries
continue
fi
fi
link_static=no # Whether the deplib will be linked statically
use_static_libs=$prefer_static_libs
if test "$use_static_libs" = built && test "$installed" = yes; then
use_static_libs=no
fi
if test -n "$library_names" &&
{ test "$use_static_libs" = no || test -z "$old_library"; }; then
case $host in
*cygwin* | *mingw* | *cegcc*)
# No point in relinking DLLs because paths are not encoded
func_append notinst_deplibs " $lib"
need_relink=no
;;
*)
if test "$installed" = no; then
func_append notinst_deplibs " $lib"
need_relink=yes
fi
;;
esac
# This is a shared library
# Warn about portability, can't link against -module's on some
# systems (darwin). Don't bleat about dlopened modules though!
dlopenmodule=""
for dlpremoduletest in $dlprefiles; do
if test "X$dlpremoduletest" = "X$lib"; then
dlopenmodule="$dlpremoduletest"
break
fi
done
if test -z "$dlopenmodule" && test "$shouldnotlink" = yes && test "$pass" = link; then
echo
if test "$linkmode" = prog; then
$ECHO "*** Warning: Linking the executable $output against the loadable module"
else
$ECHO "*** Warning: Linking the shared library $output against the loadable module"
fi
$ECHO "*** $linklib is not portable!"
fi
if test "$linkmode" = lib &&
test "$hardcode_into_libs" = yes; then
# Hardcode the library path.
# Skip directories that are in the system default run-time
# search path.
case " $sys_lib_dlsearch_path " in
*" $absdir "*) ;;
*)
case "$compile_rpath " in
*" $absdir "*) ;;
*) func_append compile_rpath " $absdir" ;;
esac
;;
esac
case " $sys_lib_dlsearch_path " in
*" $libdir "*) ;;
*)
case "$finalize_rpath " in
*" $libdir "*) ;;
*) func_append finalize_rpath " $libdir" ;;
esac
;;
esac
fi
if test -n "$old_archive_from_expsyms_cmds"; then
# figure out the soname
set dummy $library_names
shift
realname="$1"
shift
libname=`eval "\\$ECHO \"$libname_spec\""`
# use dlname if we got it. it's perfectly good, no?
if test -n "$dlname"; then
soname="$dlname"
elif test -n "$soname_spec"; then
# bleh windows
case $host in
*cygwin* | mingw* | *cegcc*)
func_arith $current - $age
major=$func_arith_result
versuffix="-$major"
;;
esac
eval soname=\"$soname_spec\"
else
soname="$realname"
fi
# Make a new name for the extract_expsyms_cmds to use
soroot="$soname"
func_basename "$soroot"
soname="$func_basename_result"
func_stripname 'lib' '.dll' "$soname"
newlib=libimp-$func_stripname_result.a
# If the library has no export list, then create one now
if test -f "$output_objdir/$soname-def"; then :
else
func_verbose "extracting exported symbol list from \`$soname'"
func_execute_cmds "$extract_expsyms_cmds" 'exit $?'
fi
# Create $newlib
if test -f "$output_objdir/$newlib"; then :; else
func_verbose "generating import library for \`$soname'"
func_execute_cmds "$old_archive_from_expsyms_cmds" 'exit $?'
fi
# make sure the library variables are pointing to the new library
dir=$output_objdir
linklib=$newlib
fi # test -n "$old_archive_from_expsyms_cmds"
if test "$linkmode" = prog || test "$opt_mode" != relink; then
add_shlibpath=
add_dir=
add=
lib_linked=yes
case $hardcode_action in
immediate | unsupported)
if test "$hardcode_direct" = no; then
add="$dir/$linklib"
case $host in
*-*-sco3.2v5.0.[024]*) add_dir="-L$dir" ;;
*-*-sysv4*uw2*) add_dir="-L$dir" ;;
*-*-sysv5OpenUNIX* | *-*-sysv5UnixWare7.[01].[10]* | \
*-*-unixware7*) add_dir="-L$dir" ;;
*-*-darwin* )
# if the lib is a (non-dlopened) module then we can not
# link against it, someone is ignoring the earlier warnings
if /usr/bin/file -L $add 2> /dev/null |
$GREP ": [^:]* bundle" >/dev/null ; then
if test "X$dlopenmodule" != "X$lib"; then
$ECHO "*** Warning: lib $linklib is a module, not a shared library"
if test -z "$old_library" ; then
echo
echo "*** And there doesn't seem to be a static archive available"
echo "*** The link will probably fail, sorry"
else
add="$dir/$old_library"
fi
elif test -n "$old_library"; then
add="$dir/$old_library"
fi
fi
esac
elif test "$hardcode_minus_L" = no; then
case $host in
*-*-sunos*) add_shlibpath="$dir" ;;
esac
add_dir="-L$dir"
add="-l$name"
elif test "$hardcode_shlibpath_var" = no; then
add_shlibpath="$dir"
add="-l$name"
else
lib_linked=no
fi
;;
relink)
if test "$hardcode_direct" = yes &&
test "$hardcode_direct_absolute" = no; then
add="$dir/$linklib"
elif test "$hardcode_minus_L" = yes; then
add_dir="-L$absdir"
# Try looking first in the location we're being installed to.
if test -n "$inst_prefix_dir"; then
case $libdir in
[\\/]*)
func_append add_dir " -L$inst_prefix_dir$libdir"
;;
esac
fi
add="-l$name"
elif test "$hardcode_shlibpath_var" = yes; then
add_shlibpath="$dir"
add="-l$name"
else
lib_linked=no
fi
;;
*) lib_linked=no ;;
esac
if test "$lib_linked" != yes; then
func_fatal_configuration "unsupported hardcode properties"
fi
if test -n "$add_shlibpath"; then
case :$compile_shlibpath: in
*":$add_shlibpath:"*) ;;
*) func_append compile_shlibpath "$add_shlibpath:" ;;
esac
fi
if test "$linkmode" = prog; then
test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs"
test -n "$add" && compile_deplibs="$add $compile_deplibs"
else
test -n "$add_dir" && deplibs="$add_dir $deplibs"
test -n "$add" && deplibs="$add $deplibs"
if test "$hardcode_direct" != yes &&
test "$hardcode_minus_L" != yes &&
test "$hardcode_shlibpath_var" = yes; then
case :$finalize_shlibpath: in
*":$libdir:"*) ;;
*) func_append finalize_shlibpath "$libdir:" ;;
esac
fi
fi
fi
if test "$linkmode" = prog || test "$opt_mode" = relink; then
add_shlibpath=
add_dir=
add=
# Finalize command for both is simple: just hardcode it.
if test "$hardcode_direct" = yes &&
test "$hardcode_direct_absolute" = no; then
add="$libdir/$linklib"
elif test "$hardcode_minus_L" = yes; then
add_dir="-L$libdir"
add="-l$name"
elif test "$hardcode_shlibpath_var" = yes; then
case :$finalize_shlibpath: in
*":$libdir:"*) ;;
*) func_append finalize_shlibpath "$libdir:" ;;
esac
add="-l$name"
elif test "$hardcode_automatic" = yes; then
if test -n "$inst_prefix_dir" &&
test -f "$inst_prefix_dir$libdir/$linklib" ; then
add="$inst_prefix_dir$libdir/$linklib"
else
add="$libdir/$linklib"
fi
else
# We cannot seem to hardcode it, guess we'll fake it.
add_dir="-L$libdir"
# Try looking first in the location we're being installed to.
if test -n "$inst_prefix_dir"; then
case $libdir in
[\\/]*)
func_append add_dir " -L$inst_prefix_dir$libdir"
;;
esac
fi
add="-l$name"
fi
if test "$linkmode" = prog; then
test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs"
test -n "$add" && finalize_deplibs="$add $finalize_deplibs"
else
test -n "$add_dir" && deplibs="$add_dir $deplibs"
test -n "$add" && deplibs="$add $deplibs"
fi
fi
elif test "$linkmode" = prog; then
# Here we assume that one of hardcode_direct or hardcode_minus_L
# is not unsupported. This is valid on all known static and
# shared platforms.
if test "$hardcode_direct" != unsupported; then
test -n "$old_library" && linklib="$old_library"
compile_deplibs="$dir/$linklib $compile_deplibs"
finalize_deplibs="$dir/$linklib $finalize_deplibs"
else
compile_deplibs="-l$name -L$dir $compile_deplibs"
finalize_deplibs="-l$name -L$dir $finalize_deplibs"
fi
elif test "$build_libtool_libs" = yes; then
# Not a shared library
if test "$deplibs_check_method" != pass_all; then
# We're trying link a shared library against a static one
# but the system doesn't support it.
# Just print a warning and add the library to dependency_libs so
# that the program can be linked against the static library.
echo
$ECHO "*** Warning: This system can not link to static lib archive $lib."
echo "*** I have the capability to make that library automatically link in when"
echo "*** you link to this library. But I can only do this if you have a"
echo "*** shared version of the library, which you do not appear to have."
if test "$module" = yes; then
echo "*** But as you try to build a module library, libtool will still create "
echo "*** a static module, that should work as long as the dlopening application"
echo "*** is linked with the -dlopen flag to resolve symbols at runtime."
if test -z "$global_symbol_pipe"; then
echo
echo "*** However, this would only work if libtool was able to extract symbol"
echo "*** lists from a program, using \`nm' or equivalent, but libtool could"
echo "*** not find such a program. So, this module is probably useless."
echo "*** \`nm' from GNU binutils and a full rebuild may help."
fi
if test "$build_old_libs" = no; then
build_libtool_libs=module
build_old_libs=yes
else
build_libtool_libs=no
fi
fi
else
deplibs="$dir/$old_library $deplibs"
link_static=yes
fi
fi # link shared/static library?
if test "$linkmode" = lib; then
if test -n "$dependency_libs" &&
{ test "$hardcode_into_libs" != yes ||
test "$build_old_libs" = yes ||
test "$link_static" = yes; }; then
# Extract -R from dependency_libs
temp_deplibs=
for libdir in $dependency_libs; do
case $libdir in
-R*) func_stripname '-R' '' "$libdir"
temp_xrpath=$func_stripname_result
case " $xrpath " in
*" $temp_xrpath "*) ;;
*) func_append xrpath " $temp_xrpath";;
esac;;
*) func_append temp_deplibs " $libdir";;
esac
done
dependency_libs="$temp_deplibs"
fi
func_append newlib_search_path " $absdir"
# Link against this library
test "$link_static" = no && newdependency_libs="$abs_ladir/$laname $newdependency_libs"
# ... and its dependency_libs
tmp_libs=
for deplib in $dependency_libs; do
newdependency_libs="$deplib $newdependency_libs"
case $deplib in
-L*) func_stripname '-L' '' "$deplib"
func_resolve_sysroot "$func_stripname_result";;
*) func_resolve_sysroot "$deplib" ;;
esac
if $opt_preserve_dup_deps ; then
case "$tmp_libs " in
*" $func_resolve_sysroot_result "*)
func_append specialdeplibs " $func_resolve_sysroot_result" ;;
esac
fi
func_append tmp_libs " $func_resolve_sysroot_result"
done
if test "$link_all_deplibs" != no; then
# Add the search paths of all dependency libraries
for deplib in $dependency_libs; do
path=
case $deplib in
-L*) path="$deplib" ;;
*.la)
func_resolve_sysroot "$deplib"
deplib=$func_resolve_sysroot_result
func_dirname "$deplib" "" "."
dir=$func_dirname_result
# We need an absolute path.
case $dir in
[\\/]* | [A-Za-z]:[\\/]*) absdir="$dir" ;;
*)
absdir=`cd "$dir" && pwd`
if test -z "$absdir"; then
func_warning "cannot determine absolute directory name of \`$dir'"
absdir="$dir"
fi
;;
esac
if $GREP "^installed=no" $deplib > /dev/null; then
case $host in
*-*-darwin*)
depdepl=
eval deplibrary_names=`${SED} -n -e 's/^library_names=\(.*\)$/\1/p' $deplib`
if test -n "$deplibrary_names" ; then
for tmp in $deplibrary_names ; do
depdepl=$tmp
done
if test -f "$absdir/$objdir/$depdepl" ; then
depdepl="$absdir/$objdir/$depdepl"
darwin_install_name=`${OTOOL} -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'`
if test -z "$darwin_install_name"; then
darwin_install_name=`${OTOOL64} -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'`
fi
func_append compiler_flags " ${wl}-dylib_file ${wl}${darwin_install_name}:${depdepl}"
func_append linker_flags " -dylib_file ${darwin_install_name}:${depdepl}"
path=
fi
fi
;;
*)
path="-L$absdir/$objdir"
;;
esac
else
eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
test -z "$libdir" && \
func_fatal_error "\`$deplib' is not a valid libtool archive"
test "$absdir" != "$libdir" && \
func_warning "\`$deplib' seems to be moved"
path="-L$absdir"
fi
;;
esac
case " $deplibs " in
*" $path "*) ;;
*) deplibs="$path $deplibs" ;;
esac
done
fi # link_all_deplibs != no
fi # linkmode = lib
done # for deplib in $libs
if test "$pass" = link; then
if test "$linkmode" = "prog"; then
compile_deplibs="$new_inherited_linker_flags $compile_deplibs"
finalize_deplibs="$new_inherited_linker_flags $finalize_deplibs"
else
compiler_flags="$compiler_flags "`$ECHO " $new_inherited_linker_flags" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
fi
fi
dependency_libs="$newdependency_libs"
if test "$pass" = dlpreopen; then
# Link the dlpreopened libraries before other libraries
for deplib in $save_deplibs; do
deplibs="$deplib $deplibs"
done
fi
if test "$pass" != dlopen; then
if test "$pass" != conv; then
# Make sure lib_search_path contains only unique directories.
lib_search_path=
for dir in $newlib_search_path; do
case "$lib_search_path " in
*" $dir "*) ;;
*) func_append lib_search_path " $dir" ;;
esac
done
newlib_search_path=
fi
if test "$linkmode,$pass" != "prog,link"; then
vars="deplibs"
else
vars="compile_deplibs finalize_deplibs"
fi
for var in $vars dependency_libs; do
# Add libraries to $var in reverse order
eval tmp_libs=\"\$$var\"
new_libs=
for deplib in $tmp_libs; do
# FIXME: Pedantically, this is the right thing to do, so
# that some nasty dependency loop isn't accidentally
# broken:
#new_libs="$deplib $new_libs"
# Pragmatically, this seems to cause very few problems in
# practice:
case $deplib in
-L*) new_libs="$deplib $new_libs" ;;
-R*) ;;
*)
# And here is the reason: when a library appears more
# than once as an explicit dependence of a library, or
# is implicitly linked in more than once by the
# compiler, it is considered special, and multiple
# occurrences thereof are not removed. Compare this
# with having the same library being listed as a
# dependency of multiple other libraries: in this case,
# we know (pedantically, we assume) the library does not
# need to be listed more than once, so we keep only the
# last copy. This is not always right, but it is rare
# enough that we require users that really mean to play
# such unportable linking tricks to link the library
# using -Wl,-lname, so that libtool does not consider it
# for duplicate removal.
case " $specialdeplibs " in
*" $deplib "*) new_libs="$deplib $new_libs" ;;
*)
case " $new_libs " in
*" $deplib "*) ;;
*) new_libs="$deplib $new_libs" ;;
esac
;;
esac
;;
esac
done
tmp_libs=
for deplib in $new_libs; do
case $deplib in
-L*)
case " $tmp_libs " in
*" $deplib "*) ;;
*) func_append tmp_libs " $deplib" ;;
esac
;;
*) func_append tmp_libs " $deplib" ;;
esac
done
eval $var=\"$tmp_libs\"
done # for var
fi
# Last step: remove runtime libs from dependency_libs
# (they stay in deplibs)
tmp_libs=
for i in $dependency_libs ; do
case " $predeps $postdeps $compiler_lib_search_path " in
*" $i "*)
i=""
;;
esac
if test -n "$i" ; then
func_append tmp_libs " $i"
fi
done
dependency_libs=$tmp_libs
done # for pass
if test "$linkmode" = prog; then
dlfiles="$newdlfiles"
fi
if test "$linkmode" = prog || test "$linkmode" = lib; then
dlprefiles="$newdlprefiles"
fi
case $linkmode in
oldlib)
if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
func_warning "\`-dlopen' is ignored for archives"
fi
case " $deplibs" in
*\ -l* | *\ -L*)
func_warning "\`-l' and \`-L' are ignored for archives" ;;
esac
test -n "$rpath" && \
func_warning "\`-rpath' is ignored for archives"
test -n "$xrpath" && \
func_warning "\`-R' is ignored for archives"
test -n "$vinfo" && \
func_warning "\`-version-info/-version-number' is ignored for archives"
test -n "$release" && \
func_warning "\`-release' is ignored for archives"
test -n "$export_symbols$export_symbols_regex" && \
func_warning "\`-export-symbols' is ignored for archives"
# Now set the variables for building old libraries.
build_libtool_libs=no
oldlibs="$output"
func_append objs "$old_deplibs"
;;
lib)
# Make sure we only generate libraries of the form `libNAME.la'.
case $outputname in
lib*)
func_stripname 'lib' '.la' "$outputname"
name=$func_stripname_result
eval shared_ext=\"$shrext_cmds\"
eval libname=\"$libname_spec\"
;;
*)
test "$module" = no && \
func_fatal_help "libtool library \`$output' must begin with \`lib'"
if test "$need_lib_prefix" != no; then
# Add the "lib" prefix for modules if required
func_stripname '' '.la' "$outputname"
name=$func_stripname_result
eval shared_ext=\"$shrext_cmds\"
eval libname=\"$libname_spec\"
else
func_stripname '' '.la' "$outputname"
libname=$func_stripname_result
fi
;;
esac
if test -n "$objs"; then
if test "$deplibs_check_method" != pass_all; then
func_fatal_error "cannot build libtool library \`$output' from non-libtool objects on this host:$objs"
else
echo
$ECHO "*** Warning: Linking the shared library $output against the non-libtool"
$ECHO "*** objects $objs is not portable!"
func_append libobjs " $objs"
fi
fi
test "$dlself" != no && \
func_warning "\`-dlopen self' is ignored for libtool libraries"
set dummy $rpath
shift
test "$#" -gt 1 && \
func_warning "ignoring multiple \`-rpath's for a libtool library"
install_libdir="$1"
oldlibs=
if test -z "$rpath"; then
if test "$build_libtool_libs" = yes; then
# Building a libtool convenience library.
# Some compilers have problems with a `.al' extension so
# convenience libraries should have the same extension an
# archive normally would.
oldlibs="$output_objdir/$libname.$libext $oldlibs"
build_libtool_libs=convenience
build_old_libs=yes
fi
test -n "$vinfo" && \
func_warning "\`-version-info/-version-number' is ignored for convenience libraries"
test -n "$release" && \
func_warning "\`-release' is ignored for convenience libraries"
else
# Parse the version information argument.
save_ifs="$IFS"; IFS=':'
set dummy $vinfo 0 0 0
shift
IFS="$save_ifs"
test -n "$7" && \
func_fatal_help "too many parameters to \`-version-info'"
# convert absolute version numbers to libtool ages
# this retains compatibility with .la files and attempts
# to make the code below a bit more comprehensible
case $vinfo_number in
yes)
number_major="$1"
number_minor="$2"
number_revision="$3"
#
# There are really only two kinds -- those that
# use the current revision as the major version
# and those that subtract age and use age as
# a minor version. But, then there is irix
# which has an extra 1 added just for fun
#
case $version_type in
# correct linux to gnu/linux during the next big refactor
darwin|linux|osf|windows|none)
func_arith $number_major + $number_minor
current=$func_arith_result
age="$number_minor"
revision="$number_revision"
;;
freebsd-aout|freebsd-elf|qnx|sunos)
current="$number_major"
revision="$number_minor"
age="0"
;;
irix|nonstopux)
func_arith $number_major + $number_minor
current=$func_arith_result
age="$number_minor"
revision="$number_minor"
lt_irix_increment=no
;;
esac
;;
no)
current="$1"
revision="$2"
age="$3"
;;
esac
# Check that each of the things are valid numbers.
case $current in
0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
*)
func_error "CURRENT \`$current' must be a nonnegative integer"
func_fatal_error "\`$vinfo' is not valid version information"
;;
esac
case $revision in
0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
*)
func_error "REVISION \`$revision' must be a nonnegative integer"
func_fatal_error "\`$vinfo' is not valid version information"
;;
esac
case $age in
0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
*)
func_error "AGE \`$age' must be a nonnegative integer"
func_fatal_error "\`$vinfo' is not valid version information"
;;
esac
if test "$age" -gt "$current"; then
func_error "AGE \`$age' is greater than the current interface number \`$current'"
func_fatal_error "\`$vinfo' is not valid version information"
fi
# Calculate the version variables.
major=
versuffix=
verstring=
case $version_type in
none) ;;
darwin)
# Like Linux, but with the current version available in
# verstring for coding it into the library header
func_arith $current - $age
major=.$func_arith_result
versuffix="$major.$age.$revision"
# Darwin ld doesn't like 0 for these options...
func_arith $current + 1
minor_current=$func_arith_result
xlcverstring="${wl}-compatibility_version ${wl}$minor_current ${wl}-current_version ${wl}$minor_current.$revision"
verstring="-compatibility_version $minor_current -current_version $minor_current.$revision"
;;
freebsd-aout)
major=".$current"
versuffix=".$current.$revision";
;;
freebsd-elf)
major=".$current"
versuffix=".$current"
;;
irix | nonstopux)
if test "X$lt_irix_increment" = "Xno"; then
func_arith $current - $age
else
func_arith $current - $age + 1
fi
major=$func_arith_result
case $version_type in
nonstopux) verstring_prefix=nonstopux ;;
*) verstring_prefix=sgi ;;
esac
verstring="$verstring_prefix$major.$revision"
# Add in all the interfaces that we are compatible with.
loop=$revision
while test "$loop" -ne 0; do
func_arith $revision - $loop
iface=$func_arith_result
func_arith $loop - 1
loop=$func_arith_result
verstring="$verstring_prefix$major.$iface:$verstring"
done
# Before this point, $major must not contain `.'.
major=.$major
versuffix="$major.$revision"
;;
linux) # correct to gnu/linux during the next big refactor
func_arith $current - $age
major=.$func_arith_result
versuffix="$major.$age.$revision"
;;
osf)
func_arith $current - $age
major=.$func_arith_result
versuffix=".$current.$age.$revision"
verstring="$current.$age.$revision"
# Add in all the interfaces that we are compatible with.
loop=$age
while test "$loop" -ne 0; do
func_arith $current - $loop
iface=$func_arith_result
func_arith $loop - 1
loop=$func_arith_result
verstring="$verstring:${iface}.0"
done
# Make executables depend on our current version.
func_append verstring ":${current}.0"
;;
qnx)
major=".$current"
versuffix=".$current"
;;
sunos)
major=".$current"
versuffix=".$current.$revision"
;;
windows)
# Use '-' rather than '.', since we only want one
# extension on DOS 8.3 filesystems.
func_arith $current - $age
major=$func_arith_result
versuffix="-$major"
;;
*)
func_fatal_configuration "unknown library version type \`$version_type'"
;;
esac
# Clear the version info if we defaulted, and they specified a release.
if test -z "$vinfo" && test -n "$release"; then
major=
case $version_type in
darwin)
# we can't check for "0.0" in archive_cmds due to quoting
# problems, so we reset it completely
verstring=
;;
*)
verstring="0.0"
;;
esac
if test "$need_version" = no; then
versuffix=
else
versuffix=".0.0"
fi
fi
# Remove version info from name if versioning should be avoided
if test "$avoid_version" = yes && test "$need_version" = no; then
major=
versuffix=
verstring=""
fi
# Check to see if the archive will have undefined symbols.
if test "$allow_undefined" = yes; then
if test "$allow_undefined_flag" = unsupported; then
func_warning "undefined symbols not allowed in $host shared libraries"
build_libtool_libs=no
build_old_libs=yes
fi
else
# Don't allow undefined symbols.
allow_undefined_flag="$no_undefined_flag"
fi
fi
func_generate_dlsyms "$libname" "$libname" "yes"
func_append libobjs " $symfileobj"
test "X$libobjs" = "X " && libobjs=
if test "$opt_mode" != relink; then
# Remove our outputs, but don't remove object files since they
# may have been created when compiling PIC objects.
removelist=
tempremovelist=`$ECHO "$output_objdir/*"`
for p in $tempremovelist; do
case $p in
*.$objext | *.gcno)
;;
$output_objdir/$outputname | $output_objdir/$libname.* | $output_objdir/${libname}${release}.*)
if test "X$precious_files_regex" != "X"; then
if $ECHO "$p" | $EGREP -e "$precious_files_regex" >/dev/null 2>&1
then
continue
fi
fi
func_append removelist " $p"
;;
*) ;;
esac
done
test -n "$removelist" && \
func_show_eval "${RM}r \$removelist"
fi
# Now set the variables for building old libraries.
if test "$build_old_libs" = yes && test "$build_libtool_libs" != convenience ; then
func_append oldlibs " $output_objdir/$libname.$libext"
# Transform .lo files to .o files.
oldobjs="$objs "`$ECHO "$libobjs" | $SP2NL | $SED "/\.${libext}$/d; $lo2o" | $NL2SP`
fi
# Eliminate all temporary directories.
#for path in $notinst_path; do
# lib_search_path=`$ECHO "$lib_search_path " | $SED "s% $path % %g"`
# deplibs=`$ECHO "$deplibs " | $SED "s% -L$path % %g"`
# dependency_libs=`$ECHO "$dependency_libs " | $SED "s% -L$path % %g"`
#done
if test -n "$xrpath"; then
# If the user specified any rpath flags, then add them.
temp_xrpath=
for libdir in $xrpath; do
func_replace_sysroot "$libdir"
func_append temp_xrpath " -R$func_replace_sysroot_result"
case "$finalize_rpath " in
*" $libdir "*) ;;
*) func_append finalize_rpath " $libdir" ;;
esac
done
if test "$hardcode_into_libs" != yes || test "$build_old_libs" = yes; then
dependency_libs="$temp_xrpath $dependency_libs"
fi
fi
# Make sure dlfiles contains only unique files that won't be dlpreopened
old_dlfiles="$dlfiles"
dlfiles=
for lib in $old_dlfiles; do
case " $dlprefiles $dlfiles " in
*" $lib "*) ;;
*) func_append dlfiles " $lib" ;;
esac
done
# Make sure dlprefiles contains only unique files
old_dlprefiles="$dlprefiles"
dlprefiles=
for lib in $old_dlprefiles; do
case "$dlprefiles " in
*" $lib "*) ;;
*) func_append dlprefiles " $lib" ;;
esac
done
if test "$build_libtool_libs" = yes; then
if test -n "$rpath"; then
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-beos* | *-cegcc* | *-*-haiku*)
# these systems don't actually have a c library (as such)!
;;
*-*-rhapsody* | *-*-darwin1.[012])
# Rhapsody C library is in the System framework
func_append deplibs " System.ltframework"
;;
*-*-netbsd*)
# Don't link with libc until the a.out ld.so is fixed.
;;
*-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
# Do not include libc due to us having libc/libc_r.
;;
*-*-sco3.2v5* | *-*-sco5v6*)
# Causes problems with __ctype
;;
*-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*)
# Compiler inserts libc in the correct place for threads to work
;;
*)
# Add libc to deplibs on all other systems if necessary.
if test "$build_libtool_need_lc" = "yes"; then
func_append deplibs " -lc"
fi
;;
esac
fi
# Transform deplibs into only deplibs that can be linked in shared.
name_save=$name
libname_save=$libname
release_save=$release
versuffix_save=$versuffix
major_save=$major
# I'm not sure if I'm treating the release correctly. I think
# release should show up in the -l (ie -lgmp5) so we don't want to
# add it in twice. Is that correct?
release=""
versuffix=""
major=""
newdeplibs=
droppeddeps=no
case $deplibs_check_method in
pass_all)
# Don't check for shared/static. Everything works.
# This might be a little naive. We might want to check
# whether the library exists or not. But this is on
# osf3 & osf4 and I'm not really sure... Just
# implementing what was already the behavior.
newdeplibs=$deplibs
;;
test_compile)
# This code stresses the "libraries are programs" paradigm to its
# limits. Maybe even breaks it. We compile a program, linking it
# against the deplibs as a proxy for the library. Then we can check
# whether they linked in statically or dynamically with ldd.
$opt_dry_run || $RM conftest.c
cat > conftest.c </dev/null`
$nocaseglob
else
potential_libs=`ls $i/$libnameglob[.-]* 2>/dev/null`
fi
for potent_lib in $potential_libs; do
# Follow soft links.
if ls -lLd "$potent_lib" 2>/dev/null |
$GREP " -> " >/dev/null; then
continue
fi
# The statement above tries to avoid entering an
# endless loop below, in case of cyclic links.
# We might still enter an endless loop, since a link
# loop can be closed while we follow links,
# but so what?
potlib="$potent_lib"
while test -h "$potlib" 2>/dev/null; do
potliblink=`ls -ld $potlib | ${SED} 's/.* -> //'`
case $potliblink in
[\\/]* | [A-Za-z]:[\\/]*) potlib="$potliblink";;
*) potlib=`$ECHO "$potlib" | $SED 's,[^/]*$,,'`"$potliblink";;
esac
done
if eval $file_magic_cmd \"\$potlib\" 2>/dev/null |
$SED -e 10q |
$EGREP "$file_magic_regex" > /dev/null; then
func_append newdeplibs " $a_deplib"
a_deplib=""
break 2
fi
done
done
fi
if test -n "$a_deplib" ; then
droppeddeps=yes
echo
$ECHO "*** Warning: linker path does not have real file for library $a_deplib."
echo "*** I have the capability to make that library automatically link in when"
echo "*** you link to this library. But I can only do this if you have a"
echo "*** shared version of the library, which you do not appear to have"
echo "*** because I did check the linker path looking for a file starting"
if test -z "$potlib" ; then
$ECHO "*** with $libname but no candidates were found. (...for file magic test)"
else
$ECHO "*** with $libname and none of the candidates passed a file format test"
$ECHO "*** using a file magic. Last file checked: $potlib"
fi
fi
;;
*)
# Add a -L argument.
func_append newdeplibs " $a_deplib"
;;
esac
done # Gone through all deplibs.
;;
match_pattern*)
set dummy $deplibs_check_method; shift
match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
for a_deplib in $deplibs; do
case $a_deplib in
-l*)
func_stripname -l '' "$a_deplib"
name=$func_stripname_result
if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
case " $predeps $postdeps " in
*" $a_deplib "*)
func_append newdeplibs " $a_deplib"
a_deplib=""
;;
esac
fi
if test -n "$a_deplib" ; then
libname=`eval "\\$ECHO \"$libname_spec\""`
for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do
potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
for potent_lib in $potential_libs; do
potlib="$potent_lib" # see symlink-check above in file_magic test
if eval "\$ECHO \"$potent_lib\"" 2>/dev/null | $SED 10q | \
$EGREP "$match_pattern_regex" > /dev/null; then
func_append newdeplibs " $a_deplib"
a_deplib=""
break 2
fi
done
done
fi
if test -n "$a_deplib" ; then
droppeddeps=yes
echo
$ECHO "*** Warning: linker path does not have real file for library $a_deplib."
echo "*** I have the capability to make that library automatically link in when"
echo "*** you link to this library. But I can only do this if you have a"
echo "*** shared version of the library, which you do not appear to have"
echo "*** because I did check the linker path looking for a file starting"
if test -z "$potlib" ; then
$ECHO "*** with $libname but no candidates were found. (...for regex pattern test)"
else
$ECHO "*** with $libname and none of the candidates passed a file format test"
$ECHO "*** using a regex pattern. Last file checked: $potlib"
fi
fi
;;
*)
# Add a -L argument.
func_append newdeplibs " $a_deplib"
;;
esac
done # Gone through all deplibs.
;;
none | unknown | *)
newdeplibs=""
tmp_deplibs=`$ECHO " $deplibs" | $SED 's/ -lc$//; s/ -[LR][^ ]*//g'`
if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
for i in $predeps $postdeps ; do
# can't use Xsed below, because $i might contain '/'
tmp_deplibs=`$ECHO " $tmp_deplibs" | $SED "s,$i,,"`
done
fi
case $tmp_deplibs in
*[!\ \ ]*)
echo
if test "X$deplibs_check_method" = "Xnone"; then
echo "*** Warning: inter-library dependencies are not supported in this platform."
else
echo "*** Warning: inter-library dependencies are not known to be supported."
fi
echo "*** All declared inter-library dependencies are being dropped."
droppeddeps=yes
;;
esac
;;
esac
versuffix=$versuffix_save
major=$major_save
release=$release_save
libname=$libname_save
name=$name_save
case $host in
*-*-rhapsody* | *-*-darwin1.[012])
# On Rhapsody replace the C library with the System framework
newdeplibs=`$ECHO " $newdeplibs" | $SED 's/ -lc / System.ltframework /'`
;;
esac
if test "$droppeddeps" = yes; then
if test "$module" = yes; then
echo
echo "*** Warning: libtool could not satisfy all declared inter-library"
$ECHO "*** dependencies of module $libname. Therefore, libtool will create"
echo "*** a static module, that should work as long as the dlopening"
echo "*** application is linked with the -dlopen flag."
if test -z "$global_symbol_pipe"; then
echo
echo "*** However, this would only work if libtool was able to extract symbol"
echo "*** lists from a program, using \`nm' or equivalent, but libtool could"
echo "*** not find such a program. So, this module is probably useless."
echo "*** \`nm' from GNU binutils and a full rebuild may help."
fi
if test "$build_old_libs" = no; then
oldlibs="$output_objdir/$libname.$libext"
build_libtool_libs=module
build_old_libs=yes
else
build_libtool_libs=no
fi
else
echo "*** The inter-library dependencies that have been dropped here will be"
echo "*** automatically added whenever a program is linked with this library"
echo "*** or is declared to -dlopen it."
if test "$allow_undefined" = no; then
echo
echo "*** Since this library must not contain undefined symbols,"
echo "*** because either the platform does not support them or"
echo "*** it was explicitly requested with -no-undefined,"
echo "*** libtool will only create a static version of it."
if test "$build_old_libs" = no; then
oldlibs="$output_objdir/$libname.$libext"
build_libtool_libs=module
build_old_libs=yes
else
build_libtool_libs=no
fi
fi
fi
fi
# Done checking deplibs!
deplibs=$newdeplibs
fi
# Time to change all our "foo.ltframework" stuff back to "-framework foo"
case $host in
*-*-darwin*)
newdeplibs=`$ECHO " $newdeplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
new_inherited_linker_flags=`$ECHO " $new_inherited_linker_flags" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
deplibs=`$ECHO " $deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
;;
esac
# move library search paths that coincide with paths to not yet
# installed libraries to the beginning of the library search list
new_libs=
for path in $notinst_path; do
case " $new_libs " in
*" -L$path/$objdir "*) ;;
*)
case " $deplibs " in
*" -L$path/$objdir "*)
func_append new_libs " -L$path/$objdir" ;;
esac
;;
esac
done
for deplib in $deplibs; do
case $deplib in
-L*)
case " $new_libs " in
*" $deplib "*) ;;
*) func_append new_libs " $deplib" ;;
esac
;;
*) func_append new_libs " $deplib" ;;
esac
done
deplibs="$new_libs"
# All the library-specific variables (install_libdir is set above).
library_names=
old_library=
dlname=
# Test again, we may have decided not to build it any more
if test "$build_libtool_libs" = yes; then
# Remove ${wl} instances when linking with ld.
# FIXME: should test the right _cmds variable.
case $archive_cmds in
*\$LD\ *) wl= ;;
esac
if test "$hardcode_into_libs" = yes; then
# Hardcode the library paths
hardcode_libdirs=
dep_rpath=
rpath="$finalize_rpath"
test "$opt_mode" != relink && rpath="$compile_rpath$rpath"
for libdir in $rpath; do
if test -n "$hardcode_libdir_flag_spec"; then
if test -n "$hardcode_libdir_separator"; then
func_replace_sysroot "$libdir"
libdir=$func_replace_sysroot_result
if test -z "$hardcode_libdirs"; then
hardcode_libdirs="$libdir"
else
# Just accumulate the unique libdirs.
case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
*"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
;;
*)
func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
;;
esac
fi
else
eval flag=\"$hardcode_libdir_flag_spec\"
func_append dep_rpath " $flag"
fi
elif test -n "$runpath_var"; then
case "$perm_rpath " in
*" $libdir "*) ;;
*) func_append perm_rpath " $libdir" ;;
esac
fi
done
# Substitute the hardcoded libdirs into the rpath.
if test -n "$hardcode_libdir_separator" &&
test -n "$hardcode_libdirs"; then
libdir="$hardcode_libdirs"
eval "dep_rpath=\"$hardcode_libdir_flag_spec\""
fi
if test -n "$runpath_var" && test -n "$perm_rpath"; then
# We should set the runpath_var.
rpath=
for dir in $perm_rpath; do
func_append rpath "$dir:"
done
eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var"
fi
test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs"
fi
shlibpath="$finalize_shlibpath"
test "$opt_mode" != relink && shlibpath="$compile_shlibpath$shlibpath"
if test -n "$shlibpath"; then
eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var"
fi
# Get the real and link names of the library.
eval shared_ext=\"$shrext_cmds\"
eval library_names=\"$library_names_spec\"
set dummy $library_names
shift
realname="$1"
shift
if test -n "$soname_spec"; then
eval soname=\"$soname_spec\"
else
soname="$realname"
fi
if test -z "$dlname"; then
dlname=$soname
fi
lib="$output_objdir/$realname"
linknames=
for link
do
func_append linknames " $link"
done
# Use standard objects if they are pic
test -z "$pic_flag" && libobjs=`$ECHO "$libobjs" | $SP2NL | $SED "$lo2o" | $NL2SP`
test "X$libobjs" = "X " && libobjs=
delfiles=
if test -n "$export_symbols" && test -n "$include_expsyms"; then
$opt_dry_run || cp "$export_symbols" "$output_objdir/$libname.uexp"
export_symbols="$output_objdir/$libname.uexp"
func_append delfiles " $export_symbols"
fi
orig_export_symbols=
case $host_os in
cygwin* | mingw* | cegcc*)
if test -n "$export_symbols" && test -z "$export_symbols_regex"; then
# exporting using user supplied symfile
if test "x`$SED 1q $export_symbols`" != xEXPORTS; then
# and it's NOT already a .def file. Must figure out
# which of the given symbols are data symbols and tag
# them as such. So, trigger use of export_symbols_cmds.
# export_symbols gets reassigned inside the "prepare
# the list of exported symbols" if statement, so the
# include_expsyms logic still works.
orig_export_symbols="$export_symbols"
export_symbols=
always_export_symbols=yes
fi
fi
;;
esac
# Prepare the list of exported symbols
if test -z "$export_symbols"; then
if test "$always_export_symbols" = yes || test -n "$export_symbols_regex"; then
func_verbose "generating symbol list for \`$libname.la'"
export_symbols="$output_objdir/$libname.exp"
$opt_dry_run || $RM $export_symbols
cmds=$export_symbols_cmds
save_ifs="$IFS"; IFS='~'
for cmd1 in $cmds; do
IFS="$save_ifs"
# Take the normal branch if the nm_file_list_spec branch
# doesn't work or if tool conversion is not needed.
case $nm_file_list_spec~$to_tool_file_cmd in
*~func_convert_file_noop | *~func_convert_file_msys_to_w32 | ~*)
try_normal_branch=yes
eval cmd=\"$cmd1\"
func_len " $cmd"
len=$func_len_result
;;
*)
try_normal_branch=no
;;
esac
if test "$try_normal_branch" = yes \
&& { test "$len" -lt "$max_cmd_len" \
|| test "$max_cmd_len" -le -1; }
then
func_show_eval "$cmd" 'exit $?'
skipped_export=false
elif test -n "$nm_file_list_spec"; then
func_basename "$output"
output_la=$func_basename_result
save_libobjs=$libobjs
save_output=$output
output=${output_objdir}/${output_la}.nm
func_to_tool_file "$output"
libobjs=$nm_file_list_spec$func_to_tool_file_result
func_append delfiles " $output"
func_verbose "creating $NM input file list: $output"
for obj in $save_libobjs; do
func_to_tool_file "$obj"
$ECHO "$func_to_tool_file_result"
done > "$output"
eval cmd=\"$cmd1\"
func_show_eval "$cmd" 'exit $?'
output=$save_output
libobjs=$save_libobjs
skipped_export=false
else
# The command line is too long to execute in one step.
func_verbose "using reloadable object file for export list..."
skipped_export=:
# Break out early, otherwise skipped_export may be
# set to false by a later but shorter cmd.
break
fi
done
IFS="$save_ifs"
if test -n "$export_symbols_regex" && test "X$skipped_export" != "X:"; then
func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
func_show_eval '$MV "${export_symbols}T" "$export_symbols"'
fi
fi
fi
if test -n "$export_symbols" && test -n "$include_expsyms"; then
tmp_export_symbols="$export_symbols"
test -n "$orig_export_symbols" && tmp_export_symbols="$orig_export_symbols"
$opt_dry_run || eval '$ECHO "$include_expsyms" | $SP2NL >> "$tmp_export_symbols"'
fi
if test "X$skipped_export" != "X:" && test -n "$orig_export_symbols"; then
# The given exports_symbols file has to be filtered, so filter it.
func_verbose "filter symbol list for \`$libname.la' to tag DATA exports"
# FIXME: $output_objdir/$libname.filter potentially contains lots of
# 's' commands which not all seds can handle. GNU sed should be fine
# though. Also, the filter scales superlinearly with the number of
# global variables. join(1) would be nice here, but unfortunately
# isn't a blessed tool.
$opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter
func_append delfiles " $export_symbols $output_objdir/$libname.filter"
export_symbols=$output_objdir/$libname.def
$opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols
fi
tmp_deplibs=
for test_deplib in $deplibs; do
case " $convenience " in
*" $test_deplib "*) ;;
*)
func_append tmp_deplibs " $test_deplib"
;;
esac
done
deplibs="$tmp_deplibs"
if test -n "$convenience"; then
if test -n "$whole_archive_flag_spec" &&
test "$compiler_needs_object" = yes &&
test -z "$libobjs"; then
# extract the archives, so we have objects to list.
# TODO: could optimize this to just extract one archive.
whole_archive_flag_spec=
fi
if test -n "$whole_archive_flag_spec"; then
save_libobjs=$libobjs
eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
test "X$libobjs" = "X " && libobjs=
else
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_extract_archives $gentop $convenience
func_append libobjs " $func_extract_archives_result"
test "X$libobjs" = "X " && libobjs=
fi
fi
if test "$thread_safe" = yes && test -n "$thread_safe_flag_spec"; then
eval flag=\"$thread_safe_flag_spec\"
func_append linker_flags " $flag"
fi
# Make a backup of the uninstalled library when relinking
if test "$opt_mode" = relink; then
$opt_dry_run || eval '(cd $output_objdir && $RM ${realname}U && $MV $realname ${realname}U)' || exit $?
fi
# Do each of the archive commands.
if test "$module" = yes && test -n "$module_cmds" ; then
if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then
eval test_cmds=\"$module_expsym_cmds\"
cmds=$module_expsym_cmds
else
eval test_cmds=\"$module_cmds\"
cmds=$module_cmds
fi
else
if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
eval test_cmds=\"$archive_expsym_cmds\"
cmds=$archive_expsym_cmds
else
eval test_cmds=\"$archive_cmds\"
cmds=$archive_cmds
fi
fi
if test "X$skipped_export" != "X:" &&
func_len " $test_cmds" &&
len=$func_len_result &&
test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
:
else
# The command line is too long to link in one step, link piecewise
# or, if using GNU ld and skipped_export is not :, use a linker
# script.
# Save the value of $output and $libobjs because we want to
# use them later. If we have whole_archive_flag_spec, we
# want to use save_libobjs as it was before
# whole_archive_flag_spec was expanded, because we can't
# assume the linker understands whole_archive_flag_spec.
# This may have to be revisited, in case too many
# convenience libraries get linked in and end up exceeding
# the spec.
if test -z "$convenience" || test -z "$whole_archive_flag_spec"; then
save_libobjs=$libobjs
fi
save_output=$output
func_basename "$output"
output_la=$func_basename_result
# Clear the reloadable object creation command queue and
# initialize k to one.
test_cmds=
concat_cmds=
objlist=
last_robj=
k=1
if test -n "$save_libobjs" && test "X$skipped_export" != "X:" && test "$with_gnu_ld" = yes; then
output=${output_objdir}/${output_la}.lnkscript
func_verbose "creating GNU ld script: $output"
echo 'INPUT (' > $output
for obj in $save_libobjs
do
func_to_tool_file "$obj"
$ECHO "$func_to_tool_file_result" >> $output
done
echo ')' >> $output
func_append delfiles " $output"
func_to_tool_file "$output"
output=$func_to_tool_file_result
elif test -n "$save_libobjs" && test "X$skipped_export" != "X:" && test "X$file_list_spec" != X; then
output=${output_objdir}/${output_la}.lnk
func_verbose "creating linker input file list: $output"
: > $output
set x $save_libobjs
shift
firstobj=
if test "$compiler_needs_object" = yes; then
firstobj="$1 "
shift
fi
for obj
do
func_to_tool_file "$obj"
$ECHO "$func_to_tool_file_result" >> $output
done
func_append delfiles " $output"
func_to_tool_file "$output"
output=$firstobj\"$file_list_spec$func_to_tool_file_result\"
else
if test -n "$save_libobjs"; then
func_verbose "creating reloadable object files..."
output=$output_objdir/$output_la-${k}.$objext
eval test_cmds=\"$reload_cmds\"
func_len " $test_cmds"
len0=$func_len_result
len=$len0
# Loop over the list of objects to be linked.
for obj in $save_libobjs
do
func_len " $obj"
func_arith $len + $func_len_result
len=$func_arith_result
if test "X$objlist" = X ||
test "$len" -lt "$max_cmd_len"; then
func_append objlist " $obj"
else
# The command $test_cmds is almost too long, add a
# command to the queue.
if test "$k" -eq 1 ; then
# The first file doesn't have a previous command to add.
reload_objs=$objlist
eval concat_cmds=\"$reload_cmds\"
else
# All subsequent reloadable object files will link in
# the last one created.
reload_objs="$objlist $last_robj"
eval concat_cmds=\"\$concat_cmds~$reload_cmds~\$RM $last_robj\"
fi
last_robj=$output_objdir/$output_la-${k}.$objext
func_arith $k + 1
k=$func_arith_result
output=$output_objdir/$output_la-${k}.$objext
objlist=" $obj"
func_len " $last_robj"
func_arith $len0 + $func_len_result
len=$func_arith_result
fi
done
# Handle the remaining objects by creating one last
# reloadable object file. All subsequent reloadable object
# files will link in the last one created.
test -z "$concat_cmds" || concat_cmds=$concat_cmds~
reload_objs="$objlist $last_robj"
eval concat_cmds=\"\${concat_cmds}$reload_cmds\"
if test -n "$last_robj"; then
eval concat_cmds=\"\${concat_cmds}~\$RM $last_robj\"
fi
func_append delfiles " $output"
else
output=
fi
if ${skipped_export-false}; then
func_verbose "generating symbol list for \`$libname.la'"
export_symbols="$output_objdir/$libname.exp"
$opt_dry_run || $RM $export_symbols
libobjs=$output
# Append the command to create the export file.
test -z "$concat_cmds" || concat_cmds=$concat_cmds~
eval concat_cmds=\"\$concat_cmds$export_symbols_cmds\"
if test -n "$last_robj"; then
eval concat_cmds=\"\$concat_cmds~\$RM $last_robj\"
fi
fi
test -n "$save_libobjs" &&
func_verbose "creating a temporary reloadable object file: $output"
# Loop through the commands generated above and execute them.
save_ifs="$IFS"; IFS='~'
for cmd in $concat_cmds; do
IFS="$save_ifs"
$opt_silent || {
func_quote_for_expand "$cmd"
eval "func_echo $func_quote_for_expand_result"
}
$opt_dry_run || eval "$cmd" || {
lt_exit=$?
# Restore the uninstalled library and exit
if test "$opt_mode" = relink; then
( cd "$output_objdir" && \
$RM "${realname}T" && \
$MV "${realname}U" "$realname" )
fi
exit $lt_exit
}
done
IFS="$save_ifs"
if test -n "$export_symbols_regex" && ${skipped_export-false}; then
func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
func_show_eval '$MV "${export_symbols}T" "$export_symbols"'
fi
fi
if ${skipped_export-false}; then
if test -n "$export_symbols" && test -n "$include_expsyms"; then
tmp_export_symbols="$export_symbols"
test -n "$orig_export_symbols" && tmp_export_symbols="$orig_export_symbols"
$opt_dry_run || eval '$ECHO "$include_expsyms" | $SP2NL >> "$tmp_export_symbols"'
fi
if test -n "$orig_export_symbols"; then
# The given exports_symbols file has to be filtered, so filter it.
func_verbose "filter symbol list for \`$libname.la' to tag DATA exports"
# FIXME: $output_objdir/$libname.filter potentially contains lots of
# 's' commands which not all seds can handle. GNU sed should be fine
# though. Also, the filter scales superlinearly with the number of
# global variables. join(1) would be nice here, but unfortunately
# isn't a blessed tool.
$opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter
func_append delfiles " $export_symbols $output_objdir/$libname.filter"
export_symbols=$output_objdir/$libname.def
$opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols
fi
fi
libobjs=$output
# Restore the value of output.
output=$save_output
if test -n "$convenience" && test -n "$whole_archive_flag_spec"; then
eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
test "X$libobjs" = "X " && libobjs=
fi
# Expand the library linking commands again to reset the
# value of $libobjs for piecewise linking.
# Do each of the archive commands.
if test "$module" = yes && test -n "$module_cmds" ; then
if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then
cmds=$module_expsym_cmds
else
cmds=$module_cmds
fi
else
if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
cmds=$archive_expsym_cmds
else
cmds=$archive_cmds
fi
fi
fi
if test -n "$delfiles"; then
# Append the command to remove temporary files to $cmds.
eval cmds=\"\$cmds~\$RM $delfiles\"
fi
# Add any objects from preloaded convenience libraries
if test -n "$dlprefiles"; then
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_extract_archives $gentop $dlprefiles
func_append libobjs " $func_extract_archives_result"
test "X$libobjs" = "X " && libobjs=
fi
save_ifs="$IFS"; IFS='~'
for cmd in $cmds; do
IFS="$save_ifs"
eval cmd=\"$cmd\"
$opt_silent || {
func_quote_for_expand "$cmd"
eval "func_echo $func_quote_for_expand_result"
}
$opt_dry_run || eval "$cmd" || {
lt_exit=$?
# Restore the uninstalled library and exit
if test "$opt_mode" = relink; then
( cd "$output_objdir" && \
$RM "${realname}T" && \
$MV "${realname}U" "$realname" )
fi
exit $lt_exit
}
done
IFS="$save_ifs"
# Restore the uninstalled library and exit
if test "$opt_mode" = relink; then
$opt_dry_run || eval '(cd $output_objdir && $RM ${realname}T && $MV $realname ${realname}T && $MV ${realname}U $realname)' || exit $?
if test -n "$convenience"; then
if test -z "$whole_archive_flag_spec"; then
func_show_eval '${RM}r "$gentop"'
fi
fi
exit $EXIT_SUCCESS
fi
# Create links to the real library.
for linkname in $linknames; do
if test "$realname" != "$linkname"; then
func_show_eval '(cd "$output_objdir" && $RM "$linkname" && $LN_S "$realname" "$linkname")' 'exit $?'
fi
done
# If -module or -export-dynamic was specified, set the dlname.
if test "$module" = yes || test "$export_dynamic" = yes; then
# On all known operating systems, these are identical.
dlname="$soname"
fi
fi
;;
obj)
if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
func_warning "\`-dlopen' is ignored for objects"
fi
case " $deplibs" in
*\ -l* | *\ -L*)
func_warning "\`-l' and \`-L' are ignored for objects" ;;
esac
test -n "$rpath" && \
func_warning "\`-rpath' is ignored for objects"
test -n "$xrpath" && \
func_warning "\`-R' is ignored for objects"
test -n "$vinfo" && \
func_warning "\`-version-info' is ignored for objects"
test -n "$release" && \
func_warning "\`-release' is ignored for objects"
case $output in
*.lo)
test -n "$objs$old_deplibs" && \
func_fatal_error "cannot build library object \`$output' from non-libtool objects"
libobj=$output
func_lo2o "$libobj"
obj=$func_lo2o_result
;;
*)
libobj=
obj="$output"
;;
esac
# Delete the old objects.
$opt_dry_run || $RM $obj $libobj
# Objects from convenience libraries. This assumes
# single-version convenience libraries. Whenever we create
# different ones for PIC/non-PIC, this we'll have to duplicate
# the extraction.
reload_conv_objs=
gentop=
# reload_cmds runs $LD directly, so let us get rid of
# -Wl from whole_archive_flag_spec and hope we can get by with
# turning comma into space..
wl=
if test -n "$convenience"; then
if test -n "$whole_archive_flag_spec"; then
eval tmp_whole_archive_flags=\"$whole_archive_flag_spec\"
reload_conv_objs=$reload_objs\ `$ECHO "$tmp_whole_archive_flags" | $SED 's|,| |g'`
else
gentop="$output_objdir/${obj}x"
func_append generated " $gentop"
func_extract_archives $gentop $convenience
reload_conv_objs="$reload_objs $func_extract_archives_result"
fi
fi
# If we're not building shared, we need to use non_pic_objs
test "$build_libtool_libs" != yes && libobjs="$non_pic_objects"
# Create the old-style object.
reload_objs="$objs$old_deplibs "`$ECHO "$libobjs" | $SP2NL | $SED "/\.${libext}$/d; /\.lib$/d; $lo2o" | $NL2SP`" $reload_conv_objs" ### testsuite: skip nested quoting test
output="$obj"
func_execute_cmds "$reload_cmds" 'exit $?'
# Exit if we aren't doing a library object file.
if test -z "$libobj"; then
if test -n "$gentop"; then
func_show_eval '${RM}r "$gentop"'
fi
exit $EXIT_SUCCESS
fi
if test "$build_libtool_libs" != yes; then
if test -n "$gentop"; then
func_show_eval '${RM}r "$gentop"'
fi
# Create an invalid libtool object if no PIC, so that we don't
# accidentally link it into a program.
# $show "echo timestamp > $libobj"
# $opt_dry_run || eval "echo timestamp > $libobj" || exit $?
exit $EXIT_SUCCESS
fi
if test -n "$pic_flag" || test "$pic_mode" != default; then
# Only do commands if we really have different PIC objects.
reload_objs="$libobjs $reload_conv_objs"
output="$libobj"
func_execute_cmds "$reload_cmds" 'exit $?'
fi
if test -n "$gentop"; then
func_show_eval '${RM}r "$gentop"'
fi
exit $EXIT_SUCCESS
;;
prog)
case $host in
*cygwin*) func_stripname '' '.exe' "$output"
output=$func_stripname_result.exe;;
esac
test -n "$vinfo" && \
func_warning "\`-version-info' is ignored for programs"
test -n "$release" && \
func_warning "\`-release' is ignored for programs"
test "$preload" = yes \
&& test "$dlopen_support" = unknown \
&& test "$dlopen_self" = unknown \
&& test "$dlopen_self_static" = unknown && \
func_warning "\`LT_INIT([dlopen])' not used. Assuming no dlopen support."
case $host in
*-*-rhapsody* | *-*-darwin1.[012])
# On Rhapsody replace the C library is the System framework
compile_deplibs=`$ECHO " $compile_deplibs" | $SED 's/ -lc / System.ltframework /'`
finalize_deplibs=`$ECHO " $finalize_deplibs" | $SED 's/ -lc / System.ltframework /'`
;;
esac
case $host in
*-*-darwin*)
# Don't allow lazy linking, it breaks C++ global constructors
# But is supposedly fixed on 10.4 or later (yay!).
if test "$tagname" = CXX ; then
case ${MACOSX_DEPLOYMENT_TARGET-10.0} in
10.[0123])
func_append compile_command " ${wl}-bind_at_load"
func_append finalize_command " ${wl}-bind_at_load"
;;
esac
fi
# Time to change all our "foo.ltframework" stuff back to "-framework foo"
compile_deplibs=`$ECHO " $compile_deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
finalize_deplibs=`$ECHO " $finalize_deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
;;
esac
# move library search paths that coincide with paths to not yet
# installed libraries to the beginning of the library search list
new_libs=
for path in $notinst_path; do
case " $new_libs " in
*" -L$path/$objdir "*) ;;
*)
case " $compile_deplibs " in
*" -L$path/$objdir "*)
func_append new_libs " -L$path/$objdir" ;;
esac
;;
esac
done
for deplib in $compile_deplibs; do
case $deplib in
-L*)
case " $new_libs " in
*" $deplib "*) ;;
*) func_append new_libs " $deplib" ;;
esac
;;
*) func_append new_libs " $deplib" ;;
esac
done
compile_deplibs="$new_libs"
func_append compile_command " $compile_deplibs"
func_append finalize_command " $finalize_deplibs"
if test -n "$rpath$xrpath"; then
# If the user specified any rpath flags, then add them.
for libdir in $rpath $xrpath; do
# This is the magic to use -rpath.
case "$finalize_rpath " in
*" $libdir "*) ;;
*) func_append finalize_rpath " $libdir" ;;
esac
done
fi
# Now hardcode the library paths
rpath=
hardcode_libdirs=
for libdir in $compile_rpath $finalize_rpath; do
if test -n "$hardcode_libdir_flag_spec"; then
if test -n "$hardcode_libdir_separator"; then
if test -z "$hardcode_libdirs"; then
hardcode_libdirs="$libdir"
else
# Just accumulate the unique libdirs.
case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
*"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
;;
*)
func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
;;
esac
fi
else
eval flag=\"$hardcode_libdir_flag_spec\"
func_append rpath " $flag"
fi
elif test -n "$runpath_var"; then
case "$perm_rpath " in
*" $libdir "*) ;;
*) func_append perm_rpath " $libdir" ;;
esac
fi
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
testbindir=`${ECHO} "$libdir" | ${SED} -e 's*/lib$*/bin*'`
case :$dllsearchpath: in
*":$libdir:"*) ;;
::) dllsearchpath=$libdir;;
*) func_append dllsearchpath ":$libdir";;
esac
case :$dllsearchpath: in
*":$testbindir:"*) ;;
::) dllsearchpath=$testbindir;;
*) func_append dllsearchpath ":$testbindir";;
esac
;;
esac
done
# Substitute the hardcoded libdirs into the rpath.
if test -n "$hardcode_libdir_separator" &&
test -n "$hardcode_libdirs"; then
libdir="$hardcode_libdirs"
eval rpath=\" $hardcode_libdir_flag_spec\"
fi
compile_rpath="$rpath"
rpath=
hardcode_libdirs=
for libdir in $finalize_rpath; do
if test -n "$hardcode_libdir_flag_spec"; then
if test -n "$hardcode_libdir_separator"; then
if test -z "$hardcode_libdirs"; then
hardcode_libdirs="$libdir"
else
# Just accumulate the unique libdirs.
case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
*"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
;;
*)
func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
;;
esac
fi
else
eval flag=\"$hardcode_libdir_flag_spec\"
func_append rpath " $flag"
fi
elif test -n "$runpath_var"; then
case "$finalize_perm_rpath " in
*" $libdir "*) ;;
*) func_append finalize_perm_rpath " $libdir" ;;
esac
fi
done
# Substitute the hardcoded libdirs into the rpath.
if test -n "$hardcode_libdir_separator" &&
test -n "$hardcode_libdirs"; then
libdir="$hardcode_libdirs"
eval rpath=\" $hardcode_libdir_flag_spec\"
fi
finalize_rpath="$rpath"
if test -n "$libobjs" && test "$build_old_libs" = yes; then
# Transform all the library objects into standard objects.
compile_command=`$ECHO "$compile_command" | $SP2NL | $SED "$lo2o" | $NL2SP`
finalize_command=`$ECHO "$finalize_command" | $SP2NL | $SED "$lo2o" | $NL2SP`
fi
func_generate_dlsyms "$outputname" "@PROGRAM@" "no"
# template prelinking step
if test -n "$prelink_cmds"; then
func_execute_cmds "$prelink_cmds" 'exit $?'
fi
wrappers_required=yes
case $host in
*cegcc* | *mingw32ce*)
# Disable wrappers for cegcc and mingw32ce hosts, we are cross compiling anyway.
wrappers_required=no
;;
*cygwin* | *mingw* )
if test "$build_libtool_libs" != yes; then
wrappers_required=no
fi
;;
*)
if test "$need_relink" = no || test "$build_libtool_libs" != yes; then
wrappers_required=no
fi
;;
esac
if test "$wrappers_required" = no; then
# Replace the output file specification.
compile_command=`$ECHO "$compile_command" | $SED 's%@OUTPUT@%'"$output"'%g'`
link_command="$compile_command$compile_rpath"
# We have no uninstalled library dependencies, so finalize right now.
exit_status=0
func_show_eval "$link_command" 'exit_status=$?'
if test -n "$postlink_cmds"; then
func_to_tool_file "$output"
postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
func_execute_cmds "$postlink_cmds" 'exit $?'
fi
# Delete the generated files.
if test -f "$output_objdir/${outputname}S.${objext}"; then
func_show_eval '$RM "$output_objdir/${outputname}S.${objext}"'
fi
exit $exit_status
fi
if test -n "$compile_shlibpath$finalize_shlibpath"; then
compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command"
fi
if test -n "$finalize_shlibpath"; then
finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command"
fi
compile_var=
finalize_var=
if test -n "$runpath_var"; then
if test -n "$perm_rpath"; then
# We should set the runpath_var.
rpath=
for dir in $perm_rpath; do
func_append rpath "$dir:"
done
compile_var="$runpath_var=\"$rpath\$$runpath_var\" "
fi
if test -n "$finalize_perm_rpath"; then
# We should set the runpath_var.
rpath=
for dir in $finalize_perm_rpath; do
func_append rpath "$dir:"
done
finalize_var="$runpath_var=\"$rpath\$$runpath_var\" "
fi
fi
if test "$no_install" = yes; then
# We don't need to create a wrapper script.
link_command="$compile_var$compile_command$compile_rpath"
# Replace the output file specification.
link_command=`$ECHO "$link_command" | $SED 's%@OUTPUT@%'"$output"'%g'`
# Delete the old output file.
$opt_dry_run || $RM $output
# Link the executable and exit
func_show_eval "$link_command" 'exit $?'
if test -n "$postlink_cmds"; then
func_to_tool_file "$output"
postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
func_execute_cmds "$postlink_cmds" 'exit $?'
fi
exit $EXIT_SUCCESS
fi
if test "$hardcode_action" = relink; then
# Fast installation is not supported
link_command="$compile_var$compile_command$compile_rpath"
relink_command="$finalize_var$finalize_command$finalize_rpath"
func_warning "this platform does not like uninstalled shared libraries"
func_warning "\`$output' will be relinked during installation"
else
if test "$fast_install" != no; then
link_command="$finalize_var$compile_command$finalize_rpath"
if test "$fast_install" = yes; then
relink_command=`$ECHO "$compile_var$compile_command$compile_rpath" | $SED 's%@OUTPUT@%\$progdir/\$file%g'`
else
# fast_install is set to needless
relink_command=
fi
else
link_command="$compile_var$compile_command$compile_rpath"
relink_command="$finalize_var$finalize_command$finalize_rpath"
fi
fi
# Replace the output file specification.
link_command=`$ECHO "$link_command" | $SED 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'`
# Delete the old output files.
$opt_dry_run || $RM $output $output_objdir/$outputname $output_objdir/lt-$outputname
func_show_eval "$link_command" 'exit $?'
if test -n "$postlink_cmds"; then
func_to_tool_file "$output_objdir/$outputname"
postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
func_execute_cmds "$postlink_cmds" 'exit $?'
fi
# Now create the wrapper script.
func_verbose "creating $output"
# Quote the relink command for shipping.
if test -n "$relink_command"; then
# Preserve any variables that may affect compiler behavior
for var in $variables_saved_for_relink; do
if eval test -z \"\${$var+set}\"; then
relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command"
elif eval var_value=\$$var; test -z "$var_value"; then
relink_command="$var=; export $var; $relink_command"
else
func_quote_for_eval "$var_value"
relink_command="$var=$func_quote_for_eval_result; export $var; $relink_command"
fi
done
relink_command="(cd `pwd`; $relink_command)"
relink_command=`$ECHO "$relink_command" | $SED "$sed_quote_subst"`
fi
# Only actually do things if not in dry run mode.
$opt_dry_run || {
# win32 will think the script is a binary if it has
# a .exe suffix, so we strip it off here.
case $output in
*.exe) func_stripname '' '.exe' "$output"
output=$func_stripname_result ;;
esac
# test for cygwin because mv fails w/o .exe extensions
case $host in
*cygwin*)
exeext=.exe
func_stripname '' '.exe' "$outputname"
outputname=$func_stripname_result ;;
*) exeext= ;;
esac
case $host in
*cygwin* | *mingw* )
func_dirname_and_basename "$output" "" "."
output_name=$func_basename_result
output_path=$func_dirname_result
cwrappersource="$output_path/$objdir/lt-$output_name.c"
cwrapper="$output_path/$output_name.exe"
$RM $cwrappersource $cwrapper
trap "$RM $cwrappersource $cwrapper; exit $EXIT_FAILURE" 1 2 15
func_emit_cwrapperexe_src > $cwrappersource
# The wrapper executable is built using the $host compiler,
# because it contains $host paths and files. If cross-
# compiling, it, like the target executable, must be
# executed on the $host or under an emulation environment.
$opt_dry_run || {
$LTCC $LTCFLAGS -o $cwrapper $cwrappersource
$STRIP $cwrapper
}
# Now, create the wrapper script for func_source use:
func_ltwrapper_scriptname $cwrapper
$RM $func_ltwrapper_scriptname_result
trap "$RM $func_ltwrapper_scriptname_result; exit $EXIT_FAILURE" 1 2 15
$opt_dry_run || {
# note: this script will not be executed, so do not chmod.
if test "x$build" = "x$host" ; then
$cwrapper --lt-dump-script > $func_ltwrapper_scriptname_result
else
func_emit_wrapper no > $func_ltwrapper_scriptname_result
fi
}
;;
* )
$RM $output
trap "$RM $output; exit $EXIT_FAILURE" 1 2 15
func_emit_wrapper no > $output
chmod +x $output
;;
esac
}
exit $EXIT_SUCCESS
;;
esac
# See if we need to build an old-fashioned archive.
for oldlib in $oldlibs; do
if test "$build_libtool_libs" = convenience; then
oldobjs="$libobjs_save $symfileobj"
addlibs="$convenience"
build_libtool_libs=no
else
if test "$build_libtool_libs" = module; then
oldobjs="$libobjs_save"
build_libtool_libs=no
else
oldobjs="$old_deplibs $non_pic_objects"
if test "$preload" = yes && test -f "$symfileobj"; then
func_append oldobjs " $symfileobj"
fi
fi
addlibs="$old_convenience"
fi
if test -n "$addlibs"; then
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_extract_archives $gentop $addlibs
func_append oldobjs " $func_extract_archives_result"
fi
# Do each command in the archive commands.
if test -n "$old_archive_from_new_cmds" && test "$build_libtool_libs" = yes; then
cmds=$old_archive_from_new_cmds
else
# Add any objects from preloaded convenience libraries
if test -n "$dlprefiles"; then
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_extract_archives $gentop $dlprefiles
func_append oldobjs " $func_extract_archives_result"
fi
# POSIX demands no paths to be encoded in archives. We have
# to avoid creating archives with duplicate basenames if we
# might have to extract them afterwards, e.g., when creating a
# static archive out of a convenience library, or when linking
# the entirety of a libtool archive into another (currently
# not supported by libtool).
if (for obj in $oldobjs
do
func_basename "$obj"
$ECHO "$func_basename_result"
done | sort | sort -uc >/dev/null 2>&1); then
:
else
echo "copying selected object files to avoid basename conflicts..."
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_mkdir_p "$gentop"
save_oldobjs=$oldobjs
oldobjs=
counter=1
for obj in $save_oldobjs
do
func_basename "$obj"
objbase="$func_basename_result"
case " $oldobjs " in
" ") oldobjs=$obj ;;
*[\ /]"$objbase "*)
while :; do
# Make sure we don't pick an alternate name that also
# overlaps.
newobj=lt$counter-$objbase
func_arith $counter + 1
counter=$func_arith_result
case " $oldobjs " in
*[\ /]"$newobj "*) ;;
*) if test ! -f "$gentop/$newobj"; then break; fi ;;
esac
done
func_show_eval "ln $obj $gentop/$newobj || cp $obj $gentop/$newobj"
func_append oldobjs " $gentop/$newobj"
;;
*) func_append oldobjs " $obj" ;;
esac
done
fi
func_to_tool_file "$oldlib" func_convert_file_msys_to_w32
tool_oldlib=$func_to_tool_file_result
eval cmds=\"$old_archive_cmds\"
func_len " $cmds"
len=$func_len_result
if test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
cmds=$old_archive_cmds
elif test -n "$archiver_list_spec"; then
func_verbose "using command file archive linking..."
for obj in $oldobjs
do
func_to_tool_file "$obj"
$ECHO "$func_to_tool_file_result"
done > $output_objdir/$libname.libcmd
func_to_tool_file "$output_objdir/$libname.libcmd"
oldobjs=" $archiver_list_spec$func_to_tool_file_result"
cmds=$old_archive_cmds
else
# the command line is too long to link in one step, link in parts
func_verbose "using piecewise archive linking..."
save_RANLIB=$RANLIB
RANLIB=:
objlist=
concat_cmds=
save_oldobjs=$oldobjs
oldobjs=
# Is there a better way of finding the last object in the list?
for obj in $save_oldobjs
do
last_oldobj=$obj
done
eval test_cmds=\"$old_archive_cmds\"
func_len " $test_cmds"
len0=$func_len_result
len=$len0
for obj in $save_oldobjs
do
func_len " $obj"
func_arith $len + $func_len_result
len=$func_arith_result
func_append objlist " $obj"
if test "$len" -lt "$max_cmd_len"; then
:
else
# the above command should be used before it gets too long
oldobjs=$objlist
if test "$obj" = "$last_oldobj" ; then
RANLIB=$save_RANLIB
fi
test -z "$concat_cmds" || concat_cmds=$concat_cmds~
eval concat_cmds=\"\${concat_cmds}$old_archive_cmds\"
objlist=
len=$len0
fi
done
RANLIB=$save_RANLIB
oldobjs=$objlist
if test "X$oldobjs" = "X" ; then
eval cmds=\"\$concat_cmds\"
else
eval cmds=\"\$concat_cmds~\$old_archive_cmds\"
fi
fi
fi
func_execute_cmds "$cmds" 'exit $?'
done
test -n "$generated" && \
func_show_eval "${RM}r$generated"
# Now create the libtool archive.
case $output in
*.la)
old_library=
test "$build_old_libs" = yes && old_library="$libname.$libext"
func_verbose "creating $output"
# Preserve any variables that may affect compiler behavior
for var in $variables_saved_for_relink; do
if eval test -z \"\${$var+set}\"; then
relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command"
elif eval var_value=\$$var; test -z "$var_value"; then
relink_command="$var=; export $var; $relink_command"
else
func_quote_for_eval "$var_value"
relink_command="$var=$func_quote_for_eval_result; export $var; $relink_command"
fi
done
# Quote the link command for shipping.
relink_command="(cd `pwd`; $SHELL $progpath $preserve_args --mode=relink $libtool_args @inst_prefix_dir@)"
relink_command=`$ECHO "$relink_command" | $SED "$sed_quote_subst"`
if test "$hardcode_automatic" = yes ; then
relink_command=
fi
# Only create the output if not a dry run.
$opt_dry_run || {
for installed in no yes; do
if test "$installed" = yes; then
if test -z "$install_libdir"; then
break
fi
output="$output_objdir/$outputname"i
# Replace all uninstalled libtool libraries with the installed ones
newdependency_libs=
for deplib in $dependency_libs; do
case $deplib in
*.la)
func_basename "$deplib"
name="$func_basename_result"
func_resolve_sysroot "$deplib"
eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $func_resolve_sysroot_result`
test -z "$libdir" && \
func_fatal_error "\`$deplib' is not a valid libtool archive"
func_append newdependency_libs " ${lt_sysroot:+=}$libdir/$name"
;;
-L*)
func_stripname -L '' "$deplib"
func_replace_sysroot "$func_stripname_result"
func_append newdependency_libs " -L$func_replace_sysroot_result"
;;
-R*)
func_stripname -R '' "$deplib"
func_replace_sysroot "$func_stripname_result"
func_append newdependency_libs " -R$func_replace_sysroot_result"
;;
*) func_append newdependency_libs " $deplib" ;;
esac
done
dependency_libs="$newdependency_libs"
newdlfiles=
for lib in $dlfiles; do
case $lib in
*.la)
func_basename "$lib"
name="$func_basename_result"
eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
test -z "$libdir" && \
func_fatal_error "\`$lib' is not a valid libtool archive"
func_append newdlfiles " ${lt_sysroot:+=}$libdir/$name"
;;
*) func_append newdlfiles " $lib" ;;
esac
done
dlfiles="$newdlfiles"
newdlprefiles=
for lib in $dlprefiles; do
case $lib in
*.la)
# Only pass preopened files to the pseudo-archive (for
# eventual linking with the app. that links it) if we
# didn't already link the preopened objects directly into
# the library:
func_basename "$lib"
name="$func_basename_result"
eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
test -z "$libdir" && \
func_fatal_error "\`$lib' is not a valid libtool archive"
func_append newdlprefiles " ${lt_sysroot:+=}$libdir/$name"
;;
esac
done
dlprefiles="$newdlprefiles"
else
newdlfiles=
for lib in $dlfiles; do
case $lib in
[\\/]* | [A-Za-z]:[\\/]*) abs="$lib" ;;
*) abs=`pwd`"/$lib" ;;
esac
func_append newdlfiles " $abs"
done
dlfiles="$newdlfiles"
newdlprefiles=
for lib in $dlprefiles; do
case $lib in
[\\/]* | [A-Za-z]:[\\/]*) abs="$lib" ;;
*) abs=`pwd`"/$lib" ;;
esac
func_append newdlprefiles " $abs"
done
dlprefiles="$newdlprefiles"
fi
$RM $output
# place dlname in correct position for cygwin
# In fact, it would be nice if we could use this code for all target
# systems that can't hard-code library paths into their executables
# and that have no shared library path variable independent of PATH,
# but it turns out we can't easily determine that from inspecting
# libtool variables, so we have to hard-code the OSs to which it
# applies here; at the moment, that means platforms that use the PE
# object format with DLL files. See the long comment at the top of
# tests/bindir.at for full details.
tdlname=$dlname
case $host,$output,$installed,$module,$dlname in
*cygwin*,*lai,yes,no,*.dll | *mingw*,*lai,yes,no,*.dll | *cegcc*,*lai,yes,no,*.dll)
# If a -bindir argument was supplied, place the dll there.
if test "x$bindir" != x ;
then
func_relative_path "$install_libdir" "$bindir"
tdlname=$func_relative_path_result$dlname
else
# Otherwise fall back on heuristic.
tdlname=../bin/$dlname
fi
;;
esac
$ECHO > $output "\
# $outputname - a libtool library file
# Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION
#
# Please DO NOT delete this file!
# It is necessary for linking the library.
# The name that we can dlopen(3).
dlname='$tdlname'
# Names of this library.
library_names='$library_names'
# The name of the static archive.
old_library='$old_library'
# Linker flags that can not go in dependency_libs.
inherited_linker_flags='$new_inherited_linker_flags'
# Libraries that this one depends upon.
dependency_libs='$dependency_libs'
# Names of additional weak libraries provided by this library
weak_library_names='$weak_libs'
# Version information for $libname.
current=$current
age=$age
revision=$revision
# Is this an already installed library?
installed=$installed
# Should we warn about portability when linking against -modules?
shouldnotlink=$module
# Files to dlopen/dlpreopen
dlopen='$dlfiles'
dlpreopen='$dlprefiles'
# Directory that this library needs to be installed in:
libdir='$install_libdir'"
if test "$installed" = no && test "$need_relink" = yes; then
$ECHO >> $output "\
relink_command=\"$relink_command\""
fi
done
}
# Do a symbolic link so that the libtool archive can be found in
# LD_LIBRARY_PATH before the program is installed.
func_show_eval '( cd "$output_objdir" && $RM "$outputname" && $LN_S "../$outputname" "$outputname" )' 'exit $?'
;;
esac
exit $EXIT_SUCCESS
}
{ test "$opt_mode" = link || test "$opt_mode" = relink; } &&
func_mode_link ${1+"$@"}
# func_mode_uninstall arg...
func_mode_uninstall ()
{
$opt_debug
RM="$nonopt"
files=
rmforce=
exit_status=0
# This variable tells wrapper scripts just to set variables rather
# than running their programs.
libtool_install_magic="$magic"
for arg
do
case $arg in
-f) func_append RM " $arg"; rmforce=yes ;;
-*) func_append RM " $arg" ;;
*) func_append files " $arg" ;;
esac
done
test -z "$RM" && \
func_fatal_help "you must specify an RM program"
rmdirs=
for file in $files; do
func_dirname "$file" "" "."
dir="$func_dirname_result"
if test "X$dir" = X.; then
odir="$objdir"
else
odir="$dir/$objdir"
fi
func_basename "$file"
name="$func_basename_result"
test "$opt_mode" = uninstall && odir="$dir"
# Remember odir for removal later, being careful to avoid duplicates
if test "$opt_mode" = clean; then
case " $rmdirs " in
*" $odir "*) ;;
*) func_append rmdirs " $odir" ;;
esac
fi
# Don't error if the file doesn't exist and rm -f was used.
if { test -L "$file"; } >/dev/null 2>&1 ||
{ test -h "$file"; } >/dev/null 2>&1 ||
test -f "$file"; then
:
elif test -d "$file"; then
exit_status=1
continue
elif test "$rmforce" = yes; then
continue
fi
rmfiles="$file"
case $name in
*.la)
# Possibly a libtool archive, so verify it.
if func_lalib_p "$file"; then
func_source $dir/$name
# Delete the libtool libraries and symlinks.
for n in $library_names; do
func_append rmfiles " $odir/$n"
done
test -n "$old_library" && func_append rmfiles " $odir/$old_library"
case "$opt_mode" in
clean)
case " $library_names " in
*" $dlname "*) ;;
*) test -n "$dlname" && func_append rmfiles " $odir/$dlname" ;;
esac
test -n "$libdir" && func_append rmfiles " $odir/$name $odir/${name}i"
;;
uninstall)
if test -n "$library_names"; then
# Do each command in the postuninstall commands.
func_execute_cmds "$postuninstall_cmds" 'test "$rmforce" = yes || exit_status=1'
fi
if test -n "$old_library"; then
# Do each command in the old_postuninstall commands.
func_execute_cmds "$old_postuninstall_cmds" 'test "$rmforce" = yes || exit_status=1'
fi
# FIXME: should reinstall the best remaining shared library.
;;
esac
fi
;;
*.lo)
# Possibly a libtool object, so verify it.
if func_lalib_p "$file"; then
# Read the .lo file
func_source $dir/$name
# Add PIC object to the list of files to remove.
if test -n "$pic_object" &&
test "$pic_object" != none; then
func_append rmfiles " $dir/$pic_object"
fi
# Add non-PIC object to the list of files to remove.
if test -n "$non_pic_object" &&
test "$non_pic_object" != none; then
func_append rmfiles " $dir/$non_pic_object"
fi
fi
;;
*)
if test "$opt_mode" = clean ; then
noexename=$name
case $file in
*.exe)
func_stripname '' '.exe' "$file"
file=$func_stripname_result
func_stripname '' '.exe' "$name"
noexename=$func_stripname_result
# $file with .exe has already been added to rmfiles,
# add $file without .exe
func_append rmfiles " $file"
;;
esac
# Do a test to see if this is a libtool program.
if func_ltwrapper_p "$file"; then
if func_ltwrapper_executable_p "$file"; then
func_ltwrapper_scriptname "$file"
relink_command=
func_source $func_ltwrapper_scriptname_result
func_append rmfiles " $func_ltwrapper_scriptname_result"
else
relink_command=
func_source $dir/$noexename
fi
# note $name still contains .exe if it was in $file originally
# as does the version of $file that was added into $rmfiles
func_append rmfiles " $odir/$name $odir/${name}S.${objext}"
if test "$fast_install" = yes && test -n "$relink_command"; then
func_append rmfiles " $odir/lt-$name"
fi
if test "X$noexename" != "X$name" ; then
func_append rmfiles " $odir/lt-${noexename}.c"
fi
fi
fi
;;
esac
func_show_eval "$RM $rmfiles" 'exit_status=1'
done
# Try to remove the ${objdir}s in the directories where we deleted files
for dir in $rmdirs; do
if test -d "$dir"; then
func_show_eval "rmdir $dir >/dev/null 2>&1"
fi
done
exit $exit_status
}
{ test "$opt_mode" = uninstall || test "$opt_mode" = clean; } &&
func_mode_uninstall ${1+"$@"}
test -z "$opt_mode" && {
help="$generic_help"
func_fatal_help "you must specify a MODE"
}
test -z "$exec_cmd" && \
func_fatal_help "invalid operation mode \`$opt_mode'"
if test -n "$exec_cmd"; then
eval exec "$exec_cmd"
exit $EXIT_FAILURE
fi
exit $exit_status
# The TAGs below are defined such that we never get into a situation
# in which we disable both kinds of libraries. Given conflicting
# choices, we go for a static library, that is the most portable,
# since we can't tell whether shared libraries were disabled because
# the user asked for that or because the platform doesn't support
# them. This is particularly important on AIX, because we don't
# support having both static and shared libraries enabled at the same
# time on that platform, so we default to a shared-only configuration.
# If a disable-shared tag is given, we'll fallback to a static-only
# configuration. But we'll never go from static-only to shared-only.
# ### BEGIN LIBTOOL TAG CONFIG: disable-shared
build_libtool_libs=no
build_old_libs=yes
# ### END LIBTOOL TAG CONFIG: disable-shared
# ### BEGIN LIBTOOL TAG CONFIG: disable-static
build_old_libs=`case $build_libtool_libs in yes) echo no;; *) echo yes;; esac`
# ### END LIBTOOL TAG CONFIG: disable-static
# Local Variables:
# mode:shell-script
# sh-indentation:2
# End:
# vi:sw=2
libctl-3.2.2/INSTALL 0000644 0001754 0000144 00000036605 12235234727 010762 0000000 0000000 Installation Instructions
*************************
Copyright (C) 1994-1996, 1999-2002, 2004-2013 Free Software Foundation,
Inc.
Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright
notice and this notice are preserved. This file is offered as-is,
without warranty of any kind.
Basic Installation
==================
Briefly, the shell commands `./configure; make; make install' should
configure, build, and install this package. The following
more-detailed instructions are generic; see the `README' file for
instructions specific to this package. Some packages provide this
`INSTALL' file but do not implement all of the features documented
below. The lack of an optional feature in a given package is not
necessarily a bug. More recommendations for GNU packages can be found
in *note Makefile Conventions: (standards)Makefile Conventions.
The `configure' shell script attempts to guess correct values for
various system-dependent variables used during compilation. It uses
those values to create a `Makefile' in each directory of the package.
It may also create one or more `.h' files containing system-dependent
definitions. Finally, it creates a shell script `config.status' that
you can run in the future to recreate the current configuration, and a
file `config.log' containing compiler output (useful mainly for
debugging `configure').
It can also use an optional file (typically called `config.cache'
and enabled with `--cache-file=config.cache' or simply `-C') that saves
the results of its tests to speed up reconfiguring. Caching is
disabled by default to prevent problems with accidental use of stale
cache files.
If you need to do unusual things to compile the package, please try
to figure out how `configure' could check whether to do them, and mail
diffs or instructions to the address given in the `README' so they can
be considered for the next release. If you are using the cache, and at
some point `config.cache' contains results you don't want to keep, you
may remove or edit it.
The file `configure.ac' (or `configure.in') is used to create
`configure' by a program called `autoconf'. You need `configure.ac' if
you want to change it or regenerate `configure' using a newer version
of `autoconf'.
The simplest way to compile this package is:
1. `cd' to the directory containing the package's source code and type
`./configure' to configure the package for your system.
Running `configure' might take a while. While running, it prints
some messages telling which features it is checking for.
2. Type `make' to compile the package.
3. Optionally, type `make check' to run any self-tests that come with
the package, generally using the just-built uninstalled binaries.
4. Type `make install' to install the programs and any data files and
documentation. When installing into a prefix owned by root, it is
recommended that the package be configured and built as a regular
user, and only the `make install' phase executed with root
privileges.
5. Optionally, type `make installcheck' to repeat any self-tests, but
this time using the binaries in their final installed location.
This target does not install anything. Running this target as a
regular user, particularly if the prior `make install' required
root privileges, verifies that the installation completed
correctly.
6. You can remove the program binaries and object files from the
source code directory by typing `make clean'. To also remove the
files that `configure' created (so you can compile the package for
a different kind of computer), type `make distclean'. There is
also a `make maintainer-clean' target, but that is intended mainly
for the package's developers. If you use it, you may have to get
all sorts of other programs in order to regenerate files that came
with the distribution.
7. Often, you can also type `make uninstall' to remove the installed
files again. In practice, not all packages have tested that
uninstallation works correctly, even though it is required by the
GNU Coding Standards.
8. Some packages, particularly those that use Automake, provide `make
distcheck', which can by used by developers to test that all other
targets like `make install' and `make uninstall' work correctly.
This target is generally not run by end users.
Compilers and Options
=====================
Some systems require unusual options for compilation or linking that
the `configure' script does not know about. Run `./configure --help'
for details on some of the pertinent environment variables.
You can give `configure' initial values for configuration parameters
by setting variables in the command line or in the environment. Here
is an example:
./configure CC=c99 CFLAGS=-g LIBS=-lposix
*Note Defining Variables::, for more details.
Compiling For Multiple Architectures
====================================
You can compile the package for more than one kind of computer at the
same time, by placing the object files for each architecture in their
own directory. To do this, you can use GNU `make'. `cd' to the
directory where you want the object files and executables to go and run
the `configure' script. `configure' automatically checks for the
source code in the directory that `configure' is in and in `..'. This
is known as a "VPATH" build.
With a non-GNU `make', it is safer to compile the package for one
architecture at a time in the source code directory. After you have
installed the package for one architecture, use `make distclean' before
reconfiguring for another architecture.
On MacOS X 10.5 and later systems, you can create libraries and
executables that work on multiple system types--known as "fat" or
"universal" binaries--by specifying multiple `-arch' options to the
compiler but only a single `-arch' option to the preprocessor. Like
this:
./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
CPP="gcc -E" CXXCPP="g++ -E"
This is not guaranteed to produce working output in all cases, you
may have to build one architecture at a time and combine the results
using the `lipo' tool if you have problems.
Installation Names
==================
By default, `make install' installs the package's commands under
`/usr/local/bin', include files under `/usr/local/include', etc. You
can specify an installation prefix other than `/usr/local' by giving
`configure' the option `--prefix=PREFIX', where PREFIX must be an
absolute file name.
You can specify separate installation prefixes for
architecture-specific files and architecture-independent files. If you
pass the option `--exec-prefix=PREFIX' to `configure', the package uses
PREFIX as the prefix for installing programs and libraries.
Documentation and other data files still use the regular prefix.
In addition, if you use an unusual directory layout you can give
options like `--bindir=DIR' to specify different values for particular
kinds of files. Run `configure --help' for a list of the directories
you can set and what kinds of files go in them. In general, the
default for these options is expressed in terms of `${prefix}', so that
specifying just `--prefix' will affect all of the other directory
specifications that were not explicitly provided.
The most portable way to affect installation locations is to pass the
correct locations to `configure'; however, many packages provide one or
both of the following shortcuts of passing variable assignments to the
`make install' command line to change installation locations without
having to reconfigure or recompile.
The first method involves providing an override variable for each
affected directory. For example, `make install
prefix=/alternate/directory' will choose an alternate location for all
directory configuration variables that were expressed in terms of
`${prefix}'. Any directories that were specified during `configure',
but not in terms of `${prefix}', must each be overridden at install
time for the entire installation to be relocated. The approach of
makefile variable overrides for each directory variable is required by
the GNU Coding Standards, and ideally causes no recompilation.
However, some platforms have known limitations with the semantics of
shared libraries that end up requiring recompilation when using this
method, particularly noticeable in packages that use GNU Libtool.
The second method involves providing the `DESTDIR' variable. For
example, `make install DESTDIR=/alternate/directory' will prepend
`/alternate/directory' before all installation names. The approach of
`DESTDIR' overrides is not required by the GNU Coding Standards, and
does not work on platforms that have drive letters. On the other hand,
it does better at avoiding recompilation issues, and works well even
when some directory options were not specified in terms of `${prefix}'
at `configure' time.
Optional Features
=================
If the package supports it, you can cause programs to be installed
with an extra prefix or suffix on their names by giving `configure' the
option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'.
Some packages pay attention to `--enable-FEATURE' options to
`configure', where FEATURE indicates an optional part of the package.
They may also pay attention to `--with-PACKAGE' options, where PACKAGE
is something like `gnu-as' or `x' (for the X Window System). The
`README' should mention any `--enable-' and `--with-' options that the
package recognizes.
For packages that use the X Window System, `configure' can usually
find the X include and library files automatically, but if it doesn't,
you can use the `configure' options `--x-includes=DIR' and
`--x-libraries=DIR' to specify their locations.
Some packages offer the ability to configure how verbose the
execution of `make' will be. For these packages, running `./configure
--enable-silent-rules' sets the default to minimal output, which can be
overridden with `make V=1'; while running `./configure
--disable-silent-rules' sets the default to verbose, which can be
overridden with `make V=0'.
Particular systems
==================
On HP-UX, the default C compiler is not ANSI C compatible. If GNU
CC is not installed, it is recommended to use the following options in
order to use an ANSI C compiler:
./configure CC="cc -Ae -D_XOPEN_SOURCE=500"
and if that doesn't work, install pre-built binaries of GCC for HP-UX.
HP-UX `make' updates targets which have the same time stamps as
their prerequisites, which makes it generally unusable when shipped
generated files such as `configure' are involved. Use GNU `make'
instead.
On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot
parse its `' header file. The option `-nodtk' can be used as
a workaround. If GNU CC is not installed, it is therefore recommended
to try
./configure CC="cc"
and if that doesn't work, try
./configure CC="cc -nodtk"
On Solaris, don't put `/usr/ucb' early in your `PATH'. This
directory contains several dysfunctional programs; working variants of
these programs are available in `/usr/bin'. So, if you need `/usr/ucb'
in your `PATH', put it _after_ `/usr/bin'.
On Haiku, software installed for all users goes in `/boot/common',
not `/usr/local'. It is recommended to use the following options:
./configure --prefix=/boot/common
Specifying the System Type
==========================
There may be some features `configure' cannot figure out
automatically, but needs to determine by the type of machine the package
will run on. Usually, assuming the package is built to be run on the
_same_ architectures, `configure' can figure that out, but if it prints
a message saying it cannot guess the machine type, give it the
`--build=TYPE' option. TYPE can either be a short name for the system
type, such as `sun4', or a canonical name which has the form:
CPU-COMPANY-SYSTEM
where SYSTEM can have one of these forms:
OS
KERNEL-OS
See the file `config.sub' for the possible values of each field. If
`config.sub' isn't included in this package, then this package doesn't
need to know the machine type.
If you are _building_ compiler tools for cross-compiling, you should
use the option `--target=TYPE' to select the type of system they will
produce code for.
If you want to _use_ a cross compiler, that generates code for a
platform different from the build platform, you should specify the
"host" platform (i.e., that on which the generated programs will
eventually be run) with `--host=TYPE'.
Sharing Defaults
================
If you want to set default values for `configure' scripts to share,
you can create a site shell script called `config.site' that gives
default values for variables like `CC', `cache_file', and `prefix'.
`configure' looks for `PREFIX/share/config.site' if it exists, then
`PREFIX/etc/config.site' if it exists. Or, you can set the
`CONFIG_SITE' environment variable to the location of the site script.
A warning: not all `configure' scripts look for a site script.
Defining Variables
==================
Variables not defined in a site shell script can be set in the
environment passed to `configure'. However, some packages may run
configure again during the build, and the customized values of these
variables may be lost. In order to avoid this problem, you should set
them in the `configure' command line, using `VAR=value'. For example:
./configure CC=/usr/local2/bin/gcc
causes the specified `gcc' to be used as the C compiler (unless it is
overridden in the site shell script).
Unfortunately, this technique does not work for `CONFIG_SHELL' due to
an Autoconf limitation. Until the limitation is lifted, you can use
this workaround:
CONFIG_SHELL=/bin/bash ./configure CONFIG_SHELL=/bin/bash
`configure' Invocation
======================
`configure' recognizes the following options to control how it
operates.
`--help'
`-h'
Print a summary of all of the options to `configure', and exit.
`--help=short'
`--help=recursive'
Print a summary of the options unique to this package's
`configure', and exit. The `short' variant lists options used
only in the top level, while the `recursive' variant lists options
also present in any nested packages.
`--version'
`-V'
Print the version of Autoconf used to generate the `configure'
script, and exit.
`--cache-file=FILE'
Enable the cache: use and save the results of the tests in FILE,
traditionally `config.cache'. FILE defaults to `/dev/null' to
disable caching.
`--config-cache'
`-C'
Alias for `--cache-file=config.cache'.
`--quiet'
`--silent'
`-q'
Do not print messages saying which checks are being made. To
suppress all normal output, redirect it to `/dev/null' (any error
messages will still be shown).
`--srcdir=DIR'
Look for the package's source code in directory DIR. Usually
`configure' can determine that directory automatically.
`--prefix=DIR'
Use DIR as the installation prefix. *note Installation Names::
for more details, including other options available for fine-tuning
the installation locations.
`--no-create'
`-n'
Run the configure checks, but stop before creating any output
files.
`configure' also accepts some other, not widely useful, options. Run
`configure --help' for more details.
libctl-3.2.2/missing 0000755 0001754 0000144 00000015331 12235234727 011321 0000000 0000000 #! /bin/sh
# Common wrapper for a few potentially missing GNU programs.
scriptversion=2012-06-26.16; # UTC
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
# Originally written by Fran,cois Pinard , 1996.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
if test $# -eq 0; then
echo 1>&2 "Try '$0 --help' for more information"
exit 1
fi
case $1 in
--is-lightweight)
# Used by our autoconf macros to check whether the available missing
# script is modern enough.
exit 0
;;
--run)
# Back-compat with the calling convention used by older automake.
shift
;;
-h|--h|--he|--hel|--help)
echo "\
$0 [OPTION]... PROGRAM [ARGUMENT]...
Run 'PROGRAM [ARGUMENT]...', returning a proper advice when this fails due
to PROGRAM being missing or too old.
Options:
-h, --help display this help and exit
-v, --version output version information and exit
Supported PROGRAM values:
aclocal autoconf autoheader autom4te automake makeinfo
bison yacc flex lex help2man
Version suffixes to PROGRAM as well as the prefixes 'gnu-', 'gnu', and
'g' are ignored when checking the name.
Send bug reports to ."
exit $?
;;
-v|--v|--ve|--ver|--vers|--versi|--versio|--version)
echo "missing $scriptversion (GNU Automake)"
exit $?
;;
-*)
echo 1>&2 "$0: unknown '$1' option"
echo 1>&2 "Try '$0 --help' for more information"
exit 1
;;
esac
# Run the given program, remember its exit status.
"$@"; st=$?
# If it succeeded, we are done.
test $st -eq 0 && exit 0
# Also exit now if we it failed (or wasn't found), and '--version' was
# passed; such an option is passed most likely to detect whether the
# program is present and works.
case $2 in --version|--help) exit $st;; esac
# Exit code 63 means version mismatch. This often happens when the user
# tries to use an ancient version of a tool on a file that requires a
# minimum version.
if test $st -eq 63; then
msg="probably too old"
elif test $st -eq 127; then
# Program was missing.
msg="missing on your system"
else
# Program was found and executed, but failed. Give up.
exit $st
fi
perl_URL=http://www.perl.org/
flex_URL=http://flex.sourceforge.net/
gnu_software_URL=http://www.gnu.org/software
program_details ()
{
case $1 in
aclocal|automake)
echo "The '$1' program is part of the GNU Automake package:"
echo "<$gnu_software_URL/automake>"
echo "It also requires GNU Autoconf, GNU m4 and Perl in order to run:"
echo "<$gnu_software_URL/autoconf>"
echo "<$gnu_software_URL/m4/>"
echo "<$perl_URL>"
;;
autoconf|autom4te|autoheader)
echo "The '$1' program is part of the GNU Autoconf package:"
echo "<$gnu_software_URL/autoconf/>"
echo "It also requires GNU m4 and Perl in order to run:"
echo "<$gnu_software_URL/m4/>"
echo "<$perl_URL>"
;;
esac
}
give_advice ()
{
# Normalize program name to check for.
normalized_program=`echo "$1" | sed '
s/^gnu-//; t
s/^gnu//; t
s/^g//; t'`
printf '%s\n' "'$1' is $msg."
configure_deps="'configure.ac' or m4 files included by 'configure.ac'"
case $normalized_program in
autoconf*)
echo "You should only need it if you modified 'configure.ac',"
echo "or m4 files included by it."
program_details 'autoconf'
;;
autoheader*)
echo "You should only need it if you modified 'acconfig.h' or"
echo "$configure_deps."
program_details 'autoheader'
;;
automake*)
echo "You should only need it if you modified 'Makefile.am' or"
echo "$configure_deps."
program_details 'automake'
;;
aclocal*)
echo "You should only need it if you modified 'acinclude.m4' or"
echo "$configure_deps."
program_details 'aclocal'
;;
autom4te*)
echo "You might have modified some maintainer files that require"
echo "the 'automa4te' program to be rebuilt."
program_details 'autom4te'
;;
bison*|yacc*)
echo "You should only need it if you modified a '.y' file."
echo "You may want to install the GNU Bison package:"
echo "<$gnu_software_URL/bison/>"
;;
lex*|flex*)
echo "You should only need it if you modified a '.l' file."
echo "You may want to install the Fast Lexical Analyzer package:"
echo "<$flex_URL>"
;;
help2man*)
echo "You should only need it if you modified a dependency" \
"of a man page."
echo "You may want to install the GNU Help2man package:"
echo "<$gnu_software_URL/help2man/>"
;;
makeinfo*)
echo "You should only need it if you modified a '.texi' file, or"
echo "any other file indirectly affecting the aspect of the manual."
echo "You might want to install the Texinfo package:"
echo "<$gnu_software_URL/texinfo/>"
echo "The spurious makeinfo call might also be the consequence of"
echo "using a buggy 'make' (AIX, DU, IRIX), in which case you might"
echo "want to install GNU make:"
echo "<$gnu_software_URL/make/>"
;;
*)
echo "You might have modified some files without having the proper"
echo "tools for further handling them. Check the 'README' file, it"
echo "often tells you about the needed prerequisites for installing"
echo "this package. You may also peek at any GNU archive site, in"
echo "case some other package contains this missing '$1' program."
;;
esac
}
give_advice "$1" | sed -e '1s/^/WARNING: /' \
-e '2,$s/^/ /' >&2
# Propagate the correct exit status (expected to be 127 for a program
# not found, 63 for a program that failed due to version mismatch).
exit $st
# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:
libctl-3.2.2/aclocal.m4 0000644 0001754 0000144 00000125316 12315333573 011565 0000000 0000000 # generated automatically by aclocal 1.14 -*- Autoconf -*-
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])])
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.69],,
[m4_warning([this file was generated for autoconf 2.69.
You have another version of autoconf. It may work, but is not guaranteed to.
If you have problems, you may need to regenerate the build system entirely.
To do so, use the procedure documented by the package, typically 'autoreconf'.])])
# Copyright (C) 2002-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_AUTOMAKE_VERSION(VERSION)
# ----------------------------
# Automake X.Y traces this macro to ensure aclocal.m4 has been
# generated from the m4 files accompanying Automake X.Y.
# (This private macro should not be called outside this file.)
AC_DEFUN([AM_AUTOMAKE_VERSION],
[am__api_version='1.14'
dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to
dnl require some minimum version. Point them to the right macro.
m4_if([$1], [1.14], [],
[AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl
])
# _AM_AUTOCONF_VERSION(VERSION)
# -----------------------------
# aclocal traces this macro to find the Autoconf version.
# This is a private macro too. Using m4_define simplifies
# the logic in aclocal, which can simply ignore this definition.
m4_define([_AM_AUTOCONF_VERSION], [])
# AM_SET_CURRENT_AUTOMAKE_VERSION
# -------------------------------
# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced.
# This function is AC_REQUIREd by AM_INIT_AUTOMAKE.
AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
[AM_AUTOMAKE_VERSION([1.14])dnl
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))])
# AM_AUX_DIR_EXPAND -*- Autoconf -*-
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets
# $ac_aux_dir to '$srcdir/foo'. In other projects, it is set to
# '$srcdir', '$srcdir/..', or '$srcdir/../..'.
#
# Of course, Automake must honor this variable whenever it calls a
# tool from the auxiliary directory. The problem is that $srcdir (and
# therefore $ac_aux_dir as well) can be either absolute or relative,
# depending on how configure is run. This is pretty annoying, since
# it makes $ac_aux_dir quite unusable in subdirectories: in the top
# source directory, any form will work fine, but in subdirectories a
# relative path needs to be adjusted first.
#
# $ac_aux_dir/missing
# fails when called from a subdirectory if $ac_aux_dir is relative
# $top_srcdir/$ac_aux_dir/missing
# fails if $ac_aux_dir is absolute,
# fails when called from a subdirectory in a VPATH build with
# a relative $ac_aux_dir
#
# The reason of the latter failure is that $top_srcdir and $ac_aux_dir
# are both prefixed by $srcdir. In an in-source build this is usually
# harmless because $srcdir is '.', but things will broke when you
# start a VPATH build or use an absolute $srcdir.
#
# So we could use something similar to $top_srcdir/$ac_aux_dir/missing,
# iff we strip the leading $srcdir from $ac_aux_dir. That would be:
# am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"`
# and then we would define $MISSING as
# MISSING="\${SHELL} $am_aux_dir/missing"
# This will work as long as MISSING is not called from configure, because
# unfortunately $(top_srcdir) has no meaning in configure.
# However there are other variables, like CC, which are often used in
# configure, and could therefore not use this "fixed" $ac_aux_dir.
#
# Another solution, used here, is to always expand $ac_aux_dir to an
# absolute PATH. The drawback is that using absolute paths prevent a
# configured tree to be moved without reconfiguration.
AC_DEFUN([AM_AUX_DIR_EXPAND],
[dnl Rely on autoconf to set up CDPATH properly.
AC_PREREQ([2.50])dnl
# expand $ac_aux_dir to an absolute path
am_aux_dir=`cd $ac_aux_dir && pwd`
])
# AM_CONDITIONAL -*- Autoconf -*-
# Copyright (C) 1997-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_CONDITIONAL(NAME, SHELL-CONDITION)
# -------------------------------------
# Define a conditional.
AC_DEFUN([AM_CONDITIONAL],
[AC_PREREQ([2.52])dnl
m4_if([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])],
[$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl
AC_SUBST([$1_TRUE])dnl
AC_SUBST([$1_FALSE])dnl
_AM_SUBST_NOTMAKE([$1_TRUE])dnl
_AM_SUBST_NOTMAKE([$1_FALSE])dnl
m4_define([_AM_COND_VALUE_$1], [$2])dnl
if $2; then
$1_TRUE=
$1_FALSE='#'
else
$1_TRUE='#'
$1_FALSE=
fi
AC_CONFIG_COMMANDS_PRE(
[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then
AC_MSG_ERROR([[conditional "$1" was never defined.
Usually this means the macro was only invoked conditionally.]])
fi])])
# Copyright (C) 1999-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# There are a few dirty hacks below to avoid letting 'AC_PROG_CC' be
# written in clear, in which case automake, when reading aclocal.m4,
# will think it sees a *use*, and therefore will trigger all it's
# C support machinery. Also note that it means that autoscan, seeing
# CC etc. in the Makefile, will ask for an AC_PROG_CC use...
# _AM_DEPENDENCIES(NAME)
# ----------------------
# See how the compiler implements dependency checking.
# NAME is "CC", "CXX", "OBJC", "OBJCXX", "UPC", or "GJC".
# We try a few techniques and use that to set a single cache variable.
#
# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was
# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular
# dependency, and given that the user is not expected to run this macro,
# just rely on AC_PROG_CC.
AC_DEFUN([_AM_DEPENDENCIES],
[AC_REQUIRE([AM_SET_DEPDIR])dnl
AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl
AC_REQUIRE([AM_MAKE_INCLUDE])dnl
AC_REQUIRE([AM_DEP_TRACK])dnl
m4_if([$1], [CC], [depcc="$CC" am_compiler_list=],
[$1], [CXX], [depcc="$CXX" am_compiler_list=],
[$1], [OBJC], [depcc="$OBJC" am_compiler_list='gcc3 gcc'],
[$1], [OBJCXX], [depcc="$OBJCXX" am_compiler_list='gcc3 gcc'],
[$1], [UPC], [depcc="$UPC" am_compiler_list=],
[$1], [GCJ], [depcc="$GCJ" am_compiler_list='gcc3 gcc'],
[depcc="$$1" am_compiler_list=])
AC_CACHE_CHECK([dependency style of $depcc],
[am_cv_$1_dependencies_compiler_type],
[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
# We make a subdir and do the tests there. Otherwise we can end up
# making bogus files that we don't know about and never remove. For
# instance it was reported that on HP-UX the gcc test will end up
# making a dummy file named 'D' -- because '-MD' means "put the output
# in D".
rm -rf conftest.dir
mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory.
cp "$am_depcomp" conftest.dir
cd conftest.dir
# We will build objects and dependencies in a subdirectory because
# it helps to detect inapplicable dependency modes. For instance
# both Tru64's cc and ICC support -MD to output dependencies as a
# side effect of compilation, but ICC will put the dependencies in
# the current directory while Tru64 will put them in the object
# directory.
mkdir sub
am_cv_$1_dependencies_compiler_type=none
if test "$am_compiler_list" = ""; then
am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp`
fi
am__universal=false
m4_case([$1], [CC],
[case " $depcc " in #(
*\ -arch\ *\ -arch\ *) am__universal=true ;;
esac],
[CXX],
[case " $depcc " in #(
*\ -arch\ *\ -arch\ *) am__universal=true ;;
esac])
for depmode in $am_compiler_list; do
# Setup a source with many dependencies, because some compilers
# like to wrap large dependency lists on column 80 (with \), and
# we should not choose a depcomp mode which is confused by this.
#
# We need to recreate these files for each test, as the compiler may
# overwrite some of them when testing with obscure command lines.
# This happens at least with the AIX C compiler.
: > sub/conftest.c
for i in 1 2 3 4 5 6; do
echo '#include "conftst'$i'.h"' >> sub/conftest.c
# Using ": > sub/conftst$i.h" creates only sub/conftst1.h with
# Solaris 10 /bin/sh.
echo '/* dummy */' > sub/conftst$i.h
done
echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf
# We check with '-c' and '-o' for the sake of the "dashmstdout"
# mode. It turns out that the SunPro C++ compiler does not properly
# handle '-M -o', and we need to detect this. Also, some Intel
# versions had trouble with output in subdirs.
am__obj=sub/conftest.${OBJEXT-o}
am__minus_obj="-o $am__obj"
case $depmode in
gcc)
# This depmode causes a compiler race in universal mode.
test "$am__universal" = false || continue
;;
nosideeffect)
# After this tag, mechanisms are not by side-effect, so they'll
# only be used when explicitly requested.
if test "x$enable_dependency_tracking" = xyes; then
continue
else
break
fi
;;
msvc7 | msvc7msys | msvisualcpp | msvcmsys)
# This compiler won't grok '-c -o', but also, the minuso test has
# not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted.
am__obj=conftest.${OBJEXT-o}
am__minus_obj=
;;
none) break ;;
esac
if depmode=$depmode \
source=sub/conftest.c object=$am__obj \
depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \
$SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \
>/dev/null 2>conftest.err &&
grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 &&
grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 &&
grep $am__obj sub/conftest.Po > /dev/null 2>&1 &&
${MAKE-make} -s -f confmf > /dev/null 2>&1; then
# icc doesn't choke on unknown options, it will just issue warnings
# or remarks (even with -Werror). So we grep stderr for any message
# that says an option was ignored or not supported.
# When given -MP, icc 7.0 and 7.1 complain thusly:
# icc: Command line warning: ignoring option '-M'; no argument required
# The diagnosis changed in icc 8.0:
# icc: Command line remark: option '-MP' not supported
if (grep 'ignoring option' conftest.err ||
grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else
am_cv_$1_dependencies_compiler_type=$depmode
break
fi
fi
done
cd ..
rm -rf conftest.dir
else
am_cv_$1_dependencies_compiler_type=none
fi
])
AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type])
AM_CONDITIONAL([am__fastdep$1], [
test "x$enable_dependency_tracking" != xno \
&& test "$am_cv_$1_dependencies_compiler_type" = gcc3])
])
# AM_SET_DEPDIR
# -------------
# Choose a directory name for dependency files.
# This macro is AC_REQUIREd in _AM_DEPENDENCIES.
AC_DEFUN([AM_SET_DEPDIR],
[AC_REQUIRE([AM_SET_LEADING_DOT])dnl
AC_SUBST([DEPDIR], ["${am__leading_dot}deps"])dnl
])
# AM_DEP_TRACK
# ------------
AC_DEFUN([AM_DEP_TRACK],
[AC_ARG_ENABLE([dependency-tracking], [dnl
AS_HELP_STRING(
[--enable-dependency-tracking],
[do not reject slow dependency extractors])
AS_HELP_STRING(
[--disable-dependency-tracking],
[speeds up one-time build])])
if test "x$enable_dependency_tracking" != xno; then
am_depcomp="$ac_aux_dir/depcomp"
AMDEPBACKSLASH='\'
am__nodep='_no'
fi
AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno])
AC_SUBST([AMDEPBACKSLASH])dnl
_AM_SUBST_NOTMAKE([AMDEPBACKSLASH])dnl
AC_SUBST([am__nodep])dnl
_AM_SUBST_NOTMAKE([am__nodep])dnl
])
# Generate code to set up dependency tracking. -*- Autoconf -*-
# Copyright (C) 1999-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_OUTPUT_DEPENDENCY_COMMANDS
# ------------------------------
AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS],
[{
# Older Autoconf quotes --file arguments for eval, but not when files
# are listed without --file. Let's play safe and only enable the eval
# if we detect the quoting.
case $CONFIG_FILES in
*\'*) eval set x "$CONFIG_FILES" ;;
*) set x $CONFIG_FILES ;;
esac
shift
for mf
do
# Strip MF so we end up with the name of the file.
mf=`echo "$mf" | sed -e 's/:.*$//'`
# Check whether this is an Automake generated Makefile or not.
# We used to match only the files named 'Makefile.in', but
# some people rename them; so instead we look at the file content.
# Grep'ing the first line is not enough: some people post-process
# each Makefile.in and add a new line on top of each file to say so.
# Grep'ing the whole file is not good either: AIX grep has a line
# limit of 2048, but all sed's we know have understand at least 4000.
if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then
dirpart=`AS_DIRNAME("$mf")`
else
continue
fi
# Extract the definition of DEPDIR, am__include, and am__quote
# from the Makefile without running 'make'.
DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"`
test -z "$DEPDIR" && continue
am__include=`sed -n 's/^am__include = //p' < "$mf"`
test -z "$am__include" && continue
am__quote=`sed -n 's/^am__quote = //p' < "$mf"`
# Find all dependency output files, they are included files with
# $(DEPDIR) in their names. We invoke sed twice because it is the
# simplest approach to changing $(DEPDIR) to its actual value in the
# expansion.
for file in `sed -n "
s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \
sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do
# Make sure the directory exists.
test -f "$dirpart/$file" && continue
fdir=`AS_DIRNAME(["$file"])`
AS_MKDIR_P([$dirpart/$fdir])
# echo "creating $dirpart/$file"
echo '# dummy' > "$dirpart/$file"
done
done
}
])# _AM_OUTPUT_DEPENDENCY_COMMANDS
# AM_OUTPUT_DEPENDENCY_COMMANDS
# -----------------------------
# This macro should only be invoked once -- use via AC_REQUIRE.
#
# This code is only required when automatic dependency tracking
# is enabled. FIXME. This creates each '.P' file that we will
# need in order to bootstrap the dependency handling code.
AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS],
[AC_CONFIG_COMMANDS([depfiles],
[test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS],
[AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"])
])
# Do all the work for Automake. -*- Autoconf -*-
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This macro actually does too much. Some checks are only needed if
# your package does certain things. But this isn't really a big deal.
dnl Redefine AC_PROG_CC to automatically invoke _AM_PROG_CC_C_O.
m4_define([AC_PROG_CC],
m4_defn([AC_PROG_CC])
[_AM_PROG_CC_C_O
])
# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE])
# AM_INIT_AUTOMAKE([OPTIONS])
# -----------------------------------------------
# The call with PACKAGE and VERSION arguments is the old style
# call (pre autoconf-2.50), which is being phased out. PACKAGE
# and VERSION should now be passed to AC_INIT and removed from
# the call to AM_INIT_AUTOMAKE.
# We support both call styles for the transition. After
# the next Automake release, Autoconf can make the AC_INIT
# arguments mandatory, and then we can depend on a new Autoconf
# release and drop the old call support.
AC_DEFUN([AM_INIT_AUTOMAKE],
[AC_PREREQ([2.65])dnl
dnl Autoconf wants to disallow AM_ names. We explicitly allow
dnl the ones we care about.
m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl
AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl
AC_REQUIRE([AC_PROG_INSTALL])dnl
if test "`cd $srcdir && pwd`" != "`pwd`"; then
# Use -I$(srcdir) only when $(srcdir) != ., so that make's output
# is not polluted with repeated "-I."
AC_SUBST([am__isrc], [' -I$(srcdir)'])_AM_SUBST_NOTMAKE([am__isrc])dnl
# test to see if srcdir already configured
if test -f $srcdir/config.status; then
AC_MSG_ERROR([source directory already configured; run "make distclean" there first])
fi
fi
# test whether we have cygpath
if test -z "$CYGPATH_W"; then
if (cygpath --version) >/dev/null 2>/dev/null; then
CYGPATH_W='cygpath -w'
else
CYGPATH_W=echo
fi
fi
AC_SUBST([CYGPATH_W])
# Define the identity of the package.
dnl Distinguish between old-style and new-style calls.
m4_ifval([$2],
[AC_DIAGNOSE([obsolete],
[$0: two- and three-arguments forms are deprecated.])
m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl
AC_SUBST([PACKAGE], [$1])dnl
AC_SUBST([VERSION], [$2])],
[_AM_SET_OPTIONS([$1])dnl
dnl Diagnose old-style AC_INIT with new-style AM_AUTOMAKE_INIT.
m4_if(
m4_ifdef([AC_PACKAGE_NAME], [ok]):m4_ifdef([AC_PACKAGE_VERSION], [ok]),
[ok:ok],,
[m4_fatal([AC_INIT should be called with package and version arguments])])dnl
AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl
AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl
_AM_IF_OPTION([no-define],,
[AC_DEFINE_UNQUOTED([PACKAGE], ["$PACKAGE"], [Name of package])
AC_DEFINE_UNQUOTED([VERSION], ["$VERSION"], [Version number of package])])dnl
# Some tools Automake needs.
AC_REQUIRE([AM_SANITY_CHECK])dnl
AC_REQUIRE([AC_ARG_PROGRAM])dnl
AM_MISSING_PROG([ACLOCAL], [aclocal-${am__api_version}])
AM_MISSING_PROG([AUTOCONF], [autoconf])
AM_MISSING_PROG([AUTOMAKE], [automake-${am__api_version}])
AM_MISSING_PROG([AUTOHEADER], [autoheader])
AM_MISSING_PROG([MAKEINFO], [makeinfo])
AC_REQUIRE([AM_PROG_INSTALL_SH])dnl
AC_REQUIRE([AM_PROG_INSTALL_STRIP])dnl
AC_REQUIRE([AC_PROG_MKDIR_P])dnl
# For better backward compatibility. To be removed once Automake 1.9.x
# dies out for good. For more background, see:
#
#
AC_SUBST([mkdir_p], ['$(MKDIR_P)'])
# We need awk for the "check" target. The system "awk" is bad on
# some platforms.
AC_REQUIRE([AC_PROG_AWK])dnl
AC_REQUIRE([AC_PROG_MAKE_SET])dnl
AC_REQUIRE([AM_SET_LEADING_DOT])dnl
_AM_IF_OPTION([tar-ustar], [_AM_PROG_TAR([ustar])],
[_AM_IF_OPTION([tar-pax], [_AM_PROG_TAR([pax])],
[_AM_PROG_TAR([v7])])])
_AM_IF_OPTION([no-dependencies],,
[AC_PROVIDE_IFELSE([AC_PROG_CC],
[_AM_DEPENDENCIES([CC])],
[m4_define([AC_PROG_CC],
m4_defn([AC_PROG_CC])[_AM_DEPENDENCIES([CC])])])dnl
AC_PROVIDE_IFELSE([AC_PROG_CXX],
[_AM_DEPENDENCIES([CXX])],
[m4_define([AC_PROG_CXX],
m4_defn([AC_PROG_CXX])[_AM_DEPENDENCIES([CXX])])])dnl
AC_PROVIDE_IFELSE([AC_PROG_OBJC],
[_AM_DEPENDENCIES([OBJC])],
[m4_define([AC_PROG_OBJC],
m4_defn([AC_PROG_OBJC])[_AM_DEPENDENCIES([OBJC])])])dnl
AC_PROVIDE_IFELSE([AC_PROG_OBJCXX],
[_AM_DEPENDENCIES([OBJCXX])],
[m4_define([AC_PROG_OBJCXX],
m4_defn([AC_PROG_OBJCXX])[_AM_DEPENDENCIES([OBJCXX])])])dnl
])
AC_REQUIRE([AM_SILENT_RULES])dnl
dnl The testsuite driver may need to know about EXEEXT, so add the
dnl 'am__EXEEXT' conditional if _AM_COMPILER_EXEEXT was seen. This
dnl macro is hooked onto _AC_COMPILER_EXEEXT early, see below.
AC_CONFIG_COMMANDS_PRE(dnl
[m4_provide_if([_AM_COMPILER_EXEEXT],
[AM_CONDITIONAL([am__EXEEXT], [test -n "$EXEEXT"])])])dnl
# POSIX will say in a future version that running "rm -f" with no argument
# is OK; and we want to be able to make that assumption in our Makefile
# recipes. So use an aggressive probe to check that the usage we want is
# actually supported "in the wild" to an acceptable degree.
# See automake bug#10828.
# To make any issue more visible, cause the running configure to be aborted
# by default if the 'rm' program in use doesn't match our expectations; the
# user can still override this though.
if rm -f && rm -fr && rm -rf; then : OK; else
cat >&2 <<'END'
Oops!
Your 'rm' program seems unable to run without file operands specified
on the command line, even when the '-f' option is present. This is contrary
to the behaviour of most rm programs out there, and not conforming with
the upcoming POSIX standard:
Please tell bug-automake@gnu.org about your system, including the value
of your $PATH and any error possibly output before this message. This
can help us improve future automake versions.
END
if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then
echo 'Configuration will proceed anyway, since you have set the' >&2
echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2
echo >&2
else
cat >&2 <<'END'
Aborting the configuration process, to ensure you take notice of the issue.
You can download and install GNU coreutils to get an 'rm' implementation
that behaves properly: .
If you want to complete the configuration process using your problematic
'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM
to "yes", and re-run configure.
END
AC_MSG_ERROR([Your 'rm' program is bad, sorry.])
fi
fi])
dnl Hook into '_AC_COMPILER_EXEEXT' early to learn its expansion. Do not
dnl add the conditional right here, as _AC_COMPILER_EXEEXT may be further
dnl mangled by Autoconf and run in a shell conditional statement.
m4_define([_AC_COMPILER_EXEEXT],
m4_defn([_AC_COMPILER_EXEEXT])[m4_provide([_AM_COMPILER_EXEEXT])])
# When config.status generates a header, we must update the stamp-h file.
# This file resides in the same directory as the config header
# that is generated. The stamp files are numbered to have different names.
# Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the
# loop where config.status creates the headers, so we can generate
# our stamp files there.
AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK],
[# Compute $1's index in $config_headers.
_am_arg=$1
_am_stamp_count=1
for _am_header in $config_headers :; do
case $_am_header in
$_am_arg | $_am_arg:* )
break ;;
* )
_am_stamp_count=`expr $_am_stamp_count + 1` ;;
esac
done
echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count])
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_PROG_INSTALL_SH
# ------------------
# Define $install_sh.
AC_DEFUN([AM_PROG_INSTALL_SH],
[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
if test x"${install_sh}" != xset; then
case $am_aux_dir in
*\ * | *\ *)
install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;;
*)
install_sh="\${SHELL} $am_aux_dir/install-sh"
esac
fi
AC_SUBST([install_sh])])
# Copyright (C) 2003-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# Check whether the underlying file-system supports filenames
# with a leading dot. For instance MS-DOS doesn't.
AC_DEFUN([AM_SET_LEADING_DOT],
[rm -rf .tst 2>/dev/null
mkdir .tst 2>/dev/null
if test -d .tst; then
am__leading_dot=.
else
am__leading_dot=_
fi
rmdir .tst 2>/dev/null
AC_SUBST([am__leading_dot])])
# Add --enable-maintainer-mode option to configure. -*- Autoconf -*-
# From Jim Meyering
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_MAINTAINER_MODE([DEFAULT-MODE])
# ----------------------------------
# Control maintainer-specific portions of Makefiles.
# Default is to disable them, unless 'enable' is passed literally.
# For symmetry, 'disable' may be passed as well. Anyway, the user
# can override the default with the --enable/--disable switch.
AC_DEFUN([AM_MAINTAINER_MODE],
[m4_case(m4_default([$1], [disable]),
[enable], [m4_define([am_maintainer_other], [disable])],
[disable], [m4_define([am_maintainer_other], [enable])],
[m4_define([am_maintainer_other], [enable])
m4_warn([syntax], [unexpected argument to AM@&t@_MAINTAINER_MODE: $1])])
AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
dnl maintainer-mode's default is 'disable' unless 'enable' is passed
AC_ARG_ENABLE([maintainer-mode],
[AS_HELP_STRING([--]am_maintainer_other[-maintainer-mode],
am_maintainer_other[ make rules and dependencies not useful
(and sometimes confusing) to the casual installer])],
[USE_MAINTAINER_MODE=$enableval],
[USE_MAINTAINER_MODE=]m4_if(am_maintainer_other, [enable], [no], [yes]))
AC_MSG_RESULT([$USE_MAINTAINER_MODE])
AM_CONDITIONAL([MAINTAINER_MODE], [test $USE_MAINTAINER_MODE = yes])
MAINT=$MAINTAINER_MODE_TRUE
AC_SUBST([MAINT])dnl
]
)
# Check to see how 'make' treats includes. -*- Autoconf -*-
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_MAKE_INCLUDE()
# -----------------
# Check to see how make treats includes.
AC_DEFUN([AM_MAKE_INCLUDE],
[am_make=${MAKE-make}
cat > confinc << 'END'
am__doit:
@echo this is the am__doit target
.PHONY: am__doit
END
# If we don't find an include directive, just comment out the code.
AC_MSG_CHECKING([for style of include used by $am_make])
am__include="#"
am__quote=
_am_result=none
# First try GNU make style include.
echo "include confinc" > confmf
# Ignore all kinds of additional output from 'make'.
case `$am_make -s -f confmf 2> /dev/null` in #(
*the\ am__doit\ target*)
am__include=include
am__quote=
_am_result=GNU
;;
esac
# Now try BSD make style include.
if test "$am__include" = "#"; then
echo '.include "confinc"' > confmf
case `$am_make -s -f confmf 2> /dev/null` in #(
*the\ am__doit\ target*)
am__include=.include
am__quote="\""
_am_result=BSD
;;
esac
fi
AC_SUBST([am__include])
AC_SUBST([am__quote])
AC_MSG_RESULT([$_am_result])
rm -f confinc confmf
])
# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*-
# Copyright (C) 1997-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_MISSING_PROG(NAME, PROGRAM)
# ------------------------------
AC_DEFUN([AM_MISSING_PROG],
[AC_REQUIRE([AM_MISSING_HAS_RUN])
$1=${$1-"${am_missing_run}$2"}
AC_SUBST($1)])
# AM_MISSING_HAS_RUN
# ------------------
# Define MISSING if not defined so far and test if it is modern enough.
# If it is, set am_missing_run to use it, otherwise, to nothing.
AC_DEFUN([AM_MISSING_HAS_RUN],
[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
AC_REQUIRE_AUX_FILE([missing])dnl
if test x"${MISSING+set}" != xset; then
case $am_aux_dir in
*\ * | *\ *)
MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;;
*)
MISSING="\${SHELL} $am_aux_dir/missing" ;;
esac
fi
# Use eval to expand $SHELL
if eval "$MISSING --is-lightweight"; then
am_missing_run="$MISSING "
else
am_missing_run=
AC_MSG_WARN(['missing' script is too old or missing])
fi
])
# Helper functions for option handling. -*- Autoconf -*-
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_MANGLE_OPTION(NAME)
# -----------------------
AC_DEFUN([_AM_MANGLE_OPTION],
[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])])
# _AM_SET_OPTION(NAME)
# --------------------
# Set option NAME. Presently that only means defining a flag for this option.
AC_DEFUN([_AM_SET_OPTION],
[m4_define(_AM_MANGLE_OPTION([$1]), [1])])
# _AM_SET_OPTIONS(OPTIONS)
# ------------------------
# OPTIONS is a space-separated list of Automake options.
AC_DEFUN([_AM_SET_OPTIONS],
[m4_foreach_w([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])])
# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET])
# -------------------------------------------
# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise.
AC_DEFUN([_AM_IF_OPTION],
[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])])
# Copyright (C) 1999-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_PROG_CC_C_O
# ---------------
# Like AC_PROG_CC_C_O, but changed for automake. We rewrite AC_PROG_CC
# to automatically call this.
AC_DEFUN([_AM_PROG_CC_C_O],
[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
AC_REQUIRE_AUX_FILE([compile])dnl
AC_LANG_PUSH([C])dnl
AC_CACHE_CHECK(
[whether $CC understands -c and -o together],
[am_cv_prog_cc_c_o],
[AC_LANG_CONFTEST([AC_LANG_PROGRAM([])])
# Make sure it works both with $CC and with simple cc.
# Following AC_PROG_CC_C_O, we do the test twice because some
# compilers refuse to overwrite an existing .o file with -o,
# though they will create one.
am_cv_prog_cc_c_o=yes
for am_i in 1 2; do
if AM_RUN_LOG([$CC -c conftest.$ac_ext -o conftest2.$ac_objext]) \
&& test -f conftest2.$ac_objext; then
: OK
else
am_cv_prog_cc_c_o=no
break
fi
done
rm -f core conftest*
unset am_i])
if test "$am_cv_prog_cc_c_o" != yes; then
# Losing compiler, so override with the script.
# FIXME: It is wrong to rewrite CC.
# But if we don't then we get into trouble of one sort or another.
# A longer-term fix would be to have automake use am__CC in this case,
# and then we could set am__CC="\$(top_srcdir)/compile \$(CC)"
CC="$am_aux_dir/compile $CC"
fi
AC_LANG_POP([C])])
# For backward compatibility.
AC_DEFUN_ONCE([AM_PROG_CC_C_O], [AC_REQUIRE([AC_PROG_CC])])
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_RUN_LOG(COMMAND)
# -------------------
# Run COMMAND, save the exit status in ac_status, and log it.
# (This has been adapted from Autoconf's _AC_RUN_LOG macro.)
AC_DEFUN([AM_RUN_LOG],
[{ echo "$as_me:$LINENO: $1" >&AS_MESSAGE_LOG_FD
($1) >&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
(exit $ac_status); }])
# Check to make sure that the build environment is sane. -*- Autoconf -*-
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_SANITY_CHECK
# ---------------
AC_DEFUN([AM_SANITY_CHECK],
[AC_MSG_CHECKING([whether build environment is sane])
# Reject unsafe characters in $srcdir or the absolute working directory
# name. Accept space and tab only in the latter.
am_lf='
'
case `pwd` in
*[[\\\"\#\$\&\'\`$am_lf]]*)
AC_MSG_ERROR([unsafe absolute working directory name]);;
esac
case $srcdir in
*[[\\\"\#\$\&\'\`$am_lf\ \ ]]*)
AC_MSG_ERROR([unsafe srcdir value: '$srcdir']);;
esac
# Do 'set' in a subshell so we don't clobber the current shell's
# arguments. Must try -L first in case configure is actually a
# symlink; some systems play weird games with the mod time of symlinks
# (eg FreeBSD returns the mod time of the symlink's containing
# directory).
if (
am_has_slept=no
for am_try in 1 2; do
echo "timestamp, slept: $am_has_slept" > conftest.file
set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null`
if test "$[*]" = "X"; then
# -L didn't work.
set X `ls -t "$srcdir/configure" conftest.file`
fi
if test "$[*]" != "X $srcdir/configure conftest.file" \
&& test "$[*]" != "X conftest.file $srcdir/configure"; then
# If neither matched, then we have a broken ls. This can happen
# if, for instance, CONFIG_SHELL is bash and it inherits a
# broken ls alias from the environment. This has actually
# happened. Such a system could not be considered "sane".
AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken
alias in your environment])
fi
if test "$[2]" = conftest.file || test $am_try -eq 2; then
break
fi
# Just in case.
sleep 1
am_has_slept=yes
done
test "$[2]" = conftest.file
)
then
# Ok.
:
else
AC_MSG_ERROR([newly created file is older than distributed files!
Check your system clock])
fi
AC_MSG_RESULT([yes])
# If we didn't sleep, we still need to ensure time stamps of config.status and
# generated files are strictly newer.
am_sleep_pid=
if grep 'slept: no' conftest.file >/dev/null 2>&1; then
( sleep 1 ) &
am_sleep_pid=$!
fi
AC_CONFIG_COMMANDS_PRE(
[AC_MSG_CHECKING([that generated files are newer than configure])
if test -n "$am_sleep_pid"; then
# Hide warnings about reused PIDs.
wait $am_sleep_pid 2>/dev/null
fi
AC_MSG_RESULT([done])])
rm -f conftest.file
])
# Copyright (C) 2009-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_SILENT_RULES([DEFAULT])
# --------------------------
# Enable less verbose build rules; with the default set to DEFAULT
# ("yes" being less verbose, "no" or empty being verbose).
AC_DEFUN([AM_SILENT_RULES],
[AC_ARG_ENABLE([silent-rules], [dnl
AS_HELP_STRING(
[--enable-silent-rules],
[less verbose build output (undo: "make V=1")])
AS_HELP_STRING(
[--disable-silent-rules],
[verbose build output (undo: "make V=0")])dnl
])
case $enable_silent_rules in @%:@ (((
yes) AM_DEFAULT_VERBOSITY=0;;
no) AM_DEFAULT_VERBOSITY=1;;
*) AM_DEFAULT_VERBOSITY=m4_if([$1], [yes], [0], [1]);;
esac
dnl
dnl A few 'make' implementations (e.g., NonStop OS and NextStep)
dnl do not support nested variable expansions.
dnl See automake bug#9928 and bug#10237.
am_make=${MAKE-make}
AC_CACHE_CHECK([whether $am_make supports nested variables],
[am_cv_make_support_nested_variables],
[if AS_ECHO([['TRUE=$(BAR$(V))
BAR0=false
BAR1=true
V=1
am__doit:
@$(TRUE)
.PHONY: am__doit']]) | $am_make -f - >/dev/null 2>&1; then
am_cv_make_support_nested_variables=yes
else
am_cv_make_support_nested_variables=no
fi])
if test $am_cv_make_support_nested_variables = yes; then
dnl Using '$V' instead of '$(V)' breaks IRIX make.
AM_V='$(V)'
AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)'
else
AM_V=$AM_DEFAULT_VERBOSITY
AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY
fi
AC_SUBST([AM_V])dnl
AM_SUBST_NOTMAKE([AM_V])dnl
AC_SUBST([AM_DEFAULT_V])dnl
AM_SUBST_NOTMAKE([AM_DEFAULT_V])dnl
AC_SUBST([AM_DEFAULT_VERBOSITY])dnl
AM_BACKSLASH='\'
AC_SUBST([AM_BACKSLASH])dnl
_AM_SUBST_NOTMAKE([AM_BACKSLASH])dnl
])
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_PROG_INSTALL_STRIP
# ---------------------
# One issue with vendor 'install' (even GNU) is that you can't
# specify the program used to strip binaries. This is especially
# annoying in cross-compiling environments, where the build's strip
# is unlikely to handle the host's binaries.
# Fortunately install-sh will honor a STRIPPROG variable, so we
# always use install-sh in "make install-strip", and initialize
# STRIPPROG with the value of the STRIP variable (set by the user).
AC_DEFUN([AM_PROG_INSTALL_STRIP],
[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl
# Installed binaries are usually stripped using 'strip' when the user
# run "make install-strip". However 'strip' might not be the right
# tool to use in cross-compilation environments, therefore Automake
# will honor the 'STRIP' environment variable to overrule this program.
dnl Don't test for $cross_compiling = yes, because it might be 'maybe'.
if test "$cross_compiling" != no; then
AC_CHECK_TOOL([STRIP], [strip], :)
fi
INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s"
AC_SUBST([INSTALL_STRIP_PROGRAM])])
# Copyright (C) 2006-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_SUBST_NOTMAKE(VARIABLE)
# ---------------------------
# Prevent Automake from outputting VARIABLE = @VARIABLE@ in Makefile.in.
# This macro is traced by Automake.
AC_DEFUN([_AM_SUBST_NOTMAKE])
# AM_SUBST_NOTMAKE(VARIABLE)
# --------------------------
# Public sister of _AM_SUBST_NOTMAKE.
AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)])
# Check how to create a tarball. -*- Autoconf -*-
# Copyright (C) 2004-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_PROG_TAR(FORMAT)
# --------------------
# Check how to create a tarball in format FORMAT.
# FORMAT should be one of 'v7', 'ustar', or 'pax'.
#
# Substitute a variable $(am__tar) that is a command
# writing to stdout a FORMAT-tarball containing the directory
# $tardir.
# tardir=directory && $(am__tar) > result.tar
#
# Substitute a variable $(am__untar) that extract such
# a tarball read from stdin.
# $(am__untar) < result.tar
#
AC_DEFUN([_AM_PROG_TAR],
[# Always define AMTAR for backward compatibility. Yes, it's still used
# in the wild :-( We should find a proper way to deprecate it ...
AC_SUBST([AMTAR], ['$${TAR-tar}'])
# We'll loop over all known methods to create a tar archive until one works.
_am_tools='gnutar m4_if([$1], [ustar], [plaintar]) pax cpio none'
m4_if([$1], [v7],
[am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'],
[m4_case([$1],
[ustar],
[# The POSIX 1988 'ustar' format is defined with fixed-size fields.
# There is notably a 21 bits limit for the UID and the GID. In fact,
# the 'pax' utility can hang on bigger UID/GID (see automake bug#8343
# and bug#13588).
am_max_uid=2097151 # 2^21 - 1
am_max_gid=$am_max_uid
# The $UID and $GID variables are not portable, so we need to resort
# to the POSIX-mandated id(1) utility. Errors in the 'id' calls
# below are definitely unexpected, so allow the users to see them
# (that is, avoid stderr redirection).
am_uid=`id -u || echo unknown`
am_gid=`id -g || echo unknown`
AC_MSG_CHECKING([whether UID '$am_uid' is supported by ustar format])
if test $am_uid -le $am_max_uid; then
AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
_am_tools=none
fi
AC_MSG_CHECKING([whether GID '$am_gid' is supported by ustar format])
if test $am_gid -le $am_max_gid; then
AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
_am_tools=none
fi],
[pax],
[],
[m4_fatal([Unknown tar format])])
AC_MSG_CHECKING([how to create a $1 tar archive])
# Go ahead even if we have the value already cached. We do so because we
# need to set the values for the 'am__tar' and 'am__untar' variables.
_am_tools=${am_cv_prog_tar_$1-$_am_tools}
for _am_tool in $_am_tools; do
case $_am_tool in
gnutar)
for _am_tar in tar gnutar gtar; do
AM_RUN_LOG([$_am_tar --version]) && break
done
am__tar="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$$tardir"'
am__tar_="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$tardir"'
am__untar="$_am_tar -xf -"
;;
plaintar)
# Must skip GNU tar: if it does not support --format= it doesn't create
# ustar tarball either.
(tar --version) >/dev/null 2>&1 && continue
am__tar='tar chf - "$$tardir"'
am__tar_='tar chf - "$tardir"'
am__untar='tar xf -'
;;
pax)
am__tar='pax -L -x $1 -w "$$tardir"'
am__tar_='pax -L -x $1 -w "$tardir"'
am__untar='pax -r'
;;
cpio)
am__tar='find "$$tardir" -print | cpio -o -H $1 -L'
am__tar_='find "$tardir" -print | cpio -o -H $1 -L'
am__untar='cpio -i -H $1 -d'
;;
none)
am__tar=false
am__tar_=false
am__untar=false
;;
esac
# If the value was cached, stop now. We just wanted to have am__tar
# and am__untar set.
test -n "${am_cv_prog_tar_$1}" && break
# tar/untar a dummy directory, and stop if the command works.
rm -rf conftest.dir
mkdir conftest.dir
echo GrepMe > conftest.dir/file
AM_RUN_LOG([tardir=conftest.dir && eval $am__tar_ >conftest.tar])
rm -rf conftest.dir
if test -s conftest.tar; then
AM_RUN_LOG([$am__untar /dev/null 2>&1 && break
fi
done
rm -rf conftest.dir
AC_CACHE_VAL([am_cv_prog_tar_$1], [am_cv_prog_tar_$1=$_am_tool])
AC_MSG_RESULT([$am_cv_prog_tar_$1])])
AC_SUBST([am__tar])
AC_SUBST([am__untar])
]) # _AM_PROG_TAR
m4_include([m4/libtool.m4])
m4_include([m4/ltoptions.m4])
m4_include([m4/ltsugar.m4])
m4_include([m4/ltversion.m4])
m4_include([m4/lt~obsolete.m4])
libctl-3.2.2/src/ 0000755 0001754 0000144 00000000000 12315333663 010564 5 0000000 0000000 libctl-3.2.2/src/Makefile.am 0000644 0001754 0000144 00000000375 12315325304 012536 0000000 0000000 lib_LTLIBRARIES = libctl.la
nodist_include_HEADERS = ctl.h
BUILT_SOURCES = ctl.h
EXTRA_DIST = ctl.h.in
libctl_la_SOURCES = ctl.c subplex.c ctl-f77-glue.c integrator.c cintegrator.c
libctl_la_LDFLAGS = -no-undefined -version-info @SHARED_VERSION_INFO@
libctl-3.2.2/src/ctl.h.in 0000644 0001754 0000144 00000036462 12315330377 012056 0000000 0000000 /* libctl: flexible Guile-based control files for scientific software
* Copyright (C) 1998-2014 Massachusetts Institute of Technology and Steven G. Johnson
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the
* Free Software Foundation, Inc., 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
* Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
*/
#ifndef CTL_H
#define CTL_H
#undef HAVE_NO_GH
#ifdef HAVE_NO_GH
# include
#else
# include
#endif
#ifdef __cplusplus
extern "C" {
#endif /* __cplusplus */
/**************************************************************************/
/* Configuration options (guessed by configure).
We have to put them here, rather than in a private config.h file,
because they need to be known by user ctl-io.c and main.c files. */
/* set to version string */
#undef LIBCTL_VERSION
#undef LIBCTL_MAJOR_VERSION
#undef LIBCTL_MINOR_VERSION
#undef LIBCTL_BUGFIX_VERSION
/* Define if you have the following functions */
#undef HAVE_GH_ENTER
#undef HAVE_GH_EVAL_STR
#undef HAVE_GH_LOAD
#undef HAVE_GH_BOOL2SCM
#undef HAVE_GH_VECTOR_REF
#undef HAVE_GH_LIST_REF
#undef HAVE_GH_LENGTH
#undef HAVE_SCM_FLUSH_ALL_PORTS
#undef HAVE_SCM_MAKE_COMPLEX
#undef HAVE_SCM_C_MAKE_RECTANGULAR
#undef HAVE_SCM_VARIABLE_SET_X
#undef HAVE_SCM_C_LOOKUP
#undef HAVE_SCM_C_MAKE_VECTOR
#undef HAVE_SCM_VARIABLE_REF
/* Define if you have the HAVE_SCM_COMPLEXP macro. */
#undef HAVE_SCM_COMPLEXP
/* Define if gh_lookup is not broken */
#undef GH_LOOKUP_OK
/* Define if we have C99 complex numbers and hence complex integration */
#undef CTL_HAS_COMPLEX_INTEGRATION
/**************************************************************************/
/* Basic types: */
typedef int integer;
typedef double number;
typedef struct { number re, im; } cnumber; /* complex numbers! */
typedef short boolean;
typedef char *string;
typedef SCM list;
typedef SCM function;
typedef SCM object;
/* define vector3 as a structure, not an array, so that it can
be a function return value and so that simple assignment works. */
typedef struct { number x,y,z; } vector3;
/* similarly for matrix3x3 */
typedef struct { vector3 c0, c1, c2; /* the columns */ } matrix3x3;
/* define complex equivalents: */
typedef struct { cnumber x,y,z; } cvector3;
typedef struct { cvector3 c0, c1, c2; /* the columns */ } cmatrix3x3;
/**************************************************************************/
#ifdef HAVE_NO_GH /* use replacements for gh functions */
# define gh_call0 scm_call_0
# define gh_call1 scm_call_1
# define gh_call2 scm_call_2
# define gh_call3 scm_call_3
# define gh_apply scm_apply_0
# define gh_eval_str scm_c_eval_string
# define gh_symbol2scm scm_from_locale_symbol
# define ctl_symbol2newstr(x) scm_to_locale_string(scm_symbol_to_string(x))
# define gh_cons scm_cons
# define gh_car scm_car
# define gh_cdr scm_cdr
# if SCM_MAJOR_VERSION >= 2 /* get types right for C++, since fc
argument is void* (grrr) in Guile 2.x */
# define gh_new_procedure(name, fcn, req, opt, rst) scm_c_define_gsubr(name, req, opt, rst, (scm_t_subr) (fcn))
# else
# define gh_new_procedure(name, fcn, req, opt, rst) scm_c_define_gsubr(name, req, opt, rst, fcn)
# endif
# define gh_repl scm_shell
#else
# define ctl_symbol2newstr(x) gh_symbol2newstr(x, 0)
#endif
#if !defined(GH_LOOKUP_OK) || defined(HAVE_NO_GH)
# if defined(HAVE_SCM_VARIABLE_REF) && defined(HAVE_SCM_C_LOOKUP)
# define gh_lookup(name) scm_variable_ref(scm_c_lookup(name))
# else
# define gh_lookup scm_symbol_value0
# endif
#endif
#if !defined(HAVE_GH_LOAD) || defined(HAVE_NO_GH)
# ifdef HAVE_NO_GH
# define gh_load scm_c_primitive_load
# else
# define gh_load gh_eval_file
# endif
#endif
extern void ctl_include(char *filename);
extern char *ctl_fix_path(const char *path);
/**************************************************************************/
#ifndef HAVE_SCM_C_MAKE_VECTOR
# define scm_c_make_vector(n,fill) scm_make_vector(SCM_MAKINUM(n), fill)
#endif
/* vector3 and matrix3x3 utilities: */
extern number vector3_dot(vector3 v1,vector3 v2);
extern number vector3_norm(vector3 v);
extern vector3 vector3_scale(number s, vector3 v);
extern vector3 unit_vector3(vector3 v);
extern vector3 vector3_cross(vector3 v1,vector3 v2);
extern vector3 vector3_plus(vector3 v1,vector3 v2);
extern vector3 vector3_minus(vector3 v1,vector3 v2);
extern int vector3_equal(vector3 v1, vector3 v2);
extern vector3 matrix3x3_vector3_mult(matrix3x3 m, vector3 v);
extern vector3 matrix3x3_transpose_vector3_mult(matrix3x3 m, vector3 v);
extern matrix3x3 matrix3x3_mult(matrix3x3 m1, matrix3x3 m2);
extern matrix3x3 matrix3x3_transpose(matrix3x3 m);
extern number matrix3x3_determinant(matrix3x3 m);
extern matrix3x3 matrix3x3_inverse(matrix3x3 m);
extern int matrix3x3_equal(matrix3x3 m1, matrix3x3 m2);
extern vector3 matrix3x3_row1(matrix3x3 m);
extern vector3 matrix3x3_row2(matrix3x3 m);
extern vector3 matrix3x3_row3(matrix3x3 m);
/**************************************************************************/
/* complex number utilities */
extern cnumber make_cnumber(number r, number i);
extern cnumber cnumber_conj(cnumber c);
extern int cnumber_equal(cnumber c1, cnumber c2);
#define cnumber_re(c) ((c).re)
#define cnumber_im(c) ((c).im)
extern vector3 cvector3_re(cvector3 cv);
extern vector3 cvector3_im(cvector3 cv);
extern cvector3 make_cvector3(vector3 vr, vector3 vi);
extern int cvector3_equal(cvector3 v1, cvector3 v2);
extern matrix3x3 cmatrix3x3_re(cmatrix3x3 cm);
extern matrix3x3 cmatrix3x3_im(cmatrix3x3 cm);
extern cmatrix3x3 make_cmatrix3x3(matrix3x3 mr, matrix3x3 mi);
cmatrix3x3 make_hermitian_cmatrix3x3(number m00, number m11, number m22,
cnumber m01, cnumber m02, cnumber m12);
extern int cmatrix3x3_equal(cmatrix3x3 m1, cmatrix3x3 m2);
/**************************************************************************/
/* type conversion */
#if !defined(HAVE_GH_BOOL2SCM) && !defined(HAVE_NO_GH)
/* Guile 1.2 is missing gh_bool2scm for some reason; redefine: */
extern SCM ctl_gh_bool2scm(boolean);
# define gh_bool2scm ctl_gh_bool2scm
#endif
extern vector3 scm2vector3(SCM sv);
extern SCM vector32scm(vector3 v);
extern matrix3x3 scm2matrix3x3(SCM sm);
extern SCM matrix3x32scm(matrix3x3 m);
extern cnumber scm2cnumber(SCM sx);
extern SCM cnumber2scm(cnumber x);
extern cvector3 scm2cvector3(SCM sv);
extern SCM cvector32scm(cvector3 v);
extern cmatrix3x3 scm2cmatrix3x3(SCM sm);
extern SCM cmatrix3x32scm(cmatrix3x3 m);
#ifdef HAVE_NO_GH
# define ctl_convert_number_to_scm(x) scm_from_double(x)
# define ctl_convert_number_to_c(x) scm_to_double(x)
# define ctl_convert_integer_to_scm(x) scm_from_int(x)
# define ctl_convert_integer_to_c(x) scm_to_int(x)
# define ctl_convert_string_to_scm(x) scm_from_locale_string(x)
# define ctl_convert_string_to_c(x) scm_to_locale_string(x)
# define ctl_convert_boolean_to_scm(x) scm_from_bool(x)
# define ctl_convert_boolean_to_c(x) scm_to_bool(x)
#else
# define ctl_convert_number_to_scm(x) gh_double2scm(x)
# define ctl_convert_number_to_c(x) gh_scm2double(x)
# define ctl_convert_integer_to_scm(x) gh_int2scm(x)
# define ctl_convert_integer_to_c(x) gh_scm2int(x)
# define ctl_convert_string_to_scm(x) gh_str02scm(x)
# define ctl_convert_string_to_c(x) gh_scm2newstr(x, 0)
# define ctl_convert_boolean_to_scm(x) gh_bool2scm(x)
# define ctl_convert_boolean_to_c(x) gh_scm2bool(x)
#endif
#define ctl_convert_cnumber_to_scm(x) cnumber2scm(x)
#define ctl_convert_vector3_to_scm(x) vector32scm(x)
#define ctl_convert_matrix3x3_to_scm(x) matrix3x32scm(x)
#define ctl_convert_cvector3_to_scm(x) cvector32scm(x)
#define ctl_convert_cmatrix3x3_to_scm(x) cmatrix3x32scm(x)
#define ctl_convert_SCM_to_scm(x) (x)
#define ctl_convert_function_to_scm(x) (x)
#define ctl_convert_object_to_scm(x) (x)
#define ctl_convert_list_to_scm(x) (x)
#define ctl_convert_cnumber_to_c(x) scm2cnumber(x)
#define ctl_convert_vector3_to_c(x) scm2vector3(x)
#define ctl_convert_matrix3x3_to_c(x) scm2matrix3x3(x)
#define ctl_convert_cvector3_to_c(x) scm2cvector3(x)
#define ctl_convert_cmatrix3x3_to_c(x) scm2cmatrix3x3(x)
#define ctl_convert_SCM_to_c(x) (x)
#define ctl_convert_function_to_c(x) (x)
#define ctl_convert_object_to_c(x) (x)
#define ctl_convert_list_to_c(x) (x)
/**************************************************************************/
/* variable get/set functions */
extern integer ctl_get_integer(char *identifier);
extern number ctl_get_number(char *identifier);
extern cnumber ctl_get_cnumber(char *identifier);
extern boolean ctl_get_boolean(char *identifier);
extern char* ctl_get_string(char *identifier);
extern vector3 ctl_get_vector3(char *identifier);
extern matrix3x3 ctl_get_matrix3x3(char *identifier);
extern cvector3 ctl_get_cvector3(char *identifier);
extern cmatrix3x3 ctl_get_cmatrix3x3(char *identifier);
extern list ctl_get_list(char *identifier);
extern object ctl_get_object(char *identifier);
extern function ctl_get_function(char *identifier);
extern SCM ctl_get_SCM(char *identifier);
extern void ctl_set_integer(char *identifier, integer value);
extern void ctl_set_number(char *identifier, number value);
extern void ctl_set_cnumber(char *identifier, cnumber value);
extern void ctl_set_boolean(char *identifier, boolean value);
extern void ctl_set_string(char *identifier, char *value);
extern void ctl_set_vector3(char *identifier, vector3 value);
extern void ctl_set_matrix3x3(char *identifier, matrix3x3 value);
extern void ctl_set_cvector3(char *identifier, cvector3 value);
extern void ctl_set_cmatrix3x3(char *identifier, cmatrix3x3 value);
extern void ctl_set_list(char *identifier, list value);
extern void ctl_set_object(char *identifier, object value);
extern void ctl_set_function(char *identifier, function value);
extern void ctl_set_SCM(char *identifier, SCM value);
/**************************************************************************/
/* list traversal */
extern int list_length(list l);
extern integer integer_list_ref(list l, int index);
extern number number_list_ref(list l, int index);
extern cnumber cnumber_list_ref(list l, int index);
extern boolean boolean_list_ref(list l, int index);
extern char* string_list_ref(list l, int index);
extern vector3 vector3_list_ref(list l, int index);
extern matrix3x3 matrix3x3_list_ref(list l, int index);
extern cvector3 cvector3_list_ref(list l, int index);
extern cmatrix3x3 cmatrix3x3_list_ref(list l, int index);
extern list list_list_ref(list l, int index);
extern object object_list_ref(list l, int index);
extern function function_list_ref(list l, int index);
extern SCM SCM_list_ref(list l, int index);
/**************************************************************************/
/* list creation */
extern list make_integer_list(int num_items, const integer *items);
extern list make_number_list(int num_items, const number *items);
extern list make_cnumber_list(int num_items, const cnumber *items);
extern list make_boolean_list(int num_items, const boolean *items);
extern list make_string_list(int num_items, const char **items);
extern list make_vector3_list(int num_items, const vector3 *items);
extern list make_matrix3x3_list(int num_items, const matrix3x3 *items);
extern list make_cvector3_list(int num_items, const cvector3 *items);
extern list make_cmatrix3x3_list(int num_items, const cmatrix3x3 *items);
extern list make_list_list(int num_items, const list *items);
extern list make_object_list(int num_items, const object *items);
extern list make_function_list(int num_items, const function *items);
extern list make_SCM_list(int num_items, const function *items);
/**************************************************************************/
/* object properties */
boolean object_is_member(char *type_name, object o);
extern integer integer_object_property(object o, char *property_name);
extern number number_object_property(object o, char *property_name);
extern cnumber cnumber_object_property(object o, char *property_name);
extern boolean boolean_object_property(object o, char *property_name);
extern char* string_object_property(object o, char *property_name);
extern vector3 vector3_object_property(object o, char *property_name);
extern matrix3x3 matrix3x3_object_property(object o, char *property_name);
extern cvector3 cvector3_object_property(object o, char *property_name);
extern cmatrix3x3 cmatrix3x3_object_property(object o, char *property_name);
extern list list_object_property(object o, char *property_name);
extern object object_object_property(object o, char *property_name);
extern function function_object_property(object o, char *property_name);
extern SCM SCM_object_property(object o, char *property_name);
/**************************************************************************/
/* main() hook functions. These are prototypes of functions
defined by the USER and called just before the program starts
and just before it ends, respectively. If you want to define
them, you should also define HAVE_CTL_HOOKS when compiling main.c.
Note that due to the behavior of the Guile interactive mode,
ctl_stop_hook will only get called in non-interactive mode. Sigh. */
extern void ctl_start_hook(int *argc, char ***argv);
extern void ctl_stop_hook(void);
/**************************************************************************/
/* subplex multi-dimensional minimization routines: */
typedef number (*multivar_func) (integer, number *, void *);
extern number subplex(multivar_func f, number *x, integer n, void *fdata,
number tol, integer maxnfe,
number fmin, boolean use_fmin,
number *scale,
integer *nfe, integer *errflag);
extern SCM subplex_scm(SCM f_scm, SCM x_scm,
SCM tol_scm, SCM maxnfe_scm,
SCM fmin_scm, SCM use_fmin_scm,
SCM scale_scm);
/* multi-dimensional integration routines */
extern number adaptive_integration(multivar_func f, number *xmin, number *xmax,
integer n, void *fdata,
number abstol, number reltol,
integer maxnfe,
number *esterr, integer *errflag);
extern SCM adaptive_integration_scm(SCM f_scm, SCM xmin_scm, SCM xmax_scm,
SCM abstol_scm, SCM reltol_scm, SCM maxnfe_scm);
#ifdef CTL_HAS_COMPLEX_INTEGRATION
typedef cnumber (*cmultivar_func) (integer, number *, void *);
extern cnumber cadaptive_integration(cmultivar_func f, number *xmin, number *xmax,
integer n, void *fdata,
number abstol, number reltol,
integer maxnfe,
number *esterr, integer *errflag);
extern SCM cadaptive_integration_scm(SCM f_scm, SCM xmin_scm, SCM xmax_scm,
SCM abstol_scm, SCM reltol_scm, SCM maxnfe_scm);
#endif /* CTL_HAS_COMPLEX_INTEGRATION */
/**************************************************************************/
#ifdef __cplusplus
} /* extern "C" */
#endif /* __cplusplus */
#endif /* CTL_H */
libctl-3.2.2/src/ctl.c 0000644 0001754 0000144 00000054625 12315330377 011445 0000000 0000000 /* libctl: flexible Guile-based control files for scientific software
* Copyright (C) 1998-2014 Massachusetts Institute of Technology and Steven G. Johnson
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the
* Free Software Foundation, Inc., 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
* Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
*/
#include
#include
#include
#include
#include "ctl.h"
/**************************************************************************/
/* Functions missing from Guile 1.2: */
#if !defined(HAVE_GH_BOOL2SCM) && !defined(HAVE_NO_GH)
/* Guile 1.2 is missing gh_bool2scm for some reason; redefine: */
SCM ctl_gh_bool2scm(boolean b) { return (b ? SCM_BOOL_T : SCM_BOOL_F); }
#endif
#if defined(HAVE_NO_GH)
# define gh_length(x) scm_to_long(scm_length(x))
#elif !defined(HAVE_GH_LENGTH)
# define gh_length gh_list_length
#endif
#if defined(HAVE_NO_GH)
# define list_ref(l,index) scm_list_ref(l,scm_from_int(index))
#elif !defined(HAVE_GH_LIST_REF)
/* Guile 1.2 doesn't have the gh_list_ref function. Sigh. */
/* Note: index must be in [0,list_length(l) - 1]. We don't check! */
static SCM list_ref(list l, int index)
{
SCM cur = SCM_UNSPECIFIED, rest = l;
while (index >= 0) {
cur = gh_car(rest);
rest = gh_cdr(rest);
--index;
}
return cur;
}
#else /* HAVE_GH_LIST_REF */
#define list_ref(l,index) gh_list_ref(l,gh_int2scm(index))
#endif
#if defined(HAVE_NO_GH)
# define vector_ref(v,i) scm_c_vector_ref(v,i)
#elif !defined(HAVE_GH_VECTOR_REF)
# define vector_ref(v,i) gh_vref(v,gh_int2scm(i))
#else
# define vector_ref(v,i) gh_vector_ref(v,gh_int2scm(i))
#endif
/**************************************************************************/
/* Scheme file loading (don't use gh_load directly because subsequent
loads won't use the correct path name). Uses our "include" function
from include.scm, or defaults to gh_load if this function isn't
defined. */
void ctl_include(char *filename)
{
SCM include_proc = gh_lookup("include");
if (include_proc == SCM_UNDEFINED)
gh_load(filename);
else
#ifdef HAVE_NO_GH
scm_call_1(include_proc, ctl_convert_string_to_scm(filename));
#else
gh_call1(include_proc, gh_str02scm(filename));
#endif
}
/* convert a pathname into one relative to the current include dir */
char *ctl_fix_path(const char *path)
{
char *newpath;
if (path[0] != '/') {
SCM include_dir = gh_lookup("include-dir");
if (include_dir != SCM_UNDEFINED) {
char *dir = ctl_convert_string_to_c(include_dir);
newpath = (char *) malloc(sizeof(char) * (strlen(dir) +
strlen(path) + 2));
strcpy(newpath, dir);
free(dir);
if (newpath[0] && newpath[strlen(newpath)-1] != '/')
strcat(newpath, "/");
strcat(newpath, path);
return newpath;
}
}
newpath = (char *) malloc(sizeof(char) * (strlen(path) + 1));
strcpy(newpath, path);
return newpath;
}
/**************************************************************************/
/* vector3 and matrix3x3 utilities: */
number vector3_dot(vector3 v1,vector3 v2)
{
return (v1.x * v2.x + v1.y * v2.y + v1.z * v2.z);
}
number vector3_norm(vector3 v)
{
return (sqrt(vector3_dot(v,v)));
}
vector3 vector3_scale(number s, vector3 v)
{
vector3 vnew;
vnew.x = s * v.x;
vnew.y = s * v.y;
vnew.z = s * v.z;
return vnew;
}
vector3 unit_vector3(vector3 v)
{
number norm = vector3_norm(v);
if (norm == 0.0)
return v;
else
return vector3_scale(1.0/norm, v);
}
vector3 vector3_plus(vector3 v1,vector3 v2)
{
vector3 vnew;
vnew.x = v1.x + v2.x;
vnew.y = v1.y + v2.y;
vnew.z = v1.z + v2.z;
return vnew;
}
vector3 vector3_minus(vector3 v1,vector3 v2)
{
vector3 vnew;
vnew.x = v1.x - v2.x;
vnew.y = v1.y - v2.y;
vnew.z = v1.z - v2.z;
return vnew;
}
vector3 vector3_cross(vector3 v1,vector3 v2)
{
vector3 vnew;
vnew.x = v1.y * v2.z - v2.y * v1.z;
vnew.y = v1.z * v2.x - v2.z * v1.x;
vnew.z = v1.x * v2.y - v2.x * v1.y;
return vnew;
}
int vector3_equal(vector3 v1, vector3 v2)
{
return (v1.x == v2.x && v1.y == v2.y && v1.z == v2.z);
}
vector3 matrix3x3_vector3_mult(matrix3x3 m, vector3 v)
{
vector3 vnew;
vnew.x = m.c0.x * v.x + m.c1.x * v.y + m.c2.x * v.z;
vnew.y = m.c0.y * v.x + m.c1.y * v.y + m.c2.y * v.z;
vnew.z = m.c0.z * v.x + m.c1.z * v.y + m.c2.z * v.z;
return vnew;
}
vector3 matrix3x3_transpose_vector3_mult(matrix3x3 m, vector3 v)
{
vector3 vnew;
vnew.x = m.c0.x * v.x + m.c0.y * v.y + m.c0.z * v.z;
vnew.y = m.c1.x * v.x + m.c1.y * v.y + m.c1.z * v.z;
vnew.z = m.c2.x * v.x + m.c2.y * v.y + m.c2.z * v.z;
return vnew;
}
matrix3x3 matrix3x3_mult(matrix3x3 m1, matrix3x3 m2)
{
matrix3x3 m;
m.c0.x = m1.c0.x * m2.c0.x + m1.c1.x * m2.c0.y + m1.c2.x * m2.c0.z;
m.c0.y = m1.c0.y * m2.c0.x + m1.c1.y * m2.c0.y + m1.c2.y * m2.c0.z;
m.c0.z = m1.c0.z * m2.c0.x + m1.c1.z * m2.c0.y + m1.c2.z * m2.c0.z;
m.c1.x = m1.c0.x * m2.c1.x + m1.c1.x * m2.c1.y + m1.c2.x * m2.c1.z;
m.c1.y = m1.c0.y * m2.c1.x + m1.c1.y * m2.c1.y + m1.c2.y * m2.c1.z;
m.c1.z = m1.c0.z * m2.c1.x + m1.c1.z * m2.c1.y + m1.c2.z * m2.c1.z;
m.c2.x = m1.c0.x * m2.c2.x + m1.c1.x * m2.c2.y + m1.c2.x * m2.c2.z;
m.c2.y = m1.c0.y * m2.c2.x + m1.c1.y * m2.c2.y + m1.c2.y * m2.c2.z;
m.c2.z = m1.c0.z * m2.c2.x + m1.c1.z * m2.c2.y + m1.c2.z * m2.c2.z;
return m;
}
matrix3x3 matrix3x3_transpose(matrix3x3 m)
{
matrix3x3 mt;
mt.c0.x = m.c0.x;
mt.c1.x = m.c0.y;
mt.c2.x = m.c0.z;
mt.c0.y = m.c1.x;
mt.c1.y = m.c1.y;
mt.c2.y = m.c1.z;
mt.c0.z = m.c2.x;
mt.c1.z = m.c2.y;
mt.c2.z = m.c2.z;
return mt;
}
number matrix3x3_determinant(matrix3x3 m)
{
return(m.c0.x*m.c1.y*m.c2.z - m.c2.x*m.c1.y*m.c0.z +
m.c1.x*m.c2.y*m.c0.z + m.c0.y*m.c1.z*m.c2.x -
m.c1.x*m.c0.y*m.c2.z - m.c2.y*m.c1.z*m.c0.x);
}
matrix3x3 matrix3x3_inverse(matrix3x3 m)
{
matrix3x3 minv;
number detinv = matrix3x3_determinant(m);
if (detinv == 0.0) {
fprintf(stderr, "error: singular matrix in matrix3x3_inverse!\n");
exit(EXIT_FAILURE);
}
detinv = 1.0/detinv;
minv.c0.x = detinv * (m.c1.y * m.c2.z - m.c2.y * m.c1.z);
minv.c1.y = detinv * (m.c0.x * m.c2.z - m.c2.x * m.c0.z);
minv.c2.z = detinv * (m.c1.y * m.c0.x - m.c0.y * m.c1.x);
minv.c0.z = detinv * (m.c0.y * m.c1.z - m.c1.y * m.c0.z);
minv.c0.y = -detinv * (m.c0.y * m.c2.z - m.c2.y * m.c0.z);
minv.c1.z = -detinv * (m.c0.x * m.c1.z - m.c1.x * m.c0.z);
minv.c2.x = detinv * (m.c1.x * m.c2.y - m.c1.y * m.c2.x);
minv.c1.x = -detinv * (m.c1.x * m.c2.z - m.c1.z * m.c2.x);
minv.c2.y = -detinv * (m.c0.x * m.c2.y - m.c0.y * m.c2.x);
return minv;
}
int matrix3x3_equal(matrix3x3 m1, matrix3x3 m2)
{
return (vector3_equal(m1.c0, m2.c0)
&& vector3_equal(m1.c1, m2.c1)
&& vector3_equal(m1.c2, m2.c2));
}
vector3 matrix3x3_row1(matrix3x3 m)
{
vector3 v;
v.x = m.c0.x;
v.y = m.c1.x;
v.z = m.c2.x;
return v;
}
vector3 matrix3x3_row2(matrix3x3 m)
{
vector3 v;
v.x = m.c0.y;
v.y = m.c1.y;
v.z = m.c2.y;
return v;
}
vector3 matrix3x3_row3(matrix3x3 m)
{
vector3 v;
v.x = m.c0.z;
v.y = m.c1.z;
v.z = m.c2.z;
return v;
}
/**************************************************************************/
/* complex number utilities */
cnumber make_cnumber(number r, number i)
{
cnumber c;
c.re = r; c.im = i;
return c;
}
cnumber cnumber_conj(cnumber c)
{
return make_cnumber(c.re, -c.im);
}
int cnumber_equal(cnumber c1, cnumber c2)
{
return (c1.re == c2.re && c1.im == c2.im);
}
vector3 cvector3_re(cvector3 cv)
{
vector3 v;
v.x = cv.x.re; v.y = cv.y.re; v.z = cv.z.re;
return v;
}
vector3 cvector3_im(cvector3 cv)
{
vector3 v;
v.x = cv.x.im; v.y = cv.y.im; v.z = cv.z.im;
return v;
}
cvector3 make_cvector3(vector3 vr, vector3 vi)
{
cvector3 cv;
cv.x = make_cnumber(vr.x, vi.x);
cv.y = make_cnumber(vr.y, vi.y);
cv.z = make_cnumber(vr.z, vi.z);
return cv;
}
int cvector3_equal(cvector3 v1, cvector3 v2)
{
return (vector3_equal(cvector3_re(v1), cvector3_re(v2)) &&
vector3_equal(cvector3_im(v1), cvector3_im(v2)));
}
matrix3x3 cmatrix3x3_re(cmatrix3x3 cm)
{
matrix3x3 m;
m.c0 = cvector3_re(cm.c0);
m.c1 = cvector3_re(cm.c1);
m.c2 = cvector3_re(cm.c2);
return m;
}
matrix3x3 cmatrix3x3_im(cmatrix3x3 cm)
{
matrix3x3 m;
m.c0 = cvector3_im(cm.c0);
m.c1 = cvector3_im(cm.c1);
m.c2 = cvector3_im(cm.c2);
return m;
}
cmatrix3x3 make_cmatrix3x3(matrix3x3 mr, matrix3x3 mi)
{
cmatrix3x3 cm;
cm.c0 = make_cvector3(mr.c0, mi.c0);
cm.c1 = make_cvector3(mr.c1, mi.c1);
cm.c2 = make_cvector3(mr.c2, mi.c2);
return cm;
}
cmatrix3x3 make_hermitian_cmatrix3x3(number m00, number m11, number m22,
cnumber m01, cnumber m02, cnumber m12)
{
cmatrix3x3 cm;
cm.c0.x = make_cnumber(m00, 0);
cm.c1.y = make_cnumber(m11, 0);
cm.c2.z = make_cnumber(m22, 0);
cm.c1.x = m01; cm.c0.y = cnumber_conj(m01);
cm.c2.x = m02; cm.c0.z = cnumber_conj(m02);
cm.c2.y = m12; cm.c1.z = cnumber_conj(m12);
return cm;
}
int cmatrix3x3_equal(cmatrix3x3 m1, cmatrix3x3 m2)
{
return (matrix3x3_equal(cmatrix3x3_re(m1), cmatrix3x3_re(m2)) &&
matrix3x3_equal(cmatrix3x3_im(m1), cmatrix3x3_im(m2)));
}
/**************************************************************************/
/* type conversion */
vector3 scm2vector3(SCM sv)
{
vector3 v;
v.x = ctl_convert_number_to_c(vector_ref(sv,0));
v.y = ctl_convert_number_to_c(vector_ref(sv,1));
v.z = ctl_convert_number_to_c(vector_ref(sv,2));
return v;
}
matrix3x3 scm2matrix3x3(SCM sm)
{
matrix3x3 m;
m.c0 = scm2vector3(vector_ref(sm,0));
m.c1 = scm2vector3(vector_ref(sm,1));
m.c2 = scm2vector3(vector_ref(sm,2));
return m;
}
static SCM make_vector3(SCM x, SCM y, SCM z)
{
SCM vscm;
vscm = scm_c_make_vector(3, SCM_UNSPECIFIED);
#ifdef SCM_SIMPLE_VECTOR_SET
SCM_SIMPLE_VECTOR_SET(vscm, 0, x);
SCM_SIMPLE_VECTOR_SET(vscm, 1, y);
SCM_SIMPLE_VECTOR_SET(vscm, 2, z);
#else
{
SCM *data;
data = SCM_VELTS(vscm);
data[0] = x;
data[1] = y;
data[2] = z;
}
#endif
return vscm;
}
SCM vector32scm(vector3 v)
{
return make_vector3(ctl_convert_number_to_scm(v.x),
ctl_convert_number_to_scm(v.y),
ctl_convert_number_to_scm(v.z));
}
SCM matrix3x32scm(matrix3x3 m)
{
return make_vector3(vector32scm(m.c0),
vector32scm(m.c1),
vector32scm(m.c2));
}
cnumber scm2cnumber(SCM sx)
{
#ifdef HAVE_SCM_COMPLEXP
if (scm_real_p(sx) && !(SCM_COMPLEXP(sx)))
return make_cnumber(ctl_convert_number_to_c(sx), 0.0);
else
return make_cnumber(SCM_COMPLEX_REAL(sx), SCM_COMPLEX_IMAG(sx));
#else
if (scm_real_p(sx) && !(SCM_NIMP(sx) && SCM_INEXP(sx) && SCM_CPLXP(sx)))
return make_cnumber(ctl_convert_number_to_c(sx), 0.0);
else
return make_cnumber(SCM_REALPART(sx), SCM_IMAG(sx));
#endif
}
SCM cnumber2scm(cnumber x)
{
#if defined(HAVE_SCM_C_MAKE_RECTANGULAR) /* Guile 1.6.5 */
return scm_c_make_rectangular(x.re, x.im); /* Guile 1.5 */
#elif defined(HAVE_SCM_MAKE_COMPLEX)
return scm_make_complex(x.re, x.im); /* Guile 1.5 */
#else
if (x.im == 0.0)
return ctl_convert_number_to_scm(x.re);
else
return scm_makdbl(x.re, x.im);
#endif
}
cvector3 scm2cvector3(SCM sv)
{
cvector3 v;
v.x = scm2cnumber(vector_ref(sv,0));
v.y = scm2cnumber(vector_ref(sv,1));
v.z = scm2cnumber(vector_ref(sv,2));
return v;
}
cmatrix3x3 scm2cmatrix3x3(SCM sm)
{
cmatrix3x3 m;
m.c0 = scm2cvector3(vector_ref(sm,0));
m.c1 = scm2cvector3(vector_ref(sm,1));
m.c2 = scm2cvector3(vector_ref(sm,2));
return m;
}
SCM cvector32scm(cvector3 v)
{
return make_vector3(cnumber2scm(v.x),
cnumber2scm(v.y),
cnumber2scm(v.z));
}
SCM cmatrix3x32scm(cmatrix3x3 m)
{
return make_vector3(cvector32scm(m.c0),
cvector32scm(m.c1),
cvector32scm(m.c2));
}
/**************************************************************************/
/* variable get/set functions */
/**** Getters ****/
integer ctl_get_integer(char *identifier)
{
return(ctl_convert_integer_to_c(gh_lookup(identifier)));
}
number ctl_get_number(char *identifier)
{
return(ctl_convert_number_to_c(gh_lookup(identifier)));
}
cnumber ctl_get_cnumber(char *identifier)
{
return(scm2cnumber(gh_lookup(identifier)));
}
boolean ctl_get_boolean(char *identifier)
{
return(ctl_convert_boolean_to_c(gh_lookup(identifier)));
}
char* ctl_get_string(char *identifier)
{
return(ctl_convert_string_to_c(gh_lookup(identifier)));
}
vector3 ctl_get_vector3(char *identifier)
{
return(scm2vector3(gh_lookup(identifier)));
}
matrix3x3 ctl_get_matrix3x3(char *identifier)
{
return(scm2matrix3x3(gh_lookup(identifier)));
}
cvector3 ctl_get_cvector3(char *identifier)
{
return(scm2cvector3(gh_lookup(identifier)));
}
cmatrix3x3 ctl_get_cmatrix3x3(char *identifier)
{
return(scm2cmatrix3x3(gh_lookup(identifier)));
}
list ctl_get_list(char *identifier)
{
return(gh_lookup(identifier));
}
object ctl_get_object(char *identifier)
{
return(gh_lookup(identifier));
}
function ctl_get_function(char *identifier)
{
return(gh_lookup(identifier));
}
SCM ctl_get_SCM(char *identifier)
{
return(gh_lookup(identifier));
}
/**** Setters ****/
/* UGLY hack alert! There doesn't seem to be any clean way of setting
Scheme variables from C in Guile (e.g. no gh_* interface).
One option is to use scm_symbol_set_x (symbol-set! in Scheme), but
I'm not sure how to get this to work in Guile 1.3 because of the
%&*@^-ing module system (I need to pass some module for the first
parameter, but I don't know what to pass).
Instead, I hacked together the following my_symbol_set_x routine,
using the functions scm_symbol_value0 and scm_symbol_set_x from the
Guile 1.3 sources. (scm_symbol_value0 has the virtue of looking in
the correct module somehow; I also used this function to replace
gh_lookup, which broke in Guile 1.3 as well...sigh.)
Note that I can't call "set!" because it is really a macro.
All the ugliness is confined to the set_value() routine, though.
Update: in Guile 1.5, we can call scm_variable_set_x (equivalent
to variable-set!) to set values of variables, which are looked up
via scm_c_lookup (which doesn't exist in Guile 1.3.x). */
#if !(defined(HAVE_SCM_VARIABLE_SET_X) && defined(HAVE_SCM_C_LOOKUP))
# define USE_MY_SYMBOL_SET_X 1 /* use the hack */
#endif
#ifdef USE_MY_SYMBOL_SET_X
static SCM my_symbol_set_x(char *name, SCM v)
{
/* code swiped from scm_symbol_value0 and scm_symbol_set_x */
SCM symbol = scm_intern_obarray_soft(name, strlen (name), scm_symhash, 0);
SCM vcell = scm_sym2vcell (SCM_CAR (symbol),
SCM_CDR (scm_top_level_lookup_closure_var),
SCM_BOOL_F);
if (SCM_FALSEP (vcell))
return SCM_UNDEFINED;
SCM_SETCDR (vcell, v);
return SCM_UNSPECIFIED;
}
#endif
static void set_value(char *identifier, SCM value)
{
#if defined(USE_SCM_SYMBOL_SET_X) /* worked in Guile 1.1, 1.2 */
scm_symbol_set_x(SCM_BOOL_F, gh_symbol2scm(identifier), value);
#elif defined(HAVE_SCM_VARIABLE_SET_X) && defined(HAVE_SCM_C_LOOKUP)
scm_variable_set_x(scm_c_lookup(identifier), value);
#elif defined(USE_MY_SYMBOL_SET_X)
my_symbol_set_x(identifier, value);
#endif
}
void ctl_set_integer(char *identifier, integer value)
{
set_value(identifier, ctl_convert_integer_to_scm(value));
}
void ctl_set_number(char *identifier, number value)
{
set_value(identifier, ctl_convert_number_to_scm(value));
}
void ctl_set_cnumber(char *identifier, cnumber value)
{
set_value(identifier, cnumber2scm(value));
}
void ctl_set_boolean(char *identifier, boolean value)
{
set_value(identifier, ctl_convert_boolean_to_scm(value));
}
void ctl_set_string(char *identifier, char *value)
{
set_value(identifier, ctl_convert_string_to_scm(value));
}
void ctl_set_vector3(char *identifier, vector3 value)
{
set_value(identifier, vector32scm(value));
}
void ctl_set_matrix3x3(char *identifier, matrix3x3 value)
{
set_value(identifier, matrix3x32scm(value));
}
void ctl_set_cvector3(char *identifier, cvector3 value)
{
set_value(identifier, cvector32scm(value));
}
void ctl_set_cmatrix3x3(char *identifier, cmatrix3x3 value)
{
set_value(identifier, cmatrix3x32scm(value));
}
void ctl_set_list(char *identifier, list value)
{
set_value(identifier, value);
}
void ctl_set_object(char *identifier, object value)
{
set_value(identifier, value);
}
void ctl_set_function(char *identifier, function value)
{
set_value(identifier, value);
}
void ctl_set_SCM(char *identifier, SCM value)
{
set_value(identifier, value);
}
/**************************************************************************/
/* list traversal */
int list_length(list l)
{
return(gh_length(l));
}
integer integer_list_ref(list l, int index)
{
return(ctl_convert_integer_to_c(list_ref(l,index)));
}
number number_list_ref(list l, int index)
{
return(ctl_convert_number_to_c(list_ref(l,index)));
}
cnumber cnumber_list_ref(list l, int index)
{
return(scm2cnumber(list_ref(l,index)));
}
boolean boolean_list_ref(list l, int index)
{
return(SCM_BOOL_F != list_ref(l,index));
}
char* string_list_ref(list l, int index)
{
return(ctl_convert_string_to_c(list_ref(l,index)));
}
vector3 vector3_list_ref(list l, int index)
{
return(scm2vector3(list_ref(l,index)));
}
matrix3x3 matrix3x3_list_ref(list l, int index)
{
return(scm2matrix3x3(list_ref(l,index)));
}
cvector3 cvector3_list_ref(list l, int index)
{
return(scm2cvector3(list_ref(l,index)));
}
cmatrix3x3 cmatrix3x3_list_ref(list l, int index)
{
return(scm2cmatrix3x3(list_ref(l,index)));
}
list list_list_ref(list l, int index)
{
return(list_ref(l,index));
}
object object_list_ref(list l, int index)
{
return(list_ref(l,index));
}
function function_list_ref(list l, int index)
{
return(list_ref(l,index));
}
SCM SCM_list_ref(list l, int index)
{
return(list_ref(l,index));
}
/**************************************************************************/
/* list creation */
#define MAKE_LIST(conv) \
{ \
int i; \
list cur_list = SCM_EOL; \
for (i = num_items - 1; i >= 0; --i) \
cur_list = gh_cons(conv (items[i]), cur_list); \
return(cur_list); \
} \
#ifdef HAVE_NO_GH
list make_integer_list(int num_items, const integer *items)
MAKE_LIST(scm_from_int)
list make_boolean_list(int num_items, const boolean *items)
MAKE_LIST(scm_from_bool)
list make_string_list(int num_items, const char **items)
MAKE_LIST(scm_from_locale_string)
list make_number_list(int num_items, const number *items)
MAKE_LIST(scm_from_double)
#else /* ! HAVE_NO_GH */
list make_integer_list(int num_items, const integer *items)
MAKE_LIST(gh_int2scm)
list make_boolean_list(int num_items, const boolean *items)
MAKE_LIST(gh_bool2scm)
list make_string_list(int num_items, const char **items)
MAKE_LIST(gh_str02scm)
list make_number_list(int num_items, const number *items)
MAKE_LIST(gh_double2scm)
#endif /* ! HAVE_NO_GH */
list make_cnumber_list(int num_items, const cnumber *items)
MAKE_LIST(cnumber2scm)
list make_vector3_list(int num_items, const vector3 *items)
MAKE_LIST(vector32scm)
list make_matrix3x3_list(int num_items, const matrix3x3 *items)
MAKE_LIST(matrix3x32scm)
list make_cvector3_list(int num_items, const cvector3 *items)
MAKE_LIST(cvector32scm)
list make_cmatrix3x3_list(int num_items, const cmatrix3x3 *items)
MAKE_LIST(cmatrix3x32scm)
#define NO_CONVERSION
list make_list_list(int num_items, const list *items)
MAKE_LIST(NO_CONVERSION)
list make_object_list(int num_items, const object *items)
MAKE_LIST(NO_CONVERSION)
list make_function_list(int num_items, const object *items)
MAKE_LIST(NO_CONVERSION)
list make_SCM_list(int num_items, const object *items)
MAKE_LIST(NO_CONVERSION)
/**************************************************************************/
/* object properties */
boolean object_is_member(char *type_name, object o)
{
return(SCM_BOOL_F != gh_call2(gh_lookup("object-member?"),
gh_symbol2scm(type_name),
o));
}
static SCM object_property_value(object o, char *property_name)
{
return(gh_call2(gh_lookup("object-property-value"),
o,
gh_symbol2scm(property_name)));
}
integer integer_object_property(object o, char *property_name)
{
return(ctl_convert_integer_to_c(object_property_value(o,property_name)));
}
number number_object_property(object o, char *property_name)
{
return(ctl_convert_number_to_c(object_property_value(o,property_name)));
}
cnumber cnumber_object_property(object o, char *property_name)
{
return(scm2cnumber(object_property_value(o,property_name)));
}
boolean boolean_object_property(object o, char *property_name)
{
return(SCM_BOOL_F != object_property_value(o,property_name));
}
char* string_object_property(object o, char *property_name)
{
return(ctl_convert_string_to_c(object_property_value(o,property_name)));
}
vector3 vector3_object_property(object o, char *property_name)
{
return(scm2vector3(object_property_value(o,property_name)));
}
matrix3x3 matrix3x3_object_property(object o, char *property_name)
{
return(scm2matrix3x3(object_property_value(o,property_name)));
}
cvector3 cvector3_object_property(object o, char *property_name)
{
return(scm2cvector3(object_property_value(o,property_name)));
}
cmatrix3x3 cmatrix3x3_object_property(object o, char *property_name)
{
return(scm2cmatrix3x3(object_property_value(o,property_name)));
}
list list_object_property(object o, char *property_name)
{
return(object_property_value(o,property_name));
}
object object_object_property(object o, char *property_name)
{
return(object_property_value(o,property_name));
}
function function_object_property(object o, char *property_name)
{
return(object_property_value(o,property_name));
}
SCM SCM_object_property(object o, char *property_name)
{
return(object_property_value(o,property_name));
}
libctl-3.2.2/src/subplex.c 0000644 0001754 0000144 00000152103 12315325343 012330 0000000 0000000 /*
Downloaded from http://www.netlib.org/opt/subplex.tgz
README file for SUBPLEX
NAME
subplex - subspace-searching simplex method for unconstrained
optimization
DESCRIPTION
Subplex is a subspace-searching simplex method for the
unconstrained optimization of general multivariate functions.
Like the Nelder-Mead simplex method it generalizes, the subplex
method is well suited for optimizing noisy objective functions.
The number of function evaluations required for convergence
typically increases only linearly with the problem size, so for
most applications the subplex method is much more efficient than
the simplex method.
INSTALLATION
To build subplex on UNIX systems, edit the Makefile as necessary
and type:
make
This will create a linkable library named subplex.a and a
demonstration executable named demo.
EXAMPLE
To run subplex on a simple objective function type:
demo < demo.in
To run subplex on other problems, edit a copy of the sample driver
demo.f as necessary.
AUTHOR
Tom Rowan
Oak Ridge National Laboratory
Mathematical Sciences Section
P.O. Box 2008, Bldg. 6012
Oak Ridge, TN 37831-6367
Phone: (423) 574-3131
Fax : (423) 574-0680
Email: na.rowan@na-net.ornl.gov
REFERENCE
T. Rowan, "Functional Stability Analysis of Numerical Algorithms",
Ph.D. thesis, Department of Computer Sciences, University of Texas
at Austin, 1990.
COMMENTS
Please send comments, suggestions, or bug reports to
na.rowan@na-net.ornl.gov.
*/
#include
#include
#include
#include "ctl.h"
typedef number doublereal;
typedef boolean logical;
#define TRUE_ 1
#define FALSE_ 0
typedef multivar_func D_fp;
#define max(a,b) ((a) > (b) ? (a) : (b))
#define min(a,b) ((a) < (b) ? (a) : (b))
#define abs(x) fabs(x)
/****************************************************************************/
/****************************************************************************/
/* dasum.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static doublereal dasum_(integer *n, doublereal *dx, integer *incx)
{
/* System generated locals */
integer i__1;
doublereal ret_val, d__1, d__2, d__3, d__4, d__5, d__6;
/* Local variables */
integer i__, m;
doublereal dtemp;
integer ix, mp1;
/* takes the sum of the absolute values. */
/* uses unrolled loops for increment equal to one. */
/* jack dongarra, linpack, 3/11/78. */
/* modified to correct problem with negative increment, 8/21/90. */
/* Parameter adjustments */
--dx;
/* Function Body */
ret_val = 0.;
dtemp = 0.;
if (*n <= 0) {
return ret_val;
}
if (*incx == 1) {
goto L20;
}
/* code for increment not equal to 1 */
ix = 1;
if (*incx < 0) {
ix = (-(*n) + 1) * *incx + 1;
}
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
dtemp += (d__1 = dx[ix], abs(d__1));
ix += *incx;
/* L10: */
}
ret_val = dtemp;
return ret_val;
/* code for increment equal to 1 */
/* clean-up loop */
L20:
m = *n % 6;
if (m == 0) {
goto L40;
}
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
dtemp += (d__1 = dx[i__], abs(d__1));
/* L30: */
}
if (*n < 6) {
goto L60;
}
L40:
mp1 = m + 1;
i__1 = *n;
for (i__ = mp1; i__ <= i__1; i__ += 6) {
dtemp = dtemp + (d__1 = dx[i__], abs(d__1)) + (d__2 = dx[i__ + 1],
abs(d__2)) + (d__3 = dx[i__ + 2], abs(d__3)) + (d__4 = dx[i__
+ 3], abs(d__4)) + (d__5 = dx[i__ + 4], abs(d__5)) + (d__6 =
dx[i__ + 5], abs(d__6));
/* L50: */
}
L60:
ret_val = dtemp;
return ret_val;
} /* dasum_ */
/* daxpy.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int daxpy_(integer *n, doublereal *da, doublereal *dx,
integer *incx, doublereal *dy, integer *incy)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer i__, m, ix, iy, mp1;
/* constant times a vector plus a vector. */
/* uses unrolled loops for increments equal to one. */
/* jack dongarra, linpack, 3/11/78. */
/* Parameter adjustments */
--dy;
--dx;
/* Function Body */
if (*n <= 0) {
return 0;
}
if (*da == 0.) {
return 0;
}
if (*incx == 1 && *incy == 1) {
goto L20;
}
/* code for unequal increments or equal increments */
/* not equal to 1 */
ix = 1;
iy = 1;
if (*incx < 0) {
ix = (-(*n) + 1) * *incx + 1;
}
if (*incy < 0) {
iy = (-(*n) + 1) * *incy + 1;
}
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
dy[iy] += *da * dx[ix];
ix += *incx;
iy += *incy;
/* L10: */
}
return 0;
/* code for both increments equal to 1 */
/* clean-up loop */
L20:
m = *n % 4;
if (m == 0) {
goto L40;
}
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
dy[i__] += *da * dx[i__];
/* L30: */
}
if (*n < 4) {
return 0;
}
L40:
mp1 = m + 1;
i__1 = *n;
for (i__ = mp1; i__ <= i__1; i__ += 4) {
dy[i__] += *da * dx[i__];
dy[i__ + 1] += *da * dx[i__ + 1];
dy[i__ + 2] += *da * dx[i__ + 2];
dy[i__ + 3] += *da * dx[i__ + 3];
/* L50: */
}
return 0;
} /* daxpy_ */
/* dcopy.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int dcopy_(integer *n, doublereal *dx, integer *incx,
doublereal *dy, integer *incy)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer i__, m, ix, iy, mp1;
/* copies a vector, x, to a vector, y. */
/* uses unrolled loops for increments equal to one. */
/* jack dongarra, linpack, 3/11/78. */
/* Parameter adjustments */
--dy;
--dx;
/* Function Body */
if (*n <= 0) {
return 0;
}
if (*incx == 1 && *incy == 1) {
goto L20;
}
/* code for unequal increments or equal increments */
/* not equal to 1 */
ix = 1;
iy = 1;
if (*incx < 0) {
ix = (-(*n) + 1) * *incx + 1;
}
if (*incy < 0) {
iy = (-(*n) + 1) * *incy + 1;
}
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
dy[iy] = dx[ix];
ix += *incx;
iy += *incy;
/* L10: */
}
return 0;
/* code for both increments equal to 1 */
/* clean-up loop */
L20:
m = *n % 7;
if (m == 0) {
goto L40;
}
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
dy[i__] = dx[i__];
/* L30: */
}
if (*n < 7) {
return 0;
}
L40:
mp1 = m + 1;
i__1 = *n;
for (i__ = mp1; i__ <= i__1; i__ += 7) {
dy[i__] = dx[i__];
dy[i__ + 1] = dx[i__ + 1];
dy[i__ + 2] = dx[i__ + 2];
dy[i__ + 3] = dx[i__ + 3];
dy[i__ + 4] = dx[i__ + 4];
dy[i__ + 5] = dx[i__ + 5];
dy[i__ + 6] = dx[i__ + 6];
/* L50: */
}
return 0;
} /* dcopy_ */
/* dscal.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int dscal_(integer *n, doublereal *da, doublereal *dx,
integer *incx)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer i__, m, ix, mp1;
/* scales a vector by a constant. */
/* uses unrolled loops for increment equal to one. */
/* jack dongarra, linpack, 3/11/78. */
/* modified to correct problem with negative increment, 8/21/90. */
/* Parameter adjustments */
--dx;
/* Function Body */
if (*n <= 0) {
return 0;
}
if (*incx == 1) {
goto L20;
}
/* code for increment not equal to 1 */
ix = 1;
if (*incx < 0) {
ix = (-(*n) + 1) * *incx + 1;
}
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
dx[ix] = *da * dx[ix];
ix += *incx;
/* L10: */
}
return 0;
/* code for increment equal to 1 */
/* clean-up loop */
L20:
m = *n % 5;
if (m == 0) {
goto L40;
}
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
dx[i__] = *da * dx[i__];
/* L30: */
}
if (*n < 5) {
return 0;
}
L40:
mp1 = m + 1;
i__1 = *n;
for (i__ = mp1; i__ <= i__1; i__ += 5) {
dx[i__] = *da * dx[i__];
dx[i__ + 1] = *da * dx[i__ + 1];
dx[i__ + 2] = *da * dx[i__ + 2];
dx[i__ + 3] = *da * dx[i__ + 3];
dx[i__ + 4] = *da * dx[i__ + 4];
/* L50: */
}
return 0;
} /* dscal_ */
/* dist.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static doublereal dist_(integer *n, doublereal *x, doublereal *y)
{
/* System generated locals */
integer i__1;
doublereal ret_val, d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer i__;
doublereal scale, absxmy, sum;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* dist calculates the distance between the points x,y. */
/* input */
/* n - number of components */
/* x - point in n-space */
/* y - point in n-space */
/* local variables */
/* subroutines and functions */
/* fortran */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--y;
--x;
/* Function Body */
absxmy = (d__1 = x[1] - y[1], abs(d__1));
if (absxmy <= 1.) {
sum = absxmy * absxmy;
scale = 1.;
} else {
sum = 1.;
scale = absxmy;
}
i__1 = *n;
for (i__ = 2; i__ <= i__1; ++i__) {
absxmy = (d__1 = x[i__] - y[i__], abs(d__1));
if (absxmy <= scale) {
/* Computing 2nd power */
d__1 = absxmy / scale;
sum += d__1 * d__1;
} else {
/* Computing 2nd power */
d__1 = scale / absxmy;
sum = sum * (d__1 * d__1) + 1.;
scale = absxmy;
}
/* L10: */
}
ret_val = scale * sqrt(sum);
return ret_val;
} /* dist_ */
/* calcc.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
/* Table of constant values */
static doublereal c_b3 = 0.;
static integer c__0 = 0;
static integer c__1 = 1;
static doublereal c_b7 = 1.;
static int calcc_(integer *ns, doublereal *s, integer *ih, integer *
inew, logical *updatc, doublereal *c__)
{
/* System generated locals */
integer s_dim1, s_offset, i__1;
doublereal d__1;
/* Local variables */
integer i__, j;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* calcc calculates the centroid of the simplex without the */
/* vertex with highest function value. */
/* input */
/* ns - subspace dimension */
/* s - double precision work space of dimension .ge. */
/* ns*(ns+3) used to store simplex */
/* ih - index to vertex with highest function value */
/* inew - index to new point */
/* updatc - logical switch */
/* = .true. : update centroid */
/* = .false. : calculate centroid from scratch */
/* c - centroid of the simplex without vertex with */
/* highest function value */
/* output */
/* c - new centroid */
/* local variables */
/* subroutines and functions */
/* blas */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--c__;
s_dim1 = *ns;
s_offset = 1 + s_dim1 * 1;
s -= s_offset;
/* Function Body */
if (*updatc) {
if (*ih == *inew) {
return 0;
}
i__1 = *ns;
for (i__ = 1; i__ <= i__1; ++i__) {
c__[i__] += (s[i__ + *inew * s_dim1] - s[i__ + *ih * s_dim1]) / *
ns;
/* L10: */
}
} else {
dcopy_(ns, &c_b3, &c__0, &c__[1], &c__1);
i__1 = *ns + 1;
for (j = 1; j <= i__1; ++j) {
if (j != *ih) {
daxpy_(ns, &c_b7, &s[j * s_dim1 + 1], &c__1, &c__[1], &c__1);
}
/* L20: */
}
d__1 = 1. / *ns;
dscal_(ns, &d__1, &c__[1], &c__1);
}
return 0;
} /* calcc_ */
/* order.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int order_(integer *npts, doublereal *fs, integer *il,
integer *is, integer *ih)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer i__, j, il0;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* order determines the indices of the vertices with the */
/* lowest, second highest, and highest function values. */
/* input */
/* npts - number of points in simplex */
/* fs - double precision vector of function values of */
/* simplex */
/* il - index to vertex with lowest function value */
/* output */
/* il - new index to vertex with lowest function value */
/* is - new index to vertex with second highest */
/* function value */
/* ih - new index to vertex with highest function value */
/* local variables */
/* subroutines and functions */
/* fortran */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--fs;
/* Function Body */
il0 = *il;
j = il0 % *npts + 1;
if (fs[j] >= fs[*il]) {
*ih = j;
*is = il0;
} else {
*ih = il0;
*is = j;
*il = j;
}
i__1 = il0 + *npts - 2;
for (i__ = il0 + 1; i__ <= i__1; ++i__) {
j = i__ % *npts + 1;
if (fs[j] >= fs[*ih]) {
*is = *ih;
*ih = j;
} else if (fs[j] > fs[*is]) {
*is = j;
} else if (fs[j] < fs[*il]) {
*il = j;
}
/* L10: */
}
return 0;
} /* order_ */
/* partx.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
/* Common Block Declarations */
static struct {
doublereal alpha, beta, gamma, delta, psi, omega;
integer nsmin, nsmax, irepl, ifxsw;
doublereal bonus, fstop;
integer nfstop, nfxe;
doublereal fxstat[4], ftest;
logical minf, initx, newx;
} usubc_;
#define usubc_1 usubc_
static int partx_(integer *n, integer *ip, doublereal *absdx,
integer *nsubs, integer *nsvals)
{
/* System generated locals */
integer i__1;
/* Local variables */
static integer i__, nleft, nused;
static doublereal as1max, gapmax, asleft, as1, as2;
static integer ns1, ns2;
static doublereal gap;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* partx partitions the vector x by grouping components of */
/* similar magnitude of change. */
/* input */
/* n - number of components (problem dimension) */
/* ip - permutation vector */
/* absdx - vector of magnitude of change in x */
/* nsvals - integer array dimensioned .ge. int(n/nsmin) */
/* output */
/* nsubs - number of subspaces */
/* nsvals - integer array of subspace dimensions */
/* common */
/* local variables */
/* subroutines and functions */
/* fortran */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--absdx;
--ip;
--nsvals;
/* Function Body */
*nsubs = 0;
nused = 0;
nleft = *n;
asleft = absdx[1];
i__1 = *n;
for (i__ = 2; i__ <= i__1; ++i__) {
asleft += absdx[i__];
/* L10: */
}
L20:
if (nused < *n) {
++(*nsubs);
as1 = 0.;
i__1 = usubc_1.nsmin - 1;
for (i__ = 1; i__ <= i__1; ++i__) {
as1 += absdx[ip[nused + i__]];
/* L30: */
}
gapmax = -1.;
i__1 = min(usubc_1.nsmax,nleft);
for (ns1 = usubc_1.nsmin; ns1 <= i__1; ++ns1) {
as1 += absdx[ip[nused + ns1]];
ns2 = nleft - ns1;
if (ns2 > 0) {
if (ns2 >= ((ns2 - 1) / usubc_1.nsmax + 1) * usubc_1.nsmin) {
as2 = asleft - as1;
gap = as1 / ns1 - as2 / ns2;
if (gap > gapmax) {
gapmax = gap;
nsvals[*nsubs] = ns1;
as1max = as1;
}
}
} else {
if (as1 / ns1 > gapmax) {
nsvals[*nsubs] = ns1;
return 0;
}
}
/* L40: */
}
nused += nsvals[*nsubs];
nleft = *n - nused;
asleft -= as1max;
goto L20;
}
return 0;
} /* partx_ */
/* sortd.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int sortd_(integer *n, doublereal *xkey, integer *ix)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer ixip1, i__, ilast, iswap, ifirst, ixi;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* sortd uses the shakersort method to sort an array of keys */
/* in decreasing order. The sort is performed implicitly by */
/* modifying a vector of indices. */
/* For nearly sorted arrays, sortd requires O(n) comparisons. */
/* for completely unsorted arrays, sortd requires O(n**2) */
/* comparisons and will be inefficient unless n is small. */
/* input */
/* n - number of components */
/* xkey - double precision vector of keys */
/* ix - integer vector of indices */
/* output */
/* ix - indices satisfy xkey(ix(i)) .ge. xkey(ix(i+1)) */
/* for i = 1,...,n-1 */
/* local variables */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--ix;
--xkey;
/* Function Body */
ifirst = 1;
iswap = 1;
ilast = *n - 1;
L10:
if (ifirst <= ilast) {
i__1 = ilast;
for (i__ = ifirst; i__ <= i__1; ++i__) {
ixi = ix[i__];
ixip1 = ix[i__ + 1];
if (xkey[ixi] < xkey[ixip1]) {
ix[i__] = ixip1;
ix[i__ + 1] = ixi;
iswap = i__;
}
/* L20: */
}
ilast = iswap - 1;
i__1 = ifirst;
for (i__ = ilast; i__ >= i__1; --i__) {
ixi = ix[i__];
ixip1 = ix[i__ + 1];
if (xkey[ixi] < xkey[ixip1]) {
ix[i__] = ixip1;
ix[i__ + 1] = ixi;
iswap = i__;
}
/* L30: */
}
ifirst = iswap + 1;
goto L10;
}
return 0;
} /* sortd_ */
/* newpt.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int newpt_(integer *ns, doublereal *coef, doublereal *xbase,
doublereal *xold, logical *new__, doublereal *xnew, logical *small)
{
/* System generated locals */
integer i__1;
/* Local variables */
integer i__;
logical eqold;
doublereal xoldi;
logical eqbase;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* newpt performs reflections, expansions, contractions, and */
/* shrinkages (massive contractions) by computing: */
/* xbase + coef * (xbase - xold) */
/* The result is stored in xnew if new .eq. .true., */
/* in xold otherwise. */
/* use : coef .gt. 0 to reflect */
/* coef .lt. 0 to expand, contract, or shrink */
/* input */
/* ns - number of components (subspace dimension) */
/* coef - one of four simplex method coefficients */
/* xbase - double precision ns-vector representing base */
/* point */
/* xold - double precision ns-vector representing old */
/* point */
/* new - logical switch */
/* = .true. : store result in xnew */
/* = .false. : store result in xold, xnew is not */
/* referenced */
/* output */
/* xold - unchanged if new .eq. .true., contains new */
/* point otherwise */
/* xnew - double precision ns-vector representing new */
/* point if new .eq. .true., not referenced */
/* otherwise */
/* small - logical flag */
/* = .true. : coincident points */
/* = .false. : otherwise */
/* local variables */
/* subroutines and functions */
/* fortran */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--xold;
--xbase;
--xnew;
/* Function Body */
eqbase = TRUE_;
eqold = TRUE_;
if (*new__) {
i__1 = *ns;
for (i__ = 1; i__ <= i__1; ++i__) {
xnew[i__] = xbase[i__] + *coef * (xbase[i__] - xold[i__]);
eqbase = eqbase && xnew[i__] == xbase[i__];
eqold = eqold && xnew[i__] == xold[i__];
/* L10: */
}
} else {
i__1 = *ns;
for (i__ = 1; i__ <= i__1; ++i__) {
xoldi = xold[i__];
xold[i__] = xbase[i__] + *coef * (xbase[i__] - xold[i__]);
eqbase = eqbase && xold[i__] == xbase[i__];
eqold = eqold && xold[i__] == xoldi;
/* L20: */
}
}
*small = eqbase || eqold;
return 0;
} /* newpt_ */
/* start.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int start_(integer *n, doublereal *x, doublereal *step,
integer *ns, integer *ips, doublereal *s, logical *small)
{
/* System generated locals */
integer s_dim1, s_offset, i__1;
/* Local variables */
integer i__, j;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* start creates the initial simplex for simplx minimization. */
/* input */
/* n - problem dimension */
/* x - current best point */
/* step - stepsizes for corresponding components of x */
/* ns - subspace dimension */
/* ips - permutation vector */
/* output */
/* s - first ns+1 columns contain initial simplex */
/* small - logical flag */
/* = .true. : coincident points */
/* = .false. : otherwise */
/* local variables */
/* subroutines and functions */
/* blas */
/* fortran */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--ips;
--step;
--x;
s_dim1 = *ns;
s_offset = 1 + s_dim1 * 1;
s -= s_offset;
/* Function Body */
i__1 = *ns;
for (i__ = 1; i__ <= i__1; ++i__) {
s[i__ + s_dim1] = x[ips[i__]];
/* L10: */
}
i__1 = *ns + 1;
for (j = 2; j <= i__1; ++j) {
dcopy_(ns, &s[s_dim1 + 1], &c__1, &s[j * s_dim1 + 1], &c__1);
s[j - 1 + j * s_dim1] = s[j - 1 + s_dim1] + step[ips[j - 1]];
/* L20: */
}
/* check for coincident points */
i__1 = *ns + 1;
for (j = 2; j <= i__1; ++j) {
if (s[j - 1 + j * s_dim1] == s[j - 1 + s_dim1]) {
goto L40;
}
/* L30: */
}
*small = FALSE_;
return 0;
/* coincident points */
L40:
*small = TRUE_;
return 0;
} /* start_ */
/* fstats.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int fstats_(doublereal *fx, integer *ifxwt, logical *reset)
{
/* System generated locals */
doublereal d__1, d__2, d__3;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static doublereal fscale;
static integer nsv;
static doublereal f1sv;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* fstats modifies the common /usubc/ variables nfxe,fxstat. */
/* input */
/* fx - most recent evaluation of f at best x */
/* ifxwt - integer weight for fx */
/* reset - logical switch */
/* = .true. : initialize nfxe,fxstat */
/* = .false. : update nfxe,fxstat */
/* common */
/* local variables */
/* subroutines and functions */
/* fortran */
/* ----------------------------------------------------------- */
if (*reset) {
usubc_1.nfxe = *ifxwt;
usubc_1.fxstat[0] = *fx;
usubc_1.fxstat[1] = *fx;
usubc_1.fxstat[2] = *fx;
usubc_1.fxstat[3] = 0.;
} else {
nsv = usubc_1.nfxe;
f1sv = usubc_1.fxstat[0];
usubc_1.nfxe += *ifxwt;
usubc_1.fxstat[0] += *ifxwt * (*fx - usubc_1.fxstat[0]) /
usubc_1.nfxe;
usubc_1.fxstat[1] = max(usubc_1.fxstat[1],*fx);
usubc_1.fxstat[2] = min(usubc_1.fxstat[2],*fx);
/* Computing MAX */
d__1 = abs(usubc_1.fxstat[1]), d__2 = abs(usubc_1.fxstat[2]), d__1 =
max(d__1,d__2);
fscale = max(d__1,1.);
/* Computing 2nd power */
d__1 = usubc_1.fxstat[3] / fscale;
/* Computing 2nd power */
d__2 = (usubc_1.fxstat[0] - f1sv) / fscale;
/* Computing 2nd power */
d__3 = (*fx - usubc_1.fxstat[0]) / fscale;
usubc_1.fxstat[3] = fscale * sqrt(((nsv - 1) * (d__1 * d__1) + nsv * (
d__2 * d__2) + *ifxwt * (d__3 * d__3)) / (usubc_1.nfxe - 1));
}
return 0;
} /* fstats_ */
/* evalf.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
/* Common Block Declarations */
static struct {
doublereal fbonus, sfstop, sfbest;
logical new__;
} isubc_;
#define isubc_1 isubc_
static logical c_true = TRUE_;
static logical c_false = FALSE_;
static int evalf_(D_fp f,void*fdata, integer *ns, integer *ips, doublereal *xs,
integer *n, doublereal *x, doublereal *sfx, integer *nfe)
{
/* System generated locals */
integer i__1;
/* Local variables */
static integer i__;
static doublereal fx;
static logical newbst;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* evalf evaluates the function f at a point defined by x */
/* with ns of its components replaced by those in xs. */
/* input */
/* f - user supplied function f(n,x) to be optimized */
/* ns - subspace dimension */
/* ips - permutation vector */
/* xs - double precision ns-vector to be mapped to x */
/* n - problem dimension */
/* x - double precision n-vector */
/* nfe - number of function evaluations */
/* output */
/* sfx - signed value of f evaluated at x */
/* nfe - incremented number of function evaluations */
/* common */
/* local variables */
/* subroutines and functions */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--ips;
--xs;
--x;
/* Function Body */
i__1 = *ns;
for (i__ = 1; i__ <= i__1; ++i__) {
x[ips[i__]] = xs[i__];
/* L10: */
}
usubc_1.newx = isubc_1.new__ || usubc_1.irepl != 2;
fx = (*f)(*n, &x[1], fdata);
if (usubc_1.irepl == 0) {
if (usubc_1.minf) {
*sfx = fx;
} else {
*sfx = -fx;
}
} else if (isubc_1.new__) {
if (usubc_1.minf) {
*sfx = fx;
newbst = fx < usubc_1.ftest;
} else {
*sfx = -fx;
newbst = fx > usubc_1.ftest;
}
if (usubc_1.initx || newbst) {
if (usubc_1.irepl == 1) {
fstats_(&fx, &c__1, &c_true);
}
usubc_1.ftest = fx;
isubc_1.sfbest = *sfx;
}
} else {
if (usubc_1.irepl == 1) {
fstats_(&fx, &c__1, &c_false);
fx = usubc_1.fxstat[usubc_1.ifxsw - 1];
}
usubc_1.ftest = fx + isubc_1.fbonus * usubc_1.fxstat[3];
if (usubc_1.minf) {
*sfx = usubc_1.ftest;
isubc_1.sfbest = fx;
} else {
*sfx = -usubc_1.ftest;
isubc_1.sfbest = -fx;
}
}
++(*nfe);
return 0;
} /* evalf_ */
/* simplx.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int simplx_(D_fp f, void *fdata, integer *n, doublereal *step, integer *
ns, integer *ips, integer *maxnfe, logical *cmode, doublereal *x,
doublereal *fx, integer *nfe, doublereal *s, doublereal *fs, integer *
iflag)
{
/* System generated locals */
integer s_dim1, s_offset, i__1;
doublereal d__1, d__2;
/* Local variables */
static integer inew;
static integer npts;
static integer i__, j;
static integer icent;
static logical small;
static integer itemp;
static doublereal fc, fe;
static integer ih, il;
static doublereal fr;
static integer is;
static logical updatc;
static doublereal dum, tol;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* simplx uses the Nelder-Mead simplex method to minimize the */
/* function f on a subspace. */
/* input */
/* f - function to be minimized, declared external in */
/* calling routine */
/* n - problem dimension */
/* step - stepsizes for corresponding components of x */
/* ns - subspace dimension */
/* ips - permutation vector */
/* maxnfe - maximum number of function evaluations */
/* cmode - logical switch */
/* = .true. : continuation of previous call */
/* = .false. : first call */
/* x - starting guess for minimum */
/* fx - value of f at x */
/* nfe - number of function evaluations */
/* s - double precision work array of dimension .ge. */
/* ns*(ns+3) used to store simplex */
/* fs - double precision work array of dimension .ge. */
/* ns+1 used to store function values of simplex */
/* vertices */
/* output */
/* x - computed minimum */
/* fx - value of f at x */
/* nfe - incremented number of function evaluations */
/* iflag - error flag */
/* = -1 : maxnfe exceeded */
/* = 0 : simplex reduced by factor of psi */
/* = 1 : limit of machine precision */
/* = 2 : reached fstop */
/* common */
/* local variables */
/* subroutines and functions */
/* blas */
/* fortran */
/* ----------------------------------------------------------- */
/* Parameter adjustments */
--x;
--step;
--fs;
s_dim1 = *ns;
s_offset = 1 + s_dim1 * 1;
s -= s_offset;
--ips;
/* Function Body */
if (*cmode) {
goto L50;
}
npts = *ns + 1;
icent = *ns + 2;
itemp = *ns + 3;
updatc = FALSE_;
start_(n, &x[1], &step[1], ns, &ips[1], &s[s_offset], &small);
if (small) {
*iflag = 1;
return 0;
}
if (usubc_1.irepl > 0) {
isubc_1.new__ = FALSE_;
evalf_((D_fp)f,fdata, ns, &ips[1], &s[s_dim1 + 1], n, &x[1], &fs[1], nfe);
} else {
fs[1] = *fx;
}
isubc_1.new__ = TRUE_;
i__1 = npts;
for (j = 2; j <= i__1; ++j) {
evalf_((D_fp)f, fdata,ns, &ips[1], &s[j * s_dim1 + 1], n, &x[1], &fs[j],
nfe);
/* L10: */
}
il = 1;
order_(&npts, &fs[1], &il, &is, &ih);
tol = usubc_1.psi * dist_(ns, &s[ih * s_dim1 + 1], &s[il * s_dim1 + 1]);
/* main loop */
L20:
calcc_(ns, &s[s_offset], &ih, &inew, &updatc, &s[icent * s_dim1 + 1]);
updatc = TRUE_;
inew = ih;
/* reflect */
newpt_(ns, &usubc_1.alpha, &s[icent * s_dim1 + 1], &s[ih * s_dim1 + 1], &
c_true, &s[itemp * s_dim1 + 1], &small);
if (small) {
goto L40;
}
evalf_((D_fp)f,fdata, ns, &ips[1], &s[itemp * s_dim1 + 1], n, &x[1], &fr, nfe);
if (fr < fs[il]) {
/* expand */
d__1 = -usubc_1.gamma;
newpt_(ns, &d__1, &s[icent * s_dim1 + 1], &s[itemp * s_dim1 + 1], &
c_true, &s[ih * s_dim1 + 1], &small);
if (small) {
goto L40;
}
evalf_((D_fp)f,fdata, ns, &ips[1], &s[ih * s_dim1 + 1], n, &x[1], &fe, nfe);
if (fe < fr) {
fs[ih] = fe;
} else {
dcopy_(ns, &s[itemp * s_dim1 + 1], &c__1, &s[ih * s_dim1 + 1], &
c__1);
fs[ih] = fr;
}
} else if (fr < fs[is]) {
/* accept reflected point */
dcopy_(ns, &s[itemp * s_dim1 + 1], &c__1, &s[ih * s_dim1 + 1], &c__1);
fs[ih] = fr;
} else {
/* contract */
if (fr > fs[ih]) {
d__1 = -usubc_1.beta;
newpt_(ns, &d__1, &s[icent * s_dim1 + 1], &s[ih * s_dim1 + 1], &
c_true, &s[itemp * s_dim1 + 1], &small);
} else {
d__1 = -usubc_1.beta;
newpt_(ns, &d__1, &s[icent * s_dim1 + 1], &s[itemp * s_dim1 + 1],
&c_false, &dum, &small);
}
if (small) {
goto L40;
}
evalf_((D_fp)f,fdata, ns, &ips[1], &s[itemp * s_dim1 + 1], n, &x[1], &fc,
nfe);
/* Computing MIN */
d__1 = fr, d__2 = fs[ih];
if (fc < min(d__1,d__2)) {
dcopy_(ns, &s[itemp * s_dim1 + 1], &c__1, &s[ih * s_dim1 + 1], &
c__1);
fs[ih] = fc;
} else {
/* shrink simplex */
i__1 = npts;
for (j = 1; j <= i__1; ++j) {
if (j != il) {
d__1 = -usubc_1.delta;
newpt_(ns, &d__1, &s[il * s_dim1 + 1], &s[j * s_dim1 + 1],
&c_false, &dum, &small);
if (small) {
goto L40;
}
evalf_((D_fp)f,fdata, ns, &ips[1], &s[j * s_dim1 + 1], n, &x[1],
&fs[j], nfe);
}
/* L30: */
}
}
updatc = FALSE_;
}
order_(&npts, &fs[1], &il, &is, &ih);
/* check termination */
L40:
if (usubc_1.irepl == 0) {
*fx = fs[il];
} else {
*fx = isubc_1.sfbest;
}
L50:
if (usubc_1.nfstop > 0 && *fx <= isubc_1.sfstop && usubc_1.nfxe >=
usubc_1.nfstop) {
*iflag = 2;
} else if (*nfe >= *maxnfe) {
*iflag = -1;
} else if (dist_(ns, &s[ih * s_dim1 + 1], &s[il * s_dim1 + 1]) <= tol ||
small) {
*iflag = 0;
} else {
goto L20;
}
/* end main loop, return best point */
i__1 = *ns;
for (i__ = 1; i__ <= i__1; ++i__) {
x[ips[i__]] = s[i__ + il * s_dim1];
/* L60: */
}
return 0;
} /* simplx_ */
/* subopt.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int subopt_(integer *n)
{
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* subopt sets options for subplx. */
/* input */
/* n - problem dimension */
/* common */
/* subroutines and functions */
/* fortran */
/* ----------------------------------------------------------- */
/* *********************************************************** */
/* simplex method strategy parameters */
/* *********************************************************** */
/* alpha - reflection coefficient */
/* alpha .gt. 0 */
usubc_1.alpha = 1.;
/* beta - contraction coefficient */
/* 0 .lt. beta .lt. 1 */
usubc_1.beta = .5;
/* gamma - expansion coefficient */
/* gamma .gt. 1 */
usubc_1.gamma = 2.;
/* delta - shrinkage (massive contraction) coefficient */
/* 0 .lt. delta .lt. 1 */
usubc_1.delta = .5;
/* *********************************************************** */
/* subplex method strategy parameters */
/* *********************************************************** */
/* psi - simplex reduction coefficient */
/* 0 .lt. psi .lt. 1 */
usubc_1.psi = .25;
/* omega - step reduction coefficient */
/* 0 .lt. omega .lt. 1 */
usubc_1.omega = .1;
/* nsmin and nsmax specify a range of subspace dimensions. */
/* In addition to satisfying 1 .le. nsmin .le. nsmax .le. n, */
/* nsmin and nsmax must be chosen so that n can be expressed */
/* as a sum of positive integers where each of these integers */
/* ns(i) satisfies nsmin .le. ns(i) .ge. nsmax. */
/* Specifically, */
/* nsmin*ceil(n/nsmax) .le. n must be true. */
/* nsmin - subspace dimension minimum */
usubc_1.nsmin = min(2,*n);
/* nsmax - subspace dimension maximum */
usubc_1.nsmax = min(5,*n);
/* *********************************************************** */
/* subplex method special cases */
/* *********************************************************** */
/* nelder-mead simplex method with periodic restarts */
/* nsmin = nsmax = n */
/* *********************************************************** */
/* nelder-mead simplex method */
/* nsmin = nsmax = n, psi = small positive */
/* *********************************************************** */
/* irepl, ifxsw, and bonus deal with measurement replication. */
/* Objective functions subject to large amounts of noise can */
/* cause an optimization method to halt at a false optimum. */
/* An expensive solution to this problem is to evaluate f */
/* several times at each point and return the average (or max */
/* or min) of these trials as the function value. subplx */
/* performs measurement replication only at the current best */
/* point. The longer a point is retained as best, the more */
/* accurate its function value becomes. */
/* The common variable nfxe contains the number of function */
/* evaluations at the current best point. fxstat contains the */
/* mean, max, min, and standard deviation of these trials. */
/* irepl - measurement replication switch */
/* irepl = 0, 1, or 2 */
/* = 0 : no measurement replication */
/* = 1 : subplx performs measurement replication */
/* = 2 : user performs measurement replication */
/* (This is useful when optimizing on the mean, */
/* max, or min of trials is insufficient. Common */
/* variable initx is true for first function */
/* evaluation. newx is true for first trial at */
/* this point. The user uses subroutine fstats */
/* within his objective function to maintain */
/* fxstat. By monitoring newx, the user can tell */
/* whether to return the function evaluation */
/* (newx = .true.) or to use the new function */
/* evaluation to refine the function evaluation */
/* of the current best point (newx = .false.). */
/* The common variable ftest gives the function */
/* value that a new point must beat to be */
/* considered the new best point.) */
usubc_1.irepl = 0;
/* ifxsw - measurement replication optimization switch */
/* ifxsw = 1, 2, or 3 */
/* = 1 : retain mean of trials as best function value */
/* = 2 : retain max */
/* = 3 : retain min */
usubc_1.ifxsw = 1;
/* Since the current best point will also be the most */
/* accurately evaluated point whenever irepl .gt. 0, a bonus */
/* should be added to the function value of the best point */
/* so that the best point is not replaced by a new point */
/* that only appears better because of noise. */
/* subplx uses bonus to determine how many multiples of */
/* fxstat(4) should be added as a bonus to the function */
/* evaluation. (The bonus is adjusted automatically by */
/* subplx when ifxsw or minf is changed.) */
/* bonus - measurement replication bonus coefficient */
/* bonus .ge. 0 (normally, bonus = 0 or 1) */
/* = 0 : bonus not used */
/* = 1 : bonus used */
usubc_1.bonus = 1.;
/* nfstop = 0 : f(x) is not tested against fstop */
/* = 1 : if f(x) has reached fstop, subplx returns */
/* iflag = 2 */
/* = 2 : (only valid when irepl .gt. 0) */
/* if f(x) has reached fstop and */
/* nfxe .gt. nfstop, subplx returns iflag = 2 */
usubc_1.nfstop = 0;
/* fstop - f target value */
/* Its usage is determined by the value of nfstop. */
/* minf - logical switch */
/* = .true. : subplx performs minimization */
/* = .false. : subplx performs maximization */
usubc_1.minf = TRUE_;
return 0;
} /* subopt_ */
/* setstp.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static double d_sign(doublereal *x, doublereal *y)
{
return copysign(*x, *y);
}
static int setstp_(integer *nsubs, integer *n, doublereal *deltax,
doublereal *step)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2, d__3;
/* Builtin functions */
/* double d_sign(doublereal *, doublereal *); */
/* Local variables */
static integer i__;
static doublereal stpfac;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* setstp sets the stepsizes for the corresponding components */
/* of the solution vector. */
/* input */
/* nsubs - number of subspaces */
/* n - number of components (problem dimension) */
/* deltax - vector of change in solution vector */
/* step - stepsizes for corresponding components of */
/* solution vector */
/* output */
/* step - new stepsizes */
/* common */
/* local variables */
/* subroutines and functions */
/* blas */
/* fortran */
/* ----------------------------------------------------------- */
/* set new step */
/* Parameter adjustments */
--step;
--deltax;
/* Function Body */
if (*nsubs > 1) {
/* Computing MIN */
/* Computing MAX */
d__3 = dasum_(n, &deltax[1], &c__1) / dasum_(n, &step[1], &c__1);
d__1 = max(d__3,usubc_1.omega), d__2 = 1. / usubc_1.omega;
stpfac = min(d__1,d__2);
} else {
stpfac = usubc_1.psi;
}
dscal_(n, &stpfac, &step[1], &c__1);
/* reorient simplex */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
if (deltax[i__] != 0.) {
step[i__] = d_sign(&step[i__], &deltax[i__]);
} else {
step[i__] = -step[i__];
}
/* L10: */
}
return 0;
} /* setstp_ */
/* subplx.f -- translated by f2c (version 19991025).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
static int subplx_(D_fp f, void *fdata, integer *n, doublereal *tol, integer *
maxnfe, integer *mode, doublereal *scale, doublereal *x, doublereal *
fx, integer *nfe, doublereal *work, integer *iwork, integer *iflag)
{
/* Initialized data */
static doublereal bnsfac[6] /* was [3][2] */ = { -1.,-2.,0.,1.,0.,2. };
/* System generated locals */
integer i__1;
doublereal d__1, d__2, d__3, d__4, d__5, d__6;
/* Local variables */
static integer i__;
static logical cmode;
static integer istep;
static doublereal xpscl;
static integer nsubs, ipptr;
static integer isptr;
static integer ns, insfnl, ifsptr;
static integer insptr;
static integer istptr;
static doublereal scl, dum;
static integer ins;
static doublereal sfx;
/* Coded by Tom Rowan */
/* Department of Computer Sciences */
/* University of Texas at Austin */
/* subplx uses the subplex method to solve unconstrained */
/* optimization problems. The method is well suited for */
/* optimizing objective functions that are noisy or are */
/* discontinuous at the solution. */
/* subplx sets default optimization options by calling the */
/* subroutine subopt. The user can override these defaults */
/* by calling subopt prior to calling subplx, changing the */
/* appropriate common variables, and setting the value of */
/* mode as indicated below. */
/* By default, subplx performs minimization. */
/* input */
/* f - user supplied function f(n,x) to be optimized, */
/* declared external in calling routine */
/* n - problem dimension */
/* tol - relative error tolerance for x (tol .ge. 0.) */
/* maxnfe - maximum number of function evaluations */
/* mode - integer mode switch with binary expansion */
/* (bit 1) (bit 0) : */
/* bit 0 = 0 : first call to subplx */
/* = 1 : continuation of previous call */
/* bit 1 = 0 : use default options */
/* = 1 : user set options */
/* scale - scale and initial stepsizes for corresponding */
/* components of x */
/* (If scale(1) .lt. 0., */
/* abs(scale(1)) is used for all components of x, */
/* and scale(2),...,scale(n) are not referenced.) */
/* x - starting guess for optimum */
/* work - double precision work array of dimension .ge. */
/* 2*n + nsmax*(nsmax+4) + 1 */
/* (nsmax is set in subroutine subopt. */
/* default: nsmax = min(5,n)) */
/* iwork - integer work array of dimension .ge. */
/* n + int(n/nsmin) */
/* (nsmin is set in subroutine subopt. */
/* default: nsmin = min(2,n)) */
/* output */
/* x - computed optimum */
/* fx - value of f at x */
/* nfe - number of function evaluations */
/* iflag - error flag */
/* = -2 : invalid input */
/* = -1 : maxnfe exceeded */
/* = 0 : tol satisfied */
/* = 1 : limit of machine precision */
/* = 2 : fstop reached (fstop usage is determined */
/* by values of options minf, nfstop, and */
/* irepl. default: f(x) not tested against */
/* fstop) */
/* iflag should not be reset between calls to */
/* subplx. */
/* common */
/* local variables */
/* subroutines and functions */
/* blas */
/* fortran */
/* data */
/* Parameter adjustments */
--x;
--scale;
--work;
--iwork;
/* Function Body */
/* ----------------------------------------------------------- */
if (*mode % 2 == 0) {
/* first call, check input */
if (*n < 1) {
goto L120;
}
if (*tol < 0.) {
goto L120;
}
if (*maxnfe < 1) {
goto L120;
}
if (scale[1] >= 0.) {
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
xpscl = x[i__] + scale[i__];
if (xpscl == x[i__]) {
goto L120;
}
/* L10: */
}
} else {
scl = abs(scale[1]);
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
xpscl = x[i__] + scl;
if (xpscl == x[i__]) {
goto L120;
}
/* L20: */
}
}
if (*mode / 2 % 2 == 0) {
subopt_(n);
} else {
if (usubc_1.alpha <= 0.) {
goto L120;
}
if (usubc_1.beta <= 0. || usubc_1.beta >= 1.) {
goto L120;
}
if (usubc_1.gamma <= 1.) {
goto L120;
}
if (usubc_1.delta <= 0. || usubc_1.delta >= 1.) {
goto L120;
}
if (usubc_1.psi <= 0. || usubc_1.psi >= 1.) {
goto L120;
}
if (usubc_1.omega <= 0. || usubc_1.omega >= 1.) {
goto L120;
}
if (usubc_1.nsmin < 1 || usubc_1.nsmax < usubc_1.nsmin || *n <
usubc_1.nsmax) {
goto L120;
}
if (*n < ((*n - 1) / usubc_1.nsmax + 1) * usubc_1.nsmin) {
goto L120;
}
if (usubc_1.irepl < 0 || usubc_1.irepl > 2) {
goto L120;
}
if (usubc_1.ifxsw < 1 || usubc_1.ifxsw > 3) {
goto L120;
}
if (usubc_1.bonus < 0.) {
goto L120;
}
if (usubc_1.nfstop < 0) {
goto L120;
}
}
/* initialization */
istptr = *n + 1;
isptr = istptr + *n;
ifsptr = isptr + usubc_1.nsmax * (usubc_1.nsmax + 3);
insptr = *n + 1;
if (scale[1] > 0.) {
dcopy_(n, &scale[1], &c__1, &work[1], &c__1);
dcopy_(n, &scale[1], &c__1, &work[istptr], &c__1);
} else {
dcopy_(n, &scl, &c__0, &work[1], &c__1);
dcopy_(n, &scl, &c__0, &work[istptr], &c__1);
}
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
iwork[i__] = i__;
/* L30: */
}
*nfe = 0;
usubc_1.nfxe = 1;
if (usubc_1.irepl == 0) {
isubc_1.fbonus = 0.;
} else if (usubc_1.minf) {
isubc_1.fbonus = bnsfac[usubc_1.ifxsw - 1] * usubc_1.bonus;
} else {
isubc_1.fbonus = bnsfac[usubc_1.ifxsw + 2] * usubc_1.bonus;
}
if (usubc_1.nfstop == 0) {
isubc_1.sfstop = 0.;
} else if (usubc_1.minf) {
isubc_1.sfstop = usubc_1.fstop;
} else {
isubc_1.sfstop = -usubc_1.fstop;
}
usubc_1.ftest = 0.;
cmode = FALSE_;
isubc_1.new__ = TRUE_;
usubc_1.initx = TRUE_;
evalf_((D_fp)f, fdata, &c__0, &iwork[1], &dum, n, &x[1], &sfx, nfe);
usubc_1.initx = FALSE_;
} else {
/* continuation of previous call */
if (*iflag == 2) {
if (usubc_1.minf) {
isubc_1.sfstop = usubc_1.fstop;
} else {
isubc_1.sfstop = -usubc_1.fstop;
}
cmode = TRUE_;
goto L70;
} else if (*iflag == -1) {
cmode = TRUE_;
goto L70;
} else if (*iflag == 0) {
cmode = FALSE_;
goto L90;
} else {
return 0;
}
}
/* subplex loop */
L40:
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
work[i__] = (d__1 = work[i__], abs(d__1));
/* L50: */
}
sortd_(n, &work[1], &iwork[1]);
partx_(n, &iwork[1], &work[1], &nsubs, &iwork[insptr]);
dcopy_(n, &x[1], &c__1, &work[1], &c__1);
ins = insptr;
insfnl = insptr + nsubs - 1;
ipptr = 1;
/* simplex loop */
L60:
ns = iwork[ins];
L70:
simplx_((D_fp)f, fdata, n, &work[istptr], &ns, &iwork[ipptr], maxnfe, &cmode, &x[
1], &sfx, nfe, &work[isptr], &work[ifsptr], iflag);
cmode = FALSE_;
if (*iflag != 0) {
goto L110;
}
if (ins < insfnl) {
++ins;
ipptr += ns;
goto L60;
}
/* end simplex loop */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
work[i__] = x[i__] - work[i__];
/* L80: */
}
/* check termination */
L90:
istep = istptr;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
/* Computing MAX */
d__4 = (d__2 = work[i__], abs(d__2)), d__5 = (d__1 = work[istep], abs(
d__1)) * usubc_1.psi;
/* Computing MAX */
d__6 = (d__3 = x[i__], abs(d__3));
if (max(d__4,d__5) / max(d__6,1.) > *tol) {
setstp_(&nsubs, n, &work[1], &work[istptr]);
goto L40;
}
++istep;
/* L100: */
}
/* end subplex loop */
*iflag = 0;
L110:
if (usubc_1.minf) {
*fx = sfx;
} else {
*fx = -sfx;
}
return 0;
/* invalid input */
L120:
*iflag = -2;
return 0;
} /* subplx_ */
/****************************************************************************/
/****************************************************************************/
/* front-end for subplex routines */
/* Wrapper around f2c'ed subplx_ routine, for multidimensinal
unconstrained optimization:
Parameters:
f: function f(n,x,fdata) to be optimized
n: problem dimension
x[n]: (input) starting guess position, (output) computed minimum
fdata: data pointer passed to f
tol: relative error tolerance for x
maxnfe: maximum number of function evaluations
scale[n]: (input) scale & initial stepsizes for components of x
(if *scale < 0, |*scale| is used for all components)
nfe: (output) number of function evaluations
errflag: (output)
= -2 : invalid input
= -1 : maxnfe exceeded
= 0 : tol satisfied
= 1 : limit of machine precision
= 2 : fstop reached (fstop usage is determined by values of
options minf, nfstop, and irepl. default: f(x) not
tested against fstop)
Return value: value of f at minimum.
*/
number subplex(multivar_func f, number *x, integer n, void *fdata,
number tol, integer maxnfe,
number fmin, boolean use_fmin,
number *scale,
integer *nfe, integer *errflag)
{
integer mode = 0, *iwork, nsmax, nsmin;
number *work, fx;
nsmax = min(5,n);
nsmin = min(2,n);
work = (number*) malloc(sizeof(number) * (2*n + nsmax*(nsmax+4) + 1));
iwork = (integer*) malloc(sizeof(integer) * (n + n/nsmin + 1));
if (!work || !iwork) {
fprintf(stderr, "subplex: error, out of memory!\n");
exit(EXIT_FAILURE);
}
if (use_fmin) { /* stop when fmin is reached */
subopt_(&n);
usubc_1.nfstop = 1;
usubc_1.fstop = fmin;
mode = 2;
}
subplx_(f,fdata, &n,
&tol, &maxnfe, &mode,
scale, x,
&fx, nfe,
work, iwork, errflag);
free(iwork);
free(work);
return fx;
}
number f_scm_wrapper(integer n, number *x, void *f_scm_p)
{
SCM *f_scm = (SCM *) f_scm_p;
return ctl_convert_number_to_c(gh_call1(*f_scm, make_number_list(n, x)));
}
/* Scheme-callable wrapper for subplex() function, above. */
SCM subplex_scm(SCM f_scm, SCM x_scm,
SCM tol_scm, SCM maxnfe_scm,
SCM fmin_scm, SCM use_fmin_scm,
SCM scale_scm)
{
number *x, tol, *scale, fx, fmin;
integer i, n, maxnfe, nfe, errflag, scale_len;
boolean use_fmin;
SCM retval;
n = list_length(x_scm);
tol = fabs(ctl_convert_number_to_c(tol_scm));
maxnfe = ctl_convert_integer_to_c(maxnfe_scm);
fmin = ctl_convert_number_to_c(fmin_scm);
use_fmin = ctl_convert_boolean_to_c(use_fmin_scm);
scale_len = list_length(scale_scm);
if (scale_len != 1 && scale_len != n) {
fprintf(stderr, "subplex: invalid scale argument length %d\n",
scale_len);
return SCM_UNDEFINED;
}
x = (number*) malloc(sizeof(number) * n);
scale = (number*) malloc(sizeof(number) * scale_len);
if (!x || !scale) {
fprintf(stderr, "subplex: error, out of memory!\n");
exit(EXIT_FAILURE);
}
for (i = 0; i < n; ++i)
x[i] = number_list_ref(x_scm, i);
for (i = 0; i < scale_len; ++i)
scale[i] = fabs(number_list_ref(scale_scm, i));
if (scale_len == 1 && scale_len != n)
*scale *= -1;
fx = subplex(f_scm_wrapper, x, n, &f_scm,
tol, maxnfe,
fmin, use_fmin,
scale,
&nfe, &errflag);
switch (errflag) {
case -2:
fprintf(stderr, "subplex error: invalid inputs\n");
return SCM_UNDEFINED;
case -1:
fprintf(stderr, "subplex warning: max # iterations exceeded\n");
break;
case 1:
fprintf(stderr, "subplex warning: machine precision reached\n");
break;
case 2:
fprintf(stderr, "subplex warning: fstop reached\n");
break;
}
retval = gh_cons(make_number_list(n, x), ctl_convert_number_to_scm(fx));
free(scale);
free(x);
return retval;
}
libctl-3.2.2/src/Makefile.in 0000644 0001754 0000144 00000053271 12315333604 012554 0000000 0000000 # Makefile.in generated by automake 1.14 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = src
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(srcdir)/ctl.h.in $(top_srcdir)/depcomp
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/libtool.m4 \
$(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \
$(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \
$(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_HEADER = $(top_builddir)/config.h ctl.h
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__installdirs = "$(DESTDIR)$(libdir)" "$(DESTDIR)$(includedir)"
LTLIBRARIES = $(lib_LTLIBRARIES)
libctl_la_LIBADD =
am_libctl_la_OBJECTS = ctl.lo subplex.lo ctl-f77-glue.lo integrator.lo \
cintegrator.lo
libctl_la_OBJECTS = $(am_libctl_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
libctl_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
$(libctl_la_LDFLAGS) $(LDFLAGS) -o $@
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
depcomp = $(SHELL) $(top_srcdir)/depcomp
am__depfiles_maybe = depfiles
am__mv = mv -f
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
$(AM_CFLAGS) $(CFLAGS)
AM_V_CC = $(am__v_CC_@AM_V@)
am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
am__v_CC_0 = @echo " CC " $@;
am__v_CC_1 =
CCLD = $(CC)
LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_CCLD = $(am__v_CCLD_@AM_V@)
am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
am__v_CCLD_0 = @echo " CCLD " $@;
am__v_CCLD_1 =
SOURCES = $(libctl_la_SOURCES)
DIST_SOURCES = $(libctl_la_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
HEADERS = $(nodist_include_HEADERS)
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)ctl.h.in
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GEN_CTL_IO = @GEN_CTL_IO@
GREP = @GREP@
GUILE = @GUILE@
GUILE_CONFIG = @GUILE_CONFIG@
INDENT = @INDENT@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBCTL_DIR = @LIBCTL_DIR@
LIBCTL_VERSION = @LIBCTL_VERSION@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHARED_VERSION_INFO = @SHARED_VERSION_INFO@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
lib_LTLIBRARIES = libctl.la
nodist_include_HEADERS = ctl.h
BUILT_SOURCES = ctl.h
EXTRA_DIST = ctl.h.in
libctl_la_SOURCES = ctl.c subplex.c ctl-f77-glue.c integrator.c cintegrator.c
libctl_la_LDFLAGS = -no-undefined -version-info @SHARED_VERSION_INFO@
all: $(BUILT_SOURCES) ctl.h
$(MAKE) $(AM_MAKEFLAGS) all-am
.SUFFIXES:
.SUFFIXES: .c .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign src/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign src/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
ctl.h: stamp-h2
@test -f $@ || rm -f stamp-h2
@test -f $@ || $(MAKE) $(AM_MAKEFLAGS) stamp-h2
stamp-h2: $(srcdir)/ctl.h.in $(top_builddir)/config.status
@rm -f stamp-h2
cd $(top_builddir) && $(SHELL) ./config.status src/ctl.h
distclean-hdr:
-rm -f ctl.h stamp-h2
install-libLTLIBRARIES: $(lib_LTLIBRARIES)
@$(NORMAL_INSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
list2=; for p in $$list; do \
if test -f $$p; then \
list2="$$list2 $$p"; \
else :; fi; \
done; \
test -z "$$list2" || { \
echo " $(MKDIR_P) '$(DESTDIR)$(libdir)'"; \
$(MKDIR_P) "$(DESTDIR)$(libdir)" || exit 1; \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \
}
uninstall-libLTLIBRARIES:
@$(NORMAL_UNINSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
for p in $$list; do \
$(am__strip_dir) \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \
done
clean-libLTLIBRARIES:
-test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES)
@list='$(lib_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libctl.la: $(libctl_la_OBJECTS) $(libctl_la_DEPENDENCIES) $(EXTRA_libctl_la_DEPENDENCIES)
$(AM_V_CCLD)$(libctl_la_LINK) -rpath $(libdir) $(libctl_la_OBJECTS) $(libctl_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cintegrator.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ctl-f77-glue.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ctl.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/integrator.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/subplex.Plo@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $<
.c.obj:
@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.c.lo:
@am__fastdepCC_TRUE@ $(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
install-nodist_includeHEADERS: $(nodist_include_HEADERS)
@$(NORMAL_INSTALL)
@list='$(nodist_include_HEADERS)'; test -n "$(includedir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(includedir)'"; \
$(MKDIR_P) "$(DESTDIR)$(includedir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
echo "$$d$$p"; \
done | $(am__base_list) | \
while read files; do \
echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(includedir)'"; \
$(INSTALL_HEADER) $$files "$(DESTDIR)$(includedir)" || exit $$?; \
done
uninstall-nodist_includeHEADERS:
@$(NORMAL_UNINSTALL)
@list='$(nodist_include_HEADERS)'; test -n "$(includedir)" || list=; \
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
dir='$(DESTDIR)$(includedir)'; $(am__uninstall_files_from_dir)
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: $(BUILT_SOURCES)
$(MAKE) $(AM_MAKEFLAGS) check-am
all-am: Makefile $(LTLIBRARIES) $(HEADERS) ctl.h
installdirs:
for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(includedir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: $(BUILT_SOURCES)
$(MAKE) $(AM_MAKEFLAGS) install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
-test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES)
clean: clean-am
clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-hdr distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am: install-nodist_includeHEADERS
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am: install-libLTLIBRARIES
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -rf ./$(DEPDIR)
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am: uninstall-libLTLIBRARIES uninstall-nodist_includeHEADERS
.MAKE: all check install install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
clean-libLTLIBRARIES clean-libtool cscopelist-am ctags \
ctags-am distclean distclean-compile distclean-generic \
distclean-hdr distclean-libtool distclean-tags distdir dvi \
dvi-am html html-am info info-am install install-am \
install-data install-data-am install-dvi install-dvi-am \
install-exec install-exec-am install-html install-html-am \
install-info install-info-am install-libLTLIBRARIES \
install-man install-nodist_includeHEADERS install-pdf \
install-pdf-am install-ps install-ps-am install-strip \
installcheck installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am uninstall-libLTLIBRARIES \
uninstall-nodist_includeHEADERS
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
libctl-3.2.2/src/ctl-f77-glue.c 0000644 0001754 0000144 00000027143 12315330377 012773 0000000 0000000 /* libctl: flexible Guile-based control files for scientific software
* Copyright (C) 1998-2014 Massachusetts Institute of Technology and Steven G. Johnson
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the
* Free Software Foundation, Inc., 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
* Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
*/
#include
#include
#include "ctl.h"
#include "config.h"
/* This file contains glue code that enables us to call libctl from
Fortran. We have to take into account several things:
1) All Fortran parameters are passed by reference.
2) Fortran compilers are case-insensitive, so they munge identifiers
in a weird way for the linker. If we want a Fortran program to
be able to call us, we have to munge our identifiers in the same
way. (We do this with the F77_FUNC macro--every Fortran compiler
is different. F77_FUNC is determined by the configure script.)
3) Fortran represents strings in a different way than C. To handle
this, we require that Fortran callers pass us the length of a
string as an explicit parameter. We also have to include ugly
hacks to accomodate the fact that Cray Fortran compilers pass
a data structure instead of a char* for string parameters.
4) On some machines, C functions return their results in a way
that the Fortran compiler can't handle. To get around this,
all return results of functions are converted into an extra parameter.
The name of our Fortran routines is the same as the corresponding
C routine with the underscores removed. So, we to construct the
Fortran call, you do something like:
C: foo = bar_baz(x,y,z);
Fortran: call barbaz(x,y,z,foo)
C: foo = bar_baz(x,string,y);
Fortran: call barbaz(x,string,length(string),y,foo)
(Note that string parameters get converted into two parameters: the
string and its length.)
*/
#ifdef F77_FUNC /* if we know how to mangle identifiers for Fortran */
/**************************************************************************/
/* Convert Fortran string parameters to C char*. This is required
in order to accomodate the ugly things that the Cray compilers do. */
#if defined(CRAY) || defined(_UNICOS) || defined(_CRAYMPP)
#include
typedef _fcd fortran_string;
#define fcp2ccp(fs) _fcdtocp(fs)
#else
typedef char *fortran_string;
#define fcp2ccp(fs) (fs)
#endif
/**************************************************************************/
/* Vector functions:
(vector3 can be declared as an array of 3 reals in Fortran) */
void F77_FUNC(vector3scale,VECTOR3SCALE)
(number *s, vector3 *v, vector3 *vscaled)
{
*vscaled = vector3_scale(*s,*v);
}
void F77_FUNC(vector3plus,VECTOR3PLUS)
(vector3 *v1, vector3 *v2, vector3 *vresult)
{
*vresult = vector3_plus(*v1,*v2);
}
void F77_FUNC(vector3minus,VECTOR3MINUS)
(vector3 *v1, vector3 *v2, vector3 *vresult)
{
*vresult = vector3_minus(*v1,*v2);
}
void F77_FUNC(vector3cross,VECTOR3CROSS)
(vector3 *v1, vector3 *v2, vector3 *vresult)
{
*vresult = vector3_cross(*v1,*v2);
}
void F77_FUNC(vector3dot,VECTOR3DOT)
(vector3 *v1, vector3 *v2, number *result)
{
*result = vector3_dot(*v1,*v2);
}
void F77_FUNC(vector3norm,VECTOR3DOT)
(vector3 *v, number *result)
{
*result = vector3_norm(*v);
}
/**************************************************************************/
/* variable get/set functions */
/* Note that list and object variables in Fortran should be declared
as something the same size as the corresponding type in C. (This
turns out to be the same size as a long int.) */
/* Getters: */
void F77_FUNC(ctlgetnumber,CTLGETNUMBER)
(fortran_string identifier, int *length, number *result)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
*result = ctl_get_number(s);
}
void F77_FUNC(ctlgetinteger,CTLGETINTEGER)
(fortran_string identifier, int *length, integer *result)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
*result = ctl_get_integer(s);
}
void F77_FUNC(ctlgetboolean,CTLGETBOOLEAN)
(fortran_string identifier, int *length, boolean *result)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
*result = ctl_get_boolean(s);
}
void F77_FUNC(ctlgetlist,CTLGETLIST)
(fortran_string identifier, int *length, list *result)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
*result = ctl_get_list(s);
}
void F77_FUNC(ctlgetobject,CTLGETOBJECT)
(fortran_string identifier, int *length, object *result)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
*result = ctl_get_object(s);
}
void F77_FUNC(ctlgetvector3,CTLGETVECTOR3)
(fortran_string identifier, int *length, vector3 *result)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
*result = ctl_get_vector3(s);
}
/* ctl_get_string doesn't work perfectly--there
is no portable way to set the length of the Fortran string.
The length is returned in result_length. */
void F77_FUNC(ctlgetstring,CTLGETSTRING)
(fortran_string identifier, int *length,
fortran_string result, int *result_length)
{
char *r;
char *s = fcp2ccp(identifier); s[*length] = 0;
r = ctl_get_string(s);
strncpy(fcp2ccp(result), r, *result_length);
if (*result_length < strlen(r))
*result_length = strlen(r);
free(r);
}
/* Setters: */
void F77_FUNC(ctlsetnumber,CTLSETNUMBER)
(fortran_string identifier, int *length, number *value)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
ctl_set_number(s, *value);
}
void F77_FUNC(ctlsetinteger,CTLSETINTEGER)
(fortran_string identifier, int *length, integer *value)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
ctl_set_integer(s, *value);
}
void F77_FUNC(ctlsetboolean,CTLSETBOOLEAN)
(fortran_string identifier, int *length, boolean *value)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
ctl_set_boolean(s, *value);
}
void F77_FUNC(ctlsetlist,CTLSETLIST)
(fortran_string identifier, int *length, list *value)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
ctl_set_list(s, *value);
}
void F77_FUNC(ctlsetobject,CTLSETOBJECT)
(fortran_string identifier, int *length, object *value)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
ctl_set_object(s, *value);
}
void F77_FUNC(ctlsetvector3,CTLSETVECTOR3)
(fortran_string identifier, int *length, vector3 *value)
{
char *s = fcp2ccp(identifier); s[*length] = 0;
ctl_set_vector3(s, *value);
}
void F77_FUNC(ctlsetstring,CTLSETSTRING)
(fortran_string identifier, int *length,
fortran_string value, int *value_length)
{
char *s = fcp2ccp(identifier);
char *v = fcp2ccp(value);
s[*length] = 0;
v[*value_length] = 0;
ctl_set_string(s, v);
}
/**************************************************************************/
/* list traversal */
void F77_FUNC(listlength,LISTLENGTH)(list *l, int *len)
{
*len = list_length(*l);
}
void F77_FUNC(numberlistref,NUMBERLISTREF)
(list *l, int *index, number *value)
{
*value = number_list_ref(*l, *index);
}
void F77_FUNC(integerlistref,INTEGERLISTREF)
(list *l, int *index, integer *value)
{
*value = integer_list_ref(*l, *index);
}
void F77_FUNC(booleanlistref,BOOLEANLISTREF)
(list *l, int *index, boolean *value)
{
*value = boolean_list_ref(*l, *index);
}
void F77_FUNC(vector3listref,VECTOR3LISTREF)
(list *l, int *index, vector3 *value)
{
*value = vector3_list_ref(*l, *index);
}
void F77_FUNC(listlistref,LISTLISTREF)
(list *l, int *index, list *value)
{
*value = list_list_ref(*l, *index);
}
void F77_FUNC(objectlistref,OBJECTLISTREF)
(list *l, int *index, object *value)
{
*value = object_list_ref(*l, *index);
}
void F77_FUNC(stringlistref,STRINGLISTREF)
(list *l, int *index, fortran_string value, int *value_length)
{
char *v;
v = string_list_ref(*l, *index);
strncpy(fcp2ccp(value), v, *value_length);
if (*value_length < strlen(v))
*value_length = strlen(v);
free(v);
}
/**************************************************************************/
/* list creation */
void F77_FUNC(makenumberlist,MAKENUMBERLIST)
(int *num_items, number *items, list *result)
{
*result = make_number_list(*num_items, items);
}
void F77_FUNC(makeintegerlist,MAKEINTEGERLIST)
(int *num_items, integer *items, list *result)
{
*result = make_integer_list(*num_items, items);
}
void F77_FUNC(makebooleanlist,MAKEBOOLEANLIST)
(int *num_items, boolean *items, list *result)
{
*result = make_boolean_list(*num_items, items);
}
void F77_FUNC(makevector3list,MAKEVECTOR3LIST)
(int *num_items, vector3 *items, list *result)
{
*result = make_vector3_list(*num_items, items);
}
void F77_FUNC(makelistlist,MAKELISTLIST)
(int *num_items, list *items, list *result)
{
*result = make_list_list(*num_items, items);
}
void F77_FUNC(makeobjectlist,MAKEOBJECTLIST)
(int *num_items, object *items, list *result)
{
*result = make_object_list(*num_items, items);
}
/* make_string_list is not supported. Strings in Fortran suck. */
/**************************************************************************/
/* object properties */
void F77_FUNC(objectismember,OBJECTISMEMBER)
(fortran_string type_name, int *length, object *o, boolean *result)
{
char *s = fcp2ccp(type_name); s[*length] = 0;
*result = object_is_member(s,*o);
}
void F77_FUNC(numberobjectproperty,NUMBEROBJECTPROPERTY)
(object *o, fortran_string property_name, int *length, number *result)
{
char *s = fcp2ccp(property_name); s[*length] = 0;
*result = number_object_property(*o,s);
}
void F77_FUNC(integerobjectproperty,INTEGEROBJECTPROPERTY)
(object *o, fortran_string property_name, int *length, integer *result)
{
char *s = fcp2ccp(property_name); s[*length] = 0;
*result = integer_object_property(*o,s);
}
void F77_FUNC(booleanobjectproperty,BOOLEANOBJECTPROPERTY)
(object *o, fortran_string property_name, int *length, boolean *result)
{
char *s = fcp2ccp(property_name); s[*length] = 0;
*result = boolean_object_property(*o,s);
}
void F77_FUNC(vector3objectproperty,VECTOR3OBJECTPROPERTY)
(object *o, fortran_string property_name, int *length, vector3 *result)
{
char *s = fcp2ccp(property_name); s[*length] = 0;
*result = vector3_object_property(*o,s);
}
void F77_FUNC(listobjectproperty,LISTOBJECTPROPERTY)
(object *o, fortran_string property_name, int *length, list *result)
{
char *s = fcp2ccp(property_name); s[*length] = 0;
*result = list_object_property(*o,s);
}
void F77_FUNC(objectobjectproperty,OBJECTOBJECTPROPERTY)
(object *o, fortran_string property_name, int *length, object *result)
{
char *s = fcp2ccp(property_name); s[*length] = 0;
*result = object_object_property(*o,s);
}
void F77_FUNC(stringobjectproperty,STRINGOBJECTPROPERTY)
(object *o, fortran_string property_name, int *length,
fortran_string result, int *result_length)
{
char *r;
char *s = fcp2ccp(property_name); s[*length] = 0;
r = string_object_property(*o,s);
strncpy(fcp2ccp(result), r, *result_length);
if (*result_length < strlen(r))
*result_length = strlen(r);
free(r);
}
/**************************************************************************/
#endif /* F77_FUNC */
libctl-3.2.2/src/cintegrator.c 0000644 0001754 0000144 00000073151 12315325343 013174 0000000 0000000 #include "ctl.h"
#ifdef CTL_HAS_COMPLEX_INTEGRATION
/*
* Copyright (c) 2005 Steven G. Johnson
*
* Portions (see comments) based on HIntLib (also distributed under
* the GNU GPL, v2 or later), copyright (c) 2002-2005 Rudolf Schuerer.
* (http://www.cosy.sbg.ac.at/~rschuer/hintlib/)
*
* Portions (see comments) based on GNU GSL (also distributed under
* the GNU GPL, v2 or later), copyright (c) 1996-2000 Brian Gough.
* (http://www.gnu.org/software/gsl/)
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
*/
/* As integrator.c, but integrates complex-valued integrands */
#include
#include
#include
#include
#include
/* Adaptive multidimensional integration on hypercubes (or, really,
hyper-rectangles) using cubature rules.
A cubature rule takes a function and a hypercube and evaluates
the function at a small number of points, returning an estimate
of the integral as well as an estimate of the error, and also
a suggested dimension of the hypercube to subdivide.
Given such a rule, the adaptive integration is simple:
1) Evaluate the cubature rule on the hypercube(s).
Stop if converged.
2) Pick the hypercube with the largest estimated error,
and divide it in two along the suggested dimension.
3) Goto (1).
*/
/* numeric type for integrand */
#include
typedef complex double num;
#define num_abs cabs
typedef num (*integrand) (unsigned ndim, const double *x, void *);
/* Integrate the function f from xmin[dim] to xmax[dim], with at most
maxEval function evaluations (0 for no limit), until the given
absolute or relative error is achieved. val returns the integral,
and err returns the estimate for the absolute error in val. The
return value of the function is 0 on success and non-zero if there
was an error. */
static int adapt_integrate(integrand f, void *fdata,
unsigned dim, const double *xmin, const double *xmax,
unsigned maxEval,
double reqAbsError, double reqRelError,
num *val, double *err);
/***************************************************************************/
/* Basic datatypes */
typedef struct {
num val;
double err;
} esterr;
static double relError(esterr ee)
{
return (ee.val == 0.0 ? HUGE_VAL : num_abs(ee.err / ee.val));
}
typedef struct {
unsigned dim;
double *data; /* length 2*dim = center followed by half-widths */
double vol; /* cache volume = product of widths */
} hypercube;
static double compute_vol(const hypercube *h)
{
unsigned i;
double vol = 1;
for (i = 0; i < h->dim; ++i)
vol *= 2 * h->data[i + h->dim];
return vol;
}
static hypercube make_hypercube(unsigned dim, const double *center, const double *halfwidth)
{
unsigned i;
hypercube h;
h.dim = dim;
h.data = (double *) malloc(sizeof(double) * dim * 2);
for (i = 0; i < dim; ++i) {
h.data[i] = center[i];
h.data[i + dim] = halfwidth[i];
}
h.vol = compute_vol(&h);
return h;
}
static hypercube make_hypercube_range(unsigned dim, const double *xmin, const double *xmax)
{
hypercube h = make_hypercube(dim, xmin, xmax);
unsigned i;
for (i = 0; i < dim; ++i) {
h.data[i] = 0.5 * (xmin[i] + xmax[i]);
h.data[i + dim] = 0.5 * (xmax[i] - xmin[i]);
}
h.vol = compute_vol(&h);
return h;
}
static void destroy_hypercube(hypercube *h)
{
free(h->data);
h->dim = 0;
}
typedef struct {
hypercube h;
esterr ee;
unsigned splitDim;
} region;
static region make_region(const hypercube *h)
{
region R;
R.h = make_hypercube(h->dim, h->data, h->data + h->dim);
R.splitDim = 0;
return R;
}
static void destroy_region(region *R)
{
destroy_hypercube(&R->h);
}
static void cut_region(region *R, region *R2)
{
unsigned d = R->splitDim, dim = R->h.dim;
*R2 = *R;
R->h.data[d + dim] *= 0.5;
R->h.vol *= 0.5;
R2->h = make_hypercube(dim, R->h.data, R->h.data + dim);
R->h.data[d] -= R->h.data[d + dim];
R2->h.data[d] += R->h.data[d + dim];
}
typedef struct rule_s {
unsigned dim; /* the dimensionality */
unsigned num_points; /* number of evaluation points */
unsigned (*evalError)(struct rule_s *r, integrand f, void *fdata,
const hypercube *h, esterr *ee);
void (*destroy)(struct rule_s *r);
} rule;
static void destroy_rule(rule *r)
{
if (r->destroy) r->destroy(r);
free(r);
}
static region eval_region(region R, integrand f, void *fdata, rule *r)
{
R.splitDim = r->evalError(r, f, fdata, &R.h, &R.ee);
return R;
}
/***************************************************************************/
/* Functions to loop over points in a hypercube. */
/* Based on orbitrule.cpp in HIntLib-0.0.10 */
/* ls0 returns the least-significant 0 bit of n (e.g. it returns
0 if the LSB is 0, it returns 1 if the 2 LSBs are 01, etcetera). */
#if (defined(__GNUC__) || defined(__ICC)) && (defined(__i386__) || defined (__x86_64__))
/* use x86 bit-scan instruction, based on count_trailing_zeros()
macro in GNU GMP's longlong.h. */
static unsigned ls0(unsigned n)
{
unsigned count;
n = ~n;
__asm__("bsfl %1,%0": "=r"(count):"rm"(n));
return count;
}
#else
static unsigned ls0(unsigned n)
{
const unsigned bits[256] = {
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 5,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 6,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 5,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 7,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 5,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 6,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 5,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 8,
};
unsigned bit = 0;
while ((n & 0xff) == 0xff) {
n >>= 8;
bit += 8;
}
return bit + bits[n & 0xff];
}
#endif
/**
* Evaluate the integral on all 2^n points (+/-r,...+/-r)
*
* A Gray-code ordering is used to minimize the number of coordinate updates
* in p.
*/
static num evalR_Rfs(integrand f, void *fdata, unsigned dim, double *p, const double *c, const double *r)
{
num sum = 0;
unsigned i;
unsigned signs = 0; /* 0/1 bit = +/- for corresponding element of r[] */
/* We start with the point where r is ADDed in every coordinate
(this implies signs=0). */
for (i = 0; i < dim; ++i)
p[i] = c[i] + r[i];
/* Loop through the points in Gray-code ordering */
for (i = 0;; ++i) {
unsigned mask, d;
sum += f(dim, p, fdata);
d = ls0(i); /* which coordinate to flip */
if (d >= dim)
break;
/* flip the d-th bit and add/subtract r[d] */
mask = 1U << d;
signs ^= mask;
p[d] = (signs & mask) ? c[d] - r[d] : c[d] + r[d];
}
return sum;
}
static num evalRR0_0fs(integrand f, void *fdata, unsigned dim, double *p, const double *c, const double *r)
{
unsigned i, j;
num sum = 0;
for (i = 0; i < dim - 1; ++i) {
p[i] = c[i] - r[i];
for (j = i + 1; j < dim; ++j) {
p[j] = c[j] - r[j];
sum += f(dim, p, fdata);
p[i] = c[i] + r[i];
sum += f(dim, p, fdata);
p[j] = c[j] + r[j];
sum += f(dim, p, fdata);
p[i] = c[i] - r[i];
sum += f(dim, p, fdata);
p[j] = c[j]; /* Done with j -> Restore p[j] */
}
p[i] = c[i]; /* Done with i -> Restore p[i] */
}
return sum;
}
static unsigned evalR0_0fs4d(integrand f, void *fdata, unsigned dim, double *p, const double *c, num *sum0_, const double *r1, num *sum1_, const double *r2, num *sum2_)
{
double maxdiff = 0;
unsigned i, dimDiffMax = 0;
num sum0, sum1 = 0, sum2 = 0; /* copies for aliasing, performance */
double ratio = r1[0] / r2[0];
ratio *= ratio;
sum0 = f(dim, p, fdata);
for (i = 0; i < dim; i++) {
num f1a, f1b, f2a, f2b;
double diff;
p[i] = c[i] - r1[i];
sum1 += (f1a = f(dim, p, fdata));
p[i] = c[i] + r1[i];
sum1 += (f1b = f(dim, p, fdata));
p[i] = c[i] - r2[i];
sum2 += (f2a = f(dim, p, fdata));
p[i] = c[i] + r2[i];
sum2 += (f2b = f(dim, p, fdata));
p[i] = c[i];
diff = num_abs(f1a + f1b - 2 * sum0 - ratio * (f2a + f2b - 2 * sum0));
if (diff > maxdiff) {
maxdiff = diff;
dimDiffMax = i;
}
}
*sum0_ += sum0;
*sum1_ += sum1;
*sum2_ += sum2;
return dimDiffMax;
}
#define num0_0(dim) (1U)
#define numR0_0fs(dim) (2 * (dim))
#define numRR0_0fs(dim) (2 * (dim) * (dim-1))
#define numR_Rfs(dim) (1U << (dim))
/***************************************************************************/
/* Based on rule75genzmalik.cpp in HIntLib-0.0.10: An embedded
cubature rule of degree 7 (embedded rule degree 5) due to A. C. Genz
and A. A. Malik. See:
A. C. Genz and A. A. Malik, "An imbedded [sic] family of fully
symmetric numerical integration rules," SIAM
J. Numer. Anal. 20 (3), 580-588 (1983).
*/
typedef struct {
rule parent;
/* temporary arrays of length dim */
double *widthLambda, *widthLambda2, *p;
/* dimension-dependent constants */
double weight1, weight3, weight5;
double weightE1, weightE3;
} rule75genzmalik;
#define real(x) ((double)(x))
#define to_int(n) ((int)(n))
static int isqr(int x)
{
return x * x;
}
static void destroy_rule75genzmalik(rule *r_)
{
rule75genzmalik *r = (rule75genzmalik *) r_;
free(r->p);
}
static unsigned rule75genzmalik_evalError(rule *r_, integrand f, void *fdata, const hypercube *h, esterr *ee)
{
/* lambda2 = sqrt(9/70), lambda4 = sqrt(9/10), lambda5 = sqrt(9/19) */
const double lambda2 = 0.3585685828003180919906451539079374954541;
const double lambda4 = 0.9486832980505137995996680633298155601160;
const double lambda5 = 0.6882472016116852977216287342936235251269;
const double weight2 = 980. / 6561.;
const double weight4 = 200. / 19683.;
const double weightE2 = 245. / 486.;
const double weightE4 = 25. / 729.;
rule75genzmalik *r = (rule75genzmalik *) r_;
unsigned i, dimDiffMax, dim = r_->dim;
num sum1 = 0.0, sum2 = 0.0, sum3 = 0.0, sum4, sum5, result, res5th;
const double *center = h->data;
const double *halfwidth = h->data + dim;
for (i = 0; i < dim; ++i)
r->p[i] = center[i];
for (i = 0; i < dim; ++i)
r->widthLambda2[i] = halfwidth[i] * lambda2;
for (i = 0; i < dim; ++i)
r->widthLambda[i] = halfwidth[i] * lambda4;
/* Evaluate function in the center, in f(lambda2,0,...,0) and
f(lambda3=lambda4, 0,...,0). Estimate dimension with largest error */
dimDiffMax = evalR0_0fs4d(f, fdata, dim, r->p, center, &sum1, r->widthLambda2, &sum2, r->widthLambda, &sum3);
/* Calculate sum4 for f(lambda4, lambda4, 0, ...,0) */
sum4 = evalRR0_0fs(f, fdata, dim, r->p, center, r->widthLambda);
/* Calculate sum5 for f(lambda5, lambda5, ..., lambda5) */
for (i = 0; i < dim; ++i)
r->widthLambda[i] = halfwidth[i] * lambda5;
sum5 = evalR_Rfs(f, fdata, dim, r->p, center, r->widthLambda);
/* Calculate fifth and seventh order results */
result = h->vol * (r->weight1 * sum1 + weight2 * sum2 + r->weight3 * sum3 + weight4 * sum4 + r->weight5 * sum5);
res5th = h->vol * (r->weightE1 * sum1 + weightE2 * sum2 + r->weightE3 * sum3 + weightE4 * sum4);
ee->val = result;
ee->err = num_abs(res5th - result);
return dimDiffMax;
}
static rule *make_rule75genzmalik(unsigned dim)
{
rule75genzmalik *r;
if (dim < 2) return 0; /* this rule does not support 1d integrals */
/* Because of the use of a bit-field in evalR_Rfs, we are limited
to be < 32 dimensions (or however many bits are in unsigned).
This is not a practical limitation...long before you reach
32 dimensions, the Genz-Malik cubature becomes excruciatingly
slow and is superseded by other methods (e.g. Monte-Carlo). */
if (dim >= sizeof(unsigned) * 8) return 0;
r = (rule75genzmalik *) malloc(sizeof(rule75genzmalik));
r->parent.dim = dim;
r->weight1 = (real(12824 - 9120 * to_int(dim) + 400 * isqr(to_int(dim)))
/ real(19683));
r->weight3 = real(1820 - 400 * to_int(dim)) / real(19683);
r->weight5 = real(6859) / real(19683) / real(1U << dim);
r->weightE1 = (real(729 - 950 * to_int(dim) + 50 * isqr(to_int(dim)))
/ real(729));
r->weightE3 = real(265 - 100 * to_int(dim)) / real(1458);
r->p = (double *) malloc(sizeof(double) * dim * 3);
r->widthLambda = r->p + dim;
r->widthLambda2 = r->p + 2 * dim;
r->parent.num_points = num0_0(dim) + 2 * numR0_0fs(dim)
+ numRR0_0fs(dim) + numR_Rfs(dim);
r->parent.evalError = rule75genzmalik_evalError;
r->parent.destroy = destroy_rule75genzmalik;
return (rule *) r;
}
/***************************************************************************/
/* 1d 15-point Gaussian quadrature rule, based on qk15.c and qk.c in
GNU GSL (which in turn is based on QUADPACK). */
static unsigned rule15gauss_evalError(rule *r, integrand f, void *fdata,
const hypercube *h, esterr *ee)
{
/* Gauss quadrature weights and kronrod quadrature abscissae and
weights as evaluated with 80 decimal digit arithmetic by
L. W. Fullerton, Bell Labs, Nov. 1981. */
const unsigned n = 8;
const double xgk[8] = { /* abscissae of the 15-point kronrod rule */
0.991455371120812639206854697526329,
0.949107912342758524526189684047851,
0.864864423359769072789712788640926,
0.741531185599394439863864773280788,
0.586087235467691130294144838258730,
0.405845151377397166906606412076961,
0.207784955007898467600689403773245,
0.000000000000000000000000000000000
/* xgk[1], xgk[3], ... abscissae of the 7-point gauss rule.
xgk[0], xgk[2], ... to optimally extend the 7-point gauss rule */
};
static const double wg[4] = { /* weights of the 7-point gauss rule */
0.129484966168869693270611432679082,
0.279705391489276667901467771423780,
0.381830050505118944950369775488975,
0.417959183673469387755102040816327
};
static const double wgk[8] = { /* weights of the 15-point kronrod rule */
0.022935322010529224963732008058970,
0.063092092629978553290700663189204,
0.104790010322250183839876322541518,
0.140653259715525918745189590510238,
0.169004726639267902826583426598550,
0.190350578064785409913256402421014,
0.204432940075298892414161999234649,
0.209482141084727828012999174891714
};
const double center = h->data[0];
const double halfwidth = h->data[1];
double fv1[7], fv2[7];
const num f_center = f(1, ¢er, fdata);
num result_gauss = f_center * wg[n/2 - 1];
num result_kronrod = f_center * wgk[n - 1];
double result_abs = num_abs(result_kronrod);
num mean;
double result_asc, err;
unsigned j;
for (j = 0; j < (n - 1) / 2; ++j) {
int j2 = 2*j + 1;
double x, w = halfwidth * xgk[j2];
num f1, f2, fsum;
x = center - w; fv1[j2] = f1 = f(1, &x, fdata);
x = center + w; fv2[j2] = f2 = f(1, &x, fdata);
fsum = f1 + f2;
result_gauss += wg[j] * fsum;
result_kronrod += wgk[j2] * fsum;
result_abs += wgk[j2] * (num_abs(f1) + num_abs(f2));
}
for (j = 0; j < n/2; ++j) {
int j2 = 2*j;
double x, w = halfwidth * xgk[j2];
num f1, f2;
x = center - w; fv1[j2] = f1 = f(1, &x, fdata);
x = center + w; fv2[j2] = f2 = f(1, &x, fdata);
result_kronrod += wgk[j2] * (f1 + f2);
result_abs += wgk[j2] * (num_abs(f1) + num_abs(f2));
}
ee->val = result_kronrod * halfwidth;
/* compute error estimate: */
mean = result_kronrod * 0.5;
result_asc = wgk[n - 1] * num_abs(f_center - mean);
for (j = 0; j < n - 1; ++j)
result_asc += wgk[j] * (num_abs(fv1[j]-mean) + num_abs(fv2[j]-mean));
err = num_abs(result_kronrod - result_gauss) * halfwidth;
result_abs *= halfwidth;
result_asc *= halfwidth;
if (result_asc != 0 && err != 0) {
double scale = pow((200 * err / result_asc), 1.5);
if (scale < 1)
err = result_asc * scale;
else
err = result_asc;
}
if (result_abs > DBL_MIN / (50 * DBL_EPSILON)) {
double min_err = 50 * DBL_EPSILON * result_abs;
if (min_err > err)
err = min_err;
}
ee->err = err;
return 0; /* no choice but to divide 0th dimension */
}
static rule *make_rule15gauss(unsigned dim)
{
rule *r;
if (dim != 1) return 0; /* this rule is only for 1d integrals */
r = (rule *) malloc(sizeof(rule));
r->dim = dim;
r->num_points = 15;
r->evalError = rule15gauss_evalError;
r->destroy = 0;
return r;
}
/***************************************************************************/
/* binary heap implementation (ala _Introduction to Algorithms_ by
Cormen, Leiserson, and Rivest), for use as a priority queue of
regions to integrate. */
typedef region heap_item;
#define KEY(hi) ((hi).ee.err)
typedef struct {
unsigned n, nalloc;
heap_item *items;
esterr ee;
} heap;
static void heap_resize(heap *h, unsigned nalloc)
{
h->nalloc = nalloc;
h->items = (heap_item *) realloc(h->items, sizeof(heap_item) * nalloc);
}
static heap heap_alloc(unsigned nalloc)
{
heap h;
h.n = 0;
h.nalloc = 0;
h.items = 0;
h.ee.val = h.ee.err = 0;
heap_resize(&h, nalloc);
return h;
}
/* note that heap_free does not deallocate anything referenced by the items */
static void heap_free(heap *h)
{
h->n = 0;
heap_resize(h, 0);
}
static void heap_push(heap *h, heap_item hi)
{
int insert;
h->ee.val += hi.ee.val;
h->ee.err += hi.ee.err;
insert = h->n;
if (++(h->n) > h->nalloc)
heap_resize(h, h->n * 2);
while (insert) {
int parent = (insert - 1) / 2;
if (KEY(hi) <= KEY(h->items[parent]))
break;
h->items[insert] = h->items[parent];
insert = parent;
}
h->items[insert] = hi;
}
static heap_item heap_pop(heap *h)
{
heap_item ret;
int i, n, child;
if (!(h->n)) {
fprintf(stderr, "attempted to pop an empty heap\n");
exit(EXIT_FAILURE);
}
ret = h->items[0];
h->items[i = 0] = h->items[n = --(h->n)];
while ((child = i * 2 + 1) < n) {
int largest;
heap_item swap;
if (KEY(h->items[child]) <= KEY(h->items[i]))
largest = i;
else
largest = child;
if (++child < n && KEY(h->items[largest]) < KEY(h->items[child]))
largest = child;
if (largest == i)
break;
swap = h->items[i];
h->items[i] = h->items[largest];
h->items[i = largest] = swap;
}
h->ee.val -= ret.ee.val;
h->ee.err -= ret.ee.err;
return ret;
}
/***************************************************************************/
/* adaptive integration, analogous to adaptintegrator.cpp in HIntLib */
static int ruleadapt_integrate(rule *r, integrand f, void *fdata, const hypercube *h, unsigned maxEval, double reqAbsError, double reqRelError, esterr *ee)
{
unsigned maxIter; /* maximum number of adaptive subdivisions */
heap regions;
unsigned i;
int status = -1; /* = ERROR */
if (maxEval) {
if (r->num_points > maxEval)
return status; /* ERROR */
maxIter = (maxEval - r->num_points) / (2 * r->num_points);
}
else
maxIter = UINT_MAX;
regions = heap_alloc(1);
heap_push(®ions, eval_region(make_region(h), f, fdata, r));
/* another possibility is to specify some non-adaptive subdivisions:
if (initialRegions != 1)
partition(h, initialRegions, EQUIDISTANT, ®ions, f,fdata, r); */
for (i = 0; i < maxIter; ++i) {
region R, R2;
if (regions.ee.err <= reqAbsError
|| relError(regions.ee) <= reqRelError) {
status = 0; /* converged! */
break;
}
R = heap_pop(®ions); /* get worst region */
cut_region(&R, &R2);
heap_push(®ions, eval_region(R, f, fdata, r));
heap_push(®ions, eval_region(R2, f, fdata, r));
}
ee->val = ee->err = 0; /* re-sum integral and errors */
for (i = 0; i < regions.n; ++i) {
ee->val += regions.items[i].ee.val;
ee->err += regions.items[i].ee.err;
destroy_region(®ions.items[i]);
}
/* printf("regions.nalloc = %d\n", regions.nalloc); */
heap_free(®ions);
return status;
}
static int adapt_integrate(integrand f, void *fdata,
unsigned dim, const double *xmin, const double *xmax,
unsigned maxEval, double reqAbsError, double reqRelError,
num *val, double *err)
{
rule *r;
hypercube h;
esterr ee;
int status;
if (dim == 0) { /* trivial integration */
*val = f(0, xmin, fdata);
*err = 0;
return 0;
}
r = dim == 1 ? make_rule15gauss(dim) : make_rule75genzmalik(dim);
if (!r) { *val = 0; *err = HUGE_VAL; return -2; /* ERROR */ }
h = make_hypercube_range(dim, xmin, xmax);
status = ruleadapt_integrate(r, f, fdata, &h,
maxEval, reqAbsError, reqRelError,
&ee);
*val = ee.val;
*err = ee.err;
destroy_hypercube(&h);
destroy_rule(r);
return status;
}
/***************************************************************************/
/* Compile with -DTEST_INTEGRATOR for a self-contained test program.
Usage: ./integrator
where = # dimensions, = relative tolerance,
is either 0/1/2 for the three test integrands (see below),
and is the maximum # function evaluations (0 for none).
*/
#ifdef TEST_INTEGRATOR
int count = 0;
int which_integrand = 0;
const double radius = 0.50124145262344534123412; /* random */
/* Simple constant function */
num
fconst (double x[], size_t dim, void *params)
{
return 1;
}
/*** f0, f1, f2, and f3 are test functions from the Monte-Carlo
integration routines in GSL 1.6 (monte/test.c). Copyright (c)
1996-2000 Michael Booth, GNU GPL. ****/
/* Simple product function */
num f0 (unsigned dim, const double *x, void *params)
{
double prod = 1.0;
unsigned int i;
for (i = 0; i < dim; ++i)
prod *= 2.0 * x[i];
return prod;
}
/* Gaussian centered at 1/2. */
num f1 (unsigned dim, const double *x, void *params)
{
double a = *(double *)params;
double sum = 0.;
unsigned int i;
for (i = 0; i < dim; i++) {
double dx = x[i] - 0.5;
sum += dx * dx;
}
return (pow (M_2_SQRTPI / (2. * a), (double) dim) *
exp (-sum / (a * a)));
}
/* double gaussian */
num f2 (unsigned dim, const double *x, void *params)
{
double a = *(double *)params;
double sum1 = 0.;
double sum2 = 0.;
unsigned int i;
for (i = 0; i < dim; i++) {
double dx1 = x[i] - 1. / 3.;
double dx2 = x[i] - 2. / 3.;
sum1 += dx1 * dx1;
sum2 += dx2 * dx2;
}
return 0.5 * pow (M_2_SQRTPI / (2. * a), dim)
* (exp (-sum1 / (a * a)) + exp (-sum2 / (a * a)));
}
/* Tsuda's example */
num f3 (unsigned dim, const double *x, void *params)
{
double c = *(double *)params;
double prod = 1.;
unsigned int i;
for (i = 0; i < dim; i++)
prod *= c / (c + 1) * pow((c + 1) / (c + x[i]), 2.0);
return prod;
}
/*** end of GSL test functions ***/
num f_test(unsigned dim, const double *x, void *data)
{
double val;
unsigned i;
++count;
switch (which_integrand) {
case 0: /* simple smooth (separable) objective: prod. cos(x[i]). */
val = 1;
for (i = 0; i < dim; ++i)
val *= cos(x[i]);
break;
case 1: { /* integral of exp(-x^2), rescaled to (0,infinity) limits */
double scale = 1.0;
val = 0;
for (i = 0; i < dim; ++i) {
double z = (1 - x[i]) / x[i];
val += z * z;
scale *= M_2_SQRTPI / (x[i] * x[i]);
}
val = exp(-val) * scale;
break;
}
case 2: /* discontinuous objective: volume of hypersphere */
val = 0;
for (i = 0; i < dim; ++i)
val += x[i] * x[i];
val = val < radius * radius;
break;
case 3:
val = f0(dim, x, data);
break;
case 4:
val = f1(dim, x, data);
break;
case 5:
val = f2(dim, x, data);
break;
case 6:
val = f3(dim, x, data);
break;
default:
fprintf(stderr, "unknown integrand %d\n", which_integrand);
exit(EXIT_FAILURE);
}
/* if (count < 100) printf("%d: f(%g, ...) = %g\n", count, x[0], val); */
return val;
}
/* surface area of n-dimensional unit hypersphere */
static double S(unsigned n)
{
double val;
int fact = 1;
if (n % 2 == 0) { /* n even */
val = 2 * pow(M_PI, n * 0.5);
n = n / 2;
while (n > 1) fact *= (n -= 1);
val /= fact;
}
else { /* n odd */
val = (1 << (n/2 + 1)) * pow(M_PI, n/2);
while (n > 2) fact *= (n -= 2);
val /= fact;
}
return val;
}
static num exact_integral(unsigned dim, const double *xmax) {
unsigned i;
double val;
switch(which_integrand) {
case 0:
val = 1;
for (i = 0; i < dim; ++i)
val *= sin(xmax[i]);
break;
case 2:
val = dim == 0 ? 1 : S(dim) * pow(radius * 0.5, dim) / dim;
break;
default:
val = 1.0;
}
return val;
}
int main(int argc, char **argv)
{
double *xmin, *xmax;
double tol, err;
num val;
unsigned i, dim, maxEval;
double fdata;
dim = argc > 1 ? atoi(argv[1]) : 2;
tol = argc > 2 ? atof(argv[2]) : 1e-2;
which_integrand = argc > 3 ? atoi(argv[3]) : 0;
maxEval = argc > 4 ? atoi(argv[4]) : 0;
fdata = which_integrand == 6 ? (1.0 + sqrt (10.0)) / 9.0 : 0.1;
xmin = (double *) malloc(dim * sizeof(double));
xmax = (double *) malloc(dim * sizeof(double));
for (i = 0; i < dim; ++i) {
xmin[i] = 0;
xmax[i] = 1 + (which_integrand >= 1 ? 0 : 0.4 * sin(i));
}
printf("%u-dim integral, tolerance = %g, integrand = %d\n",
dim, tol, which_integrand);
adapt_integrate(f_test, &fdata,
dim, xmin, xmax,
maxEval, 0, tol, &val, &err);
printf("integration val = %g, est. err = %g, true err = %g\n",
val, err, num_abs(val - exact_integral(dim, xmax)));
printf("#evals = %d\n", count);
free(xmax);
free(xmin);
return 0;
}
#else
/*************************************************************************/
/* libctl interface */
static int adapt_integrate(integrand f, void *fdata,
unsigned dim, const double *xmin, const double *xmax,
unsigned maxEval,
double reqAbsError, double reqRelError,
num *val, double *err);
typedef struct {
cmultivar_func f;
void *fdata;
} cnum_wrap_data;
static num cnum_wrap(unsigned ndim, const double *x, void *fdata_)
{
cnum_wrap_data *fdata = (cnum_wrap_data *) fdata_;
cnumber val = fdata->f(ndim, (double *) x, fdata->fdata);
return (cnumber_re(val) + I*cnumber_im(val));
}
cnumber cadaptive_integration(cmultivar_func f, number *xmin, number *xmax,
integer n, void *fdata,
number abstol, number reltol, integer maxnfe,
number *esterr, integer *errflag)
{
num val;
cnum_wrap_data wdata;
wdata.f = f; wdata.fdata = fdata;
*errflag = adapt_integrate(cnum_wrap, &wdata, n, xmin, xmax,
maxnfe, abstol, reltol, &val, esterr);
return make_cnumber(creal(val), cimag(val));
}
static cnumber cf_scm_wrapper(integer n, number *x, void *f_scm_p)
{
SCM *f_scm = (SCM *) f_scm_p;
return scm2cnumber(gh_call1(*f_scm, make_number_list(n, x)));
}
SCM cadaptive_integration_scm(SCM f_scm, SCM xmin_scm, SCM xmax_scm,
SCM abstol_scm, SCM reltol_scm, SCM maxnfe_scm)
{
integer n, maxnfe, errflag, i;
number *xmin, *xmax, abstol, reltol;
cnumber integral;
n = list_length(xmin_scm);
abstol = fabs(ctl_convert_number_to_c(abstol_scm));
reltol = fabs(ctl_convert_number_to_c(reltol_scm));
maxnfe = ctl_convert_integer_to_c(maxnfe_scm);
if (list_length(xmax_scm) != n) {
fprintf(stderr, "adaptive_integration: xmin/xmax dimension mismatch\n");
return SCM_UNDEFINED;
}
xmin = (number*) malloc(sizeof(number) * n);
xmax = (number*) malloc(sizeof(number) * n);
if (!xmin || !xmax) {
fprintf(stderr, "adaptive_integration: error, out of memory!\n");
exit(EXIT_FAILURE);
}
for (i = 0; i < n; ++i) {
xmin[i] = number_list_ref(xmin_scm, i);
xmax[i] = number_list_ref(xmax_scm, i);
}
integral = cadaptive_integration(cf_scm_wrapper, xmin, xmax, n, &f_scm,
abstol, reltol, maxnfe,
&abstol, &errflag);
free(xmax);
free(xmin);
switch (errflag) {
case 3:
fprintf(stderr, "adaptive_integration: invalid inputs\n");
return SCM_UNDEFINED;
case 1:
fprintf(stderr, "adaptive_integration: maxnfe too small\n");
break;
case 2:
fprintf(stderr, "adaptive_integration: lenwork too small\n");
break;
}
return gh_cons(cnumber2scm(integral), ctl_convert_number_to_scm(abstol));
}
#endif
#endif /* CTL_HAS_COMPLEX_INTEGRATION */
libctl-3.2.2/src/integrator.c 0000644 0001754 0000144 00000071542 12315325343 013033 0000000 0000000 /*
* Copyright (c) 2005 Steven G. Johnson
*
* Portions (see comments) based on HIntLib (also distributed under
* the GNU GPL, v2 or later), copyright (c) 2002-2005 Rudolf Schuerer.
* (http://www.cosy.sbg.ac.at/~rschuer/hintlib/)
*
* Portions (see comments) based on GNU GSL (also distributed under
* the GNU GPL, v2 or later), copyright (c) 1996-2000 Brian Gough.
* (http://www.gnu.org/software/gsl/)
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
*/
#include
#include
#include
#include
#include
/* Adaptive multidimensional integration on hypercubes (or, really,
hyper-rectangles) using cubature rules.
A cubature rule takes a function and a hypercube and evaluates
the function at a small number of points, returning an estimate
of the integral as well as an estimate of the error, and also
a suggested dimension of the hypercube to subdivide.
Given such a rule, the adaptive integration is simple:
1) Evaluate the cubature rule on the hypercube(s).
Stop if converged.
2) Pick the hypercube with the largest estimated error,
and divide it in two along the suggested dimension.
3) Goto (1).
*/
typedef double (*integrand) (unsigned ndim, const double *x, void *);
/* Integrate the function f from xmin[dim] to xmax[dim], with at most
maxEval function evaluations (0 for no limit), until the given
absolute or relative error is achieved. val returns the integral,
and err returns the estimate for the absolute error in val. The
return value of the function is 0 on success and non-zero if there
was an error. */
static int adapt_integrate(integrand f, void *fdata,
unsigned dim, const double *xmin, const double *xmax,
unsigned maxEval,
double reqAbsError, double reqRelError,
double *val, double *err);
/***************************************************************************/
/* Basic datatypes */
typedef struct {
double val, err;
} esterr;
static double relError(esterr ee)
{
return (ee.val == 0.0 ? HUGE_VAL : fabs(ee.err / ee.val));
}
typedef struct {
unsigned dim;
double *data; /* length 2*dim = center followed by half-widths */
double vol; /* cache volume = product of widths */
} hypercube;
static double compute_vol(const hypercube *h)
{
unsigned i;
double vol = 1;
for (i = 0; i < h->dim; ++i)
vol *= 2 * h->data[i + h->dim];
return vol;
}
static hypercube make_hypercube(unsigned dim, const double *center, const double *halfwidth)
{
unsigned i;
hypercube h;
h.dim = dim;
h.data = (double *) malloc(sizeof(double) * dim * 2);
for (i = 0; i < dim; ++i) {
h.data[i] = center[i];
h.data[i + dim] = halfwidth[i];
}
h.vol = compute_vol(&h);
return h;
}
static hypercube make_hypercube_range(unsigned dim, const double *xmin, const double *xmax)
{
hypercube h = make_hypercube(dim, xmin, xmax);
unsigned i;
for (i = 0; i < dim; ++i) {
h.data[i] = 0.5 * (xmin[i] + xmax[i]);
h.data[i + dim] = 0.5 * (xmax[i] - xmin[i]);
}
h.vol = compute_vol(&h);
return h;
}
static void destroy_hypercube(hypercube *h)
{
free(h->data);
h->dim = 0;
}
typedef struct {
hypercube h;
esterr ee;
unsigned splitDim;
} region;
static region make_region(const hypercube *h)
{
region R;
R.h = make_hypercube(h->dim, h->data, h->data + h->dim);
R.splitDim = 0;
return R;
}
static void destroy_region(region *R)
{
destroy_hypercube(&R->h);
}
static void cut_region(region *R, region *R2)
{
unsigned d = R->splitDim, dim = R->h.dim;
*R2 = *R;
R->h.data[d + dim] *= 0.5;
R->h.vol *= 0.5;
R2->h = make_hypercube(dim, R->h.data, R->h.data + dim);
R->h.data[d] -= R->h.data[d + dim];
R2->h.data[d] += R->h.data[d + dim];
}
typedef struct rule_s {
unsigned dim; /* the dimensionality */
unsigned num_points; /* number of evaluation points */
unsigned (*evalError)(struct rule_s *r, integrand f, void *fdata,
const hypercube *h, esterr *ee);
void (*destroy)(struct rule_s *r);
} rule;
static void destroy_rule(rule *r)
{
if (r->destroy) r->destroy(r);
free(r);
}
static region eval_region(region R, integrand f, void *fdata, rule *r)
{
R.splitDim = r->evalError(r, f, fdata, &R.h, &R.ee);
return R;
}
/***************************************************************************/
/* Functions to loop over points in a hypercube. */
/* Based on orbitrule.cpp in HIntLib-0.0.10 */
/* ls0 returns the least-significant 0 bit of n (e.g. it returns
0 if the LSB is 0, it returns 1 if the 2 LSBs are 01, etcetera). */
#if (defined(__GNUC__) || defined(__ICC)) && (defined(__i386__) || defined (__x86_64__))
/* use x86 bit-scan instruction, based on count_trailing_zeros()
macro in GNU GMP's longlong.h. */
static unsigned ls0(unsigned n)
{
unsigned count;
n = ~n;
__asm__("bsfl %1,%0": "=r"(count):"rm"(n));
return count;
}
#else
static unsigned ls0(unsigned n)
{
const unsigned bits[256] = {
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 5,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 6,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 5,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 7,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 5,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 6,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 5,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 4,
0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0, 8,
};
unsigned bit = 0;
while ((n & 0xff) == 0xff) {
n >>= 8;
bit += 8;
}
return bit + bits[n & 0xff];
}
#endif
/**
* Evaluate the integral on all 2^n points (+/-r,...+/-r)
*
* A Gray-code ordering is used to minimize the number of coordinate updates
* in p.
*/
static double evalR_Rfs(integrand f, void *fdata, unsigned dim, double *p, const double *c, const double *r)
{
double sum = 0;
unsigned i;
unsigned signs = 0; /* 0/1 bit = +/- for corresponding element of r[] */
/* We start with the point where r is ADDed in every coordinate
(this implies signs=0). */
for (i = 0; i < dim; ++i)
p[i] = c[i] + r[i];
/* Loop through the points in Gray-code ordering */
for (i = 0;; ++i) {
unsigned mask, d;
sum += f(dim, p, fdata);
d = ls0(i); /* which coordinate to flip */
if (d >= dim)
break;
/* flip the d-th bit and add/subtract r[d] */
mask = 1U << d;
signs ^= mask;
p[d] = (signs & mask) ? c[d] - r[d] : c[d] + r[d];
}
return sum;
}
static double evalRR0_0fs(integrand f, void *fdata, unsigned dim, double *p, const double *c, const double *r)
{
unsigned i, j;
double sum = 0;
for (i = 0; i < dim - 1; ++i) {
p[i] = c[i] - r[i];
for (j = i + 1; j < dim; ++j) {
p[j] = c[j] - r[j];
sum += f(dim, p, fdata);
p[i] = c[i] + r[i];
sum += f(dim, p, fdata);
p[j] = c[j] + r[j];
sum += f(dim, p, fdata);
p[i] = c[i] - r[i];
sum += f(dim, p, fdata);
p[j] = c[j]; /* Done with j -> Restore p[j] */
}
p[i] = c[i]; /* Done with i -> Restore p[i] */
}
return sum;
}
static unsigned evalR0_0fs4d(integrand f, void *fdata, unsigned dim, double *p, const double *c, double *sum0_, const double *r1, double *sum1_, const double *r2, double *sum2_)
{
double maxdiff = 0;
unsigned i, dimDiffMax = 0;
double sum0, sum1 = 0, sum2 = 0; /* copies for aliasing, performance */
double ratio = r1[0] / r2[0];
ratio *= ratio;
sum0 = f(dim, p, fdata);
for (i = 0; i < dim; i++) {
double f1a, f1b, f2a, f2b, diff;
p[i] = c[i] - r1[i];
sum1 += (f1a = f(dim, p, fdata));
p[i] = c[i] + r1[i];
sum1 += (f1b = f(dim, p, fdata));
p[i] = c[i] - r2[i];
sum2 += (f2a = f(dim, p, fdata));
p[i] = c[i] + r2[i];
sum2 += (f2b = f(dim, p, fdata));
p[i] = c[i];
diff = fabs(f1a + f1b - 2 * sum0 - ratio * (f2a + f2b - 2 * sum0));
if (diff > maxdiff) {
maxdiff = diff;
dimDiffMax = i;
}
}
*sum0_ += sum0;
*sum1_ += sum1;
*sum2_ += sum2;
return dimDiffMax;
}
#define num0_0(dim) (1U)
#define numR0_0fs(dim) (2 * (dim))
#define numRR0_0fs(dim) (2 * (dim) * (dim-1))
#define numR_Rfs(dim) (1U << (dim))
/***************************************************************************/
/* Based on rule75genzmalik.cpp in HIntLib-0.0.10: An embedded
cubature rule of degree 7 (embedded rule degree 5) due to A. C. Genz
and A. A. Malik. See:
A. C. Genz and A. A. Malik, "An imbedded [sic] family of fully
symmetric numerical integration rules," SIAM
J. Numer. Anal. 20 (3), 580-588 (1983).
*/
typedef struct {
rule parent;
/* temporary arrays of length dim */
double *widthLambda, *widthLambda2, *p;
/* dimension-dependent constants */
double weight1, weight3, weight5;
double weightE1, weightE3;
} rule75genzmalik;
#define real(x) ((double)(x))
#define to_int(n) ((int)(n))
static int isqr(int x)
{
return x * x;
}
static void destroy_rule75genzmalik(rule *r_)
{
rule75genzmalik *r = (rule75genzmalik *) r_;
free(r->p);
}
static unsigned rule75genzmalik_evalError(rule *r_, integrand f, void *fdata, const hypercube *h, esterr *ee)
{
/* lambda2 = sqrt(9/70), lambda4 = sqrt(9/10), lambda5 = sqrt(9/19) */
const double lambda2 = 0.3585685828003180919906451539079374954541;
const double lambda4 = 0.9486832980505137995996680633298155601160;
const double lambda5 = 0.6882472016116852977216287342936235251269;
const double weight2 = 980. / 6561.;
const double weight4 = 200. / 19683.;
const double weightE2 = 245. / 486.;
const double weightE4 = 25. / 729.;
rule75genzmalik *r = (rule75genzmalik *) r_;
unsigned i, dimDiffMax, dim = r_->dim;
double sum1 = 0.0, sum2 = 0.0, sum3 = 0.0, sum4, sum5, result, res5th;
const double *center = h->data;
const double *halfwidth = h->data + dim;
for (i = 0; i < dim; ++i)
r->p[i] = center[i];
for (i = 0; i < dim; ++i)
r->widthLambda2[i] = halfwidth[i] * lambda2;
for (i = 0; i < dim; ++i)
r->widthLambda[i] = halfwidth[i] * lambda4;
/* Evaluate function in the center, in f(lambda2,0,...,0) and
f(lambda3=lambda4, 0,...,0). Estimate dimension with largest error */
dimDiffMax = evalR0_0fs4d(f, fdata, dim, r->p, center, &sum1, r->widthLambda2, &sum2, r->widthLambda, &sum3);
/* Calculate sum4 for f(lambda4, lambda4, 0, ...,0) */
sum4 = evalRR0_0fs(f, fdata, dim, r->p, center, r->widthLambda);
/* Calculate sum5 for f(lambda5, lambda5, ..., lambda5) */
for (i = 0; i < dim; ++i)
r->widthLambda[i] = halfwidth[i] * lambda5;
sum5 = evalR_Rfs(f, fdata, dim, r->p, center, r->widthLambda);
/* Calculate fifth and seventh order results */
result = h->vol * (r->weight1 * sum1 + weight2 * sum2 + r->weight3 * sum3 + weight4 * sum4 + r->weight5 * sum5);
res5th = h->vol * (r->weightE1 * sum1 + weightE2 * sum2 + r->weightE3 * sum3 + weightE4 * sum4);
ee->val = result;
ee->err = fabs(res5th - result);
return dimDiffMax;
}
static rule *make_rule75genzmalik(unsigned dim)
{
rule75genzmalik *r;
if (dim < 2) return 0; /* this rule does not support 1d integrals */
/* Because of the use of a bit-field in evalR_Rfs, we are limited
to be < 32 dimensions (or however many bits are in unsigned).
This is not a practical limitation...long before you reach
32 dimensions, the Genz-Malik cubature becomes excruciatingly
slow and is superseded by other methods (e.g. Monte-Carlo). */
if (dim >= sizeof(unsigned) * 8) return 0;
r = (rule75genzmalik *) malloc(sizeof(rule75genzmalik));
r->parent.dim = dim;
r->weight1 = (real(12824 - 9120 * to_int(dim) + 400 * isqr(to_int(dim)))
/ real(19683));
r->weight3 = real(1820 - 400 * to_int(dim)) / real(19683);
r->weight5 = real(6859) / real(19683) / real(1U << dim);
r->weightE1 = (real(729 - 950 * to_int(dim) + 50 * isqr(to_int(dim)))
/ real(729));
r->weightE3 = real(265 - 100 * to_int(dim)) / real(1458);
r->p = (double *) malloc(sizeof(double) * dim * 3);
r->widthLambda = r->p + dim;
r->widthLambda2 = r->p + 2 * dim;
r->parent.num_points = num0_0(dim) + 2 * numR0_0fs(dim)
+ numRR0_0fs(dim) + numR_Rfs(dim);
r->parent.evalError = rule75genzmalik_evalError;
r->parent.destroy = destroy_rule75genzmalik;
return (rule *) r;
}
/***************************************************************************/
/* 1d 15-point Gaussian quadrature rule, based on qk15.c and qk.c in
GNU GSL (which in turn is based on QUADPACK). */
static unsigned rule15gauss_evalError(rule *r, integrand f, void *fdata,
const hypercube *h, esterr *ee)
{
/* Gauss quadrature weights and kronrod quadrature abscissae and
weights as evaluated with 80 decimal digit arithmetic by
L. W. Fullerton, Bell Labs, Nov. 1981. */
const unsigned n = 8;
const double xgk[8] = { /* abscissae of the 15-point kronrod rule */
0.991455371120812639206854697526329,
0.949107912342758524526189684047851,
0.864864423359769072789712788640926,
0.741531185599394439863864773280788,
0.586087235467691130294144838258730,
0.405845151377397166906606412076961,
0.207784955007898467600689403773245,
0.000000000000000000000000000000000
/* xgk[1], xgk[3], ... abscissae of the 7-point gauss rule.
xgk[0], xgk[2], ... to optimally extend the 7-point gauss rule */
};
static const double wg[4] = { /* weights of the 7-point gauss rule */
0.129484966168869693270611432679082,
0.279705391489276667901467771423780,
0.381830050505118944950369775488975,
0.417959183673469387755102040816327
};
static const double wgk[8] = { /* weights of the 15-point kronrod rule */
0.022935322010529224963732008058970,
0.063092092629978553290700663189204,
0.104790010322250183839876322541518,
0.140653259715525918745189590510238,
0.169004726639267902826583426598550,
0.190350578064785409913256402421014,
0.204432940075298892414161999234649,
0.209482141084727828012999174891714
};
const double center = h->data[0];
const double halfwidth = h->data[1];
double fv1[7], fv2[7];
const double f_center = f(1, ¢er, fdata);
double result_gauss = f_center * wg[n/2 - 1];
double result_kronrod = f_center * wgk[n - 1];
double result_abs = fabs(result_kronrod);
double result_asc, mean, err;
unsigned j;
for (j = 0; j < (n - 1) / 2; ++j) {
int j2 = 2*j + 1;
double x, f1, f2, fsum, w = halfwidth * xgk[j2];
x = center - w; fv1[j2] = f1 = f(1, &x, fdata);
x = center + w; fv2[j2] = f2 = f(1, &x, fdata);
fsum = f1 + f2;
result_gauss += wg[j] * fsum;
result_kronrod += wgk[j2] * fsum;
result_abs += wgk[j2] * (fabs(f1) + fabs(f2));
}
for (j = 0; j < n/2; ++j) {
int j2 = 2*j;
double x, f1, f2, w = halfwidth * xgk[j2];
x = center - w; fv1[j2] = f1 = f(1, &x, fdata);
x = center + w; fv2[j2] = f2 = f(1, &x, fdata);
result_kronrod += wgk[j2] * (f1 + f2);
result_abs += wgk[j2] * (fabs(f1) + fabs(f2));
}
ee->val = result_kronrod * halfwidth;
/* compute error estimate: */
mean = result_kronrod * 0.5;
result_asc = wgk[n - 1] * fabs(f_center - mean);
for (j = 0; j < n - 1; ++j)
result_asc += wgk[j] * (fabs(fv1[j]-mean) + fabs(fv2[j]-mean));
err = fabs(result_kronrod - result_gauss) * halfwidth;
result_abs *= halfwidth;
result_asc *= halfwidth;
if (result_asc != 0 && err != 0) {
double scale = pow((200 * err / result_asc), 1.5);
if (scale < 1)
err = result_asc * scale;
else
err = result_asc;
}
if (result_abs > DBL_MIN / (50 * DBL_EPSILON)) {
double min_err = 50 * DBL_EPSILON * result_abs;
if (min_err > err)
err = min_err;
}
ee->err = err;
return 0; /* no choice but to divide 0th dimension */
}
static rule *make_rule15gauss(unsigned dim)
{
rule *r;
if (dim != 1) return 0; /* this rule is only for 1d integrals */
r = (rule *) malloc(sizeof(rule));
r->dim = dim;
r->num_points = 15;
r->evalError = rule15gauss_evalError;
r->destroy = 0;
return r;
}
/***************************************************************************/
/* binary heap implementation (ala _Introduction to Algorithms_ by
Cormen, Leiserson, and Rivest), for use as a priority queue of
regions to integrate. */
typedef region heap_item;
#define KEY(hi) ((hi).ee.err)
typedef struct {
unsigned n, nalloc;
heap_item *items;
esterr ee;
} heap;
static void heap_resize(heap *h, unsigned nalloc)
{
h->nalloc = nalloc;
h->items = (heap_item *) realloc(h->items, sizeof(heap_item) * nalloc);
}
static heap heap_alloc(unsigned nalloc)
{
heap h;
h.n = 0;
h.nalloc = 0;
h.items = 0;
h.ee.val = h.ee.err = 0;
heap_resize(&h, nalloc);
return h;
}
/* note that heap_free does not deallocate anything referenced by the items */
static void heap_free(heap *h)
{
h->n = 0;
heap_resize(h, 0);
}
static void heap_push(heap *h, heap_item hi)
{
int insert;
h->ee.val += hi.ee.val;
h->ee.err += hi.ee.err;
insert = h->n;
if (++(h->n) > h->nalloc)
heap_resize(h, h->n * 2);
while (insert) {
int parent = (insert - 1) / 2;
if (KEY(hi) <= KEY(h->items[parent]))
break;
h->items[insert] = h->items[parent];
insert = parent;
}
h->items[insert] = hi;
}
static heap_item heap_pop(heap *h)
{
heap_item ret;
int i, n, child;
if (!(h->n)) {
fprintf(stderr, "attempted to pop an empty heap\n");
exit(EXIT_FAILURE);
}
ret = h->items[0];
h->items[i = 0] = h->items[n = --(h->n)];
while ((child = i * 2 + 1) < n) {
int largest;
heap_item swap;
if (KEY(h->items[child]) <= KEY(h->items[i]))
largest = i;
else
largest = child;
if (++child < n && KEY(h->items[largest]) < KEY(h->items[child]))
largest = child;
if (largest == i)
break;
swap = h->items[i];
h->items[i] = h->items[largest];
h->items[i = largest] = swap;
}
h->ee.val -= ret.ee.val;
h->ee.err -= ret.ee.err;
return ret;
}
/***************************************************************************/
/* adaptive integration, analogous to adaptintegrator.cpp in HIntLib */
static int ruleadapt_integrate(rule *r, integrand f, void *fdata, const hypercube *h, unsigned maxEval, double reqAbsError, double reqRelError, esterr *ee)
{
unsigned maxIter; /* maximum number of adaptive subdivisions */
heap regions;
unsigned i;
int status = -1; /* = ERROR */
if (maxEval) {
if (r->num_points > maxEval)
return status; /* ERROR */
maxIter = (maxEval - r->num_points) / (2 * r->num_points);
}
else
maxIter = UINT_MAX;
regions = heap_alloc(1);
heap_push(®ions, eval_region(make_region(h), f, fdata, r));
/* another possibility is to specify some non-adaptive subdivisions:
if (initialRegions != 1)
partition(h, initialRegions, EQUIDISTANT, ®ions, f,fdata, r); */
for (i = 0; i < maxIter; ++i) {
region R, R2;
if (regions.ee.err <= reqAbsError
|| relError(regions.ee) <= reqRelError) {
status = 0; /* converged! */
break;
}
R = heap_pop(®ions); /* get worst region */
cut_region(&R, &R2);
heap_push(®ions, eval_region(R, f, fdata, r));
heap_push(®ions, eval_region(R2, f, fdata, r));
}
ee->val = ee->err = 0; /* re-sum integral and errors */
for (i = 0; i < regions.n; ++i) {
ee->val += regions.items[i].ee.val;
ee->err += regions.items[i].ee.err;
destroy_region(®ions.items[i]);
}
/* printf("regions.nalloc = %d\n", regions.nalloc); */
heap_free(®ions);
return status;
}
static int adapt_integrate(integrand f, void *fdata,
unsigned dim, const double *xmin, const double *xmax,
unsigned maxEval, double reqAbsError, double reqRelError,
double *val, double *err)
{
rule *r;
hypercube h;
esterr ee;
int status;
if (dim == 0) { /* trivial integration */
*val = f(0, xmin, fdata);
*err = 0;
return 0;
}
r = dim == 1 ? make_rule15gauss(dim) : make_rule75genzmalik(dim);
if (!r) { *val = 0; *err = HUGE_VAL; return -2; /* ERROR */ }
h = make_hypercube_range(dim, xmin, xmax);
status = ruleadapt_integrate(r, f, fdata, &h,
maxEval, reqAbsError, reqRelError,
&ee);
*val = ee.val;
*err = ee.err;
destroy_hypercube(&h);
destroy_rule(r);
return status;
}
/***************************************************************************/
/* Compile with -DTEST_INTEGRATOR for a self-contained test program.
Usage: ./integrator
where = # dimensions, = relative tolerance,
is either 0/1/2 for the three test integrands (see below),
and is the maximum # function evaluations (0 for none).
*/
#ifdef TEST_INTEGRATOR
int count = 0;
int which_integrand = 0;
const double radius = 0.50124145262344534123412; /* random */
/* Simple constant function */
double
fconst (double x[], size_t dim, void *params)
{
return 1;
}
/*** f0, f1, f2, and f3 are test functions from the Monte-Carlo
integration routines in GSL 1.6 (monte/test.c). Copyright (c)
1996-2000 Michael Booth, GNU GPL. ****/
/* Simple product function */
double f0 (unsigned dim, const double *x, void *params)
{
double prod = 1.0;
unsigned int i;
for (i = 0; i < dim; ++i)
prod *= 2.0 * x[i];
return prod;
}
/* Gaussian centered at 1/2. */
double f1 (unsigned dim, const double *x, void *params)
{
double a = *(double *)params;
double sum = 0.;
unsigned int i;
for (i = 0; i < dim; i++) {
double dx = x[i] - 0.5;
sum += dx * dx;
}
return (pow (M_2_SQRTPI / (2. * a), (double) dim) *
exp (-sum / (a * a)));
}
/* double gaussian */
double f2 (unsigned dim, const double *x, void *params)
{
double a = *(double *)params;
double sum1 = 0.;
double sum2 = 0.;
unsigned int i;
for (i = 0; i < dim; i++) {
double dx1 = x[i] - 1. / 3.;
double dx2 = x[i] - 2. / 3.;
sum1 += dx1 * dx1;
sum2 += dx2 * dx2;
}
return 0.5 * pow (M_2_SQRTPI / (2. * a), dim)
* (exp (-sum1 / (a * a)) + exp (-sum2 / (a * a)));
}
/* Tsuda's example */
double f3 (unsigned dim, const double *x, void *params)
{
double c = *(double *)params;
double prod = 1.;
unsigned int i;
for (i = 0; i < dim; i++)
prod *= c / (c + 1) * pow((c + 1) / (c + x[i]), 2.0);
return prod;
}
/*** end of GSL test functions ***/
double f_test(unsigned dim, const double *x, void *data)
{
double val;
unsigned i;
++count;
switch (which_integrand) {
case 0: /* simple smooth (separable) objective: prod. cos(x[i]). */
val = 1;
for (i = 0; i < dim; ++i)
val *= cos(x[i]);
break;
case 1: { /* integral of exp(-x^2), rescaled to (0,infinity) limits */
double scale = 1.0;
val = 0;
for (i = 0; i < dim; ++i) {
double z = (1 - x[i]) / x[i];
val += z * z;
scale *= M_2_SQRTPI / (x[i] * x[i]);
}
val = exp(-val) * scale;
break;
}
case 2: /* discontinuous objective: volume of hypersphere */
val = 0;
for (i = 0; i < dim; ++i)
val += x[i] * x[i];
val = val < radius * radius;
break;
case 3:
val = f0(dim, x, data);
break;
case 4:
val = f1(dim, x, data);
break;
case 5:
val = f2(dim, x, data);
break;
case 6:
val = f3(dim, x, data);
break;
default:
fprintf(stderr, "unknown integrand %d\n", which_integrand);
exit(EXIT_FAILURE);
}
/* if (count < 100) printf("%d: f(%g, ...) = %g\n", count, x[0], val); */
return val;
}
/* surface area of n-dimensional unit hypersphere */
static double S(unsigned n)
{
double val;
int fact = 1;
if (n % 2 == 0) { /* n even */
val = 2 * pow(M_PI, n * 0.5);
n = n / 2;
while (n > 1) fact *= (n -= 1);
val /= fact;
}
else { /* n odd */
val = (1 << (n/2 + 1)) * pow(M_PI, n/2);
while (n > 2) fact *= (n -= 2);
val /= fact;
}
return val;
}
static double exact_integral(unsigned dim, const double *xmax) {
unsigned i;
double val;
switch(which_integrand) {
case 0:
val = 1;
for (i = 0; i < dim; ++i)
val *= sin(xmax[i]);
break;
case 2:
val = dim == 0 ? 1 : S(dim) * pow(radius * 0.5, dim) / dim;
break;
default:
val = 1.0;
}
return val;
}
int main(int argc, char **argv)
{
double *xmin, *xmax;
double tol, val, err;
unsigned i, dim, maxEval;
double fdata;
dim = argc > 1 ? atoi(argv[1]) : 2;
tol = argc > 2 ? atof(argv[2]) : 1e-2;
which_integrand = argc > 3 ? atoi(argv[3]) : 0;
maxEval = argc > 4 ? atoi(argv[4]) : 0;
fdata = which_integrand == 6 ? (1.0 + sqrt (10.0)) / 9.0 : 0.1;
xmin = (double *) malloc(dim * sizeof(double));
xmax = (double *) malloc(dim * sizeof(double));
for (i = 0; i < dim; ++i) {
xmin[i] = 0;
xmax[i] = 1 + (which_integrand >= 1 ? 0 : 0.4 * sin(i));
}
printf("%u-dim integral, tolerance = %g, integrand = %d\n",
dim, tol, which_integrand);
adapt_integrate(f_test, &fdata,
dim, xmin, xmax,
maxEval, 0, tol, &val, &err);
printf("integration val = %g, est. err = %g, true err = %g\n",
val, err, fabs(val - exact_integral(dim, xmax)));
printf("#evals = %d\n", count);
free(xmax);
free(xmin);
return 0;
}
#else
/*************************************************************************/
/* libctl interface */
#include "ctl.h"
static int adapt_integrate(integrand f, void *fdata,
unsigned dim, const double *xmin, const double *xmax,
unsigned maxEval,
double reqAbsError, double reqRelError,
double *val, double *err);
number adaptive_integration(multivar_func f, number *xmin, number *xmax,
integer n, void *fdata,
number abstol, number reltol, integer maxnfe,
number *esterr, integer *errflag)
{
double val;
*errflag = adapt_integrate((integrand) f, fdata, n, xmin, xmax,
maxnfe, abstol, reltol, &val, esterr);
return val;
}
/* from subplex.c */
extern number f_scm_wrapper(integer n, number *x, void *f_scm_p);
SCM adaptive_integration_scm(SCM f_scm, SCM xmin_scm, SCM xmax_scm,
SCM abstol_scm, SCM reltol_scm, SCM maxnfe_scm)
{
integer n, maxnfe, errflag, i;
number *xmin, *xmax, abstol, reltol, integral;
n = list_length(xmin_scm);
abstol = fabs(ctl_convert_number_to_c(abstol_scm));
reltol = fabs(ctl_convert_number_to_c(reltol_scm));
maxnfe = ctl_convert_integer_to_c(maxnfe_scm);
if (list_length(xmax_scm) != n) {
fprintf(stderr, "adaptive_integration: xmin/xmax dimension mismatch\n");
return SCM_UNDEFINED;
}
xmin = (number*) malloc(sizeof(number) * n);
xmax = (number*) malloc(sizeof(number) * n);
if (!xmin || !xmax) {
fprintf(stderr, "adaptive_integration: error, out of memory!\n");
exit(EXIT_FAILURE);
}
for (i = 0; i < n; ++i) {
xmin[i] = number_list_ref(xmin_scm, i);
xmax[i] = number_list_ref(xmax_scm, i);
}
integral = adaptive_integration(f_scm_wrapper, xmin, xmax, n, &f_scm,
abstol, reltol, maxnfe,
&abstol, &errflag);
free(xmax);
free(xmin);
switch (errflag) {
case 3:
fprintf(stderr, "adaptive_integration: invalid inputs\n");
return SCM_UNDEFINED;
case 1:
fprintf(stderr, "adaptive_integration: maxnfe too small\n");
break;
case 2:
fprintf(stderr, "adaptive_integration: lenwork too small\n");
break;
}
return gh_cons(ctl_convert_number_to_scm(integral),
ctl_convert_number_to_scm(abstol));
}
#endif
libctl-3.2.2/depcomp 0000755 0001754 0000144 00000056016 12235234727 011304 0000000 0000000 #! /bin/sh
# depcomp - compile a program generating dependencies as side-effects
scriptversion=2013-05-30.07; # UTC
# Copyright (C) 1999-2013 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
# Originally written by Alexandre Oliva .
case $1 in
'')
echo "$0: No command. Try '$0 --help' for more information." 1>&2
exit 1;
;;
-h | --h*)
cat <<\EOF
Usage: depcomp [--help] [--version] PROGRAM [ARGS]
Run PROGRAMS ARGS to compile a file, generating dependencies
as side-effects.
Environment variables:
depmode Dependency tracking mode.
source Source file read by 'PROGRAMS ARGS'.
object Object file output by 'PROGRAMS ARGS'.
DEPDIR directory where to store dependencies.
depfile Dependency file to output.
tmpdepfile Temporary file to use when outputting dependencies.
libtool Whether libtool is used (yes/no).
Report bugs to .
EOF
exit $?
;;
-v | --v*)
echo "depcomp $scriptversion"
exit $?
;;
esac
# Get the directory component of the given path, and save it in the
# global variables '$dir'. Note that this directory component will
# be either empty or ending with a '/' character. This is deliberate.
set_dir_from ()
{
case $1 in
*/*) dir=`echo "$1" | sed -e 's|/[^/]*$|/|'`;;
*) dir=;;
esac
}
# Get the suffix-stripped basename of the given path, and save it the
# global variable '$base'.
set_base_from ()
{
base=`echo "$1" | sed -e 's|^.*/||' -e 's/\.[^.]*$//'`
}
# If no dependency file was actually created by the compiler invocation,
# we still have to create a dummy depfile, to avoid errors with the
# Makefile "include basename.Plo" scheme.
make_dummy_depfile ()
{
echo "#dummy" > "$depfile"
}
# Factor out some common post-processing of the generated depfile.
# Requires the auxiliary global variable '$tmpdepfile' to be set.
aix_post_process_depfile ()
{
# If the compiler actually managed to produce a dependency file,
# post-process it.
if test -f "$tmpdepfile"; then
# Each line is of the form 'foo.o: dependency.h'.
# Do two passes, one to just change these to
# $object: dependency.h
# and one to simply output
# dependency.h:
# which is needed to avoid the deleted-header problem.
{ sed -e "s,^.*\.[$lower]*:,$object:," < "$tmpdepfile"
sed -e "s,^.*\.[$lower]*:[$tab ]*,," -e 's,$,:,' < "$tmpdepfile"
} > "$depfile"
rm -f "$tmpdepfile"
else
make_dummy_depfile
fi
}
# A tabulation character.
tab=' '
# A newline character.
nl='
'
# Character ranges might be problematic outside the C locale.
# These definitions help.
upper=ABCDEFGHIJKLMNOPQRSTUVWXYZ
lower=abcdefghijklmnopqrstuvwxyz
digits=0123456789
alpha=${upper}${lower}
if test -z "$depmode" || test -z "$source" || test -z "$object"; then
echo "depcomp: Variables source, object and depmode must be set" 1>&2
exit 1
fi
# Dependencies for sub/bar.o or sub/bar.obj go into sub/.deps/bar.Po.
depfile=${depfile-`echo "$object" |
sed 's|[^\\/]*$|'${DEPDIR-.deps}'/&|;s|\.\([^.]*\)$|.P\1|;s|Pobj$|Po|'`}
tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`}
rm -f "$tmpdepfile"
# Avoid interferences from the environment.
gccflag= dashmflag=
# Some modes work just like other modes, but use different flags. We
# parameterize here, but still list the modes in the big case below,
# to make depend.m4 easier to write. Note that we *cannot* use a case
# here, because this file can only contain one case statement.
if test "$depmode" = hp; then
# HP compiler uses -M and no extra arg.
gccflag=-M
depmode=gcc
fi
if test "$depmode" = dashXmstdout; then
# This is just like dashmstdout with a different argument.
dashmflag=-xM
depmode=dashmstdout
fi
cygpath_u="cygpath -u -f -"
if test "$depmode" = msvcmsys; then
# This is just like msvisualcpp but w/o cygpath translation.
# Just convert the backslash-escaped backslashes to single forward
# slashes to satisfy depend.m4
cygpath_u='sed s,\\\\,/,g'
depmode=msvisualcpp
fi
if test "$depmode" = msvc7msys; then
# This is just like msvc7 but w/o cygpath translation.
# Just convert the backslash-escaped backslashes to single forward
# slashes to satisfy depend.m4
cygpath_u='sed s,\\\\,/,g'
depmode=msvc7
fi
if test "$depmode" = xlc; then
# IBM C/C++ Compilers xlc/xlC can output gcc-like dependency information.
gccflag=-qmakedep=gcc,-MF
depmode=gcc
fi
case "$depmode" in
gcc3)
## gcc 3 implements dependency tracking that does exactly what
## we want. Yay! Note: for some reason libtool 1.4 doesn't like
## it if -MD -MP comes after the -MF stuff. Hmm.
## Unfortunately, FreeBSD c89 acceptance of flags depends upon
## the command line argument order; so add the flags where they
## appear in depend2.am. Note that the slowdown incurred here
## affects only configure: in makefiles, %FASTDEP% shortcuts this.
for arg
do
case $arg in
-c) set fnord "$@" -MT "$object" -MD -MP -MF "$tmpdepfile" "$arg" ;;
*) set fnord "$@" "$arg" ;;
esac
shift # fnord
shift # $arg
done
"$@"
stat=$?
if test $stat -ne 0; then
rm -f "$tmpdepfile"
exit $stat
fi
mv "$tmpdepfile" "$depfile"
;;
gcc)
## Note that this doesn't just cater to obsosete pre-3.x GCC compilers.
## but also to in-use compilers like IMB xlc/xlC and the HP C compiler.
## (see the conditional assignment to $gccflag above).
## There are various ways to get dependency output from gcc. Here's
## why we pick this rather obscure method:
## - Don't want to use -MD because we'd like the dependencies to end
## up in a subdir. Having to rename by hand is ugly.
## (We might end up doing this anyway to support other compilers.)
## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like
## -MM, not -M (despite what the docs say). Also, it might not be
## supported by the other compilers which use the 'gcc' depmode.
## - Using -M directly means running the compiler twice (even worse
## than renaming).
if test -z "$gccflag"; then
gccflag=-MD,
fi
"$@" -Wp,"$gccflag$tmpdepfile"
stat=$?
if test $stat -ne 0; then
rm -f "$tmpdepfile"
exit $stat
fi
rm -f "$depfile"
echo "$object : \\" > "$depfile"
# The second -e expression handles DOS-style file names with drive
# letters.
sed -e 's/^[^:]*: / /' \
-e 's/^['$alpha']:\/[^:]*: / /' < "$tmpdepfile" >> "$depfile"
## This next piece of magic avoids the "deleted header file" problem.
## The problem is that when a header file which appears in a .P file
## is deleted, the dependency causes make to die (because there is
## typically no way to rebuild the header). We avoid this by adding
## dummy dependencies for each header file. Too bad gcc doesn't do
## this for us directly.
## Some versions of gcc put a space before the ':'. On the theory
## that the space means something, we add a space to the output as
## well. hp depmode also adds that space, but also prefixes the VPATH
## to the object. Take care to not repeat it in the output.
## Some versions of the HPUX 10.20 sed can't process this invocation
## correctly. Breaking it into two sed invocations is a workaround.
tr ' ' "$nl" < "$tmpdepfile" \
| sed -e 's/^\\$//' -e '/^$/d' -e "s|.*$object$||" -e '/:$/d' \
| sed -e 's/$/ :/' >> "$depfile"
rm -f "$tmpdepfile"
;;
hp)
# This case exists only to let depend.m4 do its work. It works by
# looking at the text of this script. This case will never be run,
# since it is checked for above.
exit 1
;;
sgi)
if test "$libtool" = yes; then
"$@" "-Wp,-MDupdate,$tmpdepfile"
else
"$@" -MDupdate "$tmpdepfile"
fi
stat=$?
if test $stat -ne 0; then
rm -f "$tmpdepfile"
exit $stat
fi
rm -f "$depfile"
if test -f "$tmpdepfile"; then # yes, the sourcefile depend on other files
echo "$object : \\" > "$depfile"
# Clip off the initial element (the dependent). Don't try to be
# clever and replace this with sed code, as IRIX sed won't handle
# lines with more than a fixed number of characters (4096 in
# IRIX 6.2 sed, 8192 in IRIX 6.5). We also remove comment lines;
# the IRIX cc adds comments like '#:fec' to the end of the
# dependency line.
tr ' ' "$nl" < "$tmpdepfile" \
| sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' \
| tr "$nl" ' ' >> "$depfile"
echo >> "$depfile"
# The second pass generates a dummy entry for each header file.
tr ' ' "$nl" < "$tmpdepfile" \
| sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' -e 's/$/:/' \
>> "$depfile"
else
make_dummy_depfile
fi
rm -f "$tmpdepfile"
;;
xlc)
# This case exists only to let depend.m4 do its work. It works by
# looking at the text of this script. This case will never be run,
# since it is checked for above.
exit 1
;;
aix)
# The C for AIX Compiler uses -M and outputs the dependencies
# in a .u file. In older versions, this file always lives in the
# current directory. Also, the AIX compiler puts '$object:' at the
# start of each line; $object doesn't have directory information.
# Version 6 uses the directory in both cases.
set_dir_from "$object"
set_base_from "$object"
if test "$libtool" = yes; then
tmpdepfile1=$dir$base.u
tmpdepfile2=$base.u
tmpdepfile3=$dir.libs/$base.u
"$@" -Wc,-M
else
tmpdepfile1=$dir$base.u
tmpdepfile2=$dir$base.u
tmpdepfile3=$dir$base.u
"$@" -M
fi
stat=$?
if test $stat -ne 0; then
rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3"
exit $stat
fi
for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3"
do
test -f "$tmpdepfile" && break
done
aix_post_process_depfile
;;
tcc)
# tcc (Tiny C Compiler) understand '-MD -MF file' since version 0.9.26
# FIXME: That version still under development at the moment of writing.
# Make that this statement remains true also for stable, released
# versions.
# It will wrap lines (doesn't matter whether long or short) with a
# trailing '\', as in:
#
# foo.o : \
# foo.c \
# foo.h \
#
# It will put a trailing '\' even on the last line, and will use leading
# spaces rather than leading tabs (at least since its commit 0394caf7
# "Emit spaces for -MD").
"$@" -MD -MF "$tmpdepfile"
stat=$?
if test $stat -ne 0; then
rm -f "$tmpdepfile"
exit $stat
fi
rm -f "$depfile"
# Each non-empty line is of the form 'foo.o : \' or ' dep.h \'.
# We have to change lines of the first kind to '$object: \'.
sed -e "s|.*:|$object :|" < "$tmpdepfile" > "$depfile"
# And for each line of the second kind, we have to emit a 'dep.h:'
# dummy dependency, to avoid the deleted-header problem.
sed -n -e 's|^ *\(.*\) *\\$|\1:|p' < "$tmpdepfile" >> "$depfile"
rm -f "$tmpdepfile"
;;
## The order of this option in the case statement is important, since the
## shell code in configure will try each of these formats in the order
## listed in this file. A plain '-MD' option would be understood by many
## compilers, so we must ensure this comes after the gcc and icc options.
pgcc)
# Portland's C compiler understands '-MD'.
# Will always output deps to 'file.d' where file is the root name of the
# source file under compilation, even if file resides in a subdirectory.
# The object file name does not affect the name of the '.d' file.
# pgcc 10.2 will output
# foo.o: sub/foo.c sub/foo.h
# and will wrap long lines using '\' :
# foo.o: sub/foo.c ... \
# sub/foo.h ... \
# ...
set_dir_from "$object"
# Use the source, not the object, to determine the base name, since
# that's sadly what pgcc will do too.
set_base_from "$source"
tmpdepfile=$base.d
# For projects that build the same source file twice into different object
# files, the pgcc approach of using the *source* file root name can cause
# problems in parallel builds. Use a locking strategy to avoid stomping on
# the same $tmpdepfile.
lockdir=$base.d-lock
trap "
echo '$0: caught signal, cleaning up...' >&2
rmdir '$lockdir'
exit 1
" 1 2 13 15
numtries=100
i=$numtries
while test $i -gt 0; do
# mkdir is a portable test-and-set.
if mkdir "$lockdir" 2>/dev/null; then
# This process acquired the lock.
"$@" -MD
stat=$?
# Release the lock.
rmdir "$lockdir"
break
else
# If the lock is being held by a different process, wait
# until the winning process is done or we timeout.
while test -d "$lockdir" && test $i -gt 0; do
sleep 1
i=`expr $i - 1`
done
fi
i=`expr $i - 1`
done
trap - 1 2 13 15
if test $i -le 0; then
echo "$0: failed to acquire lock after $numtries attempts" >&2
echo "$0: check lockdir '$lockdir'" >&2
exit 1
fi
if test $stat -ne 0; then
rm -f "$tmpdepfile"
exit $stat
fi
rm -f "$depfile"
# Each line is of the form `foo.o: dependent.h',
# or `foo.o: dep1.h dep2.h \', or ` dep3.h dep4.h \'.
# Do two passes, one to just change these to
# `$object: dependent.h' and one to simply `dependent.h:'.
sed "s,^[^:]*:,$object :," < "$tmpdepfile" > "$depfile"
# Some versions of the HPUX 10.20 sed can't process this invocation
# correctly. Breaking it into two sed invocations is a workaround.
sed 's,^[^:]*: \(.*\)$,\1,;s/^\\$//;/^$/d;/:$/d' < "$tmpdepfile" \
| sed -e 's/$/ :/' >> "$depfile"
rm -f "$tmpdepfile"
;;
hp2)
# The "hp" stanza above does not work with aCC (C++) and HP's ia64
# compilers, which have integrated preprocessors. The correct option
# to use with these is +Maked; it writes dependencies to a file named
# 'foo.d', which lands next to the object file, wherever that
# happens to be.
# Much of this is similar to the tru64 case; see comments there.
set_dir_from "$object"
set_base_from "$object"
if test "$libtool" = yes; then
tmpdepfile1=$dir$base.d
tmpdepfile2=$dir.libs/$base.d
"$@" -Wc,+Maked
else
tmpdepfile1=$dir$base.d
tmpdepfile2=$dir$base.d
"$@" +Maked
fi
stat=$?
if test $stat -ne 0; then
rm -f "$tmpdepfile1" "$tmpdepfile2"
exit $stat
fi
for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2"
do
test -f "$tmpdepfile" && break
done
if test -f "$tmpdepfile"; then
sed -e "s,^.*\.[$lower]*:,$object:," "$tmpdepfile" > "$depfile"
# Add 'dependent.h:' lines.
sed -ne '2,${
s/^ *//
s/ \\*$//
s/$/:/
p
}' "$tmpdepfile" >> "$depfile"
else
make_dummy_depfile
fi
rm -f "$tmpdepfile" "$tmpdepfile2"
;;
tru64)
# The Tru64 compiler uses -MD to generate dependencies as a side
# effect. 'cc -MD -o foo.o ...' puts the dependencies into 'foo.o.d'.
# At least on Alpha/Redhat 6.1, Compaq CCC V6.2-504 seems to put
# dependencies in 'foo.d' instead, so we check for that too.
# Subdirectories are respected.
set_dir_from "$object"
set_base_from "$object"
if test "$libtool" = yes; then
# Libtool generates 2 separate objects for the 2 libraries. These
# two compilations output dependencies in $dir.libs/$base.o.d and
# in $dir$base.o.d. We have to check for both files, because
# one of the two compilations can be disabled. We should prefer
# $dir$base.o.d over $dir.libs/$base.o.d because the latter is
# automatically cleaned when .libs/ is deleted, while ignoring
# the former would cause a distcleancheck panic.
tmpdepfile1=$dir$base.o.d # libtool 1.5
tmpdepfile2=$dir.libs/$base.o.d # Likewise.
tmpdepfile3=$dir.libs/$base.d # Compaq CCC V6.2-504
"$@" -Wc,-MD
else
tmpdepfile1=$dir$base.d
tmpdepfile2=$dir$base.d
tmpdepfile3=$dir$base.d
"$@" -MD
fi
stat=$?
if test $stat -ne 0; then
rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3"
exit $stat
fi
for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3"
do
test -f "$tmpdepfile" && break
done
# Same post-processing that is required for AIX mode.
aix_post_process_depfile
;;
msvc7)
if test "$libtool" = yes; then
showIncludes=-Wc,-showIncludes
else
showIncludes=-showIncludes
fi
"$@" $showIncludes > "$tmpdepfile"
stat=$?
grep -v '^Note: including file: ' "$tmpdepfile"
if test $stat -ne 0; then
rm -f "$tmpdepfile"
exit $stat
fi
rm -f "$depfile"
echo "$object : \\" > "$depfile"
# The first sed program below extracts the file names and escapes
# backslashes for cygpath. The second sed program outputs the file
# name when reading, but also accumulates all include files in the
# hold buffer in order to output them again at the end. This only
# works with sed implementations that can handle large buffers.
sed < "$tmpdepfile" -n '
/^Note: including file: *\(.*\)/ {
s//\1/
s/\\/\\\\/g
p
}' | $cygpath_u | sort -u | sed -n '
s/ /\\ /g
s/\(.*\)/'"$tab"'\1 \\/p
s/.\(.*\) \\/\1:/
H
$ {
s/.*/'"$tab"'/
G
p
}' >> "$depfile"
echo >> "$depfile" # make sure the fragment doesn't end with a backslash
rm -f "$tmpdepfile"
;;
msvc7msys)
# This case exists only to let depend.m4 do its work. It works by
# looking at the text of this script. This case will never be run,
# since it is checked for above.
exit 1
;;
#nosideeffect)
# This comment above is used by automake to tell side-effect
# dependency tracking mechanisms from slower ones.
dashmstdout)
# Important note: in order to support this mode, a compiler *must*
# always write the preprocessed file to stdout, regardless of -o.
"$@" || exit $?
# Remove the call to Libtool.
if test "$libtool" = yes; then
while test "X$1" != 'X--mode=compile'; do
shift
done
shift
fi
# Remove '-o $object'.
IFS=" "
for arg
do
case $arg in
-o)
shift
;;
$object)
shift
;;
*)
set fnord "$@" "$arg"
shift # fnord
shift # $arg
;;
esac
done
test -z "$dashmflag" && dashmflag=-M
# Require at least two characters before searching for ':'
# in the target name. This is to cope with DOS-style filenames:
# a dependency such as 'c:/foo/bar' could be seen as target 'c' otherwise.
"$@" $dashmflag |
sed "s|^[$tab ]*[^:$tab ][^:][^:]*:[$tab ]*|$object: |" > "$tmpdepfile"
rm -f "$depfile"
cat < "$tmpdepfile" > "$depfile"
# Some versions of the HPUX 10.20 sed can't process this sed invocation
# correctly. Breaking it into two sed invocations is a workaround.
tr ' ' "$nl" < "$tmpdepfile" \
| sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' \
| sed -e 's/$/ :/' >> "$depfile"
rm -f "$tmpdepfile"
;;
dashXmstdout)
# This case only exists to satisfy depend.m4. It is never actually
# run, as this mode is specially recognized in the preamble.
exit 1
;;
makedepend)
"$@" || exit $?
# Remove any Libtool call
if test "$libtool" = yes; then
while test "X$1" != 'X--mode=compile'; do
shift
done
shift
fi
# X makedepend
shift
cleared=no eat=no
for arg
do
case $cleared in
no)
set ""; shift
cleared=yes ;;
esac
if test $eat = yes; then
eat=no
continue
fi
case "$arg" in
-D*|-I*)
set fnord "$@" "$arg"; shift ;;
# Strip any option that makedepend may not understand. Remove
# the object too, otherwise makedepend will parse it as a source file.
-arch)
eat=yes ;;
-*|$object)
;;
*)
set fnord "$@" "$arg"; shift ;;
esac
done
obj_suffix=`echo "$object" | sed 's/^.*\././'`
touch "$tmpdepfile"
${MAKEDEPEND-makedepend} -o"$obj_suffix" -f"$tmpdepfile" "$@"
rm -f "$depfile"
# makedepend may prepend the VPATH from the source file name to the object.
# No need to regex-escape $object, excess matching of '.' is harmless.
sed "s|^.*\($object *:\)|\1|" "$tmpdepfile" > "$depfile"
# Some versions of the HPUX 10.20 sed can't process the last invocation
# correctly. Breaking it into two sed invocations is a workaround.
sed '1,2d' "$tmpdepfile" \
| tr ' ' "$nl" \
| sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' \
| sed -e 's/$/ :/' >> "$depfile"
rm -f "$tmpdepfile" "$tmpdepfile".bak
;;
cpp)
# Important note: in order to support this mode, a compiler *must*
# always write the preprocessed file to stdout.
"$@" || exit $?
# Remove the call to Libtool.
if test "$libtool" = yes; then
while test "X$1" != 'X--mode=compile'; do
shift
done
shift
fi
# Remove '-o $object'.
IFS=" "
for arg
do
case $arg in
-o)
shift
;;
$object)
shift
;;
*)
set fnord "$@" "$arg"
shift # fnord
shift # $arg
;;
esac
done
"$@" -E \
| sed -n -e '/^# [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \
-e '/^#line [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \
| sed '$ s: \\$::' > "$tmpdepfile"
rm -f "$depfile"
echo "$object : \\" > "$depfile"
cat < "$tmpdepfile" >> "$depfile"
sed < "$tmpdepfile" '/^$/d;s/^ //;s/ \\$//;s/$/ :/' >> "$depfile"
rm -f "$tmpdepfile"
;;
msvisualcpp)
# Important note: in order to support this mode, a compiler *must*
# always write the preprocessed file to stdout.
"$@" || exit $?
# Remove the call to Libtool.
if test "$libtool" = yes; then
while test "X$1" != 'X--mode=compile'; do
shift
done
shift
fi
IFS=" "
for arg
do
case "$arg" in
-o)
shift
;;
$object)
shift
;;
"-Gm"|"/Gm"|"-Gi"|"/Gi"|"-ZI"|"/ZI")
set fnord "$@"
shift
shift
;;
*)
set fnord "$@" "$arg"
shift
shift
;;
esac
done
"$@" -E 2>/dev/null |
sed -n '/^#line [0-9][0-9]* "\([^"]*\)"/ s::\1:p' | $cygpath_u | sort -u > "$tmpdepfile"
rm -f "$depfile"
echo "$object : \\" > "$depfile"
sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::'"$tab"'\1 \\:p' >> "$depfile"
echo "$tab" >> "$depfile"
sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::\1\::p' >> "$depfile"
rm -f "$tmpdepfile"
;;
msvcmsys)
# This case exists only to let depend.m4 do its work. It works by
# looking at the text of this script. This case will never be run,
# since it is checked for above.
exit 1
;;
none)
exec "$@"
;;
*)
echo "Unknown depmode $depmode" 1>&2
exit 1
;;
esac
exit 0
# Local Variables:
# mode: shell-script
# sh-indentation: 2
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:
libctl-3.2.2/utils/ 0000755 0001754 0000144 00000000000 12315333663 011135 5 0000000 0000000 libctl-3.2.2/utils/Makefile.am 0000644 0001754 0000144 00000002650 12315325343 013110 0000000 0000000 bin_SCRIPTS = gen-ctl-io
include_HEADERS = ctlgeom.h
nodist_include_HEADERS = ctlgeom-types.h
lib_LTLIBRARIES = libctlgeom.la
noinst_PROGRAMS = geomtst
EXTRA_DIST = gen-ctl-io.in README geom.scm geom-ctl-io-defaults.c nlopt.c
BUILT_SOURCES = gen-ctl-io geom-ctl-io.c ctl-io.c ctl-io.h ctlgeom-types.h nlopt-constants.scm
libctlgeom_la_SOURCES = geom.c
nodist_libctlgeom_la_SOURCES = geom-ctl-io.c ctl-io.h
libctlgeom_la_LDFLAGS = -version-info @SHARED_VERSION_INFO@ $(top_builddir)/src/libctl.la
geomtst_SOURCES = geomtst.c
geomtst_LDADD = libctlgeom.la $(top_builddir)/src/libctl.la
dist_man_MANS = gen-ctl-io.1
ctl-io.c: geom.scm $(GEN_CTL_IO)
$(GEN_CTL_IO) --code -o $@ $(srcdir)/geom.scm $(top_srcdir)
ctl-io.h: geom.scm $(GEN_CTL_IO)
$(GEN_CTL_IO) --header -o $@ $(srcdir)/geom.scm $(top_srcdir)
ctlgeom-types.h: ctl-io.h
cp -f ctl-io.h $@
geom-ctl-io.c: ctl-io.c
sed 's,/.* Input variables .*/,@#include "geom-ctl-io-defaults.c"@#if 0@,;s,/.* Output variables .*/,#endif@,' ctl-io.c | tr '@' '\n' > $@
nlopt-constants.scm:
echo "#include " > nlopt-constants.h
echo "; AUTOMATICALLY GENERATED - DO NOT EDIT" > $@
names=`$(CPP) nlopt-constants.h 2>/dev/null | $(EGREP) 'NLOPT_[LG][ND]' | sed 's/ //g;s/_/-/g' |tr = , |cut -d, -f1`; i=0; for n in $$names; do echo "(define $$n $$i)" >> $@; i=`expr $$i + 1`; done
rm nlopt-constants.h
clean-local:
rm -f ctl-io.[ch] geom-ctl-io.c ctlgeom-types.h nlopt-constants.scm
libctl-3.2.2/utils/geom-ctl-io-defaults.c 0000644 0001754 0000144 00000001253 12315325243 015136 0000000 0000000 /* for inclusion into geom-ctl-io.c ... this is somewhat of a hack,
necessitated because gen-ctl-io doesn't write default values (from
geom.scm) for the input variable, instead relying on them being
initialized from Scheme. */
integer dimensions = 3;
material_type default_material = { 0 };
vector3 geometry_center = { 0, 0, 0 };
lattice geometry_lattice = { { 1,0,0 },
{ 0,1,0 },
{ 0,0,1 },
{ 1e20,1e20,1e20 },
{ 1,1,1 },
{ 1,0,0 },
{ 0,1,0 },
{ 0,0,1 },
{ { 1,0,0 }, { 0,1,0 }, { 0,0,1 } },
{ { 1,0,0 }, { 0,1,0 }, { 0,0,1 } } };
geometric_object_list geometry = { 0, 0 };
boolean ensure_periodicity = 0;
libctl-3.2.2/utils/geom.c 0000644 0001754 0000144 00000176111 12315330377 012156 0000000 0000000 /* libctl: flexible Guile-based control files for scientific software
* Copyright (C) 1998-2014 Massachusetts Institute of Technology and Steven G. Johnson
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the
* Free Software Foundation, Inc., 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
* Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
*/
#include
#include
#include
#include "ctl-io.h"
#include
#ifdef CXX_CTL_IO
using namespace ctlio;
# define CTLIO ctlio::
# define GEOM geometric_object::
# define BLK block::
# define CYL cylinder::
# define MAT material_type::
#else
# define CTLIO
# define GEOM
# define BLK
# define CYL
# define MAT
#endif
#ifdef __cplusplus
# define MALLOC(type,num) (new type[num])
# define MALLOC1(type) (new type)
# define FREE(p) delete[] (p)
# define FREE1(p) delete (p)
#else
# define MALLOC(type,num) ((type *) malloc(sizeof(type) * (num)))
# define MALLOC1(type) MALLOC(type,1)
# define FREE(p) free(p)
# define FREE1(p) free(p)
#endif
#define K_PI 3.14159265358979323846
/**************************************************************************/
/* If v is a vector in the lattice basis, normalize v so that
its cartesian length is unity. */
static void lattice_normalize(vector3 *v)
{
*v = vector3_scale(
1.0 /
sqrt(vector3_dot(*v,
matrix3x3_vector3_mult(geometry_lattice.metric,
*v))),
*v);
}
static vector3 lattice_to_cartesian(vector3 v)
{
return matrix3x3_vector3_mult(geometry_lattice.basis, v);
}
static vector3 cartesian_to_lattice(vector3 v)
{
return matrix3x3_vector3_mult(matrix3x3_inverse(geometry_lattice.basis),
v);
}
/* "Fix" the parameters of the given object to account for the
geometry_lattice basis, which may be non-orthogonal. In particular,
this means that the normalization of several unit vectors, such
as the cylinder or block axes, needs to be changed.
Unfortunately, we can't do this stuff at object-creation time
in Guile, because the geometry_lattice variable may not have
been assigned to its final value at that point. */
void geom_fix_object(geometric_object o)
{
switch(o.which_subclass) {
case GEOM CYLINDER:
lattice_normalize(&o.subclass.cylinder_data->axis);
if (o.subclass.cylinder_data->which_subclass == CYL WEDGE) {
vector3 a = o.subclass.cylinder_data->axis;
vector3 s = o.subclass.cylinder_data->subclass.wedge_data->wedge_start;
double p = vector3_dot(s, matrix3x3_vector3_mult(geometry_lattice.metric, a));
o.subclass.cylinder_data->subclass.wedge_data->e1 =
vector3_minus(s, vector3_scale(p, a));
lattice_normalize(&o.subclass.cylinder_data->subclass.wedge_data->e1);
o.subclass.cylinder_data->subclass.wedge_data->e2 =
cartesian_to_lattice(
vector3_cross(lattice_to_cartesian(o.subclass.cylinder_data->axis),
lattice_to_cartesian(o.subclass.cylinder_data->subclass.wedge_data->e1)));
}
break;
case GEOM BLOCK:
{
matrix3x3 m;
lattice_normalize(&o.subclass.block_data->e1);
lattice_normalize(&o.subclass.block_data->e2);
lattice_normalize(&o.subclass.block_data->e3);
m.c0 = o.subclass.block_data->e1;
m.c1 = o.subclass.block_data->e2;
m.c2 = o.subclass.block_data->e3;
o.subclass.block_data->projection_matrix = matrix3x3_inverse(m);
break;
}
case GEOM COMPOUND_GEOMETRIC_OBJECT:
{
int i;
int n = o.subclass.compound_geometric_object_data
->component_objects.num_items;
geometric_object *os = o.subclass.compound_geometric_object_data
->component_objects.items;
for (i = 0; i < n; ++i) {
#if MATERIAL_TYPE_ABSTRACT
if (os[i].material.which_subclass == MAT MATERIAL_TYPE_SELF)
material_type_copy(&o.material, &os[i].material);
#endif
geom_fix_object(os[i]);
}
break;
}
case GEOM GEOMETRIC_OBJECT_SELF: case GEOM SPHERE:
break; /* these objects are fine */
}
}
/* fix all objects in the geometry list as described in
geom_fix_object, above */
void geom_fix_objects0(geometric_object_list geometry)
{
int index;
for (index = 0; index < geometry.num_items; ++index)
geom_fix_object(geometry.items[index]);
}
void geom_fix_objects(void)
{
geom_fix_objects0(geometry);
}
void geom_fix_lattice0(lattice *L)
{
L->basis1 = unit_vector3(L->basis1);
L->basis2 = unit_vector3(L->basis2);
L->basis3 = unit_vector3(L->basis3);
L->b1 = vector3_scale(L->basis_size.x, L->basis1);
L->b2 = vector3_scale(L->basis_size.y, L->basis2);
L->b3 = vector3_scale(L->basis_size.z, L->basis3);
L->basis.c0 = L->b1;
L->basis.c1 = L->b2;
L->basis.c2 = L->b3;
L->metric = matrix3x3_mult(matrix3x3_transpose(L->basis), L->basis);
}
void geom_fix_lattice(void)
{
geom_fix_lattice0(&geometry_lattice);
}
void geom_cartesian_lattice0(lattice *L)
{
L->basis1.x = 1; L->basis1.y = 0; L->basis1.z = 0;
L->basis2.x = 0; L->basis2.y = 1; L->basis2.z = 0;
L->basis3.x = 0; L->basis3.y = 0; L->basis3.z = 1;
L->basis_size.x = L->basis_size.y = L->basis_size.z = 1;
geom_fix_lattice0(L);
}
void geom_cartesian_lattice(void)
{
geom_cartesian_lattice0(&geometry_lattice);
}
void geom_initialize(void)
{
/* initialize many of the input variables that are normally
initialized from Scheme, except for default_material and
geometry_lattice.size. */
geom_cartesian_lattice();
geometry_center.x = geometry_center.y = geometry_center.z = 0;
dimensions = 3;
ensure_periodicity = 1;
geometry.num_items = 0;
geometry.items = 0;
}
/**************************************************************************/
/* Return whether or not the point p (in the lattice basis) is inside
the object o.
Requires that the global input var geometry_lattice already be
initialized.
point_in_fixed_objectp additionally requires that geom_fix_object
has been called on o (if the lattice basis is non-orthogonal). */
boolean CTLIO point_in_objectp(vector3 p, geometric_object o)
{
geom_fix_object(o);
return point_in_fixed_objectp(p, o);
}
boolean point_in_fixed_objectp(vector3 p, geometric_object o)
{
return point_in_fixed_pobjectp(p, &o);
}
/* as point_in_fixed_objectp, but sets o to the object in question (if true)
(which may be different from the input o if o is a compound object) */
boolean point_in_fixed_pobjectp(vector3 p, geometric_object *o)
{
vector3 r = vector3_minus(p,o->center);
switch (o->which_subclass) {
case GEOM GEOMETRIC_OBJECT_SELF:
return 0;
case GEOM SPHERE:
{
number radius = o->subclass.sphere_data->radius;
return(radius > 0.0 &&
vector3_dot(r,matrix3x3_vector3_mult(geometry_lattice.metric, r))
<= radius*radius);
}
case GEOM CYLINDER:
{
vector3 rm = matrix3x3_vector3_mult(geometry_lattice.metric, r);
number proj = vector3_dot(o->subclass.cylinder_data->axis, rm);
number height = o->subclass.cylinder_data->height;
if (fabs(proj) <= 0.5 * height) {
number radius = o->subclass.cylinder_data->radius;
if (o->subclass.cylinder_data->which_subclass == CYL CONE)
radius += (proj/height + 0.5) *
(o->subclass.cylinder_data->subclass.cone_data->radius2
- radius);
else if (o->subclass.cylinder_data->which_subclass == CYL WEDGE) {
number x = vector3_dot(rm, o->subclass.cylinder_data->subclass.wedge_data->e1);
number y = vector3_dot(rm, o->subclass.cylinder_data->subclass.wedge_data->e2);
number theta = atan2(y, x);
number wedge_angle = o->subclass.cylinder_data->subclass.wedge_data->wedge_angle;
if (wedge_angle > 0) {
if (theta < 0) theta = theta + 2 * K_PI;
if (theta > wedge_angle) return 0;
}
else {
if (theta > 0) theta = theta - 2 * K_PI;
if (theta < wedge_angle) return 0;
}
}
return(radius != 0.0 && vector3_dot(r,rm) - proj*proj <= radius*radius);
}
else
return 0;
}
case GEOM BLOCK:
{
vector3 proj =
matrix3x3_vector3_mult(o->subclass.block_data->projection_matrix, r);
switch (o->subclass.block_data->which_subclass) {
case BLK BLOCK_SELF:
{
vector3 size = o->subclass.block_data->size;
return(fabs(proj.x) <= 0.5 * size.x &&
fabs(proj.y) <= 0.5 * size.y &&
fabs(proj.z) <= 0.5 * size.z);
}
case BLK ELLIPSOID:
{
vector3 isa =
o->subclass.block_data->subclass.ellipsoid_data->inverse_semi_axes;
double
a = proj.x * isa.x,
b = proj.y * isa.y,
c = proj.z * isa.z;
return(a*a + b*b + c*c <= 1.0);
}
}
}
case GEOM COMPOUND_GEOMETRIC_OBJECT:
{
int i;
int n = o->subclass.compound_geometric_object_data
->component_objects.num_items;
geometric_object *os = o->subclass.compound_geometric_object_data
->component_objects.items;
vector3 shiftby = o->center;
for (i = 0; i < n; ++i) {
*o = os[i];
o->center = vector3_plus(o->center, shiftby);
if (point_in_fixed_pobjectp(p, o))
return 1;
}
break;
}
}
return 0;
}
/**************************************************************************/
/* convert a point p inside o to a coordinate in [0,1]^3 that
is some "natural" coordinate for the object */
vector3 to_geom_object_coords(vector3 p, geometric_object o)
{
const vector3 half = {0.5, 0.5, 0.5};
vector3 r = vector3_minus(p,o.center);
switch (o.which_subclass) {
default: {
vector3 po = {0,0,0};
return po;
}
case GEOM SPHERE:
{
number radius = o.subclass.sphere_data->radius;
return vector3_plus(half, vector3_scale(0.5 / radius, r));
}
/* case GEOM CYLINDER:
NOT YET IMPLEMENTED */
case GEOM BLOCK:
{
vector3 proj =
matrix3x3_vector3_mult(o.subclass.block_data->projection_matrix, r);
vector3 size = o.subclass.block_data->size;
if (size.x != 0.0) proj.x /= size.x;
if (size.y != 0.0) proj.y /= size.y;
if (size.z != 0.0) proj.z /= size.z;
return vector3_plus(half, proj);
}
}
}
/* inverse of to_geom_object_coords */
vector3 from_geom_object_coords(vector3 p, geometric_object o)
{
const vector3 half = {0.5, 0.5, 0.5};
p = vector3_minus(p, half);
switch (o.which_subclass) {
default:
return o.center;
case GEOM SPHERE:
{
number radius = o.subclass.sphere_data->radius;
return vector3_plus(o.center, vector3_scale(radius / 0.5, p));
}
/* case GEOM CYLINDER:
NOT YET IMPLEMENTED */
case GEOM BLOCK:
{
vector3 size = o.subclass.block_data->size;
return vector3_plus(
o.center,
vector3_plus(
vector3_scale(size.x * p.x, o.subclass.block_data->e1),
vector3_plus(
vector3_scale(size.y * p.y, o.subclass.block_data->e2),
vector3_scale(size.z * p.z, o.subclass.block_data->e3))
));
}
}
}
/**************************************************************************/
/* Return the normal vector from the given object to the given point,
in lattice coordinates, using the surface of the object that the
point is "closest" to for some definition of "closest" that is
reasonable (at least for points near to the object). The length and
sign of the normal vector are arbitrary. */
vector3 CTLIO normal_to_object(vector3 p, geometric_object o)
{
geom_fix_object(o);
return normal_to_fixed_object(p, o);
}
vector3 normal_to_fixed_object(vector3 p, geometric_object o)
{
vector3 r = vector3_minus(p,o.center);
switch (o.which_subclass) {
case GEOM CYLINDER:
{
vector3 rm = matrix3x3_vector3_mult(geometry_lattice.metric, r);
double proj = vector3_dot(o.subclass.cylinder_data->axis, rm),
height = o.subclass.cylinder_data->height,
radius, prad;
if (fabs(proj) > height * 0.5)
return o.subclass.cylinder_data->axis;
radius = o.subclass.cylinder_data->radius;
prad = sqrt(fabs(vector3_dot(r,rm) - proj*proj));
if (o.subclass.cylinder_data->which_subclass == CYL CONE)
radius += (proj/height + 0.5) *
(o.subclass.cylinder_data->subclass.cone_data->radius2
- radius);
if (fabs(fabs(proj) - height * 0.5) < fabs(prad - radius))
return o.subclass.cylinder_data->axis;
if (o.subclass.cylinder_data->which_subclass == CYL CONE)
return vector3_minus(r, vector3_scale(proj + prad * (o.subclass.cylinder_data->subclass.cone_data->radius2 - radius) / height, o.subclass.cylinder_data->axis));
else
return vector3_minus(r, vector3_scale(proj, o.subclass.cylinder_data->axis));
}
case GEOM BLOCK:
{
vector3 proj =
matrix3x3_vector3_mult(o.subclass.block_data->projection_matrix, r);
switch (o.subclass.block_data->which_subclass) {
case BLK BLOCK_SELF:
{
vector3 size = o.subclass.block_data->size;
double d1 = fabs(fabs(proj.x) - 0.5 * size.x);
double d2 = fabs(fabs(proj.y) - 0.5 * size.y);
double d3 = fabs(fabs(proj.z) - 0.5 * size.z);
if (d1 < d2 && d1 < d3)
return matrix3x3_row1(o.subclass.block_data->projection_matrix);
else if (d2 < d3)
return matrix3x3_row2(o.subclass.block_data->projection_matrix);
else
return matrix3x3_row3(o.subclass.block_data->projection_matrix);
}
case BLK ELLIPSOID:
{
vector3 isa =
o.subclass.block_data->subclass.ellipsoid_data->inverse_semi_axes;
proj.x *= isa.x * isa.x;
proj.y *= isa.y * isa.y;
proj.z *= isa.z * isa.z;
return matrix3x3_transpose_vector3_mult(
o.subclass.block_data->projection_matrix, proj);
}
}
}
default:
return r;
}
}
/**************************************************************************/
/* Here is a useful macro to loop over different possible shifts of
the lattice vectors. body is executed for each possible shift,
where the shift is given by the value of shiftby (which should
be a vector3 variable). I would much rather make this a function,
but C's lack of lambda-like function construction or closures makes
this easier to do as a macro. (One could at least wish for
an easier way to make multi-line macros.) */
#define LOOP_PERIODIC(shiftby, body) { \
switch (dimensions) { \
case 1: \
{ \
int iii; \
shiftby.y = shiftby.z = 0; \
for (iii = -1; iii <= 1; ++iii) { \
shiftby.x = iii * geometry_lattice.size.x; \
body; \
} \
break; \
} \
case 2: \
{ \
int iii, jjj; \
shiftby.z = 0; \
for (iii = -1; iii <= 1; ++iii) { \
shiftby.x = iii * geometry_lattice.size.x; \
for (jjj = -1; jjj <= 1; ++jjj) { \
shiftby.y = jjj * geometry_lattice.size.y; \
body; \
} \
} \
break; \
} \
case 3: \
{ \
int iii, jjj, kkk; \
for (iii = -1; iii <= 1; ++iii) { \
shiftby.x = iii * geometry_lattice.size.x; \
for (jjj = -1; jjj <= 1; ++jjj) { \
shiftby.y = jjj * geometry_lattice.size.y; \
for (kkk = -1; kkk <= 1; ++kkk) { \
shiftby.z = kkk * geometry_lattice.size.z; \
body; \
} \
} \
} \
break; \
} \
} \
}
/**************************************************************************/
/* Like point_in_objectp, but also checks the object shifted
by the lattice vectors: */
boolean CTLIO point_in_periodic_objectp(vector3 p, geometric_object o)
{
geom_fix_object(o);
return point_in_periodic_fixed_objectp(p, o);
}
boolean point_in_periodic_fixed_objectp(vector3 p, geometric_object o)
{
vector3 shiftby;
LOOP_PERIODIC(shiftby,
if (point_in_fixed_objectp(vector3_minus(p, shiftby), o))
return 1);
return 0;
}
boolean point_shift_in_periodic_fixed_pobjectp(vector3 p, geometric_object *o,
vector3 *shiftby)
{
geometric_object o0 = *o;
LOOP_PERIODIC((*shiftby),
{
*o = o0;
if (point_in_fixed_pobjectp(
vector3_minus(p, *shiftby), o))
return 1;
});
return 0;
}
/**************************************************************************/
/* Functions to return the object or material type corresponding to
the point p (in the lattice basis). Returns default_material if p
is not in any object.
Requires that the global input vars geometry_lattice, geometry,
dimensions, default_material and ensure_periodicity already be
initialized.
Also requires that geom_fix_objects() has been called!
material_of_point_inobject is a variant that also returns whether
or not the point was in any object. */
geometric_object object_of_point0(geometric_object_list geometry, vector3 p,
vector3 *shiftby)
{
geometric_object o;
int index;
shiftby->x = shiftby->y = shiftby->z = 0;
/* loop in reverse order so that later items are given precedence: */
for (index = geometry.num_items - 1; index >= 0; --index) {
o = geometry.items[index];
if ((ensure_periodicity
&& point_shift_in_periodic_fixed_pobjectp(p, &o, shiftby))
|| point_in_fixed_pobjectp(p, &o))
return o;
}
o.which_subclass = GEOM GEOMETRIC_OBJECT_SELF; /* no object found */
return o;
}
geometric_object object_of_point(vector3 p, vector3 *shiftby)
{
return object_of_point0(geometry, p, shiftby);
}
material_type material_of_point_inobject0(geometric_object_list geometry,
vector3 p, boolean *inobject)
{
vector3 shiftby;
geometric_object o = object_of_point0(geometry, p, &shiftby);
*inobject = o.which_subclass != GEOM GEOMETRIC_OBJECT_SELF;;
return (*inobject ? o.material : default_material);
}
material_type material_of_point_inobject(vector3 p, boolean *inobject)
{
return material_of_point_inobject0(geometry, p, inobject);
}
material_type material_of_point0(geometric_object_list geometry, vector3 p)
{
boolean inobject;
return material_of_point_inobject0(geometry, p, &inobject);
}
material_type material_of_point(vector3 p)
{
return material_of_point0(geometry, p);
}
/**************************************************************************/
/* Given a geometric object o, display some information about it,
indented by indentby spaces. */
void CTLIO display_geometric_object_info(int indentby, geometric_object o)
{
geom_fix_object(o);
printf("%*s", indentby, "");
switch (o.which_subclass) {
case GEOM CYLINDER:
switch (o.subclass.cylinder_data->which_subclass) {
case CYL WEDGE:
printf("wedge");
break;
case CYL CONE:
printf("cone");
break;
case CYL CYLINDER_SELF:
printf("cylinder");
break;
}
break;
case GEOM SPHERE:
printf("sphere");
break;
case GEOM BLOCK:
switch (o.subclass.block_data->which_subclass) {
case BLK ELLIPSOID:
printf("ellipsoid");
break;
case BLK BLOCK_SELF:
printf("block");
break;
}
break;
case GEOM COMPOUND_GEOMETRIC_OBJECT:
printf("compound object");
break;
default:
printf("geometric object");
break;
}
printf(", center = (%g,%g,%g)\n",
o.center.x, o.center.y, o.center.z);
switch (o.which_subclass) {
case GEOM CYLINDER:
printf("%*s radius %g, height %g, axis (%g, %g, %g)\n",
indentby, "", o.subclass.cylinder_data->radius,
o.subclass.cylinder_data->height,
o.subclass.cylinder_data->axis.x,
o.subclass.cylinder_data->axis.y,
o.subclass.cylinder_data->axis.z);
if (o.subclass.cylinder_data->which_subclass == CYL CONE)
printf("%*s radius2 %g\n", indentby, "",
o.subclass.cylinder_data->subclass.cone_data->radius2);
else if (o.subclass.cylinder_data->which_subclass == CYL WEDGE)
printf("%*s wedge-theta %g\n", indentby, "",
o.subclass.cylinder_data->subclass.wedge_data->wedge_angle);
break;
case GEOM SPHERE:
printf("%*s radius %g\n", indentby, "",
o.subclass.sphere_data->radius);
break;
case GEOM BLOCK:
printf("%*s size (%g,%g,%g)\n", indentby, "",
o.subclass.block_data->size.x,
o.subclass.block_data->size.y,
o.subclass.block_data->size.z);
printf("%*s axes (%g,%g,%g), (%g,%g,%g), (%g,%g,%g)\n",
indentby, "",
o.subclass.block_data->e1.x,
o.subclass.block_data->e1.y,
o.subclass.block_data->e1.z,
o.subclass.block_data->e2.x,
o.subclass.block_data->e2.y,
o.subclass.block_data->e2.z,
o.subclass.block_data->e3.x,
o.subclass.block_data->e3.y,
o.subclass.block_data->e3.z);
break;
case GEOM COMPOUND_GEOMETRIC_OBJECT:
{
int i;
int n = o.subclass.compound_geometric_object_data
->component_objects.num_items;
geometric_object *os = o.subclass.compound_geometric_object_data
->component_objects.items;
printf("%*s %d components:\n", indentby, "", n);
for (i = 0; i < n; ++i)
display_geometric_object_info(indentby + 5, os[i]);
break;
}
default:
break;
}
}
/**************************************************************************/
/* Compute the intersections with o of a line along p+s*d, returning
the number of intersections (at most 2) and the two intersection "s"
values in s[0] and s[1]. (Note: o must not be a compound object.) */
int intersect_line_with_object(vector3 p, vector3 d, geometric_object o,
double s[2])
{
p = vector3_minus(p, o.center);
s[0] = s[1] = 0;
switch (o.which_subclass) {
case GEOM SPHERE: {
number radius = o.subclass.sphere_data->radius;
vector3 dm = matrix3x3_vector3_mult(geometry_lattice.metric, d);
double a = vector3_dot(d, dm);
double b2 = -vector3_dot(dm, p);
double c = vector3_dot(p, matrix3x3_vector3_mult(
geometry_lattice.metric, p)) - radius * radius;
double discrim = b2*b2 - a*c;
if (discrim < 0)
return 0;
else if (discrim == 0) {
s[0] = b2 / a;
return 1;
}
else {
discrim = sqrt(discrim);
s[0] = (b2 + discrim) / a;
s[1] = (b2 - discrim) / a;
return 2;
}
}
case GEOM CYLINDER: {
vector3 dm = matrix3x3_vector3_mult(geometry_lattice.metric, d);
vector3 pm = matrix3x3_vector3_mult(geometry_lattice.metric, p);
number height = o.subclass.cylinder_data->height;
number radius = o.subclass.cylinder_data->radius;
number radius2 = o.subclass.cylinder_data->which_subclass == CYL CONE ? o.subclass.cylinder_data->subclass.cone_data->radius2 : radius;
double dproj = vector3_dot(o.subclass.cylinder_data->axis, dm);
double pproj = vector3_dot(o.subclass.cylinder_data->axis, pm);
double D = (radius2 - radius) / height;
double L = radius + (radius2 - radius) * 0.5 + pproj*D;
double a = vector3_dot(d,dm) - dproj*dproj * (1 + D*D);
double b2 = dproj * (pproj + D*L) - vector3_dot(p,dm);
double c = vector3_dot(p,pm) - pproj*pproj - L*L;
double discrim = b2*b2 - a*c;
int ret;
if (a == 0) { /* linear equation */
if (b2 == 0) {
if (c == 0) { /* infinite intersections */
s[0] = ((height * 0.5) - pproj) / dproj;
s[1] = -((height * 0.5) + pproj) / dproj;
return 2;
}
else
ret = 0;
}
else {
s[0] = 0.5 * c / b2;
ret = 1;
}
}
else if (discrim < 0)
ret = 0;
else if (discrim == 0) {
s[0] = b2 / a;
ret = 1;
}
else {
discrim = sqrt(discrim);
s[0] = (b2 + discrim) / a;
s[1] = (b2 - discrim) / a;
ret = 2;
}
if (ret == 2 && fabs(pproj + s[1] * dproj) > height * 0.5)
ret = 1;
if (ret >= 1 && fabs(pproj + s[0] * dproj) > height * 0.5) {
--ret;
s[0] = s[1];
}
if (ret == 2 || dproj == 0)
return ret;
/* find intersections with endcaps */
s[ret] = (height * 0.5 - pproj) / dproj;
if (a * s[ret]*s[ret] - 2*b2 * s[ret] + c <= 0)
++ret;
if (ret < 2) {
s[ret] = -(height * 0.5 + pproj) / dproj;
if (a * s[ret]*s[ret] - 2*b2 * s[ret] + c <= 0)
++ret;
}
if (ret == 2 && s[0] == s[1]) ret = 1;
return ret;
}
case GEOM BLOCK:
{
vector3 dproj = matrix3x3_vector3_mult(o.subclass.block_data->projection_matrix, d);
vector3 pproj = matrix3x3_vector3_mult(o.subclass.block_data->projection_matrix, p);
switch (o.subclass.block_data->which_subclass) {
case BLK BLOCK_SELF:
{
vector3 size = o.subclass.block_data->size;
int ret = 0;
size.x *= 0.5; size.y *= 0.5; size.z *= 0.5;
if (dproj.x != 0) {
s[ret] = (size.x - pproj.x) / dproj.x;
if (fabs(pproj.y+s[ret]*dproj.y) <= size.y &&
fabs(pproj.z+s[ret]*dproj.z) <= size.z)
++ret;
s[ret] = (-size.x - pproj.x) / dproj.x;
if (fabs(pproj.y+s[ret]*dproj.y) <= size.y &&
fabs(pproj.z+s[ret]*dproj.z) <= size.z)
++ret;
if (ret == 2) return 2;
}
if (dproj.y != 0) {
s[ret] = (size.y - pproj.y) / dproj.y;
if (fabs(pproj.x+s[ret]*dproj.x) <= size.x &&
fabs(pproj.z+s[ret]*dproj.z) <= size.z)
++ret;
if (ret == 2) return 2;
s[ret] = (-size.y - pproj.y) / dproj.y;
if (fabs(pproj.x+s[ret]*dproj.x) <= size.x &&
fabs(pproj.z+s[ret]*dproj.z) <= size.z)
++ret;
if (ret == 2) return 2;
}
if (dproj.z != 0) {
s[ret] = (size.z - pproj.z) / dproj.z;
if (fabs(pproj.x+s[ret]*dproj.x) <= size.x &&
fabs(pproj.y+s[ret]*dproj.y) <= size.y)
++ret;
if (ret == 2) return 2;
s[ret] = (-size.z - pproj.z) / dproj.z;
if (fabs(pproj.x+s[ret]*dproj.x) <= size.x &&
fabs(pproj.y+s[ret]*dproj.y) <= size.y)
++ret;
}
return ret;
}
case BLK ELLIPSOID:
{
vector3 isa = o.subclass.block_data->subclass.ellipsoid_data->inverse_semi_axes;
double a, b2, c, discrim;
dproj.x *= isa.x; dproj.y *= isa.y; dproj.z *= isa.z;
pproj.x *= isa.x; pproj.y *= isa.y; pproj.z *= isa.z;
a = vector3_dot(dproj, dproj);
b2 = -vector3_dot(dproj, pproj);
c = vector3_dot(pproj, pproj) - 1;
discrim = b2*b2 - a*c;
if (discrim < 0)
return 0;
else if (discrim == 0) {
s[0] = b2 / a;
return 1;
}
else {
discrim = sqrt(discrim);
s[0] = (b2 + discrim) / a;
s[1] = (b2 - discrim) / a;
return 2;
}
}
}
}
default:
return 0;
}
}
/**************************************************************************/
/* Given a basis (matrix columns are the basis unit vectors) and the
size of the lattice (in basis vectors), returns a new "square"
basis. This corresponds to a region of the same volume, but made
rectangular, suitable for outputing to an HDF file.
Given a vector in the range (0..1, 0..1, 0..1), multiplying by
the square basis matrix will yield the coordinates of a point
in the rectangular volume, given in the lattice basis. */
matrix3x3 CTLIO square_basis(matrix3x3 basis, vector3 size)
{
matrix3x3 square;
square.c0 = basis.c0;
square.c1 = vector3_minus(basis.c1, vector3_scale(vector3_dot(basis.c0,
basis.c1),
basis.c1));
square.c2 = vector3_minus(basis.c2, vector3_scale(vector3_dot(basis.c0,
basis.c2),
basis.c2));
square.c2 = vector3_minus(square.c2, vector3_scale(vector3_dot(basis.c0,
square.c2),
unit_vector3(square.c2)));
square.c0 = vector3_scale(size.x, square.c0);
square.c1 = vector3_scale(size.y, square.c1);
square.c2 = vector3_scale(size.z, square.c2);
return matrix3x3_mult(matrix3x3_inverse(basis), square);
}
/**************************************************************************/
/**************************************************************************/
/* Fast geometry routines */
/* Using the above material_of_point routine is way too slow, especially
when there are lots of objects to test. Thus, we develop the following
replacement routines.
The basic idea here is twofold. (1) Compute bounding boxes for
each geometric object, for which inclusion tests can be computed
quickly. (2) Build a tree that recursively breaks down the unit cell
in half, allowing us to perform searches in logarithmic time. */
/**************************************************************************/
/* geom_box utilities: */
#define MAX(a,b) ((a) > (b) ? (a) : (b))
#define MIN(a,b) ((a) < (b) ? (a) : (b))
static void geom_box_union(geom_box *bu,
const geom_box *b1, const geom_box *b2)
{
bu->low.x = MIN(b1->low.x, b2->low.x);
bu->low.y = MIN(b1->low.y, b2->low.y);
bu->low.z = MIN(b1->low.z, b2->low.z);
bu->high.x = MAX(b1->high.x, b2->high.x);
bu->high.y = MAX(b1->high.y, b2->high.y);
bu->high.z = MAX(b1->high.z, b2->high.z);
}
static void geom_box_intersection(geom_box *bi,
const geom_box *b1,
const geom_box *b2)
{
bi->low.x = MAX(b1->low.x, b2->low.x);
bi->low.y = MAX(b1->low.y, b2->low.y);
bi->low.z = MAX(b1->low.z, b2->low.z);
bi->high.x = MIN(b1->high.x, b2->high.x);
bi->high.y = MIN(b1->high.y, b2->high.y);
bi->high.z = MIN(b1->high.z, b2->high.z);
}
static void geom_box_add_pt(geom_box *b, vector3 p)
{
b->low.x = MIN(b->low.x, p.x);
b->low.y = MIN(b->low.y, p.y);
b->low.z = MIN(b->low.z, p.z);
b->high.x = MAX(b->high.x, p.x);
b->high.y = MAX(b->high.y, p.y);
b->high.z = MAX(b->high.z, p.z);
}
#define BETWEEN(x, low, high) ((x) >= (low) && (x) <= (high))
static int geom_box_contains_point(const geom_box *b, vector3 p)
{
return (BETWEEN(p.x, b->low.x, b->high.x) &&
BETWEEN(p.y, b->low.y, b->high.y) &&
BETWEEN(p.z, b->low.z, b->high.z));
}
/* return whether or not the given two boxes intersect */
static int geom_boxes_intersect(const geom_box *b1, const geom_box *b2)
{
/* true if the x, y, and z ranges all intersect. */
return ((BETWEEN(b1->low.x, b2->low.x, b2->high.x) ||
BETWEEN(b1->high.x, b2->low.x, b2->high.x) ||
BETWEEN(b2->low.x, b1->low.x, b1->high.x)) &&
(BETWEEN(b1->low.y, b2->low.y, b2->high.y) ||
BETWEEN(b1->high.y, b2->low.y, b2->high.y) ||
BETWEEN(b2->low.y, b1->low.y, b1->high.y)) &&
(BETWEEN(b1->low.z, b2->low.z, b2->high.z) ||
BETWEEN(b1->high.z, b2->low.z, b2->high.z) ||
BETWEEN(b2->low.z, b1->low.z, b1->high.z)));
}
static void geom_box_shift(geom_box *b, vector3 shiftby)
{
b->low = vector3_plus(b->low, shiftby);
b->high = vector3_plus(b->high, shiftby);
}
/**************************************************************************/
/* Computing a bounding box for a geometric object: */
/* compute | (b x c) / (a * (b x c)) |, for use below */
static number compute_dot_cross(vector3 a, vector3 b, vector3 c)
{
vector3 bxc = vector3_cross(b, c);
return fabs(vector3_norm(bxc) / vector3_dot(a, bxc));
}
/* Compute a bounding box for the object o, preferably the smallest
bounding box. The box is a parallelepiped with axes given by
the geometry lattice vectors, and its corners are given in the
lattice basis.
Requires that geometry_lattice global has been initialized,
etcetera. */
void geom_get_bounding_box(geometric_object o, geom_box *box)
{
geom_fix_object(o);
/* initialize to empty box at the center of the object: */
box->low = box->high = o.center;
switch (o.which_subclass) {
case GEOM GEOMETRIC_OBJECT_SELF:
break;
case GEOM SPHERE:
{
/* Find the parallelepiped that the sphere inscribes.
The math comes out surpisingly simple--try it! */
number radius = o.subclass.sphere_data->radius;
/* actually, we could achieve the same effect here
by inverting the geometry_lattice.basis matrix... */
number r1 = compute_dot_cross(geometry_lattice.b1,
geometry_lattice.b2,
geometry_lattice.b3) * radius;
number r2 = compute_dot_cross(geometry_lattice.b2,
geometry_lattice.b3,
geometry_lattice.b1) * radius;
number r3 = compute_dot_cross(geometry_lattice.b3,
geometry_lattice.b1,
geometry_lattice.b2) * radius;
box->low.x -= r1;
box->low.y -= r2;
box->low.z -= r3;
box->high.x += r1;
box->high.y += r2;
box->high.z += r3;
break;
}
case GEOM CYLINDER:
{
/* Find the bounding boxes of the two (circular) ends of
the cylinder, then take the union. Again, the math
for finding the bounding parallelepiped of a circle
comes out suprisingly simple in the end. Proof left
as an exercise for the reader. */
number radius = o.subclass.cylinder_data->radius;
number h = o.subclass.cylinder_data->height * 0.5;
vector3 axis = /* cylinder axis in cartesian coords */
matrix3x3_vector3_mult(geometry_lattice.basis,
o.subclass.cylinder_data->axis);
vector3 e12 = vector3_cross(geometry_lattice.basis1,
geometry_lattice.basis2);
vector3 e23 = vector3_cross(geometry_lattice.basis2,
geometry_lattice.basis3);
vector3 e31 = vector3_cross(geometry_lattice.basis3,
geometry_lattice.basis1);
number elen2, eproj;
number r1, r2, r3;
geom_box tmp_box;
/* Find bounding box dimensions, in lattice coords,
for the circular ends of the cylinder: */
elen2 = vector3_dot(e23, e23);
eproj = vector3_dot(e23, axis);
r1 = fabs(sqrt(fabs(elen2 - eproj*eproj)) /
vector3_dot(e23, geometry_lattice.b1));
elen2 = vector3_dot(e31, e31);
eproj = vector3_dot(e31, axis);
r2 = fabs(sqrt(fabs(elen2 - eproj*eproj)) /
vector3_dot(e31, geometry_lattice.b2));
elen2 = vector3_dot(e12, e12);
eproj = vector3_dot(e12, axis);
r3 = fabs(sqrt(fabs(elen2 - eproj*eproj)) /
vector3_dot(e12, geometry_lattice.b3));
/* Get axis in lattice coords: */
axis = o.subclass.cylinder_data->axis;
tmp_box = *box; /* set tmp_box to center of object */
/* bounding box for -h*axis cylinder end: */
box->low.x -= h * axis.x + r1*radius;
box->low.y -= h * axis.y + r2*radius;
box->low.z -= h * axis.z + r3*radius;
box->high.x -= h * axis.x - r1*radius;
box->high.y -= h * axis.y - r2*radius;
box->high.z -= h * axis.z - r3*radius;
if (o.subclass.cylinder_data->which_subclass == CYL CONE)
radius =
fabs(o.subclass.cylinder_data->subclass.cone_data->radius2);
/* bounding box for +h*axis cylinder end: */
tmp_box.low.x += h * axis.x - r1*radius;
tmp_box.low.y += h * axis.y - r2*radius;
tmp_box.low.z += h * axis.z - r3*radius;
tmp_box.high.x += h * axis.x + r1*radius;
tmp_box.high.y += h * axis.y + r2*radius;
tmp_box.high.z += h * axis.z + r3*radius;
geom_box_union(box, box, &tmp_box);
break;
}
case GEOM BLOCK:
{
/* blocks are easy: just enlarge the box to be big enough to
contain all 8 corners of the block. */
vector3 s1 = vector3_scale(o.subclass.block_data->size.x,
o.subclass.block_data->e1);
vector3 s2 = vector3_scale(o.subclass.block_data->size.y,
o.subclass.block_data->e2);
vector3 s3 = vector3_scale(o.subclass.block_data->size.z,
o.subclass.block_data->e3);
vector3 corner =
vector3_plus(o.center,
vector3_scale(-0.5,
vector3_plus(s1, vector3_plus(s2, s3))));
geom_box_add_pt(box, corner);
geom_box_add_pt(box, vector3_plus(corner, s1));
geom_box_add_pt(box, vector3_plus(corner, s2));
geom_box_add_pt(box, vector3_plus(corner, s3));
geom_box_add_pt(box, vector3_plus(corner, vector3_plus(s1, s2)));
geom_box_add_pt(box, vector3_plus(corner, vector3_plus(s1, s3)));
geom_box_add_pt(box, vector3_plus(corner, vector3_plus(s3, s2)));
geom_box_add_pt(box,
vector3_plus(corner, vector3_plus(s1, vector3_plus(s2, s3))));
break;
}
case GEOM COMPOUND_GEOMETRIC_OBJECT:
{
int i;
int n = o.subclass.compound_geometric_object_data
->component_objects.num_items;
geometric_object *os = o.subclass.compound_geometric_object_data
->component_objects.items;
for (i = 0; i < n; ++i) {
geom_box boxi;
geom_get_bounding_box(os[i], &boxi);
geom_box_shift(&boxi, o.center);
geom_box_union(box, box, &boxi);
}
break;
}
}
}
/**************************************************************************/
/* Compute the fraction of a box's volume (or area/length in 2d/1d) that
overlaps an object. Instead of a box, we also allow an ellipsoid
inscribed inside the box (or a skewed ellipsoid if the box is not
orthogonal). */
typedef struct {
geometric_object o;
vector3 p, dir;
int pdim[2]; /* the (up to two) integration directions */
double scx[2]; /* scale factor (e.g. sign flip) for x coordinates */
unsigned dim;
double a0, b0; /* box limits along analytic direction */
int is_ellipsoid; /* 0 for box, 1 for ellipsoid */
double winv[2], c[2]; /* ellipsoid width-inverses/centers in int. dirs */
double w0, c0; /* width/center along analytic direction */
} overlap_data;
static double overlap_integrand(integer ndim, number *x, void *data_)
{
overlap_data *data = (overlap_data *) data_;
double s[2];
const double *scx = data->scx;
vector3 p = data->p;
double a0 = data->a0, b0 = data->b0;
double scale_result = 1.0;
if (ndim > 0) {
switch (data->pdim[0]) {
case 0: p.x = scx[0] * x[0]; break;
case 1: p.y = scx[0] * x[0]; break;
case 2: p.z = scx[0] * x[0]; break;
}
if (ndim > 1) {
switch (data->pdim[1]) {
case 0: p.x = scx[1] * x[1]; break;
case 1: p.y = scx[1] * x[1]; break;
case 2: p.z = scx[1] * x[1]; break;
}
}
}
if (data->is_ellipsoid && ndim > 0) {
/* compute width of ellipsoid at this point, along the
analytic-intersection direction */
double dx = (x[0] - data->c[0]) * data->winv[0];
double w = 1.0 - dx * dx;
if (ndim > 1) { /* rescale 2nd dimension to stay inside ellipsoid */
double x1;
if (w < 0) return 0.0; /* outside the ellipsoid */
scale_result = sqrt(w);
x1 = data->c[1] + (x[1] - data->c[1]) * scale_result;
switch (data->pdim[1]) {
case 0: p.x = scx[1] * x1; break;
case 1: p.y = scx[1] * x1; break;
case 2: p.z = scx[1] * x1; break;
}
dx = (x1 - data->c[1]) * data->winv[1];
w -= dx * dx;
}
if (w < 0) return 0.0; /* outside the ellipsoid */
w = data->w0 * sqrt(w);
a0 = data->c0 - w; b0 = data->c0 + w;
}
if (2 == intersect_line_with_object(p, data->dir, data->o, s)) {
double ds = (s[0] < s[1]
? MIN(s[1],b0) - MAX(s[0],a0)
: MIN(s[0],b0) - MAX(s[1],a0));
return (ds > 0 ? ds * scale_result : 0.0);
}
return 0.0;
}
number overlap_with_object(geom_box b, int is_ellipsoid, geometric_object o,
number tol, integer maxeval)
{
overlap_data data;
int empty_x = b.low.x == b.high.x;
int empty_y = b.low.y == b.high.y;
int empty_z = b.low.z == b.high.z;
double V0 = ((empty_x ? 1 : b.high.x - b.low.x) *
(empty_y ? 1 : b.high.y - b.low.y) *
(empty_z ? 1 : b.high.z - b.low.z));
vector3 ex = {1,0,0}, ey = {0,1,0}, ez = {0,0,1};
geom_box bb;
double xmin[2] = {0,0}, xmax[2] = {0,0}, esterr;
int errflag;
unsigned i;
geom_get_bounding_box(o, &bb);
geom_box_intersection(&bb, &b, &bb);
if (bb.low.x > bb.high.x || bb.low.y > bb.high.y || bb.low.z > bb.high.z
|| (!empty_x && bb.low.x == bb.high.x)
|| (!empty_y && bb.low.y == bb.high.y)
|| (!empty_z && bb.low.z == bb.high.z))
return 0.0;
data.winv[0] = data.winv[1] = data.w0 = 1.0;
data.c[0] = data.c[1] = data.c0 = 0;
data.o = o;
data.p.x = data.p.y = data.p.z = 0;
data.dim = 0;
if (!empty_x) {
data.dir = ex;
data.a0 = bb.low.x;
data.b0 = bb.high.x;
data.w0 = 0.5 * (b.high.x - b.low.x);
data.c0 = 0.5 * (b.high.x + b.low.x);
if (!empty_y) {
xmin[data.dim] = bb.low.y;
xmax[data.dim] = bb.high.y;
data.winv[data.dim] = 2.0 / (b.high.y - b.low.y);
data.c[data.dim] = 0.5 * (b.high.y + b.low.y);
data.pdim[data.dim++] = 1;
}
if (!empty_z) {
xmin[data.dim] = bb.low.z;
xmax[data.dim] = bb.high.z;
data.winv[data.dim] = 2.0 / (b.high.z - b.low.z);
data.c[data.dim] = 0.5 * (b.high.z + b.low.z);
data.pdim[data.dim++] = 2;
}
}
else if (!empty_y) {
data.dir = ey;
data.a0 = bb.low.y;
data.b0 = bb.high.y;
data.w0 = 0.5 * (b.high.y - b.low.y);
data.c0 = 0.5 * (b.high.y + b.low.y);
if (!empty_x) {
xmin[data.dim] = bb.low.x;
xmax[data.dim] = bb.high.x;
data.winv[data.dim] = 2.0 / (b.high.x - b.low.x);
data.c[data.dim] = 0.5 * (b.high.x + b.low.x);
data.pdim[data.dim++] = 0;
}
if (!empty_z) {
xmin[data.dim] = bb.low.z;
xmax[data.dim] = bb.high.z;
data.winv[data.dim] = 2.0 / (b.high.z - b.low.z);
data.c[data.dim] = 0.5 * (b.high.z + b.low.z);
data.pdim[data.dim++] = 2;
}
}
else if (!empty_z) {
data.dir = ez;
data.a0 = bb.low.z;
data.b0 = bb.high.z;
data.w0 = 0.5 * (b.high.z - b.low.z);
data.c0 = 0.5 * (b.high.z + b.low.z);
if (!empty_x) {
xmin[data.dim] = bb.low.x;
xmax[data.dim] = bb.high.x;
data.winv[data.dim] = 2.0 / (b.high.x - b.low.x);
data.c[data.dim] = 0.5 * (b.high.x + b.low.x);
data.pdim[data.dim++] = 0;
}
if (!empty_y) {
xmin[data.dim] = bb.low.y;
xmax[data.dim] = bb.high.y;
data.winv[data.dim] = 2.0 / (b.high.y - b.low.y);
data.c[data.dim] = 0.5 * (b.high.y + b.low.y);
data.pdim[data.dim++] = 1;
}
}
else
return 1.0;
#if 1
/* To maintain mirror symmetries through the x/y/z axes, we flip
the integration range whenever xmax < 0. (This is in case
the integration routine is not fully symmetric, which may
happen(?) due to the upper bound on the #evaluations.)*/
for (i = 0; i < data.dim; ++i) {
if (xmax[i] < 0) {
double xm = xmin[i];
data.scx[i] = -1;
xmin[i] = -xmax[i];
xmax[i] = -xm;
data.c[i] = -data.c[i];
}
else
data.scx[i] = 1;
}
#else
for (i = 0; i < data.dim; ++i) data.scx[i] = 1;
#endif
if ((data.is_ellipsoid = is_ellipsoid)) { /* data for ellipsoid calc. */
if (data.dim == 1)
V0 *= K_PI / 4;
else if (data.dim == 2)
V0 *= K_PI / 6;
}
return adaptive_integration(overlap_integrand, xmin, xmax,
data.dim, &data,
0.0, tol, maxeval,
&esterr, &errflag) / V0;
}
number box_overlap_with_object(geom_box b, geometric_object o,
number tol, integer maxeval)
{
return overlap_with_object(b, 0, o, tol, maxeval);
}
number ellipsoid_overlap_with_object(geom_box b, geometric_object o,
number tol, integer maxeval)
{
return overlap_with_object(b, 1, o, tol, maxeval);
}
number CTLIO range_overlap_with_object(vector3 low, vector3 high,
geometric_object o, number tol,
integer maxeval)
{
geom_box b;
b.low = low;
b.high = high;
return box_overlap_with_object(b, o, tol, maxeval);
}
/**************************************************************************/
/* geom_box_tree: a tree of boxes and the objects contained within
them. The tree recursively partitions the unit cell, allowing us
to perform binary searches for the object containing a given point. */
void destroy_geom_box_tree(geom_box_tree t)
{
if (t) {
destroy_geom_box_tree(t->t1);
destroy_geom_box_tree(t->t2);
if (t->nobjects && t->objects)
FREE(t->objects);
FREE1(t);
}
}
/* return whether the object o, shifted by the vector shiftby,
possibly intersects b. Upon return, obj_b is the bounding
box for o. */
static int object_in_box(geometric_object o, vector3 shiftby,
geom_box *obj_b, const geom_box *b)
{
geom_get_bounding_box(o, obj_b);
geom_box_shift(obj_b, shiftby);
return geom_boxes_intersect(obj_b, b);
}
#define CHECK(cond, s) if (!(cond)){fprintf(stderr,s "\n");exit(EXIT_FAILURE);}
static geom_box_tree new_geom_box_tree(void)
{
geom_box_tree t;
t = MALLOC1(struct geom_box_tree_struct);
CHECK(t, "out of memory");
t->t1 = t->t2 = NULL;
t->nobjects = 0;
t->objects = NULL;
return t;
}
/* Divide b into b1 and b2, cutting b in two along the axis
divide_axis (0 = x, 1 = y, 2 = z) at divide_point. */
static void divide_geom_box(const geom_box *b,
int divide_axis, number divide_point,
geom_box *b1, geom_box *b2)
{
*b1 = *b2 = *b;
switch (divide_axis) {
case 0:
b1->high.x = b2->low.x = divide_point;
break;
case 1:
b1->high.y = b2->low.y = divide_point;
break;
case 2:
b1->high.z = b2->low.z = divide_point;
break;
}
}
#define VEC_I(v,i) ((i) == 0 ? (v).x : ((i) == 1 ? (v).y : (v).z))
#define SMALL 1.0e-7
/* Find the best place (best_partition) to "cut" along the axis
divide_axis in order to maximally divide the objects between
the partitions. Upon return, n1 and n2 are the number of objects
below and above the partition, respectively. */
static void find_best_partition(int nobjects, const geom_box_object *objects,
int divide_axis,
number *best_partition, int *n1, int *n2)
{
number cur_partition;
int i, j, cur_n1, cur_n2;
*n1 = *n2 = nobjects + 1;
*best_partition = 0;
/* Search for the best partition, by checking all possible partitions
either just above the high end of an object or just below the
low end of an object. */
for (i = 0; i < nobjects; ++i) {
cur_partition = VEC_I(objects[i].box.high, divide_axis) + SMALL;
cur_n1 = cur_n2 = 0;
for (j = 0; j < nobjects; ++j) {
if (VEC_I(objects[j].box.low, divide_axis) <= cur_partition)
++cur_n1;
if (VEC_I(objects[j].box.high, divide_axis) >= cur_partition)
++cur_n2;
}
CHECK(cur_n1 + cur_n2 >= nobjects, "bug 1 in find_best_partition");
if (MAX(cur_n1, cur_n2) < MAX(*n1, *n2)) {
*best_partition = cur_partition;
*n1 = cur_n1;
*n2 = cur_n2;
}
}
for (i = 0; i < nobjects; ++i) {
cur_partition = VEC_I(objects[i].box.low, divide_axis) - SMALL;
cur_n1 = cur_n2 = 0;
for (j = 0; j < nobjects; ++j) {
if (VEC_I(objects[j].box.low, divide_axis) <= cur_partition)
++cur_n1;
if (VEC_I(objects[j].box.high, divide_axis) >= cur_partition)
++cur_n2;
}
CHECK(cur_n1 + cur_n2 >= nobjects, "bug 2 in find_best_partition");
if (MAX(cur_n1, cur_n2) < MAX(*n1, *n2)) {
*best_partition = cur_partition;
*n1 = cur_n1;
*n2 = cur_n2;
}
}
}
/* divide_geom_box_tree: recursively divide t in two, each time
dividing along the axis that maximally partitions the boxes,
and only stop partitioning when partitioning doesn't help any
more. Upon return, t points to the partitioned tree. */
static void divide_geom_box_tree(geom_box_tree t)
{
int division_nobjects[3][2] = {{0,0},{0,0},{0,0}};
number division_point[3];
int best = 0;
int i, j, n1, n2;
if (!t)
return;
if (t->t1 || t->t2) { /* this node has already been divided */
divide_geom_box_tree(t->t1);
divide_geom_box_tree(t->t2);
return;
}
if (t->nobjects <= 2)
return; /* no point in partitioning */
/* Try partitioning along each dimension, counting the
number of objects in the partitioned boxes and finding
the best partition. */
for (i = 0; i < dimensions; ++i) {
find_best_partition(t->nobjects, t->objects, i, &division_point[i],
&division_nobjects[i][0],
&division_nobjects[i][1]);
if (MAX(division_nobjects[i][0], division_nobjects[i][1]) <
MAX(division_nobjects[best][0], division_nobjects[best][1]))
best = i;
}
/* don't do anything if division makes the worst case worse or if
it fails to improve the best case: */
if (MAX(division_nobjects[best][0], division_nobjects[best][1]) + 1 >
t->nobjects ||
MIN(division_nobjects[best][0], division_nobjects[best][1]) + 1 >=
t->nobjects)
return; /* division didn't help us */
divide_geom_box(&t->b, best, division_point[best], &t->b1, &t->b2);
t->t1 = new_geom_box_tree();
t->t2 = new_geom_box_tree();
t->t1->b = t->b1;
t->t2->b = t->b2;
t->t1->nobjects = division_nobjects[best][0];
t->t1->objects = MALLOC(geom_box_object, t->t1->nobjects);
CHECK(t->t1->objects, "out of memory");
t->t2->nobjects = division_nobjects[best][1];
t->t2->objects = MALLOC(geom_box_object, t->t2->nobjects);
CHECK(t->t2->objects, "out of memory");
for (j = n1 = n2 = 0; j < t->nobjects; ++j) {
if (geom_boxes_intersect(&t->b1, &t->objects[j].box)) {
CHECK(n1 < t->t1->nobjects, "BUG in divide_geom_box_tree");
t->t1->objects[n1++] = t->objects[j];
}
if (geom_boxes_intersect(&t->b2, &t->objects[j].box)) {
CHECK(n2 < t->t2->nobjects, "BUG in divide_geom_box_tree");
t->t2->objects[n2++] = t->objects[j];
}
}
CHECK(j == t->nobjects && n1 == t->t1->nobjects && n2 == t->t2->nobjects,
"BUG in divide_geom_box_tree: wrong nobjects");
t->nobjects = 0;
FREE(t->objects);
t->objects = NULL;
divide_geom_box_tree(t->t1);
divide_geom_box_tree(t->t2);
}
geom_box_tree create_geom_box_tree(void)
{
geom_box b0;
b0.low = vector3_plus(geometry_center,
vector3_scale(-0.5, geometry_lattice.size));
b0.high = vector3_plus(geometry_center,
vector3_scale(0.5, geometry_lattice.size));
return create_geom_box_tree0(geometry, b0);
}
static int num_objects_in_box(const geometric_object *o, vector3 shiftby,
const geom_box *b)
{
if (o->which_subclass == GEOM COMPOUND_GEOMETRIC_OBJECT) {
int n = o->subclass.compound_geometric_object_data
->component_objects.num_items;
geometric_object *os = o->subclass.compound_geometric_object_data
->component_objects.items;
int i, sum = 0;
shiftby = vector3_plus(shiftby, o->center);
for (i = 0; i < n; ++i)
sum += num_objects_in_box(os + i, shiftby, b);
return sum;
}
else {
geom_box ob;
return object_in_box(*o, shiftby, &ob, b);
}
}
static int store_objects_in_box(const geometric_object *o, vector3 shiftby,
const geom_box *b,
geom_box_object *bo,
int precedence)
{
if (o->which_subclass == GEOM COMPOUND_GEOMETRIC_OBJECT) {
int n = o->subclass.compound_geometric_object_data
->component_objects.num_items;
geometric_object *os = o->subclass.compound_geometric_object_data
->component_objects.items;
int i, sum = 0;
shiftby = vector3_plus(shiftby, o->center);
for (i = 0; i < n; ++i)
sum += store_objects_in_box(os + i, shiftby, b, bo + sum,
precedence - sum);
return sum;
}
else {
geom_box ob;
if (object_in_box(*o, shiftby, &ob, b)) {
bo->box = ob;
bo->o = o;
bo->shiftby = shiftby;
bo->precedence = precedence;
return 1;
}
else
return 0;
}
}
geom_box_tree create_geom_box_tree0(geometric_object_list geometry,
geom_box b0)
{
geom_box_tree t = new_geom_box_tree();
int i, index;
t->b = b0;
for (i = geometry.num_items - 1; i >= 0; --i) {
vector3 shiftby = {0,0,0};
if (ensure_periodicity) {
LOOP_PERIODIC(shiftby,
t->nobjects += num_objects_in_box(
geometry.items + i, shiftby, &t->b));
}
else
t->nobjects += num_objects_in_box(
geometry.items + i, shiftby, &t->b);
}
t->objects = MALLOC(geom_box_object, t->nobjects);
CHECK(t->objects || t->nobjects == 0, "out of memory");
for (i = geometry.num_items - 1, index = 0; i >= 0; --i) {
vector3 shiftby = {0,0,0};
if (ensure_periodicity) {
int precedence = t->nobjects - index;
LOOP_PERIODIC(shiftby,
index += store_objects_in_box(
geometry.items + i, shiftby, &t->b,
t->objects + index, precedence));
}
else
index += store_objects_in_box(
geometry.items + i, shiftby, &t->b,
t->objects + index, t->nobjects - index);
}
CHECK(index == t->nobjects, "bug in create_geom_box_tree0");
divide_geom_box_tree(t);
return t;
}
/* create a new tree from t, pruning all nodes that don't intersect b */
geom_box_tree restrict_geom_box_tree(geom_box_tree t, const geom_box *b)
{
geom_box_tree tr;
int i, j;
if (!t || !geom_boxes_intersect(&t->b, b))
return NULL;
tr = new_geom_box_tree();
for (i = 0, j = 0; i < t->nobjects; ++i)
if (geom_boxes_intersect(&t->objects[i].box, b))
++j;
tr->nobjects = j;
tr->objects = MALLOC(geom_box_object, tr->nobjects);
CHECK(tr->objects || tr->nobjects == 0, "out of memory");
for (i = 0, j = 0; i < t->nobjects; ++i)
if (geom_boxes_intersect(&t->objects[i].box, b))
tr->objects[j++] = t->objects[i];
tr->t1 = restrict_geom_box_tree(t->t1, b);
tr->t2 = restrict_geom_box_tree(t->t2, b);
if (tr->nobjects == 0) {
if (tr->t1 && !tr->t2) {
geom_box_tree tr0 = tr;
tr = tr->t1;
FREE1(tr0);
}
else if (tr->t2 && !tr->t1) {
geom_box_tree tr0 = tr;
tr = tr->t2;
FREE1(tr0);
}
}
return tr;
}
/**************************************************************************/
/* recursively search the tree for the given point, returning the
subtree (if any) that contains it and the index oindex of the
object in that tree. The input value of oindex indicates the
starting object to search in t (0 to search all). */
static geom_box_tree tree_search(vector3 p, geom_box_tree t, int *oindex)
{
int i;
geom_box_tree gbt;
if (!t || !geom_box_contains_point(&t->b, p))
return NULL;
for (i = *oindex; i < t->nobjects; ++i)
if (geom_box_contains_point(&t->objects[i].box, p) &&
point_in_fixed_objectp(vector3_minus(p, t->objects[i].shiftby),
*t->objects[i].o)) {
*oindex = i;
return t;
}
*oindex = 0;
gbt = tree_search(p, t->t1, oindex);
if (!gbt)
gbt = tree_search(p, t->t2, oindex);
return gbt;
}
/* shift p to be within the unit cell of the lattice (centered on the
origin) */
vector3 shift_to_unit_cell(vector3 p)
{
while (p.x >= 0.5 * geometry_lattice.size.x)
p.x -= geometry_lattice.size.x;
while (p.x < -0.5 * geometry_lattice.size.x)
p.x += geometry_lattice.size.x;
while (p.y >= 0.5 * geometry_lattice.size.y)
p.y -= geometry_lattice.size.y;
while (p.y < -0.5 * geometry_lattice.size.y)
p.y += geometry_lattice.size.y;
while (p.z >= 0.5 * geometry_lattice.size.z)
p.z -= geometry_lattice.size.z;
while (p.z < -0.5 * geometry_lattice.size.z)
p.z += geometry_lattice.size.z;
return p;
}
const geometric_object *object_of_point_in_tree(vector3 p, geom_box_tree t,
vector3 *shiftby,
int *precedence)
{
int oindex = 0;
t = tree_search(p, t, &oindex);
if (t) {
geom_box_object *gbo = t->objects + oindex;
*shiftby = gbo->shiftby;
*precedence = gbo->precedence;
return gbo->o;
}
else {
shiftby->x = shiftby->y = shiftby->z = 0;
*precedence = 0;
return 0;
}
}
material_type material_of_unshifted_point_in_tree_inobject(
vector3 p, geom_box_tree t, boolean *inobject)
{
int oindex = 0;
t = tree_search(p, t, &oindex);
if (t) {
*inobject = 1;
return (t->objects[oindex].o->material);
}
else {
*inobject = 0;
return default_material;
}
}
material_type material_of_point_in_tree_inobject(vector3 p, geom_box_tree t,
boolean *inobject)
{
/* backwards compatibility */
return material_of_unshifted_point_in_tree_inobject(
shift_to_unit_cell(p), t, inobject);
}
material_type material_of_point_in_tree(vector3 p, geom_box_tree t)
{
boolean inobject;
return material_of_point_in_tree_inobject(p, t, &inobject);
}
geom_box_tree geom_tree_search_next(vector3 p, geom_box_tree t, int *oindex)
{
*oindex += 1; /* search starting at next oindex */
return tree_search(p, t, oindex);
}
geom_box_tree geom_tree_search(vector3 p, geom_box_tree t, int *oindex)
{
*oindex = -1; /* search all indices > -1 */
return geom_tree_search_next(p, t, oindex);
}
/**************************************************************************/
/* convert a vector p in the given object to some coordinate
in [0,1]^3 that is a more "natural" map of the object interior. */
vector3 to_geom_box_coords(vector3 p, geom_box_object *gbo)
{
return to_geom_object_coords(vector3_minus(p, gbo->shiftby), *gbo->o);
}
/**************************************************************************/
void display_geom_box_tree(int indentby, geom_box_tree t)
{
int i;
if (!t)
return;
printf("%*sbox (%g..%g, %g..%g, %g..%g)\n", indentby, "",
t->b.low.x, t->b.high.x,
t->b.low.y, t->b.high.y,
t->b.low.z, t->b.high.z);
for (i = 0; i < t->nobjects; ++i) {
printf("%*sbounding box (%g..%g, %g..%g, %g..%g)\n", indentby+5, "",
t->objects[i].box.low.x, t->objects[i].box.high.x,
t->objects[i].box.low.y, t->objects[i].box.high.y,
t->objects[i].box.low.z, t->objects[i].box.high.z);
printf("%*sshift object by (%g, %g, %g)\n", indentby+5, "",
t->objects[i].shiftby.x, t->objects[i].shiftby.y,
t->objects[i].shiftby.z);
display_geometric_object_info(indentby + 5, *t->objects[i].o);
}
display_geom_box_tree(indentby + 5, t->t1);
display_geom_box_tree(indentby + 5, t->t2);
}
/**************************************************************************/
/* Computing tree statistics (depth and number of nodes): */
/* helper function for geom_box_tree_stats */
static void get_tree_stats(geom_box_tree t, int *depth, int *nobjects)
{
if (t) {
int d1, d2;
*nobjects += t->nobjects;
d1 = d2 = *depth + 1;
get_tree_stats(t->t1, &d1, nobjects);
get_tree_stats(t->t2, &d2, nobjects);
*depth = MAX(d1, d2);
}
}
void geom_box_tree_stats(geom_box_tree t, int *depth, int *nobjects)
{
*depth = *nobjects = 0;
get_tree_stats(t, depth, nobjects);
}
/**************************************************************************/
vector3 get_grid_size(void)
{
return ctl_convert_vector3_to_c(gh_call0(gh_lookup("get-grid-size")));
}
vector3 get_resolution(void)
{
return ctl_convert_vector3_to_c(gh_call0(gh_lookup("get-resolution")));
}
void get_grid_size_n(int *nx, int *ny, int *nz)
{
vector3 grid_size;
grid_size = get_grid_size();
*nx = (int) grid_size.x;
*ny = (int) grid_size.y;
*nz = (int) grid_size.z;
}
/**************************************************************************/
/* constructors for the geometry types (ugh, wish these
could be automatically generated from geom.scm) */
geometric_object make_geometric_object(material_type material, vector3 center)
{
geometric_object o;
material_type_copy(&material, &o.material);
o.center = center;
o.which_subclass = GEOM GEOMETRIC_OBJECT_SELF;
return o;
}
geometric_object make_cylinder(material_type material, vector3 center,
number radius, number height, vector3 axis)
{
geometric_object o = make_geometric_object(material, center);
o.which_subclass = GEOM CYLINDER;
o.subclass.cylinder_data = MALLOC1(cylinder);
CHECK(o.subclass.cylinder_data, "out of memory");
o.subclass.cylinder_data->radius = radius;
o.subclass.cylinder_data->height = height;
o.subclass.cylinder_data->axis = axis;
o.subclass.cylinder_data->which_subclass = CYL CYLINDER_SELF;
geom_fix_object(o);
return o;
}
geometric_object make_cone(material_type material, vector3 center,
number radius, number height, vector3 axis,
number radius2)
{
geometric_object o = make_cylinder(material, center, radius,height, axis);
o.subclass.cylinder_data->which_subclass = CYL CONE;
o.subclass.cylinder_data->subclass.cone_data = MALLOC1(cone);
CHECK(o.subclass.cylinder_data->subclass.cone_data, "out of memory");
o.subclass.cylinder_data->subclass.cone_data->radius2 = radius2;
return o;
}
geometric_object make_wedge(material_type material, vector3 center,
number radius, number height, vector3 axis,
number wedge_angle, vector3 wedge_start)
{
geometric_object o = make_cylinder(material, center, radius,height, axis);
o.subclass.cylinder_data->which_subclass = CYL WEDGE;
o.subclass.cylinder_data->subclass.wedge_data = MALLOC1(wedge);
CHECK(o.subclass.cylinder_data->subclass.wedge_data, "out of memory");
o.subclass.cylinder_data->subclass.wedge_data->wedge_angle = wedge_angle;
o.subclass.cylinder_data->subclass.wedge_data->wedge_start = wedge_start;
geom_fix_object(o);
return o;
}
geometric_object make_sphere(material_type material, vector3 center,
number radius)
{
geometric_object o = make_geometric_object(material, center);
o.which_subclass = GEOM SPHERE;
o.subclass.sphere_data = MALLOC1(sphere);
CHECK(o.subclass.sphere_data, "out of memory");
o.subclass.sphere_data->radius = radius;
return o;
}
geometric_object make_block(material_type material, vector3 center,
vector3 e1, vector3 e2, vector3 e3,
vector3 size)
{
geometric_object o = make_geometric_object(material, center);
o.which_subclass = GEOM BLOCK;
o.subclass.block_data = MALLOC1(block);
CHECK(o.subclass.block_data, "out of memory");
o.subclass.block_data->e1 = e1;
o.subclass.block_data->e2 = e2;
o.subclass.block_data->e3 = e3;
o.subclass.block_data->size = size;
o.subclass.block_data->which_subclass = BLK BLOCK_SELF;
geom_fix_object(o);
return o;
}
geometric_object make_ellipsoid(material_type material, vector3 center,
vector3 e1, vector3 e2, vector3 e3,
vector3 size)
{
geometric_object o = make_block(material, center, e1,e2,e3, size);
o.subclass.block_data->which_subclass = BLK ELLIPSOID;
o.subclass.block_data->subclass.ellipsoid_data = MALLOC1(ellipsoid);
CHECK(o.subclass.block_data->subclass.ellipsoid_data, "out of memory");
o.subclass.block_data->subclass.ellipsoid_data->inverse_semi_axes.x
= 2.0 / size.x;
o.subclass.block_data->subclass.ellipsoid_data->inverse_semi_axes.y
= 2.0 / size.y;
o.subclass.block_data->subclass.ellipsoid_data->inverse_semi_axes.z
= 2.0 / size.z;
return o;
}
libctl-3.2.2/utils/gen-ctl-io.1 0000644 0001754 0000144 00000005444 12315325302 013073 0000000 0000000 .\" libctl: flexible Guile-based control files for scientific software
.\" Copyright (C) 1998, 1999, 2000, 2001, 2002, Steven G. Johnson
.\"
.\" This library is free software; you can redistribute it and/or
.\" modify it under the terms of the GNU Lesser General Public
.\" License as published by the Free Software Foundation; either
.\" version 2 of the License, or (at your option) any later version.
.\"
.\" This library is distributed in the hope that it will be useful,
.\" but WITHOUT ANY WARRANTY; without even the implied warranty of
.\" MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
.\" Lesser General Public License for more details.
.\"
.\" You should have received a copy of the GNU Lesser General Public
.\" License along with this library; if not, write to the
.\" Free Software Foundation, Inc., 59 Temple Place - Suite 330,
.\" Boston, MA 02111-1307, USA.
.\"
.\" Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
.\"
.TH GEN-CTL-IO 1 "March 27, 2006" "libctl" "libctl"
.SH NAME
gen-ctl-io \- generate C interface code for libctl control files
.SH SYNOPSIS
.B gen-ctl-io
[OPTION]... [\fIspec-file\fR]
.SH DESCRIPTION
.PP
." Add any additional description here
.B gen-ctl-io
generates C code to import/export the input/output
variables used in a libctl control file.
.B gen-ctl-io
generates files like \fIctl-io.h\fP and \fIctl-io.c\fP. These files define global variables, data structures, and functions for the input/output variables, classes, and function interfaces defined in the
.I spec-file
argument, automating the interaction between C and Guile.
The arguments such as
.B --code
and
.B --header
are used to control whether \fIctl-io.c\fP or \fIctl-io.h\fP,
etcetera, are generated. If no argument is specified then both of
these files are generated by default, for backwards compatibility.
libctl is a free library to aid in interfacing scientific software
with the GNU Guile scripting and extension language. Documentation
for it may be found online at the libctl home page:
.I http://ab-initio.mit.edu/libctl
.SH OPTIONS
.TP
\fB\--code\fR
Generate C (or C++) source code to implement the Guile interface
functions. The default output file name is ctl-io.c (in C) or
ctl-io.cpp (in C++).
.TP
\fB\--header\fR
Generate the header file declaring the interface data types and
functions. The default output file name is ctl-io.h (in C) or
ctl-io.hpp (in C++).
.TP
\fB\--swig\fR
Generate a SWIG interface definition file declaring automatic conversions
for the various libctl data types. The default output file name is
ctl-io.i.
.TP
\fB\--cxx\fR
Generate C++ code instead of C code.
.TP
\fB\-o\fR \fIfile\fR
Use
.I file
as the output file name instead of the defaults (above).
.SH BUGS
Send bug reports to S. G. Johnson, stevenj@alum.mit.edu.
.SH AUTHORS
Written by Steven G. Johnson.
libctl-3.2.2/utils/ctl-io.scm 0000644 0001754 0000144 00000074247 12315330377 012765 0000000 0000000 ; libctl: flexible Guile-based control files for scientific software
; Copyright (C) 1998-2014 Massachusetts Institute of Technology and Steven G. Johnson
;
; This library is free software; you can redistribute it and/or
; modify it under the terms of the GNU Lesser General Public
; License as published by the Free Software Foundation; either
; version 2 of the License, or (at your option) any later version.
;
; This library is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
; Lesser General Public License for more details.
;
; You should have received a copy of the GNU Lesser General Public
; License along with this library; if not, write to the
; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
; Boston, MA 02111-1307, USA.
;
; Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
; ***************************************************************************
; "Standard" Scheme functions missing from Guile 1.2:
(define (string-upcase s)
(list->string (map (lambda (c)
(if (and (char>=? c #\a) (char<=? c #\z))
(integer->char (+ (char->integer c)
(char->integer #\A)
(- (char->integer #\a))))
c))
(string->list s))))
; ***************************************************************************
(define cxx false) ; set to true for C++ output (c.f. gen-ctl-io --cxx)
(define namespace "ctlio")
(define (ns0) (ns namespace))
(define (ns namespace) (if cxx (string-append namespace "::") ""))
(define (c-identifier s)
(list->string (map (lambda (c)
(if (or (eq? c #\-) (eq? c #\space))
#\_ (if (eq? c #\?) #\p (if (eq? c #\!) #\B c))))
(string->list s))))
(define symbol->c-identifier (compose c-identifier symbol->string))
(define (c-type-string t)
(if (eq? t 'string) "char*" ; "string" name is reserved in C++
(c-identifier (type-string t))))
(define declared-type-names '())
(define (declare-type-name type-name)
(if (and (list-type-name? type-name)
(not (member (c-type-string type-name) declared-type-names)))
(begin
(if (list-type-name? (list-el-type-name type-name))
(declare-type-name (list-el-type-name type-name)))
(print "typedef struct {\n")
(print "int num_items;\n")
(print (c-type-string (list-el-type-name type-name))
" *items;\n")
(print "} " (c-type-string type-name) ";\n\n")
(set! declared-type-names (cons (c-type-string type-name)
declared-type-names)))))
(define (only-list-types type-names)
(list-transform-positive type-names list-type-name?))
(define (c-var-decl' var-name var-type-name ns)
(print (c-type-string var-type-name) " " ns
(symbol->c-identifier var-name) ";\n"))
(define (c-var-decl var-name var-type-name)
(c-var-decl' var-name var-type-name ""))
; ***************************************************************************
; use new/delete for C++, malloc/free for C
(define (free . vars)
(let ((var (apply string-append vars)))
(if cxx
(string-append "delete[] (" var ")")
(string-append "free(" var ")"))))
(define (free1 . vars)
(let ((var (apply string-append vars)))
(if cxx
(string-append "delete (" var ")")
(string-append "free(" var ")"))))
(define (malloc tname . nums)
(let ((num (apply string-append nums)))
(if cxx
(string-append "(new " tname "[" num "])")
(string-append
"((" tname " *) malloc(sizeof(" tname ") * (" num ")))"))))
(define (malloc1 . tnames)
(let ((tname (apply string-append tnames)))
(if cxx
(string-append "(new " tname ")")
(string-append "((" tname " *) malloc(sizeof(" tname ")))"))))
; ***************************************************************************
(define (find-direct-subclasses class)
(list-transform-positive class-list
(lambda (c) (eq? (class-parent c) class))))
(define (class-identifier class)
(symbol->c-identifier (class-type-name class)))
(define (class-enum-name0 class)
(string-upcase (class-identifier class)))
(define (class-enum-name class)
(string-append (ns (class-identifier (class-parent class)))
(class-enum-name0 class)))
(define (class-self-enum-name class)
(string-append (ns (class-identifier class))
(class-enum-name0 class) "_SELF"))
(define (c-class-decl class)
(for-each (compose declare-type-name property-type-name)
(class-properties class))
(print "typedef struct " (class-identifier class)
"_struct {\n")
(for-each
(lambda (property)
(c-var-decl (property-name property) (property-type-name property)))
(class-properties class))
(let ((subclasses (find-direct-subclasses class)))
(if (not (null? subclasses))
(begin
(print "enum { " (class-enum-name0 class) "_SELF")
(for-each (lambda (sc) (print ", " (class-enum-name0 sc)))
subclasses)
(print " } which_subclass;\n")
(print "union {\n")
(for-each (lambda (sc)
(print
"struct " (class-identifier sc) "_struct *"
(class-identifier sc) "_data;\n"))
subclasses)
(print "} subclass;\n"))))
(print "} " (class-identifier class) ";\n")
(if (and (not (null? (find-direct-subclasses class)))
(null? (class-properties class)))
(print "#define " (class-enum-name0 class) "_ABSTRACT 1\n"))
(print "\n"))
(define (display-c-class-decls)
(print "/******* Type declarations *******/\n\n")
(for-each c-class-decl (reverse class-list)))
; ***************************************************************************
(define (declare-var var)
(c-var-decl' (var-name var) (var-type-name var) (ns0)))
(define (declare-extern-var var)
(print "extern ")
(c-var-decl (var-name var) (var-type-name var)))
(define (declarer-if-not-input-var declarer)
(lambda (var)
(if (not (member var input-var-list))
(declarer var)
(begin (print "/* " (var-name var)
" is both input and output */\n")))))
(define (all-type-names)
(append
exported-type-list
(map var-type-name
(append (reverse input-var-list)
(reverse output-var-list)))
(map external-function-return-type-name
external-function-list)
(fold-left append '()
(map external-function-arg-type-names
external-function-list))))
(define (declare-var-types) (for-each declare-type-name (all-type-names)))
(define (declare-vars declarer)
(print "/******* Input variables *******/\n")
(for-each declarer (reverse input-var-list))
(print "\n")
(print "/******* Output variables *******/\n")
(for-each (declarer-if-not-input-var declarer) (reverse output-var-list))
(print "\n"))
(define (declare-vars-header)
(declare-var-types)
(declare-vars declare-extern-var))
(define (declare-vars-source) (declare-vars declare-var))
; ***************************************************************************
(define (input-value s-var-name-str c-var-name-str type-name getter)
(let ((desc (get-type-descriptor type-name)))
(cond
((eq? (type-descriptor-kind desc) 'simple)
(print c-var-name-str " = "
(getter type-name s-var-name-str) ";\n"))
((eq? (type-descriptor-kind desc) 'object)
(print (class-input-function-name type-name) "("
(getter 'object s-var-name-str)
", &" c-var-name-str ");\n"))
((eq? (type-descriptor-kind desc) 'uniform-list)
(input-list (getter 'list s-var-name-str) c-var-name-str
(list-el-type-name type-name))))))
(define (get-global type-symbol name-str)
(string-append "ctl_get_" (symbol->c-identifier type-symbol)
"(\"" name-str "\")" ))
(define (property-getter object-name-str)
(lambda (type-symbol name-str)
(string-append (symbol->c-identifier type-symbol)
"_object_property(" object-name-str ", "
"\"" name-str "\")" )))
(define (list-getter lo-name-str)
(lambda (type-symbol name-str)
(string-append (symbol->c-identifier type-symbol)
"_list_ref(" lo-name-str ", "
name-str ")" )))
(define list-temp-suffix "_t")
(define (input-list list-object-get-str c-var-name-str type-name)
(print "{\n")
(let ((lo-name-str (string-append "lo" list-temp-suffix))
(index-name-str (string-append "i" list-temp-suffix))
(saved-list-temp-suffix list-temp-suffix))
(set! list-temp-suffix (string-append list-temp-suffix "_t"))
(print "list " lo-name-str " = "
list-object-get-str ";\n")
(print "int " index-name-str ";\n")
(print c-var-name-str
".num_items = list_length(" lo-name-str ");\n")
(print c-var-name-str ".items = "
(malloc (c-type-string type-name) c-var-name-str ".num_items")
";\n")
(print "for (" index-name-str " = 0; " index-name-str " < "
c-var-name-str ".num_items; " index-name-str "++) {\n")
(input-value index-name-str
(string-append c-var-name-str ".items[" index-name-str "]")
type-name (list-getter lo-name-str))
(print "}\n")
(set! list-temp-suffix saved-list-temp-suffix))
(print "}\n"))
(define (class-input-function-name type-name)
(string-append (symbol->c-identifier type-name)
"_input"))
(define (class-input-function-decl class ns)
(print "void " ns
(class-input-function-name (class-type-name class))
"(SCM so, "
(c-type-string (class-type-name class)) " *o)"))
(define (class-input-function class)
(class-input-function-decl class (ns0))
(print "\n{\n")
(for-each
(lambda (property)
(input-value (symbol->string (property-name property))
(string-append "o->" (symbol->c-identifier
(property-name property)))
(property-type-name property)
(property-getter "so")))
(class-properties class))
(let ((subclasses (find-direct-subclasses class)))
(for-each
(lambda (sc)
(print "if (object_is_member(\"" (class-type-name sc)
"\", so)) {\n")
(print "o->which_subclass = " (class-enum-name sc) ";\n")
(print "o->subclass." (class-identifier sc) "_data = "
(malloc1 (class-identifier sc)) ";\n")
(print (class-input-function-name (class-type-name sc))
"(so, o->subclass." (class-identifier sc) "_data);\n"
"}\nelse "))
subclasses)
(if (not (null? subclasses))
(begin
(print "\n")
(print "o->which_subclass = "
(class-self-enum-name class) ";\n"))))
(print "}\n\n"))
(define (output-class-input-functions-header)
(print "/******* class input function prototypes *******/\n\n")
(for-each
(lambda (class)
(print "extern ") (class-input-function-decl class "")
(print ";\n"))
class-list)
(print "\n"))
(define (output-class-input-functions-source)
(print "/******* class input functions *******/\n\n")
(for-each class-input-function class-list))
(define (input-vars-function)
(print "/******* read input variables *******/\n\n")
(print "SCM " (ns0) "read_input_vars(void)\n")
(print "{\n")
(print "if (num_read_input_vars++) destroy_input_vars();\n")
(for-each
(lambda (var)
(input-value
(symbol->string (var-name var))
(symbol->c-identifier (var-name var))
(var-type-name var)
get-global))
(reverse input-var-list))
(print "return SCM_UNSPECIFIED;\n")
(print "}\n\n"))
; ***************************************************************************
(define (copy-value c0-var-name-str c-var-name-str type-name)
(let ((desc (get-type-descriptor type-name)))
(cond
((eq? (type-descriptor-kind desc) 'simple)
(print c-var-name-str " = " c0-var-name-str ";\n"))
((eq? (type-descriptor-kind desc) 'object)
(print (class-copy-function-name type-name) "(&"
c0-var-name-str
", &" c-var-name-str ");\n"))
((eq? (type-descriptor-kind desc) 'uniform-list)
(copy-list c0-var-name-str c-var-name-str
(list-el-type-name type-name))))))
(define (copy-list c0-var-name-str c-var-name-str type-name)
(print "{\n")
(let ((index-name-str (string-append "i" list-temp-suffix))
(saved-list-temp-suffix list-temp-suffix))
(set! list-temp-suffix (string-append list-temp-suffix "_t"))
(print "int " index-name-str ";\n")
(print c-var-name-str ".num_items = "
c0-var-name-str ".num_items;\n")
(print c-var-name-str ".items = "
(malloc (c-type-string type-name) c-var-name-str ".num_items")
";\n")
(print "for (" index-name-str " = 0; " index-name-str " < "
c-var-name-str ".num_items; " index-name-str "++) {\n")
(copy-value (string-append c0-var-name-str ".items[" index-name-str "]")
(string-append c-var-name-str ".items[" index-name-str "]")
type-name)
(print "}\n")
(set! list-temp-suffix saved-list-temp-suffix))
(print "}\n"))
(define (class-copy-function-name type-name)
(string-append (symbol->c-identifier type-name)
"_copy"))
(define (class-copy-function-decl class ns)
(print "void " ns
(class-copy-function-name (class-type-name class))
"(const " (c-type-string (class-type-name class)) " *o0,"
(c-type-string (class-type-name class)) " *o)"))
(define (class-copy-function class)
(class-copy-function-decl class (ns0))
(print "\n{\n")
(for-each
(lambda (property)
(copy-value (string-append "o0->" (symbol->c-identifier
(property-name property)))
(string-append "o->" (symbol->c-identifier
(property-name property)))
(property-type-name property)))
(class-properties class))
(let ((subclasses (find-direct-subclasses class)))
(for-each
(lambda (sc)
(print "if (o0->which_subclass == " (class-enum-name sc) ") {\n")
(print "o->which_subclass = " (class-enum-name sc) ";\n")
(print "o->subclass." (class-identifier sc) "_data = "
(malloc1 (class-identifier sc)) ";\n")
(print (class-copy-function-name (class-type-name sc))
"(o0->subclass." (class-identifier sc)
"_data, o->subclass." (class-identifier sc) "_data);\n"
"}\nelse "))
subclasses)
(if (not (null? subclasses))
(begin
(print "\n")
(print "o->which_subclass = "
(class-self-enum-name class) ";\n"))))
(print "}\n\n"))
(define (output-class-copy-functions-header)
(print "/******* class copy function prototypes *******/\n\n")
(for-each
(lambda (class)
(print "extern ") (class-copy-function-decl class "")
(print ";\n"))
class-list)
(print "\n"))
(define (output-class-copy-functions-source)
(print "/******* class copy functions *******/\n\n")
(for-each class-copy-function class-list))
; ***************************************************************************
(define (equal-value c0-var-name-str c-var-name-str type-name)
(let ((desc (get-type-descriptor type-name)))
(cond
((primitive-type? type-name)
(print "if (" c-var-name-str " != " c0-var-name-str ") return 0;\n"))
((eq? type-name 'string)
(print "if (strcmp(" c-var-name-str ", " c0-var-name-str
")) return 0;\n"))
((eq? (type-descriptor-kind desc) 'simple)
(print "if (!" type-name "_equal("
c-var-name-str ", " c0-var-name-str ")) return 0;\n"))
((eq? (type-descriptor-kind desc) 'object)
(print "if (!" (class-equal-function-name type-name) "(&"
c0-var-name-str
", &" c-var-name-str ")) return 0;\n"))
((eq? (type-descriptor-kind desc) 'uniform-list)
(equal-list c0-var-name-str c-var-name-str
(list-el-type-name type-name))))))
(define (equal-list c0-var-name-str c-var-name-str type-name)
(print "{\n")
(let ((index-name-str (string-append "i" list-temp-suffix))
(saved-list-temp-suffix list-temp-suffix))
(set! list-temp-suffix (string-append list-temp-suffix "_t"))
(print "int " index-name-str ";\n")
(print "if (" c-var-name-str ".num_items != "
c0-var-name-str ".num_items) return 0;\n")
(print "for (" index-name-str " = 0; " index-name-str " < "
c-var-name-str ".num_items; " index-name-str "++) {\n")
(equal-value (string-append c0-var-name-str ".items[" index-name-str "]")
(string-append c-var-name-str ".items[" index-name-str "]")
type-name)
(print "}\n")
(set! list-temp-suffix saved-list-temp-suffix))
(print "}\n"))
(define (class-equal-function-name type-name)
(string-append (symbol->c-identifier type-name)
"_equal"))
(define (class-equal-function-decl class ns)
(print "boolean " ns
(class-equal-function-name (class-type-name class))
"(const " (c-type-string (class-type-name class)) " *o0, "
"const " (c-type-string (class-type-name class)) " *o)"))
(define (class-equal-function class)
(class-equal-function-decl class (ns0))
(print "\n{\n")
(for-each
(lambda (property)
(equal-value (string-append "o0->" (symbol->c-identifier
(property-name property)))
(string-append "o->" (symbol->c-identifier
(property-name property)))
(property-type-name property)))
(class-properties class))
(let ((subclasses (find-direct-subclasses class)))
(if (not (null? subclasses))
(print "if (o0->which_subclass != o->which_subclass) return 0;\n"))
(for-each
(lambda (sc)
(print "if (o0->which_subclass == " (class-enum-name sc) ") {\n")
(print "if (!" (class-equal-function-name (class-type-name sc))
"(o0->subclass." (class-identifier sc)
"_data, o->subclass." (class-identifier sc) "_data)) return 0;\n"
"}\nelse "))
subclasses)
(print ";\n"))
(print "return 1;\n")
(print "}\n\n"))
(define (output-class-equal-functions-header)
(print "/******* class equal function prototypes *******/\n\n")
(for-each
(lambda (class)
(print "extern ") (class-equal-function-decl class "")
(print ";\n"))
class-list)
(print "\n"))
(define (output-class-equal-functions-source)
(print "/******* class equal functions *******/\n\n")
(for-each class-equal-function class-list))
; ***************************************************************************
(define (export-object-value c-var-name-str type-name exporter)
(error "object output variables are not yet supported. "
type-name c-var-name-str))
(define (export-list-value c-var-name-str type-name exporter)
(let ((el-type-name (list-el-type-name type-name)))
(let ((el-desc (get-type-descriptor el-type-name)))
(cond
((eq? (type-descriptor-kind el-desc) 'simple)
(exporter (string-append "make_" (type-descriptor-name-str el-desc)
"_list("
c-var-name-str ".num_items, "
c-var-name-str ".items)")))
(else
(error
"only export of lists of simple types is currently supported, not "
el-type-name))))))
(define (output-value s-var-name-str c-var-name-str type-name setter)
(let ((desc (get-type-descriptor type-name)))
(cond
((eq? (type-descriptor-kind desc) 'simple)
(print (setter type-name s-var-name-str c-var-name-str) "\n"))
((eq? (type-descriptor-kind desc) 'object)
(export-object-value c-var-name-str type-name
(lambda (sobj-str)
(print
(setter 'object s-var-name-str sobj-str))
(print "\n"))))
((eq? (type-descriptor-kind desc) 'uniform-list)
(export-list-value c-var-name-str type-name
(lambda (slist-str)
(print
(setter 'list s-var-name-str slist-str))
(print "\n")))))))
(define (set-global type-symbol s-name-str c-name-str)
(string-append "ctl_set_" (symbol->c-identifier type-symbol)
"(\"" s-name-str "\", " c-name-str ");" ))
(define (output-vars-function)
(print "/******* write output variables *******/\n\n")
(print "SCM " (ns0) "write_output_vars(void)\n")
(print "{\n")
(print "num_write_output_vars++;\n")
(for-each
(lambda (var)
(output-value
(symbol->string (var-name var))
(symbol->c-identifier (var-name var))
(var-type-name var)
set-global))
(reverse output-var-list))
(print "return SCM_UNSPECIFIED;\n")
(print "}\n\n"))
; ***************************************************************************
(define (destroy-c-var var-str type-name)
(let ((desc (get-type-descriptor type-name)))
(cond
((eq? type-name 'string)
(print (free var-str) ";\n"))
((eq? (type-descriptor-kind desc) 'uniform-list)
(destroy-list var-str (list-el-type-name type-name)))
((eq? (type-descriptor-kind desc) 'object)
(destroy-object var-str type-name)))))
(define (class-destroy-function-name type-name)
(string-append (symbol->c-identifier type-name)
"_destroy"))
(define (class-destroy-function-decl class ns)
(print "void " ns
(class-destroy-function-name (class-type-name class))
"("
(c-type-string (class-type-name class)) " o)"))
(define (destroy-list var-str el-type-name)
(let ((index-name (string-append "index" list-temp-suffix))
(saved-suffix list-temp-suffix))
(set! list-temp-suffix (string-append list-temp-suffix "_t"))
(print "{\n")
(print "int " index-name ";\n")
(print "for (" index-name " = 0; " index-name " < "
var-str ".num_items; " index-name "++) {\n")
(destroy-c-var (string-append var-str ".items[" index-name "]")
el-type-name)
(print "}\n")
(print "}\n")
(print (free var-str ".items") ";\n")
(set! list-temp-suffix saved-suffix)))
(define (destroy-object var-str type-name)
(print (class-destroy-function-name type-name) "(" var-str ");\n"))
(define (destroy-property prefix-str property)
(destroy-c-var (string-append prefix-str (symbol->c-identifier
(property-name property)))
(property-type-name property)))
(define (class-destroy-function class)
(class-destroy-function-decl class (ns0))
(print "\n{\n")
(for-each
(lambda (property) (destroy-property "o." property))
(class-properties class))
(let ((subclasses (find-direct-subclasses class)))
(for-each
(lambda (sc)
(print "if (o.which_subclass == " (class-enum-name sc) ") {\n")
(destroy-object (string-append "*o.subclass."
(class-identifier sc) "_data")
(class-type-name sc))
(print (free1 "o.subclass." (class-identifier sc) "_data") ";\n")
(print "}\n")
(print "else "))
subclasses)
(if (not (null? subclasses))
(begin
(print "{ }\n"))))
(print "}\n\n"))
(define (output-class-destruction-functions-header)
(print "/******* class destruction function prototypes *******/\n\n")
(for-each
(lambda (class)
(print "extern ") (class-destroy-function-decl class "")
(print ";\n"))
class-list)
(print "\n"))
(define (output-class-destruction-functions-source)
(print "/******* class destruction functions *******/\n\n")
(for-each class-destroy-function class-list))
(define (destroy-input-vars-function)
(print "/******* destroy input variables *******/\n\n")
(print "SCM " (ns0) "destroy_input_vars(void)\n")
(print "{\n")
(for-each
(lambda (var)
(destroy-c-var
(symbol->c-identifier (var-name var))
(var-type-name var)))
(reverse input-var-list))
(print "return SCM_UNSPECIFIED;\n")
(print "}\n\n"))
(define (destroy-output-vars-function)
(print "/******* destroy output variables *******/\n\n")
(print "SCM " (ns0) "destroy_output_vars(void)\n")
(print "{\n")
(for-each
(lambda (var)
(if (not (member var input-var-list))
(destroy-c-var
(symbol->c-identifier (var-name var))
(var-type-name var))))
(reverse output-var-list))
(print "return SCM_UNSPECIFIED;\n")
(print "}\n\n"))
; ***************************************************************************
(define (list->indices lst start-index)
(if (null? lst) '()
(cons start-index (list->indices (cdr lst) (+ start-index 1)))))
(define (declare-external-function external-function ns)
(print "SCM " ns (symbol->c-identifier
(external-function-aux-name
(external-function-name external-function)))
"(")
(for-each
(lambda (argnum)
(if (> argnum 0) (print ", "))
(print "SCM arg_scm_" argnum))
(list->indices (external-function-arg-type-names external-function) 0))
(if (= (length (external-function-arg-type-names external-function)) 0)
(print "void"))
(print ")"))
(define (declare-external-c-function external-function)
(print
"extern "
(if (not (eq? (external-function-return-type-name external-function)
no-return-value))
(c-type-string (external-function-return-type-name external-function))
"void")
" "
(symbol->c-identifier (external-function-name external-function))
"(")
(for-each
(lambda (arg-type-name argnum)
(if (> argnum 0) (print ", "))
(print (c-type-string arg-type-name)))
(external-function-arg-type-names external-function)
(list->indices (external-function-arg-type-names external-function) 0))
(if (= (length (external-function-arg-type-names external-function)) 0)
(print "void"))
(print ");\n"))
(define (output-external-functions-header)
(print "/******* external-functions *******/\n\n")
(for-each
(lambda (ef)
(declare-external-c-function ef)
(print "extern ")
(declare-external-function ef "")
(print ";\n\n"))
external-function-list)
(print "\nextern void export_external_functions(void);\n")
(print "\n"))
(define (output-external-function-export external-function)
(print
"gh_new_procedure(\""
(external-function-aux-name (external-function-name external-function))
"\", "
"(SCM (*)()) "
(symbol->c-identifier
(external-function-aux-name (external-function-name external-function)))
", "
(length (external-function-arg-type-names external-function))
", 0, 0);\n"))
(define (output-export-external-functions)
(print "void " (ns0) "export_external_functions(void)\n")
(print "{\n")
(for-each output-external-function-export external-function-list)
(print "}\n\n"))
(define (get-c-local type-symbol name-str)
(string-append "ctl_convert_" (symbol->c-identifier type-symbol)
"_to_c(" name-str ")"))
(define (set-c-local type-symbol s-name-str c-name-str)
(string-append s-name-str " = ctl_convert_"
(symbol->c-identifier type-symbol)
"_to_scm(" c-name-str ");"))
(define (output-external-function external-function)
(declare-external-function external-function (ns0)) (print "\n")
(print "{\n")
(if (not (eq? (external-function-return-type-name external-function)
no-return-value))
(begin
(print "SCM return_val_scm;\n")
(c-var-decl 'return-val-c (external-function-return-type-name
external-function))))
(for-each
(lambda (arg-type-name argnum)
(print (c-type-string arg-type-name) " arg_c_" argnum ";\n"))
(external-function-arg-type-names external-function)
(list->indices (external-function-arg-type-names external-function) 0))
(print "\n")
(for-each
(lambda (arg-type-name argnum)
(input-value (string-append "arg_scm_" (number->string argnum))
(string-append "arg_c_" (number->string argnum))
arg-type-name
get-c-local))
(external-function-arg-type-names external-function)
(list->indices (external-function-arg-type-names external-function) 0))
(print "\n")
(print "#ifdef HAVE_SCM_FLUSH_ALL_PORTS\nscm_flush_all_ports();\n#endif\n")
(if (not (eq? (external-function-return-type-name external-function)
no-return-value))
(print "return_val_c = "))
(print
(symbol->c-identifier (external-function-name external-function))
"(")
(for-each
(lambda (argnum)
(if (> argnum 0) (print ", "))
(print "arg_c_" argnum))
(list->indices (external-function-arg-type-names external-function) 0))
(print ");\n\n")
(print "fflush(stdout); fflush(stderr);\n")
(for-each
(lambda (arg-type-name argnum)
(destroy-c-var
(string-append "arg_c_" (number->string argnum)) arg-type-name))
(external-function-arg-type-names external-function)
(list->indices (external-function-arg-type-names external-function) 0))
(print "\n")
(if (not (eq? (external-function-return-type-name external-function)
no-return-value))
(begin
(output-value
"return_val_scm" "return_val_c"
(external-function-return-type-name external-function)
set-c-local)
(destroy-c-var "return_val_c"
(external-function-return-type-name external-function))
(print "return return_val_scm;\n"))
(begin (print "return SCM_UNSPECIFIED;\n")))
(print "}\n\n"))
(define (output-external-functions-source)
(print "/******* external-functions *******/\n\n")
(for-each output-external-function external-function-list)
(output-export-external-functions))
; ***************************************************************************
(define (swig-type-header type-name)
(print "%typemap(guile,in) "
(if cxx (string-append namespace "::") "")
(c-type-string type-name) " {\n")
(if cxx (print "using namespace " namespace ";\n"))
(input-value "$input" "$1" type-name get-c-local)
(print "}\n")
(if (and (not (eq? 'object (type-descriptor-kind
(get-type-descriptor type-name))))
(or (not (list-type-name? type-name))
(eq? 'simple (type-descriptor-kind
(get-type-descriptor
(list-el-type-name type-name))))))
(begin
(print "%typemap(guile,out) "
(if cxx (string-append namespace "::") "")
(c-type-string type-name) " {\n")
(if cxx (print "using namespace " namespace ";\n"))
(output-value "$result" "$1" type-name set-c-local)
(destroy-c-var "$1" type-name)
(print "}\n")))
(print "\n")
)
(define (output-swig-header)
(print "%{\n#include \"ctl-io.h\"\n%}\n\n")
(print "/******* SWIG type-conversion mappings *******/\n\n")
(for-each swig-type-header
(append (only-list-types (all-type-names))
(map class-type-name class-list))))
; ***************************************************************************
(define (output-header)
(display-c-class-decls)
(declare-vars-header)
(print "extern int num_read_input_vars;\n")
(print "extern int num_write_output_vars;\n\n")
(print "extern SCM read_input_vars(void);\n")
(print "extern SCM write_output_vars(void);\n")
(print "extern SCM destroy_input_vars(void);\n")
(print "extern SCM destroy_output_vars(void);\n\n")
(output-external-functions-header)
(output-class-input-functions-header)
(output-class-copy-functions-header)
(output-class-equal-functions-header)
(output-class-destruction-functions-header)
)
(define (output-source)
(declare-vars-source)
(print
"int " (ns0) "num_read_input_vars = 0; /* # calls to read_input_vars */\n"
"int " (ns0) "num_write_output_vars = 0; /* # calls to read_input_vars */\n\n")
(output-class-input-functions-source)
(output-class-copy-functions-source)
(output-class-equal-functions-source)
(output-class-destruction-functions-source)
(input-vars-function)
(output-vars-function)
(destroy-input-vars-function)
(destroy-output-vars-function)
(output-external-functions-source))
libctl-3.2.2/utils/nlopt.c 0000644 0001754 0000144 00000006403 12315325324 012353 0000000 0000000 /* wrapper around NLopt nonlinear optimization library (if installed) */
#ifdef HAVE_NLOPT
#include
#include
#include
#include
#include
static double f_scm_wrap(integer n, const double *x, double *grad, void *f_scm_p)
{
SCM *f_scm = (SCM *) f_scm_p;
SCM ret = gh_call1(*f_scm, make_number_list(n, x));
if (scm_real_p(ret))
return scm_to_double(ret);
else { /* otherwise must be a list of value, gradient components,
i.e. (cons value gradient). */
SCM gscm = ret;
int i;
for (i = 0; i < n; ++i) {
gscm = SCM_CDR(gscm);
grad[i] = scm_to_double(SCM_CAR(gscm));
}
return scm_to_double(SCM_CAR(ret));
}
}
/* Scheme-callable wrapper for nlopt_minimize() function.
Note that Guile-callable C subroutines cannot take more than
10 arguments (grrr), so we past the last few arguments with a "rest"
list parameter */
SCM nlopt_minimize_scm(SCM algorithm_scm,
SCM f_scm,
SCM lb_scm, SCM ub_scm, SCM x_scm,
SCM minf_max_scm, SCM ftol_rel_scm, SCM ftol_abs_scm,
SCM rest
/*
SCM xtol_rel_scm, SCM xtol_abs_scm,
SCM maxeval_scm, SCM maxtime_scm
*/)
{
nlopt_algorithm algorithm = (nlopt_algorithm) scm_to_int(algorithm_scm);
int i, n = list_length(x_scm);
double *x, *lb, *ub, *xtol_abs = 0;
double minf_max = scm_to_double(minf_max_scm);
double ftol_rel = scm_to_double(ftol_rel_scm);
double ftol_abs = scm_to_double(ftol_abs_scm);
double xtol_rel = 0;
double maxeval = 0;
double maxtime = 0;
int nrest = list_length(rest);
/*
double xtol_rel = scm_to_double(xtol_rel_scm);
int maxeval = scm_to_int(maxeval_scm);
double maxtime = scm_to_double(maxtime_scm);
*/
double minf;
nlopt_result result;
SCM v, ret;
x = (double *) malloc(sizeof(double) * n * 4);
lb = x + n; ub = lb + n;
if (!x) {
fprintf(stderr, "nlopt_minimize_scm: out of memory!\n");
exit(EXIT_FAILURE);
}
if (list_length(lb_scm) != n || list_length(ub_scm) != n) {
fprintf(stderr, "nlopt_minimize_scm: invalid arguments\n");
exit(EXIT_FAILURE);
}
for (v=x_scm, i=0; i < n; ++i) {
x[i] = scm_to_double(SCM_CAR(v));
v = SCM_CDR(v);
}
for (v=lb_scm, i=0; i < n; ++i) {
lb[i] = scm_to_double(SCM_CAR(v));
v = SCM_CDR(v);
}
for (v=ub_scm, i=0; i < n; ++i) {
ub[i] = scm_to_double(SCM_CAR(v));
v = SCM_CDR(v);
}
if (nrest >= 1) xtol_rel = scm_to_double(SCM_CAR(rest));
if (nrest >= 2) {
SCM xtol_abs_scm = scm_cadr(rest);
if (list_length(xtol_abs_scm)) {
xtol_abs = ub + n;
for (v=xtol_abs_scm, i=0; i < n; ++i) {
xtol_abs[i] = scm_to_double(SCM_CAR(v));
v = SCM_CDR(v);
}
}
}
if (nrest >= 3) maxeval = scm_to_int(scm_caddr(rest));
if (nrest >= 4) maxtime = scm_to_double(scm_cadddr(rest));
result = nlopt_minimize(algorithm, n, f_scm_wrap, &f_scm,
lb, ub, x, &minf,
minf_max, ftol_rel, ftol_abs, xtol_rel, xtol_abs,
maxeval, maxtime);
ret = scm_cons(scm_from_int((int) result),
scm_cons(scm_from_double(minf), make_number_list(n, x)));
free(x);
return ret;
}
#endif /* HAVE_NLOPT */
libctl-3.2.2/utils/README 0000644 0001754 0000144 00000002313 12315324756 011737 0000000 0000000 This directory contains utilities for use with libctl.
First, there are ctl-io.scm and gen-ctl-io.scm, which are used to
generate C glue code (ctl-io.h and ctl-io.c) from a specifications
file for translating input/output variables to/from C.
Second, there is libctlgeom, a collection of utility code for manipulating
geometric objects, for use with libctl. libctlgeom contains:
* geom.scm: specifications file containing classes and utilities
for dealing with three-dimensional geometric objects (spheres,
cylinders, etcetera). This should be included in the specifications
file for anything using libgeom, with:
(include "/utils/geom.scm")
Each geometric object derives from the class geometric-object, and
has a material property whose type is the class material-type. Users
should provide their own material-type class (if none is provided,
a dummy class is used).
* geom.c, geom.h: C routines (callable from Guile) for performing
various operations on a geometry, such as finding out what object
a given point is inside. Note that most of these routines
use the global input variables defined in geom.scm--they must
be called only when these variables have been imported to C.
libctl-3.2.2/utils/ctlgeom.h 0000644 0001754 0000144 00000014037 12315330377 012664 0000000 0000000 /* libctl: flexible Guile-based control files for scientific software
* Copyright (C) 1998-2014 Massachusetts Institute of Technology and Steven G. Johnson
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the
* Free Software Foundation, Inc., 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
* Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
*/
#ifndef GEOM_H
#define GEOM_H
#ifndef CTL_IO_H
# include
#endif
#ifdef CXX_CTL_IO
#define MATERIAL_TYPE ctlio::material_type
#define GEOMETRIC_OBJECT ctlio::geometric_object
#define GEOMETRIC_OBJECT_LIST ctlio::geometric_object_list
#define LATTICE ctlio::lattice
#else
#define MATERIAL_TYPE material_type
#define GEOMETRIC_OBJECT geometric_object
#define GEOMETRIC_OBJECT_LIST geometric_object_list
#define LATTICE lattice
#endif
#ifdef __cplusplus
extern "C" {
#endif /* __cplusplus */
/**************************************************************************/
extern void geom_initialize(void);
extern void geom_fix_object(GEOMETRIC_OBJECT o);
extern void geom_fix_objects(void);
extern void geom_fix_objects0(GEOMETRIC_OBJECT_LIST geometry);
extern void geom_fix_lattice(void);
extern void geom_fix_lattice0(LATTICE *L);
extern void geom_cartesian_lattice(void);
extern void geom_cartesian_lattice0(LATTICE *L);
extern boolean point_in_objectp(vector3 p, GEOMETRIC_OBJECT o);
extern boolean point_in_periodic_objectp(vector3 p, GEOMETRIC_OBJECT o);
extern boolean point_in_fixed_objectp(vector3 p, GEOMETRIC_OBJECT o);
extern boolean point_in_fixed_pobjectp(vector3 p, GEOMETRIC_OBJECT *o);
extern boolean point_in_periodic_fixed_objectp(vector3 p, GEOMETRIC_OBJECT o);
extern vector3 to_geom_object_coords(vector3 p, GEOMETRIC_OBJECT o);
extern vector3 from_geom_object_coords(vector3 p, GEOMETRIC_OBJECT o);
extern vector3 normal_to_object(vector3 p, GEOMETRIC_OBJECT o);
extern vector3 normal_to_fixed_object(vector3 p, GEOMETRIC_OBJECT o);
extern int intersect_line_with_object(vector3 p, vector3 d, GEOMETRIC_OBJECT o,
double s[2]);
extern MATERIAL_TYPE material_of_point_inobject(vector3 p, boolean *inobject);
extern MATERIAL_TYPE material_of_point_inobject0(
GEOMETRIC_OBJECT_LIST geometry, vector3 p, boolean *inobject);
extern MATERIAL_TYPE material_of_point(vector3 p);
extern MATERIAL_TYPE material_of_point0(GEOMETRIC_OBJECT_LIST geometry,
vector3 p);
GEOMETRIC_OBJECT object_of_point0(GEOMETRIC_OBJECT_LIST geometry, vector3 p,
vector3 *shiftby);
GEOMETRIC_OBJECT object_of_point(vector3 p, vector3 *shiftby);
vector3 shift_to_unit_cell(vector3 p);
extern matrix3x3 square_basis(matrix3x3 lattice_basis, vector3 size);
typedef struct {
vector3 low, high;
} geom_box;
typedef struct {
geom_box box;
const GEOMETRIC_OBJECT *o;
vector3 shiftby;
int precedence;
} geom_box_object;
typedef struct geom_box_tree_struct {
geom_box b, b1, b2;
struct geom_box_tree_struct *t1, *t2;
int nobjects;
geom_box_object *objects;
} *geom_box_tree;
extern void destroy_geom_box_tree(geom_box_tree t);
extern geom_box_tree create_geom_box_tree(void);
extern geom_box_tree create_geom_box_tree0(GEOMETRIC_OBJECT_LIST geometry,
geom_box b0);
extern geom_box_tree restrict_geom_box_tree(geom_box_tree, const geom_box *);
extern geom_box_tree geom_tree_search(vector3 p, geom_box_tree t, int *oindex);
extern geom_box_tree geom_tree_search_next(vector3 p, geom_box_tree t, int *oindex);
extern MATERIAL_TYPE material_of_point_in_tree_inobject(vector3 p, geom_box_tree t, boolean *inobject);
extern MATERIAL_TYPE material_of_point_in_tree(vector3 p, geom_box_tree t);
extern MATERIAL_TYPE material_of_unshifted_point_in_tree_inobject(vector3 p, geom_box_tree t, boolean *inobject);
const GEOMETRIC_OBJECT *object_of_point_in_tree(vector3 p, geom_box_tree t,
vector3 *shiftby,
int *precedence);
extern vector3 to_geom_box_coords(vector3 p, geom_box_object *gbo);
extern void display_geom_box_tree(int indentby, geom_box_tree t);
extern void geom_box_tree_stats(geom_box_tree t, int *depth, int *nobjects);
extern void geom_get_bounding_box(GEOMETRIC_OBJECT o, geom_box *box);
extern number box_overlap_with_object(geom_box b, GEOMETRIC_OBJECT o, number tol, integer maxeval);
extern number ellipsoid_overlap_with_object(geom_box b, GEOMETRIC_OBJECT o, number tol, integer maxeval);
extern number range_overlap_with_object(vector3 low, vector3 high,
GEOMETRIC_OBJECT o, number tol,
integer maxeval);
extern vector3 get_grid_size(void);
extern vector3 get_resolution(void);
extern void get_grid_size_n(int *nx, int *ny, int *nz);
GEOMETRIC_OBJECT make_geometric_object(MATERIAL_TYPE material, vector3 center);
GEOMETRIC_OBJECT make_cylinder(MATERIAL_TYPE material, vector3 center,
number radius, number height, vector3 axis);
GEOMETRIC_OBJECT make_cone(MATERIAL_TYPE material, vector3 center,
number radius, number height, vector3 axis,
number radius2);
GEOMETRIC_OBJECT make_sphere(MATERIAL_TYPE material, vector3 center,
number radius);
GEOMETRIC_OBJECT make_block(MATERIAL_TYPE material, vector3 center,
vector3 e1, vector3 e2, vector3 e3,
vector3 size);
GEOMETRIC_OBJECT make_ellipsoid(MATERIAL_TYPE material, vector3 center,
vector3 e1, vector3 e2, vector3 e3,
vector3 size);
/**************************************************************************/
#ifdef __cplusplus
} /* extern "C" */
#endif /* __cplusplus */
#endif /* GEOM_H */
libctl-3.2.2/utils/gen-ctl-io.in 0000755 0001754 0000144 00000014045 12315325343 013346 0000000 0000000 #!/bin/sh
# libctl: flexible Guile-based control files for scientific software
# Copyright (C) 1998, 1999, 2000, 2001, 2002, Steven G. Johnson
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
code=false
header=false
cxx=false
swig=false
output_file=""
while test $# -ge 1; do
case $1 in
-o) shift; output_file=$1 ;;
--cxx) cxx=true ;;
--code) code=true; header=false; swig=false ;;
--header) header=true; code=false; swig=false ;;
--swig) swig=true; header=false; code=false ;;
*) break;;
esac
shift
done
if test $code = true; then
if test $cxx = true; then
default_output_file=ctl-io.cpp
else
default_output_file=ctl-io.c
fi
elif test $header = true; then
if test $cxx = true; then
default_output_file=ctl-io.hpp
else
default_output_file=ctl-io.h
fi
elif test $swig = true; then
default_output_file=ctl-io.i
else
# No output specified. Backwards compatibility mode (code + header output).
$0 --header $*
$0 --code $*
exit 0
fi
if test "x$output_file" = x; then
output_file=$default_output_file
fi
spec_file=$1
if test ! -f "$spec_file"; then
echo "cannot read specification file $spec_file"
exit 1
fi
if test "$#" = "2"; then
libctl_dir="$2"
else
prefix="@prefix@"
datarootdir="@datarootdir@"
libctl_dir="@datadir@/libctl"
fi
case $libctl_dir in .*) libctl_dir=`pwd`/$libctl_dir ;; esac
if test ! -r $libctl_dir/utils/ctl-io.scm; then
echo "couldn't find $libctl_dir/utils/ctl-io.scm"
exit 1
fi
ok=yes
###########################################################################
if test $header = true; then
rm -f $output_file
cat > $output_file <
EOF
if test $cxx = true; then
cat >> $output_file <> $output_file <> $output_file
(@GUILE@ -l $libctl_dir/base/include.scm \
-c "(include "'"'"$libctl_dir/base/ctl.scm"'"'") (include "'"'"$libctl_dir/utils/ctl-io.scm"'"'") (set"'!'" cxx $cxx) (include "'"'"$spec_file"'"'") (output-header)" >> $output_file) || ok=no
if test $ok = no; then rm -f $output_file; exit 1; fi
echo >> $output_file
if test $cxx = true; then
cat >> $output_file <> $output_file <> $output_file < /dev/null 2>&1
rm -f ${output_file}~ ${output_file}.BAK
fi
fi # header = true
###########################################################################
if test $code = true; then
rm -f $output_file
cat > $output_file <
#include
#include
#include "ctl-io.h"
#ifdef CXX_CTL_IO
using namespace ctlio;
#endif
EOF
(@GUILE@ -l $libctl_dir/base/include.scm \
-c "(include "'"'"$libctl_dir/base/ctl.scm"'"'") (include "'"'"$libctl_dir/utils/ctl-io.scm"'"'") (set"'!'" cxx $cxx) (include "'"'"$spec_file"'"'") (output-source)" >> $output_file) || ok=no
if test $ok = no; then rm -f $output_file; exit 1; fi
if test $cxx = false; then
@INDENT@ $output_file > /dev/null 2>&1
rm -f ${output_file}~ ${output_file}.BAK
fi
fi # code = true
###########################################################################
if test $swig = true; then
cat > $output_file <> $output_file) || ok=no
if test $ok = no; then rm -f $output_file; exit 1; fi
cat >> $output_file <