#ifndef lint
static char *RCSid = "$Id: expr.c,v 1.2 1993/05/10 05:52:08 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1993-1994  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#include "rexx.h"

#include <string.h>
#include <ctype.h>
#include <assert.h>

#define TRACEVALUE(a,b) if (trace_stat=='I') tracevalue(a,b) 


extern nodeptr currentnode ;
extern nodeptr nvar_sigl ;
extern proclevel currlevel ;
extern sysinfo systeminfo ;

nodeptr getlabel( streng *input ) ; 

static num_descr rdes = { NULL, 0, 0, 0, 0 }, ldes = { NULL, 0, 0, 0, 0 } ;


#ifdef TRACEMEM
static void mark_in_expr( void ) 
{
   if (rdes.num)
      markmemory( rdes.num, TRC_STATIC ) ;
   if (ldes.num)
      markmemory( ldes.num, TRC_STATIC ) ;
}
#endif


void initexpr( void )
{
#ifdef TRACEMEM
   regmarker( mark_in_expr ) ;
#endif
}


num_descr *copy_num( num_descr *input ) 
{
   num_descr *new ;

   new = Malloc( sizeof( num_descr )) ;
   new->negative = input->negative ;
   new->size = input->size ;
   new->max = input->max ;
   new->exp = input->exp ;
   new->num = Malloc( input->max ) ;
   memcpy( new->num, input->num, new->size ) ;
   return new ;
}


streng *num_to_str( num_descr *input )
{
   return str_norm( input, NULL ) ;
}

int num_to_bool( num_descr *input ) 
{
   char ch ;

   if (input==NULL)
      exiterror( ERR_UNLOGICAL_VALUE ) ;

   if (input->size!=1 || input->negative || input->exp!=1)
      exiterror( ERR_UNLOGICAL_VALUE ) ;

    ch = input->num[0] ;
    if (ch!='0' && ch!='1') 
       exiterror( ERR_UNLOGICAL_VALUE ) ;

    return ch=='1' ;
}

int str_to_bool( streng *input )
{
   char ch ;

   if (input->len!=1)
      exiterror( ERR_UNLOGICAL_VALUE ) ;
  
   ch = input->value[0] ;
   if (ch!='0' && ch!='1')
      exiterror( ERR_UNLOGICAL_VALUE ) ;

   return ch == '1' ;
}

streng *bool_to_str( int input )
{
   return Str_cre( input ? "1" : "0" ) ;
}


num_descr *str_to_num( streng *input ) 
{
   return get_a_descr( input ) ;
}

num_descr *bool_to_num( int input )
{
   num_descr *num ;
 
   num = Malloc( sizeof( num_descr )) ;
   num->max = 8 ;
   num->num = Malloc( 8 ) ;
   num->size = 1 ;
   num->negative = 0 ;
   num->exp = 1 ;
   num->num[0] = (input) ? '1' : '0' ;
   return num ;
}


/*
   kilone = kiltwo = 0 ;
   if (this->p[0])
   {
      nptr = this->p[0] ;
      type = nptr->type ;
      if (type==X_STRING || type==X_CON_SYMBOL)
      {
         if (!nptr->u.number)
            nptr->u.number = get_a_descr( nptr ) ;
         numone = nptr->u.number ;
      }
      else if (type==X_SIM_SYMBOL)
         numone = shortcutnum( nptr ) ;

      else if (type==X_HEAD_SYMBOL)
         numone = fixcompoundnum( nptr, NULL ) ;         

      else
      {
         numone = calcul( nptr ) ;
         killone = 
      }
   }

*/

