/*
Copyright (C) 2012-2013 Jarno Rajahalme
This file is part of Octave.
Octave 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 3 of the License, or (at your
option) any later version.
Octave 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 Octave; see the file COPYING. If not, see
.
*/
/*
Wrapper for Apple libBLAS.dylib and libLAPACK.dylib
At least on the versions of OSX 10.6 so far (up and including 10.6.6)
these libraries are incompatible with 64 bit builds, as some functions
in libBLAS.dylib are not conforming to F2C calling conventions, as
they should. This breaks them in 64-bit builds on the x86_64
architecture.
Newer gfortran compoilers no longer default to the F2C calling
convention. These wrappers map the F2C conformant functions in
libBLAS and libLAPACK to the native gfortran calling convention, so
that the libraries can be used with software built for x86_64
architecture.
*/
#ifdef HAVE_CONFIG_H
#include /* USE_BLASWRAP ? */
#endif
#ifdef USE_BLASWRAP
/*
* vecLib is an Apple framework (collection of libraries) containing
* libBLAS and libLAPACK. The fortran stubs in these libraries are
* (mostly, but not completely) in the F2C calling convention.
* We access the libraries via the vecLib framework to make sure we
* get the Apple versions, rather than some other blas/lapack with the
* same name.
*/
#ifndef VECLIB_FILE
#define VECLIB_FILE "/System/Library/Frameworks/vecLib.framework/Versions/A/vecLib"
#endif
/*
* Since this is a wrapper for fortran functions,
* we do not have prototypes for them.
*/
#pragma GCC diagnostic ignored "-Wmissing-prototypes"
#include
#include
#include
/*
* On-demand symbol loading
*/
static void * apple_vecLib = 0;
__attribute__((constructor))
static void initVecLibWrappers (void)
{
static const char* veclib = VECLIB_FILE;
apple_vecLib = dlopen (veclib, RTLD_LOCAL | RTLD_NOLOAD | RTLD_FIRST);
if ( apple_vecLib != 0 ) return;
fprintf( stderr, "Failed to open vecLib library; aborting.\n Location: %s\n", veclib );
abort ();
}
__attribute__((destructor))
static void finiVecLibWrappers (void)
{
if ( apple_vecLib == 0 ) return;
dlclose (apple_vecLib);
apple_vecLib = 0;
}
static void* loadsym( const char* nm )
{
void *ans = dlsym( apple_vecLib, nm );
if ( ans != 0 ) return ans;
fprintf( stderr, "vecLib symbol '%s' could not be resolved; aborting.\n", nm );
abort();
}
/*
* Wrappers to convert double return values back to float
*/
#define F2C_FFUNC(name,args,fargs) \
typedef double (*f_ ## name) fargs; \
float name fargs \
{ \
static f_ ## name func = 0; \
if ( !func ) func = (f_ ## name)loadsym( #name ); \
return (*func) args; \
}
#define F2C_FFUNC_8(name) \
F2C_FFUNC(name,(a1,a2,a3,a4,a5,a6,a7,a8),(void*a1,void*a2,void*a3,void*a4,void*a5,void*a6,void*a7,void*a8))
#define F2C_FFUNC_7(name) \
F2C_FFUNC(name,(a1,a2,a3,a4,a5,a6,a7),(void*a1,void*a2,void*a3,void*a4,void*a5,void*a6,void*a7))
#define F2C_FFUNC_6(name) \
F2C_FFUNC(name,(a1,a2,a3,a4,a5,a6),(void*a1,void*a2,void*a3,void*a4,void*a5,void*a6))
#define F2C_FFUNC_5(name) \
F2C_FFUNC(name,(a1,a2,a3,a4,a5),(void*a1,void*a2,void*a3,void*a4,void*a5))
#define F2C_FFUNC_4(name) \
F2C_FFUNC(name,(a1,a2,a3,a4),(void*a1,void*a2,void*a3,void*a4))
#define F2C_FFUNC_3(name) \
F2C_FFUNC(name,(a1,a2,a3),(void*a1,void*a2,void*a3))
#define F2C_FFUNC_2(name) \
F2C_FFUNC(name,(a1,a2),(void*a1,void*a2))
#define F2C_FFUNC_1(name) \
F2C_FFUNC(name,(a1),(void*a1))
#define F2C_FFUNC_0(name) \
F2C_FFUNC(name,(),(void))
/*
* Wrappers to handle complex return values
*/
#define F2C_CFUNC_5(type, name) \
typedef struct { type r, i; } c_ ## name; \
typedef void (*f_ ## name) (void*,void*,void*,void*,void*,void*); \
c_ ## name name (void* a1, void* a2, void* a3, void* a4, void* a5) \
{ \
c_ ## name cplx; \
static f_ ## name func = 0; \
if ( !func ) func = (f_ ## name)loadsym( #name ); \
(*func) (&cplx, a1, a2, a3, a4, a5); \
return cplx; \
}
/*
* BLAS / LAPACK function conversions
*/
F2C_FFUNC_6(clange_)
F2C_FFUNC_5(clangt_)
F2C_FFUNC_7(clanhb_)
F2C_FFUNC_6(clanhe_)
F2C_FFUNC_5(clanhp_)
F2C_FFUNC_5(clanhs_)
F2C_FFUNC_4(clanht_)
F2C_FFUNC_7(clansb_)
F2C_FFUNC_5(clansp_)
F2C_FFUNC_6(clansy_)
F2C_FFUNC_8(clantb_)
F2C_FFUNC_6(clantp_)
F2C_FFUNC_8(clantr_)
F2C_FFUNC_3(scsum1_)
F2C_FFUNC_0(second_)
F2C_FFUNC_2(slamc3_)
F2C_FFUNC_1(slamch_)
F2C_FFUNC_7(slangb_)
F2C_FFUNC_6(slange_)
F2C_FFUNC_5(slangt_)
F2C_FFUNC_5(slanhs_)
F2C_FFUNC_7(slansb_)
F2C_FFUNC_5(slansp_)
F2C_FFUNC_4(slanst_)
F2C_FFUNC_6(slansy_)
F2C_FFUNC_8(slantb_)
F2C_FFUNC_6(slantp_)
F2C_FFUNC_8(slantr_)
F2C_FFUNC_2(slapy2_)
F2C_FFUNC_3(slapy3_)
F2C_FFUNC_3(sasum_)
F2C_FFUNC_3(scasum_)
F2C_FFUNC_3(scnrm2_)
F2C_FFUNC_5(sdot_)
F2C_FFUNC_5(sdsdot_)
F2C_CFUNC_5(float,cdotu_)
F2C_CFUNC_5(double,zdotu_)
F2C_CFUNC_5(float,cdotc_)
F2C_CFUNC_5(double,zdotc_)
#endif /* USE_BLASWRAP */