1 /*
2 * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana
3 * University Research and Technology
4 * Corporation. All rights reserved.
5 * Copyright (c) 2004-2014 The University of Tennessee and The University
6 * of Tennessee Research Foundation. All rights
7 * reserved.
8 * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
9 * University of Stuttgart. All rights reserved.
10 * Copyright (c) 2004-2005 The Regents of the University of California.
11 * All rights reserved.
12 * Copyright (c) 2010-2018 Cisco Systems, Inc. All rights reserved
13 * Copyright (c) 2017 Research Organization for Information Science
14 * and Technology (RIST). All rights reserved.
15 * $COPYRIGHT$
16 *
17 * Additional copyrights may follow
18 *
19 * $HEADER$
20 */
21
22 #include "ompi_config.h"
23
24 #include <string.h>
25 #include <stdlib.h>
26 #include <stdio.h>
27
28 #include "opal/util/argv.h"
29 #include "opal/util/string_copy.h"
30
31 #include "ompi/constants.h"
32 #include "ompi/mpi/fortran/base/fortran_base_strings.h"
33
34
35 /*
36 * creates a C string from an F77 string
37 */
38 int ompi_fortran_string_f2c(char *fstr, int len, char **cstr)
39 {
40 char *end;
41 int i;
42
43 /* Leading and trailing blanks are discarded. */
44
45 end = fstr + len - 1;
46
47 for (i = 0; (i < len) && (' ' == *fstr); ++i, ++fstr) {
48 continue;
49 }
50
51 if (i >= len) {
52 len = 0;
53 } else {
54 for (; (end > fstr) && (' ' == *end); --end) {
55 continue;
56 }
57
58 len = end - fstr + 1;
59 }
60
61 /* Allocate space for the C string. */
62
63 if (NULL == (*cstr = (char *) malloc(len + 1))) {
64 return OMPI_ERR_OUT_OF_RESOURCE;
65 }
66
67 /* Copy F77 string into C string and NULL terminate it. */
68
69 if (len > 0) {
70 opal_string_copy(*cstr, fstr, len + 1);
71 } else {
72 (*cstr)[0] = '\0';
73 }
74
75 return OMPI_SUCCESS;
76 }
77
78
79 /*
80 * Copy a C string into a Fortran string. Note that when Fortran
81 * copies strings, even if it operates on subsets of the strings, it
82 * is expected to zero out the rest of the string with spaces. Hence,
83 * when calling this function, the "len" parameter should be the
84 * compiler-passed length of the entire string, even if you're copying
85 * over less than the full string. Specifically:
86 *
87 * http://www.ibiblio.org/pub/languages/fortran/ch2-13.html
88 *
89 * "Whole operations 'using' only 'part' of it, e.g. assignment of a
90 * shorter string, or reading a shorter record, automatically pads the
91 * rest of the string with blanks."
92 */
93 int ompi_fortran_string_c2f(char *cstr, char *fstr, int len)
94 {
95 int i;
96
97 opal_string_copy(fstr, cstr, len);
98 for (i = strlen(cstr); i < len; ++i) {
99 fstr[i] = ' ';
100 }
101
102 return OMPI_SUCCESS;
103 }
104
105
106 /*
107 * Creates a C argument vector from an F77 array of strings. The
108 * array is terminated by a blank string.
109 *
110 * This function is quite similar to ompi_fortran_argv_count_f2c(),
111 * that it looks for a blank string to know when it has finished
112 * traversing the entire array (vs. having the length of the array
113 * passed in as a parameter).
114 *
115 * This function is used to convert "argv" in MPI_COMM_SPAWN (which is
116 * defined to be terminated by a blank string).
117 */
118 int ompi_fortran_argv_blank_f2c(char *array, int string_len, int advance,
119 char ***argv)
120 {
121 int err, argc = 0;
122 char *cstr;
123
124 /* Fortran lines up strings in memory, each delimited by \0. So
125 just convert them until we hit an extra \0. */
126
127 *argv = NULL;
128 while (1) {
129 if (OMPI_SUCCESS != (err = ompi_fortran_string_f2c(array, string_len,
130 &cstr))) {
131 opal_argv_free(*argv);
132 return err;
133 }
134
135 if ('\0' == *cstr) {
136 break;
137 }
138
139 if (OMPI_SUCCESS != (err = opal_argv_append(&argc, argv, cstr))) {
140 opal_argv_free(*argv);
141 free(cstr);
142 return err;
143 }
144
145 free(cstr);
146 array += advance;
147 }
148
149 free(cstr);
150 return OMPI_SUCCESS;
151 }
152
153
154 /*
155 * Creates a C argument vector from an F77 array of array_len strings.
156 *
157 * This function is quite similar to ompi_fortran_argv_blank_f2c(),
158 * except that the length of the array is a parameter (vs. looking for
159 * a blank line to end the array).
160 *
161 * This function is used to convert "array_of_commands" in
162 * MPI_COMM_SPAWN_MULTIPLE (which is not precisely defined, but is
163 * assumed to be of length "count", and *not* terminated by a blank
164 * line).
165 */
166 int ompi_fortran_argv_count_f2c(char *array, int array_len, int string_len, int advance,
167 char ***argv)
168 {
169 int err, argc = 0;
170 char *cstr;
171
172 /* Fortran lines up strings in memory, each delimited by \0. So
173 just convert them until we hit an extra \0. */
174
175 *argv = NULL;
176 for (int i = 0; i < array_len; ++i) {
177 if (OMPI_SUCCESS != (err = ompi_fortran_string_f2c(array, string_len,
178 &cstr))) {
179 opal_argv_free(*argv);
180 return err;
181 }
182
183 if (OMPI_SUCCESS != (err = opal_argv_append(&argc, argv, cstr))) {
184 opal_argv_free(*argv);
185 free(cstr);
186 return err;
187 }
188
189 free(cstr);
190 array += advance;
191 }
192
193 return OMPI_SUCCESS;
194 }
195
196
197 /*
198 * Creates a set of C argv arrays from an F77 array of argv's (where
199 * each argv array is terminated by a blank string). The returned
200 * arrays need to be freed by the caller.
201 */
202 int ompi_fortran_multiple_argvs_f2c(int num_argv_arrays, char *array,
203 int string_len, char ****argv)
204 {
205 char ***argv_array;
206 int i;
207 char *current_array = array;
208 int ret;
209
210 argv_array = (char ***) malloc (num_argv_arrays * sizeof(char **));
211
212 for (i = 0; i < num_argv_arrays; ++i) {
213 ret = ompi_fortran_argv_blank_f2c(current_array, string_len,
214 string_len * num_argv_arrays,
215 &argv_array[i]);
216 if (OMPI_SUCCESS != ret) {
217 free(argv_array);
218 return ret;
219 }
220 current_array += string_len;
221 }
222 *argv = argv_array;
223 return OMPI_SUCCESS;
224 }