chem/KPP/kpp/kpp-2.1/src.org/code.c

   1 /******************************************************************************
   2
   3   KPP - The Kinetic PreProcessor
   4         Builds simulation code for chemical kinetic systems
   5
   6   Copyright (C) 1995-1996 Valeriu Damian and Adrian Sandu
   7   Copyright (C) 1997-2005 Adrian Sandu
   8
   9   KPP is free software; you can redistribute it and/or modify it under the
  10   terms of the GNU General Public License as published by the Free Software
  11   Foundation (http://www.gnu.org/copyleft/gpl.html); either version 2 of the
  12   License, or (at your option) any later version.
  13
  14   KPP is distributed in the hope that it will be useful, but WITHOUT ANY
  15   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  16   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  17   details.
  18
  19   You should have received a copy of the GNU General Public License along
  20   with this program; if not, consult http://www.gnu.org/copyleft/gpl.html or
  21   write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22   Boston, MA  02111-1307,  USA.
  23
  24   Adrian Sandu
  25   Computer Science Department
  26   Virginia Polytechnic Institute and State University
  27   Blacksburg, VA 24060
  28   E-mail: sandu@cs.vt.edu
  29
  30 ******************************************************************************/
  31
  32
  33 #include "gdata.h"
  34 #include "code.h"
  35 #include <time.h>
  36 #include <unistd.h>
  37 #include <string.h>
  38
  39 /*            NONE, ADD, SUB, MUL, DIV, POW, CONST, ELM, VELM, MELM, EELM  */
  40 int PRI[] = {   10,   1,   1,   2,   2,   3,    10,  10,   10,   10,   10 };
  41
  42 void (*WriteElm)( NODE *n );
  43 void (*WriteSymbol)( int op );
  44 void (*WriteAssign)( char* lval, char* rval );
  45 void (*WriteComment)( char *fmt, ...  );
  46 void (*Declare)( int v );
  47 void (*ExternDeclare)( int v );
  48 void (*GlobalDeclare)( int v );
  49 void (*InitDeclare)( int var, int nv, void * values );
  50 void (*DeclareConstant)( int v, char *val );
  51 void (*FunctionStart)( int f, int *vars );
  52 void (*FunctionPrototipe)( int f, ... );
  53 void (*FunctionBegin)( int f, ... );
  54 void (*FunctionEnd)( int f );
  55
  56 NODE * substList;
  57 int substENABLED = 1;
  58 int crtop = NONE;
  59 char *outBuf;
  60 char *outBuffer;
  61
  62 VARIABLE cnst = { "", CONST, REAL, 0, 0 };
  63 VARIABLE expr = { "", EELM, 0, 0, 0 };
  64 VARIABLE *varTable[ MAX_VAR ] = { &cnst, &expr };
  65
  66 int IsConst( NODE *n, float val );
  67 NODE * BinaryOp( int op, NODE *n1, NODE *n2 );
  68 int NodeCmp( NODE *n1, NODE *n2 );
  69 NODE * NodeCopy( NODE *n1 );
  70 void WriteNode( NODE *n );
  71 void WriteOp( int op );
  72 void ExpandElm( NODE * n );
  73 int ExpandNode( NODE *n, int lastop );
  74 NODE * LookUpSubst( NODE *n );
  75
  76 FILE * param_headerFile   = 0;
  77 FILE * initFile = 0; /*  mz_rs_20050117 */
  78 FILE * driverFile = 0;
  79 FILE * integratorFile = 0;
  80 FILE * linalgFile = 0;
  81 FILE * functionFile = 0;
  82 FILE * jacobianFile = 0;
  83 FILE * rateFile = 0;
  84 FILE * stoichiomFile = 0;
  85 FILE * utilFile = 0;
  86 FILE * sparse_dataFile = 0;
  87 FILE * sparse_jacFile = 0;
  88 FILE * sparse_hessFile = 0;
  89 FILE * sparse_stoicmFile = 0;
  90 FILE * stochasticFile = 0;
  91 FILE * global_dataFile = 0;
  92 FILE * hessianFile = 0;
  93 FILE * mapFile = 0;
  94 FILE * makeFile = 0;
  95 FILE * monitorFile = 0;
  96 FILE * mex_funFile = 0;
  97 FILE * mex_jacFile = 0;
  98 FILE * mex_hessFile = 0;
  99
 100 FILE * currentFile;
 101
 102 int ident = 0;
 103
 104 FILE * UseFile( FILE * file )
 105 {
 106 FILE *oldf;
 107     if (file == NULL) {
 108       printf("\n\nKPP Warning (internal): trying to UseFile NULL file pointer!\n");
 109     }
 110     oldf = currentFile;
 111     currentFile = file;
 112     return oldf;
 113 }
 114
 115 void OpenFile( FILE **fpp, char *name, char * ext, char * identity )
 116 {
 117 char bufname[200];
 118 char buf[200];
 119 time_t t;
 120 int blength;
 121
 122   time( &t );
 123   sprintf( bufname, "%s%s", name, ext );
 124   if( *fpp ) fclose( *fpp );
 125   *fpp = fopen( bufname, "w" );
 126   if ( *fpp == 0 )
 127     FatalError(3,"%s: Can't create file", bufname );
 128
 129   UseFile( *fpp );
 130
 131   WriteDelim();
 132   WriteComment("");
 133   WriteComment("%s",identity);
 134   WriteComment("");
 135   WriteComment("Generated by KPP-%s symbolic chemistry Kinetics PreProcessor",
 136                 KPP_VERSION );
 137   WriteComment("      (http://www.cs.vt.edu/~asandu/Software/KPP)");
 138   WriteComment("KPP is distributed under GPL, the general public licence");
 139   WriteComment("      (http://www.gnu.org/copyleft/gpl.html)");
 140   WriteComment("(C) 1995-1997, V. Damian & A. Sandu, CGRER, Univ. Iowa" );
 141   WriteComment("(C) 1997-2005, A. Sandu, Michigan Tech, Virginia Tech" );
 142   WriteComment("    With important contributions from:" );
 143   WriteComment("       M. Damian, Villanova University, USA");
 144   WriteComment("       R. Sander, Max-Planck Institute for Chemistry, Mainz, Germany");
 145   WriteComment("");
 146   WriteComment("%-20s : %s", "File", bufname );
 147   strcpy( buf, ctime( &t ) );
 148   buf[ (int)strlen(buf) - 1 ] = 0;
 149   WriteComment("%-20s : %s", "Time", buf );
 150   WriteComment("%-20s : %s", "Working directory", getcwd(buf, 200) );
 151   WriteComment("%-20s : %s", "Equation file", eqFileName );
 152   WriteComment("%-20s : %s", "Output root filename", rootFileName );
 153   WriteComment("");
 154   WriteDelim();
 155   NewLines(1);
 156 /* Include Headers in .c  Files, except Makefile */
 157   blength = strlen(bufname);
 158   if ( (bufname[blength-2]=='.')&&(bufname[blength-1]=='c') ) {
 159     C_Inline("#include <stdio.h>");
 160     C_Inline("#include <stdlib.h>");
 161     C_Inline("#include <math.h>");
 162     C_Inline("#include <string.h>");
 163     C_Inline("#include \"%s_Parameters.h\"", rootFileName);
 164     C_Inline("#include \"%s_Global.h\"", rootFileName);
 165     if( useJacSparse )
 166        C_Inline("#include \"%s_Sparse.h\"", rootFileName);
 167     }
 168   NewLines(2);
 169 }
 170
 171 void AllowBreak()
 172 {
 173   *(outBuffer-1) |= 0x80;
 174 }
 175
 176 void bprintf( char *fmt, ... )
 177 {
 178 Va_list args;
 179
 180   if ( !fmt ) return;
 181   Va_start( args, fmt );
 182   vsprintf( outBuffer, fmt, args );
 183   va_end( args );
 184   outBuffer += strlen( outBuffer );
 185 }
 186
 187 void FlushBuf()
 188 {
 189 char *p;
 190
 191   p = outBuf;
 192   while( *p )
 193     *p++ &= ~0x80;
 194   fprintf( currentFile, outBuf );
 195   outBuffer = outBuf;
 196   *outBuffer = 0;
 197 }
 198
 199 void FlushThisBuf( char * buf )
 200 {
 201 char *p;
 202
 203   p = buf;
 204   while( *p )
 205     *p++ &= ~0x80;
 206   fprintf( currentFile, buf );
 207 }
 208
 209 void WriteDelim()
 210 {
 211 /*
 212   WriteComment("****************************************************************");
 213 */
 214   WriteComment("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~");
 215 }
 216
 217 void NewLines( int n )
 218 {
 219   for( ; n > 0; n-- )
 220     bprintf("\n");
 221
 222   FlushBuf();
 223 }
 224
 225 void IncludeFile( char * fname )
 226 {
 227 FILE *fp;
 228 #define MAX_LINE 200
 229 char line[ MAX_LINE ];
 230
 231
 232   fp = fopen( fname, "r" );
 233   if ( fp == 0 )
 234     FatalError(3,"%s: Can't read file", fname );
 235
 236   FlushBuf();
 237
 238   while( !feof(fp) ) {
 239     *line = '\0';
 240     fgets( line, MAX_LINE, fp );
 241     fputs( line, currentFile );
 242   }
 243
 244   fclose( fp );
 245 }
 246
 247 void IncludeCode( char* fmt, ... )
 248 {
 249 Va_list args;
 250 char buf[200];
 251 char cmd[500];
 252 static char tmpfile[] = "kppfile.tmp";
 253 FILE * fp;
 254
 255   Va_start( args, fmt );
 256   vsprintf( buf, fmt, args );
 257   va_end( args );
 258
 259   switch( useLang ) {
 260     case F77_LANG: sprintf( buf, "%s.f", buf );
 261                  break;
 262     case F90_LANG: sprintf( buf, "%s.f90", buf );
 263                  break;
 264     case C_LANG: sprintf( buf, "%s.c", buf );
 265                  break;
 266     case MATLAB_LANG: sprintf( buf, "%s.m", buf );
 267                  break;
 268     default: printf("\n Language '%d' not implemented!\n",useLang);
 269                  exit(1);
 270   }
 271   fp = fopen( buf, "r" );
 272   if ( fp == 0 )
 273     FatalError(3,"%s: Can't read file", buf );
 274   fclose(fp);
 275
 276   strcpy( cmd, "sed " );
 277
 278   sprintf( cmd, "%s -e 's/KPP_ROOT/%s/g'", cmd, rootFileName );
 279   sprintf( cmd, "%s -e 's/KPP_NVAR/%d/g'", cmd, VarNr );
 280   sprintf( cmd, "%s -e 's/KPP_NFIX/%d/g'", cmd, FixNr );
 281   sprintf( cmd, "%s -e 's/KPP_NSPEC/%d/g'", cmd,SpcNr );
 282   sprintf( cmd, "%s -e 's/KPP_NREACT/%d/g'", cmd, EqnNr );
 283   sprintf( cmd, "%s -e 's/KPP_NONZERO/%d/g'", cmd, Jac_NZ );
 284   sprintf( cmd, "%s -e 's/KPP_LU_NONZERO/%d/g'", cmd, LU_Jac_NZ );
 285   sprintf( cmd, "%s -e 's/KPP_NHESS/%d/g'", cmd, Hess_NZ );
 286
 287   switch( useLang ) {
 288     case F77_LANG:
 289                  sprintf( cmd, "%s -e 's/KPP_REAL/%s/g'", cmd, F77_types[real] );
 290                  break;
 291     case F90_LANG:
 292                  sprintf( cmd, "%s -e 's/KPP_REAL/%s/g'", cmd, F90_types[real] );
 293                  break;
 294     case C_LANG:
 295                  sprintf( cmd, "%s -e 's/KPP_REAL/%s/g'", cmd, C_types[real] );
 296                  break;
 297     case MATLAB_LANG:
 298                  break;
 299     default: printf("\n Language '%d' not implemented!\n",useLang);
 300                  exit(1);
 301   }
 302
 303   sprintf( cmd, "%s %s > %s", cmd, buf, tmpfile );
 304
 305   system( cmd );
 306   IncludeFile( tmpfile );
 307   sprintf( cmd, "rm %s", tmpfile );
 308   system( cmd );
 309 }
 310
 311 void MapFunctionComment( int f, int *vars )
 312 {
 313 FILE *oldf;
 314
 315   oldf = UseFile( mapFile );
 316   FunctionStart( f, vars );
 317   /*NewLines(1);
 318   CommentFncBegin( f, vars );*/
 319   FlushBuf();
 320   UseFile( oldf );
 321 }
 322
 323 int DefineVariable( char * name, int t, int bt, int maxi, int maxj, char * comment )
 324 {
 325 int i;
 326 VARIABLE * var;
 327
 328   for( i = 0; i < MAX_VAR; i++ )
 329     if( varTable[ i ] == 0 ) break;
 330
 331   if( varTable[ i ] != 0 ) {
 332     printf("\nVariable Table overflow");
 333     return -1;
 334   }
 335
 336   var = (VARIABLE*) malloc( sizeof( VARIABLE ) );
 337   var->name = name;
 338   var->type = t;
 339   var->baseType = bt;
 340   var->maxi = maxi;
 341   var->maxj = maxj;
 342   var->value = -1;
 343   var->comment = comment;
 344
 345   varTable[ i ] = var;
 346   return i;
 347 }
 348
 349 void FreeVariable( int n )
 350 {
 351   if( varTable[ n ] ) {
 352     free( varTable[ n ] );
 353     varTable[ n ] = 0;
 354   }
 355 }
 356
 357 NODE * Elm( int v, ... )
 358 {
 359 Va_list args;
 360 NODE *n;
 361 ELEMENT *elm;
 362 VARIABLE *var;
 363 int i, j;
 364 float val;
 365 char *expr;
 366
 367   var = varTable[ v ];
 368   n   = (NODE*)    malloc( sizeof(NODE) );
 369   elm = (ELEMENT*) malloc( sizeof(ELEMENT) );
 370   n->left = 0;
 371   n->right = 0;
 372   n->sign = 1;
 373   n->type = var->type;
 374   n->elm = elm;
 375   elm->var = v;
 376
 377   Va_start( args, v );
 378   switch( var->type ) {
 379     case CONST: switch( var->baseType ) {
 380                   case REAL: elm->val.cnst = (float)va_arg( args, double );
 381                              break;
 382                   case INT:  elm->val.cnst = (float)va_arg( args, int );
 383                 }
 384                 if( elm->val.cnst < 0 ) {
 385                   elm->val.cnst = -elm->val.cnst;
 386                   n->sign = -1;
 387                 }
 388                 break;
 389     case ELM:
 390                 break;
 391     case VELM:  elm->val.idx.i = va_arg( args, int );
 392                 break;
 393     case MELM:  elm->val.idx.i = va_arg( args, int );
 394                 elm->val.idx.j = va_arg( args, int );
 395                 break;
 396     case EELM:  elm->val.expr = va_arg( args, char* );
 397                 break;
 398   }
 399   va_end( args );
 400
 401   return n;
 402 }
 403
 404 int IsConst( NODE *n, float val )
 405 {
 406   return ( ( n ) &&
 407            ( n->type == CONST ) &&
 408            ( n->elm->val.cnst == val )
 409          );
 410 }
 411
 412 NODE * BinaryOp( int op, NODE *n1, NODE *n2 )
 413 {
 414 NODE *n;
 415
 416   n   = (NODE*)    malloc( sizeof(NODE) );
 417   n->left = n1;
 418   n->right = n2;
 419   n->type = op;
 420   n->sign = 1;
 421   n->elm = 0;
 422   return n;
 423 }
 424
 425 NODE * Add( NODE *n1, NODE *n2 )
 426 {
 427   if( n1 == 0 ) return n2;
 428   if( n2 == 0 ) return n1;
 429
 430   if( IsConst( n1, 0 ) ) {
 431     FreeNode( n1 );
 432     return n2;
 433   }
 434   if( IsConst( n2, 0 ) ) {
 435     FreeNode( n2 );
 436     return n1;
 437   }
 438   return BinaryOp( ADD, n1, n2 );
 439 }
 440
 441 NODE * Sub( NODE *n1, NODE *n2 )
 442 {
 443   if( n1 == 0 ) return BinaryOp( SUB, 0, n2 );
 444   if( n2 == 0 ) return n1;
 445
 446   if( IsConst( n1, 0 ) ) {
 447     FreeNode( n1 );
 448     return  BinaryOp( SUB, 0, n2 );
 449   }
 450   if( IsConst( n2, 0 ) ) {
 451     FreeNode( n2 );
 452     return n1;
 453   }
 454   return BinaryOp( SUB, n1, n2 );
 455 }
 456
 457 NODE * Mul( NODE *n1, NODE *n2 )
 458 {
 459   if( n1 == 0 ) return n2;
 460   if( n2 == 0 ) return n1;
 461
 462   if( IsConst( n1, 1 ) ) {
 463     n2->sign *= n1->sign;
 464     FreeNode( n1 );
 465     return n2;
 466   }
 467   if( IsConst( n2, 1 ) ) {
 468     n2->sign *= n1->sign;
 469     FreeNode( n2 );
 470     return n1;
 471   }
 472   if( IsConst( n1, 0 ) ) {
 473     FreeNode( n2 );
 474     return n1;
 475   }
 476   if( IsConst( n2, 0 ) ) {
 477     FreeNode( n1 );
 478     return n2;
 479   }
 480
 481   return BinaryOp( MUL, n1, n2 );
 482 }
 483
 484 NODE * Div( NODE *n1, NODE *n2 )
 485 {
 486   if( n1 == 0 ) return BinaryOp( DIV, Const(1), n2 );
 487   if( n2 == 0 ) return n1;
 488
 489   if( IsConst( n2, 1 ) ) {
 490     n2->sign *= n1->sign;
 491     FreeNode( n2 );
 492     return n1;
 493   }
 494
 495   return BinaryOp( DIV, n1, n2 );
 496 }
 497
 498 NODE * Pow( NODE *n1, NODE *n2 )
 499 {
 500   if( n1 == 0 ) return n2;
 501   if( n2 == 0 ) return n1;
 502   return BinaryOp( POW, n1, n2 );
 503 }
 504
 505 void FreeNode( NODE * n )
 506 {
 507   if( n == 0 ) return;
 508   FreeNode( n->left );
 509   FreeNode( n->right );
 510   if( n->elm ) free( n->elm );
 511   free( n );
 512 }
 513
 514 int NodeCmp( NODE *n1, NODE *n2 )
 515 {
 516 ELEMENT *elm1;
 517 ELEMENT *elm2;
 518
 519   if( n1 == n2 ) return 1;
 520   if( n1 == 0 ) return 0;
 521   if( n2 == 0 ) return 0;
 522
 523   if( (n1->type % SUBST) != (n2->type % SUBST) ) return 0;
 524
 525   elm1 = n1->elm;
 526   elm2 = n2->elm;
 527
 528   if( elm1 == elm2 ) return 1;
 529   if( elm1 == 0 ) return 0;
 530   if( elm2 == 0 ) return 0;
 531
 532   if( elm1->var != elm2->var )return 0;
 533   switch( n1->type ) {
 534     case CONST: if( elm1->val.cnst != elm2->val.cnst ) return 0;
 535                 break;
 536     case ELM:   break;
 537     case VELM:  if( elm1->val.idx.i != elm2->val.idx.i ) return 0;
 538                 break;
 539     case MELM:  if( elm1->val.idx.i != elm2->val.idx.i ) return 0;
 540                 if( elm1->val.idx.j != elm2->val.idx.j ) return 0;
 541                 break;
 542     case EELM:  if( strcmp( elm1->val.expr, elm2->val.expr ) != 0 ) return 0;
 543                 break;
 544   }
 545
 546   return 1;
 547 }
 548
 549 NODE * NodeCopy( NODE *n1 )
 550 {
 551 NODE *n;
 552 ELEMENT *elm;
 553
 554   n   = (NODE*)    malloc( sizeof(NODE) );
 555   elm = (ELEMENT*) malloc( sizeof(ELEMENT) );
 556   *n = *n1;
 557   n->elm = elm;
 558   *n->elm = *n1->elm;
 559   return n;
 560 }
 561
 562 void WriteNode( NODE *n )
 563 {
 564   crtop = NONE;
 565   ExpandNode( n, NONE );
 566 }
 567
 568 void WriteOp( int op )
 569 {
 570   WriteSymbol( op );
 571   crtop = NONE;
 572 }
 573
 574 void ExpandElm( NODE * n )
 575 {
 576 NODE *cn;
 577
 578   if( substENABLED == 0 ) {
 579     WriteElm( n );
 580     return;
 581   }
 582   cn = LookUpSubst( n );
 583   if( cn == 0 ) {
 584     WriteElm( n );
 585   } else {
 586     if( cn->type > SUBST ) {
 587       WriteElm( n );
 588     } else {
 589       cn->type += SUBST;
 590       WriteSymbol( O_PAREN );
 591       WriteNode( cn->right );
 592       WriteSymbol( C_PAREN );
 593       cn->type -= SUBST;
 594     }
 595   }
 596 }
 597
 598 int ExpandNode( NODE *n, int lastop )
 599 {
 600 int needParen = 0;
 601
 602   if( n == 0 ) return lastop;
 603
 604   if( ( n->left ) &&
 605       ( PRI[ n->left->type ] < PRI[ n->type ] ) )
 606       needParen = 1;
 607
 608   if( needParen ) {
 609     WriteOp( crtop );
 610     WriteSymbol( O_PAREN );
 611   }
 612   lastop = ExpandNode( n->left, lastop );
 613   if( needParen ) WriteSymbol( C_PAREN );
 614
 615   switch( n->type ) {
 616     case ADD:
 617     case SUB:
 618     case MUL:
 619     case DIV:
 620     case POW:   crtop = n->type;
 621                 break;
 622     case NONE:  printf("ERROR - null element");
 623                 break;
 624     case CONST:
 625     case ELM:
 626     case VELM:
 627     case MELM:
 628     case EELM:
 629                 switch( crtop ) {
 630                   case MUL: case DIV: case POW:
 631                     WriteOp( crtop );
 632                     if ( n->sign == -1 ) {
 633                       WriteSymbol( O_PAREN );
 634                       WriteOp( SUB );
 635                       ExpandElm( n );
 636                       WriteSymbol( C_PAREN );
 637                     } else {
 638                       ExpandElm( n );
 639                     }
 640                     break;
 641                   case ADD:  if( n->sign == -1 )
 642                                crtop = SUB;
 643                              WriteOp( crtop );
 644                              ExpandElm( n );
 645                              break;
 646                   case SUB:  if( n->sign == -1 )
 647                                crtop = ADD;
 648                              WriteOp( crtop );
 649                              ExpandElm( n );
 650                              break;
 651                   case NONE: if( n->sign == -1 )
 652                                WriteOp( SUB );
 653                              ExpandElm( n );
 654                              break;
 655                 }
 656                 break;
 657   }
 658
 659   if( ( n->right ) &&
 660       ( PRI[ n->right->type ] <= PRI[ n->type ] ) )
 661       needParen = 1;
 662
 663   if( needParen ) {
 664     WriteOp( crtop );
 665     WriteSymbol( O_PAREN );
 666   }
 667   lastop = ExpandNode( n->right, n->type );
 668   if( needParen ) WriteSymbol( C_PAREN );
 669   return lastop;
 670 }
 671
 672 void Assign( NODE *lval, NODE *rval )
 673 {
 674 char *ls;
 675 char *rs;
 676 char *olds;
 677
 678   ls = (char*)malloc( MAX_OUTBUF );
 679   rs = (char*)malloc( MAX_OUTBUF );
 680
 681   olds = outBuffer;
 682   outBuffer = ls;
 683   WriteNode( lval );
 684   outBuffer = rs;
 685   WriteNode( rval );
 686   outBuffer = olds;
 687
 688   WriteAssign( ls, rs );
 689
 690   free( rs );
 691   free( ls );
 692   FreeNode( lval );
 693   FreeNode( rval );
 694 }
 695
 696 NODE * LookUpSubst( NODE *n )
 697 {
 698 NODE *cn;
 699
 700   cn = substList;
 701   while( cn != 0 ) {
 702     if( NodeCmp( n, cn ) )
 703       return cn;
 704     cn = cn->left;
 705   }
 706   return 0;
 707 }
 708
 709 void MkSubst( NODE *n1, NODE *n2 )
 710 {
 711 NODE *n;
 712
 713   n = LookUpSubst( n1 );
 714   if( n == 0 ) {
 715     n = n1;
 716     n->left = substList;
 717     substList = n;
 718   } else {
 719     FreeNode( n->right );
 720     FreeNode( n1 );
 721   }
 722   n->right = n2;
 723 }
 724
 725 void RmSubst( NODE *n )
 726 {
 727 NODE *pn;
 728 NODE *cn;
 729
 730   pn = 0;
 731   cn = substList;
 732   while( cn != 0 ) {
 733     if( NodeCmp( n, cn ) )
 734       break;
 735     pn = cn;
 736     cn = cn->left;
 737   }
 738   if( cn == 0 ) return;
 739
 740   FreeNode( cn->right );
 741   if( pn )
 742     pn->left = cn->left;
 743   else
 744     substList = cn->left;
 745
 746   cn->right = 0;
 747   cn->left = 0;
 748   FreeNode( cn );
 749 }
 750
 751 void DisplaySubst()
 752 {
 753 NODE *n;
 754
 755   n = substList;
 756   substENABLED = 0;
 757   while( n != 0 ) {
 758     printf("Subst: ");
 759     WriteElm( n );
 760     printf( " --> " );
 761     WriteNode( n->right );
 762     printf("\n");
 763     n = n->left;
 764   }
 765   substENABLED = 1;
 766 }
 767
 768 void CommentFncBegin( int f, int *vars )
 769 {
 770 VARIABLE *var;
 771 char * name;
 772 int narg;
 773 int i;
 774
 775   name = varTable[ f ]->name;
 776   narg = varTable[ f ]->maxi;
 777   var = varTable[ f ];
 778
 779   WriteDelim();
 780   WriteComment("");
 781   WriteComment("%s - %s", var->name, var->comment );
 782   WriteComment("  Arguments :");
 783   for( i = 0; i < narg; i++ ) {
 784     var = varTable[vars[i]];
 785     WriteComment("     %-10s- %s", var->name, var->comment );
 786   }
 787   WriteComment("");
 788   WriteDelim();
 789   NewLines(1);
 790 }
 791
 792 void CommentFunctionBegin( int f, ... )
 793 {
 794 Va_list args;
 795 int i;
 796 int vars[20];
 797 char * name;
 798 int narg;
 799
 800   name = varTable[ f ]->name;
 801   narg = varTable[ f ]->maxi;
 802
 803   Va_start( args, f );
 804   for( i = 0; i < narg; i++ )
 805     vars[i] = va_arg( args, int );
 806   va_end( args );
 807
 808   CommentFncBegin( f, vars );
 809   /* MapFunctionComment( f, vars ); */
 810 }
 811
 812 void CommentFunctionEnd( int f )
 813 {
 814   WriteComment("End of %s function", varTable[ f ]->name );
 815   WriteDelim();
 816   NewLines(2);
 817 }
 818