make_fint.c 33.3 KB
Newer Older
1
#define _XOPEN_SOURCE 700
2
#define _GNU_SOURCE // needed for getline(3) on some systems it seems
3
#include <ctype.h>
4
#include <errno.h>
5
#include <regex.h>
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
6
7
8
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
9
#include <sys/types.h>
Uwe Schulzweida's avatar
Uwe Schulzweida committed
10
#include <time.h>
11
#include <unistd.h>
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
12

13
14
15
#ifndef HAVE_GETLINE
#include "getline.c"
#endif
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
16

17
//#include "config.h"
18
#define VERSION "1.6.2"
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
19
20
typedef struct
{
21
  size_t naline;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
22
23
24
25
26
27
  char *fname;
  char *aline[99];
  char *text;
}
Docu;

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

static const char default_doc_root[] = "../doc";
static struct {
  const char *name;
  size_t len;
} fname_list[] = {
  { "c_quick_ref.txt", 0 },
  { "f_quick_ref.txt", 0 },
  { "tex/c_quick_ref.tex", 0 },
  { "tex/f_quick_ref.tex", 0 },
};
enum {
  NAME_C_QUICK_REF,
  NAME_F_QUICK_REF,
  NAME_C_QUICK_REF_TEX,
  NAME_F_QUICK_REF_TEX,
  fname_list_size = sizeof(fname_list)/sizeof(fname_list[0]),
};


48
49
50
static Docu cdoc[9999], fdoc[9999];
static size_t ncdoc = 0, nfdoc = 0;
static int debug = 0;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
51

Thomas Jahns's avatar
Thomas Jahns committed
52
static int doccmp(const void *s1, const void *s2)
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
53
54
55
56
57
58
59
{
  Docu *x = (Docu *) s1;
  Docu *y = (Docu *) s2;

  return (strcmp(x->fname, y->fname));
}

Thomas Jahns's avatar
Thomas Jahns committed
60
static void doctotex(FILE *fp, Docu *doc, size_t ndoc)
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
61
{
62
  size_t i, k;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
63
64
65
66
67
68
69
70
71
72
73
74

  for ( i = 0; i < ndoc; i++ )
    {
      fprintf(fp, "\\section*{\\tt \\htmlref{%s}{%s}}\n\n", doc[i].fname, doc[i].fname);
      fprintf(fp, "\\begin{verbatim}\n");
      for ( k = 0; k < doc[i].naline; k++ )
	fprintf(fp, "    %s\n", doc[i].aline[k]);
      fprintf(fp, "\\end{verbatim}\n");
      fprintf(fp, "\n%s.\n\n\n", doc[i].text);
    }
}

Thomas Jahns's avatar
Thomas Jahns committed
75
static void doctotxt(FILE *fp, Docu *doc, size_t ndoc)
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
76
{
77
  size_t i, k;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
78
79
80
81
82
83
84
85
86
87

  for ( i = 0; i < ndoc; i++ )
    {
      fprintf(fp, "%s\n\n", doc[i].fname);
      for ( k = 0; k < doc[i].naline; k++ )
	fprintf(fp, "    %s\n", doc[i].aline[k]);
      fprintf(fp, "\n  %s.\n\n", doc[i].text);
    }
}

88
enum cftype {ISVOID, ISCONSTSTRING, ISINT, ISREAL, ISDOUBLE, ISMPI_COMM,
89
             ISXT_IDXLIST, ISCHOICE, ISINTP, ISINTV, ISINTVV, ISREALP,
90
             ISDOUBLEP, ISCBUF, ISSTRING, ISSTRINGP, VOIDFUNCVOID,
91
92
93
94
95
96
97
             NUM_KNOWN_ARG_TYPES};

enum conversionType { CONV_ARG, CONV_RET };


typedef int (*cfConversionEmitter)(FILE *outfp, const char *argName,
                                   size_t argNameLen, enum conversionType part);
98
99
typedef int (*cfPrologueEmitter)(FILE *outfp, size_t argNum);

100
101
102

static int cfMPICommConvert(FILE *outfp, const char *argName,
                            size_t argNameLen, enum conversionType part);
103

104
105
106
static int cfXtIdxlistConvert(FILE *outfp, const char *argName,
                            size_t argNameLen, enum conversionType part);

107
108
static int cfVoidFuncPrologue(FILE *outfp, size_t argNum);

109
struct symbol {
110
111
  const char *f77name, *cfint, *cfmt, *parseRE;
  /* pair of parentheses which matches the argument name */
112
  size_t nameMatch;
113
  int needsExtraWrapper, needsPrologue;
114
  cfConversionEmitter convert;
115
  const char *convcfmt;
116
  cfPrologueEmitter prologue;
117
118
119
120
121
122
123
124
125
126
  regex_t preg;
};

