src/gmxlib/metacode.c

   1 /*
   2  * $Id$
   3  *
   4  *                This source code is part of
   5  *
   6  *                 G   R   O   M   A   C   S
   7  *
   8  *          GROningen MAchine for Chemical Simulations
   9  *
  10  *                        VERSION 3.2.0
  11  * Written by David van der Spoel, Erik Lindahl, Berk Hess, and others.
  12  * Copyright (c) 1991-2000, University of Groningen, The Netherlands.
  13  * Copyright (c) 2001-2004, The GROMACS development team,
  14  * check out http://www.gromacs.org for more information.
  15
  16  * This program is free software; you can redistribute it and/or
  17  * modify it under the terms of the GNU General Public License
  18  * as published by the Free Software Foundation; either version 2
  19  * of the License, or (at your option) any later version.
  20  *
  21  * If you want to redistribute modifications, please consider that
  22  * scientific software is very special. Version control is crucial -
  23  * bugs must be traceable. We will be happy to consider code for
  24  * inclusion in the official distribution, but derived work must not
  25  * be called official GROMACS. Details are found in the README & COPYING
  26  * files - if they are missing, get the official version at www.gromacs.org.
  27  *
  28  * To help us fund GROMACS development, we humbly ask that you cite
  29  * the papers on the package - you can find them in the top README file.
  30  *
  31  * For more info, check our website at http://www.gromacs.org
  32  *
  33  * And Hey:
  34  * GROningen Mixture of Alchemy and Childrens' Stories
  35  */
  36 #include <stdlib.h>
  37 #include <string.h>
  38 #include <metacode.h>
  39 #include <stdarg.h>
  40 #include <ctype.h>
  41
  42 /* This file is NOT threadsafe, but it is only used to create
  43  * the innerloops during the build process, so it will never be
  44  * executed by multiple threads.
  45  */
  46
  47 #define MAXCODESIZE 1000000
  48 #define MAXDECL 1000
  49 #define F77IND 6
  50 #define CIND 2
  51
  52 #ifdef DOUBLE
  53 int prec   = 8;
  54 #else
  55 int prec   = 4;
  56 #endif
  57
  58 #define REAL_FORMAT "%.16f"
  59
  60 int IND=F77IND;
  61
  62 char header[10000]; /* Should be enough for a few comment lines
  63                      * and the function name
  64                      */
  65 FILE *output;
  66 char *codebuffer=NULL;
  67 decl_t *decl_list;
  68
  69 int ndecl=0;
  70 int nargs=0;  /* the first nargs entries in the declaration list
  71                * are function arguments
  72                */
  73
  74 bool bC       = TRUE;
  75
  76 void init_metacode()
  77 {
  78   static bool first=TRUE;
  79   int i;
  80
  81   IND = bC ? CIND : F77IND;
  82
  83   /* sanity check if the buffers are initialized more than once.
  84    * They are also emptied upon flushing.
  85    */
  86   if(first) {
  87     decl_list=(decl_t *)malloc(sizeof(decl_t)*MAXDECL);
  88     codebuffer=(char *)malloc(MAXCODESIZE);
  89     first=FALSE;
  90   }
  91   ndecl=0;
  92   nargs=0;
  93   codebuffer[0]=0;
  94   header[0]=0;
  95 }
  96
  97
  98 void add_to_buffer(char *buffer,char *term)
  99 {
 100   if(strlen(buffer)>0)
 101     strcat(buffer,"+");
 102   strcat(buffer,term);
 103 }
 104
 105
 106 static bool findname(char *buffer,char *name)
 107 {
 108   /* This routine returns true if name is found in
 109    * buffer, and the surrounding characters are non
 110    * alphanumeric. (i.e. it is not a substring of
 111    * a longer word). It might catch things in comments
 112    * if you choose to keep them with -DKEEP_COMMENTS, though,
 113    * in which case you'll get warnings about unused variables.
 114    */
 115   char *ch;
 116
 117   /* the first character will be a space,
 118    * so it is safe to start at buffer+1.
 119    */
 120   ch=buffer;
 121
 122   do {
 123     if((ch=strstr(ch+1,name))!=NULL) {
 124       /* Found something. But is it a full variable
 125        * or a substring in a larger name?
 126        * Check if the prev/next chars are alphanumeric!
 127        */
 128       if(!isalnum(*(ch+strlen(name))) && !isalnum(*(ch-1)))
 129         return TRUE; /* found it! */
 130     }
 131   } while(ch!=NULL);
 132
 133   return FALSE; /* no hit */
 134 }
 135
 136
 137 void flush_buffers(void)
 138 {
 139   int i;
 140   int nwritten;
 141   char *ch;
 142   /* scan the code output buffer for arguments and
 143    * variables. Remove all that are unreferenced!
 144    */
 145   for(i=0;i<ndecl;i++)
 146     decl_list[i].breferenced=findname(codebuffer,decl_list[i].name);
 147
 148   /* write the function name (and start argument list) */
 149   fprintf(output,header);
 150
 151   nwritten=0;
 152   /* write out all referenced FUNCTION ARGUMENTS */
 153   for(i=0;i<nargs;i++) {
 154     if(!decl_list[i].breferenced)
 155       continue;
 156     if(nwritten) /* separate from earlier arg with comma */
 157       fprintf(output,",");
 158     nwritten++;
 159     if(bC)
 160       fprintf(output,"\n\t%15s %s%s",decl_list[i].typename,decl_list[i].name,
 161               decl_list[i].bvector ? "[]" : "");
 162     else
 163       fprintf(output,"\n" FCON "  %s",decl_list[i].name);
 164   }
 165
 166   /* finish argument list, start function */
 167   fprintf(output,")\n");
 168   if(bC)
 169     fprintf(output,"{\n");
 170   else
 171     newline();
 172
 173   /* declare arguments in fortran */
 174   if(!bC) {
 175     fprintf(output,"%simplicit none\n",indent());
 176     for(i=0;i<nargs;i++) {
 177       if(!decl_list[i].breferenced)
 178         continue;
 179       fprintf(output,"%s%-10s %s%s\n",indent(),
 180               decl_list[i].typename,decl_list[i].name,
 181               decl_list[i].bvector ? "(*)" : "");
 182     }
 183   }
 184
 185   /* declare all non-removed VARIABLES following the arguments */
 186   for(i=nargs;i<ndecl;i++) {
 187     if(!decl_list[i].breferenced)
 188       continue;
 189     if(bC) {
 190       fprintf(output,"%s%-10s %s%s",indent(),
 191               decl_list[i].typename,decl_list[i].name,
 192               decl_list[i].bvector ? "[]" : "");
 193       if(decl_list[i].bconst)
 194         fprintf(output,"  =  %s;\n",decl_list[i].constval);
 195       else
 196         fprintf(output,";\n");
 197     } else {
 198       fprintf(output,"%s%-10s %s%s\n",indent(),
 199               decl_list[i].typename,decl_list[i].name,
 200               decl_list[i].bvector ? "(*)" : "");
 201     }
 202   }
 203
 204   /* assign fortran parameters */
 205   if(!bC) {
 206     for(i=nargs;i<ndecl;i++)
 207       if(decl_list[i].breferenced && decl_list[i].bconst)
 208         fprintf(output,"%sparameter (%s  =  %s)\n",
 209                 indent(),decl_list[i].name,decl_list[i].constval);
 210   }
 211   /* write one huge piece of function code */
 212   fprintf(output,codebuffer);
 213
 214   /* empty the buffers to prepare for next routine... */
 215
 216   ndecl=nargs=0;
 217   codebuffer[0]=0;
 218   header[0]=0;
 219 }
 220
 221
 222 /* Return the correct indentation as a string */
 223 char *indent(void)
 224 {
 225   static char indbuf[1024];
 226   int i,n;
 227
 228   n = max(0,IND);
 229   for(i=0; (i<n); i++)
 230     indbuf[i] = ' ';
 231   indbuf[i] = '\0';
 232
 233   return indbuf;
 234 }
 235
 236 void fortran_splitline(char *line)
 237 {
 238   char tmpbuf[1024],linebuf[1000];
 239   int i,j,maxlen;
 240
 241   maxlen=strlen(line);
 242
 243   i=0;
 244   while(i+72-IND<maxlen) {
 245     j=i+71-IND;
 246     if (j>=maxlen)
 247       j=maxlen;
 248
 249     while(j>(i+1)) {
 250       if(line[j]=='+' ||
 251          line[j]=='-' ||
 252          line[j]=='/' ||
 253          (line[j]=='*' && line[j-1]!='*') ||  /* dont split pows */
 254          line[j]==' ')
 255         break;
 256       j--;
 257     }
 258     if(j==i) {
 259       printf("Error: Couldn't break this line:\n%s\n",line);
 260       exit(1);
 261     }
 262     strncpy(tmpbuf,line+i,j-i+1);
 263     tmpbuf[j-i]=0;
 264
 265     strcat(codebuffer,tmpbuf);
 266     newline();
 267     i=j;
 268     strcat(codebuffer,FCON "  ");
 269   }
 270   strcat(codebuffer,line+i);
 271 }
 272
 273
 274 /* Print a line of code to the output file */
 275 void code(char *fmt, ...)
 276 {
 277   va_list ap;
 278   int d;
 279   double f;
 280   char *s;
 281   char tmpbuf[1024];
 282   char outbuf[1024];
 283
 284   sprintf(outbuf,"%s",indent());
 285
 286   va_start(ap,fmt);
 287
 288   while(*fmt) {
 289     if(*fmt=='%') {
 290       switch(*(++fmt)) {
 291       case 'd':
 292         d = va_arg(ap, int);
 293         sprintf(tmpbuf,"%d",d);
 294         strcat(outbuf,tmpbuf);
 295         break;
 296       case 'f':
 297         f = va_arg(ap, double);
 298         sprintf(tmpbuf,REAL_FORMAT,f);
 299         strcat(outbuf,tmpbuf);
 300         break;
 301       case 's':
 302         s = va_arg(ap, char *);
 303         sprintf(tmpbuf,s);
 304         strcat(outbuf,tmpbuf);
 305         break;
 306       default:
 307         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 308         exit(-1);
 309         break;
 310       }
 311     } else {
 312       sprintf(tmpbuf,"%c",*fmt);
 313       strcat(outbuf,tmpbuf);
 314     }
 315     fmt++;
 316   }
 317   va_end(ap);
 318   if(bC)
 319     strcat(codebuffer,outbuf);
 320   else
 321     fortran_splitline(outbuf);
 322   newline();
 323 }
 324
 325
 326
 327
 328 void newline(void)
 329 {
 330   strcat(codebuffer,"\n");
 331 }
 332
 333 /* Add a comment - might just come in handy for debugging,
 334    but we don't need it in production level code */
 335 void comment(char *s)
 336 {
 337   char buf[512];
 338 #ifdef KEEP_COMMENTS
 339   if (bC)
 340     sprintf(buf,"\n%s/* %s */\n",indent(),s);
 341   else {
 342     IND--;
 343     sprintf(buf,"\nC%s%s\n",indent(),s);
 344     IND++;
 345   }
 346   strcat(codebuffer,buf);
 347 #endif
 348 }
 349
 350
 351 /* Define a new floating-point variable */
 352 void declare_real(char *name)
 353 {
 354
 355   if (bC)
 356     strcpy(decl_list[ndecl].typename,"real");
 357   else
 358     sprintf(decl_list[ndecl].typename,"real*%d",prec);
 359
 360   strcpy(decl_list[ndecl].name,name);
 361
 362   decl_list[ndecl].breferenced=TRUE;
 363   decl_list[ndecl].bvector=FALSE;
 364   decl_list[ndecl].bconst=FALSE;
 365   ndecl++;
 366 }
 367
 368 void declare_real4(char *name)
 369 {
 370
 371   if (bC)
 372     strcpy(decl_list[ndecl].typename,"float");
 373   else
 374     sprintf(decl_list[ndecl].typename,"real*4");
 375
 376   strcpy(decl_list[ndecl].name,name);
 377
 378   decl_list[ndecl].breferenced=TRUE;
 379   decl_list[ndecl].bvector=FALSE;
 380   decl_list[ndecl].bconst=FALSE;
 381   ndecl++;
 382 }
 383
 384 void declare_real_vector(char *name)
 385 {
 386
 387   if (bC)
 388     strcpy(decl_list[ndecl].typename,"real");
 389   else
 390     sprintf(decl_list[ndecl].typename,"real*%d",prec);
 391
 392   strcpy(decl_list[ndecl].name,name);
 393
 394   decl_list[ndecl].breferenced=TRUE;
 395   decl_list[ndecl].bvector=TRUE;
 396   decl_list[ndecl].bconst=FALSE;
 397   ndecl++;
 398 }
 399
 400
 401 void declare_intreal(char *name)
 402 {
 403 #ifdef DOUBLE
 404   declare_int8(name);
 405 #else
 406   declare_int4(name);
 407 #endif
 408 }
 409
 410
 411 void declare_const_real(char *name,double val)
 412 {
 413   if (bC)
 414     strcpy(decl_list[ndecl].typename,"const real");
 415   else
 416     sprintf(decl_list[ndecl].typename,"real*%d",prec);
 417
 418   strcpy(decl_list[ndecl].name,name);
 419
 420   decl_list[ndecl].breferenced=TRUE;
 421   decl_list[ndecl].bvector=FALSE; /* cant have const vectors */
 422   decl_list[ndecl].bconst=TRUE;
 423   sprintf(decl_list[ndecl].constval,REAL_FORMAT,val);
 424   ndecl++;
 425 }
 426
 427 void declare_const_int(char *name,int val)
 428 {
 429   if (bC)
 430     strcpy(decl_list[ndecl].typename,"const int");
 431   else
 432     sprintf(decl_list[ndecl].typename,"integer*4");
 433
 434   strcpy(decl_list[ndecl].name,name);
 435
 436   decl_list[ndecl].breferenced=TRUE;
 437   decl_list[ndecl].bvector=FALSE; /* cant have const vectors */
 438   decl_list[ndecl].bconst=TRUE;
 439   sprintf(decl_list[ndecl].constval,"%d",val);
 440   ndecl++;
 441 }
 442
 443
 444 void declare_int(char *name)
 445 {
 446   if (bC)
 447     strcpy(decl_list[ndecl].typename,"int");
 448   else
 449     sprintf(decl_list[ndecl].typename,"integer*%d",(int)sizeof(int));
 450
 451   strcpy(decl_list[ndecl].name,name);
 452
 453   decl_list[ndecl].breferenced=TRUE;
 454   decl_list[ndecl].bvector=FALSE;
 455   decl_list[ndecl].bconst=FALSE;
 456   ndecl++;
 457 }
 458
 459 void declare_int_vector(char *name)
 460 {
 461   if (bC)
 462     strcpy(decl_list[ndecl].typename,"int");
 463   else
 464     sprintf(decl_list[ndecl].typename,"integer*%d",(int)sizeof(int));
 465
 466   strcpy(decl_list[ndecl].name,name);
 467
 468   decl_list[ndecl].breferenced=TRUE;
 469   decl_list[ndecl].bvector=TRUE;
 470   decl_list[ndecl].bconst=FALSE;
 471   ndecl++;
 472 }
 473
 474
 475 void declare_int4(char *name)
 476 {
 477   if (bC)
 478     strcpy(decl_list[ndecl].typename,"int");
 479   else
 480     strcpy(decl_list[ndecl].typename,"integer*4");
 481
 482   strcpy(decl_list[ndecl].name,name);
 483
 484   decl_list[ndecl].breferenced=TRUE;
 485   decl_list[ndecl].bvector=FALSE;
 486   decl_list[ndecl].bconst=FALSE;
 487   ndecl++;
 488 }
 489
 490
 491 void declare_int8(char *name)
 492 {
 493   if (bC)
 494     strcpy(decl_list[ndecl].typename,"long long");
 495   else
 496     strcpy(decl_list[ndecl].typename,"integer*8");
 497
 498   strcpy(decl_list[ndecl].name,name);
 499
 500   decl_list[ndecl].breferenced=TRUE;
 501   decl_list[ndecl].bvector=FALSE;
 502   decl_list[ndecl].bconst=FALSE;
 503   ndecl++;
 504 }
 505
 506 void declare_other(char *typename,char *name)
 507 {
 508   if (bC)
 509     strcpy(decl_list[ndecl].typename,typename);
 510   else
 511     strcpy(decl_list[ndecl].typename,typename);
 512
 513   strcpy(decl_list[ndecl].name,name);
 514
 515   decl_list[ndecl].breferenced=TRUE;
 516   decl_list[ndecl].bvector=FALSE;
 517   decl_list[ndecl].bconst=FALSE;
 518   ndecl++;
 519 }
 520
 521
 522 /* Cray vector pragma */
 523 void vector_pragma(void)
 524 {
 525 #ifdef CRAY_PRAGMA
 526   if (bC)
 527     strcat(codebuffer,"#pragma ivdep\n");
 528   else
 529     strcat(codebuffer,"cdir$ivdep\n");
 530 #endif
 531 }
 532
 533 char *_array(char *a, char *idx, ...)
 534 {
 535   char arrtmp[1000],idxtmp[1000],tmp[1000];
 536   va_list ap;
 537   int d;
 538   char *s,c;
 539
 540   arrtmp[0]=idxtmp[0]=0;
 541
 542   va_start(ap,idx);
 543
 544   while(*a) {
 545     if(*a=='%') {
 546       switch(*(++a)) {
 547       case 'd':
 548         d = va_arg(ap, int);
 549         sprintf(tmp,"%d",d);
 550         break;
 551       case 's':
 552         s = va_arg(ap, char *);
 553         sprintf(tmp,s);
 554         break;
 555       case 'c':
 556         c = va_arg(ap, int);
 557         sprintf(tmp,"%c",c);
 558         break;
 559       default:
 560         fprintf(stderr,"Error, unsupported format supplied to _array()\n");
 561         exit(-1);
 562         break;
 563       }
 564     } else
 565       sprintf(tmp,"%c",*a);
 566     a++;
 567     strcat(arrtmp,tmp);
 568   }
 569
 570   while(*idx) {
 571     if(*idx=='%') {
 572       switch(*(++idx)) {
 573       case 'd':
 574         d = va_arg(ap, int);
 575         sprintf(tmp,"%d",d);
 576         break;
 577       case 's':
 578         s = va_arg(ap, char *);
 579         sprintf(tmp,s);
 580         break;
 581       case 'c':
 582         c = va_arg(ap, int);
 583         sprintf(tmp,"%c",c);
 584         break;
 585       default:
 586         fprintf(stderr,"Error, unsupported format supplied to _array()\n");
 587         exit(-1);
 588         break;
 589       }
 590     } else
 591       sprintf(tmp,"%c",*idx);
 592     idx++;
 593     strcat(idxtmp,tmp);
 594   }
 595
 596   va_end(ap);
 597
 598   sprintf(tmp,"%s%c%s%c",arrtmp, bC ? '[' : '(',idxtmp, bC ? ']' : ')');
 599   /* ok, now we got the array reference in tmp. But there might be
 600    * some stupid things which need to be removed. First, if we add
 601    * a negative offset of e.g. -1 somewhere, we will get a "+-1" which
 602    * is bad... remove the minus sign:
 603    */
 604   if((s=strstr(tmp,"+-"))!=NULL) {
 605     strcpy(arrtmp,s+1); /* copy to tmparray */
 606     strcpy(s,arrtmp);   /* copy back */
 607   }
 608
 609   /* It is also stupid to add a zero offset. Kill that cat! */
 610   if((s=strstr(tmp,"+0"))!=NULL) {
 611     strcpy(arrtmp,s+2); /* copy to tmparray */
 612     strcpy(s,arrtmp);   /* copy back */
 613   }
 614
 615   return strdup(tmp);
 616 }
 617
 618
 619 void file_error(char *fn)
 620 {
 621   fprintf(stderr,"Error creating file %s\n",fn);
 622   exit(-1);
 623 }
 624
 625
 626 void _p_state(char *left,char *right,char *symb)
 627 {
 628   char buf[512];
 629
 630   if (bC) {
 631     if (IND+16+3+strlen(right) > 78) {
 632       sprintf(buf,"%s%-16s %2s \n",indent(),left,symb);
 633       strcat(codebuffer,buf);
 634       IND+=2;
 635       sprintf(buf,"%s%s;\n",indent(),right);
 636       strcat(codebuffer,buf);
 637       IND-=2;
 638     }
 639     else {
 640       sprintf(buf,"%s%-16s %2s %s;\n",indent(),left,symb,right);
 641       strcat(codebuffer,buf);
 642     }
 643   }
 644   else {
 645     if (IND+16+3+strlen(right) > 72) {
 646       sprintf(buf,"%s%-16s = \n%s",indent(),left,FCON);
 647       strcat(codebuffer,buf);
 648       IND-=6-3;
 649       code(right);
 650       IND+=6-3;
 651     }
 652     else {
 653       sprintf(buf,"%s%-16s = %s\n",indent(),left,right);
 654       strcat(codebuffer,buf);
 655     }
 656   }
 657 }
 658
 659
 660 void assign(char *left,char *right, ...)
 661 {
 662   char ltmp[1000],rtmp[1000],tmp[1000];
 663   va_list ap;
 664   int d;
 665   double f;
 666   char *s,c;
 667
 668   ltmp[0]=rtmp[0]=0;
 669
 670   va_start(ap,right);
 671
 672   while(*left) {
 673     if(*left=='%') {
 674       switch(*(++left)) {
 675       case 'd':
 676         d = va_arg(ap, int);
 677         sprintf(tmp,"%d",d);
 678         break;
 679       case 'f':
 680         f = va_arg(ap, double);
 681         sprintf(tmp,REAL_FORMAT,f);
 682         break;
 683       case 's':
 684         s = va_arg(ap, char *);
 685         sprintf(tmp,s);
 686         break;
 687       case 'c':
 688         c = va_arg(ap, int);
 689         sprintf(tmp,"%c",c);
 690         break;
 691       default:
 692         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 693         exit(-1);
 694         break;
 695       }
 696     } else
 697       sprintf(tmp,"%c",*left);
 698     left++;
 699     strcat(ltmp,tmp);
 700   }
 701
 702   while(*right) {
 703     if(*right=='%') {
 704       switch(*(++right)) {
 705       case 'd':
 706         d = va_arg(ap, int);
 707         sprintf(tmp,"%d",d);
 708         break;
 709       case 'f':
 710         f = va_arg(ap, double);
 711         sprintf(tmp,REAL_FORMAT,f);
 712         break;
 713       case 's':
 714         s = va_arg(ap, char *);
 715         sprintf(tmp,s);
 716         break;
 717       case 'c':
 718         c = va_arg(ap, int);
 719         sprintf(tmp,"%c",c);
 720         break;
 721       default:
 722         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 723         exit(-1);
 724         break;
 725       }
 726     } else
 727       sprintf(tmp,"%c",*right);
 728     right++;
 729     strcat(rtmp,tmp);
 730   }
 731
 732   va_end(ap);
 733   _p_state(ltmp,rtmp,"=");
 734 }
 735
 736
 737 void increment(char *left,char *right, ...)
 738 {
 739   char ltmp[1000],rtmp[1000],tmp[1000];
 740   va_list ap;
 741   int d;
 742   double f;
 743   char *s,c;
 744
 745   ltmp[0]=rtmp[0]=0;
 746
 747   va_start(ap,right);
 748
 749   while(*left) {
 750     if(*left=='%') {
 751       switch(*(++left)) {
 752       case 'd':
 753         d = va_arg(ap, int);
 754         sprintf(tmp,"%d",d);
 755         break;
 756       case 'f':
 757         f = va_arg(ap, double);
 758         sprintf(tmp,REAL_FORMAT,f);
 759         break;
 760       case 's':
 761         s = va_arg(ap, char *);
 762         sprintf(tmp,s);
 763         break;
 764       case 'c':
 765         c = va_arg(ap, int);
 766         sprintf(tmp,"%c",c);
 767         break;
 768       default:
 769         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 770         exit(-1);
 771         break;
 772       }
 773     } else
 774       sprintf(tmp,"%c",*left);
 775     left++;
 776     strcat(ltmp,tmp);
 777   }
 778
 779   strcpy(rtmp,ltmp);
 780   strcat(rtmp," + ");
 781
 782   while(*right) {
 783     if(*right=='%') {
 784       switch(*(++right)) {
 785       case 'd':
 786         d = va_arg(ap, int);
 787         sprintf(tmp,"%d",d);
 788         break;
 789       case 'f':
 790         f = va_arg(ap, double);
 791         sprintf(tmp,REAL_FORMAT,f);
 792         break;
 793       case 's':
 794         s = va_arg(ap, char *);
 795         sprintf(tmp,s);
 796         break;
 797       case 'c':
 798         c = va_arg(ap, int);
 799         sprintf(tmp,"%c",c);
 800         break;
 801       default:
 802         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 803         exit(-1);
 804         break;
 805       }
 806     } else
 807       sprintf(tmp,"%c",*right);
 808     right++;
 809     strcat(rtmp,tmp);
 810   }
 811
 812   va_end(ap);
 813   _p_state(ltmp,rtmp,"=");
 814
 815 }
 816
 817
 818 void decrement(char *left,char *right, ...)
 819 {
 820   char ltmp[1000],rtmp[1000],tmp[1000];
 821   va_list ap;
 822   int d;
 823   double f;
 824   char *s,c;
 825
 826   ltmp[0]=rtmp[0]=0;
 827
 828   va_start(ap,right);
 829
 830   while(*left) {
 831     if(*left=='%') {
 832       switch(*(++left)) {
 833       case 'd':
 834         d = va_arg(ap, int);
 835         sprintf(tmp,"%d",d);
 836         break;
 837       case 'f':
 838         f = va_arg(ap, double);
 839         sprintf(tmp,REAL_FORMAT,f);
 840         break;
 841       case 's':
 842         s = va_arg(ap, char *);
 843         sprintf(tmp,s);
 844         break;
 845       case 'c':
 846         c = va_arg(ap, int);
 847         sprintf(tmp,"%c",c);
 848         break;
 849       default:
 850         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 851         exit(-1);
 852         break;
 853       }
 854     } else
 855       sprintf(tmp,"%c",*left);
 856     left++;
 857     strcat(ltmp,tmp);
 858   }
 859
 860   strcpy(rtmp,ltmp);
 861   strcat(rtmp," - ");
 862
 863   while(*right) {
 864     if(*right=='%') {
 865       switch(*(++right)) {
 866       case 'd':
 867         d = va_arg(ap, int);
 868         sprintf(tmp,"%d",d);
 869         break;
 870       case 'f':
 871         f = va_arg(ap, double);
 872         sprintf(tmp,REAL_FORMAT,f);
 873         break;
 874       case 's':
 875         s = va_arg(ap, char *);
 876         sprintf(tmp,s);
 877         break;
 878       case 'c':
 879         c = va_arg(ap, int);
 880         sprintf(tmp,"%c",c);
 881         break;
 882       default:
 883         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 884         exit(-1);
 885         break;
 886       }
 887     } else
 888       sprintf(tmp,"%c",*right);
 889     right++;
 890     strcat(rtmp,tmp);
 891   }
 892
 893   va_end(ap);
 894   _p_state(ltmp,rtmp,"=");
 895 }
 896
 897
 898
 899 void add(char *left,char *r1,char *r2, ...)
 900 {
 901   char ltmp[1000],rtmp[1000],tmp[1000];
 902   va_list ap;
 903   int d;
 904   double f;
 905   char *s,c;
 906
 907   ltmp[0]=rtmp[0]=0;
 908
 909   va_start(ap,r2);
 910
 911   while(*left) {
 912     if(*left=='%') {
 913       switch(*(++left)) {
 914       case 'd':
 915         d = va_arg(ap, int);
 916         sprintf(tmp,"%d",d);
 917         break;
 918       case 'f':
 919         f = va_arg(ap, double);
 920         sprintf(tmp,REAL_FORMAT,f);
 921         break;
 922       case 's':
 923         s = va_arg(ap, char *);
 924         sprintf(tmp,s);
 925         break;
 926       case 'c':
 927         c = va_arg(ap, int);
 928         sprintf(tmp,"%c",c);
 929         break;
 930       default:
 931         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 932         exit(-1);
 933         break;
 934       }
 935     } else
 936       sprintf(tmp,"%c",*left);
 937     left++;
 938     strcat(ltmp,tmp);
 939   }
 940
 941   while(*r1) {
 942     if(*r1=='%') {
 943       switch(*(++r1)) {
 944       case 'd':
 945         d = va_arg(ap, int);
 946         sprintf(tmp,"%d",d);
 947         break;
 948       case 'f':
 949         f = va_arg(ap, double);
 950         sprintf(tmp,REAL_FORMAT,f);
 951         break;
 952       case 's':
 953         s = va_arg(ap, char *);
 954         sprintf(tmp,s);
 955         break;
 956       case 'c':
 957         c = va_arg(ap, int);
 958         sprintf(tmp,"%c",c);
 959         break;
 960       default:
 961         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 962         exit(-1);
 963         break;
 964       }
 965     } else
 966       sprintf(tmp,"%c",*r1);
 967     r1++;
 968     strcat(rtmp,tmp);
 969   }
 970   strcat(rtmp," + ");
 971
 972   while(*r2) {
 973     if(*r2=='%') {
 974       switch(*(++r2)) {
 975       case 'd':
 976         d = va_arg(ap, int);
 977         sprintf(tmp,"%d",d);
 978         break;
 979       case 'f':
 980         f = va_arg(ap, double);
 981         sprintf(tmp,REAL_FORMAT,f);
 982         break;
 983       case 's':
 984         s = va_arg(ap, char *);
 985         sprintf(tmp,s);
 986         break;
 987       case 'c':
 988         c = va_arg(ap, int);
 989         sprintf(tmp,"%c",c);
 990         break;
 991       default:
 992         fprintf(stderr,"Error, unsupported format supplied to code()\n");
 993         exit(-1);
 994         break;
 995       }
 996     } else
 997       sprintf(tmp,"%c",*r2);
 998     r2++;
 999     strcat(rtmp,tmp);
1000   }
1001
1002   va_end(ap);
1003   _p_state(ltmp,rtmp,"=");
1004 }
1005
1006
1007 void subtract(char *left,char *r1,char *r2, ...)
1008 {
1009   char ltmp[1000],rtmp[1000],tmp[1000];
1010   va_list ap;
1011   int d;
1012   double f;
1013   char *s,c;
1014
1015   ltmp[0]=rtmp[0]=0;
1016
1017   va_start(ap,r2);
1018
1019   while(*left) {
1020     if(*left=='%') {
1021       switch(*(++left)) {
1022       case 'd':
1023         d = va_arg(ap, int);
1024         sprintf(tmp,"%d",d);
1025         break;
1026       case 'f':
1027         f = va_arg(ap, double);
1028         sprintf(tmp,REAL_FORMAT,f);
1029         break;
1030       case 's':
1031         s = va_arg(ap, char *);
1032         sprintf(tmp,s);
1033         break;
1034       case 'c':
1035         c = va_arg(ap, int);
1036         sprintf(tmp,"%c",c);
1037         break;
1038       default:
1039         fprintf(stderr,"Error, unsupported format supplied to code()\n");
1040         exit(-1);
1041         break;
1042       }
1043     } else
1044       sprintf(tmp,"%c",*left);
1045     left++;
1046     strcat(ltmp,tmp);
1047   }
1048
1049   while(*r1) {
1050     if(*r1=='%') {
1051       switch(*(++r1)) {
1052       case 'd':
1053         d = va_arg(ap, int);
1054         sprintf(tmp,"%d",d);
1055         break;
1056       case 'f':
1057         f = va_arg(ap, double);
1058         sprintf(tmp,REAL_FORMAT,f);
1059         break;
1060       case 's':
1061         s = va_arg(ap, char *);
1062         sprintf(tmp,s);
1063         break;
1064       case 'c':
1065         c = va_arg(ap, int);
1066         sprintf(tmp,"%c",c);
1067         break;
1068       default:
1069         fprintf(stderr,"Error, unsupported format supplied to code()\n");
1070         exit(-1);
1071         break;
1072       }
1073     } else
1074       sprintf(tmp,"%c",*r1);
1075     r1++;
1076     strcat(rtmp,tmp);
1077   }
1078   strcat(rtmp," - ");
1079
1080   while(*r2) {
1081     if(*r2=='%') {
1082       switch(*(++r2)) {
1083       case 'd':
1084         d = va_arg(ap, int);
1085         sprintf(tmp,"%d",d);
1086         break;
1087       case 'f':
1088         f = va_arg(ap, double);
1089         sprintf(tmp,REAL_FORMAT,f);
1090         break;
1091       case 's':
1092         s = va_arg(ap, char *);
1093         sprintf(tmp,s);
1094         break;
1095       case 'c':
1096         c = va_arg(ap, int);
1097         sprintf(tmp,"%c",c);
1098         break;
1099       default:
1100         fprintf(stderr,"Error, unsupported format supplied to code()\n");
1101         exit(-1);
1102         break;
1103       }
1104     } else
1105       sprintf(tmp,"%c",*r2);
1106     r2++;
1107     strcat(rtmp,tmp);
1108   }
1109
1110   va_end(ap);
1111   _p_state(ltmp,rtmp,"=");
1112 }
1113
1114
1115
1116 void multiply(char *left,char *r1,char *r2, ...)
1117 {
1118   char ltmp[1000],rtmp[1000],tmp[1000];
1119   va_list ap;
1120   int d;
1121   double f;
1122   char *s,c;
1123
1124   ltmp[0]=rtmp[0]=0;
1125
1126   va_start(ap,r2);
1127
1128   while(*left) {
1129     if(*left=='%') {
1130       switch(*(++left)) {
1131       case 'd':
1132         d = va_arg(ap, int);
1133         sprintf(tmp,"%d",d);
1134         break;
1135       case 'f':
1136         f = va_arg(ap, double);
1137         sprintf(tmp,REAL_FORMAT,f);
1138         break;
1139       case 's':
1140         s = va_arg(ap, char *);
1141         sprintf(tmp,s);
1142         break;
1143       case 'c':
1144         c = va_arg(ap, int);
1145         sprintf(tmp,"%c",c);
1146         break;
1147       default:
1148         fprintf(stderr,"Error, unsupported format supplied to code()\n");
1149         exit(-1);
1150         break;
1151       }
1152     } else
1153       sprintf(tmp,"%c",*left);
1154     left++;
1155     strcat(ltmp,tmp);
1156   }
1157
1158   while(*r1) {
1159     if(*r1=='%') {
1160       switch(*(++r1)) {
1161       case 'd':
1162         d = va_arg(ap, int);
1163         sprintf(tmp,"%d",d);
1164         break;
1165       case 'f':
1166         f = va_arg(ap, double);
1167         sprintf(tmp,REAL_FORMAT,f);
1168         break;
1169       case 's':
1170         s = va_arg(ap, char *);
1171         sprintf(tmp,s);
1172         break;
1173       case 'c':
1174         c = va_arg(ap, int);
1175         sprintf(tmp,"%c",c);
1176         break;
1177       default:
1178         fprintf(stderr,"Error, unsupported format supplied to code()\n");
1179         exit(-1);
1180         break;
1181       }
1182     } else
1183       sprintf(tmp,"%c",*r1);
1184     r1++;
1185     strcat(rtmp,tmp);
1186   }
1187   strcat(rtmp," * ");
1188
1189   while(*r2) {
1190     if(*r2=='%') {
1191       switch(*(++r2)) {
1192       case 'd':
1193         d = va_arg(ap, int);
1194         sprintf(tmp,"%d",d);
1195         break;
1196       case 'f':
1197         f = va_arg(ap, double);
1198         sprintf(tmp,REAL_FORMAT,f);
1199         break;
1200       case 's':
1201         s = va_arg(ap, char *);
1202         sprintf(tmp,s);
1203         break;
1204       case 'c':
1205         c = va_arg(ap, int);
1206         sprintf(tmp,"%c",c);
1207         break;
1208       default:
1209         fprintf(stderr,"Error, unsupported format supplied to code()\n");
1210         exit(-1);
1211         break;
1212       }
1213     } else
1214       sprintf(tmp,"%c",*r2);
1215     r2++;
1216     strcat(rtmp,tmp);
1217   }
1218
1219   va_end(ap);
1220   _p_state(ltmp,rtmp,"=");
1221
1222 }
1223
1224
1225
1226 void edit_warning(char *fn)
1227 {
1228   if(bC)
1229     fprintf(output,
1230           "  /**********************************************************\n"
1231           "   *    This code is generated automatically by %s\n"
1232           "   *                DO NOT EDIT THIS FILE\n"
1233           "   *     Erik Lindahl, David van der Spoel 1999-2000\n"
1234           "   **********************************************************/"
1235           "\n",fn);
1236   else
1237     fprintf(output,
1238           "CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC\n"
1239           "C       This code is generated automatically by %s\n"
1240           "C                   DO NOT EDIT THIS FILE\n"
1241           "C        Erik Lindahl, David van der Spoel 1999-2000\n"
1242           "CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC\n",
1243           fn);
1244 }
1245
1246 void closeit(void)
1247 {
1248   if (bC)
1249     strcat(codebuffer,"}\n\n");
1250   else {
1251     code("return");
1252     code("end");
1253   }
1254 }
1255
1256 void usage(int argc,char *argv[])
1257 {
1258   fprintf(stderr,"Usage: %s language\n",argv[0]);
1259   fprintf(stderr,"\tAvailable languages:  c  fortran\n");
1260   exit(-1);
1261 }
1262
1263 int count_lines(char *fn)
1264 {
1265   FILE *fp;
1266   int nl=0;
1267   char buf[1024];
1268
1269   if ((fp = fopen(fn,"r")) == NULL) {
1270     perror(fn);
1271     exit(1);
1272   }
1273
1274   while (fgets(buf,255,fp) != NULL)
1275     nl++;
1276   fclose(fp);
1277
1278   return nl;
1279 }
1280
1281
1282 void start_loop(char *lvar,char *from,char *to)
1283 {
1284   if (bC)
1285     code("for(%s=%s; (%s<%s); %s++) {", lvar,from,lvar,to,lvar);
1286   else
1287     code("do %s=%s,%s",lvar,from,to);
1288
1289   IND += 2;
1290 }
1291
1292
1293 void start_stride_loop(char *lvar,char *from,char *to, char *stride)
1294 {
1295   if (bC)
1296     code("for(%s=%s; (%s<%s); %s+=%s) {", lvar,from,lvar,to,lvar,stride);
1297   else
1298     code("do %s=%s,%s,%s",lvar,from,to,stride);
1299
1300   IND += 2;
1301 }
1302
1303
1304
1305 void end_loop(void)
1306 {
1307   IND -= 2;
1308
1309   if (bC)
1310     code("}");
1311   else
1312     code("end do");
1313 }
1314
1315 void start_if(char *cond)
1316 {
1317   if (bC)
1318     code("if(%s) {", cond);
1319   else
1320     code("if (%s) then",cond);
1321
1322   IND += 2;
1323 }
1324
1325 void do_else()
1326 {
1327   IND -= 2;
1328
1329   if (bC)
1330     code("} else {");
1331   else
1332     code("else");
1333
1334   IND += 2;
1335 }
1336
1337
1338
1339 void end_if(void)
1340 {
1341   IND -= 2;
1342
1343   if (bC)
1344     code("}");
1345   else
1346     code("endif");
1347 }
1348
1349
1350 void close_func()
1351 {
1352   if (bC)
1353     strcat(codebuffer,"}\n\n");
1354   else {
1355     code("return");
1356     code("end");
1357   }
1358 }