make_fint.c 37.5 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.7.0"
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;

Uwe Schulzweida's avatar
Uwe Schulzweida committed
28
// Example: ./make_fint -d ../doc/pio/ cdipio.h
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

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]),
};


49
50
51
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
52

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

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

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

  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
76
static void doctotxt(FILE *fp, Docu *doc, size_t ndoc)
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
77
{
78
  size_t i, k;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
79
80
81
82
83
84
85
86
87
88

  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);
    }
}

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

enum conversionType { CONV_ARG, CONV_RET };


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

102
103
104

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

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

109
110
static int cfVoidFuncPrologue(FILE *outfp, size_t argNum);

111
struct symbol {
112
113
  const char *f77name, *cfint, *cfmt, *parseRE;
  /* pair of parentheses which matches the argument name */
114
  size_t nameMatch;
115
  int needsExtraWrapper, needsPrologue;
116
  cfConversionEmitter convert;
117
  const char *convcfmt;
118
  cfPrologueEmitter prologue;
119
120
121
122
123
124
125
126
127
128
  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",
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
        "^"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[]",
149
        "^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*\\[[^]]*\\]"
150
151
        WS"*[,\\)]", 3, 0, 0 },
      { "INTEGER",         "INTVV",    "int %.*s[][]",
152
        "^"WS"*(const"WS"+)?int("WS"+"SYMRE")?"WS"*\\[[^]]*\\]"
153
154
155
156
157
        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 },
158
      { "CHARACTER*(*)",   "PPSTRING",    "char *%.*s",
159
160
        "^"WS"*(const"WS"+)?char"WS"+\\*""([A-Za-z_][A-Za-z_0-9]*_cbuf)"
        WS"*[,\\)]", 2, 0, 0 },
161
162
163
164
      { "INTEGER*1(16)",   "PVOID",    "unsigned char %.*s[16]",
        "^"WS"*(const"WS"+)?unsigned"WS"+char"WS"+"SYMRE"?\\[(16|CDI_UUID_SIZE)\\]"WS"*[,\\)]", 2, 0, 0 },
      { "INTEGER*1(*)",   "PVOID",    "unsigned char *%.*s",
        "^"WS"*(const"WS"+)?unsigned"WS"+char"WS"+\\*"SYMRE"?"WS"*[,\\)]", 2, 0, 0 },
165
166
167
168
      { "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 },
169
170
171
      { "PROCEDURE", "ROUTINE", "void (*%.*s)(void)",
        "^"WS"*void"WS"*\\("WS"*\\*"WS"*"SYMRE"?"WS"*\\)"
        WS"*\\("WS"*void"WS"*\\)"WS"*[,\\)]", 1, 0, 1,
172
        NULL, NULL, cfVoidFuncPrologue },
173
174
175
};

static struct symbol funRet[] = {
176
177
178
179
180
181
182
183
184
185
186
187
  { "",                "",        "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" },
188
189
190
191
192
193
194
};

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

enum {
  MAX_FUNC_ARGS = 200,
195
  MAX_FUNC_NAME_LEN = 127,
196
197
198
199
200
};

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

201
202
203
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
204
205
206
207
static size_t
symRegexCompile(size_t numSyms, struct symbol symList[],
                char **line, size_t *lineBufSize);

208
209
static void
build_header_name(const char *fname, char *cppMacro);
Thomas Jahns's avatar
Thomas Jahns committed
210

211
212
213
214
215
216
217
218
static int detectComment(char **line_, ssize_t *lineLen, size_t *lineBufSize,
                         size_t maxMatch, regmatch_t reMatch[],
                         char *xname, size_t *xnameLen,
                         char *xdes,
                         FILE *fpin, FILE *fpinc, FILE *fpint);

static regex_t commentStartRE, commentEndRE, commentRE, docCommentRE;

219
220
static void fortran_interface(char *fname, char *fnameinc, char *fnameint,
                              const char *doc_root)
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
221
222
223
{
  FILE *fpin, *fpinc, *fpint;
  FILE *fp;
224
225
226
  char *line = NULL, *pline;
  size_t lineBufSize = 0;
  char sname[128], *parname;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
227
  char xname[128], xdes[128];
228
  xname[0] = 0;
229
  size_t xnameLen = 0;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
230
  int parvalue;
231
  enum cftype functype;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
232
  int lineno = 0;
233

234
  char funcname[MAX_FUNC_NAME_LEN];
235
236
237
238
  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
239
240
241
  char timestr[30];
  time_t date_and_time_in_sec;
  struct tm *date_and_time;
242
243
  regmatch_t *reMatch = NULL;
  size_t maxMatch = 0;
Uwe Schulzweida's avatar
Uwe Schulzweida committed
244
245
246
247
248
249
250
251
252

  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
253
254
255
256
257
258
259
260
261
262

  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; }

