source: lmdz_wrf/WRFV3/tools/reg_parse.c @ 1

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#ifdef _WIN32
# define rindex(X,Y) strrchr(X,Y)
# define index(X,Y) strchr(X,Y)
#else
# include <strings.h>
#endif

#include "registry.h"
#include "protos.h"
#include "data.h"
#include "sym.h"

/* read in the Registry file and build the internal representation of the registry */

#define MAXTOKENS 5000 /*changed MAXTOKENS from 1000 to 5000 by Manish Shrivastava on 01/28/2010*/

/* fields for state entries (note, these get converted to field entries in the
   reg_parse routine; therefore, only TABLE needs to be looked at */
#define TABLE 0

/* fields for field entries (TABLE="typedef" and, with some munging,  TABLE="state") */
#define FIELD_OF        1
#define FIELD_TYPE     2
#define FIELD_SYM      3
#define FIELD_DIMS     4
#define FIELD_USE      5
#define FIELD_NTL      6
#define FIELD_STAG     7
#define FIELD_IO       8
#define FIELD_DNAME    9
#define FIELD_DESCRIP 10
#define FIELD_UNITS   11

#define F_OF       0
#define F_TYPE     1
#define F_SYM      2
#define F_DIMS     3
#define F_USE      4
#define F_NTL      5
#define F_STAG     6
#define F_IO       7
#define F_DNAME    8
#define F_DESCRIP  9
#define F_UNITS   10

/* fields for rconfig entries (RCNF) */
#define RCNF_TYPE_PRE       1
#define RCNF_SYM_PRE        2
#define RCNF_HOWSET_PRE     3
#define RCNF_NENTRIES_PRE   4
#define RCNF_DEFAULT_PRE    5
#define RCNF_IO_PRE         6
#define RCNF_DNAME_PRE      7
#define RCNF_DESCRIP_PRE    8
#define RCNF_UNITS_PRE      9

#define RCNF_TYPE       2
#define RCNF_SYM        3
#define RCNF_USE        FIELD_USE
#define RCNF_IO         FIELD_IO
#define RCNF_DNAME      FIELD_DNAME
#define RCNF_DESCRIP    FIELD_DESCRIP
#define RCNF_UNITS      FIELD_UNITS
#define RCNF_HOWSET    20
#define RCNF_NENTRIES  21
#define RCNF_DEFAULT   22

/* fields for dimension entries (TABLE="dimspec") */
#define DIM_NAME       1
#define DIM_ORDER      2
#define DIM_SPEC       3
#define DIM_ORIENT     4
#define DIM_DATA_NAME  5

#define PKG_SYM            1
#define PKG_ASSOC          2
#define PKG_STATEVARS      3
#define PKG_4DSCALARS      4

#define COMM_ID            1
#define COMM_USE           2
#define COMM_DEFINE        3

static int ntracers = 0 ;
static char tracers[1000][100] ;

int
pre_parse( char * dir, FILE * infile, FILE * outfile )
{
  /* Decreased size for SOA from 8192 to 8000--double check if necessary, Manish Shrivastava 2010 */
  char inln[8000], parseline[8000], parseline_save[8000] ;
  int found ; 
  char *p, *q ;
  char *tokens[MAXTOKENS], *toktmp[MAXTOKENS], newdims[NAMELEN_LONG], newdims4d[NAMELEN_LONG],newname[NAMELEN_LONG] ;
  int i, ii, len_of_tok ;
  char x, xstr[NAMELEN_LONG] ;
  int is4d, wantstend, wantsbdy ;
  int ifdef_stack_ptr = 0 ;
  int ifdef_stack[100] ;
  int inquote, retval ;

  ifdef_stack[0] = 1 ;
  retval = 0 ;

  parseline[0] = '\0' ;
/* main parse loop over registry lines */
  /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */
  while ( fgets ( inln , 7000 , infile ) != NULL )
  {

/*** preprocessing directives ****/
    /* look for an include statement */
    for ( p = inln ; ( *p == ' ' || *p == '     ' ) && *p != '\0' ; p++ ) ;
    if ( !strncmp( p , "include", 7 ) &&  ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) {
      FILE *include_fp ;
      char include_file_name[128] ;
      p += 7 ; for ( ; ( *p == ' ' || *p == '   ' ) && *p != '\0' ; p++ ) ;
      if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; }
      else {
        sprintf( include_file_name , "%s/%s", dir , p ) ;
        if ( (p=index(include_file_name,'\n')) != NULL ) *p = '\0' ;
        fprintf(stderr,"opening %s\n",include_file_name) ;
        if (( include_fp = fopen( include_file_name , "r" )) != NULL ) {

          fprintf(stderr,"including %s\n",include_file_name ) ;
          pre_parse( dir , include_fp , outfile ) ;

          fclose( include_fp ) ;
        } else {
          fprintf(stderr,"Registry warning: cannot open %s. Ignoring.\n", include_file_name ) ;
        } 
      }
    }
    else if ( !strncmp( p , "ifdef", 5 ) ) {
      char value[32] ;
      p += 5 ; for ( ; ( *p == ' ' || *p == '   ' ) && *p != '\0' ; p++ ) ;
      strncpy(value, p, 31 ) ; value[31] = '\0' ;
      if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
      if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'     ')) != NULL ) *p = '\0' ; 
      ifdef_stack_ptr++ ;
      ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) != NULL && ifdef_stack[ifdef_stack_ptr-1] ) ;
      if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; }
      continue ;
    }
    else if ( !strncmp( p , "ifndef", 6 ) ) {
      char value[32] ;
      p += 6 ; for ( ; ( *p == ' ' || *p == '   ' ) && *p != '\0' ; p++ ) ;
      strncpy(value, p, 31 ) ; value[31] = '\0' ;
      if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
      if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'     ')) != NULL ) *p = '\0' ; 
      ifdef_stack_ptr++ ;
      ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) == NULL && ifdef_stack[ifdef_stack_ptr-1] ) ;
      if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; }
      continue ;
    }
    else if ( !strncmp( p , "endif", 5 ) ) {
      ifdef_stack_ptr-- ; 
      if ( ifdef_stack_ptr < 0 ) { fprintf(stderr,"Registry fatal: unmatched endif\n") ; exit(1) ; }
      continue ;
    }
    else if ( !strncmp( p , "define", 6 ) ) {
      char value[32] ;
      p += 6 ; for ( ; ( *p == ' ' || *p == '   ' ) && *p != '\0' ; p++ ) ;
      strncpy(value, p, 31 ) ; value[31] = '\0' ;
      if ( (p=index(value,'\n')) != NULL ) *p = '\0' ;
      if ( (p=index(value,' ')) != NULL ) *p = '\0' ; if ( (p=index(value,'     ')) != NULL ) *p = '\0' ; 
      sym_add( value ) ;
      continue ;
    }
    if ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) continue ;