num_descr *calcul( nodeptr this, num_descr **kill )
{
   num_descr *numthr, *numone, *numtwo ;
   num_descr *ntmp1, *ntmp2 ;
   int power ;
   num_descr *nptr ;
   streng *sptr ;

   switch (/*(unsigned char)*/(this->type))
   {
      case 0:
      case 255:
      case X_MINUS:
         numone = calcul( this->p[0], &ntmp1 ) ;
         numtwo = calcul( this->p[1], &ntmp2 ) ;
         if (!ntmp2)
            ntmp2 = numtwo = copy_num( numtwo ) ;

         numtwo->negative = !numtwo->negative ;
         goto do_an_add ;

      case X_PLUSS:
         numone = calcul( this->p[0], &ntmp1 ) ;
         numtwo = calcul( this->p[1], &ntmp2 ) ;
do_an_add:
         if (ntmp1)
         {
            numthr = numone ;
            ntmp1 = NULL ;
         }
         else if (ntmp2)
         {
            numthr = numtwo ;
            ntmp2 = NULL ;
         }
         else
            numthr = copy_num( numtwo ) ;
          
         string_add( numone, numtwo, numthr ) ;
         break ;

      case X_MULT:
         numone = calcul( this->p[0], &ntmp1 ) ;
         numtwo = calcul( this->p[1], &ntmp2 ) ;
         if (ntmp1)
         {
            numthr = numone ;
            ntmp1 = NULL ;
         }
         else if (ntmp2)
         {
            numthr = numtwo ;
            ntmp2 = NULL ;
         }
         else
            numthr = copy_num( numtwo ) ;
          
         string_mul( numone, numtwo, numthr ) ;
         break ;

      case X_DEVIDE:
      case X_MODULUS:
      case X_INTDIV:
         numone = calcul( this->p[0], &ntmp1 ) ;
         numtwo = calcul( this->p[1], &ntmp2 ) ;
         if (numtwo->size==1 && numtwo->num[0]=='0')
            exiterror( ERR_BAD_ARITHMETIC ) ;

         numthr = copy_num( numtwo ) ;
         string_div( numone, numtwo, numthr, 
            ((this->type==X_DEVIDE) ? DIVTYPE_NORMAL :
            ((this->type==X_MODULUS) ? DIVTYPE_REMINDER : DIVTYPE_INTEGER))) ;
         break ;

      case X_EXP:
         numone = calcul( this->p[0], &ntmp1 ) ;
         power = descr_to_int( calcul( this->p[1], &ntmp2 )) ;
         if (ntmp2)
         {
            numtwo = ntmp2 ;
/*            ntmp2 = NULL ; */
         }
         else 
            ntmp2 = numtwo = copy_num( numone ) ;
         

         numthr = copy_num( numone ) ;
         string_pow( numone, power, numtwo, numthr ) ;
         break ;

      case X_STRING:
      case X_CON_SYMBOL: 
         if (!this->u.number)
            this->u.number = get_a_descr( this->name ) ;

         if (trace_stat=='I')
            tracenumber( this->u.number, 'L' ) ;

         if (kill)
         {
            *kill = NULL ;
            return this->u.number ;
         }
         else
            return copy_num( this->u.number ) ;

      case X_SIM_SYMBOL:
      case X_STEM_SYMBOL:
         if (kill)
            *kill = NULL ;

         nptr = shortcutnum( this ) ;
         if (!nptr)
            exiterror( ERR_BAD_ARITHMETIC ) ;

         if (kill)
            return nptr ;
         else
            return copy_num( nptr ) ;

      case X_HEAD_SYMBOL:
         if (kill)
            *kill = NULL ;

         nptr = fix_compoundnum( this, NULL ) ;
         if (!nptr)
            exiterror( ERR_BAD_ARITHMETIC ) ;

         if (kill)
            return nptr ;
         else
            return copy_num( nptr ) ;

      case X_U_PLUSS:
      case X_U_MINUS:
         numthr = calcul( this->p[0], &ntmp1 ) ;
         if (!ntmp1)
            numthr = copy_num( numthr ) ;

         if (this->type==X_U_MINUS) 
            numthr->negative = !numthr->negative ;

         if (kill)
            *kill = numthr ; 
 
         if (trace_stat=='I')
            tracenumber( numthr, 'P' ) ;

         return numthr ;

      case X_IN_FUNC:
      case X_IS_INTERNAL:
      case X_IS_BUILTIN:
      case X_EX_FUNC:
      case X_IS_EXTERNAL:
      case X_CONCAT:
      case X_SPACE:
      {
         streng *stmp ;
         numthr = str_to_num( stmp=evaluate( this, &sptr )) ;
         if (sptr)
            Free_string( sptr ) ;
         if (kill)
            *kill = numthr ;
         return numthr ;
      }
      case X_LOG_NOT:
      case X_LOG_OR:
      case X_LOG_AND:
      case X_LOG_XOR:
      case X_S_DIFF:
      case X_S_EQUAL:
      case X_EQUAL:
      case X_GT:
      case X_LT:	 
      case X_GTE:
      case X_LTE:
      case X_DIFF:
      case X_SEQUAL:
      case X_SGT:
      case X_SLT:	 
      case X_SGTE:
      case X_SLTE:
      case X_SDIFF:
      case X_NEQUAL:
      case X_NGT:
      case X_NLT:	 
      case X_NGTE:
      case X_NLTE:
      case X_NDIFF:
         numthr = bool_to_num( boolean( this )) ;
         if (kill)
            *kill = numthr ;
         return numthr ;

      default:
         exiterror( ERR_INTERPRETER_FAILURE ) ;
         return NULL ;
   }

   if (ntmp1)
   {
      Free( numone->num ) ;
      Free( numone ) ;
   }
   if (ntmp2)
   {
      Free( numtwo->num ) ;
      Free( numtwo ) ;
   }
   if (kill)
      *kill = numthr ; 
 
   if (trace_stat=='I')
      tracenumber( numthr, 'O' ) ;

   str_strip( numthr ) ;
   str_round( numthr, currlevel->currnumsize ) ;
   return numthr ;
}