263
  /* complete symbol table data */
Thomas Jahns's avatar
Thomas Jahns committed
264
265
266
267
268
269
270
271
  {
    maxMatch = symRegexCompile(NUM_KNOWN_ARG_TYPES, funArgSym,
                             &line, &lineBufSize);
    size_t maxFunMatch = symRegexCompile(NUM_RET_TYPES, funRet,
                                         &line, &lineBufSize);
    if (maxFunMatch > maxMatch)
      maxMatch = maxFunMatch;
  }
272
  ++maxMatch;
273
274
275
276
277
278
279
280
281
282
283
284
285
286
  reMatch = (regmatch_t *)malloc((size_t)maxMatch * sizeof (reMatch[0]));
  /* compile comment start regular expression */
  {
    static const char commentStartREString[] = "^"WS"*/\\*"WS"*(.*"NWS")"WS"*";
    if (reCompile(&commentStartRE, commentStartREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
  }
  /* compile comment end regular expression */
  {
    static const char commentEndREString[] = "\\*/";
    if (reCompile(&commentEndRE, commentEndREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
  }
  /* compile complete comment regular expression */
287
  {
288
289
290
    static const char commentREString[] = "^"WS"*/\\*"WS"*(.*"NWS")"WS"*\\*/";
    if (reCompile(&commentRE, commentREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
291
292
293
  }
  /* compile documentation comment regular expression */
  {
294
    static const char docCommentREString[] = "^"WS"*/\\*"WS"*"SYMRE":"
295
      WS"*("NWS".*"NWS")"WS"*\\*/";
296
297
    if (reCompile(&docCommentRE, docCommentREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
298
  }
299
300
301
  regex_t cppCondRE;
  {
    static const char cppCondREString[]
302
      = "^"WS"*#"WS"*((ifn?def)"WS"+"SYMRE"|endif)"WS"*(/\\*[^*]*\\*/|//.*)?";
303
304
305
    if (reCompile(&cppCondRE, cppCondREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
  }
306
307
308
309
310
311
312
  regex_t cppElseRE;
  {
    static const char cppElseREString[]
      = "^"WS"*#"WS"*else"WS"*(/\\*[^*]*\\*/|//.*)?";
    if (reCompile(&cppElseRE, cppElseREString, &line, &lineBufSize))
      exit(EXIT_FAILURE);
  }
313
314
315
316
317
318
  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
319
320
  /* fortran include */

321
  fprintf(fpinc, "! This file was automatically generated, don't edit!\n");
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
322
  fprintf(fpinc, "!\n");
323
  fprintf(fpinc, "! Fortran interface for CDI library version %s\n", VERSION);
Uwe Schulzweida's avatar
Uwe Schulzweida committed
324
325
326
327
  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
328
329
330
331
  fprintf(fpinc, "!\n\n");

  /* fortran interface */

332
  fprintf(fpint, "/* Automatically generated by make_fint.c, don't edit! */\n");
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
333
334
335
336
337
  fprintf(fpint, "\n");
  fprintf(fpint, "#if defined (HAVE_CONFIG_H)\n");
  fprintf(fpint, "#  include \"config.h\"\n");
  fprintf(fpint, "#endif\n");
  fprintf(fpint, "\n");
338
  {
Uwe Schulzweida's avatar
Uwe Schulzweida committed
339
    char *cppMacro = (char*) malloc(strlen(fname) + 2);
340
341
342
343
344
345
    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
346
347
348
349
350
351
352
  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");

353
354
  ssize_t lineLen;
  while ((lineLen = getline(&line, &lineBufSize, fpin)) >= 0)
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
355
    {
356
      static const char cplusplus_macro[] = "__cplusplus";
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
357
358
      lineno++;
      functype = ISVOID;
359
360
      size_t funcargc = 0;
      pline = line;
361
      int needsExtraWrapper = 0, needsPrologue = 0;
362
      size_t funcnameLen;
363
364
365
366
367
368
369
      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;
370
371
              needsExtraWrapper
                = needsExtraWrapper || funRet[retType].needsExtraWrapper;
372
373
374
375
376
              break;
            }
        if (declType == UNKNOWN_DECL)
          break;
        regmatch_t *nameMatch = reMatch + funRet[functype].nameMatch;
377
378
        if (debug)
          printf("Found: %.*s\n",
379
                 (int) (nameMatch->rm_eo - nameMatch->rm_so),
380
                 pline + nameMatch->rm_so);
381
382
        ssize_t funNameLast = reMatch[0].rm_eo - 1;
        ssize_t nameLen = nameMatch->rm_eo - nameMatch->rm_so;
383
        funcnameLen = (size_t)nameLen;
384
385
386
387
388
        if ( pline[funNameLast] != '(' )
          {
            printf("%s\n>(< not found!", line);
            return;
          }
389
390
        memcpy(funcname, pline + nameMatch->rm_so, funcnameLen);
        funcname[funcnameLen] = 0;
391
392
        pline += reMatch[0].rm_eo;
      } while (0);
393
394
      int cppSwitchLen, cppSymLen;

395
396
397
398
399
      if (declType == FUNC_DECL)
        {
	  funcargname[funcargc].rm_so = (regoff_t)(pline - line);
          {
            ssize_t i = 0;
400
            size_t innerParens = 0;
401
402
403
404
            do {
              ssize_t restLen = lineLen - (ssize_t)(pline - line);
              for (; i < restLen; i++ )
                {
405
                  switch (pline[i])
406
                    {
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
                    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;
428
429
430
                      break;
                    }
                }
431
              endOfArgSearch:
432
433
434
435
436
437
438
439
              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)
Uwe Schulzweida's avatar
Uwe Schulzweida committed
440
                if (!(line = (char*) realloc(line, (size_t)(lineLen + extLen + 1))))
441
442
443
444
445
446
                  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
447
448

	  /*  printf("funcargc = %d\n", funcargc);*/
449
450
451
452
453
454
455
456
457
            /* 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;
            }
458
459
          {
            size_t i;
460
            for (i = 0; i < funcargc; ++i )
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
              {
                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;
477
478
                      needsExtraWrapper
                        = needsExtraWrapper || funArgSym[argtype].needsExtraWrapper;
479
480
                      needsPrologue = needsPrologue
                        || funArgSym[argtype].needsPrologue;
481
482
483
484
485
486
487
488
489
490
491
492
493
494
                      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
495
496

	  strcpy(sname, funcname);
497

Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
498
499
500
501
502
	  /* fortran include */

	  if ( functype == ISVOID )
	    fprintf(fpinc, "!     %-16s", "");
	  else
503
	    fprintf(fpinc, "      %-16s", funArgSym[functype].f77name);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
504
505
506
507

          fprintf(fpinc, "%s", sname);
	  fprintf(fpinc, "\n");
	  if ( (funcargc == 1 && funcargtype[0] == ISVOID) ) funcargc = 0;
508
	  for (size_t i = 0; i < funcargc; i++ )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
509
510
511
512
513
	    {
	      if ( i == 0 )
		fprintf(fpinc, "!%36s(", "");
	      else
		fprintf(fpinc, ",\n!%36s ", "");
514
515
516
	      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
517
518
519
520
521
522
	    }
	  if ( funcargc )
	    fprintf(fpinc, ")\n");
	  fprintf(fpinc, "      %-16s%s\n\n", "EXTERNAL", sname);

	  /* fortran interface */
523
524
          const char *delegateName;
          char delegateNameBuf[MAX_FUNC_NAME_LEN + 7];
525
          size_t delegateNameLen = funcnameLen;
526
527
528
529
530
531
532
533
534
535
536
          /* 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);
                }
            }
537
538
539
540
541
          /* emit wrapper for type conversions if needed */
          if (needsExtraWrapper)
            {
              strcpy(delegateNameBuf, funcname);
              strcat(delegateNameBuf, "_fwrap");
542
              delegateNameLen += 6;
543
              delegateName = delegateNameBuf;
544
545
546
547
548
              fputs("static ", fpint);
              fprintf(fpint, (funRet[functype].convert
                              ?funRet[functype].convcfmt:funRet[functype].cfmt),
                      (int)delegateNameLen, delegateName);
              fputs("(", fpint);
549
550
              for (size_t i = 0; i < funcargc; i++ )
                {
551
552
553
554
555
                  if (i > 0)
                    fputs(", ", fpint);
                  fprintf(fpint, (funArgSym[funcargtype[i]].convert
                                  ?funArgSym[funcargtype[i]].convcfmt
                                  :funArgSym[funcargtype[i]].cfmt),
556
557
558
559
560
                          (int)(funcargname[i].rm_eo - funcargname[i].rm_so),
                          line + funcargname[i].rm_so);
                }
              fputs(")\n{\n", fpint);
              if (functype != ISVOID)
561
562
563
564
565
566
                {
                  fputs("  ", fpint);
                  fprintf(fpint, funRet[functype].cfmt, 1, "v");
                  fprintf(fpint, ";\n"
                          "  v = %s(", funcname);
                }
567
568
569
570
              else
                fprintf(fpint, "  %s(", funcname);
              for (size_t i = 0; i < funcargc; i++ )
                {
571
572
                  if (i > 0)
                    fputs(", ", fpint);
573
574
575
576
577
578
579
580
581
                  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
582
                    fprintf(fpint, "%.*s",
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
                            (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
600
601
602
603
	  if ( functype == ISVOID )
	    fprintf(fpint, "FCALLSCSUB");
	  else
	    fprintf(fpint, "FCALLSCFUN");
604
	  fprintf(fpint, "%zd ", funcargc);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
605
606
	  fprintf(fpint, "(");
	  if ( functype != ISVOID )
607
608
	    fprintf(fpint, "%s, ", funRet[functype].cfint);
	  fprintf(fpint, "%s, ", delegateName);
609
610
	  for (size_t i = 0; i < funcnameLen; ++i)
            sname[i] = (char)toupper((int) sname[i]);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
611
	  fprintf(fpint, "%s, ", sname);
612
613
	  for (size_t i = 0; i < funcnameLen; ++i)
            sname[i] = (char)tolower((int) sname[i]);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
614
	  fprintf(fpint, "%s", sname);
615
	  for (size_t i = 0; i < funcargc; i++ )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
616
	    {
617
618
	      fprintf(fpint, ", %s", funArgSym[funcargtype[i]].cfint);
	    }
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
619
620
621
	  fprintf(fpint, ")\n");


622
623
	  if ( funcnameLen == xnameLen
               && memcmp(funcname, xname, funcnameLen) == 0 )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
624
625
	    {
	      char xline[128];
626
              size_t xlineLen = 0;
627
628
	      int nch;

Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
629
630
631
632
633
634
	      /* C Quick Guide */

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

635
636
637
638
639
640
	      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
641
642
643

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

644
	      for (size_t i = 0; i < funcargc; i++ )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
645
		{
646
647
648
649
650
		  if (i)
                    {
                      strcat(xline, ", ");
                      xlineLen += 2;
                    }
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
651

652
653
654
655
656
657
658
659
660
661
662
                  /* 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);
663
		  if ( (xlineLen + (size_t)nchn) > (size_t)80 )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
664
		    {
665
                      if (i) xline[--xlineLen] = 0;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
666
667
		      cdoc[ncdoc].aline[cdoc[ncdoc].naline++] = strdup(xline);
		      sprintf(xline, "%*s", nch, "");
668
                      xlineLen = (size_t)nch;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
669
670
		    }
		  strcat(xline, farg);
671
                  xlineLen += (size_t)nchn;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
672
		}
673
	      strcat(xline, ");");
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
674
675
676
677
678
679
680
681
682
683
684
685
	      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 )
686
		nch = sprintf(xline, "SUBROUTINE %s", xname);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
687
	      else
688
		nch = sprintf(xline, "%s FUNCTION %s", funArgSym[functype].f77name, xname);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
689
690

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

693
694
              xlineLen = (size_t)nch;

695
	      for (size_t i = 0; i < funcargc; i++ )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
696
		{
697
698
699
700
701
		  if (i)
                    {
                      strcat(xline, ", ");
                      xlineLen += 2U;
                    }
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
702

703
704
705
706
707
708
709
710
711
712
                  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();
713
		  if ( (xlineLen + (size_t)nchn) > 80 )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
714
		    {
715
                      if (i) xline[--xlineLen] = 0;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
716
717
		      fdoc[nfdoc].aline[fdoc[nfdoc].naline++] = strdup(xline);
		      sprintf(xline, "%*s", nch, "");
718
                      xlineLen = (size_t)nch;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
719
720
		    }
		  strcat(xline, farg);
721
                  xlineLen += (size_t)nchn;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
722
723
724
725
726
727
728
729
		}
	      if ( funcargc ) strcat(xline, ")");
	      fdoc[nfdoc].aline[fdoc[nfdoc].naline++] = strdup(xline);
	      fdoc[nfdoc].text  = strdup(xdes);

	      nfdoc++;
	    }
	}
730
      else if ( memcmp(line, "#define", 7) == 0 )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
731
732
733
734
735
	{
	  pline = line;
	  pline += 7;
	  while ( isspace((int) *pline) ) pline++;
	  parname = pline;
736
	  size_t len = strlen(pline);
737
738
          size_t i = 0;
	  for (; i < len; i++ )
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
739
740
741
742
743
744
745
746
747
748
749
	    {
	      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 */
750
751
752
	  fprintf(fpinc, "      INTEGER    %-22s\n"
                  "      PARAMETER (%-22s = %2d)\n", parname, parname,
                  parvalue);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
753
	}
754
755
756
757
758
759
      else if (!regexec(&cppCondRE, line, maxMatch, reMatch, 0)
               && ((cppSwitchLen = reMatch[2].rm_eo - reMatch[2].rm_so) == 5)
               && ((size_t)(cppSymLen = reMatch[3].rm_eo - reMatch[3].rm_so)
                   == sizeof (cplusplus_macro) - 1)
               && !memcmp(line + reMatch[3].rm_so, cplusplus_macro,
                          sizeof (cplusplus_macro) - 1))
760
	{
761
762
763
764
765
          fprintf(stderr, "Found conditional C++ block, skipping to #else\n");
          while ((lineLen = getline(&line, &lineBufSize, fpin)) >= 0)
            if (!regexec(&cppElseRE, line, maxMatch, reMatch, 0))
              break;
        }
766
767
768
769
770
      else if (detectComment(&line, &lineLen, &lineBufSize,
                             maxMatch, reMatch,
                             xname, &xnameLen, xdes,
                             fpin, fpinc, fpint))
        ;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
771
772
      else
	{
773
774
775
	  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
776
777
778
	}
    }

779
780
  fputs("\n"
        "#endif\n", fpint);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
781
782
783
784
785
786
787
788

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

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

789
790
791
792
793
794
795
796
797
798
799
800
801
802

  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'  */
Uwe Schulzweida's avatar
Uwe Schulzweida committed
803
    filename = (char*) malloc(doc_root_len + 1 + max_len + 1);
804
805
806
807
808
809
810
811
  }

  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
812
813
814
815
816
817
818
819
  if ( fp )
    {
      fprintf(fp, "C Quick Reference\n");
      fprintf(fp, "-----------------\n\n");

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

826
827
828
829
  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
830
831
832
833
834
835
836
837
  if ( fp )
    {
      fprintf(fp, "Fortran Quick Reference\n");
      fprintf(fp, "-----------------------\n\n");

      doctotxt(fp, fdoc, nfdoc);
      fclose(fp);
    }
838
839
840
841
842
  else
    {
      fprintf(stderr, "warning: cannot open documentation output file %s, %s",
              filename, strerror(errno));
    }
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
843

844
845
846
847
  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
848
849
850
851
852
853
854
855
856
857
858
859
  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);
    }
860
861
862
863
864
  else
    {
      fprintf(stderr, "warning: cannot open documentation output file %s, %s",
              filename, strerror(errno));
    }
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
865

866
867
868
869
  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
870
871
872
873
874
875
876
877
878
879
880
881
  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);
    }
882
883
884
885
886
887
  else
    {
      fprintf(stderr, "warning: cannot open documentation output file %s, %s",
              filename, strerror(errno));
    }
  free(filename);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
888
889
}

890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
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
907
908
909
910
int main(int argc, char *argv[])
{
  char *fname;
  char *cp;
911
  const char *doc_root = default_doc_root;
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
912
913
914
  char fnameinc[128], fnameint[128];
  size_t len;

915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
  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
932
    {
933
      printf("Usage:  %s [-d DOCROOT] includefile\n", argv[0]);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
934
935
936
      return (1);
    }

937
  fname = argv[1 + optargCount];
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
938
939
940

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

943
944
  memcpy(fnameinc, fname, len);
  memcpy(fnameint, fname, len);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
945
946
947

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

949
  fortran_interface(fname, fnameinc, fnameint, doc_root);
Uwe Schulzweida's avatar
Cleanup    
Uwe Schulzweida committed
950
951
952

  return (0);
}
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981

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
982
983
984
985
986
987
988
989
990
991
992
993
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)
    {
994
995
996
      if (reCompile(&symList[sym].preg, symList[sym].parseRE,
                    line, lineBufSize))
        exit(EXIT_FAILURE);
Thomas Jahns's avatar
Thomas Jahns committed
997
998
999
1000
1001
1002
      if (symList[sym].nameMatch > maxMatch)
        maxMatch = symList[sym].nameMatch;
    }
  return maxMatch;
}

1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
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
Uwe Schulzweida's avatar
Uwe Schulzweida committed
1013
          && (line = (char*) realloc(*lineBuf, resize = REGEX_MAX_ERRSTRLEN)))
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
        {
          *lineBuf = line;
          *lineBufSize = resize;
          regerror(errcode, RE, line, *lineBufSize);
          fprintf(stderr, "Error compiling regular expression: %s: %s\n",
                  REstring, *lineBuf);
        }
    }
  return errcode;
}

1025
1026
/* emit conversion code for MPI_Comm argument */
static int cfMPICommConvert(FILE *outfp, const char *argName,
1027
                            size_t argNameLen, enum conversionType part)
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
{
  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;
}
1042

1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
/* 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;
}

1061
1062
1063
static int cfVoidFuncPrologue(FILE *outfp, size_t argNum)
{
  int retval
Thomas Jahns's avatar
Thomas Jahns committed
1064
1065
    = fprintf(outfp, "\n#undef ROUTINE_%zu\n#define ROUTINE_%zu %s\n",
              argNum+1, argNum+1, "(void (*)(void))");
1066
1067
1068
  return retval;
}

1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
enum {
  FOUND_NOTHING,
  FOUND_COMMENT,
  FOUND_DOCCOMMENT,
};

static int detectComment(char **line_, ssize_t *lineLen, size_t *lineBufSize,
                         size_t maxMatch, regmatch_t reMatch[],
                         char *xname, size_t *xnameLen,
                         char *xdes,
                         FILE *fpin, FILE *fpinc, FILE *fpint)
{
  char *restrict line = *line_;
  int matchType;
  do {
    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;
        *xnameLen = nameMatchLen;
        memcpy(xdes, line + reMatch[2].rm_so, docMatchLen);
        {
          char *eol = xdes;
          while ((eol = strchr(eol, '\n')))
            {
              ++eol;
              /* delete whitespace following newline */
              size_t squeezeLen = strspn(eol, " \t*");
              char *startoftext = eol + squeezeLen;
              memmove(eol, startoftext, docMatchLen - (size_t)(eol - xdes));
              docMatchLen -= squeezeLen;
            }
        }
        xdes[docMatchLen] = 0;
        printf("Found documentation for \"%s\": \"%s\"\n", xname,
               xdes);
        matchType = FOUND_DOCCOMMENT;
        break;
      }
    else if (!regexec(&commentRE, line, maxMatch, reMatch, 0))
      {
        size_t commentLen = (size_t)(reMatch[1].rm_eo - reMatch[1].rm_so);
        char *comment = line + reMatch[1].rm_so;
        {
          char savedCommentEnd = comment[commentLen];
          comment[commentLen] = '\0';
          /* fortran include */
          fputs("!\n", fpinc);
          char *cline = comment;
          do {
            cline += strspn(cline, " \t*");
            char *eol = strchr(cline, '\n');
            if (!eol)
              eol = comment + commentLen;
            size_t lineLen = (size_t)(eol - cline);
            fprintf(fpinc, "!  %.*s\n", (int)lineLen, cline);
            cline = (eol != comment + commentLen) ? eol + 1: NULL;
          } while (cline);
          fputs("!\n", fpinc);
          comment[commentLen] = savedCommentEnd;
        }
        /* fortran interface */
        fprintf(fpint, "\n/*  %.*s  */\n\n", (int)commentLen, comment);
        matchType = FOUND_COMMENT;
        break;
      }
    /* found comment start, read further lines and retry */
    else if (!regexec(&commentStartRE, line, maxMatch, reMatch, 0))
      {
        int foundCommentEnd = 0;
        char *lineExtension = NULL;
        size_t extSize = 0;
        do {
          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;
          foundCommentEnd
            = !regexec(&commentEndRE, lineExtension, maxMatch, reMatch, 0);
        } while (!foundCommentEnd);
      }
    else
      /* found no comment at all */
      break;
  } while (1);
  *line_ = line;
  return matchType;
}

1165
1166


1167
1168
1169
1170
1171
1172
1173
1174
1175
/*
 * Local Variables:
 * c-file-style: "Java"
 * c-basic-offset: 2
 * indent-tabs-mode: nil
 * show-trailing-whitespace: t
 * require-trailing-newline: t
 * End:
 */
1176