problem_compile.c

Go to the documentation of this file.
00001 
00011 /* $Id: problem_compile.c,v 1.98 2008/10/22 20:03:26 seymour Exp $ */
00012 /* $UTK_Copyright: $ */
00013 
00014 
00015 #include <stdio.h>
00016 #include <string.h>
00017 #include <sys/stat.h>
00018 #include <sys/types.h>
00019 #include <sys/wait.h>
00020 #include <errno.h>
00021 #include <unistd.h>
00022 #include <dirent.h>
00023 #include <stdlib.h>
00024 #include <ctype.h>
00025 
00026 #ifdef HAVE_CONFIG_H
00027 #include "config.h"
00028 #include "gridsolve-config.h"
00029 #endif /* HAVE_CONFIG_H */
00030 #include "problem.h"
00031 #include "comm_encode.h"
00032 #include "utility.h"
00033 
00035 char *gridsolve_root = NULL;
00036 
00038 int gs_remove_failed_service = TRUE;
00039 
00051 char *
00052 gs_idl_emit_fortran_ifdefs(FILE *file, char *name, char *lang)
00053 {
00054   if(!name || !lang)
00055     return NULL;
00056 
00057   if(!strcasecmp(lang, "FORTRAN")) {
00058     char *lo, *up;
00059     int i;
00060 
00061     lo = strdup(name);
00062     if(!lo) return NULL;
00063 
00064     up = strdup(name);
00065     if(!up) {
00066       free(lo);
00067       return NULL;
00068     }
00069 
00070     for(i=0;i<strlen(name);i++) {
00071       lo[i] = tolower(lo[i]);
00072       up[i] = toupper(up[i]);
00073     }
00074 
00075     fprintf(file, "#ifdef F2CNOCHANGE\n");
00076     fprintf(file, "#define GS_USER_ROUTINE %s\n", lo);
00077     fprintf(file, "#elif F2CADD_\n");
00078     fprintf(file, "#define GS_USER_ROUTINE %s_\n", lo);
00079     fprintf(file, "#elif F2CADD__\n");
00080     fprintf(file, "#define GS_USER_ROUTINE %s__\n", lo);
00081     fprintf(file, "#elif F2CUPCASE\n");
00082     fprintf(file, "#define GS_USER_ROUTINE %s\n", up);
00083     fprintf(file, "#else\n");
00084     fprintf(file, "#define GS_USER_ROUTINE %s\n", lo);
00085     fprintf(file, "#endif\n");
00086     fprintf(file, "\n");
00087 
00088     return strdup("GS_USER_ROUTINE");
00089   }
00090 
00091   return strdup(name);
00092 }
00093 
00108 char *
00109 gs_idl_arg_name_mangle(gs_argument_t * arg, char *lang, int argnum)
00110 {
00111   char *string;
00112 
00113   if(!arg || !lang)
00114     return NULL;
00115 
00116   if((arg->objecttype == GS_FILE) || (arg->objecttype == GS_PACKEDFILE))
00117     string = dstring_sprintf("(%s *) argdata[%d]",
00118                              gs_c_datatype[arg->datatype], argnum);
00119   /* if it's passed by value, dereference before calling */
00120   else if(!strcasecmp(lang, "C") && arg->objecttype == GS_SCALAR &&
00121      ((arg->inout == GS_IN) || (arg->inout == GS_WORKSPACE)))
00122     string = dstring_sprintf("(*(%s*)argdata[%d])",
00123                              gs_c_datatype[arg->datatype], argnum);
00124   else if(arg->inout == GS_VAROUT)
00125     string = dstring_sprintf("(%s**) argdata[%d]",
00126                              gs_c_datatype[arg->datatype], argnum);
00127   else
00128     string = dstring_sprintf("(%s*) argdata[%d]",
00129                              gs_c_datatype[arg->datatype], argnum);
00130 
00131   return (string);
00132 }
00133 
00147 int
00148 gs_non_workspace_args_left(gs_argument_t *arg)
00149 {
00150   gs_argument_t *atmp;
00151 
00152   for(atmp = arg->next; atmp != NULL; atmp = atmp->next) {
00153     if(atmp->inout != GS_WORKSPACE)
00154       return FALSE;
00155   }
00156 
00157   return TRUE;
00158 }
00159 
00169 int
00170 gs_idl_generate_grpc_example(gs_problem_t * problem)
00171 {
00172   gs_argument_t *arg;
00173   char *fname;
00174   FILE *file;
00175   int needs_scval = 0, needs_dcval = 0;
00176 
00177   fname = dstring_sprintf("%s/service/%s/%s_grpc_example.c",
00178                           gridsolve_root, problem->name,
00179                           problem->name);
00180   if(!fname) {
00181     ERRPRINTF("Could not generate name of service file\n");
00182     return -1;
00183   }
00184 
00185   if((file = fopen(fname, "w")) == NULL) {
00186     ERRPRINTF("Could not open file %s\n", fname);
00187     free(fname);
00188     return -1;
00189   }
00190 
00191   free(fname);
00192 
00193   /* first generate the typical header stuff */
00194   fprintf(file, "/* This is an automatically generated code example, so\n");
00195   fprintf(file, " * arguments are initialized with some arbitrary values\n");
00196   fprintf(file, " * that may not be valid for the routine.  It is just\n");
00197   fprintf(file, " * intended to show the proper calling sequence (whether\n");
00198   fprintf(file, " * arguments should be passed by reference, how\n");
00199   fprintf(file, " * they could be declared, etc) and simple GridRPC\n");
00200   fprintf(file, " * initialization, calling, and error handling.\n");
00201   fprintf(file, " */\n");
00202   fprintf(file, "\n");
00203 
00204   fprintf(file, "#include <stdio.h>\n");
00205   fprintf(file, "#include <stdlib.h>\n");
00206   fprintf(file, "\n");
00207 
00208   fprintf(file, "#undef  max\n");
00209   fprintf(file, "#define max(a, b)  (((a) > (b)) ? (a) : (b))\n");
00210   fprintf(file, "\n");
00211 
00212   fprintf(file, "#undef  min\n");
00213   fprintf(file, "#define min(a, b)  (((a) < (b)) ? (a) : (b))\n");
00214   fprintf(file, "\n");
00215 
00216   fprintf(file, "\n");
00217   fprintf(file, "#include \"grpc.h\"\n");
00218   fprintf(file, "\n");
00219   fprintf(file, "int main()\n");
00220   fprintf(file, "{\n");
00221   fprintf(file, "  grpc_function_handle_t __handle;\n");
00222   fprintf(file, "  grpc_error_t __status;\n");
00223 
00224   /* now generate local variable declarations for the args */
00225   for(arg = problem->arglist; arg != NULL; arg = arg->next) {
00226     /* skip workspace args */
00227     if(arg->inout == GS_WORKSPACE)
00228       continue;
00229 
00230     fprintf(file, "  %s ", gs_c_datatype[arg->datatype]);
00231     if((arg->objecttype == GS_VECTOR) || (arg->objecttype == GS_MATRIX)
00232        || (arg->objecttype == GS_SPARSEMATRIX) || (arg->objecttype == GS_FILE))
00233       fprintf(file, "*");
00234     else if(arg->objecttype == GS_PACKEDFILE)
00235       fprintf(file, "**");
00236     fprintf(file, "%s;\n", arg->name);
00237 
00238     if(arg->datatype == GS_SCOMPLEX)
00239       needs_scval = 1;
00240     if(arg->datatype == GS_DCOMPLEX)
00241       needs_dcval = 1;
00242   }
00243 
00244   if(needs_scval)
00245     fprintf(file, "  %s __scval = {4.0, 6.0};\n", gs_c_datatype[GS_SCOMPLEX]);
00246 
00247   if(needs_dcval)
00248     fprintf(file, "  %s __dcval = {4.0, 6.0};\n", gs_c_datatype[GS_DCOMPLEX]);
00249 
00250   fprintf(file, "\n");
00251 
00252   /* initialize scalar arguments */
00253   for(arg = problem->arglist; arg != NULL; arg = arg->next) {
00254     /* skip workspace args */
00255     if(arg->inout == GS_WORKSPACE)
00256       continue;
00257 
00258     /* skip this if it's a sparse matrix attribute */
00259     if(gs_arg_is_sparse_attr(arg->name, problem->arglist))
00260       continue;
00261 
00262     if((arg->objecttype == GS_SCALAR) && (arg->inout != GS_OUT))
00263       fprintf(file, "  %s = %s;\n", arg->name, gs_const[arg->datatype]);
00264     else if(arg->objecttype == GS_FILE)
00265       fprintf(file, "  %s = \"foo\";\n", arg->name);
00266   }
00267 
00268   /* for non-scalar args we must allocate memory */
00269   for(arg = problem->arglist; arg != NULL; arg = arg->next) {
00270     /* skip workspace args */
00271     if(arg->inout == GS_WORKSPACE)
00272       continue;
00273 
00274     /* skip this if it's a sparse matrix attribute */
00275     if(gs_arg_is_sparse_attr(arg->name, problem->arglist))
00276       continue;
00277 
00278     if((arg->objecttype == GS_VECTOR) || (arg->objecttype == GS_MATRIX) 
00279         || (arg->objecttype == GS_PACKEDFILE))
00280       fprintf(file, "  %s = (%s %s)malloc((%s)*(%s)*sizeof(*%s));\n", arg->name,
00281               gs_c_datatype[arg->datatype], 
00282               arg->objecttype == GS_PACKEDFILE ? "**" : "*",
00283               arg->rowexp, arg->colexp, arg->name);
00284   }
00285 
00286   for(arg = problem->arglist; arg != NULL; arg = arg->next) {
00287     /* skip this if it's a sparse matrix attribute */
00288     if(gs_arg_is_sparse_attr(arg->name, problem->arglist))
00289       continue;
00290 
00291     if(((arg->objecttype == GS_VECTOR) || (arg->objecttype == GS_MATRIX))
00292        && (arg->inout != GS_OUT) && (arg->inout != GS_WORKSPACE)) {
00293       fprintf(file, "  {\n    int __i;\n");
00294 
00295       fprintf(file, "    for(__i=0;__i<(%s)*(%s);__i++)\n", arg->rowexp,
00296               arg->colexp);
00297       fprintf(file, "      %s[__i] = %s;\n", arg->name,
00298               gs_const[arg->datatype]);
00299       fprintf(file, "  }\n");
00300     }
00301     else if(arg->objecttype == GS_PACKEDFILE) {
00302       fprintf(file, "  {\n    int __i;\n");
00303       fprintf(file, "    for(__i=0;__i<(%s);__i++)\n", arg->rowexp);
00304       fprintf(file, "      %s[__i] = \"foo\";\n", arg->name);
00305       fprintf(file, "  }\n");
00306     }
00307     else if(arg->objecttype == GS_SPARSEMATRIX) {
00308       fprintf(file, "\n  /* initialize sparse matrix %s */\n", arg->name);
00309       fprintf(file, "  if((%s = gs_gen_sparse_mat_%s(%s, (0*%s)+1, (1*%s)-1 , &%s, &%s, &%s)) < 0) {\n",
00310         arg->sparse_attr.nnzexp, gs_c_datatype[arg->datatype], arg->colexp, 
00311         arg->rowexp, arg->rowexp, arg->name, arg->sparse_attr.indices, 
00312         arg->sparse_attr.pointer);
00313       fprintf(file, "    fprintf(stderr,\"Error creating sparse matrix\\n\");\n");
00314       fprintf(file, "    exit(EXIT_FAILURE);\n");
00315       fprintf(file, "  }\n");
00316     }
00317   }
00318 
00319   fprintf(file, "\n");
00320 
00321   /* generate a call to initialize GRPC */
00322   fprintf(file, "  if(grpc_initialize(NULL) != GRPC_NO_ERROR) {\n");
00323   fprintf(file, "    grpc_perror(\"grpc_initialize\");\n");
00324   fprintf(file, "    exit(EXIT_FAILURE);\n");
00325   fprintf(file, "  }\n");
00326   fprintf(file, "\n");
00327 
00328   /* create the GRPC function handle to the function we want to call */
00329   fprintf(file,
00330           "  if(grpc_function_handle_default(&__handle, \"%s\") != GRPC_NO_ERROR) {\n",
00331           problem->name);
00332   fprintf(file,
00333           "    fprintf(stderr,\"Error creating function handle\\n\");\n");
00334   fprintf(file, "    exit(EXIT_FAILURE);\n");
00335   fprintf(file, "  }\n");
00336 
00337   /* start generating the actual call */
00338   fprintf(file, "  __status = grpc_call(&__handle,");
00339 
00340   for(arg = problem->arglist; arg != NULL; arg = arg->next) {
00341     /* skip workspace args */
00342     if(arg->inout == GS_WORKSPACE)
00343       continue;
00344 
00345     /* if this is a scalar passed by reference, pass the address */
00346     if(((arg->objecttype == GS_SCALAR) && (arg->inout != GS_IN)) ||
00347         (arg->inout == GS_VAROUT))
00348       fprintf(file, "&");
00349     fprintf(file, "%s", arg->name);
00350     if(!gs_non_workspace_args_left(arg))
00351       fprintf(file, ",");
00352   }
00353 
00354   fprintf(file, ");\n\n");
00355 
00356   /* call is complete, check the status */
00357   fprintf(file, "  if(__status != GRPC_NO_ERROR) {\n");
00358   fprintf(file, "    printf(\"GRPC error __status  = %%d\\n\", __status);\n");
00359   fprintf(file, "    grpc_perror(\"grpc_call\");\n");
00360   fprintf(file, "    exit(__status);\n");
00361   fprintf(file, "  }\n");
00362 
00363   fprintf(file, "\n  printf(\"GridRPC call completed successfully.\\n\");\n");
00364 
00365   /* we are done.  finalize */
00366   fprintf(file, "  grpc_finalize();\n");
00367   fprintf(file, "  exit(EXIT_SUCCESS);\n");
00368 
00369   fprintf(file, "}\n");
00370   fclose(file);
00371 
00372   return 0;
00373 }
00374 
00384 int
00385 gs_idl_generate_source(gs_problem_t * problem)
00386 {
00387   char *fname, *language, *problem_name;
00388   gs_argument_t *arg, *lastarg;
00389   int i, argcount;
00390   FILE *file;
00391 
00392   if(!problem)
00393     return -1;
00394 
00395   language = gs_problem_getinfo(problem, "LANGUAGE", "C");
00396 
00397   /* generate source code for the interface */
00398   fname = dstring_sprintf("%s/service/%s/%s_service.c",
00399                           gridsolve_root, problem->name,
00400                           problem->name);
00401   if(!fname) {
00402     ERRPRINTF("Could not generate name of service file\n");
00403     return -1;
00404   }
00405 
00406   DBGPRINTF("Generating source for %s in file %s\n", problem->name, fname);
00407   if((file = fopen(fname, "w")) == NULL) {
00408     ERRPRINTF("Could not open file %s\n", fname);
00409     free(fname);
00410     return -1;
00411   }
00412 
00413   free(fname);
00414 
00415   fprintf(file, "#include <stdio.h>\n");
00416   fprintf(file, "#include <stdlib.h>\n");
00417   fprintf(file, "#include <unistd.h>\n");
00418   fprintf(file, "\n");
00419   fprintf(file, "#include \"problem.h\"\n");
00420   fprintf(file, "\n");
00421 
00422   problem_name = gs_idl_emit_fortran_ifdefs(file, problem->name, language);
00423 
00424   if(!problem_name)
00425     return -1;
00426 
00427   for(lastarg = problem->arglist; lastarg && lastarg->next;
00428       lastarg = lastarg->next)
00429     /* spin */ ;
00430 
00431   if(problem->type == GS_FUNCTION && !lastarg) {
00432     ERRPRINTF("Error: expected non-null last argument for function\n");
00433     return -1;
00434   }
00435 
00436   /* emit the prototype for the user's function that will be called */
00437 
00438   if(problem->type == GS_SUBROUTINE)
00439     fprintf(file, "extern void %s(", problem_name);
00440   else
00441     fprintf(file, "extern %s %s %s(", gs_c_datatype[lastarg->datatype],
00442             (lastarg->objecttype == GS_SCALAR) ? " " : "*", problem_name);
00443 
00444   for(argcount = 0, arg = problem->arglist; arg != NULL;
00445       arg = arg->next, argcount++) {
00446     arg->prob = problem;
00447 
00448     /* if this problem has a return value and we're on the last arg, don't
00449        emit it since it's not part of the routine's calling sequence. */
00450     if((problem->type == GS_FUNCTION) && (arg->next == NULL)) {
00451       argcount++;
00452       break;
00453     }
00454 
00455     /* if this is passed by value (i.e. a C input-only scalar argument) then
00456        do not declare as pointer in the prototype. */
00457     if(!strcasecmp(language, "C") && arg->objecttype == GS_SCALAR &&
00458        ((arg->inout == GS_IN) || (arg->inout == GS_WORKSPACE)))
00459       fprintf(file, "%s %s", gs_c_datatype[arg->datatype], arg->name);
00460     else if(arg->inout == GS_VAROUT)
00461       fprintf(file, "%s** %s", gs_c_datatype[arg->datatype], arg->name);
00462     else
00463       fprintf(file, "%s* %s", gs_c_datatype[arg->datatype], arg->name);
00464 
00465     if(problem->type == GS_FUNCTION) {
00466       if(arg->next && arg->next->next)
00467         fprintf(file, ", ");
00468     }
00469     else if(arg->next) {
00470       fprintf(file, ", ");
00471     }
00472 
00473     if((argcount % 4) == 0)
00474       fprintf(file, "\n   ");
00475   }
00476 
00477   fprintf(file, ");\n");
00478   fprintf(file, "\n");
00479 
00480   /* start emitting service routine and generate variable declarations */
00481 
00482   fprintf(file, "int gs_problem_service(gs_problem_t *problem)  /* %s */ \n",
00483           problem->name);
00484   fprintf(file, "{ \n");
00485   fprintf(file, "  gs_argument_t *arg; \n");
00486   fprintf(file, "  void *argdata[%d]; \n", argcount);
00487   fprintf(file, "  int i; \n");
00488   if(problem->type == GS_FUNCTION)
00489     fprintf(file, "  gs_argument_t *lastarg;\n");
00490   fprintf(file, "\n");
00491 
00492   if(problem->type == GS_FUNCTION)
00493     fprintf(file, "  lastarg=problem->arglist;\n");
00494 
00495   /* set up the array of arguments from the linked list */
00496 
00497   fprintf(file, "  for(arg=problem->arglist,i=0; arg!=NULL; \
00498     arg=arg->next,i++) {\n");
00499   fprintf(file, "    argdata[i] = arg->data;\n");
00500   if(problem->type == GS_FUNCTION)
00501     fprintf(file, "    if(!arg->next) lastarg = arg;\n");
00502   fprintf(file, "  }\n");
00503   fprintf(file, "\n");
00504 
00505   if((problem->type == GS_FUNCTION) && (lastarg->objecttype == GS_SCALAR))
00506     fprintf(file, "  lastarg->data = (%s*)malloc(sizeof(%s));\n",
00507             gs_c_datatype[lastarg->datatype],
00508             gs_c_datatype[lastarg->datatype]);
00509 
00510   /* now emit the call to the user's routine */
00511 
00512   if(problem->type == GS_FUNCTION) {
00513     if(lastarg->objecttype == GS_SCALAR)
00514       fprintf(file, "  *((%s*)(lastarg->data)) = %s(",
00515               gs_c_datatype[lastarg->datatype], problem_name);
00516     else
00517       fprintf(file, "  lastarg->data = %s(", problem_name);
00518   }
00519   else
00520     fprintf(file, "  %s(", problem_name);
00521 
00522   free(problem_name);
00523 
00524   for(i = 0, arg = problem->arglist; arg != NULL; arg = arg->next, i++) {
00525     char *carg;
00526 
00527     /* if this problem has a return value and we're on the last arg, don't
00528        emit it since it's not part of the routine's calling sequence. */
00529     if((problem->type == GS_FUNCTION) && (arg->next == NULL))
00530       break;
00531 
00532     carg = gs_idl_arg_name_mangle(arg, language, i);
00533 
00534     if(carg) {
00535       fprintf(file, "%s", carg);
00536       free(carg);
00537     }
00538     else {
00539       ERRPRINTF("gs_idl_arg_name_mangle failed\n");
00540       fclose(file);
00541       return -1;
00542     }
00543 
00544     if(problem->type == GS_FUNCTION) {
00545       if(arg->next && arg->next->next)
00546         fprintf(file, ", ");
00547     }
00548     else if(arg->next) {
00549       fprintf(file, ", ");
00550     }
00551 
00552     if((i % 4) == 0)
00553       fprintf(file, "\n   ");
00554   }
00555 
00556   fprintf(file, ");\n");
00557   fprintf(file, "  return 0;\n");
00558   fprintf(file, "} \n");
00559 
00560   /* Set up main program to call service_template */
00561   fprintf(file, "\n");
00562   fprintf(file, "\n");
00563   fprintf(file, "/* The service_template routine is defined in the */\n");
00564   fprintf(file, "/* problem directory and is compiled into a library */\n");
00565   fprintf(file, "/* and linked in.  It sets up some stuff, and then */\n");
00566   fprintf(file, "/* calls the gs_problem_service above */ \n");
00567   fprintf(file, "int service_template(int argc, char *argv[]); \n");
00568   fprintf(file, "\n");
00569   fprintf(file, "int gs_argc;\n");
00570   fprintf(file, "char **gs_argv;\n");
00571   fprintf(file, "\n");
00572   fprintf(file, "int main(int argc, char *argv[]) \n");
00573   fprintf(file, "{ \n");
00574   fprintf(file, "  gs_argc = argc;\n");
00575   fprintf(file, "  gs_argv = argv;\n");
00576   fprintf(file, "  return service_template(argc, argv); \n");
00577   fprintf(file, "} \n");
00578   fprintf(file, "\n");
00579 
00580   fclose(file);
00581 
00582   return 0;
00583 }
00584 
00589 int
00590 gs_emit_service_vars(FILE *file, char *bin_name, char *serv_src, char *language, 
00591   char *libs, char *service)
00592 {
00593   fprintf(file, "%s_SOURCES = %s.c\n", bin_name, serv_src);
00594   fprintf(file, "%s_LDFLAGS = \n", bin_name);
00595   fprintf(file, "%s_OBJECTS = %s.o\n", bin_name, serv_src);
00596   fprintf(file, "%s_DEPENDENCIES = \n", bin_name);
00597   fprintf(file, "%s_LDADD = -L%s/lib -l%s %s/lib/libgridsolve_infrastructure.a \
00598      $(FLIBS) $(LIBS) -lm $(IBPLIB)\n", bin_name, gridsolve_root, service,
00599      gridsolve_root);
00600   fprintf(file, "\n\n");
00601 
00602   return 0;
00603 }
00604 
00608 int
00609 gs_emit_service_link(FILE *file, char *parallel, char *language, char *pname)
00610 {
00611   if(!strcasecmp(parallel, "sequential") && !strcasecmp(language, "C"))
00612     fprintf(file, "%s_LD = $(CCLD)\n", pname);
00613   else if(!strcasecmp(parallel, "sequential")
00614           && !strcasecmp(language, "FORTRAN"))
00615     fprintf(file, "%s_LD = $(SERVICE_LINK)\n", pname);
00616   else if(!strcasecmp(parallel, "parallel") && !strcasecmp(language, "C"))
00617     fprintf(file, "%s_LD = $(MPICC)\n", pname);
00618   else if(!strcasecmp(parallel, "parallel") && !strcasecmp(language, "C"))
00619     fprintf(file, "%s_LD = $(MPIF77)\n", pname);
00620 
00621   fprintf(file, "%s_LINK = $(%s_LD) $(AM_LDFLAGS) $(LDFLAGS) -o $@\n",
00622           pname, pname);
00623   fprintf(file, "%s: $(%s_OBJECTS) $(%s_DEPENDENCIES) \n", pname, pname,
00624           pname);
00625   fprintf(file, "\t$(%s_LINK) $(%s_LDFLAGS) $(%s_OBJECTS) \
00626     $(%s_LDADD) $(LIBS) $(__USER_LIBS)\n", pname, pname, pname, pname);
00627   fprintf(file, "\n");
00628 
00629   return 0;
00630 }
00631 
00641 int
00642 gs_idl_generate_makefile(gs_problem_t * problem)
00643 {
00644   char *fname, *language, *parallel, *libs, *pname, *bname, *grpc_pname;
00645   char *submit_script, *probe_script, *cancel_script, *linker;
00646   gs_info_t *info;
00647   int batch_mode;
00648   FILE *file;
00649 
00650   submit_script = gs_problem_getinfo(problem, "BATCH_SUBMIT", NULL);
00651   probe_script = gs_problem_getinfo(problem, "BATCH_PROBE", NULL);
00652   cancel_script = gs_problem_getinfo(problem, "BATCH_CANCEL", NULL);
00653 
00654   if(submit_script && probe_script && cancel_script)
00655     batch_mode = 1;
00656   else if(!submit_script && !probe_script && !cancel_script)
00657     batch_mode = 0;
00658   else {
00659     ERRPRINTF("If using batch mode, BATCH_SUBMIT, BATCH_PROBE, and BATCH_CANCEL must all be specified.\n");
00660     return -1;
00661   }
00662 
00663   if(!problem)
00664     return -1;
00665 
00666   DBGPRINTF("Generating makefile %s\n", problem->name);
00667 
00668   language = gs_problem_getinfo(problem, "LANGUAGE", "C");
00669   parallel = gs_problem_getinfo(problem, "PARALLEL", "sequential");
00670   linker = gs_problem_getinfo(problem, "LINKER", NULL);
00671   libs = gs_problem_getinfo(problem, "LIBS", "");
00672 
00673   fname = dstring_sprintf("%s/service/%s/%s_makefile",
00674                           gridsolve_root, problem->name,
00675                           problem->name);
00676   if(!fname) {
00677     ERRPRINTF("Error generating the name of the makefile\n");
00678     return -1;
00679   }
00680 
00681   unlink(fname);
00682 
00683   if((file = fopen(fname, "w")) == NULL) {
00684     ERRPRINTF("Could not open file '%s'\n", fname);
00685     free(fname);
00686     return -1;
00687   }
00688   free(fname);
00689 
00690   pname = dstring_sprintf("%s_service", problem->name);
00691   if(!pname) {
00692     ERRPRINTF("Error generating the name of the service\n");
00693     return -1;
00694   }
00695 
00696   gs_emit_service_vars(file, pname, pname, language, libs, "gsservice_template");
00697 
00698   if(batch_mode) {
00699     bname = dstring_sprintf("%s_batch_service", problem->name);
00700     if(!bname) {
00701       ERRPRINTF("Error generating the name of the service\n");
00702       return -1;
00703     }
00704 
00705     gs_emit_service_vars(file, bname, pname, language, libs, "gsbatch_template");
00706   }
00707   else
00708     bname = "";
00709 
00710   grpc_pname = dstring_sprintf("%s_grpc_example", problem->name);
00711   if(!grpc_pname) {
00712     ERRPRINTF("Error generating the name of the service\n");
00713     free(pname);
00714     return -1;
00715   }
00716 
00717   gs_emit_service_vars(file, grpc_pname, grpc_pname, language, libs, "gsservice_template");
00718 
00719   fprintf(file, "bin_PROGRAMS = %s %s %s\n", pname, grpc_pname, bname);
00720   fprintf(file, "\n");
00721 
00722   fprintf(file, "include ../template_problem/Makefile.inc\n");
00723 
00724   for(info = problem->infolist; info != NULL; info = info->next) {
00725     if(!strcmp(info->type, "LIBS"))
00726       fprintf(file, "__USER_LIBS=%s\n", info->value);
00727     else
00728       fprintf(file, "%s=%s\n", info->type, info->value);
00729   }
00730 
00731   if(!strcmp(gridsolve_root, GRIDSOLVE_TOP_BUILD_DIR))
00732     fprintf(file, "INCLUDES = -I%s/include -I%s/include $(IBP_INCDIR)\n", GRIDSOLVE_TOP_BUILD_DIR, GRIDSOLVE_TOP_SRC_DIR);
00733   else 
00734     fprintf(file, "INCLUDES = -I%s/include $(IBP_INCDIR)\n", gridsolve_root);
00735   fprintf(file, "\n");
00736   
00737   if(linker)
00738     fprintf(file, "CCLD=%s\n", linker);
00739   
00740   gs_emit_service_link(file, parallel, language, pname);
00741   gs_emit_service_link(file, parallel, language, grpc_pname);
00742   if(batch_mode) {
00743     gs_emit_service_link(file, parallel, language, bname);
00744     fprintf(file, "gs_copy_batch_scripts:\n");
00745     fprintf(file, "\tcp %s gs_submit\n", submit_script);
00746     fprintf(file, "\tchmod u+rwx gs_submit\n");
00747     fprintf(file, "\tcp %s gs_probe\n", probe_script);
00748     fprintf(file, "\tchmod u+rwx gs_probe\n");
00749     fprintf(file, "\tcp %s gs_cancel\n", cancel_script);
00750     fprintf(file, "\tchmod u+rwx gs_cancel\n");
00751   }
00752 
00753   fprintf(file, "check_f77:\n");
00754   fprintf(file, "ifeq ($(strip $(F77)),)\n");
00755   fprintf(file, "\techo no f77\n");
00756   fprintf(file, "\texit -7\n");
00757   fprintf(file, "else\n");
00758   fprintf(file, "\texit 0\n");
00759   fprintf(file, "endif\n");
00760 
00761   free(pname);
00762   free(grpc_pname);
00763 
00764   fclose(file);
00765 
00766   return 0;
00767 }
00768 
00779 int
00780 gs_idl_generate_description(gs_problem_t * problem)
00781 {
00782   char *fname = NULL;
00783   FILE *file = NULL;
00784   char *problemstr = NULL;
00785 
00786   if(!problem)
00787     return -1;
00788 
00789   DBGPRINTF("Generating description %s\n", problem->name);
00790 
00791   fname = dstring_sprintf("%s/service/%s/%s.xml",
00792                           gridsolve_root, problem->name,
00793                           problem->name);
00794 
00795   if(!fname) {
00796     ERRPRINTF("Error generating xml service desc name.\n");
00797     return -1;
00798   }
00799 
00800   DBGPRINTF("Creating problem description in %s\n", fname);
00801   if((file = fopen(fname, "w")) == NULL) {
00802     ERRPRINTF("Error creating problem description file '%s'.\n", fname);
00803     free(fname);
00804     return -1;
00805   }
00806 
00807   free(fname);
00808 
00809   DBGPRINTF("Encoding problem to string\n");
00810   if(gs_encode_problem(&problemstr, problem) < 0) {
00811     ERRPRINTF("Failed to encode problem.\n");
00812     return -1;
00813   }
00814 
00815   DBGPRINTF("Problem description: %s\n", problemstr);
00816   fprintf(file, "%s\n", problemstr);
00817 
00818 #ifdef GS_DEBUG
00819   gs_idl_dump_info(problem, problemstr);
00820 #endif
00821 
00822   free(problemstr);
00823   fclose(file);
00824 
00825   return 0;
00826 }
00827 
00838 int
00839 gs_idl_do_make(gs_problem_t * problem, char *target)
00840 {
00841   char *command;
00842   int status;
00843 
00844   if(!problem)
00845     return -1;
00846 
00847   DBGPRINTF("Executing makefile for %s\n", problem->name);
00848 
00849   command =
00850       dstring_sprintf("cd \"%s/service/%s\"; make -f %s_makefile %s",
00851                       gridsolve_root, problem->name,
00852                       problem->name, target);
00853 
00854   if(!command) {
00855     ERRPRINTF("Error creating command to build target = '%s'\n", target);
00856     goto gs_idl_do_make_error;
00857   }
00858 
00859   DBGPRINTF("Make command: %s\n", command);
00860 
00861   status = system(command);
00862 
00863   if((status < 0) || (WEXITSTATUS(status) != 0)) {
00864     ERRPRINTF("Error building problem (%s), target = '%s'\n", command, target);
00865     goto gs_idl_do_make_error;
00866   }
00867 
00868   free(command);
00869   return 0;
00870 
00871 gs_idl_do_make_error:
00872   if(command)
00873     free(command);
00874   return -1;
00875 }
00876 
00890 int
00891 gs_idl_create_service_dir(char *suffix)
00892 {
00893   char *fname;
00894   struct stat stbuf;
00895   
00896   fname = calloc((strlen(gridsolve_root) + strlen("/service/") +
00897          + (suffix ? strlen(suffix) + 1 : 0) + 1), sizeof(char));
00898   sprintf(fname, "%s", gridsolve_root);
00899 
00900   /* if the directory doesn't exist, try to create it */
00901   if(stat(fname, &stbuf) < 0)
00902     if(mkdir(fname, 0755) < 0)
00903       return -1;
00904 
00905   sprintf(fname, "%s/service%s%s", gridsolve_root,
00906           suffix ? "/" : "", suffix ? suffix : "");
00907 
00908   /* if the directory doesn't exist, try to create it */
00909   if(stat(fname, &stbuf) < 0)
00910     if(mkdir(fname, 0755) < 0)
00911       return -1;
00912 
00913   free(fname);
00914   return 0;
00915 }
00916 
00926 int
00927 gs_idl_remove_directory(char *suffix)
00928 {
00929   char *fname;
00930   struct stat stbuf;
00931   struct dirent *dp;
00932   char *entry;
00933   DIR *dirp;
00934   int max;
00935 
00936   if(!suffix)
00937     return -1;
00938 
00939   fname = calloc((strlen(gridsolve_root) + strlen("/service/") +
00940           + (suffix ? strlen(suffix) + 1 : 0) + 1), sizeof(char));
00941   sprintf(fname, "%s", gridsolve_root);
00942 
00943   /* quick return if the root directory doesn't exist */
00944   if(stat(fname, &stbuf) < 0)
00945     return 0;
00946 
00947   sprintf(fname, "%s/service%s%s", gridsolve_root,
00948           suffix ? "/" : "", suffix ? suffix : "");
00949 
00950   /* quick return if the service directory doesn't exist */
00951   if(stat(fname, &stbuf) < 0)
00952     return 0;
00953 
00954   dirp = opendir(fname);
00955 
00956   if(!dirp)
00957     return -1;
00958 
00959   /* find the longest file name so we can allocate the proper size
00960    * array to hold the fully-qualified name.
00961    */
00962   max = 0;
00963   while ((dp = readdir(dirp)) != NULL)
00964     if(strlen(dp->d_name) > max)
00965       max = strlen(dp->d_name);
00966 
00967   rewinddir(dirp);
00968 
00969   /* now remove each file in the service directory */
00970   if(max > 0) {
00971     entry = (char *)malloc(strlen(fname) + max + 2);
00972 
00973     if(!entry) return -1;
00974 
00975     while ((dp = readdir(dirp)) != NULL)
00976     {
00977       if(strcmp(".", dp->d_name) && strcmp("..", dp->d_name))
00978       {
00979         sprintf(entry, "%s/%s", fname, dp->d_name);
00980 
00981         if(unlink(entry) < 0)
00982         {
00983           perror("unlink");
00984           free(entry);
00985           return -1;
00986         }
00987       }
00988     }
00989     free(entry);
00990   }
00991 
00992   (void)closedir(dirp);
00993 
00994   /* finally remove the service directory itself */
00995 
00996   if(rmdir(fname) < 0)
00997     return -1;
00998 
00999   free(fname);
01000   return 0;
01001 }
01002 
01014 int
01015 gs_idl_find_arg(gs_problem_t *problem, char *tag, gs_argument_t **found_arg)
01016 {
01017   gs_argument_t *f;
01018   int found = 0;
01019 
01020   for(f = problem->arglist; f; f = f->next)
01021     if(!strcmp(f->name, tag)) {
01022       found = 1;
01023       break;
01024     }
01025 
01026   *found_arg = found ? f : NULL;
01027 
01028   return found ? 0 : -1;
01029 }
01030 
01041 int
01042 gs_idl_check_dim_expr(gs_problem_t * problem, gs_argument_t *arg)
01043 {
01044   icl_list_t *vlist, *l;
01045   int errors;
01046 
01047   errors = 0;
01048 
01049   /* this list holds the names of all the variables used in
01050    * the dimension expressions.
01051    */
01052 
01053   vlist = icl_list_new();
01054 
01055   if(gs_get_var_list_from_expr(arg->rowexp, vlist) < 0) {
01056     ERRPRINTF("Failed to parse row expression '%s'\n", arg->rowexp);
01057     icl_list_destroy(vlist, free);
01058     return -1;
01059   }
01060 
01061   if(gs_get_var_list_from_expr(arg->colexp, vlist) < 0) {
01062     ERRPRINTF("Failed to parse column expression '%s'\n", arg->rowexp);
01063     icl_list_destroy(vlist, free);
01064     return -1;
01065   }
01066 
01067   for(l=icl_list_first(vlist); l!=NULL; l=icl_list_next(vlist, l)) {
01068     gs_argument_t *found_arg;
01069 
01070     if(gs_idl_find_arg(problem, (char *)l->data, &found_arg) < 0) {
01071       ERRPRINTF("Var '%s' not found. (referenced in size expr of '%s')\n",
01072         (char *)l->data, arg->name);
01073       errors++;
01074       continue;
01075     }
01076 
01077     if(found_arg->objecttype != GS_SCALAR) {
01078       ERRPRINTF("Unsupported use of non-scalar var '%s' in dim expr\n",
01079         found_arg->name);
01080       errors++;
01081       continue;
01082     }
01083 
01084     if((found_arg->datatype != GS_INT) &&
01085        (found_arg->datatype != GS_FLOAT) && 
01086        (found_arg->datatype != GS_DOUBLE) && 
01087        (found_arg->datatype != GS_CHAR))
01088     {
01089       if((found_arg->datatype == GS_SCOMPLEX) ||
01090          (found_arg->datatype == GS_DCOMPLEX))
01091         ERRPRINTF("Unsupported use of complex var '%s' in dim expr\n",
01092           found_arg->name);
01093       else
01094         ERRPRINTF("Unsupported use of non-numeric var '%s' in dim expr\n",
01095           found_arg->name);
01096 
01097       errors++;
01098       continue;
01099     }
01100 
01101     /* make sure the variables referenced in the dimension expression 
01102      * are IN or INOUT (doesn't apply to VAROUT, FILE, etc).
01103      */
01104 
01105     if((arg->inout == GS_IN) || (arg->inout == GS_INOUT) ||
01106        (arg->inout == GS_OUT) || (arg->inout == GS_WORKSPACE)) {
01107       if((found_arg->inout != GS_IN) && (found_arg->inout != GS_INOUT)) {
01108         ERRPRINTF("Var '%s' used in dim expr should be defined as IN or INOUT\n",
01109           found_arg->name);
01110         errors++;
01111       }
01112     }
01113     else if(arg->inout == GS_VAROUT) {
01114       if(found_arg->inout != GS_OUT) {
01115         ERRPRINTF("Var '%s' in dim expr of a VAROUT should be defined as OUT\n",
01116           found_arg->name);
01117         errors++;
01118       }
01119     }
01120   }
01121 
01122   icl_list_destroy(vlist, free);
01123   return errors > 0 ? -1 : 0;
01124 }
01125 
01135 int
01136 gs_idl_check_sparse_mat(gs_problem_t * problem, gs_argument_t *arg)
01137 {
01138   gs_argument_t *found_arg;
01139   int errors = 0;
01140 
01141   if(arg->inout == GS_WORKSPACE) {
01142     ERRPRINTF("WORKSPACE not yet supported for sparse matrices (%s)\n",
01143        arg->name);
01144     errors++;
01145   }
01146   else if(arg->inout == GS_VAROUT) {
01147     ERRPRINTF("VAROUT not yet supported for sparse matrices (%s)\n",
01148        arg->name);
01149     errors++;
01150   }
01151 
01152   if(gs_idl_find_arg(problem, arg->sparse_attr.nnzexp, &found_arg) < 0) {
01153     ERRPRINTF("Var '%s' not found. (referenced in NNZ expr of '%s')\n",
01154       arg->sparse_attr.nnzexp, arg->name);
01155     errors++;
01156   }
01157   else {
01158     if(found_arg->objecttype != GS_SCALAR) {
01159       ERRPRINTF("NNZ expr '%s' must be scalar. (referenced in '%s')\n",
01160         found_arg->name, arg->name);
01161       errors++;
01162     }
01163 
01164     if(found_arg->datatype != GS_INT) {
01165       ERRPRINTF("NNZ expr '%s' must be integer. (referenced in '%s')\n",
01166         found_arg->name, arg->name);
01167       errors++;
01168     }
01169 
01170     if(found_arg->inout != GS_IN) {
01171       ERRPRINTF("NNZ expr '%s' must be IN only. (referenced in '%s')\n",
01172         found_arg->name, arg->name);
01173       errors++;
01174     }
01175   }
01176 
01177   if(gs_idl_find_arg(problem, arg->sparse_attr.indices, &found_arg) < 0) {
01178     ERRPRINTF("Var '%s' not found. (referenced in IDX expr of '%s')\n",
01179       arg->sparse_attr.indices, arg->name);
01180     errors++;
01181   } 
01182   else {
01183     if(found_arg->objecttype != GS_VECTOR) {
01184       ERRPRINTF("IDX expr '%s' must be a vector. (referenced in '%s')\n",
01185         found_arg->name, arg->name);
01186       errors++;
01187     }
01188 
01189     if(found_arg->datatype != GS_INT) {
01190       ERRPRINTF("IDX expr '%s' must be integer. (referenced in '%s')\n",
01191         found_arg->name, arg->name);
01192       errors++;
01193     }
01194 
01195     if(found_arg->inout != arg->inout) {
01196       ERRPRINTF("INOUT mode of '%s' and '%s' must match.\n",
01197         found_arg->name, arg->name);
01198       errors++;
01199     }
01200   }
01201 
01202   if(gs_idl_find_arg(problem, arg->sparse_attr.pointer, &found_arg) < 0) {
01203     ERRPRINTF("Var '%s' not found. (referenced in PTR expr of '%s')\n",
01204       arg->sparse_attr.pointer, arg->name);
01205     errors++;
01206   } 
01207   else {
01208     if(found_arg->objecttype != GS_VECTOR) {
01209       ERRPRINTF("PTR expr '%s' must be a vector. (referenced in '%s')\n",
01210         found_arg->name, arg->name);
01211       errors++;
01212     }
01213 
01214     if(found_arg->datatype != GS_INT) {
01215       ERRPRINTF("PTR expr '%s' must be integer. (referenced in '%s')\n",
01216         found_arg->name, arg->name);
01217       errors++;
01218     }
01219 
01220     if(found_arg->inout != arg->inout) {
01221       ERRPRINTF("INOUT mode of '%s' and '%s' must match.\n",
01222         found_arg->name, arg->name);
01223       errors++;
01224     }
01225   }
01226 
01227   return errors > 0 ? -1 : 0;
01228 }
01229 
01238 int
01239 gs_idl_check_complexity(gs_problem_t *problem)
01240 {
01241   icl_list_t *vlist, *l;
01242   char *complexity;
01243   int errors;
01244 
01245   errors = 0;
01246 
01247   complexity = gs_problem_getinfo(problem, "COMPLEXITY", NULL);
01248 
01249   if(!complexity)
01250     return 0;
01251 
01252   /* this list holds the names of all the variables used in
01253    * the complexity expression.
01254    */
01255 
01256   vlist = icl_list_new();
01257   
01258   if(gs_get_var_list_from_expr(complexity, vlist) < 0) {
01259     ERRPRINTF("Failed to parse complexity expression '%s'\n", complexity);
01260     icl_list_destroy(vlist, free); 
01261     return -1;
01262   } 
01263   
01264   for (l=icl_list_first(vlist); l!=NULL; l=icl_list_next(vlist, l)) {
01265     gs_argument_t *found_arg;
01266     
01267     if(gs_idl_find_arg(problem, (char *)l->data, &found_arg) < 0) {
01268       ERRPRINTF("Var '%s' not found. (referenced in complexity '%s')\n",
01269         (char *)l->data, complexity); 
01270       errors++;
01271       continue;
01272     }
01273     
01274     if(found_arg->objecttype != GS_SCALAR) {
01275       ERRPRINTF("Unsupported use of non-scalar var '%s' in complexity expr\n",
01276         found_arg->name);
01277       errors++;
01278       continue;
01279     }
01280     
01281     if((found_arg->datatype != GS_INT) &&
01282        (found_arg->datatype != GS_FLOAT) &&
01283        (found_arg->datatype != GS_DOUBLE) &&
01284        (found_arg->datatype != GS_CHAR))
01285     {
01286       if((found_arg->datatype == GS_SCOMPLEX) ||
01287          (found_arg->datatype == GS_DCOMPLEX))
01288         ERRPRINTF("Unsupported use of complex var '%s' in complexity expr\n",
01289           found_arg->name);
01290       else
01291         ERRPRINTF("Unsupported use of non-numeric var '%s' in complexity expr\n",
01292           found_arg->name);
01293 
01294       errors++;
01295       continue;
01296     }
01297     
01298     if((found_arg->inout != GS_IN) && (found_arg->inout != GS_INOUT)) {
01299       ERRPRINTF("Var '%s' used in complexity expr should be IN or INOUT\n",
01300         found_arg->name); 
01301       errors++;
01302     }
01303   }
01304 
01305   icl_list_destroy(vlist, free);
01306   return errors ? -1 : 0;
01307 }
01308 
01317 int
01318 gs_idl_check_problems(gs_problem_t * problemlist)
01319 {   
01320   gs_problem_t *problem;
01321   int errors;
01322 
01323   errors = 0;
01324 
01325   if(!problemlist)
01326     return -1;
01327 
01328   for(problem = problemlist; problem != NULL; problem = problem->next) {
01329     gs_argument_t *arg;
01330 
01331     for(arg = problem->arglist; arg != NULL; arg = arg->next) {
01332       if(arg->objecttype == GS_SPARSEMATRIX) {
01333         if(gs_idl_check_sparse_mat(problem, arg) < 0)
01334           errors++;
01335       }
01336 
01337       if(gs_idl_check_dim_expr(problem, arg) < 0)
01338         errors++;
01339     }
01340 
01341     if(gs_idl_check_complexity(problem) < 0)
01342       errors++;
01343 
01344   }
01345 
01346   return errors ? -1 : 0;
01347 }
01348 
01357 int
01358 gs_idl_compile_problems(gs_problem_t * problemlist)
01359 {
01360   gs_problem_t *problem;
01361 
01362   if(!problemlist)
01363     return -1;
01364 
01365   DBGPRINTF("Compiling problemlist\n");
01366 
01367   /* create $GRIDSOLVE_ROOT/service/ */
01368   gs_idl_create_service_dir(NULL);
01369 
01370   for(problem = problemlist; problem != NULL; problem = problem->next) {
01371     /* create $GRIDSOLVE_ROOT/service/problem_name */
01372     gs_idl_create_service_dir(problem->name);
01373 
01374     if(gs_idl_generate_source(problem) < 0) {
01375       ERRPRINTF("gs_idl_generate_source failed\n");
01376       if(gs_remove_failed_service)
01377         gs_idl_remove_directory(problem->name);
01378       return -1;
01379     }
01380     if(gs_idl_generate_makefile(problem) < 0) {
01381       ERRPRINTF("gs_idl_generate_makefile failed\n");
01382       if(gs_remove_failed_service)
01383         gs_idl_remove_directory(problem->name);
01384       return -1;
01385     }
01386     if(gs_idl_generate_description(problem) < 0) {
01387       ERRPRINTF("gs_idl_generate_description failed\n");
01388       if(gs_remove_failed_service)
01389         gs_idl_remove_directory(problem->name);
01390       return -1;
01391     }
01392     if(gs_idl_generate_grpc_example(problem) < 0) {
01393       ERRPRINTF("Warning: couldn't generate example (probably non-fatal).\n");
01394     }
01395     if(gs_idl_do_make(problem, "install") < 0) {
01396       char * lang;
01397 
01398       lang = gs_problem_getinfo(problem, "LANGUAGE", NULL);
01399 
01400       if(lang && !strcmp(lang, "FORTRAN")) {
01401         if(gs_idl_do_make(problem, "check_f77") < 0) {
01402           ERRPRINTF("Build failed: probably due to lack of Fortran compiler.\n");
01403           if(gs_remove_failed_service)
01404             gs_idl_remove_directory(problem->name);
01405 
01406           /* continue to allow others to complete */
01407           continue;
01408         }
01409       }
01410 
01411       ERRPRINTF("gs_idl_do_make failed\n");
01412       if(gs_remove_failed_service)
01413         gs_idl_remove_directory(problem->name);
01414       return -1;
01415     }
01416     if(gs_problem_getinfo(problem, "BATCH_SUBMIT", NULL) &&
01417        gs_problem_getinfo(problem, "BATCH_PROBE", NULL) &&
01418        gs_problem_getinfo(problem, "BATCH_CANCEL", NULL))
01419     {
01420       if(gs_idl_do_make(problem, "gs_copy_batch_scripts") < 0) {
01421         ERRPRINTF("gs_idl_do_make failed\n");
01422         if(gs_remove_failed_service)
01423           gs_idl_remove_directory(problem->name);
01424         return -1;
01425       }
01426     }
01427   }
01428 
01429   return 0;
01430 }
01431 
01440 int
01441 gs_idl_parse_and_compile(char *idlfile)
01442 {
01443   FILE *fin = NULL;
01444   int status = -1;
01445 
01446   /* Used by the lexer and parser */
01447   extern gs_problem_t *problemp;
01448   extern int idl_parse();
01449   extern FILE *idl_in;
01450 
01451   if(!idlfile)
01452     return -1;
01453 
01454   if((fin = fopen(idlfile, "r")) == NULL) {
01455     ERRPRINTF("Could not open idl file: %s \n", idlfile);
01456     return -1;
01457   }
01458 
01459   DBGPRINTF("Calling parser\n");
01460   idl_in = fin;
01461   status = idl_parse();
01462   fclose(fin);
01463   idl_lexer_free_memory();
01464 
01465   if(status != 0)
01466     return -1;
01467 
01468   status = gs_idl_check_problems(problemp);
01469 
01470   if(status < 0) {
01471     gs_free_problem(problemp);
01472     return -1;
01473   }
01474 
01475   status = gs_idl_compile_problems(problemp);
01476 
01477   gs_free_problem(problemp);
01478 
01479   return status;
01480 }
01481 
01492 int
01493 gs_idl_dump_info(gs_problem_t * problem, char *problemstr)
01494 {
01495   if(!problem || !problemstr)
01496     return -1;
01497 
01498   DBGPRINTF("Dumping the xml\n %s\n", problemstr);
01499 
01500   return 0;
01501 }
01502 
01520 int
01521 gs_idl_compiler_parse_cmd_line(int argc, char **argv,
01522   char ***idlfiles, int *remove_failed)
01523 {
01524   int c;
01525 
01526   *remove_failed = 1;
01527 
01528   /* when making changes to the command line args, update
01529    * GS_COMPILER_USAGE_STR so the usage information is printed
01530    * correctly upon error.
01531    */
01532 
01533 #define GS_COMPILER_USAGE_STR \
01534   "Usage: GS_problem_compiler [-k] <IDL Files...>"
01535 
01536   while((c = getopt(argc,argv,"k")) != EOF) {
01537     switch(c) {
01538       case 'k':
01539         *remove_failed = 0;
01540         break;
01541       case '?':
01542         return -1;
01543         break;
01544       default:
01545         ERRPRINTF("Bad arg: '%c'.\n",c);
01546         return -1;
01547     }
01548   }
01549 
01550   *idlfiles = (char **)malloc((argc - optind + 1) * sizeof(char *));
01551 
01552   if(!*idlfiles)
01553     return -1;
01554 
01555   for (c = optind; c < argc; c++) {
01556     (*idlfiles)[c-optind] = strdup(argv[c]);
01557     if(!(*idlfiles)[c-optind])
01558       return -1;
01559   }
01560   (*idlfiles)[argc-optind] = NULL;
01561   return 0;
01562 }
01563 
01574 int
01575 main(int argc, char *argv[])
01576 {
01577   int i, failure = 0;
01578   char **idlfiles;
01579 
01580   if(gs_idl_compiler_parse_cmd_line(argc, argv, &idlfiles, 
01581       &gs_remove_failed_service) < 0) {
01582     ERRPRINTF("%s\n", GS_COMPILER_USAGE_STR);
01583     exit(EXIT_FAILURE);
01584   }
01585 
01586   if(!(gridsolve_root = getenv("GRIDSOLVE_ROOT"))) 
01587     gridsolve_root = GRIDSOLVE_TOP_BUILD_DIR;
01588 
01589   if(!gridsolve_root) {
01590     ERRPRINTF("Error: GRIDSOLVE_ROOT could not be set.  ");
01591     ERRPRINTF("Please check the environment variables.\n");
01592     exit(EXIT_FAILURE);
01593   }
01594 
01595   for(i=0;idlfiles[i];i++) {
01596     if(gs_idl_parse_and_compile(idlfiles[i]) < 0) {
01597       ERRPRINTF("Failed to compile '%s'\n", idlfiles[i]);
01598       failure = 1;
01599     }
01600   }
01601 
01602   if(failure) {
01603     ERRPRINTF("Some IDL files could not be compiled \n");
01604     ERRPRINTF("Possible problems Check the environment variables especially GRIDSOLVE_ROOT.\n");
01605     ERRPRINTF("GridSolve expects to find files in $GRIDSOLVE_ROOT/include and $GRIDSOLVE_ROOT/lib\n");
01606   }
01607 
01608   /* temporarily return SUCCESS always.  when we add the capability
01609    * to parse the enabled problems from server_config, we should
01610    * change this back so that failures are fatal.
01611    */
01612 
01613   /*  exit(failure ? EXIT_FAILURE : EXIT_SUCCESS); */
01614   exit(EXIT_SUCCESS);
01615 }