

#ifdef R2PERL

#include "rexx.h"
#include "stdio.h"

int indentsize=0 ;
int loopcnt=1 ;


void indent()
{
   int i ;

   for (i=0; i<indentsize; i++)
      putchar( ' ' ) ;
}


void tabin()
{
   indentsize += 3 ;   
}


void tabout()
{
   indentsize -= 3 ;
}


void preamble() 
{
   printf( "require \"r2perl.pl\" ;\n\n" ) ;
}


void output( char *cptr )
{
    printf( "%s", cptr ) ;
}


void outint( int num ) 
{
    printf( "%d", num ) ;
}


void outstr( streng *str ) 
{
   int i ;

   for (i=0; i<str->len; i++)
      putchar( str->value[i] ) ;
}

void expression( nodeptr this ) 
{
   nodeptr tptr ;

   if (!this)
   {
      return ;
   }

   switch (this->type) 
   {
      case X_NULL:
         output( "\"\"" ) ;
         return ;
 
      case X_GT:
      case X_LT:
      case X_EQUAL:
         output( "(" ) ;
         expression( this->p[0] ) ;
         switch (this->type)
         {
            case X_EQUAL: output( "==" ) ; break ;
            case X_GT: output( "==" ) ; break ;
            case X_LT: output( "==" ) ; break ;
         }
         expression( this->p[1] ) ;
         output( ")" ) ;
         break ;

      case X_MODULUS:
      case X_DEVIDE:
      case X_MINUS:
      case X_PLUSS:
      case X_MULT:
         output( "(" ) ;
         expression( this->p[0] ) ;

         switch (this->type)
         {
            case X_MODULUS: output( "%" ) ; break ;
            case X_DEVIDE: output( "/" ) ; break ;
            case X_MULT:  output( "*" ) ; break ;
            case X_MINUS: output( "-" ) ; break ;
            case X_PLUSS: output( "+" ) ; break ;
         }
         expression( this->p[1] ) ;
         output( ")" ) ;
         break ;

      case X_IN_FUNC:
         output( "&" ) ;
         outstr( this->name ) ;
         output( "(" ) ;
         for (tptr=this->p[0]; tptr; tptr=tptr->p[1])
         {
            output( "(" ) ;
            expression( tptr->p[0] ) ;
            output( ")" ) ;
            if (tptr->p[1])
               output( "," ) ;
         }
         output( ")" ) ;
         break ;
     
      case X_STRING:
      case X_CON_SYMBOL:
         output( "\"" ) ;
         outstr( this->name ) ;
         output( "\"" ) ;
         break ;

      case X_SIM_SYMBOL:
         output( "$" ) ;
         outstr( this->name ) ;
         break ;

      case X_CONCAT:
      case X_SPACE:
         expression( this->p[0] ) ;
         if (this->type == X_SPACE)
            output( ",\" \"," ) ;
         else
            output( "," ) ;
         expression( this->p[1] ) ;
         break ;

      default:
         abort() ;
         
   }

   return ;
}