/*** end of preprocessing directives ****/

    strcat( parseline , inln ) ;

    /* allow \ to continue the end of a line */
    if (( p = index( parseline,  '\\'  )) != NULL )
    {
      if ( *(p+1) == '\n' || *(p+1) == '\0' )
      {
        *p = '\0' ;
        continue ;  /* go get another line */
      }
    }
    make_lower( parseline ) ;

    if (( p = index( parseline , '\n' )) != NULL  ) *p = '\0' ; /* discard newlines */

    /* check line and zap any # characters that are in double quotes */

    for ( p = parseline, inquote = 0 ; *p ; p++ ) {
      if      ( *p == '"' && inquote ) inquote = 0 ;
      else if ( *p == '"' && !inquote ) inquote = 1 ;
      else if ( *p == '#' && inquote ) *p = ' ' ;
      else if ( *p == '#' && !inquote ) { *p = '\0' ; break ; }
    }
    if ( inquote ) { retval=1 ; fprintf(stderr,"Registry error: unbalanced quotes in line:\n%s\n",parseline) ;}

    for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ;
    i = 0 ;

    strcpy( parseline_save, parseline ) ;

    if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ;
    while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ;
    if ( i <= 0 ) continue ;

    for ( i = 0 ; i < MAXTOKENS ; i++ )
    {
      if ( tokens[i] == NULL ) tokens[i] = "-" ;
    }
/* remove quotes from quoted entries */
    for ( i = 0 ; i < MAXTOKENS ; i++ )
    {
      char * pp ;
      if ( tokens[i][0] == '"' ) tokens[i]++ ;
      if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ;
    }
    if      ( !strcmp( tokens[ TABLE ] , "state" ) )
    {
        int inbrace = 0 ;
        strcpy( newdims, "" ) ;
        strcpy( newdims4d, "" ) ;
        is4d = 0 ; wantstend = 0 ; wantsbdy = 0 ; 
        for ( i = 0 ; i < (len_of_tok = strlen(tokens[F_DIMS])) ; i++ )
        {
          x = tolower(tokens[F_DIMS][i]) ;
          if ( x == '{' ) { inbrace = 1 ; }
          if ( x == '}' ) { inbrace = 0 ; }
          if ( x >= 'a' && x <= 'z' && !inbrace ) {
            if ( x == 'f' ) { is4d = 1 ; }
            if ( x == 't' ) { wantstend = 1 ; }
            if ( x == 'b' ) { wantsbdy = 1 ; }
          }
          sprintf(xstr,"%c",x) ;
          if ( x != 'b' || inbrace ) strcat ( newdims , xstr ) ;
          if ( x != 'f' && x != 't' || inbrace ) strcat( newdims4d , xstr ) ;

        }
        if ( wantsbdy ) {


/* first re-gurg the original entry without the b in the dims */

 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"%s\" \"%s\"\n",tokens[F_TYPE],tokens[F_SYM], newdims,
                  tokens[F_USE],tokens[F_NTL],tokens[F_STAG],tokens[F_IO],
                  tokens[F_DNAME],tokens[F_DESCRIP],tokens[F_UNITS] ) ;

          if ( strcmp( tokens[F_SYM] , "-" ) ) {  /* if not unnamed, as can happen with first 4d tracer */
/* next, output some additional entries for the boundary arrays for these guys */
            if ( is4d == 1 ) {
              for ( i = 0, found = 0 ; i < ntracers ; i++ ) {
                if ( !strcmp( tokens[F_USE] , tracers[i] ) ) found = 1 ; 
              }
              if ( found == 0 ) {
                sprintf(tracers[ntracers],tokens[F_USE]) ;
                ntracers++ ;

/* add entries for _b and _bt arrays */

 sprintf(newname,"%s_b",tokens[F_USE]) ;
 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,newdims4d,
                  "_4d_bdy_array_","-",tokens[F_STAG],"b",
                  newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;

 sprintf(newname,"%s_bt",tokens[F_USE]) ;
 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,newdims4d,
                  "_4d_bdy_array_","-",tokens[F_STAG],"b",
                  newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;

              }
            } else {

/* add entries for _b and _bt arrays */

 sprintf(newname,"%s_b",tokens[F_SYM]) ;
 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy %s\" \"%s\"\n",tokens[F_TYPE],newname,tokens[F_DIMS],
                  tokens[F_USE],"-",tokens[F_STAG],"b",
                  newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;

 sprintf(newname,"%s_bt",tokens[F_SYM]) ;
 fprintf( outfile,"state %s %s %s %s %s %s %s \"%s\" \"bdy tend %s\" \"(%s)/dt\"\n",tokens[F_TYPE],newname,tokens[F_DIMS],
                  tokens[F_USE],"-",tokens[F_STAG],"b",
                  newname,tokens[F_DESCRIP],tokens[F_UNITS] ) ;

            }
          }
          parseline[0] = '\0' ;  /* reset parseline */
          continue ;
        }
    }
