« back to all changes in this revision
Viewing changes to base/ctl-f77-glue.c
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Josselin Mouette
- Date: 2002-04-17 10:36:45 UTC
- Revision ID: james.westby@ubuntu.com-20020417103645-29vomjspk4yf4olw
Tags: upstream-2.1
Import upstream version 2.1
- files added:
- autom4te.cache
- base
- doc
- examples
- utils
added
removed
base/ctl-f77-glue.c
1
/* libctl: flexible Guile-based control files for scientific software
2
* Copyright (C) 1998, 1999, 2000, 2001, 2002, Steven G. Johnson
3
*
4
* This library is free software; you can redistribute it and/or
5
* modify it under the terms of the GNU Lesser General Public
6
* License as published by the Free Software Foundation; either
7
* version 2 of the License, or (at your option) any later version.
8
*
9
* This library is distributed in the hope that it will be useful,
10
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12
* Lesser General Public License for more details.
13
*
14
* You should have received a copy of the GNU Lesser General Public
15
* License along with this library; if not, write to the
16
* Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17
* Boston, MA 02111-1307, USA.
18
*
19
* Steven G. Johnson can be contacted at stevenj@alum.mit.edu.
20
*/
21
22
#include <stdlib.h>
23
#include <string.h>
24
25
#include "ctl.h"
26
#include "f77-func.h"
27
28
/* This file contains glue code that enables us to call libctl from
29
Fortran. We have to take into account several things:
30
31
1) All Fortran parameters are passed by reference.
32
33
2) Fortran compilers are case-insensitive, so they munge identifiers
34
in a weird way for the linker. If we want a Fortran program to
35
be able to call us, we have to munge our identifiers in the same
36
way. (We do this with the F77_FUNC macro--every Fortran compiler
37
is different. F77_FUNC is determined by the configure script.)
38
39
3) Fortran represents strings in a different way than C. To handle
40
this, we require that Fortran callers pass us the length of a
41
string as an explicit parameter. We also have to include ugly
42
hacks to accomodate the fact that Cray Fortran compilers pass
43
a data structure instead of a char* for string parameters.
44
45
4) On some machines, C functions return their results in a way
46
that the Fortran compiler can't handle. To get around this,
47
all return results of functions are converted into an extra parameter.
48
49
The name of our Fortran routines is the same as the corresponding
50
C routine with the underscores removed. So, we to construct the
51
Fortran call, you do something like:
52
53
C: foo = bar_baz(x,y,z);
54
Fortran: call barbaz(x,y,z,foo)
55
56
C: foo = bar_baz(x,string,y);
57
Fortran: call barbaz(x,string,length(string),y,foo)
58
59
(Note that string parameters get converted into two parameters: the
60
string and its length.)
61
*/
62
63
#ifdef F77_FUNC /* if we know how to mangle identifiers for Fortran */
64
65
/**************************************************************************/
66
67
/* Convert Fortran string parameters to C char*. This is required
68
in order to accomodate the ugly things that the Cray compilers do. */
69
70
#if defined(CRAY) || defined(_UNICOS) || defined(_CRAYMPP)
71
#include <fortran.h>
72
typedef _fcd fortran_string;
73
#define fcp2ccp(fs) _fcdtocp(fs)
74
#else
75
typedef char *fortran_string;
76
#define fcp2ccp(fs) (fs)
77
#endif
78
79
/**************************************************************************/
80
81
/* Vector functions:
82
(vector3 can be declared as an array of 3 reals in Fortran) */
83
84
void F77_FUNC(vector3scale,VECTOR3SCALE)
85
(number *s, vector3 *v, vector3 *vscaled)
86
{
87
*vscaled = vector3_scale(*s,*v);
88
}
89
90
void F77_FUNC(vector3plus,VECTOR3PLUS)
91
(vector3 *v1, vector3 *v2, vector3 *vresult)
92
{
93
*vresult = vector3_plus(*v1,*v2);
94
}
95
96
void F77_FUNC(vector3minus,VECTOR3MINUS)
97
(vector3 *v1, vector3 *v2, vector3 *vresult)
98
{
99
*vresult = vector3_minus(*v1,*v2);
100
}
101
102
void F77_FUNC(vector3cross,VECTOR3CROSS)
103
(vector3 *v1, vector3 *v2, vector3 *vresult)
104
{
105
*vresult = vector3_cross(*v1,*v2);
106
}
107
108
void F77_FUNC(vector3dot,VECTOR3DOT)
109
(vector3 *v1, vector3 *v2, number *result)
110
{
111
*result = vector3_dot(*v1,*v2);
112
}
113
114
void F77_FUNC(vector3norm,VECTOR3DOT)
115
(vector3 *v, number *result)
116
{
117
*result = vector3_norm(*v);
118
}
119
120
/**************************************************************************/
121
122
/* variable get/set functions */
123
124
/* Note that list and object variables in Fortran should be declared
125
as something the same size as the corresponding type in C. (This
126
turns out to be the same size as a long int.) */
127
128
/* Getters: */
129
130
void F77_FUNC(ctlgetnumber,CTLGETNUMBER)
131
(fortran_string identifier, int *length, number *result)
132
{
133
char *s = fcp2ccp(identifier); s[*length] = 0;
134
*result = ctl_get_number(s);
135
}
136
137
void F77_FUNC(ctlgetinteger,CTLGETINTEGER)
138
(fortran_string identifier, int *length, integer *result)
139
{
140
char *s = fcp2ccp(identifier); s[*length] = 0;
141
*result = ctl_get_integer(s);
142
}
143
144
void F77_FUNC(ctlgetboolean,CTLGETBOOLEAN)
145
(fortran_string identifier, int *length, boolean *result)
146
{
147
char *s = fcp2ccp(identifier); s[*length] = 0;
148
*result = ctl_get_boolean(s);
149
}
150
151
void F77_FUNC(ctlgetlist,CTLGETLIST)
152
(fortran_string identifier, int *length, list *result)
153
{
154
char *s = fcp2ccp(identifier); s[*length] = 0;
155
*result = ctl_get_list(s);
156
}
157
158
void F77_FUNC(ctlgetobject,CTLGETOBJECT)
159
(fortran_string identifier, int *length, object *result)
160
{
161
char *s = fcp2ccp(identifier); s[*length] = 0;
162
*result = ctl_get_object(s);
163
}
164
165
void F77_FUNC(ctlgetvector3,CTLGETVECTOR3)
166
(fortran_string identifier, int *length, vector3 *result)
167
{
168
char *s = fcp2ccp(identifier); s[*length] = 0;
169
*result = ctl_get_vector3(s);
170
}
171
172
/* ctl_get_string doesn't work perfectly--there
173
is no portable way to set the length of the Fortran string.
174
The length is returned in result_length. */
175
void F77_FUNC(ctlgetstring,CTLGETSTRING)
176
(fortran_string identifier, int *length,
177
fortran_string result, int *result_length)
178
{
179
char *r;
180
char *s = fcp2ccp(identifier); s[*length] = 0;
181
r = ctl_get_string(s);
182
strncpy(fcp2ccp(result), r, *result_length);
183
if (*result_length < strlen(r))
184
*result_length = strlen(r);
185
free(r);
186
}
187
188
/* Setters: */
189
190
void F77_FUNC(ctlsetnumber,CTLSETNUMBER)
191
(fortran_string identifier, int *length, number *value)
192
{
193
char *s = fcp2ccp(identifier); s[*length] = 0;
194
ctl_set_number(s, *value);
195
}
196
197
void F77_FUNC(ctlsetinteger,CTLSETINTEGER)
198
(fortran_string identifier, int *length, integer *value)
199
{
200
char *s = fcp2ccp(identifier); s[*length] = 0;
201
ctl_set_integer(s, *value);
202
}
203
204
void F77_FUNC(ctlsetboolean,CTLSETBOOLEAN)
205
(fortran_string identifier, int *length, boolean *value)
206
{
207
char *s = fcp2ccp(identifier); s[*length] = 0;
208
ctl_set_boolean(s, *value);
209
}
210
211
void F77_FUNC(ctlsetlist,CTLSETLIST)
212
(fortran_string identifier, int *length, list *value)
213
{
214
char *s = fcp2ccp(identifier); s[*length] = 0;
215
ctl_set_list(s, *value);
216
}
217
218
void F77_FUNC(ctlsetobject,CTLSETOBJECT)
219
(fortran_string identifier, int *length, object *value)
220
{
221
char *s = fcp2ccp(identifier); s[*length] = 0;
222
ctl_set_object(s, *value);
223
}
224
225
void F77_FUNC(ctlsetvector3,CTLSETVECTOR3)
226
(fortran_string identifier, int *length, vector3 *value)
227
{
228
char *s = fcp2ccp(identifier); s[*length] = 0;
229
ctl_set_vector3(s, *value);
230
}
231
232
void F77_FUNC(ctlsetstring,CTLSETSTRING)
233
(fortran_string identifier, int *length,
234
fortran_string value, int *value_length)
235
{
236
char *s = fcp2ccp(identifier);
237
char *v = fcp2ccp(value);
238
s[*length] = 0;
239
v[*value_length] = 0;
240
ctl_set_string(s, v);
241
}
242
243
/**************************************************************************/
244
245
/* list traversal */
246
247
void F77_FUNC(listlength,LISTLENGTH)(list *l, int *len)
248
{
249
*len = list_length(*l);
250
}
251
252
void F77_FUNC(numberlistref,NUMBERLISTREF)
253
(list *l, int *index, number *value)
254
{
255
*value = number_list_ref(*l, *index);
256
}
257
258
void F77_FUNC(integerlistref,INTEGERLISTREF)
259
(list *l, int *index, integer *value)
260
{
261
*value = integer_list_ref(*l, *index);
262
}
263
264
void F77_FUNC(booleanlistref,BOOLEANLISTREF)
265
(list *l, int *index, boolean *value)
266
{
267
*value = boolean_list_ref(*l, *index);
268
}
269
270
void F77_FUNC(vector3listref,VECTOR3LISTREF)
271
(list *l, int *index, vector3 *value)
272
{
273
*value = vector3_list_ref(*l, *index);
274
}
275
276
void F77_FUNC(listlistref,LISTLISTREF)
277
(list *l, int *index, list *value)
278
{
279
*value = list_list_ref(*l, *index);
280
}
281
282
void F77_FUNC(objectlistref,OBJECTLISTREF)
283
(list *l, int *index, object *value)
284
{
285
*value = object_list_ref(*l, *index);
286
}
287
288
void F77_FUNC(stringlistref,STRINGLISTREF)
289
(list *l, int *index, fortran_string value, int *value_length)
290
{
291
char *v;
292
v = string_list_ref(*l, *index);
293
strncpy(fcp2ccp(value), v, *value_length);
294
if (*value_length < strlen(v))
295
*value_length = strlen(v);
296
free(v);
297
}
298
299
/**************************************************************************/
300
301
/* list creation */
302
303
void F77_FUNC(makenumberlist,MAKENUMBERLIST)
304
(int *num_items, number *items, list *result)
305
{
306
*result = make_number_list(*num_items, items);
307
}
308
309
void F77_FUNC(makeintegerlist,MAKEINTEGERLIST)
310
(int *num_items, integer *items, list *result)
311
{
312
*result = make_integer_list(*num_items, items);
313
}
314
315
void F77_FUNC(makebooleanlist,MAKEBOOLEANLIST)
316
(int *num_items, boolean *items, list *result)
317
{
318
*result = make_boolean_list(*num_items, items);
319
}
320
321
void F77_FUNC(makevector3list,MAKEVECTOR3LIST)
322
(int *num_items, vector3 *items, list *result)
323
{
324
*result = make_vector3_list(*num_items, items);
325
}
326
327
void F77_FUNC(makelistlist,MAKELISTLIST)
328
(int *num_items, list *items, list *result)
329
{
330
*result = make_list_list(*num_items, items);
331
}
332
333
void F77_FUNC(makeobjectlist,MAKEOBJECTLIST)
334
(int *num_items, object *items, list *result)
335
{
336
*result = make_object_list(*num_items, items);
337
}
338
339
/* make_string_list is not supported. Strings in Fortran suck. */
340
341
/**************************************************************************/
342
343
/* object properties */
344
345
void F77_FUNC(objectismember,OBJECTISMEMBER)
346
(fortran_string type_name, int *length, object *o, boolean *result)
347
{
348
char *s = fcp2ccp(type_name); s[*length] = 0;
349
*result = object_is_member(s,*o);
350
}
351
352
void F77_FUNC(numberobjectproperty,NUMBEROBJECTPROPERTY)
353
(object *o, fortran_string property_name, int *length, number *result)
354
{
355
char *s = fcp2ccp(property_name); s[*length] = 0;
356
*result = number_object_property(*o,s);
357
}
358
359
void F77_FUNC(integerobjectproperty,INTEGEROBJECTPROPERTY)
360
(object *o, fortran_string property_name, int *length, integer *result)
361
{
362
char *s = fcp2ccp(property_name); s[*length] = 0;
363
*result = integer_object_property(*o,s);
364
}
365
366
void F77_FUNC(booleanobjectproperty,BOOLEANOBJECTPROPERTY)
367
(object *o, fortran_string property_name, int *length, boolean *result)
368
{
369
char *s = fcp2ccp(property_name); s[*length] = 0;
370
*result = boolean_object_property(*o,s);
371
}
372
373
void F77_FUNC(vector3objectproperty,VECTOR3OBJECTPROPERTY)
374
(object *o, fortran_string property_name, int *length, vector3 *result)
375
{
376
char *s = fcp2ccp(property_name); s[*length] = 0;
377
*result = vector3_object_property(*o,s);
378
}
379
380
void F77_FUNC(listobjectproperty,LISTOBJECTPROPERTY)
381
(object *o, fortran_string property_name, int *length, list *result)
382
{
383
char *s = fcp2ccp(property_name); s[*length] = 0;
384
*result = list_object_property(*o,s);
385
}
386
387
void F77_FUNC(objectobjectproperty,OBJECTOBJECTPROPERTY)
388
(object *o, fortran_string property_name, int *length, object *result)
389
{
390
char *s = fcp2ccp(property_name); s[*length] = 0;
391
*result = object_object_property(*o,s);
392
}
393
394
void F77_FUNC(stringobjectproperty,STRINGOBJECTPROPERTY)
395
(object *o, fortran_string property_name, int *length,
396
fortran_string result, int *result_length)
397
{
398
char *r;
399
char *s = fcp2ccp(property_name); s[*length] = 0;
400
r = string_object_property(*o,s);
401
strncpy(fcp2ccp(result), r, *result_length);
402
if (*result_length < strlen(r))
403
*result_length = strlen(r);
404
free(r);
405
}
406
407
/**************************************************************************/
408
409
#endif /* F77_FUNC */
Loggerhead is a web-based interface for Breezy
Version: 2.0.1