GridLAB-D: core/load.c Source File

00001 
00131 #ifdef HAVE_CONFIG_H
00132 #include "config.h"
00133 #else // not a build using automake
00134 #define DLEXT ".dll"
00135 #endif // HAVE_CONFIG_H
00136 
00137 #include <stdlib.h>
00138 #include <stdio.h>
00139 #include <string.h>
00140 #include <ctype.h>
00141 #include <float.h>
00142 #include <sys/types.h>
00143 #include <sys/stat.h>
00144 #include <math.h>
00145 #include "stream.h"
00146 
00147 /* define this to use # for comment and % for macros (the way Version 1.x works) */
00148 /* #define OLDSTYLE */
00149 
00150 #ifdef OLDSTYLE
00151 #define COMMENT "#"
00152 #define MACRO "%"
00153 #else
00154 #define COMMENT "//"
00155 #define MACRO "#"
00156 #endif
00157 
00158 #ifdef WIN32
00159 #include <process.h>
00160 typedef struct _stat STAT;
00161 #define FSTAT _fstat
00162 #define tzset _tzset
00163 #define snprintf _snprintf
00164 #else
00165 #include <unistd.h>
00166 typedef struct stat STAT;
00167 #define FSTAT fstat
00168 #endif
00169 
00170 #define QNAN (sqrt(-1)) /* used to force a quiet NAN return value for bad results */
00171 
00172 #include "complex.h"
00173 #include "object.h"
00174 #include "load.h"
00175 #include "output.h"
00176 #include "random.h"
00177 #include "convert.h"
00178 #include "schedule.h"
00179 
00180 static unsigned int linenum=1;
00181 static int include_fail = 0;
00182 static char filename[1024];
00183 static time_t modtime = 0;
00184 
00185 static char *format_object(OBJECT *obj)
00186 {
00187     static char256 buffer;
00188     strcpy(buffer,"(unidentified)");
00189     if (obj->name==NULL)
00190         sprintf(buffer,global_object_format,obj->oclass->name,obj->id);
00191     else
00192         sprintf(buffer,"%s (%s:%d)",obj->name,obj->oclass->name, obj->id);
00193     return buffer;
00194 }
00195 
00196 /* inline source code support */
00197 char code_block[65536] = "";
00198 char global_block[65536] = "";
00199 char init_block[65535] = "";
00200 int code_used = 0;
00201 
00202 /* used to track which functions are included in runtime classes */
00203 #define FN_CREATE   0x0001
00204 #define FN_INIT     0x0002
00205 #define FN_NOTIFY   0x0004
00206 #define FN_RECALC   0x0008
00207 #define FN_PRESYNC  0x0010
00208 #define FN_SYNC     0x0020
00209 #define FN_POSTSYNC 0x0040
00210 #define FN_PLC      0x0080
00211 #define FN_ISA      0x0100
00212 
00213 /* used for tracking #include directives in files */
00214 #define BUFFERSIZE (65536*1000)
00215 typedef struct s_include_list {
00216     char file[256];
00217     struct s_include_list *next;
00218 } INCLUDELIST;
00219 
00220 INCLUDELIST *include_list = NULL;
00221 INCLUDELIST *header_list = NULL;
00222 
00223 static char *forward_slashes(char *a)
00224 {
00225     static char buffer[1024];
00226     char *b=buffer;
00227     while (*a!='\0' && b<buffer+sizeof(buffer))
00228     {
00229         if (*a=='\\')
00230             *b = '/';
00231         else
00232             *b = *a;
00233         a++;
00234         b++;
00235     }
00236     *b='\0';
00237     return buffer;
00238 }
00239 
00240 /* extract parts of a filename */
00241 static void filename_parts(char *fullname, char *path, char *name, char *ext)
00242 {
00243     /* fix delimiters (result is a static copy) */
00244     char *file = forward_slashes(fullname);
00245 
00246     /* find the last delimiter */
00247     char *s = strrchr(file,'/');
00248 
00249     /* find the last dot */
00250     char *e = strrchr(file,'.');
00251 
00252     /* clear results */
00253     path[0] = name[0] = ext[0] = '\0';
00254     
00255     /* if both found but dot is before delimiter */
00256     if (e && s && e<s) 
00257         
00258         /* there is not extension */
00259         e = NULL;
00260     
00261     /* copy extension (if any) and terminate filename at dot */
00262     if (e)
00263     {
00264         strcpy(ext,e+1);
00265         *e = '\0';
00266     }
00267 
00268     /* if path is given */
00269     if (s)
00270     {
00271         /* copy name and terminate path */
00272         strcpy(name,s+1);
00273         *s = '\0';
00274 
00275         /* copy path */
00276         strcpy(path,file);
00277     }
00278 
00279     /* otherwise copy everything */
00280     else
00281         strcpy(name,file);
00282 }
00283 
00284 
00285 static int append_init(char* format,...)
00286 {
00287     static char code[1024];
00288     va_list ptr;
00289     va_start(ptr,format);
00290     vsprintf(code,format,ptr);
00291     va_end(ptr);
00292 
00293     if (strlen(init_block)+strlen(code)>sizeof(init_block))
00294     {
00295         output_fatal("insufficient buffer space to compile init code");
00296         /*  TROUBLESHOOT
00297             The loader creates a buffer in which it can temporarily hold source
00298             initialization code from your GLM file.  This error occurs when the buffer space
00299             has been exhausted.  There are only two ways to fix this problem,
00300             1) make the code smaller (which can be difficult to do), or 
00301             2) increase the buffer space (which requires a rebuild).
00302         */
00303         return 0;
00304     }
00305     strcat(init_block,code);
00306     return ++code_used;
00307 }
00308 static int append_code(char* format,...)
00309 {
00310     static char code[65536];
00311     va_list ptr;
00312     va_start(ptr,format);
00313     vsprintf(code,format,ptr);
00314     va_end(ptr);
00315 
00316     if (strlen(code_block)+strlen(code)>sizeof(code_block))
00317     {
00318         output_fatal("insufficient buffer space to compile source code");
00319         /*  TROUBLESHOOT
00320             The loader creates a buffer in which it can temporarily hold source
00321             runtime code from your GLM file.  This error occurs when the buffer space
00322             has been exhausted.  There are only two ways to fix this problem,
00323             1) make the code smaller (which can be difficult to do), or 
00324             2) increase the buffer space (which requires a rebuild).
00325         */
00326         return 0;
00327     }
00328     strcat(code_block,code);
00329     return ++code_used;
00330 }
00331 static int append_global(char* format,...)
00332 {
00333     static char code[1024];
00334     va_list ptr;
00335     va_start(ptr,format);
00336     vsprintf(code,format,ptr);
00337     va_end(ptr);
00338 
00339     if (strlen(global_block)+strlen(code)>sizeof(global_block))
00340     {
00341         output_fatal("insufficient buffer space to compile global code");
00342         /*  TROUBLESHOOT
00343             The loader creates a buffer in which it can temporarily hold source
00344             global code from your GLM file.  This error occurs when the buffer space
00345             has been exhausted.  There are only two ways to fix this problem,
00346             1) make the code smaller (which can be difficult to do), or 
00347             2) increase the buffer space (which requires a rebuild).
00348         */
00349         return 0;
00350     }
00351     strcat(global_block,code);
00352     return ++code_used;
00353 }
00354 static void mark_linex(char *filename, int linenum)
00355 {
00356     if (global_getvar("noglmrefs",NULL,0)==NULL)
00357         append_code("#line %d \"%s\"\n", linenum, forward_slashes(filename));
00358 }
00359 static void mark_line()
00360 {
00361     mark_linex(filename,linenum);
00362 }
00363 static STATUS exec(char *format,...)
00364 {
00365     char cmd[1024];
00366     va_list ptr;
00367     va_start(ptr,format);
00368     vsprintf(cmd,format,ptr);
00369     va_end(ptr);
00370     output_debug("Running '%s'", cmd);
00371     return system(cmd)==0?SUCCESS:FAILED;
00372 }
00373 
00374 static STATUS debugger(char *target)
00375 {
00376     int result;
00377     output_debug("Starting debugger");
00378 #ifdef _MSC_VER
00379 #define getpid _getpid
00380     result = exec("start %s gdb --quiet %s --pid=%d",global_gdb_window?"":"/b",target,global_process_id)>=0?SUCCESS:FAILED;
00381     system("pause");
00382 #else
00383     output_debug("Use 'dll-symbols %s' to load symbols",target);
00384     result = exec("gdb --quiet %s --pid=%d &",target,global_process_id)>=0?SUCCESS:FAILED;
00385 #endif
00386     return result;
00387 }
00388 
00389 static char *setup_class(CLASS *oclass)
00390 {
00391     static char buffer[65536] = "";
00392     int len = 0;
00393     PROPERTY *prop;
00394     len += sprintf(buffer+len,"\tOBJECT obj; obj.oclass = oclass; %s *t = (%s*)((&obj)+1);\n",oclass->name,oclass->name);
00395     //len += sprintf(buffer+len,"\tif (callback->define_map(oclass,\n");
00396     len += sprintf(buffer+len,"\toclass->size = sizeof(%s);\n", oclass->name);
00397     for (prop=oclass->pmap; prop!=NULL; prop=prop->next)
00398     {
00399         len += sprintf(buffer+len,"\t(*(callback->properties.get_property))(&obj,\"%s\")->addr = (PROPERTYADDR)((char*)&(t->%s) - (char*)t);\n",prop->name,prop->name);
00400 #ifdef NEVER
00401         if (prop->unit==NULL)
00402             len += sprintf(buffer+len,"\t\tPT_%s,\"%s\",(char*)&(t->%s)-(char*)t,\n",
00403                 class_get_property_typename(prop->ptype),prop->name,prop->name);
00404         else
00405             len += sprintf(buffer+len,"\t\tPT_%s,\"%s[%s]\",(char*)&(t->%s)-char(*)t,\n",
00406                 class_get_property_typename(prop->ptype),prop->name,prop->unit->name,prop->name);
00407         if (prop->keywords)
00408         {
00409             KEYWORD *key;
00410             for (key=prop->keywords; key!=NULL; key=key->next)
00411                 len += sprintf(buffer+len, "\t\t\tPT_KEYWORD, \"%s\", %d,\n", key->name, key->value);
00412         }
00413 #endif
00414     }
00415     //len += sprintf(buffer+len,"\t\tNULL)<1) throw(\"unable to publish properties in class %s\");\n", oclass->name);
00416     len += sprintf(buffer+len,"%s\n",init_block);
00417     return buffer;
00418 }
00419 
00420 static int outlinenum = 0;
00421 static char *outfilename = NULL;
00422 static int write_file(FILE *fp, char *data, ...)
00423 {
00424     char buffer[65536];
00425     char *c, *d=buffer;
00426     int len=0;
00427     int diff = 0;
00428     char *b;
00429     va_list ptr;
00430     va_start(ptr,data);
00431     vsprintf(buffer,data,ptr);
00432     va_end(ptr);
00433     while ((c=strstr(d,"/*RESETLINE*/\n"))!=NULL)
00434     {
00435         for (b=d; b<c; b++)
00436         {
00437             if (*b=='\n')
00438                 outlinenum++;
00439             fputc(*b,fp);
00440             diff++;
00441             len++;
00442         }
00443         d =  c + strlen("/*RESETLINE*/\n");
00444         if (global_getvar("noglmrefs",NULL,0)==NULL)
00445             len += fprintf(fp,"#line %d \"%s\"\n", ++outlinenum+1,forward_slashes(outfilename));
00446     }
00447     for (b=d; *b!='\0'; b++)
00448     {
00449         if (*b=='\n')
00450             outlinenum++;
00451         fputc(*b,fp);
00452         len++;
00453     }
00454     return len;
00455 }
00456 static void reset_line(FILE *fp, char *file)
00457 {
00458     if (global_getvar("noglmrefs",NULL,0)==NULL)
00459         write_file(fp,"#line %s \"%s\"\n", outlinenum,forward_slashes(file));
00460 }
00461 
00462 static STATUS compile_code(CLASS *oclass, int64 functions)
00463 {
00464     char include_file_str[1024];
00465     bool use_msvc = (global_getvar("use_msvc",NULL,0)!=NULL);
00466 
00467     include_file_str[0] = '\0';
00468 
00469     /* check global_include */
00470     if (strlen(global_include)==0)
00471     {
00472         if (getenv("GRIDLABD"))
00473         {
00474             strncpy(global_include,getenv("GRIDLABD"),sizeof(global_include));
00475             output_verbose("global_include is not set, assuming value of GRIDLABD variable '%s'", global_include);
00476         }
00477         else
00478         {
00479             output_error("'include' variable is not set and neither is GRIDLABD environment, compiler cannot proceed without a way to find rt/gridlabd.h");
00480             /* TROUBLESHOOT
00481                 The runtime class compiler needs to find the file rt/gridlabd.h and uses either the <i>include<i> global variable or the <b>gridlabd</b> 
00482                 environment variable to find it.  Check the definition of the <b>gridlabd</b> environment variable or use the 
00483                 <code>#define include=<i>path</i></code> to specify the path to the <code>rt/gridlabd.h<code>.
00484              */
00485             return FAILED;
00486         }
00487     }
00488 
00489     if (code_used>0)
00490     {
00491         MODULE *mod;
00492 
00493         FILE *fp;
00494         STAT stat;
00495         int outdated = true;
00496         char cfile[1024];
00497         char ofile[1024];
00498         char afile[1024];
00499         char file[1024];
00500         char tmp[1024];
00501         size_t ifs_off = 0;
00502         INCLUDELIST *lptr = 0;
00503 
00504         /* build class implementation files */
00505         global_getvar("tmp",tmp,sizeof(tmp));
00506         if (strlen(tmp)>0 && tmp[strlen(tmp)-1]!='/' && tmp[strlen(tmp)-1]!='\\')
00507             strcat(tmp,"/");
00508         sprintf(cfile,"%s%s.cpp", (use_msvc||global_gdb||global_gdb_window)?"":tmp,oclass->name);
00509         sprintf(ofile,"%s%s.o", (use_msvc||global_gdb||global_gdb_window)?"":tmp,oclass->name);
00510         sprintf(file,"%s%s", (use_msvc||global_gdb||global_gdb_window)?"":tmp, oclass->name);
00511         sprintf(afile, "%s" DLEXT , oclass->name);
00512 
00513         /* peek at library file */
00514         fp = fopen(afile,"r");
00515         if (fp!=NULL && FSTAT(fileno(fp),&stat)==0)
00516         {
00517             if (global_gdb || global_gdb_window )
00518             {
00519                 output_verbose("%s is being used for debugging", afile);
00520             }
00521             else if (global_force_compile)
00522                 output_verbose("%s recompile is forced", afile);
00523             else if (modtime<stat.st_mtime)
00524             {
00525                 output_verbose("%s is up to date", afile);
00526                 outdated = false;
00527             }
00528             else
00529                 output_verbose("%s is outdated", afile);
00530             fclose(fp);
00531         }
00532         
00533         if (outdated)
00534         {
00535             /* write source file */
00536             fp = fopen(cfile,"w");
00537 
00538             output_verbose("writing inline code to '%s'", cfile);
00539             if (fp==NULL)
00540             {
00541                 output_fatal("unable to open '%s' for writing", cfile);
00542                 /*  TROUBLESHOOT
00543                     The internal compiler cannot write a temporary C or C++ that
00544                     it needs to build your model.  The message indicates where
00545                     the file is.  To remedy the problem you must make sure that
00546                     the system allows full access to the file.
00547                  */
00548                 return FAILED;
00549             }
00550             outfilename = cfile;
00551             ifs_off = 0;
00552             for(lptr = header_list; lptr != 0; lptr = lptr->next){
00553                 sprintf(include_file_str+ifs_off, "#include \"%s\"\n;", lptr->file);
00554                 ifs_off+=strlen(lptr->file)+13;
00555             }
00556             if (write_file(fp,"/* automatically generated from GridLAB-D */\n\n"
00557                     "int major=0, minor=0;\n\n"
00558                     "%s\n\n"
00559                     "#include \"rt/gridlabd.h\"\n\n"
00560                     "%s"
00561                     "CALLBACKS *callback = NULL;\n"
00562                     "static CLASS *myclass = NULL;\n"
00563                     "static int setup_class(CLASS *);\n\n",
00564                     include_file_str,
00565                     global_getvar("use_msvc",NULL,0)!=NULL
00566                     ?
00567                         "int __declspec(dllexport) dllinit() { return 0;};\n"
00568                         "int __declspec(dllexport) dllkill() { return 0;};\n"
00569                     :
00570                         "extern \"C\" int dllinit() __attribute__((constructor));\n"
00571                         "extern \"C\" int dllinit() { return 0;}\n"
00572                         "extern \"C\"  int dllkill() __attribute__((destructor));\n"
00573                         "extern \"C\" int dllkill() { return 0;};\n\n"
00574                     )<0
00575                 || write_file(fp,"extern \"C\" CLASS *init(CALLBACKS *fntable, MODULE *module, int argc, char *argv[])\n"
00576                     "{\n"
00577                     "\tcallback=fntable;\n"
00578                     "\tmyclass=(CLASS*)((*(callback->class_getname))(\"%s\"));\n"
00579                     "\tif (!setup_class(myclass)) return NULL;\n"
00580                     "\treturn myclass;"
00581                     "}\n",oclass->name)<0
00582                 || write_file(fp,"%s",code_block)<0 
00583                 || write_file(fp,"%s",global_block)<0
00584                 || write_file(fp,"static int setup_class(CLASS *oclass)\n"
00585                     "{\t\n%s\treturn 1;\n}\n",setup_class(oclass))<0 
00586                 )
00587             {
00588                 output_fatal("unable to write to '%s'", cfile);
00589                 /*  TROUBLESHOOT
00590                     The internal compiler cannot write a temporary C or C++ that
00591                     it needs to build your model.  The message indicates where
00592                     the file is.  To remedy the problem you must make sure that
00593                     the system allows full access to the file.
00594                  */
00595                 return FAILED;
00596             }
00597             fclose(fp);
00598             outfilename=NULL;
00599 
00600             /* compile object file */
00601             output_verbose("compiling inline code from '%s'", cfile);
00602             output_debug("PATH=%s", getenv("PATH"));
00603             output_debug("INCLUDE=%s", getenv("INCLUDE"));
00604             output_debug("LIB=%s", getenv("LIB"));
00605             if (!use_msvc)
00606             {
00607 #ifdef WIN32
00608 #define EXTRA_CXXFLAGS ""
00609 #else
00610 #define EXTRA_CXXFLAGS "-fPIC"
00611 #endif
00612 
00613                 char execstr[1024];
00614                 char exportsyms[64]="-export-all-symbols";
00615 
00616                 /* Mac OS X uses different exportsyms command */
00617                 if (strcmp(DLEXT,".dylib")==0)
00618                     strcpy(exportsyms,"-dynamiclib");
00619                 
00620                 sprintf(execstr, "%s %s %s -I \"%s\" -c \"%s\" -o \"%s\"", getenv("CXX")?getenv("CXX"):"g++", getenv("CXXFLAGS")?getenv("CXXFLAGS"):EXTRA_CXXFLAGS, global_debug_output?"-g -O0":"", global_include, cfile, ofile);
00621                 output_verbose("compile string: \"%s\"", execstr);
00622                 //if (exec("g++ %s -I\"%s\" -c \"%s\" -o \"%s\"", global_debug_output?"-g -O0":"", global_include, cfile, ofile)==FAILED)
00623                 if(exec(execstr)==FAILED)
00624                     return FAILED;
00625                 if (!(global_gdb||global_gdb_window))
00626                     unlink(cfile);
00627 
00628 
00629                 /* link new runtime module */
00630                 output_verbose("linking inline code from '%s'", ofile);
00631                 if (exec("%s %s %s %s -shared -Wl,%s -o %s -lstdc++", getenv("CXX")?getenv("CXX"):"g++" , getenv("LDFLAGS")?getenv("LDFLAGS"):EXTRA_CXXFLAGS, global_debug_output?"-g -O0":"", exportsyms, ofile,afile)==FAILED)
00632                     return FAILED;
00633                 unlink(ofile);
00634             }
00635             else
00636             {
00637                 char exports[1024] = "/EXPORT:init ";
00638 
00639                 sprintf(exports+strlen(exports),"/EXPORT:create_%s ",oclass->name); /* create is required */
00640                 if (functions&FN_INIT) sprintf(exports+strlen(exports),"/EXPORT:init_%s ",oclass->name);
00641                 if (functions&FN_PRESYNC || functions&FN_SYNC || functions&FN_POSTSYNC) sprintf(exports+strlen(exports),"/EXPORT:sync_%s ",oclass->name);
00642                 if (functions&FN_ISA) sprintf(exports+strlen(exports),"/EXPORT:isa_%s ",oclass->name);
00643                 if (functions&FN_NOTIFY) sprintf(exports+strlen(exports),"/EXPORT:notify_%s ",oclass->name);
00644                 if (functions&FN_PLC) sprintf(exports+strlen(exports),"/EXPORT:plc_%s ",oclass->name);
00645                 if (functions&FN_RECALC) sprintf(exports+strlen(exports),"/EXPORT:recalc_%s ",oclass->name);
00646 
00647                 // /Od /I "..\core" /I "..\third_party\cppunit-1.12.0\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_USRDLL" /D "_CRT_SECURE_NO_DEPRECATE" 
00648                 // /D "_TESTING" /D "_WINDLL" /D "_MBCS" /Gm /EHsc /RTC1 /MDd /Fo"Win32\Debug\powerflow\\" 
00649                 // /Fd"Win32\Debug\powerflow\vc80.pdb" /W3 /nologo /c /Wp64 /ZI /TP /wd4996 /errorReport:prompt
00650                 if (exec("cl /Od /DWIN32 /D_DEBUG /D_WINDOWS /D_USRDLL /D_CRT_SECURE_NO_DEPRECATE /D_WINDLL /D_MBCS /Gm /EHsc /RTC1 "
00651                     "/MDd /nologo /W3 /Zi /TP /wd4996 /errorReport:prompt %s%s%s /c /Fo%s %s"
00652                     "", strlen(global_include)>0?"/I \"":"", global_include, strlen(global_include)>0?"\"":"", file, cfile)==FAILED)
00653                     return FAILED;
00654 
00655                 // /OUT:"Win32\Debug\powerflow.dll" /INCREMENTAL /NOLOGO /LIBPATH:"Win32\Debug" /DLL /MANIFEST 
00656                 // /MANIFESTFILE:"Win32\Debug\powerflow\powerflow.dll.intermediate.manifest" /DEBUG 
00657                 // /PDB:"c:\Projects\GridLAB-D\trunk\source\VS2005\Win32\Debug\powerflow.pdb" /SUBSYSTEM:WINDOWS 
00658                 // /MACHINE:X86 /ERRORREPORT:PROMPT cppunitd.lib  kernel32.lib user32.lib gdi32.lib winspool.lib 
00659                 // comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib
00660                 if (exec("link %s /OUT:%s /NOLOGO /LIBPATH:. /DLL /MANIFEST /MANIFESTFILE:%s.manifest "
00661                     "/DEBUG /SUBSYSTEM:WINDOWS /MACHINE:X86 /ERRORREPORT:PROMPT "
00662                     "%s "
00663                     "kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib "
00664                     "uuid.lib odbc32.lib odbccp32.lib", file,afile,oclass->name,exports)==FAILED)
00665                     return FAILED;
00666             }
00667 
00668         }
00669 
00670         /* load runtime module */
00671         output_verbose("loading dynamic link library %s...", afile);
00672         mod = module_load(oclass->name,0,NULL);
00673         if (mod==NULL)
00674         {
00675             output_error("unable to load inline code");
00676             return FAILED;
00677         }
00678         oclass->module = mod;
00679 
00680         /* start debugger if requested */
00681         if (global_gdb || global_gdb_window)
00682         {
00683             if (global_debug_mode)
00684                 output_debug("using gdb requires GLD debugger be disabled");
00685             global_debug_output = 1;
00686             output_verbose("attaching debugger to process id %d", getpid());
00687             if (debugger(afile)==FAILED)
00688             {
00689                 output_error("debugger load failed: %s", errno?strerror(errno):"(no details)");
00690                 return FAILED;
00691             }
00692         }
00693 
00694         /* provide info so external debugger can be attached */
00695         else
00696             output_debug("class %s running in process %d", oclass->name, getpid());
00697 
00698     }
00699     return SUCCESS;
00700 }
00701 
00702 
00703 static OBJECT **object_index = NULL;
00704 static unsigned char *object_linked = NULL;
00705 static unsigned int object_index_size = 65536;
00706 /*static*/ STATUS load_set_index(OBJECT *obj, OBJECTNUM id)
00707 {
00708     if (object_index==NULL)
00709     {
00710         object_index = malloc(sizeof(OBJECT*)*object_index_size);
00711         memset(object_index,0,sizeof(OBJECT*)*object_index_size);
00712         object_linked = malloc(sizeof(unsigned char)*object_index_size);
00713         memset(object_linked,0,sizeof(unsigned char)*object_index_size);
00714     }
00715     if (id>=object_index_size) /* index needs to grow */
00716     {
00717         int new_size = (id/object_index_size+1)*object_index_size;
00718         object_index = realloc(object_index,sizeof(OBJECT*)*new_size);
00719 //      memset(object_index+object_index_size*sizeof(OBJECT *),0,sizeof(OBJECT*)*(new_size-object_index_size));
00720         object_linked = realloc(object_linked,sizeof(unsigned char)*new_size);
00721 //      memset(object_linked+object_index_size*sizeof(unsigned char),0,sizeof(unsigned char)*(new_size-object_index_size));
00722         object_index_size = new_size;
00723     }
00724     if (object_index==NULL) { errno = ENOMEM; return FAILED;}
00725     /* collision check here */
00726     object_index[id] = obj;
00727     object_linked[id] = 0;
00728     return SUCCESS;
00729 }
00730 /*static*/ OBJECT *load_get_index(OBJECTNUM id)
00731 {
00732     if (object_index==NULL || id<0 || id>=object_index_size)
00733         return NULL;
00734     object_linked[id]++;
00735     return object_index[id];
00736 }
00737 static OBJECT *get_next_unlinked(CLASS *oclass)
00738 {
00739     unsigned int id;
00740     if (object_index==NULL)
00741         return NULL;
00742     for (id=0; id<object_index_size; id++)
00743     {
00744         if (object_linked[id]==0 && object_index[id]!=NULL && object_index[id]->oclass==oclass)
00745         {
00746             object_linked[id]++;
00747             return object_index[id];
00748         }
00749     }
00750     return NULL;
00751 }
00752 static void free_index(void)
00753 {
00754     if (object_index!=NULL)
00755         free(object_index);
00756     object_index=NULL;
00757     object_index_size = 65536;
00758 }
00759 
00760 static UNRESOLVED *first_unresolved = NULL;
00761 /*static*/ UNRESOLVED *add_unresolved(OBJECT *by, PROPERTYTYPE ptype, void *ref, CLASS *oclass, char *id, char *file, unsigned int line, int flags)
00762 {
00763     UNRESOLVED *item = malloc(sizeof(UNRESOLVED));
00764     if (item==NULL) { errno = ENOMEM; return NULL; }
00765     item->by = by;
00766     item->ptype = ptype;
00767     item->ref = ref;
00768     item->oclass = oclass;
00769     strncpy(item->id,id,sizeof(item->id));
00770     if (first_unresolved!=NULL && strcmp(first_unresolved->file,file)==0)
00771     {
00772         item->file = first_unresolved->file; // means keep using the same file
00773         first_unresolved->file = NULL;
00774     }
00775     else
00776     {
00777         item->file = (char*)malloc(strlen(file)+1);
00778         strcpy(item->file,file);
00779     }
00780     item->line = line;
00781     item->next = first_unresolved;
00782     item->flags = flags;
00783     first_unresolved = item;
00784     return item;
00785 }
00786 static int resolve_object(UNRESOLVED *item, char *filename)
00787 {
00788     OBJECT *obj;
00789     char classname[65];
00790     char propname[65];
00791     OBJECTNUM id = 0;
00792     char op[2];
00793     char star;
00794 
00795     if(0 == strcmp(item->id, "root"))
00796         obj = NULL;
00797     else if (sscanf(item->id,"%64[^.].%64[^:]:",classname,propname)==2)
00798     {
00799         char *value = strchr(item->id,':');
00800         FINDLIST *match;
00801         if (value++==NULL)
00802         {
00803             output_error_raw("%s(%d): %s reference to %s is missing match value", filename, item->line,
00804                 format_object(item->by), item->id);
00805             return FAILED;
00806         }
00807         match = find_objects(FL_NEW,FT_CLASS,SAME,classname,AND,FT_PROPERTY,propname,SAME,value,FT_END);
00808         if (match==NULL || match->hit_count==0)
00809         {
00810             output_error_raw("%s(%d): %s reference to %s does not match any existing objects", filename, item->line,
00811                 format_object(item->by), item->id);
00812             return FAILED;
00813         }
00814         else if (match->hit_count>1)
00815         {
00816             output_error_raw("%s(%d): %s reference to %s matches more than one object", filename, item->line,
00817                 format_object(item->by), item->id);
00818             return FAILED;
00819         }
00820         obj=find_first(match);
00821     }
00822     else if (sscanf(item->id,"%[^:]:id%[+-]%d",classname,op,&id)==3)
00823     {
00824         CLASS *oclass = class_get_class_from_classname(classname);
00825         obj = object_find_by_id(item->by->id + (op[0]=='+'?+1:-1)*id);
00826         if (obj==NULL)
00827         {
00828             output_error_raw("%s(%d): unable resolve reference from %s to %s", filename, item->line,
00829                 format_object(item->by), item->id);
00830             return FAILED;
00831         }
00832     }
00833     else if (sscanf(item->id,global_object_scan,classname,&id)==2)
00834     {
00835         obj = load_get_index(id);
00836         if (obj==NULL)
00837         {
00838             output_error_raw("%s(%d): unable resolve reference from %s to %s", filename, item->line,
00839                 format_object(item->by), item->id);
00840             return FAILED;
00841         }
00842         if ((strcmp(obj->oclass->name,classname)!=0) && (strcmp("id", classname) != 0))
00843         { /* "id:###" is our wildcard.  some converters use it for dangerous simplicity. -mh */
00844             output_error_raw("%s(%d): class of reference from %s to %s mismatched", filename, item->line,
00845                 format_object(item->by), item->id);
00846             return FAILED;
00847         }
00848     }
00849     else if (sscanf(item->id,"%[^:]:%c",classname,&star)==2 && star=='*')
00850     {
00851         CLASS *oclass = class_get_class_from_classname(classname);
00852         obj = get_next_unlinked(oclass);
00853         if (obj==NULL)
00854         {
00855             output_error_raw("%s(%d): unable resolve reference from %s to %s", filename, item->line,
00856                 format_object(item->by), item->id);
00857             return FAILED;
00858         }
00859     }
00860     else if ((obj=object_find_name(item->id))!=NULL)
00861     {
00862         /* found it already*/
00863     }
00864     else
00865     {
00866         output_error_raw("%s(%d): '%s' not found", filename, item->line, item->id);
00867         return FAILED;
00868     }
00869     *(OBJECT**)(item->ref) = obj;
00870     if ((item->flags&UR_RANKS)==UR_RANKS)
00871         object_set_rank(obj,item->by->rank);
00872     return SUCCESS;
00873 }
00874 static int resolve_double(UNRESOLVED *item, char *context)
00875 {
00876     FULLNAME oname;
00877     PROPERTYNAME pname;
00878     char *filename = (item->file ? item->file : context);
00879 
00880     if (sscanf(item->id,"%64[^.].%64s",oname,pname)==2)
00881     {
00882         OBJECT *obj = NULL;
00883         PROPERTY *prop = NULL;
00884         double **ref = NULL;
00885         SCHEDULEXFORM *xform = NULL;
00886 
00887         /* get and check the object */
00888         obj = object_find_name(oname);
00889         if (obj==NULL)
00890         {
00891             output_error_raw("%s(%d): object '%s' not found", filename, item->line, oname);
00892             return FAILED;
00893         }
00894 
00895         /* get and check the property */
00896         prop = object_get_property(obj,pname);
00897         if (prop==NULL)
00898         {
00899             output_error_raw("%s(%d): property '%s' not found", filename, item->line, pname);
00900             return FAILED;
00901         }
00902 
00903         /* get transform reference */
00904         if ((item->flags&UR_TRANSFORM)==UR_TRANSFORM)
00905         {
00906             /* find transform that uses this target */
00907             while ((xform=scheduletransform_getnext(xform))!=NULL)
00908             {
00909                 /* the reference is to the schedule's source */
00910                 if (xform==item->ref)
00911                 {
00912                     ref = &(xform->source);
00913                     break;
00914                 }
00915             }
00916         }
00917 
00918         /* get the direct reference */
00919         else
00920             ref = (double**)(item->ref);
00921         
00922         /* extract the reference to the object property */
00923         switch (prop->ptype) {
00924         case PT_double:
00925             *ref = object_get_double(obj,prop);
00926             if (xform) xform->source_type = XS_DOUBLE;
00927             break;
00928         case PT_complex:
00929             *ref = &(((complex*)object_get_addr(obj,prop->name))->r);
00930             if (xform) xform->source_type = XS_COMPLEX;
00931             break;
00932         case PT_loadshape:
00933             *ref = &(((loadshape*)object_get_addr(obj,prop->name))->load);
00934             if (xform) xform->source_type = XS_LOADSHAPE;
00935             break;
00936         case PT_enduse:
00937             *ref = &(((enduse*)object_get_addr(obj,prop->name))->total.r);
00938             if (xform) xform->source_type = XS_ENDUSE;
00939             break;
00940         default:
00941             output_error_raw("%s(%d): reference '%s' type is not supported", filename, item->line, item->id);
00942             return FAILED;
00943         }
00944 
00945         output_debug("reference '%s' resolved ok", item->id);
00946 
00947         return SUCCESS;
00948     }
00949     return FAILED;
00950 }
00951 
00952 static int resolve_list(UNRESOLVED *item)
00953 {
00954     UNRESOLVED *next;
00955     char *filename = NULL;
00956     while (item!=NULL)
00957     {   
00958         // context file name changes
00959         if (item->file!=NULL)
00960         {
00961             // free last context file name
00962             if (filename!=NULL)
00963                 free(filename); // last one - not used again
00964 
00965             // get next context file name
00966             filename = item->file;
00967         }
00968 
00969         // handle different reference types
00970         switch (item->ptype) {
00971         case PT_object:
00972             if (resolve_object(item, filename)==FAILED)
00973                 return FAILED;
00974             break;
00975         case PT_double:
00976         case PT_complex:
00977         case PT_loadshape:
00978         case PT_enduse:
00979             if (resolve_double(item, filename)==FAILED)
00980                 return FAILED;
00981             break;
00982         default:
00983             output_error_raw("%s(%d): unresolved reference to property '%s' uses unsupported type (ptype=%d)", filename, item->line, item->id, item->ptype);
00984             break;
00985         }
00986         next = item->next;
00987         free(item);
00988         item=next;
00989     }
00990     return SUCCESS;
00991 }
00992 /*static*/ int load_resolve_all()
00993 {
00994     return resolve_list(first_unresolved);
00995 }
00996 
00997 #define PARSER char *_p
00998 #define START int _mm=0, _m=0, _n=0, _l=linenum;
00999 #define ACCEPT { _n+=_m; _p+=_m; _m=0; }
01000 #define HERE (_p+_m)
01001 #define OR {_m=0;}
01002 #define REJECT { linenum=_l; return 0; }
01003 //#define WHITE (_m+=white(HERE))
01004 #define WHITE (TERM(white(HERE)))
01005 #define LITERAL(X) (_mm=literal(HERE,(X)),_m+=_mm,_mm>0)
01006 #define TERM(X) (_mm=(X),_m+=_mm,_mm>0)
01007 #define COPY(X) {size--; (X)[_n++]=*_p++;}
01008 #define DONE return _n;
01009 #define BEGIN_REPEAT {char *__p=_p; int __mm=_mm, __m=_m, __n=_n, __l=_l; int __ln=linenum;
01010 #define REPEAT _p=__p;_m=__m; _mm=__mm; _n=__n; _l=__l; linenum=__ln;
01011 #define END_REPEAT }
01012 
01013 static void syntax_error(char *p)
01014 {
01015     char context[16], *nl;
01016     strncpy(context,p,15);
01017     nl = strchr(context,'\n');
01018     if (nl!=NULL) *nl='\0'; else context[15]='\0';
01019     if (strlen(context)>0)
01020         output_error_raw("%s(%d): syntax error at '%s...'", filename, linenum, context);
01021     else
01022         output_error_raw("%s(%d): syntax error", filename, linenum);
01023 }
01024 
01025 static int white(PARSER)
01026 {
01027     int len = 0;
01028     for(len = 0; *_p != '\0' && isspace((unsigned char)(*_p)); ++_p){
01029         if (*_p == '\n')
01030             ++linenum;
01031         ++len;
01032     }
01033     return len;
01034 }
01035 
01036 
01037 static int comment(PARSER)
01038 {
01039     int _n = white(_p);
01040     if (_p[_n]=='#')
01041     {
01042         while (_p[_n]!='\n')
01043             _n++;
01044         linenum++;
01045     }
01046     return _n;
01047 }
01048 
01049 static int pattern(PARSER, char *pattern, char *result, int size)
01050 {
01051     char format[64];
01052     START;
01053     sprintf(format,"%%%s",pattern);
01054     if (sscanf(_p,format,result)==1)
01055         _n = (int)strlen(result);
01056     DONE;
01057 }
01058 
01059 static int scan(PARSER, char *format, char *result, int size)
01060 {
01061     START;
01062     if (sscanf(_p,format,result)==1)
01063         _n = (int)strlen(result);
01064     DONE;
01065 }
01066 
01067 static int literal(PARSER, char *text)
01068 {
01069     if (strncmp(_p,text,strlen(text))==0)
01070         return (int)strlen(text);
01071     return 0;
01072 }
01073 
01074 static int dashed_name(PARSER, char *result, int size)
01075 {   /* basic name */
01076     START;
01077     /* names cannot start with a digit */
01078     if (isdigit(*_p)) return 0;
01079     while (size>1 && isalpha(*_p) || isdigit(*_p) || *_p=='_' || *_p=='-') COPY(result);
01080     result[_n]='\0';
01081     DONE;
01082 }
01083 
01084 static int name(PARSER, char *result, int size)
01085 {   /* basic name */
01086     START;
01087     /* names cannot start with a digit */
01088     if (isdigit(*_p)) return 0;
01089     while (size>1 && isalpha(*_p) || isdigit(*_p) || *_p=='_') COPY(result);
01090     result[_n]='\0';
01091     DONE;
01092 }
01093 
01094 static int unitspec(PARSER, UNIT **unit)
01095 {
01096     char result[1024];
01097     int size=sizeof(result);
01098     START;
01099     while (size>1 && isalpha(*_p) || isdigit(*_p) || *_p=='$' || *_p=='%' || *_p=='*' || *_p=='/' || *_p=='^') COPY(result);
01100     result[_n]='\0';
01101     TRY {
01102         if ((*unit=unit_find(result))==NULL)
01103             REJECT
01104         else
01105             return (int)strlen(result);
01106     }
01107     CATCH (char *msg) {
01108         REJECT;
01109     }
01110     ENDCATCH
01111     DONE;
01112 }
01113 
01114 static int unitsuffix(PARSER, UNIT **unit)
01115 {
01116     START;
01117     if (LITERAL("["))
01118     {
01119         if (!TERM(unitspec(HERE,unit)))
01120         {
01121             output_error_raw("%s(%d): missing valid unit after [", filename, linenum);
01122             REJECT;
01123         }
01124         if (!LITERAL("]"))
01125         {
01126             output_error_raw("%s(%d): missing ] after unit '%s'", filename, linenum,(*unit)->name);
01127         }
01128         ACCEPT;
01129         DONE;
01130     }
01131     REJECT;
01132     DONE;
01133 }
01134 
01135 static int nameunit(PARSER,char *result,int size,UNIT **unit)
01136 {
01137     START;
01138     if (TERM(name(HERE,result,size)) && TERM(unitsuffix(HERE,unit))) ACCEPT; DONE;
01139     REJECT;
01140 }
01141 
01142 static int dotted_name(PARSER, char *result, int size)
01143 {   /* basic name */
01144     START;
01145     while (size>1 && isalpha(*_p) || isdigit(*_p) || *_p=='_' || *_p=='.') COPY(result);
01146     result[_n]='\0';
01147     DONE;
01148 }
01149 
01150 static int delim_value(PARSER, char *result, int size, char *delims)
01151 {
01152     /* everything to any of delims */
01153     int quote=0;
01154     char *start=_p;
01155     START;
01156     if (*_p=='"')
01157     {
01158         quote=1;
01159         *_p++;
01160         size--;
01161     }
01162     while (size>1 && *_p!='\0' && ((quote&&*_p!='"') || strchr(delims,*_p)==NULL) && *_p!='\n') COPY(result);
01163     result[_n]='\0';
01164     return (int)(_p - start);
01165 }
01166 static int value(PARSER, char *result, int size)
01167 {
01168     /* everything to a semicolon */
01169     char delim=';';
01170     char *start=_p;
01171     int quote=0;
01172     START;
01173     while (size>1 && *_p!='\0' && !(*_p==delim && quote == 0) && *_p!='\n') 
01174     {
01175         if (*_p=='"')
01176         {
01177             *_p++;
01178             size--;
01179             quote = (1+quote) % 2;
01180         }
01181         else
01182             COPY(result);
01183     }
01184     result[_n]='\0';
01185     if (quote&1)
01186         output_warning("%s(%d): missing closing double quote", filename, linenum);
01187     return (int)(_p - start);
01188 }
01189 
01190 #if 0
01191 static int functional_int(PARSER, int64 *value){
01192     char result[256];
01193     int size=sizeof(result);
01194     double pValue;
01195     char32 fname;
01196     START;
01197 //  while (size>1 && isdigit(*_p)) COPY(result);
01198 //  result[_n]='\0';
01199 //  *value=atoi64(result);
01200     /* copy-pasted from functional */
01201     if (LITERAL("random.") && TERM(name(HERE,fname,sizeof(fname))))
01202     {
01203         RANDOMTYPE rtype = random_type(fname);
01204         int nargs = random_nargs(fname);
01205         double a;
01206         if (rtype==RT_INVALID || nargs==0 || (WHITE,!LITERAL("(")))
01207         {
01208             output_message("%s(%d): %s is not a valid random distribution", filename,linenum,fname);
01209             REJECT;
01210         }
01211         if (nargs==-1)
01212         {
01213             if (WHITE,TERM(real_value(HERE,&a)))
01214             {
01215                 double b[1024];
01216                 int maxb = sizeof(b)/sizeof(b[0]);
01217                 int n;
01218                 b[0] = a;
01219                 for (n=1; n<maxb && (WHITE,LITERAL(",")); n++)
01220                 {
01221                     if (WHITE,TERM(real_value(HERE,&b[n])))
01222                         continue;
01223                     else
01224                     {
01225                         // variable arg list
01226                         output_message("%s(%d): expected a %s distribution term after ,", filename,linenum, fname);
01227                         REJECT;
01228                     }
01229                 }
01230                 if (WHITE,LITERAL(")"))
01231                 {
01232                     pValue = random_value(rtype,n,b);
01233                     ACCEPT;
01234                 }
01235                 else
01236                 {
01237                     output_message("%s(%d): missing ) after %s distribution terms", filename,linenum, fname);
01238                     REJECT;
01239                 }
01240             }
01241             else
01242             {
01243                 output_message("%s(%d): expected first term of %s distribution", filename,linenum, fname);
01244                 REJECT;
01245             }
01246         }
01247         else 
01248         {
01249             if (WHITE,TERM(real_value(HERE,&a)))
01250             {
01251                 // fixed arg list
01252                 double b,c;
01253                 if (nargs==1)
01254                 {
01255                     if (WHITE,LITERAL(")"))
01256                     {
01257                         pValue = random_value(rtype,a);
01258                         ACCEPT;
01259                     }
01260                     else
01261                     {
01262                         output_message("%s(%d): expected ) after %s distribution term", filename,linenum, fname);
01263                         REJECT;
01264                     }
01265                 }
01266                 else if (nargs==2)
01267                 {
01268                     if ( (WHITE,LITERAL(",")) && (WHITE,TERM(real_value(HERE,&b))) && (WHITE,LITERAL(")")))
01269                     {
01270                         pValue = random_value(rtype,a,b);
01271                         ACCEPT;
01272                     }
01273                     else
01274                     {
01275                         output_message("%s(%d): missing second %s distribution term and/or )", filename,linenum, fname);
01276                         REJECT;
01277                     }
01278                 }
01279                 else if (nargs==3)
01280                 {
01281                     if ( (WHITE,LITERAL(",")) && (WHITE,TERM(real_value(HERE,&b))) && WHITE,LITERAL(",") && (WHITE,TERM(real_value(HERE,&c))) && (WHITE,LITERAL(")")))
01282                     {
01283                         pValue = random_value(rtype,a,b,c);
01284                         ACCEPT;
01285                     }
01286                     else
01287                     {
01288                         output_message("%s(%d): missing terms and/or ) in %s distribution ", filename,linenum, fname);
01289                         REJECT;
01290                     }
01291                 }
01292                 else
01293                 {
01294                     output_message("%s(%d): %d terms is not supported", filename,linenum, nargs);
01295                     REJECT;
01296                 }
01297             }
01298             else
01299             {
01300                 output_message("%s(%d): expected first term of %s distribution", filename,linenum, fname);
01301                 REJECT;
01302             }
01303         }
01304     } // end if "random."
01305     return _n;
01306 }
01307 #endif
01308 
01309 static int integer(PARSER, int64 *value)
01310 {
01311     char result[256];
01312     int size=sizeof(result);
01313     START;
01314     while (size>1 && isdigit(*_p)) COPY(result);
01315     result[_n]='\0';
01316     *value=atoi64(result);
01317     return _n;
01318 }
01319 
01320 static int integer32(PARSER, int32 *value)
01321 {
01322     char result[256];
01323     int size=sizeof(result);
01324     START;
01325     while (size>1 && isdigit(*_p)) COPY(result);
01326     result[_n]='\0';
01327     *value=atoi(result);
01328     return _n;
01329 }
01330 
01331 static int integer16(PARSER, int16 *value)
01332 {
01333     char result[256];
01334     int size=sizeof(result);
01335     START;
01336     while (size>1 && isdigit(*_p)) COPY(result);
01337     result[_n]='\0';
01338     *value=atoi(result);
01339     return _n;
01340 }
01341 
01342 static int real_value(PARSER, double *value)
01343 {
01344     char result[256];
01345     int ndigits=0;
01346     int size=sizeof(result);
01347     START;
01348     if (*_p=='+' || *_p=='-') COPY(result);
01349     while (size>1 && isdigit(*_p)) {COPY(result);++ndigits;}
01350     if (*_p=='.') COPY(result);
01351     while (size>1 && isdigit(*_p)) {COPY(result);ndigits++;}
01352     if (ndigits>0 && (*_p=='E' || *_p=='e')) 
01353     {
01354         COPY(result);
01355         if (*_p=='+' || *_p=='-') COPY(result);
01356         while (size>1 && isdigit(*_p)) COPY(result);
01357     }
01358     result[_n]='\0';
01359     *value=atof(result);
01360     return _n;
01361 }
01362 
01363 static int functional(PARSER, double *pValue)
01364 {
01365     char32 fname;
01366     START;
01367     if WHITE ACCEPT;
01368     if (LITERAL("random.") && TERM(name(HERE,fname,sizeof(fname))))
01369     {
01370         RANDOMTYPE rtype = random_type(fname);
01371         int nargs = random_nargs(fname);
01372         double a;
01373         if (rtype==RT_INVALID || nargs==0 || (WHITE,!LITERAL("(")))
01374         {
01375             output_error_raw("%s(%d): %s is not a valid random distribution", filename,linenum,fname);
01376             REJECT;
01377         }
01378         if (nargs==-1)
01379         {
01380             if (WHITE,TERM(real_value(HERE,&a)))
01381             {
01382                 double b[1024];
01383                 int maxb = sizeof(b)/sizeof(b[0]);
01384                 int n;
01385                 b[0] = a;
01386                 for (n=1; n<maxb && (WHITE,LITERAL(",")); n++)
01387                 {
01388                     if (WHITE,TERM(real_value(HERE,&b[n])))
01389                         continue;
01390                     else
01391                     {
01392                         // variable arg list
01393                         output_error_raw("%s(%d): expected a %s distribution term after ,", filename,linenum, fname);
01394                         REJECT;
01395                     }
01396                 }
01397                 if (WHITE,LITERAL(")"))
01398                 {
01399                     *pValue = random_value(rtype,n,b);
01400                     ACCEPT;
01401                 }
01402                 else
01403                 {
01404                     output_error_raw("%s(%d): missing ) after %s distribution terms", filename,linenum, fname);
01405                     REJECT;
01406                 }
01407             }
01408             else
01409             {
01410                 output_error_raw("%s(%d): expected first term of %s distribution", filename,linenum, fname);
01411                 REJECT;
01412             }
01413         }
01414         else 
01415         {
01416             if (WHITE,TERM(real_value(HERE,&a)))
01417             {
01418                 // fixed arg list
01419                 double b,c;
01420                 if (nargs==1)
01421                 {
01422                     if (WHITE,LITERAL(")"))
01423                     {
01424                         *pValue = random_value(rtype,a);
01425                         ACCEPT;
01426                     }
01427                     else
01428                     {
01429                         output_error_raw("%s(%d): expected ) after %s distribution term", filename,linenum, fname);
01430                         REJECT;
01431                     }
01432                 }
01433                 else if (nargs==2)
01434                 {
01435                     if ( (WHITE,LITERAL(",")) && (WHITE,TERM(real_value(HERE,&b))) && (WHITE,LITERAL(")")))
01436                     {
01437                         *pValue = random_value(rtype,a,b);
01438                         ACCEPT;
01439                     }
01440                     else
01441                     {
01442                         output_error_raw("%s(%d): missing second %s distribution term and/or )", filename,linenum, fname);
01443                         REJECT;
01444                     }
01445                 }
01446                 else if (nargs==3)
01447                 {
01448                     if ( (WHITE,LITERAL(",")) && (WHITE,TERM(real_value(HERE,&b))) && WHITE,LITERAL(",") && (WHITE,TERM(real_value(HERE,&c))) && (WHITE,LITERAL(")")))
01449                     {
01450                         *pValue = random_value(rtype,a,b,c);
01451                         ACCEPT;
01452                     }
01453                     else
01454                     {
01455                         output_error_raw("%s(%d): missing terms and/or ) in %s distribution ", filename,linenum, fname);
01456                         REJECT;
01457                     }
01458                 }
01459                 else
01460                 {
01461                     output_error_raw("%s(%d): %d terms is not supported", filename,linenum, nargs);
01462                     REJECT;
01463                 }
01464             }
01465             else
01466             {
01467                 output_error_raw("%s(%d): expected first term of %s distribution", filename,linenum, fname);
01468                 REJECT;
01469             }
01470         }
01471     } else if TERM(real_value(HERE,pValue)){
01472         ACCEPT;
01473     } else
01474     {
01475         /* possibly valid through expression() -MH */
01476         //output_message("%s(%d): expected property or functional value", filename,linenum);
01477         REJECT;
01478     }
01479     DONE;
01480 }
01481 
01482 /* Expression rules:
01483  *  every value is either a double value, or a PT_double object property of the form "this.propname"
01484  *  valid operators are {+, -, *, /, ^}
01485  *  every expression begins and ends with parenthesis
01486  *  every value is followed by an operator or a close parenthesis
01487  *  every operator is followed by a value or an open parenthesis
01488  *  every open parenthesis is followed by a value
01489  *  every close parenthesis is followed by an operator or the end of the expression
01490  *  parenthesis must be matched
01491  *  every value or operator must consume trailing whitespace
01492  * Step one: form the expression list
01493  * Step two: break the list into a tree
01494  * Step three: evaluate the tree bottom-up
01495  *
01496  *
01497  *  Dijkstra's Shunting Yard algorithm
01498  *  ref: wikipedia (sadly)
01499  *
01500  *  - read a token
01501  *  - if the token is a number, add it to the output queue
01502  *  - if the token is a function token, then push it onto the stack
01503  *  - if the token is an operator, o1, then:
01504  *      - while there is an operator, o2, at the top of the stack, and either
01505  *          - o1 is associative or left-associative and its precedence is less than or equal to that of o2, or
01506  *          - o1 is right-associative and its precedence is less than that of o2
01507  *          then pop o2 off the stack and onto the output queue
01508  *  - if the token is a left parenthesis, then push it onto the stack.
01509  *  - if the toekn is a right parenthesis:
01510  *      - until the token at the top is a left parenthesis, pop operators off the stack onto the output queue
01511  *      - pop the left parenthesis from the stack, but not onto the output queue
01512  *      - if the token at the top of the stack is a function token, pop it and onto the output queue
01513  *      - if the stack runs out without finding a left parenthesis, then there are mismatched parentheses
01514  *  - when there are no more tokens to read:
01515  *      - while there are still operator tokens on the stack,
01516  *          - if the operator token is a parenthesis, we have a mismatched parenthesis
01517  *          - pop the operator onto the queue
01518  * - FIN
01519  */
01520 struct s_rpn {
01521     int op;
01522     double val; // if op = 0, check val
01523 };
01524 
01525 struct s_rpn_func {
01526     char *name;
01527     int args; /* use a mode instead? else assume only doubles */
01528     int index;
01529     double (*fptr)(double);
01530     /* fptr? for now, just to recognize */
01531 } rpn_map[] = {
01532     {"sin", 1, -1, sin},
01533     {"cos", 1, -2, cos},
01534     {"tan", 1, -3, tan},
01535     {"abs", 1, -4, fabs},
01536     {"sqrt", 1, -5, sqrt},
01537     {"acos", 1, -6, acos},
01538     {"asin", 1, -7, asin},
01539     {"atan", 1, -8, atan},
01540 //  {"atan2", 2},   /* only one with two inputs? */
01541     {"log", 1, -10, log},
01542     {"log10", 1, -11, log10},
01543     {"floor", 1, -12, floor},
01544     {"ceil", 1, -13, ceil}
01545 };
01546 
01547 static int rpnfunc(PARSER, int *val){
01548     struct s_rpn_func *ptr = rpn_map;
01549     int i = 0, count = 0;
01550     START;
01551     count = (sizeof(rpn_map)/sizeof(rpn_map[0]));
01552     for(i = 0; i < count; ++i){
01553         if(strncmp(rpn_map[i].name, HERE, strlen(rpn_map[i].name)) == 0){
01554             *val = rpn_map[i].index;
01555             return (int)strlen(rpn_map[i].name);
01556         }
01557     }
01558     return 0;
01559 }
01560 
01561 //static const int OP_END = 0, OP_OPEN = 1, OP_CLOSE = 2, OP_POW = 3,
01562 //      OP_MULT = 4, OP_MOD = 5, OP_DIV = 6, OP_ADD = 7, OP_SUB = 8;
01563 //static int OP_SIN = -1, OP_COS = -2, OP_TAN = -3, OP_ABS = -4;
01564 
01565 #define OP_END 0
01566 #define OP_OPEN 1
01567 #define OP_CLOSE 2
01568 #define OP_POW 3
01569 #define OP_MULT 4
01570 #define OP_MOD 5
01571 #define OP_DIV 6
01572 #define OP_ADD 7
01573 #define OP_SUB 8
01574 #define OP_SIN -1
01575 #define OP_COS -2
01576 #define OP_TAN -3
01577 #define OP_ABS -4
01578 
01579 static int op_prec[] = {0, 0, 0, 3, 2, 2, 2, 1, 1};
01580 
01581 #define PASS_OP(T) \
01582     while(op_prec[(T)] <= op_prec[op_stk[op_i]]){   \
01583         rpn_stk[rpn_i].op = op_stk[op_i];               \
01584         rpn_stk[rpn_i].val = 0;                         \
01585         ++rpn_i;                                        \
01586         --op_i;                                         \
01587     }                                                   \
01588     op_stk[++op_i] = (T);                           \
01589     ++rpn_sz;                           
01590     
01591 static int expression(PARSER, double *pValue, UNIT **unit, OBJECT *obj){
01592     double val_q[128], tVal;
01593     char tname[128]; /* type name for this.prop */
01594     char oname[128], pname[128];
01595     struct s_rpn rpn_stk[256];
01596     int op_stk[128], val_i = 0, op_i = 1, rpn_i = 0, depth = 0, rfname = 0, rpn_sz = 0;
01597     int i = 0;
01598     
01599     START;
01600     /* RPN-ify */
01601     if LITERAL("("){
01602         ACCEPT;
01603         if WHITE ACCEPT;
01604         depth = 1;
01605         op_stk[0] = OP_OPEN;
01606         op_i = 0;
01607     } else {
01608         REJECT; /* all expressions must be contained within a () block */
01609     }
01610     while(depth > 0){ /* grab tokens*/
01611         if LITERAL(";"){ /* says we're done */
01612             ACCEPT;
01613             break;
01614         } else if LITERAL("("){ /* parantheses */
01615             ACCEPT;
01616             op_stk[++op_i] = OP_OPEN;
01617             //++op_i;
01618             ++depth;
01619             if WHITE ACCEPT;
01620         } else if LITERAL(")"){
01621             ACCEPT;
01622             if WHITE ACCEPT;
01623             --depth;
01624             /* consume operations until OP_OPEN found */
01625             while((op_i >= 0) && (op_stk[op_i] != OP_OPEN)){
01626                 rpn_stk[rpn_i].op = op_stk[op_i--];
01627                 rpn_stk[rpn_i].val = 0.0;
01628                 ++rpn_i;
01629             }
01630             /* consume OP_OPEN too */
01631             op_i--;
01632             /* rpnfunc lookahead */
01633             if(op_stk[op_i] < 0){ /* push rpnfunc */
01634                 rpn_stk[rpn_i].op = op_stk[op_i--];
01635                 rpn_stk[rpn_i].val = 0.0;
01636                 ++rpn_i;
01637             }
01638             /* op_stk[op_i] == OP_CLOSE */
01639         } else if LITERAL("^"){ /* operators */
01640             ACCEPT;
01641             if WHITE ACCEPT;
01642             op_stk[++op_i] = OP_POW; /* nothing but () and functions hold higher precedence */
01643             ++rpn_sz;
01644         } else if LITERAL("*"){ /* prec = 4 */
01645             ACCEPT;
01646             if WHITE ACCEPT;
01647             PASS_OP(OP_MULT);
01648         } else if LITERAL("/"){
01649             ACCEPT;
01650             if WHITE ACCEPT;
01651             PASS_OP(OP_DIV);
01652         } else if LITERAL("%"){
01653             ACCEPT;
01654             if WHITE ACCEPT;
01655             PASS_OP(OP_MOD);
01656         } else if LITERAL("+"){ /* prec = 6 */
01657             ACCEPT;
01658             if WHITE ACCEPT;
01659             PASS_OP(OP_ADD);
01660         } else if LITERAL("-"){
01661             ACCEPT;
01662             if WHITE ACCEPT;
01663             PASS_OP(OP_SUB);
01664         } else if(TERM(rpnfunc(HERE, &rfname))){
01665             ACCEPT;
01666             if WHITE ACCEPT;
01667             op_stk[++op_i] = rfname;
01668             if LITERAL("("){
01669                 ACCEPT;
01670                 if WHITE ACCEPT;
01671                 op_stk[++op_i] = OP_OPEN;
01672                 ++depth;
01673                 ++rpn_sz;
01674             } else {
01675                 REJECT;
01676             }
01677         } else if ((LITERAL("$") || LITERAL("this.")) && TERM(name(HERE,tname,sizeof(tname)))){
01678             /* TODO: support non-this object name references. would need to delay processing of expr
01679              * with unrecognized object names. -d3p988 */
01680             double *valptr = object_get_double_by_name(obj, tname);
01681             if(valptr == NULL){
01682                 output_error_raw("%s(%d): invalid property: %s.%s", filename,linenum, obj->oclass->name, tname);
01683                 REJECT;
01684             }
01685             ACCEPT;
01686             if WHITE ACCEPT;
01687             rpn_stk[rpn_i].op = 0;
01688             rpn_stk[rpn_i].val = *valptr;
01689             ++rpn_sz;
01690             ++rpn_i;
01691         } else if (TERM(functional(HERE, &tVal))){ /* captures reals too */
01692             ACCEPT;
01693             if WHITE ACCEPT;
01694             rpn_stk[rpn_i].op = 0;
01695 
01696             rpn_stk[rpn_i].val = tVal;
01697             ++rpn_i;
01698             ++rpn_sz;
01699         } else if(TERM(name(HERE,oname,sizeof(oname))) && LITERAL(".") && TERM(name(HERE,pname,sizeof(pname)))){
01700             /* obj.prop*/
01701             OBJECT *otarg = NULL;
01702             ACCEPT;
01703             if WHITE ACCEPT;
01704             if(0 == strcmp(oname, "parent")){
01705                 otarg = obj->parent;
01706             } else {
01707                 otarg = object_find_name(oname);
01708             }
01709             if(otarg == NULL){ // delayed checking
01710                 // disabled for now
01711                 output_error_raw("%s(%d): unknown reference: %s.%s", filename, linenum, oname, pname);
01712                 output_error("may be an order issue, delayed reference checking is a todo");
01713                 REJECT;
01714             } else {
01715                 double *valptr = object_get_double_by_name(otarg, pname);
01716                 if(valptr == NULL){
01717                     output_error_raw("%s(%d): invalid property: %s.%s", filename,linenum, oname, pname);
01718                     REJECT;
01719                 }
01720                 rpn_stk[rpn_i].op = 0;
01721                 rpn_stk[rpn_i].val = *valptr;
01722                 ++rpn_sz;
01723                 ++rpn_i;
01724             }
01725         } else { /* oops */
01726             output_error_raw("%s(%d): unrecognized token within: %s9", filename,linenum, HERE-2);
01727             REJECT;
01728             /* It looked like an expression.  Give fair warning. */
01729         }
01730     }
01731 
01732     /* depth == 0 ~ pop the op stack to the rpn queue */
01733     while(op_i >= 0){
01734         if(op_stk[op_i] != OP_OPEN){
01735             rpn_stk[rpn_i].op = op_stk[op_i];
01736             rpn_stk[rpn_i].val = 0.0;
01737             ++rpn_i;
01738         }
01739         --op_i;
01740     }
01741     /* if no semicolon, there's a bigger error, so we don't check that here */
01742     
01743     /* postfix algorithm */
01744     /*  - while there are input tokens left,
01745      *      - read the next input token
01746      *      - if the token is a value
01747      *          - push the token onto a stack
01748      *      - if the token is an operator
01749      *          - it is known a priori that the operator takes N arguments
01750      *          - if there are fewer than N values on the stack, error.
01751      *          - else pop the top n values from the stack
01752      *          - evaluate the operator with with the values as arguments
01753      *          - push the returned value back onto the stack
01754      *  - iff one value remains on the stack, return that value
01755      *  - if more values exist on the stack, error
01756      */
01757 
01758     rpn_i = 0;
01759 
01760     for(i = 0; i < rpn_sz; ++i){
01761         if(rpn_stk[i].op == 0){ /* push value */
01762             val_q[val_i++] = rpn_stk[i].val;
01763         } else if(rpn_stk[i].op > 0){ /* binary operator */
01764             double popval = val_q[--val_i];
01765             if(val_i < 0){
01766                 output_error_raw("%s(%d): insufficient arguments in equation", filename,linenum, rpn_stk[i].op);
01767                 REJECT;
01768             }
01769             switch(rpn_stk[i].op){
01770                 case OP_POW:
01771                     val_q[val_i-1] = pow(val_q[val_i-1], popval);
01772                     break;
01773                 case OP_MULT:
01774                     val_q[val_i-1] *= popval;
01775                     break;
01776                 case OP_MOD:
01777                     val_q[val_i-1] = fmod(val_q[val_i-1], popval);
01778                     break;
01779                 case OP_DIV:
01780                     val_q[val_i-1] /= popval;
01781                     break;
01782                 case OP_ADD:
01783                     val_q[val_i-1] += popval;
01784                     break;
01785                 case OP_SUB:
01786                     val_q[val_i-1] -= popval;
01787                     break;
01788                 default:
01789                     output_error_raw("%s(%d): unrecognized operator index %i (bug!)", filename,linenum, rpn_stk[i].op);
01790                     REJECT;
01791             }
01792         } else if(rpn_stk[i].op < 0){ /* rpn_func */
01793             int j;
01794             int count = (sizeof(rpn_map)/sizeof(rpn_map[0]));
01795             for(j = 0; j < count; ++j){
01796                 if(rpn_map[j].index == rpn_stk[i].op){
01797                     double popval = val_q[--val_i];
01798                     if(val_i < 0){
01799                         output_error_raw("%s(%d): insufficient arguments in equation", filename,linenum, rpn_stk[i].op);
01800                         REJECT;
01801                     }
01802                     val_q[val_i++] = (*rpn_map[j].fptr)(popval);
01803                     break;
01804                 }
01805             }
01806             if(j == count){ /* missed */
01807                 output_error_raw("%s(%d): unrecognized function index %i (bug!)", filename,linenum, rpn_stk[i].op);
01808                 REJECT;
01809             }
01810 
01811         }
01812     }
01813     if((val_i > 1)){
01814         output_error_raw("%s(%d): too many values in equation!", filename,linenum);
01815         REJECT;
01816     }
01817     *pValue = val_q[0];
01818     DONE;
01819 }
01820 
01821 static int functional_unit(PARSER,double *pValue,UNIT **unit)
01822 {
01823     START;
01824     if TERM(functional(HERE,pValue))
01825     {
01826         *unit = NULL;
01827         if WHITE ACCEPT;
01828         if TERM(unitspec(HERE,unit)) ACCEPT;
01829         ACCEPT;
01830         DONE;
01831     }
01832     REJECT;
01833 }
01834 
01835 static int complex_value(PARSER, complex *pValue)
01836 {
01837     double r, i, m, a;
01838     START;
01839     if ((WHITE,TERM(real_value(HERE,&r))) && (WHITE,TERM(real_value(HERE,&i))) && LITERAL("i"))
01840     {
01841         pValue->r = r;
01842         pValue->i = i;
01843         pValue->f = I;
01844         ACCEPT;
01845         DONE;
01846     }
01847     OR
01848     if ((WHITE,TERM(real_value(HERE,&r))) && (WHITE,TERM(real_value(HERE,&i))) && LITERAL("j"))
01849     {
01850         pValue->r = r;
01851         pValue->i = i;
01852         pValue->f = J;
01853         ACCEPT;
01854         DONE;
01855     }
01856     OR
01857     if ((WHITE,TERM(real_value(HERE,&m))) && (WHITE,TERM(real_value(HERE,&a))) && LITERAL("d"))
01858     {
01859         pValue->r = m*cos(a*PI/180);
01860         pValue->i = m*sin(a*PI/180);
01861         pValue->f = A;
01862         ACCEPT;
01863         DONE;
01864     }
01865     OR
01866     if ((WHITE,TERM(real_value(HERE,&m))) && (WHITE,TERM(real_value(HERE,&a))) && LITERAL("r"))
01867     {
01868         pValue->r = m*cos(a);
01869         pValue->i = m*sin(a);
01870         pValue->f = R;
01871         ACCEPT;
01872         DONE;
01873     } 
01874     OR
01875     if ((WHITE,TERM(real_value(HERE,&m))))
01876     {
01877         pValue->r = m;
01878         pValue->i = 0.0;
01879         pValue->f = I;
01880         ACCEPT;
01881         DONE;
01882     }
01883 
01884     REJECT;
01885 }
01886 
01887 static int complex_unit(PARSER,complex *pValue,UNIT **unit)
01888 {
01889     START;
01890     if TERM(complex_value(HERE,pValue))
01891     {
01892         *unit = NULL;
01893         if WHITE ACCEPT;
01894         if TERM(unitspec(HERE,unit)) ACCEPT;
01895         ACCEPT;
01896         DONE;
01897     }
01898     REJECT;
01899 }
01900 
01901 static int time_value_seconds(PARSER, TIMESTAMP *t)
01902 {
01903     START;
01904     if WHITE ACCEPT;
01905     if (TERM(integer(HERE,t)) && LITERAL("s")) { *t *= TS_SECOND; ACCEPT; DONE;}
01906     OR
01907     if (TERM(integer(HERE,t)) && LITERAL("S")) { *t *= TS_SECOND; ACCEPT; DONE;}
01908     REJECT;
01909 }
01910 
01911 static int time_value_minutes(PARSER, TIMESTAMP *t)
01912 {
01913     START;
01914     if WHITE ACCEPT;
01915     if (TERM(integer(HERE,t)) && LITERAL("m")) { *t *= 60*TS_SECOND; ACCEPT; DONE;}
01916     OR
01917     if (TERM(integer(HERE,t)) && LITERAL("M")) { *t *= 60*TS_SECOND; ACCEPT; DONE;}
01918     REJECT;
01919 }
01920 
01921 static int time_value_hours(PARSER, TIMESTAMP *t)
01922 {
01923     START;
01924     if WHITE ACCEPT;
01925     if (TERM(integer(HERE,t)) && LITERAL("h")) { *t *= 3600*TS_SECOND; ACCEPT; DONE;}
01926     OR
01927     if (TERM(integer(HERE,t)) && LITERAL("H")) { *t *= 3600*TS_SECOND; ACCEPT; DONE;}
01928     REJECT;
01929 }
01930 
01931 static int time_value_days(PARSER, TIMESTAMP *t)
01932 {
01933     START;
01934     if WHITE ACCEPT;
01935     if (TERM(integer(HERE,t)) && LITERAL("d")) { *t *= 86400*TS_SECOND; ACCEPT; DONE;}
01936     OR
01937     if (TERM(integer(HERE,t)) && LITERAL("D")) { *t *= 86400*TS_SECOND; ACCEPT; DONE;}
01938     REJECT;
01939 }
01940 
01941 int time_value_datetime(PARSER, TIMESTAMP *t)
01942 {
01943     DATETIME dt;
01944     START;
01945     if WHITE ACCEPT;
01946     if LITERAL("'") ACCEPT;
01947     if (TERM(integer16(HERE,&dt.year)) && LITERAL("-")
01948         && TERM(integer16(HERE,&dt.month)) && LITERAL("-")
01949         && TERM(integer16(HERE,&dt.day)) && LITERAL(" ")
01950         && TERM(integer16(HERE,&dt.hour)) && LITERAL(":")
01951         && TERM(integer16(HERE,&dt.minute)) && LITERAL(":")
01952         && TERM(integer16(HERE,&dt.second)) && LITERAL("'"))
01953     {
01954         dt.microsecond = 0;
01955         dt.weekday = -1;
01956         dt.is_dst = -1;
01957         strcpy(dt.tz,"");
01958         *t = mkdatetime(&dt);
01959         if (*t!=-1) 
01960         {
01961             ACCEPT;
01962         }
01963         else
01964             REJECT;
01965     }
01966     else
01967         REJECT;
01968     DONE;
01969 }
01970 
01971 static int time_value_datetimezone(PARSER, TIMESTAMP *t)
01972 {
01973     DATETIME dt;
01974     START;
01975     if WHITE ACCEPT;
01976     if LITERAL("'") ACCEPT;
01977     if (TERM(integer16(HERE,&dt.year)) && LITERAL("-")
01978         && TERM(integer16(HERE,&dt.month)) && LITERAL("-")
01979         && TERM(integer16(HERE,&dt.day)) && LITERAL(" ")
01980         && TERM(integer16(HERE,&dt.hour)) && LITERAL(":")
01981         && TERM(integer16(HERE,&dt.minute)) && LITERAL(":")
01982         && TERM(integer16(HERE,&dt.second)) && LITERAL(" ")
01983         && TERM(name(HERE,dt.tz,sizeof(dt.tz))) && LITERAL("'"))
01984     {
01985         dt.microsecond = 0;
01986         dt.weekday = -1;
01987         dt.is_dst = -1;
01988         *t = mkdatetime(&dt);
01989         if (*t!=-1) 
01990         {
01991             ACCEPT;
01992         }
01993         else
01994             REJECT;
01995     }
01996     else
01997         REJECT;
01998     DONE;
01999 }
02000 
02001 /*static*/ int time_value(PARSER, TIMESTAMP *t)
02002 {
02003     START;
02004     if WHITE ACCEPT;
02005     if (TERM(time_value_seconds(HERE,t)) && (WHITE,LITERAL(";"))) {ACCEPT; DONE; }
02006     OR
02007     if (TERM(time_value_minutes(HERE,t)) && (WHITE,LITERAL(";"))) {ACCEPT; DONE; }
02008     OR
02009     if (TERM(time_value_hours(HERE,t)) && (WHITE,LITERAL(";"))) {ACCEPT; DONE; }
02010     OR
02011     if (TERM(time_value_days(HERE,t)) && (WHITE,LITERAL(";"))) {ACCEPT; DONE; }
02012     OR
02013     if (TERM(time_value_datetime(HERE,t)) && (WHITE,LITERAL(";"))) {ACCEPT; DONE; }
02014     OR
02015     if (TERM(time_value_datetimezone(HERE,t)) && (WHITE,LITERAL(";"))) {ACCEPT; DONE; }
02016     OR
02017     if (TERM(integer(HERE,t)) && (WHITE,LITERAL(";"))) {ACCEPT; DONE; }
02018     else REJECT;
02019     DONE;
02020 }
02021 
02022 double load_latitude(char *buffer)
02023 {
02024     int32 d, m=0;
02025     double s=0;
02026     char ns;
02027     if((strcmp(buffer, "none") == 0) || (strcmp(buffer, "NONE") == 0)){
02028         return QNAN;
02029     }
02030     if (sscanf(buffer,"%d%c%d'%lf\"",&d,&ns,&m,&s)>1)
02031     {
02032         double v = (double)d+(double)m/60+s/3600;
02033         if (v>=0 && v<=90)
02034         {
02035             if (ns=='S')
02036                 return -v;
02037             else if (ns=='N')
02038                 return v;
02039         }
02040     }
02041     output_error_raw("%s(%d): '%s' is not a valid latitude", filename,linenum,buffer);
02042     return QNAN;
02043 }
02044 
02045 double load_longitude(char *buffer)
02046 {
02047     int32 d, m=0;
02048     double s=0;
02049     char ns;
02050     if((strcmp(buffer, "none") == 0) || (strcmp(buffer, "NONE") == 0)){
02051         return QNAN;
02052     }
02053     if (sscanf(buffer,"%d%c%d'%lf\"",&d,&ns,&m,&s)>1)
02054     {
02055         double v = (double)d+(double)m/60+s/3600;
02056         if (v>=0 && v<=180)
02057         {
02058             if (ns=='W')
02059                 return -v;
02060             else if (ns=='E')
02061                 return v;
02062         }
02063     }
02064     output_error_raw("%s(%d): '%s' is not a valid longitude", filename,linenum,buffer);
02065     return QNAN;
02066 }
02067 
02068 static int clock_properties(PARSER)
02069 {
02070     TIMESTAMP tsval;
02071     char32 timezone;
02072     double realval;
02073     START;
02074     if WHITE ACCEPT;
02075     if (LITERAL("tick") && WHITE)
02076     {
02077         if (TERM(real_value(HERE,&realval)) && (WHITE,LITERAL(";")))
02078         {
02079             if (realval!=TS_RESOLUTION)
02080             {
02081                 output_error_raw("%s(%d): timestamp resolution %g does not match system resolution %g, this version does not support variable tick", filename, linenum, realval, TS_RESOLUTION);
02082                 REJECT;
02083             }
02084             ACCEPT;
02085             goto Next;
02086         }
02087         output_error_raw("%s(%d): expected tick value", filename, linenum);
02088         REJECT;
02089     }
02090     OR if (LITERAL("timestamp") && WHITE)
02091     {
02092         if (TERM(time_value(HERE,&tsval)))
02093         {
02094             global_clock = tsval;
02095             ACCEPT;
02096             goto Next;
02097         }
02098         output_error_raw("%s(%d): expected time value", filename, linenum);
02099         REJECT;
02100     }
02101     OR if (LITERAL("starttime") && WHITE)
02102     {
02103         if (TERM(time_value(HERE,&tsval)))
02104         {
02105             global_clock = tsval; // note: this is correct - internally starttime refers to the real starttime, but in sim world it refers to global_clock
02106             ACCEPT;
02107             goto Next;
02108         }
02109         output_error_raw("%s(%d): expected time value", filename, linenum);
02110         REJECT;
02111     }
02112     OR if (LITERAL("stoptime") && WHITE)
02113     {
02114         if (TERM(time_value(HERE,&tsval)))
02115         {
02116             global_stoptime = tsval;
02117             ACCEPT;
02118             goto Next;
02119         }
02120         output_error_raw("%s(%d): expected time value", filename, linenum);
02121         REJECT;
02122     }
02123     OR if (LITERAL("timezone") && WHITE)
02124     {
02125         if (TERM(value(HERE,timezone,sizeof(timezone))) && (WHITE,LITERAL(";")) && strlen(timezone)>0)
02126         {
02127             if (timestamp_set_tz(timezone)==NULL)
02128                 output_warning("%s(%d): timezone %s is not defined",filename,linenum,timezone);
02129                 /* TROUBLESHOOT
02130                     The specified timezone is not defined in the timezone file <code>.../etc/tzinfo.txt</code>.  
02131                     Try using an known timezone, or add the desired timezone to the timezome file and try again.
02132                  */
02133             ACCEPT;
02134             goto Next;
02135         }
02136         output_error_raw("%s(%d): expected time zone specification", filename, linenum);
02137         REJECT;
02138     }
02139     OR if (WHITE,LITERAL("}")) {/* don't accept yet */ DONE;}
02140     OR { syntax_error(HERE); REJECT; }
02141     /* may be repeated */
02142 Next:
02143     if TERM(clock_properties(HERE)) ACCEPT;
02144     DONE;
02145 }
02146 
02147 static int pathname(PARSER, char *path, int size)
02148 {
02149     START;
02150     if TERM(pattern(HERE,"[-A-Za-z0-9/\\:_,. ]",path,size)) {ACCEPT;}
02151     else REJECT;
02152     DONE;
02153 }
02154 
02170 static OBJECT *current_object = NULL; /* context object */
02171 static MODULE *current_module = NULL; /* context module */
02172 static int expanded_value(char *text, char *result, int size, char *delims)
02173 {
02174     int n=0;
02175     if (text[n] == '`')
02176     {
02177         n++;
02178         memset(result,0,size--); /* preserve the string terminator even when buffer is full */
02179         for ( ; text[n]!='`'; n++)
02180         {
02181             if (size==0)
02182             {
02183                 output_error_raw("%s(%d): string expansion buffer overrun", filename, linenum);
02184                 return 0;
02185             }
02186             if (text[n]=='{')
02187             {
02188                 char varname[256];
02189                 char value[1024];
02190                 char path[1024], name[1024], ext[1024];
02191                 filename_parts(filename,path,name,ext);
02192 
02193                 if (sscanf(text+n+1,"%255[a-zA-Z0-9_]",varname)==0)
02194                 {
02195                     output_error_raw("%s(%d): expanded string variable syntax error", filename, linenum);
02196                     return 0;
02197                 }
02198                 n+=(int)strlen(varname)+1;
02199                 if (text[n]!='}')
02200                 {
02201                     output_error_raw("%s(%d): expanded string variable missing closing }", filename, linenum);
02202                     return 0;
02203                 }
02204 
02205                 /* expanded specials variables */
02206                 if (strcmp(varname,"file")==0)
02207                     strcpy(value,filename);
02208                 else if (strcmp(varname,"filename")==0)
02209                     strcpy(value,name);
02210                 else if (strcmp(varname,"filepath")==0)
02211                     strcpy(value,path); 
02212                 else if (strcmp(varname,"fileext")==0)
02213                     strcpy(value,ext);
02214                 else if (strcmp(varname,"namespace")==0)
02215                     object_namespace(value,sizeof(value));
02216                 else if (strcmp(varname,"class")==0)
02217                     strcpy(value,current_object?current_object->oclass->name:"");
02218                 else if (strcmp(varname,"gridlabd")==0)
02219                     strcpy(value,global_execdir);
02220                 else if (strcmp(varname,"id")==0)
02221                 {
02222                     if (current_object)
02223                         sprintf(value,"%d",current_object->id);
02224                     else
02225                         strcpy(value,"");
02226                 }
02227                 else if (!object_get_value_by_name(current_object,varname,value,sizeof(value)))
02228                 {
02229                     output_error_raw("%s(%d): variable '%s' not found in this context", filename, linenum, varname);
02230                     return 0;
02231                 }
02232 
02233                 /* accept the value */
02234                 if ((int)strlen(value)>=size)
02235                 {
02236                     output_error_raw("%s(%d): string expansion buffer overrun", filename, linenum);
02237                     return 0;
02238                 }
02239                 strcat(result,value);
02240                 size -= (int)strlen(value);
02241                 result += strlen(value);
02242             }
02243             else
02244             {
02245                 *result++ = text[n];
02246                 size--;
02247             }
02248         }
02249         if (text[n+1]==';')
02250             return n+1;
02251         else
02252         {
02253             output_error_raw("%s(%d): missing terminating ;", filename, linenum);
02254             return 0;
02255         }
02256     }
02257     else if (delims==NULL)
02258         return value(text,result,size);
02259     else
02260         return delim_value(text,result,size,delims);
02261 }
02262 
02269 static int alternate_value(PARSER, char *value, int size)
02270 {
02271     double test;
02272     char value1[1024];
02273     char value2[1024];
02274     START;
02275     if (WHITE) ACCEPT;
02276     if (TERM(expression(HERE,&test,NULL,current_object)) && (WHITE,LITERAL("?")))
02277     {
02278         if ((WHITE,TERM(expanded_value(HERE,value1,sizeof(value1)," \t\n:"))) && (WHITE,LITERAL(":")) && (WHITE,TERM(expanded_value(HERE,value2,sizeof(value2)," \n\t;"))))
02279         {
02280             ACCEPT;
02281             if (test>0)
02282             {
02283                 if ((int)strlen(value1)>size)
02284                 {
02285                     output_error_raw("%s(%d): alternate value 1 is too large ;", filename, linenum);
02286                     REJECT;
02287                 }
02288                 else
02289                 {
02290                     strcpy(value,value1);
02291                     ACCEPT;
02292                 }
02293             }
02294             else
02295             {
02296                 if ((int)strlen(value2)>size)
02297                 {
02298                     output_error_raw("%s(%d): alternate value 2 is too large ;", filename, linenum);
02299                     REJECT;
02300                 }
02301                 else
02302                 {
02303                     strcpy(value,value2);
02304                     ACCEPT;
02305                 }
02306             }
02307         }
02308         else
02309         {
02310             output_error_raw("%s(%d): missing or invalid alternate values;", filename, linenum);
02311             REJECT;
02312         }
02313         DONE;
02314     }
02315     OR if (TERM(expanded_value(HERE,value,size,NULL)))
02316     {
02317         ACCEPT;
02318         DONE
02319     }
02320     REJECT;
02321     DONE;
02322 }
02323 
02327 static int line_spec(PARSER)
02328 {
02329     char fname[1024];
02330     int32 lnum;
02331     START;
02332     if LITERAL("@") 
02333     {
02334         if (TERM(pathname(HERE,fname,sizeof(fname))) && LITERAL(";") && TERM(integer32(HERE,&lnum)))
02335         {
02336             strcpy(filename,fname);
02337             linenum = lnum;
02338             ACCEPT; DONE;
02339         }
02340         else
02341         {
02342             output_error_raw("%s(%d): @ syntax error", filename, linenum);
02343             REJECT; DONE;
02344         }
02345     }
02346     else
02347         REJECT;
02348     DONE;
02349 }
02350 
02351 static int clock_block(PARSER)
02352 {
02353     START;
02354     if WHITE ACCEPT;
02355     if LITERAL("clock") ACCEPT else REJECT;
02356     if WHITE ACCEPT;
02357     if LITERAL("{") ACCEPT
02358     else
02359     {
02360         output_error_raw("%s(%d): expected clock block opening {",filename,linenum);
02361         REJECT;
02362     }
02363     if WHITE ACCEPT;
02364     if TERM(clock_properties(HERE)) ACCEPT;
02365     if WHITE ACCEPT;
02366     if LITERAL("}") ACCEPT else
02367     {
02368         output_error_raw("%s(%d): expected clock block closing }",filename,linenum);
02369         REJECT;
02370     }
02371     DONE;
02372 }
02373 
02374 static int module_properties(PARSER, MODULE *mod)
02375 {
02376     int64 val;
02377     CLASSNAME classname;
02378     char256 propname;
02379     char256 propvalue;
02380     START;
02381     if WHITE ACCEPT;
02382     if (LITERAL("major") && (WHITE))
02383     {
02384         if (TERM(integer(HERE,&val)))
02385         {
02386             if WHITE ACCEPT;
02387             if LITERAL(";")
02388             {
02389                 if (val!=mod->major)
02390                 {
02391                     output_error_raw("%s(%d): %s has an incompatible module major version", filename,linenum,mod->name);
02392                     REJECT;
02393                 }
02394                 ACCEPT;
02395                 goto Next;
02396             }
02397             else
02398             {
02399                 output_error_raw("%s(%d): expected ; after %s module major number", filename,linenum, mod->name);
02400                 REJECT;
02401             }
02402         }
02403         else
02404         {
02405             output_error_raw("%s(%d): expected %s module major number", filename,linenum, mod->name);
02406             REJECT;
02407         }
02408     }
02409     OR if (LITERAL("minor") && (WHITE))
02410     {
02411         if (TERM(integer(HERE,&val)))
02412         {
02413             if WHITE ACCEPT;
02414             if LITERAL(";")
02415             {
02416                 if (val!=mod->minor)
02417                 {
02418                     output_error_raw("%s(%d): %s has an incompatible module minor version", filename,linenum,mod->name);
02419                     REJECT;
02420                 }
02421                 ACCEPT;
02422                 goto Next;
02423             }
02424             else
02425             {
02426                 output_error_raw("%s(%d): expected ; after %s module minor number", filename,linenum, mod->name);
02427                 REJECT;
02428             }
02429         }
02430         else
02431         {
02432             output_error_raw("%s(%d): expected %s module minor number", filename,linenum, mod->name);
02433             REJECT;
02434         }
02435     }
02436     OR if (LITERAL("class") && WHITE)
02437     {
02438         if TERM(name(HERE,classname,sizeof(classname)))
02439         {
02440             if WHITE ACCEPT;
02441             if LITERAL(";")
02442             {
02443                 CLASS *oclass = class_get_class_from_classname(classname);
02444                 if (oclass==NULL || oclass->module!=mod)
02445                 {
02446                     output_error_raw("%s(%d): module '%s' does not implement class '%s'", filename, linenum, mod->name, classname);
02447                     REJECT;
02448                 }
02449                 ACCEPT;
02450                 goto Next;
02451             }
02452             else
02453             {
02454                 output_error_raw("%s(%d): expected ; after module %s class %s declaration", filename,linenum, mod->name, classname);
02455                 REJECT;
02456             }
02457         }
02458         else
02459         {
02460             output_error_raw("%s(%d): missing class name in module %s class declaration", filename,linenum, mod->name);
02461             REJECT;
02462         }
02463     }
02464     OR if (TERM(name(HERE,propname,sizeof(propname))) && (WHITE))
02465     {
02466         current_object = NULL; /* object context */
02467         current_module = mod; /* module context */
02468         if TERM(alternate_value(HERE,propvalue,sizeof(propvalue)))
02469         {
02470             if WHITE ACCEPT;
02471             if LITERAL(";")
02472             {
02473                 if (module_setvar(mod,propname,propvalue)>0)
02474                 {
02475                     ACCEPT;
02476                     goto Next;
02477                 }
02478                 else
02479                 {
02480                     output_error_raw("%s(%d): invalid module %s property '%s'", filename, linenum, mod->name, propname);
02481                     REJECT;
02482                 }
02483             }
02484             else
02485             {
02486                 output_error_raw("%s(%d): expected ; after module %s property specification", filename, linenum, mod->name);
02487                 REJECT;
02488             }
02489         }
02490         else
02491         {
02492             output_error_raw("%s(%d): missing module %s property %s value", filename, linenum, mod->name, propname);
02493             REJECT;
02494         }
02495     }
02496     OR if LITERAL("}") {/* don't accept yet */ DONE;}
02497     OR { syntax_error(HERE); REJECT; }
02498     /* may be repeated */
02499 Next:
02500     if TERM(module_properties(HERE,mod)) ACCEPT;
02501     DONE;
02502 }
02503 
02504 static int module_block(PARSER)
02505 {
02506     char module_name[64];
02507     char fmod[8],mod[54];
02508     MODULE *module;
02509     START;
02510     if WHITE ACCEPT;
02511     if (LITERAL("module") && WHITE) ACCEPT else REJECT;
02512     //if WHITE ACCEPT;
02513     /* load options should go here and get converted to argc/argv */
02514 
02515     /* foreign module */
02516     if (TERM(name(HERE,fmod,sizeof(fmod))) && LITERAL("::") && TERM(name(HERE,mod,sizeof(mod))))
02517     {
02518         sprintf(module_name,"%s::%s",fmod,mod);
02519         if ((module=module_load(module_name,0,NULL))!=NULL)
02520         {
02521             ACCEPT;
02522         }
02523         else
02524         {
02525             output_error_raw("%s(%d): %s module '%s' load failed, %s", filename, linenum, fmod, mod,errno?strerror(errno):"(no details)");
02526             REJECT;
02527         }
02528     }
02529 
02530     OR
02531     /* native C/C++ module */
02532     if (TERM(name(HERE,module_name,sizeof(module_name))))
02533     {
02534         if ((module=module_load(module_name,0,NULL))!=NULL)
02535         {
02536             ACCEPT;
02537         }
02538         else
02539         {
02540             output_error_raw("%s(%d): module '%s' load failed, %s", filename, linenum, module_name,errno?strerror(errno):"(no details)");
02541             REJECT;
02542         }
02543     }
02544     if WHITE ACCEPT;
02545     if LITERAL(";") {ACCEPT;DONE;}
02546     OR
02547     if LITERAL("{") ACCEPT
02548     else
02549     {
02550         output_error_raw("%s(%d): expected module %s block opening {", filename, linenum, module_name);
02551         REJECT;
02552     }
02553     if TERM(module_properties(HERE,module)) ACCEPT else REJECT;
02554     if WHITE ACCEPT;
02555     if LITERAL("}") ACCEPT
02556     else
02557     {
02558         output_error_raw("%s(%d): expected module %s block closing }", filename, linenum, module_name);
02559         REJECT;
02560     }
02561     DONE;
02562 }
02563 
02564 static int property_specs(PARSER, KEYWORD **keys)
02565 {
02566     char keyname[32];
02567     int32 keyvalue;
02568     START;
02569     if WHITE ACCEPT;
02570     if ( TERM(name(HERE,keyname,sizeof(keyname))) && (WHITE,LITERAL("=")) && TERM(integer32(HERE,&keyvalue)))
02571     {
02572         *keys = malloc(sizeof(KEYWORD));
02573         (*keys)->next = NULL;
02574         if WHITE ACCEPT;
02575         if LITERAL(",") ACCEPT;
02576         if WHITE ACCEPT;
02577         if TERM(property_specs(HERE, &((*keys)->next)));
02578         ACCEPT;
02579         strcpy((*keys)->name,keyname);
02580         (*keys)->value = keyvalue;
02581     }
02582     else
02583         REJECT;
02584     DONE;
02585 }
02586 
02587 static int property_type(PARSER, PROPERTYTYPE *ptype, KEYWORD **keys)
02588 {
02589     char32 type;
02590     START;
02591     if WHITE ACCEPT;
02592     if TERM(name(HERE,type,sizeof(type)))
02593     {
02594         *ptype = class_get_propertytype_from_typename(type);
02595         if (*ptype==PT_void)
02596         {
02597             output_error_raw("%s(%d): class member %s is not recognized", filename, linenum, type);
02598             REJECT;
02599         }
02600         if (WHITE,LITERAL("{"))
02601         {
02602             if (TERM(property_specs(HERE,keys)) && (WHITE,LITERAL("}")))
02603             {
02604                 ACCEPT;}
02605             else
02606             {   REJECT;}
02607         }
02608         ACCEPT;
02609     }
02610     else REJECT;
02611     DONE;
02612 }
02613 
02614 static int class_intrinsic_function_name(PARSER, CLASS *oclass, int64 *function, char **ftype, char **fname)
02615 {
02616     char buffer[1024];
02617     START;
02618     if WHITE ACCEPT;
02619     if LITERAL("create")
02620     {
02621         *ftype = "int64";
02622         *fname = "create";
02623         *function |= FN_CREATE;
02624         ACCEPT;
02625     }
02626     else if LITERAL("init")
02627     {
02628         *ftype = "int64";
02629         *fname = "init";
02630         *function |= FN_INIT;
02631         ACCEPT;
02632     }
02633     else if LITERAL("presync")
02634     {
02635         *ftype = "TIMESTAMP";
02636         *fname = "presync";
02637         oclass->passconfig |= PC_PRETOPDOWN;
02638         *function |= FN_PRESYNC;
02639         ACCEPT;
02640     }
02641     else if LITERAL("sync")
02642     {
02643         *ftype = "TIMESTAMP";
02644         *fname = "sync";
02645         oclass->passconfig |= PC_BOTTOMUP;
02646         *function |= FN_SYNC;
02647         ACCEPT;
02648     }
02649     else if LITERAL("postsync")
02650     {
02651         *ftype = "TIMESTAMP";
02652         *fname = "postsync";
02653         oclass->passconfig |= PC_POSTTOPDOWN;
02654         *function |= FN_POSTSYNC;
02655         ACCEPT;
02656     }
02657     else if LITERAL("recalc")
02658     {
02659         *ftype = "int64";
02660         *fname = "recalc";
02661         *function |= FN_RECALC;
02662         ACCEPT;
02663     }
02664     else if LITERAL("notify")
02665     {
02666         *ftype = "int64";
02667         *fname = "notify";
02668         *function |= FN_NOTIFY;
02669         ACCEPT;
02670     }
02671     else if LITERAL("plc")
02672     {
02673         *ftype = "TIMESTAMP";
02674         *fname = "plc";
02675         *function |= FN_PLC;
02676         ACCEPT;
02677     }
02678     else if LITERAL("isa")
02679     {
02680         *ftype = "int64";
02681         *fname = "isa";
02682         *function |= FN_ISA;
02683         ACCEPT;
02684     }
02685     else if TERM(name(HERE,buffer,sizeof(buffer)))
02686     {
02687         output_error_raw("%s(%d): '%s' is not a recognized intrinsic function", filename,linenum,buffer);
02688         REJECT;
02689     }
02690     DONE;
02691 }
02692 
02693 static int argument_list(PARSER, char *args, int size)
02694 {
02695     START;
02696     if WHITE ACCEPT;
02697     strcpy(args,"");
02698     if (LITERAL("("))
02699     {
02700         if (WHITE,TERM(pattern(HERE,"[^)]",args,size)))
02701         {
02702             ACCEPT;
02703         }
02704         if (WHITE,LITERAL(")"))
02705         {
02706             ACCEPT;
02707         }
02708         else
02709         {
02710             output_error_raw("%s(%d): unterminated argument list",filename, linenum);
02711             REJECT;
02712         }
02713     }
02714     else
02715         REJECT;
02716     DONE;
02717 }
02718 
02719 static int source_code(PARSER, char *code, int size)
02720 {
02721     int _n = 0;
02722     int nest = 0;
02723     enum {CODE,COMMENTBLOCK,COMMENTLINE,STRING,CHAR} state=CODE;
02724     while (*_p!='\0')
02725     {
02726         char c1 = _p[0];
02727         char c2 = _p[1];
02728         if (c1=='\n')
02729             linenum++;
02730         if (size==0)
02731         {
02732             output_error_raw("%s(%d): insufficient buffer space to load code", filename,linenum);
02733             return 0;
02734         }
02735         switch(state) {
02736         case CODE:
02737             if (c1==';' && nest==0)
02738             {
02739                     code[_n]='\0';
02740                     return _n;
02741             }
02742             else if (c1=='{')
02743             {
02744                 nest++;
02745                 COPY(code);
02746             }
02747             else if (c1=='}')
02748             {
02749                 if (nest>0)
02750                 {
02751                     nest--;
02752                     COPY(code);
02753                 }
02754                 else
02755                 {
02756                     output_error_raw("%s(%d): unmatched }", filename,linenum);
02757                     return 0;
02758                 }
02759             }
02760             else if (c1=='/' && c2=='*')
02761                 state = COMMENTBLOCK;
02762             else if (c1=='/' && c2=='/')
02763                 state = COMMENTLINE;
02764             else if (c1=='"')
02765             {
02766                 state = STRING;
02767                 COPY(code);
02768             }
02769             else if (c1=='\'')
02770             {
02771                 state = CHAR;
02772                 COPY(code);
02773             }
02774             else
02775                 COPY(code);
02776             break;
02777         case COMMENTBLOCK:
02778             if (c1=='*' && c2=='/')
02779             {
02780                 if (!global_debug_output && global_getvar("noglmrefs",NULL,0)==NULL)
02781                     sprintf(code+strlen(code),"#line %d \"%c\"\n", linenum,forward_slashes(filename));
02782                 state = CODE;
02783             }
02784             break;
02785         case COMMENTLINE:
02786             if (c1=='\n')
02787                 state = CODE;
02788             break;
02789         case STRING:
02790             if (c1=='"')
02791                 state = CODE;
02792             else if (c1=='\n')
02793             {
02794                 output_error_raw("%s(%d): unterminated string constant", filename,linenum);
02795                 return 0;
02796             }
02797             COPY(code);
02798             break;
02799         case CHAR:
02800             if (c1=='\'')
02801                 state = CODE;
02802             else if (c1=='\n')
02803             {
02804                 output_error_raw("%s(%d): unterminated char constant", filename,linenum);
02805                 return 0;
02806             }
02807             COPY(code);
02808             break;
02809         default:
02810             COPY(code);
02811             break;
02812         }
02813     }
02814     output_error_raw("%s(%d): unterminated code block", filename,linenum);
02815     return 0;
02816 }
02817 
02818 static int class_intrinsic_function(PARSER, CLASS *oclass, int64 *functions, char *code, int size)
02819 {
02820     char *fname = NULL;
02821     char *ftype = NULL;
02822     char arglist[1024];
02823     char source[4096];
02824     int startline;
02825     START;
02826     if WHITE ACCEPT;
02827     if (LITERAL("intrinsic") && WHITE && TERM(class_intrinsic_function_name(HERE,oclass,functions,&ftype,&fname)) && (WHITE,TERM(argument_list(HERE,arglist,sizeof(arglist)))) && (startline=linenum,WHITE,TERM(source_code(HERE,source,sizeof(source)))) && (WHITE,LITERAL(";")))
02828     {
02829         if (oclass->module==NULL)
02830         {
02831             mark_linex(filename,startline);
02832             append_code("\t%s %s (%s) { OBJECT*my=((OBJECT*)this)-1;",ftype,fname,arglist);
02833             append_code("\n\ttry %s ",source);
02834             append_code("catch (char *msg) {callback->output_error(\"%%s[%%s:%%d] exception - %%s\",my->name?my->name:\"(unnamed)\",my->oclass->name,my->id,msg); return 0;} ");
02835             append_code("catch (...) {callback->output_error(\"%%s[%%s:%%d] unhandled exception\",my->name?my->name:\"(unnamed)\",my->oclass->name,my->id); return 0;} ");
02836             append_code("callback->output_error(\"%s::%s(%s) not all paths return a value\"); return 0;}\n",oclass->name,fname,arglist);
02837             append_code("/*RESETLINE*/\n");
02838             ACCEPT;
02839         }
02840         else
02841         {
02842             output_error_raw("%s(%d): intrinsic functions not permitted in static classes", filename, linenum);
02843             REJECT;
02844         }
02845     }
02846     else
02847         REJECT;
02848     DONE;
02849 }
02850 
02851 static int class_export_function(PARSER, CLASS *oclass, char *fname, int fsize, char *arglist, int asize, char *code, int csize)
02852 {
02853     int startline;
02854     START;
02855     if WHITE ACCEPT;
02856     if (LITERAL("export") 
02857         && (WHITE,TERM(name(HERE,fname,fsize)))
02858         && (WHITE,TERM(argument_list(HERE,arglist,asize))) 
02859         && (startline=linenum,WHITE,TERM(source_code(HERE,code,csize))) && (WHITE,LITERAL(";")))
02860     {
02861         if (oclass->module==NULL)
02862         {
02863             mark_linex(filename,startline);
02864             append_code("\tstatic int64 %s (%s) %s;\n/*RESETLINE*/\n",fname,arglist,code);
02865 
02866             if (global_getvar("noglmrefs",NULL,0)==NULL)
02867                 append_init("#line %d \"%s\"\n"
02868                     "\tif ((*(callback->function.define))(oclass,\"%s\",(FUNCTIONADDR)&%s::%s)==NULL) return 0;\n"
02869                     "/*RESETLINE*/\n", startline, forward_slashes(filename),
02870                     fname,oclass->name,fname);
02871 
02872             ACCEPT;
02873         }
02874         else
02875         {
02876             output_error_raw("%s(%d): export functions not permitted in static classes", filename, linenum);
02877             REJECT;
02878         }
02879     }
02880     else
02881         REJECT;
02882     DONE;
02883 }
02884 
02885 static int class_explicit_declaration(PARSER, char *type, int size)
02886 {
02887     START;
02888     if WHITE ACCEPT;
02889     if LITERAL("private")
02890     {
02891         strcpy(type,"private");
02892         ACCEPT;
02893     }
02894     else if LITERAL("protected")
02895     {
02896         strcpy(type,"protected");
02897         ACCEPT;
02898     }
02899     else if LITERAL("public")
02900     {
02901         strcpy(type,"public");
02902         ACCEPT;
02903     }
02904     else if LITERAL("static")
02905     {
02906         strcpy(type,"static");
02907         ACCEPT;
02908     }
02909     else 
02910         REJECT;
02911     DONE;
02912 }
02913 
02914 static int class_explicit_definition(PARSER, CLASS *oclass)
02915 {
02916     int startline;
02917     char type[64];
02918     char code[4096];
02919     START;
02920     if WHITE ACCEPT;
02921     if (TERM(class_explicit_declaration(HERE,type,sizeof(type))))
02922     {
02923         if (oclass->module==NULL)
02924         {
02925             startline=linenum;
02926             if WHITE ACCEPT;
02927             if TERM(source_code(HERE,code,sizeof(code)))
02928             {
02929                 if WHITE ACCEPT;
02930                 if LITERAL(";")
02931                 {
02932                     mark_linex(filename,startline);
02933                     append_code("\t%s: %s;\n",type,code);
02934                     append_code("/*RESETLINE*/\n");
02935                     ACCEPT;
02936                 }
02937                 else
02938                 {
02939                     output_error_raw("%s(%d): missing ; after code block",filename, linenum);
02940                     REJECT;
02941                 }
02942             }
02943             else 
02944             {
02945                 output_error_raw("%s(%d): syntax error in code block",filename, linenum);
02946                 REJECT;
02947             }
02948         }
02949         else
02950         {
02951             output_error_raw("%s(%d): explicit definitions not permitted in static classes", filename, linenum);
02952             REJECT;
02953         }
02954     }
02955     else
02956         REJECT;
02957     DONE;
02958 }
02959 
02960 static int class_external_function(PARSER, CLASS *oclass, CLASS **eclass,char *fname, int fsize)
02961 {
02962     CLASSNAME classname;
02963     START;
02964     if (LITERAL("function") && WHITE && TERM(name(HERE,classname,sizeof(classname))) && LITERAL("::") && TERM(name(HERE,fname,fsize)) && WHITE,LITERAL(";"))
02965     {
02966         if (oclass->module==NULL)
02967         {
02968             CLASS *oclass = class_get_class_from_classname(classname);
02969             if (oclass==NULL) 
02970             {
02971                 output_error_raw("%s(%d): class '%s' does not exist", filename, linenum, classname);
02972                 REJECT;
02973             }
02974             else
02975             {
02976                 if (class_get_function(classname,fname))
02977                 {
02978                     *eclass = oclass;
02979                     ACCEPT;
02980                 }
02981                 else
02982                 {
02983                     output_error_raw("%s(%d): class '%s' does not define function '%s'", filename, linenum, classname, fname);
02984                     REJECT;
02985                 }
02986             }
02987         }
02988         else
02989         {
02990             output_error_raw("%s(%d): external functions not permitted in static classes", filename, linenum);
02991             REJECT;
02992         }
02993     }
02994     else
02995         REJECT;
02996     DONE;
02997 }
02998 
02999 static int class_properties(PARSER, CLASS *oclass, int64 *functions, char *initcode, int initsize)
03000 {
03001     static char code[65536];
03002     char arglist[1024];
03003     char fname[64];
03004     CLASS *eclass;
03005     PROPERTYTYPE type;
03006     PROPERTYNAME propname;
03007     KEYWORD *keys = NULL;
03008     UNIT *pUnit=NULL;
03009     START;
03010     if WHITE ACCEPT;
03011     if TERM(class_intrinsic_function(HERE,oclass,functions,code,sizeof(code)))
03012     {
03013         ACCEPT;
03014     }
03015     else if TERM(class_external_function(HERE,oclass,&eclass,fname,sizeof(fname)))
03016     {
03017         append_global("FUNCTIONADDR %s::%s = NULL;\n",oclass->name,fname);
03018         if (global_getvar("noglmrefs",NULL,0)==NULL)
03019             append_init("#line %d \"%s\"\n\tif ((%s::%s=gl_get_function(\"%s\",\"%s\"))==NULL) throw \"%s::%s not defined\";\n", 
03020                 linenum, forward_slashes(filename), oclass->name, fname, 
03021                 eclass->name, fname, eclass->name, fname);
03022         append_code("\tstatic FUNCTIONADDR %s;\n",fname);
03023         ACCEPT;
03024     }
03025     else if TERM(class_explicit_definition(HERE, oclass))
03026     {
03027         ACCEPT;
03028     }
03029     else if TERM(class_export_function(HERE, oclass,fname,sizeof(fname),arglist,sizeof(arglist),code,sizeof(code)))
03030     {
03031         /* TODO add to global block */
03032         ACCEPT;
03033     }
03034     else if (TERM(property_type(HERE,&type,&keys)) && (WHITE,(TERM(nameunit(HERE,propname,sizeof(propname),&pUnit))||TERM(name(HERE,propname,sizeof(propname))))) && (WHITE,LITERAL(";")) )
03035     {
03036         PROPERTY *prop = class_find_property(oclass,propname);
03037         if (prop==NULL)
03038         {
03039             if (type==PT_void)
03040             {
03041                 output_error_raw("%s(%d): property type %s is not recognized", filename, linenum, type);
03042                 REJECT;
03043             }
03044             else
03045             {
03046                 if (pUnit != NULL)
03047                 {
03048                     if (type==PT_double || type==PT_complex)
03049                         prop = class_add_extended_property(oclass,propname,type,pUnit->name);
03050                     else
03051                     {
03052                         output_error_raw("%s(%d): units not permitted for type %s", filename, linenum, class_get_property_typename(type));
03053                         REJECT;
03054                     }
03055                 }
03056                 else if (keys!=NULL)
03057                 {
03058                     if (type==PT_enumeration || type==PT_set)
03059                     {
03060                         prop = class_add_extended_property(oclass,propname,type,NULL);
03061                         prop->keywords = keys;
03062                     }
03063                     else
03064                     {
03065                         output_error_raw("%s(%d): keys not permitted for type %s", filename, linenum, class_get_property_typename(prop->ptype));
03066                         REJECT;
03067                     }
03068                 }
03069                 else
03070                     prop = class_add_extended_property(oclass,propname,type,NULL);
03071                 if (oclass->module==NULL)
03072                 {
03073                     mark_line();
03074                     if (keys!=NULL)
03075                     {
03076                         KEYWORD *key;
03077                         for (key=prop->keywords; key!=NULL; key=key->next)
03078                             append_code("#define %s (0x%x)\n", key->name, key->value);
03079                     }
03080                     append_code("\t%s %s;\n", class_get_property_typename(prop->ptype), prop->name);
03081                     append_code("/*RESETLINE*/\n");
03082                 }
03083             }
03084         }
03085         else if (prop->ptype!=type)
03086         {
03087             output_error_raw("%s(%d): property %s is defined in class %s as type %s", filename, linenum, propname, oclass->name, class_get_property_typename(prop->ptype));
03088             REJECT;
03089         }
03090         ACCEPT;
03091     }
03092     else if LITERAL("}") {/* don't accept yet */ DONE;}
03093     else { syntax_error(HERE); REJECT; }
03094     /* may be repeated */
03095     if TERM(class_properties(HERE,oclass,functions,initcode,initsize)) ACCEPT;
03096     DONE;
03097 }
03098 
03099 static int class_block(PARSER)
03100 {
03101     CLASSNAME classname;
03102     CLASS *oclass;
03103     int startline;
03104     int64 functions = 0;
03105     char initcode[65536]="";
03106     char parent[64];
03107     enum {NONE, PRIVATE, PROTECTED, PUBLIC, EXTERNAL} inherit = NONE;
03108     START;
03109     if WHITE ACCEPT;
03110     if (LITERAL("class") && WHITE) /* enforced whitespace */
03111     {
03112         startline = linenum;
03113         if TERM(name(HERE,classname,sizeof(classname)))
03114         {
03115             if (WHITE,LITERAL(":"))
03116             {
03117                 if WHITE ACCEPT;
03118                 if (LITERAL("public") && WHITE && TERM(name(HERE,parent,sizeof(parent))) )
03119                 {
03120                     inherit = PUBLIC;
03121                     ACCEPT;
03122                 }
03123                 else if (LITERAL("protected") && WHITE && TERM(name(HERE,parent,sizeof(parent))) )
03124                 {
03125                     inherit = PROTECTED;
03126                     ACCEPT;
03127                 }
03128                 else if (LITERAL("private") && WHITE && TERM(name(HERE,parent,sizeof(parent))) )
03129                 {
03130                     inherit = PRIVATE;
03131                     ACCEPT;
03132                 }
03133                 else
03134                 {
03135                     output_error_raw("%s(%d): missing inheritance qualifier", filename, linenum);
03136                     REJECT;
03137                     DONE;
03138                 }
03139                 if (class_get_class_from_classname(parent)==NULL)
03140                 {
03141                     output_error_raw("%s(%d): class %s inherits from undefined class %s", filename, linenum, classname, parent);
03142                     REJECT;
03143                     DONE;
03144                 }
03145             }
03146             if WHITE ACCEPT;
03147             if LITERAL("{")
03148             {
03149                 oclass = class_get_class_from_classname(classname);
03150                 if (oclass==NULL)
03151                 {
03152                     oclass = class_register(NULL,classname,0,0x00);
03153                     mark_line();
03154                     switch (inherit) {
03155                     case NONE:
03156                         append_code("class %s {\npublic:\n\t%s(MODULE*mod) {};\n", oclass->name, oclass->name);
03157                         break;
03158                     case PRIVATE:
03159                         append_code("class %s : private %s {\npublic:\n\t%s(MODULE*mod) : %s(mod) {};\n", oclass->name, parent, oclass->name, parent);
03160                         oclass->parent = class_get_class_from_classname(parent);
03161                         break;
03162                     case PROTECTED:
03163                         append_code("class %s : protected %s {\npublic:\n\t%s(MODULE*mod) : %s(mod) {};\n", oclass->name, parent, oclass->name, parent);
03164                         oclass->parent = class_get_class_from_classname(parent);
03165                         break;
03166                     case PUBLIC:
03167                         append_code("class %s : public %s {\npublic:\n\t%s(MODULE*mod) : %s(mod) {};\n", oclass->name, parent, oclass->name, parent);
03168                         oclass->parent = class_get_class_from_classname(parent);
03169                         break;
03170                     default:
03171                         output_error("class_block inherit status is invalid (inherit=%d)", inherit);
03172                         REJECT;
03173                         DONE;
03174                         break;
03175                     }
03176                     mark_line();
03177                 }
03178                 ACCEPT;
03179             }
03180             else
03181             {
03182                 output_error_raw("%s(%d): expected class %s block opening {",filename,linenum,classname);
03183                 REJECT;
03184             }
03185         }
03186         else
03187         {
03188             output_error_raw("%s(%d): expected class name",filename,linenum);
03189             REJECT;
03190         }
03191         if (TERM(class_properties(HERE,oclass,&functions,initcode,sizeof(initcode)))) ACCEPT;
03192         if WHITE ACCEPT;
03193         if LITERAL("}")
03194         {
03195             if (oclass->module==NULL)
03196             {
03197                 append_code("};\n");
03198 #define ENTERING(OBJ,X) if (strstr(global_trace,#X)!=NULL) append_code("trace(\"call %s::%s\",("#OBJ"));",oclass->name,#X)
03199 #define EXITING(OBJ,X) if (strstr(global_trace,#X)!=NULL) append_code("trace(\"exit %s::%s\",("#OBJ"));",oclass->name,#X)
03200 
03201                 append_code("/*RESETLINE*/\n");
03202                 append_code("/*RESETLINE*/\n");
03203                 append_code("extern \"C\" int64 create_%s(OBJECT **obj, OBJECT *parent)\n{\n",oclass->name);
03204                 append_code(
03205                         "\tif ((*obj=gl_create_object(myclass))==NULL)\n\t\treturn 0;\n"
03206                         "\tgl_set_parent(*obj,parent);\n", oclass->name,oclass->name);
03207                     if (functions&FN_CREATE) 
03208                     {
03209                         ENTERING(*obj,create);
03210                         append_code("\tint64 ret = ((%s*)((*obj)+1))->create(parent);\n",oclass->name);
03211                         EXITING(*obj,create);
03212                         append_code("\treturn ret;\n}\n");
03213                     }
03214                     else
03215                         append_code("\treturn 1;\n}\n");
03216                 if (functions&FN_INIT) {
03217                     append_code("/*RESETLINE*/\n");
03218                     append_code("extern \"C\" int64 init_%s(OBJECT *obj, OBJECT *parent)\n{\n",oclass->name);
03219                     ENTERING(*obj,create);
03220                     append_code("\tint64 ret = ((%s*)(obj+1))->init(parent);\n",oclass->name);
03221                     EXITING(*obj,create);
03222                     append_code("\treturn ret;\n}\n");
03223                 }
03224                 if (functions&FN_SYNC || functions&FN_PRESYNC || functions&FN_POSTSYNC) {
03225                     append_code("/*RESETLINE*/\n");
03226                     append_code("extern \"C\" int64 sync_%s(OBJECT *obj, TIMESTAMP t1, PASSCONFIG pass)\n{\n",oclass->name);
03227                     append_code("\tint64 t2 = TS_NEVER;\n\tswitch (pass) {\n");
03228                     if (functions&FN_PRESYNC)
03229                     {
03230                         append_code("\tcase PC_PRETOPDOWN:\n");
03231                         ENTERING(obj,presync);
03232                         append_code("\t\tt2=((%s*)(obj+1))->presync(obj->clock,t1);\n",oclass->name);
03233                         EXITING(obj,presync);
03234                         if ((functions&(FN_SYNC|FN_POSTSYNC))==0)
03235                             append_code("\t\tobj->clock = t1;\n");
03236                         append_code("\t\tbreak;\n");
03237                     }
03238                     if (functions&FN_SYNC)
03239                     {
03240                         append_code("\tcase PC_BOTTOMUP:\n");
03241                         ENTERING(obj,sync);
03242                         append_code("\t\tt2=((%s*)(obj+1))->sync(obj->clock,t1);\n",oclass->name);
03243                         EXITING(obj,sync);
03244                         if ((functions&FN_POSTSYNC)==0)
03245                             append_code("\t\tobj->clock = t1;\n");
03246                         append_code("\t\tbreak;\n");
03247                     }
03248                     if (functions&FN_POSTSYNC)
03249                     {
03250                         append_code("\tcase PC_POSTTOPDOWN:\n");
03251                         ENTERING(obj,postsync);
03252                         append_code("\t\tt2=((%s*)(obj+1))->postsync(obj->clock,t1);\n",oclass->name);
03253                         EXITING(obj,postsync);
03254                         append_code("\t\tobj->clock = t1;\n");
03255                         append_code("\t\tbreak;\n");
03256                     }
03257                     append_code("\tdefault:\n\t\tbreak;\n\t}\n\treturn t2;\n}\n");
03258                 }
03259                 if (functions&FN_PLC) {
03260                     append_code("/*RESETLINE*/\n");
03261                     append_code("extern \"C\" int64 plc_%s(OBJECT *obj, TIMESTAMP t1)\n{\n",oclass->name);
03262                     ENTERING(obj,plc);
03263                     append_code("\tint64 t2 = ((%s*)(obj+1))->plc(obj->clock,t1);\n",oclass->name);
03264                     EXITING(obj,plc);
03265                     append_code("\treturn t2;\n}\n");
03266                 }
03267                 if (functions&FN_ISA) {
03268                     append_code("/*RESETLINE*/\n");
03269                     append_code("extern \"C\" int64 isa_%s(OBJECT *obj, char *type)\n{\n",oclass->name);
03270                     ENTERING(obj,isa);
03271                     append_code("\tint64 ret = ((%s*)(obj+1))->isa(type);\n",oclass->name);
03272                     EXITING(obj,isa);
03273                     append_code("\treturn ret;\n}\n");
03274                 }
03275                 if (functions&FN_NOTIFY) {
03276                     append_code("/*RESETLINE*/\n");
03277                     append_code("extern \"C\" int64 notify_%s(OBJECT *obj, NOTIFYMODULE msg)\n{\n",oclass->name);
03278                     ENTERING(obj,notify);
03279                     append_code("\tint ret64 = ((%s*)(obj+1))->isa(type);\n",oclass->name);
03280                     EXITING(obj,notify);
03281                     append_code("\treturn ret;\n}\n");
03282                 }
03283                 if (functions&FN_RECALC) {
03284                     append_code("/*RESETLINE*/\n");
03285                     append_code("extern \"C\" int64 recalc_%s(OBJECT *obj)\n{\n",oclass->name);
03286                     ENTERING(obj,recalc);
03287                     append_code("\tint ret64 = ((%s*)(obj+1))->recalc();\n",oclass->name);
03288                     EXITING(obj,recalc);
03289                     append_code("\treturn ret;\n}\n");
03290                 }
03291 
03292                 /* TODO add other intrinsics (notify, recalc, isa) */
03293                 if (!compile_code(oclass,functions)) REJECT;
03294             }               
03295             ACCEPT;
03296         }
03297         else
03298         {
03299             output_error_raw("%s(%d): expected closing } after class block", filename, linenum);
03300             REJECT;
03301         }
03302     }
03303     else REJECT;
03304     DONE;
03305 }
03306 
03307 int set_flags(OBJECT *obj, char1024 propval)
03308 {
03309     extern KEYWORD oflags[];
03310     if (convert_to_set(propval,&(obj->flags),object_flag_property())<=0)
03311     {
03312         output_error_raw("%s(%d): flags of %s:%d %s could not be set to %s", filename, linenum, obj->oclass->name, obj->id, obj->name, propval);
03313         return 0;
03314     };
03315     return 1;
03316 }
03317 
03318 int is_int(PROPERTYTYPE pt){
03319     if(pt == PT_int16 || pt == PT_int32 || pt == PT_int64){
03320         return (int)pt;
03321     } else {
03322         return 0;
03323     }
03324 }
03325 
03326 static int schedule_ref(PARSER, SCHEDULE **sch)
03327 {
03328     char name[64];
03329     START;
03330     if WHITE ACCEPT;
03331     if (TERM(dashed_name(HERE,name,sizeof(name))))
03332     {
03333         ACCEPT;
03334         if (((*sch)=schedule_find_byname(name))==NULL)
03335             REJECT;
03336     }
03337     else
03338         REJECT;
03339     DONE;
03340 }
03341 static int property_ref(PARSER, XFORMSOURCE *xstype, void **ref, OBJECT *from)
03342 {
03343     FULLNAME oname;
03344     PROPERTYNAME pname;
03345     START;
03346     if WHITE ACCEPT;
03347     if (TERM(name(HERE,oname,sizeof(oname))) && LITERAL(".") && TERM(dotted_name(HERE,pname,sizeof(pname))))
03348     {
03349         OBJECT *obj = (strcmp(oname,"this")==0 ? from : object_find_name(oname));
03350 
03351         // object isn't defined yet
03352         if (obj==NULL)
03353         {
03354             // add to unresolved list
03355             char id[1024];
03356             sprintf(id,"%s.%s",oname,pname);
03357             *ref = (void*)add_unresolved(from,PT_double,NULL,from->oclass,id,filename,linenum,UR_TRANSFORM);
03358             ACCEPT;
03359         }
03360         else 
03361         {
03362             PROPERTY *prop = object_get_property(obj,pname);
03363             if (prop==NULL)
03364             {
03365                 output_error_raw("%s(%d): property '%s' of object '%s' not found", filename, linenum, oname,pname);
03366                 REJECT;
03367             }
03368             else if (prop->ptype==PT_double)
03369             {
03370                 *ref = (void*)object_get_addr(obj,pname); 
03371                 *xstype = XS_DOUBLE;
03372                 ACCEPT;
03373             }
03374             else if (prop->ptype==PT_complex)
03375             {
03376                 // TODO support R,I parts
03377                 *ref = (void*)object_get_addr(obj,pname); // get R part only
03378                 *xstype = XS_COMPLEX;
03379                 ACCEPT;
03380             }
03381             else if (prop->ptype==PT_loadshape)
03382             {
03383                 loadshape *ls = (void*)object_get_addr(obj,pname);
03384                 *ref = &(ls->load);
03385                 *xstype = XS_LOADSHAPE;
03386                 ACCEPT;
03387             }
03388             else if (prop->ptype==PT_enduse)
03389             {
03390                 enduse *eu = (void*)object_get_addr(obj,pname);
03391                 *ref = &(eu->total.r);
03392                 *xstype = XS_ENDUSE;
03393             }
03394             else
03395             {
03396                 output_error_raw("%s(%d): transform '%s.%s' does not reference a double or a double container like a loadshape", filename, linenum, oname,pname);
03397                 REJECT;
03398             }
03399         }
03400     }
03401     else
03402     {   REJECT; }
03403     DONE;
03404 }
03405 
03406 static int transform_source(PARSER, XFORMSOURCE *xstype, void **source, OBJECT *from)
03407 {
03408     SCHEDULE *sch;
03409     START;
03410     if WHITE ACCEPT;
03411     if (TERM(schedule_ref(HERE,&sch)))
03412     {
03413         *source = (void*)&(sch->value);
03414         *xstype = XS_SCHEDULE;
03415         ACCEPT;
03416     }
03417     else if (TERM(property_ref(HERE,xstype,source,from)))
03418     {   ACCEPT; }
03419     else
03420     {   REJECT; }
03421     DONE;
03422 }
03423 
03424 static int linear_transform(PARSER, XFORMSOURCE *xstype, void **source, double *scale, double *bias, OBJECT *from)
03425 {
03426     START;
03427     if WHITE ACCEPT;
03428     /* scale * schedule_name [+ bias]  */
03429     if (TERM(functional(HERE,scale)) && (WHITE,LITERAL("*")) && (WHITE,TERM(transform_source(HERE, xstype, source, from))))
03430     {   
03431         if ((WHITE,LITERAL("+")) && (WHITE,TERM(functional(HERE,bias)))) { ACCEPT; }
03432         else { *bias = 0;   ACCEPT;}
03433         DONE;
03434     }
03435     OR
03436     /* scale * schedule_name [- bias]  */
03437     if (TERM(functional(HERE,scale)) &&( WHITE,LITERAL("*")) && (WHITE,TERM(transform_source(HERE,xstype, source,from))))
03438     {
03439         if ((WHITE,LITERAL("-")) && (WHITE,TERM(functional(HERE,bias)))) { *bias *= -1; ACCEPT; }
03440         else { *bias = 0;   ACCEPT;}
03441         DONE;
03442     }
03443     OR
03444     /* schedule_name [* scale] [+ bias]  */
03445     if (TERM(transform_source(HERE,xstype,source,from)))
03446     {
03447         if ((WHITE,LITERAL("*")) && (WHITE,TERM(functional(HERE,scale)))) { ACCEPT; }
03448         else { ACCEPT; *scale = 1;}
03449         if ((WHITE,LITERAL("+")) && (WHITE,TERM(functional(HERE,bias)))) { ACCEPT; DONE; }
03450         OR if ((WHITE,LITERAL("-")) && (WHITE,TERM(functional(HERE,bias)))) { *bias *= -1; ACCEPT; DONE}
03451         else { *bias = 0;   ACCEPT;}
03452         DONE;
03453     }
03454     OR
03455     /* bias + scale * schedule_name  */
03456     if (TERM(functional(HERE,bias)) && (WHITE,LITERAL("+")) && (WHITE,TERM(functional(HERE,scale))) && (WHITE,LITERAL("*")) && (WHITE,TERM(transform_source(HERE,xstype, source,from))))
03457     {
03458         ACCEPT;
03459         DONE;
03460     }
03461     OR
03462     /* bias - scale * schedule_name  */
03463     if (TERM(functional(HERE,bias)) && (WHITE,LITERAL("-")) && (WHITE,TERM(functional(HERE,scale))) && (WHITE,LITERAL("*")) && (WHITE,TERM(transform_source(HERE,xstype, source,from))))
03464     {
03465         *scale *= -1;
03466         ACCEPT;
03467         DONE;
03468     }
03469     OR
03470     /* bias + schedule_name [* scale] */
03471     if (TERM(functional(HERE,bias)) && (WHITE,LITERAL("+")) && (WHITE,TERM(transform_source(HERE,xstype, source,from))))
03472     {
03473         if (WHITE,LITERAL("*") && WHITE,TERM(functional(HERE,scale))) { ACCEPT; }
03474         else { ACCEPT; *scale = 1;}
03475         DONE;
03476     }
03477     OR
03478     /* bias - schedule_name [* scale] */
03479     if (TERM(functional(HERE,bias)) && WHITE,LITERAL("-") && WHITE,TERM(transform_source(HERE,xstype, source,from)))
03480     {
03481         if ((WHITE,LITERAL("*")) && (WHITE,TERM(functional(HERE,scale)))) { ACCEPT; *scale *= -1; }
03482         else { ACCEPT; *scale = 1;}
03483         DONE;
03484     }
03485     REJECT;
03486     DONE;
03487 }
03488 
03489 static int object_block(PARSER, OBJECT *parent, OBJECT **obj);
03490 static int object_properties(PARSER, CLASS *oclass, OBJECT *obj)
03491 {
03492     PROPERTYNAME propname;
03493     char1024 propval;
03494     double dval;
03495     complex cval;
03496     void *source=NULL;
03497     XFORMSOURCE xstype = XS_UNKNOWN;
03498     double scale=1,bias=0;
03499     UNIT *unit=NULL;
03500     OBJECT *subobj=NULL;
03501     START;
03502     if WHITE ACCEPT;
03503     if TERM(line_spec(HERE)) {ACCEPT;}
03504     if WHITE ACCEPT;
03505     if TERM(object_block(HERE,obj,&subobj)) 
03506     {       
03507         if (WHITE,LITERAL(";"))
03508         {   ACCEPT;}
03509         else
03510         {
03511             output_error_raw("%s(%d): missing ; at end of nested object block", filename, linenum,propname);
03512             REJECT;
03513         }
03514             
03515     }
03516     else if (TERM(dotted_name(HERE,propname,sizeof(propname))) && WHITE)
03517     {
03518         PROPERTY *prop = class_find_property(oclass,propname);
03519         OBJECT *subobj=NULL;
03520         current_object = obj; /* object context */
03521         current_module = obj->oclass->module; /* module context */
03522         if (prop!=NULL && prop->ptype==PT_object && TERM(object_block(HERE,NULL,&subobj)))
03523         {
03524             char objname[64];
03525             if (subobj->name) strcpy(objname,subobj->name); else sprintf(objname,"%s:%d", subobj->oclass->name,subobj->id);
03526             if (object_set_value_by_name(obj,propname,objname))
03527                 ACCEPT
03528             else
03529             {
03530                 output_error_raw("%s(%d): unable to link subobject to property '%s'", filename, linenum,propname);
03531                 REJECT;
03532             }
03533         }
03534         else if (prop!=NULL && prop->ptype==PT_complex && TERM(complex_unit(HERE,&cval,&unit)))
03535         {
03536             if (unit!=NULL && prop->unit!=NULL && strcmp((char *)unit, "") != 0 && unit_convert_complex(unit,prop->unit,&cval)==0)
03537             {
03538                 output_error_raw("%s(%d): units of value are incompatible with units of property, cannot convert from %s to %s", filename, linenum, unit->name,prop->unit->name);
03539                 REJECT;
03540             }
03541             else if (object_set_complex_by_name(obj,propname,cval)==0)
03542             {
03543                 output_error_raw("%s(%d): property %s of %s %s could not be set to '%g%+gi'", filename, linenum, propname, format_object(obj), cval.r, cval.i);
03544                 REJECT;
03545             }
03546             else
03547                 ACCEPT;
03548         }
03549         else if (prop!=NULL && prop->ptype==PT_double && TERM(expression(HERE, &dval, &unit, obj)))
03550         {
03551             if (unit!=NULL && prop->unit!=NULL && strcmp((char *)unit, "") != 0 && unit_convert_ex(unit,prop->unit,&dval)==0)
03552             {
03553                 output_error_raw("%s(%d): units of value are incompatible with units of property, cannot convert from %s to %s", filename, linenum, unit->name,prop->unit->name);
03554                 REJECT;
03555             }
03556             else if (object_set_double_by_name(obj,propname,dval)==0)
03557             {
03558                 output_error_raw("%s(%d): property %s of %s %s could not be set to '%g'", filename, linenum, propname, format_object(obj), dval);
03559                 REJECT;
03560             }
03561             else
03562                 ACCEPT;
03563         } 
03564         else if (prop!=NULL && prop->ptype==PT_double && TERM(functional_unit(HERE,&dval,&unit)))
03565         {
03566             if (unit!=NULL && prop->unit!=NULL && strcmp((char *)unit, "") != 0 && unit_convert_ex(unit,prop->unit,&dval)==0)
03567             {
03568                 output_error_raw("%s(%d): units of value are incompatible with units of property, cannot convert from %s to %s", filename, linenum, unit->name,prop->unit->name);
03569                 REJECT;
03570             }
03571             else if (object_set_double_by_name(obj,propname,dval)==0)
03572             {
03573                 output_error_raw("%s(%d): property %s of %s %s could not be set to '%g'", filename, linenum, propname, format_object(obj), dval);
03574                 REJECT;
03575             }
03576             else
03577                 ACCEPT;
03578         }
03579         else if(prop != NULL && is_int(prop->ptype) && TERM(functional_unit(HERE, &dval, &unit))){
03580             int64 ival = 0;
03581             int16 ival16 = 0;
03582             int32 ival32 = 0;
03583             int64 ival64 = 0;
03584             int rv = 0;
03585 
03586             if(unit != NULL && prop->unit != NULL && strcmp((char *)(unit), "") != 0 && unit_convert_ex(unit, prop->unit, &dval) == 0){
03587                 output_error_raw("%s(%d): units of value are incompatible with units of property, cannot convert from %s to %s", filename, linenum, unit->name,prop->unit->name);
03588                 REJECT;
03589             } else {
03590                 switch(prop->ptype){
03591                     case PT_int16:
03592                         ival16 = (int16)dval;
03593                         ival = rv = object_set_int16_by_name(obj, propname, ival16);
03594                         break;
03595                     case PT_int32:
03596                         ival = ival32 = (int32)dval;
03597                         rv = object_set_int32_by_name(obj, propname, ival32);
03598                         break;
03599                     case PT_int64:
03600                         ival = ival64 = (int64)dval;
03601                         rv = object_set_int64_by_name(obj, propname, ival64);
03602                         break;
03603                     default:
03604                         output_error("function_int operating on a non-integer (we shouldn't be here)");
03605                         REJECT;
03606                 } /* end switch */
03607                 if(rv == 0){
03608                     output_error_raw("%s(%d): property %s of %s %s could not be set to '%g'", filename, linenum, propname, format_object(obj), ival);
03609                     REJECT;
03610                 } else {
03611                     ACCEPT;
03612                 }
03613 #if 0
03614             if (object_set_double_by_name(obj,propname,dval)==0)
03615             {
03616                 output_message("%s(%d): property %s of %s %s could not be set to '%g'", filename, linenum, propname, format_object(obj), dval);
03617                 REJECT;
03618             } else {
03619                 ACCEPT;
03620             }
03621 #endif
03622             } /* end unit_convert_ex else */
03623         }
03624         else if (prop!=NULL && prop->ptype==PT_double && TERM(linear_transform(HERE, &xstype, &source,&scale,&bias,obj)))
03625         {
03626             double *target = (double*)((char*)(obj+1) + (int64)prop->addr);
03627 
03628             /* add the transform list */
03629             if (!schedule_add_xform(xstype,source,target,scale,bias,obj,prop))
03630             {
03631                 output_error_raw("%s(%d): schedule transform could not be created - %s", filename, linenum, errno?strerror(errno):"(no details)");
03632                 REJECT;
03633             }
03634             else
03635             {
03636                 /* a transform is unresolved */
03637                 if (first_unresolved==source)
03638 
03639                     /* source was the unresolved entry, now it will be the transform itself */
03640                     first_unresolved->ref = (void*)scheduletransform_getnext(NULL);
03641 
03642                 ACCEPT;
03643             }
03644         }
03645         else if TERM(alternate_value(HERE,propval,sizeof(propval)))
03646         {
03647             if (prop==NULL)
03648             {
03649                 /* check for special properties */
03650                 if (strcmp(propname,"root")==0)
03651                     obj->parent = NULL;
03652                 else if (strcmp(propname,"parent")==0)
03653                 {
03654                     if (add_unresolved(obj,PT_object,(void*)&obj->parent,oclass,propval,filename,linenum,UR_RANKS)==NULL)
03655                     {
03656                         output_error_raw("%s(%d): unable to add unresolved reference to parent %s", filename, linenum, propval);
03657                         REJECT;
03658                     }
03659                     else
03660                         ACCEPT;
03661                 }
03662                 else if (strcmp(propname,"rank")==0)
03663                 {
03664                     if ((obj->rank = atoi(propval))<0)
03665                     {
03666                         output_error_raw("%s(%d): unable to set rank to %s", filename, linenum, propval);
03667                         REJECT;
03668                     }
03669                     else
03670                         ACCEPT;
03671                 }
03672                 else if (strcmp(propname,"clock")==0)
03673                 {
03674                     obj->clock = atoi64(propval); // @todo convert_to_timestamp should be used
03675                     ACCEPT;
03676                 }
03677                 else if (strcmp(propname,"valid_to")==0)
03678                 {
03679                     obj->valid_to = atoi64(propval); // @todo convert_to_timestamp should be used
03680                     ACCEPT;
03681                 }
03682                 else if (strcmp(propname,"latitude")==0)
03683                 {
03684                     obj->latitude = load_latitude(propval);
03685                     ACCEPT;
03686                 }
03687                 else if (strcmp(propname,"longitude")==0)
03688                 {
03689                     obj->longitude = load_longitude(propval);
03690                     ACCEPT;
03691                 }
03692                 else if (strcmp(propname,"in")==0)
03693                 {
03694                     obj->in_svc = convert_to_timestamp(propval);
03695                     ACCEPT;
03696                 }
03697                 else if (strcmp(propname,"out")==0)
03698                 {
03699                     obj->out_svc = convert_to_timestamp(propval);
03700                     ACCEPT;
03701                 }
03702                 else if (strcmp(propname,"name")==0)
03703                 {
03704                     if (object_set_name(obj,propval)==NULL)
03705                     {
03706                         output_error_raw("%s(%d): property name %s could not be used", filename, linenum, propval);
03707                         REJECT;
03708                     }
03709                     else
03710                         ACCEPT;
03711                 }
03712                 else if (strcmp(propname,"groupid")==0){
03713                     strncpy(obj->groupid, propval, sizeof(obj->groupid));
03714                 }
03715                 else if (strcmp(propname,"flags")==0)
03716                 {
03717                     if(set_flags(obj,propval) == 0)
03718                     {
03719                         REJECT;
03720                     }
03721                     else
03722                         ACCEPT;
03723                 }
03724                 else if (strcmp(propname,"library")==0)
03725                 {
03726                     output_warning("%s(%d): libraries not yet supported", filename, linenum);
03727                     /* TROUBLESHOOT
03728                         An attempt to use the <b>library</b> GLM directive was made.  Library directives
03729                         are not supported yet.
03730                      */
03731                     ACCEPT;
03732                     DONE;
03733                 }
03734                 else
03735                 {
03736                     output_error_raw("%s(%d): property %s is not defined in class %s", filename, linenum, propname, oclass->name);
03737                     REJECT;
03738                 }
03739             }
03740             else if (prop->ptype==PT_object)
03741             {   void *addr = object_get_addr(obj,propname);
03742                 if (addr==NULL)
03743                 {
03744                     output_error_raw("%s(%d): unable to get %s member %s", filename, linenum, format_object(obj), propname);
03745                     REJECT;
03746                 }
03747                 else
03748                 {
03749                     add_unresolved(obj,PT_object,addr,oclass,propval,filename,linenum,UR_NONE);
03750                     ACCEPT;
03751                 }
03752             }
03753             else if (object_set_value_by_name(obj,propname,propval)==0)
03754             {
03755                 output_error_raw("%s(%d): property %s of %s could not be set to '%s'", filename, linenum, propname, format_object(obj), propval);
03756                 REJECT;
03757             }
03758             else
03759                 ACCEPT; // @todo shouldn't this be REJECT?
03760         }
03761         if WHITE ACCEPT;
03762         if LITERAL(";") {ACCEPT;}
03763         else
03764         {
03765             output_error_raw("%s(%d): expected ';' at end of property specification", filename,linenum);
03766             REJECT;
03767         }
03768     }
03769     else if LITERAL("}") {/* don't accept yet */ DONE;}
03770     else { syntax_error(HERE); REJECT; }
03771     /* may be repeated */
03772     if TERM(object_properties(HERE,oclass,obj)) ACCEPT;
03773     DONE;
03774 }
03775 
03776 static int object_name_id(PARSER,char *classname, int64 *id)
03777 {
03778     START;
03779     if WHITE ACCEPT;
03780     if TERM(dotted_name(HERE,classname,sizeof(CLASSNAME)))
03781     {
03782         *id = -1; /* anonymous object */
03783         if LITERAL(":")
03784         {
03785             TERM(integer(HERE,id));
03786         }
03787         ACCEPT;
03788         DONE;
03789     }
03790     else if TERM(name(HERE,classname,sizeof(CLASSNAME)))
03791     {
03792         *id = -1; /* anonymous object */
03793         if LITERAL(":")
03794         {
03795             TERM(integer(HERE,id));
03796         }
03797         ACCEPT;
03798         DONE;
03799     }
03800     else
03801         REJECT;
03802 }
03803 
03804 static int object_name_id_range(PARSER,char *classname, int64 *from, int64 *to)
03805 {
03806     START;
03807     if WHITE ACCEPT;
03808     if (TERM(dotted_name(HERE,classname,sizeof(CLASSNAME))) && LITERAL(":") && TERM(integer(HERE,from)) && LITERAL("..")) ACCEPT
03809     else if (TERM(name(HERE,classname,sizeof(CLASSNAME))) && LITERAL(":") && TERM(integer(HERE,from)) && LITERAL("..")) ACCEPT
03810     else REJECT;
03811     if (TERM(integer(HERE,to))) ACCEPT else
03812     {
03813         output_error_raw("%s(%d): expected id range end value", filename, linenum);
03814         REJECT;
03815     }
03816     DONE;
03817 }
03818 
03819 static int object_name_id_count(PARSER,char *classname, int64 *count)
03820 {
03821     START;
03822     if WHITE ACCEPT;
03823     if (TERM(dotted_name(HERE,classname,sizeof(CLASSNAME))) && LITERAL(":") && LITERAL("..")) ACCEPT
03824     else if (TERM(name(HERE,classname,sizeof(CLASSNAME))) && LITERAL(":") && LITERAL("..")) ACCEPT
03825     else REJECT;
03826     if (TERM(integer(HERE,count))) ACCEPT else
03827     {
03828         output_error_raw("%s(%d): expected id count", filename, linenum);
03829         REJECT;
03830     }
03831     DONE;
03832 }
03833 
03834 static int object_block(PARSER, OBJECT *parent, OBJECT **subobj)
03835 {
03836 #define NAMEOBJ  /* DPC: not sure what this does, but it doesn't seem to be harmful */
03837 #ifdef NAMEOBJ
03838     static OBJECT nameobj;
03839 #endif
03840     FULLNAME space;
03841     CLASSNAME classname;
03842     CLASS *oclass;
03843     OBJECT *obj=NULL;
03844     int64 id=-1, id2=-1;
03845     START;
03846 
03847     if WHITE ACCEPT;
03848     if (LITERAL("namespace") && (WHITE,TERM(name(HERE,space,sizeof(space)))) && (WHITE,LITERAL("{")))
03849     {
03850         if (!object_open_namespace(space))
03851         {
03852             output_error_raw("%s(%d): namespace %s could not be opened", filename, linenum, space);
03853             REJECT;
03854         }
03855 
03856         while (TERM(object_block(HERE,parent,subobj))) {LITERAL(";");}
03857         while (WHITE);
03858         if (LITERAL("}"))
03859         {   object_close_namespace();
03860             ACCEPT;
03861             DONE;
03862         }
03863         else
03864         {
03865             output_error_raw("%s(%d): namespace %s missing closing }", filename, linenum, space);
03866             REJECT;
03867         }
03868     }
03869 
03870     if WHITE ACCEPT;
03871     if (LITERAL("object") && WHITE) ACCEPT else REJECT /* enforced whitespace */
03872     //if WHITE ACCEPT;
03873     if TERM(object_name_id_range(HERE,classname,&id,&id2))
03874     {
03875         oclass = class_get_class_from_classname(classname);
03876         if (oclass==NULL) 
03877         {
03878             output_error_raw("%s(%d): class '%s' is not known", filename, linenum, classname);
03879             REJECT;
03880         }
03881         id2++;
03882         ACCEPT;
03883     }
03884     else if TERM(object_name_id_count(HERE,classname,&id2))
03885     {
03886         id=-1; id2--;  /* count down to zero inclusive */
03887         oclass = class_get_class_from_classname(classname);
03888         if (oclass==NULL) 
03889         {
03890             output_error_raw("%s(%d): class '%s' is not known", filename, linenum, classname);
03891             REJECT;
03892         }
03893         ACCEPT;
03894     }
03895     else if TERM(object_name_id(HERE,classname,&id))
03896     {
03897         oclass = class_get_class_from_classname(classname);
03898         if (oclass==NULL)
03899         {
03900             output_error_raw("%s(%d): class '%s' is not known", filename, linenum, classname);
03901             REJECT;
03902         }
03903         ACCEPT;
03904     }
03905     else
03906     {
03907         output_error_raw("%s(%d): expected object id or range", filename, linenum);
03908         REJECT;
03909     }
03910     if WHITE ACCEPT;
03911     if (LITERAL("{")) ACCEPT else
03912     {
03913         output_error_raw("%s(%d): expected object block starting {", filename, linenum);
03914         REJECT;
03915     }
03916 
03917     /* id(s) is/are valid */
03918 #ifdef NAMEOBJ
03919     nameobj.name = classname;
03920 #endif
03921     if (id2==-1) id2=id+1; /* create singleton */
03922     BEGIN_REPEAT;
03923     while (id<id2)
03924     {
03925         REPEAT;
03926 #ifdef NAMEOBJ
03927         obj = &nameobj;
03928 #endif
03929         if (oclass->create==NULL)
03930         {
03931             output_error_raw("%s(%d): create not implemented for objects of class %s", filename, linenum, classname);
03932             REJECT;
03933         }
03934         else if ((*oclass->create)(&obj,parent)==0) 
03935         {
03936             output_error_raw("%s(%d): create failed for object %s:%d", filename, linenum, classname, id);
03937             REJECT;
03938         }
03939         else if (obj==NULL
03940 #ifdef NAMEOBJ
03941             || obj==&nameobj
03942 #endif
03943             ) 
03944         {
03945             output_error_raw("%s(%d): create failed name object %s:%d", filename, linenum, classname, id);
03946             REJECT;
03947         }
03948         else if (id!=-1 && load_set_index(obj,(OBJECTNUM)id)==FAILED)
03949         {
03950             output_error_raw("%s(%d): unable to index object id number for %s:%d", filename, linenum, classname, id);
03951             REJECT;
03952         }
03953         else if TERM(object_properties(HERE,oclass,obj))
03954         {
03955             ACCEPT;
03956         } 
03957         else REJECT;
03958         if (id==-1) id2--; else id++;
03959     }
03960     END_REPEAT;
03961     if WHITE ACCEPT;
03962     if LITERAL("}") ACCEPT else
03963     {
03964         output_error_raw("%s(%d): expected object block closing }", filename, linenum);
03965         REJECT;
03966     }
03967     if (subobj) *subobj = obj;
03968     DONE;
03969 }
03970 
03971 static int import(PARSER)
03972 {
03973     char32 modname;
03974     char1024 fname;
03975     START;
03976     if WHITE ACCEPT;
03977     if (LITERAL("import") && WHITE) /* enforced whitespace */
03978     {
03979         if (TERM(name(HERE,modname,sizeof(modname))) && WHITE) /* enforced whitespace */
03980         {
03981             current_object = NULL; /* object context */
03982             current_module = NULL; /* module context */
03983             if TERM(alternate_value(HERE,fname,sizeof(fname)))
03984             {
03985                 if LITERAL(";")
03986                 {
03987                     int result;
03988                     MODULE *module = module_find(modname);
03989                     if (module==NULL)
03990                     {
03991                         output_error_raw("%s(%d): module %s not loaded", filename, linenum, modname);
03992                         REJECT;
03993                     }
03994                     result = module_import(module,fname);
03995                     if (result < 0)
03996                     {
03997                         output_error_raw("%s(%d): %d errors loading importing %s into %s module", filename, linenum, -result, fname, modname);
03998                         REJECT;
03999                     }
04000                     else if (result==0)
04001                     {
04002                         output_error_raw("%s(%d): module %s load of %s failed; %s", filename, linenum, modname, fname, errno?strerror(errno):"(no details)");
04003                         REJECT;
04004                     }
04005                     else
04006                     {
04007                         output_verbose("%d objects loaded to %s from %s", result, modname, fname);
04008                         ACCEPT;
04009                     }
04010                 }
04011                 else
04012                 {
04013                     output_error_raw("%s(%d): expected ; after module %s import from %s statement", filename, linenum, modname, fname);
04014                     REJECT;
04015                 }
04016             }
04017             else
04018             {
04019                 output_error_raw("%s(%d): expected filename after module %s import statement", filename, linenum, modname);
04020                 REJECT;
04021             }
04022         }
04023         else
04024         {
04025             output_error_raw("%s(%d): expected module name after import statement", filename, linenum);
04026             REJECT;
04027         }
04028     }
04029     DONE
04030 }
04031 
04032 static int library(PARSER)
04033 {
04034     START;
04035     if WHITE ACCEPT;
04036     if (LITERAL("library") && WHITE) /* enforced whitespace */
04037     {
04038         char libname[1024];
04039         if ( TERM(dotted_name(HERE,libname,sizeof(libname))) && (WHITE,LITERAL(";")))
04040         {
04041             output_warning("%s(%d): libraries not yet supported", filename, linenum);
04042             /* TROUBLESHOOT
04043                 An attempt to parse a <b>library</b> GLM directive was made.  Library directives
04044                 are not supported yet.
04045              */
04046             ACCEPT;
04047             DONE;
04048         }
04049         else
04050         {
04051             output_error_raw("%s(%d): library syntax error", filename, linenum);
04052             REJECT;
04053         }
04054     }
04055     REJECT;
04056 }
04057 
04058 static int comment_block(PARSER)
04059 {
04060     int startline = linenum;
04061     if (_p[0]=='/' && _p[1]=='*')
04062     {
04063         int result=0;
04064         int matched=0;
04065         _p+=2;
04066         while (_p[0]!='*' && _p[1]=='/')
04067         {
04068             _p++; result++;
04069             if (_p[0]=='\0')
04070             {
04071                 output_error_raw("%s(%d): unterminated C-style comment", filename, startline);
04072                 return 0;
04073             }
04074             if (_p[0]=='\n')
04075                 linenum++;
04076         }
04077         return matched?result:0;
04078     }
04079     return 0;
04080 }
04081 
04082 static int schedule(PARSER)
04083 {
04084     int startline = linenum;
04085     char schedname[64];
04086     START;
04087     if WHITE ACCEPT;
04088     if (LITERAL("schedule") && WHITE && TERM(name(HERE,schedname,sizeof(schedname))) && WHITE,LITERAL("{"))
04089     {
04090         char buffer[65536], *p=buffer;
04091         int nest=0;
04092         for (nest=0; nest>=0; _m++)
04093         {
04094             char c = *HERE;
04095             if (c=='\0') break;
04096             switch (c) {
04097             case '{': nest++; *p++ = c; break;
04098             case '}': if (nest-->0) *p++ = c; break; 
04099             case '\n': *p++ = c; ++linenum; break;
04100             //case '\r': *p++ = c; ++linenum; break;
04101             default: *p++ = c; break;
04102             }
04103             *p = '\0';
04104         }
04105         if (schedule_create(schedname, buffer))
04106         {
04107             ACCEPT;
04108         }
04109         else
04110         {
04111             output_error_raw("%s(%d): schedule '%s' is not valid", filename, startline, schedname);
04112             REJECT;
04113         }
04114     }
04115     else
04116         REJECT;
04117     DONE;
04118 }
04119 
04120 static int gridlabd_file(PARSER)
04121 {
04122     START;
04123     if WHITE {ACCEPT; DONE;}
04124     OR if LITERAL(";") {ACCEPT; DONE;}
04125     OR if TERM(line_spec(HERE)) { ACCEPT; DONE; }
04126     OR if TERM(object_block(HERE,NULL,NULL)) {ACCEPT; DONE;}
04127     OR if TERM(class_block(HERE)) {ACCEPT; DONE;}
04128     OR if TERM(module_block(HERE)) {ACCEPT; DONE;}
04129     OR if TERM(clock_block(HERE)) {ACCEPT; DONE;}
04130     OR if TERM(import(HERE)) {ACCEPT; DONE; }
04131     OR if TERM(library(HERE)) {ACCEPT; DONE; }
04132     OR if TERM(schedule(HERE)) {ACCEPT; DONE; }
04133     OR if (*(HERE)=='\0') {ACCEPT; DONE;}
04134     else REJECT;
04135     DONE;
04136 }
04137 
04138 int replace_variables(char *to,char *from,int len)
04139 {
04140     char *p, *e=from;
04141     int n = 0;
04142     while ((p=strstr(e,"${"))!=NULL)
04143     {
04144         char varname[1024];
04145         if (sscanf(p+2,"%1024[^}]",varname)==1)
04146         {
04147             char *env = getenv(varname);
04148             char *var;
04149             int m = (int)(p-e);
04150             strncpy(to+n,e,m);
04151             n += m;
04152             var =  global_getvar(varname,to+n,len-n);
04153             if (var!=NULL)
04154                 n+=(int)strlen(var);
04155             else if (env!=NULL)
04156             {
04157                 strncpy(to+n,env,len-n);
04158                 n+=(int)strlen(env);
04159             }
04160             else
04161             {
04162                 /* this must be benign because otherwise macros that are inactive fail when they shouldn't */
04163                 output_warning("%s(%d): variable '%s' not found", filename, linenum, varname);
04164                 /* TROUBLESHOOT
04165                     A macro refers to a variable that is not defined.  Correct the variable reference, or
04166                     define the variable before using it and try again.
04167                  */
04168             }
04169             e = strchr(p,'}');
04170             if (e==NULL)
04171                 goto Unterminated;
04172             e++;
04173         }
04174         else
04175         {
04176 Unterminated:
04177             output_error_raw("%s(%d): unterminated variable name %.10p...", filename, linenum, p);
04178             return 1;
04179         }
04180     }
04181 
04182     if ((int)strlen(e)<len-n)
04183     {
04184         strcpy(to+n,e);
04185         return (int)strlen(to);
04186     }
04187     else
04188     {
04189         output_error_raw("%s(%d): insufficient buffer space to continue", filename, linenum);
04190         return -1;
04191     }
04192 }
04193 
04194 static int suppress = 0;
04195 static int nesting = 0;
04196 static int macro_line[64];
04197 static int process_macro(char *line, int size, char *filename, int linenum);
04198 static int buffer_read(FILE *fp, char *buffer, char *filename, int size)
04199 {
04200     char line[65536];
04201     int n=0;
04202     int linenum=0;
04203     int startnest = nesting;
04204     while (fgets(line,sizeof(line),fp)!=NULL)
04205     {
04206         int len;
04207         char subst[65536];
04208 
04209         /* comments must have preceding whitespace in macros */
04210         char *c = line[0]!='#'?strstr(line,COMMENT):strstr(line, " " COMMENT);
04211         linenum++;
04212         if (c!=NULL) /* truncate at comment */
04213             strcpy(c,"\n");
04214         len = (int)strlen(line);
04215         if (len>=size-1)
04216             return 0;
04217 
04218     
04219 #ifndef OLDSTYLE
04220         /* check for oldstyle file under newstyle parse */
04221         if (linenum==1 && strncmp(line,"# ",2)==0)
04222         {
04223             output_error("%s looks like a version 1.x GLM files, please convert this file to new style before loading", filename);
04224             return 0;
04225         }
04226 #endif
04227         /* expand variables */
04228         if ((len=replace_variables(subst,line,sizeof(subst)))>=0)
04229             strcpy(line,subst);
04230         else
04231         {
04232             output_error_raw("%s(%d): unable to continue", filename,linenum);
04233             return -1;
04234         }
04235 
04236         /* expand macros */
04237         if (strncmp(line,MACRO,strlen(MACRO))==0)
04238         {
04239             /* macro disables reading */
04240             if (process_macro(line,sizeof(line),filename,linenum)==FALSE)
04241                 return 0;
04242             len = (int)strlen(line);
04243             strcat(buffer,line);
04244             buffer += len;
04245             size -= len;
04246             n += len;
04247         }
04248 
04249         /* if reading is enabled */
04250         else if (suppress==0)
04251         {
04252             strcpy(buffer,subst);
04253             buffer+=len;
04254             size -= len;
04255             n+=len;
04256         }
04257     }
04258     if (nesting != startnest)
04259     {
04260         //output_message("%s(%d): missing %sendif for #if at %s(%d)", filename,linenum,MACRO,filename,macro_line[nesting-1]);
04261         output_error_raw("%s(%d): Unbalanced %sif/%sendif at %s(%d) ~ started with nestlevel %i, ending %i", filename,linenum,MACRO,MACRO,filename,macro_line[nesting-1], startnest, nesting);
04262         return -1;
04263     }
04264     return n;
04265 }
04266 
04267 static int buffer_read_alt(FILE *fp, char *buffer, char *filename, int size)
04268 {
04269     char line[10240];
04270     char *buf = buffer;
04271     int n = 0, i = 0;
04272     int _linenum=0;
04273     int startnest = nesting;
04274     int bnest = 0, quote = 0;
04275     int hassc = 0; // has semicolon
04276     int quoteline = 0;
04277     while (fgets(line,sizeof(line),fp)!=NULL)
04278     {
04279         int len;
04280         char subst[65536];
04281 
04282         /* comments must have preceding whitespace in macros */
04283         char *c = line[0]!='#'?strstr(line,COMMENT):strstr(line, " " COMMENT);
04284         _linenum++;
04285         if (c!=NULL) /* truncate at comment */
04286             strcpy(c,"\n");
04287         len = (int)strlen(line);
04288         if (len>=size-1){
04289             output_error("load.c: buffer exhaustion reading %i lines past line %i", _linenum, linenum);
04290             if(quote != 0){
04291                 output_error("look for an unterminated doublequote string on line %i", quoteline);
04292             }
04293             return 0;
04294         }
04295     
04296 #ifndef OLDSTYLE
04297         /* check for oldstyle file under newstyle parse */
04298         if (_linenum==1 && strncmp(line,"# ",2)==0)
04299         {
04300             output_error("%s looks like a version 1.x GLM files, please convert this file to new style before loading", filename);
04301             return 0;
04302         }
04303 #endif
04304         /* expand variables */
04305         if ((len=replace_variables(subst,line,sizeof(subst)))>=0)
04306             strcpy(line,subst);
04307         else
04308         {
04309             output_error_raw("%s(%d): unable to continue", filename,_linenum);
04310             return -1;
04311         }
04312 
04313         /* expand macros */
04314         if (strncmp(line,MACRO,strlen(MACRO))==0)
04315         {
04316             /* macro disables reading */
04317             if (process_macro(line,sizeof(line),filename,linenum + _linenum - 1)==FALSE)
04318                 return 0;
04319             strcat(buffer,line);
04320             //strcpy(buffer,line);
04321             len = (int)strlen(buffer); // include anything else in the buffer, then advance
04322             buffer += len;
04323             size -= len;
04324             n += len;
04325         }
04326 
04327         /* if reading is enabled */
04328         else if (suppress==0)
04329         {
04330             strcpy(buffer,subst);
04331             buffer+=len;
04332             size -= len;
04333             n+=len;
04334             for(i = 0; i < len; ++i){
04335                 if(quote == 0){
04336                     if(subst[i] == '\"'){
04337                         quoteline = linenum + _linenum - 1;
04338                         quote = 1;
04339                     } else if(subst[i] == '{'){
04340                         ++bnest;
04341                         ++hassc;
04342                     } else if(subst[i] == '}'){
04343                         --bnest;
04344                     } else if(subst[i] == ';'){
04345                         ++hassc;
04346                     }
04347                 } else {
04348                     if(subst[i] == '\"'){
04349                         quote = 0;
04350                     }
04351                 }
04352             }
04353         } else {
04354             strcpy(buffer,"\n");
04355             buffer+=strlen("\n");
04356             size -= 1;
04357             n += 1;
04358         }
04359         if(bnest == 0 && hassc > 0 && nesting == startnest){ // make sure we read ALL of an #if block, if possible
04360             /* end of block */
04361             return n;
04362         }
04363 
04364     }
04365     if(quote != 0){
04366         output_warning("unterminated doublequote string");
04367     }
04368     if(bnest != 0){
04369         output_warning("incomplete loader block");
04370     }
04371     if (nesting != startnest)
04372     {
04373         //output_message("%s(%d): missing %sendif for #if at %s(%d)", filename,_linenum,MACRO,filename,macro_line[nesting-1]);
04374         output_error_raw("%s(%d): Unbalanced %sif/%sendif at %s(%d) ~ started with nestlevel %i, ending %i", filename,_linenum,MACRO,MACRO,filename,macro_line[nesting-1], startnest, nesting);
04375         return -1;
04376     }
04377     return n;
04378 }
04379 
04380 
04381 static int include_file(char *incname, char *buffer, int size, int _linenum)
04382 {
04383     int move = 0;
04384     char *p = buffer;
04385     int count = 0;
04386     char *ext = 0;
04387     char *name = 0;
04388     STAT stat;
04389     char *ff = find_file(incname,NULL,R_OK);
04390     FILE *fp = 0;
04391     char buffer2[20480];
04392     unsigned int old_linenum = _linenum;
04393     /* check include list */
04394     INCLUDELIST *list;
04395     INCLUDELIST *this = (INCLUDELIST *)malloc(sizeof(INCLUDELIST));//={incname,include_list}; /* REALLY BAD IDEA ~~ "this" is a reserved C++ keyword */
04396 
04397     strcpy(this->file, incname);
04398     this->next = include_list;
04399     output_verbose("include_file(char *incname='%s', char *buffer=0x%p, int size=%d): search of GLPATH='%s' result is '%s'", 
04400         incname, buffer, size, getenv("GLPATH") ? getenv("GLPATH") : "NULL", ff ? ff : "NULL");
04401 
04402     buffer2[0]=0;
04403     
04404     for (list = include_list; list != NULL; list = list->next)
04405     {
04406         if (strcmp(incname, list->file) == 0)
04407         {
04408             output_error_raw("%s(%d): include file has already been included", incname, _linenum);
04409             return 0;
04410         }
04411     }
04412 
04413     /* if source file, add to header list and keep moving */
04414     ext = strrchr(incname, '.');
04415     name = strrchr(incname, '/');
04416     if (ext>name) {
04417         if(strcmp(ext, ".hpp") == 0 || strcmp(ext, ".h")==0 || strcmp(ext, ".c") == 0 || strcmp(ext, ".cpp") == 0){
04418             // append to list
04419             for (list = header_list; list != NULL; list = list->next){
04420                 if(strcmp(incname, list->file) == 0){
04421                     // normal behavior
04422                     return 0;
04423                 }
04424             }
04425             this->next = header_list;
04426             header_list = this;
04427         }
04428     } else { /* no extension */
04429         for (list = header_list; list != NULL; list = list->next){
04430             if(strcmp(incname, list->file) == 0){
04431                 // normal behavior
04432                 return 0;
04433             }
04434         }
04435         this->next = header_list;
04436         header_list = this;
04437     }
04438 
04439     /* open file */
04440     fp = ff ? fopen(ff, "rt") : NULL;
04441     
04442     if(fp == NULL){
04443         output_error_raw("%s(%d): include file open failed: %s", incname, _linenum, errno?strerror(errno):"(no details)");
04444         return -1;
04445     }
04446 
04447     old_linenum = linenum;
04448     linenum = 1;
04449 
04450     if(FSTAT(fileno(fp), &stat) == 0){
04451         if(stat.st_mtime > modtime){
04452             modtime = stat.st_mtime;
04453         }
04454 
04455         //if(size < stat.st_size){
04457             /* buffer = realloc(buffer,size+stat.st_size); */
04458         //  output_message("%s(%d): unable to grow size of read buffer to include file", incname, linenum);
04459         //  return 0;
04460         //}
04461     } else {
04462         output_error_raw("%s(%d): unable to get size of included file", incname, _linenum);
04463         return -1;
04464     }
04465 
04466     output_verbose("%s(%d): included file is %d bytes long", incname, old_linenum, stat.st_size);
04467 
04468     /* reset line counter for parser */
04469     include_list = this;
04470     //count = buffer_read(fp,buffer,incname,size); // fread(buffer,1,stat.st_size,fp);
04471 
04472     move = buffer_read_alt(fp, buffer2, incname, 20479);
04473     while(move > 0){
04474         count += move;
04475         p = buffer2; // grab a block
04476         while(*p != 0){
04477             // and process it
04478             move = gridlabd_file(p);
04479             if(move == 0)
04480                 break;
04481             p += move;
04482         }
04483         if(*p != 0){
04484             // failed if we didn't parse the whole thing
04485             count = -1;
04486             break;
04487         }
04488         move = buffer_read_alt(fp, buffer2, incname, 20479);
04489     }
04490 
04491     //include_list = this.next;
04492 
04493     linenum = old_linenum;
04494 
04495     return count;
04496 }
04497 
04499 static int process_macro(char *line, int size, char *_filename, int linenum)
04500 {
04501 #ifndef WIN32
04502     char *var, *val, *save; // used by *nix
04503     int i, count;           // used by *nix
04504 #endif
04505     if (strncmp(line,MACRO "endif",6)==0)
04506     {
04507         if (nesting>0)
04508         {
04509             nesting--;
04510             suppress &= ~(1<<nesting);
04511         }
04512         else
04513             output_error_raw("%s(%d): %sendif is mismatched", filename, linenum,MACRO);
04514         strcpy(line,"\n");
04515         return TRUE;
04516     }
04517     else if (strncmp(line,MACRO "else",5)==0)
04518     {
04519         if ( (suppress&(1<<(nesting-1))) == (1<<(nesting-1)) )
04520             suppress &= ~(1<<(nesting-1));
04521         else
04522             suppress |= (1<<(nesting-1));
04523         strcpy(line,"\n");
04524     }
04525     else if (strncmp(line,MACRO "ifdef",6)==0)
04526     {
04527         char *term = strchr(line+6,' ');
04528         char value[1024];
04529         if (term==NULL)
04530         {
04531             output_error_raw("%s(%d): %sifdef macro missing term",filename,linenum,MACRO);
04532             return FALSE;
04533         }
04534         if (sscanf(term+1,"%[^\n]",value)==1 && global_getvar(value, NULL, 0)==NULL && getenv(value)==NULL)
04535             suppress |= (1<<nesting);
04536         macro_line[nesting] = linenum;
04537         nesting++;
04538         strcpy(line,"\n");
04539         return TRUE;
04540     }
04541     else if (strncmp(line,MACRO "ifexist",8)==0)
04542     {
04543         char *term = strchr(line+8,' ');
04544         char value[1024];
04545         if (term==NULL)
04546         {
04547             output_error_raw("%s(%d): %sifexist macro missing term",filename,linenum,MACRO);
04548             return FALSE;
04549         }
04550         while(isspace((unsigned char)(*term)))
04551             ++term;
04552         if (sscanf(term,"\"%[^\"\n]",value)==1 && find_file(value, NULL, 0)==NULL)
04553             suppress |= (1<<nesting);
04554         macro_line[nesting] = linenum;
04555         nesting++;
04556         strcpy(line,"\n");
04557         return TRUE;
04558     }
04559     else if (strncmp(line,MACRO "ifndef",7)==0)
04560     {
04561         char *term = strchr(line+7,' ');
04562         char value[1024];
04563         if (term==NULL)
04564         {
04565             output_error_raw("%s(%d): %sifndef macro missing term",filename,linenum,MACRO);
04566             return FALSE;
04567         }
04568         if (sscanf(term+1,"%[^\n]",value)==1 && (global_getvar(value, NULL, 0)!=NULL || getenv(value)!=NULL))
04569             suppress |= (1<<nesting);
04570         macro_line[nesting] = linenum;
04571         nesting++;
04572         strcpy(line,"\n");
04573         return TRUE;
04574     }
04575     else if (strncmp(line,MACRO "if",3)==0)
04576     {
04577         char var[32], op[4], *value;
04578         char val[1024];
04579         if (sscanf(line+4,"%[a-zA-Z_0-9]%[!<>=]%[^\n]",var,op,val)!=3)
04580         {
04581             output_error_raw("%s(%d): %sif macro statement syntax error", filename,linenum,MACRO);
04582             strcpy(line,"\n");
04583             return FALSE;
04584         }
04585         value = global_getvar(var, NULL, 0);
04586         if (value==NULL)
04587         {
04588             output_error_raw("%s(%d): %s is not defined", filename,linenum,var);
04589             strcpy(line,"\n");
04590             return FALSE;
04591         }
04592         if (strcmp(op,"<")==0) { if (!strcmp(value,val)<0) suppress|=(1<<nesting); }
04593         else if (strcmp(op,">")==0) { if (!strcmp(value,val)>0) suppress|=(1<<nesting); }
04594         else if (strcmp(op,">=")==0) { if (!strcmp(value,val)>=0) suppress|=(1<<nesting); }
04595         else if (strcmp(op,"<=")==0) { if (!strcmp(value,val)<=0) suppress|=(1<<nesting); }
04596         else if (strcmp(op,"==")==0) { if (!strcmp(value,val)==0) suppress|=(1<<nesting); }
04597         else if (strcmp(op,"!=")==0) { if (!strcmp(value,val)!=0) suppress|=(1<<nesting); }
04598         else
04599         {
04600             output_error_raw("%s(%d): operator %s is not recognized", filename,linenum,op);
04601             strcpy(line,"\n");
04602             return FALSE;
04603         }
04604         macro_line[nesting] = linenum;
04605         nesting++;
04606         strcpy(line,"\n");
04607         return TRUE;
04608     }
04609 
04610     /* handles suppressed macros */
04611     if (suppress!=0)
04612     {
04613         strcpy(line,"\n");
04614         return TRUE;
04615     }
04616 
04617     /* these macros can be suppressed */
04618     if (strncmp(line,MACRO "include",8)==0)
04619     {
04620         char *term = strchr(line+8,' ');
04621         char value[1024];
04622         char oldfile[1024];
04623         if (term==NULL)
04624         {
04625             output_error_raw("%s(%d): %sinclude macro missing term",filename,linenum,MACRO);
04626             strcpy(line,"\n");
04627             return FALSE;
04628         }
04629         while(isspace((unsigned char)(*term)))
04630             ++term;
04631         if (sscanf(term,"\"%[^\"]\"",value)==1)
04632         {
04633             char *start=line;
04634             int len = sprintf(line,"@%s;%d\n",value,0);
04635             line+=len; size-=len;
04636             strcpy(oldfile, filename);  // push old filename
04637             strcpy(filename, value);    // use include file name for errors while within context
04638             len=(int)include_file(value,line,size,linenum);
04639             strcpy(filename, oldfile);  // pop include filename, use calling filename
04640             if (len<0)
04641             {
04642                 output_error_raw("%s(%d): #include failed",filename,linenum);
04643                 include_fail = 1;
04644                 strcpy(line,"\n");
04645                 return FALSE;
04646             }
04647             else
04648             {
04649 //              line+=len; size-=len; // not relevant to the block loader, was already consumed
04650                 len = sprintf(line,"@%s;%d\n",filename,linenum);
04651                 line+=len; size-=len;
04652                 return size>0;
04653             }
04654         } else if(sscanf(term, "<%[^>]>", value) == 1){
04655             /* C include file */
04656             output_verbose("added C include for \"%s\", value");
04657             append_code(value);
04658         } else
04659         {
04660             output_error_raw("%s(%d): #include failed",filename,linenum);
04661                 strcpy(line,"\n");
04662                 return FALSE;
04663         }
04664     }
04665     else if (strncmp(line,MACRO "setenv",7)==0)
04666     {
04667         char *term = strchr(line+7,' ');
04668         char value[65536];
04669         if (term==NULL)
04670         {
04671             output_error_raw("%s(%d): %ssetenv macro missing term",filename,linenum,MACRO);
04672             strcpy(line,"\n");
04673             return FALSE;
04674         }
04675         if (sscanf(term+1,"%[^\n]",value)==1)
04676         {
04677 /*          if(0 == putenv(value)){;
04678                 strcpy(line,"\n");
04679                 return SUCCESS;
04680             }
04681             else
04682             {
04683                 output_fatal("unable to putenv(%s)", value);
04684                 return FAILED;
04685             }
04686  */
04687 #ifdef WIN32
04688             putenv(value);
04689 #else
04690             var = strtok_r(value, "=", &save);
04691                         val = strtok_r(NULL, "=", &save);
04692                         setenv(var, val, 1);
04693 #endif
04694             strcpy(line,"\n");
04695             return SUCCESS;
04696         }
04697         else
04698         {
04699             output_error_raw("%s(%d): %ssetenv term missing or invalid",filename,linenum,MACRO);
04700             strcpy(line,"\n");
04701             return FALSE;
04702         }
04703     }
04704     else if (strncmp(line,MACRO "set",4)==0)
04705     {
04706         char *term = strchr(line+4,' ');
04707         char value[1024];
04708         if (term==NULL)
04709         {
04710             output_error_raw("%s(%d): %sset macro missing term",filename,linenum,MACRO);
04711             strcpy(line,"\n");
04712             return FALSE;
04713         }
04714         if (sscanf(term+1,"%[^\n]",value)==1)
04715         {
04716             STATUS result;
04717             if (strchr(value,'=')==NULL)
04718             {
04719                 output_error_raw("%s(%d): %sset missing assignment",filename,linenum,MACRO);
04720                 return FAILED;
04721             }
04722             else
04723             {
04724                 int oldstrict = global_strictnames;
04725                 global_strictnames = TRUE;
04726                 result = global_setvar(value);
04727                 global_strictnames = oldstrict;
04728                 if (result==FAILED)
04729                     output_error_raw("%s(%d): %sset term not found",filename,linenum,MACRO);
04730                 strcpy(line,"\n");
04731                 return result==SUCCESS;
04732             }
04733         }
04734         else
04735         {
04736             output_error_raw("%s(%d): %sset term missing or invalid",filename,linenum,MACRO);
04737             strcpy(line,"\n");
04738             return FALSE;
04739         }
04740     }
04741     else if (strncmp(line,MACRO "binpath",8)==0)
04742     {
04743         char *term = strchr(line+8,' ');
04744         char value[1024];
04745         if (term==NULL)
04746         {
04747             output_error_raw("%s(%d): %sbinpath macro missing term",filename,linenum,MACRO);
04748             strcpy(line,"\n");
04749             return FALSE;
04750         }
04751         if (sscanf(term+1,"%[^\n]",value)==1)
04752         {
04753             char path[1024];
04754             sprintf(path,"PATH=%s",value);
04755 #ifdef WIN32
04756                         putenv(path);
04757 #else
04758                         setenv("PATH", value, 1);
04759 #endif
04760 
04761             strcpy(line,"\n");
04762             return SUCCESS;
04763         }
04764         else
04765         {
04766             output_error_raw("%s(%d): %sbinpath term missing or invalid",filename,linenum,MACRO);
04767             strcpy(line,"\n");
04768             return FALSE;
04769         }
04770     }
04771     else if (strncmp(line,MACRO "libpath",8)==0)
04772     {
04773         char *term = strchr(line+8,' ');
04774         char value[1024];
04775         if (term==NULL)
04776         {
04777             output_error_raw("%s(%d): %slibpath macro missing term",filename,linenum,MACRO);
04778             strcpy(line,"\n");
04779             return FALSE;
04780         }
04781         if (sscanf(term+1,"%[^\n]",value)==1)
04782         {
04783             char path[1024];
04784             sprintf(path,"GLPATH=%s",value);
04785 #ifdef WIN32
04786                         putenv(path);
04787 #else
04788                         setenv("GLPATH", value, 1);
04789 #endif
04790             strcpy(line,"\n");
04791             return SUCCESS;
04792         }
04793         else
04794         {
04795             output_error_raw("%s(%d): %slibpath term missing or invalid",filename,linenum, MACRO);
04796             strcpy(line,"\n");
04797             return FALSE;
04798         }
04799     }
04800     else if (strncmp(line,MACRO "incpath",8)==0)
04801     {
04802         char *term = strchr(line+8,' ');
04803         char value[1024];
04804         if (term==NULL)
04805         {
04806             output_error_raw("%s(%d): %sincpath macro missing term",filename,linenum,MACRO);
04807             strcpy(line,"\n");
04808             return FALSE;
04809         }
04810         if (sscanf(term+1,"%[^\n]",value)==1)
04811         {
04812             char path[1024];
04813             sprintf(path,"INCLUDE=%s",value);
04814 #ifdef WIN32
04815                         putenv(path);
04816 #else
04817                         setenv("INCLUDE", value, 1);
04818 #endif
04819 
04820             strcpy(line,"\n");
04821             return SUCCESS;
04822         }
04823         else
04824         {
04825             output_error_raw("%s(%d): %sincpath term missing or invalid",filename,linenum, MACRO);
04826             strcpy(line,"\n");
04827             return FALSE;
04828         }
04829     }
04830     else if (strncmp(line,MACRO "define",7)==0)
04831     {
04832         char *term = strchr(line+7,' ');
04833         char value[1024];
04834         if (term==NULL)
04835         {
04836             output_error_raw("%s(%d): %sdefine macro missing term",filename,linenum, MACRO);
04837             strcpy(line,"\n");
04838             return FALSE;
04839         }
04840         if (sscanf(term+1,"%[^\n]",value)==1)
04841         {
04842             STATUS result;
04843             int oldstrict = global_strictnames;
04844             if (strchr(value,'=')==NULL)
04845                 strcat(value,"="); // void entry
04846             global_strictnames = FALSE;
04847             result = global_setvar(value,"\"\""); // extra "" is used in case value is term is empty string
04848             global_strictnames = oldstrict;
04849             if (result==FAILED)
04850                 output_error_raw("%s(%d): %sdefine term not found",filename,linenum,MACRO);
04851             strcpy(line,"\n");
04852             return result==SUCCESS;
04853         }
04854         else
04855         {
04856             output_error_raw("%s(%d): %sdefine missing expression",filename,linenum,MACRO);
04857             strcpy(line,"\n");
04858             return FALSE;
04859         }
04860     }
04861     else if (strncmp(line,MACRO "print",6)==0)
04862     {
04863         char *term = strchr(line+6,' ');
04864         char value[1024];
04865         if (term==NULL)
04866         {
04867             output_error_raw("%s(%d): %sprint missing message text",filename,linenum,MACRO);
04868             strcpy(line,"\n");
04869             return FALSE;
04870         }
04871         if (sscanf(term+1,"%[^\n]",value)==1)
04872         {
04873             output_error_raw("%s(%d): %s", filename, linenum, value);
04874             strcpy(line,"\n");
04875             return TRUE;
04876         }
04877         else
04878         {
04879             output_error_raw("%s(%d): %sprint term not found",filename,linenum,MACRO);
04880             strcpy(line,"\n");
04881             return FALSE;
04882         }
04883     }
04884     else if (strncmp(line,MACRO "error",6)==0)
04885     {
04886         char *term = strchr(line+6,' ');
04887         char value[1024];
04888         if (term==NULL)
04889         {
04890             output_error_raw("%s(%d): %serror missing expression",filename,linenum,MACRO);
04891             strcpy(line,"\n");
04892             return FALSE;
04893         }
04894         if (sscanf(term+1,"%[^\n]",value)==1)
04895         {
04896             //output_message("%s(%d): ERROR - %s", filename, linenum, value);
04897             output_error_raw("%s(%d):\t%s", filename, linenum, value);
04898             strcpy(line,"\n");
04899             return FALSE;
04900         }
04901         else
04902         {
04903             output_error_raw("%s(%d): %serror missing message text",filename,linenum,MACRO);
04904             strcpy(line,"\n");
04905             return FALSE;
04906         }
04907     }
04908     else if (strncmp(line,MACRO "warning",8)==0)
04909     {
04910         char *term = strchr(line+8,' ');
04911         char value[1024];
04912         if (term==NULL)
04913         {
04914             output_error_raw("%s(%d): %swarning missing message text",filename,linenum,MACRO);
04915             strcpy(line,"\n");
04916             return FALSE;
04917         }
04918         if (sscanf(term+1,"%[^\n]",value)==1)
04919         {
04920             output_error_raw("%s(%d): WARNING - %s", filename, linenum, value);
04921             strcpy(line,"\n");
04922             return TRUE;
04923         }
04924         else
04925         {
04926             output_error_raw("%s(%d): %swarning missing expression",filename,linenum,MACRO);
04927             strcpy(line,"\n");
04928             return FALSE;
04929         }
04930     }
04931     else
04932     {
04933         strcpy(line,"\n");
04934         return FALSE;
04935     }
04936 
04937     output_error_raw("%s(%d): macro fell out of logic tree", filename, linenum);
04938     return FALSE;
04939 }
04940 
04941 STATUS loadall_glm(char *file) 
04942 {
04943     OBJECT *obj, *first = object_get_first();
04944     char *buffer = NULL, *p = NULL;
04945     int fsize = 0;
04946     STATUS status=FAILED;
04947     STAT stat;
04948     char *ext = strrchr(file,'.');
04949     FILE *fp;
04950     int move=0;
04951     errno = 0;
04952 
04953     fp = fopen(file,"rt");
04954     if (fp==NULL)
04955         goto Failed;
04956     if (FSTAT(fileno(fp),&stat)==0)
04957     {
04958         modtime = stat.st_mtime;
04959         fsize = stat.st_size;
04960         buffer = malloc(BUFFERSIZE); /* lots of space */
04961     }
04962     output_verbose("file '%s' is %d bytes long", file,fsize);
04963     if (buffer==NULL)
04964     {
04965         output_error("unable to allocate buffer for file '%s': %s", file, errno?strerror(errno):"(no details)");
04966         errno = ENOMEM;
04967         goto Done;
04968     }
04969     else
04970         p=buffer;
04971 
04972     buffer[0] = '\0';
04973     if (buffer_read(fp,buffer,file,BUFFERSIZE)==0)
04974     {
04975         fclose(fp);
04976         goto Failed;
04977     }
04978     fclose(fp);
04979 
04980     /* reset line counter for parser */
04981     linenum = 1;
04982     while (*p!='\0')
04983     {
04984         move = gridlabd_file(p);
04985         if (move==0)
04986             break;
04987         p+=move;
04988     }
04989     status = (*p=='\0') ? SUCCESS : FAILED;
04990     if (status==FAILED)
04991     {
04992         char *eol = strchr(p,'\n');
04993         if (eol!=NULL)
04994             *eol='\0';
04995         output_error_raw("%s(%d): load failed at or near '%.12s...'", file, linenum,*p=='\0'?"end of line":p);
04996         if (p==0)
04997             output_error("%s doesn't appear to be a GLM file", file);
04998         goto Failed;
04999     }
05000     else if ((status=load_resolve_all())==FAILED)
05001         goto Failed;
05002 
05003     /* establish ranks */
05004     for (obj=first?first:object_get_first(); obj!=NULL; obj=obj->next)
05005         object_set_parent(obj,obj->parent);
05006     output_verbose("%d object%s loaded", object_get_count(), object_get_count()>1?"s":"");
05007     goto Done;
05008 Failed:
05009     if (errno!=0){
05010         output_error("unable to load '%s': %s", file, errno?strerror(errno):"(no details)");
05011         /*  TROUBLESHOOT
05012             In most cases, strerror(errno) will claim "No such file or directory".  This claim should be ignored in
05013             favor of prior error messages.
05014         */
05015     }
05016 Done:
05017     free(buffer);
05018     free_index();
05019     linenum=1; // parser starts at 1
05020     return status;
05021 }
05022 
05023 
05024 STATUS loadall_glm_roll(char *file) 
05025 {
05026     OBJECT *obj, *first = object_get_first();
05027     //char *buffer = NULL, *p = NULL;
05028     char *p = NULL;
05029     char buffer[20480];
05030     int fsize = 0;
05031     STATUS status=FAILED;
05032     STAT stat;
05033     char *ext = strrchr(file,'.');
05034     FILE *fp;
05035     int move = 0;
05036     errno = 0;
05037 
05038     fp = fopen(file,"rt");
05039     if (fp==NULL)
05040         goto Failed;
05041     if (FSTAT(fileno(fp),&stat)==0)
05042     {
05043         modtime = stat.st_mtime;
05044         fsize = stat.st_size;
05045     }
05046     if(fsize <= 1){
05047         // empty file short circuit
05048         return SUCCESS;
05049     }
05050     output_verbose("file '%s' is %d bytes long", file,fsize);
05051     /* removed malloc check since it doesn't malloc any more */
05052     buffer[0] = '\0';
05053 
05054     move = buffer_read_alt(fp, buffer, file, 20479);
05055     while(move > 0){
05056         p = buffer; // grab a block
05057         while(*p != 0){
05058             // and process it
05059             move = gridlabd_file(p);
05060             if(move == 0)
05061                 break;
05062             p += move;
05063         }
05064         if(*p != 0){
05065             // failed if we didn't parse the whole thing
05066             status = FAILED;
05067             break;
05068         }
05069         move = buffer_read_alt(fp, buffer, file, 20479);
05070     }
05071 
05072     if(p != 0){ /* did the file contain anything? */
05073         status = (*p=='\0' && !include_fail) ? SUCCESS : FAILED;
05074     } else {
05075         status = FAILED;
05076     }
05077     if (status==FAILED)
05078     {
05079         char *eol = NULL;
05080         if(p){
05081             eol = strchr(p,'\n');
05082         } else {
05083             p = "";
05084         }
05085         if (eol!=NULL){
05086             *eol='\0';
05087         }
05088         output_error_raw("%s(%d): load failed at or near '%.12s...'", file, linenum,*p=='\0'?"end of line":p);
05089         if (p==0)
05090             output_error("%s doesn't appear to be a GLM file", file);
05091         goto Failed;
05092     }
05093     else if ((status=load_resolve_all())==FAILED)
05094         goto Failed;
05095 
05096     /* establish ranks */
05097     for (obj=first?first:object_get_first(); obj!=NULL; obj=obj->next)
05098         object_set_parent(obj,obj->parent);
05099     output_verbose("%d object%s loaded", object_get_count(), object_get_count()>1?"s":"");
05100     goto Done;
05101 Failed:
05102     if (errno!=0){
05103         output_error("unable to load '%s': %s", file, errno?strerror(errno):"(no details)");
05104         /*  TROUBLESHOOT
05105             In most cases, strerror(errno) will claim "No such file or directory".  This claim should be ignored in
05106             favor of prior error messages.
05107         */
05108     }
05109 Done:
05110     //free(buffer);
05111     free_index();
05112     linenum=1; // parser starts at one
05113     if (fp!=NULL) fclose(fp);
05114     return status;
05115 }
05121 STATUS loadall(char *file){
05122     char *buffer = NULL, *p = NULL;
05123     char *ext = strrchr(file,'.');
05124     unsigned int old_obj_count = object_get_count();
05125     unsigned int new_obj_count = 0;
05126 //  unsigned int i;
05127     char *conf = find_file("gridlabd.conf",NULL,R_OK);
05128     static int loaded_files = 0;
05129     STATUS load_status = FAILED;
05130 
05131     if(old_obj_count > 1 && global_forbid_multiload){
05132         output_error("loadall: only one file load is supported at this time.");
05133         return FAILED; /* not what they expected--do not proceed */
05134     }
05135 
05136     /* first time only */
05137     if (loaded_files==0)
05138     {
05139         /* load the gridlabd.conf file */
05140         if (conf==NULL)
05141             output_warning("gridlabd.conf was not found");
05142             /* TROUBLESHOOT
05143                 The <code>gridlabd.conf</code> was not found in the <b>GLPATH</b> environment path.
05144                 This file is always loaded before a GLM file is loaded.
05145                 Make sure that <b>GLPATH</b> includes the <code>.../etc</code> folder and try again.
05146              */
05147         else{
05148             sprintf(filename, "gridlabd.conf");
05149             if(loadall_glm_roll(conf)==FAILED){
05150                 return FAILED;
05151             }
05152         }
05153 
05154         /* load the debugger.conf file */
05155         if (global_debug_mode)
05156         {
05157             char *dbg = find_file("debugger.conf",NULL,R_OK);
05158             if (dbg==NULL)
05159                 output_warning("debugger.conf was not found");
05160                 /* TROUBLESHOOT
05161                     The <code>debugger.conf</code> was not found in the <b>GLPATH</b> environment path.
05162                     This file is loaded when the debugger is enabled.
05163                     Make sure that <b>GLPATH</b> includes the <code>.../etc</code> folder and try again.
05164                  */
05165             else if (loadall_glm_roll(dbg)==FAILED)
05166                 return FAILED;
05167         }
05168     }
05169 
05170     /* handle default extension */
05171     strcpy(filename,file);
05172     if (ext==NULL || ext<file+strlen(file)-5)
05173     {
05174         ext = filename+strlen(filename);
05175         strcat(filename,".glm");
05176     }
05177 
05178     /* load the appropriate type of file */
05179     if (global_streaming_io_enabled)
05180     {
05181         FILE *fp = fopen(file,"rb");
05182         if (fp==NULL || stream_in(fp,SF_ALL)<0)
05183         {
05184             output_error("%s: unable to read stream", file);
05185             return FAILED;
05186         }
05187         else
05188             load_status = SUCCESS;
05189     }
05190     else if (ext==NULL || strcmp(ext, ".glm")==0)
05191         load_status = loadall_glm_roll(filename);
05192     else if(strcmp(ext, ".xml")==0)
05193         load_status = loadall_xml(filename);
05194     else
05195         output_error("%s: unable to load unknown file type", filename, ext);
05196 
05197     /* handle new objects */
05198 //  new_obj_count = object_get_count();
05199 //  if((load_status == FAILED) && (old_obj_count < new_obj_count)){
05200 //      for(i = old_obj_count+1; i <= new_obj_count; ++i){
05201 //          object_remove_by_id(i);
05202 //      }
05203 //  }
05204 
05205     loaded_files++;
05206     return load_status;
05207 }
05208