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