normal:
    /* otherwise output the line as is */
    fprintf(outfile,"%s\n",parseline_save) ;
    parseline[0] = '\0' ;  /* reset parseline */
  }
  return(retval) ;
}

int
reg_parse( FILE * infile )
{
  /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */
  char inln[7000], parseline[7000] ;
  char *p, *q ;
  char *tokens[MAXTOKENS], *toktmp[MAXTOKENS] ; 
  int i, ii ;
  int defining_state_field, defining_rconfig_field, defining_i1_field ;

  parseline[0] = '\0' ;

  max_time_level = 1 ;

/* main parse loop over registry lines */
/* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */
  while ( fgets ( inln , 7000 , infile ) != NULL )
  {
    strcat( parseline , inln ) ; 
    /* allow \ to continue the end of a line */
    if (( p = index( parseline,  '\\'  )) != NULL )
    {
      if ( *(p+1) == '\n' || *(p+1) == '\0' )
      {
        *p = '\0' ;
        continue ;  /* go get another line */
      }
    }

    make_lower( parseline ) ;
    if (( p = index( parseline , '#' ))  != NULL  ) *p = '\0' ; /* discard comments (dont worry about quotes for now) */
    if (( p = index( parseline , '\n' )) != NULL  ) *p = '\0' ; /* discard newlines */
    for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; 
    i = 0 ;

    if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; 

    while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ;
    if ( i <= 0 ) continue ;

    for ( i = 0 ; i < MAXTOKENS ; i++ )
    {
      if ( tokens[i] == NULL ) tokens[i] = "-" ;
    }

/* remove quotes from quoted entries */
    for ( i = 0 ; i < MAXTOKENS ; i++ )
    {
      char * pp ;
      if ( tokens[i][0] == '"' ) tokens[i]++ ;
      if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ;
    }

    defining_state_field = 0 ;
    defining_rconfig_field = 0 ;
    defining_i1_field = 0 ;

/* state entry */
    if      ( !strcmp( tokens[ TABLE ] , "state" ) )
    {
      /* turn a state entry into a typedef to define a field in the top-level built-in type domain */
      tokens[TABLE] = "typedef" ;
      for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; /* shift the fields to the left */
      tokens[FIELD_OF] = "domain" ;
                 if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ; 
      defining_state_field = 1 ;
    }
    if      ( !strcmp( tokens[ TABLE ] , "rconfig" ) )
    {

      char *pp, value[256] ;
      for ( pp = tokens[RCNF_SYM_PRE] ; (*pp == ' ' || *pp == ' ') && *pp ; pp++ ) ;
      sprintf(value, "RCONFIG_%s" ,pp) ;
      if ( sym_get(value) == NULL ) {
        sym_add(value) ;
      } else {
        parseline[0] = '\0' ;  /* reset parseline */
        continue ;
      }

      /* turn a rconfig entry into a typedef to define a field in the top-level built-in type domain */
      for ( i = 0 ; i < MAXTOKENS ; i++ ) { toktmp[i] = tokens[i] ; tokens[i] = "-" ; }
      tokens[TABLE] = "typedef" ;
      tokens[FIELD_OF]       = "domain" ;
      tokens[RCNF_TYPE]      = toktmp[RCNF_TYPE_PRE] ;
                 if ( !strcmp( tokens[RCNF_TYPE], "double" ) ) tokens[RCNF_TYPE] = "doubleprecision" ; 
      tokens[RCNF_SYM]       = toktmp[RCNF_SYM_PRE] ;
      tokens[RCNF_IO]        = toktmp[RCNF_IO_PRE] ;
      tokens[RCNF_DNAME]     = toktmp[RCNF_DNAME_PRE] ;
      tokens[RCNF_USE]       = "-" ;
      tokens[RCNF_DESCRIP]   = toktmp[RCNF_DESCRIP_PRE] ;
      tokens[RCNF_UNITS]     = toktmp[RCNF_UNITS_PRE] ;
      tokens[RCNF_HOWSET]    = toktmp[RCNF_HOWSET_PRE] ;
      tokens[RCNF_NENTRIES]  = toktmp[RCNF_NENTRIES_PRE] ;
      tokens[RCNF_DEFAULT]   = toktmp[RCNF_DEFAULT_PRE] ;
      defining_rconfig_field = 1 ;
    }
    if      ( !strcmp( tokens[ TABLE ] , "i1" ) )
    {
      /* turn a state entry into a typedef to define a field in 
         the top-level built-in type domain */
      tokens[TABLE] = "typedef" ;
      /* shift the fields to the left */
      for ( i = MAXTOKENS-1 ; i >= 2 ; i-- ) tokens[i] = tokens[i-1] ; 
      tokens[FIELD_OF] = "domain" ;
                 if ( !strcmp( tokens[FIELD_TYPE], "double" ) ) tokens[FIELD_TYPE] = "doubleprecision" ; 
      defining_i1_field = 1 ;
    }

    /* NOTE: fall through */

/* typedef entry */
    if ( !strcmp( tokens[ TABLE ] , "typedef" ) )
    {
      node_t * field_struct ;
      node_t * type_struct ;

      if ( !defining_state_field && ! defining_i1_field && 
           !defining_rconfig_field && !strcmp(tokens[FIELD_OF],"domain") )
       { fprintf(stderr,"Registry warning: 'domain' is a reserved registry type name. Cannot 'typedef domain'\n") ; }

      type_struct = get_type_entry( tokens[ FIELD_OF ] ) ;
      if ( type_struct == NULL ) 
      {  
        type_struct = new_node( TYPE ) ;
        strcpy( type_struct->name, tokens[FIELD_OF] ) ;
        type_struct->type_type = DERIVED ;
        add_node_to_end( type_struct , &Type ) ;
      }

      if        ( defining_i1_field )      {
        field_struct = new_node( I1 ) ;
      } else if ( defining_rconfig_field ) {
        field_struct = new_node( RCONFIG ) ;
      } else {
        field_struct = new_node( FIELD ) ;
      }

      strcpy( field_struct->name, tokens[FIELD_SYM] ) ;

      if ( set_state_type( tokens[FIELD_TYPE], field_struct ) )
       { fprintf(stderr,"Registry warning: type %s used before defined \n",tokens[FIELD_TYPE] ) ; }

      if ( set_state_dims( tokens[FIELD_DIMS], field_struct ) )
       { fprintf(stderr,"Registry warning: some problem with dimstring %s\n", tokens[FIELD_DIMS] ) ; }

      if ( strcmp( tokens[FIELD_NTL], "-" ) ) /* that is, if not equal "-" */
       { field_struct->ntl = atoi(tokens[FIELD_NTL]) ; }
      field_struct->ntl = ( field_struct->ntl > 0 )?field_struct->ntl:1 ;
      /* calculate the maximum number of time levels and store in global variable */
      if ( field_struct->ntl > max_time_level && field_struct->ntl <= 3 ) max_time_level = field_struct->ntl ;

      field_struct->stag_x = 0 ; field_struct->stag_y = 0 ; field_struct->stag_z = 0 ;
      for ( i = 0 ; i < strlen(tokens[FIELD_STAG]) ; i++ )
      {
        if ( tolower(tokens[FIELD_STAG][i]) == 'x' || sw_all_x_staggered ) field_struct->stag_x = 1 ;
        if ( tolower(tokens[FIELD_STAG][i]) == 'y' || sw_all_y_staggered ) field_struct->stag_y = 1 ;
        if ( tolower(tokens[FIELD_STAG][i]) == 'z' ) field_struct->stag_z = 1 ;
      }

      field_struct->restart  = 0 ; field_struct->boundary  = 0 ;
      for ( i = 0 ; i < MAX_STREAMS ; i++ ) { 
        reset_mask( field_struct->io_mask, i ) ;
      }

      {
        char prev = '\0' ;
        char x ;
        char tmp[NAMELEN], tmp1[NAMELEN], tmp2[NAMELEN] ;
        int len_of_tok ;
        char fcn_name[2048], aux_fields[2048] ;

        strcpy(tmp,tokens[FIELD_IO]) ;
        if (( p = index(tmp,'=') ) != NULL ) { *p = '\0' ; }
        for ( i = 0 ; i < strlen(tmp) ; i++ )
        {
          x = tolower(tmp[i]) ;
          if ( x == 'h' || x == 'i' ) {
            char c, *p, *pp ;
            int unitid ;
            int stream ;
            unsigned int * mask ;
            stream = ( x == 'h' )?HISTORY_STREAM:INPUT_STREAM ;
            mask = field_struct->io_mask ;
            set_mask( mask , stream ) ;
            strcpy(tmp1, &(tmp[++i])) ;
            for ( p = tmp1  ; *p ; i++, p++ ) { 
              c = tolower(*p) ; if ( c >= 'a' && c <= 'z' ) { *p = '\0' ; i-- ; break ; }
              reset_mask( mask , stream ) ;
            }
            for ( p = tmp1  ; *p ; p++ ) { 
              x = *p ;
              if ( x >= '0' && x <= '9' ) { 
                set_mask( mask , stream + x - '0' ) ; 
              }
              else if ( x == '{' ) {
                strcpy(tmp2,p+1) ;
                if (( pp = index(tmp2,'}') ) != NULL ) {
                  *pp = '\0' ;
                  unitid = atoi(tmp2) ;  /* JM 20100416 */
                  if ( unitid >= 0  || unitid < MAX_STREAMS && stream + unitid < MAX_HISTORY ) {
                    set_mask( mask , stream + unitid   ) ;
                  }
                  p = p + strlen(tmp2) + 1 ;
                } else {
                  fprintf(stderr,"registry syntax error: unmatched {} in the io string for definition of %s\n",tokens[FIELD_SYM]) ;
                  exit(9) ;
                }
              }
            }
          }
        }

        for ( i = 0 ; i < (len_of_tok = strlen(tokens[FIELD_IO])) ; i++ )
        {
          int unitid = -1 ;
          x = tolower(tokens[FIELD_IO][i]) ;
          if ( x == '{' ) {
            int ii,iii ;
            char * pp ;
            char tmp[NAMELEN] ;
            strcpy(tmp,tokens[FIELD_IO]) ;   

            if (( pp = index(tmp,'}') ) != NULL ) {
              *pp = '\0' ;
              iii = pp - (tmp + i + 1) ;
              unitid = atoi(tmp+i+1) ;  /* JM 20091102 */
              if ( unitid >= 0  || unitid < MAX_STREAMS  && unitid < MAX_HISTORY ) {
                if        ( prev == 'i' ) {
                  set_mask( field_struct->io_mask , unitid + MAX_HISTORY  ) ;
                } else if ( prev == 'h' ) {
                  set_mask( field_struct->io_mask , unitid   ) ;
                }
              }
              i += iii ;
              continue ;
            } else {
              fprintf(stderr,"registry syntax error: unmatched {} in the io string for definition of %s\n",tokens[FIELD_SYM]) ;
              exit(9) ;
            }

          } else if ( x >= 'a' && x <= 'z' ) {
            if ( x == 'r' ) { field_struct->restart = 1 ; set_mask( field_struct->io_mask , RESTART_STREAM   ) ; }
            if ( x == 'b' ) { field_struct->boundary  = 1 ; set_mask( field_struct->io_mask , BOUNDARY_STREAM   ) ; }
            if ( x == 'f' || x == 'd' || x == 'u' || x == 's' ) { 
                               strcpy(aux_fields,"") ;
                               strcpy(fcn_name,"") ; 
                               if ( tokens[FIELD_IO][i+1] == '(' )     /* catch a possible error */
                               {
                                 fprintf(stderr,
                                    "Registry warning: syntax error in %c specifier of IO field for %s\n",x,tokens[FIELD_SYM]) ;
                                 fprintf(stderr,
                                    "                  equal sign needed before left paren\n") ;
                               }

                               if ( tokens[FIELD_IO][i+1] == '=' ) 
                               {
                                 int ii, jj, state ;
                                 state = 0 ;
                                 jj = 0 ;
                                 for ( ii = i+3 ; ii < len_of_tok ; ii++ )
                                 {
                                   if ( tokens[FIELD_IO][ii] == ')' ) { if (state == 0 )fcn_name[jj] = '\0' ; aux_fields[jj] = '\0' ; break ; }
                                   if ( tokens[FIELD_IO][ii] == ':' ) { fcn_name[jj] = '\0' ; jj= 0 ; state++ ; continue ;}
                                   if ( tokens[FIELD_IO][ii] == ',' && state == 0 ) {
                                     fprintf(stderr,
                                             "Registry warning: syntax error in %c specifier of IO field for %s\n",x,
                                             tokens[FIELD_SYM]) ;
                                   }
                                   if ( state == 0 )  /* looking for interpolation fcn name */
                                   {
                                     fcn_name[jj++] = tokens[FIELD_IO][ii] ;
                                   }
                                   if ( state > 0 )
                                   {
                                     aux_fields[jj++] = tokens[FIELD_IO][ii] ;
                                   }
                                 }
                                 i = ii ;
                               }
                               else
                               {
                                 if ( x == 'f' || x == 'd' ) strcpy(fcn_name,"interp_fcn") ;
                                 if ( x == 'u' ) strcpy(fcn_name,"copy_fcn") ;
                                 if ( x == 's' ) strcpy(fcn_name,"smoother") ;
                               }
                               if      ( x == 'f' )  { 
                                 field_struct->nest_mask |= FORCE_DOWN ; 
                                 strcpy(field_struct->force_fcn_name, fcn_name ) ;
                                 strcpy(field_struct->force_aux_fields, aux_fields ) ;
                               }
                               else if ( x == 'd' )  { 
                                 field_struct->nest_mask |= INTERP_DOWN ; 
                                 strcpy(field_struct->interpd_fcn_name, fcn_name ) ;
                                 strcpy(field_struct->interpd_aux_fields, aux_fields ) ;
                               }
                               else if ( x == 's' )  { 
                                 field_struct->nest_mask |= SMOOTH_UP ; 
                                 strcpy(field_struct->smoothu_fcn_name, fcn_name ) ;
                                 strcpy(field_struct->smoothu_aux_fields, aux_fields ) ;
                               }
                               else if ( x == 'u' )  { 
                                 field_struct->nest_mask |= INTERP_UP ; 
                                 strcpy(field_struct->interpu_fcn_name, fcn_name ) ;
                                 strcpy(field_struct->interpu_aux_fields, aux_fields ) ;
                               }
            }
            prev = x ;
          }
        }
      }

      field_struct->dname[0] = '\0' ;
      if ( strcmp( tokens[FIELD_DNAME], "-" ) ) /* that is, if not equal "-" */
        { strcpy( field_struct->dname , tokens[FIELD_DNAME] ) ; }
      strcpy(field_struct->descrip,"-") ;
      if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */
        { strcpy( field_struct->descrip , tokens[FIELD_DESCRIP] ) ; }
      strcpy(field_struct->units,"-") ;
      if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */
        { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; }
      strcpy(field_struct->use,"-") ;
      if ( strcmp( tokens[FIELD_USE], "-" ) ) /* that is, if not equal "-" */
        { strcpy( field_struct->use , tokens[FIELD_USE] ) ;
        }

      /* specific settings for RCONFIG entries */
      if ( defining_rconfig_field )
      {
        if ( strcmp( tokens[RCNF_NENTRIES] , "-" ) ) /* that is, if not equal "-" */
        {
          strcpy(field_struct->nentries, tokens[RCNF_NENTRIES] ) ;
        } else {
          strcpy(field_struct->nentries, "1" ) ;
        }
        if ( strcmp( tokens[RCNF_HOWSET] , "-" ) ) /* that is, if not equal "-" */
        {
          strcpy(field_struct->howset,tokens[RCNF_HOWSET]) ;
        } else {
          strcpy(field_struct->howset,"") ;
        }
        if ( strcmp( tokens[RCNF_DEFAULT] , "-" ) ) /* that is, if not equal "-" */
        {
          strcpy(field_struct->dflt,tokens[RCNF_DEFAULT]) ;
        } else {
          strcpy(field_struct->dflt,"") ;
        }
      }

      if ( field_struct->type != NULL )
        if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 )
          { fprintf(stderr,"Registry warning: type item %s of type %s can not be multi-dimensional ",
                           tokens[FIELD_SYM], tokens[FIELD_TYPE] ) ; }

/**/  if ( ! field_struct->scalar_array_member )
      {
        add_node_to_end( field_struct , &(type_struct->fields) ) ;
      }
/**/  else   /* if ( field_struct->scalar_array_member ) */
      {
/* 
   Here we are constructing a list of nodes to represent the list of 4D scalar arrays in the model

   This list is rooted at the FourD pointer.
   Each array is represented by its own node; each node has a pointer, members, to the list
   of fields that make it up.  

*/
        node_t * q , * member  ;
        if (( q = get_4d_entry(field_struct->use )) == NULL )  /* first instance of a 4d array member */
        {
          q = new_node( FOURD ) ;
          *q = *field_struct ;  /* this overwrites the node */
          strcpy( q->name, field_struct->use ) ;
          strcpy( q->use, "" ) ;
          q->node_kind = FOURD ;
          q->scalar_array_member = 0 ;
          q->next4d = NULL ;
          q->next = NULL ;
                  /* add 4d q node to the list of fields of this type and also attach
                     it to the global list of 4d arrays */
          add_node_to_end( q , &(type_struct->fields) ) ;
          add_node_to_end_4d( q , &(FourD) ) ;
        }
        member = new_node( MEMBER ) ;
        *member = *q ;
        member->node_kind = MEMBER ;
        member->members = NULL ;
        member->scalar_array_member = 1 ;
        strcpy( member->name , field_struct->name ) ;
        strcpy( member->dname , field_struct->dname ) ;
        strcpy( member->use , field_struct->use ) ;
        strcpy( member->descrip , field_struct->descrip ) ;
        strcpy( member->units , field_struct->units ) ;
        member->next = NULL ;
        for ( i = 0 ; i < IO_MASK_SIZE ; i++ ) {
          member->io_mask[i] = field_struct->io_mask[i] ;
        }
        member->nest_mask = field_struct->nest_mask ;
        member->ndims = field_struct->ndims ;
        member->restart = field_struct->restart ;
        member->boundary = field_struct->boundary ;
        strcpy( member->interpd_fcn_name, field_struct->interpd_fcn_name) ;
        strcpy( member->interpd_aux_fields,  field_struct->interpd_aux_fields)  ;
        strcpy( member->interpu_fcn_name, field_struct->interpu_fcn_name) ;
        strcpy( member->interpu_aux_fields,  field_struct->interpu_aux_fields)  ;
        strcpy( member->smoothu_fcn_name, field_struct->smoothu_fcn_name) ;
        strcpy( member->smoothu_aux_fields,  field_struct->smoothu_aux_fields)  ;
        strcpy( member->force_fcn_name, field_struct->force_fcn_name) ;
        strcpy( member->force_aux_fields,  field_struct->force_aux_fields)  ;
        for ( ii = 0 ; ii < member->ndims ; ii++ )
          member->dims[ii] = field_struct->dims[ii] ;
        add_node_to_end( member , &(q->members) ) ;
        free(field_struct) ;  /* We've used all the information about this entry.
                                 It is not a field but the name of one of the members of
                                 a 4d field.  we have handled that here. Discard the original node. */
      }
    }

/* dimespec entry */
    else if ( !strcmp( tokens[ TABLE ] , "dimspec" ) )
    {
      node_t * dim_struct ;
      dim_struct = new_node( DIM ) ;
      if ( get_dim_entry ( tokens[DIM_NAME] ) != NULL )
        { fprintf(stderr,"Registry warning: dimspec (%s) already defined\n",tokens[DIM_NAME] ) ; }
      strcpy(dim_struct->dim_name,tokens[DIM_NAME]) ;
      if ( set_dim_order( tokens[DIM_ORDER], dim_struct ) )
        { fprintf(stderr,"Registry warning: problem with dimorder (%s)\n",tokens[DIM_ORDER] ) ; }
      if ( set_dim_len( tokens[DIM_SPEC], dim_struct ) )
        { fprintf(stderr,"Registry warning: problem with dimspec (%s)\n",tokens[DIM_SPEC] ) ; }
      if ( set_dim_orient( tokens[DIM_ORIENT], dim_struct ) )
        { fprintf(stderr,"Registry warning: problem with dimorient (%s)\n",tokens[DIM_ORIENT] ) ; }
      if ( strcmp( tokens[DIM_DATA_NAME], "-" ) ) /* that is, if not equal "-" */
        { strcpy( dim_struct->dim_data_name , tokens[DIM_DATA_NAME] ) ; }

      add_node_to_end( dim_struct , &Dim ) ;
    }

/* package */
    else if ( !strcmp( tokens[ TABLE ] , "package" ) )
    {
      node_t * package_struct ;
      package_struct = new_node( PACKAGE ) ;
      strcpy( package_struct->name          , tokens[PKG_SYM]       ) ;
      strcpy( package_struct->pkg_assoc     , tokens[PKG_ASSOC]     ) ;
      strcpy( package_struct->pkg_statevars , tokens[PKG_STATEVARS] ) ;
      strcpy( package_struct->pkg_4dscalars , tokens[PKG_4DSCALARS] ) ;

      add_node_to_end( package_struct , &Packages ) ;
    }

/* halo, period, xpose */
    else if ( !strcmp( tokens[ TABLE ] , "halo" ) )
    {
      node_t * comm_struct ;
      comm_struct = new_node( HALO ) ;
      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
#if 1
      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
      } 
#else
      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
#endif
      add_node_to_end( comm_struct , &Halos ) ;
    }
    else if ( !strcmp( tokens[ TABLE ] , "period" ) )
    {
      node_t * comm_struct ;
      comm_struct = new_node( PERIOD ) ;
      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
#if 1
      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
      } 