streng *evaluate( nodeptr this, streng **kill )
{
   streng *strone, *strtwo, *strthr ;
   streng *stmp1, *stmp2, *sptr ;
   streng *stmp ;
   num_descr *ntmp ;

   switch (/*(unsigned char)*/(this->type))
   {
      case 0:
      case 255:
      case X_PLUSS:
      case X_MINUS:
      case X_MULT:
      case X_DEVIDE:
      case X_MODULUS:
      case X_INTDIV:
      case X_EXP:
      case X_U_MINUS:
      case X_U_PLUSS:
         stmp = num_to_str( calcul( this, &ntmp )) ;
         if (ntmp)
         {
            Free( ntmp->num ) ;
            Free( ntmp ) ;
         }
         if (kill)
            *kill = stmp ;

         return stmp ;

      case X_NULL:
         return NULL ;

      case X_STRING:
      case X_CON_SYMBOL: 
         stmp = this->name ;
         if (trace_stat=='I')
            tracevalue( stmp, 'L' ) ;

         goto cnsnt ;

      case X_HEAD_SYMBOL:
         /* always duplicate, since stmp might point to tmp area */
         stmp = Str_dup( fix_compound(this, NULL)) ;
         if (kill)
            *kill = stmp ;
         return stmp ;

      case X_STEM_SYMBOL:
      case X_SIM_SYMBOL:
         stmp = shortcut(this) ;
cnsnt:   if (kill)
            *kill = NULL ;
         else
            stmp = Str_dup( stmp ) ;
         return stmp ;

      case X_IN_FUNC:
      {
         nodeptr entry ;
         if ((entry=getlabel(this->name)))
         { 
            this->type = X_IS_INTERNAL ;
            this->u.node = entry ;  
         }
         else
            this->u.node = NULL ;
      }

      case X_IS_INTERNAL:
      {
         proclevel oldlevel ;
         int stackmark ;
         nodeptr entry ;
         paramboxptr args ;
         streng *ptr ;

         if ((entry=this->u.node))
         {
 	    setshortcut(nvar_sigl,int_to_streng( currentnode->lineno )) ;
            oldlevel = currlevel ;
            args = initplist( this ) ;
            currlevel = newlevel( currlevel ) ;
            currlevel->args = args ;
            stackmark = pushcallstack(currentnode) ;

            ptr = interpret( entry->next ) ;
            if (ptr==NULL) 
               exiterror( ERR_NO_DATA_RETURNED ) ;

            popcallstack(stackmark) ;
            removelevel( currlevel ) ;
            currlevel = oldlevel ; 
            currlevel->next = NULL ;
            trace_stat = currlevel->tracestat ;
            if (kill)
               *kill = ptr ;
            if (trace_stat=='I')
               tracevalue( ptr, 'F' ) ;

            return ptr ; 
         }
      }

      case X_IS_BUILTIN:
      case X_EX_FUNC:
      {
         streng *ptr ;

         if (&nofunc!=(ptr=buildtinfunc( this )))
         {
            if (this->type != X_IS_BUILTIN)
               this->type = X_IS_BUILTIN ;
            if (kill)
               *kill = ptr ;

            if (!ptr)
               exiterror( ERR_NO_DATA_RETURNED ) ;

            if (trace_stat=='I')
               tracevalue( ptr, 'F' ) ;

            return ptr ;
         }     
         else
            this->type = X_IS_EXTERNAL ;
      }

      case X_IS_EXTERNAL:
      {
         streng *ptr, *command ;
         int stackmark ;
         paramboxptr args, targs ;

         update_envirs( currlevel ) ;

         args = targs = initplist( this ) ;
         command = Str_make( 1000 ) ;
         command = Str_cat(command,this->name ) ;
         for (;targs;targs=targs->next) 
            if (targs->value) 
            {
               command = Str_catstr(command," ") ; 
               command = Str_cat(command,targs->value) ; 
            }
         
	 stackmark = pushcallstack( currentnode ) ;
         ptr = execute_external(command,args,systeminfo->environment,
                                NULL,0, INVO_FUNCTION);
         popcallstack( stackmark ) ;
         deallocplink( args ) ;

         if (!ptr) 
            ptr = run_popen( command, currlevel->environment ) ;

         if (!ptr)
         {
            exiterror( ERR_ROUTINE_NOT_FOUND ) ;
            ptr = nullstringptr() ;
         }
         if (kill)
            *kill = ptr ;

         if (trace_stat=='I')
            tracevalue( ptr, 'F' ) ;

         Free_string( command ) ;
         return ptr ;         
      }

      case X_CONCAT:
      case X_SPACE:
      {
         char *cptr ;

         strone = evaluate( this->p[0], &stmp1 ) ;
         strtwo = evaluate( this->p[1], &stmp2 ) ;
         strthr = Str_make(Str_len(strone)+Str_len(strtwo)+1) ; 
         cptr = strthr->value ;
         memcpy( cptr, strone->value, strone->len ) ;
         cptr += strone->len ;
         if (this->type==X_SPACE) 
            *(cptr++) = ' ' ;

         memcpy( cptr, strtwo->value, strtwo->len ) ;
         strthr->len = (cptr-strthr->value) + strtwo->len ;

         if (kill)
            *kill = strthr ;
         if (stmp1)
            Free_string( stmp1 ) ;
         if (stmp2)
            Free_string( stmp2 ) ;

         if (trace_stat=='I')
            tracevalue( strthr, 'O' ) ;


         return strthr ;
      }


      case X_LOG_NOT:
      case X_LOG_OR:
      case X_LOG_AND:
      case X_LOG_XOR:
      case X_S_DIFF:
      case X_S_EQUAL:
      case X_EQUAL:
      case X_GT:
      case X_LT:	 
      case X_GTE:
      case X_LTE:
      case X_DIFF:
      case X_SEQUAL:
      case X_SGT:
      case X_SLT:	 
      case X_SGTE:
      case X_SLTE:
      case X_SDIFF:
      case X_NEQUAL:
      case X_NGT:
      case X_NLT:	 
      case X_NGTE:
      case X_NLTE:
      case X_NDIFF:
         sptr = bool_to_str( boolean( this )) ;
         if (kill)
            *kill = sptr ;
         return sptr ;

      default:
         exiterror( ERR_INTERPRETER_FAILURE ) ;
         return NULL ;
   }
}