void translate( nodeptr this )
{
   int i ;

start_again:

   if (!this)
      return ;

   switch ( this->type ) 
   {
      case X_PROGRAM:
      case X_WHENS:
      case X_STATS:       
      case X_OTHERWISE:
         translate( this->p[0] ) ;
         this = this->p[1] ;
         goto start_again ;


      case X_DO:
         indent() ;
         if ((!this->p[0]) && (!this->p[1])) 
         {
            output( "{\n" ) ;
            tabin() ;
         }
         else if (this->p[0] && !this->p[0]->name)
         {
            output( "for ($loopcnt_" ) ;
            outint( loopcnt ) ;
            output( "=0; $loopcnt_" ) ;
            outint( loopcnt ) ;
            output( "<" ) ;
            expression( this->p[0]->p[1]->p[0] ) ;
            output( "; $loopcnt_" ) ;
            outint( loopcnt++ ) ;
            output( "++)\n" ) ;
            indent() ;
            output( "{\n" ) ;
            tabin() ;
         }
         else
         {
            output( "for ($" ) ;
            outstr( this->p[0]->name ) ;
            output( "=" ) ;
            expression( this->p[0]->p[0] ) ;
            output( "; " ) ;

            for (i=1; i<4; i++)
            {
               if (this->p[0]->p[i] && this->p[0]->p[i]->type == X_DO_TO)
               {
                  output( "$" ) ;
                  outstr( this->p[0]->name ) ;
                  output( "<=" ) ;
                  expression( this->p[0]->p[i]->p[0] ) ;
                  break ;
               }
            }
            output( "; " ) ;

            for (i=1; i<4; i++)
            {
               if (this->p[0]->p[i] && this->p[0]->p[i]->type == X_DO_BY)
               {
                  output( "$" ) ;
                  outstr( this->p[0]->name ) ;
                  output( "+=" ) ;
                  expression( this->p[0]->p[i]->p[0] ) ;
                  break ;
               }
            }
            output( ")\n" ) ;
            indent() ;
            output( "{\n" ) ;
            tabin() ;
         }

         if (this->p[1] && this->p[1]->type == X_WHILE)
         {
            indent() ;
            output( "if (" ) ;
            expression( this->p[1]->p[0] ) ;
            output( ") break ;\n" ) ;
         }

         translate( this->p[2] ) ;

         if (this->p[1] && this->p[1]->type == X_UNTIL)
         {
            indent() ;
            output( "if (" ) ;
            expression( this->p[1]->p[0] ) ;
            output( ") break ;\n" ) ;
         }

         tabout() ;
         indent() ;
         output( "}\n" ) ;
         break ;


       case X_IF:
         indent() ;
         output( "if (" ) ;
         expression( this->p[0] ) ;
         output( ")\n" ) ;
         indent() ; 
         output( "{\n" ) ;
         tabin() ;
         translate( this->p[1] ) ;
         tabout() ;
         indent() ;
         output( "}\n" ) ;
         if ( this->p[2] ) 
         {
             indent() ;
             output( "else\n" ) ;
             indent() ; 
             output( "{\n" ) ;
             tabin() ;
             translate( this->p[2] ) ;
             tabout() ;
             indent() ;
             output( "}\n" ) ;
         }
         break ;

      case X_ASSIGN:
      {
         indent() ;
         output( "$" ) ;
         outstr( this->name ) ;
         output( " = " ) ;
         expression( this->p[0] ) ;
         output( " ;\n" ) ;
         break ;
      }

/* 
      case X_IPRET:
      {
         output( "eval( " ) ;
         output( expression( this->p[0] ) ) ;
         output( " )\n" ) ;
         break ;	
      }

      case X_NO_OTHERWISE:
      {
         output( "else { die( "WHEN or OTHERWISE expected" ) ; }" ) ;
         break ; 
      }
                  
      case X_SELECT:
      {
         first_when = 1 ;
      }
         nstack[nstackptr++] = this->next ;
         nstack[nstackptr++] = this->p[1] ;
         this = this->p[0] ;
         goto fakerecurse ;

      case X_WHEN:
      {
         streng *tptr ;

         if (str_true(tptr=evaluate(this->p[0]))) 
         {
            Free_string( tptr ) ;
            nstackptr-- ; / * kill the OTHERWISE on the stack * /
            this = this->p[1] ;
            goto fakerecurse ;
         }
         Free_string( tptr ) ;
         break ;
      }
*/

      case X_SAY:
      {
         indent() ;
         output( "print " ) ;
         if (this->p[0])
         {
            expression( this->p[0] ) ;
            output( "," ) ;
         }
         output( "\"\\n\" ;\n" ) ;
         break ;
      }

      case X_TRACE:
      {
         break ; 
      }     

      case X_EXIT:
      {
         indent() ;
         output( "exit(" ) ;
         expression( this->p[0] ) ;
         output( " ) ;\n" ) ;
         break ;
      }

      case X_COMMAND:
      {
         indent() ;
         output( "system(" ) ;
         expression( this->p[0] ) ;
         output( " ) ;\n" ) ;
      }
/*
      case X_ADDR_N:   / * ADDRESS environment [expr] * /
      {
         static streng rc_str = { 3, 2, "RC" } ;
         streng *envir, *tmp ;
         int rc ;

         envir = this->name ;
         if (this->p[0])
         {
            if ((rc=perform(tmp=evaluate(this->p[0]), envir, this->lineno)))
               traceerror( this, rc ) ;
            Free_string( tmp ) ;
            setvalue( &rc_str, int_to_streng(rc) ) ;
         }
         else
         {
            Free_string( currlevel->prev_env ) ;
            currlevel->prev_env = currlevel->environment ;
            currlevel->environment = Str_dup(envir) ;
         }
         break ;
      }

	 
      case X_ADDR_V:   / * ADDRESS [VALUE] expr * /
      {
         streng *cptr ;

         cptr = evaluate(this->p[0]) ;
         Free_string( currlevel->prev_env ) ;
         currlevel->prev_env = currlevel->environment ;
         currlevel->environment = cptr ;
         break ;
      }


      case X_ADDR_S:   / * ADDRESS * /
      {
         streng *tptr ;

         tptr = currlevel->environment ;
         currlevel->environment = currlevel->prev_env ;
         currlevel->prev_env = tptr ;
         break ;
      }         


      case X_DROP:
      {
         nodeptr nptr ;
         for (nptr=this->p[0]; nptr; nptr=nptr->p[0] ) 
            if (nptr->name)
               if (nptr->type == X_SIM_SYMBOL)
                  drop_var( nptr->name ) ;
               else if (nptr->type == X_IND_SYMBOL)
               {
                  char *start, *stop, *end ;
                  streng *name, *value ;
                 
                  value = shortcut( nptr ) ;
/ *                value = getvalue( nptr->name, 0 ) ; * /
                  end = Str_end( value ) ;
                  start = value->value ;
                  for (;;)
                  {
                     for (; start<end && isspace(*start); start++) ;
                     for (stop=start; stop<end && !isspace(*stop); stop++) ;
                     if (stop==start)
                        break ;

                     name = Str_make( stop - start ) ;
                     Str_ncatstr( name, start, stop-start ) ;
                     for (; start<stop; start++)
                        if (islower(*start))
                           *start = toupper(*start) ;

                     drop_var( name ) ;
                     Free_string( name ) ;
                  }
               }		   
         break ;
      }

      case X_SIG_SET:
      case X_CALL_SET:
      {
         int type ;
         trap *traps = gettraps( currlevel ) ;

         / * which kind of condition is this? * /
         type = identify_trap( this->p[1]->type ) ;
 
         / * We always set this * /
         traps[type].invoked = (this->type == X_SIG_SET) ;
         traps[type].delayed = 0 ;         
         traps[type].on_off = (this->p[0]->type == X_ON ) ;

         / * set the name of the variable to work on * /
         FREE_IF_DEFINED( traps[type].name ) ;
         if (this->name)
            traps[type].name = Str_dup( this->name ) ;
         else if (this->p[0]->type == X_ON)
            traps[type].name = Str_cre( signalnames[type] ) ;

         break ;
      }

      case X_SIG_VAL:
      case X_SIG_LAB:
      {
         streng *cptr ;

         cptr = (this->name) ? Str_dup(this->name) : evaluate( this->p[0] ) ;
         nstackptr = 0 ;
         for (;stackptr>0;stackptr--) 
         {
            if (stack[stackptr-1].increment) 
                 free_a_descr(stack[stackptr-1].increment) ;

            if (stack[stackptr-1].stopval) 
                 free_a_descr(stack[stackptr-1].stopval) ;
         }

         setvalue( var_sigl, int_to_streng( this->lineno )) ;
         entry = getlabel( cptr ) ;

         if (!this->name)
            Free_string( cptr ) ;

         if ((entry)==NULL) exiterror(16) ;
         this = entry->next ;
         goto fakerecurse ;
         break ;
      }
      case X_PROC: 
         if (currlevel->varflag) 
            exiterror(ERR_UNEXPECTED_PROC) ;

         for (ptr=this->p[0];(ptr);ptr=ptr->p[0])
	    if (ptr->name) 
               expose_var(ptr->name) ;
            else
               exiterror(ERR_INTERPRETER_FAILURE) ;

         expose_var(NULL) ;
         break ; 

      case X_CALL:
      {
         this->u.node = getlabel(this->name) ;
         this->type = (this->u.node) ? X_IS_INTERNAL : X_IS_BUILTIN ;
      }

      case X_IS_INTERNAL: 
      {
         paramboxptr targs ;

         if ( this->u.node ) 
         {
            setvalue( var_sigl, int_to_streng( this->lineno )) ;

            no_next_interactive = 1 ;
            targs = initplist( this ) ;
            oldlevel = currlevel ;
            currlevel = newlevel( currlevel ) ;
            currlevel->args = targs ; 
            stackmark = pushcallstack( this ) ;

            result = interpret( this->u.node ) ;

            popcallstack( stackmark ) ;
            removelevel( currlevel ) ;
            currlevel = oldlevel ; 
            currlevel->next = NULL ;

            if (result)
               setvalue( var_result, result ) ;
            else
               drop_var( var_result ) ;
         
            break ;
        }
     }
   
     case X_IS_BUILTIN: 
     {
        if (!(result = buildtinfunc( this )))
           exiterror( ERR_ROUTINE_NOT_FOUND ) ;

        if (result)
           setvalue( var_result, result ) ;
        else
           drop_var( var_result ) ;
        
        break ;
      }

      case X_PARSE_ARG:
      case X_PARSE_ARG_U:
        args = currlevel->args->next ;
        (void)parseargtree( this, args, this->type!=X_PARSE_ARG ) ;
        break ;

      case X_PARSE_U:
      case X_PARSE:
         source = NULL ;
         switch (this->p[0]->type) {
             case X_PARSE_VAR:
                source = Str_dup(shortcut( this->p[0] )) ;
/ *              source = Str_dup(getvalue( this->p[0]->name, 1 )) ; * /
                break ; 

             case X_PARSE_VAL:
                source = evaluate(this->p[0]->p[0]);
                break ;

	     case X_PARSE_PULL:
	        source = popline() ;
                break ;

             case X_PARSE_VER:
                source = Str_cre(PARSE_VERSION_STRING) ;
                break ;

             case X_PARSE_EXT:
                source = readkbdline() ;
                break ; 

             case X_PARSE_SRC:
                origfile = systeminfo->called_as ;
                inpfile = systeminfo->input_file ;
                source = Str_make(15+Str_len(origfile)+Str_len(inpfile)) ;
                source->len = 0 ;
                Str_catstr(source,"UNIX COMMAND ") ;
                Str_cat(source,inpfile) ;
                Str_catstr(source," ") ;
                Str_cat(source,origfile) ;
                break ;      
             } 

        if (this->type==X_PARSE_U) 
           (void)upcase(source) ;

        doparse( source, this->p[1], 0, 0 ) ;
        Free_string( source ) ;
        break ;
*/

      case X_PUSH:
        indent() ;
        output( "push( @rx_array, " ) ;
        expression( this->p[0] ) ;
        output( ") ;\n" ) ; 
        break ;

      case X_PULL:
        indent() ;
        output( "pop( @rx_array, " ) ;
        expression( this->p[0] ) ;
        output( ") ;\n" ) ; 
        break ;

      case X_QUEUE:
        indent() ;
        output( "unshift( @rx_array, " ) ;
        expression( this->p[0] ) ;
        output( ") ;\n" ) ;
        break ; 

      case X_RETURN:
      {
         indent() ;
         output( "return( " ) ;
         if (this->p[0]) 
            expression( this->p[0] ) ;
         else
            output( "\"\"" ) ;
         output( " ) ;\n" ) ;
         break ;
      }

      case X_LEAVE:
      {
         if (this->name) 
            output( "warn( \"symbolname ignored in LEAVE\n\") ;\n" ) ;
          
         indent() ;
         output( "break ;\n" ) ;
         break ;
      }

      case X_ITERATE:
      {
         if (this->name) 
            output( "warn( \"symbolname ignored in ITERATE\n\") ;\n" ) ;
          
         indent() ;
         output( "continue ;\n" ) ;
         break ;
      }
/*
      case X_NUM_D:
      {
	 streng *cptr = evaluate( this->p[0] ) ;
         currlevel->currnumsize = atopos( cptr ) ;
         Free_string( cptr ) ;
         break ;
      }

      case X_NUM_FUZZ:
      {
	 streng *cptr = evaluate( this->p[0] ) ;
         currlevel->numfuzz = atozpos( cptr ) ;
         Free_string( cptr ) ;
         break ;
      }

      case X_NUM_F:
      {
         if (this->p[0]->type == X_NUM_SCI)
            currlevel->numform = NUM_FORM_SCI ;
         else if (this->p[0]->type == X_NUM_ENG)
            currlevel->numform = NUM_FORM_ENG ;
         else
            exiterror( ERR_INTERPRETER_FAILURE ) ;
         break ;
      }


      case X_LABEL:
      case X_NULL:
         break ;
*/
   }

}



#endif /* R2PERL */