#else
      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
#endif
      add_node_to_end( comm_struct , &Periods ) ;
    }
    else if ( !strcmp( tokens[ TABLE ] , "xpose" ) )
    {
      node_t * comm_struct ;
      comm_struct = new_node( XPOSE ) ;
      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
#if 1
      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
      } 
#else
      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
#endif
      add_node_to_end( comm_struct , &Xposes ) ;
    }
    else if ( !strcmp( tokens[ TABLE ] , "swap" ) )
    {
      node_t * comm_struct ;
      comm_struct = new_node( SWAP ) ;
      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
#if 1
      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
      }
#else
      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
#endif
      add_node_to_end( comm_struct , &Swaps ) ;
    }
    else if ( !strcmp( tokens[ TABLE ] , "cycle" ) )
    {
      node_t * comm_struct ;
      comm_struct = new_node( CYCLE ) ;
      strcpy( comm_struct->name        , tokens[COMM_ID]     ) ;
      strcpy( comm_struct->use         , tokens[COMM_USE]     ) ;
#if 1
      for ( i = COMM_DEFINE, q=comm_struct->comm_define ; strcmp(tokens[i],"-") ; i++ )  {
        for(p=tokens[i];*p;p++)if(*p!=' '&&*p!='\t'){*q++=*p;}
      }
#else
      strcpy( comm_struct->comm_define , tokens[COMM_DEFINE] ) ;
#endif
      add_node_to_end( comm_struct , &Cycles ) ;
    }


