41 #if defined (HAVE_CONFIG_H)
45 #if defined (USE_BLASWRAP)
55 #if ! defined (VECLIB_FILE)
56 # define VECLIB_FILE "/System/Library/Frameworks/vecLib.framework/Versions/A/vecLib"
63 #pragma GCC diagnostic ignored "-Wmissing-prototypes"
73 static void (*f2c_blas_func[]) (void);
74 static void (*f2c_lapack_func[]) (void);
80 typedef double (*F2C_CALL_0) (void);
81 typedef double (*F2C_CALL_1) (
void *a1);
82 typedef double (*F2C_CALL_2) (
void *a1,
void *
a2);
83 typedef double (*F2C_CALL_3) (
void *a1,
void *
a2,
void *a3);
84 typedef double (*F2C_CALL_4) (
void *a1,
void *
a2,
void *a3,
void *a4);
85 typedef double (*F2C_CALL_5) (
void *a1,
void *
a2,
void *a3,
void *a4,
void *a5);
86 typedef double (*F2C_CALL_6) (
void *a1,
void *
a2,
void *a3,
void *a4,
void *a5,
88 typedef double (*F2C_CALL_7) (
void *a1,
void *
a2,
void *a3,
void *a4,
void *a5,
90 typedef double (*F2C_CALL_8) (
void *a1,
void *
a2,
void *a3,
void *a4,
void *a5,
91 void *a6,
void *a7,
void *a8);
93 #define F2C_LAPACK_CALL_8(name) \
94 float name (void *a1, void *a2, void *a3, void *a4, void *a5, void *a6, void *a7, void *a8) \
96 return ((F2C_CALL_8)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4, a5, a6, a7, a8); \
99 #define F2C_LAPACK_CALL_7(name) \
100 float name (void *a1, void *a2, void *a3, void *a4, void *a5, void *a6, void *a7) \
102 return ((F2C_CALL_7)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4, a5, a6, a7); \
105 #define F2C_LAPACK_CALL_6(name) \
106 float name (void *a1, void *a2, void *a3, void *a4, void *a5, void *a6) \
108 return ((F2C_CALL_6)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4, a5, a6); \
111 #define F2C_LAPACK_CALL_5(name) \
112 float name (void *a1, void *a2, void *a3, void *a4, void *a5) \
114 return ((F2C_CALL_5)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4, a5); \
117 #define F2C_LAPACK_CALL_4(name) \
118 float name (void *a1, void *a2, void *a3, void *a4) \
120 return ((F2C_CALL_4)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3, a4); \
123 #define F2C_LAPACK_CALL_3(name) \
124 float name (void *a1, void *a2, void *a3) \
126 return ((F2C_CALL_3)f2c_lapack_func[f2c_ ## name]) (a1, a2, a3); \
129 #define F2C_LAPACK_CALL_2(name) \
130 float name (void *a1, void *a2) \
132 return ((F2C_CALL_2)f2c_lapack_func[f2c_ ## name]) (a1, a2); \
135 #define F2C_LAPACK_CALL_1(name) \
136 float name (void *a1) \
138 return ((F2C_CALL_1)f2c_lapack_func[f2c_ ## name]) (a1); \
141 #define F2C_LAPACK_CALL_0(name) \
144 return ((F2C_CALL_0)f2c_lapack_func[f2c_ ## name]) (); \
147 #define F2C_LAPACK_CALL_NONE(name)
149 #define F2C_LAPACK_CALL(name, args) F2C_LAPACK_CALL_ ## args (name)
151 #define ENUM_ITEM(name, args) \
154 #define NAME_TO_STRING_CASE(name, args) \
155 case f2c_ ## name: return #name;
157 #define DEFINE_LAPACK_ENUM(name, list) \
162 f2c_ ## name ## _name (name n) { \
164 list(NAME_TO_STRING_CASE) \
165 default: return ""; \
168 list(F2C_LAPACK_CALL)
170 #define DEFINE_BLAS_ENUM(name, list) \
175 f2c_ ## name ## _name(name n) { \
177 list(NAME_TO_STRING_CASE) \
178 default: return ""; \
186 #define LAPACK_LIST(_) \
223 #define BLAS_LIST(_) \
230 DEFINE_BLAS_ENUM(blas, BLAS_LIST)
232 DEFINE_LAPACK_ENUM(lapack, LAPACK_LIST)
238 typedef
struct {
float r,
i; } complex;
239 typedef struct {
double r,
i; } doublecomplex;
241 typedef void (*F2C_BLAS_CALL_6) (
void *
c,
void *a1,
void *
a2,
void *a3,
244 #define F2C_BLAS_CALL(type, name) \
245 type name (void *a1, void *a2, void *a3, void *a4, void *a5) \
248 ((F2C_BLAS_CALL_6)f2c_blas_func[f2c_ ## name]) (&cplx, a1, a2, a3, a4, a5); \
252 F2C_BLAS_CALL(complex, cdotu_)
253 F2C_BLAS_CALL(doublecomplex, zdotu_)
254 F2C_BLAS_CALL(complex, cdotc_)
255 F2C_BLAS_CALL(doublecomplex, zdotc_)
260 static
void (*f2c_blas_func[f2c_BLAS_COUNT]) (
void) = { 0 };
261 static void (*f2c_lapack_func[f2c_LAPACK_COUNT]) (void) = { 0 };
268 static void * apple_vecLib = 0;
270 __attribute__((constructor))
271 static
void initVecLibWrappers (
void)
273 apple_vecLib = dlopen (VECLIB_FILE, RTLD_LOCAL | RTLD_NOLOAD | RTLD_FIRST);
274 if (0 == apple_vecLib)
278 for (i = 0; i < f2c_LAPACK_COUNT; i++)
279 if (0 == (f2c_lapack_func[i] = dlsym (apple_vecLib, f2c_lapack_name(i))))
281 for (i = 0; i < f2c_BLAS_COUNT; i++)
282 if (0 == (f2c_blas_func[i] = dlsym (apple_vecLib, f2c_blas_name(i))))
286 __attribute__((destructor))
287 static
void finiVecLibWrappers (
void)
290 dlclose (apple_vecLib);
create a structure array and initialize its values The dimensions of each cell array of values must match Singleton cells and non cell values are repeated so that they fill the entire array If the cells are create an empty structure array with the specified field names If the argument is an return the underlying struct Observe that the syntax is optimized for struct trong struct("foo", 1) esult
const octave_base_value & a2
the sparsity preserving column transformation such that that defines the pivoting threshold can be given in which case it defines the c
=val(i)}if ode{val(i)}occurs in table i
issues an error eealso double