1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
/*********************************************************************
* Copyright 2018, UCAR/Unidata
* See netcdf/COPYRIGHT file for copying and redistribution conditions.
*********************************************************************/
#include "includes.h"
#include "nc_iter.h"
#ifdef ENABLE_F77
#include <math.h>
int f77_uid = 0;
static int
f77_charconstant(Generator* generator, Symbol* sym, Bytebuffer* codebuf, ...)
{
/* Escapes and quoting will be handled in genc_write */
/* Just transfer charbuf to codebuf */
Bytebuffer* charbuf;
va_list ap;
va_start(ap,codebuf);
charbuf = va_arg(ap, Bytebuffer*);
va_end(ap);
bbNull(charbuf);
bbCatbuf(codebuf,charbuf);
return 1;
}
static int
f77_constant(Generator* generator, Symbol* sym, NCConstant* ci, Bytebuffer* codebuf,...)
{
char tmp[64];
char* special = NULL;
switch (ci->nctype) {
case NC_CHAR:
if(ci->value.charv == '\'')
sprintf(tmp,"'\\''");
else
sprintf(tmp,"'%c'",ci->value.charv);
break;
case NC_BYTE:
sprintf(tmp,"%hhd",ci->value.int8v);
break;
case NC_SHORT:
sprintf(tmp,"%hd",ci->value.int16v);
break;
case NC_INT:
sprintf(tmp,"%d",ci->value.int32v);
break;
case NC_FLOAT:
sprintf(tmp,"%.8g",ci->value.floatv);
break;
case NC_DOUBLE: {
char* p = tmp;
/* FORTRAN requires e|E->D */
sprintf(tmp,"%.16g",ci->value.doublev);
while(*p) {if(*p == 'e' || *p == 'E') {*p = 'D';}; p++;}
} break;
case NC_STRING:
{
Bytebuffer* buf = bbNew();
bbAppendn(buf,ci->value.stringv.stringv,ci->value.stringv.len);
f77quotestring(buf);
special = bbDup(buf);
bbFree(buf);
}
break;
default: PANIC1("f77data: bad type code: %d",ci->nctype);
}
if(special != NULL)
bbCat(codebuf,special);
else
bbCat(codebuf,tmp);
return 1;
}
static int
f77_listbegin(Generator* generator, Symbol* sym, void* liststate, ListClass lc, size_t size, Bytebuffer* codebuf, int* uidp, ...)
{
if(uidp) *uidp = ++f77_uid;
return 1;
}
static int
f77_list(Generator* generator, Symbol* sym, void* liststate, ListClass lc, int uid, size_t count, Bytebuffer* codebuf, ...)
{
switch (lc) {
case LISTATTR:
if(count > 0) bbCat(codebuf,", ");
break;
case LISTDATA:
bbAppend(codebuf,' ');
break;
case LISTVLEN:
case LISTCOMPOUND:
case LISTFIELDARRAY:
break;
}
return 1;
}
static int
f77_listend(Generator* generator, Symbol* sym, void* liststate, ListClass lc, int uid, size_t count, Bytebuffer* buf, ...)
{
return 1;
}
static int
f77_vlendecl(Generator* generator, Symbol* tsym, Bytebuffer* codebuf, int uid, size_t count, ...)
{
return 1;
}
static int
f77_vlenstring(Generator* generator, Symbol* sym, Bytebuffer* vlenmem, int* uidp, size_t* countp,...)
{
if(uidp) *uidp = ++f77_uid;
return 1;
}
/* Define the single static bin data generator */
static Generator f77_generator_singleton = {
NULL,
f77_charconstant,
f77_constant,
f77_listbegin,
f77_list,
f77_listend,
f77_vlendecl,
f77_vlenstring
};
Generator* f77_generator = &f77_generator_singleton;
#endif /*ENABLE_F77*/
|