#if 0
     fprintf(stderr,"vvvvvvvvvvvvvvvvvvvvvvvvvvv\n") ;
     show_nodelist( Type ) ;
     fprintf(stderr,"^^^^^^^^^^^^^^^^^^^^^^^^^^^\n") ;
#endif
     parseline[0] = '\0' ;  /* reset parseline */
  }

  Domain = *(get_type_entry( "domain" )) ;

#if 0
  show_node( &Domain ) ;
#endif

  return(0) ;

}

node_t *
get_dim_entry( char *s )
{
  node_t * p ;
  for ( p = Dim ; p != NULL ; p = p->next )
  {
    if ( !strcmp(p->dim_name, s ) ) {
      return( p ) ;
    }
  }
  return(NULL) ;
}

int
set_state_type( char * typename, node_t * state_entry )
{
  if ( typename == NULL ) return(1) ;
  return (( state_entry->type = get_type_entry( typename )) == NULL )  ;
}

int
set_dim_len ( char * dimspec , node_t * dim_entry )
{
  if      (!strcmp( dimspec , "standard_domain" ))
   { dim_entry->len_defined_how = DOMAIN_STANDARD ; }
  else if (!strncmp( dimspec, "constant=" , 9 ))
  {
    char *p, *colon, *paren ;
    p = &(dimspec[9]) ;
    /* check for colon */
    if (( colon = index(p,':')) != NULL )
    {
      *colon = '\0' ;
      if (( paren = index(p,'(')) !=NULL )
      {
        dim_entry->coord_start = atoi(paren+1) ;
      }
      else
      {
        fprintf(stderr,"WARNING: illegal syntax (missing opening paren) for constant: %s\n",p) ;
      }
      dim_entry->coord_end   = atoi(colon+1) ;
    }
    else
    {
      dim_entry->coord_start = 1 ;
      dim_entry->coord_end   = atoi(p) ;
    }
    dim_entry->len_defined_how = CONSTANT ;
  }
  else if (!strncmp( dimspec, "namelist=", 9 ))
  {
    char *p, *colon ;

    p = &(dimspec[9]) ;
    /* check for colon */
    if (( colon = index(p,':')) != NULL )
    {
      *colon = '\0' ;
      strcpy( dim_entry->assoc_nl_var_s, p ) ;
      strcpy( dim_entry->assoc_nl_var_e, colon+1 ) ;
    }
    else
    {
      strcpy( dim_entry->assoc_nl_var_s, "1" ) ;
      strcpy( dim_entry->assoc_nl_var_e, p ) ;
    }
    dim_entry->len_defined_how = NAMELIST ;
  }
  else
  {
    return(1) ;
  }
  return(0) ;
}