/* C symbol names */
#define SYMRE "([A-Za-z_][A-Za-z_0-9]*)"
/* white-space */
#define WS "[[:blank:]\n]"
#define NWS "[^[:blank:]\n]"
static struct symbol funArgSym[]
  = { { "",                "",        "void",
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
        "^"WS"*void"WS"*)", 0, 0, 0 },
      { "CHARACTER(80)",    "STRING",  "char *%.*s",
        "^"WS"*const"WS"+char"WS"+\\*"SYMRE WS"*\\(", 1, 0, 0 },
      { "INTEGER",         "INT",     "int %.*s",
        "^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*[,\\)]", 3, 0, 0 },
      { "REAL",            "FLOAT",   "float %.*s",
        "^"WS"*(const"WS"+)?float"WS"+"SYMRE"?"WS"*[,\\)]", 2, 0, 0 },
      { "DOUBLEPRECISION", "DOUBLE",  "double %.*s",
        "^"WS"*(const"WS"+)?double"WS"+"SYMRE"?"WS"*[,\\)]", 2, 0, 0 },
      { "INTEGER",         "INT", "MPI_Comm %.*s",
        "^"WS"*MPI_Comm"WS"+"SYMRE"?"WS"*[,\\)]", 1, 1, 0,
        cfMPICommConvert, "int %.*s" },
      { "TYPE(XT_IDXLIST)", "PVOID", "Xt_idxlist %.*s",
        "^"WS"*Xt_idxlist"WS"+"SYMRE"?"WS"*[,\\)]", 1, 1, 0,
        cfXtIdxlistConvert, "void *%.*s" },
      { "CHOICE", "PVOID", "const void *%.*s",
        "^"WS"*const"WS"+void"WS"*\\*"WS"*"SYMRE"?"WS"*[,\\)]", 1, 0, 0 },
      { "INTEGER",         "PINT",    "int *%.*s",
        "^"WS"*(const"WS"+)?int"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2, 0, 0 },
      { "INTEGER",         "INTV",    "int  %.*s[]",
147
        "^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*\\[[^]]*\\]"
148
149
        WS"*[,\\)]", 3, 0, 0 },
      { "INTEGER",         "INTVV",    "int %.*s[][]",
150
        "^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*\\[[^]]*\\]"
151
152
153
154
155
156
157
158
159
160
161
162
        WS"*\\[[^]]*\\]"WS"*[,\\)]", 3, 0, 0 },
      { "REAL",            "PFLOAT",  "float *%.*s",
        "^"WS"*(const"WS"+)?float"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2, 0, 0 },
      { "DOUBLEPRECISION", "PDOUBLE", "double *%.*s",
        "^"WS"*(const"WS"+)?double"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2, 0, 0 },
      { "CHARACTER*(*)",   "CBUF",    "char *%.*s",
        "^"WS"*(const"WS"+)?char"WS"+\\*""([A-Za-z_][A-Za-z_0-9]*_cbuf)"
        WS"*[,\\)]", 2, 0, 0 },
      { "CHARACTER*(*)",   "STRING",  "char *%.*s",
        "^"WS"*const"WS"+char"WS"+\\*"WS"*"SYMRE"?"WS"*[,\\)]", 1, 0, 0 },
      { "CHARACTER*(*)",   "PSTRING", "char *%.*s",
        "^"WS"*char"WS"+\\*"SYMRE"?"WS"*[,\\)]", 1, 0, 0 },
163
164
165
166
      { "PROCEDURE", "ROUTINE", "void (*%.*s)(void)",
        "^"WS"*void"WS"*\\("WS"*\\*"WS"*"SYMRE"?"WS"*\\)"
        WS"*\\("WS"*void"WS"*\\)"WS"*[,\\)]", 1, 0, 1,
        NULL, NULL, cfVoidFuncPrologue }
167
168
169
};

static struct symbol funRet[] = {
170
171
172
173
174
175
176
177
178
179
180
181
  { "",                "",        "void %.*s",
    "void"WS"+"SYMRE WS"*\\(", 1, 0, 0 },
  { "CHARACTER",       "STRING",  "char *%.*s",
    "char"WS"+\\*"WS"*"SYMRE WS"*\\(", 1, 0, 0 },
  { "INTEGER",         "INT",     "int %.*s",
    "(const"WS"+)?int"WS"+"SYMRE WS"*\\(", 2, 0, 0 },
  { "REAL",            "FLOAT",   "float %.*s",
    "(const"WS"+)?float"WS"+"SYMRE WS"*\\(", 2, 0, 0 },
  { "DOUBLEPRECISION", "DOUBLE",  "double %.*s",
    "(const"WS"+)?double"WS"+"SYMRE WS"*\\(", 2, 0, 0 },
  { "INTEGER",         "INT",     "MPI_Comm %.*s",
    "MPI_Comm"WS"+"SYMRE WS"*\\(", 1, 0, 0, cfMPICommConvert, "int %.*s" },
182
183
184
185
186
187
188
};

enum { NUM_RET_TYPES = sizeof (funRet) / sizeof (funRet[0]) };
enum decl { UNKNOWN_DECL, FUNC_DECL, PARAM_DECL };

enum {
  MAX_FUNC_ARGS = 200,
189
  MAX_FUNC_NAME_LEN = 127,
190
191
192
193
194
};

static inline size_t
compress_whitespace(size_t len, char str[]);

195
196
197
static int
reCompile(regex_t *restrict RE, const char *restrict REstring,
          char * restrict *restrict lineBuf, size_t * restrict lineBufSize);
Thomas Jahns's avatar
Thomas Jahns committed
198
199
200
201
static size_t
symRegexCompile(size_t numSyms, struct symbol symList[],
                char **line, size_t *lineBufSize);

202
203
static void
build_header_name(const char *fname, char *cppMacro);
Thomas Jahns's avatar
Thomas Jahns committed
204

