gen_scalar_derefs.c

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 #define DUMMY 1
11 #define ACTUAL 2 
12 
13 int
14 gen_scalar_derefs ( char * dirname )
15 {
16   int i ;
17   
18   for ( i = 0 ; i < get_num_cores() ; i++ )
19     scalar_derefs ( dirname , get_corename_i(i) ) ; 
20   return(0) ;
21 }
22 
23 #define DIR_COPY_OUT 1
24 #define DIR_COPY_IN  2
25 
26 int
27 scalar_derefs ( char * dirname , char * corename )
28 {
29   FILE * fp ;
30   char  fname[NAMELEN] ;
31   char * fn = "_scalar_derefs.inc" ;
32   char * p ;
33   int linelen ;
34   char outstr[64*4096] ;
35 
36   if ( dirname == NULL || corename == NULL ) return(1) ;
37   if ( strlen(dirname) > 0 ) 
38    { sprintf(fname,"%s/%s%s",dirname,corename, fn) ; }
39   else                       
40    { sprintf(fname,"%s%s",corename,fn) ; }
41 
42   if ((fp = fopen( fname , "w" )) == NULL ) return(1) ;
43   print_warning(fp,fname) ;
44   fprintf(fp,"! BEGIN SCALAR DEREFS\n") ;
45   linelen = 0 ;
46   if ( sw_limit_args ) {
47     fprintf(fp,"#undef CPY\n") ;
48     fprintf(fp,"#undef CPYC\n") ;
49     fprintf(fp,"#ifdef COPY_OUT\n") ;
50     scalar_derefs1 ( fp , corename , &Domain, DIR_COPY_OUT ) ;
51     fprintf(fp,"#else\n") ;
52     scalar_derefs1 ( fp , corename , &Domain, DIR_COPY_IN ) ;
53     fprintf(fp,"#endif\n") ;
54   }
55   fprintf(fp,"! END SCALAR DEREFS\n") ;
56   close_the_file( fp ) ;
57   return(0) ;
58 }
59 
60 int
61 scalar_derefs1 ( FILE * fp , char * corename, node_t * node, int direction )
62 {
63   node_t * p ;
64   int tag ;
65   char fname[NAMELEN] ;
66 
67   if ( node == NULL ) return(1) ;
68   for ( p = node->fields ; p != NULL ; p = p->next )
69   {
70     if ( p->node_kind & I1 ) continue ;              /* short circuit any field that is not state */
71                                                      /* short circuit DERIVED types */
72     if ( p->type->type_type == DERIVED ) continue ;
73                                                      /* short circuit non-scalars */
74     if ( p->ndims > 0 ) continue ; 
75 
76     if (                 (
77                                                    /* if it's a core specific field and we're doing that core or... */
78           (p->node_kind & FIELD && (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)))
79                                                    /* it is not a core specific field and it is not a derived type -ajb */
80        || (p->node_kind & FIELD && (p->type->type_type != DERIVED) && ( strncmp("dyn_",p->use,4)))
81 #if 0
82                                                    /* it is a state variable */
83        || (p->node_kind & RCONFIG )
84 #endif
85                          )
86        )
87     {
88       for ( tag = 1 ; tag <= p->ntl ; tag++ )
89       {
90         char * x ;
91         /* if this is a core-specific variable, prepend the name of the core to */
92         /* the variable at the driver level */
93         if ((!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)) ) { x = "C" ; } else { x = "" ; }
94         strcpy(fname,field_name(t4,p,(p->ntl>1)?tag:0)) ;
95         /* generate deref */
96         if ( direction == DIR_COPY_OUT ) {
97           if ( (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)) ) { fprintf(fp, " grid%%%s_%s = %s\n",corename,fname,fname) ; }
98           else                                { fprintf(fp, " grid%%%s    = %s\n",fname,fname ) ; }
99         } else {
100           if ( (!strncmp("dyn_",p->use,4)&&!strcmp(corename,p->use+4)) ) { fprintf(fp, " %s = grid%%%s_%s\n",fname,corename,fname) ; }
101           else                                { fprintf(fp, " %s = grid%%%s\n",fname,fname ) ; }
102         }
103       }
104     }
105   }
106   return(0) ;
107 }
108