int
set_dim_orient ( char * dimorient , node_t * dim_entry )
{
  if      (!strcmp( dimorient , "x" ))
   { dim_entry->coord_axis = COORD_X ; }
  else if (!strcmp( dimorient , "y" )) 
   { dim_entry->coord_axis = COORD_Y ; }
  else if (!strcmp( dimorient , "z" )) 
   { dim_entry->coord_axis = COORD_Z ; }
  else
   { dim_entry->coord_axis = COORD_C ; }
  return(0) ;
}

/* integrity checking of dimension list; make sure that
   namelist specified dimensions have an associated namelist variable */
int
check_dimspecs()
{
  node_t * p, *q ;
  int ord ;

  for ( p = Dim ; p != NULL ; p = p->next )
  {
    if      ( p->len_defined_how == DOMAIN_STANDARD )
    {
      if ( p->dim_order < 1 || p->dim_order > 3 )
      {
        fprintf(stderr,"WARNING: illegal dim order %d for dimspec %s\n",p->dim_order,p->name) ;
      }
      ord = p->dim_order-1 ;
      if ( model_order[ord] != p->coord_axis )
      {
        if ( model_order[ord] == -1 ) model_order[ord] = p->coord_axis ;
        else
        {
          fprintf(stderr,"WARNING: coord-axis/dim-order for dimspec %s is inconsistent with previous dimspec.\n",p->name) ;
        }
      }
    }
    else if ( p->len_defined_how == NAMELIST )
    {
      if ( strcmp( p->assoc_nl_var_s, "1" ) )   /* if not equal to "1" */
      {
        if (( q = get_entry(p->assoc_nl_var_s,Domain.fields)) == NULL )
        {
          fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
                  p->assoc_nl_var_s,p->name ) ;
          return(1) ;
        }
        if ( ! q->node_kind & RCONFIG )
        {
          fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
                  p->assoc_nl_var_s,p->name ) ;
          return(1) ;
        }
        if ( strcmp( q->type->name , "integer" ) )   /* if not integer */
        {
          fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
                  p->assoc_nl_var_s,p->name ) ;
          return(1) ;
        }
        if ( strcmp( q->nentries , "1" ) )   /* if not 1 entry */
        {
          fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
                  p->assoc_nl_var_s,p->name ) ;
          return(1) ;
        }
      }
      if (( q = get_entry(p->assoc_nl_var_e,Domain.fields)) == NULL )
      {
        fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
                p->assoc_nl_var_e,p->name ) ;
        return(1) ;
      }
      if ( ! q->node_kind & RCONFIG )
      {
        fprintf(stderr,"WARNING: no namelist variable %s defined for dimension %s\n",
                p->assoc_nl_var_e,p->name ) ;
        return(1) ;
      }
      if ( strcmp( q->type->name , "integer" ) )   /* if not integer */
      {
        fprintf(stderr,"WARNING: namelist variable %s must be an integer if used to define dimension %s\n",
                p->assoc_nl_var_e,p->name ) ;
        return(1) ;
      }
      if ( strcmp( q->nentries , "1" ) )   /* if not 1 entry */
      {
        fprintf(stderr,"WARNING: namelist variable %s must have only one entry if used to define dimension %s\n",
                p->assoc_nl_var_e,p->name ) ;
        return(1) ;
      }
    }
  }
  return(0) ;
}

int
set_dim_order ( char * dimorder , node_t * dim_entry )
{
  dim_entry->dim_order = atoi(dimorder) ;
  return(0) ;
}

int
init_parser()
{
  model_order[0] = -1 ;
  model_order[1] = -1 ;
  model_order[2] = -1 ;
  return(0) ;
}