1 /* Passing from fortran to C by value, using %VAL. */
2
3 #include <inttypes.h>
4
5 /* We used to #include <complex.h>, but this fails for some platforms
6 (like cygwin) who don't have it yet. */
7 #define complex __complex__
8 #define _Complex_I (1.0iF)
9
10 extern void f_to_f__ (float*, float, float*, float**);
11 extern void f_to_f8__ (double*, double, double*, double**);
12 extern void i_to_i__ (int*, int, int*, int**);
13 extern void i_to_i8__ (int64_t*, int64_t, int64_t*, int64_t**);
14 extern void c_to_c__ (complex float*, complex float, complex float*, complex float**);
15 extern void c_to_c8__ (complex double*, complex double, complex double*, complex double**);
16 extern void abort (void);
17
18 void
f_to_f__(float * retval,float a1,float * a2,float ** a3)19 f_to_f__(float *retval, float a1, float *a2, float **a3)
20 {
21 if ( a1 != *a2 ) abort();
22 if ( a1 != **a3 ) abort();
23 a1 = 0.0;
24 *retval = *a2 * 2.0;
25 return;
26 }
27
28 void
f_to_f8__(double * retval,double a1,double * a2,double ** a3)29 f_to_f8__(double *retval, double a1, double *a2, double **a3)
30 {
31 if ( a1 != *a2 ) abort();
32 if ( a1 != **a3 ) abort();
33 a1 = 0.0;
34 *retval = *a2 * 2.0;
35 return;
36 }
37
38 void
i_to_i__(int * retval,int i1,int * i2,int ** i3)39 i_to_i__(int *retval, int i1, int *i2, int **i3)
40 {
41 if ( i1 != *i2 ) abort();
42 if ( i1 != **i3 ) abort();
43 i1 = 0;
44 *retval = *i2 * 3;
45 return;
46 }
47
48 void
i_to_i8__(int64_t * retval,int64_t i1,int64_t * i2,int64_t ** i3)49 i_to_i8__(int64_t *retval, int64_t i1, int64_t *i2, int64_t **i3)
50 {
51 if ( i1 != *i2 ) abort();
52 if ( i1 != **i3 ) abort();
53 i1 = 0;
54 *retval = *i2 * 3;
55 return;
56 }
57
58 void
c_to_c__(complex float * retval,complex float c1,complex float * c2,complex float ** c3)59 c_to_c__(complex float *retval, complex float c1, complex float *c2, complex float **c3)
60 {
61 if ( c1 != *c2 ) abort();
62 if ( c1 != *(*c3) ) abort();
63 c1 = 0.0 + 0.0 * _Complex_I;
64 *retval = (*c2) * 4.0;
65 return;
66 }
67
68 void
c_to_c8__(complex double * retval,complex double c1,complex double * c2,complex double ** c3)69 c_to_c8__(complex double *retval, complex double c1, complex double *c2, complex double **c3)
70 {
71 if ( c1 != *c2 ) abort();
72 if ( c1 != *(*c3) ) abort();
73 c1 = 0.0 + 0.0 * _Complex_I;;
74 *retval = (*c2) * 4.0;
75 return;
76 }
77