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