205
206
static void fortran_interface(char *fname, char *fnameinc, char *fnameint,
                              const char *doc_root)
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
207
208
209
{
  FILE *fpin, *fpinc, *fpint;
  FILE *fp;
210
211
212
  char *line = NULL, *pline;
  size_t lineBufSize = 0;
  char sname[128], *parname;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
213
  char xname[128], xdes[128];
214
  xname[0] = 0;
215
  size_t xnameLen = 0;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
216
  int parvalue;
217
  enum cftype functype;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
218
  int lineno = 0;
219

220
  char funcname[MAX_FUNC_NAME_LEN];
221
222
223
224
  regmatch_t funcargfull[MAX_FUNC_ARGS];
  regmatch_t funcargname[MAX_FUNC_ARGS];
  int  funcargtype[MAX_FUNC_ARGS];
  /* char *strsort[99999]; */
Uwe Schulzweida's avatar
Uwe Schulzweida committed
225
226
227
  char timestr[30];
  time_t date_and_time_in_sec;
  struct tm *date_and_time;
228
229
  regmatch_t *reMatch = NULL;
  size_t maxMatch = 0;
Uwe Schulzweida's avatar
Uwe Schulzweida committed
230
231
232
233
234
235
236
237
238

  date_and_time_in_sec = time(NULL);
  timestr[0] = 0;

  if ( date_and_time_in_sec != -1 )
    {
      date_and_time = localtime(&date_and_time_in_sec);
      (void) strftime(timestr, sizeof(timestr), "%B %Y", date_and_time);
    }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
239
240
241
242
243
244
245
246
247
248

  fpin = fopen(fname, "r");
  if ( fpin == NULL ) { perror(fname); return; }

  fpinc = fopen(fnameinc, "w");
  if ( fpinc == NULL ) { perror(fnameinc); return; }

  fpint = fopen(fnameint, "w");
  if ( fpint == NULL ) { perror(fnameint); return; }

249
  /* complete symbol table data */
Thomas Jahns's avatar
Thomas Jahns committed
250
251
252
253
254
255
256
257
  {
    maxMatch = symRegexCompile(NUM_KNOWN_ARG_TYPES, funArgSym,
                             &line, &lineBufSize);
    size_t maxFunMatch = symRegexCompile(NUM_RET_TYPES, funRet,
                                         &line, &lineBufSize);
    if (maxFunMatch > maxMatch)
      maxMatch = maxFunMatch;
  }
258
259
260
261
262
  ++maxMatch;
  reMatch = malloc((size_t)maxMatch * sizeof (reMatch[0]));
  /* compile comment regular expression */
  regex_t commentRE;
  {
263
264
265
    static const char commentREString[] = "^"WS"*/\\*"WS"*(.*"NWS")"WS"*\\*/";
    if (reCompile(&commentRE, commentREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
266
267
268
269
  }
  /* compile documentation comment regular expression */
  regex_t docCommentRE;
  {
270
    static const char docCommentREString[] = "^"WS"*/\\*"WS"*"SYMRE":"
271
      WS"*("NWS".*"NWS")"WS"*\\*/";
272
273
    if (reCompile(&docCommentRE, docCommentREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
274
  }
275
276
277
278
279
280
281
282
283
284
  /* compile keep-conditional regular expression */
  /* if(n)def and endif preprocessor conditionals followed by
     make_fint keep are copied to the Fortran interface file */
  regex_t cppCondRE;
  {
    static const char cppCondREString[]
      = "^"WS"*#"WS"*(ifn?def"WS"+"SYMRE"|endif)"WS"+/\\*"WS"*make_fint keep"WS"*\\*/";
    if (reCompile(&cppCondRE, cppCondREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
  }
285
286
287
288
289
290
  regex_t emptyStringRE;
  {
    static const char emptyStringREString[] = "^"WS"*";
    if (reCompile(&emptyStringRE, emptyStringREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
  }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
291
292
  /* fortran include */

293
  fprintf(fpinc, "! This file was automatically generated, don't edit!\n");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
294
  fprintf(fpinc, "!\n");
295
  fprintf(fpinc, "! Fortran interface for CDI library version %s\n", VERSION);
Uwe Schulzweida's avatar
Uwe Schulzweida committed
296
297
298
299
  fprintf(fpinc, "!\n");
  fprintf(fpinc, "! Author:\n");
  fprintf(fpinc, "! -------\n");
  fprintf(fpinc, "! Uwe Schulzweida, MPI-MET, Hamburg,   %s\n", timestr);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
300
301
302
303
  fprintf(fpinc, "!\n\n");

  /* fortran interface */

304
  fprintf(fpint, "/* Automatically generated by make_fint.c, don't edit! */\n");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
305
306
307
308
309
  fprintf(fpint, "\n");
  fprintf(fpint, "#if defined (HAVE_CONFIG_H)\n");
  fprintf(fpint, "#  include \"config.h\"\n");
  fprintf(fpint, "#endif\n");
  fprintf(fpint, "\n");
310
311
312
313
314
315
316
317
  {
    char *cppMacro = malloc(strlen(fname) + 2);
    build_header_name(fname, cppMacro);
    fprintf(fpint, "#if ! defined (%s)\n"
            "#  include \"%s\"\n"
            "#endif\n"
            "\n", cppMacro, fname);
  }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
318
319
320
321
322
323
  fprintf(fpint, "#if defined (HAVE_CF_INTERFACE)\n");
  fprintf(fpint, "\n");
  fprintf(fpint, "#if ! defined (__CFORTRAN_LOADED)\n");
  fprintf(fpint, "#  include \"cfortran.h\"\n");
  fprintf(fpint, "#endif\n");
  fprintf(fpint, "\n");
324
325
326
327
  fprintf(fpint, "#if ! defined (_CDIFORTRAN_H)\n");
  fprintf(fpint, "#  include \"cdiFortran.h\"\n");
  fprintf(fpint, "#endif\n");
  fprintf(fpint, "\n");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
328

329
330
  ssize_t lineLen;
  while ((lineLen = getline(&line, &lineBufSize, fpin)) >= 0)
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
331
332
333
    {
      lineno++;
      functype = ISVOID;
334
335
      size_t funcargc = 0;
      pline = line;
336
      int needsExtraWrapper = 0, needsPrologue = 0;
337
      size_t funcnameLen;
338
339
340
341
342
343
344
      enum decl declType = UNKNOWN_DECL;
      do {
        for (int retType = 0; retType < NUM_RET_TYPES; ++retType)
          if (!regexec(&funRet[retType].preg, pline, maxMatch, reMatch, 0))
            {
              functype = retType;
              declType = FUNC_DECL;
345
346
              needsExtraWrapper
                = needsExtraWrapper || funRet[retType].needsExtraWrapper;
347
348
349
350
351
              break;
            }
        if (declType == UNKNOWN_DECL)
          break;
        regmatch_t *nameMatch = reMatch + funRet[functype].nameMatch;
352
353
        if (debug)
          printf("Found: %.*s\n",
354
                 (int) (nameMatch->rm_eo - nameMatch->rm_so),
355
                 pline + nameMatch->rm_so);
356
357
        ssize_t funNameLast = reMatch[0].rm_eo - 1;
        ssize_t nameLen = nameMatch->rm_eo - nameMatch->rm_so;
358
        funcnameLen = (size_t)nameLen;
359
360
361
362
363
        if ( pline[funNameLast] != '(' )
          {
            printf("%s\n>(< not found!", line);
            return;
          }
364
365
        memcpy(funcname, pline + nameMatch->rm_so, funcnameLen);
        funcname[funcnameLen] = 0;
366
367
368
369
370
371
372
        pline += reMatch[0].rm_eo;
      } while (0);
      if (declType == FUNC_DECL)
        {
	  funcargname[funcargc].rm_so = (regoff_t)(pline - line);
          {
            ssize_t i = 0;
373
            size_t innerParens = 0;
374
375
376
377
            do {
              ssize_t restLen = lineLen - (ssize_t)(pline - line);
              for (; i < restLen; i++ )
                {
378
                  switch (pline[i])
379
                    {
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
                    case ',':
                      if (!innerParens)
                        {
                          funcargc++;
                          funcargname[funcargc].rm_so
                            = (regoff_t)(pline - line + i + 1);
                        }
                      break;
                    case '(':
                      ++innerParens;
                      break;
                    case ')':
                      if (!innerParens)
                        {
                          funcargc++;
                          funcargname[funcargc].rm_so
                            = (regoff_t)(pline - line + i + 1);
                          goto endOfArgSearch;
                        }
                      else
                        --innerParens;
401
402
403
                      break;
                    }
                }
404
              endOfArgSearch:
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
              if (i < restLen)
                break;
              char *lineExtension = NULL;
              size_t extSize = 0, plineOff = (size_t)(pline - line);
              ssize_t extLen;
              if ((extLen = getline(&lineExtension, &extSize, fpin)) <= 0)
                break;
              if ((size_t)(lineLen + extLen) >= lineBufSize)
                if (!(line = realloc(line, (size_t)(lineLen + extLen + 1))))
                  exit(EXIT_FAILURE);
              memcpy(line + lineLen, lineExtension, (size_t)extLen + 1);
              lineLen += extLen;
              pline = line + plineOff;
            } while (1);
          }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
420
421

	  /*  printf("funcargc = %d\n", funcargc);*/
422
423
424
425
426
427
428
429
430
            /* test if argument list is actually empty */
          if (funcargc == 1
              && !regexec(&emptyStringRE, line + funcargname[0].rm_so, 1,
                          reMatch, 0)
              && (funcargname[0].rm_so + reMatch[0].rm_eo
                  == funcargname[funcargc].rm_so - 1))
            {
              funcargc = 0;
            }
431
432
          {
            size_t i;
433
            for (i = 0; i < funcargc; ++i )
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
              {
                pline = line + funcargname[i].rm_so;
                int argtype;
                regoff_t argStart = (regoff_t)(pline - line);
                for (argtype = ISVOID;
                     argtype < NUM_KNOWN_ARG_TYPES;
                     ++argtype)
                  if (!regexec(&funArgSym[argtype].preg, pline, maxMatch,
                               reMatch, 0))
                    {
                      funcargtype[i] = argtype;
                      funcargfull[i].rm_so = reMatch[0].rm_so + argStart;
                      funcargfull[i].rm_eo = reMatch[0].rm_eo + argStart;
                      regmatch_t *nameMatch = reMatch + funArgSym[argtype].nameMatch;
                      funcargname[i].rm_so = nameMatch->rm_so + argStart;
                      funcargname[i].rm_eo = nameMatch->rm_eo + argStart;
450
451
                      needsExtraWrapper
                        = needsExtraWrapper || funArgSym[argtype].needsExtraWrapper;
452
453
                      needsPrologue = needsPrologue
                        || funArgSym[argtype].needsPrologue;
454
455
456
457
458
459
460
461
462
463
464
465
466
467
                      break;
                    }
                if (argtype == NUM_KNOWN_ARG_TYPES)
                  {
                    printf("%s not implemented\n", line + funcargname[i].rm_so);
                    break;
                  }
              }
            if ( i != funcargc )
              {
                printf("problem parsing line: %s\n", line);
                continue;
              }
          }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
468
469

	  strcpy(sname, funcname);
470

Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
471
472
473
474
475
	  /* fortran include */

	  if ( functype == ISVOID )
	    fprintf(fpinc, "!     %-16s", "");
	  else
476
	    fprintf(fpinc, "      %-16s", funArgSym[functype].f77name);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
477
478
479
480

          fprintf(fpinc, "%s", sname);
	  fprintf(fpinc, "\n");
	  if ( (funcargc == 1 && funcargtype[0] == ISVOID) ) funcargc = 0;
481
	  for (size_t i = 0; i < funcargc; i++ )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
482
483
484
485
486
	    {
	      if ( i == 0 )
		fprintf(fpinc, "!%36s(", "");
	      else
		fprintf(fpinc, ",\n!%36s ", "");
487
488
489
	      fprintf(fpinc, "%-16s%.*s", funArgSym[funcargtype[i]].f77name,
                      (int)(funcargname[i].rm_eo - funcargname[i].rm_so),
                      line + funcargname[i].rm_so);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
490
491
492
493
494
495
	    }
	  if ( funcargc )
	    fprintf(fpinc, ")\n");
	  fprintf(fpinc, "      %-16s%s\n\n", "EXTERNAL", sname);

	  /* fortran interface */
496
497
          const char *delegateName;
          char delegateNameBuf[MAX_FUNC_NAME_LEN + 7];
498
          size_t delegateNameLen = funcnameLen;
499
500
501
502
503
504
505
506
507
508
509
          /* emit prologue if needed */
          if (needsPrologue)
            {
              if (funRet[functype].needsPrologue)
                funRet[functype].prologue(fpint, (size_t)-1);
              for (size_t i = 0; i < funcargc; i++ )
                {
                  if (funArgSym[funcargtype[i]].needsPrologue)
                    funArgSym[funcargtype[i]].prologue(fpint, i);
                }
            }
510
511
512
513
514
          /* emit wrapper for type conversions if needed */
          if (needsExtraWrapper)
            {
              strcpy(delegateNameBuf, funcname);
              strcat(delegateNameBuf, "_fwrap");
515
              delegateNameLen += 6;
516
              delegateName = delegateNameBuf;
517
518
519
520
521
              fputs("static ", fpint);
              fprintf(fpint, (funRet[functype].convert
                              ?funRet[functype].convcfmt:funRet[functype].cfmt),
                      (int)delegateNameLen, delegateName);
              fputs("(", fpint);
522
523
              for (size_t i = 0; i < funcargc; i++ )
                {
524
525
526
527
528
                  if (i > 0)
                    fputs(", ", fpint);
                  fprintf(fpint, (funArgSym[funcargtype[i]].convert
                                  ?funArgSym[funcargtype[i]].convcfmt
                                  :funArgSym[funcargtype[i]].cfmt),
529
530
531
532
533
                          (int)(funcargname[i].rm_eo - funcargname[i].rm_so),
                          line + funcargname[i].rm_so);
                }
              fputs(")\n{\n", fpint);
              if (functype != ISVOID)
534
535
536
537
538
539
                {
                  fputs("  ", fpint);
                  fprintf(fpint, funRet[functype].cfmt, 1, "v");
                  fprintf(fpint, ";\n"
                          "  v = %s(", funcname);
                }
540
541
542
543
              else
                fprintf(fpint, "  %s(", funcname);
              for (size_t i = 0; i < funcargc; i++ )
                {
544
545
                  if (i > 0)
                    fputs(", ", fpint);
546
547
548
549
550
551
552
553
554
                  if (funArgSym[funcargtype[i]].convert)
                    {
                      funArgSym[funcargtype[i]]
                        .convert(fpint,
                                 line + funcargname[i].rm_so,
                                 (size_t)(funcargname[i].rm_eo
                                          - funcargname[i].rm_so), CONV_ARG);
                    }
                  else
555
                    fprintf(fpint, "%.*s",
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
                            (int)(funcargname[i].rm_eo - funcargname[i].rm_so),
                            line + funcargname[i].rm_so);
                }
              fputs(");\n", fpint);
              if (functype != ISVOID)
                {
                  fputs("  return ", fpint);
                  if (funRet[functype].convert)
                    funRet[functype].convert(fpint, "v", 1, CONV_RET);
                  else
                    fputc('v', fpint);
                  fputs(";\n", fpint);
                }
              fputs("}\n", fpint);
            }
          else
            delegateName = funcname;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
573
574
575
576
	  if ( functype == ISVOID )
	    fprintf(fpint, "FCALLSCSUB");
	  else
	    fprintf(fpint, "FCALLSCFUN");
577
	  fprintf(fpint, "%zd ", funcargc);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
578
579
	  fprintf(fpint, "(");
	  if ( functype != ISVOID )
580
581
	    fprintf(fpint, "%s, ", funRet[functype].cfint);
	  fprintf(fpint, "%s, ", delegateName);
582
583
	  for (size_t i = 0; i < funcnameLen; ++i)
            sname[i] = (char)toupper((int) sname[i]);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
584
	  fprintf(fpint, "%s, ", sname);
585
586
	  for (size_t i = 0; i < funcnameLen; ++i)
            sname[i] = (char)tolower((int) sname[i]);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
587
	  fprintf(fpint, "%s", sname);
588
	  for (size_t i = 0; i < funcargc; i++ )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
589
	    {
590
591
	      fprintf(fpint, ", %s", funArgSym[funcargtype[i]].cfint);
	    }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
592
593
594
	  fprintf(fpint, ")\n");


595
596
	  if ( funcnameLen == xnameLen
               && memcmp(funcname, xname, funcnameLen) == 0 )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
597
598
	    {
	      char xline[128];
599
              size_t xlineLen = 0;
600
601
	      int nch;

Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
602
603
604
605
606
607
	      /* C Quick Guide */

	      cdoc[ncdoc].naline = 0;
	      cdoc[ncdoc].text   = NULL;
	      cdoc[ncdoc].fname  = strdup(funcname);

608
609
610
611
612
613
	      nch = sprintf(xline, funRet[functype].cfmt,
                            (int)funcnameLen, funcname);
              xline[nch++] = ' ';
              xline[nch++] = '(';
              xline[nch] = '\0';
              xlineLen = (size_t)nch;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
614
615
616

	      if ( (funcargc == 1 && funcargtype[0] == ISVOID) ) funcargc = 0;

617
	      for (size_t i = 0; i < funcargc; i++ )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
618
		{
619
620
621
622
623
		  if (i)
                    {
                      strcat(xline, ", ");
                      xlineLen += 2;
                    }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
624

625
626
627
628
629
630
631
632
633
634
635
                  /* extract full argument text from match */
                  char farg[128];
                  /* - 1 to omit closing paren ) or comma , */
                  int nchn = snprintf(farg, sizeof (farg), "%.*s",
                                      (int)(funcargfull[i].rm_eo
                                            - funcargfull[i].rm_so - 1),
                                      line + funcargfull[i].rm_so);
                  if (nchn < 0)
                    abort();
                  /* compress white-space */
                  nchn = (int)compress_whitespace((size_t)nchn, farg);
636
		  if ( (xlineLen + (size_t)nchn) > (size_t)80 )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
637
		    {
638
                      if (i) xline[--xlineLen] = 0;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
639
640
		      cdoc[ncdoc].aline[cdoc[ncdoc].naline++] = strdup(xline);
		      sprintf(xline, "%*s", nch, "");
641
                      xlineLen = (size_t)nch;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
642
643
		    }
		  strcat(xline, farg);
644
                  xlineLen += (size_t)nchn;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
645
		}
646
	      strcat(xline, ");");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
647
648
649
650
651
652
653
654
655
656
657
658
	      cdoc[ncdoc].aline[cdoc[ncdoc].naline++] = strdup(xline);
	      cdoc[ncdoc].text  = strdup(xdes);

	      ncdoc++;

	      /* Fortran Quick Guide */

	      fdoc[nfdoc].naline = 0;
	      fdoc[nfdoc].text   = NULL;
	      fdoc[nfdoc].fname  = strdup(funcname);

	      if ( functype == ISVOID )
659
		nch = sprintf(xline, "SUBROUTINE %s", xname);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
660
	      else
661
		nch = sprintf(xline, "%s FUNCTION %s", funArgSym[functype].f77name, xname);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
662
663

	      if ( (funcargc == 1 && funcargtype[0] == ISVOID) ) funcargc = 0;
664
              if (funcargc) strcat(xline, " ("), nch += 2;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
665

666
667
              xlineLen = (size_t)nch;

668
	      for (size_t i = 0; i < funcargc; i++ )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
669
		{
670
671
672
673
674
		  if (i)
                    {
                      strcat(xline, ", ");
                      xlineLen += 2U;
                    }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
675

676
677
678
679
680
681
682
683
684
685
                  char farg[128];
                  /* FIXME: optional empty argument name unhandled */
		  int nchn
                    = snprintf(farg, sizeof (farg), "%s %.*s",
                               funArgSym[funcargtype[i]].f77name,
                               (int)(funcargname[i].rm_eo
                                     - funcargname[i].rm_so),
                               line + funcargname[i].rm_so);
                  if (nchn < 0)
                    abort();
686
		  if ( (xlineLen + (size_t)nchn) > 80 )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
687
		    {
688
                      if (i) xline[--xlineLen] = 0;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
689
690
		      fdoc[nfdoc].aline[fdoc[nfdoc].naline++] = strdup(xline);
		      sprintf(xline, "%*s", nch, "");
691
                      xlineLen = (size_t)nch;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
692
693
		    }
		  strcat(xline, farg);
694
                  xlineLen += (size_t)nchn;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
695
696
697
698
699
700
701
702
		}
	      if ( funcargc ) strcat(xline, ")");
	      fdoc[nfdoc].aline[fdoc[nfdoc].naline++] = strdup(xline);
	      fdoc[nfdoc].text  = strdup(xdes);

	      nfdoc++;
	    }
	}
703
      else if ( memcmp(line, "#define", 7) == 0 )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
704
705
706
707
708
	{
	  pline = line;
	  pline += 7;
	  while ( isspace((int) *pline) ) pline++;
	  parname = pline;
709
	  size_t len = strlen(pline);
710
711
          size_t i = 0;
	  for (; i < len; i++ )
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
712
713
714
715
716
717
718
719
720
721
722
	    {
	      if ( isspace((int) pline[i]) ) break;
	    }
	  if ( i == len ) continue;
	  parname[i] = 0;
	  pline += i+1;
	  while ( isspace((int) *pline) ) pline++;
	  if ( ! (isdigit((int) *pline) || *pline == '-') ) continue;
	  parvalue = atoi(pline);

	  /* fortran include */
723
724
725
	  fprintf(fpinc, "      INTEGER    %-22s\n"
                  "      PARAMETER (%-22s = %2d)\n", parname, parname,
                  parvalue);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
726
	}
727
728
729
730
731
      else if (!regexec(&cppCondRE, line, maxMatch, reMatch, 0))
	{
          /* fortran include */
	  fputs(line, fpint);
	}
732
733
734
735
736
737
738
      else if (!regexec(&docCommentRE, line, maxMatch, reMatch, 0))
        {
          /* found documentation comment */
          size_t nameMatchLen = (size_t)(reMatch[1].rm_eo - reMatch[1].rm_so),
            docMatchLen = (size_t)(reMatch[2].rm_eo - reMatch[2].rm_so);
          memcpy(xname, line + reMatch[1].rm_so, nameMatchLen);
          xname[nameMatchLen] = 0;
739
          xnameLen = nameMatchLen;
740
741
742
743
744
745
          memcpy(xdes, line + reMatch[2].rm_so, docMatchLen);
          xdes[docMatchLen] = 0;
          printf("Found documentation for \"%s\": \"%s\"\n", xname,
                 xdes);
        }
      else if (!regexec(&commentRE, line, maxMatch, reMatch, 0))
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
746
	{
747
748
749
750
          size_t commentLen = (size_t)(reMatch[1].rm_eo - reMatch[1].rm_so);
          const char *comment = line + reMatch[1].rm_so;
          /* fortran include */
          fprintf(fpinc, "!\n!  %.*s\n!\n", (int)commentLen, comment);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
751

752
753
          /* fortran interface */
          fprintf(fpint, "\n/*  %.*s  */\n\n", (int)commentLen, comment);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
754
755
756
	}
      else
	{
757
758
759
	  if ( lineLen > 1 )
	    printf("skip: line %3d  size %3zd  %s%s", lineno, lineLen, line,
                   line[lineLen-1]=='\n'?"":"missing new-line\n");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
760
761
762
763
764
765
766
767
768
769
770
771
772
	}
    }

  fprintf(fpint, "\n");
  fprintf(fpint, "#endif\n");

  fclose(fpin);
  fclose(fpinc);
  fclose(fpint);

  qsort(cdoc, ncdoc, sizeof(Docu), doccmp);
  qsort(fdoc, nfdoc, sizeof(Docu), doccmp);

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795

  char *filename;
  size_t doc_root_len = strlen(doc_root);
  {
    size_t max_len = 0;
    for (size_t i = 0; i < (size_t)fname_list_size; ++i)
      {
        size_t len = strlen(fname_list[i].name);
        fname_list[i].len = len;
        if (len > max_len)
          max_len = len;
      }
    /* path to document root, separating /, max of path within root,
     * terminating '\0'  */
    filename = malloc(doc_root_len + 1 + max_len + 1);
  }

  memcpy(filename, doc_root, doc_root_len);
  filename[doc_root_len] = '/';
  memcpy(filename + doc_root_len + 1,
         fname_list[NAME_C_QUICK_REF].name,
         fname_list[NAME_C_QUICK_REF].len + 1);
  fp = fopen(filename, "w");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
796
797
798
799
800
801
802
803
  if ( fp )
    {
      fprintf(fp, "C Quick Reference\n");
      fprintf(fp, "-----------------\n\n");

      doctotxt(fp, cdoc, ncdoc);
      fclose(fp);
    }
804
805
806
807
808
  else
    {
      fprintf(stderr, "warning: cannot open documentation output file %s, %s",
              filename, strerror(errno));
    }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
809

810
811
812
813
  memcpy(filename + doc_root_len + 1,
         fname_list[NAME_F_QUICK_REF].name,
         fname_list[NAME_F_QUICK_REF].len + 1);
  fp = fopen(filename, "w");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
814
815
816
817
818
819
820
821
  if ( fp )
    {
      fprintf(fp, "Fortran Quick Reference\n");
      fprintf(fp, "-----------------------\n\n");

      doctotxt(fp, fdoc, nfdoc);
      fclose(fp);
    }
822
823
824
825
826
  else
    {
      fprintf(stderr, "warning: cannot open documentation output file %s, %s",
              filename, strerror(errno));
    }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
827

828
829
830
831
  memcpy(filename + doc_root_len + 1,
         fname_list[NAME_C_QUICK_REF_TEX].name,
         fname_list[NAME_C_QUICK_REF_TEX].len + 1);
  fp = fopen(filename, "w");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
832
833
834
835
836
837
838
839
840
841
842
843
  if ( fp )
    {
      fprintf(fp, "\\chapter*{Quick Reference}\n");
      fprintf(fp, "\\addcontentsline{toc}{chapter}{Quick Reference}\n");
      fprintf(fp, "\n");
      fprintf(fp, "This appendix provide a brief listing of the C language bindings of the\n");
      fprintf(fp, "CDI library routines:\n");
      fprintf(fp, "\n");

      doctotex(fp, cdoc, ncdoc);
      fclose(fp);
    }
844
845
846
847
848
  else
    {
      fprintf(stderr, "warning: cannot open documentation output file %s, %s",
              filename, strerror(errno));
    }
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
849

850
851
852
853
  memcpy(filename + doc_root_len + 1,
         fname_list[NAME_F_QUICK_REF_TEX].name,
         fname_list[NAME_F_QUICK_REF_TEX].len + 1);
  fp = fopen(filename, "w");
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
854
855
856
857
858
859
860
861
862
863
864
865
  if ( fp )
    {
      fprintf(fp, "\\chapter*{Quick Reference}\n");
      fprintf(fp, "\\addcontentsline{toc}{chapter}{Quick Reference}\n");
      fprintf(fp, "\n");
      fprintf(fp, "This appendix provide a brief listing of the Fortran language bindings of the\n");
      fprintf(fp, "CDI library routines:\n");
      fprintf(fp, "\n");

      doctotex(fp, fdoc, nfdoc);
      fclose(fp);
    }
866
867
868
869
870
871
  else
    {
      fprintf(stderr, "warning: cannot open documentation output file %s, %s",
              filename, strerror(errno));
    }
  free(filename);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
872
873
}

874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
static void
build_header_name(const char *fname, char *cppMacro)
{
  size_t len = strlen(fname);
  for (size_t i = 0; i < len; ++i)
    switch (fname[i])
      {
      case '.':
        cppMacro[i] = '_';
        break;
      default:
        cppMacro[i] = (char)toupper((int)fname[i]);
      }
  cppMacro[len] = '_';
  cppMacro[len + 1] = '\0';
}

Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
891
892
893
894
int main(int argc, char *argv[])
{
  char *fname;
  char *cp;
895
  const char *doc_root = default_doc_root;
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
896
897
898
  char fnameinc[128], fnameint[128];
  size_t len;

899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
  int optargCount = 0;
  {
    int opt;
    while ((opt = getopt(argc, argv, "d:")) != -1)
      switch (opt) {
      case 'd':
        doc_root = optarg;
        optargCount = 2;
        break;
      default: /* '?' */
        fprintf(stderr, "Usage: %s [-d DOCROOT] includefile\n", argv[0]);
        return(EXIT_FAILURE);
      }
  }


  if ( argc != 2 + optargCount)
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
916
    {
917
      printf("Usage:  %s [-d DOCROOT] includefile\n", argv[0]);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
918
919
920
      return (1);
    }

921
  fname = argv[1 + optargCount];
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
922
923
924

  cp = strrchr(fname, '.');
  if ( cp == NULL ) len = strlen(fname);
925
  else              len = (size_t)(cp - fname);
926

927
928
  memcpy(fnameinc, fname, len);
  memcpy(fnameint, fname, len);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
929
930
931

  strcpy(fnameinc+len, ".inc");
  strcpy(fnameint+len, "Fortran.c");
932

933
  fortran_interface(fname, fnameinc, fnameint, doc_root);
Uwe Schulzweida's avatar
Cleanup  
Uwe Schulzweida committed
934
935
936

  return (0);
}
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965

static inline size_t
compress_whitespace(size_t len, char str[])
{
  size_t wpos = 0;
  size_t i = 0;
  /* skip leading white-space */
  while (i < len && (isblank(str[i]) || str[i] == '\n'))
    ++i;
  /* after the leading white-space the following is
   * an alternation of white- and non-white-space
   * characters, where sequences of the latter will
   * be compressed to a single space */
  while (i < len)
    {
      /* handle white-space */
      while (i < len && !(isblank(str[i]) || str[i] == '\n'))
        str[wpos++] = str[i++];
      /* skip non-white-space */
      size_t wscount = 0;
      while (i < len && (isblank(str[i]) || str[i] == '\n'))
        ++i, ++wscount;
      if (wscount)
        str[wpos++] = ' ';
    }
  str[wpos] = '\0';
  return wpos;
}

Thomas Jahns's avatar
Thomas Jahns committed
966
967
968
969
970
971
972
973
974
975
976
977
enum {
  REGEX_MAX_ERRSTRLEN = 1024,
};


static size_t
symRegexCompile(size_t numSyms, struct symbol symList[],
                char **line, size_t *lineBufSize)
{
  size_t maxMatch = 0;
  for (size_t sym = 0; sym < numSyms; ++sym)
    {
978
979
980
      if (reCompile(&symList[sym].preg, symList[sym].parseRE,
                    line, lineBufSize))
        exit(EXIT_FAILURE);
Thomas Jahns's avatar
Thomas Jahns committed
981
982
983
984
985
986
      if (symList[sym].nameMatch > maxMatch)
        maxMatch = symList[sym].nameMatch;
    }
  return maxMatch;
}

987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
static int
reCompile(regex_t *restrict RE, const char *restrict REstring,
          char * restrict *restrict lineBuf, size_t * restrict lineBufSize)
{
  int errcode;
  if ((errcode = regcomp(RE, REstring, REG_EXTENDED)))
    {
      char *restrict line;
      size_t resize;
      if (*lineBufSize < REGEX_MAX_ERRSTRLEN
          && (line = realloc(*lineBuf, resize = REGEX_MAX_ERRSTRLEN)))
        {
          *lineBuf = line;
          *lineBufSize = resize;
          regerror(errcode, RE, line, *lineBufSize);
          fprintf(stderr, "Error compiling regular expression: %s: %s\n",
                  REstring, *lineBuf);
        }
    }
  return errcode;
}

1009
1010
/* emit conversion code for MPI_Comm argument */
static int cfMPICommConvert(FILE *outfp, const char *argName,
1011
                            size_t argNameLen, enum conversionType part)
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
{
  int retval = 0;
  switch (part)
    {
    case CONV_ARG:
      retval
        = fprintf(outfp, "MPI_Comm_f2c(%.*s)", (int)argNameLen, argName);
      break;
    case CONV_RET:
      retval = fprintf(outfp, "MPI_Comm_c2f(%.*s)", (int)argNameLen, argName);
      break;
    }
  return retval;
}
1026

1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
/* emit conversion code for Xt_idxlist argument */
static int cfXtIdxlistConvert(FILE *outfp, const char *argName,
                              size_t argNameLen, enum conversionType part)
{
  int retval = 0;
  switch (part)
    {
    case CONV_ARG:
      retval
        = fprintf(outfp, "(*(Xt_idxlist *)%.*s)", (int)argNameLen, argName);
      break;
    case CONV_RET:
      abort();
      break;
    }
  return retval;
}

1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
static int cfVoidFuncPrologue(FILE *outfp, size_t argNum)
{
  int retval
    = fprintf(outfp, "\n#undef ROUTINE_%zu\n#define ROUTINE_%zu %s\n", argNum,
              argNum, "(void (*)(void))");
  return retval;
}



1055
1056
1057
1058
1059
1060
1061
1062
1063
/*
 * Local Variables:
 * c-file-style: "Java"
 * c-basic-offset: 2
 * indent-tabs-mode: nil
 * show-trailing-whitespace: t
 * require-trailing-newline: t
 * End:
 */
1064