int boolean( nodeptr this )
{
   streng *strone, *strtwo ;
   streng *stmp1, *stmp2 ;
   int tmp, sint ;
   streng *sptr ;
   num_descr *ntmp ;

   switch (/*(unsigned char)*/(this->type))
   {
      case 0:
      case 255:
      case X_PLUSS:
      case X_MINUS:
      case X_MULT:
      case X_DEVIDE:
      case X_MODULUS:
      case X_INTDIV:
      case X_EXP:
      case X_U_MINUS:
      case X_U_PLUSS:
         tmp = num_to_bool( calcul( this, &ntmp )) ;
         if (ntmp)
         {
            Free( ntmp->num ) ;
            Free( ntmp ) ;
         }
         return tmp ;

      case X_STRING:
      case X_CON_SYMBOL: 
         if (!this->u.number)
            this->u.number = get_a_descr( this->name ) ;

         return num_to_bool( this->u.number ) ;

      case X_SIM_SYMBOL:
      case X_STEM_SYMBOL:
         return num_to_bool( shortcutnum( this )) ;

      case X_HEAD_SYMBOL:
         return num_to_bool( fix_compoundnum(this, NULL )) ;

      case X_IN_FUNC:
      case X_IS_INTERNAL:
      case X_IS_BUILTIN:
      case X_EX_FUNC:
      case X_IS_EXTERNAL:
      case X_CONCAT:
      case X_SPACE:
         tmp = str_to_bool( sptr = evaluate( this, &sptr )) ;
         if (sptr)
            Free_string( sptr ) ;
         return tmp ;

      case X_LOG_NOT:
         sint = !boolean( this->p[0] ) ;
         if (trace_stat=='I')
            tracebool( sint, 'U' ) ;
         return sint ;

      case X_LOG_OR:
         sint = ( boolean(this->p[0]) | boolean( this->p[1] )) ;
         if (trace_stat=='I')
            tracebool( sint, 'U' ) ;
         return sint ;

      case X_LOG_AND:
         sint = ( boolean(this->p[0]) & boolean( this->p[1] )) ;
         if (trace_stat=='I')
            tracebool( sint, 'U' ) ;
         return sint ;

      case X_LOG_XOR:
         /* Well, sort of ... */
         sint = ( boolean( this->p[0]) ^ boolean( this->p[1] )) ;
         if (trace_stat=='I')
            tracebool( sint, 'U' ) ;
         return sint ;

      case X_EQUAL:
      case X_DIFF: 
      case X_GT:
      case X_GTE:
      case X_LT:
      case X_LTE:
      {
         int type ;
         compflags flags ;
         num_descr *rnum, *lnum ;
         streng *lval, *rval ;

         flags = this->u.flags ;
         rnum = lnum = 0 ;
         rval = lval = NULL ;
         stmp1 = stmp2 = NULL ;

         if (flags.lnum)
         {
            lnum = this->p[0]->u.number ;
            if (trace_stat=='I')
               tracenumber( lnum, 'L' ) ;
         }
         else if (flags.lsvar)
            lnum = shortcutnum( this->p[0] ) ;
         else if (flags.lcvar)
            lnum = fix_compoundnum( this->p[0], NULL ) ;

         if (!lnum)
            lval = evaluate( this->p[0], &stmp1 ) ;
            
         if (flags.rnum)
         {
            rnum = this->p[1]->u.number ;
            if (trace_stat=='I')
               tracenumber( rnum, 'L' ) ;
         }
         else if (flags.rsvar)
            rnum = shortcutnum( this->p[1] ) ;
         else if (flags.rcvar)
            rnum = fix_compoundnum( this->p[1], NULL ) ;

         if (!rnum)
            rval = evaluate( this->p[1], &stmp2 ) ;

         if (!lnum && !getdescr( lval, &ldes ))
            lnum = &ldes ;

         if (!rnum && !getdescr( rval, &rdes ))
            rnum = &rdes ;
        
         if (rnum && lnum)
            tmp = string_test( lnum, rnum ) ;
         else
         {
            char *s1, *s2, *e1, *e2 ;

            if (!lval)
            {
               assert( !stmp1 ) ;
               stmp1 = lval = str_norm( lnum, NULL ) ;
            }
         
            if (!rval)
            {
               assert( !stmp2 ) ;
               stmp2 = rval = str_norm( rnum, NULL ) ;
            }

            s1 = lval->value ;
            s2 = rval->value ;
            e1 = s1 + lval->len ;
            e2 = s2 + rval->len ;
            for(;(s1<e1)&&(isspace(*s1));s1++);
            for(;(s2<e2)&&(isspace(*s2));s2++);
            for (;(*s1==*s2)&&(s1<e1)&&(s2<e2);s1++,s2++) ;
               
            for (;(s1<e1)&&(isspace(*s1));s1++) ;
            for (;(s2<e2)&&(isspace(*s2));s2++) ;

            if (s1==e1 && s2==e2)
               tmp = 0 ;
            else if (s1<e1 && s2<e2)
               tmp = (*s1<*s2) ? -1 : 1 ;
            else 
               tmp = (s1<e1) ? 1 : -1 ;
         }

         if (stmp1)
            Free_string( stmp1 ) ;
         if (stmp2)
            Free_string( stmp2 ) ;

         type = this->type ;
         if (tmp==0)
            sint = (type==X_GTE || type==X_LTE || type==X_EQUAL) ;
         else if (tmp>0)
            sint = (type==X_GT || type==X_GTE || type==X_DIFF) ;
         else
            sint = (type==X_LT || type==X_LTE || type==X_DIFF) ;
     
         if (trace_stat=='I')
            tracebool( sint, 'O' ) ;

         return sint ;
      }

      case X_SGT:
      case X_SLT:
      case X_SLTE:
      case X_SGTE: 
      case X_SEQUAL:
      case X_SDIFF:
      {  /* non-strict string comparison */
         char *s1, *s2, *e1, *e2 ;
         int type ;
	 
         type = this->type ;
         strone = evaluate( this->p[0], &stmp1 ) ;
         strtwo = evaluate( this->p[1], &stmp2 ) ;

         s1 = strone->value ;
         s2 = strtwo->value ;
         e1 = s1 + strone->len ;
         e2 = s2 + strtwo->len ;
         for(;(s1<e1)&&(isspace(*s1));s1++);
         for(;(s2<e2)&&(isspace(*s2));s2++);
         for (;(*s1==*s2)&&(s1<e1)&&(s2<e2);s1++,s2++) ;
               
         for (;(s1<e1)&&(isspace(*s1));s1++) ;
         for (;(s2<e2)&&(isspace(*s2));s2++) ;

         if (s1==e1 && s2==e2)
            tmp = 0 ;
         else if (s1<e1 && s2<e2)
            tmp = (*s1<*s2) ? -1 : 1 ;
         else 
            tmp = (s1<e1) ? 1 : -1 ;

         if (stmp1)
            Free_string( stmp1 ) ;
         if (stmp2)
            Free_string( stmp2 ) ;

         if (tmp==0)
            sint = (type==X_SGTE || type==X_SLTE || type==X_SEQUAL) ;
         else if (tmp>0)
            sint = (type==X_SGT || type==X_SGTE || type==X_SDIFF) ;
         else
            sint = (type==X_SLT || type==X_SLTE || type==X_SDIFF) ;

         if (trace_stat=='I')
            tracebool( sint, 'O' ) ;

         return sint ;
      }


      case X_NGT:
      case X_NLT:
      case X_NLTE:
      case X_NGTE: 
      case X_NEQUAL:
      case X_NDIFF:
      {
         int type ;
         num_descr *ntmp1, *ntmp2 ;
         num_descr *numone, *numtwo ;

         type = this->type ;

         numone = calcul( this->p[0], &ntmp1 ) ;
         numtwo = calcul( this->p[1], &ntmp2 ) ;
         tmp = string_test( numone, numtwo ) ;
       
         if (ntmp1)
         {
            Free( ntmp1->num ) ;
            Free( ntmp1 ) ;
         }
         if (ntmp2)
         {
            Free( ntmp2->num ) ;
            Free( ntmp2 ) ;
         }
  
         if (tmp==0)
            sint = (type==X_NGTE || type==X_NLTE || type==X_NEQUAL) ;
         else if (tmp>0)
            sint = (type==X_NGT || type==X_NGTE || type==X_NDIFF) ;
         else
            sint = (type==X_NLT || type==X_NLTE || type==X_NDIFF) ;

         if (trace_stat=='I')
            tracebool( sint, 'O' ) ;

         return sint ;
      }

      case X_S_DIFF:
         strone = evaluate( this->p[0], &stmp1 ) ;
         strtwo = evaluate( this->p[1], &stmp2 ) ;
         tmp = Str_cmp(strone,strtwo)!=0 ;
         if (stmp1)
            Free_string( stmp1 ) ;
         if (stmp2) 
            Free_string( stmp2 ) ;
         if (trace_stat=='I')
            tracebool( tmp, 'O' ) ;

         return tmp ;
         

      case X_S_EQUAL:
         strone = evaluate( this->p[0], &stmp1 ) ;
         strtwo = evaluate( this->p[1], &stmp2 ) ;
         tmp = Str_cmp(strone,strtwo)==0 ;
         if (stmp1)
            Free_string( stmp1 ) ;
         if (stmp2) 
            Free_string( stmp2 ) ;
         if (trace_stat=='I')
            tracebool( tmp, 'O' ) ;

         return tmp ;


      default:
         exiterror( ERR_INTERPRETER_FAILURE ) ;
         return 0 ;
   }
}

