regina/expr.c

   1 /*
   2  *  The Regina Rexx Interpreter
   3  *  Copyright (C) 1993-1994  Anders Christensen <anders@pvv.unit.no>
   4  *
   5  *  This library is free software; you can redistribute it and/or
   6  *  modify it under the terms of the GNU Library General Public
   7  *  License as published by the Free Software Foundation; either
   8  *  version 2 of the License, or (at your option) any later version.
   9  *
  10  *  This library is distributed in the hope that it will be useful,
  11  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  *  Library General Public License for more details.
  14  *
  15  *  You should have received a copy of the GNU Library General Public
  16  *  License along with this library; if not, write to the Free
  17  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  */
  19
  20 #include "rexx.h"
  21
  22 #include <string.h>
  23 #include <assert.h>
  24
  25 #define TRACEVALUE(a,b) if (TSD->trace_stat=='I') tracevalue(TSD,a,b)
  26
  27 #ifdef TRACEMEM
  28 static void mark_in_expr( const tsd_t *TSD )
  29 {
  30    if (TSD->rdes.num)
  31       markmemory( TSD->rdes.num, TRC_STATIC ) ;
  32    if (TSD->ldes.num)
  33       markmemory( TSD->ldes.num, TRC_STATIC ) ;
  34 }
  35 #endif
  36
  37 /*
  38  * COMP_IGNORE returns 1 if c shall be ignored on a non-strict comparison
  39  * between non-numbers. Previously, this was equal to isspace(c). This was
  40  * wrong according to ANSI, section 7.4.7. This fixes bug 594674.
  41  */
  42 #define ANSI_COMP_IGNORE(c) ( (c) == ' ' )
  43 #define REGINA_COMP_IGNORE(c) ( rx_isspace(c) )
  44
  45 #define FREE_TMP_STRING(str) if ( str )               \
  46                                 Free_stringTSD( str )
  47
  48 int init_expr( tsd_t *TSD )
  49 {
  50 #ifdef TRACEMEM
  51    regmarker( TSD, mark_in_expr ) ;
  52 #endif
  53    TSD = TSD; /* keep compiler happy */
  54    return(1);
  55 }
  56
  57
  58 static num_descr *copy_num( const tsd_t *TSD, const num_descr *input )
  59 {
  60    num_descr *newptr=NULL ;
  61
  62    newptr = (num_descr *)MallocTSD( sizeof( num_descr )) ;
  63    newptr->negative = input->negative ;
  64    newptr->size = input->size ;
  65    newptr->max = (input->max < 1) ? 1 : input->max ;
  66    newptr->exp = input->exp ;
  67    newptr->num = (char *)MallocTSD( newptr->max ) ;
  68    newptr->used_digits = input->used_digits;
  69    memcpy( newptr->num, input->num, newptr->size ) ;
  70    TSD = TSD; /* keep compiler happy */
  71    return newptr ;
  72 }
  73
  74
  75 static streng *num_to_str( const tsd_t *TSD, num_descr *input )
  76 {
  77    return str_norm( TSD, input, NULL ) ;
  78 }
  79
  80 static int num_to_bool( const num_descr *input )
  81 {
  82    char ch=' ' ;
  83
  84    if (input==NULL)
  85        exiterror( ERR_UNLOGICAL_VALUE, 0 )  ;
  86
  87    if (input->size!=1 || input->negative || input->exp!=1)
  88        exiterror( ERR_UNLOGICAL_VALUE, 0 )  ;
  89
  90     ch = input->num[0] ;
  91     if (ch!='0' && ch!='1')
  92         exiterror( ERR_UNLOGICAL_VALUE, 0 )  ;
  93
  94     return ch=='1' ;
  95 }
  96
  97 static int str_to_bool( const streng *input )
  98 {
  99    char ch=' ' ;
 100
 101    if (input->len!=1)
 102        exiterror( ERR_UNLOGICAL_VALUE, 0 )  ;
 103
 104    ch = input->value[0] ;
 105    if (ch!='0' && ch!='1')
 106        exiterror( ERR_UNLOGICAL_VALUE, 0 )  ;
 107
 108    return ch == '1' ;
 109 }
 110
 111 static streng *bool_to_str( const tsd_t *TSD, int input )
 112 {
 113    return Str_creTSD( input ? "1" : "0" ) ;
 114 }
 115
 116 static num_descr *bool_to_num( const tsd_t *TSD, int input )
 117 {
 118    num_descr *num=NULL ;
 119
 120    num = (num_descr *)MallocTSD( sizeof( num_descr )) ;
 121    num->max = 8 ;
 122    num->num = (char *)MallocTSD( 8 ) ;
 123    num->size = 1 ;
 124    num->negative = 0 ;
 125    num->exp = 1 ;
 126    num->num[0] = (char) ((input) ? '1' : '0') ;
 127    num->used_digits = TSD->currlevel->currnumsize;
 128    return num ;
 129 }
 130
 131 /*
 132  * calcul evaluates a numeric expression. thisptr is the current evaluation tree.
 133  * kill? return value?
 134  * Note: This is one of the most time-consuming routines. Be careful.
 135  */
 136 num_descr *calcul( tsd_t *TSD, nodeptr thisptr, num_descr **kill )
 137 {
 138    num_descr *numthr, *numone, *numtwo ;
 139    num_descr *ntmp1=NULL, *ntmp2=NULL ;
 140    num_descr *nptr;
 141    streng *sptr;
 142    int strip2 = 0; /* fixes bug 1107763, second part */
 143
 144    switch ( thisptr->type )
 145    {
 146       case 0:
 147       case 255:
 148       case X_MINUS:
 149          numone = calcul( TSD, thisptr->p[0], &ntmp1 ) ;
 150          numtwo = calcul( TSD, thisptr->p[1], &ntmp2 ) ;
 151          if (!ntmp2)
 152             ntmp2 = numtwo = copy_num( TSD, numtwo ) ;
 153
 154          numtwo->negative = !numtwo->negative ;
 155          goto do_an_add ;
 156
 157       case X_PLUSS:
 158          numone = calcul( TSD, thisptr->p[0], &ntmp1 ) ;
 159          numtwo = calcul( TSD, thisptr->p[1], &ntmp2 ) ;
 160 do_an_add:
 161          if (ntmp1)
 162          {
 163             numthr = numone ;
 164             ntmp1 = NULL ;
 165          }
 166          else if (ntmp2)
 167          {
 168             numthr = numtwo ;
 169             ntmp2 = NULL ;
 170          }
 171          else
 172             numthr = copy_num( TSD, numtwo ) ;
 173
 174          string_add( TSD, numone, numtwo, numthr, thisptr->p[0], thisptr->p[1] ) ;
 175          break ;
 176
 177       case X_MULT:
 178          numone = calcul( TSD, thisptr->p[0], &ntmp1 ) ;
 179          numtwo = calcul( TSD, thisptr->p[1], &ntmp2 ) ;
 180          if (ntmp1)
 181          {
 182             numthr = numone ;
 183             ntmp1 = NULL ;
 184          }
 185          else if (ntmp2)
 186          {
 187             numthr = numtwo ;
 188             ntmp2 = NULL ;
 189          }
 190          else
 191             numthr = copy_num( TSD, numtwo ) ;
 192
 193          string_mul( TSD, numone, numtwo, numthr, thisptr->p[0], thisptr->p[1] );
 194          break ;
 195
 196       case X_DEVIDE:
 197       case X_MODULUS:
 198       case X_INTDIV:
 199          numone = calcul( TSD, thisptr->p[0], &ntmp1 ) ;
 200          numtwo = calcul( TSD, thisptr->p[1], &ntmp2 ) ;
 201          if (numtwo->size==1 && numtwo->num[0]=='0')
 202              exiterror( ERR_ARITH_OVERFLOW, 3 )  ;
 203
 204          numthr = copy_num( TSD, numtwo ) ;
 205          string_div( TSD, numone, numtwo, numthr, NULL,
 206             ((thisptr->type==X_DEVIDE) ? DIVTYPE_NORMAL :
 207             ((thisptr->type==X_MODULUS) ? DIVTYPE_REMAINDER : DIVTYPE_INTEGER)),
 208             thisptr->p[0], thisptr->p[1] );
 209          strip2 = 1;
 210          break ;
 211
 212       case X_EXP:
 213          numone = calcul( TSD, thisptr->p[0], &ntmp1 ) ;
 214          numtwo = ntmp2 = calcul( TSD, thisptr->p[1], NULL ) ;
 215          numthr = copy_num( TSD, numone ) ;
 216          string_pow( TSD, numone, numtwo, numthr, thisptr->p[0], thisptr->p[1] ) ;
 217          strip2 = 1;
 218          break ;
 219
 220       case X_STRING:
 221       case X_CON_SYMBOL:
 222          if ( !thisptr->u.number )
 223             thisptr->u.number = get_a_descr( TSD, NULL, 0, thisptr->name ) ;
 224
 225          if (TSD->trace_stat=='I')
 226             tracenumber( TSD, thisptr->u.number, 'L' ) ;
 227
 228          if (kill)
 229          {
 230             *kill = NULL ;
 231             return thisptr->u.number ;
 232          }
 233          else
 234             return copy_num( TSD, thisptr->u.number ) ;
 235
 236       case X_SIM_SYMBOL:
 237       case X_STEM_SYMBOL:
 238          if (kill)
 239             *kill = NULL ;
 240
 241          nptr = shortcutnum( TSD, thisptr ) ;
 242          if (!nptr)
 243              exiterror( ERR_BAD_ARITHMETIC, 0 )  ;
 244
 245          if (kill)
 246             return nptr ;
 247          else
 248             return copy_num( TSD, nptr ) ;
 249
 250       case X_HEAD_SYMBOL:
 251          if (kill)
 252             *kill = NULL ;
 253
 254          nptr = fix_compoundnum( TSD, thisptr, NULL, NULL );
 255          if (!nptr)
 256              exiterror( ERR_BAD_ARITHMETIC, 0 )  ;
 257
 258          if (kill)
 259             return nptr ;
 260          else
 261             return copy_num( TSD, nptr ) ;
 262
 263       case X_U_PLUSS:
 264       case X_U_MINUS:
 265          numthr = calcul( TSD, thisptr->p[0], &ntmp1 ) ;
 266          if (!ntmp1)
 267             numthr = copy_num( TSD, numthr ) ;
 268
 269          if (thisptr->type==X_U_MINUS)
 270             numthr->negative = !numthr->negative ;
 271
 272          if (kill)
 273             *kill = numthr ;
 274
 275          if (TSD->trace_stat=='I')
 276             tracenumber( TSD, numthr, 'P' ) ;
 277
 278          return numthr ;
 279
 280       case X_IN_FUNC:
 281       case X_IS_INTERNAL:
 282       case X_IS_BUILTIN:
 283       case X_EX_FUNC:
 284       case X_IS_EXTERNAL:
 285       case X_CONCAT:
 286       case X_SPACE:
 287       {
 288          numthr = get_a_descr( TSD, NULL, 0, evaluate( TSD, thisptr, &sptr ) );
 289          FREE_TMP_STRING( sptr );
 290          if (kill)
 291             *kill = numthr ;
 292          return numthr ;
 293       }
 294       case X_LOG_NOT:
 295       case X_LOG_OR:
 296       case X_LOG_AND:
 297       case X_LOG_XOR:
 298       case X_S_DIFF:
 299       case X_S_EQUAL:
 300       case X_EQUAL:
 301       case X_GT:
 302       case X_LT:
 303       case X_GTE:
 304       case X_LTE:
 305       case X_DIFF:
 306       case X_SEQUAL:
 307       case X_SGT:
 308       case X_SLT:
 309       case X_SGTE:
 310       case X_SLTE:
 311       case X_SDIFF:
 312       case X_NEQUAL:
 313       case X_NGT:
 314       case X_NLT:
 315       case X_NGTE:
 316       case X_NLTE:
 317       case X_NDIFF:
 318       case X_S_NGT:
 319       case X_S_NLT:
 320       case X_S_GT:
 321       case X_S_GTE:
 322       case X_S_LT:
 323       case X_S_LTE:
 324          numthr = bool_to_num( TSD, isboolean( TSD, thisptr, 0, NULL )) ;
 325          if (kill)
 326             *kill = numthr ;
 327          return numthr ;
 328
 329       default:
 330          exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
 331          return NULL ;
 332    }
 333
 334    if (ntmp1)
 335    {
 336       FreeTSD( numone->num ) ;
 337       FreeTSD( numone ) ;
 338    }
 339    if (ntmp2)
 340    {
 341       FreeTSD( numtwo->num ) ;
 342       FreeTSD( numtwo ) ;
 343    }
 344    if (kill)
 345       *kill = numthr ;
 346
 347    if (TSD->trace_stat=='I')
 348       tracenumber( TSD, numthr, 'O' ) ;
 349
 350    str_strip( numthr ) ;
 351    str_round( numthr, TSD->currlevel->currnumsize ) ;
 352    if ( strip2 )
 353    {
 354       /*
 355        * ANSI 7.4.10, PostOp, add. rounding for / and **
 356        */
 357       strip2 = numthr->size;
 358       while ( ( strip2 > 1 ) &&
 359               ( numthr->exp < strip2) &&
 360               ( numthr->num[strip2 - 1] == '0' ) )
 361          strip2--;
 362       if ( strip2 != numthr->size )
 363       {
 364          numthr->size = strip2;
 365          if ( strip2 < numthr->used_digits )
 366             numthr->used_digits = strip2;
 367       }
 368    }
 369    return numthr ;
 370 }
 371
 372 static void strip_whitespace( tsd_t *TSD, unsigned char **s1,
 373                               unsigned char **e1, unsigned char **s2,
 374                               unsigned char **e2 )
 375 {
 376    if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI )
 377    ||   get_options_flag( TSD->currlevel, EXT_STRICT_WHITE_SPACE_COMPARISONS ) )
 378    {
 379       /*
 380        * ANSI 7.4.7 behaviour; non-strict comparisons
 381        * removed ONLY spaces, so single TAB not equal to single SPACE
 382        */
 383       /*
 384        * Strip leading spaces - ignored in comparison
 385        */
 386       for( ; ( *s1 < *e1 ) && ANSI_COMP_IGNORE( **s1 ); (*s1)++ )
 387       {
 388       }
 389       for( ; ( *s2 < *e2 ) && ANSI_COMP_IGNORE( **s2 ); (*s2)++ )
 390       {
 391       }
 392       for ( ; ( *s1 < *e1 ) && ( *s2 < *e2 ) && ( **s1 == **s2 ); (*s1)++, (*s2)++ )
 393       {
 394       }
 395       /*
 396        * Strip trailing spaces - ignored in comparison
 397        */
 398       for ( ; ( *e1 > *s1 ) && ANSI_COMP_IGNORE( *( *e1 - 1 ) ); (*e1)-- )
 399       {
 400       }
 401       for ( ; ( *e2 > *s2 ) && ANSI_COMP_IGNORE( *( *e2 - 1 ) ); (*e2)-- )
 402       {
 403       }
 404    }
 405    else
 406    {
 407       /*
 408        * Original Regina behaviour; non-strict comparisons
 409        * removed ALL white space, so single TAB equalled single SPACE
 410        */
 411       /*
 412        * Strip leading white space - ignored in comparison
 413        */
 414       for( ; ( *s1 < *e1 ) && REGINA_COMP_IGNORE( **s1 ); (*s1)++ )
 415       {
 416       }
 417       for( ; ( *s2 < *e2 ) && REGINA_COMP_IGNORE( **s2 ); (*s2)++ )
 418       {
 419       }
 420       for ( ; ( *s1 < *e1 ) && ( *s2 < *e2 ) && ( **s1 == **s2 ); (*s1)++, (*s2)++ )
 421       {
 422       }
 423       /*
 424        * Strip trailing white space - ignored in comparison
 425        */
 426       for ( ; ( *e1 > *s1 ) && REGINA_COMP_IGNORE( *( *e1 - 1 ) ); (*e1)-- )
 427       {
 428       }
 429       for ( ; ( *e2 > *s2 ) && REGINA_COMP_IGNORE( *( *e2 - 1 ) ); (*e2)-- )
 430       {
 431       }
 432    }
 433 }
 434
 435
 436 /*
 437  * evaluate evaluates an expression. The nodeptr "thisptr" must point to an
 438  * expression part. The return value is the value of the expression.
 439  * For a proper cleanup the caller probably has to delete a the returned
 440  * value. For this purpose, the caller may set "kill" to non-NULL.
 441  * *kill is set to NULL, if the returned value is a const value and must
 442  * not be freed. *kill is set to a temporary value which has to be deleted
 443  * after the use of the returned value.
 444  * The caller may omit kill, this forces evaluate to create a freshly allocated
 445  * return value.
 446  */
 447 streng *evaluate( tsd_t *TSD, nodeptr thisptr, streng **kill )
 448 {
 449 #define RETURN_NEW(val) if ( kill )     \
 450                            *kill = val; \
 451                         return val;
 452    streng *strone,*strtwo,*strthr;
 453    streng *stmp1,*stmp2;
 454    const streng *cstmp;
 455    num_descr *ntmp;
 456
 457    if ( kill )
 458       *kill = NULL;
 459    switch ( thisptr->type )
 460    {
 461       case 0:
 462       case 255:
 463       case X_PLUSS:
 464       case X_MINUS:
 465       case X_MULT:
 466       case X_DEVIDE:
 467       case X_MODULUS:
 468       case X_INTDIV:
 469       case X_EXP:
 470       case X_U_MINUS:
 471       case X_U_PLUSS:
 472          ntmp = NULL;
 473          stmp1 = num_to_str( TSD, calcul( TSD, thisptr, &ntmp ) );
 474          if ( ntmp )
 475          {
 476             FreeTSD( ntmp->num );
 477             FreeTSD( ntmp );
 478          }
 479          RETURN_NEW( stmp1 );
 480
 481       case X_NULL:
 482          return NULL ;
 483
 484       case X_STRING:
 485       case X_CON_SYMBOL:
 486          cstmp = thisptr->name;
 487          if ( TSD->trace_stat == 'I' )
 488             tracevalue( TSD, cstmp, 'L' );
 489          if ( kill )
 490             return (streng *) cstmp; /* and *kill is set to NULL above */
 491          stmp1 = Str_dupTSD( cstmp );
 492          RETURN_NEW( stmp1 );
 493
 494       case X_HEAD_SYMBOL:
 495          /* always duplicate, since stmp1 might point to tmp area */
 496          stmp1 = Str_dupTSD( fix_compound( TSD, thisptr, NULL ) );
 497          RETURN_NEW( stmp1 );
 498
 499       case X_STEM_SYMBOL:
 500       case X_SIM_SYMBOL:
 501          cstmp = shortcut(TSD,thisptr) ;
 502          if ( kill )
 503             return (streng *) cstmp; /* and *kill is set to NULL above */
 504          stmp1 = Str_dupTSD( cstmp );
 505          RETURN_NEW( stmp1 );
 506
 507       case X_IN_FUNC:
 508       {
 509          nodeptr entry;
 510
 511          if ( ( entry = getlabel( TSD, thisptr->name ) ) != NULL )
 512          {
 513             if ( entry->u.trace_only )
 514                exiterror( ERR_UNEXISTENT_LABEL, 3, tmpstr_of( TSD, thisptr->name ) );
 515             thisptr->type = X_IS_INTERNAL;
 516             thisptr->u.node = entry;
 517          }
 518          else
 519             thisptr->u.node = NULL;
 520       }
 521
 522       case X_IS_INTERNAL:
 523       {
 524          nodeptr entry ;
 525          paramboxptr args ;
 526          streng *ptr ;
 527
 528          /*
 529           * Check if the internal function name ends with a '.'.
 530           * This is an error in the ANSI standard, but it is possible
 531           * that existing code allows this, so only generate an error
 532           * if STRICT_ANSI OPTION is set.
 533           */
 534          if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 535          {
 536             if ( thisptr->name->value[(thisptr->name->len)-1] == '.' )
 537                exiterror( ERR_UNQUOTED_FUNC_STOP, 1, tmpstr_of( TSD, thisptr->name ) )  ;
 538          }
 539          if ( ( entry = thisptr->u.node ) != NULL )
 540          {
 541             set_reserved_value( TSD, POOL0_SIGL, NULL,
 542                                 TSD->currentnode->lineno, VFLAG_NUM );
 543             args = initplist( TSD, thisptr );
 544
 545             ptr = CallInternalFunction( TSD, entry->next, TSD->currentnode,
 546                                         args );
 547
 548             if (ptr==NULL) /* fixes bug 592393 */
 549                exiterror( ERR_NO_DATA_RETURNED, 1, tmpstr_of( TSD, thisptr->name ) );
 550
 551             if (TSD->trace_stat=='I')
 552                tracevalue( TSD, ptr, 'F' );
 553
 554             RETURN_NEW( ptr );
 555          }
 556       }
 557       /* THIS IS MEANT TO FALL THROUGH! */
 558       case X_IS_BUILTIN:
 559       case X_EX_FUNC:
 560       {
 561          streng *ptr ;
 562
 563          if ((ptr=buildtinfunc( TSD, thisptr )) != NOFUNC)
 564          {
 565             if (thisptr->type != X_IS_BUILTIN)
 566                thisptr->type = X_IS_BUILTIN ;
 567
 568             if (!ptr)
 569                 exiterror( ERR_NO_DATA_RETURNED, 1, tmpstr_of( TSD, thisptr->name ) )  ;
 570
 571             if (TSD->trace_stat=='I')
 572                tracevalue( TSD, ptr, 'F' ) ;
 573
 574             RETURN_NEW( ptr );
 575          }
 576          else
 577             thisptr->type = X_IS_EXTERNAL ;
 578       }
 579       /* THIS IS MEANT TO FALL THROUGH! */
 580       case X_IS_EXTERNAL:
 581       {
 582          streng *ptr, *command;
 583          int stackmark,len,err;
 584          paramboxptr args, targs;
 585
 586          if ( TSD->restricted )
 587             exiterror( ERR_RESTRICTED, 5 );
 588
 589          update_envirs( TSD, TSD->currlevel );
 590
 591          args = initplist( TSD, thisptr );
 592          stackmark = pushcallstack( TSD, TSD->currentnode );
 593          ptr = execute_external( TSD, thisptr->name,
 594                                  args,
 595                                  TSD->systeminfo->environment,
 596                                  &err,
 597                                  TSD->systeminfo->hooks,
 598                                  INVO_FUNCTION );
 599          popcallstack( TSD, stackmark );
 600
 601          if ( err == -ERR_PROG_UNREADABLE )
 602          {
 603             /*
 604              * "thisptr->name" wasn't a Rexx program, so
 605              * see if it is an OS command.
 606              * Only do thisptr if the OPTIONS EXT_COMMANDS_AS_FUNCS is
 607              * set and STRICT_ANSI is NOT set.
 608              */
 609             if ( get_options_flag( TSD->currlevel, EXT_EXT_COMMANDS_AS_FUNCS )
 610             &&  !get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 611             {
 612                len = Str_len( thisptr->name );
 613                for( targs = args; targs; targs = targs->next )
 614                {
 615                   if ( targs->value )
 616                      len += 1 + Str_len( targs->value );
 617                }
 618                command = Str_makeTSD( len );
 619                command = Str_catTSD( command, thisptr->name );
 620                for( targs = args; targs; targs = targs->next )
 621                {
 622                   if ( targs->value )
 623                   {
 624                      command = Str_catstrTSD( command, " " );
 625                      command = Str_catTSD( command, targs->value );
 626                   }
 627                }
 628                ptr = run_popen( TSD, command, TSD->currlevel->environment );
 629                if ( ptr != NULL )
 630                   err = 0;
 631                Free_stringTSD( command );
 632             }
 633          }
 634
 635          deallocplink( TSD, args );
 636
 637          if ( ptr && ( TSD->trace_stat == 'I' ) )
 638             tracevalue( TSD, ptr, 'F' );
 639
 640          if ( err == -ERR_PROG_UNREADABLE )
 641          {
 642             exiterror( ERR_ROUTINE_NOT_FOUND, 1, tmpstr_of( TSD, thisptr->name ) );
 643          }
 644          else if ( err )
 645          {
 646             post_process_system_call( TSD, thisptr->name, -err, NULL, thisptr );
 647          }
 648
 649          if ( !ptr )
 650             exiterror( ERR_NO_DATA_RETURNED, 1, tmpstr_of( TSD, thisptr->name ) );
 651
 652          RETURN_NEW( ptr );
 653       }
 654
 655       case X_CONCAT:
 656       case X_SPACE:
 657       {
 658          char *cptr ;
 659
 660          strone = evaluate( TSD, thisptr->p[0], &stmp1 ) ;
 661          strtwo = evaluate( TSD, thisptr->p[1], &stmp2 ) ;
 662          strthr = Str_makeTSD(Str_len(strone)+Str_len(strtwo)+1) ;
 663          cptr = strthr->value ;
 664          memcpy( cptr, strone->value, strone->len ) ;
 665          cptr += strone->len ;
 666          if (thisptr->type==X_SPACE)
 667             *(cptr++) = ' ' ;
 668
 669          memcpy( cptr, strtwo->value, strtwo->len ) ;
 670          strthr->len = (cptr-strthr->value) + strtwo->len ;
 671
 672          FREE_TMP_STRING( stmp1 );
 673          FREE_TMP_STRING( stmp2 );
 674
 675          if (TSD->trace_stat=='I')
 676             tracevalue( TSD, strthr, 'O' ) ;
 677
 678
 679          RETURN_NEW( strthr );
 680       }
 681
 682
 683       case X_LOG_NOT:
 684       case X_LOG_OR:
 685       case X_LOG_AND:
 686       case X_LOG_XOR:
 687       case X_S_DIFF:
 688       case X_S_EQUAL:
 689       case X_EQUAL:
 690       case X_GT:
 691       case X_LT:
 692       case X_GTE:
 693       case X_LTE:
 694       case X_DIFF:
 695       case X_SEQUAL:
 696       case X_SGT:
 697       case X_SLT:
 698       case X_SGTE:
 699       case X_SLTE:
 700       case X_SDIFF:
 701       case X_NEQUAL:
 702       case X_NGT:
 703       case X_NLT:
 704       case X_NGTE:
 705       case X_NLTE:
 706       case X_NDIFF:
 707       case X_S_NGT:
 708       case X_S_NLT:
 709       case X_S_GT:
 710       case X_S_GTE:
 711       case X_S_LT:
 712       case X_S_LTE:
 713          stmp1 = bool_to_str( TSD, isboolean( TSD, thisptr, 0, NULL )) ;
 714          RETURN_NEW( stmp1 );
 715
 716       default:
 717          exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
 718          return NULL ;
 719    }
 720 #undef RETURN_NEW
 721 }
 722
 723
 724 /*
 725  * isboolean evaluates a boolean expression and returns 0 for false, another
 726  * value for true. "thisptr" is the current evaluation tree.
 727  * Note: This is one of the most time-consuming routines. Be careful.
 728  */
 729 int isboolean( tsd_t *TSD, nodeptr thisptr, int suberror, const char *op )
 730 {
 731    streng *strone,*strtwo;
 732    streng *stmp1,*stmp2;
 733    int tmp,sint;
 734    num_descr *ntmp;
 735
 736    switch ( thisptr->type )
 737    {
 738       case 0:
 739       case 255:
 740       case X_PLUSS:
 741       case X_MINUS:
 742       case X_MULT:
 743       case X_DEVIDE:
 744       case X_MODULUS:
 745       case X_INTDIV:
 746       case X_EXP:
 747       case X_U_MINUS:
 748       case X_U_PLUSS:
 749          ntmp = NULL;
 750          tmp = num_to_bool( calcul( TSD, thisptr, &ntmp )) ;
 751          if (ntmp)
 752          {
 753             FreeTSD( ntmp->num ) ;
 754             FreeTSD( ntmp ) ;
 755          }
 756          return tmp ;
 757
 758       case X_STRING:
 759       case X_CON_SYMBOL:
 760          if ( !thisptr->u.number )
 761             thisptr->u.number = get_a_descr( TSD, NULL, 0, thisptr->name ) ;
 762          if ( Str_len( thisptr->name ) != 1 )
 763          {
 764             /* fixes bug 1111931, "01" is not a logical value in ANSI */
 765             if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 766             {
 767                if ( op )
 768                {
 769                   exiterror( ERR_UNLOGICAL_VALUE, suberror, op, tmpstr_of( TSD, thisptr->name ) );
 770                }
 771                else
 772                {
 773                   exiterror( ERR_UNLOGICAL_VALUE, suberror, tmpstr_of( TSD, thisptr->name ) );
 774                }
 775             }
 776          }
 777          return num_to_bool( thisptr->u.number ) ;
 778
 779       case X_SIM_SYMBOL:
 780       case X_STEM_SYMBOL:
 781          if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 782          {
 783             /* fixes bug 1111931 */
 784             stmp1 = (streng *) shortcut( TSD, thisptr );
 785             tmp = Str_val( stmp1 )[0] - '0';
 786             if ( ( Str_len( stmp1 ) != 1 ) || ( ( tmp != 0 ) && ( tmp != 1 ) ) )
 787             {
 788                if ( op )
 789                {
 790                   exiterror( ERR_UNLOGICAL_VALUE, suberror, op, tmpstr_of( TSD, stmp1 ) );
 791                }
 792                else
 793                {
 794                   exiterror( ERR_UNLOGICAL_VALUE, suberror, tmpstr_of( TSD, stmp1 ) );
 795                }
 796             }
 797             return tmp;
 798          }
 799          return num_to_bool( shortcutnum( TSD, thisptr )) ;
 800
 801       case X_HEAD_SYMBOL:
 802          if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 803          {
 804             /* fixes bug 1111931 */
 805             volatile char *s;
 806
 807             stmp1 = (streng *) fix_compound( TSD, thisptr, NULL );
 808             tmp = Str_val( stmp1 )[0] - '0';
 809             if ( ( Str_len( stmp1 ) != 1 ) || ( ( tmp != 0 ) && ( tmp != 1 ) ) )
 810             {
 811                s = tmpstr_of( TSD, stmp1 );
 812                Free_stringTSD( stmp1 );
 813                if ( op )
 814                {
 815                   exiterror( ERR_UNLOGICAL_VALUE, suberror, op, s );
 816                }
 817                else
 818                {
 819                   exiterror( ERR_UNLOGICAL_VALUE, suberror, s );
 820                }
 821             }
 822             Free_stringTSD( stmp1 );
 823             return tmp;
 824          }
 825          return num_to_bool( fix_compoundnum( TSD, thisptr, NULL, NULL ) );
 826
 827       case X_IN_FUNC:
 828       case X_IS_INTERNAL:
 829       case X_IS_BUILTIN:
 830       case X_EX_FUNC:
 831       case X_IS_EXTERNAL:
 832       case X_CONCAT:
 833       case X_SPACE:
 834          tmp = str_to_bool( evaluate( TSD, thisptr, &stmp1 ) );
 835          FREE_TMP_STRING( stmp1 );
 836          return tmp;
 837
 838       case X_LOG_NOT:
 839          sint = !isboolean( TSD, thisptr->p[0], 6, "\\" ) ;
 840          if (TSD->trace_stat=='I')
 841             tracebool( TSD, sint, 'U' ) ;
 842          return sint ;
 843
 844       case X_LOG_OR:
 845          sint = ( isboolean(TSD, thisptr->p[0], 5, "|") | isboolean( TSD, thisptr->p[1], 6, "|" )) ;
 846          if (TSD->trace_stat=='I')
 847             tracebool( TSD, sint, 'U' ) ;
 848          return sint ;
 849
 850       case X_LOG_AND:
 851          sint = ( isboolean(TSD, thisptr->p[0], 5, "&" ) & isboolean( TSD, thisptr->p[1], 6, "&" )) ;
 852          if (TSD->trace_stat=='I')
 853             tracebool( TSD, sint, 'U' ) ;
 854          return sint ;
 855
 856       case X_LOG_XOR:
 857          /* Well, sort of ... */
 858          sint = ( isboolean( TSD, thisptr->p[0], 5, "&&" ) ^ isboolean( TSD, thisptr->p[1], 6, "&&" )) ;
 859          if (TSD->trace_stat=='I')
 860             tracebool( TSD, sint, 'U' ) ;
 861          return sint ;
 862
 863       case X_EQUAL:
 864       case X_DIFF:
 865       case X_GT:
 866       case X_GTE:
 867       case X_LT:
 868       case X_LTE:
 869       {
 870          int type ;
 871          compflags flags ;
 872          num_descr *rnum, *lnum ;
 873          streng *lval, *rval ;
 874
 875          flags = thisptr->u.flags ;
 876          rnum = lnum = 0 ;
 877          rval = lval = NULL ;
 878          stmp1 = stmp2 = NULL ;
 879
 880          if (flags.lnum)
 881          {
 882             if ( !thisptr->p[0]->u.number )
 883                thisptr->p[0]->u.number = get_a_descr( TSD, NULL, 0, thisptr->p[0]->name );
 884
 885             lnum = thisptr->p[0]->u.number ;
 886             if (TSD->trace_stat=='I')
 887                tracenumber( TSD, lnum, 'L' ) ;
 888          }
 889          else if (flags.lsvar)
 890             lnum = shortcutnum( TSD, thisptr->p[0] ) ;
 891          else if (flags.lcvar)
 892             lnum = fix_compoundnum( TSD, thisptr->p[0], NULL, NULL );
 893
 894          if (!lnum)
 895             lval = evaluate( TSD, thisptr->p[0], &stmp1 ) ;
 896
 897          if (flags.rnum)
 898          {
 899             if ( !thisptr->p[1]->u.number )
 900                thisptr->p[1]->u.number = get_a_descr( TSD, NULL, 0, thisptr->p[1]->name );
 901
 902             rnum = thisptr->p[1]->u.number ;
 903             if (TSD->trace_stat=='I')
 904                tracenumber( TSD, rnum, 'L' ) ;
 905          }
 906          else if (flags.rsvar)
 907             rnum = shortcutnum( TSD, thisptr->p[1] ) ;
 908          else if (flags.rcvar)
 909             rnum = fix_compoundnum( TSD, thisptr->p[1], NULL, NULL );
 910
 911          if (!rnum)
 912             rval = evaluate( TSD, thisptr->p[1], &stmp2 ) ;
 913
 914          if (!lnum && !getdescr( TSD, lval, &TSD->ldes ))
 915             lnum = &TSD->ldes ;
 916
 917          if (!rnum && !getdescr( TSD, rval, &TSD->rdes ))
 918             rnum = &TSD->rdes ;
 919
 920          if (rnum && lnum)
 921             tmp = string_test( TSD, lnum, rnum ) ;
 922          else
 923          {
 924             unsigned char *s1,*s2,*e1,*e2;
 925
 926             if ( !lval )
 927             {
 928                assert( !stmp1 );
 929                stmp1 = lval = str_norm( TSD, lnum, NULL );
 930             }
 931
 932             if ( !rval )
 933             {
 934                assert( !stmp2 );
 935                stmp2 = rval = str_norm( TSD, rnum, NULL );
 936             }
 937
 938             s1 = (unsigned char *) lval->value;
 939             s2 = (unsigned char *) rval->value;
 940             e1 = (unsigned char *) s1 + lval->len;
 941             e2 = (unsigned char *) s2 + rval->len;
 942
 943             strip_whitespace( TSD, &s1, &e1, &s2, &e2 );
 944
 945             if ( s1 == e1 && s2 == e2 )
 946                tmp = 0;
 947             else if ( s1 < e1 && s2 < e2 )
 948                tmp = ( *s1 < *s2 ) ? -1 : 1;
 949             else
 950                tmp = ( s1 < e1 ) ? 1 : -1;
 951          }
 952
 953          FREE_TMP_STRING( stmp1 );
 954          FREE_TMP_STRING( stmp2 );
 955
 956          type = thisptr->type ;
 957          if (tmp==0)
 958             sint = (type==X_GTE || type==X_LTE || type==X_EQUAL) ;
 959          else if (tmp>0)
 960             sint = (type==X_GT || type==X_GTE || type==X_DIFF) ;
 961          else
 962             sint = (type==X_LT || type==X_LTE || type==X_DIFF) ;
 963
 964          if (TSD->trace_stat=='I')
 965             tracebool( TSD, sint, 'O' ) ;
 966
 967          return sint ;
 968       }
 969
 970       case X_SGT:
 971       case X_SLT:
 972       case X_SLTE:
 973       case X_SGTE:
 974       case X_SEQUAL:
 975       case X_SDIFF:
 976       {  /* string comparison */
 977          unsigned char *s1, *s2, *e1, *e2 ;
 978          int type ;
 979
 980          type = thisptr->type ;
 981          strone = evaluate( TSD, thisptr->p[0], &stmp1 ) ;
 982          strtwo = evaluate( TSD, thisptr->p[1], &stmp2 ) ;
 983
 984          s1 = (unsigned char *) strone->value ;
 985          s2 = (unsigned char *) strtwo->value ;
 986          e1 = (unsigned char *) s1 + strone->len ;
 987          e2 = (unsigned char *) s2 + strtwo->len ;
 988
 989          strip_whitespace( TSD, &s1, &e1, &s2, &e2 );
 990
 991          if (s1==e1 && s2==e2)
 992             tmp = 0 ;
 993          else if (s1<e1 && s2<e2)
 994             tmp = (*s1<*s2) ? -1 : 1 ;
 995          else
 996             tmp = (s1<e1) ? 1 : -1 ;
 997
 998          FREE_TMP_STRING( stmp1 );
 999          FREE_TMP_STRING( stmp2 );
1000
1001          if (tmp==0)
1002             sint = (type==X_SGTE || type==X_SLTE || type==X_SEQUAL) ;
1003          else if (tmp>0)
1004             sint = (type==X_SGT || type==X_SGTE || type==X_SDIFF) ;
1005          else
1006             sint = (type==X_SLT || type==X_SLTE || type==X_SDIFF) ;
1007
1008          if (TSD->trace_stat=='I')
1009             tracebool( TSD, sint, 'O' ) ;
1010
1011          return sint ;
1012       }
1013
1014       case X_NGT:
1015       case X_NLT:
1016       case X_NLTE:
1017       case X_NGTE:
1018       case X_NEQUAL:
1019       case X_NDIFF:
1020       {
1021          /* numeric NOT comparison */
1022          int type ;
1023          num_descr *ntmp1, *ntmp2 ;
1024          num_descr *numone, *numtwo ;
1025
1026          type = thisptr->type ;
1027
1028          ntmp1 = ntmp2 = NULL;
1029          numone = calcul( TSD, thisptr->p[0], &ntmp1 ) ;
1030          numtwo = calcul( TSD, thisptr->p[1], &ntmp2 ) ;
1031          tmp = string_test( TSD, numone, numtwo ) ;
1032
1033          if (ntmp1)
1034          {
1035             FreeTSD( ntmp1->num ) ;
1036             FreeTSD( ntmp1 ) ;
1037          }
1038          if (ntmp2)
1039          {
1040             FreeTSD( ntmp2->num ) ;
1041             FreeTSD( ntmp2 ) ;
1042          }
1043
1044          if (tmp==0)
1045             sint = (type==X_NGTE || type==X_NLTE || type==X_NEQUAL) ;
1046          else if (tmp>0)
1047             sint = (type==X_NGT || type==X_NGTE || type==X_NDIFF) ;
1048          else
1049             sint = (type==X_NLT || type==X_NLTE || type==X_NDIFF) ;
1050
1051          if (TSD->trace_stat=='I')
1052             tracebool( TSD, sint, 'O' ) ;
1053
1054          return sint ;
1055       }
1056
1057       case X_S_DIFF:
1058          strone = evaluate( TSD, thisptr->p[0], &stmp1 ) ;
1059          strtwo = evaluate( TSD, thisptr->p[1], &stmp2 ) ;
1060          tmp = Str_cmp(strone,strtwo)!=0 ;
1061
1062          FREE_TMP_STRING( stmp1 );
1063          FREE_TMP_STRING( stmp2 );
1064
1065          if (TSD->trace_stat=='I')
1066             tracebool( TSD, tmp, 'O' ) ;
1067
1068          return tmp ;
1069
1070
1071       case X_S_EQUAL:
1072          strone = evaluate( TSD, thisptr->p[0], &stmp1 ) ;
1073          strtwo = evaluate( TSD, thisptr->p[1], &stmp2 ) ;
1074          tmp = Str_cmp(strone,strtwo)==0 ;
1075
1076          FREE_TMP_STRING( stmp1 );
1077          FREE_TMP_STRING( stmp2 );
1078
1079          if (TSD->trace_stat=='I')
1080             tracebool( TSD, tmp, 'O' ) ;
1081
1082          return tmp ;
1083
1084       case X_S_NGT:
1085       case X_S_NLT:
1086       {  /* strict string NOT comparison */
1087          unsigned char *s1, *s2, *e1, *e2 ;
1088          int type ;
1089
1090          type = thisptr->type ;
1091          strone = evaluate( TSD, thisptr->p[0], &stmp1 ) ;
1092          strtwo = evaluate( TSD, thisptr->p[1], &stmp2 ) ;
1093
1094          s1 = (unsigned char *) strone->value ;
1095          s2 = (unsigned char *) strtwo->value ;
1096          e1 = (unsigned char *) s1 + strone->len ;
1097          e2 = (unsigned char *) s2 + strtwo->len ;
1098          /*
1099           * same compare as non-strict except that leading and trailing spaces
1100           * are retained for comparison.
1101           */
1102          for (;(s1<e1)&&(s2<e2)&&(*s1==*s2);s1++,s2++) ;
1103          if (s1==e1 && s2==e2)
1104             tmp = 0 ;
1105          else if (s1<e1 && s2<e2)
1106             tmp = (*s1<*s2) ? 1 : -1 ;
1107          else
1108             tmp = (s1<e1) ? -1 : 1 ;
1109
1110          FREE_TMP_STRING( stmp1 );
1111          FREE_TMP_STRING( stmp2 );
1112
1113          if (tmp==0)
1114             sint = 1;
1115          else if (tmp>0)
1116             sint = (type==X_S_NGT) ;
1117          else
1118             sint = (type==X_S_NLT) ;
1119
1120          if (TSD->trace_stat=='I')
1121             tracebool( TSD, sint, 'O' ) ;
1122
1123          return sint ;
1124       }
1125
1126       case X_S_GT:
1127       case X_S_GTE:
1128       case X_S_LT:
1129       case X_S_LTE:
1130       {  /* strict string comparison */
1131          unsigned char *s1, *s2, *e1, *e2 ;
1132          int type ;
1133
1134          type = thisptr->type ;
1135          strone = evaluate( TSD, thisptr->p[0], &stmp1 ) ;
1136          strtwo = evaluate( TSD, thisptr->p[1], &stmp2 ) ;
1137
1138          s1 = (unsigned char *) strone->value ;
1139          s2 = (unsigned char *) strtwo->value ;
1140          e1 = (unsigned char *) s1 + strone->len ;
1141          e2 = (unsigned char *) s2 + strtwo->len ;
1142          /*
1143           * same compare as non-strict except that leading and trailing spaces
1144           * are retained for comparison.
1145           */
1146          for (;(s1<e1)&&(s2<e2)&&(*s1==*s2);s1++,s2++) ;
1147          if (s1==e1 && s2==e2)
1148             tmp = 0 ;
1149          else if (s1<e1 && s2<e2)
1150             tmp = (*s1<*s2) ? -1 : 1 ;
1151          else
1152             tmp = (s1<e1) ? 1 : -1 ;
1153
1154          FREE_TMP_STRING( stmp1 );
1155          FREE_TMP_STRING( stmp2 );
1156
1157          if (tmp==0)
1158             sint = (type==X_S_GTE || type==X_S_LTE) ;
1159          else if (tmp>0)
1160             sint = (type==X_S_GT || type==X_S_GTE ) ;
1161          else
1162             sint = (type==X_S_LT || type==X_S_LTE ) ;
1163
1164          if (TSD->trace_stat=='I')
1165             tracebool( TSD, sint, 'O' ) ;
1166
1167          return sint ;
1168       }
1169
1170
1171       default:
1172          exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
1173          return 0 ;
1174    }
1175 }
1176