gen_defs.c
References to this file elsewhere.
1 #include <stdio.h>
2 #include <stdlib.h>
3 #include <string.h>
4 #include <strings.h>
5
6 #include "protos.h"
7 #include "registry.h"
8 #include "data.h"
9
10 enum sw_ranges { COLON_RANGE , ARGADJ , GRIDREF } ;
11 enum sw_pointdecl { POINTERDECL , NOPOINTERDECL } ;
12
13 int
14 gen_state_struct ( char * dirname )
15 {
16 FILE * fp ;
17 char fname[NAMELEN] ;
18 char * fn = "state_struct.inc" ;
19
20 strcpy( fname, fn ) ;
21 if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
22 if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
23 print_warning(fp,fname) ;
24 gen_decls ( fp , "", &Domain , COLON_RANGE , POINTERDECL , FIELD | RCONFIG | FOURD , DRIVER_LAYER ) ;
25 close_the_file( fp ) ;
26 return(0) ;
27 }
28
29 int
30 gen_state_subtypes ( char * dirname )
31 {
32 FILE * fp ;
33 char fname[NAMELEN] ;
34 char * fn = "state_subtypes.inc" ;
35
36 strcpy( fname, fn ) ;
37 if ( strlen(dirname) > 0 ) { sprintf(fname,"%s/%s",dirname,fn) ; }
38
39 if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
40 print_warning(fp,fname) ;
41 gen_state_subtypes1( fp , &Domain , COLON_RANGE , POINTERDECL , FIELD | RCONFIG | FOURD ) ;
42 close_the_file(fp) ;
43 return(0) ;
44 }
45
46 int
47 gen_dummy_decls ( char * dn )
48 {
49 int i ;
50 FILE * fp ;
51 char fname[NAMELEN] ;
52 char corename[NAMELEN] ;
53 char * fn = "_dummy_decl.inc" ;
54
55 if ( dn == NULL ) return(1) ;
56 for ( i = 0 ; i < get_num_cores() ; i++ )
57 {
58 strcpy( corename , get_corename_i(i) ) ;
59 if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s%s",dn,corename,fn) ; }
60 else { sprintf(fname,"%s%s",corename,fn) ; }
61 if ((fp = fopen( fname , "w" )) == NULL ) continue ;
62 print_warning(fp,fname) ;
63 #if 0
64 gen_decls ( fp, corename, &Domain , GRIDREF , NOPOINTERDECL , FIELD | RCONFIG | FOURD , MEDIATION_LAYER ) ;
65 #else
66 gen_decls ( fp, corename, &Domain , GRIDREF , NOPOINTERDECL , FIELD | FOURD , MEDIATION_LAYER ) ;
67 #endif
68 fprintf(fp,"#undef COPY_IN\n") ;
69 fprintf(fp,"#undef COPY_OUT\n") ;
70 close_the_file( fp ) ;
71 }
72 return(0);
73 }
74
75 int
76 gen_dummy_decls_new ( char * dn )
77 {
78 int i ;
79 FILE * fp ;
80 char fname[NAMELEN] ;
81 char corename[NAMELEN] ;
82 char * fn = "_dummy_new_decl.inc" ;
83
84 if ( dn == NULL ) return(1) ;
85 for ( i = 0 ; i < get_num_cores() ; i++ )
86 {
87 strcpy( corename , get_corename_i(i) ) ;
88 if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s%s",dn,corename,fn) ; }
89 else { sprintf(fname,"%s%s",corename,fn) ; }
90 if ((fp = fopen( fname , "w" )) == NULL ) continue ;
91 print_warning(fp,fname) ;
92 gen_decls ( fp, corename, &Domain , GRIDREF , NOPOINTERDECL , FOURD | FIELD | BDYONLY , MEDIATION_LAYER ) ;
93 fprintf(fp,"#undef COPY_IN\n") ;
94 fprintf(fp,"#undef COPY_OUT\n") ;
95 close_the_file( fp ) ;
96 }
97 return(0);
98 }
99
100
101 int
102 gen_i1_decls ( char * dn )
103 {
104 int i ;
105 FILE * fp ;
106 char fname[NAMELEN], post[NAMELEN] ;
107 char * fn = "_i1_decl.inc" ;
108 char corename[NAMELEN] ;
109 char * dimspec ;
110 node_t * p ;
111
112 if ( dn == NULL ) return(1) ;
113 for ( i = 0 ; i < get_num_cores() ; i++ )
114 {
115 strcpy(corename,get_corename_i(i)) ;
116 if ( strlen(dn) > 0 ) { sprintf(fname,"%s/%s%s",dn,corename,fn) ; }
117 else { sprintf(fname,"%s%s",corename,fn) ; }
118 if ((fp = fopen( fname , "w" )) == NULL ) continue ;
119 print_warning(fp,fname) ;
120 gen_decls ( fp , corename, &Domain , GRIDREF , NOPOINTERDECL , I1 , MEDIATION_LAYER ) ;
121
122 /* now generate tendencies for 4d vars if specified */
123 for ( p = FourD ; p != NULL ; p = p->next )
124 {
125 if ( p->node_kind & FOURD && p->has_scalar_array_tendencies )
126 {
127 sprintf(fname,"%s_tend",p->name) ;
128 sprintf(post,",num_%s)",p->name) ;
129 dimspec=dimension_with_ranges( "grid%",",DIMENSION(",-1,t2,p,post,"" ) ;
130 /* type dim pdecl name */
131 fprintf(fp, "%-10s%-20s%-10s :: %s\n",
132 field_type( t1, p ) ,
133 dimspec ,
134 "" ,
135 fname ) ;
136 sprintf(fname,"%s_old",p->name) ;
137 sprintf(post,",num_%s)",p->name) ;
138 dimspec=dimension_with_ranges( "grid%",",DIMENSION(",-1,t2,p,post,"" ) ;
139 /* type dim pdecl name */
140 fprintf(fp, "#ifndef NO_I1_OLD\n") ;
141 fprintf(fp, "%-10s%-20s%-10s :: %s\n",
142 field_type( t1, p ) ,
143 dimspec ,
144 "" ,
145 fname ) ;
146 fprintf(fp, "#endif\n") ;
147
148 }
149 }
150 close_the_file( fp ) ;
151 }
152 return(0) ;
153 }
154
155 int
156 gen_decls ( FILE * fp , char * corename , node_t * node , int sw_ranges, int sw_point , int mask , int layer )
157 {
158 node_t * p ;
159 int tag, ipass ;
160 char fname[NAMELEN], post[NAMELEN] ;
161 char * dimspec ;
162 int bdyonly = 0 ;
163
164 if ( node == NULL ) return(1) ;
165
166 bdyonly = mask & BDYONLY ;
167
168 /* make two passes; the first is for scalars, second for arrays. */
169 /* do it this way so that the scalars get declared first (some compilers complain */
170 /* if a scalar is used to declare an array before it's declared) */
171
172 for ( ipass = 0 ; ipass < 2 ; ipass++ )
173 {
174 for ( p = node->fields ; p != NULL ; p = p->next )
175 {
176 if ( p->node_kind & mask )
177 {
178 /* add an extra dimension to the 4d arrays. */
179 /* note the call to dimension_with_colons, below, does this by itself */
180 /* but dimension_with_ranges needs help (since the last arg is not just a colon) */
181
182 if ( p->node_kind & FOURD ) {
183 sprintf(post,",num_%s)",field_name(t4,p,0)) ;
184 } else {
185 sprintf(post,")") ;
186 }
187
188 for ( tag = 1 ; tag <= p->ntl ; tag++ )
189 {
190
191 /* if this is a core-specific variable, if we are generating non-driver-layer */
192 /* declarations, and if this not a variable for the core named in corename, short-circuit */
193 if (!strncmp( p->use, "dyn_", 4 ) && layer != DRIVER_LAYER && strcmp( p->use+4, corename)) continue ;
194
195 /* if this is a core-specific variable, prepend the name of the core to */
196 /* the variable at the driver level */
197 if (!strncmp( p->use, "dyn_", 4 ) && layer == DRIVER_LAYER )
198 sprintf(fname,"%s_%s",p->use+4,field_name(t4,p,(p->ntl>1)?tag:0)) ;
199 else
200 strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
201
202 if ( ! p->boundary_array || ! sw_new_bdys ) {
203 switch ( sw_ranges )
204 {
205 case COLON_RANGE :
206 dimspec=dimension_with_colons( ",DIMENSION(",t2,p,")" ) ; break ;
207 case GRIDREF :
208 dimspec=dimension_with_ranges( "grid%",",DIMENSION(",-1,t2,p,post,"" ) ; break ;
209 case ARGADJ :
210 dimspec=dimension_with_ranges( "",",DIMENSION(",-1,t2,p,post,"" ) ; break ;
211 }
212 } else {
213 dimspec="dummy" ; /* allow fall through on next tests. dimension with ranges will be called again anyway for bdy arrays */
214 }
215
216 if ( !strcmp( dimspec, "" ) && ipass == 1 ) continue ; /* short circuit scalars on 2nd pass */
217 if ( strcmp( dimspec, "" ) && ipass == 0 ) continue ; /* short circuit arrays on 2nd pass */
218 if ( bdyonly && p->node_kind & FIELD && ! p->boundary_array ) continue ; /* short circuit all fields except bdy arrrays */
219
220 if ( p->boundary_array && sw_new_bdys ) {
221 int bdy ;
222 for ( bdy = 1; bdy <=4 ; bdy++ ) {
223 switch ( sw_ranges )
224 {
225 case COLON_RANGE :
226 dimspec=dimension_with_colons( ",DIMENSION(",t2,p,")" ) ; break ;
227 case GRIDREF :
228 dimspec=dimension_with_ranges( "grid%",",DIMENSION(",bdy,t2,p,post,"" ) ; break ;
229 case ARGADJ :
230 dimspec=dimension_with_ranges( "",",DIMENSION(",bdy,t2,p,post,"" ) ; break ;
231 }
232 /* type dim pdecl name */
233 fprintf(fp, "%-10s%-20s%-10s :: %s%s\n",
234 field_type( t1, p ) ,
235 dimspec ,
236 (sw_point==POINTERDECL)?declare_array_as_pointer(t3,p):"" ,
237 fname, bdy_indicator( bdy ) ) ;
238 }
239 } else {
240 switch ( sw_ranges )
241 {
242 case COLON_RANGE :
243 dimspec=dimension_with_colons( ",DIMENSION(",t2,p,")" ) ; break ;
244 case GRIDREF :
245 dimspec=dimension_with_ranges( "grid%",",DIMENSION(",-1,t2,p,post,"" ) ; break ;
246 case ARGADJ :
247 dimspec=dimension_with_ranges( "",",DIMENSION(",-1,t2,p,post,"" ) ; break ;
248 }
249 /* type dim pdecl name */
250 fprintf(fp, "%-10s%-20s%-10s :: %s\n",
251 field_type( t1, p ) ,
252 dimspec ,
253 (sw_point==POINTERDECL)?declare_array_as_pointer(t3,p):"" ,
254 fname ) ;
255 }
256 }
257 }
258 }
259 }
260 return(0) ;
261 }
262
263 int
264 gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges , int sw_point , int mask )
265 {
266 node_t * p ;
267 int i ;
268 int new;
269 char TypeName [NAMELEN] ;
270 char tempname [NAMELEN] ;
271 if ( node == NULL ) return(1) ;
272 for ( p = node->fields ; p != NULL ; p = p->next )
273 {
274 if ( p->type != NULL )
275 if ( p->type->type_type == DERIVED )
276 {
277 new = 1 ; /* determine if this is a new type -ajb */
278 strcpy( tempname, p->type->name ) ;
279 for ( i = 0 ; i < get_num_typedefs() ; i++ )
280 {
281 strcpy( TypeName, get_typename_i(i) ) ;
282 if ( ! strcmp( TypeName, tempname ) ) new = 0 ;
283 }
284
285 if ( new ) /* add this type to the history and generate declarations -ajb */
286 {
287 add_typedef_name ( tempname ) ;
288 gen_state_subtypes1 ( fp , p->type , sw_ranges , sw_point , mask ) ;
289 fprintf(fp,"TYPE %s\n",p->type->name) ;
290 gen_decls ( fp , "", p->type , sw_ranges , sw_point , mask , DRIVER_LAYER ) ;
291 fprintf(fp,"END TYPE %s\n",p->type->name) ;
292 }
293 }
294 }
295 return(0) ;
296 }
297
298 /* old version of gen_state_subtypes1 -ajb */
299 /*
300 int
301 gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges , int sw_point , int mask )
302 {
303 node_t * p ;
304 int tag ;
305 if ( node == NULL ) return(1) ;
306 for ( p = node->fields ; p != NULL ; p = p->next )
307 {
308 if ( p->type != NULL )
309 if ( p->type->type_type == DERIVED )
310 {
311 gen_state_subtypes1 ( fp , p->type , sw_ranges , sw_point , mask ) ;
312 fprintf(fp,"TYPE %s\n",p->type->name) ;
313 gen_decls ( fp , "", p->type , sw_ranges , sw_point , mask , DRIVER_LAYER ) ;
314 fprintf(fp,"END TYPE %s\n",p->type->name) ;
315 }
316 }
317 return(0) ;
318 }
319 */